Win32: use low-level memory allocation during initialization
[git/dscho.git] / git-gui / git-gui.sh
blobe5038ddd1211031922b34647fb5b3c60ead186e4
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
303 set v [string tolower $v]
304 if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
305 return 1
306 } else {
307 return 0
311 proc is_config_false {name} {
312 global repo_config
313 if {[catch {set v $repo_config($name)}]} {
314 return 0
316 set v [string tolower $v]
317 if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
318 return 1
319 } else {
320 return 0
324 proc get_config {name} {
325 global repo_config
326 if {[catch {set v $repo_config($name)}]} {
327 return {}
328 } else {
329 return $v
333 proc is_bare {} {
334 global _isbare
335 global _gitdir
336 global _gitworktree
338 if {$_isbare eq {}} {
339 if {[catch {
340 set _bare [git rev-parse --is-bare-repository]
341 switch -- $_bare {
342 true { set _isbare 1 }
343 false { set _isbare 0}
344 default { throw }
346 }]} {
347 if {[is_config_true core.bare]
348 || ($_gitworktree eq {}
349 && [lindex [file split $_gitdir] end] ne {.git})} {
350 set _isbare 1
351 } else {
352 set _isbare 0
356 return $_isbare
359 ######################################################################
361 ## handy utils
363 proc _trace_exec {cmd} {
364 if {!$::_trace} return
365 set d {}
366 foreach v $cmd {
367 if {$d ne {}} {
368 append d { }
370 if {[regexp {[ \t\r\n'"$?*]} $v]} {
371 set v [sq $v]
373 append d $v
375 puts stderr $d
378 #'" fix poor old emacs font-lock mode
380 proc _git_cmd {name} {
381 global _git_cmd_path
383 if {[catch {set v $_git_cmd_path($name)}]} {
384 switch -- $name {
385 version -
386 --version -
387 --exec-path { return [list $::_git $name] }
390 set p [gitexec git-$name$::_search_exe]
391 if {[file exists $p]} {
392 set v [list $p]
393 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
394 # Try to determine what sort of magic will make
395 # git-$name go and do its thing, because native
396 # Tcl on Windows doesn't know it.
398 set p [gitexec git-$name]
399 set f [open $p r]
400 set s [gets $f]
401 close $f
403 switch -glob -- [lindex $s 0] {
404 #!*sh { set i sh }
405 #!*perl { set i perl }
406 #!*python { set i python }
407 default { error "git-$name is not supported: $s" }
410 upvar #0 _$i interp
411 if {![info exists interp]} {
412 set interp [_which $i]
414 if {$interp eq {}} {
415 error "git-$name requires $i (not in PATH)"
417 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
418 } else {
419 # Assume it is builtin to git somehow and we
420 # aren't actually able to see a file for it.
422 set v [list $::_git $name]
424 set _git_cmd_path($name) $v
426 return $v
429 proc _which {what args} {
430 global env _search_exe _search_path
432 if {$_search_path eq {}} {
433 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
434 set _search_path [split [exec cygpath \
435 --windows \
436 --path \
437 --absolute \
438 $env(PATH)] {;}]
439 set _search_exe .exe
440 } elseif {[is_Windows]} {
441 set gitguidir [file dirname [info script]]
442 regsub -all ";" $gitguidir "\\;" gitguidir
443 set env(PATH) "$gitguidir;$env(PATH)"
444 set _search_path [split $env(PATH) {;}]
445 set _search_exe .exe
446 } else {
447 set _search_path [split $env(PATH) :]
448 set _search_exe {}
452 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
453 set suffix {}
454 } else {
455 set suffix $_search_exe
458 foreach p $_search_path {
459 set p [file join $p $what$suffix]
460 if {[file exists $p]} {
461 return [file normalize $p]
464 return {}
467 # Test a file for a hashbang to identify executable scripts on Windows.
468 proc is_shellscript {filename} {
469 if {![file exists $filename]} {return 0}
470 set f [open $filename r]
471 fconfigure $f -encoding binary
472 set magic [read $f 2]
473 close $f
474 return [expr {$magic eq "#!"}]
477 # Run a command connected via pipes on stdout.
478 # This is for use with textconv filters and uses sh -c "..." to allow it to
479 # contain a command with arguments. On windows we must check for shell
480 # scripts specifically otherwise just call the filter command.
481 proc open_cmd_pipe {cmd path} {
482 global env
483 if {![file executable [shellpath]]} {
484 set exe [auto_execok [lindex $cmd 0]]
485 if {[is_shellscript [lindex $exe 0]]} {
486 set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path]
487 } else {
488 set run [concat $exe [lrange $cmd 1 end] $path]
490 } else {
491 set run [list [shellpath] -c "$cmd \"\$0\"" $path]
493 return [open |$run r]
496 proc _lappend_nice {cmd_var} {
497 global _nice
498 upvar $cmd_var cmd
500 if {![info exists _nice]} {
501 set _nice [_which nice]
502 if {[catch {exec $_nice git version}]} {
503 set _nice {}
504 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
505 set _nice {}
508 if {$_nice ne {}} {
509 lappend cmd $_nice
513 proc git {args} {
514 set opt [list]
516 while {1} {
517 switch -- [lindex $args 0] {
518 --nice {
519 _lappend_nice opt
522 default {
523 break
528 set args [lrange $args 1 end]
531 set cmdp [_git_cmd [lindex $args 0]]
532 set args [lrange $args 1 end]
534 _trace_exec [concat $opt $cmdp $args]
535 set result [eval exec $opt $cmdp $args]
536 if {[encoding system] != "utf-8"} {
537 set result [encoding convertfrom utf-8 [encoding convertto $result]]
539 if {$::_trace} {
540 puts stderr "< $result"
542 return $result
545 proc _open_stdout_stderr {cmd} {
546 _trace_exec $cmd
547 if {[catch {
548 set fd [open [concat [list | ] $cmd] r]
549 } err]} {
550 if { [lindex $cmd end] eq {2>@1}
551 && $err eq {can not find channel named "1"}
553 # Older versions of Tcl 8.4 don't have this 2>@1 IO
554 # redirect operator. Fallback to |& cat for those.
555 # The command was not actually started, so its safe
556 # to try to start it a second time.
558 set fd [open [concat \
559 [list | ] \
560 [lrange $cmd 0 end-1] \
561 [list |& cat] \
562 ] r]
563 } else {
564 error $err
567 fconfigure $fd -eofchar {}
568 return $fd
571 proc git_read {args} {
572 set opt [list]
574 while {1} {
575 switch -- [lindex $args 0] {
576 --nice {
577 _lappend_nice opt
580 --stderr {
581 lappend args 2>@1
584 default {
585 break
590 set args [lrange $args 1 end]
593 set cmdp [_git_cmd [lindex $args 0]]
594 set args [lrange $args 1 end]
596 return [_open_stdout_stderr [concat $opt $cmdp $args]]
599 proc git_write {args} {
600 set opt [list]
602 while {1} {
603 switch -- [lindex $args 0] {
604 --nice {
605 _lappend_nice opt
608 default {
609 break
614 set args [lrange $args 1 end]
617 set cmdp [_git_cmd [lindex $args 0]]
618 set args [lrange $args 1 end]
620 _trace_exec [concat $opt $cmdp $args]
621 return [open [concat [list | ] $opt $cmdp $args] w]
624 proc githook_read {hook_name args} {
625 set pchook [gitdir hooks $hook_name]
626 lappend args 2>@1
628 # On Windows [file executable] might lie so we need to ask
629 # the shell if the hook is executable. Yes that's annoying.
631 if {[is_Windows]} {
632 upvar #0 _sh interp
633 if {![info exists interp]} {
634 set interp [_which sh]
636 if {$interp eq {}} {
637 error "hook execution requires sh (not in PATH)"
640 set scr {if test -x "$1";then exec "$@";fi}
641 set sh_c [list $interp -c $scr $interp $pchook]
642 return [_open_stdout_stderr [concat $sh_c $args]]
645 if {[file executable $pchook]} {
646 return [_open_stdout_stderr [concat [list $pchook] $args]]
649 return {}
652 proc kill_file_process {fd} {
653 set process [pid $fd]
655 catch {
656 if {[is_Windows]} {
657 # Use a Cygwin-specific flag to allow killing
658 # native Windows processes
659 exec kill -f $process
660 } else {
661 exec kill $process
666 proc gitattr {path attr default} {
667 if {[catch {set r [git check-attr $attr -- $path]}]} {
668 set r unspecified
669 } else {
670 set r [join [lrange [split $r :] 2 end] :]
671 regsub {^ } $r {} r
673 if {$r eq {unspecified}} {
674 return $default
676 return $r
679 proc sq {value} {
680 regsub -all ' $value "'\\''" value
681 return "'$value'"
684 proc load_current_branch {} {
685 global current_branch is_detached
687 set fd [open [gitdir HEAD] r]
688 if {[gets $fd ref] < 1} {
689 set ref {}
691 close $fd
693 set pfx {ref: refs/heads/}
694 set len [string length $pfx]
695 if {[string equal -length $len $pfx $ref]} {
696 # We're on a branch. It might not exist. But
697 # HEAD looks good enough to be a branch.
699 set current_branch [string range $ref $len end]
700 set is_detached 0
701 } else {
702 # Assume this is a detached head.
704 set current_branch HEAD
705 set is_detached 1
709 auto_load tk_optionMenu
710 rename tk_optionMenu real__tkOptionMenu
711 proc tk_optionMenu {w varName args} {
712 set m [eval real__tkOptionMenu $w $varName $args]
713 $m configure -font font_ui
714 $w configure -font font_ui
715 return $m
718 proc rmsel_tag {text} {
719 $text tag conf sel \
720 -background [$text cget -background] \
721 -foreground [$text cget -foreground] \
722 -borderwidth 0
723 $text tag conf in_sel -background lightgray
724 bind $text <Motion> break
725 return $text
728 wm withdraw .
729 set root_exists 0
730 bind . <Visibility> {
731 bind . <Visibility> {}
732 set root_exists 1
735 if {[is_Windows]} {
736 wm iconbitmap . -default $oguilib/git-gui.ico
737 set ::tk::AlwaysShowSelection 1
738 bind . <Control-F2> {console show}
740 # Spoof an X11 display for SSH
741 if {![info exists env(DISPLAY)]} {
742 set env(DISPLAY) :9999
744 } else {
745 catch {
746 image create photo gitlogo -width 16 -height 16
748 gitlogo put #33CC33 -to 7 0 9 2
749 gitlogo put #33CC33 -to 4 2 12 4
750 gitlogo put #33CC33 -to 7 4 9 6
751 gitlogo put #CC3333 -to 4 6 12 8
752 gitlogo put gray26 -to 4 9 6 10
753 gitlogo put gray26 -to 3 10 6 12
754 gitlogo put gray26 -to 8 9 13 11
755 gitlogo put gray26 -to 8 11 10 12
756 gitlogo put gray26 -to 11 11 13 14
757 gitlogo put gray26 -to 3 12 5 14
758 gitlogo put gray26 -to 5 13
759 gitlogo put gray26 -to 10 13
760 gitlogo put gray26 -to 4 14 12 15
761 gitlogo put gray26 -to 5 15 11 16
762 gitlogo redither
764 image create photo gitlogo32 -width 32 -height 32
765 gitlogo32 copy gitlogo -zoom 2 2
767 wm iconphoto . -default gitlogo gitlogo32
771 ######################################################################
773 ## config defaults
775 set cursor_ptr arrow
776 font create font_ui
777 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
778 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
779 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
780 } else {
781 font create font_diff -family Courier -size 10
782 catch {
783 label .dummy
784 eval font configure font_ui [font actual [.dummy cget -font]]
785 destroy .dummy
789 font create font_uiitalic
790 font create font_uibold
791 font create font_diffbold
792 font create font_diffitalic
794 foreach class {Button Checkbutton Entry Label
795 Labelframe Listbox Message
796 Radiobutton Spinbox Text} {
797 option add *$class.font font_ui
799 if {![is_MacOSX]} {
800 option add *Menu.font font_ui
801 option add *Entry.borderWidth 1 startupFile
802 option add *Entry.relief sunken startupFile
803 option add *RadioButton.anchor w startupFile
805 unset class
807 if {[is_Windows] || [is_MacOSX]} {
808 option add *Menu.tearOff 0
811 if {[is_MacOSX]} {
812 set M1B M1
813 set M1T Cmd
814 } else {
815 set M1B Control
816 set M1T Ctrl
819 proc bind_button3 {w cmd} {
820 bind $w <Any-Button-3> $cmd
821 if {[is_MacOSX]} {
822 # Mac OS X sends Button-2 on right click through three-button mouse,
823 # or through trackpad right-clicking (two-finger touch + click).
824 bind $w <Any-Button-2> $cmd
825 bind $w <Control-Button-1> $cmd
829 proc apply_config {} {
830 global repo_config font_descs
832 foreach option $font_descs {
833 set name [lindex $option 0]
834 set font [lindex $option 1]
835 if {[catch {
836 set need_weight 1
837 foreach {cn cv} $repo_config(gui.$name) {
838 if {$cn eq {-weight}} {
839 set need_weight 0
841 font configure $font $cn $cv
843 if {$need_weight} {
844 font configure $font -weight normal
846 } err]} {
847 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
849 foreach {cn cv} [font configure $font] {
850 font configure ${font}bold $cn $cv
851 font configure ${font}italic $cn $cv
853 font configure ${font}bold -weight bold
854 font configure ${font}italic -slant italic
857 global use_ttk NS
858 set use_ttk 0
859 set NS {}
860 if {$repo_config(gui.usettk)} {
861 set use_ttk [package vsatisfies [package provide Tk] 8.5]
862 if {$use_ttk} {
863 set NS ttk
864 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
865 pave_toplevel .
870 set default_config(branch.autosetupmerge) true
871 set default_config(merge.tool) {}
872 set default_config(mergetool.keepbackup) true
873 set default_config(merge.diffstat) true
874 set default_config(merge.summary) false
875 set default_config(merge.verbosity) 2
876 set default_config(user.name) {}
877 set default_config(user.email) {}
879 set default_config(gui.encoding) [encoding system]
880 set default_config(gui.matchtrackingbranch) false
881 set default_config(gui.textconv) true
882 set default_config(gui.pruneduringfetch) false
883 set default_config(gui.trustmtime) false
884 set default_config(gui.fastcopyblame) false
885 set default_config(gui.copyblamethreshold) 40
886 set default_config(gui.blamehistoryctx) 7
887 set default_config(gui.diffcontext) 5
888 set default_config(gui.diffopts) {}
889 set default_config(gui.commitmsgwidth) 75
890 set default_config(gui.newbranchtemplate) {}
891 set default_config(gui.spellingdictionary) {}
892 set default_config(gui.fontui) [font configure font_ui]
893 set default_config(gui.fontdiff) [font configure font_diff]
894 # TODO: this option should be added to the git-config documentation
895 set default_config(gui.maxfilesdisplayed) 5000
896 set default_config(gui.usettk) 1
897 set default_config(gui.warndetachedcommit) 1
898 set font_descs {
899 {fontui font_ui {mc "Main Font"}}
900 {fontdiff font_diff {mc "Diff/Console Font"}}
902 set default_config(gui.stageuntracked) ask
904 ######################################################################
906 ## find git
908 set _git [_which git]
909 if {$_git eq {}} {
910 catch {wm withdraw .}
911 tk_messageBox \
912 -icon error \
913 -type ok \
914 -title [mc "git-gui: fatal error"] \
915 -message [mc "Cannot find git in PATH."]
916 exit 1
919 ######################################################################
921 ## version check
923 if {[catch {set _git_version [git --version]} err]} {
924 catch {wm withdraw .}
925 tk_messageBox \
926 -icon error \
927 -type ok \
928 -title [mc "git-gui: fatal error"] \
929 -message "Cannot determine Git version:
931 $err
933 [appname] requires Git 1.5.0 or later."
934 exit 1
936 if {![regsub {^git version } $_git_version {} _git_version]} {
937 catch {wm withdraw .}
938 tk_messageBox \
939 -icon error \
940 -type ok \
941 -title [mc "git-gui: fatal error"] \
942 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
943 exit 1
946 proc get_trimmed_version {s} {
947 set r {}
948 foreach x [split $s -._] {
949 if {[string is integer -strict $x]} {
950 lappend r $x
951 } else {
952 break
955 return [join $r .]
957 set _real_git_version $_git_version
958 set _git_version [get_trimmed_version $_git_version]
960 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
961 catch {wm withdraw .}
962 if {[tk_messageBox \
963 -icon warning \
964 -type yesno \
965 -default no \
966 -title "[appname]: warning" \
967 -message [mc "Git version cannot be determined.
969 %s claims it is version '%s'.
971 %s requires at least Git 1.5.0 or later.
973 Assume '%s' is version 1.5.0?
974 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
975 set _git_version 1.5.0
976 } else {
977 exit 1
980 unset _real_git_version
982 proc git-version {args} {
983 global _git_version
985 switch [llength $args] {
987 return $_git_version
991 set op [lindex $args 0]
992 set vr [lindex $args 1]
993 set cm [package vcompare $_git_version $vr]
994 return [expr $cm $op 0]
998 set type [lindex $args 0]
999 set name [lindex $args 1]
1000 set parm [lindex $args 2]
1001 set body [lindex $args 3]
1003 if {($type ne {proc} && $type ne {method})} {
1004 error "Invalid arguments to git-version"
1006 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
1007 error "Last arm of $type $name must be default"
1010 foreach {op vr cb} [lrange $body 0 end-2] {
1011 if {[git-version $op $vr]} {
1012 return [uplevel [list $type $name $parm $cb]]
1016 return [uplevel [list $type $name $parm [lindex $body end]]]
1019 default {
1020 error "git-version >= x"
1026 if {[git-version < 1.5]} {
1027 catch {wm withdraw .}
1028 tk_messageBox \
1029 -icon error \
1030 -type ok \
1031 -title [mc "git-gui: fatal error"] \
1032 -message "[appname] requires Git 1.5.0 or later.
1034 You are using [git-version]:
1036 [git --version]"
1037 exit 1
1040 ######################################################################
1042 ## configure our library
1044 set idx [file join $oguilib tclIndex]
1045 if {[catch {set fd [open $idx r]} err]} {
1046 catch {wm withdraw .}
1047 tk_messageBox \
1048 -icon error \
1049 -type ok \
1050 -title [mc "git-gui: fatal error"] \
1051 -message $err
1052 exit 1
1054 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1055 set idx [list]
1056 while {[gets $fd n] >= 0} {
1057 if {$n ne {} && ![string match #* $n]} {
1058 lappend idx $n
1061 } else {
1062 set idx {}
1064 close $fd
1066 if {$idx ne {}} {
1067 set loaded [list]
1068 foreach p $idx {
1069 if {[lsearch -exact $loaded $p] >= 0} continue
1070 source [file join $oguilib $p]
1071 lappend loaded $p
1073 unset loaded p
1074 } else {
1075 set auto_path [concat [list $oguilib] $auto_path]
1077 unset -nocomplain idx fd
1079 ######################################################################
1081 ## config file parsing
1083 git-version proc _parse_config {arr_name args} {
1084 >= 1.5.3 {
1085 upvar $arr_name arr
1086 array unset arr
1087 set buf {}
1088 catch {
1089 set fd_rc [eval \
1090 [list git_read config] \
1091 $args \
1092 [list --null --list]]
1093 fconfigure $fd_rc -translation binary -encoding utf-8
1094 set buf [read $fd_rc]
1095 close $fd_rc
1097 foreach line [split $buf "\0"] {
1098 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1099 if {[is_many_config $name]} {
1100 lappend arr($name) $value
1101 } else {
1102 set arr($name) $value
1104 } elseif {[regexp {^([^\n]+)$} $line line name]} {
1105 # no value given, but interpreting them as
1106 # boolean will be handled as true
1107 set arr($name) {}
1111 default {
1112 upvar $arr_name arr
1113 array unset arr
1114 catch {
1115 set fd_rc [eval [list git_read config --list] $args]
1116 while {[gets $fd_rc line] >= 0} {
1117 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1118 if {[is_many_config $name]} {
1119 lappend arr($name) $value
1120 } else {
1121 set arr($name) $value
1123 } elseif {[regexp {^([^=]+)$} $line line name]} {
1124 # no value given, but interpreting them as
1125 # boolean will be handled as true
1126 set arr($name) {}
1129 close $fd_rc
1134 proc load_config {include_global} {
1135 global repo_config global_config system_config default_config
1137 if {$include_global} {
1138 _parse_config system_config --system
1139 _parse_config global_config --global
1141 _parse_config repo_config
1143 foreach name [array names default_config] {
1144 if {[catch {set v $system_config($name)}]} {
1145 set system_config($name) $default_config($name)
1148 foreach name [array names system_config] {
1149 if {[catch {set v $global_config($name)}]} {
1150 set global_config($name) $system_config($name)
1152 if {[catch {set v $repo_config($name)}]} {
1153 set repo_config($name) $system_config($name)
1158 ######################################################################
1160 ## feature option selection
1162 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1163 unset _junk
1164 } else {
1165 set subcommand gui
1167 if {$subcommand eq {gui.sh}} {
1168 set subcommand gui
1170 if {$subcommand eq {gui} && [llength $argv] > 0} {
1171 set subcommand [lindex $argv 0]
1172 set argv [lrange $argv 1 end]
1175 enable_option multicommit
1176 enable_option branch
1177 enable_option transport
1178 disable_option bare
1180 switch -- $subcommand {
1181 browser -
1182 blame {
1183 enable_option bare
1185 disable_option multicommit
1186 disable_option branch
1187 disable_option transport
1189 citool {
1190 enable_option singlecommit
1191 enable_option retcode
1193 disable_option multicommit
1194 disable_option branch
1195 disable_option transport
1197 while {[llength $argv] > 0} {
1198 set a [lindex $argv 0]
1199 switch -- $a {
1200 --amend {
1201 enable_option initialamend
1203 --nocommit {
1204 enable_option nocommit
1205 enable_option nocommitmsg
1207 --commitmsg {
1208 disable_option nocommitmsg
1210 default {
1211 break
1215 set argv [lrange $argv 1 end]
1220 ######################################################################
1222 ## execution environment
1224 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1226 # Suggest our implementation of askpass, if none is set
1227 if {![info exists env(SSH_ASKPASS)]} {
1228 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1230 if {![info exists env(GIT_ASKPASS)]} {
1231 set env(GIT_ASKPASS) [gitexec git-gui--askpass]
1233 if {![info exists env(GIT_ASK_YESNO)]} {
1234 set env(GIT_ASK_YESNO) [gitexec git-gui--askyesno]
1237 ######################################################################
1239 ## repository setup
1241 set picked 0
1242 if {[catch {
1243 set _gitdir $env(GIT_DIR)
1244 set _prefix {}
1246 && [catch {
1247 # beware that from the .git dir this sets _gitdir to .
1248 # and _prefix to the empty string
1249 set _gitdir [git rev-parse --git-dir]
1250 set _prefix [git rev-parse --show-prefix]
1251 } err]} {
1252 load_config 1
1253 apply_config
1254 choose_repository::pick
1255 set picked 1
1258 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1259 # run from the .git dir itself) lest the routines to find the worktree
1260 # get confused
1261 if {$_gitdir eq "."} {
1262 set _gitdir [pwd]
1265 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1266 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1268 if {![file isdirectory $_gitdir]} {
1269 catch {wm withdraw .}
1270 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1271 exit 1
1273 # _gitdir exists, so try loading the config
1274 load_config 0
1275 apply_config
1277 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
1278 if {[package vsatisfies $_git_version 1.7.0]} {
1279 set _gitworktree [git rev-parse --show-toplevel]
1280 } else {
1281 # try to set work tree from environment, core.worktree or use
1282 # cdup to obtain a relative path to the top of the worktree. If
1283 # run from the top, the ./ prefix ensures normalize expands pwd.
1284 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1285 set _gitworktree [get_config core.worktree]
1286 if {$_gitworktree eq ""} {
1287 set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1292 if {$_prefix ne {}} {
1293 if {$_gitworktree eq {}} {
1294 regsub -all {[^/]+/} $_prefix ../ cdup
1295 } else {
1296 set cdup $_gitworktree
1298 if {[catch {cd $cdup} err]} {
1299 catch {wm withdraw .}
1300 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1301 exit 1
1303 set _gitworktree [pwd]
1304 unset cdup
1305 } elseif {![is_enabled bare]} {
1306 if {[is_bare]} {
1307 catch {wm withdraw .}
1308 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1309 exit 1
1311 if {$_gitworktree eq {}} {
1312 set _gitworktree [file dirname $_gitdir]
1314 if {[catch {cd $_gitworktree} err]} {
1315 catch {wm withdraw .}
1316 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1317 exit 1
1319 set _gitworktree [pwd]
1321 set _reponame [file split [file normalize $_gitdir]]
1322 if {[lindex $_reponame end] eq {.git}} {
1323 set _reponame [lindex $_reponame end-1]
1324 } else {
1325 set _reponame [lindex $_reponame end]
1328 ######################################################################
1330 ## global init
1332 set current_diff_path {}
1333 set current_diff_side {}
1334 set diff_actions [list]
1336 set HEAD {}
1337 set PARENT {}
1338 set MERGE_HEAD [list]
1339 set commit_type {}
1340 set empty_tree {}
1341 set current_branch {}
1342 set is_detached 0
1343 set current_diff_path {}
1344 set is_3way_diff 0
1345 set is_submodule_diff 0
1346 set is_conflict_diff 0
1347 set selected_commit_type new
1348 set diff_empty_count 0
1350 set nullid "0000000000000000000000000000000000000000"
1351 set nullid2 "0000000000000000000000000000000000000001"
1353 ######################################################################
1355 ## task management
1357 set rescan_active 0
1358 set diff_active 0
1359 set last_clicked {}
1361 set disable_on_lock [list]
1362 set index_lock_type none
1364 proc lock_index {type} {
1365 global index_lock_type disable_on_lock
1367 if {$index_lock_type eq {none}} {
1368 set index_lock_type $type
1369 foreach w $disable_on_lock {
1370 uplevel #0 $w disabled
1372 return 1
1373 } elseif {$index_lock_type eq "begin-$type"} {
1374 set index_lock_type $type
1375 return 1
1377 return 0
1380 proc unlock_index {} {
1381 global index_lock_type disable_on_lock
1383 set index_lock_type none
1384 foreach w $disable_on_lock {
1385 uplevel #0 $w normal
1389 ######################################################################
1391 ## status
1393 proc repository_state {ctvar hdvar mhvar} {
1394 global current_branch
1395 upvar $ctvar ct $hdvar hd $mhvar mh
1397 set mh [list]
1399 load_current_branch
1400 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1401 set hd {}
1402 set ct initial
1403 return
1406 set merge_head [gitdir MERGE_HEAD]
1407 if {[file exists $merge_head]} {
1408 set ct merge
1409 set fd_mh [open $merge_head r]
1410 while {[gets $fd_mh line] >= 0} {
1411 lappend mh $line
1413 close $fd_mh
1414 return
1417 set ct normal
1420 proc PARENT {} {
1421 global PARENT empty_tree
1423 set p [lindex $PARENT 0]
1424 if {$p ne {}} {
1425 return $p
1427 if {$empty_tree eq {}} {
1428 set empty_tree [git mktree << {}]
1430 return $empty_tree
1433 proc force_amend {} {
1434 global selected_commit_type
1435 global HEAD PARENT MERGE_HEAD commit_type
1437 repository_state newType newHEAD newMERGE_HEAD
1438 set HEAD $newHEAD
1439 set PARENT $newHEAD
1440 set MERGE_HEAD $newMERGE_HEAD
1441 set commit_type $newType
1443 set selected_commit_type amend
1444 do_select_commit_type
1447 proc rescan {after {honor_trustmtime 1}} {
1448 global HEAD PARENT MERGE_HEAD commit_type
1449 global ui_index ui_workdir ui_comm
1450 global rescan_active file_states
1451 global repo_config
1453 if {$rescan_active > 0 || ![lock_index read]} return
1455 repository_state newType newHEAD newMERGE_HEAD
1456 if {[string match amend* $commit_type]
1457 && $newType eq {normal}
1458 && $newHEAD eq $HEAD} {
1459 } else {
1460 set HEAD $newHEAD
1461 set PARENT $newHEAD
1462 set MERGE_HEAD $newMERGE_HEAD
1463 set commit_type $newType
1466 array unset file_states
1468 if {!$::GITGUI_BCK_exists &&
1469 (![$ui_comm edit modified]
1470 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1471 if {[string match amend* $commit_type]} {
1472 } elseif {[load_message GITGUI_MSG]} {
1473 } elseif {[run_prepare_commit_msg_hook]} {
1474 } elseif {[load_message MERGE_MSG]} {
1475 } elseif {[load_message SQUASH_MSG]} {
1477 $ui_comm edit reset
1478 $ui_comm edit modified false
1481 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1482 rescan_stage2 {} $after
1483 } else {
1484 set rescan_active 1
1485 ui_status [mc "Refreshing file status..."]
1486 set fd_rf [git_read update-index \
1487 -q \
1488 --unmerged \
1489 --ignore-missing \
1490 --refresh \
1492 fconfigure $fd_rf -blocking 0 -translation binary
1493 fileevent $fd_rf readable \
1494 [list rescan_stage2 $fd_rf $after]
1498 if {[is_Cygwin]} {
1499 set is_git_info_exclude {}
1500 proc have_info_exclude {} {
1501 global is_git_info_exclude
1503 if {$is_git_info_exclude eq {}} {
1504 if {[catch {exec test -f [gitdir info exclude]}]} {
1505 set is_git_info_exclude 0
1506 } else {
1507 set is_git_info_exclude 1
1510 return $is_git_info_exclude
1512 } else {
1513 proc have_info_exclude {} {
1514 return [file readable [gitdir info exclude]]
1518 proc rescan_stage2 {fd after} {
1519 global rescan_active buf_rdi buf_rdf buf_rlo
1521 if {$fd ne {}} {
1522 read $fd
1523 if {![eof $fd]} return
1524 close $fd
1527 if {[package vsatisfies $::_git_version 1.6.3]} {
1528 set ls_others [list --exclude-standard]
1529 } else {
1530 set ls_others [list --exclude-per-directory=.gitignore]
1531 if {[have_info_exclude]} {
1532 lappend ls_others "--exclude-from=[gitdir info exclude]"
1534 set user_exclude [get_config core.excludesfile]
1535 if {$user_exclude ne {} && [file readable $user_exclude]} {
1536 lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1540 set buf_rdi {}
1541 set buf_rdf {}
1542 set buf_rlo {}
1544 set rescan_active 3
1545 ui_status [mc "Scanning for modified files ..."]
1546 set fd_di [git_read diff-index --cached -z [PARENT]]
1547 set fd_df [git_read diff-files -z]
1548 set fd_lo [eval git_read ls-files --others -z $ls_others]
1550 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1551 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1552 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1553 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1554 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1555 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1558 proc load_message {file} {
1559 global ui_comm
1561 set f [gitdir $file]
1562 if {[file isfile $f]} {
1563 if {[catch {set fd [open $f r]}]} {
1564 return 0
1566 fconfigure $fd -eofchar {}
1567 set content [string trim [read $fd]]
1568 close $fd
1569 regsub -all -line {[ \r\t]+$} $content {} content
1570 $ui_comm delete 0.0 end
1571 $ui_comm insert end $content
1572 return 1
1574 return 0
1577 proc run_prepare_commit_msg_hook {} {
1578 global pch_error
1580 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1581 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1582 # empty file but existent file.
1584 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1586 if {[file isfile [gitdir MERGE_MSG]]} {
1587 set pcm_source "merge"
1588 set fd_mm [open [gitdir MERGE_MSG] r]
1589 puts -nonewline $fd_pcm [read $fd_mm]
1590 close $fd_mm
1591 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1592 set pcm_source "squash"
1593 set fd_sm [open [gitdir SQUASH_MSG] r]
1594 puts -nonewline $fd_pcm [read $fd_sm]
1595 close $fd_sm
1596 } else {
1597 set pcm_source ""
1600 close $fd_pcm
1602 set fd_ph [githook_read prepare-commit-msg \
1603 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1604 if {$fd_ph eq {}} {
1605 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1606 return 0;
1609 ui_status [mc "Calling prepare-commit-msg hook..."]
1610 set pch_error {}
1612 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1613 fileevent $fd_ph readable \
1614 [list prepare_commit_msg_hook_wait $fd_ph]
1616 return 1;
1619 proc prepare_commit_msg_hook_wait {fd_ph} {
1620 global pch_error
1622 append pch_error [read $fd_ph]
1623 fconfigure $fd_ph -blocking 1
1624 if {[eof $fd_ph]} {
1625 if {[catch {close $fd_ph}]} {
1626 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1627 hook_failed_popup prepare-commit-msg $pch_error
1628 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1629 exit 1
1630 } else {
1631 load_message PREPARE_COMMIT_MSG
1633 set pch_error {}
1634 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1635 return
1637 fconfigure $fd_ph -blocking 0
1638 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1641 proc read_diff_index {fd after} {
1642 global buf_rdi
1644 append buf_rdi [read $fd]
1645 set c 0
1646 set n [string length $buf_rdi]
1647 while {$c < $n} {
1648 set z1 [string first "\0" $buf_rdi $c]
1649 if {$z1 == -1} break
1650 incr z1
1651 set z2 [string first "\0" $buf_rdi $z1]
1652 if {$z2 == -1} break
1654 incr c
1655 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1656 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1657 merge_state \
1658 [encoding convertfrom utf-8 $p] \
1659 [lindex $i 4]? \
1660 [list [lindex $i 0] [lindex $i 2]] \
1661 [list]
1662 set c $z2
1663 incr c
1665 if {$c < $n} {
1666 set buf_rdi [string range $buf_rdi $c end]
1667 } else {
1668 set buf_rdi {}
1671 rescan_done $fd buf_rdi $after
1674 proc read_diff_files {fd after} {
1675 global buf_rdf
1677 append buf_rdf [read $fd]
1678 set c 0
1679 set n [string length $buf_rdf]
1680 while {$c < $n} {
1681 set z1 [string first "\0" $buf_rdf $c]
1682 if {$z1 == -1} break
1683 incr z1
1684 set z2 [string first "\0" $buf_rdf $z1]
1685 if {$z2 == -1} break
1687 incr c
1688 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1689 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1690 merge_state \
1691 [encoding convertfrom utf-8 $p] \
1692 ?[lindex $i 4] \
1693 [list] \
1694 [list [lindex $i 0] [lindex $i 2]]
1695 set c $z2
1696 incr c
1698 if {$c < $n} {
1699 set buf_rdf [string range $buf_rdf $c end]
1700 } else {
1701 set buf_rdf {}
1704 rescan_done $fd buf_rdf $after
1707 proc read_ls_others {fd after} {
1708 global buf_rlo
1710 append buf_rlo [read $fd]
1711 set pck [split $buf_rlo "\0"]
1712 set buf_rlo [lindex $pck end]
1713 foreach p [lrange $pck 0 end-1] {
1714 set p [encoding convertfrom utf-8 $p]
1715 if {[string index $p end] eq {/}} {
1716 set p [string range $p 0 end-1]
1718 merge_state $p ?O
1720 rescan_done $fd buf_rlo $after
1723 proc rescan_done {fd buf after} {
1724 global rescan_active current_diff_path
1725 global file_states repo_config
1726 upvar $buf to_clear
1728 if {![eof $fd]} return
1729 set to_clear {}
1730 close $fd
1731 if {[incr rescan_active -1] > 0} return
1733 prune_selection
1734 unlock_index
1735 display_all_files
1736 if {$current_diff_path ne {}} { reshow_diff $after }
1737 if {$current_diff_path eq {}} { select_first_diff $after }
1740 proc prune_selection {} {
1741 global file_states selected_paths
1743 foreach path [array names selected_paths] {
1744 if {[catch {set still_here $file_states($path)}]} {
1745 unset selected_paths($path)
1750 ######################################################################
1752 ## ui helpers
1754 proc mapicon {w state path} {
1755 global all_icons
1757 if {[catch {set r $all_icons($state$w)}]} {
1758 puts "error: no icon for $w state={$state} $path"
1759 return file_plain
1761 return $r
1764 proc mapdesc {state path} {
1765 global all_descs
1767 if {[catch {set r $all_descs($state)}]} {
1768 puts "error: no desc for state={$state} $path"
1769 return $state
1771 return $r
1774 proc ui_status {msg} {
1775 global main_status
1776 if {[info exists main_status]} {
1777 $main_status show $msg
1781 proc ui_ready {{test {}}} {
1782 global main_status
1783 if {[info exists main_status]} {
1784 $main_status show [mc "Ready."] $test
1788 proc escape_path {path} {
1789 regsub -all {\\} $path "\\\\" path
1790 regsub -all "\n" $path "\\n" path
1791 return $path
1794 proc short_path {path} {
1795 return [escape_path [lindex [file split $path] end]]
1798 set next_icon_id 0
1799 set null_sha1 [string repeat 0 40]
1801 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1802 global file_states next_icon_id null_sha1
1804 set s0 [string index $new_state 0]
1805 set s1 [string index $new_state 1]
1807 if {[catch {set info $file_states($path)}]} {
1808 set state __
1809 set icon n[incr next_icon_id]
1810 } else {
1811 set state [lindex $info 0]
1812 set icon [lindex $info 1]
1813 if {$head_info eq {}} {set head_info [lindex $info 2]}
1814 if {$index_info eq {}} {set index_info [lindex $info 3]}
1817 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1818 elseif {$s0 eq {_}} {set s0 _}
1820 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1821 elseif {$s1 eq {_}} {set s1 _}
1823 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1824 set head_info [list 0 $null_sha1]
1825 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1826 && $head_info eq {}} {
1827 set head_info $index_info
1828 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1829 set index_info $head_info
1830 set head_info {}
1833 set file_states($path) [list $s0$s1 $icon \
1834 $head_info $index_info \
1836 return $state
1839 proc display_file_helper {w path icon_name old_m new_m} {
1840 global file_lists
1842 if {$new_m eq {_}} {
1843 set lno [lsearch -sorted -exact $file_lists($w) $path]
1844 if {$lno >= 0} {
1845 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1846 incr lno
1847 $w conf -state normal
1848 $w delete $lno.0 [expr {$lno + 1}].0
1849 $w conf -state disabled
1851 } elseif {$old_m eq {_} && $new_m ne {_}} {
1852 lappend file_lists($w) $path
1853 set file_lists($w) [lsort -unique $file_lists($w)]
1854 set lno [lsearch -sorted -exact $file_lists($w) $path]
1855 incr lno
1856 $w conf -state normal
1857 $w image create $lno.0 \
1858 -align center -padx 5 -pady 1 \
1859 -name $icon_name \
1860 -image [mapicon $w $new_m $path]
1861 $w insert $lno.1 "[escape_path $path]\n"
1862 $w conf -state disabled
1863 } elseif {$old_m ne $new_m} {
1864 $w conf -state normal
1865 $w image conf $icon_name -image [mapicon $w $new_m $path]
1866 $w conf -state disabled
1870 proc display_file {path state} {
1871 global file_states selected_paths
1872 global ui_index ui_workdir
1874 set old_m [merge_state $path $state]
1875 set s $file_states($path)
1876 set new_m [lindex $s 0]
1877 set icon_name [lindex $s 1]
1879 set o [string index $old_m 0]
1880 set n [string index $new_m 0]
1881 if {$o eq {U}} {
1882 set o _
1884 if {$n eq {U}} {
1885 set n _
1887 display_file_helper $ui_index $path $icon_name $o $n
1889 if {[string index $old_m 0] eq {U}} {
1890 set o U
1891 } else {
1892 set o [string index $old_m 1]
1894 if {[string index $new_m 0] eq {U}} {
1895 set n U
1896 } else {
1897 set n [string index $new_m 1]
1899 display_file_helper $ui_workdir $path $icon_name $o $n
1901 if {$new_m eq {__}} {
1902 unset file_states($path)
1903 catch {unset selected_paths($path)}
1907 proc display_all_files_helper {w path icon_name m} {
1908 global file_lists
1910 lappend file_lists($w) $path
1911 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1912 $w image create end \
1913 -align center -padx 5 -pady 1 \
1914 -name $icon_name \
1915 -image [mapicon $w $m $path]
1916 $w insert end "[escape_path $path]\n"
1919 set files_warning 0
1920 proc display_all_files {} {
1921 global ui_index ui_workdir
1922 global file_states file_lists
1923 global last_clicked
1924 global files_warning
1926 $ui_index conf -state normal
1927 $ui_workdir conf -state normal
1929 $ui_index delete 0.0 end
1930 $ui_workdir delete 0.0 end
1931 set last_clicked {}
1933 set file_lists($ui_index) [list]
1934 set file_lists($ui_workdir) [list]
1936 set to_display [lsort [array names file_states]]
1937 set display_limit [get_config gui.maxfilesdisplayed]
1938 if {[llength $to_display] > $display_limit} {
1939 if {!$files_warning} {
1940 # do not repeatedly warn:
1941 set files_warning 1
1942 info_popup [mc "Displaying only %s of %s files." \
1943 $display_limit [llength $to_display]]
1945 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1947 foreach path $to_display {
1948 set s $file_states($path)
1949 set m [lindex $s 0]
1950 set icon_name [lindex $s 1]
1952 set s [string index $m 0]
1953 if {$s ne {U} && $s ne {_}} {
1954 display_all_files_helper $ui_index $path \
1955 $icon_name $s
1958 if {[string index $m 0] eq {U}} {
1959 set s U
1960 } else {
1961 set s [string index $m 1]
1963 if {$s ne {_}} {
1964 display_all_files_helper $ui_workdir $path \
1965 $icon_name $s
1969 $ui_index conf -state disabled
1970 $ui_workdir conf -state disabled
1973 ######################################################################
1975 ## icons
1977 set filemask {
1978 #define mask_width 14
1979 #define mask_height 15
1980 static unsigned char mask_bits[] = {
1981 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1982 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1983 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1986 image create bitmap file_plain -background white -foreground black -data {
1987 #define plain_width 14
1988 #define plain_height 15
1989 static unsigned char plain_bits[] = {
1990 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1991 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1992 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1993 } -maskdata $filemask
1995 image create bitmap file_mod -background white -foreground blue -data {
1996 #define mod_width 14
1997 #define mod_height 15
1998 static unsigned char mod_bits[] = {
1999 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2000 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2001 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2002 } -maskdata $filemask
2004 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2005 #define file_fulltick_width 14
2006 #define file_fulltick_height 15
2007 static unsigned char file_fulltick_bits[] = {
2008 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2009 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2010 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2011 } -maskdata $filemask
2013 image create bitmap file_question -background white -foreground black -data {
2014 #define file_question_width 14
2015 #define file_question_height 15
2016 static unsigned char file_question_bits[] = {
2017 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2018 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2019 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2020 } -maskdata $filemask
2022 image create bitmap file_removed -background white -foreground red -data {
2023 #define file_removed_width 14
2024 #define file_removed_height 15
2025 static unsigned char file_removed_bits[] = {
2026 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2027 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2028 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2029 } -maskdata $filemask
2031 image create bitmap file_merge -background white -foreground blue -data {
2032 #define file_merge_width 14
2033 #define file_merge_height 15
2034 static unsigned char file_merge_bits[] = {
2035 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2036 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2037 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2038 } -maskdata $filemask
2040 image create bitmap file_statechange -background white -foreground green -data {
2041 #define file_statechange_width 14
2042 #define file_statechange_height 15
2043 static unsigned char file_statechange_bits[] = {
2044 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2045 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2046 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2047 } -maskdata $filemask
2049 set ui_index .vpane.files.index.list
2050 set ui_workdir .vpane.files.workdir.list
2052 set all_icons(_$ui_index) file_plain
2053 set all_icons(A$ui_index) file_plain
2054 set all_icons(M$ui_index) file_fulltick
2055 set all_icons(D$ui_index) file_removed
2056 set all_icons(U$ui_index) file_merge
2057 set all_icons(T$ui_index) file_statechange
2059 set all_icons(_$ui_workdir) file_plain
2060 set all_icons(M$ui_workdir) file_mod
2061 set all_icons(D$ui_workdir) file_question
2062 set all_icons(U$ui_workdir) file_merge
2063 set all_icons(O$ui_workdir) file_plain
2064 set all_icons(T$ui_workdir) file_statechange
2066 set max_status_desc 0
2067 foreach i {
2068 {__ {mc "Unmodified"}}
2070 {_M {mc "Modified, not staged"}}
2071 {M_ {mc "Staged for commit"}}
2072 {MM {mc "Portions staged for commit"}}
2073 {MD {mc "Staged for commit, missing"}}
2075 {_T {mc "File type changed, not staged"}}
2076 {MT {mc "File type changed, old type staged for commit"}}
2077 {AT {mc "File type changed, old type staged for commit"}}
2078 {T_ {mc "File type changed, staged"}}
2079 {TM {mc "File type change staged, modification not staged"}}
2080 {TD {mc "File type change staged, file missing"}}
2082 {_O {mc "Untracked, not staged"}}
2083 {A_ {mc "Staged for commit"}}
2084 {AM {mc "Portions staged for commit"}}
2085 {AD {mc "Staged for commit, missing"}}
2087 {_D {mc "Missing"}}
2088 {D_ {mc "Staged for removal"}}
2089 {DO {mc "Staged for removal, still present"}}
2091 {_U {mc "Requires merge resolution"}}
2092 {U_ {mc "Requires merge resolution"}}
2093 {UU {mc "Requires merge resolution"}}
2094 {UM {mc "Requires merge resolution"}}
2095 {UD {mc "Requires merge resolution"}}
2096 {UT {mc "Requires merge resolution"}}
2098 set text [eval [lindex $i 1]]
2099 if {$max_status_desc < [string length $text]} {
2100 set max_status_desc [string length $text]
2102 set all_descs([lindex $i 0]) $text
2104 unset i
2106 ######################################################################
2108 ## util
2110 proc scrollbar2many {list mode args} {
2111 foreach w $list {eval $w $mode $args}
2114 proc many2scrollbar {list mode sb top bottom} {
2115 $sb set $top $bottom
2116 foreach w $list {$w $mode moveto $top}
2119 proc incr_font_size {font {amt 1}} {
2120 set sz [font configure $font -size]
2121 incr sz $amt
2122 font configure $font -size $sz
2123 font configure ${font}bold -size $sz
2124 font configure ${font}italic -size $sz
2127 ######################################################################
2129 ## ui commands
2131 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2133 proc do_gitk {revs {is_submodule false}} {
2134 global current_diff_path file_states current_diff_side ui_index
2135 global _gitworktree
2137 # -- Always start gitk through whatever we were loaded with. This
2138 # lets us bypass using shell process on Windows systems.
2140 set exe [_which gitk -script]
2141 set cmd [list [info nameofexecutable] $exe]
2142 if {$exe eq {}} {
2143 error_popup [mc "Couldn't find gitk in PATH"]
2144 } else {
2145 global env
2147 if {[info exists env(GIT_DIR)]} {
2148 set old_GIT_DIR $env(GIT_DIR)
2149 } else {
2150 set old_GIT_DIR {}
2153 set pwd [pwd]
2155 if {!$is_submodule} {
2156 if {![is_bare]} {
2157 cd $_gitworktree
2159 set env(GIT_DIR) [file normalize [gitdir]]
2160 } else {
2161 cd $current_diff_path
2162 if {$revs eq {--}} {
2163 set s $file_states($current_diff_path)
2164 set old_sha1 {}
2165 set new_sha1 {}
2166 switch -glob -- [lindex $s 0] {
2167 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2168 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2169 MM {
2170 if {$current_diff_side eq $ui_index} {
2171 set old_sha1 [lindex [lindex $s 2] 1]
2172 set new_sha1 [lindex [lindex $s 3] 1]
2173 } else {
2174 set old_sha1 [lindex [lindex $s 3] 1]
2178 set revs $old_sha1...$new_sha1
2180 if {[info exists env(GIT_DIR)]} {
2181 unset env(GIT_DIR)
2184 eval exec $cmd $revs "--" "--" &
2186 if {$old_GIT_DIR ne {}} {
2187 set env(GIT_DIR) $old_GIT_DIR
2189 cd $pwd
2191 ui_status $::starting_gitk_msg
2192 after 10000 {
2193 ui_ready $starting_gitk_msg
2198 proc do_git_gui {} {
2199 global current_diff_path
2201 # -- Always start git gui through whatever we were loaded with. This
2202 # lets us bypass using shell process on Windows systems.
2204 set exe [list [_which git]]
2205 if {$exe eq {}} {
2206 error_popup [mc "Couldn't find git gui in PATH"]
2207 } else {
2208 global env
2210 if {[info exists env(GIT_DIR)]} {
2211 set old_GIT_DIR $env(GIT_DIR)
2212 unset env(GIT_DIR)
2213 } else {
2214 set old_GIT_DIR {}
2217 set pwd [pwd]
2218 cd $current_diff_path
2220 eval exec $exe gui &
2222 if {$old_GIT_DIR ne {}} {
2223 set env(GIT_DIR) $old_GIT_DIR
2225 cd $pwd
2227 ui_status $::starting_gitk_msg
2228 after 10000 {
2229 ui_ready $starting_gitk_msg
2234 proc do_explore {} {
2235 global _gitworktree
2236 set explorer {}
2237 if {[is_Cygwin] || [is_Windows]} {
2238 set explorer "explorer.exe"
2239 } elseif {[is_MacOSX]} {
2240 set explorer "open"
2241 } else {
2242 # freedesktop.org-conforming system is our best shot
2243 set explorer "xdg-open"
2245 eval exec $explorer [list [file nativename $_gitworktree]] &
2248 set is_quitting 0
2249 set ret_code 1
2251 proc terminate_me {win} {
2252 global ret_code
2253 if {$win ne {.}} return
2254 exit $ret_code
2257 proc do_quit {{rc {1}}} {
2258 global ui_comm is_quitting repo_config commit_type
2259 global GITGUI_BCK_exists GITGUI_BCK_i
2260 global ui_comm_spell
2261 global ret_code use_ttk
2263 if {$is_quitting} return
2264 set is_quitting 1
2266 if {[winfo exists $ui_comm]} {
2267 # -- Stash our current commit buffer.
2269 set save [gitdir GITGUI_MSG]
2270 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2271 file rename -force [gitdir GITGUI_BCK] $save
2272 set GITGUI_BCK_exists 0
2273 } else {
2274 set msg [string trim [$ui_comm get 0.0 end]]
2275 regsub -all -line {[ \r\t]+$} $msg {} msg
2276 if {(![string match amend* $commit_type]
2277 || [$ui_comm edit modified])
2278 && $msg ne {}} {
2279 catch {
2280 set fd [open $save w]
2281 puts -nonewline $fd $msg
2282 close $fd
2284 } else {
2285 catch {file delete $save}
2289 # -- Cancel our spellchecker if its running.
2291 if {[info exists ui_comm_spell]} {
2292 $ui_comm_spell stop
2295 # -- Remove our editor backup, its not needed.
2297 after cancel $GITGUI_BCK_i
2298 if {$GITGUI_BCK_exists} {
2299 catch {file delete [gitdir GITGUI_BCK]}
2302 # -- Stash our current window geometry into this repository.
2304 set cfg_wmstate [wm state .]
2305 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2306 set rc_wmstate {}
2308 if {$cfg_wmstate ne $rc_wmstate} {
2309 catch {git config gui.wmstate $cfg_wmstate}
2311 if {$cfg_wmstate eq {zoomed}} {
2312 # on Windows wm geometry will lie about window
2313 # position (but not size) when window is zoomed
2314 # restore the window before querying wm geometry
2315 wm state . normal
2317 set cfg_geometry [list]
2318 lappend cfg_geometry [wm geometry .]
2319 if {$use_ttk} {
2320 lappend cfg_geometry [.vpane sashpos 0]
2321 lappend cfg_geometry [.vpane.files sashpos 0]
2322 } else {
2323 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2324 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2326 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2327 set rc_geometry {}
2329 if {$cfg_geometry ne $rc_geometry} {
2330 catch {git config gui.geometry $cfg_geometry}
2334 set ret_code $rc
2336 # Briefly enable send again, working around Tk bug
2337 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2338 tk appname [appname]
2340 destroy .
2343 proc do_rescan {} {
2344 rescan ui_ready
2347 proc ui_do_rescan {} {
2348 rescan {force_first_diff ui_ready}
2351 proc do_commit {} {
2352 commit_tree
2355 proc next_diff {{after {}}} {
2356 global next_diff_p next_diff_w next_diff_i
2357 show_diff $next_diff_p $next_diff_w {} {} $after
2360 proc find_anchor_pos {lst name} {
2361 set lid [lsearch -sorted -exact $lst $name]
2363 if {$lid == -1} {
2364 set lid 0
2365 foreach lname $lst {
2366 if {$lname >= $name} break
2367 incr lid
2371 return $lid
2374 proc find_file_from {flist idx delta path mmask} {
2375 global file_states
2377 set len [llength $flist]
2378 while {$idx >= 0 && $idx < $len} {
2379 set name [lindex $flist $idx]
2381 if {$name ne $path && [info exists file_states($name)]} {
2382 set state [lindex $file_states($name) 0]
2384 if {$mmask eq {} || [regexp $mmask $state]} {
2385 return $idx
2389 incr idx $delta
2392 return {}
2395 proc find_next_diff {w path {lno {}} {mmask {}}} {
2396 global next_diff_p next_diff_w next_diff_i
2397 global file_lists ui_index ui_workdir
2399 set flist $file_lists($w)
2400 if {$lno eq {}} {
2401 set lno [find_anchor_pos $flist $path]
2402 } else {
2403 incr lno -1
2406 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2407 if {$w eq $ui_index} {
2408 set mmask "^$mmask"
2409 } else {
2410 set mmask "$mmask\$"
2414 set idx [find_file_from $flist $lno 1 $path $mmask]
2415 if {$idx eq {}} {
2416 incr lno -1
2417 set idx [find_file_from $flist $lno -1 $path $mmask]
2420 if {$idx ne {}} {
2421 set next_diff_w $w
2422 set next_diff_p [lindex $flist $idx]
2423 set next_diff_i [expr {$idx+1}]
2424 return 1
2425 } else {
2426 return 0
2430 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2431 global current_diff_path
2433 if {$path ne $current_diff_path} {
2434 return {}
2435 } elseif {[find_next_diff $w $path $lno $mmask]} {
2436 return {next_diff;}
2437 } else {
2438 return {reshow_diff;}
2442 proc select_first_diff {after} {
2443 global ui_workdir
2445 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2446 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2447 next_diff $after
2448 } else {
2449 uplevel #0 $after
2453 proc force_first_diff {after} {
2454 global ui_workdir current_diff_path file_states
2456 if {[info exists file_states($current_diff_path)]} {
2457 set state [lindex $file_states($current_diff_path) 0]
2458 } else {
2459 set state {OO}
2462 set reselect 0
2463 if {[string first {U} $state] >= 0} {
2464 # Already a conflict, do nothing
2465 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2466 set reselect 1
2467 } elseif {[string index $state 1] ne {O}} {
2468 # Already a diff & no conflicts, do nothing
2469 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2470 set reselect 1
2473 if {$reselect} {
2474 next_diff $after
2475 } else {
2476 uplevel #0 $after
2480 proc toggle_or_diff {w x y} {
2481 global file_states file_lists current_diff_path ui_index ui_workdir
2482 global last_clicked selected_paths
2484 set pos [split [$w index @$x,$y] .]
2485 set lno [lindex $pos 0]
2486 set col [lindex $pos 1]
2487 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2488 if {$path eq {}} {
2489 set last_clicked {}
2490 return
2493 set last_clicked [list $w $lno]
2494 array unset selected_paths
2495 $ui_index tag remove in_sel 0.0 end
2496 $ui_workdir tag remove in_sel 0.0 end
2498 # Determine the state of the file
2499 if {[info exists file_states($path)]} {
2500 set state [lindex $file_states($path) 0]
2501 } else {
2502 set state {__}
2505 # Restage the file, or simply show the diff
2506 if {$col == 0 && $y > 1} {
2507 # Conflicts need special handling
2508 if {[string first {U} $state] >= 0} {
2509 # $w must always be $ui_workdir, but...
2510 if {$w ne $ui_workdir} { set lno {} }
2511 merge_stage_workdir $path $lno
2512 return
2515 if {[string index $state 1] eq {O}} {
2516 set mmask {}
2517 } else {
2518 set mmask {[^O]}
2521 set after [next_diff_after_action $w $path $lno $mmask]
2523 if {$w eq $ui_index} {
2524 update_indexinfo \
2525 "Unstaging [short_path $path] from commit" \
2526 [list $path] \
2527 [concat $after [list ui_ready]]
2528 } elseif {$w eq $ui_workdir} {
2529 update_index \
2530 "Adding [short_path $path]" \
2531 [list $path] \
2532 [concat $after [list ui_ready]]
2534 } else {
2535 set selected_paths($path) 1
2536 show_diff $path $w $lno
2540 proc add_one_to_selection {w x y} {
2541 global file_lists last_clicked selected_paths
2543 set lno [lindex [split [$w index @$x,$y] .] 0]
2544 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2545 if {$path eq {}} {
2546 set last_clicked {}
2547 return
2550 if {$last_clicked ne {}
2551 && [lindex $last_clicked 0] ne $w} {
2552 array unset selected_paths
2553 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2556 set last_clicked [list $w $lno]
2557 if {[catch {set in_sel $selected_paths($path)}]} {
2558 set in_sel 0
2560 if {$in_sel} {
2561 unset selected_paths($path)
2562 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2563 } else {
2564 set selected_paths($path) 1
2565 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2569 proc add_range_to_selection {w x y} {
2570 global file_lists last_clicked selected_paths
2572 if {[lindex $last_clicked 0] ne $w} {
2573 toggle_or_diff $w $x $y
2574 return
2577 set lno [lindex [split [$w index @$x,$y] .] 0]
2578 set lc [lindex $last_clicked 1]
2579 if {$lc < $lno} {
2580 set begin $lc
2581 set end $lno
2582 } else {
2583 set begin $lno
2584 set end $lc
2587 foreach path [lrange $file_lists($w) \
2588 [expr {$begin - 1}] \
2589 [expr {$end - 1}]] {
2590 set selected_paths($path) 1
2592 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2595 proc show_more_context {} {
2596 global repo_config
2597 if {$repo_config(gui.diffcontext) < 99} {
2598 incr repo_config(gui.diffcontext)
2599 reshow_diff
2603 proc show_less_context {} {
2604 global repo_config
2605 if {$repo_config(gui.diffcontext) > 1} {
2606 incr repo_config(gui.diffcontext) -1
2607 reshow_diff
2611 ######################################################################
2613 ## ui construction
2615 set ui_comm {}
2617 # -- Menu Bar
2619 menu .mbar -tearoff 0
2620 if {[is_MacOSX]} {
2621 # -- Apple Menu (Mac OS X only)
2623 .mbar add cascade -label Apple -menu .mbar.apple
2624 menu .mbar.apple
2626 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2627 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2628 if {[is_enabled branch]} {
2629 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2631 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2632 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2634 if {[is_enabled transport]} {
2635 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2636 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2638 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2639 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2642 # -- Repository Menu
2644 menu .mbar.repository
2646 if {![is_bare]} {
2647 .mbar.repository add command \
2648 -label [mc "Explore Working Copy"] \
2649 -command {do_explore}
2650 .mbar.repository add separator
2653 .mbar.repository add command \
2654 -label [mc "Browse Current Branch's Files"] \
2655 -command {browser::new $current_branch}
2656 set ui_browse_current [.mbar.repository index last]
2657 .mbar.repository add command \
2658 -label [mc "Browse Branch Files..."] \
2659 -command browser_open::dialog
2660 .mbar.repository add separator
2662 .mbar.repository add command \
2663 -label [mc "Visualize Current Branch's History"] \
2664 -command {do_gitk $current_branch}
2665 set ui_visualize_current [.mbar.repository index last]
2666 .mbar.repository add command \
2667 -label [mc "Visualize All Branch History"] \
2668 -command {do_gitk --all}
2669 .mbar.repository add separator
2671 proc current_branch_write {args} {
2672 global current_branch
2673 .mbar.repository entryconf $::ui_browse_current \
2674 -label [mc "Browse %s's Files" $current_branch]
2675 .mbar.repository entryconf $::ui_visualize_current \
2676 -label [mc "Visualize %s's History" $current_branch]
2678 trace add variable current_branch write current_branch_write
2680 if {[is_enabled multicommit]} {
2681 .mbar.repository add command -label [mc "Database Statistics"] \
2682 -command do_stats
2684 .mbar.repository add command -label [mc "Compress Database"] \
2685 -command do_gc
2687 .mbar.repository add command -label [mc "Verify Database"] \
2688 -command do_fsck_objects
2690 .mbar.repository add separator
2692 if {[is_Cygwin]} {
2693 .mbar.repository add command \
2694 -label [mc "Create Desktop Icon"] \
2695 -command do_cygwin_shortcut
2696 } elseif {[is_Windows]} {
2697 .mbar.repository add command \
2698 -label [mc "Create Desktop Icon"] \
2699 -command do_windows_shortcut
2700 } elseif {[is_MacOSX]} {
2701 .mbar.repository add command \
2702 -label [mc "Create Desktop Icon"] \
2703 -command do_macosx_app
2707 if {[is_MacOSX]} {
2708 proc ::tk::mac::Quit {args} { do_quit }
2709 } else {
2710 .mbar.repository add command -label [mc Quit] \
2711 -command do_quit \
2712 -accelerator $M1T-Q
2715 # -- Edit Menu
2717 menu .mbar.edit
2718 .mbar.edit add command -label [mc Undo] \
2719 -command {catch {[focus] edit undo}} \
2720 -accelerator $M1T-Z
2721 .mbar.edit add command -label [mc Redo] \
2722 -command {catch {[focus] edit redo}} \
2723 -accelerator $M1T-Y
2724 .mbar.edit add separator
2725 .mbar.edit add command -label [mc Cut] \
2726 -command {catch {tk_textCut [focus]}} \
2727 -accelerator $M1T-X
2728 .mbar.edit add command -label [mc Copy] \
2729 -command {catch {tk_textCopy [focus]}} \
2730 -accelerator $M1T-C
2731 .mbar.edit add command -label [mc Paste] \
2732 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2733 -accelerator $M1T-V
2734 .mbar.edit add command -label [mc Delete] \
2735 -command {catch {[focus] delete sel.first sel.last}} \
2736 -accelerator Del
2737 .mbar.edit add separator
2738 .mbar.edit add command -label [mc "Select All"] \
2739 -command {catch {[focus] tag add sel 0.0 end}} \
2740 -accelerator $M1T-A
2742 # -- Branch Menu
2744 if {[is_enabled branch]} {
2745 menu .mbar.branch
2747 .mbar.branch add command -label [mc "Create..."] \
2748 -command branch_create::dialog \
2749 -accelerator $M1T-N
2750 lappend disable_on_lock [list .mbar.branch entryconf \
2751 [.mbar.branch index last] -state]
2753 .mbar.branch add command -label [mc "Checkout..."] \
2754 -command branch_checkout::dialog \
2755 -accelerator $M1T-O
2756 lappend disable_on_lock [list .mbar.branch entryconf \
2757 [.mbar.branch index last] -state]
2759 .mbar.branch add command -label [mc "Rename..."] \
2760 -command branch_rename::dialog
2761 lappend disable_on_lock [list .mbar.branch entryconf \
2762 [.mbar.branch index last] -state]
2764 .mbar.branch add command -label [mc "Delete..."] \
2765 -command branch_delete::dialog
2766 lappend disable_on_lock [list .mbar.branch entryconf \
2767 [.mbar.branch index last] -state]
2769 .mbar.branch add command -label [mc "Reset..."] \
2770 -command merge::reset_hard
2771 lappend disable_on_lock [list .mbar.branch entryconf \
2772 [.mbar.branch index last] -state]
2775 # -- Commit Menu
2777 proc commit_btn_caption {} {
2778 if {[is_enabled nocommit]} {
2779 return [mc "Done"]
2780 } else {
2781 return [mc Commit@@verb]
2785 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2786 menu .mbar.commit
2788 if {![is_enabled nocommit]} {
2789 .mbar.commit add radiobutton \
2790 -label [mc "New Commit"] \
2791 -command do_select_commit_type \
2792 -variable selected_commit_type \
2793 -value new
2794 lappend disable_on_lock \
2795 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2797 .mbar.commit add radiobutton \
2798 -label [mc "Amend Last Commit"] \
2799 -command do_select_commit_type \
2800 -variable selected_commit_type \
2801 -value amend
2802 lappend disable_on_lock \
2803 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2805 .mbar.commit add separator
2808 .mbar.commit add command -label [mc Rescan] \
2809 -command ui_do_rescan \
2810 -accelerator F5
2811 lappend disable_on_lock \
2812 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2814 .mbar.commit add command -label [mc "Stage To Commit"] \
2815 -command do_add_selection \
2816 -accelerator $M1T-T
2817 lappend disable_on_lock \
2818 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2820 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2821 -command do_add_all \
2822 -accelerator $M1T-I
2823 lappend disable_on_lock \
2824 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2826 .mbar.commit add command -label [mc "Unstage From Commit"] \
2827 -command do_unstage_selection \
2828 -accelerator $M1T-U
2829 lappend disable_on_lock \
2830 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2832 .mbar.commit add command -label [mc "Revert Changes"] \
2833 -command do_revert_selection \
2834 -accelerator $M1T-J
2835 lappend disable_on_lock \
2836 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2838 .mbar.commit add separator
2840 .mbar.commit add command -label [mc "Show Less Context"] \
2841 -command show_less_context \
2842 -accelerator $M1T-\-
2844 .mbar.commit add command -label [mc "Show More Context"] \
2845 -command show_more_context \
2846 -accelerator $M1T-=
2848 .mbar.commit add separator
2850 if {![is_enabled nocommitmsg]} {
2851 .mbar.commit add command -label [mc "Sign Off"] \
2852 -command do_signoff \
2853 -accelerator $M1T-S
2856 .mbar.commit add command -label [commit_btn_caption] \
2857 -command do_commit \
2858 -accelerator $M1T-Return
2859 lappend disable_on_lock \
2860 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2863 # -- Merge Menu
2865 if {[is_enabled branch]} {
2866 menu .mbar.merge
2867 .mbar.merge add command -label [mc "Local Merge..."] \
2868 -command merge::dialog \
2869 -accelerator $M1T-M
2870 lappend disable_on_lock \
2871 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2872 .mbar.merge add command -label [mc "Abort Merge..."] \
2873 -command merge::reset_hard
2874 lappend disable_on_lock \
2875 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2878 # -- Transport Menu
2880 if {[is_enabled transport]} {
2881 menu .mbar.remote
2883 .mbar.remote add command \
2884 -label [mc "Add..."] \
2885 -command remote_add::dialog \
2886 -accelerator $M1T-A
2887 .mbar.remote add command \
2888 -label [mc "Push..."] \
2889 -command do_push_anywhere \
2890 -accelerator $M1T-P
2891 .mbar.remote add command \
2892 -label [mc "Delete Branch..."] \
2893 -command remote_branch_delete::dialog
2896 if {[is_MacOSX]} {
2897 proc ::tk::mac::ShowPreferences {} {do_options}
2898 } else {
2899 # -- Edit Menu
2901 .mbar.edit add separator
2902 .mbar.edit add command -label [mc "Options..."] \
2903 -command do_options
2906 # -- Tools Menu
2908 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2909 set tools_menubar .mbar.tools
2910 menu $tools_menubar
2911 $tools_menubar add separator
2912 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2913 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2914 set tools_tailcnt 3
2915 if {[array names repo_config guitool.*.cmd] ne {}} {
2916 tools_populate_all
2920 # -- Help Menu
2922 .mbar add cascade -label [mc Help] -menu .mbar.help
2923 menu .mbar.help
2925 if {[is_MacOSX]} {
2926 .mbar.apple add command -label [mc "About %s" [appname]] \
2927 -command do_about
2928 .mbar.apple add separator
2929 } else {
2930 .mbar.help add command -label [mc "About %s" [appname]] \
2931 -command do_about
2933 . configure -menu .mbar
2935 set doc_path [githtmldir]
2936 if {$doc_path ne {}} {
2937 set doc_path [file join $doc_path index.html]
2939 if {[is_Cygwin]} {
2940 set doc_path [exec cygpath --mixed $doc_path]
2944 if {[file isfile $doc_path]} {
2945 set doc_url "file:$doc_path"
2946 } else {
2947 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2950 proc start_browser {url} {
2951 git "web--browse" $url
2954 .mbar.help add command -label [mc "Online Documentation"] \
2955 -command [list start_browser $doc_url]
2957 .mbar.help add command -label [mc "Show SSH Key"] \
2958 -command do_ssh_key
2960 unset doc_path doc_url
2962 # -- Standard bindings
2964 wm protocol . WM_DELETE_WINDOW do_quit
2965 bind all <$M1B-Key-q> do_quit
2966 bind all <$M1B-Key-Q> do_quit
2967 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2968 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2970 set subcommand_args {}
2971 proc usage {} {
2972 set s "usage: $::argv0 $::subcommand $::subcommand_args"
2973 if {[tk windowingsystem] eq "win32"} {
2974 wm withdraw .
2975 tk_messageBox -icon info -message $s \
2976 -title [mc "Usage"]
2977 } else {
2978 puts stderr $s
2980 exit 1
2983 proc normalize_relpath {path} {
2984 set elements {}
2985 foreach item [file split $path] {
2986 if {$item eq {.}} continue
2987 if {$item eq {..} && [llength $elements] > 0
2988 && [lindex $elements end] ne {..}} {
2989 set elements [lrange $elements 0 end-1]
2990 continue
2992 lappend elements $item
2994 return [eval file join $elements]
2997 # -- Not a normal commit type invocation? Do that instead!
2999 switch -- $subcommand {
3000 browser -
3001 blame {
3002 if {$subcommand eq "blame"} {
3003 set subcommand_args {[--line=<num>] rev? path}
3004 } else {
3005 set subcommand_args {rev? path}
3007 if {$argv eq {}} usage
3008 set head {}
3009 set path {}
3010 set jump_spec {}
3011 set is_path 0
3012 foreach a $argv {
3013 if {$is_path || [file exists $_prefix$a]} {
3014 if {$path ne {}} usage
3015 set path [normalize_relpath $_prefix$a]
3016 break
3017 } elseif {$a eq {--}} {
3018 if {$path ne {}} {
3019 if {$head ne {}} usage
3020 set head $path
3021 set path {}
3023 set is_path 1
3024 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3025 if {$jump_spec ne {} || $head ne {}} usage
3026 set jump_spec [list $lnum]
3027 } elseif {$head eq {}} {
3028 if {$head ne {}} usage
3029 set head $a
3030 set is_path 1
3031 } else {
3032 usage
3035 unset is_path
3037 if {$head ne {} && $path eq {}} {
3038 set path [normalize_relpath $_prefix$head]
3039 set head {}
3042 if {$head eq {}} {
3043 load_current_branch
3044 } else {
3045 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3046 if {[catch {
3047 set head [git rev-parse --verify $head]
3048 } err]} {
3049 if {[tk windowingsystem] eq "win32"} {
3050 tk_messageBox -icon error -title [mc Error] -message $err
3051 } else {
3052 puts stderr $err
3054 exit 1
3057 set current_branch $head
3060 wm deiconify .
3061 switch -- $subcommand {
3062 browser {
3063 if {$jump_spec ne {}} usage
3064 if {$head eq {}} {
3065 if {$path ne {} && [file isdirectory $path]} {
3066 set head $current_branch
3067 } else {
3068 set head $path
3069 set path {}
3072 browser::new $head $path
3074 blame {
3075 if {$head eq {} && ![file exists $path]} {
3076 catch {wm withdraw .}
3077 tk_messageBox \
3078 -icon error \
3079 -type ok \
3080 -title [mc "git-gui: fatal error"] \
3081 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3082 exit 1
3084 blame::new $head $path $jump_spec
3087 return
3089 citool -
3090 gui {
3091 if {[llength $argv] != 0} {
3092 usage
3094 # fall through to setup UI for commits
3096 default {
3097 set err "usage: $argv0 \[{blame|browser|citool}\]"
3098 if {[tk windowingsystem] eq "win32"} {
3099 wm withdraw .
3100 tk_messageBox -icon error -message $err \
3101 -title [mc "Usage"]
3102 } else {
3103 puts stderr $err
3105 exit 1
3109 # -- Branch Control
3111 ${NS}::frame .branch
3112 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3113 ${NS}::label .branch.l1 \
3114 -text [mc "Current Branch:"] \
3115 -anchor w \
3116 -justify left
3117 ${NS}::label .branch.cb \
3118 -textvariable current_branch \
3119 -anchor w \
3120 -justify left
3121 pack .branch.l1 -side left
3122 pack .branch.cb -side left -fill x
3123 pack .branch -side top -fill x
3125 # -- Main Window Layout
3127 ${NS}::panedwindow .vpane -orient horizontal
3128 ${NS}::panedwindow .vpane.files -orient vertical
3129 if {$use_ttk} {
3130 .vpane add .vpane.files
3131 } else {
3132 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3134 pack .vpane -anchor n -side top -fill both -expand 1
3136 # -- Index File List
3138 ${NS}::frame .vpane.files.index -height 100 -width 200
3139 tlabel .vpane.files.index.title \
3140 -text [mc "Staged Changes (Will Commit)"] \
3141 -background lightgreen -foreground black
3142 text $ui_index -background white -foreground black \
3143 -borderwidth 0 \
3144 -width 20 -height 10 \
3145 -wrap none \
3146 -cursor $cursor_ptr \
3147 -xscrollcommand {.vpane.files.index.sx set} \
3148 -yscrollcommand {.vpane.files.index.sy set} \
3149 -state disabled
3150 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3151 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3152 pack .vpane.files.index.title -side top -fill x
3153 pack .vpane.files.index.sx -side bottom -fill x
3154 pack .vpane.files.index.sy -side right -fill y
3155 pack $ui_index -side left -fill both -expand 1
3157 # -- Working Directory File List
3159 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3160 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3161 -background lightsalmon -foreground black
3162 text $ui_workdir -background white -foreground black \
3163 -borderwidth 0 \
3164 -width 20 -height 10 \
3165 -wrap none \
3166 -cursor $cursor_ptr \
3167 -xscrollcommand {.vpane.files.workdir.sx set} \
3168 -yscrollcommand {.vpane.files.workdir.sy set} \
3169 -state disabled
3170 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3171 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3172 pack .vpane.files.workdir.title -side top -fill x
3173 pack .vpane.files.workdir.sx -side bottom -fill x
3174 pack .vpane.files.workdir.sy -side right -fill y
3175 pack $ui_workdir -side left -fill both -expand 1
3177 .vpane.files add .vpane.files.workdir
3178 .vpane.files add .vpane.files.index
3179 if {!$use_ttk} {
3180 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3181 .vpane.files paneconfigure .vpane.files.index -sticky news
3184 foreach i [list $ui_index $ui_workdir] {
3185 rmsel_tag $i
3186 $i tag conf in_diff -background [$i tag cget in_sel -background]
3188 unset i
3190 # -- Diff and Commit Area
3192 ${NS}::frame .vpane.lower -height 300 -width 400
3193 ${NS}::frame .vpane.lower.commarea
3194 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3195 pack .vpane.lower.diff -fill both -expand 1
3196 pack .vpane.lower.commarea -side bottom -fill x
3197 .vpane add .vpane.lower
3198 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3200 # -- Commit Area Buttons
3202 ${NS}::frame .vpane.lower.commarea.buttons
3203 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3204 -anchor w \
3205 -justify left
3206 pack .vpane.lower.commarea.buttons.l -side top -fill x
3207 pack .vpane.lower.commarea.buttons -side left -fill y
3209 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3210 -command ui_do_rescan
3211 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3212 lappend disable_on_lock \
3213 {.vpane.lower.commarea.buttons.rescan conf -state}
3215 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3216 -command do_add_all
3217 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3218 lappend disable_on_lock \
3219 {.vpane.lower.commarea.buttons.incall conf -state}
3221 if {![is_enabled nocommitmsg]} {
3222 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3223 -command do_signoff
3224 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3227 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3228 -command do_commit
3229 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3230 lappend disable_on_lock \
3231 {.vpane.lower.commarea.buttons.commit conf -state}
3233 if {![is_enabled nocommit]} {
3234 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3235 -command do_push_anywhere
3236 pack .vpane.lower.commarea.buttons.push -side top -fill x
3239 # -- Commit Message Buffer
3241 ${NS}::frame .vpane.lower.commarea.buffer
3242 ${NS}::frame .vpane.lower.commarea.buffer.header
3243 set ui_comm .vpane.lower.commarea.buffer.t
3244 set ui_coml .vpane.lower.commarea.buffer.header.l
3246 if {![is_enabled nocommit]} {
3247 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3248 -text [mc "New Commit"] \
3249 -command do_select_commit_type \
3250 -variable selected_commit_type \
3251 -value new
3252 lappend disable_on_lock \
3253 [list .vpane.lower.commarea.buffer.header.new conf -state]
3254 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3255 -text [mc "Amend Last Commit"] \
3256 -command do_select_commit_type \
3257 -variable selected_commit_type \
3258 -value amend
3259 lappend disable_on_lock \
3260 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3263 ${NS}::label $ui_coml \
3264 -anchor w \
3265 -justify left
3266 proc trace_commit_type {varname args} {
3267 global ui_coml commit_type
3268 switch -glob -- $commit_type {
3269 initial {set txt [mc "Initial Commit Message:"]}
3270 amend {set txt [mc "Amended Commit Message:"]}
3271 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3272 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3273 merge {set txt [mc "Merge Commit Message:"]}
3274 * {set txt [mc "Commit Message:"]}
3276 $ui_coml conf -text $txt
3278 trace add variable commit_type write trace_commit_type
3279 pack $ui_coml -side left -fill x
3281 if {![is_enabled nocommit]} {
3282 pack .vpane.lower.commarea.buffer.header.amend -side right
3283 pack .vpane.lower.commarea.buffer.header.new -side right
3286 text $ui_comm -background white -foreground black \
3287 -borderwidth 1 \
3288 -undo true \
3289 -maxundo 20 \
3290 -autoseparators true \
3291 -relief sunken \
3292 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3293 -font font_diff \
3294 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3295 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3296 -command [list $ui_comm yview]
3297 pack .vpane.lower.commarea.buffer.header -side top -fill x
3298 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3299 pack $ui_comm -side left -fill y
3300 pack .vpane.lower.commarea.buffer -side left -fill y
3302 # -- Commit Message Buffer Context Menu
3304 set ctxm .vpane.lower.commarea.buffer.ctxm
3305 menu $ctxm -tearoff 0
3306 $ctxm add command \
3307 -label [mc Cut] \
3308 -command {tk_textCut $ui_comm}
3309 $ctxm add command \
3310 -label [mc Copy] \
3311 -command {tk_textCopy $ui_comm}
3312 $ctxm add command \
3313 -label [mc Paste] \
3314 -command {tk_textPaste $ui_comm}
3315 $ctxm add command \
3316 -label [mc Delete] \
3317 -command {catch {$ui_comm delete sel.first sel.last}}
3318 $ctxm add separator
3319 $ctxm add command \
3320 -label [mc "Select All"] \
3321 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3322 $ctxm add command \
3323 -label [mc "Copy All"] \
3324 -command {
3325 $ui_comm tag add sel 0.0 end
3326 tk_textCopy $ui_comm
3327 $ui_comm tag remove sel 0.0 end
3329 $ctxm add separator
3330 $ctxm add command \
3331 -label [mc "Sign Off"] \
3332 -command do_signoff
3333 set ui_comm_ctxm $ctxm
3335 # -- Diff Header
3337 proc trace_current_diff_path {varname args} {
3338 global current_diff_path diff_actions file_states
3339 if {$current_diff_path eq {}} {
3340 set s {}
3341 set f {}
3342 set p {}
3343 set o disabled
3344 } else {
3345 set p $current_diff_path
3346 set s [mapdesc [lindex $file_states($p) 0] $p]
3347 set f [mc "File:"]
3348 set p [escape_path $p]
3349 set o normal
3352 .vpane.lower.diff.header.status configure -text $s
3353 .vpane.lower.diff.header.file configure -text $f
3354 .vpane.lower.diff.header.path configure -text $p
3355 foreach w $diff_actions {
3356 uplevel #0 $w $o
3359 trace add variable current_diff_path write trace_current_diff_path
3361 gold_frame .vpane.lower.diff.header
3362 tlabel .vpane.lower.diff.header.status \
3363 -background gold \
3364 -foreground black \
3365 -width $max_status_desc \
3366 -anchor w \
3367 -justify left
3368 tlabel .vpane.lower.diff.header.file \
3369 -background gold \
3370 -foreground black \
3371 -anchor w \
3372 -justify left
3373 tlabel .vpane.lower.diff.header.path \
3374 -background gold \
3375 -foreground black \
3376 -anchor w \
3377 -justify left
3378 pack .vpane.lower.diff.header.status -side left
3379 pack .vpane.lower.diff.header.file -side left
3380 pack .vpane.lower.diff.header.path -fill x
3381 set ctxm .vpane.lower.diff.header.ctxm
3382 menu $ctxm -tearoff 0
3383 $ctxm add command \
3384 -label [mc Copy] \
3385 -command {
3386 clipboard clear
3387 clipboard append \
3388 -format STRING \
3389 -type STRING \
3390 -- $current_diff_path
3392 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3393 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3395 # -- Diff Body
3397 ${NS}::frame .vpane.lower.diff.body
3398 set ui_diff .vpane.lower.diff.body.t
3399 text $ui_diff -background white -foreground black \
3400 -borderwidth 0 \
3401 -width 80 -height 5 -wrap none \
3402 -font font_diff \
3403 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3404 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3405 -state disabled
3406 catch {$ui_diff configure -tabstyle wordprocessor}
3407 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3408 -command [list $ui_diff xview]
3409 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3410 -command [list $ui_diff yview]
3411 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3412 pack .vpane.lower.diff.body.sby -side right -fill y
3413 pack $ui_diff -side left -fill both -expand 1
3414 pack .vpane.lower.diff.header -side top -fill x
3415 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3417 foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3418 $ui_diff tag configure clr4$n -background $c
3419 $ui_diff tag configure clri4$n -foreground $c
3420 $ui_diff tag configure clr3$n -foreground $c
3421 $ui_diff tag configure clri3$n -background $c
3423 $ui_diff tag configure clr1 -font font_diffbold
3424 $ui_diff tag configure clr4 -underline 1
3426 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3428 $ui_diff tag conf d_cr -elide true
3429 $ui_diff tag conf d_@ -font font_diffbold
3430 $ui_diff tag conf d_+ -foreground {#00a000}
3431 $ui_diff tag conf d_- -foreground red
3433 $ui_diff tag conf d_++ -foreground {#00a000}
3434 $ui_diff tag conf d_-- -foreground red
3435 $ui_diff tag conf d_+s \
3436 -foreground {#00a000} \
3437 -background {#e2effa}
3438 $ui_diff tag conf d_-s \
3439 -foreground red \
3440 -background {#e2effa}
3441 $ui_diff tag conf d_s+ \
3442 -foreground {#00a000} \
3443 -background ivory1
3444 $ui_diff tag conf d_s- \
3445 -foreground red \
3446 -background ivory1
3448 $ui_diff tag conf d< \
3449 -foreground orange \
3450 -font font_diffbold
3451 $ui_diff tag conf d= \
3452 -foreground orange \
3453 -font font_diffbold
3454 $ui_diff tag conf d> \
3455 -foreground orange \
3456 -font font_diffbold
3458 $ui_diff tag raise sel
3460 # -- Diff Body Context Menu
3463 proc create_common_diff_popup {ctxm} {
3464 $ctxm add command \
3465 -label [mc Refresh] \
3466 -command reshow_diff
3467 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3468 $ctxm add command \
3469 -label [mc Copy] \
3470 -command {tk_textCopy $ui_diff}
3471 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3472 $ctxm add command \
3473 -label [mc "Select All"] \
3474 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3475 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3476 $ctxm add command \
3477 -label [mc "Copy All"] \
3478 -command {
3479 $ui_diff tag add sel 0.0 end
3480 tk_textCopy $ui_diff
3481 $ui_diff tag remove sel 0.0 end
3483 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3484 $ctxm add separator
3485 $ctxm add command \
3486 -label [mc "Decrease Font Size"] \
3487 -command {incr_font_size font_diff -1}
3488 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3489 $ctxm add command \
3490 -label [mc "Increase Font Size"] \
3491 -command {incr_font_size font_diff 1}
3492 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3493 $ctxm add separator
3494 set emenu $ctxm.enc
3495 menu $emenu
3496 build_encoding_menu $emenu [list force_diff_encoding]
3497 $ctxm add cascade \
3498 -label [mc "Encoding"] \
3499 -menu $emenu
3500 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3501 $ctxm add separator
3502 $ctxm add command -label [mc "Options..."] \
3503 -command do_options
3506 set ctxm .vpane.lower.diff.body.ctxm
3507 menu $ctxm -tearoff 0
3508 $ctxm add command \
3509 -label [mc "Apply/Reverse Hunk"] \
3510 -command {apply_hunk $cursorX $cursorY}
3511 set ui_diff_applyhunk [$ctxm index last]
3512 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3513 $ctxm add command \
3514 -label [mc "Apply/Reverse Line"] \
3515 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3516 set ui_diff_applyline [$ctxm index last]
3517 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3518 $ctxm add separator
3519 $ctxm add command \
3520 -label [mc "Show Less Context"] \
3521 -command show_less_context
3522 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3523 $ctxm add command \
3524 -label [mc "Show More Context"] \
3525 -command show_more_context
3526 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3527 $ctxm add separator
3528 create_common_diff_popup $ctxm
3530 set ctxmmg .vpane.lower.diff.body.ctxmmg
3531 menu $ctxmmg -tearoff 0
3532 $ctxmmg add command \
3533 -label [mc "Run Merge Tool"] \
3534 -command {merge_resolve_tool}
3535 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3536 $ctxmmg add separator
3537 $ctxmmg add command \
3538 -label [mc "Use Remote Version"] \
3539 -command {merge_resolve_one 3}
3540 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3541 $ctxmmg add command \
3542 -label [mc "Use Local Version"] \
3543 -command {merge_resolve_one 2}
3544 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3545 $ctxmmg add command \
3546 -label [mc "Revert To Base"] \
3547 -command {merge_resolve_one 1}
3548 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3549 $ctxmmg add separator
3550 $ctxmmg add command \
3551 -label [mc "Show Less Context"] \
3552 -command show_less_context
3553 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3554 $ctxmmg add command \
3555 -label [mc "Show More Context"] \
3556 -command show_more_context
3557 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3558 $ctxmmg add separator
3559 create_common_diff_popup $ctxmmg
3561 set ctxmsm .vpane.lower.diff.body.ctxmsm
3562 menu $ctxmsm -tearoff 0
3563 $ctxmsm add command \
3564 -label [mc "Visualize These Changes In The Submodule"] \
3565 -command {do_gitk -- true}
3566 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3567 $ctxmsm add command \
3568 -label [mc "Visualize Current Branch History In The Submodule"] \
3569 -command {do_gitk {} true}
3570 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3571 $ctxmsm add command \
3572 -label [mc "Visualize All Branch History In The Submodule"] \
3573 -command {do_gitk --all true}
3574 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3575 $ctxmsm add separator
3576 $ctxmsm add command \
3577 -label [mc "Start git gui In The Submodule"] \
3578 -command {do_git_gui}
3579 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3580 $ctxmsm add separator
3581 create_common_diff_popup $ctxmsm
3583 proc has_textconv {path} {
3584 if {[is_config_false gui.textconv]} {
3585 return 0
3587 set filter [gitattr $path diff set]
3588 set textconv [get_config [join [list diff $filter textconv] .]]
3589 if {$filter ne {set} && $textconv ne {}} {
3590 return 1
3591 } else {
3592 return 0
3596 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3597 global current_diff_path file_states
3598 set ::cursorX $x
3599 set ::cursorY $y
3600 if {[info exists file_states($current_diff_path)]} {
3601 set state [lindex $file_states($current_diff_path) 0]
3602 } else {
3603 set state {__}
3605 if {[string first {U} $state] >= 0} {
3606 tk_popup $ctxmmg $X $Y
3607 } elseif {$::is_submodule_diff} {
3608 tk_popup $ctxmsm $X $Y
3609 } else {
3610 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3611 if {$::ui_index eq $::current_diff_side} {
3612 set l [mc "Unstage Hunk From Commit"]
3613 if {$has_range} {
3614 set t [mc "Unstage Lines From Commit"]
3615 } else {
3616 set t [mc "Unstage Line From Commit"]
3618 } else {
3619 set l [mc "Stage Hunk For Commit"]
3620 if {$has_range} {
3621 set t [mc "Stage Lines For Commit"]
3622 } else {
3623 set t [mc "Stage Line For Commit"]
3626 if {$::is_3way_diff
3627 || $current_diff_path eq {}
3628 || {__} eq $state
3629 || {_O} eq $state
3630 || [string match {?T} $state]
3631 || [string match {T?} $state]
3632 || [has_textconv $current_diff_path]} {
3633 set s disabled
3634 } else {
3635 set s normal
3637 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3638 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3639 tk_popup $ctxm $X $Y
3642 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3644 # -- Status Bar
3646 set main_status [::status_bar::new .status]
3647 pack .status -anchor w -side bottom -fill x
3648 $main_status show [mc "Initializing..."]
3650 # -- Load geometry
3652 proc on_ttk_pane_mapped {w pane pos} {
3653 bind $w <Map> {}
3654 after 0 [list after idle [list $w sashpos $pane $pos]]
3656 proc on_tk_pane_mapped {w pane x y} {
3657 bind $w <Map> {}
3658 after 0 [list after idle [list $w sash place $pane $x $y]]
3660 proc on_application_mapped {} {
3661 global repo_config use_ttk
3662 bind . <Map> {}
3663 set gm $repo_config(gui.geometry)
3664 if {$use_ttk} {
3665 bind .vpane <Map> \
3666 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3667 bind .vpane.files <Map> \
3668 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3669 } else {
3670 bind .vpane <Map> \
3671 [list on_tk_pane_mapped %W 0 \
3672 [lindex $gm 1] \
3673 [lindex [.vpane sash coord 0] 1]]
3674 bind .vpane.files <Map> \
3675 [list on_tk_pane_mapped %W 0 \
3676 [lindex [.vpane.files sash coord 0] 0] \
3677 [lindex $gm 2]]
3679 wm geometry . [lindex $gm 0]
3681 if {[info exists repo_config(gui.geometry)]} {
3682 bind . <Map> [list on_application_mapped]
3683 wm geometry . [lindex $repo_config(gui.geometry) 0]
3686 # -- Load window state
3688 if {[info exists repo_config(gui.wmstate)]} {
3689 catch {wm state . $repo_config(gui.wmstate)}
3692 # -- Key Bindings
3694 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3695 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3696 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3697 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3698 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3699 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3700 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3701 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3702 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3703 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3704 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3705 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3706 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3707 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3708 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3709 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3710 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3711 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3712 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3713 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3714 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3715 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3717 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3718 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3719 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3720 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3721 bind $ui_diff <$M1B-Key-v> {break}
3722 bind $ui_diff <$M1B-Key-V> {break}
3723 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3724 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3725 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3726 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3727 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3728 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3729 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3730 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3731 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3732 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3733 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3734 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3735 bind $ui_diff <Button-1> {focus %W}
3737 if {[is_enabled branch]} {
3738 bind . <$M1B-Key-n> branch_create::dialog
3739 bind . <$M1B-Key-N> branch_create::dialog
3740 bind . <$M1B-Key-o> branch_checkout::dialog
3741 bind . <$M1B-Key-O> branch_checkout::dialog
3742 bind . <$M1B-Key-m> merge::dialog
3743 bind . <$M1B-Key-M> merge::dialog
3745 if {[is_enabled transport]} {
3746 bind . <$M1B-Key-p> do_push_anywhere
3747 bind . <$M1B-Key-P> do_push_anywhere
3750 bind . <Key-F5> ui_do_rescan
3751 bind . <$M1B-Key-r> ui_do_rescan
3752 bind . <$M1B-Key-R> ui_do_rescan
3753 bind . <$M1B-Key-s> do_signoff
3754 bind . <$M1B-Key-S> do_signoff
3755 bind . <$M1B-Key-t> do_add_selection
3756 bind . <$M1B-Key-T> do_add_selection
3757 bind . <$M1B-Key-j> do_revert_selection
3758 bind . <$M1B-Key-J> do_revert_selection
3759 bind . <$M1B-Key-i> do_add_all
3760 bind . <$M1B-Key-I> do_add_all
3761 bind . <$M1B-Key-minus> {show_less_context;break}
3762 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3763 bind . <$M1B-Key-equal> {show_more_context;break}
3764 bind . <$M1B-Key-plus> {show_more_context;break}
3765 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3766 bind . <$M1B-Key-Return> do_commit
3767 foreach i [list $ui_index $ui_workdir] {
3768 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3769 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3770 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3772 unset i
3774 set file_lists($ui_index) [list]
3775 set file_lists($ui_workdir) [list]
3777 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3778 focus -force $ui_comm
3780 # -- Warn the user about environmental problems. Cygwin's Tcl
3781 # does *not* pass its env array onto any processes it spawns.
3782 # This means that git processes get none of our environment.
3784 if {[is_Cygwin]} {
3785 set ignored_env 0
3786 set suggest_user {}
3787 set msg [mc "Possible environment issues exist.
3789 The following environment variables are probably
3790 going to be ignored by any Git subprocess run
3791 by %s:
3793 " [appname]]
3794 foreach name [array names env] {
3795 switch -regexp -- $name {
3796 {^GIT_INDEX_FILE$} -
3797 {^GIT_OBJECT_DIRECTORY$} -
3798 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3799 {^GIT_DIFF_OPTS$} -
3800 {^GIT_EXTERNAL_DIFF$} -
3801 {^GIT_PAGER$} -
3802 {^GIT_TRACE$} -
3803 {^GIT_CONFIG$} -
3804 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3805 append msg " - $name\n"
3806 incr ignored_env
3808 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3809 append msg " - $name\n"
3810 incr ignored_env
3811 set suggest_user $name
3815 if {$ignored_env > 0} {
3816 append msg [mc "
3817 This is due to a known issue with the
3818 Tcl binary distributed by Cygwin."]
3820 if {$suggest_user ne {}} {
3821 append msg [mc "
3823 A good replacement for %s
3824 is placing values for the user.name and
3825 user.email settings into your personal
3826 ~/.gitconfig file.
3827 " $suggest_user]
3829 warn_popup $msg
3831 unset ignored_env msg suggest_user name
3834 # -- Only initialize complex UI if we are going to stay running.
3836 if {[is_enabled transport]} {
3837 load_all_remotes
3839 set n [.mbar.remote index end]
3840 populate_remotes_menu
3841 set n [expr {[.mbar.remote index end] - $n}]
3842 if {$n > 0} {
3843 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3844 .mbar.remote insert $n separator
3846 unset n
3849 if {[winfo exists $ui_comm]} {
3850 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3852 # -- If both our backup and message files exist use the
3853 # newer of the two files to initialize the buffer.
3855 if {$GITGUI_BCK_exists} {
3856 set m [gitdir GITGUI_MSG]
3857 if {[file isfile $m]} {
3858 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3859 catch {file delete [gitdir GITGUI_MSG]}
3860 } else {
3861 $ui_comm delete 0.0 end
3862 $ui_comm edit reset
3863 $ui_comm edit modified false
3864 catch {file delete [gitdir GITGUI_BCK]}
3865 set GITGUI_BCK_exists 0
3868 unset m
3871 proc backup_commit_buffer {} {
3872 global ui_comm GITGUI_BCK_exists
3874 set m [$ui_comm edit modified]
3875 if {$m || $GITGUI_BCK_exists} {
3876 set msg [string trim [$ui_comm get 0.0 end]]
3877 regsub -all -line {[ \r\t]+$} $msg {} msg
3879 if {$msg eq {}} {
3880 if {$GITGUI_BCK_exists} {
3881 catch {file delete [gitdir GITGUI_BCK]}
3882 set GITGUI_BCK_exists 0
3884 } elseif {$m} {
3885 catch {
3886 set fd [open [gitdir GITGUI_BCK] w]
3887 puts -nonewline $fd $msg
3888 close $fd
3889 set GITGUI_BCK_exists 1
3893 $ui_comm edit modified false
3896 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3899 backup_commit_buffer
3901 # -- If the user has aspell available we can drive it
3902 # in pipe mode to spellcheck the commit message.
3904 set spell_cmd [list |]
3905 set spell_dict [get_config gui.spellingdictionary]
3906 lappend spell_cmd aspell
3907 if {$spell_dict ne {}} {
3908 lappend spell_cmd --master=$spell_dict
3910 lappend spell_cmd --mode=none
3911 lappend spell_cmd --encoding=utf-8
3912 lappend spell_cmd pipe
3913 if {$spell_dict eq {none}
3914 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3915 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3916 } else {
3917 set ui_comm_spell [spellcheck::init \
3918 $spell_fd \
3919 $ui_comm \
3920 $ui_comm_ctxm \
3923 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3926 lock_index begin-read
3927 if {![winfo ismapped .]} {
3928 wm deiconify .
3930 after 1 {
3931 if {[is_enabled initialamend]} {
3932 force_amend
3933 } else {
3934 do_rescan
3937 if {[is_enabled nocommitmsg]} {
3938 $ui_comm configure -state disabled -background gray
3941 if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
3942 after 1000 hint_gc
3944 if {[is_enabled retcode]} {
3945 bind . <Destroy> {+terminate_me %W}
3947 if {$picked && [is_config_true gui.autoexplore]} {
3948 do_explore
3951 # Local variables:
3952 # mode: tcl
3953 # indent-tabs-mode: t
3954 # tab-width: 4
3955 # End: