Kill the blame back-end on window close.
[alt-git.git] / git-gui.sh
blob83e2645714e11ab783144bb8dc71a968502640d1
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 dirname [file normalize $argv0]]]
56 set oguilib [file join $oguilib share git-gui lib]
57 set oguimsg [file join $oguilib msgs]
58 } elseif {[string match @@* $oguirel]} {
59 set oguilib [file join [file dirname [file normalize $argv0]] lib]
60 set oguimsg [file join [file dirname [file normalize $argv0]] po]
61 } else {
62 set oguimsg [file join $oguilib msgs]
64 unset oguirel
66 ######################################################################
68 ## enable verbose loading?
70 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
71 unset _verbose
72 rename auto_load real__auto_load
73 proc auto_load {name args} {
74 puts stderr "auto_load $name"
75 return [uplevel 1 real__auto_load $name $args]
77 rename source real__source
78 proc source {name} {
79 puts stderr "source $name"
80 uplevel 1 real__source $name
84 ######################################################################
86 ## Internationalization (i18n) through msgcat and gettext. See
87 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
89 package require msgcat
91 proc _mc_trim {fmt} {
92 set cmk [string first @@ $fmt]
93 if {$cmk > 0} {
94 return [string range $fmt 0 [expr {$cmk - 1}]]
96 return $fmt
99 proc mc {en_fmt args} {
100 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
101 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
102 set msg [eval [list format [_mc_trim $en_fmt]] $args]
104 return $msg
107 proc strcat {args} {
108 return [join $args {}]
111 ::msgcat::mcload $oguimsg
112 unset oguimsg
114 ######################################################################
116 ## read only globals
118 set _appname {Git Gui}
119 set _gitdir {}
120 set _gitexec {}
121 set _reponame {}
122 set _iscygwin {}
123 set _search_path {}
125 set _trace [lsearch -exact $argv --trace]
126 if {$_trace >= 0} {
127 set argv [lreplace $argv $_trace $_trace]
128 set _trace 1
129 } else {
130 set _trace 0
133 proc appname {} {
134 global _appname
135 return $_appname
138 proc gitdir {args} {
139 global _gitdir
140 if {$args eq {}} {
141 return $_gitdir
143 return [eval [list file join $_gitdir] $args]
146 proc gitexec {args} {
147 global _gitexec
148 if {$_gitexec eq {}} {
149 if {[catch {set _gitexec [git --exec-path]} err]} {
150 error "Git not installed?\n\n$err"
152 if {[is_Cygwin]} {
153 set _gitexec [exec cygpath \
154 --windows \
155 --absolute \
156 $_gitexec]
157 } else {
158 set _gitexec [file normalize $_gitexec]
161 if {$args eq {}} {
162 return $_gitexec
164 return [eval [list file join $_gitexec] $args]
167 proc reponame {} {
168 return $::_reponame
171 proc is_MacOSX {} {
172 if {[tk windowingsystem] eq {aqua}} {
173 return 1
175 return 0
178 proc is_Windows {} {
179 if {$::tcl_platform(platform) eq {windows}} {
180 return 1
182 return 0
185 proc is_Cygwin {} {
186 global _iscygwin
187 if {$_iscygwin eq {}} {
188 if {$::tcl_platform(platform) eq {windows}} {
189 if {[catch {set p [exec cygpath --windir]} err]} {
190 set _iscygwin 0
191 } else {
192 set _iscygwin 1
194 } else {
195 set _iscygwin 0
198 return $_iscygwin
201 proc is_enabled {option} {
202 global enabled_options
203 if {[catch {set on $enabled_options($option)}]} {return 0}
204 return $on
207 proc enable_option {option} {
208 global enabled_options
209 set enabled_options($option) 1
212 proc disable_option {option} {
213 global enabled_options
214 set enabled_options($option) 0
217 ######################################################################
219 ## config
221 proc is_many_config {name} {
222 switch -glob -- $name {
223 gui.recentrepo -
224 remote.*.fetch -
225 remote.*.push
226 {return 1}
228 {return 0}
232 proc is_config_true {name} {
233 global repo_config
234 if {[catch {set v $repo_config($name)}]} {
235 return 0
236 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
237 return 1
238 } else {
239 return 0
243 proc get_config {name} {
244 global repo_config
245 if {[catch {set v $repo_config($name)}]} {
246 return {}
247 } else {
248 return $v
252 ######################################################################
254 ## handy utils
256 proc _trace_exec {cmd} {
257 if {!$::_trace} return
258 set d {}
259 foreach v $cmd {
260 if {$d ne {}} {
261 append d { }
263 if {[regexp {[ \t\r\n'"$?*]} $v]} {
264 set v [sq $v]
266 append d $v
268 puts stderr $d
271 proc _git_cmd {name} {
272 global _git_cmd_path
274 if {[catch {set v $_git_cmd_path($name)}]} {
275 switch -- $name {
276 version -
277 --version -
278 --exec-path { return [list $::_git $name] }
281 set p [gitexec git-$name$::_search_exe]
282 if {[file exists $p]} {
283 set v [list $p]
284 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
285 # Try to determine what sort of magic will make
286 # git-$name go and do its thing, because native
287 # Tcl on Windows doesn't know it.
289 set p [gitexec git-$name]
290 set f [open $p r]
291 set s [gets $f]
292 close $f
294 switch -glob -- [lindex $s 0] {
295 #!*sh { set i sh }
296 #!*perl { set i perl }
297 #!*python { set i python }
298 default { error "git-$name is not supported: $s" }
301 upvar #0 _$i interp
302 if {![info exists interp]} {
303 set interp [_which $i]
305 if {$interp eq {}} {
306 error "git-$name requires $i (not in PATH)"
308 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
309 } else {
310 # Assume it is builtin to git somehow and we
311 # aren't actually able to see a file for it.
313 set v [list $::_git $name]
315 set _git_cmd_path($name) $v
317 return $v
320 proc _which {what} {
321 global env _search_exe _search_path
323 if {$_search_path eq {}} {
324 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
325 set _search_path [split [exec cygpath \
326 --windows \
327 --path \
328 --absolute \
329 $env(PATH)] {;}]
330 set _search_exe .exe
331 } elseif {[is_Windows]} {
332 set gitguidir [file dirname [info script]]
333 regsub -all ";" $gitguidir "\\;" gitguidir
334 set env(PATH) "$gitguidir;$env(PATH)"
335 set _search_path [split $env(PATH) {;}]
336 set _search_exe .exe
337 } else {
338 set _search_path [split $env(PATH) :]
339 set _search_exe {}
343 foreach p $_search_path {
344 set p [file join $p $what$_search_exe]
345 if {[file exists $p]} {
346 return [file normalize $p]
349 return {}
352 proc _lappend_nice {cmd_var} {
353 global _nice
354 upvar $cmd_var cmd
356 if {![info exists _nice]} {
357 set _nice [_which nice]
359 if {$_nice ne {}} {
360 lappend cmd $_nice
364 proc git {args} {
365 set opt [list]
367 while {1} {
368 switch -- [lindex $args 0] {
369 --nice {
370 _lappend_nice opt
373 default {
374 break
379 set args [lrange $args 1 end]
382 set cmdp [_git_cmd [lindex $args 0]]
383 set args [lrange $args 1 end]
385 _trace_exec [concat $opt $cmdp $args]
386 set result [eval exec $opt $cmdp $args]
387 if {$::_trace} {
388 puts stderr "< $result"
390 return $result
393 proc _open_stdout_stderr {cmd} {
394 _trace_exec $cmd
395 if {[catch {
396 set fd [open [concat [list | ] $cmd] r]
397 } err]} {
398 if { [lindex $cmd end] eq {2>@1}
399 && $err eq {can not find channel named "1"}
401 # Older versions of Tcl 8.4 don't have this 2>@1 IO
402 # redirect operator. Fallback to |& cat for those.
403 # The command was not actually started, so its safe
404 # to try to start it a second time.
406 set fd [open [concat \
407 [list | ] \
408 [lrange $cmd 0 end-1] \
409 [list |& cat] \
410 ] r]
411 } else {
412 error $err
415 fconfigure $fd -eofchar {}
416 return $fd
419 proc git_read {args} {
420 set opt [list]
422 while {1} {
423 switch -- [lindex $args 0] {
424 --nice {
425 _lappend_nice opt
428 --stderr {
429 lappend args 2>@1
432 default {
433 break
438 set args [lrange $args 1 end]
441 set cmdp [_git_cmd [lindex $args 0]]
442 set args [lrange $args 1 end]
444 return [_open_stdout_stderr [concat $opt $cmdp $args]]
447 proc git_write {args} {
448 set opt [list]
450 while {1} {
451 switch -- [lindex $args 0] {
452 --nice {
453 _lappend_nice opt
456 default {
457 break
462 set args [lrange $args 1 end]
465 set cmdp [_git_cmd [lindex $args 0]]
466 set args [lrange $args 1 end]
468 _trace_exec [concat $opt $cmdp $args]
469 return [open [concat [list | ] $opt $cmdp $args] w]
472 proc githook_read {hook_name args} {
473 set pchook [gitdir hooks $hook_name]
474 lappend args 2>@1
476 # On Windows [file executable] might lie so we need to ask
477 # the shell if the hook is executable. Yes that's annoying.
479 if {[is_Windows]} {
480 upvar #0 _sh interp
481 if {![info exists interp]} {
482 set interp [_which sh]
484 if {$interp eq {}} {
485 error "hook execution requires sh (not in PATH)"
488 set scr {if test -x "$1";then exec "$@";fi}
489 set sh_c [list $interp -c $scr $interp $pchook]
490 return [_open_stdout_stderr [concat $sh_c $args]]
493 if {[file executable $pchook]} {
494 return [_open_stdout_stderr [concat [list $pchook] $args]]
497 return {}
500 proc kill_file_process {fd} {
501 set process [pid $fd]
503 catch {
504 if {[is_Windows]} {
505 # Use a Cygwin-specific flag to allow killing
506 # native Windows processes
507 exec kill -f $process
508 } else {
509 exec kill $process
514 proc sq {value} {
515 regsub -all ' $value "'\\''" value
516 return "'$value'"
519 proc load_current_branch {} {
520 global current_branch is_detached
522 set fd [open [gitdir HEAD] r]
523 if {[gets $fd ref] < 1} {
524 set ref {}
526 close $fd
528 set pfx {ref: refs/heads/}
529 set len [string length $pfx]
530 if {[string equal -length $len $pfx $ref]} {
531 # We're on a branch. It might not exist. But
532 # HEAD looks good enough to be a branch.
534 set current_branch [string range $ref $len end]
535 set is_detached 0
536 } else {
537 # Assume this is a detached head.
539 set current_branch HEAD
540 set is_detached 1
544 auto_load tk_optionMenu
545 rename tk_optionMenu real__tkOptionMenu
546 proc tk_optionMenu {w varName args} {
547 set m [eval real__tkOptionMenu $w $varName $args]
548 $m configure -font font_ui
549 $w configure -font font_ui
550 return $m
553 proc rmsel_tag {text} {
554 $text tag conf sel \
555 -background [$text cget -background] \
556 -foreground [$text cget -foreground] \
557 -borderwidth 0
558 $text tag conf in_sel -background lightgray
559 bind $text <Motion> break
560 return $text
563 set root_exists 0
564 bind . <Visibility> {
565 bind . <Visibility> {}
566 set root_exists 1
569 if {[is_Windows]} {
570 wm iconbitmap . -default $oguilib/git-gui.ico
573 ######################################################################
575 ## config defaults
577 set cursor_ptr arrow
578 font create font_diff -family Courier -size 10
579 font create font_ui
580 catch {
581 label .dummy
582 eval font configure font_ui [font actual [.dummy cget -font]]
583 destroy .dummy
586 font create font_uiitalic
587 font create font_uibold
588 font create font_diffbold
589 font create font_diffitalic
591 foreach class {Button Checkbutton Entry Label
592 Labelframe Listbox Menu Message
593 Radiobutton Spinbox Text} {
594 option add *$class.font font_ui
596 unset class
598 if {[is_Windows] || [is_MacOSX]} {
599 option add *Menu.tearOff 0
602 if {[is_MacOSX]} {
603 set M1B M1
604 set M1T Cmd
605 } else {
606 set M1B Control
607 set M1T Ctrl
610 proc bind_button3 {w cmd} {
611 bind $w <Any-Button-3> $cmd
612 if {[is_MacOSX]} {
613 # Mac OS X sends Button-2 on right click through three-button mouse,
614 # or through trackpad right-clicking (two-finger touch + click).
615 bind $w <Any-Button-2> $cmd
616 bind $w <Control-Button-1> $cmd
620 proc apply_config {} {
621 global repo_config font_descs
623 foreach option $font_descs {
624 set name [lindex $option 0]
625 set font [lindex $option 1]
626 if {[catch {
627 set need_weight 1
628 foreach {cn cv} $repo_config(gui.$name) {
629 if {$cn eq {-weight}} {
630 set need_weight 0
632 font configure $font $cn $cv
634 if {$need_weight} {
635 font configure $font -weight normal
637 } err]} {
638 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
640 foreach {cn cv} [font configure $font] {
641 font configure ${font}bold $cn $cv
642 font configure ${font}italic $cn $cv
644 font configure ${font}bold -weight bold
645 font configure ${font}italic -slant italic
649 set default_config(branch.autosetupmerge) true
650 set default_config(merge.diffstat) true
651 set default_config(merge.summary) false
652 set default_config(merge.verbosity) 2
653 set default_config(user.name) {}
654 set default_config(user.email) {}
656 set default_config(gui.matchtrackingbranch) false
657 set default_config(gui.pruneduringfetch) false
658 set default_config(gui.trustmtime) false
659 set default_config(gui.fastcopyblame) false
660 set default_config(gui.copyblamethreshold) 40
661 set default_config(gui.diffcontext) 5
662 set default_config(gui.commitmsgwidth) 75
663 set default_config(gui.newbranchtemplate) {}
664 set default_config(gui.spellingdictionary) {}
665 set default_config(gui.fontui) [font configure font_ui]
666 set default_config(gui.fontdiff) [font configure font_diff]
667 set font_descs {
668 {fontui font_ui {mc "Main Font"}}
669 {fontdiff font_diff {mc "Diff/Console Font"}}
672 ######################################################################
674 ## find git
676 set _git [_which git]
677 if {$_git eq {}} {
678 catch {wm withdraw .}
679 tk_messageBox \
680 -icon error \
681 -type ok \
682 -title [mc "git-gui: fatal error"] \
683 -message [mc "Cannot find git in PATH."]
684 exit 1
687 ######################################################################
689 ## version check
691 if {[catch {set _git_version [git --version]} err]} {
692 catch {wm withdraw .}
693 tk_messageBox \
694 -icon error \
695 -type ok \
696 -title [mc "git-gui: fatal error"] \
697 -message "Cannot determine Git version:
699 $err
701 [appname] requires Git 1.5.0 or later."
702 exit 1
704 if {![regsub {^git version } $_git_version {} _git_version]} {
705 catch {wm withdraw .}
706 tk_messageBox \
707 -icon error \
708 -type ok \
709 -title [mc "git-gui: fatal error"] \
710 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
711 exit 1
714 set _real_git_version $_git_version
715 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
716 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
717 regsub {\.rc[0-9]+$} $_git_version {} _git_version
718 regsub {\.GIT$} $_git_version {} _git_version
719 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
721 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
722 catch {wm withdraw .}
723 if {[tk_messageBox \
724 -icon warning \
725 -type yesno \
726 -default no \
727 -title "[appname]: warning" \
728 -message [mc "Git version cannot be determined.
730 %s claims it is version '%s'.
732 %s requires at least Git 1.5.0 or later.
734 Assume '%s' is version 1.5.0?
735 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
736 set _git_version 1.5.0
737 } else {
738 exit 1
741 unset _real_git_version
743 proc git-version {args} {
744 global _git_version
746 switch [llength $args] {
748 return $_git_version
752 set op [lindex $args 0]
753 set vr [lindex $args 1]
754 set cm [package vcompare $_git_version $vr]
755 return [expr $cm $op 0]
759 set type [lindex $args 0]
760 set name [lindex $args 1]
761 set parm [lindex $args 2]
762 set body [lindex $args 3]
764 if {($type ne {proc} && $type ne {method})} {
765 error "Invalid arguments to git-version"
767 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
768 error "Last arm of $type $name must be default"
771 foreach {op vr cb} [lrange $body 0 end-2] {
772 if {[git-version $op $vr]} {
773 return [uplevel [list $type $name $parm $cb]]
777 return [uplevel [list $type $name $parm [lindex $body end]]]
780 default {
781 error "git-version >= x"
787 if {[git-version < 1.5]} {
788 catch {wm withdraw .}
789 tk_messageBox \
790 -icon error \
791 -type ok \
792 -title [mc "git-gui: fatal error"] \
793 -message "[appname] requires Git 1.5.0 or later.
795 You are using [git-version]:
797 [git --version]"
798 exit 1
801 ######################################################################
803 ## configure our library
805 set idx [file join $oguilib tclIndex]
806 if {[catch {set fd [open $idx r]} err]} {
807 catch {wm withdraw .}
808 tk_messageBox \
809 -icon error \
810 -type ok \
811 -title [mc "git-gui: fatal error"] \
812 -message $err
813 exit 1
815 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
816 set idx [list]
817 while {[gets $fd n] >= 0} {
818 if {$n ne {} && ![string match #* $n]} {
819 lappend idx $n
822 } else {
823 set idx {}
825 close $fd
827 if {$idx ne {}} {
828 set loaded [list]
829 foreach p $idx {
830 if {[lsearch -exact $loaded $p] >= 0} continue
831 source [file join $oguilib $p]
832 lappend loaded $p
834 unset loaded p
835 } else {
836 set auto_path [concat [list $oguilib] $auto_path]
838 unset -nocomplain idx fd
840 ######################################################################
842 ## config file parsing
844 git-version proc _parse_config {arr_name args} {
845 >= 1.5.3 {
846 upvar $arr_name arr
847 array unset arr
848 set buf {}
849 catch {
850 set fd_rc [eval \
851 [list git_read config] \
852 $args \
853 [list --null --list]]
854 fconfigure $fd_rc -translation binary
855 set buf [read $fd_rc]
856 close $fd_rc
858 foreach line [split $buf "\0"] {
859 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
860 if {[is_many_config $name]} {
861 lappend arr($name) $value
862 } else {
863 set arr($name) $value
868 default {
869 upvar $arr_name arr
870 array unset arr
871 catch {
872 set fd_rc [eval [list git_read config --list] $args]
873 while {[gets $fd_rc line] >= 0} {
874 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
875 if {[is_many_config $name]} {
876 lappend arr($name) $value
877 } else {
878 set arr($name) $value
882 close $fd_rc
887 proc load_config {include_global} {
888 global repo_config global_config default_config
890 if {$include_global} {
891 _parse_config global_config --global
893 _parse_config repo_config
895 foreach name [array names default_config] {
896 if {[catch {set v $global_config($name)}]} {
897 set global_config($name) $default_config($name)
899 if {[catch {set v $repo_config($name)}]} {
900 set repo_config($name) $default_config($name)
905 ######################################################################
907 ## feature option selection
909 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
910 unset _junk
911 } else {
912 set subcommand gui
914 if {$subcommand eq {gui.sh}} {
915 set subcommand gui
917 if {$subcommand eq {gui} && [llength $argv] > 0} {
918 set subcommand [lindex $argv 0]
919 set argv [lrange $argv 1 end]
922 enable_option multicommit
923 enable_option branch
924 enable_option transport
925 disable_option bare
927 switch -- $subcommand {
928 browser -
929 blame {
930 enable_option bare
932 disable_option multicommit
933 disable_option branch
934 disable_option transport
936 citool {
937 enable_option singlecommit
939 disable_option multicommit
940 disable_option branch
941 disable_option transport
945 ######################################################################
947 ## repository setup
949 if {[catch {
950 set _gitdir $env(GIT_DIR)
951 set _prefix {}
953 && [catch {
954 set _gitdir [git rev-parse --git-dir]
955 set _prefix [git rev-parse --show-prefix]
956 } err]} {
957 load_config 1
958 apply_config
959 choose_repository::pick
961 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
962 catch {set _gitdir [exec cygpath --windows $_gitdir]}
964 if {![file isdirectory $_gitdir]} {
965 catch {wm withdraw .}
966 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
967 exit 1
969 if {$_prefix ne {}} {
970 regsub -all {[^/]+/} $_prefix ../ cdup
971 if {[catch {cd $cdup} err]} {
972 catch {wm withdraw .}
973 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
974 exit 1
976 unset cdup
977 } elseif {![is_enabled bare]} {
978 if {[lindex [file split $_gitdir] end] ne {.git}} {
979 catch {wm withdraw .}
980 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
981 exit 1
983 if {[catch {cd [file dirname $_gitdir]} err]} {
984 catch {wm withdraw .}
985 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
986 exit 1
989 set _reponame [file split [file normalize $_gitdir]]
990 if {[lindex $_reponame end] eq {.git}} {
991 set _reponame [lindex $_reponame end-1]
992 } else {
993 set _reponame [lindex $_reponame end]
996 ######################################################################
998 ## global init
1000 set current_diff_path {}
1001 set current_diff_side {}
1002 set diff_actions [list]
1004 set HEAD {}
1005 set PARENT {}
1006 set MERGE_HEAD [list]
1007 set commit_type {}
1008 set empty_tree {}
1009 set current_branch {}
1010 set is_detached 0
1011 set current_diff_path {}
1012 set is_3way_diff 0
1013 set selected_commit_type new
1015 ######################################################################
1017 ## task management
1019 set rescan_active 0
1020 set diff_active 0
1021 set last_clicked {}
1023 set disable_on_lock [list]
1024 set index_lock_type none
1026 proc lock_index {type} {
1027 global index_lock_type disable_on_lock
1029 if {$index_lock_type eq {none}} {
1030 set index_lock_type $type
1031 foreach w $disable_on_lock {
1032 uplevel #0 $w disabled
1034 return 1
1035 } elseif {$index_lock_type eq "begin-$type"} {
1036 set index_lock_type $type
1037 return 1
1039 return 0
1042 proc unlock_index {} {
1043 global index_lock_type disable_on_lock
1045 set index_lock_type none
1046 foreach w $disable_on_lock {
1047 uplevel #0 $w normal
1051 ######################################################################
1053 ## status
1055 proc repository_state {ctvar hdvar mhvar} {
1056 global current_branch
1057 upvar $ctvar ct $hdvar hd $mhvar mh
1059 set mh [list]
1061 load_current_branch
1062 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1063 set hd {}
1064 set ct initial
1065 return
1068 set merge_head [gitdir MERGE_HEAD]
1069 if {[file exists $merge_head]} {
1070 set ct merge
1071 set fd_mh [open $merge_head r]
1072 while {[gets $fd_mh line] >= 0} {
1073 lappend mh $line
1075 close $fd_mh
1076 return
1079 set ct normal
1082 proc PARENT {} {
1083 global PARENT empty_tree
1085 set p [lindex $PARENT 0]
1086 if {$p ne {}} {
1087 return $p
1089 if {$empty_tree eq {}} {
1090 set empty_tree [git mktree << {}]
1092 return $empty_tree
1095 proc rescan {after {honor_trustmtime 1}} {
1096 global HEAD PARENT MERGE_HEAD commit_type
1097 global ui_index ui_workdir ui_comm
1098 global rescan_active file_states
1099 global repo_config
1101 if {$rescan_active > 0 || ![lock_index read]} return
1103 repository_state newType newHEAD newMERGE_HEAD
1104 if {[string match amend* $commit_type]
1105 && $newType eq {normal}
1106 && $newHEAD eq $HEAD} {
1107 } else {
1108 set HEAD $newHEAD
1109 set PARENT $newHEAD
1110 set MERGE_HEAD $newMERGE_HEAD
1111 set commit_type $newType
1114 array unset file_states
1116 if {!$::GITGUI_BCK_exists &&
1117 (![$ui_comm edit modified]
1118 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1119 if {[string match amend* $commit_type]} {
1120 } elseif {[load_message GITGUI_MSG]} {
1121 } elseif {[load_message MERGE_MSG]} {
1122 } elseif {[load_message SQUASH_MSG]} {
1124 $ui_comm edit reset
1125 $ui_comm edit modified false
1128 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1129 rescan_stage2 {} $after
1130 } else {
1131 set rescan_active 1
1132 ui_status [mc "Refreshing file status..."]
1133 set fd_rf [git_read update-index \
1134 -q \
1135 --unmerged \
1136 --ignore-missing \
1137 --refresh \
1139 fconfigure $fd_rf -blocking 0 -translation binary
1140 fileevent $fd_rf readable \
1141 [list rescan_stage2 $fd_rf $after]
1145 if {[is_Cygwin]} {
1146 set is_git_info_exclude {}
1147 proc have_info_exclude {} {
1148 global is_git_info_exclude
1150 if {$is_git_info_exclude eq {}} {
1151 if {[catch {exec test -f [gitdir info exclude]}]} {
1152 set is_git_info_exclude 0
1153 } else {
1154 set is_git_info_exclude 1
1157 return $is_git_info_exclude
1159 } else {
1160 proc have_info_exclude {} {
1161 return [file readable [gitdir info exclude]]
1165 proc rescan_stage2 {fd after} {
1166 global rescan_active buf_rdi buf_rdf buf_rlo
1168 if {$fd ne {}} {
1169 read $fd
1170 if {![eof $fd]} return
1171 close $fd
1174 set ls_others [list --exclude-per-directory=.gitignore]
1175 if {[have_info_exclude]} {
1176 lappend ls_others "--exclude-from=[gitdir info exclude]"
1178 set user_exclude [get_config core.excludesfile]
1179 if {$user_exclude ne {} && [file readable $user_exclude]} {
1180 lappend ls_others "--exclude-from=$user_exclude"
1183 set buf_rdi {}
1184 set buf_rdf {}
1185 set buf_rlo {}
1187 set rescan_active 3
1188 ui_status [mc "Scanning for modified files ..."]
1189 set fd_di [git_read diff-index --cached -z [PARENT]]
1190 set fd_df [git_read diff-files -z]
1191 set fd_lo [eval git_read ls-files --others -z $ls_others]
1193 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1194 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1195 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1196 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1197 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1198 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1201 proc load_message {file} {
1202 global ui_comm
1204 set f [gitdir $file]
1205 if {[file isfile $f]} {
1206 if {[catch {set fd [open $f r]}]} {
1207 return 0
1209 fconfigure $fd -eofchar {}
1210 set content [string trim [read $fd]]
1211 close $fd
1212 regsub -all -line {[ \r\t]+$} $content {} content
1213 $ui_comm delete 0.0 end
1214 $ui_comm insert end $content
1215 return 1
1217 return 0
1220 proc read_diff_index {fd after} {
1221 global buf_rdi
1223 append buf_rdi [read $fd]
1224 set c 0
1225 set n [string length $buf_rdi]
1226 while {$c < $n} {
1227 set z1 [string first "\0" $buf_rdi $c]
1228 if {$z1 == -1} break
1229 incr z1
1230 set z2 [string first "\0" $buf_rdi $z1]
1231 if {$z2 == -1} break
1233 incr c
1234 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1235 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1236 merge_state \
1237 [encoding convertfrom $p] \
1238 [lindex $i 4]? \
1239 [list [lindex $i 0] [lindex $i 2]] \
1240 [list]
1241 set c $z2
1242 incr c
1244 if {$c < $n} {
1245 set buf_rdi [string range $buf_rdi $c end]
1246 } else {
1247 set buf_rdi {}
1250 rescan_done $fd buf_rdi $after
1253 proc read_diff_files {fd after} {
1254 global buf_rdf
1256 append buf_rdf [read $fd]
1257 set c 0
1258 set n [string length $buf_rdf]
1259 while {$c < $n} {
1260 set z1 [string first "\0" $buf_rdf $c]
1261 if {$z1 == -1} break
1262 incr z1
1263 set z2 [string first "\0" $buf_rdf $z1]
1264 if {$z2 == -1} break
1266 incr c
1267 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1268 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1269 merge_state \
1270 [encoding convertfrom $p] \
1271 ?[lindex $i 4] \
1272 [list] \
1273 [list [lindex $i 0] [lindex $i 2]]
1274 set c $z2
1275 incr c
1277 if {$c < $n} {
1278 set buf_rdf [string range $buf_rdf $c end]
1279 } else {
1280 set buf_rdf {}
1283 rescan_done $fd buf_rdf $after
1286 proc read_ls_others {fd after} {
1287 global buf_rlo
1289 append buf_rlo [read $fd]
1290 set pck [split $buf_rlo "\0"]
1291 set buf_rlo [lindex $pck end]
1292 foreach p [lrange $pck 0 end-1] {
1293 set p [encoding convertfrom $p]
1294 if {[string index $p end] eq {/}} {
1295 set p [string range $p 0 end-1]
1297 merge_state $p ?O
1299 rescan_done $fd buf_rlo $after
1302 proc rescan_done {fd buf after} {
1303 global rescan_active current_diff_path
1304 global file_states repo_config
1305 upvar $buf to_clear
1307 if {![eof $fd]} return
1308 set to_clear {}
1309 close $fd
1310 if {[incr rescan_active -1] > 0} return
1312 prune_selection
1313 unlock_index
1314 display_all_files
1315 if {$current_diff_path ne {}} reshow_diff
1316 uplevel #0 $after
1319 proc prune_selection {} {
1320 global file_states selected_paths
1322 foreach path [array names selected_paths] {
1323 if {[catch {set still_here $file_states($path)}]} {
1324 unset selected_paths($path)
1329 ######################################################################
1331 ## ui helpers
1333 proc mapicon {w state path} {
1334 global all_icons
1336 if {[catch {set r $all_icons($state$w)}]} {
1337 puts "error: no icon for $w state={$state} $path"
1338 return file_plain
1340 return $r
1343 proc mapdesc {state path} {
1344 global all_descs
1346 if {[catch {set r $all_descs($state)}]} {
1347 puts "error: no desc for state={$state} $path"
1348 return $state
1350 return $r
1353 proc ui_status {msg} {
1354 global main_status
1355 if {[info exists main_status]} {
1356 $main_status show $msg
1360 proc ui_ready {{test {}}} {
1361 global main_status
1362 if {[info exists main_status]} {
1363 $main_status show [mc "Ready."] $test
1367 proc escape_path {path} {
1368 regsub -all {\\} $path "\\\\" path
1369 regsub -all "\n" $path "\\n" path
1370 return $path
1373 proc short_path {path} {
1374 return [escape_path [lindex [file split $path] end]]
1377 set next_icon_id 0
1378 set null_sha1 [string repeat 0 40]
1380 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1381 global file_states next_icon_id null_sha1
1383 set s0 [string index $new_state 0]
1384 set s1 [string index $new_state 1]
1386 if {[catch {set info $file_states($path)}]} {
1387 set state __
1388 set icon n[incr next_icon_id]
1389 } else {
1390 set state [lindex $info 0]
1391 set icon [lindex $info 1]
1392 if {$head_info eq {}} {set head_info [lindex $info 2]}
1393 if {$index_info eq {}} {set index_info [lindex $info 3]}
1396 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1397 elseif {$s0 eq {_}} {set s0 _}
1399 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1400 elseif {$s1 eq {_}} {set s1 _}
1402 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1403 set head_info [list 0 $null_sha1]
1404 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1405 && $head_info eq {}} {
1406 set head_info $index_info
1409 set file_states($path) [list $s0$s1 $icon \
1410 $head_info $index_info \
1412 return $state
1415 proc display_file_helper {w path icon_name old_m new_m} {
1416 global file_lists
1418 if {$new_m eq {_}} {
1419 set lno [lsearch -sorted -exact $file_lists($w) $path]
1420 if {$lno >= 0} {
1421 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1422 incr lno
1423 $w conf -state normal
1424 $w delete $lno.0 [expr {$lno + 1}].0
1425 $w conf -state disabled
1427 } elseif {$old_m eq {_} && $new_m ne {_}} {
1428 lappend file_lists($w) $path
1429 set file_lists($w) [lsort -unique $file_lists($w)]
1430 set lno [lsearch -sorted -exact $file_lists($w) $path]
1431 incr lno
1432 $w conf -state normal
1433 $w image create $lno.0 \
1434 -align center -padx 5 -pady 1 \
1435 -name $icon_name \
1436 -image [mapicon $w $new_m $path]
1437 $w insert $lno.1 "[escape_path $path]\n"
1438 $w conf -state disabled
1439 } elseif {$old_m ne $new_m} {
1440 $w conf -state normal
1441 $w image conf $icon_name -image [mapicon $w $new_m $path]
1442 $w conf -state disabled
1446 proc display_file {path state} {
1447 global file_states selected_paths
1448 global ui_index ui_workdir
1450 set old_m [merge_state $path $state]
1451 set s $file_states($path)
1452 set new_m [lindex $s 0]
1453 set icon_name [lindex $s 1]
1455 set o [string index $old_m 0]
1456 set n [string index $new_m 0]
1457 if {$o eq {U}} {
1458 set o _
1460 if {$n eq {U}} {
1461 set n _
1463 display_file_helper $ui_index $path $icon_name $o $n
1465 if {[string index $old_m 0] eq {U}} {
1466 set o U
1467 } else {
1468 set o [string index $old_m 1]
1470 if {[string index $new_m 0] eq {U}} {
1471 set n U
1472 } else {
1473 set n [string index $new_m 1]
1475 display_file_helper $ui_workdir $path $icon_name $o $n
1477 if {$new_m eq {__}} {
1478 unset file_states($path)
1479 catch {unset selected_paths($path)}
1483 proc display_all_files_helper {w path icon_name m} {
1484 global file_lists
1486 lappend file_lists($w) $path
1487 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1488 $w image create end \
1489 -align center -padx 5 -pady 1 \
1490 -name $icon_name \
1491 -image [mapicon $w $m $path]
1492 $w insert end "[escape_path $path]\n"
1495 proc display_all_files {} {
1496 global ui_index ui_workdir
1497 global file_states file_lists
1498 global last_clicked
1500 $ui_index conf -state normal
1501 $ui_workdir conf -state normal
1503 $ui_index delete 0.0 end
1504 $ui_workdir delete 0.0 end
1505 set last_clicked {}
1507 set file_lists($ui_index) [list]
1508 set file_lists($ui_workdir) [list]
1510 foreach path [lsort [array names file_states]] {
1511 set s $file_states($path)
1512 set m [lindex $s 0]
1513 set icon_name [lindex $s 1]
1515 set s [string index $m 0]
1516 if {$s ne {U} && $s ne {_}} {
1517 display_all_files_helper $ui_index $path \
1518 $icon_name $s
1521 if {[string index $m 0] eq {U}} {
1522 set s U
1523 } else {
1524 set s [string index $m 1]
1526 if {$s ne {_}} {
1527 display_all_files_helper $ui_workdir $path \
1528 $icon_name $s
1532 $ui_index conf -state disabled
1533 $ui_workdir conf -state disabled
1536 ######################################################################
1538 ## icons
1540 set filemask {
1541 #define mask_width 14
1542 #define mask_height 15
1543 static unsigned char mask_bits[] = {
1544 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1545 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1546 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1549 image create bitmap file_plain -background white -foreground black -data {
1550 #define plain_width 14
1551 #define plain_height 15
1552 static unsigned char plain_bits[] = {
1553 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1554 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1555 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1556 } -maskdata $filemask
1558 image create bitmap file_mod -background white -foreground blue -data {
1559 #define mod_width 14
1560 #define mod_height 15
1561 static unsigned char mod_bits[] = {
1562 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1563 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1564 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1565 } -maskdata $filemask
1567 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1568 #define file_fulltick_width 14
1569 #define file_fulltick_height 15
1570 static unsigned char file_fulltick_bits[] = {
1571 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1572 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1573 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1574 } -maskdata $filemask
1576 image create bitmap file_parttick -background white -foreground "#005050" -data {
1577 #define parttick_width 14
1578 #define parttick_height 15
1579 static unsigned char parttick_bits[] = {
1580 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1581 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1582 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1583 } -maskdata $filemask
1585 image create bitmap file_question -background white -foreground black -data {
1586 #define file_question_width 14
1587 #define file_question_height 15
1588 static unsigned char file_question_bits[] = {
1589 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1590 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1591 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1592 } -maskdata $filemask
1594 image create bitmap file_removed -background white -foreground red -data {
1595 #define file_removed_width 14
1596 #define file_removed_height 15
1597 static unsigned char file_removed_bits[] = {
1598 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1599 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1600 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1601 } -maskdata $filemask
1603 image create bitmap file_merge -background white -foreground blue -data {
1604 #define file_merge_width 14
1605 #define file_merge_height 15
1606 static unsigned char file_merge_bits[] = {
1607 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1608 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1609 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1610 } -maskdata $filemask
1612 set ui_index .vpane.files.index.list
1613 set ui_workdir .vpane.files.workdir.list
1615 set all_icons(_$ui_index) file_plain
1616 set all_icons(A$ui_index) file_fulltick
1617 set all_icons(M$ui_index) file_fulltick
1618 set all_icons(D$ui_index) file_removed
1619 set all_icons(U$ui_index) file_merge
1621 set all_icons(_$ui_workdir) file_plain
1622 set all_icons(M$ui_workdir) file_mod
1623 set all_icons(D$ui_workdir) file_question
1624 set all_icons(U$ui_workdir) file_merge
1625 set all_icons(O$ui_workdir) file_plain
1627 set max_status_desc 0
1628 foreach i {
1629 {__ {mc "Unmodified"}}
1631 {_M {mc "Modified, not staged"}}
1632 {M_ {mc "Staged for commit"}}
1633 {MM {mc "Portions staged for commit"}}
1634 {MD {mc "Staged for commit, missing"}}
1636 {_O {mc "Untracked, not staged"}}
1637 {A_ {mc "Staged for commit"}}
1638 {AM {mc "Portions staged for commit"}}
1639 {AD {mc "Staged for commit, missing"}}
1641 {_D {mc "Missing"}}
1642 {D_ {mc "Staged for removal"}}
1643 {DO {mc "Staged for removal, still present"}}
1645 {U_ {mc "Requires merge resolution"}}
1646 {UU {mc "Requires merge resolution"}}
1647 {UM {mc "Requires merge resolution"}}
1648 {UD {mc "Requires merge resolution"}}
1650 set text [eval [lindex $i 1]]
1651 if {$max_status_desc < [string length $text]} {
1652 set max_status_desc [string length $text]
1654 set all_descs([lindex $i 0]) $text
1656 unset i
1658 ######################################################################
1660 ## util
1662 proc scrollbar2many {list mode args} {
1663 foreach w $list {eval $w $mode $args}
1666 proc many2scrollbar {list mode sb top bottom} {
1667 $sb set $top $bottom
1668 foreach w $list {$w $mode moveto $top}
1671 proc incr_font_size {font {amt 1}} {
1672 set sz [font configure $font -size]
1673 incr sz $amt
1674 font configure $font -size $sz
1675 font configure ${font}bold -size $sz
1676 font configure ${font}italic -size $sz
1679 ######################################################################
1681 ## ui commands
1683 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1685 proc do_gitk {revs} {
1686 # -- Always start gitk through whatever we were loaded with. This
1687 # lets us bypass using shell process on Windows systems.
1689 set exe [file join [file dirname $::_git] gitk]
1690 set cmd [list [info nameofexecutable] $exe]
1691 if {! [file exists $exe]} {
1692 error_popup [mc "Unable to start gitk:\n\n%s does not exist" $exe]
1693 } else {
1694 global env
1696 if {[info exists env(GIT_DIR)]} {
1697 set old_GIT_DIR $env(GIT_DIR)
1698 } else {
1699 set old_GIT_DIR {}
1702 set pwd [pwd]
1703 cd [file dirname [gitdir]]
1704 set env(GIT_DIR) [file tail [gitdir]]
1706 eval exec $cmd $revs &
1708 if {$old_GIT_DIR eq {}} {
1709 unset env(GIT_DIR)
1710 } else {
1711 set env(GIT_DIR) $old_GIT_DIR
1713 cd $pwd
1715 ui_status $::starting_gitk_msg
1716 after 10000 {
1717 ui_ready $starting_gitk_msg
1722 set is_quitting 0
1724 proc do_quit {} {
1725 global ui_comm is_quitting repo_config commit_type
1726 global GITGUI_BCK_exists GITGUI_BCK_i
1727 global ui_comm_spell
1729 if {$is_quitting} return
1730 set is_quitting 1
1732 if {[winfo exists $ui_comm]} {
1733 # -- Stash our current commit buffer.
1735 set save [gitdir GITGUI_MSG]
1736 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1737 file rename -force [gitdir GITGUI_BCK] $save
1738 set GITGUI_BCK_exists 0
1739 } else {
1740 set msg [string trim [$ui_comm get 0.0 end]]
1741 regsub -all -line {[ \r\t]+$} $msg {} msg
1742 if {(![string match amend* $commit_type]
1743 || [$ui_comm edit modified])
1744 && $msg ne {}} {
1745 catch {
1746 set fd [open $save w]
1747 puts -nonewline $fd $msg
1748 close $fd
1750 } else {
1751 catch {file delete $save}
1755 # -- Cancel our spellchecker if its running.
1757 if {[info exists ui_comm_spell]} {
1758 $ui_comm_spell stop
1761 # -- Remove our editor backup, its not needed.
1763 after cancel $GITGUI_BCK_i
1764 if {$GITGUI_BCK_exists} {
1765 catch {file delete [gitdir GITGUI_BCK]}
1768 # -- Stash our current window geometry into this repository.
1770 set cfg_geometry [list]
1771 lappend cfg_geometry [wm geometry .]
1772 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
1773 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
1774 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1775 set rc_geometry {}
1777 if {$cfg_geometry ne $rc_geometry} {
1778 catch {git config gui.geometry $cfg_geometry}
1782 destroy .
1785 proc do_rescan {} {
1786 rescan ui_ready
1789 proc do_commit {} {
1790 commit_tree
1793 proc next_diff {} {
1794 global next_diff_p next_diff_w next_diff_i
1795 show_diff $next_diff_p $next_diff_w $next_diff_i
1798 proc toggle_or_diff {w x y} {
1799 global file_states file_lists current_diff_path ui_index ui_workdir
1800 global last_clicked selected_paths
1802 set pos [split [$w index @$x,$y] .]
1803 set lno [lindex $pos 0]
1804 set col [lindex $pos 1]
1805 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1806 if {$path eq {}} {
1807 set last_clicked {}
1808 return
1811 set last_clicked [list $w $lno]
1812 array unset selected_paths
1813 $ui_index tag remove in_sel 0.0 end
1814 $ui_workdir tag remove in_sel 0.0 end
1816 if {$col == 0 && $y > 1} {
1817 set i [expr {$lno-1}]
1818 set ll [expr {[llength $file_lists($w)]-1}]
1820 if {$i == $ll && $i == 0} {
1821 set after {reshow_diff;}
1822 } else {
1823 global next_diff_p next_diff_w next_diff_i
1825 set next_diff_w $w
1827 if {$i < $ll} {
1828 set i [expr {$i + 1}]
1829 set next_diff_i $i
1830 } else {
1831 set next_diff_i $i
1832 set i [expr {$i - 1}]
1835 set next_diff_p [lindex $file_lists($w) $i]
1837 if {$next_diff_p ne {} && $current_diff_path ne {}} {
1838 set after {next_diff;}
1839 } else {
1840 set after {}
1844 if {$w eq $ui_index} {
1845 update_indexinfo \
1846 "Unstaging [short_path $path] from commit" \
1847 [list $path] \
1848 [concat $after [list ui_ready]]
1849 } elseif {$w eq $ui_workdir} {
1850 update_index \
1851 "Adding [short_path $path]" \
1852 [list $path] \
1853 [concat $after [list ui_ready]]
1855 } else {
1856 show_diff $path $w $lno
1860 proc add_one_to_selection {w x y} {
1861 global file_lists last_clicked selected_paths
1863 set lno [lindex [split [$w index @$x,$y] .] 0]
1864 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1865 if {$path eq {}} {
1866 set last_clicked {}
1867 return
1870 if {$last_clicked ne {}
1871 && [lindex $last_clicked 0] ne $w} {
1872 array unset selected_paths
1873 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1876 set last_clicked [list $w $lno]
1877 if {[catch {set in_sel $selected_paths($path)}]} {
1878 set in_sel 0
1880 if {$in_sel} {
1881 unset selected_paths($path)
1882 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1883 } else {
1884 set selected_paths($path) 1
1885 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1889 proc add_range_to_selection {w x y} {
1890 global file_lists last_clicked selected_paths
1892 if {[lindex $last_clicked 0] ne $w} {
1893 toggle_or_diff $w $x $y
1894 return
1897 set lno [lindex [split [$w index @$x,$y] .] 0]
1898 set lc [lindex $last_clicked 1]
1899 if {$lc < $lno} {
1900 set begin $lc
1901 set end $lno
1902 } else {
1903 set begin $lno
1904 set end $lc
1907 foreach path [lrange $file_lists($w) \
1908 [expr {$begin - 1}] \
1909 [expr {$end - 1}]] {
1910 set selected_paths($path) 1
1912 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1915 proc show_more_context {} {
1916 global repo_config
1917 if {$repo_config(gui.diffcontext) < 99} {
1918 incr repo_config(gui.diffcontext)
1919 reshow_diff
1923 proc show_less_context {} {
1924 global repo_config
1925 if {$repo_config(gui.diffcontext) >= 1} {
1926 incr repo_config(gui.diffcontext) -1
1927 reshow_diff
1931 ######################################################################
1933 ## ui construction
1935 load_config 0
1936 apply_config
1937 set ui_comm {}
1939 # -- Menu Bar
1941 menu .mbar -tearoff 0
1942 .mbar add cascade -label [mc Repository] -menu .mbar.repository
1943 .mbar add cascade -label [mc Edit] -menu .mbar.edit
1944 if {[is_enabled branch]} {
1945 .mbar add cascade -label [mc Branch] -menu .mbar.branch
1947 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1948 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
1950 if {[is_enabled transport]} {
1951 .mbar add cascade -label [mc Merge] -menu .mbar.merge
1952 .mbar add cascade -label [mc Remote] -menu .mbar.remote
1954 . configure -menu .mbar
1956 # -- Repository Menu
1958 menu .mbar.repository
1960 .mbar.repository add command \
1961 -label [mc "Browse Current Branch's Files"] \
1962 -command {browser::new $current_branch}
1963 set ui_browse_current [.mbar.repository index last]
1964 .mbar.repository add command \
1965 -label [mc "Browse Branch Files..."] \
1966 -command browser_open::dialog
1967 .mbar.repository add separator
1969 .mbar.repository add command \
1970 -label [mc "Visualize Current Branch's History"] \
1971 -command {do_gitk $current_branch}
1972 set ui_visualize_current [.mbar.repository index last]
1973 .mbar.repository add command \
1974 -label [mc "Visualize All Branch History"] \
1975 -command {do_gitk --all}
1976 .mbar.repository add separator
1978 proc current_branch_write {args} {
1979 global current_branch
1980 .mbar.repository entryconf $::ui_browse_current \
1981 -label [mc "Browse %s's Files" $current_branch]
1982 .mbar.repository entryconf $::ui_visualize_current \
1983 -label [mc "Visualize %s's History" $current_branch]
1985 trace add variable current_branch write current_branch_write
1987 if {[is_enabled multicommit]} {
1988 .mbar.repository add command -label [mc "Database Statistics"] \
1989 -command do_stats
1991 .mbar.repository add command -label [mc "Compress Database"] \
1992 -command do_gc
1994 .mbar.repository add command -label [mc "Verify Database"] \
1995 -command do_fsck_objects
1997 .mbar.repository add separator
1999 if {[is_Cygwin]} {
2000 .mbar.repository add command \
2001 -label [mc "Create Desktop Icon"] \
2002 -command do_cygwin_shortcut
2003 } elseif {[is_Windows]} {
2004 .mbar.repository add command \
2005 -label [mc "Create Desktop Icon"] \
2006 -command do_windows_shortcut
2007 } elseif {[is_MacOSX]} {
2008 .mbar.repository add command \
2009 -label [mc "Create Desktop Icon"] \
2010 -command do_macosx_app
2014 if {[is_MacOSX]} {
2015 proc ::tk::mac::Quit {args} { do_quit }
2016 } else {
2017 .mbar.repository add command -label [mc Quit] \
2018 -command do_quit \
2019 -accelerator $M1T-Q
2022 # -- Edit Menu
2024 menu .mbar.edit
2025 .mbar.edit add command -label [mc Undo] \
2026 -command {catch {[focus] edit undo}} \
2027 -accelerator $M1T-Z
2028 .mbar.edit add command -label [mc Redo] \
2029 -command {catch {[focus] edit redo}} \
2030 -accelerator $M1T-Y
2031 .mbar.edit add separator
2032 .mbar.edit add command -label [mc Cut] \
2033 -command {catch {tk_textCut [focus]}} \
2034 -accelerator $M1T-X
2035 .mbar.edit add command -label [mc Copy] \
2036 -command {catch {tk_textCopy [focus]}} \
2037 -accelerator $M1T-C
2038 .mbar.edit add command -label [mc Paste] \
2039 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2040 -accelerator $M1T-V
2041 .mbar.edit add command -label [mc Delete] \
2042 -command {catch {[focus] delete sel.first sel.last}} \
2043 -accelerator Del
2044 .mbar.edit add separator
2045 .mbar.edit add command -label [mc "Select All"] \
2046 -command {catch {[focus] tag add sel 0.0 end}} \
2047 -accelerator $M1T-A
2049 # -- Branch Menu
2051 if {[is_enabled branch]} {
2052 menu .mbar.branch
2054 .mbar.branch add command -label [mc "Create..."] \
2055 -command branch_create::dialog \
2056 -accelerator $M1T-N
2057 lappend disable_on_lock [list .mbar.branch entryconf \
2058 [.mbar.branch index last] -state]
2060 .mbar.branch add command -label [mc "Checkout..."] \
2061 -command branch_checkout::dialog \
2062 -accelerator $M1T-O
2063 lappend disable_on_lock [list .mbar.branch entryconf \
2064 [.mbar.branch index last] -state]
2066 .mbar.branch add command -label [mc "Rename..."] \
2067 -command branch_rename::dialog
2068 lappend disable_on_lock [list .mbar.branch entryconf \
2069 [.mbar.branch index last] -state]
2071 .mbar.branch add command -label [mc "Delete..."] \
2072 -command branch_delete::dialog
2073 lappend disable_on_lock [list .mbar.branch entryconf \
2074 [.mbar.branch index last] -state]
2076 .mbar.branch add command -label [mc "Reset..."] \
2077 -command merge::reset_hard
2078 lappend disable_on_lock [list .mbar.branch entryconf \
2079 [.mbar.branch index last] -state]
2082 # -- Commit Menu
2084 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2085 menu .mbar.commit
2087 .mbar.commit add radiobutton \
2088 -label [mc "New Commit"] \
2089 -command do_select_commit_type \
2090 -variable selected_commit_type \
2091 -value new
2092 lappend disable_on_lock \
2093 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2095 .mbar.commit add radiobutton \
2096 -label [mc "Amend Last Commit"] \
2097 -command do_select_commit_type \
2098 -variable selected_commit_type \
2099 -value amend
2100 lappend disable_on_lock \
2101 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2103 .mbar.commit add separator
2105 .mbar.commit add command -label [mc Rescan] \
2106 -command do_rescan \
2107 -accelerator F5
2108 lappend disable_on_lock \
2109 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2111 .mbar.commit add command -label [mc "Stage To Commit"] \
2112 -command do_add_selection \
2113 -accelerator $M1T-T
2114 lappend disable_on_lock \
2115 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2117 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2118 -command do_add_all \
2119 -accelerator $M1T-I
2120 lappend disable_on_lock \
2121 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2123 .mbar.commit add command -label [mc "Unstage From Commit"] \
2124 -command do_unstage_selection
2125 lappend disable_on_lock \
2126 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2128 .mbar.commit add command -label [mc "Revert Changes"] \
2129 -command do_revert_selection
2130 lappend disable_on_lock \
2131 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2133 .mbar.commit add separator
2135 .mbar.commit add command -label [mc "Show Less Context"] \
2136 -command show_less_context \
2137 -accelerator $M1T-\-
2139 .mbar.commit add command -label [mc "Show More Context"] \
2140 -command show_more_context \
2141 -accelerator $M1T-=
2143 .mbar.commit add separator
2145 .mbar.commit add command -label [mc "Sign Off"] \
2146 -command do_signoff \
2147 -accelerator $M1T-S
2149 .mbar.commit add command -label [mc Commit@@verb] \
2150 -command do_commit \
2151 -accelerator $M1T-Return
2152 lappend disable_on_lock \
2153 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2156 # -- Merge Menu
2158 if {[is_enabled branch]} {
2159 menu .mbar.merge
2160 .mbar.merge add command -label [mc "Local Merge..."] \
2161 -command merge::dialog \
2162 -accelerator $M1T-M
2163 lappend disable_on_lock \
2164 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2165 .mbar.merge add command -label [mc "Abort Merge..."] \
2166 -command merge::reset_hard
2167 lappend disable_on_lock \
2168 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2171 # -- Transport Menu
2173 if {[is_enabled transport]} {
2174 menu .mbar.remote
2176 .mbar.remote add command \
2177 -label [mc "Push..."] \
2178 -command do_push_anywhere \
2179 -accelerator $M1T-P
2180 .mbar.remote add command \
2181 -label [mc "Delete..."] \
2182 -command remote_branch_delete::dialog
2185 if {[is_MacOSX]} {
2186 # -- Apple Menu (Mac OS X only)
2188 .mbar add cascade -label Apple -menu .mbar.apple
2189 menu .mbar.apple
2191 .mbar.apple add command -label [mc "About %s" [appname]] \
2192 -command do_about
2193 .mbar.apple add separator
2194 .mbar.apple add command \
2195 -label [mc "Preferences..."] \
2196 -command do_options \
2197 -accelerator $M1T-,
2198 bind . <$M1B-,> do_options
2199 } else {
2200 # -- Edit Menu
2202 .mbar.edit add separator
2203 .mbar.edit add command -label [mc "Options..."] \
2204 -command do_options
2207 # -- Help Menu
2209 .mbar add cascade -label [mc Help] -menu .mbar.help
2210 menu .mbar.help
2212 if {![is_MacOSX]} {
2213 .mbar.help add command -label [mc "About %s" [appname]] \
2214 -command do_about
2217 set browser {}
2218 catch {set browser $repo_config(instaweb.browser)}
2219 set doc_path [file dirname [gitexec]]
2220 set doc_path [file join $doc_path Documentation index.html]
2222 if {[is_Cygwin]} {
2223 set doc_path [exec cygpath --mixed $doc_path]
2226 if {$browser eq {}} {
2227 if {[is_MacOSX]} {
2228 set browser open
2229 } elseif {[is_Cygwin]} {
2230 set program_files [file dirname [exec cygpath --windir]]
2231 set program_files [file join $program_files {Program Files}]
2232 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2233 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2234 if {[file exists $firefox]} {
2235 set browser $firefox
2236 } elseif {[file exists $ie]} {
2237 set browser $ie
2239 unset program_files firefox ie
2243 if {[file isfile $doc_path]} {
2244 set doc_url "file:$doc_path"
2245 } else {
2246 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2249 if {$browser ne {}} {
2250 .mbar.help add command -label [mc "Online Documentation"] \
2251 -command [list exec $browser $doc_url &]
2253 unset browser doc_path doc_url
2255 # -- Standard bindings
2257 wm protocol . WM_DELETE_WINDOW do_quit
2258 bind all <$M1B-Key-q> do_quit
2259 bind all <$M1B-Key-Q> do_quit
2260 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2261 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2263 set subcommand_args {}
2264 proc usage {} {
2265 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2266 exit 1
2269 # -- Not a normal commit type invocation? Do that instead!
2271 switch -- $subcommand {
2272 browser -
2273 blame {
2274 set subcommand_args {rev? path}
2275 if {$argv eq {}} usage
2276 set head {}
2277 set path {}
2278 set is_path 0
2279 foreach a $argv {
2280 if {$is_path || [file exists $_prefix$a]} {
2281 if {$path ne {}} usage
2282 set path $_prefix$a
2283 break
2284 } elseif {$a eq {--}} {
2285 if {$path ne {}} {
2286 if {$head ne {}} usage
2287 set head $path
2288 set path {}
2290 set is_path 1
2291 } elseif {$head eq {}} {
2292 if {$head ne {}} usage
2293 set head $a
2294 set is_path 1
2295 } else {
2296 usage
2299 unset is_path
2301 if {$head ne {} && $path eq {}} {
2302 set path $_prefix$head
2303 set head {}
2306 if {$head eq {}} {
2307 load_current_branch
2308 } else {
2309 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2310 if {[catch {
2311 set head [git rev-parse --verify $head]
2312 } err]} {
2313 puts stderr $err
2314 exit 1
2317 set current_branch $head
2320 switch -- $subcommand {
2321 browser {
2322 if {$head eq {}} {
2323 if {$path ne {} && [file isdirectory $path]} {
2324 set head $current_branch
2325 } else {
2326 set head $path
2327 set path {}
2330 browser::new $head $path
2332 blame {
2333 if {$head eq {} && ![file exists $path]} {
2334 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2335 exit 1
2337 blame::new $head $path
2340 return
2342 citool -
2343 gui {
2344 if {[llength $argv] != 0} {
2345 puts -nonewline stderr "usage: $argv0"
2346 if {$subcommand ne {gui}
2347 && [file tail $argv0] ne "git-$subcommand"} {
2348 puts -nonewline stderr " $subcommand"
2350 puts stderr {}
2351 exit 1
2353 # fall through to setup UI for commits
2355 default {
2356 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2357 exit 1
2361 # -- Branch Control
2363 frame .branch \
2364 -borderwidth 1 \
2365 -relief sunken
2366 label .branch.l1 \
2367 -text [mc "Current Branch:"] \
2368 -anchor w \
2369 -justify left
2370 label .branch.cb \
2371 -textvariable current_branch \
2372 -anchor w \
2373 -justify left
2374 pack .branch.l1 -side left
2375 pack .branch.cb -side left -fill x
2376 pack .branch -side top -fill x
2378 # -- Main Window Layout
2380 panedwindow .vpane -orient horizontal
2381 panedwindow .vpane.files -orient vertical
2382 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2383 pack .vpane -anchor n -side top -fill both -expand 1
2385 # -- Index File List
2387 frame .vpane.files.index -height 100 -width 200
2388 label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2389 -background lightgreen -foreground black
2390 text $ui_index -background white -foreground black \
2391 -borderwidth 0 \
2392 -width 20 -height 10 \
2393 -wrap none \
2394 -cursor $cursor_ptr \
2395 -xscrollcommand {.vpane.files.index.sx set} \
2396 -yscrollcommand {.vpane.files.index.sy set} \
2397 -state disabled
2398 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2399 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2400 pack .vpane.files.index.title -side top -fill x
2401 pack .vpane.files.index.sx -side bottom -fill x
2402 pack .vpane.files.index.sy -side right -fill y
2403 pack $ui_index -side left -fill both -expand 1
2405 # -- Working Directory File List
2407 frame .vpane.files.workdir -height 100 -width 200
2408 label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2409 -background lightsalmon -foreground black
2410 text $ui_workdir -background white -foreground black \
2411 -borderwidth 0 \
2412 -width 20 -height 10 \
2413 -wrap none \
2414 -cursor $cursor_ptr \
2415 -xscrollcommand {.vpane.files.workdir.sx set} \
2416 -yscrollcommand {.vpane.files.workdir.sy set} \
2417 -state disabled
2418 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2419 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2420 pack .vpane.files.workdir.title -side top -fill x
2421 pack .vpane.files.workdir.sx -side bottom -fill x
2422 pack .vpane.files.workdir.sy -side right -fill y
2423 pack $ui_workdir -side left -fill both -expand 1
2425 .vpane.files add .vpane.files.workdir -sticky nsew
2426 .vpane.files add .vpane.files.index -sticky nsew
2428 foreach i [list $ui_index $ui_workdir] {
2429 rmsel_tag $i
2430 $i tag conf in_diff -background [$i tag cget in_sel -background]
2432 unset i
2434 # -- Diff and Commit Area
2436 frame .vpane.lower -height 300 -width 400
2437 frame .vpane.lower.commarea
2438 frame .vpane.lower.diff -relief sunken -borderwidth 1
2439 pack .vpane.lower.diff -fill both -expand 1
2440 pack .vpane.lower.commarea -side bottom -fill x
2441 .vpane add .vpane.lower -sticky nsew
2443 # -- Commit Area Buttons
2445 frame .vpane.lower.commarea.buttons
2446 label .vpane.lower.commarea.buttons.l -text {} \
2447 -anchor w \
2448 -justify left
2449 pack .vpane.lower.commarea.buttons.l -side top -fill x
2450 pack .vpane.lower.commarea.buttons -side left -fill y
2452 button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2453 -command do_rescan
2454 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2455 lappend disable_on_lock \
2456 {.vpane.lower.commarea.buttons.rescan conf -state}
2458 button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2459 -command do_add_all
2460 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2461 lappend disable_on_lock \
2462 {.vpane.lower.commarea.buttons.incall conf -state}
2464 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2465 -command do_signoff
2466 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2468 button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
2469 -command do_commit
2470 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2471 lappend disable_on_lock \
2472 {.vpane.lower.commarea.buttons.commit conf -state}
2474 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2475 -command do_push_anywhere
2476 pack .vpane.lower.commarea.buttons.push -side top -fill x
2478 # -- Commit Message Buffer
2480 frame .vpane.lower.commarea.buffer
2481 frame .vpane.lower.commarea.buffer.header
2482 set ui_comm .vpane.lower.commarea.buffer.t
2483 set ui_coml .vpane.lower.commarea.buffer.header.l
2484 radiobutton .vpane.lower.commarea.buffer.header.new \
2485 -text [mc "New Commit"] \
2486 -command do_select_commit_type \
2487 -variable selected_commit_type \
2488 -value new
2489 lappend disable_on_lock \
2490 [list .vpane.lower.commarea.buffer.header.new conf -state]
2491 radiobutton .vpane.lower.commarea.buffer.header.amend \
2492 -text [mc "Amend Last Commit"] \
2493 -command do_select_commit_type \
2494 -variable selected_commit_type \
2495 -value amend
2496 lappend disable_on_lock \
2497 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2498 label $ui_coml \
2499 -anchor w \
2500 -justify left
2501 proc trace_commit_type {varname args} {
2502 global ui_coml commit_type
2503 switch -glob -- $commit_type {
2504 initial {set txt [mc "Initial Commit Message:"]}
2505 amend {set txt [mc "Amended Commit Message:"]}
2506 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2507 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2508 merge {set txt [mc "Merge Commit Message:"]}
2509 * {set txt [mc "Commit Message:"]}
2511 $ui_coml conf -text $txt
2513 trace add variable commit_type write trace_commit_type
2514 pack $ui_coml -side left -fill x
2515 pack .vpane.lower.commarea.buffer.header.amend -side right
2516 pack .vpane.lower.commarea.buffer.header.new -side right
2518 text $ui_comm -background white -foreground black \
2519 -borderwidth 1 \
2520 -undo true \
2521 -maxundo 20 \
2522 -autoseparators true \
2523 -relief sunken \
2524 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
2525 -font font_diff \
2526 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2527 scrollbar .vpane.lower.commarea.buffer.sby \
2528 -command [list $ui_comm yview]
2529 pack .vpane.lower.commarea.buffer.header -side top -fill x
2530 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2531 pack $ui_comm -side left -fill y
2532 pack .vpane.lower.commarea.buffer -side left -fill y
2534 # -- Commit Message Buffer Context Menu
2536 set ctxm .vpane.lower.commarea.buffer.ctxm
2537 menu $ctxm -tearoff 0
2538 $ctxm add command \
2539 -label [mc Cut] \
2540 -command {tk_textCut $ui_comm}
2541 $ctxm add command \
2542 -label [mc Copy] \
2543 -command {tk_textCopy $ui_comm}
2544 $ctxm add command \
2545 -label [mc Paste] \
2546 -command {tk_textPaste $ui_comm}
2547 $ctxm add command \
2548 -label [mc Delete] \
2549 -command {$ui_comm delete sel.first sel.last}
2550 $ctxm add separator
2551 $ctxm add command \
2552 -label [mc "Select All"] \
2553 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2554 $ctxm add command \
2555 -label [mc "Copy All"] \
2556 -command {
2557 $ui_comm tag add sel 0.0 end
2558 tk_textCopy $ui_comm
2559 $ui_comm tag remove sel 0.0 end
2561 $ctxm add separator
2562 $ctxm add command \
2563 -label [mc "Sign Off"] \
2564 -command do_signoff
2565 set ui_comm_ctxm $ctxm
2567 # -- Diff Header
2569 proc trace_current_diff_path {varname args} {
2570 global current_diff_path diff_actions file_states
2571 if {$current_diff_path eq {}} {
2572 set s {}
2573 set f {}
2574 set p {}
2575 set o disabled
2576 } else {
2577 set p $current_diff_path
2578 set s [mapdesc [lindex $file_states($p) 0] $p]
2579 set f [mc "File:"]
2580 set p [escape_path $p]
2581 set o normal
2584 .vpane.lower.diff.header.status configure -text $s
2585 .vpane.lower.diff.header.file configure -text $f
2586 .vpane.lower.diff.header.path configure -text $p
2587 foreach w $diff_actions {
2588 uplevel #0 $w $o
2591 trace add variable current_diff_path write trace_current_diff_path
2593 frame .vpane.lower.diff.header -background gold
2594 label .vpane.lower.diff.header.status \
2595 -background gold \
2596 -foreground black \
2597 -width $max_status_desc \
2598 -anchor w \
2599 -justify left
2600 label .vpane.lower.diff.header.file \
2601 -background gold \
2602 -foreground black \
2603 -anchor w \
2604 -justify left
2605 label .vpane.lower.diff.header.path \
2606 -background gold \
2607 -foreground black \
2608 -anchor w \
2609 -justify left
2610 pack .vpane.lower.diff.header.status -side left
2611 pack .vpane.lower.diff.header.file -side left
2612 pack .vpane.lower.diff.header.path -fill x
2613 set ctxm .vpane.lower.diff.header.ctxm
2614 menu $ctxm -tearoff 0
2615 $ctxm add command \
2616 -label [mc Copy] \
2617 -command {
2618 clipboard clear
2619 clipboard append \
2620 -format STRING \
2621 -type STRING \
2622 -- $current_diff_path
2624 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2625 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2627 # -- Diff Body
2629 frame .vpane.lower.diff.body
2630 set ui_diff .vpane.lower.diff.body.t
2631 text $ui_diff -background white -foreground black \
2632 -borderwidth 0 \
2633 -width 80 -height 15 -wrap none \
2634 -font font_diff \
2635 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2636 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2637 -state disabled
2638 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2639 -command [list $ui_diff xview]
2640 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2641 -command [list $ui_diff yview]
2642 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2643 pack .vpane.lower.diff.body.sby -side right -fill y
2644 pack $ui_diff -side left -fill both -expand 1
2645 pack .vpane.lower.diff.header -side top -fill x
2646 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2648 $ui_diff tag conf d_cr -elide true
2649 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2650 $ui_diff tag conf d_+ -foreground {#00a000}
2651 $ui_diff tag conf d_- -foreground red
2653 $ui_diff tag conf d_++ -foreground {#00a000}
2654 $ui_diff tag conf d_-- -foreground red
2655 $ui_diff tag conf d_+s \
2656 -foreground {#00a000} \
2657 -background {#e2effa}
2658 $ui_diff tag conf d_-s \
2659 -foreground red \
2660 -background {#e2effa}
2661 $ui_diff tag conf d_s+ \
2662 -foreground {#00a000} \
2663 -background ivory1
2664 $ui_diff tag conf d_s- \
2665 -foreground red \
2666 -background ivory1
2668 $ui_diff tag conf d<<<<<<< \
2669 -foreground orange \
2670 -font font_diffbold
2671 $ui_diff tag conf d======= \
2672 -foreground orange \
2673 -font font_diffbold
2674 $ui_diff tag conf d>>>>>>> \
2675 -foreground orange \
2676 -font font_diffbold
2678 $ui_diff tag raise sel
2680 # -- Diff Body Context Menu
2682 set ctxm .vpane.lower.diff.body.ctxm
2683 menu $ctxm -tearoff 0
2684 $ctxm add command \
2685 -label [mc "Apply/Reverse Hunk"] \
2686 -command {apply_hunk $cursorX $cursorY}
2687 set ui_diff_applyhunk [$ctxm index last]
2688 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2689 $ctxm add command \
2690 -label [mc "Apply/Reverse Line"] \
2691 -command {apply_line $cursorX $cursorY; do_rescan}
2692 set ui_diff_applyline [$ctxm index last]
2693 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
2694 $ctxm add separator
2695 $ctxm add command \
2696 -label [mc "Show Less Context"] \
2697 -command show_less_context
2698 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2699 $ctxm add command \
2700 -label [mc "Show More Context"] \
2701 -command show_more_context
2702 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2703 $ctxm add separator
2704 $ctxm add command \
2705 -label [mc Refresh] \
2706 -command reshow_diff
2707 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2708 $ctxm add command \
2709 -label [mc Copy] \
2710 -command {tk_textCopy $ui_diff}
2711 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2712 $ctxm add command \
2713 -label [mc "Select All"] \
2714 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2715 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2716 $ctxm add command \
2717 -label [mc "Copy All"] \
2718 -command {
2719 $ui_diff tag add sel 0.0 end
2720 tk_textCopy $ui_diff
2721 $ui_diff tag remove sel 0.0 end
2723 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2724 $ctxm add separator
2725 $ctxm add command \
2726 -label [mc "Decrease Font Size"] \
2727 -command {incr_font_size font_diff -1}
2728 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2729 $ctxm add command \
2730 -label [mc "Increase Font Size"] \
2731 -command {incr_font_size font_diff 1}
2732 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2733 $ctxm add separator
2734 $ctxm add command -label [mc "Options..."] \
2735 -command do_options
2736 proc popup_diff_menu {ctxm x y X Y} {
2737 global current_diff_path file_states
2738 set ::cursorX $x
2739 set ::cursorY $y
2740 if {$::ui_index eq $::current_diff_side} {
2741 set l [mc "Unstage Hunk From Commit"]
2742 set t [mc "Unstage Line From Commit"]
2743 } else {
2744 set l [mc "Stage Hunk For Commit"]
2745 set t [mc "Stage Line For Commit"]
2747 if {$::is_3way_diff
2748 || $current_diff_path eq {}
2749 || ![info exists file_states($current_diff_path)]
2750 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2751 set s disabled
2752 } else {
2753 set s normal
2755 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2756 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
2757 tk_popup $ctxm $X $Y
2759 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2761 # -- Status Bar
2763 set main_status [::status_bar::new .status]
2764 pack .status -anchor w -side bottom -fill x
2765 $main_status show [mc "Initializing..."]
2767 # -- Load geometry
2769 catch {
2770 set gm $repo_config(gui.geometry)
2771 wm geometry . [lindex $gm 0]
2772 .vpane sash place 0 \
2773 [lindex $gm 1] \
2774 [lindex [.vpane sash coord 0] 1]
2775 .vpane.files sash place 0 \
2776 [lindex [.vpane.files sash coord 0] 0] \
2777 [lindex $gm 2]
2778 unset gm
2781 # -- Key Bindings
2783 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2784 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
2785 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
2786 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2787 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2788 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2789 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2790 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2791 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2792 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2793 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2794 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2795 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2796 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
2797 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
2798 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
2799 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
2800 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
2802 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2803 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2804 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2805 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2806 bind $ui_diff <$M1B-Key-v> {break}
2807 bind $ui_diff <$M1B-Key-V> {break}
2808 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2809 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2810 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2811 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2812 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2813 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2814 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2815 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2816 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2817 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2818 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2819 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2820 bind $ui_diff <Button-1> {focus %W}
2822 if {[is_enabled branch]} {
2823 bind . <$M1B-Key-n> branch_create::dialog
2824 bind . <$M1B-Key-N> branch_create::dialog
2825 bind . <$M1B-Key-o> branch_checkout::dialog
2826 bind . <$M1B-Key-O> branch_checkout::dialog
2827 bind . <$M1B-Key-m> merge::dialog
2828 bind . <$M1B-Key-M> merge::dialog
2830 if {[is_enabled transport]} {
2831 bind . <$M1B-Key-p> do_push_anywhere
2832 bind . <$M1B-Key-P> do_push_anywhere
2835 bind . <Key-F5> do_rescan
2836 bind . <$M1B-Key-r> do_rescan
2837 bind . <$M1B-Key-R> do_rescan
2838 bind . <$M1B-Key-s> do_signoff
2839 bind . <$M1B-Key-S> do_signoff
2840 bind . <$M1B-Key-t> do_add_selection
2841 bind . <$M1B-Key-T> do_add_selection
2842 bind . <$M1B-Key-i> do_add_all
2843 bind . <$M1B-Key-I> do_add_all
2844 bind . <$M1B-Key-minus> {show_less_context;break}
2845 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
2846 bind . <$M1B-Key-equal> {show_more_context;break}
2847 bind . <$M1B-Key-plus> {show_more_context;break}
2848 bind . <$M1B-Key-KP_Add> {show_more_context;break}
2849 bind . <$M1B-Key-Return> do_commit
2850 foreach i [list $ui_index $ui_workdir] {
2851 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2852 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2853 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2855 unset i
2857 set file_lists($ui_index) [list]
2858 set file_lists($ui_workdir) [list]
2860 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2861 focus -force $ui_comm
2863 # -- Warn the user about environmental problems. Cygwin's Tcl
2864 # does *not* pass its env array onto any processes it spawns.
2865 # This means that git processes get none of our environment.
2867 if {[is_Cygwin]} {
2868 set ignored_env 0
2869 set suggest_user {}
2870 set msg [mc "Possible environment issues exist.
2872 The following environment variables are probably
2873 going to be ignored by any Git subprocess run
2874 by %s:
2876 " [appname]]
2877 foreach name [array names env] {
2878 switch -regexp -- $name {
2879 {^GIT_INDEX_FILE$} -
2880 {^GIT_OBJECT_DIRECTORY$} -
2881 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2882 {^GIT_DIFF_OPTS$} -
2883 {^GIT_EXTERNAL_DIFF$} -
2884 {^GIT_PAGER$} -
2885 {^GIT_TRACE$} -
2886 {^GIT_CONFIG$} -
2887 {^GIT_CONFIG_LOCAL$} -
2888 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2889 append msg " - $name\n"
2890 incr ignored_env
2892 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2893 append msg " - $name\n"
2894 incr ignored_env
2895 set suggest_user $name
2899 if {$ignored_env > 0} {
2900 append msg [mc "
2901 This is due to a known issue with the
2902 Tcl binary distributed by Cygwin."]
2904 if {$suggest_user ne {}} {
2905 append msg [mc "
2907 A good replacement for %s
2908 is placing values for the user.name and
2909 user.email settings into your personal
2910 ~/.gitconfig file.
2911 " $suggest_user]
2913 warn_popup $msg
2915 unset ignored_env msg suggest_user name
2918 # -- Only initialize complex UI if we are going to stay running.
2920 if {[is_enabled transport]} {
2921 load_all_remotes
2923 set n [.mbar.remote index end]
2924 populate_push_menu
2925 populate_fetch_menu
2926 set n [expr {[.mbar.remote index end] - $n}]
2927 if {$n > 0} {
2928 .mbar.remote insert $n separator
2930 unset n
2933 if {[winfo exists $ui_comm]} {
2934 set GITGUI_BCK_exists [load_message GITGUI_BCK]
2936 # -- If both our backup and message files exist use the
2937 # newer of the two files to initialize the buffer.
2939 if {$GITGUI_BCK_exists} {
2940 set m [gitdir GITGUI_MSG]
2941 if {[file isfile $m]} {
2942 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2943 catch {file delete [gitdir GITGUI_MSG]}
2944 } else {
2945 $ui_comm delete 0.0 end
2946 $ui_comm edit reset
2947 $ui_comm edit modified false
2948 catch {file delete [gitdir GITGUI_BCK]}
2949 set GITGUI_BCK_exists 0
2952 unset m
2955 proc backup_commit_buffer {} {
2956 global ui_comm GITGUI_BCK_exists
2958 set m [$ui_comm edit modified]
2959 if {$m || $GITGUI_BCK_exists} {
2960 set msg [string trim [$ui_comm get 0.0 end]]
2961 regsub -all -line {[ \r\t]+$} $msg {} msg
2963 if {$msg eq {}} {
2964 if {$GITGUI_BCK_exists} {
2965 catch {file delete [gitdir GITGUI_BCK]}
2966 set GITGUI_BCK_exists 0
2968 } elseif {$m} {
2969 catch {
2970 set fd [open [gitdir GITGUI_BCK] w]
2971 puts -nonewline $fd $msg
2972 close $fd
2973 set GITGUI_BCK_exists 1
2977 $ui_comm edit modified false
2980 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2983 backup_commit_buffer
2985 # -- If the user has aspell available we can drive it
2986 # in pipe mode to spellcheck the commit message.
2988 set spell_cmd [list |]
2989 set spell_dict [get_config gui.spellingdictionary]
2990 lappend spell_cmd aspell
2991 if {$spell_dict ne {}} {
2992 lappend spell_cmd --master=$spell_dict
2994 lappend spell_cmd --mode=none
2995 lappend spell_cmd --encoding=utf-8
2996 lappend spell_cmd pipe
2997 if {$spell_dict eq {none}
2998 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
2999 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3000 } else {
3001 set ui_comm_spell [spellcheck::init \
3002 $spell_fd \
3003 $ui_comm \
3004 $ui_comm_ctxm \
3007 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3010 lock_index begin-read
3011 if {![winfo ismapped .]} {
3012 wm deiconify .
3014 after 1 do_rescan
3015 if {[is_enabled multicommit]} {
3016 after 1000 hint_gc