git-gui: drop the 'n' and 'Shift-n' bindings from the last patch.
[git/dscho.git] / git-gui.sh
blobf8971603f77a495b253b5470f5546d51dd6efd14
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 wish "$argv0" -- "$@"
12 set appvers {@@GITGUI_VERSION@@}
13 set copyright [string map [list (c) \u00a9] {
14 Copyright (c) 2006-2010 Shawn Pearce, et. al.
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.
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.
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}]
30 ######################################################################
32 ## Tcl/Tk sanity check
34 if {[catch {package require Tcl 8.4} err]
35 || [catch {package require Tk 8.4} 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
46 catch {rename send {}} ; # What an evil concept...
48 ######################################################################
50 ## locate our library
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]
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]
68 unset oguirel
70 ######################################################################
72 ## enable verbose loading?
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]
81 rename source real__source
82 proc source {name} {
83 puts stderr "source $name"
84 uplevel 1 real__source $name
86 if {[tk windowingsystem] eq "win32"} { console show }
89 ######################################################################
91 ## Internationalization (i18n) through msgcat and gettext. See
92 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
94 package require msgcat
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
112 _mc_update_locale
115 proc _mc_trim {fmt} {
116 set cmk [string first @@ $fmt]
117 if {$cmk > 0} {
118 return [string range $fmt 0 [expr {$cmk - 1}]]
120 return $fmt
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]
128 return $msg
131 proc strcat {args} {
132 return [join $args {}]
135 ::msgcat::mcload $oguimsg
136 unset oguimsg
138 ######################################################################
140 ## read only globals
142 set _appname {Git Gui}
143 set _gitdir {}
144 set _gitworktree {}
145 set _isbare {}
146 set _gitexec {}
147 set _githtmldir {}
148 set _reponame {}
149 set _iscygwin {}
150 set _search_path {}
151 set _shellpath {@@SHELL_PATH@@}
153 set _trace [lsearch -exact $argv --trace]
154 if {$_trace >= 0} {
155 set argv [lreplace $argv $_trace $_trace]
156 set _trace 1
157 } else {
158 set _trace 0
161 # variable for the last merged branch (useful for a default when deleting
162 # branches).
163 set _last_merged_branch {}
165 proc shellpath {} {
166 global _shellpath env
167 if {[string match @@* $_shellpath]} {
168 if {[info exists env(SHELL)]} {
169 return $env(SHELL)
170 } else {
171 return /bin/sh
174 return $_shellpath
177 proc appname {} {
178 global _appname
179 return $_appname
182 proc gitdir {args} {
183 global _gitdir
184 if {$args eq {}} {
185 return $_gitdir
187 return [eval [list file join $_gitdir] $args]
190 proc gitexec {args} {
191 global _gitexec
192 if {$_gitexec eq {}} {
193 if {[catch {set _gitexec [git --exec-path]} err]} {
194 error "Git not installed?\n\n$err"
196 if {[is_Cygwin]} {
197 set _gitexec [exec cygpath \
198 --windows \
199 --absolute \
200 $_gitexec]
201 } else {
202 set _gitexec [file normalize $_gitexec]
205 if {$args eq {}} {
206 return $_gitexec
208 return [eval [list file join $_gitexec] $args]
211 proc githtmldir {args} {
212 global _githtmldir
213 if {$_githtmldir eq {}} {
214 if {[catch {set _githtmldir [git --html-path]}]} {
215 # Git not installed or option not yet supported
216 return {}
218 if {[is_Cygwin]} {
219 set _githtmldir [exec cygpath \
220 --windows \
221 --absolute \
222 $_githtmldir]
223 } else {
224 set _githtmldir [file normalize $_githtmldir]
227 if {$args eq {}} {
228 return $_githtmldir
230 return [eval [list file join $_githtmldir] $args]
233 proc reponame {} {
234 return $::_reponame
237 proc is_MacOSX {} {
238 if {[tk windowingsystem] eq {aqua}} {
239 return 1
241 return 0
244 proc is_Windows {} {
245 if {$::tcl_platform(platform) eq {windows}} {
246 return 1
248 return 0
251 proc is_Cygwin {} {
252 global _iscygwin
253 if {$_iscygwin eq {}} {
254 if {$::tcl_platform(platform) eq {windows}} {
255 if {[catch {set p [exec cygpath --windir]} err]} {
256 set _iscygwin 0
257 } else {
258 set _iscygwin 1
260 } else {
261 set _iscygwin 0
264 return $_iscygwin
267 proc is_enabled {option} {
268 global enabled_options
269 if {[catch {set on $enabled_options($option)}]} {return 0}
270 return $on
273 proc enable_option {option} {
274 global enabled_options
275 set enabled_options($option) 1
278 proc disable_option {option} {
279 global enabled_options
280 set enabled_options($option) 0
283 ######################################################################
285 ## config
287 proc is_many_config {name} {
288 switch -glob -- $name {
289 gui.recentrepo -
290 remote.*.fetch -
291 remote.*.push
292 {return 1}
294 {return 0}
298 proc is_config_true {name} {
299 global repo_config
300 if {[catch {set v $repo_config($name)}]} {
301 return 0
302 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
303 return 1
304 } else {
305 return 0
309 proc is_config_false {name} {
310 global repo_config
311 if {[catch {set v $repo_config($name)}]} {
312 return 0
313 } elseif {$v eq {false} || $v eq {0} || $v eq {no}} {
314 return 1
315 } else {
316 return 0
320 proc get_config {name} {
321 global repo_config
322 if {[catch {set v $repo_config($name)}]} {
323 return {}
324 } else {
325 return $v
329 proc is_bare {} {
330 global _isbare
331 global _gitdir
332 global _gitworktree
334 if {$_isbare eq {}} {
335 if {[catch {
336 set _bare [git rev-parse --is-bare-repository]
337 switch -- $_bare {
338 true { set _isbare 1 }
339 false { set _isbare 0}
340 default { throw }
342 }]} {
343 if {[is_config_true core.bare]
344 || ($_gitworktree eq {}
345 && [lindex [file split $_gitdir] end] ne {.git})} {
346 set _isbare 1
347 } else {
348 set _isbare 0
352 return $_isbare
355 ######################################################################
357 ## handy utils
359 proc _trace_exec {cmd} {
360 if {!$::_trace} return
361 set d {}
362 foreach v $cmd {
363 if {$d ne {}} {
364 append d { }
366 if {[regexp {[ \t\r\n'"$?*]} $v]} {
367 set v [sq $v]
369 append d $v
371 puts stderr $d
374 #'" fix poor old emacs font-lock mode
376 proc _git_cmd {name} {
377 global _git_cmd_path
379 if {[catch {set v $_git_cmd_path($name)}]} {
380 switch -- $name {
381 version -
382 --version -
383 --exec-path { return [list $::_git $name] }
386 set p [gitexec git-$name$::_search_exe]
387 if {[file exists $p]} {
388 set v [list $p]
389 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
390 # Try to determine what sort of magic will make
391 # git-$name go and do its thing, because native
392 # Tcl on Windows doesn't know it.
394 set p [gitexec git-$name]
395 set f [open $p r]
396 set s [gets $f]
397 close $f
399 switch -glob -- [lindex $s 0] {
400 #!*sh { set i sh }
401 #!*perl { set i perl }
402 #!*python { set i python }
403 default { error "git-$name is not supported: $s" }
406 upvar #0 _$i interp
407 if {![info exists interp]} {
408 set interp [_which $i]
410 if {$interp eq {}} {
411 error "git-$name requires $i (not in PATH)"
413 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
414 } else {
415 # Assume it is builtin to git somehow and we
416 # aren't actually able to see a file for it.
418 set v [list $::_git $name]
420 set _git_cmd_path($name) $v
422 return $v
425 proc _which {what args} {
426 global env _search_exe _search_path
428 if {$_search_path eq {}} {
429 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
430 set _search_path [split [exec cygpath \
431 --windows \
432 --path \
433 --absolute \
434 $env(PATH)] {;}]
435 set _search_exe .exe
436 } elseif {[is_Windows]} {
437 set gitguidir [file dirname [info script]]
438 regsub -all ";" $gitguidir "\\;" gitguidir
439 set env(PATH) "$gitguidir;$env(PATH)"
440 set _search_path [split $env(PATH) {;}]
441 set _search_exe .exe
442 } else {
443 set _search_path [split $env(PATH) :]
444 set _search_exe {}
448 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
449 set suffix {}
450 } else {
451 set suffix $_search_exe
454 foreach p $_search_path {
455 set p [file join $p $what$suffix]
456 if {[file exists $p]} {
457 return [file normalize $p]
460 return {}
463 proc _lappend_nice {cmd_var} {
464 global _nice
465 upvar $cmd_var cmd
467 if {![info exists _nice]} {
468 set _nice [_which nice]
469 if {[catch {exec $_nice git version}]} {
470 set _nice {}
471 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
472 set _nice {}
475 if {$_nice ne {}} {
476 lappend cmd $_nice
480 proc git {args} {
481 set opt [list]
483 while {1} {
484 switch -- [lindex $args 0] {
485 --nice {
486 _lappend_nice opt
489 default {
490 break
495 set args [lrange $args 1 end]
498 set cmdp [_git_cmd [lindex $args 0]]
499 set args [lrange $args 1 end]
501 _trace_exec [concat $opt $cmdp $args]
502 set result [eval exec $opt $cmdp $args]
503 if {$::_trace} {
504 puts stderr "< $result"
506 return $result
509 proc _open_stdout_stderr {cmd} {
510 _trace_exec $cmd
511 if {[catch {
512 set fd [open [concat [list | ] $cmd] r]
513 } err]} {
514 if { [lindex $cmd end] eq {2>@1}
515 && $err eq {can not find channel named "1"}
517 # Older versions of Tcl 8.4 don't have this 2>@1 IO
518 # redirect operator. Fallback to |& cat for those.
519 # The command was not actually started, so its safe
520 # to try to start it a second time.
522 set fd [open [concat \
523 [list | ] \
524 [lrange $cmd 0 end-1] \
525 [list |& cat] \
526 ] r]
527 } else {
528 error $err
531 fconfigure $fd -eofchar {}
532 return $fd
535 proc git_read {args} {
536 set opt [list]
538 while {1} {
539 switch -- [lindex $args 0] {
540 --nice {
541 _lappend_nice opt
544 --stderr {
545 lappend args 2>@1
548 default {
549 break
554 set args [lrange $args 1 end]
557 set cmdp [_git_cmd [lindex $args 0]]
558 set args [lrange $args 1 end]
560 return [_open_stdout_stderr [concat $opt $cmdp $args]]
563 proc git_write {args} {
564 set opt [list]
566 while {1} {
567 switch -- [lindex $args 0] {
568 --nice {
569 _lappend_nice opt
572 default {
573 break
578 set args [lrange $args 1 end]
581 set cmdp [_git_cmd [lindex $args 0]]
582 set args [lrange $args 1 end]
584 _trace_exec [concat $opt $cmdp $args]
585 return [open [concat [list | ] $opt $cmdp $args] w]
588 proc githook_read {hook_name args} {
589 set pchook [gitdir hooks $hook_name]
590 lappend args 2>@1
592 # On Windows [file executable] might lie so we need to ask
593 # the shell if the hook is executable. Yes that's annoying.
595 if {[is_Windows]} {
596 upvar #0 _sh interp
597 if {![info exists interp]} {
598 set interp [_which sh]
600 if {$interp eq {}} {
601 error "hook execution requires sh (not in PATH)"
604 set scr {if test -x "$1";then exec "$@";fi}
605 set sh_c [list $interp -c $scr $interp $pchook]
606 return [_open_stdout_stderr [concat $sh_c $args]]
609 if {[file executable $pchook]} {
610 return [_open_stdout_stderr [concat [list $pchook] $args]]
613 return {}
616 proc kill_file_process {fd} {
617 set process [pid $fd]
619 catch {
620 if {[is_Windows]} {
621 # Use a Cygwin-specific flag to allow killing
622 # native Windows processes
623 exec kill -f $process
624 } else {
625 exec kill $process
630 proc gitattr {path attr default} {
631 if {[catch {set r [git check-attr $attr -- $path]}]} {
632 set r unspecified
633 } else {
634 set r [join [lrange [split $r :] 2 end] :]
635 regsub {^ } $r {} r
637 if {$r eq {unspecified}} {
638 return $default
640 return $r
643 proc sq {value} {
644 regsub -all ' $value "'\\''" value
645 return "'$value'"
648 proc load_current_branch {} {
649 global current_branch is_detached
651 set fd [open [gitdir HEAD] r]
652 if {[gets $fd ref] < 1} {
653 set ref {}
655 close $fd
657 set pfx {ref: refs/heads/}
658 set len [string length $pfx]
659 if {[string equal -length $len $pfx $ref]} {
660 # We're on a branch. It might not exist. But
661 # HEAD looks good enough to be a branch.
663 set current_branch [string range $ref $len end]
664 set is_detached 0
665 } else {
666 # Assume this is a detached head.
668 set current_branch HEAD
669 set is_detached 1
673 auto_load tk_optionMenu
674 rename tk_optionMenu real__tkOptionMenu
675 proc tk_optionMenu {w varName args} {
676 set m [eval real__tkOptionMenu $w $varName $args]
677 $m configure -font font_ui
678 $w configure -font font_ui
679 return $m
682 proc rmsel_tag {text} {
683 $text tag conf sel \
684 -background [$text cget -background] \
685 -foreground [$text cget -foreground] \
686 -borderwidth 0
687 $text tag conf in_sel -background lightgray
688 bind $text <Motion> break
689 return $text
692 wm withdraw .
693 set root_exists 0
694 bind . <Visibility> {
695 bind . <Visibility> {}
696 set root_exists 1
699 if {[is_Windows]} {
700 wm iconbitmap . -default $oguilib/git-gui.ico
701 set ::tk::AlwaysShowSelection 1
702 bind . <Control-F2> {console show}
704 # Spoof an X11 display for SSH
705 if {![info exists env(DISPLAY)]} {
706 set env(DISPLAY) :9999
708 } else {
709 catch {
710 image create photo gitlogo -width 16 -height 16
712 gitlogo put #33CC33 -to 7 0 9 2
713 gitlogo put #33CC33 -to 4 2 12 4
714 gitlogo put #33CC33 -to 7 4 9 6
715 gitlogo put #CC3333 -to 4 6 12 8
716 gitlogo put gray26 -to 4 9 6 10
717 gitlogo put gray26 -to 3 10 6 12
718 gitlogo put gray26 -to 8 9 13 11
719 gitlogo put gray26 -to 8 11 10 12
720 gitlogo put gray26 -to 11 11 13 14
721 gitlogo put gray26 -to 3 12 5 14
722 gitlogo put gray26 -to 5 13
723 gitlogo put gray26 -to 10 13
724 gitlogo put gray26 -to 4 14 12 15
725 gitlogo put gray26 -to 5 15 11 16
726 gitlogo redither
728 wm iconphoto . -default gitlogo
732 ######################################################################
734 ## config defaults
736 set cursor_ptr arrow
737 font create font_ui
738 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
739 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
740 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
741 } else {
742 font create font_diff -family Courier -size 10
743 catch {
744 label .dummy
745 eval font configure font_ui [font actual [.dummy cget -font]]
746 destroy .dummy
750 font create font_uiitalic
751 font create font_uibold
752 font create font_diffbold
753 font create font_diffitalic
755 foreach class {Button Checkbutton Entry Label
756 Labelframe Listbox Message
757 Radiobutton Spinbox Text} {
758 option add *$class.font font_ui
760 if {![is_MacOSX]} {
761 option add *Menu.font font_ui
762 option add *Entry.borderWidth 1 startupFile
763 option add *Entry.relief sunken startupFile
764 option add *RadioButton.anchor w startupFile
766 unset class
768 if {[is_Windows] || [is_MacOSX]} {
769 option add *Menu.tearOff 0
772 if {[is_MacOSX]} {
773 set M1B M1
774 set M1T Cmd
775 } else {
776 set M1B Control
777 set M1T Ctrl
780 proc bind_button3 {w cmd} {
781 bind $w <Any-Button-3> $cmd
782 if {[is_MacOSX]} {
783 # Mac OS X sends Button-2 on right click through three-button mouse,
784 # or through trackpad right-clicking (two-finger touch + click).
785 bind $w <Any-Button-2> $cmd
786 bind $w <Control-Button-1> $cmd
790 proc apply_config {} {
791 global repo_config font_descs
793 foreach option $font_descs {
794 set name [lindex $option 0]
795 set font [lindex $option 1]
796 if {[catch {
797 set need_weight 1
798 foreach {cn cv} $repo_config(gui.$name) {
799 if {$cn eq {-weight}} {
800 set need_weight 0
802 font configure $font $cn $cv
804 if {$need_weight} {
805 font configure $font -weight normal
807 } err]} {
808 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
810 foreach {cn cv} [font configure $font] {
811 font configure ${font}bold $cn $cv
812 font configure ${font}italic $cn $cv
814 font configure ${font}bold -weight bold
815 font configure ${font}italic -slant italic
818 global use_ttk NS
819 set use_ttk 0
820 set NS {}
821 if {$repo_config(gui.usettk)} {
822 set use_ttk [package vsatisfies [package provide Tk] 8.5]
823 if {$use_ttk} {
824 set NS ttk
825 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
826 pave_toplevel .
831 set default_config(branch.autosetupmerge) true
832 set default_config(merge.tool) {}
833 set default_config(mergetool.keepbackup) true
834 set default_config(merge.diffstat) true
835 set default_config(merge.summary) false
836 set default_config(merge.verbosity) 2
837 set default_config(user.name) {}
838 set default_config(user.email) {}
840 set default_config(gui.encoding) [encoding system]
841 set default_config(gui.matchtrackingbranch) false
842 set default_config(gui.textconv) true
843 set default_config(gui.pruneduringfetch) false
844 set default_config(gui.trustmtime) false
845 set default_config(gui.fastcopyblame) false
846 set default_config(gui.copyblamethreshold) 40
847 set default_config(gui.blamehistoryctx) 7
848 set default_config(gui.diffcontext) 5
849 set default_config(gui.commitmsgwidth) 75
850 set default_config(gui.newbranchtemplate) {}
851 set default_config(gui.spellingdictionary) {}
852 set default_config(gui.fontui) [font configure font_ui]
853 set default_config(gui.fontdiff) [font configure font_diff]
854 # TODO: this option should be added to the git-config documentation
855 set default_config(gui.maxfilesdisplayed) 5000
856 set default_config(gui.usettk) 1
857 set default_config(gui.warndetachedcommit) 1
858 set font_descs {
859 {fontui font_ui {mc "Main Font"}}
860 {fontdiff font_diff {mc "Diff/Console Font"}}
863 ######################################################################
865 ## find git
867 set _git [_which git]
868 if {$_git eq {}} {
869 catch {wm withdraw .}
870 tk_messageBox \
871 -icon error \
872 -type ok \
873 -title [mc "git-gui: fatal error"] \
874 -message [mc "Cannot find git in PATH."]
875 exit 1
878 ######################################################################
880 ## version check
882 if {[catch {set _git_version [git --version]} err]} {
883 catch {wm withdraw .}
884 tk_messageBox \
885 -icon error \
886 -type ok \
887 -title [mc "git-gui: fatal error"] \
888 -message "Cannot determine Git version:
890 $err
892 [appname] requires Git 1.5.0 or later."
893 exit 1
895 if {![regsub {^git version } $_git_version {} _git_version]} {
896 catch {wm withdraw .}
897 tk_messageBox \
898 -icon error \
899 -type ok \
900 -title [mc "git-gui: fatal error"] \
901 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
902 exit 1
905 proc get_trimmed_version {s} {
906 set r {}
907 foreach x [split $s -._] {
908 if {[string is integer -strict $x]} {
909 lappend r $x
910 } else {
911 break
914 return [join $r .]
916 set _real_git_version $_git_version
917 set _git_version [get_trimmed_version $_git_version]
919 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
920 catch {wm withdraw .}
921 if {[tk_messageBox \
922 -icon warning \
923 -type yesno \
924 -default no \
925 -title "[appname]: warning" \
926 -message [mc "Git version cannot be determined.
928 %s claims it is version '%s'.
930 %s requires at least Git 1.5.0 or later.
932 Assume '%s' is version 1.5.0?
933 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
934 set _git_version 1.5.0
935 } else {
936 exit 1
939 unset _real_git_version
941 proc git-version {args} {
942 global _git_version
944 switch [llength $args] {
946 return $_git_version
950 set op [lindex $args 0]
951 set vr [lindex $args 1]
952 set cm [package vcompare $_git_version $vr]
953 return [expr $cm $op 0]
957 set type [lindex $args 0]
958 set name [lindex $args 1]
959 set parm [lindex $args 2]
960 set body [lindex $args 3]
962 if {($type ne {proc} && $type ne {method})} {
963 error "Invalid arguments to git-version"
965 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
966 error "Last arm of $type $name must be default"
969 foreach {op vr cb} [lrange $body 0 end-2] {
970 if {[git-version $op $vr]} {
971 return [uplevel [list $type $name $parm $cb]]
975 return [uplevel [list $type $name $parm [lindex $body end]]]
978 default {
979 error "git-version >= x"
985 if {[git-version < 1.5]} {
986 catch {wm withdraw .}
987 tk_messageBox \
988 -icon error \
989 -type ok \
990 -title [mc "git-gui: fatal error"] \
991 -message "[appname] requires Git 1.5.0 or later.
993 You are using [git-version]:
995 [git --version]"
996 exit 1
999 ######################################################################
1001 ## configure our library
1003 set idx [file join $oguilib tclIndex]
1004 if {[catch {set fd [open $idx r]} err]} {
1005 catch {wm withdraw .}
1006 tk_messageBox \
1007 -icon error \
1008 -type ok \
1009 -title [mc "git-gui: fatal error"] \
1010 -message $err
1011 exit 1
1013 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1014 set idx [list]
1015 while {[gets $fd n] >= 0} {
1016 if {$n ne {} && ![string match #* $n]} {
1017 lappend idx $n
1020 } else {
1021 set idx {}
1023 close $fd
1025 if {$idx ne {}} {
1026 set loaded [list]
1027 foreach p $idx {
1028 if {[lsearch -exact $loaded $p] >= 0} continue
1029 source [file join $oguilib $p]
1030 lappend loaded $p
1032 unset loaded p
1033 } else {
1034 set auto_path [concat [list $oguilib] $auto_path]
1036 unset -nocomplain idx fd
1038 ######################################################################
1040 ## config file parsing
1042 git-version proc _parse_config {arr_name args} {
1043 >= 1.5.3 {
1044 upvar $arr_name arr
1045 array unset arr
1046 set buf {}
1047 catch {
1048 set fd_rc [eval \
1049 [list git_read config] \
1050 $args \
1051 [list --null --list]]
1052 fconfigure $fd_rc -translation binary
1053 set buf [read $fd_rc]
1054 close $fd_rc
1056 foreach line [split $buf "\0"] {
1057 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1058 if {[is_many_config $name]} {
1059 lappend arr($name) $value
1060 } else {
1061 set arr($name) $value
1066 default {
1067 upvar $arr_name arr
1068 array unset arr
1069 catch {
1070 set fd_rc [eval [list git_read config --list] $args]
1071 while {[gets $fd_rc line] >= 0} {
1072 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1073 if {[is_many_config $name]} {
1074 lappend arr($name) $value
1075 } else {
1076 set arr($name) $value
1080 close $fd_rc
1085 proc load_config {include_global} {
1086 global repo_config global_config system_config default_config
1088 if {$include_global} {
1089 _parse_config system_config --system
1090 _parse_config global_config --global
1092 _parse_config repo_config
1094 foreach name [array names default_config] {
1095 if {[catch {set v $system_config($name)}]} {
1096 set system_config($name) $default_config($name)
1099 foreach name [array names system_config] {
1100 if {[catch {set v $global_config($name)}]} {
1101 set global_config($name) $system_config($name)
1103 if {[catch {set v $repo_config($name)}]} {
1104 set repo_config($name) $system_config($name)
1109 ######################################################################
1111 ## feature option selection
1113 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1114 unset _junk
1115 } else {
1116 set subcommand gui
1118 if {$subcommand eq {gui.sh}} {
1119 set subcommand gui
1121 if {$subcommand eq {gui} && [llength $argv] > 0} {
1122 set subcommand [lindex $argv 0]
1123 set argv [lrange $argv 1 end]
1126 enable_option multicommit
1127 enable_option branch
1128 enable_option transport
1129 disable_option bare
1131 switch -- $subcommand {
1132 browser -
1133 blame {
1134 enable_option bare
1136 disable_option multicommit
1137 disable_option branch
1138 disable_option transport
1140 citool {
1141 enable_option singlecommit
1142 enable_option retcode
1144 disable_option multicommit
1145 disable_option branch
1146 disable_option transport
1148 while {[llength $argv] > 0} {
1149 set a [lindex $argv 0]
1150 switch -- $a {
1151 --amend {
1152 enable_option initialamend
1154 --nocommit {
1155 enable_option nocommit
1156 enable_option nocommitmsg
1158 --commitmsg {
1159 disable_option nocommitmsg
1161 default {
1162 break
1166 set argv [lrange $argv 1 end]
1171 ######################################################################
1173 ## execution environment
1175 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1177 # Suggest our implementation of askpass, if none is set
1178 if {![info exists env(SSH_ASKPASS)]} {
1179 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1182 ######################################################################
1184 ## repository setup
1186 set picked 0
1187 if {[catch {
1188 set _gitdir $env(GIT_DIR)
1189 set _prefix {}
1191 && [catch {
1192 # beware that from the .git dir this sets _gitdir to .
1193 # and _prefix to the empty string
1194 set _gitdir [git rev-parse --git-dir]
1195 set _prefix [git rev-parse --show-prefix]
1196 } err]} {
1197 load_config 1
1198 apply_config
1199 choose_repository::pick
1200 set picked 1
1203 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1204 # run from the .git dir itself) lest the routines to find the worktree
1205 # get confused
1206 if {$_gitdir eq "."} {
1207 set _gitdir [pwd]
1210 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1211 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1213 if {![file isdirectory $_gitdir]} {
1214 catch {wm withdraw .}
1215 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1216 exit 1
1218 # _gitdir exists, so try loading the config
1219 load_config 0
1220 apply_config
1222 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
1223 if {[package vsatisfies $_git_version 1.7.0]} {
1224 set _gitworktree [git rev-parse --show-toplevel]
1225 } else {
1226 # try to set work tree from environment, core.worktree or use
1227 # cdup to obtain a relative path to the top of the worktree. If
1228 # run from the top, the ./ prefix ensures normalize expands pwd.
1229 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1230 set _gitworktree [get_config core.worktree]
1231 if {$_gitworktree eq ""} {
1232 set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1237 if {$_prefix ne {}} {
1238 if {$_gitworktree eq {}} {
1239 regsub -all {[^/]+/} $_prefix ../ cdup
1240 } else {
1241 set cdup $_gitworktree
1243 if {[catch {cd $cdup} err]} {
1244 catch {wm withdraw .}
1245 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1246 exit 1
1248 set _gitworktree [pwd]
1249 unset cdup
1250 } elseif {![is_enabled bare]} {
1251 if {[is_bare]} {
1252 catch {wm withdraw .}
1253 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1254 exit 1
1256 if {$_gitworktree eq {}} {
1257 set _gitworktree [file dirname $_gitdir]
1259 if {[catch {cd $_gitworktree} err]} {
1260 catch {wm withdraw .}
1261 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1262 exit 1
1264 set _gitworktree [pwd]
1266 set _reponame [file split [file normalize $_gitdir]]
1267 if {[lindex $_reponame end] eq {.git}} {
1268 set _reponame [lindex $_reponame end-1]
1269 } else {
1270 set _reponame [lindex $_reponame end]
1273 set env(GIT_DIR) $_gitdir
1274 set env(GIT_WORK_TREE) $_gitworktree
1276 ######################################################################
1278 ## global init
1280 set current_diff_path {}
1281 set current_diff_side {}
1282 set diff_actions [list]
1284 set HEAD {}
1285 set PARENT {}
1286 set MERGE_HEAD [list]
1287 set commit_type {}
1288 set empty_tree {}
1289 set current_branch {}
1290 set is_detached 0
1291 set current_diff_path {}
1292 set is_3way_diff 0
1293 set is_submodule_diff 0
1294 set is_conflict_diff 0
1295 set selected_commit_type new
1296 set diff_empty_count 0
1298 set nullid "0000000000000000000000000000000000000000"
1299 set nullid2 "0000000000000000000000000000000000000001"
1301 ######################################################################
1303 ## task management
1305 set rescan_active 0
1306 set diff_active 0
1307 set last_clicked {}
1309 set disable_on_lock [list]
1310 set index_lock_type none
1312 proc lock_index {type} {
1313 global index_lock_type disable_on_lock
1315 if {$index_lock_type eq {none}} {
1316 set index_lock_type $type
1317 foreach w $disable_on_lock {
1318 uplevel #0 $w disabled
1320 return 1
1321 } elseif {$index_lock_type eq "begin-$type"} {
1322 set index_lock_type $type
1323 return 1
1325 return 0
1328 proc unlock_index {} {
1329 global index_lock_type disable_on_lock
1331 set index_lock_type none
1332 foreach w $disable_on_lock {
1333 uplevel #0 $w normal
1337 ######################################################################
1339 ## status
1341 proc repository_state {ctvar hdvar mhvar} {
1342 global current_branch
1343 upvar $ctvar ct $hdvar hd $mhvar mh
1345 set mh [list]
1347 load_current_branch
1348 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1349 set hd {}
1350 set ct initial
1351 return
1354 set merge_head [gitdir MERGE_HEAD]
1355 if {[file exists $merge_head]} {
1356 set ct merge
1357 set fd_mh [open $merge_head r]
1358 while {[gets $fd_mh line] >= 0} {
1359 lappend mh $line
1361 close $fd_mh
1362 return
1365 set ct normal
1368 proc PARENT {} {
1369 global PARENT empty_tree
1371 set p [lindex $PARENT 0]
1372 if {$p ne {}} {
1373 return $p
1375 if {$empty_tree eq {}} {
1376 set empty_tree [git mktree << {}]
1378 return $empty_tree
1381 proc force_amend {} {
1382 global selected_commit_type
1383 global HEAD PARENT MERGE_HEAD commit_type
1385 repository_state newType newHEAD newMERGE_HEAD
1386 set HEAD $newHEAD
1387 set PARENT $newHEAD
1388 set MERGE_HEAD $newMERGE_HEAD
1389 set commit_type $newType
1391 set selected_commit_type amend
1392 do_select_commit_type
1395 proc rescan {after {honor_trustmtime 1}} {
1396 global HEAD PARENT MERGE_HEAD commit_type
1397 global ui_index ui_workdir ui_comm
1398 global rescan_active file_states
1399 global repo_config
1401 if {$rescan_active > 0 || ![lock_index read]} return
1403 repository_state newType newHEAD newMERGE_HEAD
1404 if {[string match amend* $commit_type]
1405 && $newType eq {normal}
1406 && $newHEAD eq $HEAD} {
1407 } else {
1408 set HEAD $newHEAD
1409 set PARENT $newHEAD
1410 set MERGE_HEAD $newMERGE_HEAD
1411 set commit_type $newType
1414 array unset file_states
1416 if {!$::GITGUI_BCK_exists &&
1417 (![$ui_comm edit modified]
1418 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1419 if {[string match amend* $commit_type]} {
1420 } elseif {[load_message GITGUI_MSG]} {
1421 } elseif {[run_prepare_commit_msg_hook]} {
1422 } elseif {[load_message MERGE_MSG]} {
1423 } elseif {[load_message SQUASH_MSG]} {
1425 $ui_comm edit reset
1426 $ui_comm edit modified false
1429 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1430 rescan_stage2 {} $after
1431 } else {
1432 set rescan_active 1
1433 ui_status [mc "Refreshing file status..."]
1434 set fd_rf [git_read update-index \
1435 -q \
1436 --unmerged \
1437 --ignore-missing \
1438 --refresh \
1440 fconfigure $fd_rf -blocking 0 -translation binary
1441 fileevent $fd_rf readable \
1442 [list rescan_stage2 $fd_rf $after]
1446 if {[is_Cygwin]} {
1447 set is_git_info_exclude {}
1448 proc have_info_exclude {} {
1449 global is_git_info_exclude
1451 if {$is_git_info_exclude eq {}} {
1452 if {[catch {exec test -f [gitdir info exclude]}]} {
1453 set is_git_info_exclude 0
1454 } else {
1455 set is_git_info_exclude 1
1458 return $is_git_info_exclude
1460 } else {
1461 proc have_info_exclude {} {
1462 return [file readable [gitdir info exclude]]
1466 proc rescan_stage2 {fd after} {
1467 global rescan_active buf_rdi buf_rdf buf_rlo
1469 if {$fd ne {}} {
1470 read $fd
1471 if {![eof $fd]} return
1472 close $fd
1475 if {[package vsatisfies $::_git_version 1.6.3]} {
1476 set ls_others [list --exclude-standard]
1477 } else {
1478 set ls_others [list --exclude-per-directory=.gitignore]
1479 if {[have_info_exclude]} {
1480 lappend ls_others "--exclude-from=[gitdir info exclude]"
1482 set user_exclude [get_config core.excludesfile]
1483 if {$user_exclude ne {} && [file readable $user_exclude]} {
1484 lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1488 set buf_rdi {}
1489 set buf_rdf {}
1490 set buf_rlo {}
1492 set rescan_active 3
1493 ui_status [mc "Scanning for modified files ..."]
1494 set fd_di [git_read diff-index --cached -z [PARENT]]
1495 set fd_df [git_read diff-files -z]
1496 set fd_lo [eval git_read ls-files --others -z $ls_others]
1498 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1499 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1500 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1501 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1502 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1503 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1506 proc load_message {file} {
1507 global ui_comm
1509 set f [gitdir $file]
1510 if {[file isfile $f]} {
1511 if {[catch {set fd [open $f r]}]} {
1512 return 0
1514 fconfigure $fd -eofchar {}
1515 set content [string trim [read $fd]]
1516 close $fd
1517 regsub -all -line {[ \r\t]+$} $content {} content
1518 $ui_comm delete 0.0 end
1519 $ui_comm insert end $content
1520 return 1
1522 return 0
1525 proc run_prepare_commit_msg_hook {} {
1526 global pch_error
1528 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1529 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1530 # empty file but existent file.
1532 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1534 if {[file isfile [gitdir MERGE_MSG]]} {
1535 set pcm_source "merge"
1536 set fd_mm [open [gitdir MERGE_MSG] r]
1537 puts -nonewline $fd_pcm [read $fd_mm]
1538 close $fd_mm
1539 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1540 set pcm_source "squash"
1541 set fd_sm [open [gitdir SQUASH_MSG] r]
1542 puts -nonewline $fd_pcm [read $fd_sm]
1543 close $fd_sm
1544 } else {
1545 set pcm_source ""
1548 close $fd_pcm
1550 set fd_ph [githook_read prepare-commit-msg \
1551 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1552 if {$fd_ph eq {}} {
1553 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1554 return 0;
1557 ui_status [mc "Calling prepare-commit-msg hook..."]
1558 set pch_error {}
1560 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1561 fileevent $fd_ph readable \
1562 [list prepare_commit_msg_hook_wait $fd_ph]
1564 return 1;
1567 proc prepare_commit_msg_hook_wait {fd_ph} {
1568 global pch_error
1570 append pch_error [read $fd_ph]
1571 fconfigure $fd_ph -blocking 1
1572 if {[eof $fd_ph]} {
1573 if {[catch {close $fd_ph}]} {
1574 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1575 hook_failed_popup prepare-commit-msg $pch_error
1576 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1577 exit 1
1578 } else {
1579 load_message PREPARE_COMMIT_MSG
1581 set pch_error {}
1582 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1583 return
1585 fconfigure $fd_ph -blocking 0
1586 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1589 proc read_diff_index {fd after} {
1590 global buf_rdi
1592 append buf_rdi [read $fd]
1593 set c 0
1594 set n [string length $buf_rdi]
1595 while {$c < $n} {
1596 set z1 [string first "\0" $buf_rdi $c]
1597 if {$z1 == -1} break
1598 incr z1
1599 set z2 [string first "\0" $buf_rdi $z1]
1600 if {$z2 == -1} break
1602 incr c
1603 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1604 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1605 merge_state \
1606 [encoding convertfrom $p] \
1607 [lindex $i 4]? \
1608 [list [lindex $i 0] [lindex $i 2]] \
1609 [list]
1610 set c $z2
1611 incr c
1613 if {$c < $n} {
1614 set buf_rdi [string range $buf_rdi $c end]
1615 } else {
1616 set buf_rdi {}
1619 rescan_done $fd buf_rdi $after
1622 proc read_diff_files {fd after} {
1623 global buf_rdf
1625 append buf_rdf [read $fd]
1626 set c 0
1627 set n [string length $buf_rdf]
1628 while {$c < $n} {
1629 set z1 [string first "\0" $buf_rdf $c]
1630 if {$z1 == -1} break
1631 incr z1
1632 set z2 [string first "\0" $buf_rdf $z1]
1633 if {$z2 == -1} break
1635 incr c
1636 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1637 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1638 merge_state \
1639 [encoding convertfrom $p] \
1640 ?[lindex $i 4] \
1641 [list] \
1642 [list [lindex $i 0] [lindex $i 2]]
1643 set c $z2
1644 incr c
1646 if {$c < $n} {
1647 set buf_rdf [string range $buf_rdf $c end]
1648 } else {
1649 set buf_rdf {}
1652 rescan_done $fd buf_rdf $after
1655 proc read_ls_others {fd after} {
1656 global buf_rlo
1658 append buf_rlo [read $fd]
1659 set pck [split $buf_rlo "\0"]
1660 set buf_rlo [lindex $pck end]
1661 foreach p [lrange $pck 0 end-1] {
1662 set p [encoding convertfrom $p]
1663 if {[string index $p end] eq {/}} {
1664 set p [string range $p 0 end-1]
1666 merge_state $p ?O
1668 rescan_done $fd buf_rlo $after
1671 proc rescan_done {fd buf after} {
1672 global rescan_active current_diff_path
1673 global file_states repo_config
1674 upvar $buf to_clear
1676 if {![eof $fd]} return
1677 set to_clear {}
1678 close $fd
1679 if {[incr rescan_active -1] > 0} return
1681 prune_selection
1682 unlock_index
1683 display_all_files
1684 if {$current_diff_path ne {}} { reshow_diff $after }
1685 if {$current_diff_path eq {}} { select_first_diff $after }
1688 proc prune_selection {} {
1689 global file_states selected_paths
1691 foreach path [array names selected_paths] {
1692 if {[catch {set still_here $file_states($path)}]} {
1693 unset selected_paths($path)
1698 ######################################################################
1700 ## ui helpers
1702 proc mapicon {w state path} {
1703 global all_icons
1705 if {[catch {set r $all_icons($state$w)}]} {
1706 puts "error: no icon for $w state={$state} $path"
1707 return file_plain
1709 return $r
1712 proc mapdesc {state path} {
1713 global all_descs
1715 if {[catch {set r $all_descs($state)}]} {
1716 puts "error: no desc for state={$state} $path"
1717 return $state
1719 return $r
1722 proc ui_status {msg} {
1723 global main_status
1724 if {[info exists main_status]} {
1725 $main_status show $msg
1729 proc ui_ready {{test {}}} {
1730 global main_status
1731 if {[info exists main_status]} {
1732 $main_status show [mc "Ready."] $test
1736 proc escape_path {path} {
1737 regsub -all {\\} $path "\\\\" path
1738 regsub -all "\n" $path "\\n" path
1739 return $path
1742 proc short_path {path} {
1743 return [escape_path [lindex [file split $path] end]]
1746 set next_icon_id 0
1747 set null_sha1 [string repeat 0 40]
1749 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1750 global file_states next_icon_id null_sha1
1752 set s0 [string index $new_state 0]
1753 set s1 [string index $new_state 1]
1755 if {[catch {set info $file_states($path)}]} {
1756 set state __
1757 set icon n[incr next_icon_id]
1758 } else {
1759 set state [lindex $info 0]
1760 set icon [lindex $info 1]
1761 if {$head_info eq {}} {set head_info [lindex $info 2]}
1762 if {$index_info eq {}} {set index_info [lindex $info 3]}
1765 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1766 elseif {$s0 eq {_}} {set s0 _}
1768 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1769 elseif {$s1 eq {_}} {set s1 _}
1771 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1772 set head_info [list 0 $null_sha1]
1773 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1774 && $head_info eq {}} {
1775 set head_info $index_info
1776 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1777 set index_info $head_info
1778 set head_info {}
1781 set file_states($path) [list $s0$s1 $icon \
1782 $head_info $index_info \
1784 return $state
1787 proc display_file_helper {w path icon_name old_m new_m} {
1788 global file_lists
1790 if {$new_m eq {_}} {
1791 set lno [lsearch -sorted -exact $file_lists($w) $path]
1792 if {$lno >= 0} {
1793 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1794 incr lno
1795 $w conf -state normal
1796 $w delete $lno.0 [expr {$lno + 1}].0
1797 $w conf -state disabled
1799 } elseif {$old_m eq {_} && $new_m ne {_}} {
1800 lappend file_lists($w) $path
1801 set file_lists($w) [lsort -unique $file_lists($w)]
1802 set lno [lsearch -sorted -exact $file_lists($w) $path]
1803 incr lno
1804 $w conf -state normal
1805 $w image create $lno.0 \
1806 -align center -padx 5 -pady 1 \
1807 -name $icon_name \
1808 -image [mapicon $w $new_m $path]
1809 $w insert $lno.1 "[escape_path $path]\n"
1810 $w conf -state disabled
1811 } elseif {$old_m ne $new_m} {
1812 $w conf -state normal
1813 $w image conf $icon_name -image [mapicon $w $new_m $path]
1814 $w conf -state disabled
1818 proc display_file {path state} {
1819 global file_states selected_paths
1820 global ui_index ui_workdir
1822 set old_m [merge_state $path $state]
1823 set s $file_states($path)
1824 set new_m [lindex $s 0]
1825 set icon_name [lindex $s 1]
1827 set o [string index $old_m 0]
1828 set n [string index $new_m 0]
1829 if {$o eq {U}} {
1830 set o _
1832 if {$n eq {U}} {
1833 set n _
1835 display_file_helper $ui_index $path $icon_name $o $n
1837 if {[string index $old_m 0] eq {U}} {
1838 set o U
1839 } else {
1840 set o [string index $old_m 1]
1842 if {[string index $new_m 0] eq {U}} {
1843 set n U
1844 } else {
1845 set n [string index $new_m 1]
1847 display_file_helper $ui_workdir $path $icon_name $o $n
1849 if {$new_m eq {__}} {
1850 unset file_states($path)
1851 catch {unset selected_paths($path)}
1855 proc display_all_files_helper {w path icon_name m} {
1856 global file_lists
1858 lappend file_lists($w) $path
1859 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1860 $w image create end \
1861 -align center -padx 5 -pady 1 \
1862 -name $icon_name \
1863 -image [mapicon $w $m $path]
1864 $w insert end "[escape_path $path]\n"
1867 set files_warning 0
1868 proc display_all_files {} {
1869 global ui_index ui_workdir
1870 global file_states file_lists
1871 global last_clicked
1872 global files_warning
1874 $ui_index conf -state normal
1875 $ui_workdir conf -state normal
1877 $ui_index delete 0.0 end
1878 $ui_workdir delete 0.0 end
1879 set last_clicked {}
1881 set file_lists($ui_index) [list]
1882 set file_lists($ui_workdir) [list]
1884 set to_display [lsort [array names file_states]]
1885 set display_limit [get_config gui.maxfilesdisplayed]
1886 if {[llength $to_display] > $display_limit} {
1887 if {!$files_warning} {
1888 # do not repeatedly warn:
1889 set files_warning 1
1890 info_popup [mc "Displaying only %s of %s files." \
1891 $display_limit [llength $to_display]]
1893 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1895 foreach path $to_display {
1896 set s $file_states($path)
1897 set m [lindex $s 0]
1898 set icon_name [lindex $s 1]
1900 set s [string index $m 0]
1901 if {$s ne {U} && $s ne {_}} {
1902 display_all_files_helper $ui_index $path \
1903 $icon_name $s
1906 if {[string index $m 0] eq {U}} {
1907 set s U
1908 } else {
1909 set s [string index $m 1]
1911 if {$s ne {_}} {
1912 display_all_files_helper $ui_workdir $path \
1913 $icon_name $s
1917 $ui_index conf -state disabled
1918 $ui_workdir conf -state disabled
1921 ######################################################################
1923 ## icons
1925 set filemask {
1926 #define mask_width 14
1927 #define mask_height 15
1928 static unsigned char mask_bits[] = {
1929 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1930 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1931 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1934 image create bitmap file_plain -background white -foreground black -data {
1935 #define plain_width 14
1936 #define plain_height 15
1937 static unsigned char plain_bits[] = {
1938 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1939 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1940 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1941 } -maskdata $filemask
1943 image create bitmap file_mod -background white -foreground blue -data {
1944 #define mod_width 14
1945 #define mod_height 15
1946 static unsigned char mod_bits[] = {
1947 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1948 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1949 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1950 } -maskdata $filemask
1952 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1953 #define file_fulltick_width 14
1954 #define file_fulltick_height 15
1955 static unsigned char file_fulltick_bits[] = {
1956 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1957 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1958 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1959 } -maskdata $filemask
1961 image create bitmap file_question -background white -foreground black -data {
1962 #define file_question_width 14
1963 #define file_question_height 15
1964 static unsigned char file_question_bits[] = {
1965 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1966 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1967 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1968 } -maskdata $filemask
1970 image create bitmap file_removed -background white -foreground red -data {
1971 #define file_removed_width 14
1972 #define file_removed_height 15
1973 static unsigned char file_removed_bits[] = {
1974 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1975 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1976 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1977 } -maskdata $filemask
1979 image create bitmap file_merge -background white -foreground blue -data {
1980 #define file_merge_width 14
1981 #define file_merge_height 15
1982 static unsigned char file_merge_bits[] = {
1983 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1984 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1985 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1986 } -maskdata $filemask
1988 image create bitmap file_statechange -background white -foreground green -data {
1989 #define file_statechange_width 14
1990 #define file_statechange_height 15
1991 static unsigned char file_statechange_bits[] = {
1992 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1993 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1994 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1995 } -maskdata $filemask
1997 set ui_index .vpane.files.index.list
1998 set ui_workdir .vpane.files.workdir.list
2000 set all_icons(_$ui_index) file_plain
2001 set all_icons(A$ui_index) file_plain
2002 set all_icons(M$ui_index) file_fulltick
2003 set all_icons(D$ui_index) file_removed
2004 set all_icons(U$ui_index) file_merge
2005 set all_icons(T$ui_index) file_statechange
2007 set all_icons(_$ui_workdir) file_plain
2008 set all_icons(M$ui_workdir) file_mod
2009 set all_icons(D$ui_workdir) file_question
2010 set all_icons(U$ui_workdir) file_merge
2011 set all_icons(O$ui_workdir) file_plain
2012 set all_icons(T$ui_workdir) file_statechange
2014 set max_status_desc 0
2015 foreach i {
2016 {__ {mc "Unmodified"}}
2018 {_M {mc "Modified, not staged"}}
2019 {M_ {mc "Staged for commit"}}
2020 {MM {mc "Portions staged for commit"}}
2021 {MD {mc "Staged for commit, missing"}}
2023 {_T {mc "File type changed, not staged"}}
2024 {MT {mc "File type changed, old type staged for commit"}}
2025 {AT {mc "File type changed, old type staged for commit"}}
2026 {T_ {mc "File type changed, staged"}}
2027 {TM {mc "File type change staged, modification not staged"}}
2028 {TD {mc "File type change staged, file missing"}}
2030 {_O {mc "Untracked, not staged"}}
2031 {A_ {mc "Staged for commit"}}
2032 {AM {mc "Portions staged for commit"}}
2033 {AD {mc "Staged for commit, missing"}}
2035 {_D {mc "Missing"}}
2036 {D_ {mc "Staged for removal"}}
2037 {DO {mc "Staged for removal, still present"}}
2039 {_U {mc "Requires merge resolution"}}
2040 {U_ {mc "Requires merge resolution"}}
2041 {UU {mc "Requires merge resolution"}}
2042 {UM {mc "Requires merge resolution"}}
2043 {UD {mc "Requires merge resolution"}}
2044 {UT {mc "Requires merge resolution"}}
2046 set text [eval [lindex $i 1]]
2047 if {$max_status_desc < [string length $text]} {
2048 set max_status_desc [string length $text]
2050 set all_descs([lindex $i 0]) $text
2052 unset i
2054 ######################################################################
2056 ## util
2058 proc scrollbar2many {list mode args} {
2059 foreach w $list {eval $w $mode $args}
2062 proc many2scrollbar {list mode sb top bottom} {
2063 $sb set $top $bottom
2064 foreach w $list {$w $mode moveto $top}
2067 proc incr_font_size {font {amt 1}} {
2068 set sz [font configure $font -size]
2069 incr sz $amt
2070 font configure $font -size $sz
2071 font configure ${font}bold -size $sz
2072 font configure ${font}italic -size $sz
2075 ######################################################################
2077 ## ui commands
2079 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2081 proc do_gitk {revs {is_submodule false}} {
2082 global current_diff_path file_states current_diff_side ui_index
2083 global _gitdir _gitworktree
2085 # -- Always start gitk through whatever we were loaded with. This
2086 # lets us bypass using shell process on Windows systems.
2088 set exe [_which gitk -script]
2089 set cmd [list [info nameofexecutable] $exe]
2090 if {$exe eq {}} {
2091 error_popup [mc "Couldn't find gitk in PATH"]
2092 } else {
2093 global env
2095 set pwd [pwd]
2097 if {!$is_submodule} {
2098 if {![is_bare]} {
2099 cd $_gitworktree
2101 } else {
2102 cd $current_diff_path
2103 if {$revs eq {--}} {
2104 set s $file_states($current_diff_path)
2105 set old_sha1 {}
2106 set new_sha1 {}
2107 switch -glob -- [lindex $s 0] {
2108 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2109 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2110 MM {
2111 if {$current_diff_side eq $ui_index} {
2112 set old_sha1 [lindex [lindex $s 2] 1]
2113 set new_sha1 [lindex [lindex $s 3] 1]
2114 } else {
2115 set old_sha1 [lindex [lindex $s 3] 1]
2119 set revs $old_sha1...$new_sha1
2121 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2122 # we've been using for the main repository, so unset them.
2123 # TODO we could make life easier (start up faster?) for gitk
2124 # by setting these to the appropriate values to allow gitk
2125 # to skip the heuristics to find their proper value
2126 unset env(GIT_DIR)
2127 unset env(GIT_WORK_TREE)
2129 eval exec $cmd $revs "--" "--" &
2131 set env(GIT_DIR) $_gitdir
2132 set env(GIT_WORK_TREE) $_gitworktree
2133 cd $pwd
2135 ui_status $::starting_gitk_msg
2136 after 10000 {
2137 ui_ready $starting_gitk_msg
2142 proc do_git_gui {} {
2143 global current_diff_path
2145 # -- Always start git gui through whatever we were loaded with. This
2146 # lets us bypass using shell process on Windows systems.
2148 set exe [list [_which git]]
2149 if {$exe eq {}} {
2150 error_popup [mc "Couldn't find git gui in PATH"]
2151 } else {
2152 global env
2153 global _gitdir _gitworktree
2155 # see note in do_gitk about unsetting these vars when
2156 # running tools in a submodule
2157 unset env(GIT_DIR)
2158 unset env(GIT_WORK_TREE)
2160 set pwd [pwd]
2161 cd $current_diff_path
2163 eval exec $exe gui &
2165 set env(GIT_DIR) $_gitdir
2166 set env(GIT_WORK_TREE) $_gitworktree
2167 cd $pwd
2169 ui_status $::starting_gitk_msg
2170 after 10000 {
2171 ui_ready $starting_gitk_msg
2176 proc do_explore {} {
2177 global _gitworktree
2178 set explorer {}
2179 if {[is_Cygwin] || [is_Windows]} {
2180 set explorer "explorer.exe"
2181 } elseif {[is_MacOSX]} {
2182 set explorer "open"
2183 } else {
2184 # freedesktop.org-conforming system is our best shot
2185 set explorer "xdg-open"
2187 eval exec $explorer [list [file nativename $_gitworktree]] &
2190 set is_quitting 0
2191 set ret_code 1
2193 proc terminate_me {win} {
2194 global ret_code
2195 if {$win ne {.}} return
2196 exit $ret_code
2199 proc do_quit {{rc {1}}} {
2200 global ui_comm is_quitting repo_config commit_type
2201 global GITGUI_BCK_exists GITGUI_BCK_i
2202 global ui_comm_spell
2203 global ret_code use_ttk
2205 if {$is_quitting} return
2206 set is_quitting 1
2208 if {[winfo exists $ui_comm]} {
2209 # -- Stash our current commit buffer.
2211 set save [gitdir GITGUI_MSG]
2212 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2213 file rename -force [gitdir GITGUI_BCK] $save
2214 set GITGUI_BCK_exists 0
2215 } else {
2216 set msg [string trim [$ui_comm get 0.0 end]]
2217 regsub -all -line {[ \r\t]+$} $msg {} msg
2218 if {(![string match amend* $commit_type]
2219 || [$ui_comm edit modified])
2220 && $msg ne {}} {
2221 catch {
2222 set fd [open $save w]
2223 puts -nonewline $fd $msg
2224 close $fd
2226 } else {
2227 catch {file delete $save}
2231 # -- Cancel our spellchecker if its running.
2233 if {[info exists ui_comm_spell]} {
2234 $ui_comm_spell stop
2237 # -- Remove our editor backup, its not needed.
2239 after cancel $GITGUI_BCK_i
2240 if {$GITGUI_BCK_exists} {
2241 catch {file delete [gitdir GITGUI_BCK]}
2244 # -- Stash our current window geometry into this repository.
2246 set cfg_wmstate [wm state .]
2247 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2248 set rc_wmstate {}
2250 if {$cfg_wmstate ne $rc_wmstate} {
2251 catch {git config gui.wmstate $cfg_wmstate}
2253 if {$cfg_wmstate eq {zoomed}} {
2254 # on Windows wm geometry will lie about window
2255 # position (but not size) when window is zoomed
2256 # restore the window before querying wm geometry
2257 wm state . normal
2259 set cfg_geometry [list]
2260 lappend cfg_geometry [wm geometry .]
2261 if {$use_ttk} {
2262 lappend cfg_geometry [.vpane sashpos 0]
2263 lappend cfg_geometry [.vpane.files sashpos 0]
2264 } else {
2265 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2266 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2268 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2269 set rc_geometry {}
2271 if {$cfg_geometry ne $rc_geometry} {
2272 catch {git config gui.geometry $cfg_geometry}
2276 set ret_code $rc
2278 # Briefly enable send again, working around Tk bug
2279 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2280 tk appname [appname]
2282 destroy .
2285 proc do_rescan {} {
2286 rescan ui_ready
2289 proc ui_do_rescan {} {
2290 rescan {force_first_diff ui_ready}
2293 proc do_commit {} {
2294 commit_tree
2297 proc next_diff {{after {}}} {
2298 global next_diff_p next_diff_w next_diff_i
2299 show_diff $next_diff_p $next_diff_w {} {} $after
2302 proc find_anchor_pos {lst name} {
2303 set lid [lsearch -sorted -exact $lst $name]
2305 if {$lid == -1} {
2306 set lid 0
2307 foreach lname $lst {
2308 if {$lname >= $name} break
2309 incr lid
2313 return $lid
2316 proc find_file_from {flist idx delta path mmask} {
2317 global file_states
2319 set len [llength $flist]
2320 while {$idx >= 0 && $idx < $len} {
2321 set name [lindex $flist $idx]
2323 if {$name ne $path && [info exists file_states($name)]} {
2324 set state [lindex $file_states($name) 0]
2326 if {$mmask eq {} || [regexp $mmask $state]} {
2327 return $idx
2331 incr idx $delta
2334 return {}
2337 proc find_next_diff {w path {lno {}} {mmask {}}} {
2338 global next_diff_p next_diff_w next_diff_i
2339 global file_lists ui_index ui_workdir
2341 set flist $file_lists($w)
2342 if {$lno eq {}} {
2343 set lno [find_anchor_pos $flist $path]
2344 } else {
2345 incr lno -1
2348 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2349 if {$w eq $ui_index} {
2350 set mmask "^$mmask"
2351 } else {
2352 set mmask "$mmask\$"
2356 set idx [find_file_from $flist $lno 1 $path $mmask]
2357 if {$idx eq {}} {
2358 incr lno -1
2359 set idx [find_file_from $flist $lno -1 $path $mmask]
2362 if {$idx ne {}} {
2363 set next_diff_w $w
2364 set next_diff_p [lindex $flist $idx]
2365 set next_diff_i [expr {$idx+1}]
2366 return 1
2367 } else {
2368 return 0
2372 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2373 global current_diff_path
2375 if {$path ne $current_diff_path} {
2376 return {}
2377 } elseif {[find_next_diff $w $path $lno $mmask]} {
2378 return {next_diff;}
2379 } else {
2380 return {reshow_diff;}
2384 proc select_first_diff {after} {
2385 global ui_workdir
2387 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2388 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2389 next_diff $after
2390 } else {
2391 uplevel #0 $after
2395 proc force_first_diff {after} {
2396 global ui_workdir current_diff_path file_states
2398 if {[info exists file_states($current_diff_path)]} {
2399 set state [lindex $file_states($current_diff_path) 0]
2400 } else {
2401 set state {OO}
2404 set reselect 0
2405 if {[string first {U} $state] >= 0} {
2406 # Already a conflict, do nothing
2407 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2408 set reselect 1
2409 } elseif {[string index $state 1] ne {O}} {
2410 # Already a diff & no conflicts, do nothing
2411 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2412 set reselect 1
2415 if {$reselect} {
2416 next_diff $after
2417 } else {
2418 uplevel #0 $after
2422 proc toggle_or_diff {w x y} {
2423 global file_states file_lists current_diff_path ui_index ui_workdir
2424 global last_clicked selected_paths
2426 set pos [split [$w index @$x,$y] .]
2427 set lno [lindex $pos 0]
2428 set col [lindex $pos 1]
2429 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2430 if {$path eq {}} {
2431 set last_clicked {}
2432 return
2435 set last_clicked [list $w $lno]
2436 array unset selected_paths
2437 $ui_index tag remove in_sel 0.0 end
2438 $ui_workdir tag remove in_sel 0.0 end
2440 # Determine the state of the file
2441 if {[info exists file_states($path)]} {
2442 set state [lindex $file_states($path) 0]
2443 } else {
2444 set state {__}
2447 # Restage the file, or simply show the diff
2448 if {$col == 0 && $y > 1} {
2449 # Conflicts need special handling
2450 if {[string first {U} $state] >= 0} {
2451 # $w must always be $ui_workdir, but...
2452 if {$w ne $ui_workdir} { set lno {} }
2453 merge_stage_workdir $path $lno
2454 return
2457 if {[string index $state 1] eq {O}} {
2458 set mmask {}
2459 } else {
2460 set mmask {[^O]}
2463 set after [next_diff_after_action $w $path $lno $mmask]
2465 if {$w eq $ui_index} {
2466 update_indexinfo \
2467 "Unstaging [short_path $path] from commit" \
2468 [list $path] \
2469 [concat $after [list ui_ready]]
2470 } elseif {$w eq $ui_workdir} {
2471 update_index \
2472 "Adding [short_path $path]" \
2473 [list $path] \
2474 [concat $after [list ui_ready]]
2476 } else {
2477 show_diff $path $w $lno
2481 proc add_one_to_selection {w x y} {
2482 global file_lists last_clicked selected_paths
2484 set lno [lindex [split [$w index @$x,$y] .] 0]
2485 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2486 if {$path eq {}} {
2487 set last_clicked {}
2488 return
2491 if {$last_clicked ne {}
2492 && [lindex $last_clicked 0] ne $w} {
2493 array unset selected_paths
2494 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2497 set last_clicked [list $w $lno]
2498 if {[catch {set in_sel $selected_paths($path)}]} {
2499 set in_sel 0
2501 if {$in_sel} {
2502 unset selected_paths($path)
2503 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2504 } else {
2505 set selected_paths($path) 1
2506 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2510 proc add_range_to_selection {w x y} {
2511 global file_lists last_clicked selected_paths
2513 if {[lindex $last_clicked 0] ne $w} {
2514 toggle_or_diff $w $x $y
2515 return
2518 set lno [lindex [split [$w index @$x,$y] .] 0]
2519 set lc [lindex $last_clicked 1]
2520 if {$lc < $lno} {
2521 set begin $lc
2522 set end $lno
2523 } else {
2524 set begin $lno
2525 set end $lc
2528 foreach path [lrange $file_lists($w) \
2529 [expr {$begin - 1}] \
2530 [expr {$end - 1}]] {
2531 set selected_paths($path) 1
2533 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2536 proc show_more_context {} {
2537 global repo_config
2538 if {$repo_config(gui.diffcontext) < 99} {
2539 incr repo_config(gui.diffcontext)
2540 reshow_diff
2544 proc show_less_context {} {
2545 global repo_config
2546 if {$repo_config(gui.diffcontext) > 1} {
2547 incr repo_config(gui.diffcontext) -1
2548 reshow_diff
2552 ######################################################################
2554 ## ui construction
2556 set ui_comm {}
2558 # -- Menu Bar
2560 menu .mbar -tearoff 0
2561 if {[is_MacOSX]} {
2562 # -- Apple Menu (Mac OS X only)
2564 .mbar add cascade -label Apple -menu .mbar.apple
2565 menu .mbar.apple
2567 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2568 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2569 if {[is_enabled branch]} {
2570 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2572 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2573 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2575 if {[is_enabled transport]} {
2576 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2577 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2579 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2580 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2583 # -- Repository Menu
2585 menu .mbar.repository
2587 if {![is_bare]} {
2588 .mbar.repository add command \
2589 -label [mc "Explore Working Copy"] \
2590 -command {do_explore}
2591 .mbar.repository add separator
2594 .mbar.repository add command \
2595 -label [mc "Browse Current Branch's Files"] \
2596 -command {browser::new $current_branch}
2597 set ui_browse_current [.mbar.repository index last]
2598 .mbar.repository add command \
2599 -label [mc "Browse Branch Files..."] \
2600 -command browser_open::dialog
2601 .mbar.repository add separator
2603 .mbar.repository add command \
2604 -label [mc "Visualize Current Branch's History"] \
2605 -command {do_gitk $current_branch}
2606 set ui_visualize_current [.mbar.repository index last]
2607 .mbar.repository add command \
2608 -label [mc "Visualize All Branch History"] \
2609 -command {do_gitk --all}
2610 .mbar.repository add separator
2612 proc current_branch_write {args} {
2613 global current_branch
2614 .mbar.repository entryconf $::ui_browse_current \
2615 -label [mc "Browse %s's Files" $current_branch]
2616 .mbar.repository entryconf $::ui_visualize_current \
2617 -label [mc "Visualize %s's History" $current_branch]
2619 trace add variable current_branch write current_branch_write
2621 if {[is_enabled multicommit]} {
2622 .mbar.repository add command -label [mc "Database Statistics"] \
2623 -command do_stats
2625 .mbar.repository add command -label [mc "Compress Database"] \
2626 -command do_gc
2628 .mbar.repository add command -label [mc "Verify Database"] \
2629 -command do_fsck_objects
2631 .mbar.repository add separator
2633 if {[is_Cygwin]} {
2634 .mbar.repository add command \
2635 -label [mc "Create Desktop Icon"] \
2636 -command do_cygwin_shortcut
2637 } elseif {[is_Windows]} {
2638 .mbar.repository add command \
2639 -label [mc "Create Desktop Icon"] \
2640 -command do_windows_shortcut
2641 } elseif {[is_MacOSX]} {
2642 .mbar.repository add command \
2643 -label [mc "Create Desktop Icon"] \
2644 -command do_macosx_app
2648 if {[is_MacOSX]} {
2649 proc ::tk::mac::Quit {args} { do_quit }
2650 } else {
2651 .mbar.repository add command -label [mc Quit] \
2652 -command do_quit \
2653 -accelerator $M1T-Q
2656 # -- Edit Menu
2658 menu .mbar.edit
2659 .mbar.edit add command -label [mc Undo] \
2660 -command {catch {[focus] edit undo}} \
2661 -accelerator $M1T-Z
2662 .mbar.edit add command -label [mc Redo] \
2663 -command {catch {[focus] edit redo}} \
2664 -accelerator $M1T-Y
2665 .mbar.edit add separator
2666 .mbar.edit add command -label [mc Cut] \
2667 -command {catch {tk_textCut [focus]}} \
2668 -accelerator $M1T-X
2669 .mbar.edit add command -label [mc Copy] \
2670 -command {catch {tk_textCopy [focus]}} \
2671 -accelerator $M1T-C
2672 .mbar.edit add command -label [mc Paste] \
2673 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2674 -accelerator $M1T-V
2675 .mbar.edit add command -label [mc Delete] \
2676 -command {catch {[focus] delete sel.first sel.last}} \
2677 -accelerator Del
2678 .mbar.edit add separator
2679 .mbar.edit add command -label [mc "Select All"] \
2680 -command {catch {[focus] tag add sel 0.0 end}} \
2681 -accelerator $M1T-A
2683 # -- Branch Menu
2685 if {[is_enabled branch]} {
2686 menu .mbar.branch
2688 .mbar.branch add command -label [mc "Create..."] \
2689 -command branch_create::dialog \
2690 -accelerator $M1T-N
2691 lappend disable_on_lock [list .mbar.branch entryconf \
2692 [.mbar.branch index last] -state]
2694 .mbar.branch add command -label [mc "Checkout..."] \
2695 -command branch_checkout::dialog \
2696 -accelerator $M1T-O
2697 lappend disable_on_lock [list .mbar.branch entryconf \
2698 [.mbar.branch index last] -state]
2700 .mbar.branch add command -label [mc "Rename..."] \
2701 -command branch_rename::dialog
2702 lappend disable_on_lock [list .mbar.branch entryconf \
2703 [.mbar.branch index last] -state]
2705 .mbar.branch add command -label [mc "Delete..."] \
2706 -command branch_delete::dialog
2707 lappend disable_on_lock [list .mbar.branch entryconf \
2708 [.mbar.branch index last] -state]
2710 .mbar.branch add command -label [mc "Reset..."] \
2711 -command merge::reset_hard
2712 lappend disable_on_lock [list .mbar.branch entryconf \
2713 [.mbar.branch index last] -state]
2716 # -- Commit Menu
2718 proc commit_btn_caption {} {
2719 if {[is_enabled nocommit]} {
2720 return [mc "Done"]
2721 } else {
2722 return [mc Commit@@verb]
2726 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2727 menu .mbar.commit
2729 if {![is_enabled nocommit]} {
2730 .mbar.commit add radiobutton \
2731 -label [mc "New Commit"] \
2732 -command do_select_commit_type \
2733 -variable selected_commit_type \
2734 -value new
2735 lappend disable_on_lock \
2736 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2738 .mbar.commit add radiobutton \
2739 -label [mc "Amend Last Commit"] \
2740 -command do_select_commit_type \
2741 -variable selected_commit_type \
2742 -value amend
2743 lappend disable_on_lock \
2744 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2746 .mbar.commit add separator
2749 .mbar.commit add command -label [mc Rescan] \
2750 -command ui_do_rescan \
2751 -accelerator F5
2752 lappend disable_on_lock \
2753 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2755 .mbar.commit add command -label [mc "Stage To Commit"] \
2756 -command do_add_selection \
2757 -accelerator $M1T-T
2758 lappend disable_on_lock \
2759 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2761 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2762 -command do_add_all \
2763 -accelerator $M1T-I
2764 lappend disable_on_lock \
2765 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2767 .mbar.commit add command -label [mc "Unstage From Commit"] \
2768 -command do_unstage_selection \
2769 -accelerator $M1T-U
2770 lappend disable_on_lock \
2771 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2773 .mbar.commit add command -label [mc "Revert Changes"] \
2774 -command do_revert_selection \
2775 -accelerator $M1T-J
2776 lappend disable_on_lock \
2777 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2779 .mbar.commit add separator
2781 .mbar.commit add command -label [mc "Show Less Context"] \
2782 -command show_less_context \
2783 -accelerator $M1T-\-
2785 .mbar.commit add command -label [mc "Show More Context"] \
2786 -command show_more_context \
2787 -accelerator $M1T-=
2789 .mbar.commit add separator
2791 if {![is_enabled nocommitmsg]} {
2792 .mbar.commit add command -label [mc "Sign Off"] \
2793 -command do_signoff \
2794 -accelerator $M1T-S
2797 .mbar.commit add command -label [commit_btn_caption] \
2798 -command do_commit \
2799 -accelerator $M1T-Return
2800 lappend disable_on_lock \
2801 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2804 # -- Merge Menu
2806 if {[is_enabled branch]} {
2807 menu .mbar.merge
2808 .mbar.merge add command -label [mc "Local Merge..."] \
2809 -command merge::dialog \
2810 -accelerator $M1T-M
2811 lappend disable_on_lock \
2812 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2813 .mbar.merge add command -label [mc "Abort Merge..."] \
2814 -command merge::reset_hard
2815 lappend disable_on_lock \
2816 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2819 # -- Transport Menu
2821 if {[is_enabled transport]} {
2822 menu .mbar.remote
2824 .mbar.remote add command \
2825 -label [mc "Add..."] \
2826 -command remote_add::dialog \
2827 -accelerator $M1T-A
2828 .mbar.remote add command \
2829 -label [mc "Push..."] \
2830 -command do_push_anywhere \
2831 -accelerator $M1T-P
2832 .mbar.remote add command \
2833 -label [mc "Delete Branch..."] \
2834 -command remote_branch_delete::dialog
2837 if {[is_MacOSX]} {
2838 proc ::tk::mac::ShowPreferences {} {do_options}
2839 } else {
2840 # -- Edit Menu
2842 .mbar.edit add separator
2843 .mbar.edit add command -label [mc "Options..."] \
2844 -command do_options
2847 # -- Tools Menu
2849 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2850 set tools_menubar .mbar.tools
2851 menu $tools_menubar
2852 $tools_menubar add separator
2853 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2854 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2855 set tools_tailcnt 3
2856 if {[array names repo_config guitool.*.cmd] ne {}} {
2857 tools_populate_all
2861 # -- Help Menu
2863 .mbar add cascade -label [mc Help] -menu .mbar.help
2864 menu .mbar.help
2866 if {[is_MacOSX]} {
2867 .mbar.apple add command -label [mc "About %s" [appname]] \
2868 -command do_about
2869 .mbar.apple add separator
2870 } else {
2871 .mbar.help add command -label [mc "About %s" [appname]] \
2872 -command do_about
2874 . configure -menu .mbar
2876 set doc_path [githtmldir]
2877 if {$doc_path ne {}} {
2878 set doc_path [file join $doc_path index.html]
2880 if {[is_Cygwin]} {
2881 set doc_path [exec cygpath --mixed $doc_path]
2885 if {[file isfile $doc_path]} {
2886 set doc_url "file:$doc_path"
2887 } else {
2888 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2891 proc start_browser {url} {
2892 git "web--browse" $url
2895 .mbar.help add command -label [mc "Online Documentation"] \
2896 -command [list start_browser $doc_url]
2898 .mbar.help add command -label [mc "Show SSH Key"] \
2899 -command do_ssh_key
2901 unset doc_path doc_url
2903 # -- Standard bindings
2905 wm protocol . WM_DELETE_WINDOW do_quit
2906 bind all <$M1B-Key-q> do_quit
2907 bind all <$M1B-Key-Q> do_quit
2908 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2909 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2911 set subcommand_args {}
2912 proc usage {} {
2913 set s "usage: $::argv0 $::subcommand $::subcommand_args"
2914 if {[tk windowingsystem] eq "win32"} {
2915 wm withdraw .
2916 tk_messageBox -icon info -message $s \
2917 -title [mc "Usage"]
2918 } else {
2919 puts stderr $s
2921 exit 1
2924 proc normalize_relpath {path} {
2925 set elements {}
2926 foreach item [file split $path] {
2927 if {$item eq {.}} continue
2928 if {$item eq {..} && [llength $elements] > 0
2929 && [lindex $elements end] ne {..}} {
2930 set elements [lrange $elements 0 end-1]
2931 continue
2933 lappend elements $item
2935 return [eval file join $elements]
2938 # -- Not a normal commit type invocation? Do that instead!
2940 switch -- $subcommand {
2941 browser -
2942 blame {
2943 if {$subcommand eq "blame"} {
2944 set subcommand_args {[--line=<num>] rev? path}
2945 } else {
2946 set subcommand_args {rev? path}
2948 if {$argv eq {}} usage
2949 set head {}
2950 set path {}
2951 set jump_spec {}
2952 set is_path 0
2953 foreach a $argv {
2954 if {$is_path || [file exists $_prefix$a]} {
2955 if {$path ne {}} usage
2956 set path [normalize_relpath $_prefix$a]
2957 break
2958 } elseif {$a eq {--}} {
2959 if {$path ne {}} {
2960 if {$head ne {}} usage
2961 set head $path
2962 set path {}
2964 set is_path 1
2965 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2966 if {$jump_spec ne {} || $head ne {}} usage
2967 set jump_spec [list $lnum]
2968 } elseif {$head eq {}} {
2969 if {$head ne {}} usage
2970 set head $a
2971 set is_path 1
2972 } else {
2973 usage
2976 unset is_path
2978 if {$head ne {} && $path eq {}} {
2979 set path [normalize_relpath $_prefix$head]
2980 set head {}
2983 if {$head eq {}} {
2984 load_current_branch
2985 } else {
2986 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2987 if {[catch {
2988 set head [git rev-parse --verify $head]
2989 } err]} {
2990 if {[tk windowingsystem] eq "win32"} {
2991 tk_messageBox -icon error -title [mc Error] -message $err
2992 } else {
2993 puts stderr $err
2995 exit 1
2998 set current_branch $head
3001 wm deiconify .
3002 switch -- $subcommand {
3003 browser {
3004 if {$jump_spec ne {}} usage
3005 if {$head eq {}} {
3006 if {$path ne {} && [file isdirectory $path]} {
3007 set head $current_branch
3008 } else {
3009 set head $path
3010 set path {}
3013 browser::new $head $path
3015 blame {
3016 if {$head eq {} && ![file exists $path]} {
3017 catch {wm withdraw .}
3018 tk_messageBox \
3019 -icon error \
3020 -type ok \
3021 -title [mc "git-gui: fatal error"] \
3022 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3023 exit 1
3025 blame::new $head $path $jump_spec
3028 return
3030 citool -
3031 gui {
3032 if {[llength $argv] != 0} {
3033 usage
3035 # fall through to setup UI for commits
3037 default {
3038 set err "usage: $argv0 \[{blame|browser|citool}\]"
3039 if {[tk windowingsystem] eq "win32"} {
3040 wm withdraw .
3041 tk_messageBox -icon error -message $err \
3042 -title [mc "Usage"]
3043 } else {
3044 puts stderr $err
3046 exit 1
3050 # -- Branch Control
3052 ${NS}::frame .branch
3053 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3054 ${NS}::label .branch.l1 \
3055 -text [mc "Current Branch:"] \
3056 -anchor w \
3057 -justify left
3058 ${NS}::label .branch.cb \
3059 -textvariable current_branch \
3060 -anchor w \
3061 -justify left
3062 pack .branch.l1 -side left
3063 pack .branch.cb -side left -fill x
3064 pack .branch -side top -fill x
3066 # -- Main Window Layout
3068 ${NS}::panedwindow .vpane -orient horizontal
3069 ${NS}::panedwindow .vpane.files -orient vertical
3070 if {$use_ttk} {
3071 .vpane add .vpane.files
3072 } else {
3073 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3075 pack .vpane -anchor n -side top -fill both -expand 1
3077 # -- Index File List
3079 ${NS}::frame .vpane.files.index -height 100 -width 200
3080 tlabel .vpane.files.index.title \
3081 -text [mc "Staged Changes (Will Commit)"] \
3082 -background lightgreen -foreground black
3083 text $ui_index -background white -foreground black \
3084 -borderwidth 0 \
3085 -width 20 -height 10 \
3086 -wrap none \
3087 -cursor $cursor_ptr \
3088 -xscrollcommand {.vpane.files.index.sx set} \
3089 -yscrollcommand {.vpane.files.index.sy set} \
3090 -state disabled
3091 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3092 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3093 pack .vpane.files.index.title -side top -fill x
3094 pack .vpane.files.index.sx -side bottom -fill x
3095 pack .vpane.files.index.sy -side right -fill y
3096 pack $ui_index -side left -fill both -expand 1
3098 # -- Working Directory File List
3100 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3101 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3102 -background lightsalmon -foreground black
3103 text $ui_workdir -background white -foreground black \
3104 -borderwidth 0 \
3105 -width 20 -height 10 \
3106 -wrap none \
3107 -cursor $cursor_ptr \
3108 -xscrollcommand {.vpane.files.workdir.sx set} \
3109 -yscrollcommand {.vpane.files.workdir.sy set} \
3110 -state disabled
3111 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3112 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3113 pack .vpane.files.workdir.title -side top -fill x
3114 pack .vpane.files.workdir.sx -side bottom -fill x
3115 pack .vpane.files.workdir.sy -side right -fill y
3116 pack $ui_workdir -side left -fill both -expand 1
3118 .vpane.files add .vpane.files.workdir
3119 .vpane.files add .vpane.files.index
3120 if {!$use_ttk} {
3121 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3122 .vpane.files paneconfigure .vpane.files.index -sticky news
3125 foreach i [list $ui_index $ui_workdir] {
3126 rmsel_tag $i
3127 $i tag conf in_diff -background [$i tag cget in_sel -background]
3129 unset i
3131 # -- Diff and Commit Area
3133 ${NS}::frame .vpane.lower -height 300 -width 400
3134 ${NS}::frame .vpane.lower.commarea
3135 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3136 pack .vpane.lower.diff -fill both -expand 1
3137 pack .vpane.lower.commarea -side bottom -fill x
3138 .vpane add .vpane.lower
3139 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3141 # -- Commit Area Buttons
3143 ${NS}::frame .vpane.lower.commarea.buttons
3144 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3145 -anchor w \
3146 -justify left
3147 pack .vpane.lower.commarea.buttons.l -side top -fill x
3148 pack .vpane.lower.commarea.buttons -side left -fill y
3150 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3151 -command ui_do_rescan
3152 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3153 lappend disable_on_lock \
3154 {.vpane.lower.commarea.buttons.rescan conf -state}
3156 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3157 -command do_add_all
3158 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3159 lappend disable_on_lock \
3160 {.vpane.lower.commarea.buttons.incall conf -state}
3162 if {![is_enabled nocommitmsg]} {
3163 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3164 -command do_signoff
3165 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3168 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3169 -command do_commit
3170 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3171 lappend disable_on_lock \
3172 {.vpane.lower.commarea.buttons.commit conf -state}
3174 if {![is_enabled nocommit]} {
3175 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3176 -command do_push_anywhere
3177 pack .vpane.lower.commarea.buttons.push -side top -fill x
3180 # -- Commit Message Buffer
3182 ${NS}::frame .vpane.lower.commarea.buffer
3183 ${NS}::frame .vpane.lower.commarea.buffer.header
3184 set ui_comm .vpane.lower.commarea.buffer.t
3185 set ui_coml .vpane.lower.commarea.buffer.header.l
3187 if {![is_enabled nocommit]} {
3188 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3189 -text [mc "New Commit"] \
3190 -command do_select_commit_type \
3191 -variable selected_commit_type \
3192 -value new
3193 lappend disable_on_lock \
3194 [list .vpane.lower.commarea.buffer.header.new conf -state]
3195 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3196 -text [mc "Amend Last Commit"] \
3197 -command do_select_commit_type \
3198 -variable selected_commit_type \
3199 -value amend
3200 lappend disable_on_lock \
3201 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3204 ${NS}::label $ui_coml \
3205 -anchor w \
3206 -justify left
3207 proc trace_commit_type {varname args} {
3208 global ui_coml commit_type
3209 switch -glob -- $commit_type {
3210 initial {set txt [mc "Initial Commit Message:"]}
3211 amend {set txt [mc "Amended Commit Message:"]}
3212 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3213 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3214 merge {set txt [mc "Merge Commit Message:"]}
3215 * {set txt [mc "Commit Message:"]}
3217 $ui_coml conf -text $txt
3219 trace add variable commit_type write trace_commit_type
3220 pack $ui_coml -side left -fill x
3222 if {![is_enabled nocommit]} {
3223 pack .vpane.lower.commarea.buffer.header.amend -side right
3224 pack .vpane.lower.commarea.buffer.header.new -side right
3227 text $ui_comm -background white -foreground black \
3228 -borderwidth 1 \
3229 -undo true \
3230 -maxundo 20 \
3231 -autoseparators true \
3232 -relief sunken \
3233 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3234 -font font_diff \
3235 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3236 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3237 -command [list $ui_comm yview]
3238 pack .vpane.lower.commarea.buffer.header -side top -fill x
3239 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3240 pack $ui_comm -side left -fill y
3241 pack .vpane.lower.commarea.buffer -side left -fill y
3243 # -- Commit Message Buffer Context Menu
3245 set ctxm .vpane.lower.commarea.buffer.ctxm
3246 menu $ctxm -tearoff 0
3247 $ctxm add command \
3248 -label [mc Cut] \
3249 -command {tk_textCut $ui_comm}
3250 $ctxm add command \
3251 -label [mc Copy] \
3252 -command {tk_textCopy $ui_comm}
3253 $ctxm add command \
3254 -label [mc Paste] \
3255 -command {tk_textPaste $ui_comm}
3256 $ctxm add command \
3257 -label [mc Delete] \
3258 -command {catch {$ui_comm delete sel.first sel.last}}
3259 $ctxm add separator
3260 $ctxm add command \
3261 -label [mc "Select All"] \
3262 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3263 $ctxm add command \
3264 -label [mc "Copy All"] \
3265 -command {
3266 $ui_comm tag add sel 0.0 end
3267 tk_textCopy $ui_comm
3268 $ui_comm tag remove sel 0.0 end
3270 $ctxm add separator
3271 $ctxm add command \
3272 -label [mc "Sign Off"] \
3273 -command do_signoff
3274 set ui_comm_ctxm $ctxm
3276 # -- Diff Header
3278 proc trace_current_diff_path {varname args} {
3279 global current_diff_path diff_actions file_states
3280 if {$current_diff_path eq {}} {
3281 set s {}
3282 set f {}
3283 set p {}
3284 set o disabled
3285 } else {
3286 set p $current_diff_path
3287 set s [mapdesc [lindex $file_states($p) 0] $p]
3288 set f [mc "File:"]
3289 set p [escape_path $p]
3290 set o normal
3293 .vpane.lower.diff.header.status configure -text $s
3294 .vpane.lower.diff.header.file configure -text $f
3295 .vpane.lower.diff.header.path configure -text $p
3296 foreach w $diff_actions {
3297 uplevel #0 $w $o
3300 trace add variable current_diff_path write trace_current_diff_path
3302 gold_frame .vpane.lower.diff.header
3303 tlabel .vpane.lower.diff.header.status \
3304 -background gold \
3305 -foreground black \
3306 -width $max_status_desc \
3307 -anchor w \
3308 -justify left
3309 tlabel .vpane.lower.diff.header.file \
3310 -background gold \
3311 -foreground black \
3312 -anchor w \
3313 -justify left
3314 tlabel .vpane.lower.diff.header.path \
3315 -background gold \
3316 -foreground black \
3317 -anchor w \
3318 -justify left
3319 pack .vpane.lower.diff.header.status -side left
3320 pack .vpane.lower.diff.header.file -side left
3321 pack .vpane.lower.diff.header.path -fill x
3322 set ctxm .vpane.lower.diff.header.ctxm
3323 menu $ctxm -tearoff 0
3324 $ctxm add command \
3325 -label [mc Copy] \
3326 -command {
3327 clipboard clear
3328 clipboard append \
3329 -format STRING \
3330 -type STRING \
3331 -- $current_diff_path
3333 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3334 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3336 # -- Diff Body
3338 ${NS}::frame .vpane.lower.diff.body
3339 set ui_diff .vpane.lower.diff.body.t
3340 text $ui_diff -background white -foreground black \
3341 -borderwidth 0 \
3342 -width 80 -height 5 -wrap none \
3343 -font font_diff \
3344 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3345 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3346 -state disabled
3347 catch {$ui_diff configure -tabstyle wordprocessor}
3348 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3349 -command [list $ui_diff xview]
3350 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3351 -command [list $ui_diff yview]
3352 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3353 pack .vpane.lower.diff.body.sby -side right -fill y
3354 pack $ui_diff -side left -fill both -expand 1
3355 pack .vpane.lower.diff.header -side top -fill x
3356 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3358 foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3359 $ui_diff tag configure clr4$n -background $c
3360 $ui_diff tag configure clri4$n -foreground $c
3361 $ui_diff tag configure clr3$n -foreground $c
3362 $ui_diff tag configure clri3$n -background $c
3364 $ui_diff tag configure clr1 -font font_diffbold
3366 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3368 $ui_diff tag conf d_cr -elide true
3369 $ui_diff tag conf d_@ -font font_diffbold
3370 $ui_diff tag conf d_+ -foreground {#00a000}
3371 $ui_diff tag conf d_- -foreground red
3373 $ui_diff tag conf d_++ -foreground {#00a000}
3374 $ui_diff tag conf d_-- -foreground red
3375 $ui_diff tag conf d_+s \
3376 -foreground {#00a000} \
3377 -background {#e2effa}
3378 $ui_diff tag conf d_-s \
3379 -foreground red \
3380 -background {#e2effa}
3381 $ui_diff tag conf d_s+ \
3382 -foreground {#00a000} \
3383 -background ivory1
3384 $ui_diff tag conf d_s- \
3385 -foreground red \
3386 -background ivory1
3388 $ui_diff tag conf d< \
3389 -foreground orange \
3390 -font font_diffbold
3391 $ui_diff tag conf d= \
3392 -foreground orange \
3393 -font font_diffbold
3394 $ui_diff tag conf d> \
3395 -foreground orange \
3396 -font font_diffbold
3398 $ui_diff tag raise sel
3400 # -- Diff Body Context Menu
3403 proc create_common_diff_popup {ctxm} {
3404 $ctxm add command \
3405 -label [mc Refresh] \
3406 -command reshow_diff
3407 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3408 $ctxm add command \
3409 -label [mc Copy] \
3410 -command {tk_textCopy $ui_diff}
3411 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3412 $ctxm add command \
3413 -label [mc "Select All"] \
3414 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3415 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3416 $ctxm add command \
3417 -label [mc "Copy All"] \
3418 -command {
3419 $ui_diff tag add sel 0.0 end
3420 tk_textCopy $ui_diff
3421 $ui_diff tag remove sel 0.0 end
3423 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3424 $ctxm add separator
3425 $ctxm add command \
3426 -label [mc "Decrease Font Size"] \
3427 -command {incr_font_size font_diff -1}
3428 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3429 $ctxm add command \
3430 -label [mc "Increase Font Size"] \
3431 -command {incr_font_size font_diff 1}
3432 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3433 $ctxm add separator
3434 set emenu $ctxm.enc
3435 menu $emenu
3436 build_encoding_menu $emenu [list force_diff_encoding]
3437 $ctxm add cascade \
3438 -label [mc "Encoding"] \
3439 -menu $emenu
3440 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3441 $ctxm add separator
3442 $ctxm add command -label [mc "Options..."] \
3443 -command do_options
3446 set ctxm .vpane.lower.diff.body.ctxm
3447 menu $ctxm -tearoff 0
3448 $ctxm add command \
3449 -label [mc "Apply/Reverse Hunk"] \
3450 -command {apply_hunk $cursorX $cursorY}
3451 set ui_diff_applyhunk [$ctxm index last]
3452 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3453 $ctxm add command \
3454 -label [mc "Apply/Reverse Line"] \
3455 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3456 set ui_diff_applyline [$ctxm index last]
3457 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3458 $ctxm add separator
3459 $ctxm add command \
3460 -label [mc "Show Less Context"] \
3461 -command show_less_context
3462 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3463 $ctxm add command \
3464 -label [mc "Show More Context"] \
3465 -command show_more_context
3466 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3467 $ctxm add separator
3468 create_common_diff_popup $ctxm
3470 set ctxmmg .vpane.lower.diff.body.ctxmmg
3471 menu $ctxmmg -tearoff 0
3472 $ctxmmg add command \
3473 -label [mc "Run Merge Tool"] \
3474 -command {merge_resolve_tool}
3475 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3476 $ctxmmg add separator
3477 $ctxmmg add command \
3478 -label [mc "Use Remote Version"] \
3479 -command {merge_resolve_one 3}
3480 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3481 $ctxmmg add command \
3482 -label [mc "Use Local Version"] \
3483 -command {merge_resolve_one 2}
3484 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3485 $ctxmmg add command \
3486 -label [mc "Revert To Base"] \
3487 -command {merge_resolve_one 1}
3488 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3489 $ctxmmg add separator
3490 $ctxmmg add command \
3491 -label [mc "Show Less Context"] \
3492 -command show_less_context
3493 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3494 $ctxmmg add command \
3495 -label [mc "Show More Context"] \
3496 -command show_more_context
3497 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3498 $ctxmmg add separator
3499 create_common_diff_popup $ctxmmg
3501 set ctxmsm .vpane.lower.diff.body.ctxmsm
3502 menu $ctxmsm -tearoff 0
3503 $ctxmsm add command \
3504 -label [mc "Visualize These Changes In The Submodule"] \
3505 -command {do_gitk -- true}
3506 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3507 $ctxmsm add command \
3508 -label [mc "Visualize Current Branch History In The Submodule"] \
3509 -command {do_gitk {} true}
3510 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3511 $ctxmsm add command \
3512 -label [mc "Visualize All Branch History In The Submodule"] \
3513 -command {do_gitk --all true}
3514 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3515 $ctxmsm add separator
3516 $ctxmsm add command \
3517 -label [mc "Start git gui In The Submodule"] \
3518 -command {do_git_gui}
3519 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3520 $ctxmsm add separator
3521 create_common_diff_popup $ctxmsm
3523 proc has_textconv {path} {
3524 if {[is_config_false gui.textconv]} {
3525 return 0
3527 set filter [gitattr $path diff set]
3528 set textconv [get_config [join [list diff $filter textconv] .]]
3529 if {$filter ne {set} && $textconv ne {}} {
3530 return 1
3531 } else {
3532 return 0
3536 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3537 global current_diff_path file_states
3538 set ::cursorX $x
3539 set ::cursorY $y
3540 if {[info exists file_states($current_diff_path)]} {
3541 set state [lindex $file_states($current_diff_path) 0]
3542 } else {
3543 set state {__}
3545 if {[string first {U} $state] >= 0} {
3546 tk_popup $ctxmmg $X $Y
3547 } elseif {$::is_submodule_diff} {
3548 tk_popup $ctxmsm $X $Y
3549 } else {
3550 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3551 if {$::ui_index eq $::current_diff_side} {
3552 set l [mc "Unstage Hunk From Commit"]
3553 if {$has_range} {
3554 set t [mc "Unstage Lines From Commit"]
3555 } else {
3556 set t [mc "Unstage Line From Commit"]
3558 } else {
3559 set l [mc "Stage Hunk For Commit"]
3560 if {$has_range} {
3561 set t [mc "Stage Lines For Commit"]
3562 } else {
3563 set t [mc "Stage Line For Commit"]
3566 if {$::is_3way_diff
3567 || $current_diff_path eq {}
3568 || {__} eq $state
3569 || {_O} eq $state
3570 || [string match {?T} $state]
3571 || [string match {T?} $state]
3572 || [has_textconv $current_diff_path]} {
3573 set s disabled
3574 } else {
3575 set s normal
3577 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3578 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3579 tk_popup $ctxm $X $Y
3582 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3584 # -- Status Bar
3586 set main_status [::status_bar::new .status]
3587 pack .status -anchor w -side bottom -fill x
3588 $main_status show [mc "Initializing..."]
3590 # -- Load geometry
3592 proc on_ttk_pane_mapped {w pane pos} {
3593 bind $w <Map> {}
3594 after 0 [list after idle [list $w sashpos $pane $pos]]
3596 proc on_tk_pane_mapped {w pane x y} {
3597 bind $w <Map> {}
3598 after 0 [list after idle [list $w sash place $pane $x $y]]
3600 proc on_application_mapped {} {
3601 global repo_config use_ttk
3602 bind . <Map> {}
3603 set gm $repo_config(gui.geometry)
3604 if {$use_ttk} {
3605 bind .vpane <Map> \
3606 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3607 bind .vpane.files <Map> \
3608 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3609 } else {
3610 bind .vpane <Map> \
3611 [list on_tk_pane_mapped %W 0 \
3612 [lindex $gm 1] \
3613 [lindex [.vpane sash coord 0] 1]]
3614 bind .vpane.files <Map> \
3615 [list on_tk_pane_mapped %W 0 \
3616 [lindex [.vpane.files sash coord 0] 0] \
3617 [lindex $gm 2]]
3619 wm geometry . [lindex $gm 0]
3621 if {[info exists repo_config(gui.geometry)]} {
3622 bind . <Map> [list on_application_mapped]
3623 wm geometry . [lindex $repo_config(gui.geometry) 0]
3626 # -- Load window state
3628 if {[info exists repo_config(gui.wmstate)]} {
3629 catch {wm state . $repo_config(gui.wmstate)}
3632 # -- Key Bindings
3634 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3635 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3636 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3637 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3638 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3639 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3640 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3641 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3642 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3643 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3644 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3645 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3646 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3647 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3648 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3649 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3650 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3651 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3652 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3653 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3654 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3655 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3657 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3658 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3659 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3660 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3661 bind $ui_diff <$M1B-Key-v> {break}
3662 bind $ui_diff <$M1B-Key-V> {break}
3663 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3664 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3665 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3666 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3667 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3668 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3669 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3670 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3671 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3672 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3673 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3674 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3675 bind $ui_diff <Button-1> {focus %W}
3677 if {[is_enabled branch]} {
3678 bind . <$M1B-Key-n> branch_create::dialog
3679 bind . <$M1B-Key-N> branch_create::dialog
3680 bind . <$M1B-Key-o> branch_checkout::dialog
3681 bind . <$M1B-Key-O> branch_checkout::dialog
3682 bind . <$M1B-Key-m> merge::dialog
3683 bind . <$M1B-Key-M> merge::dialog
3685 if {[is_enabled transport]} {
3686 bind . <$M1B-Key-p> do_push_anywhere
3687 bind . <$M1B-Key-P> do_push_anywhere
3690 bind . <Key-F5> ui_do_rescan
3691 bind . <$M1B-Key-r> ui_do_rescan
3692 bind . <$M1B-Key-R> ui_do_rescan
3693 bind . <$M1B-Key-s> do_signoff
3694 bind . <$M1B-Key-S> do_signoff
3695 bind . <$M1B-Key-t> do_add_selection
3696 bind . <$M1B-Key-T> do_add_selection
3697 bind . <$M1B-Key-j> do_revert_selection
3698 bind . <$M1B-Key-J> do_revert_selection
3699 bind . <$M1B-Key-i> do_add_all
3700 bind . <$M1B-Key-I> do_add_all
3701 bind . <$M1B-Key-minus> {show_less_context;break}
3702 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3703 bind . <$M1B-Key-equal> {show_more_context;break}
3704 bind . <$M1B-Key-plus> {show_more_context;break}
3705 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3706 bind . <$M1B-Key-Return> do_commit
3707 foreach i [list $ui_index $ui_workdir] {
3708 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3709 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3710 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3712 unset i
3714 set file_lists($ui_index) [list]
3715 set file_lists($ui_workdir) [list]
3717 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3718 focus -force $ui_comm
3720 # -- Warn the user about environmental problems. Cygwin's Tcl
3721 # does *not* pass its env array onto any processes it spawns.
3722 # This means that git processes get none of our environment.
3724 if {[is_Cygwin]} {
3725 set ignored_env 0
3726 set suggest_user {}
3727 set msg [mc "Possible environment issues exist.
3729 The following environment variables are probably
3730 going to be ignored by any Git subprocess run
3731 by %s:
3733 " [appname]]
3734 foreach name [array names env] {
3735 switch -regexp -- $name {
3736 {^GIT_INDEX_FILE$} -
3737 {^GIT_OBJECT_DIRECTORY$} -
3738 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3739 {^GIT_DIFF_OPTS$} -
3740 {^GIT_EXTERNAL_DIFF$} -
3741 {^GIT_PAGER$} -
3742 {^GIT_TRACE$} -
3743 {^GIT_CONFIG$} -
3744 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3745 append msg " - $name\n"
3746 incr ignored_env
3748 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3749 append msg " - $name\n"
3750 incr ignored_env
3751 set suggest_user $name
3755 if {$ignored_env > 0} {
3756 append msg [mc "
3757 This is due to a known issue with the
3758 Tcl binary distributed by Cygwin."]
3760 if {$suggest_user ne {}} {
3761 append msg [mc "
3763 A good replacement for %s
3764 is placing values for the user.name and
3765 user.email settings into your personal
3766 ~/.gitconfig file.
3767 " $suggest_user]
3769 warn_popup $msg
3771 unset ignored_env msg suggest_user name
3774 # -- Only initialize complex UI if we are going to stay running.
3776 if {[is_enabled transport]} {
3777 load_all_remotes
3779 set n [.mbar.remote index end]
3780 populate_remotes_menu
3781 set n [expr {[.mbar.remote index end] - $n}]
3782 if {$n > 0} {
3783 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3784 .mbar.remote insert $n separator
3786 unset n
3789 if {[winfo exists $ui_comm]} {
3790 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3792 # -- If both our backup and message files exist use the
3793 # newer of the two files to initialize the buffer.
3795 if {$GITGUI_BCK_exists} {
3796 set m [gitdir GITGUI_MSG]
3797 if {[file isfile $m]} {
3798 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3799 catch {file delete [gitdir GITGUI_MSG]}
3800 } else {
3801 $ui_comm delete 0.0 end
3802 $ui_comm edit reset
3803 $ui_comm edit modified false
3804 catch {file delete [gitdir GITGUI_BCK]}
3805 set GITGUI_BCK_exists 0
3808 unset m
3811 proc backup_commit_buffer {} {
3812 global ui_comm GITGUI_BCK_exists
3814 set m [$ui_comm edit modified]
3815 if {$m || $GITGUI_BCK_exists} {
3816 set msg [string trim [$ui_comm get 0.0 end]]
3817 regsub -all -line {[ \r\t]+$} $msg {} msg
3819 if {$msg eq {}} {
3820 if {$GITGUI_BCK_exists} {
3821 catch {file delete [gitdir GITGUI_BCK]}
3822 set GITGUI_BCK_exists 0
3824 } elseif {$m} {
3825 catch {
3826 set fd [open [gitdir GITGUI_BCK] w]
3827 puts -nonewline $fd $msg
3828 close $fd
3829 set GITGUI_BCK_exists 1
3833 $ui_comm edit modified false
3836 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3839 backup_commit_buffer
3841 # -- If the user has aspell available we can drive it
3842 # in pipe mode to spellcheck the commit message.
3844 set spell_cmd [list |]
3845 set spell_dict [get_config gui.spellingdictionary]
3846 lappend spell_cmd aspell
3847 if {$spell_dict ne {}} {
3848 lappend spell_cmd --master=$spell_dict
3850 lappend spell_cmd --mode=none
3851 lappend spell_cmd --encoding=utf-8
3852 lappend spell_cmd pipe
3853 if {$spell_dict eq {none}
3854 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3855 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3856 } else {
3857 set ui_comm_spell [spellcheck::init \
3858 $spell_fd \
3859 $ui_comm \
3860 $ui_comm_ctxm \
3863 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3866 lock_index begin-read
3867 if {![winfo ismapped .]} {
3868 wm deiconify .
3870 after 1 {
3871 if {[is_enabled initialamend]} {
3872 force_amend
3873 } else {
3874 do_rescan
3877 if {[is_enabled nocommitmsg]} {
3878 $ui_comm configure -state disabled -background gray
3881 if {[is_enabled multicommit]} {
3882 after 1000 hint_gc
3884 if {[is_enabled retcode]} {
3885 bind . <Destroy> {+terminate_me %W}
3887 if {$picked && [is_config_true gui.autoexplore]} {
3888 do_explore
3891 # Local variables:
3892 # mode: tcl
3893 # indent-tabs-mode: t
3894 # tab-width: 4
3895 # End: