add tests for git diff --submodule-summary
[git/dscho.git] / git-gui / git-gui.sh
blob158d7e079656b91ed7434cc92fe2dd980d24132c
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 [encoding convertfrom utf-8 {
14 Copyright © 2006, 2007 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 [mc "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
88 ######################################################################
90 ## Internationalization (i18n) through msgcat and gettext. See
91 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93 package require msgcat
95 proc _mc_trim {fmt} {
96 set cmk [string first @@ $fmt]
97 if {$cmk > 0} {
98 return [string range $fmt 0 [expr {$cmk - 1}]]
100 return $fmt
103 proc mc {en_fmt args} {
104 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
105 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
106 set msg [eval [list format [_mc_trim $en_fmt]] $args]
108 return $msg
111 proc strcat {args} {
112 return [join $args {}]
115 ::msgcat::mcload $oguimsg
116 unset oguimsg
118 ######################################################################
120 ## read only globals
122 set _appname {Git Gui}
123 set _gitdir {}
124 set _gitexec {}
125 set _githtmldir {}
126 set _reponame {}
127 set _iscygwin {}
128 set _search_path {}
130 set _trace [lsearch -exact $argv --trace]
131 if {$_trace >= 0} {
132 set argv [lreplace $argv $_trace $_trace]
133 set _trace 1
134 } else {
135 set _trace 0
138 proc appname {} {
139 global _appname
140 return $_appname
143 proc gitdir {args} {
144 global _gitdir
145 if {$args eq {}} {
146 return $_gitdir
148 return [eval [list file join $_gitdir] $args]
151 proc gitexec {args} {
152 global _gitexec
153 if {$_gitexec eq {}} {
154 if {[catch {set _gitexec [git --exec-path]} err]} {
155 error "Git not installed?\n\n$err"
157 if {[is_Cygwin]} {
158 set _gitexec [exec cygpath \
159 --windows \
160 --absolute \
161 $_gitexec]
162 } else {
163 set _gitexec [file normalize $_gitexec]
166 if {$args eq {}} {
167 return $_gitexec
169 return [eval [list file join $_gitexec] $args]
172 proc githtmldir {args} {
173 global _githtmldir
174 if {$_githtmldir eq {}} {
175 if {[catch {set _githtmldir [git --html-path]}]} {
176 # Git not installed or option not yet supported
177 return {}
179 if {[is_Cygwin]} {
180 set _githtmldir [exec cygpath \
181 --windows \
182 --absolute \
183 $_githtmldir]
184 } else {
185 set _githtmldir [file normalize $_githtmldir]
188 if {$args eq {}} {
189 return $_githtmldir
191 return [eval [list file join $_githtmldir] $args]
194 proc reponame {} {
195 return $::_reponame
198 proc is_MacOSX {} {
199 if {[tk windowingsystem] eq {aqua}} {
200 return 1
202 return 0
205 proc is_Windows {} {
206 if {$::tcl_platform(platform) eq {windows}} {
207 return 1
209 return 0
212 proc is_Cygwin {} {
213 global _iscygwin
214 if {$_iscygwin eq {}} {
215 if {$::tcl_platform(platform) eq {windows}} {
216 if {[catch {set p [exec cygpath --windir]} err]} {
217 set _iscygwin 0
218 } else {
219 set _iscygwin 1
221 } else {
222 set _iscygwin 0
225 return $_iscygwin
228 proc is_enabled {option} {
229 global enabled_options
230 if {[catch {set on $enabled_options($option)}]} {return 0}
231 return $on
234 proc enable_option {option} {
235 global enabled_options
236 set enabled_options($option) 1
239 proc disable_option {option} {
240 global enabled_options
241 set enabled_options($option) 0
244 ######################################################################
246 ## config
248 proc is_many_config {name} {
249 switch -glob -- $name {
250 gui.recentrepo -
251 remote.*.fetch -
252 remote.*.push
253 {return 1}
255 {return 0}
259 proc is_config_true {name} {
260 global repo_config
261 if {[catch {set v $repo_config($name)}]} {
262 return 0
263 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
264 return 1
265 } else {
266 return 0
270 proc get_config {name} {
271 global repo_config
272 if {[catch {set v $repo_config($name)}]} {
273 return {}
274 } else {
275 return $v
279 ######################################################################
281 ## handy utils
283 proc _trace_exec {cmd} {
284 if {!$::_trace} return
285 set d {}
286 foreach v $cmd {
287 if {$d ne {}} {
288 append d { }
290 if {[regexp {[ \t\r\n'"$?*]} $v]} {
291 set v [sq $v]
293 append d $v
295 puts stderr $d
298 proc _git_cmd {name} {
299 global _git_cmd_path
301 if {[catch {set v $_git_cmd_path($name)}]} {
302 switch -- $name {
303 version -
304 --version -
305 --exec-path { return [list $::_git $name] }
308 set p [gitexec git-$name$::_search_exe]
309 if {[file exists $p]} {
310 set v [list $p]
311 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
312 # Try to determine what sort of magic will make
313 # git-$name go and do its thing, because native
314 # Tcl on Windows doesn't know it.
316 set p [gitexec git-$name]
317 set f [open $p r]
318 set s [gets $f]
319 close $f
321 switch -glob -- [lindex $s 0] {
322 #!*sh { set i sh }
323 #!*perl { set i perl }
324 #!*python { set i python }
325 default { error "git-$name is not supported: $s" }
328 upvar #0 _$i interp
329 if {![info exists interp]} {
330 set interp [_which $i]
332 if {$interp eq {}} {
333 error "git-$name requires $i (not in PATH)"
335 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
336 } else {
337 # Assume it is builtin to git somehow and we
338 # aren't actually able to see a file for it.
340 set v [list $::_git $name]
342 set _git_cmd_path($name) $v
344 return $v
347 proc _which {what args} {
348 global env _search_exe _search_path
350 if {$_search_path eq {}} {
351 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
352 set _search_path [split [exec cygpath \
353 --windows \
354 --path \
355 --absolute \
356 $env(PATH)] {;}]
357 set _search_exe .exe
358 } elseif {[is_Windows]} {
359 set gitguidir [file dirname [info script]]
360 regsub -all ";" $gitguidir "\\;" gitguidir
361 set env(PATH) "$gitguidir;$env(PATH)"
362 set _search_path [split $env(PATH) {;}]
363 set _search_exe .exe
364 } else {
365 set _search_path [split $env(PATH) :]
366 set _search_exe {}
370 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
371 set suffix {}
372 } else {
373 set suffix $_search_exe
376 foreach p $_search_path {
377 set p [file join $p $what$suffix]
378 if {[file exists $p]} {
379 return [file normalize $p]
382 return {}
385 proc _lappend_nice {cmd_var} {
386 global _nice
387 upvar $cmd_var cmd
389 if {![info exists _nice]} {
390 set _nice [_which nice]
392 if {$_nice ne {}} {
393 lappend cmd $_nice
397 proc git {args} {
398 set opt [list]
400 while {1} {
401 switch -- [lindex $args 0] {
402 --nice {
403 _lappend_nice opt
406 default {
407 break
412 set args [lrange $args 1 end]
415 set cmdp [_git_cmd [lindex $args 0]]
416 set args [lrange $args 1 end]
418 _trace_exec [concat $opt $cmdp $args]
419 set result [eval exec $opt $cmdp $args]
420 if {$::_trace} {
421 puts stderr "< $result"
423 return $result
426 proc _open_stdout_stderr {cmd} {
427 _trace_exec $cmd
428 if {[catch {
429 set fd [open [concat [list | ] $cmd] r]
430 } err]} {
431 if { [lindex $cmd end] eq {2>@1}
432 && $err eq {can not find channel named "1"}
434 # Older versions of Tcl 8.4 don't have this 2>@1 IO
435 # redirect operator. Fallback to |& cat for those.
436 # The command was not actually started, so its safe
437 # to try to start it a second time.
439 set fd [open [concat \
440 [list | ] \
441 [lrange $cmd 0 end-1] \
442 [list |& cat] \
443 ] r]
444 } else {
445 error $err
448 fconfigure $fd -eofchar {}
449 return $fd
452 proc git_read {args} {
453 set opt [list]
455 while {1} {
456 switch -- [lindex $args 0] {
457 --nice {
458 _lappend_nice opt
461 --stderr {
462 lappend args 2>@1
465 default {
466 break
471 set args [lrange $args 1 end]
474 set cmdp [_git_cmd [lindex $args 0]]
475 set args [lrange $args 1 end]
477 return [_open_stdout_stderr [concat $opt $cmdp $args]]
480 proc git_write {args} {
481 set opt [list]
483 while {1} {
484 switch -- [lindex $args 0] {
485 --nice {
486 _lappend_nice opt
489 default {
490 break
495 set args [lrange $args 1 end]
498 set cmdp [_git_cmd [lindex $args 0]]
499 set args [lrange $args 1 end]
501 _trace_exec [concat $opt $cmdp $args]
502 return [open [concat [list | ] $opt $cmdp $args] w]
505 proc githook_read {hook_name args} {
506 set pchook [gitdir hooks $hook_name]
507 lappend args 2>@1
509 # On Windows [file executable] might lie so we need to ask
510 # the shell if the hook is executable. Yes that's annoying.
512 if {[is_Windows]} {
513 upvar #0 _sh interp
514 if {![info exists interp]} {
515 set interp [_which sh]
517 if {$interp eq {}} {
518 error "hook execution requires sh (not in PATH)"
521 set scr {if test -x "$1";then exec "$@";fi}
522 set sh_c [list $interp -c $scr $interp $pchook]
523 return [_open_stdout_stderr [concat $sh_c $args]]
526 if {[file executable $pchook]} {
527 return [_open_stdout_stderr [concat [list $pchook] $args]]
530 return {}
533 proc kill_file_process {fd} {
534 set process [pid $fd]
536 catch {
537 if {[is_Windows]} {
538 # Use a Cygwin-specific flag to allow killing
539 # native Windows processes
540 exec kill -f $process
541 } else {
542 exec kill $process
547 proc gitattr {path attr default} {
548 if {[catch {set r [git check-attr $attr -- $path]}]} {
549 set r unspecified
550 } else {
551 set r [join [lrange [split $r :] 2 end] :]
552 regsub {^ } $r {} r
554 if {$r eq {unspecified}} {
555 return $default
557 return $r
560 proc sq {value} {
561 regsub -all ' $value "'\\''" value
562 return "'$value'"
565 proc load_current_branch {} {
566 global current_branch is_detached
568 set fd [open [gitdir HEAD] r]
569 if {[gets $fd ref] < 1} {
570 set ref {}
572 close $fd
574 set pfx {ref: refs/heads/}
575 set len [string length $pfx]
576 if {[string equal -length $len $pfx $ref]} {
577 # We're on a branch. It might not exist. But
578 # HEAD looks good enough to be a branch.
580 set current_branch [string range $ref $len end]
581 set is_detached 0
582 } else {
583 # Assume this is a detached head.
585 set current_branch HEAD
586 set is_detached 1
590 auto_load tk_optionMenu
591 rename tk_optionMenu real__tkOptionMenu
592 proc tk_optionMenu {w varName args} {
593 set m [eval real__tkOptionMenu $w $varName $args]
594 $m configure -font font_ui
595 $w configure -font font_ui
596 return $m
599 proc rmsel_tag {text} {
600 $text tag conf sel \
601 -background [$text cget -background] \
602 -foreground [$text cget -foreground] \
603 -borderwidth 0
604 $text tag conf in_sel -background lightgray
605 bind $text <Motion> break
606 return $text
609 set root_exists 0
610 bind . <Visibility> {
611 bind . <Visibility> {}
612 set root_exists 1
615 if {[is_Windows]} {
616 wm iconbitmap . -default $oguilib/git-gui.ico
617 set ::tk::AlwaysShowSelection 1
619 # Spoof an X11 display for SSH
620 if {![info exists env(DISPLAY)]} {
621 set env(DISPLAY) :9999
623 } else {
624 catch {
625 image create photo gitlogo -width 16 -height 16
627 gitlogo put #33CC33 -to 7 0 9 2
628 gitlogo put #33CC33 -to 4 2 12 4
629 gitlogo put #33CC33 -to 7 4 9 6
630 gitlogo put #CC3333 -to 4 6 12 8
631 gitlogo put gray26 -to 4 9 6 10
632 gitlogo put gray26 -to 3 10 6 12
633 gitlogo put gray26 -to 8 9 13 11
634 gitlogo put gray26 -to 8 11 10 12
635 gitlogo put gray26 -to 11 11 13 14
636 gitlogo put gray26 -to 3 12 5 14
637 gitlogo put gray26 -to 5 13
638 gitlogo put gray26 -to 10 13
639 gitlogo put gray26 -to 4 14 12 15
640 gitlogo put gray26 -to 5 15 11 16
641 gitlogo redither
643 wm iconphoto . -default gitlogo
647 ######################################################################
649 ## config defaults
651 set cursor_ptr arrow
652 font create font_diff -family Courier -size 10
653 font create font_ui
654 catch {
655 label .dummy
656 eval font configure font_ui [font actual [.dummy cget -font]]
657 destroy .dummy
660 font create font_uiitalic
661 font create font_uibold
662 font create font_diffbold
663 font create font_diffitalic
665 foreach class {Button Checkbutton Entry Label
666 Labelframe Listbox Message
667 Radiobutton Spinbox Text} {
668 option add *$class.font font_ui
670 if {![is_MacOSX]} {
671 option add *Menu.font font_ui
673 unset class
675 if {[is_Windows] || [is_MacOSX]} {
676 option add *Menu.tearOff 0
679 if {[is_MacOSX]} {
680 set M1B M1
681 set M1T Cmd
682 } else {
683 set M1B Control
684 set M1T Ctrl
687 proc bind_button3 {w cmd} {
688 bind $w <Any-Button-3> $cmd
689 if {[is_MacOSX]} {
690 # Mac OS X sends Button-2 on right click through three-button mouse,
691 # or through trackpad right-clicking (two-finger touch + click).
692 bind $w <Any-Button-2> $cmd
693 bind $w <Control-Button-1> $cmd
697 proc apply_config {} {
698 global repo_config font_descs
700 foreach option $font_descs {
701 set name [lindex $option 0]
702 set font [lindex $option 1]
703 if {[catch {
704 set need_weight 1
705 foreach {cn cv} $repo_config(gui.$name) {
706 if {$cn eq {-weight}} {
707 set need_weight 0
709 font configure $font $cn $cv
711 if {$need_weight} {
712 font configure $font -weight normal
714 } err]} {
715 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
717 foreach {cn cv} [font configure $font] {
718 font configure ${font}bold $cn $cv
719 font configure ${font}italic $cn $cv
721 font configure ${font}bold -weight bold
722 font configure ${font}italic -slant italic
726 set default_config(branch.autosetupmerge) true
727 set default_config(merge.tool) {}
728 set default_config(mergetool.keepbackup) true
729 set default_config(merge.diffstat) true
730 set default_config(merge.summary) false
731 set default_config(merge.verbosity) 2
732 set default_config(user.name) {}
733 set default_config(user.email) {}
735 set default_config(gui.encoding) [encoding system]
736 set default_config(gui.matchtrackingbranch) false
737 set default_config(gui.pruneduringfetch) false
738 set default_config(gui.trustmtime) false
739 set default_config(gui.fastcopyblame) false
740 set default_config(gui.copyblamethreshold) 40
741 set default_config(gui.blamehistoryctx) 7
742 set default_config(gui.diffcontext) 5
743 set default_config(gui.commitmsgwidth) 75
744 set default_config(gui.newbranchtemplate) {}
745 set default_config(gui.spellingdictionary) {}
746 set default_config(gui.fontui) [font configure font_ui]
747 set default_config(gui.fontdiff) [font configure font_diff]
748 set font_descs {
749 {fontui font_ui {mc "Main Font"}}
750 {fontdiff font_diff {mc "Diff/Console Font"}}
753 ######################################################################
755 ## find git
757 set _git [_which git]
758 if {$_git eq {}} {
759 catch {wm withdraw .}
760 tk_messageBox \
761 -icon error \
762 -type ok \
763 -title [mc "git-gui: fatal error"] \
764 -message [mc "Cannot find git in PATH."]
765 exit 1
768 ######################################################################
770 ## version check
772 if {[catch {set _git_version [git --version]} err]} {
773 catch {wm withdraw .}
774 tk_messageBox \
775 -icon error \
776 -type ok \
777 -title [mc "git-gui: fatal error"] \
778 -message "Cannot determine Git version:
780 $err
782 [appname] requires Git 1.5.0 or later."
783 exit 1
785 if {![regsub {^git version } $_git_version {} _git_version]} {
786 catch {wm withdraw .}
787 tk_messageBox \
788 -icon error \
789 -type ok \
790 -title [mc "git-gui: fatal error"] \
791 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
792 exit 1
795 set _real_git_version $_git_version
796 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
797 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
798 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
799 regsub {\.GIT$} $_git_version {} _git_version
800 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
802 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
803 catch {wm withdraw .}
804 if {[tk_messageBox \
805 -icon warning \
806 -type yesno \
807 -default no \
808 -title "[appname]: warning" \
809 -message [mc "Git version cannot be determined.
811 %s claims it is version '%s'.
813 %s requires at least Git 1.5.0 or later.
815 Assume '%s' is version 1.5.0?
816 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
817 set _git_version 1.5.0
818 } else {
819 exit 1
822 unset _real_git_version
824 proc git-version {args} {
825 global _git_version
827 switch [llength $args] {
829 return $_git_version
833 set op [lindex $args 0]
834 set vr [lindex $args 1]
835 set cm [package vcompare $_git_version $vr]
836 return [expr $cm $op 0]
840 set type [lindex $args 0]
841 set name [lindex $args 1]
842 set parm [lindex $args 2]
843 set body [lindex $args 3]
845 if {($type ne {proc} && $type ne {method})} {
846 error "Invalid arguments to git-version"
848 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
849 error "Last arm of $type $name must be default"
852 foreach {op vr cb} [lrange $body 0 end-2] {
853 if {[git-version $op $vr]} {
854 return [uplevel [list $type $name $parm $cb]]
858 return [uplevel [list $type $name $parm [lindex $body end]]]
861 default {
862 error "git-version >= x"
868 if {[git-version < 1.5]} {
869 catch {wm withdraw .}
870 tk_messageBox \
871 -icon error \
872 -type ok \
873 -title [mc "git-gui: fatal error"] \
874 -message "[appname] requires Git 1.5.0 or later.
876 You are using [git-version]:
878 [git --version]"
879 exit 1
882 ######################################################################
884 ## configure our library
886 set idx [file join $oguilib tclIndex]
887 if {[catch {set fd [open $idx r]} err]} {
888 catch {wm withdraw .}
889 tk_messageBox \
890 -icon error \
891 -type ok \
892 -title [mc "git-gui: fatal error"] \
893 -message $err
894 exit 1
896 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
897 set idx [list]
898 while {[gets $fd n] >= 0} {
899 if {$n ne {} && ![string match #* $n]} {
900 lappend idx $n
903 } else {
904 set idx {}
906 close $fd
908 if {$idx ne {}} {
909 set loaded [list]
910 foreach p $idx {
911 if {[lsearch -exact $loaded $p] >= 0} continue
912 source [file join $oguilib $p]
913 lappend loaded $p
915 unset loaded p
916 } else {
917 set auto_path [concat [list $oguilib] $auto_path]
919 unset -nocomplain idx fd
921 ######################################################################
923 ## config file parsing
925 git-version proc _parse_config {arr_name args} {
926 >= 1.5.3 {
927 upvar $arr_name arr
928 array unset arr
929 set buf {}
930 catch {
931 set fd_rc [eval \
932 [list git_read config] \
933 $args \
934 [list --null --list]]
935 fconfigure $fd_rc -translation binary
936 set buf [read $fd_rc]
937 close $fd_rc
939 foreach line [split $buf "\0"] {
940 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
941 if {[is_many_config $name]} {
942 lappend arr($name) $value
943 } else {
944 set arr($name) $value
949 default {
950 upvar $arr_name arr
951 array unset arr
952 catch {
953 set fd_rc [eval [list git_read config --list] $args]
954 while {[gets $fd_rc line] >= 0} {
955 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
956 if {[is_many_config $name]} {
957 lappend arr($name) $value
958 } else {
959 set arr($name) $value
963 close $fd_rc
968 proc load_config {include_global} {
969 global repo_config global_config system_config default_config
971 if {$include_global} {
972 _parse_config system_config --system
973 _parse_config global_config --global
975 _parse_config repo_config
977 foreach name [array names default_config] {
978 if {[catch {set v $system_config($name)}]} {
979 set system_config($name) $default_config($name)
982 foreach name [array names system_config] {
983 if {[catch {set v $global_config($name)}]} {
984 set global_config($name) $system_config($name)
986 if {[catch {set v $repo_config($name)}]} {
987 set repo_config($name) $system_config($name)
992 ######################################################################
994 ## feature option selection
996 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
997 unset _junk
998 } else {
999 set subcommand gui
1001 if {$subcommand eq {gui.sh}} {
1002 set subcommand gui
1004 if {$subcommand eq {gui} && [llength $argv] > 0} {
1005 set subcommand [lindex $argv 0]
1006 set argv [lrange $argv 1 end]
1009 enable_option multicommit
1010 enable_option branch
1011 enable_option transport
1012 disable_option bare
1014 switch -- $subcommand {
1015 browser -
1016 blame {
1017 enable_option bare
1019 disable_option multicommit
1020 disable_option branch
1021 disable_option transport
1023 citool {
1024 enable_option singlecommit
1025 enable_option retcode
1027 disable_option multicommit
1028 disable_option branch
1029 disable_option transport
1031 while {[llength $argv] > 0} {
1032 set a [lindex $argv 0]
1033 switch -- $a {
1034 --amend {
1035 enable_option initialamend
1037 --nocommit {
1038 enable_option nocommit
1039 enable_option nocommitmsg
1041 --commitmsg {
1042 disable_option nocommitmsg
1044 default {
1045 break
1049 set argv [lrange $argv 1 end]
1054 ######################################################################
1056 ## execution environment
1058 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1060 # Suggest our implementation of askpass, if none is set
1061 if {![info exists env(SSH_ASKPASS)]} {
1062 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1065 ######################################################################
1067 ## repository setup
1069 set picked 0
1070 if {[catch {
1071 set _gitdir $env(GIT_DIR)
1072 set _prefix {}
1074 && [catch {
1075 set _gitdir [git rev-parse --git-dir]
1076 set _prefix [git rev-parse --show-prefix]
1077 } err]} {
1078 load_config 1
1079 apply_config
1080 choose_repository::pick
1081 set picked 1
1083 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1084 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1086 if {![file isdirectory $_gitdir]} {
1087 catch {wm withdraw .}
1088 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1089 exit 1
1091 if {$_prefix ne {}} {
1092 regsub -all {[^/]+/} $_prefix ../ cdup
1093 if {[catch {cd $cdup} err]} {
1094 catch {wm withdraw .}
1095 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1096 exit 1
1098 unset cdup
1099 } elseif {![is_enabled bare]} {
1100 if {[lindex [file split $_gitdir] end] ne {.git}} {
1101 catch {wm withdraw .}
1102 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
1103 exit 1
1105 if {[catch {cd [file dirname $_gitdir]} err]} {
1106 catch {wm withdraw .}
1107 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
1108 exit 1
1111 set _reponame [file split [file normalize $_gitdir]]
1112 if {[lindex $_reponame end] eq {.git}} {
1113 set _reponame [lindex $_reponame end-1]
1114 } else {
1115 set _reponame [lindex $_reponame end]
1118 ######################################################################
1120 ## global init
1122 set current_diff_path {}
1123 set current_diff_side {}
1124 set diff_actions [list]
1126 set HEAD {}
1127 set PARENT {}
1128 set MERGE_HEAD [list]
1129 set commit_type {}
1130 set empty_tree {}
1131 set current_branch {}
1132 set is_detached 0
1133 set current_diff_path {}
1134 set is_3way_diff 0
1135 set is_submodule_diff 0
1136 set is_conflict_diff 0
1137 set selected_commit_type new
1138 set diff_empty_count 0
1140 set nullid "0000000000000000000000000000000000000000"
1141 set nullid2 "0000000000000000000000000000000000000001"
1143 ######################################################################
1145 ## task management
1147 set rescan_active 0
1148 set diff_active 0
1149 set last_clicked {}
1151 set disable_on_lock [list]
1152 set index_lock_type none
1154 proc lock_index {type} {
1155 global index_lock_type disable_on_lock
1157 if {$index_lock_type eq {none}} {
1158 set index_lock_type $type
1159 foreach w $disable_on_lock {
1160 uplevel #0 $w disabled
1162 return 1
1163 } elseif {$index_lock_type eq "begin-$type"} {
1164 set index_lock_type $type
1165 return 1
1167 return 0
1170 proc unlock_index {} {
1171 global index_lock_type disable_on_lock
1173 set index_lock_type none
1174 foreach w $disable_on_lock {
1175 uplevel #0 $w normal
1179 ######################################################################
1181 ## status
1183 proc repository_state {ctvar hdvar mhvar} {
1184 global current_branch
1185 upvar $ctvar ct $hdvar hd $mhvar mh
1187 set mh [list]
1189 load_current_branch
1190 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1191 set hd {}
1192 set ct initial
1193 return
1196 set merge_head [gitdir MERGE_HEAD]
1197 if {[file exists $merge_head]} {
1198 set ct merge
1199 set fd_mh [open $merge_head r]
1200 while {[gets $fd_mh line] >= 0} {
1201 lappend mh $line
1203 close $fd_mh
1204 return
1207 set ct normal
1210 proc PARENT {} {
1211 global PARENT empty_tree
1213 set p [lindex $PARENT 0]
1214 if {$p ne {}} {
1215 return $p
1217 if {$empty_tree eq {}} {
1218 set empty_tree [git mktree << {}]
1220 return $empty_tree
1223 proc force_amend {} {
1224 global selected_commit_type
1225 global HEAD PARENT MERGE_HEAD commit_type
1227 repository_state newType newHEAD newMERGE_HEAD
1228 set HEAD $newHEAD
1229 set PARENT $newHEAD
1230 set MERGE_HEAD $newMERGE_HEAD
1231 set commit_type $newType
1233 set selected_commit_type amend
1234 do_select_commit_type
1237 proc rescan {after {honor_trustmtime 1}} {
1238 global HEAD PARENT MERGE_HEAD commit_type
1239 global ui_index ui_workdir ui_comm
1240 global rescan_active file_states
1241 global repo_config
1243 if {$rescan_active > 0 || ![lock_index read]} return
1245 repository_state newType newHEAD newMERGE_HEAD
1246 if {[string match amend* $commit_type]
1247 && $newType eq {normal}
1248 && $newHEAD eq $HEAD} {
1249 } else {
1250 set HEAD $newHEAD
1251 set PARENT $newHEAD
1252 set MERGE_HEAD $newMERGE_HEAD
1253 set commit_type $newType
1256 array unset file_states
1258 if {!$::GITGUI_BCK_exists &&
1259 (![$ui_comm edit modified]
1260 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1261 if {[string match amend* $commit_type]} {
1262 } elseif {[load_message GITGUI_MSG]} {
1263 } elseif {[run_prepare_commit_msg_hook]} {
1264 } elseif {[load_message MERGE_MSG]} {
1265 } elseif {[load_message SQUASH_MSG]} {
1267 $ui_comm edit reset
1268 $ui_comm edit modified false
1271 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1272 rescan_stage2 {} $after
1273 } else {
1274 set rescan_active 1
1275 ui_status [mc "Refreshing file status..."]
1276 set fd_rf [git_read update-index \
1277 -q \
1278 --unmerged \
1279 --ignore-missing \
1280 --refresh \
1282 fconfigure $fd_rf -blocking 0 -translation binary
1283 fileevent $fd_rf readable \
1284 [list rescan_stage2 $fd_rf $after]
1288 if {[is_Cygwin]} {
1289 set is_git_info_exclude {}
1290 proc have_info_exclude {} {
1291 global is_git_info_exclude
1293 if {$is_git_info_exclude eq {}} {
1294 if {[catch {exec test -f [gitdir info exclude]}]} {
1295 set is_git_info_exclude 0
1296 } else {
1297 set is_git_info_exclude 1
1300 return $is_git_info_exclude
1302 } else {
1303 proc have_info_exclude {} {
1304 return [file readable [gitdir info exclude]]
1308 proc rescan_stage2 {fd after} {
1309 global rescan_active buf_rdi buf_rdf buf_rlo
1311 if {$fd ne {}} {
1312 read $fd
1313 if {![eof $fd]} return
1314 close $fd
1317 set ls_others [list --exclude-per-directory=.gitignore]
1318 if {[have_info_exclude]} {
1319 lappend ls_others "--exclude-from=[gitdir info exclude]"
1321 set user_exclude [get_config core.excludesfile]
1322 if {$user_exclude ne {} && [file readable $user_exclude]} {
1323 lappend ls_others "--exclude-from=$user_exclude"
1326 set buf_rdi {}
1327 set buf_rdf {}
1328 set buf_rlo {}
1330 set rescan_active 3
1331 ui_status [mc "Scanning for modified files ..."]
1332 set fd_di [git_read diff-index --cached -z [PARENT]]
1333 set fd_df [git_read diff-files -z]
1334 set fd_lo [eval git_read ls-files --others -z $ls_others]
1336 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1337 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1338 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1339 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1340 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1341 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1344 proc load_message {file} {
1345 global ui_comm
1347 set f [gitdir $file]
1348 if {[file isfile $f]} {
1349 if {[catch {set fd [open $f r]}]} {
1350 return 0
1352 fconfigure $fd -eofchar {}
1353 set content [string trim [read $fd]]
1354 close $fd
1355 regsub -all -line {[ \r\t]+$} $content {} content
1356 $ui_comm delete 0.0 end
1357 $ui_comm insert end $content
1358 return 1
1360 return 0
1363 proc run_prepare_commit_msg_hook {} {
1364 global pch_error
1366 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1367 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1368 # empty file but existant file.
1370 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1372 if {[file isfile [gitdir MERGE_MSG]]} {
1373 set pcm_source "merge"
1374 set fd_mm [open [gitdir MERGE_MSG] r]
1375 puts -nonewline $fd_pcm [read $fd_mm]
1376 close $fd_mm
1377 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1378 set pcm_source "squash"
1379 set fd_sm [open [gitdir SQUASH_MSG] r]
1380 puts -nonewline $fd_pcm [read $fd_sm]
1381 close $fd_sm
1382 } else {
1383 set pcm_source ""
1386 close $fd_pcm
1388 set fd_ph [githook_read prepare-commit-msg \
1389 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1390 if {$fd_ph eq {}} {
1391 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1392 return 0;
1395 ui_status [mc "Calling prepare-commit-msg hook..."]
1396 set pch_error {}
1398 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1399 fileevent $fd_ph readable \
1400 [list prepare_commit_msg_hook_wait $fd_ph]
1402 return 1;
1405 proc prepare_commit_msg_hook_wait {fd_ph} {
1406 global pch_error
1408 append pch_error [read $fd_ph]
1409 fconfigure $fd_ph -blocking 1
1410 if {[eof $fd_ph]} {
1411 if {[catch {close $fd_ph}]} {
1412 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1413 hook_failed_popup prepare-commit-msg $pch_error
1414 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1415 exit 1
1416 } else {
1417 load_message PREPARE_COMMIT_MSG
1419 set pch_error {}
1420 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1421 return
1423 fconfigure $fd_ph -blocking 0
1424 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1427 proc read_diff_index {fd after} {
1428 global buf_rdi
1430 append buf_rdi [read $fd]
1431 set c 0
1432 set n [string length $buf_rdi]
1433 while {$c < $n} {
1434 set z1 [string first "\0" $buf_rdi $c]
1435 if {$z1 == -1} break
1436 incr z1
1437 set z2 [string first "\0" $buf_rdi $z1]
1438 if {$z2 == -1} break
1440 incr c
1441 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1442 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1443 merge_state \
1444 [encoding convertfrom $p] \
1445 [lindex $i 4]? \
1446 [list [lindex $i 0] [lindex $i 2]] \
1447 [list]
1448 set c $z2
1449 incr c
1451 if {$c < $n} {
1452 set buf_rdi [string range $buf_rdi $c end]
1453 } else {
1454 set buf_rdi {}
1457 rescan_done $fd buf_rdi $after
1460 proc read_diff_files {fd after} {
1461 global buf_rdf
1463 append buf_rdf [read $fd]
1464 set c 0
1465 set n [string length $buf_rdf]
1466 while {$c < $n} {
1467 set z1 [string first "\0" $buf_rdf $c]
1468 if {$z1 == -1} break
1469 incr z1
1470 set z2 [string first "\0" $buf_rdf $z1]
1471 if {$z2 == -1} break
1473 incr c
1474 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1475 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1476 merge_state \
1477 [encoding convertfrom $p] \
1478 ?[lindex $i 4] \
1479 [list] \
1480 [list [lindex $i 0] [lindex $i 2]]
1481 set c $z2
1482 incr c
1484 if {$c < $n} {
1485 set buf_rdf [string range $buf_rdf $c end]
1486 } else {
1487 set buf_rdf {}
1490 rescan_done $fd buf_rdf $after
1493 proc read_ls_others {fd after} {
1494 global buf_rlo
1496 append buf_rlo [read $fd]
1497 set pck [split $buf_rlo "\0"]
1498 set buf_rlo [lindex $pck end]
1499 foreach p [lrange $pck 0 end-1] {
1500 set p [encoding convertfrom $p]
1501 if {[string index $p end] eq {/}} {
1502 set p [string range $p 0 end-1]
1504 merge_state $p ?O
1506 rescan_done $fd buf_rlo $after
1509 proc rescan_done {fd buf after} {
1510 global rescan_active current_diff_path
1511 global file_states repo_config
1512 upvar $buf to_clear
1514 if {![eof $fd]} return
1515 set to_clear {}
1516 close $fd
1517 if {[incr rescan_active -1] > 0} return
1519 prune_selection
1520 unlock_index
1521 display_all_files
1522 if {$current_diff_path ne {}} { reshow_diff $after }
1523 if {$current_diff_path eq {}} { select_first_diff $after }
1526 proc prune_selection {} {
1527 global file_states selected_paths
1529 foreach path [array names selected_paths] {
1530 if {[catch {set still_here $file_states($path)}]} {
1531 unset selected_paths($path)
1536 ######################################################################
1538 ## ui helpers
1540 proc mapicon {w state path} {
1541 global all_icons
1543 if {[catch {set r $all_icons($state$w)}]} {
1544 puts "error: no icon for $w state={$state} $path"
1545 return file_plain
1547 return $r
1550 proc mapdesc {state path} {
1551 global all_descs
1553 if {[catch {set r $all_descs($state)}]} {
1554 puts "error: no desc for state={$state} $path"
1555 return $state
1557 return $r
1560 proc ui_status {msg} {
1561 global main_status
1562 if {[info exists main_status]} {
1563 $main_status show $msg
1567 proc ui_ready {{test {}}} {
1568 global main_status
1569 if {[info exists main_status]} {
1570 $main_status show [mc "Ready."] $test
1574 proc escape_path {path} {
1575 regsub -all {\\} $path "\\\\" path
1576 regsub -all "\n" $path "\\n" path
1577 return $path
1580 proc short_path {path} {
1581 return [escape_path [lindex [file split $path] end]]
1584 set next_icon_id 0
1585 set null_sha1 [string repeat 0 40]
1587 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1588 global file_states next_icon_id null_sha1
1590 set s0 [string index $new_state 0]
1591 set s1 [string index $new_state 1]
1593 if {[catch {set info $file_states($path)}]} {
1594 set state __
1595 set icon n[incr next_icon_id]
1596 } else {
1597 set state [lindex $info 0]
1598 set icon [lindex $info 1]
1599 if {$head_info eq {}} {set head_info [lindex $info 2]}
1600 if {$index_info eq {}} {set index_info [lindex $info 3]}
1603 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1604 elseif {$s0 eq {_}} {set s0 _}
1606 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1607 elseif {$s1 eq {_}} {set s1 _}
1609 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1610 set head_info [list 0 $null_sha1]
1611 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1612 && $head_info eq {}} {
1613 set head_info $index_info
1616 set file_states($path) [list $s0$s1 $icon \
1617 $head_info $index_info \
1619 return $state
1622 proc display_file_helper {w path icon_name old_m new_m} {
1623 global file_lists
1625 if {$new_m eq {_}} {
1626 set lno [lsearch -sorted -exact $file_lists($w) $path]
1627 if {$lno >= 0} {
1628 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1629 incr lno
1630 $w conf -state normal
1631 $w delete $lno.0 [expr {$lno + 1}].0
1632 $w conf -state disabled
1634 } elseif {$old_m eq {_} && $new_m ne {_}} {
1635 lappend file_lists($w) $path
1636 set file_lists($w) [lsort -unique $file_lists($w)]
1637 set lno [lsearch -sorted -exact $file_lists($w) $path]
1638 incr lno
1639 $w conf -state normal
1640 $w image create $lno.0 \
1641 -align center -padx 5 -pady 1 \
1642 -name $icon_name \
1643 -image [mapicon $w $new_m $path]
1644 $w insert $lno.1 "[escape_path $path]\n"
1645 $w conf -state disabled
1646 } elseif {$old_m ne $new_m} {
1647 $w conf -state normal
1648 $w image conf $icon_name -image [mapicon $w $new_m $path]
1649 $w conf -state disabled
1653 proc display_file {path state} {
1654 global file_states selected_paths
1655 global ui_index ui_workdir
1657 set old_m [merge_state $path $state]
1658 set s $file_states($path)
1659 set new_m [lindex $s 0]
1660 set icon_name [lindex $s 1]
1662 set o [string index $old_m 0]
1663 set n [string index $new_m 0]
1664 if {$o eq {U}} {
1665 set o _
1667 if {$n eq {U}} {
1668 set n _
1670 display_file_helper $ui_index $path $icon_name $o $n
1672 if {[string index $old_m 0] eq {U}} {
1673 set o U
1674 } else {
1675 set o [string index $old_m 1]
1677 if {[string index $new_m 0] eq {U}} {
1678 set n U
1679 } else {
1680 set n [string index $new_m 1]
1682 display_file_helper $ui_workdir $path $icon_name $o $n
1684 if {$new_m eq {__}} {
1685 unset file_states($path)
1686 catch {unset selected_paths($path)}
1690 proc display_all_files_helper {w path icon_name m} {
1691 global file_lists
1693 lappend file_lists($w) $path
1694 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1695 $w image create end \
1696 -align center -padx 5 -pady 1 \
1697 -name $icon_name \
1698 -image [mapicon $w $m $path]
1699 $w insert end "[escape_path $path]\n"
1702 proc display_all_files {} {
1703 global ui_index ui_workdir
1704 global file_states file_lists
1705 global last_clicked
1707 $ui_index conf -state normal
1708 $ui_workdir conf -state normal
1710 $ui_index delete 0.0 end
1711 $ui_workdir delete 0.0 end
1712 set last_clicked {}
1714 set file_lists($ui_index) [list]
1715 set file_lists($ui_workdir) [list]
1717 foreach path [lsort [array names file_states]] {
1718 set s $file_states($path)
1719 set m [lindex $s 0]
1720 set icon_name [lindex $s 1]
1722 set s [string index $m 0]
1723 if {$s ne {U} && $s ne {_}} {
1724 display_all_files_helper $ui_index $path \
1725 $icon_name $s
1728 if {[string index $m 0] eq {U}} {
1729 set s U
1730 } else {
1731 set s [string index $m 1]
1733 if {$s ne {_}} {
1734 display_all_files_helper $ui_workdir $path \
1735 $icon_name $s
1739 $ui_index conf -state disabled
1740 $ui_workdir conf -state disabled
1743 ######################################################################
1745 ## icons
1747 set filemask {
1748 #define mask_width 14
1749 #define mask_height 15
1750 static unsigned char mask_bits[] = {
1751 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1752 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1753 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1756 image create bitmap file_plain -background white -foreground black -data {
1757 #define plain_width 14
1758 #define plain_height 15
1759 static unsigned char plain_bits[] = {
1760 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1761 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1762 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1763 } -maskdata $filemask
1765 image create bitmap file_mod -background white -foreground blue -data {
1766 #define mod_width 14
1767 #define mod_height 15
1768 static unsigned char mod_bits[] = {
1769 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1770 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1771 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1772 } -maskdata $filemask
1774 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1775 #define file_fulltick_width 14
1776 #define file_fulltick_height 15
1777 static unsigned char file_fulltick_bits[] = {
1778 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1779 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1780 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1781 } -maskdata $filemask
1783 image create bitmap file_parttick -background white -foreground "#005050" -data {
1784 #define parttick_width 14
1785 #define parttick_height 15
1786 static unsigned char parttick_bits[] = {
1787 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1788 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1789 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1790 } -maskdata $filemask
1792 image create bitmap file_question -background white -foreground black -data {
1793 #define file_question_width 14
1794 #define file_question_height 15
1795 static unsigned char file_question_bits[] = {
1796 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1797 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1798 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1799 } -maskdata $filemask
1801 image create bitmap file_removed -background white -foreground red -data {
1802 #define file_removed_width 14
1803 #define file_removed_height 15
1804 static unsigned char file_removed_bits[] = {
1805 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1806 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1807 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1808 } -maskdata $filemask
1810 image create bitmap file_merge -background white -foreground blue -data {
1811 #define file_merge_width 14
1812 #define file_merge_height 15
1813 static unsigned char file_merge_bits[] = {
1814 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1815 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1816 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1817 } -maskdata $filemask
1819 image create bitmap file_statechange -background white -foreground green -data {
1820 #define file_merge_width 14
1821 #define file_merge_height 15
1822 static unsigned char file_statechange_bits[] = {
1823 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1824 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1825 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1826 } -maskdata $filemask
1828 set ui_index .vpane.files.index.list
1829 set ui_workdir .vpane.files.workdir.list
1831 set all_icons(_$ui_index) file_plain
1832 set all_icons(A$ui_index) file_fulltick
1833 set all_icons(M$ui_index) file_fulltick
1834 set all_icons(D$ui_index) file_removed
1835 set all_icons(U$ui_index) file_merge
1836 set all_icons(T$ui_index) file_statechange
1838 set all_icons(_$ui_workdir) file_plain
1839 set all_icons(M$ui_workdir) file_mod
1840 set all_icons(D$ui_workdir) file_question
1841 set all_icons(U$ui_workdir) file_merge
1842 set all_icons(O$ui_workdir) file_plain
1843 set all_icons(T$ui_workdir) file_statechange
1845 set max_status_desc 0
1846 foreach i {
1847 {__ {mc "Unmodified"}}
1849 {_M {mc "Modified, not staged"}}
1850 {M_ {mc "Staged for commit"}}
1851 {MM {mc "Portions staged for commit"}}
1852 {MD {mc "Staged for commit, missing"}}
1854 {_T {mc "File type changed, not staged"}}
1855 {T_ {mc "File type changed, staged"}}
1857 {_O {mc "Untracked, not staged"}}
1858 {A_ {mc "Staged for commit"}}
1859 {AM {mc "Portions staged for commit"}}
1860 {AD {mc "Staged for commit, missing"}}
1862 {_D {mc "Missing"}}
1863 {D_ {mc "Staged for removal"}}
1864 {DO {mc "Staged for removal, still present"}}
1866 {_U {mc "Requires merge resolution"}}
1867 {U_ {mc "Requires merge resolution"}}
1868 {UU {mc "Requires merge resolution"}}
1869 {UM {mc "Requires merge resolution"}}
1870 {UD {mc "Requires merge resolution"}}
1871 {UT {mc "Requires merge resolution"}}
1873 set text [eval [lindex $i 1]]
1874 if {$max_status_desc < [string length $text]} {
1875 set max_status_desc [string length $text]
1877 set all_descs([lindex $i 0]) $text
1879 unset i
1881 ######################################################################
1883 ## util
1885 proc scrollbar2many {list mode args} {
1886 foreach w $list {eval $w $mode $args}
1889 proc many2scrollbar {list mode sb top bottom} {
1890 $sb set $top $bottom
1891 foreach w $list {$w $mode moveto $top}
1894 proc incr_font_size {font {amt 1}} {
1895 set sz [font configure $font -size]
1896 incr sz $amt
1897 font configure $font -size $sz
1898 font configure ${font}bold -size $sz
1899 font configure ${font}italic -size $sz
1902 ######################################################################
1904 ## ui commands
1906 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1908 proc do_gitk {revs is_submodule} {
1909 global current_diff_path old_submod_sha1 new_submod_sha1
1911 # -- Always start gitk through whatever we were loaded with. This
1912 # lets us bypass using shell process on Windows systems.
1914 set exe [_which gitk -script]
1915 set cmd [list [info nameofexecutable] $exe]
1916 if {$exe eq {}} {
1917 error_popup [mc "Couldn't find gitk in PATH"]
1918 } else {
1919 global env
1921 if {[info exists env(GIT_DIR)]} {
1922 set old_GIT_DIR $env(GIT_DIR)
1923 } else {
1924 set old_GIT_DIR {}
1927 set pwd [pwd]
1928 if {!$is_submodule} {
1929 cd [file dirname [gitdir]]
1930 set env(GIT_DIR) [file tail [gitdir]]
1931 } else {
1932 cd $current_diff_path
1933 if {$revs eq {}} {
1934 set revs $old_submod_sha1...$new_submod_sha1
1935 } elseif {$revs eq {--}} {
1936 set revs $new_submod_sha1
1938 if {[info exists env(GIT_DIR)]} {
1939 unset env(GIT_DIR)
1943 eval exec $cmd $revs &
1945 if {$old_GIT_DIR ne {}} {
1946 set env(GIT_DIR) $old_GIT_DIR
1948 cd $pwd
1950 ui_status $::starting_gitk_msg
1951 after 10000 {
1952 ui_ready $starting_gitk_msg
1957 proc do_git_gui {} {
1958 global current_diff_path
1960 # -- Always start git gui through whatever we were loaded with. This
1961 # lets us bypass using shell process on Windows systems.
1963 set exe [_which git]
1964 if {$exe eq {}} {
1965 error_popup [mc "Couldn't find git gui in PATH"]
1966 } else {
1967 global env
1969 if {[info exists env(GIT_DIR)]} {
1970 set old_GIT_DIR $env(GIT_DIR)
1971 unset env(GIT_DIR)
1972 } else {
1973 set old_GIT_DIR {}
1976 set pwd [pwd]
1977 cd $current_diff_path
1979 eval exec $exe gui &
1981 if {$old_GIT_DIR ne {}} {
1982 set env(GIT_DIR) $old_GIT_DIR
1984 cd $pwd
1986 ui_status $::starting_gitk_msg
1987 after 10000 {
1988 ui_ready $starting_gitk_msg
1993 proc do_explore {} {
1994 set explorer {}
1995 if {[is_Cygwin] || [is_Windows]} {
1996 set explorer "explorer.exe"
1997 } elseif {[is_MacOSX]} {
1998 set explorer "open"
1999 } else {
2000 # freedesktop.org-conforming system is our best shot
2001 set explorer "xdg-open"
2003 eval exec $explorer [list [file nativename [file dirname [gitdir]]]] &
2006 set is_quitting 0
2007 set ret_code 1
2009 proc terminate_me {win} {
2010 global ret_code
2011 if {$win ne {.}} return
2012 exit $ret_code
2015 proc do_quit {{rc {1}}} {
2016 global ui_comm is_quitting repo_config commit_type
2017 global GITGUI_BCK_exists GITGUI_BCK_i
2018 global ui_comm_spell
2019 global ret_code
2021 if {$is_quitting} return
2022 set is_quitting 1
2024 if {[winfo exists $ui_comm]} {
2025 # -- Stash our current commit buffer.
2027 set save [gitdir GITGUI_MSG]
2028 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2029 file rename -force [gitdir GITGUI_BCK] $save
2030 set GITGUI_BCK_exists 0
2031 } else {
2032 set msg [string trim [$ui_comm get 0.0 end]]
2033 regsub -all -line {[ \r\t]+$} $msg {} msg
2034 if {(![string match amend* $commit_type]
2035 || [$ui_comm edit modified])
2036 && $msg ne {}} {
2037 catch {
2038 set fd [open $save w]
2039 puts -nonewline $fd $msg
2040 close $fd
2042 } else {
2043 catch {file delete $save}
2047 # -- Cancel our spellchecker if its running.
2049 if {[info exists ui_comm_spell]} {
2050 $ui_comm_spell stop
2053 # -- Remove our editor backup, its not needed.
2055 after cancel $GITGUI_BCK_i
2056 if {$GITGUI_BCK_exists} {
2057 catch {file delete [gitdir GITGUI_BCK]}
2060 # -- Stash our current window geometry into this repository.
2062 set cfg_geometry [list]
2063 lappend cfg_geometry [wm geometry .]
2064 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2065 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2066 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2067 set rc_geometry {}
2069 if {$cfg_geometry ne $rc_geometry} {
2070 catch {git config gui.geometry $cfg_geometry}
2074 set ret_code $rc
2075 destroy .
2078 proc do_rescan {} {
2079 rescan ui_ready
2082 proc ui_do_rescan {} {
2083 rescan {force_first_diff ui_ready}
2086 proc do_commit {} {
2087 commit_tree
2090 proc next_diff {{after {}}} {
2091 global next_diff_p next_diff_w next_diff_i
2092 show_diff $next_diff_p $next_diff_w {} {} $after
2095 proc find_anchor_pos {lst name} {
2096 set lid [lsearch -sorted -exact $lst $name]
2098 if {$lid == -1} {
2099 set lid 0
2100 foreach lname $lst {
2101 if {$lname >= $name} break
2102 incr lid
2106 return $lid
2109 proc find_file_from {flist idx delta path mmask} {
2110 global file_states
2112 set len [llength $flist]
2113 while {$idx >= 0 && $idx < $len} {
2114 set name [lindex $flist $idx]
2116 if {$name ne $path && [info exists file_states($name)]} {
2117 set state [lindex $file_states($name) 0]
2119 if {$mmask eq {} || [regexp $mmask $state]} {
2120 return $idx
2124 incr idx $delta
2127 return {}
2130 proc find_next_diff {w path {lno {}} {mmask {}}} {
2131 global next_diff_p next_diff_w next_diff_i
2132 global file_lists ui_index ui_workdir
2134 set flist $file_lists($w)
2135 if {$lno eq {}} {
2136 set lno [find_anchor_pos $flist $path]
2137 } else {
2138 incr lno -1
2141 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2142 if {$w eq $ui_index} {
2143 set mmask "^$mmask"
2144 } else {
2145 set mmask "$mmask\$"
2149 set idx [find_file_from $flist $lno 1 $path $mmask]
2150 if {$idx eq {}} {
2151 incr lno -1
2152 set idx [find_file_from $flist $lno -1 $path $mmask]
2155 if {$idx ne {}} {
2156 set next_diff_w $w
2157 set next_diff_p [lindex $flist $idx]
2158 set next_diff_i [expr {$idx+1}]
2159 return 1
2160 } else {
2161 return 0
2165 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2166 global current_diff_path
2168 if {$path ne $current_diff_path} {
2169 return {}
2170 } elseif {[find_next_diff $w $path $lno $mmask]} {
2171 return {next_diff;}
2172 } else {
2173 return {reshow_diff;}
2177 proc select_first_diff {after} {
2178 global ui_workdir
2180 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2181 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2182 next_diff $after
2183 } else {
2184 uplevel #0 $after
2188 proc force_first_diff {after} {
2189 global ui_workdir current_diff_path file_states
2191 if {[info exists file_states($current_diff_path)]} {
2192 set state [lindex $file_states($current_diff_path) 0]
2193 } else {
2194 set state {OO}
2197 set reselect 0
2198 if {[string first {U} $state] >= 0} {
2199 # Already a conflict, do nothing
2200 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2201 set reselect 1
2202 } elseif {[string index $state 1] ne {O}} {
2203 # Already a diff & no conflicts, do nothing
2204 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2205 set reselect 1
2208 if {$reselect} {
2209 next_diff $after
2210 } else {
2211 uplevel #0 $after
2215 proc toggle_or_diff {w x y} {
2216 global file_states file_lists current_diff_path ui_index ui_workdir
2217 global last_clicked selected_paths
2219 set pos [split [$w index @$x,$y] .]
2220 set lno [lindex $pos 0]
2221 set col [lindex $pos 1]
2222 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2223 if {$path eq {}} {
2224 set last_clicked {}
2225 return
2228 set last_clicked [list $w $lno]
2229 array unset selected_paths
2230 $ui_index tag remove in_sel 0.0 end
2231 $ui_workdir tag remove in_sel 0.0 end
2233 # Determine the state of the file
2234 if {[info exists file_states($path)]} {
2235 set state [lindex $file_states($path) 0]
2236 } else {
2237 set state {__}
2240 # Restage the file, or simply show the diff
2241 if {$col == 0 && $y > 1} {
2242 # Conflicts need special handling
2243 if {[string first {U} $state] >= 0} {
2244 # $w must always be $ui_workdir, but...
2245 if {$w ne $ui_workdir} { set lno {} }
2246 merge_stage_workdir $path $lno
2247 return
2250 if {[string index $state 1] eq {O}} {
2251 set mmask {}
2252 } else {
2253 set mmask {[^O]}
2256 set after [next_diff_after_action $w $path $lno $mmask]
2258 if {$w eq $ui_index} {
2259 update_indexinfo \
2260 "Unstaging [short_path $path] from commit" \
2261 [list $path] \
2262 [concat $after [list ui_ready]]
2263 } elseif {$w eq $ui_workdir} {
2264 update_index \
2265 "Adding [short_path $path]" \
2266 [list $path] \
2267 [concat $after [list ui_ready]]
2269 } else {
2270 show_diff $path $w $lno
2274 proc add_one_to_selection {w x y} {
2275 global file_lists last_clicked selected_paths
2277 set lno [lindex [split [$w index @$x,$y] .] 0]
2278 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2279 if {$path eq {}} {
2280 set last_clicked {}
2281 return
2284 if {$last_clicked ne {}
2285 && [lindex $last_clicked 0] ne $w} {
2286 array unset selected_paths
2287 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2290 set last_clicked [list $w $lno]
2291 if {[catch {set in_sel $selected_paths($path)}]} {
2292 set in_sel 0
2294 if {$in_sel} {
2295 unset selected_paths($path)
2296 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2297 } else {
2298 set selected_paths($path) 1
2299 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2303 proc add_range_to_selection {w x y} {
2304 global file_lists last_clicked selected_paths
2306 if {[lindex $last_clicked 0] ne $w} {
2307 toggle_or_diff $w $x $y
2308 return
2311 set lno [lindex [split [$w index @$x,$y] .] 0]
2312 set lc [lindex $last_clicked 1]
2313 if {$lc < $lno} {
2314 set begin $lc
2315 set end $lno
2316 } else {
2317 set begin $lno
2318 set end $lc
2321 foreach path [lrange $file_lists($w) \
2322 [expr {$begin - 1}] \
2323 [expr {$end - 1}]] {
2324 set selected_paths($path) 1
2326 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2329 proc show_more_context {} {
2330 global repo_config
2331 if {$repo_config(gui.diffcontext) < 99} {
2332 incr repo_config(gui.diffcontext)
2333 reshow_diff
2337 proc show_less_context {} {
2338 global repo_config
2339 if {$repo_config(gui.diffcontext) > 1} {
2340 incr repo_config(gui.diffcontext) -1
2341 reshow_diff
2345 ######################################################################
2347 ## ui construction
2349 load_config 0
2350 apply_config
2351 set ui_comm {}
2353 # -- Menu Bar
2355 menu .mbar -tearoff 0
2356 if {[is_MacOSX]} {
2357 # -- Apple Menu (Mac OS X only)
2359 .mbar add cascade -label Apple -menu .mbar.apple
2360 menu .mbar.apple
2362 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2363 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2364 if {[is_enabled branch]} {
2365 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2367 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2368 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2370 if {[is_enabled transport]} {
2371 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2372 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2374 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2375 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2378 # -- Repository Menu
2380 menu .mbar.repository
2382 .mbar.repository add command \
2383 -label [mc "Explore Working Copy"] \
2384 -command {do_explore}
2385 .mbar.repository add separator
2387 .mbar.repository add command \
2388 -label [mc "Browse Current Branch's Files"] \
2389 -command {browser::new $current_branch}
2390 set ui_browse_current [.mbar.repository index last]
2391 .mbar.repository add command \
2392 -label [mc "Browse Branch Files..."] \
2393 -command browser_open::dialog
2394 .mbar.repository add separator
2396 .mbar.repository add command \
2397 -label [mc "Visualize Current Branch's History"] \
2398 -command {do_gitk $current_branch false}
2399 set ui_visualize_current [.mbar.repository index last]
2400 .mbar.repository add command \
2401 -label [mc "Visualize All Branch History"] \
2402 -command {do_gitk --all false}
2403 .mbar.repository add separator
2405 proc current_branch_write {args} {
2406 global current_branch
2407 .mbar.repository entryconf $::ui_browse_current \
2408 -label [mc "Browse %s's Files" $current_branch]
2409 .mbar.repository entryconf $::ui_visualize_current \
2410 -label [mc "Visualize %s's History" $current_branch]
2412 trace add variable current_branch write current_branch_write
2414 if {[is_enabled multicommit]} {
2415 .mbar.repository add command -label [mc "Database Statistics"] \
2416 -command do_stats
2418 .mbar.repository add command -label [mc "Compress Database"] \
2419 -command do_gc
2421 .mbar.repository add command -label [mc "Verify Database"] \
2422 -command do_fsck_objects
2424 .mbar.repository add separator
2426 if {[is_Cygwin]} {
2427 .mbar.repository add command \
2428 -label [mc "Create Desktop Icon"] \
2429 -command do_cygwin_shortcut
2430 } elseif {[is_Windows]} {
2431 .mbar.repository add command \
2432 -label [mc "Create Desktop Icon"] \
2433 -command do_windows_shortcut
2434 } elseif {[is_MacOSX]} {
2435 .mbar.repository add command \
2436 -label [mc "Create Desktop Icon"] \
2437 -command do_macosx_app
2441 if {[is_MacOSX]} {
2442 proc ::tk::mac::Quit {args} { do_quit }
2443 } else {
2444 .mbar.repository add command -label [mc Quit] \
2445 -command do_quit \
2446 -accelerator $M1T-Q
2449 # -- Edit Menu
2451 menu .mbar.edit
2452 .mbar.edit add command -label [mc Undo] \
2453 -command {catch {[focus] edit undo}} \
2454 -accelerator $M1T-Z
2455 .mbar.edit add command -label [mc Redo] \
2456 -command {catch {[focus] edit redo}} \
2457 -accelerator $M1T-Y
2458 .mbar.edit add separator
2459 .mbar.edit add command -label [mc Cut] \
2460 -command {catch {tk_textCut [focus]}} \
2461 -accelerator $M1T-X
2462 .mbar.edit add command -label [mc Copy] \
2463 -command {catch {tk_textCopy [focus]}} \
2464 -accelerator $M1T-C
2465 .mbar.edit add command -label [mc Paste] \
2466 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2467 -accelerator $M1T-V
2468 .mbar.edit add command -label [mc Delete] \
2469 -command {catch {[focus] delete sel.first sel.last}} \
2470 -accelerator Del
2471 .mbar.edit add separator
2472 .mbar.edit add command -label [mc "Select All"] \
2473 -command {catch {[focus] tag add sel 0.0 end}} \
2474 -accelerator $M1T-A
2476 # -- Branch Menu
2478 if {[is_enabled branch]} {
2479 menu .mbar.branch
2481 .mbar.branch add command -label [mc "Create..."] \
2482 -command branch_create::dialog \
2483 -accelerator $M1T-N
2484 lappend disable_on_lock [list .mbar.branch entryconf \
2485 [.mbar.branch index last] -state]
2487 .mbar.branch add command -label [mc "Checkout..."] \
2488 -command branch_checkout::dialog \
2489 -accelerator $M1T-O
2490 lappend disable_on_lock [list .mbar.branch entryconf \
2491 [.mbar.branch index last] -state]
2493 .mbar.branch add command -label [mc "Rename..."] \
2494 -command branch_rename::dialog
2495 lappend disable_on_lock [list .mbar.branch entryconf \
2496 [.mbar.branch index last] -state]
2498 .mbar.branch add command -label [mc "Delete..."] \
2499 -command branch_delete::dialog
2500 lappend disable_on_lock [list .mbar.branch entryconf \
2501 [.mbar.branch index last] -state]
2503 .mbar.branch add command -label [mc "Reset..."] \
2504 -command merge::reset_hard
2505 lappend disable_on_lock [list .mbar.branch entryconf \
2506 [.mbar.branch index last] -state]
2509 # -- Commit Menu
2511 proc commit_btn_caption {} {
2512 if {[is_enabled nocommit]} {
2513 return [mc "Done"]
2514 } else {
2515 return [mc Commit@@verb]
2519 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2520 menu .mbar.commit
2522 if {![is_enabled nocommit]} {
2523 .mbar.commit add radiobutton \
2524 -label [mc "New Commit"] \
2525 -command do_select_commit_type \
2526 -variable selected_commit_type \
2527 -value new
2528 lappend disable_on_lock \
2529 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2531 .mbar.commit add radiobutton \
2532 -label [mc "Amend Last Commit"] \
2533 -command do_select_commit_type \
2534 -variable selected_commit_type \
2535 -value amend
2536 lappend disable_on_lock \
2537 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2539 .mbar.commit add separator
2542 .mbar.commit add command -label [mc Rescan] \
2543 -command ui_do_rescan \
2544 -accelerator F5
2545 lappend disable_on_lock \
2546 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2548 .mbar.commit add command -label [mc "Stage To Commit"] \
2549 -command do_add_selection \
2550 -accelerator $M1T-T
2551 lappend disable_on_lock \
2552 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2554 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2555 -command do_add_all \
2556 -accelerator $M1T-I
2557 lappend disable_on_lock \
2558 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2560 .mbar.commit add command -label [mc "Unstage From Commit"] \
2561 -command do_unstage_selection
2562 lappend disable_on_lock \
2563 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2565 .mbar.commit add command -label [mc "Revert Changes"] \
2566 -command do_revert_selection
2567 lappend disable_on_lock \
2568 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2570 .mbar.commit add separator
2572 .mbar.commit add command -label [mc "Show Less Context"] \
2573 -command show_less_context \
2574 -accelerator $M1T-\-
2576 .mbar.commit add command -label [mc "Show More Context"] \
2577 -command show_more_context \
2578 -accelerator $M1T-=
2580 .mbar.commit add separator
2582 if {![is_enabled nocommitmsg]} {
2583 .mbar.commit add command -label [mc "Sign Off"] \
2584 -command do_signoff \
2585 -accelerator $M1T-S
2588 .mbar.commit add command -label [commit_btn_caption] \
2589 -command do_commit \
2590 -accelerator $M1T-Return
2591 lappend disable_on_lock \
2592 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2595 # -- Merge Menu
2597 if {[is_enabled branch]} {
2598 menu .mbar.merge
2599 .mbar.merge add command -label [mc "Local Merge..."] \
2600 -command merge::dialog \
2601 -accelerator $M1T-M
2602 lappend disable_on_lock \
2603 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2604 .mbar.merge add command -label [mc "Abort Merge..."] \
2605 -command merge::reset_hard
2606 lappend disable_on_lock \
2607 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2610 # -- Transport Menu
2612 if {[is_enabled transport]} {
2613 menu .mbar.remote
2615 .mbar.remote add command \
2616 -label [mc "Add..."] \
2617 -command remote_add::dialog \
2618 -accelerator $M1T-A
2619 .mbar.remote add command \
2620 -label [mc "Push..."] \
2621 -command do_push_anywhere \
2622 -accelerator $M1T-P
2623 .mbar.remote add command \
2624 -label [mc "Delete Branch..."] \
2625 -command remote_branch_delete::dialog
2628 if {[is_MacOSX]} {
2629 proc ::tk::mac::ShowPreferences {} {do_options}
2630 } else {
2631 # -- Edit Menu
2633 .mbar.edit add separator
2634 .mbar.edit add command -label [mc "Options..."] \
2635 -command do_options
2638 # -- Tools Menu
2640 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2641 set tools_menubar .mbar.tools
2642 menu $tools_menubar
2643 $tools_menubar add separator
2644 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2645 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2646 set tools_tailcnt 3
2647 if {[array names repo_config guitool.*.cmd] ne {}} {
2648 tools_populate_all
2652 # -- Help Menu
2654 .mbar add cascade -label [mc Help] -menu .mbar.help
2655 menu .mbar.help
2657 if {[is_MacOSX]} {
2658 .mbar.apple add command -label [mc "About %s" [appname]] \
2659 -command do_about
2660 .mbar.apple add separator
2661 } else {
2662 .mbar.help add command -label [mc "About %s" [appname]] \
2663 -command do_about
2665 . configure -menu .mbar
2667 set doc_path [githtmldir]
2668 if {$doc_path ne {}} {
2669 set doc_path [file join $doc_path index.html]
2671 if {[is_Cygwin]} {
2672 set doc_path [exec cygpath --mixed $doc_path]
2676 if {[file isfile $doc_path]} {
2677 set doc_url "file:$doc_path"
2678 } else {
2679 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2682 proc start_browser {url} {
2683 git "web--browse" $url
2686 .mbar.help add command -label [mc "Online Documentation"] \
2687 -command [list start_browser $doc_url]
2689 .mbar.help add command -label [mc "Show SSH Key"] \
2690 -command do_ssh_key
2692 unset doc_path doc_url
2694 # -- Standard bindings
2696 wm protocol . WM_DELETE_WINDOW do_quit
2697 bind all <$M1B-Key-q> do_quit
2698 bind all <$M1B-Key-Q> do_quit
2699 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2700 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2702 set subcommand_args {}
2703 proc usage {} {
2704 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2705 exit 1
2708 proc normalize_relpath {path} {
2709 set elements {}
2710 foreach item [file split $path] {
2711 if {$item eq {.}} continue
2712 if {$item eq {..} && [llength $elements] > 0
2713 && [lindex $elements end] ne {..}} {
2714 set elements [lrange $elements 0 end-1]
2715 continue
2717 lappend elements $item
2719 return [eval file join $elements]
2722 # -- Not a normal commit type invocation? Do that instead!
2724 switch -- $subcommand {
2725 browser -
2726 blame {
2727 if {$subcommand eq "blame"} {
2728 set subcommand_args {[--line=<num>] rev? path}
2729 } else {
2730 set subcommand_args {rev? path}
2732 if {$argv eq {}} usage
2733 set head {}
2734 set path {}
2735 set jump_spec {}
2736 set is_path 0
2737 foreach a $argv {
2738 if {$is_path || [file exists $_prefix$a]} {
2739 if {$path ne {}} usage
2740 set path [normalize_relpath $_prefix$a]
2741 break
2742 } elseif {$a eq {--}} {
2743 if {$path ne {}} {
2744 if {$head ne {}} usage
2745 set head $path
2746 set path {}
2748 set is_path 1
2749 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2750 if {$jump_spec ne {} || $head ne {}} usage
2751 set jump_spec [list $lnum]
2752 } elseif {$head eq {}} {
2753 if {$head ne {}} usage
2754 set head $a
2755 set is_path 1
2756 } else {
2757 usage
2760 unset is_path
2762 if {$head ne {} && $path eq {}} {
2763 set path [normalize_relpath $_prefix$head]
2764 set head {}
2767 if {$head eq {}} {
2768 load_current_branch
2769 } else {
2770 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2771 if {[catch {
2772 set head [git rev-parse --verify $head]
2773 } err]} {
2774 puts stderr $err
2775 exit 1
2778 set current_branch $head
2781 switch -- $subcommand {
2782 browser {
2783 if {$jump_spec ne {}} usage
2784 if {$head eq {}} {
2785 if {$path ne {} && [file isdirectory $path]} {
2786 set head $current_branch
2787 } else {
2788 set head $path
2789 set path {}
2792 browser::new $head $path
2794 blame {
2795 if {$head eq {} && ![file exists $path]} {
2796 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2797 exit 1
2799 blame::new $head $path $jump_spec
2802 return
2804 citool -
2805 gui {
2806 if {[llength $argv] != 0} {
2807 puts -nonewline stderr "usage: $argv0"
2808 if {$subcommand ne {gui}
2809 && [file tail $argv0] ne "git-$subcommand"} {
2810 puts -nonewline stderr " $subcommand"
2812 puts stderr {}
2813 exit 1
2815 # fall through to setup UI for commits
2817 default {
2818 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2819 exit 1
2823 # -- Branch Control
2825 frame .branch \
2826 -borderwidth 1 \
2827 -relief sunken
2828 label .branch.l1 \
2829 -text [mc "Current Branch:"] \
2830 -anchor w \
2831 -justify left
2832 label .branch.cb \
2833 -textvariable current_branch \
2834 -anchor w \
2835 -justify left
2836 pack .branch.l1 -side left
2837 pack .branch.cb -side left -fill x
2838 pack .branch -side top -fill x
2840 # -- Main Window Layout
2842 panedwindow .vpane -orient horizontal
2843 panedwindow .vpane.files -orient vertical
2844 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2845 pack .vpane -anchor n -side top -fill both -expand 1
2847 # -- Index File List
2849 frame .vpane.files.index -height 100 -width 200
2850 label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2851 -background lightgreen -foreground black
2852 text $ui_index -background white -foreground black \
2853 -borderwidth 0 \
2854 -width 20 -height 10 \
2855 -wrap none \
2856 -cursor $cursor_ptr \
2857 -xscrollcommand {.vpane.files.index.sx set} \
2858 -yscrollcommand {.vpane.files.index.sy set} \
2859 -state disabled
2860 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2861 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2862 pack .vpane.files.index.title -side top -fill x
2863 pack .vpane.files.index.sx -side bottom -fill x
2864 pack .vpane.files.index.sy -side right -fill y
2865 pack $ui_index -side left -fill both -expand 1
2867 # -- Working Directory File List
2869 frame .vpane.files.workdir -height 100 -width 200
2870 label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2871 -background lightsalmon -foreground black
2872 text $ui_workdir -background white -foreground black \
2873 -borderwidth 0 \
2874 -width 20 -height 10 \
2875 -wrap none \
2876 -cursor $cursor_ptr \
2877 -xscrollcommand {.vpane.files.workdir.sx set} \
2878 -yscrollcommand {.vpane.files.workdir.sy set} \
2879 -state disabled
2880 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2881 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2882 pack .vpane.files.workdir.title -side top -fill x
2883 pack .vpane.files.workdir.sx -side bottom -fill x
2884 pack .vpane.files.workdir.sy -side right -fill y
2885 pack $ui_workdir -side left -fill both -expand 1
2887 .vpane.files add .vpane.files.workdir -sticky nsew
2888 .vpane.files add .vpane.files.index -sticky nsew
2890 foreach i [list $ui_index $ui_workdir] {
2891 rmsel_tag $i
2892 $i tag conf in_diff -background [$i tag cget in_sel -background]
2894 unset i
2896 # -- Diff and Commit Area
2898 frame .vpane.lower -height 300 -width 400
2899 frame .vpane.lower.commarea
2900 frame .vpane.lower.diff -relief sunken -borderwidth 1
2901 pack .vpane.lower.diff -fill both -expand 1
2902 pack .vpane.lower.commarea -side bottom -fill x
2903 .vpane add .vpane.lower -sticky nsew
2905 # -- Commit Area Buttons
2907 frame .vpane.lower.commarea.buttons
2908 label .vpane.lower.commarea.buttons.l -text {} \
2909 -anchor w \
2910 -justify left
2911 pack .vpane.lower.commarea.buttons.l -side top -fill x
2912 pack .vpane.lower.commarea.buttons -side left -fill y
2914 button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2915 -command ui_do_rescan
2916 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2917 lappend disable_on_lock \
2918 {.vpane.lower.commarea.buttons.rescan conf -state}
2920 button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2921 -command do_add_all
2922 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2923 lappend disable_on_lock \
2924 {.vpane.lower.commarea.buttons.incall conf -state}
2926 if {![is_enabled nocommitmsg]} {
2927 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2928 -command do_signoff
2929 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2932 button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
2933 -command do_commit
2934 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2935 lappend disable_on_lock \
2936 {.vpane.lower.commarea.buttons.commit conf -state}
2938 if {![is_enabled nocommit]} {
2939 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2940 -command do_push_anywhere
2941 pack .vpane.lower.commarea.buttons.push -side top -fill x
2944 # -- Commit Message Buffer
2946 frame .vpane.lower.commarea.buffer
2947 frame .vpane.lower.commarea.buffer.header
2948 set ui_comm .vpane.lower.commarea.buffer.t
2949 set ui_coml .vpane.lower.commarea.buffer.header.l
2951 if {![is_enabled nocommit]} {
2952 radiobutton .vpane.lower.commarea.buffer.header.new \
2953 -text [mc "New Commit"] \
2954 -command do_select_commit_type \
2955 -variable selected_commit_type \
2956 -value new
2957 lappend disable_on_lock \
2958 [list .vpane.lower.commarea.buffer.header.new conf -state]
2959 radiobutton .vpane.lower.commarea.buffer.header.amend \
2960 -text [mc "Amend Last Commit"] \
2961 -command do_select_commit_type \
2962 -variable selected_commit_type \
2963 -value amend
2964 lappend disable_on_lock \
2965 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2968 label $ui_coml \
2969 -anchor w \
2970 -justify left
2971 proc trace_commit_type {varname args} {
2972 global ui_coml commit_type
2973 switch -glob -- $commit_type {
2974 initial {set txt [mc "Initial Commit Message:"]}
2975 amend {set txt [mc "Amended Commit Message:"]}
2976 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2977 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2978 merge {set txt [mc "Merge Commit Message:"]}
2979 * {set txt [mc "Commit Message:"]}
2981 $ui_coml conf -text $txt
2983 trace add variable commit_type write trace_commit_type
2984 pack $ui_coml -side left -fill x
2986 if {![is_enabled nocommit]} {
2987 pack .vpane.lower.commarea.buffer.header.amend -side right
2988 pack .vpane.lower.commarea.buffer.header.new -side right
2991 text $ui_comm -background white -foreground black \
2992 -borderwidth 1 \
2993 -undo true \
2994 -maxundo 20 \
2995 -autoseparators true \
2996 -relief sunken \
2997 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
2998 -font font_diff \
2999 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3000 scrollbar .vpane.lower.commarea.buffer.sby \
3001 -command [list $ui_comm yview]
3002 pack .vpane.lower.commarea.buffer.header -side top -fill x
3003 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3004 pack $ui_comm -side left -fill y
3005 pack .vpane.lower.commarea.buffer -side left -fill y
3007 # -- Commit Message Buffer Context Menu
3009 set ctxm .vpane.lower.commarea.buffer.ctxm
3010 menu $ctxm -tearoff 0
3011 $ctxm add command \
3012 -label [mc Cut] \
3013 -command {tk_textCut $ui_comm}
3014 $ctxm add command \
3015 -label [mc Copy] \
3016 -command {tk_textCopy $ui_comm}
3017 $ctxm add command \
3018 -label [mc Paste] \
3019 -command {tk_textPaste $ui_comm}
3020 $ctxm add command \
3021 -label [mc Delete] \
3022 -command {catch {$ui_comm delete sel.first sel.last}}
3023 $ctxm add separator
3024 $ctxm add command \
3025 -label [mc "Select All"] \
3026 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3027 $ctxm add command \
3028 -label [mc "Copy All"] \
3029 -command {
3030 $ui_comm tag add sel 0.0 end
3031 tk_textCopy $ui_comm
3032 $ui_comm tag remove sel 0.0 end
3034 $ctxm add separator
3035 $ctxm add command \
3036 -label [mc "Sign Off"] \
3037 -command do_signoff
3038 set ui_comm_ctxm $ctxm
3040 # -- Diff Header
3042 proc trace_current_diff_path {varname args} {
3043 global current_diff_path diff_actions file_states
3044 if {$current_diff_path eq {}} {
3045 set s {}
3046 set f {}
3047 set p {}
3048 set o disabled
3049 } else {
3050 set p $current_diff_path
3051 set s [mapdesc [lindex $file_states($p) 0] $p]
3052 set f [mc "File:"]
3053 set p [escape_path $p]
3054 set o normal
3057 .vpane.lower.diff.header.status configure -text $s
3058 .vpane.lower.diff.header.file configure -text $f
3059 .vpane.lower.diff.header.path configure -text $p
3060 foreach w $diff_actions {
3061 uplevel #0 $w $o
3064 trace add variable current_diff_path write trace_current_diff_path
3066 frame .vpane.lower.diff.header -background gold
3067 label .vpane.lower.diff.header.status \
3068 -background gold \
3069 -foreground black \
3070 -width $max_status_desc \
3071 -anchor w \
3072 -justify left
3073 label .vpane.lower.diff.header.file \
3074 -background gold \
3075 -foreground black \
3076 -anchor w \
3077 -justify left
3078 label .vpane.lower.diff.header.path \
3079 -background gold \
3080 -foreground black \
3081 -anchor w \
3082 -justify left
3083 pack .vpane.lower.diff.header.status -side left
3084 pack .vpane.lower.diff.header.file -side left
3085 pack .vpane.lower.diff.header.path -fill x
3086 set ctxm .vpane.lower.diff.header.ctxm
3087 menu $ctxm -tearoff 0
3088 $ctxm add command \
3089 -label [mc Copy] \
3090 -command {
3091 clipboard clear
3092 clipboard append \
3093 -format STRING \
3094 -type STRING \
3095 -- $current_diff_path
3097 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3098 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3100 # -- Diff Body
3102 frame .vpane.lower.diff.body
3103 set ui_diff .vpane.lower.diff.body.t
3104 text $ui_diff -background white -foreground black \
3105 -borderwidth 0 \
3106 -width 80 -height 15 -wrap none \
3107 -font font_diff \
3108 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3109 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3110 -state disabled
3111 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3112 -command [list $ui_diff xview]
3113 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3114 -command [list $ui_diff yview]
3115 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3116 pack .vpane.lower.diff.body.sby -side right -fill y
3117 pack $ui_diff -side left -fill both -expand 1
3118 pack .vpane.lower.diff.header -side top -fill x
3119 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3121 $ui_diff tag conf d_cr -elide true
3122 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
3123 $ui_diff tag conf d_+ -foreground {#00a000}
3124 $ui_diff tag conf d_- -foreground red
3126 $ui_diff tag conf d_++ -foreground {#00a000}
3127 $ui_diff tag conf d_-- -foreground red
3128 $ui_diff tag conf d_+s \
3129 -foreground {#00a000} \
3130 -background {#e2effa}
3131 $ui_diff tag conf d_-s \
3132 -foreground red \
3133 -background {#e2effa}
3134 $ui_diff tag conf d_s+ \
3135 -foreground {#00a000} \
3136 -background ivory1
3137 $ui_diff tag conf d_s- \
3138 -foreground red \
3139 -background ivory1
3141 $ui_diff tag conf d<<<<<<< \
3142 -foreground orange \
3143 -font font_diffbold
3144 $ui_diff tag conf d======= \
3145 -foreground orange \
3146 -font font_diffbold
3147 $ui_diff tag conf d>>>>>>> \
3148 -foreground orange \
3149 -font font_diffbold
3151 $ui_diff tag raise sel
3153 # -- Diff Body Context Menu
3156 proc create_common_diff_popup {ctxm} {
3157 $ctxm add command \
3158 -label [mc Refresh] \
3159 -command reshow_diff
3160 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3161 $ctxm add command \
3162 -label [mc Copy] \
3163 -command {tk_textCopy $ui_diff}
3164 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3165 $ctxm add command \
3166 -label [mc "Select All"] \
3167 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3168 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3169 $ctxm add command \
3170 -label [mc "Copy All"] \
3171 -command {
3172 $ui_diff tag add sel 0.0 end
3173 tk_textCopy $ui_diff
3174 $ui_diff tag remove sel 0.0 end
3176 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3177 $ctxm add separator
3178 $ctxm add command \
3179 -label [mc "Decrease Font Size"] \
3180 -command {incr_font_size font_diff -1}
3181 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3182 $ctxm add command \
3183 -label [mc "Increase Font Size"] \
3184 -command {incr_font_size font_diff 1}
3185 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3186 $ctxm add separator
3187 set emenu $ctxm.enc
3188 menu $emenu
3189 build_encoding_menu $emenu [list force_diff_encoding]
3190 $ctxm add cascade \
3191 -label [mc "Encoding"] \
3192 -menu $emenu
3193 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3194 $ctxm add separator
3195 $ctxm add command -label [mc "Options..."] \
3196 -command do_options
3199 set ctxm .vpane.lower.diff.body.ctxm
3200 menu $ctxm -tearoff 0
3201 $ctxm add command \
3202 -label [mc "Apply/Reverse Hunk"] \
3203 -command {apply_hunk $cursorX $cursorY}
3204 set ui_diff_applyhunk [$ctxm index last]
3205 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3206 $ctxm add command \
3207 -label [mc "Apply/Reverse Line"] \
3208 -command {apply_line $cursorX $cursorY; do_rescan}
3209 set ui_diff_applyline [$ctxm index last]
3210 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3211 $ctxm add separator
3212 $ctxm add command \
3213 -label [mc "Show Less Context"] \
3214 -command show_less_context
3215 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3216 $ctxm add command \
3217 -label [mc "Show More Context"] \
3218 -command show_more_context
3219 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3220 $ctxm add separator
3221 create_common_diff_popup $ctxm
3223 set ctxmmg .vpane.lower.diff.body.ctxmmg
3224 menu $ctxmmg -tearoff 0
3225 $ctxmmg add command \
3226 -label [mc "Run Merge Tool"] \
3227 -command {merge_resolve_tool}
3228 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3229 $ctxmmg add separator
3230 $ctxmmg add command \
3231 -label [mc "Use Remote Version"] \
3232 -command {merge_resolve_one 3}
3233 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3234 $ctxmmg add command \
3235 -label [mc "Use Local Version"] \
3236 -command {merge_resolve_one 2}
3237 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3238 $ctxmmg add command \
3239 -label [mc "Revert To Base"] \
3240 -command {merge_resolve_one 1}
3241 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3242 $ctxmmg add separator
3243 $ctxmmg add command \
3244 -label [mc "Show Less Context"] \
3245 -command show_less_context
3246 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3247 $ctxmmg add command \
3248 -label [mc "Show More Context"] \
3249 -command show_more_context
3250 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3251 $ctxmmg add separator
3252 create_common_diff_popup $ctxmmg
3254 set ctxmsm .vpane.lower.diff.body.ctxmsm
3255 menu $ctxmsm -tearoff 0
3256 $ctxmsm add command \
3257 -label [mc "Start git gui In The Submodule"] \
3258 -command {do_git_gui}
3259 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3260 $ctxmsm add command \
3261 -label [mc "Visualize These Changes In The Submodule"] \
3262 -command {do_gitk {} true}
3263 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3264 $ctxmsm add command \
3265 -label [mc "Visualize This Commits History In The Submodule"] \
3266 -command {do_gitk -- true}
3267 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3268 $ctxmsm add command \
3269 -label [mc "Visualize All Branch History In The Submodule"] \
3270 -command {do_gitk --all true}
3271 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3272 $ctxmsm add separator
3273 create_common_diff_popup $ctxmsm
3275 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3276 global current_diff_path file_states
3277 set ::cursorX $x
3278 set ::cursorY $y
3279 if {[info exists file_states($current_diff_path)]} {
3280 set state [lindex $file_states($current_diff_path) 0]
3281 } else {
3282 set state {__}
3284 if {[string first {U} $state] >= 0} {
3285 tk_popup $ctxmmg $X $Y
3286 } elseif {$::is_submodule_diff} {
3287 tk_popup $ctxmsm $X $Y
3288 } else {
3289 if {$::ui_index eq $::current_diff_side} {
3290 set l [mc "Unstage Hunk From Commit"]
3291 set t [mc "Unstage Line From Commit"]
3292 } else {
3293 set l [mc "Stage Hunk For Commit"]
3294 set t [mc "Stage Line For Commit"]
3296 if {$::is_3way_diff
3297 || $current_diff_path eq {}
3298 || {__} eq $state
3299 || {_O} eq $state
3300 || {_T} eq $state
3301 || {T_} eq $state} {
3302 set s disabled
3303 } else {
3304 set s normal
3306 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3307 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3308 tk_popup $ctxm $X $Y
3311 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3313 # -- Status Bar
3315 set main_status [::status_bar::new .status]
3316 pack .status -anchor w -side bottom -fill x
3317 $main_status show [mc "Initializing..."]
3319 # -- Load geometry
3321 catch {
3322 set gm $repo_config(gui.geometry)
3323 wm geometry . [lindex $gm 0]
3324 .vpane sash place 0 \
3325 [lindex $gm 1] \
3326 [lindex [.vpane sash coord 0] 1]
3327 .vpane.files sash place 0 \
3328 [lindex [.vpane.files sash coord 0] 0] \
3329 [lindex $gm 2]
3330 unset gm
3333 # -- Key Bindings
3335 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3336 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3337 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3338 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3339 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3340 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3341 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3342 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3343 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3344 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3345 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3346 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3347 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3348 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3349 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3350 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3351 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3352 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3354 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3355 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3356 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3357 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3358 bind $ui_diff <$M1B-Key-v> {break}
3359 bind $ui_diff <$M1B-Key-V> {break}
3360 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3361 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3362 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3363 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3364 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3365 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3366 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3367 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3368 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3369 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3370 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3371 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3372 bind $ui_diff <Button-1> {focus %W}
3374 if {[is_enabled branch]} {
3375 bind . <$M1B-Key-n> branch_create::dialog
3376 bind . <$M1B-Key-N> branch_create::dialog
3377 bind . <$M1B-Key-o> branch_checkout::dialog
3378 bind . <$M1B-Key-O> branch_checkout::dialog
3379 bind . <$M1B-Key-m> merge::dialog
3380 bind . <$M1B-Key-M> merge::dialog
3382 if {[is_enabled transport]} {
3383 bind . <$M1B-Key-p> do_push_anywhere
3384 bind . <$M1B-Key-P> do_push_anywhere
3387 bind . <Key-F5> ui_do_rescan
3388 bind . <$M1B-Key-r> ui_do_rescan
3389 bind . <$M1B-Key-R> ui_do_rescan
3390 bind . <$M1B-Key-s> do_signoff
3391 bind . <$M1B-Key-S> do_signoff
3392 bind . <$M1B-Key-t> do_add_selection
3393 bind . <$M1B-Key-T> do_add_selection
3394 bind . <$M1B-Key-i> do_add_all
3395 bind . <$M1B-Key-I> do_add_all
3396 bind . <$M1B-Key-minus> {show_less_context;break}
3397 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3398 bind . <$M1B-Key-equal> {show_more_context;break}
3399 bind . <$M1B-Key-plus> {show_more_context;break}
3400 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3401 bind . <$M1B-Key-Return> do_commit
3402 foreach i [list $ui_index $ui_workdir] {
3403 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3404 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3405 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3407 unset i
3409 set file_lists($ui_index) [list]
3410 set file_lists($ui_workdir) [list]
3412 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3413 focus -force $ui_comm
3415 # -- Warn the user about environmental problems. Cygwin's Tcl
3416 # does *not* pass its env array onto any processes it spawns.
3417 # This means that git processes get none of our environment.
3419 if {[is_Cygwin]} {
3420 set ignored_env 0
3421 set suggest_user {}
3422 set msg [mc "Possible environment issues exist.
3424 The following environment variables are probably
3425 going to be ignored by any Git subprocess run
3426 by %s:
3428 " [appname]]
3429 foreach name [array names env] {
3430 switch -regexp -- $name {
3431 {^GIT_INDEX_FILE$} -
3432 {^GIT_OBJECT_DIRECTORY$} -
3433 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3434 {^GIT_DIFF_OPTS$} -
3435 {^GIT_EXTERNAL_DIFF$} -
3436 {^GIT_PAGER$} -
3437 {^GIT_TRACE$} -
3438 {^GIT_CONFIG$} -
3439 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3440 append msg " - $name\n"
3441 incr ignored_env
3443 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3444 append msg " - $name\n"
3445 incr ignored_env
3446 set suggest_user $name
3450 if {$ignored_env > 0} {
3451 append msg [mc "
3452 This is due to a known issue with the
3453 Tcl binary distributed by Cygwin."]
3455 if {$suggest_user ne {}} {
3456 append msg [mc "
3458 A good replacement for %s
3459 is placing values for the user.name and
3460 user.email settings into your personal
3461 ~/.gitconfig file.
3462 " $suggest_user]
3464 warn_popup $msg
3466 unset ignored_env msg suggest_user name
3469 # -- Only initialize complex UI if we are going to stay running.
3471 if {[is_enabled transport]} {
3472 load_all_remotes
3474 set n [.mbar.remote index end]
3475 populate_remotes_menu
3476 set n [expr {[.mbar.remote index end] - $n}]
3477 if {$n > 0} {
3478 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3479 .mbar.remote insert $n separator
3481 unset n
3484 if {[winfo exists $ui_comm]} {
3485 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3487 # -- If both our backup and message files exist use the
3488 # newer of the two files to initialize the buffer.
3490 if {$GITGUI_BCK_exists} {
3491 set m [gitdir GITGUI_MSG]
3492 if {[file isfile $m]} {
3493 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3494 catch {file delete [gitdir GITGUI_MSG]}
3495 } else {
3496 $ui_comm delete 0.0 end
3497 $ui_comm edit reset
3498 $ui_comm edit modified false
3499 catch {file delete [gitdir GITGUI_BCK]}
3500 set GITGUI_BCK_exists 0
3503 unset m
3506 proc backup_commit_buffer {} {
3507 global ui_comm GITGUI_BCK_exists
3509 set m [$ui_comm edit modified]
3510 if {$m || $GITGUI_BCK_exists} {
3511 set msg [string trim [$ui_comm get 0.0 end]]
3512 regsub -all -line {[ \r\t]+$} $msg {} msg
3514 if {$msg eq {}} {
3515 if {$GITGUI_BCK_exists} {
3516 catch {file delete [gitdir GITGUI_BCK]}
3517 set GITGUI_BCK_exists 0
3519 } elseif {$m} {
3520 catch {
3521 set fd [open [gitdir GITGUI_BCK] w]
3522 puts -nonewline $fd $msg
3523 close $fd
3524 set GITGUI_BCK_exists 1
3528 $ui_comm edit modified false
3531 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3534 backup_commit_buffer
3536 # -- If the user has aspell available we can drive it
3537 # in pipe mode to spellcheck the commit message.
3539 set spell_cmd [list |]
3540 set spell_dict [get_config gui.spellingdictionary]
3541 lappend spell_cmd aspell
3542 if {$spell_dict ne {}} {
3543 lappend spell_cmd --master=$spell_dict
3545 lappend spell_cmd --mode=none
3546 lappend spell_cmd --encoding=utf-8
3547 lappend spell_cmd pipe
3548 if {$spell_dict eq {none}
3549 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3550 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3551 } else {
3552 set ui_comm_spell [spellcheck::init \
3553 $spell_fd \
3554 $ui_comm \
3555 $ui_comm_ctxm \
3558 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3561 lock_index begin-read
3562 if {![winfo ismapped .]} {
3563 wm deiconify .
3565 after 1 {
3566 if {[is_enabled initialamend]} {
3567 force_amend
3568 } else {
3569 do_rescan
3572 if {[is_enabled nocommitmsg]} {
3573 $ui_comm configure -state disabled -background gray
3576 if {[is_enabled multicommit]} {
3577 after 1000 hint_gc
3579 if {[is_enabled retcode]} {
3580 bind . <Destroy> {+terminate_me %W}
3582 if {$picked && [is_config_true gui.autoexplore]} {
3583 do_explore