?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
git-gui: add build tab
[git-gui/bertw.git] / git-gui.sh
blob72ce09906b731ba60a3239346331c42d53ce2185
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 || test "z$*" = z--version; \
5 then \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
7 exit; \
8 fi; \
9 argv0=$0; \
10 exec wish8.5 "$argv0" -- "$@"
11
12 set appvers {@@GITGUI_VERSION@@}
13 set copyright [string map [list (c) \u00a9] {
14 Copyright (c) 2006-2010 Shawn Pearce, et. al.
15
16 This program is free software; you can redistribute it and/or modify
17 it under the terms of the GNU General Public License as published by
18 the Free Software Foundation; either version 2 of the License, or
19 (at your option) any later version.
20
21 This program is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License for more details.
25
26 You should have received a copy of the GNU General Public License
27 along with this program; if not, write to the Free Software
28 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}]
29
30 ######################################################################
31 ##
32 ## Tcl/Tk sanity check
33
34 if {[catch {package require Tcl 8.5} err]
35 || [catch {package require Tk 8.5} err]
36 } {
37 catch {wm withdraw .}
38 tk_messageBox \
39 -icon error \
40 -type ok \
41 -title "git-gui: fatal error" \
42 -message $err
43 exit 1
44 }
45
46 catch {rename send {}} ; # What an evil concept...
47
48 ######################################################################
49 ##
50 ## locate our library
51
52 set oguilib {@@GITGUI_LIBDIR@@}
53 set oguirel {@@GITGUI_RELATIVE@@}
54 if {$oguirel eq {1}} {
55 set oguilib [file dirname [file normalize $argv0]]
56 if {[file tail $oguilib] eq {git-core}} {
57 set oguilib [file dirname $oguilib]
58 }
59 set oguilib [file dirname $oguilib]
60 set oguilib [file join $oguilib share git-gui lib]
61 set oguimsg [file join $oguilib msgs]
62 } elseif {[string match @@* $oguirel]} {
63 set oguilib [file join [file dirname [file normalize $argv0]] lib]
64 set oguimsg [file join [file dirname [file normalize $argv0]] po]
65 } else {
66 set oguimsg [file join $oguilib msgs]
67 }
68 unset oguirel
69
70 ######################################################################
71 ##
72 ## enable verbose loading?
73
74 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
75 unset _verbose
76 rename auto_load real__auto_load
77 proc auto_load {name args} {
78 puts stderr "auto_load $name"
79 return [uplevel 1 real__auto_load $name $args]
80 }
81 rename source real__source
82 proc source {name} {
83 puts stderr "source $name"
84 uplevel 1 real__source $name
85 }
86 if {[tk windowingsystem] eq "win32"} { console show }
87 }
88
89 ######################################################################
90 ##
91 ## Internationalization (i18n) through msgcat and gettext. See
92 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93
94 package require msgcat
95
96 # Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
97 if {[tk windowingsystem] eq "win32"
98 && [package vcompare [package provide msgcat] 1.4.4] < 0
99 } then {
100 proc _mc_update_locale {} {
101 set key {HKEY_CURRENT_USER\Control Panel\Desktop}
102 if {![catch {
103 package require registry
104 set uilocale [registry get $key "PreferredUILanguages"]
105 msgcat::ConvertLocale [string map {- _} [lindex $uilocale 0]]
106 } uilocale]} {
107 if {[string length $uilocale] > 0} {
108 msgcat::mclocale $uilocale
109 }
110 }
111 }
112 _mc_update_locale
113 }
114
115 proc _mc_trim {fmt} {
116 set cmk [string first @@ $fmt]
117 if {$cmk > 0} {
118 return [string range $fmt 0 [expr {$cmk - 1}]]
119 }
120 return $fmt
121 }
122
123 proc mc {en_fmt args} {
124 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
125 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
126 set msg [eval [list format [_mc_trim $en_fmt]] $args]
127 }
128 return $msg
129 }
130
131 proc strcat {args} {
132 return [join $args {}]
133 }
134
135 ::msgcat::mcload $oguimsg
136 unset oguimsg
137
138 ######################################################################
139 ##
140 ## On Mac, bring the current Wish process window to front
141
142 if {[tk windowingsystem] eq "aqua"} {
143 catch {
144 exec osascript -e [format {
145 tell application "System Events"
146 set frontmost of processes whose unix id is %d to true
147 end tell
148 } [pid]]
149 }
150 }
151
152 ######################################################################
153 ##
154 ## read only globals
155
156 set _appname {Git Gui}
157 set _gitdir {}
158 set _gitworktree {}
159 set _isbare {}
160 set _gitexec {}
161 set _githtmldir {}
162 set _reponame {}
163 set _iscygwin {}
164 set _search_path {}
165 set _shellpath {@@SHELL_PATH@@}
166
167 set _trace [lsearch -exact $argv --trace]
168 if {$_trace >= 0} {
169 set argv [lreplace $argv $_trace $_trace]
170 set _trace 1
171 if {[tk windowingsystem] eq "win32"} { console show }
172 } else {
173 set _trace 0
174 }
175
176 # variable for the last merged branch (useful for a default when deleting
177 # branches).
178 set _last_merged_branch {}
179
180 proc shellpath {} {
181 global _shellpath env
182 if {[string match @@* $_shellpath]} {
183 if {[info exists env(SHELL)]} {
184 return $env(SHELL)
185 } else {
186 return /bin/sh
187 }
188 }
189 return $_shellpath
190 }
191
192 proc appname {} {
193 global _appname
194 return $_appname
195 }
196
197 proc gitdir {args} {
198 if {$args eq {}} {
199 return $::GIT_DIR
200 }
201 return [eval [list file join $::GIT_DIR] $args]
202 }
203
204 proc gitexec {args} {
205 global _gitexec
206 if {$_gitexec eq {}} {
207 if {[catch {set _gitexec [git --exec-path]} err]} {
208 error "Git not installed?\n\n$err"
209 }
210 if {[is_Cygwin]} {
211 set _gitexec [exec cygpath \
212 --windows \
213 --absolute \
214 $_gitexec]
215 } else {
216 set _gitexec [file normalize $_gitexec]
217 }
218 }
219 if {$args eq {}} {
220 return $_gitexec
221 }
222 return [eval [list file join $_gitexec] $args]
223 }
224
225 proc githtmldir {args} {
226 global _githtmldir
227 if {$_githtmldir eq {}} {
228 if {[catch {set _githtmldir [git --html-path]}]} {
229 # Git not installed or option not yet supported
230 return {}
231 }
232 if {[is_Cygwin]} {
233 set _githtmldir [exec cygpath \
234 --windows \
235 --absolute \
236 $_githtmldir]
237 } else {
238 set _githtmldir [file normalize $_githtmldir]
239 }
240 }
241 if {$args eq {}} {
242 return $_githtmldir
243 }
244 return [eval [list file join $_githtmldir] $args]
245 }
246
247 proc reponame {} {
248 return $::_reponame
249 }
250
251 proc is_MacOSX {} {
252 if {[tk windowingsystem] eq {aqua}} {
253 return 1
254 }
255 return 0
256 }
257
258 proc is_Windows {} {
259 if {$::tcl_platform(platform) eq {windows}} {
260 return 1
261 }
262 return 0
263 }
264
265 proc is_Cygwin {} {
266 global _iscygwin
267 if {$_iscygwin eq {}} {
268 if {$::tcl_platform(platform) eq {windows}} {
269 if {[catch {set p [exec cygpath --windir]} err]} {
270 set _iscygwin 0
271 } else {
272 set _iscygwin 1
273 }
274 } else {
275 set _iscygwin 0
276 }
277 }
278 return $_iscygwin
279 }
280
281 proc is_enabled {option} {
282 global enabled_options
283 if {[catch {set on $enabled_options($option)}]} {return 0}
284 return $on
285 }
286
287 proc enable_option {option} {
288 global enabled_options
289 set enabled_options($option) 1
290 }
291
292 proc disable_option {option} {
293 global enabled_options
294 set enabled_options($option) 0
295 }
296
297 ######################################################################
298 ##
299 ## config
300
301 proc is_many_config {name} {
302 switch -glob -- $name {
303 gui.recentrepo -
304 gui.build -
305 gui.build.env -
306 gui.build.config -
307 gui.build.*.env -
308 gui.build.*.config -
309 gui.buildconfig.*.env -
310 remote.*.fetch -
311 remote.*.push
312 {return 1}
313 *
314 {return 0}
315 }
316 }
317
318 proc is_config_true {name} {
319 global repo_config
320 if {[catch {set v $repo_config($name)}]} {
321 return 0
322 }
323 set v [string tolower $v]
324 if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
325 return 1
326 } else {
327 return 0
328 }
329 }
330
331 proc is_config_false {name} {
332 global repo_config
333 if {[catch {set v $repo_config($name)}]} {
334 return 0
335 }
336 set v [string tolower $v]
337 if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
338 return 1
339 } else {
340 return 0
341 }
342 }
343
344 proc get_config {name {default {}}} {
345 global repo_config
346 if {[catch {set v $repo_config($name)}]} {
347 return $default
348 } else {
349 return $v
350 }
351 }
352
353 proc is_bare {} {
354 global _isbare
355 global _gitdir
356 global _gitworktree
357
358 if {$_isbare eq {}} {
359 if {[catch {
360 set _bare [git rev-parse --is-bare-repository]
361 switch -- $_bare {
362 true { set _isbare 1 }
363 false { set _isbare 0}
364 default { throw }
365 }
366 }]} {
367 if {[is_config_true core.bare]
368 || ($_gitworktree eq {}
369 && [lindex [file split $_gitdir] end] ne {.git})} {
370 set _isbare 1
371 } else {
372 set _isbare 0
373 }
374 }
375 }
376 return $_isbare
377 }
378
379 ######################################################################
380 ##
381 ## handy utils
382
383 proc _trace_exec {cmd} {
384 if {!$::_trace} return
385 set d {}
386 foreach v $cmd {
387 if {$d ne {}} {
388 append d { }
389 }
390 if {[regexp {[ \t\r\n'"$?*]} $v]} {
391 set v [sq $v]
392 }
393 append d $v
394 }
395 puts stderr $d
396 }
397
398 #'" fix poor old emacs font-lock mode
399
400 proc _git_cmd {name} {
401 global _git_cmd_path
402
403 if {[catch {set v $_git_cmd_path($name)}]} {
404 switch -- $name {
405 version -
406 --version -
407 --exec-path { return [list $::_git $name] }
408 }
409
410 set p [gitexec git-$name$::_search_exe]
411 if {[file exists $p]} {
412 set v [list $p]
413 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
414 # Try to determine what sort of magic will make
415 # git-$name go and do its thing, because native
416 # Tcl on Windows doesn't know it.
417 #
418 set p [gitexec git-$name]
419 set f [open $p r]
420 set s [gets $f]
421 close $f
422
423 switch -glob -- [lindex $s 0] {
424 #!*sh { set i sh }
425 #!*perl { set i perl }
426 #!*python { set i python }
427 default { error "git-$name is not supported: $s" }
428 }
429
430 upvar #0 _$i interp
431 if {![info exists interp]} {
432 set interp [_which $i]
433 }
434 if {$interp eq {}} {
435 error "git-$name requires $i (not in PATH)"
436 }
437 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
438 } else {
439 # Assume it is builtin to git somehow and we
440 # aren't actually able to see a file for it.
441 #
442 set v [list $::_git $name]
443 }
444 set _git_cmd_path($name) $v
445 }
446 return $v
447 }
448
449 proc _which {what args} {
450 global env _search_exe _search_path
451
452 if {$_search_path eq {}} {
453 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
454 set _search_path [split [exec cygpath \
455 --windows \
456 --path \
457 --absolute \
458 $env(PATH)] {;}]
459 set _search_exe .exe
460 } elseif {[is_Windows]} {
461 set gitguidir [file dirname [info script]]
462 regsub -all ";" $gitguidir "\\;" gitguidir
463 set env(PATH) "$gitguidir;$env(PATH)"
464 set _search_path [split $env(PATH) {;}]
465 set _search_exe .exe
466 } else {
467 set _search_path [split $env(PATH) :]
468 set _search_exe {}
469 }
470 }
471
472 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
473 set suffix {}
474 } else {
475 set suffix $_search_exe
476 }
477
478 foreach p $_search_path {
479 set p [file join $p $what$suffix]
480 if {[file exists $p]} {
481 return [file normalize $p]
482 }
483 }
484 return {}
485 }
486
487 # Test a file for a hashbang to identify executable scripts on Windows.
488 proc is_shellscript {filename} {
489 if {![file exists $filename]} {return 0}
490 set f [open $filename r]
491 fconfigure $f -encoding binary
492 set magic [read $f 2]
493 close $f
494 return [expr {$magic eq "#!"}]
495 }
496
497 # Run a command connected via pipes on stdout.
498 # This is for use with textconv filters and uses sh -c "..." to allow it to
499 # contain a command with arguments. On windows we must check for shell
500 # scripts specifically otherwise just call the filter command.
501 proc open_cmd_pipe {cmd path} {
502 global env
503 if {![file executable [shellpath]]} {
504 set exe [auto_execok [lindex $cmd 0]]
505 if {[is_shellscript [lindex $exe 0]]} {
506 set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path]
507 } else {
508 set run [concat $exe [lrange $cmd 1 end] $path]
509 }
510 } else {
511 set run [list [shellpath] -c "$cmd \"\$0\"" $path]
512 }
513 return [open |$run r]
514 }
515
516 proc _lappend_nice {cmd_var} {
517 global _nice
518 upvar $cmd_var cmd
519
520 if {![info exists _nice]} {
521 set _nice [_which nice]
522 if {[catch {exec $_nice git version}]} {
523 set _nice {}
524 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
525 set _nice {}
526 }
527 }
528 if {$_nice ne {}} {
529 lappend cmd $_nice
530 }
531 }
532
533 proc git {args} {
534 set opt [list]
535
536 while {1} {
537 switch -- [lindex $args 0] {
538 --nice {
539 _lappend_nice opt
540 }
541
542 default {
543 break
544 }
545
546 }
547
548 set args [lrange $args 1 end]
549 }
550
551 set cmdp [_git_cmd [lindex $args 0]]
552 set args [lrange $args 1 end]
553
554 _trace_exec [concat $opt $cmdp $args]
555 set result [eval exec $opt $cmdp $args]
556 if {$::_trace} {
557 puts stderr "< $result"
558 }
559 return $result
560 }
561
562 proc _open_stdout_stderr {cmd} {
563 _trace_exec $cmd
564 if {[catch {
565 set fd [open [concat [list | ] $cmd] r]
566 } err]} {
567 if { [lindex $cmd end] eq {2>@1}
568 && $err eq {can not find channel named "1"}
569 } {
570 # Older versions of Tcl 8.4 don't have this 2>@1 IO
571 # redirect operator. Fallback to |& cat for those.
572 # The command was not actually started, so its safe
573 # to try to start it a second time.
574 #
575 set fd [open [concat \
576 [list | ] \
577 [lrange $cmd 0 end-1] \
578 [list |& cat] \
579 ] r]
580 } else {
581 error $err
582 }
583 }
584 fconfigure $fd -eofchar {}
585 return $fd
586 }
587
588 proc open_read {args} {
589 return [_open_stdout_stderr $args]
590 }
591
592 proc git_read {args} {
593 set opt [list]
594
595 while {1} {
596 switch -- [lindex $args 0] {
597 --nice {
598 _lappend_nice opt
599 }
600
601 --stderr {
602 lappend args 2>@1
603 }
604
605 default {
606 break
607 }
608
609 }
610
611 set args [lrange $args 1 end]
612 }
613
614 set cmdp [_git_cmd [lindex $args 0]]
615 set args [lrange $args 1 end]
616
617 return [_open_stdout_stderr [concat $opt $cmdp $args]]
618 }
619
620 proc git_write {args} {
621 set opt [list]
622
623 while {1} {
624 switch -- [lindex $args 0] {
625 --nice {
626 _lappend_nice opt
627 }
628
629 default {
630 break
631 }
632
633 }
634
635 set args [lrange $args 1 end]
636 }
637
638 set cmdp [_git_cmd [lindex $args 0]]
639 set args [lrange $args 1 end]
640
641 _trace_exec [concat $opt $cmdp $args]
642 return [open [concat [list | ] $opt $cmdp $args] w]
643 }
644
645 proc githook_read {hook_name args} {
646 set pchook [gitdir hooks $hook_name]
647 lappend args 2>@1
648
649 # On Windows [file executable] might lie so we need to ask
650 # the shell if the hook is executable. Yes that's annoying.
651 #
652 if {[is_Windows]} {
653 upvar #0 _sh interp
654 if {![info exists interp]} {
655 set interp [_which sh]
656 }
657 if {$interp eq {}} {
658 error "hook execution requires sh (not in PATH)"
659 }
660
661 set scr {if test -x "$1";then exec "$@";fi}
662 set sh_c [list $interp -c $scr $interp $pchook]
663 return [_open_stdout_stderr [concat $sh_c $args]]
664 }
665
666 if {[file executable $pchook]} {
667 return [_open_stdout_stderr [concat [list $pchook] $args]]
668 }
669
670 return {}
671 }
672
673 proc kill_file_process {fd} {
674 set process [pid $fd]
675
676 catch {
677 if {[is_Windows]} {
678 # Use a Cygwin-specific flag to allow killing
679 # native Windows processes
680 exec kill -f $process
681 } else {
682 exec kill $process
683 }
684 }
685 }
686
687 proc gitattr {path attr default} {
688 if {[catch {set r [git check-attr $attr -- $path]}]} {
689 set r unspecified
690 } else {
691 set r [join [lrange [split $r :] 2 end] :]
692 regsub {^ } $r {} r
693 }
694 if {$r eq {unspecified}} {
695 return $default
696 }
697 return $r
698 }
699
700 proc sq {value} {
701 regsub -all ' $value "'\\''" value
702 return "'$value'"
703 }
704
705 proc load_current_branch {} {
706 global current_branch is_detached
707
708 set fd [open [gitdir HEAD] r]
709 if {[gets $fd ref] < 1} {
710 set ref {}
711 }
712 close $fd
713
714 set pfx {ref: refs/heads/}
715 set len [string length $pfx]
716 if {[string equal -length $len $pfx $ref]} {
717 # We're on a branch. It might not exist. But
718 # HEAD looks good enough to be a branch.
719 #
720 set current_branch [string range $ref $len end]
721 set is_detached 0
722 } else {
723 # Assume this is a detached head.
724 #
725 set current_branch HEAD
726 set is_detached 1
727 }
728 }
729
730 auto_load tk_optionMenu
731 rename tk_optionMenu real__tkOptionMenu
732 proc tk_optionMenu {w varName args} {
733 set m [eval real__tkOptionMenu $w $varName $args]
734 $m configure -font font_ui
735 $w configure -font font_ui
736 return $m
737 }
738
739 proc rmsel_tag {text} {
740 $text tag conf sel \
741 -background [$text cget -background] \
742 -foreground [$text cget -foreground] \
743 -borderwidth 0
744 $text tag conf in_sel -background lightgray
745 bind $text <Motion> break
746 return $text
747 }
748
749 wm withdraw .
750 set root_exists 0
751 bind . <Visibility> {
752 bind . <Visibility> {}
753 set root_exists 1
754 }
755
756 if {[is_Windows]} {
757 wm iconbitmap . -default $oguilib/git-gui.ico
758 set ::tk::AlwaysShowSelection 1
759 bind . <Control-F2> {console show}
760
761 # Spoof an X11 display for SSH
762 if {![info exists env(DISPLAY)]} {
763 set env(DISPLAY) :9999
764 }
765 } else {
766 catch {
767 image create photo gitlogo -width 16 -height 16
768
769 gitlogo put #33CC33 -to 7 0 9 2
770 gitlogo put #33CC33 -to 4 2 12 4
771 gitlogo put #33CC33 -to 7 4 9 6
772 gitlogo put #CC3333 -to 4 6 12 8
773 gitlogo put gray26 -to 4 9 6 10
774 gitlogo put gray26 -to 3 10 6 12
775 gitlogo put gray26 -to 8 9 13 11
776 gitlogo put gray26 -to 8 11 10 12
777 gitlogo put gray26 -to 11 11 13 14
778 gitlogo put gray26 -to 3 12 5 14
779 gitlogo put gray26 -to 5 13
780 gitlogo put gray26 -to 10 13
781 gitlogo put gray26 -to 4 14 12 15
782 gitlogo put gray26 -to 5 15 11 16
783 gitlogo redither
784
785 image create photo gitlogo32 -width 32 -height 32
786 gitlogo32 copy gitlogo -zoom 2 2
787
788 wm iconphoto . -default gitlogo gitlogo32
789 }
790 }
791
792 ######################################################################
793 ##
794 ## config defaults
795
796 set cursor_ptr arrow
797 font create font_ui
798 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
799 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
800 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
801 } else {
802 font create font_diff -family Courier -size 10
803 catch {
804 label .dummy
805 eval font configure font_ui [font actual [.dummy cget -font]]
806 destroy .dummy
807 }
808 }
809
810 font create font_uiitalic
811 font create font_uibold
812 font create font_diffbold
813 font create font_diffitalic
814
815 foreach class {Button Checkbutton Entry Label
816 Labelframe Listbox Message
817 Radiobutton Spinbox Text} {
818 option add *$class.font font_ui
819 }
820 if {![is_MacOSX]} {
821 option add *Menu.font font_ui
822 option add *Entry.borderWidth 1 startupFile
823 option add *Entry.relief sunken startupFile
824 option add *RadioButton.anchor w startupFile
825 }
826 unset class
827
828 if {[is_Windows] || [is_MacOSX]} {
829 option add *Menu.tearOff 0
830 }
831
832 if {[is_MacOSX]} {
833 set M1B M1
834 set M1T Cmd
835 } else {
836 set M1B Control
837 set M1T Ctrl
838 }
839
840 proc bind_button3 {w cmd} {
841 bind $w <Any-Button-3> $cmd
842 if {[is_MacOSX]} {
843 # Mac OS X sends Button-2 on right click through three-button mouse,
844 # or through trackpad right-clicking (two-finger touch + click).
845 bind $w <Any-Button-2> $cmd
846 bind $w <Control-Button-1> $cmd
847 }
848 }
849
850 proc apply_config {} {
851 global repo_config font_descs
852
853 foreach option $font_descs {
854 set name [lindex $option 0]
855 set font [lindex $option 1]
856 if {[catch {
857 set need_weight 1
858 foreach {cn cv} $repo_config(gui.$name) {
859 if {$cn eq {-weight}} {
860 set need_weight 0
861 }
862 font configure $font $cn $cv
863 }
864 if {$need_weight} {
865 font configure $font -weight normal
866 }
867 } err]} {
868 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
869 }
870 foreach {cn cv} [font configure $font] {
871 font configure ${font}bold $cn $cv
872 font configure ${font}italic $cn $cv
873 }
874 font configure ${font}bold -weight bold
875 font configure ${font}italic -slant italic
876 }
877
878 global use_ttk NS
879 set use_ttk 0
880 set NS {}
881 if {$repo_config(gui.usettk)} {
882 set use_ttk [package vsatisfies [package provide Tk] 8.5]
883 if {$use_ttk} {
884 set NS ttk
885 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
886 pave_toplevel .
887 }
888 }
889 }
890
891 set default_config(branch.autosetupmerge) true
892 set default_config(merge.tool) {}
893 set default_config(mergetool.keepbackup) true
894 set default_config(merge.diffstat) true
895 set default_config(merge.summary) false
896 set default_config(merge.verbosity) 2
897 set default_config(user.name) {}
898 set default_config(user.email) {}
899
900 set default_config(gui.encoding) [encoding system]
901 set default_config(gui.matchtrackingbranch) false
902 set default_config(gui.textconv) true
903 set default_config(gui.pruneduringfetch) false
904 set default_config(gui.trustmtime) false
905 set default_config(gui.fastcopyblame) false
906 set default_config(gui.maxrecentrepo) 10
907 set default_config(gui.copyblamethreshold) 40
908 set default_config(gui.blamehistoryctx) 7
909 set default_config(gui.diffcontext) 5
910 set default_config(gui.diffopts) {}
911 set default_config(gui.commitmsgwidth) 75
912 set default_config(gui.newbranchtemplate) {}
913 set default_config(gui.spellingdictionary) {}
914 set default_config(gui.fontui) [font configure font_ui]
915 set default_config(gui.fontdiff) [font configure font_diff]
916 # TODO: this option should be added to the git-config documentation
917 set default_config(gui.maxfilesdisplayed) 5000
918 set default_config(gui.usettk) 1
919 set default_config(gui.warndetachedcommit) 1
920 set font_descs {
921 {fontui font_ui {mc "Main Font"}}
922 {fontdiff font_diff {mc "Diff/Console Font"}}
923 }
924 set default_config(gui.stageuntracked) ask
925 set default_config(gui.displayuntracked) true
926
927 ######################################################################
928 ##
929 ## find git
930
931 set _git [_which git]
932 if {$_git eq {}} {
933 catch {wm withdraw .}
934 tk_messageBox \
935 -icon error \
936 -type ok \
937 -title [mc "git-gui: fatal error"] \
938 -message [mc "Cannot find git in PATH."]
939 exit 1
940 }
941
942 ######################################################################
943 ##
944 ## version check
945
946 if {[catch {set _git_version [git --version]} err]} {
947 catch {wm withdraw .}
948 tk_messageBox \
949 -icon error \
950 -type ok \
951 -title [mc "git-gui: fatal error"] \
952 -message "Cannot determine Git version:
953
954 $err
955
956 [appname] requires Git 1.5.0 or later."
957 exit 1
958 }
959 if {![regsub {^git version } $_git_version {} _git_version]} {
960 catch {wm withdraw .}
961 tk_messageBox \
962 -icon error \
963 -type ok \
964 -title [mc "git-gui: fatal error"] \
965 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
966 exit 1
967 }
968
969 proc get_trimmed_version {s} {
970 set r {}
971 foreach x [split $s -._] {
972 if {[string is integer -strict $x]} {
973 lappend r $x
974 } else {
975 break
976 }
977 }
978 return [join $r .]
979 }
980 set _real_git_version $_git_version
981 set _git_version [get_trimmed_version $_git_version]
982
983 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
984 catch {wm withdraw .}
985 if {[tk_messageBox \
986 -icon warning \
987 -type yesno \
988 -default no \
989 -title "[appname]: warning" \
990 -message [mc "Git version cannot be determined.
991
992 %s claims it is version '%s'.
993
994 %s requires at least Git 1.5.0 or later.
995
996 Assume '%s' is version 1.5.0?
997 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
998 set _git_version 1.5.0
999 } else {
1000 exit 1
1001 }
1002 }
1003 unset _real_git_version
1004
1005 proc git-version {args} {
1006 global _git_version
1007
1008 switch [llength $args] {
1009 0 {
1010 return $_git_version
1011 }
1012
1013 2 {
1014 set op [lindex $args 0]
1015 set vr [lindex $args 1]
1016 set cm [package vcompare $_git_version $vr]
1017 return [expr $cm $op 0]
1018 }
1019
1020 4 {
1021 set type [lindex $args 0]
1022 set name [lindex $args 1]
1023 set parm [lindex $args 2]
1024 set body [lindex $args 3]
1025
1026 if {($type ne {proc} && $type ne {method})} {
1027 error "Invalid arguments to git-version"
1028 }
1029 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
1030 error "Last arm of $type $name must be default"
1031 }
1032
1033 foreach {op vr cb} [lrange $body 0 end-2] {
1034 if {[git-version $op $vr]} {
1035 return [uplevel [list $type $name $parm $cb]]
1036 }
1037 }
1038
1039 return [uplevel [list $type $name $parm [lindex $body end]]]
1040 }
1041
1042 default {
1043 error "git-version >= x"
1044 }
1045
1046 }
1047 }
1048
1049 if {[git-version < 1.5]} {
1050 catch {wm withdraw .}
1051 tk_messageBox \
1052 -icon error \
1053 -type ok \
1054 -title [mc "git-gui: fatal error"] \
1055 -message "[appname] requires Git 1.5.0 or later.
1056
1057 You are using [git-version]:
1058
1059 [git --version]"
1060 exit 1
1061 }
1062
1063 ######################################################################
1064 ##
1065 ## configure our library
1066
1067 set idx [file join $oguilib tclIndex]
1068 if {[catch {set fd [open $idx r]} err]} {
1069 catch {wm withdraw .}
1070 tk_messageBox \
1071 -icon error \
1072 -type ok \
1073 -title [mc "git-gui: fatal error"] \
1074 -message $err
1075 exit 1
1076 }
1077 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1078 set idx [list]
1079 while {[gets $fd n] >= 0} {
1080 if {$n ne {} && ![string match #* $n]} {
1081 lappend idx $n
1082 }
1083 }
1084 } else {
1085 set idx {}
1086 }
1087 close $fd
1088
1089 if {$idx ne {}} {
1090 set loaded [list]
1091 foreach p $idx {
1092 if {[lsearch -exact $loaded $p] >= 0} continue
1093 source [file join $oguilib $p]
1094 lappend loaded $p
1095 }
1096 unset loaded p
1097 } else {
1098 set auto_path [concat [list $oguilib] $auto_path]
1099 }
1100 unset -nocomplain idx fd
1101
1102 ######################################################################
1103 ##
1104 ## config file parsing
1105
1106 git-version proc _parse_config {arr_name cmd} {
1107 >= 1.5.3 {
1108 upvar $arr_name arr
1109 array unset arr
1110 set buf {}
1111 catch {
1112 set fd_rc [eval \
1113 $cmd \
1114 [list --null]]
1115 fconfigure $fd_rc -translation binary
1116 set buf [read $fd_rc]
1117 close $fd_rc
1118 }
1119 foreach line [split $buf "\0"] {
1120 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1121 if {[is_many_config $name]} {
1122 lappend arr($name) $value
1123 } else {
1124 set arr($name) $value
1125 }
1126 } elseif {[regexp {^([^\n]+)$} $line line name]} {
1127 # no value given, but interpreting them as
1128 # boolean will be handled as true
1129 set arr($name) {}
1130 }
1131 }
1132 }
1133 default {
1134 upvar $arr_name arr
1135 array unset arr
1136 catch {
1137 set fd_rc [eval $cmd]
1138 while {[gets $fd_rc line] >= 0} {
1139 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1140 if {[is_many_config $name]} {
1141 lappend arr($name) $value
1142 } else {
1143 set arr($name) $value
1144 }
1145 } elseif {[regexp {^([^=]+)$} $line line name]} {
1146 # no value given, but interpreting them as
1147 # boolean will be handled as true
1148 set arr($name) {}
1149 }
1150 }
1151 close $fd_rc
1152 }
1153 }
1154 }
1155
1156 proc load_config {include_global} {
1157 global repo_config global_config system_config default_config
1158
1159 if {$include_global} {
1160 _parse_config system_config [list git_read config --system --list]
1161 _parse_config global_config [list git_read config --global --list]
1162 }
1163 _parse_config repo_config [list git_read config --list]
1164
1165 foreach name [array names default_config] {
1166 if {[catch {set v $system_config($name)}]} {
1167 set system_config($name) $default_config($name)
1168 }
1169 }
1170 foreach name [array names system_config] {
1171 if {[catch {set v $global_config($name)}]} {
1172 set global_config($name) $system_config($name)
1173 }
1174 if {[catch {set v $repo_config($name)}]} {
1175 set repo_config($name) $system_config($name)
1176 }
1177 }
1178 }
1179
1180 ######################################################################
1181 ##
1182 ## feature option selection
1183
1184 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1185 unset _junk
1186 } else {
1187 set subcommand gui
1188 }
1189 if {$subcommand eq {gui.sh}} {
1190 set subcommand gui
1191 }
1192 if {$subcommand eq {gui} && [llength $argv] > 0} {
1193 set subcommand [lindex $argv 0]
1194 set argv [lrange $argv 1 end]
1195 }
1196
1197 enable_option multicommit
1198 enable_option branch
1199 enable_option transport
1200 disable_option bare
1201
1202 switch -- $subcommand {
1203 browser -
1204 blame -
1205 grep {
1206 enable_option bare
1207
1208 disable_option multicommit
1209 disable_option branch
1210 disable_option transport
1211 }
1212 citool {
1213 enable_option singlecommit
1214 enable_option retcode
1215
1216 disable_option multicommit
1217 disable_option branch
1218 disable_option transport
1219
1220 while {[llength $argv] > 0} {
1221 set a [lindex $argv 0]
1222 switch -- $a {
1223 --amend {
1224 enable_option initialamend
1225 }
1226 --nocommit {
1227 enable_option nocommit
1228 enable_option nocommitmsg
1229 }
1230 --commitmsg {
1231 disable_option nocommitmsg
1232 }
1233 default {
1234 break
1235 }
1236 }
1237
1238 set argv [lrange $argv 1 end]
1239 }
1240 }
1241 }
1242
1243 ######################################################################
1244 ##
1245 ## execution environment
1246
1247 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1248
1249 # Suggest our implementation of askpass, if none is set
1250 if {![info exists env(SSH_ASKPASS)]} {
1251 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1252 }
1253
1254 ######################################################################
1255 ##
1256 ## repository setup
1257
1258 set picked 0
1259 if {[catch {
1260 set _gitdir $env(GIT_DIR)
1261 set _prefix {}
1262 }]
1263 && [catch {
1264 # beware that from the .git dir this sets _gitdir to .
1265 # and _prefix to the empty string
1266 set _gitdir [git rev-parse --git-dir]
1267 set _prefix [git rev-parse --show-prefix]
1268 } err]} {
1269 load_config 1
1270 apply_config
1271 choose_repository::pick
1272 set picked 1
1273 }
1274
1275 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1276 # run from the .git dir itself) lest the routines to find the worktree
1277 # get confused
1278 if {$_gitdir eq "."} {
1279 set _gitdir [pwd]
1280 }
1281
1282 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1283 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1284 }
1285 if {![file isdirectory $_gitdir]} {
1286 catch {wm withdraw .}
1287 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1288 exit 1
1289 }
1290
1291 # _gitdir exists, so try loading the config
1292 load_config 0
1293 apply_config
1294
1295 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
1296 if {[package vsatisfies $_git_version 1.7.0]} {
1297 if { [is_Cygwin] } {
1298 catch {set _gitworktree [exec cygpath --windows [git rev-parse --show-toplevel]]}
1299 } else {
1300 set _gitworktree [git rev-parse --show-toplevel]
1301 }
1302 } else {
1303 # try to set work tree from environment, core.worktree or use
1304 # cdup to obtain a relative path to the top of the worktree. If
1305 # run from the top, the ./ prefix ensures normalize expands pwd.
1306 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1307 set _gitworktree [get_config core.worktree]
1308 if {$_gitworktree eq ""} {
1309 set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1310 }
1311 }
1312 }
1313
1314 if {$_prefix ne {}} {
1315 if {$_gitworktree eq {}} {
1316 regsub -all {[^/]+/} $_prefix ../ cdup
1317 } else {
1318 set cdup $_gitworktree
1319 }
1320 if {[catch {cd $cdup} err]} {
1321 catch {wm withdraw .}
1322 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1323 exit 1
1324 }
1325 set _gitworktree [pwd]
1326 unset cdup
1327 } elseif {![is_enabled bare]} {
1328 if {[is_bare]} {
1329 catch {wm withdraw .}
1330 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1331 exit 1
1332 }
1333 if {$_gitworktree eq {}} {
1334 set _gitworktree [file dirname $_gitdir]
1335 }
1336 if {[catch {cd $_gitworktree} err]} {
1337 catch {wm withdraw .}
1338 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1339 exit 1
1340 }
1341 set _gitworktree [pwd]
1342 }
1343 set _reponame [file split [file normalize $_gitdir]]
1344 if {[lindex $_reponame end] eq {.git}} {
1345 set _reponame [lindex $_reponame end-1]
1346 } else {
1347 set _reponame [lindex $_reponame end]
1348 }
1349
1350 proc git_env_proxy {var_name index_name op} {
1351 upvar $var_name var
1352 # strip leading ::
1353 set var_name [string range $var_name 2 end]
1354 if {$op eq "write"} {
1355 set ::env($var_name) $var
1356 } elseif {$op eq "unset"} {
1357 unset ::env($var_name)
1358 }
1359 }
1360
1361 proc git_reset_env {} {
1362 set ::GIT_DIR $::_gitdir
1363 set ::GIT_WORK_TREE $::_gitworktree
1364 set ::GIT_INDEX_FILE $::_gitindex
1365 }
1366
1367 proc git_clear_env {} {
1368 unset ::GIT_DIR
1369 unset ::GIT_WORK_TREE
1370 unset ::GIT_INDEX_FILE
1371 }
1372
1373 set _gitdir [file normalize $_gitdir]
1374 set GIT_DIR $_gitdir
1375 trace add variable GIT_DIR [list write unset] git_env_proxy
1376
1377 set _gitworktree [file normalize $_gitworktree]
1378 set GIT_WORK_TREE $_gitworktree
1379 trace add variable GIT_WORK_TREE [list write unset] git_env_proxy
1380
1381 if {[info exists env(GIT_INDEX_FILE)]} {
1382 set _gitindex $env(GIT_INDEX_FILE)
1383 } else {
1384 set _gitindex [gitdir index]
1385 }
1386 set GIT_INDEX_FILE $_gitindex
1387 trace add variable GIT_INDEX_FILE [list write unset] git_env_proxy
1388
1389 git_reset_env
1390
1391 catch { unset env(GIT_EDITOR_F_NBLOCK) }
1392 catch { unset env(GIT_EDITOR_F_POSITION) }
1393 catch { unset env(GIT_EDITOR_F_AUX) }
1394
1395 ######################################################################
1396 ##
1397 ## global init
1398
1399 set current_diff_path {}
1400 set current_diff_side {}
1401 set diff_actions [list]
1402
1403 set HEAD {}
1404 set PARENT {}
1405 set MERGE_HEAD [list]
1406 set commit_type {}
1407 set empty_tree {}
1408 set current_branch {}
1409 set is_detached 0
1410 set current_diff_path {}
1411 set is_3way_diff 0
1412 set is_submodule_diff 0
1413 set is_conflict_diff 0
1414 set selected_commit_type new
1415 set diff_empty_count 0
1416 set diff_show_line_numbers 1
1417 set diff_lno_column_width 0
1418 set is_other_diff 0
1419
1420 set nullid "0000000000000000000000000000000000000000"
1421 set nullid2 "0000000000000000000000000000000000000001"
1422
1423
1424 ######################################################################
1425 ##
1426 ## task management
1427
1428 set rescan_active 0
1429 set diff_active 0
1430 set last_clicked {}
1431
1432 set disable_on_lock [list]
1433 set index_lock_type none
1434
1435 proc lock_index {type} {
1436 global index_lock_type disable_on_lock
1437
1438 if {$index_lock_type eq {none}} {
1439 set index_lock_type $type
1440 foreach w $disable_on_lock {
1441 uplevel #0 $w disabled
1442 }
1443 return 1
1444 } elseif {$index_lock_type eq "begin-$type"} {
1445 set index_lock_type $type
1446 return 1
1447 }
1448 return 0
1449 }
1450
1451 proc unlock_index {} {
1452 global index_lock_type disable_on_lock
1453
1454 set index_lock_type none
1455 foreach w $disable_on_lock {
1456 uplevel #0 $w normal
1457 }
1458 }
1459
1460 ######################################################################
1461 ##
1462 ## status
1463
1464 proc repository_state {ctvar hdvar mhvar} {
1465 global current_branch
1466 upvar $ctvar ct $hdvar hd $mhvar mh
1467
1468 set mh [list]
1469
1470 load_current_branch
1471 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1472 set hd {}
1473 set ct initial
1474 return
1475 }
1476
1477 set merge_head [gitdir MERGE_HEAD]
1478 if {[file exists $merge_head]} {
1479 set ct merge
1480 set fd_mh [open $merge_head r]
1481 while {[gets $fd_mh line] >= 0} {
1482 lappend mh $line
1483 }
1484 close $fd_mh
1485 return
1486 }
1487
1488 set ct normal
1489 }
1490
1491 proc PARENT {} {
1492 global PARENT empty_tree
1493
1494 set p [lindex $PARENT 0]
1495 if {$p ne {}} {
1496 return $p
1497 }
1498 if {$empty_tree eq {}} {
1499 set empty_tree [git mktree << {}]
1500 }
1501 return $empty_tree
1502 }
1503
1504 proc force_amend {} {
1505 global selected_commit_type
1506 global HEAD PARENT MERGE_HEAD commit_type
1507
1508 repository_state newType newHEAD newMERGE_HEAD
1509 set HEAD $newHEAD
1510 set PARENT $newHEAD
1511 set MERGE_HEAD $newMERGE_HEAD
1512 set commit_type $newType
1513
1514 set selected_commit_type amend
1515 do_select_commit_type
1516 }
1517
1518 proc rescan {after {honor_trustmtime 1}} {
1519 global HEAD PARENT MERGE_HEAD commit_type
1520 global ui_index ui_workdir ui_comm
1521 global rescan_active file_states
1522 global repo_config
1523
1524 if {$rescan_active > 0 || ![lock_index read]} return
1525
1526 repository_state newType newHEAD newMERGE_HEAD
1527 if {[string match amend* $commit_type]
1528 && $newType eq {normal}
1529 && $newHEAD eq $HEAD} {
1530 } else {
1531 set HEAD $newHEAD
1532 set PARENT $newHEAD
1533 set MERGE_HEAD $newMERGE_HEAD
1534 set commit_type $newType
1535 }
1536
1537 array unset file_states
1538
1539 if {!$::GITGUI_BCK_exists &&
1540 (![$ui_comm edit modified]
1541 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1542 if {[string match amend* $commit_type]} {
1543 } elseif {[load_message GITGUI_MSG utf-8]} {
1544 } elseif {[run_prepare_commit_msg_hook]} {
1545 } elseif {[load_message MERGE_MSG]} {
1546 } elseif {[load_message SQUASH_MSG]} {
1547 }
1548 $ui_comm edit reset
1549 $ui_comm edit modified false
1550 }
1551
1552 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1553 rescan_stage2 {} $after
1554 } else {
1555 set rescan_active 1
1556 ui_status [mc "Refreshing file status..."]
1557 set fd_rf [git_read update-index \
1558 -q \
1559 --unmerged \
1560 --ignore-missing \
1561 --refresh \
1562 ]
1563 fconfigure $fd_rf -blocking 0 -translation binary
1564 fileevent $fd_rf readable \
1565 [list rescan_stage2 $fd_rf $after]
1566 }
1567 }
1568
1569 if {[is_Cygwin]} {
1570 set is_git_info_exclude {}
1571 proc have_info_exclude {} {
1572 global is_git_info_exclude
1573
1574 if {$is_git_info_exclude eq {}} {
1575 if {[catch {exec test -f [gitdir info exclude]}]} {
1576 set is_git_info_exclude 0
1577 } else {
1578 set is_git_info_exclude 1
1579 }
1580 }
1581 return $is_git_info_exclude
1582 }
1583 } else {
1584 proc have_info_exclude {} {
1585 return [file readable [gitdir info exclude]]
1586 }
1587 }
1588
1589 proc rescan_stage2 {fd after} {
1590 global rescan_active buf_rdi buf_rdf buf_rlo
1591
1592 if {$fd ne {}} {
1593 read $fd
1594 if {![eof $fd]} return
1595 close $fd
1596 }
1597
1598 if {[package vsatisfies $::_git_version 1.6.3]} {
1599 set ls_others [list --exclude-standard]
1600 } else {
1601 set ls_others [list --exclude-per-directory=.gitignore]
1602 if {[have_info_exclude]} {
1603 lappend ls_others "--exclude-from=[gitdir info exclude]"
1604 }
1605 set user_exclude [get_config core.excludesfile]
1606 if {$user_exclude ne {} && [file readable $user_exclude]} {
1607 lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1608 }
1609 }
1610
1611 set buf_rdi {}
1612 set buf_rdf {}
1613 set buf_rlo {}
1614
1615 set rescan_active 2
1616 ui_status [mc "Scanning for modified files ..."]
1617 set fd_di [git_read diff-index --cached -z [PARENT]]
1618 set fd_df [git_read diff-files -z]
1619
1620 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1621 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1622
1623 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1624 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1625
1626 if {[is_config_true gui.displayuntracked]} {
1627 set fd_lo [eval git_read ls-files --others -z $ls_others]
1628 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1629 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1630 incr rescan_active
1631 }
1632 }
1633
1634 proc load_message {file {encoding {}}} {
1635 global ui_comm
1636
1637 set f [gitdir $file]
1638 if {[file isfile $f]} {
1639 if {[catch {set fd [open $f r]}]} {
1640 return 0
1641 }
1642 fconfigure $fd -eofchar {}
1643 if {$encoding ne {}} {
1644 fconfigure $fd -encoding $encoding
1645 }
1646 set content [string trim [read $fd]]
1647 close $fd
1648 regsub -all -line {[ \r\t]+$} $content {} content
1649 $ui_comm delete 0.0 end
1650 $ui_comm insert end $content
1651 return 1
1652 }
1653 return 0
1654 }
1655
1656 proc run_prepare_commit_msg_hook {} {
1657 global pch_error
1658
1659 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1660 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1661 # empty file but existent file.
1662
1663 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1664
1665 if {[file isfile [gitdir MERGE_MSG]]} {
1666 set pcm_source "merge"
1667 set fd_mm [open [gitdir MERGE_MSG] r]
1668 puts -nonewline $fd_pcm [read $fd_mm]
1669 close $fd_mm
1670 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1671 set pcm_source "squash"
1672 set fd_sm [open [gitdir SQUASH_MSG] r]
1673 puts -nonewline $fd_pcm [read $fd_sm]
1674 close $fd_sm
1675 } else {
1676 set pcm_source ""
1677 }
1678
1679 close $fd_pcm
1680
1681 set fd_ph [githook_read prepare-commit-msg \
1682 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1683 if {$fd_ph eq {}} {
1684 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1685 return 0;
1686 }
1687
1688 ui_status [mc "Calling prepare-commit-msg hook..."]
1689 set pch_error {}
1690
1691 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1692 fileevent $fd_ph readable \
1693 [list prepare_commit_msg_hook_wait $fd_ph]
1694
1695 return 1;
1696 }
1697
1698 proc prepare_commit_msg_hook_wait {fd_ph} {
1699 global pch_error
1700
1701 append pch_error [read $fd_ph]
1702 fconfigure $fd_ph -blocking 1
1703 if {[eof $fd_ph]} {
1704 if {[catch {close $fd_ph}]} {
1705 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1706 hook_failed_popup prepare-commit-msg $pch_error
1707 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1708 exit 1
1709 } else {
1710 load_message PREPARE_COMMIT_MSG
1711 }
1712 set pch_error {}
1713 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1714 return
1715 }
1716 fconfigure $fd_ph -blocking 0
1717 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1718 }
1719
1720 proc read_diff_index {fd after} {
1721 global buf_rdi
1722
1723 append buf_rdi [read $fd]
1724 set c 0
1725 set n [string length $buf_rdi]
1726 while {$c < $n} {
1727 set z1 [string first "\0" $buf_rdi $c]
1728 if {$z1 == -1} break
1729 incr z1
1730 set z2 [string first "\0" $buf_rdi $z1]
1731 if {$z2 == -1} break
1732
1733 incr c
1734 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1735 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1736 merge_state \
1737 [encoding convertfrom $p] \
1738 [lindex $i 4]? \
1739 [list [lindex $i 0] [lindex $i 2]] \
1740 [list]
1741 set c $z2
1742 incr c
1743 }
1744 if {$c < $n} {
1745 set buf_rdi [string range $buf_rdi $c end]
1746 } else {
1747 set buf_rdi {}
1748 }
1749
1750 rescan_done $fd buf_rdi $after
1751 }
1752
1753 proc read_diff_files {fd after} {
1754 global buf_rdf
1755
1756 append buf_rdf [read $fd]
1757 set c 0
1758 set n [string length $buf_rdf]
1759 while {$c < $n} {
1760 set z1 [string first "\0" $buf_rdf $c]
1761 if {$z1 == -1} break
1762 incr z1
1763 set z2 [string first "\0" $buf_rdf $z1]
1764 if {$z2 == -1} break
1765
1766 incr c
1767 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1768 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1769 merge_state \
1770 [encoding convertfrom $p] \
1771 ?[lindex $i 4] \
1772 [list] \
1773 [list [lindex $i 0] [lindex $i 2]]
1774 set c $z2
1775 incr c
1776 }
1777 if {$c < $n} {
1778 set buf_rdf [string range $buf_rdf $c end]
1779 } else {
1780 set buf_rdf {}
1781 }
1782
1783 rescan_done $fd buf_rdf $after
1784 }
1785
1786 proc read_ls_others {fd after} {
1787 global buf_rlo
1788
1789 append buf_rlo [read $fd]
1790 set pck [split $buf_rlo "\0"]
1791 set buf_rlo [lindex $pck end]
1792 foreach p [lrange $pck 0 end-1] {
1793 set p [encoding convertfrom $p]
1794 if {[string index $p end] eq {/}} {
1795 set p [string range $p 0 end-1]
1796 }
1797 merge_state $p ?O
1798 }
1799 rescan_done $fd buf_rlo $after
1800 }
1801
1802 proc rescan_done {fd buf after} {
1803 global rescan_active current_diff_path
1804 global file_states repo_config
1805 upvar $buf to_clear
1806
1807 if {![eof $fd]} return
1808 set to_clear {}
1809 close $fd
1810 if {[incr rescan_active -1] > 0} return
1811
1812 prune_selection
1813 unlock_index
1814 display_all_files
1815 if {$current_diff_path ne {}} { reshow_diff $after }
1816 if {$current_diff_path eq {}} { select_first_diff $after }
1817 }
1818
1819 proc prune_selection {} {
1820 global file_states selected_paths
1821
1822 foreach path [array names selected_paths] {
1823 if {[catch {set still_here $file_states($path)}]} {
1824 unset selected_paths($path)
1825 }
1826 }
1827 }
1828
1829 ######################################################################
1830 ##
1831 ## ui helpers
1832
1833 proc mapicon {w state path} {
1834 global all_icons
1835
1836 if {[catch {set r $all_icons($state$w)}]} {
1837 puts "error: no icon for $w state={$state} $path"
1838 return file_plain
1839 }
1840 return $r
1841 }
1842
1843 proc mapdesc {state path} {
1844 global all_descs
1845
1846 if {[catch {set r $all_descs($state)}]} {
1847 puts "error: no desc for state={$state} $path"
1848 return $state
1849 }
1850 return $r
1851 }
1852
1853 proc ui_status {msg} {
1854 global main_status
1855 if {[info exists main_status]} {
1856 $main_status show $msg
1857 }
1858 }
1859
1860 proc ui_ready {{test {}}} {
1861 global main_status
1862 if {[info exists main_status]} {
1863 $main_status show [mc "Ready."] $test
1864 }
1865 }
1866
1867 proc escape_path {path} {
1868 regsub -all {\\} $path "\\\\" path
1869 regsub -all "\n" $path "\\n" path
1870 return $path
1871 }
1872
1873 proc short_path {path} {
1874 return [escape_path [lindex [file split $path] end]]
1875 }
1876
1877 set next_icon_id 0
1878 set null_sha1 [string repeat 0 40]
1879
1880 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1881 global file_states next_icon_id null_sha1
1882
1883 set s0 [string index $new_state 0]
1884 set s1 [string index $new_state 1]
1885
1886 if {[catch {set info $file_states($path)}]} {
1887 set state __
1888 set icon n[incr next_icon_id]
1889 } else {
1890 set state [lindex $info 0]
1891 set icon [lindex $info 1]
1892 if {$head_info eq {}} {set head_info [lindex $info 2]}
1893 if {$index_info eq {}} {set index_info [lindex $info 3]}
1894 }
1895
1896 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1897 elseif {$s0 eq {_}} {set s0 _}
1898
1899 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1900 elseif {$s1 eq {_}} {set s1 _}
1901
1902 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1903 set head_info [list 0 $null_sha1]
1904 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1905 && $head_info eq {}} {
1906 set head_info $index_info
1907 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1908 set index_info $head_info
1909 set head_info {}
1910 }
1911
1912 set file_states($path) [list $s0$s1 $icon \
1913 $head_info $index_info \
1914 ]
1915 return $state
1916 }
1917
1918 proc display_file_helper {w path icon_name old_m new_m} {
1919 global file_lists
1920
1921 if {$new_m eq {_}} {
1922 set lno [lsearch -sorted -exact $file_lists($w) $path]
1923 if {$lno >= 0} {
1924 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1925 incr lno
1926 $w conf -state normal
1927 $w delete $lno.0 [expr {$lno + 1}].0
1928 $w conf -state disabled
1929 }
1930 } elseif {$old_m eq {_} && $new_m ne {_}} {
1931 lappend file_lists($w) $path
1932 set file_lists($w) [lsort -unique $file_lists($w)]
1933 set lno [lsearch -sorted -exact $file_lists($w) $path]
1934 incr lno
1935 $w conf -state normal
1936 $w image create $lno.0 \
1937 -align center -padx 5 -pady 1 \
1938 -name $icon_name \
1939 -image [mapicon $w $new_m $path]
1940 $w insert $lno.1 "[escape_path $path]\n"
1941 $w conf -state disabled
1942 } elseif {$old_m ne $new_m} {
1943 $w conf -state normal
1944 $w image conf $icon_name -image [mapicon $w $new_m $path]
1945 $w conf -state disabled
1946 }
1947 }
1948
1949 proc display_file {path state} {
1950 global file_states selected_paths
1951 global ui_index ui_workdir
1952
1953 set old_m [merge_state $path $state]
1954 set s $file_states($path)
1955 set new_m [lindex $s 0]
1956 set icon_name [lindex $s 1]
1957
1958 set o [string index $old_m 0]
1959 set n [string index $new_m 0]
1960 if {$o eq {U}} {
1961 set o _
1962 }
1963 if {$n eq {U}} {
1964 set n _
1965 }
1966 display_file_helper $ui_index $path $icon_name $o $n
1967
1968 if {[string index $old_m 0] eq {U}} {
1969 set o U
1970 } else {
1971 set o [string index $old_m 1]
1972 }
1973 if {[string index $new_m 0] eq {U}} {
1974 set n U
1975 } else {
1976 set n [string index $new_m 1]
1977 }
1978 display_file_helper $ui_workdir $path $icon_name $o $n
1979
1980 if {$new_m eq {__}} {
1981 unset file_states($path)
1982 catch {unset selected_paths($path)}
1983 }
1984 }
1985
1986 proc display_all_files_helper {w path icon_name m} {
1987 global file_lists
1988
1989 lappend file_lists($w) $path
1990 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1991 $w image create end \
1992 -align center -padx 5 -pady 1 \
1993 -name $icon_name \
1994 -image [mapicon $w $m $path]
1995 $w insert end "[escape_path $path]\n"
1996 }
1997
1998 set files_warning 0
1999 proc display_all_files {} {
2000 global ui_index ui_workdir
2001 global file_states file_lists
2002 global last_clicked
2003 global files_warning
2004
2005 $ui_index conf -state normal
2006 $ui_workdir conf -state normal
2007
2008 $ui_index delete 0.0 end
2009 $ui_workdir delete 0.0 end
2010 set last_clicked {}
2011
2012 set file_lists($ui_index) [list]
2013 set file_lists($ui_workdir) [list]
2014
2015 set to_display [lsort [array names file_states]]
2016 set display_limit [get_config gui.maxfilesdisplayed]
2017 if {[llength $to_display] > $display_limit} {
2018 if {!$files_warning} {
2019 # do not repeatedly warn:
2020 set files_warning 1
2021 info_popup [mc "Displaying only %s of %s files." \
2022 $display_limit [llength $to_display]]
2023 }
2024 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
2025 }
2026 foreach path $to_display {
2027 set s $file_states($path)
2028 set m [lindex $s 0]
2029 set icon_name [lindex $s 1]
2030
2031 set s [string index $m 0]
2032 if {$s ne {U} && $s ne {_}} {
2033 display_all_files_helper $ui_index $path \
2034 $icon_name $s
2035 }
2036
2037 if {[string index $m 0] eq {U}} {
2038 set s U
2039 } else {
2040 set s [string index $m 1]
2041 }
2042 if {$s ne {_}} {
2043 display_all_files_helper $ui_workdir $path \
2044 $icon_name $s
2045 }
2046 }
2047
2048 $ui_index conf -state disabled
2049 $ui_workdir conf -state disabled
2050 }
2051
2052 ######################################################################
2053 ##
2054 ## icons
2055
2056 set filemask {
2057 #define mask_width 14
2058 #define mask_height 15
2059 static unsigned char mask_bits[] = {
2060 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2061 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2062 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2063 }
2064
2065 image create bitmap file_plain -background white -foreground black -data {
2066 #define plain_width 14
2067 #define plain_height 15
2068 static unsigned char plain_bits[] = {
2069 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2070 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2071 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2072 } -maskdata $filemask
2073
2074 image create bitmap file_mod -background white -foreground blue -data {
2075 #define mod_width 14
2076 #define mod_height 15
2077 static unsigned char mod_bits[] = {
2078 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2079 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2080 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2081 } -maskdata $filemask
2082
2083 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2084 #define file_fulltick_width 14
2085 #define file_fulltick_height 15
2086 static unsigned char file_fulltick_bits[] = {
2087 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2088 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2089 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2090 } -maskdata $filemask
2091
2092 image create bitmap file_question -background white -foreground black -data {
2093 #define file_question_width 14
2094 #define file_question_height 15
2095 static unsigned char file_question_bits[] = {
2096 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2097 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2098 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2099 } -maskdata $filemask
2100
2101 image create bitmap file_removed -background white -foreground red -data {
2102 #define file_removed_width 14
2103 #define file_removed_height 15
2104 static unsigned char file_removed_bits[] = {
2105 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2106 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2107 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2108 } -maskdata $filemask
2109
2110 image create bitmap file_merge -background white -foreground blue -data {
2111 #define file_merge_width 14
2112 #define file_merge_height 15
2113 static unsigned char file_merge_bits[] = {
2114 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2115 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2116 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2117 } -maskdata $filemask
2118
2119 image create bitmap file_statechange -background white -foreground green -data {
2120 #define file_statechange_width 14
2121 #define file_statechange_height 15
2122 static unsigned char file_statechange_bits[] = {
2123 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2124 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2125 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2126 } -maskdata $filemask
2127
2128 image create photo tab_close -data {R0lGODlhDgAOAMZaAFJSUlNTUlNTU1RUVFVVVVVWVVZWVllZWVpaWVpaWlpbWltbWltbW1xcW1xcXFxdXF1dXF1dXV1eXV5eXV5eXl9fXV9fXl9fX19gXmBgYGBhX2NjY2RlY2VlZWVmZGZmZmZnZWZoZWhpZ2hqaGtramttamxtbG1ubG5vbW9wbnBxb3FycHJzcXJzcnN1cnR1c3V1dHV2dHZ4dXd5dnt8enx+e4GCgIGDgYeIhoeJh4mKiIuLi42NjY+PjZCQkJGRkZKSkpSUlJWVlZeXl5mZmZubm5ycnJ2dnZ6enqCgoKKioqioqLOzs8XFxcbGxsfHx8vLy83NzdDQ0NHR0dLS0tbW1tnZ2d3d3d7e3t/f3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////yH5BAEKAH8ALAAAAAAOAA4AAAeZgH+CWYKFf1eGf1QdQoY/H1WFURIrEUGCQBUtFFJ/VgkpOjkRP0ENODokG1h/SQclMjcPBzYzIwRMhUcGISw1NC4hA0uJRAQgKCogA0aJfzwMMR4eMQ47iT4HLyIYEyIwCD2FQQcmHBABAg8cJweNUxQKGgsCSEoA8ggUU39PGQUEhggqMsCAhSeFnFzwYSgIhSaJoDiTKCgQADs=}
2129
2130 set ui_index .vpane.files.index.list
2131 set ui_workdir .vpane.files.workdir.list
2132
2133 set all_icons(_$ui_index) file_plain
2134 set all_icons(A$ui_index) file_plain
2135 set all_icons(M$ui_index) file_fulltick
2136 set all_icons(D$ui_index) file_removed
2137 set all_icons(U$ui_index) file_merge
2138 set all_icons(T$ui_index) file_statechange
2139
2140 set all_icons(_$ui_workdir) file_plain
2141 set all_icons(M$ui_workdir) file_mod
2142 set all_icons(D$ui_workdir) file_question
2143 set all_icons(U$ui_workdir) file_merge
2144 set all_icons(O$ui_workdir) file_plain
2145 set all_icons(T$ui_workdir) file_statechange
2146
2147 foreach i {
2148 {__ {mc "Unmodified"}}
2149
2150 {_M {mc "Modified, not staged"}}
2151 {M_ {mc "Staged for commit"}}
2152 {MM {mc "Portions staged for commit"}}
2153 {MD {mc "Staged for commit, missing"}}
2154
2155 {_T {mc "File type changed, not staged"}}
2156 {MT {mc "File type changed, old type staged for commit"}}
2157 {AT {mc "File type changed, old type staged for commit"}}
2158 {T_ {mc "File type changed, staged"}}
2159 {TM {mc "File type change staged, modification not staged"}}
2160 {TD {mc "File type change staged, file missing"}}
2161
2162 {_O {mc "Untracked, not staged"}}
2163 {A_ {mc "Staged for commit"}}
2164 {AM {mc "Portions staged for commit"}}
2165 {AD {mc "Staged for commit, missing"}}
2166
2167 {_D {mc "Missing"}}
2168 {D_ {mc "Staged for removal"}}
2169 {DO {mc "Staged for removal, still present"}}
2170
2171 {_U {mc "Requires merge resolution"}}
2172 {U_ {mc "Requires merge resolution"}}
2173 {UU {mc "Requires merge resolution"}}
2174 {UM {mc "Requires merge resolution"}}
2175 {UD {mc "Requires merge resolution"}}
2176 {UT {mc "Requires merge resolution"}}
2177 } {
2178 set all_descs([lindex $i 0]) [eval [lindex $i 1]]
2179 }
2180 unset i
2181
2182 ######################################################################
2183 ##
2184 ## util
2185
2186 proc scrollbar2many {list mode args} {
2187 foreach w $list {eval $w $mode $args}
2188 }
2189
2190 proc many2scrollbar {list mode sb top bottom} {
2191 $sb set $top $bottom
2192 foreach w $list {$w $mode moveto $top}
2193 }
2194
2195 # delegates mouse selection actions from gutter columns to the main text
2196 # widget
2197 # use delegator_bind, if you need to bind more actions
2198 proc delegate_sel_to {w from} {
2199 set bind_list [list \
2200 <Button-1> \
2201 <B1-Motion> \
2202 <Double-Button-1> \
2203 <Triple-Button-1> \
2204 <Shift-Button-1> \
2205 <Double-Shift-Button-1> \
2206 <Triple-Shift-Button-1> \
2207 ]
2208
2209 foreach seq $bind_list {
2210 set script [bind Text $seq]
2211 set new_script [string map [list %W $w %x 0 word line] $script]
2212 foreach f $from {
2213 bind $f $seq "$new_script; focus $w; break"
2214 }
2215 }
2216 }
2217
2218 # use this for binding any of the mouse actions from a delegator
2219 # see bind_list in delegate_sel_to
2220 proc delegator_bind {tag seq script} {
2221 bind $tag $seq "$script; [bind $tag $seq]"
2222 }
2223
2224 proc incr_font_size {font {amt 1}} {
2225 set sz [font configure $font -size]
2226 incr sz $amt
2227 font configure $font -size $sz
2228 font configure ${font}bold -size $sz
2229 font configure ${font}italic -size $sz
2230 }
2231
2232 ######################################################################
2233 ##
2234 ## ui commands
2235
2236 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2237
2238 proc do_gitk {revs {is_submodule false}} {
2239 global current_diff_path file_states current_diff_side ui_index
2240
2241 # -- Always start gitk through whatever we were loaded with. This
2242 # lets us bypass using shell process on Windows systems.
2243 #
2244 set exe [_which gitk -script]
2245 set cmd [list [info nameofexecutable] $exe]
2246 if {$exe eq {}} {
2247 error_popup [mc "Couldn't find gitk in PATH"]
2248 } else {
2249 global env
2250
2251 set pwd [pwd]
2252
2253 if {!$is_submodule} {
2254 if {![is_bare]} {
2255 cd $::GIT_WORK_TREE
2256 }
2257 } else {
2258 cd $current_diff_path
2259 if {$revs eq {--}} {
2260 set s $file_states($current_diff_path)
2261 set old_sha1 {}
2262 set new_sha1 {}
2263 switch -glob -- [lindex $s 0] {
2264 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2265 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2266 MM {
2267 if {$current_diff_side eq $ui_index} {
2268 set old_sha1 [lindex [lindex $s 2] 1]
2269 set new_sha1 [lindex [lindex $s 3] 1]
2270 } else {
2271 set old_sha1 [lindex [lindex $s 3] 1]
2272 }
2273 }
2274 }
2275 set revs $old_sha1...$new_sha1
2276 }
2277 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2278 # we've been using for the main repository, so unset them.
2279 # TODO we could make life easier (start up faster?) for gitk
2280 # by setting these to the appropriate values to allow gitk
2281 # to skip the heuristics to find their proper value
2282 git_clear_env
2283 }
2284 eval exec $cmd $revs "--" "--" &
2285
2286 git_reset_env
2287 cd $pwd
2288
2289 ui_status $::starting_gitk_msg
2290 after 10000 {
2291 ui_ready $starting_gitk_msg
2292 }
2293 }
2294 }
2295
2296 proc do_git_gui {} {
2297 global current_diff_path
2298
2299 # -- Always start git gui through whatever we were loaded with. This
2300 # lets us bypass using shell process on Windows systems.
2301 #
2302 set exe [list [_which git]]
2303 if {$exe eq {}} {
2304 error_popup [mc "Couldn't find git gui in PATH"]
2305 } else {
2306 # see note in do_gitk about unsetting these vars when
2307 # running tools in a submodule
2308 git_clear_env
2309
2310 set pwd [pwd]
2311 cd $current_diff_path
2312
2313 eval exec $exe gui &
2314
2315 cd $pwd
2316 git_reset_env
2317
2318 ui_status $::starting_gitk_msg
2319 after 10000 {
2320 ui_ready $starting_gitk_msg
2321 }
2322 }
2323 }
2324
2325 proc do_explore {} {
2326 global _gitworktree
2327 set explorer {}
2328 if {[is_Cygwin] || [is_Windows]} {
2329 set explorer "explorer.exe"
2330 } elseif {[is_MacOSX]} {
2331 set explorer "open"
2332 } else {
2333 # freedesktop.org-conforming system is our best shot
2334 set explorer "xdg-open"
2335 }
2336 eval exec $explorer [list [file nativename $_gitworktree]] &
2337 }
2338
2339 set is_quitting 0
2340 set ret_code 1
2341
2342 proc terminate_me {win} {
2343 global ret_code
2344 if {$win ne {.}} return
2345 exit $ret_code
2346 }
2347
2348 proc do_quit {{rc {1}}} {
2349 global ui_comm is_quitting repo_config commit_type
2350 global GITGUI_BCK_exists GITGUI_BCK_i
2351 global ui_comm_spell
2352 global ret_code use_ttk
2353
2354 if {$is_quitting} return
2355 set is_quitting 1
2356
2357 if {[winfo exists $ui_comm]} {
2358 # -- Stash our current commit buffer.
2359 #
2360 set save [gitdir GITGUI_MSG]
2361 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2362 file rename -force [gitdir GITGUI_BCK] $save
2363 set GITGUI_BCK_exists 0
2364 } else {
2365 set msg [string trim [$ui_comm get 0.0 end]]
2366 regsub -all -line {[ \r\t]+$} $msg {} msg
2367 if {(![string match amend* $commit_type]
2368 || [$ui_comm edit modified])
2369 && $msg ne {}} {
2370 catch {
2371 set fd [open $save w]
2372 fconfigure $fd -encoding utf-8
2373 puts -nonewline $fd $msg
2374 close $fd
2375 }
2376 } else {
2377 catch {file delete $save}
2378 }
2379 }
2380
2381 # -- Cancel our spellchecker if its running.
2382 #
2383 if {[info exists ui_comm_spell]} {
2384 $ui_comm_spell stop
2385 }
2386
2387 # -- Remove our editor backup, its not needed.
2388 #
2389 after cancel $GITGUI_BCK_i
2390 if {$GITGUI_BCK_exists} {
2391 catch {file delete [gitdir GITGUI_BCK]}
2392 }
2393
2394 # -- Stash our current window geometry into this repository.
2395 #
2396 set cfg_wmstate [wm state .]
2397 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2398 set rc_wmstate {}
2399 }
2400 if {$cfg_wmstate ne $rc_wmstate} {
2401 catch {git config gui.wmstate $cfg_wmstate}
2402 }
2403 if {$cfg_wmstate eq {zoomed}} {
2404 # on Windows wm geometry will lie about window
2405 # position (but not size) when window is zoomed
2406 # restore the window before querying wm geometry
2407 wm state . normal
2408 }
2409 set cfg_geometry [list]
2410 lappend cfg_geometry [wm geometry .]
2411 if {$use_ttk} {
2412 lappend cfg_geometry [.vpane sashpos 0]
2413 lappend cfg_geometry [.vpane.files sashpos 0]
2414 } else {
2415 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2416 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2417 }
2418 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2419 set rc_geometry {}
2420 }
2421 if {$cfg_geometry ne $rc_geometry} {
2422 catch {git config gui.geometry $cfg_geometry}
2423 }
2424 }
2425
2426 set ret_code $rc
2427
2428 # Briefly enable send again, working around Tk bug
2429 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2430 tk appname [appname]
2431
2432 destroy .
2433 }
2434
2435 proc do_rescan {} {
2436 rescan ui_ready
2437 $::browser_tab reload
2438 $::grep_tab grep
2439 }
2440
2441 proc ui_do_rescan {} {
2442 rescan {force_first_diff ui_ready}
2443 $::browser_tab reload
2444 $::grep_tab grep
2445 }
2446
2447 proc do_commit {} {
2448 commit_tree
2449 $::browser_tab reload
2450 $::grep_tab grep
2451 }
2452
2453 proc next_diff {{after {}}} {
2454 global next_diff_p next_diff_w next_diff_i
2455 show_diff $next_diff_p $next_diff_w {} {} $after
2456 }
2457
2458 proc find_anchor_pos {lst name} {
2459 set lid [lsearch -sorted -exact $lst $name]
2460
2461 if {$lid == -1} {
2462 set lid 0
2463 foreach lname $lst {
2464 if {$lname >= $name} break
2465 incr lid
2466 }
2467 }
2468
2469 return $lid
2470 }
2471
2472 proc find_file_from {flist idx delta path mmask} {
2473 global file_states
2474
2475 set len [llength $flist]
2476 while {$idx >= 0 && $idx < $len} {
2477 set name [lindex $flist $idx]
2478
2479 if {$name ne $path && [info exists file_states($name)]} {
2480 set state [lindex $file_states($name) 0]
2481
2482 if {$mmask eq {} || [regexp $mmask $state]} {
2483 return $idx
2484 }
2485 }
2486
2487 incr idx $delta
2488 }
2489
2490 return {}
2491 }
2492
2493 proc find_next_diff {w path {lno {}} {mmask {}}} {
2494 global next_diff_p next_diff_w next_diff_i
2495 global file_lists ui_index ui_workdir
2496
2497 set flist $file_lists($w)
2498 if {$lno eq {}} {
2499 set lno [find_anchor_pos $flist $path]
2500 } else {
2501 incr lno -1
2502 }
2503
2504 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2505 if {$w eq $ui_index} {
2506 set mmask "^$mmask"
2507 } else {
2508 set mmask "$mmask\$"
2509 }
2510 }
2511
2512 set idx [find_file_from $flist $lno 1 $path $mmask]
2513 if {$idx eq {}} {
2514 incr lno -1
2515 set idx [find_file_from $flist $lno -1 $path $mmask]
2516 }
2517
2518 if {$idx ne {}} {
2519 set next_diff_w $w
2520 set next_diff_p [lindex $flist $idx]
2521 set next_diff_i [expr {$idx+1}]
2522 return 1
2523 } else {
2524 return 0
2525 }
2526 }
2527
2528 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2529 global current_diff_path
2530
2531 if {$path ne $current_diff_path} {
2532 return {}
2533 } elseif {[find_next_diff $w $path $lno $mmask]} {
2534 return {next_diff;}
2535 } else {
2536 return {reshow_diff;}
2537 }
2538 }
2539
2540 proc select_first_diff {after} {
2541 global ui_workdir
2542
2543 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2544 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2545 next_diff $after
2546 } else {
2547 uplevel #0 $after
2548 }
2549 }
2550
2551 proc force_first_diff {after} {
2552 global ui_workdir current_diff_path file_states
2553
2554 if {[info exists file_states($current_diff_path)]} {
2555 set state [lindex $file_states($current_diff_path) 0]
2556 } else {
2557 set state {OO}
2558 }
2559
2560 set reselect 0
2561 if {[string first {U} $state] >= 0} {
2562 # Already a conflict, do nothing
2563 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2564 set reselect 1
2565 } elseif {[string index $state 1] ne {O}} {
2566 # Already a diff & no conflicts, do nothing
2567 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2568 set reselect 1
2569 }
2570
2571 if {$reselect} {
2572 next_diff $after
2573 } else {
2574 uplevel #0 $after
2575 }
2576 }
2577
2578 # opens file in editor
2579 proc open_in_git_editor {path {lno 0} {edit_index 0} {aux {}}} {
2580 global env
2581
2582 if {$edit_index} {
2583 if {[catch {
2584 set fd [git_read ls-files -s --error-unmatch -- $path]
2585 fconfigure $fd -translation binary -encoding binary
2586 set info [split [gets $fd] " \t"]
2587 close $fd
2588 set mode [lindex $info 0]
2589 set sha1 [lindex $info 1]
2590 set stage [lindex $info 2]
2591 if {$mode != 100644 && $mode != 100755} {
2592 return -code error "Path is not a regular file: $mode"
2593 }
2594 if {$stage != 0} {
2595 return -code error "Path is in unmerged state."
2596 }
2597 set tmp_path "[file rootname $path].[string range $sha1 0 11][file extension $path]"
2598 if {[file exists $tmp_path]} {
2599 return -code error "Path is currently edited."
2600 }
2601 set fd [git_read checkout-index --temp -- $path]
2602 fconfigure $fd -translation binary -encoding binary
2603 set info [split [gets $fd] " \t"]
2604 close $fd
2605 set git_tmp_path [lindex $info 0]
2606 file rename $git_tmp_path $tmp_path
2607 unset git_tmp_path
2608 if {$mode == 100644} {
2609 file attributes $tmp_path -permissions 0600
2610 } else {
2611 file attributes $tmp_path -permissions 0700
2612 }
2613 set orig_path $path
2614 set path $tmp_path
2615 unset tmp_path
2616 } err]} {
2617 if {[info exists tmp_path]} {
2618 file delete $tmp_path
2619 }
2620 if {[info exists git_tmp_path]} {
2621 file delete $git_tmp_path
2622 }
2623 tk_messageBox \
2624 -icon error \
2625 -type ok \
2626 -title {git-gui: Can't edit path from index} \
2627 -message $err
2628 return
2629 }
2630 }
2631
2632 catch { unset env(ARGS) }
2633 catch { unset env(REVISION) }
2634
2635 if {!$edit_index} {
2636 set env(GIT_EDITOR_F_NBLOCK) 1
2637 }
2638 if {$lno != 0} {
2639 set env(GIT_EDITOR_F_POSITION) $lno
2640 }
2641 if {$aux ne {}} {
2642 set env(GIT_EDITOR_F_AUX) [sq $aux]
2643 }
2644
2645 if {[catch {exec [shellpath] -c "[git var GIT_EDITOR] [sq $path]"} err]} {
2646 tk_messageBox \
2647 -icon error \
2648 -type ok \
2649 -title {git-gui: Can't start GIT_EDITOR} \
2650 -message $err
2651 }
2652
2653 catch { unset env(GIT_EDITOR_F_NBLOCK) }
2654 catch { unset env(GIT_EDITOR_F_POSITION) }
2655 catch { unset env(GIT_EDITOR_F_AUX) }
2656
2657 if {$edit_index} {
2658 if {[catch {
2659 set new_mode [file attributes $path -permissions]
2660 switch -glob $new_mode {
2661 ??6?? {
2662 set new_mode 100644
2663 }
2664 ??7?? {
2665 set new_mode 100755
2666 }
2667 * {
2668 return -code error "Invalid mode of edited file."
2669 }
2670 }
2671 set fd [git_read hash-object -w --path=[encoding convertto $orig_path] -- [encoding convertto $path]]
2672 fconfigure $fd -translation binary -encoding binary
2673 set new_sha1 [gets $fd]
2674 close $fd
2675 file delete $path
2676 set fd [git_write update-index -z --index-info]
2677 puts -nonewline $fd "$new_mode $new_sha1\t[encoding convertto $orig_path]\0"
2678 close $fd
2679 } err]} {
2680 file delete $path
2681 tk_messageBox \
2682 -icon error \
2683 -type ok \
2684 -title {git-gui: Can't edit path from index} \
2685 -message $err
2686 return
2687 }
2688 do_rescan
2689 }
2690 }
2691
2692 proc get_best_diff_lno {w lno} {
2693 set fwi [$w search -elide -regexp {^\d+$} $lno.0 end]
2694 if {$fwi eq {}} {
2695 set fwi end
2696 }
2697 set bwi [$w search -elide -backwards -regexp {^\d+$} $lno.0 1.0]
2698 if {$bwi eq {}} {
2699 set bwi 1.0
2700 }
2701 set fwl [$w count -lines $lno.0 $fwi]
2702 set bwl [$w count -lines $bwi $lno.0]
2703 if {$fwl <= $bwl} {
2704 set lno [$w get "$fwi linestart" "$fwi lineend"]
2705 } else {
2706 set lno [$w get "$bwi linestart" "$bwi lineend"]
2707 }
2708
2709 if {$lno eq {}} {
2710 set lno 0
2711 }
2712
2713 return $lno
2714 }
2715
2716 proc open_from_file_list {w x y {edit_index 0}} {
2717 global ui_diff ui_diff_blnos
2718 global file_lists current_diff_path
2719
2720 set pos [split [$w index @$x,$y] .]
2721 set lno [lindex $pos 0]
2722 set col [lindex $pos 1]
2723 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2724 if {$path eq {}} {
2725 return
2726 }
2727
2728 set lno 0
2729 if {$path eq $current_diff_path} {
2730 # calculate the line number which is visible in the middle
2731 set height [$ui_diff count -ypixels 1.0 end]
2732 set ypos [$ui_diff yview]
2733 set yposm [expr {([lindex $ypos 1] + [lindex $ypos 0]) / 2}]
2734 set mpixel [expr {$height * $yposm}]
2735 set ytop [expr {[lindex $ypos 0] * $height}]
2736 set rmpixel [expr {round($mpixel - $ytop)}]
2737 set lno [$ui_diff index "@0,$rmpixel linestart"]
2738 set lno [lindex [split $lno .] 0]
2739
2740 set lno [get_best_diff_lno $ui_diff_blnos $lno]
2741 }
2742
2743 open_in_git_editor $path $lno $edit_index
2744 }
2745
2746 proc open_from_diff_view {x y {edit_index 0}} {
2747 global ui_diff ui_diff_blnos
2748 global file_lists current_diff_path
2749
2750 if {$current_diff_path eq {}} {
2751 return
2752 }
2753
2754 set lno [$ui_diff index "@0,$y linestart"]
2755 set lno [lindex [split $lno .] 0]
2756 set lno [get_best_diff_lno $ui_diff_blnos $lno]
2757
2758 open_in_git_editor $current_diff_path $lno $edit_index
2759 }
2760
2761 proc blame_from_file_list {w x y} {
2762 global ui_diff ui_diff_blnos
2763 global file_lists current_diff_path
2764
2765 set pos [split [$w index @$x,$y] .]
2766 set lno [lindex $pos 0]
2767 set col [lindex $pos 1]
2768 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2769 if {$path eq {}} {
2770 return
2771 }
2772
2773 set lno 0
2774 if {$path eq $current_diff_path} {
2775 # calculate the line number which is visible in the middle
2776 set height [$ui_diff count -ypixels 1.0 end]
2777 set ypos [$ui_diff yview]
2778 set yposm [expr {([lindex $ypos 1] + [lindex $ypos 0]) / 2}]
2779 set mpixel [expr {$height * $yposm}]
2780 set ytop [expr {[lindex $ypos 0] * $height}]
2781 set rmpixel [expr {round($mpixel - $ytop)}]
2782 set lno [$ui_diff index "@0,$rmpixel linestart"]
2783 set lno [lindex [split $lno .] 0]
2784
2785 set lno [get_best_diff_lno $ui_diff_blnos $lno]
2786 }
2787
2788 blame_path_in_tab $path $lno
2789 }
2790
2791 set ::blame_seq 0
2792 proc blame_path_in_tab {path {lno {}}} {
2793 global NS main_status
2794
2795 set new_blame_tab .nb.blame[incr ::blame_seq]
2796 ${NS}::frame $new_blame_tab
2797 set blame_tab [::blame::embed $new_blame_tab $main_status "" $path $lno]
2798 .nb add $new_blame_tab -text "[lindex [file split $path] end]" -image tab_close -compound right
2799 .nb select $new_blame_tab
2800 focus $new_blame_tab
2801 }
2802
2803 proc popup_files_ctxm {m w x y X Y} {
2804 global file_lists popup_path
2805
2806 set ::cursorX $x
2807 set ::cursorY $y
2808
2809 set pos [split [$w index @$x,$y] .]
2810 set lno [lindex $pos 0]
2811 set col [lindex $pos 1]
2812 set popup_path [lindex $file_lists($w) [expr {$lno - 1}]]
2813 if {$popup_path eq {}} {
2814 return
2815 }
2816 tk_popup $m $X $Y
2817 }
2818
2819 proc toggle_or_diff {w x y} {
2820 global file_states file_lists current_diff_path ui_index ui_workdir
2821 global last_clicked selected_paths
2822
2823 set pos [split [$w index @$x,$y] .]
2824 set lno [lindex $pos 0]
2825 set col [lindex $pos 1]
2826 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2827 if {$path eq {}} {
2828 set last_clicked {}
2829 return
2830 }
2831
2832 set last_clicked [list $w $lno]
2833 array unset selected_paths
2834 $ui_index tag remove in_sel 0.0 end
2835 $ui_workdir tag remove in_sel 0.0 end
2836
2837 # Determine the state of the file
2838 if {[info exists file_states($path)]} {
2839 set state [lindex $file_states($path) 0]
2840 } else {
2841 set state {__}
2842 }
2843
2844 # Restage the file, or simply show the diff
2845 if {$col == 0 && $y > 1} {
2846 # Conflicts need special handling
2847 if {[string first {U} $state] >= 0} {
2848 # $w must always be $ui_workdir, but...
2849 if {$w ne $ui_workdir} { set lno {} }
2850 merge_stage_workdir $path $lno
2851 return
2852 }
2853
2854 if {[string index $state 1] eq {O}} {
2855 set mmask {}
2856 } else {
2857 set mmask {[^O]}
2858 }
2859
2860 set after [next_diff_after_action $w $path $lno $mmask]
2861
2862 if {$w eq $ui_index} {
2863 update_indexinfo \
2864 "Unstaging [short_path $path] from commit" \
2865 [list $path] \
2866 [concat $after [list ui_ready]]
2867 } elseif {$w eq $ui_workdir} {
2868 update_index \
2869 "Adding [short_path $path]" \
2870 [list $path] \
2871 [concat $after [list ui_ready]]
2872 }
2873 } else {
2874 show_diff $path $w $lno
2875 }
2876 }
2877
2878 proc add_one_to_selection {w x y} {
2879 global file_lists last_clicked selected_paths
2880
2881 set lno [lindex [split [$w index @$x,$y] .] 0]
2882 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2883 if {$path eq {}} {
2884 set last_clicked {}
2885 return
2886 }
2887
2888 if {$last_clicked ne {}
2889 && [lindex $last_clicked 0] ne $w} {
2890 array unset selected_paths
2891 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2892 }
2893
2894 set last_clicked [list $w $lno]
2895 if {[catch {set in_sel $selected_paths($path)}]} {
2896 set in_sel 0
2897 }
2898 if {$in_sel} {
2899 unset selected_paths($path)
2900 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2901 } else {
2902 set selected_paths($path) 1
2903 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2904 }
2905 }
2906
2907 proc add_range_to_selection {w x y} {
2908 global file_lists last_clicked selected_paths
2909
2910 if {[lindex $last_clicked 0] ne $w} {
2911 toggle_or_diff $w $x $y
2912 return
2913 }
2914
2915 set lno [lindex [split [$w index @$x,$y] .] 0]
2916 set lc [lindex $last_clicked 1]
2917 if {$lc < $lno} {
2918 set begin $lc
2919 set end $lno
2920 } else {
2921 set begin $lno
2922 set end $lc
2923 }
2924
2925 foreach path [lrange $file_lists($w) \
2926 [expr {$begin - 1}] \
2927 [expr {$end - 1}]] {
2928 set selected_paths($path) 1
2929 }
2930 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2931 }
2932
2933 proc show_more_context {} {
2934 global repo_config
2935 if {$repo_config(gui.diffcontext) < 99} {
2936 incr repo_config(gui.diffcontext)
2937 reshow_diff
2938 }
2939 }
2940
2941 proc show_less_context {} {
2942 global repo_config
2943 if {$repo_config(gui.diffcontext) > 1} {
2944 incr repo_config(gui.diffcontext) -1
2945 reshow_diff
2946 }
2947 }
2948
2949 ######################################################################
2950 ##
2951 ## ui construction
2952
2953 set ui_comm {}
2954
2955 # -- Menu Bar
2956 #
2957 menu .mbar -tearoff 0
2958 if {[is_MacOSX]} {
2959 # -- Apple Menu (Mac OS X only)
2960 #
2961 .mbar add cascade -label Apple -menu .mbar.apple
2962 menu .mbar.apple
2963 }
2964 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2965 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2966 if {[is_enabled branch]} {
2967 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2968 }
2969 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2970 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2971 }
2972 if {[is_enabled transport]} {
2973 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2974 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2975 }
2976 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2977 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2978 }
2979
2980 # -- Repository Menu
2981 #
2982 menu .mbar.repository
2983
2984 if {![is_bare]} {
2985 .mbar.repository add command \
2986 -label [mc "Explore Working Copy"] \
2987 -command {do_explore}
2988 }
2989
2990 if {[is_Windows]} {
2991 .mbar.repository add command \
2992 -label [mc "Git Bash"] \
2993 -command {eval exec [auto_execok start] \
2994 [list "Git Bash" bash --login -l &]}
2995 }
2996
2997 if {[is_Windows] || ![is_bare]} {
2998 .mbar.repository add separator
2999 }
3000
3001 .mbar.repository add command \
3002 -label [mc "Browse Current Branch's Files"] \
3003 -command {browser::new $current_branch}
3004 set ui_browse_current [.mbar.repository index last]
3005 .mbar.repository add command \
3006 -label [mc "Browse Branch Files..."] \
3007 -command browser_open::dialog
3008 .mbar.repository add separator
3009
3010 .mbar.repository add command \
3011 -label [mc "Visualize Current Branch's History"] \
3012 -command {do_gitk $current_branch}
3013 set ui_visualize_current [.mbar.repository index last]
3014 .mbar.repository add command \
3015 -label [mc "Visualize All Branch History"] \
3016 -command {do_gitk --all}
3017 .mbar.repository add separator
3018
3019 proc current_branch_write {args} {
3020 global current_branch
3021 .mbar.repository entryconf $::ui_browse_current \
3022 -label [mc "Browse %s's Files" $current_branch]
3023 .mbar.repository entryconf $::ui_visualize_current \
3024 -label [mc "Visualize %s's History" $current_branch]
3025 }
3026 trace add variable current_branch write current_branch_write
3027
3028 if {[is_enabled multicommit]} {
3029 .mbar.repository add command -label [mc "Database Statistics"] \
3030 -command do_stats
3031
3032 .mbar.repository add command -label [mc "Compress Database"] \
3033 -command do_gc
3034
3035 .mbar.repository add command -label [mc "Verify Database"] \
3036 -command do_fsck_objects
3037
3038 .mbar.repository add separator
3039
3040 if {[is_Cygwin]} {
3041 .mbar.repository add command \
3042 -label [mc "Create Desktop Icon"] \
3043 -command do_cygwin_shortcut
3044 } elseif {[is_Windows]} {
3045 .mbar.repository add command \
3046 -label [mc "Create Desktop Icon"] \
3047 -command do_windows_shortcut
3048 } elseif {[is_MacOSX]} {
3049 .mbar.repository add command \
3050 -label [mc "Create Desktop Icon"] \
3051 -command do_macosx_app
3052 }
3053 }
3054
3055 if {[is_MacOSX]} {
3056 proc ::tk::mac::Quit {args} { do_quit }
3057 } else {
3058 .mbar.repository add command -label [mc Quit] \
3059 -command do_quit \
3060 -accelerator $M1T-Q
3061 }
3062
3063 # -- Edit Menu
3064 #
3065 menu .mbar.edit
3066 .mbar.edit add command -label [mc Undo] \
3067 -command {catch {[focus] edit undo}} \
3068 -accelerator $M1T-Z
3069 .mbar.edit add command -label [mc Redo] \
3070 -command {catch {[focus] edit redo}} \
3071 -accelerator $M1T-Y
3072 .mbar.edit add separator
3073 .mbar.edit add command -label [mc Cut] \
3074 -command {catch {tk_textCut [focus]}} \
3075 -accelerator $M1T-X
3076 .mbar.edit add command -label [mc Copy] \
3077 -command {catch {tk_textCopy [focus]}} \
3078 -accelerator $M1T-C
3079 .mbar.edit add command -label [mc Paste] \
3080 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3081 -accelerator $M1T-V
3082 .mbar.edit add command -label [mc Delete] \
3083 -command {catch {[focus] delete sel.first sel.last}} \
3084 -accelerator Del
3085 .mbar.edit add separator
3086 .mbar.edit add command -label [mc "Select All"] \
3087 -command {catch {[focus] tag add sel 0.0 end}} \
3088 -accelerator $M1T-A
3089
3090 # -- Branch Menu
3091 #
3092 if {[is_enabled branch]} {
3093 menu .mbar.branch
3094
3095 .mbar.branch add command -label [mc "Create..."] \
3096 -command branch_create::dialog \
3097 -accelerator $M1T-N
3098 lappend disable_on_lock [list .mbar.branch entryconf \
3099 [.mbar.branch index last] -state]
3100
3101 .mbar.branch add command -label [mc "Checkout..."] \
3102 -command branch_checkout::dialog \
3103 -accelerator $M1T-O
3104 lappend disable_on_lock [list .mbar.branch entryconf \
3105 [.mbar.branch index last] -state]
3106
3107 .mbar.branch add command -label [mc "Rename..."] \
3108 -command branch_rename::dialog
3109 lappend disable_on_lock [list .mbar.branch entryconf \
3110 [.mbar.branch index last] -state]
3111
3112 .mbar.branch add command -label [mc "Delete..."] \
3113 -command branch_delete::dialog
3114 lappend disable_on_lock [list .mbar.branch entryconf \
3115 [.mbar.branch index last] -state]
3116
3117 .mbar.branch add command -label [mc "Reset..."] \
3118 -command merge::reset_hard
3119 lappend disable_on_lock [list .mbar.branch entryconf \
3120 [.mbar.branch index last] -state]
3121 }
3122
3123 # -- Commit Menu
3124 #
3125 proc commit_btn_caption {} {
3126 if {[is_enabled nocommit]} {
3127 return [mc "Done"]
3128 } else {
3129 return [mc Commit@@verb]
3130 }
3131 }
3132
3133 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
3134 menu .mbar.commit
3135
3136 if {![is_enabled nocommit]} {
3137 .mbar.commit add radiobutton \
3138 -label [mc "New Commit"] \
3139 -command do_select_commit_type \
3140 -variable selected_commit_type \
3141 -value new
3142 lappend disable_on_lock \
3143 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3144
3145 .mbar.commit add radiobutton \
3146 -label [mc "Amend Last Commit"] \
3147 -command do_select_commit_type \
3148 -variable selected_commit_type \
3149 -value amend
3150 lappend disable_on_lock \
3151 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3152
3153 .mbar.commit add separator
3154 }
3155
3156 .mbar.commit add command -label [mc Rescan] \
3157 -command ui_do_rescan \
3158 -accelerator $M1T-R
3159 lappend disable_on_lock \
3160 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3161
3162 .mbar.commit add command -label [mc "Stage To Commit"] \
3163 -command do_add_selection \
3164 -accelerator $M1T-T
3165 lappend disable_on_lock \
3166 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3167
3168 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
3169 -command do_add_all \
3170 -accelerator $M1T-I
3171 lappend disable_on_lock \
3172 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3173
3174 .mbar.commit add command -label [mc "Unstage From Commit"] \
3175 -command do_unstage_selection \
3176 -accelerator $M1T-U
3177 lappend disable_on_lock \
3178 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3179
3180 .mbar.commit add command -label [mc "Revert Changes"] \
3181 -command do_revert_selection \
3182 -accelerator $M1T-J
3183 lappend disable_on_lock \
3184 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3185
3186 .mbar.commit add separator
3187
3188 .mbar.commit add command -label [mc "Show Less Context"] \
3189 -command show_less_context \
3190 -accelerator $M1T-\-
3191
3192 .mbar.commit add command -label [mc "Show More Context"] \
3193 -command show_more_context \
3194 -accelerator $M1T-=
3195
3196 .mbar.commit add checkbutton -label [mc "Show Line Numbers"] \
3197 -command update_show_line_numbers \
3198 -variable diff_show_line_numbers
3199
3200 .mbar.commit add separator
3201
3202 if {![is_enabled nocommitmsg]} {
3203 .mbar.commit add command -label [mc "Sign Off"] \
3204 -command do_signoff \
3205 -accelerator $M1T-S
3206 }
3207
3208 .mbar.commit add command -label [commit_btn_caption] \
3209 -command do_commit \
3210 -accelerator $M1T-Return
3211 lappend disable_on_lock \
3212 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3213 }
3214
3215 # -- Merge Menu
3216 #
3217 if {[is_enabled branch]} {
3218 menu .mbar.merge
3219 .mbar.merge add command -label [mc "Local Merge..."] \
3220 -command merge::dialog \
3221 -accelerator $M1T-M
3222 lappend disable_on_lock \
3223 [list .mbar.merge entryconf [.mbar.merge index last] -state]
3224 .mbar.merge add command -label [mc "Abort Merge..."] \
3225 -command merge::reset_hard
3226 lappend disable_on_lock \
3227 [list .mbar.merge entryconf [.mbar.merge index last] -state]
3228 }
3229
3230 # -- Transport Menu
3231 #
3232 if {[is_enabled transport]} {
3233 menu .mbar.remote
3234
3235 .mbar.remote add command \
3236 -label [mc "Add..."] \
3237 -command remote_add::dialog \
3238 -accelerator $M1T-A
3239 .mbar.remote add command \
3240 -label [mc "Push..."] \
3241 -command do_push_anywhere \
3242 -accelerator $M1T-P
3243 .mbar.remote add command \
3244 -label [mc "Delete Branch..."] \
3245 -command remote_branch_delete::dialog
3246 }
3247
3248 if {[is_MacOSX]} {
3249 proc ::tk::mac::ShowPreferences {} {do_options}
3250 } else {
3251 # -- Edit Menu
3252 #
3253 .mbar.edit add separator
3254 .mbar.edit add command -label [mc "Options..."] \
3255 -command do_options
3256 }
3257
3258 # -- Tools Menu
3259 #
3260 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
3261 set tools_menubar .mbar.tools
3262 menu $tools_menubar
3263 $tools_menubar add separator
3264 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
3265 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
3266 if {[array names repo_config guitool.*.cmd] ne {}} {
3267 tools_populate_all 3
3268 }
3269 }
3270
3271 # -- Help Menu
3272 #
3273 .mbar add cascade -label [mc Help] -menu .mbar.help
3274 menu .mbar.help
3275
3276 if {[is_MacOSX]} {
3277 .mbar.apple add command -label [mc "About %s" [appname]] \
3278 -command do_about
3279 .mbar.apple add separator
3280 } else {
3281 .mbar.help add command -label [mc "About %s" [appname]] \
3282 -command do_about
3283 }
3284 . configure -menu .mbar
3285
3286 set doc_path [githtmldir]
3287 if {$doc_path ne {}} {
3288 set doc_path [file join $doc_path index.html]
3289
3290 if {[is_Cygwin]} {
3291 set doc_path [exec cygpath --mixed $doc_path]
3292 }
3293 }
3294
3295 if {[file isfile $doc_path]} {
3296 set doc_url "file:$doc_path"
3297 } else {
3298 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
3299 }
3300
3301 proc start_browser {url} {
3302 git "web--browse" $url
3303 }
3304
3305 .mbar.help add command -label [mc "Online Documentation"] \
3306 -command [list start_browser $doc_url]
3307
3308 .mbar.help add command -label [mc "Show SSH Key"] \
3309 -command do_ssh_key
3310
3311 unset doc_path doc_url
3312
3313 # -- Standard bindings
3314 #
3315 wm protocol . WM_DELETE_WINDOW do_quit
3316 bind all <$M1B-Key-q> do_quit
3317 bind all <$M1B-Key-Q> do_quit
3318 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3319 bind all <$M1B-Key-W> {close_blame_tab}
3320
3321 set subcommand_args {}
3322 proc usage {} {
3323 set s "usage: $::argv0 $::subcommand $::subcommand_args"
3324 if {[tk windowingsystem] eq "win32"} {
3325 wm withdraw .
3326 tk_messageBox -icon info -message $s \
3327 -title [mc "Usage"]
3328 } else {
3329 puts stderr $s
3330 }
3331 exit 1
3332 }
3333
3334 proc normalize_relpath {path} {
3335 set elements {}
3336 foreach item [file split $path] {
3337 if {$item eq {.}} continue
3338 if {$item eq {..} && [llength $elements] > 0
3339 && [lindex $elements end] ne {..}} {
3340 set elements [lrange $elements 0 end-1]
3341 continue
3342 }
3343 lappend elements $item
3344 }
3345 return [eval file join $elements]
3346 }
3347
3348 # -- Not a normal commit type invocation? Do that instead!
3349 #
3350 switch -- $subcommand {
3351 browser -
3352 blame {
3353 if {$subcommand eq "blame"} {
3354 set subcommand_args {[--line=<num>] rev? path}
3355 } else {
3356 set subcommand_args {rev? path}
3357 }
3358 if {$argv eq {}} usage
3359 set head {}
3360 set path {}
3361 set jump_spec {}
3362 set is_path 0
3363 foreach a $argv {
3364 set p [file join $_prefix $a]
3365
3366 if {$is_path || [file exists $p]} {
3367 if {$path ne {}} usage
3368 set path [normalize_relpath $p]
3369 break
3370 } elseif {$a eq {--}} {
3371 if {$path ne {}} {
3372 if {$head ne {}} usage
3373 set head $path
3374 set path {}
3375 }
3376 set is_path 1
3377 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3378 if {$jump_spec ne {} || $head ne {}} usage
3379 set jump_spec [list $lnum]
3380 } elseif {$head eq {}} {
3381 if {$head ne {}} usage
3382 set head $a
3383 set is_path 1
3384 } else {
3385 usage
3386 }
3387 }
3388 unset is_path
3389
3390 if {$head ne {} && $path eq {}} {
3391 if {[string index $head 0] eq {/}} {
3392 set path [normalize_relpath $head]
3393 set head {}
3394 } else {
3395 set path [normalize_relpath $_prefix$head]
3396 set head {}
3397 }
3398 }
3399
3400 if {$head eq {}} {
3401 load_current_branch
3402 } else {
3403 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3404 if {[catch {
3405 set head [git rev-parse --verify $head]
3406 } err]} {
3407 if {[tk windowingsystem] eq "win32"} {
3408 tk_messageBox -icon error -title [mc Error] -message $err
3409 } else {
3410 puts stderr $err
3411 }
3412 exit 1
3413 }
3414 }
3415 set current_branch $head
3416 }
3417
3418 wm deiconify .
3419 switch -- $subcommand {
3420 browser {
3421 if {$jump_spec ne {}} usage
3422 if {$head eq {}} {
3423 if {$path ne {} && [file isdirectory $path]} {
3424 set head $current_branch
3425 } else {
3426 set head $path
3427 set path {}
3428 }
3429 }
3430 browser::new $head $path
3431 }
3432 blame {
3433 if {$head eq {} && ![file exists $path]} {
3434 catch {wm withdraw .}
3435 tk_messageBox \
3436 -icon error \
3437 -type ok \
3438 -title [mc "git-gui: fatal error"] \
3439 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3440 exit 1
3441 }
3442 blame::new $head $path $jump_spec
3443 }
3444 }
3445 return
3446 }
3447 grep {
3448 wm deiconify .
3449 ::grep::new {*}$argv
3450 return
3451 }
3452 citool -
3453 gui {
3454 if {[llength $argv] != 0} {
3455 usage
3456 }
3457 # fall through to setup UI for commits
3458 }
3459 default {
3460 set err "usage: $argv0 \[{blame|browser|citool|grep}\]"
3461 if {[tk windowingsystem] eq "win32"} {
3462 wm withdraw .
3463 tk_messageBox -icon error -message $err \
3464 -title [mc "Usage"]
3465 } else {
3466 puts stderr $err
3467 }
3468 exit 1
3469 }
3470 }
3471
3472 # -- Branch Control
3473 #
3474 ${NS}::frame .branch
3475 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3476 ${NS}::label .branch.l1 \
3477 -text [mc "Current Branch:"] \
3478 -anchor w \
3479 -justify left
3480 ${NS}::label .branch.cb \
3481 -textvariable current_branch \
3482 -anchor w \
3483 -justify left
3484 pack .branch.l1 -side left
3485 pack .branch.cb -side left -fill x
3486 pack .branch -side top -fill x
3487
3488 # -- Main Window Layout
3489 #
3490 ${NS}::notebook .nb
3491 pack .nb -anchor n -side top -fill both -expand 1
3492
3493 proc select_next_tab {which} {
3494 set tabs [.nb tabs]
3495 set n_tabs [llength $tabs]
3496 set current [.nb select]
3497 set next [lsearch -exact $tabs $current]
3498 set next [expr $next + $which]
3499 if {$next eq $n_tabs} {
3500 set next 0
3501 } elseif {$next eq -1} {
3502 set next [expr $n_tabs - 1]
3503 }
3504 set next [lindex $tabs $next]
3505 .nb select $next
3506 focus $next
3507 }
3508
3509 proc close_blame_tab {} {
3510 set c [.nb select]
3511 if {[string match {.nb.blame*} $c]} {
3512 .nb forget $c
3513 }
3514 }
3515
3516 bind all <$M1B-Prior> "select_next_tab -1; break"
3517 bind all <$M1B-Next> "select_next_tab 1; break"
3518
3519 # -- Commit tab
3520 #
3521 ${NS}::panedwindow .vpane -orient horizontal
3522 .nb add .vpane -text [mc Commit@@verb]
3523
3524 ${NS}::panedwindow .vpane.files -orient vertical
3525 if {$use_ttk} {
3526 .vpane add .vpane.files -weight 0
3527 } else {
3528 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3529 }
3530
3531
3532 # -- Index File List
3533 #
3534 ${NS}::frame .vpane.files.index -height 100 -width 200
3535 tlabel .vpane.files.index.title \
3536 -text [mc "Staged Changes (Will Commit)"] \
3537 -background lightgreen -foreground black
3538 text $ui_index -background white -foreground black \
3539 -borderwidth 0 \
3540 -width 20 -height 10 \
3541 -wrap none \
3542 -cursor $cursor_ptr \
3543 -xscrollcommand {.vpane.files.index.sx set} \
3544 -yscrollcommand {.vpane.files.index.sy set} \
3545 -state disabled
3546 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3547 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3548 pack .vpane.files.index.title -side top -fill x
3549 pack .vpane.files.index.sx -side bottom -fill x
3550 pack .vpane.files.index.sy -side right -fill y
3551 pack $ui_index -side left -fill both -expand 1
3552
3553 # -- Working Directory File List
3554 #
3555 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3556 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3557 -background lightsalmon -foreground black
3558 text $ui_workdir -background white -foreground black \
3559 -borderwidth 0 \
3560 -width 20 -height 10 \
3561 -wrap none \
3562 -cursor $cursor_ptr \
3563 -xscrollcommand {.vpane.files.workdir.sx set} \
3564 -yscrollcommand {.vpane.files.workdir.sy set} \
3565 -state disabled
3566 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3567 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3568 pack .vpane.files.workdir.title -side top -fill x
3569 pack .vpane.files.workdir.sx -side bottom -fill x
3570 pack .vpane.files.workdir.sy -side right -fill y
3571 pack $ui_workdir -side left -fill both -expand 1
3572
3573 if {$use_ttk} {
3574 .vpane.files add .vpane.files.workdir -weight 1
3575 .vpane.files add .vpane.files.index -weight 1
3576 } else {
3577 .vpane.files add .vpane.files.workdir -sticky news
3578 .vpane.files add .vpane.files.index -sticky news
3579 }
3580
3581 foreach i [list $ui_index $ui_workdir] {
3582 rmsel_tag $i
3583 $i tag conf in_diff -background [$i tag cget in_sel -background]
3584 #$i tag conf in_diff -underline 1
3585 #$i tag conf in_sel -background {#c6e2ff} -font font_diffitalic
3586 $i tag conf in_sel -background [$i cget -background] -underline 1
3587 }
3588 unset i
3589
3590 set files_ctxm .vpane.files.ctxm
3591 menu $files_ctxm -tearoff 0
3592 $files_ctxm add separator
3593 $files_ctxm add command \
3594 -label [mc "Open in Editor"] \
3595 -command {open_from_file_list $current_diff_side $cursorX $cursorY}
3596 $files_ctxm add command \
3597 -label [mc "Stage All Changed"] \
3598 -command do_add_all
3599 $files_ctxm add command \
3600 -label [mc "Stage Selected"] \
3601 -command do_add_selection
3602 $files_ctxm add command \
3603 -label [mc "Blame in new Tab"] \
3604 -command {blame_from_file_list $current_diff_side $cursorX $cursorY}
3605 if {[array names repo_config guitool.*.cmd] ne {}} {
3606 files_tools_populate_all 5 popup_path
3607 }
3608
3609
3610 # -- Diff and Commit Area
3611 #
3612 if {$have_tk85} {
3613 ${NS}::panedwindow .vpane.lower -orient vertical
3614 ${NS}::frame .vpane.lower.commarea
3615 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1 -height 500
3616 .vpane.lower add .vpane.lower.diff
3617 .vpane.lower add .vpane.lower.commarea
3618 .vpane add .vpane.lower
3619 if {$use_ttk} {
3620 .vpane.lower pane .vpane.lower.diff -weight 1
3621 .vpane.lower pane .vpane.lower.commarea -weight 0
3622 } else {
3623 .vpane.lower paneconfigure .vpane.lower.diff -stretch always
3624 .vpane.lower paneconfigure .vpane.lower.commarea -stretch never
3625 }
3626 } else {
3627 frame .vpane.lower -height 300 -width 400
3628 frame .vpane.lower.commarea
3629 frame .vpane.lower.diff -relief sunken -borderwidth 1
3630 pack .vpane.lower.diff -fill both -expand 1
3631 pack .vpane.lower.commarea -side bottom -fill x
3632 .vpane add .vpane.lower
3633 .vpane paneconfigure .vpane.lower -sticky nsew
3634 }
3635
3636 # -- Commit Area Buttons
3637 #
3638 ${NS}::frame .vpane.lower.commarea.buttons
3639 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3640 -anchor w \
3641 -justify left
3642 pack .vpane.lower.commarea.buttons.l -side top -fill x
3643 pack .vpane.lower.commarea.buttons -side left -fill y
3644
3645 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3646 -command ui_do_rescan
3647 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3648 lappend disable_on_lock \
3649 {.vpane.lower.commarea.buttons.rescan conf -state}
3650
3651 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3652 -command do_add_all
3653 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3654 lappend disable_on_lock \
3655 {.vpane.lower.commarea.buttons.incall conf -state}
3656
3657 if {![is_enabled nocommitmsg]} {
3658 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3659 -command do_signoff
3660 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3661 }
3662
3663 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3664 -command do_commit
3665 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3666 lappend disable_on_lock \
3667 {.vpane.lower.commarea.buttons.commit conf -state}
3668
3669 if {![is_enabled nocommit]} {
3670 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3671 -command do_push_anywhere
3672 pack .vpane.lower.commarea.buttons.push -side top -fill x
3673 }
3674
3675 # -- Commit Message Buffer
3676 #
3677 ${NS}::frame .vpane.lower.commarea.buffer
3678 ${NS}::frame .vpane.lower.commarea.buffer.header
3679 set ui_comm .vpane.lower.commarea.buffer.t
3680 set ui_coml .vpane.lower.commarea.buffer.header.l
3681
3682 proc ignore_yscrollcommand {top bottom} {}
3683
3684 proc update_show_line_numbers {} {
3685 global ui_diff_alnos ui_diff_blnos ui_diff_clnos
3686 global diff_show_line_numbers is_3way_diff is_other_diff
3687 global ui_diff ui_diff_columns ui_diff_columns_to_scroll
3688
3689 # remember current sscroll position
3690 set current_pos [.vpane.lower.diff.body.sby get]
3691
3692 # remove all line number columns
3693 grid remove $ui_diff_alnos $ui_diff_blnos $ui_diff_clnos
3694 set ui_diff_columns_to_scroll [list $ui_diff]
3695 foreach i $ui_diff_columns {
3696 $i conf -yscrollcommand {}
3697 }
3698
3699 if {$diff_show_line_numbers} {
3700 if {!$is_other_diff} {
3701 grid configure $ui_diff_alnos
3702 lappend ui_diff_columns_to_scroll $ui_diff_alnos
3703 }
3704 grid configure $ui_diff_blnos
3705 lappend ui_diff_columns_to_scroll $ui_diff_blnos
3706 if {$is_3way_diff} {
3707 grid configure $ui_diff_clnos
3708 lappend ui_diff_columns_to_scroll $ui_diff_clnos
3709 }
3710 }
3711
3712 foreach i $ui_diff_columns_to_scroll {
3713 $i conf -yscrollcommand \
3714 "[list many2scrollbar $ui_diff_columns_to_scroll yview .vpane.lower.diff.body.sby]"
3715 }
3716 .vpane.lower.diff.body.sby conf \
3717 -command [list scrollbar2many $ui_diff_columns_to_scroll yview]
3718
3719 # restore current scroll position
3720 many2scrollbar $ui_diff_columns_to_scroll yview .vpane.lower.diff.body.sby [lindex $current_pos 0] [lindex $current_pos 1]
3721 }
3722
3723 if {![is_enabled nocommit]} {
3724 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3725 -text [mc "New Commit"] \
3726 -command do_select_commit_type \
3727 -variable selected_commit_type \
3728 -value new
3729 lappend disable_on_lock \
3730 [list .vpane.lower.commarea.buffer.header.new conf -state]
3731 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3732 -text [mc "Amend Last Commit"] \
3733 -command do_select_commit_type \
3734 -variable selected_commit_type \
3735 -value amend
3736 lappend disable_on_lock \
3737 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3738 }
3739
3740 ${NS}::label $ui_coml \
3741 -anchor w \
3742 -justify left
3743 proc trace_commit_type {varname args} {
3744 global ui_coml commit_type
3745 switch -glob -- $commit_type {
3746 initial {set txt [mc "Initial Commit Message:"]}
3747 amend {set txt [mc "Amended Commit Message:"]}
3748 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3749 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3750 merge {set txt [mc "Merge Commit Message:"]}
3751 * {set txt [mc "Commit Message:"]}
3752 }
3753 $ui_coml conf -text $txt
3754 }
3755 trace add variable commit_type write trace_commit_type
3756 pack $ui_coml -side left -fill x
3757
3758 if {![is_enabled nocommit]} {
3759 pack .vpane.lower.commarea.buffer.header.amend -side right
3760 pack .vpane.lower.commarea.buffer.header.new -side right
3761 }
3762
3763 text $ui_comm -background white -foreground black \
3764 -borderwidth 1 \
3765 -undo true \
3766 -maxundo 20 \
3767 -autoseparators true \
3768 -relief sunken \
3769 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3770 -font font_diff \
3771 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3772 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3773 -command [list $ui_comm yview]
3774 pack .vpane.lower.commarea.buffer.header -side top -fill x
3775 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3776 pack $ui_comm -side left -fill y
3777 pack .vpane.lower.commarea.buffer -side left -fill y
3778
3779 # -- Commit Message Buffer Context Menu
3780 #
3781 set ui_comm_ctxm .vpane.lower.commarea.buffer.ctxm
3782 menu $ui_comm_ctxm -tearoff 0
3783 $ui_comm_ctxm add command \
3784 -label [mc Cut] \
3785 -command {tk_textCut $ui_comm}
3786 $ui_comm_ctxm add command \
3787 -label [mc Copy] \
3788 -command {tk_textCopy $ui_comm}
3789 $ui_comm_ctxm add command \
3790 -label [mc Paste] \
3791 -command {tk_textPaste $ui_comm}
3792 $ui_comm_ctxm add command \
3793 -label [mc Delete] \
3794 -command {catch {$ui_comm delete sel.first sel.last}}
3795 $ui_comm_ctxm add separator
3796 $ui_comm_ctxm add command \
3797 -label [mc "Select All"] \
3798 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3799 $ui_comm_ctxm add command \
3800 -label [mc "Copy All"] \
3801 -command {
3802 $ui_comm tag add sel 0.0 end
3803 tk_textCopy $ui_comm
3804 $ui_comm tag remove sel 0.0 end
3805 }
3806 $ui_comm_ctxm add separator
3807 $ui_comm_ctxm add command \
3808 -label [mc "Sign Off"] \
3809 -command do_signoff
3810
3811 # -- Diff Header
3812 #
3813 proc trace_current_diff_path {varname args} {
3814 global current_diff_path diff_actions file_states
3815 if {$current_diff_path eq {}} {
3816 set s {}
3817 set f {}
3818 set p {}
3819 set o disabled
3820 } else {
3821 set p $current_diff_path
3822 set s [mapdesc [lindex $file_states($p) 0] $p]
3823 set f [mc "File:"]
3824 set p [escape_path $p]
3825 set o normal
3826 }
3827
3828 .vpane.lower.diff.header.status configure -text $s
3829 .vpane.lower.diff.header.file configure -text $f
3830 .vpane.lower.diff.header.path configure -text $p
3831 foreach w $diff_actions {
3832 uplevel #0 $w $o
3833 }
3834 }
3835 trace add variable current_diff_path write trace_current_diff_path
3836
3837 gold_frame .vpane.lower.diff.header
3838 tlabel .vpane.lower.diff.header.status \
3839 -background gold \
3840 -foreground black \
3841 -anchor w \
3842 -justify left
3843 tlabel .vpane.lower.diff.header.file \
3844 -background gold \
3845 -foreground black \
3846 -anchor w \
3847 -justify left
3848 tlabel .vpane.lower.diff.header.path \
3849 -background gold \
3850 -foreground black \
3851 -anchor w \
3852 -justify left
3853 pack .vpane.lower.diff.header.status -side left
3854 pack .vpane.lower.diff.header.path -side right -fill x
3855 pack .vpane.lower.diff.header.file -side right
3856 set hctxm .vpane.lower.diff.header.ctxm
3857 menu $hctxm -tearoff 0
3858 $hctxm add command \
3859 -label [mc Copy] \
3860 -command {
3861 clipboard clear
3862 clipboard append \
3863 -format STRING \
3864 -type STRING \
3865 -- $current_diff_path
3866 }
3867 lappend diff_actions [list $hctxm entryconf [$hctxm index last] -state]
3868 bind_button3 .vpane.lower.diff.header.path "tk_popup $hctxm %X %Y"
3869
3870 # -- Diff Body
3871 #
3872 ${NS}::frame .vpane.lower.diff.body
3873 set ui_diff .vpane.lower.diff.body.t
3874 # for 3way merges
3875 set ui_diff_clnos .vpane.lower.diff.body.c
3876 # - lines
3877 set ui_diff_alnos .vpane.lower.diff.body.a
3878 # + lines
3879 set ui_diff_blnos .vpane.lower.diff.body.b
3880
3881 set ui_diff_lno_col_width 2
3882
3883 text $ui_diff_alnos \
3884 -takefocus 0 \
3885 -highlightthickness 0 \
3886 -padx 0 -pady 0 \
3887 -background grey90 \
3888 -foreground black \
3889 -borderwidth 0 \
3890 -width [expr $ui_diff_lno_col_width + 2] \
3891 -height 5 \
3892 -wrap none \
3893 -font font_diff \
3894 -state disabled
3895 $ui_diff_alnos tag conf linenumber -justify right -rmargin 5
3896 $ui_diff_alnos tag conf red -foreground red
3897 $ui_diff_alnos tag conf green -foreground green4
3898
3899 text $ui_diff_blnos \
3900 -takefocus 0 \
3901 -highlightthickness 0 \
3902 -padx 0 -pady 0 \
3903 -background grey95 \
3904 -foreground black \
3905 -borderwidth 0 \
3906 -width [expr $ui_diff_lno_col_width + 2] \
3907 -height 5 \
3908 -wrap none \
3909 -font font_diff \
3910 -state disabled
3911 $ui_diff_blnos tag conf linenumber -justify right -rmargin 5
3912 $ui_diff_blnos tag conf red -foreground red
3913 $ui_diff_blnos tag conf green -foreground green4
3914 $ui_diff_blnos tag conf hide -elide 1
3915
3916 text $ui_diff_clnos \
3917 -takefocus 0 \
3918 -highlightthickness 0 \
3919 -padx 0 -pady 0 \
3920 -background grey90 \
3921 -foreground black \
3922 -borderwidth 0 \
3923 -width [expr $ui_diff_lno_col_width + 2] \
3924 -height 5 \
3925 -wrap none \
3926 -font font_diff \
3927 -state disabled
3928 $ui_diff_clnos tag conf linenumber -justify right -rmargin 5
3929 $ui_diff_clnos tag conf red -foreground red
3930 $ui_diff_clnos tag conf green -foreground green4
3931
3932 delegate_sel_to $ui_diff [list $ui_diff_alnos $ui_diff_blnos $ui_diff_clnos]
3933
3934 text $ui_diff \
3935 -highlightthickness 0 \
3936 -padx 0 -pady 0 \
3937 -background white \
3938 -foreground black \
3939 -borderwidth 0 \
3940 -width 80 -height 5 \
3941 -wrap none \
3942 -font font_diff \
3943 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3944 -state disabled
3945 catch {$ui_diff configure -tabstyle wordprocessor}
3946
3947 set ui_diff_columns [list $ui_diff_alnos $ui_diff_blnos $ui_diff $ui_diff_clnos]
3948 set ui_diff_line_columns [list $ui_diff_alnos $ui_diff_blnos $ui_diff_clnos]
3949 set ui_diff_columns_to_scroll $ui_diff_columns
3950
3951 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3952 -command [list $ui_diff xview]
3953 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3954 -command [list scrollbar2many $ui_diff_columns_to_scroll yview]
3955
3956 grid $ui_diff_alnos $ui_diff_blnos $ui_diff_clnos $ui_diff .vpane.lower.diff.body.sby -sticky nsew
3957 grid conf .vpane.lower.diff.body.sbx \
3958 -column 0 \
3959 -sticky we \
3960 -columnspan 5
3961 grid columnconfigure .vpane.lower.diff.body \
3962 3 \
3963 -weight 1
3964 grid rowconfigure .vpane.lower.diff.body \
3965 0 \
3966 -weight 1
3967
3968 update_show_line_numbers
3969
3970 pack .vpane.lower.diff.header -side top -fill x
3971 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3972
3973
3974 foreach {n c} {0 black 1 red 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3975 $ui_diff tag configure clr4$n -background $c
3976 $ui_diff tag configure clri4$n -foreground $c
3977 $ui_diff tag configure clr3$n -foreground $c
3978 $ui_diff tag configure clri3$n -background $c
3979 }
3980 $ui_diff tag configure clr1 -font font_diffbold
3981 $ui_diff tag configure clr4 -underline 1
3982
3983 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3984
3985 $ui_diff tag conf d_cr -elide true
3986 $ui_diff tag conf d_@ -font font_diffbold
3987 $ui_diff tag conf d_+ -foreground green4
3988 $ui_diff tag conf d_- -foreground red
3989
3990 $ui_diff tag conf d_++ -foreground green4
3991 $ui_diff tag conf d_-- -foreground red
3992 $ui_diff tag conf d_+s \
3993 -foreground green4 \
3994 -background {#e2effa}
3995 $ui_diff tag conf d_-s \
3996 -foreground red \
3997 -background {#e2effa}
3998 $ui_diff tag conf d_s+ \
3999 -foreground green4 \
4000 -background ivory1
4001 $ui_diff tag conf d_s- \
4002 -foreground red \
4003 -background ivory1
4004
4005 $ui_diff tag conf d< \
4006 -foreground orange \
4007 -font font_diffbold
4008 $ui_diff tag conf d| \
4009 -foreground orange \
4010 -font font_diffbold
4011 $ui_diff tag conf d= \
4012 -foreground orange \
4013 -font font_diffbold
4014 $ui_diff tag conf d> \
4015 -foreground orange \
4016 -font font_diffbold
4017
4018 foreach i $ui_diff_columns {
4019 $i tag raise sel
4020 }
4021
4022 # -- Diff Body Context Menu
4023 #
4024
4025 proc create_common_diff_popup {ctxm} {
4026 $ctxm add command \
4027 -label [mc Refresh] \
4028 -command reshow_diff
4029 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4030 $ctxm add command \
4031 -label [mc Copy] \
4032 -command {tk_textCopy $ui_diff}
4033 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4034 $ctxm add command \
4035 -label [mc "Select All"] \
4036 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4037 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4038 $ctxm add command \
4039 -label [mc "Copy All"] \
4040 -command {
4041 $ui_diff tag add sel 0.0 end
4042 tk_textCopy $ui_diff
4043 $ui_diff tag remove sel 0.0 end
4044 }
4045 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4046 $ctxm add separator
4047 $ctxm add command \
4048 -label [mc "Decrease Font Size"] \
4049 -command {incr_font_size font_diff -1}
4050 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4051 $ctxm add command \
4052 -label [mc "Increase Font Size"] \
4053 -command {incr_font_size font_diff 1}
4054 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4055 $ctxm add separator
4056 set emenu $ctxm.enc
4057 menu $emenu
4058 build_encoding_menu $emenu [list force_diff_encoding]
4059 $ctxm add cascade \
4060 -label [mc "Encoding"] \
4061 -menu $emenu
4062 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4063 $ctxm add separator
4064 $ctxm add command -label [mc "Options..."] \
4065 -command do_options
4066 }
4067
4068 set ctxmw .vpane.lower.diff.body.ctxmw
4069 menu $ctxmw -tearoff 0
4070 $ctxmw add command \
4071 -label [mc "Apply/Reverse Hunk"] \
4072 -command {apply_hunk $cursorX $cursorY}
4073 set ui_diff_applyhunk [$ctxmw index last]
4074 lappend diff_actions [list $ctxmw entryconf $ui_diff_applyhunk -state]
4075 $ctxmw add command \
4076 -label [mc "Apply/Reverse Line"] \
4077 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
4078 set ui_diff_applyline [$ctxmw index last]
4079 lappend diff_actions [list $ctxmw entryconf $ui_diff_applyline -state]
4080 $ctxmw add separator
4081 $ctxmw add command \
4082 -label [mc "Revert Hunk"] \
4083 -command {apply_hunk $cursorX $cursorY 1}
4084 lappend diff_actions [list $ctxmw entryconf $ui_diff_applyhunk -state]
4085 $ctxmw add command \
4086 -label [mc "Revert Line"] \
4087 -command {apply_range_or_line $cursorX $cursorY 1; do_rescan}
4088 set ui_diff_revertline [$ctxmw index last]
4089 lappend diff_actions [list $ctxmw entryconf $ui_diff_applyline -state]
4090 $ctxmw add separator
4091 $ctxmw add command \
4092 -label [mc "Open in Editor"] \
4093 -command {open_from_diff_view $cursorX $cursorY}
4094 lappend diff_actions [list $ctxmw entryconf [$ctxmw index last] -state]
4095 $ctxmw add command \
4096 -label [mc "Show Less Context"] \
4097 -command show_less_context
4098 lappend diff_actions [list $ctxmw entryconf [$ctxmw index last] -state]
4099 $ctxmw add command \
4100 -label [mc "Show More Context"] \
4101 -command show_more_context
4102 lappend diff_actions [list $ctxmw entryconf [$ctxmw index last] -state]
4103 $ctxmw add checkbutton \
4104 -label [mc "Show Line Numbers"] \
4105 -command update_show_line_numbers \
4106 -variable diff_show_line_numbers
4107 $ctxmw add separator
4108 create_common_diff_popup $ctxmw
4109
4110 set ctxmi .vpane.lower.diff.body.ctxmi
4111 menu $ctxmi -tearoff 0
4112 $ctxmi add command \
4113 -label [mc "Apply/Reverse Hunk"] \
4114 -command {apply_hunk $cursorX $cursorY}
4115 lappend diff_actions [list $ctxmi entryconf $ui_diff_applyhunk -state]
4116 $ctxmi add command \
4117 -label [mc "Apply/Reverse Line"] \
4118 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
4119 lappend diff_actions [list $ctxmi entryconf $ui_diff_applyline -state]
4120 $ctxmi add separator
4121 $ctxmi add command \
4122 -label [mc "Open in Editor"] \
4123 -command {open_from_diff_view $cursorX $cursorY}
4124 lappend diff_actions [list $ctxmi entryconf [$ctxmi index last] -state]
4125 $ctxmi add command \
4126 -label [mc "Open Staged Content in Editor"] \
4127 -command {open_from_diff_view $cursorX $cursorY 1}
4128 lappend diff_actions [list $ctxmi entryconf [$ctxmi index last] -state]
4129 $ctxmi add command \
4130 -label [mc "Show Less Context"] \
4131 -command show_less_context
4132 lappend diff_actions [list $ctxmi entryconf [$ctxmi index last] -state]
4133 $ctxmi add command \
4134 -label [mc "Show More Context"] \
4135 -command show_more_context
4136 lappend diff_actions [list $ctxmi entryconf [$ctxmi index last] -state]
4137 $ctxmi add checkbutton \
4138 -label [mc "Show Line Numbers"] \
4139 -command update_show_line_numbers \
4140 -variable diff_show_line_numbers
4141 $ctxmi add separator
4142 create_common_diff_popup $ctxmi
4143
4144 set ctxmmg .vpane.lower.diff.body.ctxmmg
4145 menu $ctxmmg -tearoff 0
4146 $ctxmmg add command \
4147 -label [mc "Run Merge Tool"] \
4148 -command {merge_resolve_tool}
4149 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4150 $ctxmmg add separator
4151 $ctxmmg add command \
4152 -label [mc "Use Remote Version"] \
4153 -command {merge_resolve_one 3}
4154 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4155 $ctxmmg add command \
4156 -label [mc "Use Local Version"] \
4157 -command {merge_resolve_one 2}
4158 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4159 $ctxmmg add command \
4160 -label [mc "Revert To Base"] \
4161 -command {merge_resolve_one 1}
4162 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4163 $ctxmmg add separator
4164 $ctxmmg add command \
4165 -label [mc "Open in Editor"] \
4166 -command {open_from_diff_view $cursorX $cursorY}
4167 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4168 $ctxmmg add command \
4169 -label [mc "Show Less Context"] \
4170 -command show_less_context
4171 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4172 $ctxmmg add command \
4173 -label [mc "Show More Context"] \
4174 -command show_more_context
4175 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4176 $ctxmmg add checkbutton \
4177 -label [mc "Show Line Numbers"] \
4178 -command update_show_line_numbers \
4179 -variable diff_show_line_numbers
4180 $ctxmmg add separator
4181 create_common_diff_popup $ctxmmg
4182
4183 set ctxmsm .vpane.lower.diff.body.ctxmsm
4184 menu $ctxmsm -tearoff 0
4185 $ctxmsm add command \
4186 -label [mc "Visualize These Changes In The Submodule"] \
4187 -command {do_gitk -- true}
4188 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
4189 $ctxmsm add command \
4190 -label [mc "Visualize Current Branch History In The Submodule"] \
4191 -command {do_gitk {} true}
4192 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
4193 $ctxmsm add command \
4194 -label [mc "Visualize All Branch History In The Submodule"] \
4195 -command {do_gitk --all true}
4196 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
4197 $ctxmsm add separator
4198 $ctxmsm add command \
4199 -label [mc "Start git gui In The Submodule"] \
4200 -command {do_git_gui}
4201 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
4202 $ctxmsm add separator
4203 create_common_diff_popup $ctxmsm
4204
4205 proc has_textconv {path} {
4206 if {[is_config_false gui.textconv]} {
4207 return 0
4208 }
4209 set filter [gitattr $path diff set]
4210 set textconv [get_config [join [list diff $filter textconv] .]]
4211 if {$filter ne {set} && $textconv ne {}} {
4212 return 1
4213 } else {
4214 return 0
4215 }
4216 }
4217
4218 proc popup_diff_menu {ctxmw ctxmi ctxmmg ctxmsm x y X Y} {
4219 global current_diff_path file_states
4220 set ::cursorX $x
4221 set ::cursorY $y
4222 if {[info exists file_states($current_diff_path)]} {
4223 set state [lindex $file_states($current_diff_path) 0]
4224 } else {
4225 set state {__}
4226 }
4227 if {[string first {U} $state] >= 0} {
4228 tk_popup $ctxmmg $X $Y
4229 } elseif {$::is_submodule_diff} {
4230 tk_popup $ctxmsm $X $Y
4231 } else {
4232 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
4233 if {$::ui_index eq $::current_diff_side} {
4234 set ctxm $ctxmi
4235 set l [mc "Unstage Hunk From Commit"]
4236 if {$has_range} {
4237 set t [mc "Unstage Lines From Commit"]
4238 } else {
4239 set t [mc "Unstage Line From Commit"]
4240 }
4241 } else {
4242 set ctxm $ctxmw
4243 set l [mc "Stage Hunk For Commit"]
4244 if {$has_range} {
4245 set t [mc "Stage Lines For Commit"]
4246 set r [mc "Revert Lines"]
4247 } else {
4248 set t [mc "Stage Line For Commit"]
4249 set r [mc "Revert Line"]
4250 }
4251 }
4252 if {$::is_3way_diff
4253 || $current_diff_path eq {}
4254 || {__} eq $state
4255 || {_O} eq $state
4256 || [string match {?T} $state]
4257 || [string match {T?} $state]
4258 || [has_textconv $current_diff_path]} {
4259 set s disabled
4260 } else {
4261 set s normal
4262 }
4263 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
4264 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
4265 if {$::ui_workdir eq $::current_diff_side} {
4266 $ctxm entryconf $::ui_diff_revertline -state $s -label $r
4267 }
4268 tk_popup $ctxm $X $Y
4269 }
4270 }
4271 bind_button3 $ui_diff [list popup_diff_menu $ctxmw $ctxmi $ctxmmg $ctxmsm %x %y %X %Y]
4272
4273 foreach i $ui_diff_columns {
4274 bind $i <ButtonRelease-2> {open_from_diff_view %x %y}
4275 bind $i <Shift-ButtonRelease-2> {open_from_diff_view %x %y 1}
4276 }
4277
4278 # -- Grep Tab
4279 #
4280 ${NS}::frame .nb.grep
4281 set ::grep_tab [::grep::embed .nb.grep]
4282 $::grep_tab link_vpane .vpane
4283 $::grep_tab reorder_bindtags
4284 .nb add .nb.grep -text [mc "Grep"]
4285 $::grep_tab grep
4286
4287 foreach i [list all $ui_diff] {
4288 bind $i <$M1B-Key-h> {
4289 .nb select .nb.grep
4290 focus .nb.grep
4291 $::grep_tab grep_from_selection
4292 }
4293 bind $i <$M1B-Key-H> {
4294 .nb select .nb.grep
4295 focus .nb.grep
4296 $::grep_tab grep_from_selection
4297 }
4298 }
4299
4300 # -- Build Tabs
4301 #
4302
4303 proc build_tab_state_change_cb {w build state} {
4304 if {$build eq {}} {
4305 set t "Build"
4306 } else {
4307 set t "Build: $build"
4308 }
4309 switch $state {
4310 idle -
4311 succeeded {
4312 .nb tab $w -text "$t"
4313 }
4314 running -
4315 loading -
4316 canceling -
4317 committing {
4318 .nb tab $w -text "?$t"
4319 }
4320 failed {
4321 .nb tab $w -text "!$t"
4322 }
4323 }
4324 }
4325
4326 if {[is_config_false gui.build.nodefault] == 1} {
4327 if {[catch {
4328 set w .nb.build
4329 ${NS}::frame $w
4330 set b [::build::embed \
4331 $w \
4332 [get_config gui.build.vpath .] \
4333 [get_config gui.build.ref default] \
4334 [get_config gui.build.shell] \
4335 [get_config gui.build.env [list]] \
4336 [get_config gui.build.config [list]] \
4337 [list build_tab_state_change_cb $w {}]]
4338 $b link_vpane .vpane
4339 $b reorder_bindtags
4340 unset b
4341 .nb add $w -text "Build"
4342 } err]} {
4343 tk_messageBox \
4344 -icon error \
4345 -type ok \
4346 -title "git-gui: error for default build tab" \
4347 -message $err
4348 }
4349 }
4350
4351 set ::build_count 0
4352 foreach build [get_config gui.build] {
4353 if {[catch {
4354 set w .nb.build[incr ::build_count]
4355 ${NS}::frame $w
4356 set b [::build::embed \
4357 $w \
4358 [get_config gui.build.$build.vpath .] \
4359 [get_config gui.build.$build.ref $build] \
4360 [get_config gui.build.$build.shell [get_config gui.build.shell]] \
4361 [concat [get_config gui.build.env [list]] \
4362 [get_config gui.build.$build.env [list]]] \
4363 [concat [get_config gui.build.config [list]] \
4364 [get_config gui.build.$build.config [list]]] \
4365 [list build_tab_state_change_cb $w $build]]
4366 $b link_vpane .vpane
4367 $b reorder_bindtags
4368 unset b
4369 .nb add $w -text "Build: $build"
4370 } err]} {
4371 tk_messageBox \
4372 -icon error \
4373 -type ok \
4374 -title "git-gui: error for build tab $build" \
4375 -message $err
4376 }
4377 }
4378 unset build_count
4379 catch {unset w}
4380
4381 # -- Browser Tab
4382 #
4383 ${NS}::frame .nb.browser
4384 set ::browser_tab [::full_browser::embed .nb.browser]
4385 $::browser_tab reorder_bindtags
4386 .nb add .nb.browser -text [mc "Browse"]
4387
4388 # -- Status Bar
4389 #
4390 set main_status [::status_bar::new .status]
4391 pack .status -anchor s -side bottom -fill x -before .nb
4392 $main_status show [mc "Initializing..."]
4393
4394 # -- Load geometry
4395 #
4396 proc on_ttk_pane_mapped {w pane pos} {
4397 bind $w <Map> {}
4398 after 0 [list after idle [list $w sashpos $pane $pos]]
4399 }
4400 proc on_tk_pane_mapped {w pane x y} {
4401 bind $w <Map> {}
4402 after 0 [list after idle [list $w sash place $pane $x $y]]
4403 }
4404 proc on_application_mapped {} {
4405 global repo_config use_ttk
4406 bind . <Map> {}
4407 set gm $repo_config(gui.geometry)
4408 if {$use_ttk} {
4409 bind .vpane <Map> \
4410 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
4411 bind .vpane.files <Map> \
4412 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
4413 } else {
4414 bind .vpane <Map> \
4415 [list on_tk_pane_mapped %W 0 \
4416 [lindex $gm 1] \
4417 [lindex [.vpane sash coord 0] 1]]
4418 bind .vpane.files <Map> \
4419 [list on_tk_pane_mapped %W 0 \
4420 [lindex [.vpane.files sash coord 0] 0] \
4421 [lindex $gm 2]]
4422 }
4423 wm geometry . [lindex $gm 0]
4424 }
4425 if {[info exists repo_config(gui.geometry)]} {
4426 bind . <Map> [list on_application_mapped]
4427 wm geometry . [lindex $repo_config(gui.geometry) 0]
4428 }
4429
4430 # -- Load window state
4431 #
4432 if {[info exists repo_config(gui.wmstate)]} {
4433 catch {wm state . $repo_config(gui.wmstate)}
4434 }
4435
4436 # -- Key Bindings
4437 #
4438 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4439 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
4440 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
4441 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
4442 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
4443 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
4444 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
4445 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4446 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4447 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4448 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4449 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4450 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4451 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4452 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4453 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4454 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4455 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
4456 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
4457 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
4458 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
4459 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
4460
4461 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4462 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4463 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4464 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4465 bind $ui_diff <$M1B-Key-v> {break}
4466 bind $ui_diff <$M1B-Key-V> {break}
4467 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4468 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4469 bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
4470 bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
4471 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
4472 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
4473 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
4474 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
4475 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
4476 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
4477 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
4478 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
4479 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
4480 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
4481 bind $ui_diff <Button-1> {focus %W}
4482
4483 if {[is_enabled branch]} {
4484 bind . <$M1B-Key-n> branch_create::dialog
4485 bind . <$M1B-Key-N> branch_create::dialog
4486 bind . <$M1B-Key-o> branch_checkout::dialog
4487 bind . <$M1B-Key-O> branch_checkout::dialog
4488 bind . <$M1B-Key-m> merge::dialog
4489 bind . <$M1B-Key-M> merge::dialog
4490 }
4491 if {[is_enabled transport]} {
4492 bind . <$M1B-Key-p> do_push_anywhere
4493 bind . <$M1B-Key-P> do_push_anywhere
4494 }
4495
4496 bind . <Key-F5> ui_do_rescan
4497 bind . <$M1B-Key-r> ui_do_rescan
4498 bind . <$M1B-Key-R> ui_do_rescan
4499 bind . <$M1B-Key-s> do_signoff
4500 bind . <$M1B-Key-S> do_signoff
4501 bind . <$M1B-Key-t> do_add_selection
4502 bind . <$M1B-Key-T> do_add_selection
4503 bind . <$M1B-Key-u> do_unstage_selection
4504 bind . <$M1B-Key-U> do_unstage_selection
4505 bind . <$M1B-Key-j> do_revert_selection
4506 bind . <$M1B-Key-J> do_revert_selection
4507 bind . <$M1B-Key-i> do_add_all
4508 bind . <$M1B-Key-I> do_add_all
4509 bind . <$M1B-Key-minus> {show_less_context;break}
4510 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
4511 bind . <$M1B-Key-equal> {show_more_context;break}
4512 bind . <$M1B-Key-plus> {show_more_context;break}
4513 bind . <$M1B-Key-KP_Add> {show_more_context;break}
4514 bind . <$M1B-Key-Return> do_commit
4515 foreach i [list $ui_index $ui_workdir] {
4516 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
4517 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
4518 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4519
4520 bind $i <ButtonRelease-2> "open_from_file_list $i %x %y; break"
4521 bind $i <Shift-ButtonRelease-2> "open_from_file_list $i %x %y 1; break"
4522
4523 bind $i <$M1B-ButtonRelease-2> "blame_from_file_list $i %x %y; break"
4524 }
4525
4526 if {[$files_ctxm index end] == 1} {
4527 # remove the separator, when we don't have user specified file tools
4528 $files_ctxm delete 0
4529 }
4530 bind_button3 $ui_index "popup_files_ctxm $files_ctxm $ui_index %x %y %X %Y; break"
4531 bind_button3 $ui_workdir "popup_files_ctxm $files_ctxm $ui_workdir %x %y %X %Y; break"
4532
4533 unset i
4534
4535 set file_lists($ui_index) [list]
4536 set file_lists($ui_workdir) [list]
4537
4538 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
4539 focus -force $ui_comm
4540
4541 # -- Warn the user about environmental problems. Cygwin's Tcl
4542 # does *not* pass its env array onto any processes it spawns.
4543 # This means that git processes get none of our environment.
4544 #
4545 if {[is_Cygwin]} {
4546 set ignored_env 0
4547 set suggest_user {}
4548 set msg [mc "Possible environment issues exist.
4549
4550 The following environment variables are probably
4551 going to be ignored by any Git subprocess run
4552 by %s:
4553
4554 " [appname]]
4555 foreach name [array names env] {
4556 switch -regexp -- $name {
4557 {^GIT_INDEX_FILE$} -
4558 {^GIT_OBJECT_DIRECTORY$} -
4559 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4560 {^GIT_DIFF_OPTS$} -
4561 {^GIT_EXTERNAL_DIFF$} -
4562 {^GIT_PAGER$} -
4563 {^GIT_TRACE$} -
4564 {^GIT_CONFIG$} -
4565 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4566 append msg " - $name\n"
4567 incr ignored_env
4568 }
4569 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4570 append msg " - $name\n"
4571 incr ignored_env
4572 set suggest_user $name
4573 }
4574 }
4575 }
4576 if {$ignored_env > 0} {
4577 append msg [mc "
4578 This is due to a known issue with the
4579 Tcl binary distributed by Cygwin."]
4580
4581 if {$suggest_user ne {}} {
4582 append msg [mc "
4583
4584 A good replacement for %s
4585 is placing values for the user.name and
4586 user.email settings into your personal
4587 ~/.gitconfig file.
4588 " $suggest_user]
4589 }
4590 warn_popup $msg
4591 }
4592 unset ignored_env msg suggest_user name
4593 }
4594
4595 # -- Only initialize complex UI if we are going to stay running.
4596 #
4597 if {[is_enabled transport]} {
4598 load_all_remotes
4599
4600 set n [.mbar.remote index end]
4601 populate_remotes_menu
4602 set n [expr {[.mbar.remote index end] - $n}]
4603 if {$n > 0} {
4604 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
4605 .mbar.remote insert $n separator
4606 }
4607 unset n
4608 }
4609
4610 if {[winfo exists $ui_comm]} {
4611 set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
4612
4613 # -- If both our backup and message files exist use the
4614 # newer of the two files to initialize the buffer.
4615 #
4616 if {$GITGUI_BCK_exists} {
4617 set m [gitdir GITGUI_MSG]
4618 if {[file isfile $m]} {
4619 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
4620 catch {file delete [gitdir GITGUI_MSG]}
4621 } else {
4622 $ui_comm delete 0.0 end
4623 $ui_comm edit reset
4624 $ui_comm edit modified false
4625 catch {file delete [gitdir GITGUI_BCK]}
4626 set GITGUI_BCK_exists 0
4627 }
4628 }
4629 unset m
4630 }
4631
4632 proc backup_commit_buffer {} {
4633 global ui_comm GITGUI_BCK_exists
4634
4635 set m [$ui_comm edit modified]
4636 if {$m || $GITGUI_BCK_exists} {
4637 set msg [string trim [$ui_comm get 0.0 end]]
4638 regsub -all -line {[ \r\t]+$} $msg {} msg
4639
4640 if {$msg eq {}} {
4641 if {$GITGUI_BCK_exists} {
4642 catch {file delete [gitdir GITGUI_BCK]}
4643 set GITGUI_BCK_exists 0
4644 }
4645 } elseif {$m} {
4646 catch {
4647 set fd [open [gitdir GITGUI_BCK] w]
4648 fconfigure $fd -encoding utf-8
4649 puts -nonewline $fd $msg
4650 close $fd
4651 set GITGUI_BCK_exists 1
4652 }
4653 }
4654
4655 $ui_comm edit modified false
4656 }
4657
4658 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
4659 }
4660
4661 backup_commit_buffer
4662
4663 # -- If the user has aspell available we can drive it
4664 # in pipe mode to spellcheck the commit message.
4665 #
4666 set spell_cmd [list |]
4667 set spell_dict [get_config gui.spellingdictionary]
4668 lappend spell_cmd aspell
4669 if {$spell_dict ne {}} {
4670 lappend spell_cmd --master=$spell_dict
4671 }
4672 lappend spell_cmd --mode=none
4673 lappend spell_cmd --encoding=utf-8
4674 lappend spell_cmd pipe
4675 if {$spell_dict eq {none}
4676 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
4677 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
4678 } else {
4679 set ui_comm_spell [spellcheck::init \
4680 $spell_fd \
4681 $ui_comm \
4682 $ui_comm_ctxm \
4683 ]
4684 }
4685 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
4686 }
4687
4688 lock_index begin-read
4689 if {![winfo ismapped .]} {
4690 wm deiconify .
4691 }
4692 after 1 {
4693 if {[is_enabled initialamend]} {
4694 force_amend
4695 } else {
4696 do_rescan
4697 }
4698
4699 if {[is_enabled nocommitmsg]} {
4700 $ui_comm configure -state disabled -background gray
4701 }
4702 }
4703 if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
4704 after 1000 hint_gc
4705 }
4706 if {[is_enabled retcode]} {
4707 bind . <Destroy> {+terminate_me %W}
4708 }
4709 if {$picked && [is_config_true gui.autoexplore]} {
4710 do_explore
4711 }
4712
4713 # Local variables:
4714 # mode: tcl
4715 # indent-tabs-mode: t
4716 # tab-width: 4
4717 # End: