Add options to control the search for copies in blame.
[git/dscho.git] / git-gui.sh
blobb1ed0ec5681ea78fb5ece8393604760fb302214f
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 sq {value} {
501 regsub -all ' $value "'\\''" value
502 return "'$value'"
505 proc load_current_branch {} {
506 global current_branch is_detached
508 set fd [open [gitdir HEAD] r]
509 if {[gets $fd ref] < 1} {
510 set ref {}
512 close $fd
514 set pfx {ref: refs/heads/}
515 set len [string length $pfx]
516 if {[string equal -length $len $pfx $ref]} {
517 # We're on a branch. It might not exist. But
518 # HEAD looks good enough to be a branch.
520 set current_branch [string range $ref $len end]
521 set is_detached 0
522 } else {
523 # Assume this is a detached head.
525 set current_branch HEAD
526 set is_detached 1
530 auto_load tk_optionMenu
531 rename tk_optionMenu real__tkOptionMenu
532 proc tk_optionMenu {w varName args} {
533 set m [eval real__tkOptionMenu $w $varName $args]
534 $m configure -font font_ui
535 $w configure -font font_ui
536 return $m
539 proc rmsel_tag {text} {
540 $text tag conf sel \
541 -background [$text cget -background] \
542 -foreground [$text cget -foreground] \
543 -borderwidth 0
544 $text tag conf in_sel -background lightgray
545 bind $text <Motion> break
546 return $text
549 set root_exists 0
550 bind . <Visibility> {
551 bind . <Visibility> {}
552 set root_exists 1
555 if {[is_Windows]} {
556 wm iconbitmap . -default $oguilib/git-gui.ico
559 ######################################################################
561 ## config defaults
563 set cursor_ptr arrow
564 font create font_diff -family Courier -size 10
565 font create font_ui
566 catch {
567 label .dummy
568 eval font configure font_ui [font actual [.dummy cget -font]]
569 destroy .dummy
572 font create font_uiitalic
573 font create font_uibold
574 font create font_diffbold
575 font create font_diffitalic
577 foreach class {Button Checkbutton Entry Label
578 Labelframe Listbox Menu Message
579 Radiobutton Spinbox Text} {
580 option add *$class.font font_ui
582 unset class
584 if {[is_Windows] || [is_MacOSX]} {
585 option add *Menu.tearOff 0
588 if {[is_MacOSX]} {
589 set M1B M1
590 set M1T Cmd
591 } else {
592 set M1B Control
593 set M1T Ctrl
596 proc bind_button3 {w cmd} {
597 bind $w <Any-Button-3> $cmd
598 if {[is_MacOSX]} {
599 # Mac OS X sends Button-2 on right click through three-button mouse,
600 # or through trackpad right-clicking (two-finger touch + click).
601 bind $w <Any-Button-2> $cmd
602 bind $w <Control-Button-1> $cmd
606 proc apply_config {} {
607 global repo_config font_descs
609 foreach option $font_descs {
610 set name [lindex $option 0]
611 set font [lindex $option 1]
612 if {[catch {
613 set need_weight 1
614 foreach {cn cv} $repo_config(gui.$name) {
615 if {$cn eq {-weight}} {
616 set need_weight 0
618 font configure $font $cn $cv
620 if {$need_weight} {
621 font configure $font -weight normal
623 } err]} {
624 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
626 foreach {cn cv} [font configure $font] {
627 font configure ${font}bold $cn $cv
628 font configure ${font}italic $cn $cv
630 font configure ${font}bold -weight bold
631 font configure ${font}italic -slant italic
635 set default_config(branch.autosetupmerge) true
636 set default_config(merge.diffstat) true
637 set default_config(merge.summary) false
638 set default_config(merge.verbosity) 2
639 set default_config(user.name) {}
640 set default_config(user.email) {}
642 set default_config(gui.matchtrackingbranch) false
643 set default_config(gui.pruneduringfetch) false
644 set default_config(gui.trustmtime) false
645 set default_config(gui.fastcopyblame) false
646 set default_config(gui.copyblamethreshold) 40
647 set default_config(gui.diffcontext) 5
648 set default_config(gui.commitmsgwidth) 75
649 set default_config(gui.newbranchtemplate) {}
650 set default_config(gui.spellingdictionary) {}
651 set default_config(gui.fontui) [font configure font_ui]
652 set default_config(gui.fontdiff) [font configure font_diff]
653 set font_descs {
654 {fontui font_ui {mc "Main Font"}}
655 {fontdiff font_diff {mc "Diff/Console Font"}}
658 ######################################################################
660 ## find git
662 set _git [_which git]
663 if {$_git eq {}} {
664 catch {wm withdraw .}
665 tk_messageBox \
666 -icon error \
667 -type ok \
668 -title [mc "git-gui: fatal error"] \
669 -message [mc "Cannot find git in PATH."]
670 exit 1
673 ######################################################################
675 ## version check
677 if {[catch {set _git_version [git --version]} err]} {
678 catch {wm withdraw .}
679 tk_messageBox \
680 -icon error \
681 -type ok \
682 -title [mc "git-gui: fatal error"] \
683 -message "Cannot determine Git version:
685 $err
687 [appname] requires Git 1.5.0 or later."
688 exit 1
690 if {![regsub {^git version } $_git_version {} _git_version]} {
691 catch {wm withdraw .}
692 tk_messageBox \
693 -icon error \
694 -type ok \
695 -title [mc "git-gui: fatal error"] \
696 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
697 exit 1
700 set _real_git_version $_git_version
701 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
702 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
703 regsub {\.rc[0-9]+$} $_git_version {} _git_version
704 regsub {\.GIT$} $_git_version {} _git_version
705 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
707 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
708 catch {wm withdraw .}
709 if {[tk_messageBox \
710 -icon warning \
711 -type yesno \
712 -default no \
713 -title "[appname]: warning" \
714 -message [mc "Git version cannot be determined.
716 %s claims it is version '%s'.
718 %s requires at least Git 1.5.0 or later.
720 Assume '%s' is version 1.5.0?
721 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
722 set _git_version 1.5.0
723 } else {
724 exit 1
727 unset _real_git_version
729 proc git-version {args} {
730 global _git_version
732 switch [llength $args] {
734 return $_git_version
738 set op [lindex $args 0]
739 set vr [lindex $args 1]
740 set cm [package vcompare $_git_version $vr]
741 return [expr $cm $op 0]
745 set type [lindex $args 0]
746 set name [lindex $args 1]
747 set parm [lindex $args 2]
748 set body [lindex $args 3]
750 if {($type ne {proc} && $type ne {method})} {
751 error "Invalid arguments to git-version"
753 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
754 error "Last arm of $type $name must be default"
757 foreach {op vr cb} [lrange $body 0 end-2] {
758 if {[git-version $op $vr]} {
759 return [uplevel [list $type $name $parm $cb]]
763 return [uplevel [list $type $name $parm [lindex $body end]]]
766 default {
767 error "git-version >= x"
773 if {[git-version < 1.5]} {
774 catch {wm withdraw .}
775 tk_messageBox \
776 -icon error \
777 -type ok \
778 -title [mc "git-gui: fatal error"] \
779 -message "[appname] requires Git 1.5.0 or later.
781 You are using [git-version]:
783 [git --version]"
784 exit 1
787 ######################################################################
789 ## configure our library
791 set idx [file join $oguilib tclIndex]
792 if {[catch {set fd [open $idx r]} err]} {
793 catch {wm withdraw .}
794 tk_messageBox \
795 -icon error \
796 -type ok \
797 -title [mc "git-gui: fatal error"] \
798 -message $err
799 exit 1
801 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
802 set idx [list]
803 while {[gets $fd n] >= 0} {
804 if {$n ne {} && ![string match #* $n]} {
805 lappend idx $n
808 } else {
809 set idx {}
811 close $fd
813 if {$idx ne {}} {
814 set loaded [list]
815 foreach p $idx {
816 if {[lsearch -exact $loaded $p] >= 0} continue
817 source [file join $oguilib $p]
818 lappend loaded $p
820 unset loaded p
821 } else {
822 set auto_path [concat [list $oguilib] $auto_path]
824 unset -nocomplain idx fd
826 ######################################################################
828 ## config file parsing
830 git-version proc _parse_config {arr_name args} {
831 >= 1.5.3 {
832 upvar $arr_name arr
833 array unset arr
834 set buf {}
835 catch {
836 set fd_rc [eval \
837 [list git_read config] \
838 $args \
839 [list --null --list]]
840 fconfigure $fd_rc -translation binary
841 set buf [read $fd_rc]
842 close $fd_rc
844 foreach line [split $buf "\0"] {
845 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
846 if {[is_many_config $name]} {
847 lappend arr($name) $value
848 } else {
849 set arr($name) $value
854 default {
855 upvar $arr_name arr
856 array unset arr
857 catch {
858 set fd_rc [eval [list git_read config --list] $args]
859 while {[gets $fd_rc line] >= 0} {
860 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
861 if {[is_many_config $name]} {
862 lappend arr($name) $value
863 } else {
864 set arr($name) $value
868 close $fd_rc
873 proc load_config {include_global} {
874 global repo_config global_config default_config
876 if {$include_global} {
877 _parse_config global_config --global
879 _parse_config repo_config
881 foreach name [array names default_config] {
882 if {[catch {set v $global_config($name)}]} {
883 set global_config($name) $default_config($name)
885 if {[catch {set v $repo_config($name)}]} {
886 set repo_config($name) $default_config($name)
891 ######################################################################
893 ## feature option selection
895 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
896 unset _junk
897 } else {
898 set subcommand gui
900 if {$subcommand eq {gui.sh}} {
901 set subcommand gui
903 if {$subcommand eq {gui} && [llength $argv] > 0} {
904 set subcommand [lindex $argv 0]
905 set argv [lrange $argv 1 end]
908 enable_option multicommit
909 enable_option branch
910 enable_option transport
911 disable_option bare
913 switch -- $subcommand {
914 browser -
915 blame {
916 enable_option bare
918 disable_option multicommit
919 disable_option branch
920 disable_option transport
922 citool {
923 enable_option singlecommit
925 disable_option multicommit
926 disable_option branch
927 disable_option transport
931 ######################################################################
933 ## repository setup
935 if {[catch {
936 set _gitdir $env(GIT_DIR)
937 set _prefix {}
939 && [catch {
940 set _gitdir [git rev-parse --git-dir]
941 set _prefix [git rev-parse --show-prefix]
942 } err]} {
943 load_config 1
944 apply_config
945 choose_repository::pick
947 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
948 catch {set _gitdir [exec cygpath --windows $_gitdir]}
950 if {![file isdirectory $_gitdir]} {
951 catch {wm withdraw .}
952 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
953 exit 1
955 if {$_prefix ne {}} {
956 regsub -all {[^/]+/} $_prefix ../ cdup
957 if {[catch {cd $cdup} err]} {
958 catch {wm withdraw .}
959 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
960 exit 1
962 unset cdup
963 } elseif {![is_enabled bare]} {
964 if {[lindex [file split $_gitdir] end] ne {.git}} {
965 catch {wm withdraw .}
966 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
967 exit 1
969 if {[catch {cd [file dirname $_gitdir]} err]} {
970 catch {wm withdraw .}
971 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
972 exit 1
975 set _reponame [file split [file normalize $_gitdir]]
976 if {[lindex $_reponame end] eq {.git}} {
977 set _reponame [lindex $_reponame end-1]
978 } else {
979 set _reponame [lindex $_reponame end]
982 ######################################################################
984 ## global init
986 set current_diff_path {}
987 set current_diff_side {}
988 set diff_actions [list]
990 set HEAD {}
991 set PARENT {}
992 set MERGE_HEAD [list]
993 set commit_type {}
994 set empty_tree {}
995 set current_branch {}
996 set is_detached 0
997 set current_diff_path {}
998 set is_3way_diff 0
999 set selected_commit_type new
1001 ######################################################################
1003 ## task management
1005 set rescan_active 0
1006 set diff_active 0
1007 set last_clicked {}
1009 set disable_on_lock [list]
1010 set index_lock_type none
1012 proc lock_index {type} {
1013 global index_lock_type disable_on_lock
1015 if {$index_lock_type eq {none}} {
1016 set index_lock_type $type
1017 foreach w $disable_on_lock {
1018 uplevel #0 $w disabled
1020 return 1
1021 } elseif {$index_lock_type eq "begin-$type"} {
1022 set index_lock_type $type
1023 return 1
1025 return 0
1028 proc unlock_index {} {
1029 global index_lock_type disable_on_lock
1031 set index_lock_type none
1032 foreach w $disable_on_lock {
1033 uplevel #0 $w normal
1037 ######################################################################
1039 ## status
1041 proc repository_state {ctvar hdvar mhvar} {
1042 global current_branch
1043 upvar $ctvar ct $hdvar hd $mhvar mh
1045 set mh [list]
1047 load_current_branch
1048 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1049 set hd {}
1050 set ct initial
1051 return
1054 set merge_head [gitdir MERGE_HEAD]
1055 if {[file exists $merge_head]} {
1056 set ct merge
1057 set fd_mh [open $merge_head r]
1058 while {[gets $fd_mh line] >= 0} {
1059 lappend mh $line
1061 close $fd_mh
1062 return
1065 set ct normal
1068 proc PARENT {} {
1069 global PARENT empty_tree
1071 set p [lindex $PARENT 0]
1072 if {$p ne {}} {
1073 return $p
1075 if {$empty_tree eq {}} {
1076 set empty_tree [git mktree << {}]
1078 return $empty_tree
1081 proc rescan {after {honor_trustmtime 1}} {
1082 global HEAD PARENT MERGE_HEAD commit_type
1083 global ui_index ui_workdir ui_comm
1084 global rescan_active file_states
1085 global repo_config
1087 if {$rescan_active > 0 || ![lock_index read]} return
1089 repository_state newType newHEAD newMERGE_HEAD
1090 if {[string match amend* $commit_type]
1091 && $newType eq {normal}
1092 && $newHEAD eq $HEAD} {
1093 } else {
1094 set HEAD $newHEAD
1095 set PARENT $newHEAD
1096 set MERGE_HEAD $newMERGE_HEAD
1097 set commit_type $newType
1100 array unset file_states
1102 if {!$::GITGUI_BCK_exists &&
1103 (![$ui_comm edit modified]
1104 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1105 if {[string match amend* $commit_type]} {
1106 } elseif {[load_message GITGUI_MSG]} {
1107 } elseif {[load_message MERGE_MSG]} {
1108 } elseif {[load_message SQUASH_MSG]} {
1110 $ui_comm edit reset
1111 $ui_comm edit modified false
1114 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1115 rescan_stage2 {} $after
1116 } else {
1117 set rescan_active 1
1118 ui_status [mc "Refreshing file status..."]
1119 set fd_rf [git_read update-index \
1120 -q \
1121 --unmerged \
1122 --ignore-missing \
1123 --refresh \
1125 fconfigure $fd_rf -blocking 0 -translation binary
1126 fileevent $fd_rf readable \
1127 [list rescan_stage2 $fd_rf $after]
1131 if {[is_Cygwin]} {
1132 set is_git_info_exclude {}
1133 proc have_info_exclude {} {
1134 global is_git_info_exclude
1136 if {$is_git_info_exclude eq {}} {
1137 if {[catch {exec test -f [gitdir info exclude]}]} {
1138 set is_git_info_exclude 0
1139 } else {
1140 set is_git_info_exclude 1
1143 return $is_git_info_exclude
1145 } else {
1146 proc have_info_exclude {} {
1147 return [file readable [gitdir info exclude]]
1151 proc rescan_stage2 {fd after} {
1152 global rescan_active buf_rdi buf_rdf buf_rlo
1154 if {$fd ne {}} {
1155 read $fd
1156 if {![eof $fd]} return
1157 close $fd
1160 set ls_others [list --exclude-per-directory=.gitignore]
1161 if {[have_info_exclude]} {
1162 lappend ls_others "--exclude-from=[gitdir info exclude]"
1164 set user_exclude [get_config core.excludesfile]
1165 if {$user_exclude ne {} && [file readable $user_exclude]} {
1166 lappend ls_others "--exclude-from=$user_exclude"
1169 set buf_rdi {}
1170 set buf_rdf {}
1171 set buf_rlo {}
1173 set rescan_active 3
1174 ui_status [mc "Scanning for modified files ..."]
1175 set fd_di [git_read diff-index --cached -z [PARENT]]
1176 set fd_df [git_read diff-files -z]
1177 set fd_lo [eval git_read ls-files --others -z $ls_others]
1179 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1180 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1181 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1182 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1183 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1184 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1187 proc load_message {file} {
1188 global ui_comm
1190 set f [gitdir $file]
1191 if {[file isfile $f]} {
1192 if {[catch {set fd [open $f r]}]} {
1193 return 0
1195 fconfigure $fd -eofchar {}
1196 set content [string trim [read $fd]]
1197 close $fd
1198 regsub -all -line {[ \r\t]+$} $content {} content
1199 $ui_comm delete 0.0 end
1200 $ui_comm insert end $content
1201 return 1
1203 return 0
1206 proc read_diff_index {fd after} {
1207 global buf_rdi
1209 append buf_rdi [read $fd]
1210 set c 0
1211 set n [string length $buf_rdi]
1212 while {$c < $n} {
1213 set z1 [string first "\0" $buf_rdi $c]
1214 if {$z1 == -1} break
1215 incr z1
1216 set z2 [string first "\0" $buf_rdi $z1]
1217 if {$z2 == -1} break
1219 incr c
1220 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1221 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1222 merge_state \
1223 [encoding convertfrom $p] \
1224 [lindex $i 4]? \
1225 [list [lindex $i 0] [lindex $i 2]] \
1226 [list]
1227 set c $z2
1228 incr c
1230 if {$c < $n} {
1231 set buf_rdi [string range $buf_rdi $c end]
1232 } else {
1233 set buf_rdi {}
1236 rescan_done $fd buf_rdi $after
1239 proc read_diff_files {fd after} {
1240 global buf_rdf
1242 append buf_rdf [read $fd]
1243 set c 0
1244 set n [string length $buf_rdf]
1245 while {$c < $n} {
1246 set z1 [string first "\0" $buf_rdf $c]
1247 if {$z1 == -1} break
1248 incr z1
1249 set z2 [string first "\0" $buf_rdf $z1]
1250 if {$z2 == -1} break
1252 incr c
1253 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1254 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1255 merge_state \
1256 [encoding convertfrom $p] \
1257 ?[lindex $i 4] \
1258 [list] \
1259 [list [lindex $i 0] [lindex $i 2]]
1260 set c $z2
1261 incr c
1263 if {$c < $n} {
1264 set buf_rdf [string range $buf_rdf $c end]
1265 } else {
1266 set buf_rdf {}
1269 rescan_done $fd buf_rdf $after
1272 proc read_ls_others {fd after} {
1273 global buf_rlo
1275 append buf_rlo [read $fd]
1276 set pck [split $buf_rlo "\0"]
1277 set buf_rlo [lindex $pck end]
1278 foreach p [lrange $pck 0 end-1] {
1279 set p [encoding convertfrom $p]
1280 if {[string index $p end] eq {/}} {
1281 set p [string range $p 0 end-1]
1283 merge_state $p ?O
1285 rescan_done $fd buf_rlo $after
1288 proc rescan_done {fd buf after} {
1289 global rescan_active current_diff_path
1290 global file_states repo_config
1291 upvar $buf to_clear
1293 if {![eof $fd]} return
1294 set to_clear {}
1295 close $fd
1296 if {[incr rescan_active -1] > 0} return
1298 prune_selection
1299 unlock_index
1300 display_all_files
1301 if {$current_diff_path ne {}} reshow_diff
1302 uplevel #0 $after
1305 proc prune_selection {} {
1306 global file_states selected_paths
1308 foreach path [array names selected_paths] {
1309 if {[catch {set still_here $file_states($path)}]} {
1310 unset selected_paths($path)
1315 ######################################################################
1317 ## ui helpers
1319 proc mapicon {w state path} {
1320 global all_icons
1322 if {[catch {set r $all_icons($state$w)}]} {
1323 puts "error: no icon for $w state={$state} $path"
1324 return file_plain
1326 return $r
1329 proc mapdesc {state path} {
1330 global all_descs
1332 if {[catch {set r $all_descs($state)}]} {
1333 puts "error: no desc for state={$state} $path"
1334 return $state
1336 return $r
1339 proc ui_status {msg} {
1340 global main_status
1341 if {[info exists main_status]} {
1342 $main_status show $msg
1346 proc ui_ready {{test {}}} {
1347 global main_status
1348 if {[info exists main_status]} {
1349 $main_status show [mc "Ready."] $test
1353 proc escape_path {path} {
1354 regsub -all {\\} $path "\\\\" path
1355 regsub -all "\n" $path "\\n" path
1356 return $path
1359 proc short_path {path} {
1360 return [escape_path [lindex [file split $path] end]]
1363 set next_icon_id 0
1364 set null_sha1 [string repeat 0 40]
1366 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1367 global file_states next_icon_id null_sha1
1369 set s0 [string index $new_state 0]
1370 set s1 [string index $new_state 1]
1372 if {[catch {set info $file_states($path)}]} {
1373 set state __
1374 set icon n[incr next_icon_id]
1375 } else {
1376 set state [lindex $info 0]
1377 set icon [lindex $info 1]
1378 if {$head_info eq {}} {set head_info [lindex $info 2]}
1379 if {$index_info eq {}} {set index_info [lindex $info 3]}
1382 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1383 elseif {$s0 eq {_}} {set s0 _}
1385 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1386 elseif {$s1 eq {_}} {set s1 _}
1388 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1389 set head_info [list 0 $null_sha1]
1390 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1391 && $head_info eq {}} {
1392 set head_info $index_info
1395 set file_states($path) [list $s0$s1 $icon \
1396 $head_info $index_info \
1398 return $state
1401 proc display_file_helper {w path icon_name old_m new_m} {
1402 global file_lists
1404 if {$new_m eq {_}} {
1405 set lno [lsearch -sorted -exact $file_lists($w) $path]
1406 if {$lno >= 0} {
1407 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1408 incr lno
1409 $w conf -state normal
1410 $w delete $lno.0 [expr {$lno + 1}].0
1411 $w conf -state disabled
1413 } elseif {$old_m eq {_} && $new_m ne {_}} {
1414 lappend file_lists($w) $path
1415 set file_lists($w) [lsort -unique $file_lists($w)]
1416 set lno [lsearch -sorted -exact $file_lists($w) $path]
1417 incr lno
1418 $w conf -state normal
1419 $w image create $lno.0 \
1420 -align center -padx 5 -pady 1 \
1421 -name $icon_name \
1422 -image [mapicon $w $new_m $path]
1423 $w insert $lno.1 "[escape_path $path]\n"
1424 $w conf -state disabled
1425 } elseif {$old_m ne $new_m} {
1426 $w conf -state normal
1427 $w image conf $icon_name -image [mapicon $w $new_m $path]
1428 $w conf -state disabled
1432 proc display_file {path state} {
1433 global file_states selected_paths
1434 global ui_index ui_workdir
1436 set old_m [merge_state $path $state]
1437 set s $file_states($path)
1438 set new_m [lindex $s 0]
1439 set icon_name [lindex $s 1]
1441 set o [string index $old_m 0]
1442 set n [string index $new_m 0]
1443 if {$o eq {U}} {
1444 set o _
1446 if {$n eq {U}} {
1447 set n _
1449 display_file_helper $ui_index $path $icon_name $o $n
1451 if {[string index $old_m 0] eq {U}} {
1452 set o U
1453 } else {
1454 set o [string index $old_m 1]
1456 if {[string index $new_m 0] eq {U}} {
1457 set n U
1458 } else {
1459 set n [string index $new_m 1]
1461 display_file_helper $ui_workdir $path $icon_name $o $n
1463 if {$new_m eq {__}} {
1464 unset file_states($path)
1465 catch {unset selected_paths($path)}
1469 proc display_all_files_helper {w path icon_name m} {
1470 global file_lists
1472 lappend file_lists($w) $path
1473 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1474 $w image create end \
1475 -align center -padx 5 -pady 1 \
1476 -name $icon_name \
1477 -image [mapicon $w $m $path]
1478 $w insert end "[escape_path $path]\n"
1481 proc display_all_files {} {
1482 global ui_index ui_workdir
1483 global file_states file_lists
1484 global last_clicked
1486 $ui_index conf -state normal
1487 $ui_workdir conf -state normal
1489 $ui_index delete 0.0 end
1490 $ui_workdir delete 0.0 end
1491 set last_clicked {}
1493 set file_lists($ui_index) [list]
1494 set file_lists($ui_workdir) [list]
1496 foreach path [lsort [array names file_states]] {
1497 set s $file_states($path)
1498 set m [lindex $s 0]
1499 set icon_name [lindex $s 1]
1501 set s [string index $m 0]
1502 if {$s ne {U} && $s ne {_}} {
1503 display_all_files_helper $ui_index $path \
1504 $icon_name $s
1507 if {[string index $m 0] eq {U}} {
1508 set s U
1509 } else {
1510 set s [string index $m 1]
1512 if {$s ne {_}} {
1513 display_all_files_helper $ui_workdir $path \
1514 $icon_name $s
1518 $ui_index conf -state disabled
1519 $ui_workdir conf -state disabled
1522 ######################################################################
1524 ## icons
1526 set filemask {
1527 #define mask_width 14
1528 #define mask_height 15
1529 static unsigned char mask_bits[] = {
1530 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1531 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1532 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1535 image create bitmap file_plain -background white -foreground black -data {
1536 #define plain_width 14
1537 #define plain_height 15
1538 static unsigned char plain_bits[] = {
1539 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1540 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1541 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1542 } -maskdata $filemask
1544 image create bitmap file_mod -background white -foreground blue -data {
1545 #define mod_width 14
1546 #define mod_height 15
1547 static unsigned char mod_bits[] = {
1548 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1549 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1550 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1551 } -maskdata $filemask
1553 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1554 #define file_fulltick_width 14
1555 #define file_fulltick_height 15
1556 static unsigned char file_fulltick_bits[] = {
1557 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1558 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1559 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1560 } -maskdata $filemask
1562 image create bitmap file_parttick -background white -foreground "#005050" -data {
1563 #define parttick_width 14
1564 #define parttick_height 15
1565 static unsigned char parttick_bits[] = {
1566 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1567 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1568 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1569 } -maskdata $filemask
1571 image create bitmap file_question -background white -foreground black -data {
1572 #define file_question_width 14
1573 #define file_question_height 15
1574 static unsigned char file_question_bits[] = {
1575 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1576 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1577 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1578 } -maskdata $filemask
1580 image create bitmap file_removed -background white -foreground red -data {
1581 #define file_removed_width 14
1582 #define file_removed_height 15
1583 static unsigned char file_removed_bits[] = {
1584 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1585 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1586 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1587 } -maskdata $filemask
1589 image create bitmap file_merge -background white -foreground blue -data {
1590 #define file_merge_width 14
1591 #define file_merge_height 15
1592 static unsigned char file_merge_bits[] = {
1593 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1594 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1595 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1596 } -maskdata $filemask
1598 set ui_index .vpane.files.index.list
1599 set ui_workdir .vpane.files.workdir.list
1601 set all_icons(_$ui_index) file_plain
1602 set all_icons(A$ui_index) file_fulltick
1603 set all_icons(M$ui_index) file_fulltick
1604 set all_icons(D$ui_index) file_removed
1605 set all_icons(U$ui_index) file_merge
1607 set all_icons(_$ui_workdir) file_plain
1608 set all_icons(M$ui_workdir) file_mod
1609 set all_icons(D$ui_workdir) file_question
1610 set all_icons(U$ui_workdir) file_merge
1611 set all_icons(O$ui_workdir) file_plain
1613 set max_status_desc 0
1614 foreach i {
1615 {__ {mc "Unmodified"}}
1617 {_M {mc "Modified, not staged"}}
1618 {M_ {mc "Staged for commit"}}
1619 {MM {mc "Portions staged for commit"}}
1620 {MD {mc "Staged for commit, missing"}}
1622 {_O {mc "Untracked, not staged"}}
1623 {A_ {mc "Staged for commit"}}
1624 {AM {mc "Portions staged for commit"}}
1625 {AD {mc "Staged for commit, missing"}}
1627 {_D {mc "Missing"}}
1628 {D_ {mc "Staged for removal"}}
1629 {DO {mc "Staged for removal, still present"}}
1631 {U_ {mc "Requires merge resolution"}}
1632 {UU {mc "Requires merge resolution"}}
1633 {UM {mc "Requires merge resolution"}}
1634 {UD {mc "Requires merge resolution"}}
1636 set text [eval [lindex $i 1]]
1637 if {$max_status_desc < [string length $text]} {
1638 set max_status_desc [string length $text]
1640 set all_descs([lindex $i 0]) $text
1642 unset i
1644 ######################################################################
1646 ## util
1648 proc scrollbar2many {list mode args} {
1649 foreach w $list {eval $w $mode $args}
1652 proc many2scrollbar {list mode sb top bottom} {
1653 $sb set $top $bottom
1654 foreach w $list {$w $mode moveto $top}
1657 proc incr_font_size {font {amt 1}} {
1658 set sz [font configure $font -size]
1659 incr sz $amt
1660 font configure $font -size $sz
1661 font configure ${font}bold -size $sz
1662 font configure ${font}italic -size $sz
1665 ######################################################################
1667 ## ui commands
1669 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1671 proc do_gitk {revs} {
1672 # -- Always start gitk through whatever we were loaded with. This
1673 # lets us bypass using shell process on Windows systems.
1675 set exe [file join [file dirname $::_git] gitk]
1676 set cmd [list [info nameofexecutable] $exe]
1677 if {! [file exists $exe]} {
1678 error_popup [mc "Unable to start gitk:\n\n%s does not exist" $exe]
1679 } else {
1680 global env
1682 if {[info exists env(GIT_DIR)]} {
1683 set old_GIT_DIR $env(GIT_DIR)
1684 } else {
1685 set old_GIT_DIR {}
1688 set pwd [pwd]
1689 cd [file dirname [gitdir]]
1690 set env(GIT_DIR) [file tail [gitdir]]
1692 eval exec $cmd $revs &
1694 if {$old_GIT_DIR eq {}} {
1695 unset env(GIT_DIR)
1696 } else {
1697 set env(GIT_DIR) $old_GIT_DIR
1699 cd $pwd
1701 ui_status $::starting_gitk_msg
1702 after 10000 {
1703 ui_ready $starting_gitk_msg
1708 set is_quitting 0
1710 proc do_quit {} {
1711 global ui_comm is_quitting repo_config commit_type
1712 global GITGUI_BCK_exists GITGUI_BCK_i
1713 global ui_comm_spell
1715 if {$is_quitting} return
1716 set is_quitting 1
1718 if {[winfo exists $ui_comm]} {
1719 # -- Stash our current commit buffer.
1721 set save [gitdir GITGUI_MSG]
1722 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1723 file rename -force [gitdir GITGUI_BCK] $save
1724 set GITGUI_BCK_exists 0
1725 } else {
1726 set msg [string trim [$ui_comm get 0.0 end]]
1727 regsub -all -line {[ \r\t]+$} $msg {} msg
1728 if {(![string match amend* $commit_type]
1729 || [$ui_comm edit modified])
1730 && $msg ne {}} {
1731 catch {
1732 set fd [open $save w]
1733 puts -nonewline $fd $msg
1734 close $fd
1736 } else {
1737 catch {file delete $save}
1741 # -- Cancel our spellchecker if its running.
1743 if {[info exists ui_comm_spell]} {
1744 $ui_comm_spell stop
1747 # -- Remove our editor backup, its not needed.
1749 after cancel $GITGUI_BCK_i
1750 if {$GITGUI_BCK_exists} {
1751 catch {file delete [gitdir GITGUI_BCK]}
1754 # -- Stash our current window geometry into this repository.
1756 set cfg_geometry [list]
1757 lappend cfg_geometry [wm geometry .]
1758 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
1759 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
1760 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1761 set rc_geometry {}
1763 if {$cfg_geometry ne $rc_geometry} {
1764 catch {git config gui.geometry $cfg_geometry}
1768 destroy .
1771 proc do_rescan {} {
1772 rescan ui_ready
1775 proc do_commit {} {
1776 commit_tree
1779 proc next_diff {} {
1780 global next_diff_p next_diff_w next_diff_i
1781 show_diff $next_diff_p $next_diff_w $next_diff_i
1784 proc toggle_or_diff {w x y} {
1785 global file_states file_lists current_diff_path ui_index ui_workdir
1786 global last_clicked selected_paths
1788 set pos [split [$w index @$x,$y] .]
1789 set lno [lindex $pos 0]
1790 set col [lindex $pos 1]
1791 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1792 if {$path eq {}} {
1793 set last_clicked {}
1794 return
1797 set last_clicked [list $w $lno]
1798 array unset selected_paths
1799 $ui_index tag remove in_sel 0.0 end
1800 $ui_workdir tag remove in_sel 0.0 end
1802 if {$col == 0 && $y > 1} {
1803 set i [expr {$lno-1}]
1804 set ll [expr {[llength $file_lists($w)]-1}]
1806 if {$i == $ll && $i == 0} {
1807 set after {reshow_diff;}
1808 } else {
1809 global next_diff_p next_diff_w next_diff_i
1811 set next_diff_w $w
1813 if {$i < $ll} {
1814 set i [expr {$i + 1}]
1815 set next_diff_i $i
1816 } else {
1817 set next_diff_i $i
1818 set i [expr {$i - 1}]
1821 set next_diff_p [lindex $file_lists($w) $i]
1823 if {$next_diff_p ne {} && $current_diff_path ne {}} {
1824 set after {next_diff;}
1825 } else {
1826 set after {}
1830 if {$w eq $ui_index} {
1831 update_indexinfo \
1832 "Unstaging [short_path $path] from commit" \
1833 [list $path] \
1834 [concat $after [list ui_ready]]
1835 } elseif {$w eq $ui_workdir} {
1836 update_index \
1837 "Adding [short_path $path]" \
1838 [list $path] \
1839 [concat $after [list ui_ready]]
1841 } else {
1842 show_diff $path $w $lno
1846 proc add_one_to_selection {w x y} {
1847 global file_lists last_clicked selected_paths
1849 set lno [lindex [split [$w index @$x,$y] .] 0]
1850 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1851 if {$path eq {}} {
1852 set last_clicked {}
1853 return
1856 if {$last_clicked ne {}
1857 && [lindex $last_clicked 0] ne $w} {
1858 array unset selected_paths
1859 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1862 set last_clicked [list $w $lno]
1863 if {[catch {set in_sel $selected_paths($path)}]} {
1864 set in_sel 0
1866 if {$in_sel} {
1867 unset selected_paths($path)
1868 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1869 } else {
1870 set selected_paths($path) 1
1871 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1875 proc add_range_to_selection {w x y} {
1876 global file_lists last_clicked selected_paths
1878 if {[lindex $last_clicked 0] ne $w} {
1879 toggle_or_diff $w $x $y
1880 return
1883 set lno [lindex [split [$w index @$x,$y] .] 0]
1884 set lc [lindex $last_clicked 1]
1885 if {$lc < $lno} {
1886 set begin $lc
1887 set end $lno
1888 } else {
1889 set begin $lno
1890 set end $lc
1893 foreach path [lrange $file_lists($w) \
1894 [expr {$begin - 1}] \
1895 [expr {$end - 1}]] {
1896 set selected_paths($path) 1
1898 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1901 proc show_more_context {} {
1902 global repo_config
1903 if {$repo_config(gui.diffcontext) < 99} {
1904 incr repo_config(gui.diffcontext)
1905 reshow_diff
1909 proc show_less_context {} {
1910 global repo_config
1911 if {$repo_config(gui.diffcontext) >= 1} {
1912 incr repo_config(gui.diffcontext) -1
1913 reshow_diff
1917 ######################################################################
1919 ## ui construction
1921 load_config 0
1922 apply_config
1923 set ui_comm {}
1925 # -- Menu Bar
1927 menu .mbar -tearoff 0
1928 .mbar add cascade -label [mc Repository] -menu .mbar.repository
1929 .mbar add cascade -label [mc Edit] -menu .mbar.edit
1930 if {[is_enabled branch]} {
1931 .mbar add cascade -label [mc Branch] -menu .mbar.branch
1933 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1934 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
1936 if {[is_enabled transport]} {
1937 .mbar add cascade -label [mc Merge] -menu .mbar.merge
1938 .mbar add cascade -label [mc Remote] -menu .mbar.remote
1940 . configure -menu .mbar
1942 # -- Repository Menu
1944 menu .mbar.repository
1946 .mbar.repository add command \
1947 -label [mc "Browse Current Branch's Files"] \
1948 -command {browser::new $current_branch}
1949 set ui_browse_current [.mbar.repository index last]
1950 .mbar.repository add command \
1951 -label [mc "Browse Branch Files..."] \
1952 -command browser_open::dialog
1953 .mbar.repository add separator
1955 .mbar.repository add command \
1956 -label [mc "Visualize Current Branch's History"] \
1957 -command {do_gitk $current_branch}
1958 set ui_visualize_current [.mbar.repository index last]
1959 .mbar.repository add command \
1960 -label [mc "Visualize All Branch History"] \
1961 -command {do_gitk --all}
1962 .mbar.repository add separator
1964 proc current_branch_write {args} {
1965 global current_branch
1966 .mbar.repository entryconf $::ui_browse_current \
1967 -label [mc "Browse %s's Files" $current_branch]
1968 .mbar.repository entryconf $::ui_visualize_current \
1969 -label [mc "Visualize %s's History" $current_branch]
1971 trace add variable current_branch write current_branch_write
1973 if {[is_enabled multicommit]} {
1974 .mbar.repository add command -label [mc "Database Statistics"] \
1975 -command do_stats
1977 .mbar.repository add command -label [mc "Compress Database"] \
1978 -command do_gc
1980 .mbar.repository add command -label [mc "Verify Database"] \
1981 -command do_fsck_objects
1983 .mbar.repository add separator
1985 if {[is_Cygwin]} {
1986 .mbar.repository add command \
1987 -label [mc "Create Desktop Icon"] \
1988 -command do_cygwin_shortcut
1989 } elseif {[is_Windows]} {
1990 .mbar.repository add command \
1991 -label [mc "Create Desktop Icon"] \
1992 -command do_windows_shortcut
1993 } elseif {[is_MacOSX]} {
1994 .mbar.repository add command \
1995 -label [mc "Create Desktop Icon"] \
1996 -command do_macosx_app
2000 if {[is_MacOSX]} {
2001 proc ::tk::mac::Quit {args} { do_quit }
2002 } else {
2003 .mbar.repository add command -label [mc Quit] \
2004 -command do_quit \
2005 -accelerator $M1T-Q
2008 # -- Edit Menu
2010 menu .mbar.edit
2011 .mbar.edit add command -label [mc Undo] \
2012 -command {catch {[focus] edit undo}} \
2013 -accelerator $M1T-Z
2014 .mbar.edit add command -label [mc Redo] \
2015 -command {catch {[focus] edit redo}} \
2016 -accelerator $M1T-Y
2017 .mbar.edit add separator
2018 .mbar.edit add command -label [mc Cut] \
2019 -command {catch {tk_textCut [focus]}} \
2020 -accelerator $M1T-X
2021 .mbar.edit add command -label [mc Copy] \
2022 -command {catch {tk_textCopy [focus]}} \
2023 -accelerator $M1T-C
2024 .mbar.edit add command -label [mc Paste] \
2025 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2026 -accelerator $M1T-V
2027 .mbar.edit add command -label [mc Delete] \
2028 -command {catch {[focus] delete sel.first sel.last}} \
2029 -accelerator Del
2030 .mbar.edit add separator
2031 .mbar.edit add command -label [mc "Select All"] \
2032 -command {catch {[focus] tag add sel 0.0 end}} \
2033 -accelerator $M1T-A
2035 # -- Branch Menu
2037 if {[is_enabled branch]} {
2038 menu .mbar.branch
2040 .mbar.branch add command -label [mc "Create..."] \
2041 -command branch_create::dialog \
2042 -accelerator $M1T-N
2043 lappend disable_on_lock [list .mbar.branch entryconf \
2044 [.mbar.branch index last] -state]
2046 .mbar.branch add command -label [mc "Checkout..."] \
2047 -command branch_checkout::dialog \
2048 -accelerator $M1T-O
2049 lappend disable_on_lock [list .mbar.branch entryconf \
2050 [.mbar.branch index last] -state]
2052 .mbar.branch add command -label [mc "Rename..."] \
2053 -command branch_rename::dialog
2054 lappend disable_on_lock [list .mbar.branch entryconf \
2055 [.mbar.branch index last] -state]
2057 .mbar.branch add command -label [mc "Delete..."] \
2058 -command branch_delete::dialog
2059 lappend disable_on_lock [list .mbar.branch entryconf \
2060 [.mbar.branch index last] -state]
2062 .mbar.branch add command -label [mc "Reset..."] \
2063 -command merge::reset_hard
2064 lappend disable_on_lock [list .mbar.branch entryconf \
2065 [.mbar.branch index last] -state]
2068 # -- Commit Menu
2070 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2071 menu .mbar.commit
2073 .mbar.commit add radiobutton \
2074 -label [mc "New Commit"] \
2075 -command do_select_commit_type \
2076 -variable selected_commit_type \
2077 -value new
2078 lappend disable_on_lock \
2079 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2081 .mbar.commit add radiobutton \
2082 -label [mc "Amend Last Commit"] \
2083 -command do_select_commit_type \
2084 -variable selected_commit_type \
2085 -value amend
2086 lappend disable_on_lock \
2087 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2089 .mbar.commit add separator
2091 .mbar.commit add command -label [mc Rescan] \
2092 -command do_rescan \
2093 -accelerator F5
2094 lappend disable_on_lock \
2095 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2097 .mbar.commit add command -label [mc "Stage To Commit"] \
2098 -command do_add_selection \
2099 -accelerator $M1T-T
2100 lappend disable_on_lock \
2101 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2103 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2104 -command do_add_all \
2105 -accelerator $M1T-I
2106 lappend disable_on_lock \
2107 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2109 .mbar.commit add command -label [mc "Unstage From Commit"] \
2110 -command do_unstage_selection
2111 lappend disable_on_lock \
2112 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2114 .mbar.commit add command -label [mc "Revert Changes"] \
2115 -command do_revert_selection
2116 lappend disable_on_lock \
2117 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2119 .mbar.commit add separator
2121 .mbar.commit add command -label [mc "Show Less Context"] \
2122 -command show_less_context \
2123 -accelerator $M1T-\-
2125 .mbar.commit add command -label [mc "Show More Context"] \
2126 -command show_more_context \
2127 -accelerator $M1T-=
2129 .mbar.commit add separator
2131 .mbar.commit add command -label [mc "Sign Off"] \
2132 -command do_signoff \
2133 -accelerator $M1T-S
2135 .mbar.commit add command -label [mc Commit@@verb] \
2136 -command do_commit \
2137 -accelerator $M1T-Return
2138 lappend disable_on_lock \
2139 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2142 # -- Merge Menu
2144 if {[is_enabled branch]} {
2145 menu .mbar.merge
2146 .mbar.merge add command -label [mc "Local Merge..."] \
2147 -command merge::dialog \
2148 -accelerator $M1T-M
2149 lappend disable_on_lock \
2150 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2151 .mbar.merge add command -label [mc "Abort Merge..."] \
2152 -command merge::reset_hard
2153 lappend disable_on_lock \
2154 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2157 # -- Transport Menu
2159 if {[is_enabled transport]} {
2160 menu .mbar.remote
2162 .mbar.remote add command \
2163 -label [mc "Push..."] \
2164 -command do_push_anywhere \
2165 -accelerator $M1T-P
2166 .mbar.remote add command \
2167 -label [mc "Delete..."] \
2168 -command remote_branch_delete::dialog
2171 if {[is_MacOSX]} {
2172 # -- Apple Menu (Mac OS X only)
2174 .mbar add cascade -label Apple -menu .mbar.apple
2175 menu .mbar.apple
2177 .mbar.apple add command -label [mc "About %s" [appname]] \
2178 -command do_about
2179 .mbar.apple add separator
2180 .mbar.apple add command \
2181 -label [mc "Preferences..."] \
2182 -command do_options \
2183 -accelerator $M1T-,
2184 bind . <$M1B-,> do_options
2185 } else {
2186 # -- Edit Menu
2188 .mbar.edit add separator
2189 .mbar.edit add command -label [mc "Options..."] \
2190 -command do_options
2193 # -- Help Menu
2195 .mbar add cascade -label [mc Help] -menu .mbar.help
2196 menu .mbar.help
2198 if {![is_MacOSX]} {
2199 .mbar.help add command -label [mc "About %s" [appname]] \
2200 -command do_about
2203 set browser {}
2204 catch {set browser $repo_config(instaweb.browser)}
2205 set doc_path [file dirname [gitexec]]
2206 set doc_path [file join $doc_path Documentation index.html]
2208 if {[is_Cygwin]} {
2209 set doc_path [exec cygpath --mixed $doc_path]
2212 if {$browser eq {}} {
2213 if {[is_MacOSX]} {
2214 set browser open
2215 } elseif {[is_Cygwin]} {
2216 set program_files [file dirname [exec cygpath --windir]]
2217 set program_files [file join $program_files {Program Files}]
2218 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2219 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2220 if {[file exists $firefox]} {
2221 set browser $firefox
2222 } elseif {[file exists $ie]} {
2223 set browser $ie
2225 unset program_files firefox ie
2229 if {[file isfile $doc_path]} {
2230 set doc_url "file:$doc_path"
2231 } else {
2232 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2235 if {$browser ne {}} {
2236 .mbar.help add command -label [mc "Online Documentation"] \
2237 -command [list exec $browser $doc_url &]
2239 unset browser doc_path doc_url
2241 # -- Standard bindings
2243 wm protocol . WM_DELETE_WINDOW do_quit
2244 bind all <$M1B-Key-q> do_quit
2245 bind all <$M1B-Key-Q> do_quit
2246 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2247 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2249 set subcommand_args {}
2250 proc usage {} {
2251 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2252 exit 1
2255 # -- Not a normal commit type invocation? Do that instead!
2257 switch -- $subcommand {
2258 browser -
2259 blame {
2260 set subcommand_args {rev? path}
2261 if {$argv eq {}} usage
2262 set head {}
2263 set path {}
2264 set is_path 0
2265 foreach a $argv {
2266 if {$is_path || [file exists $_prefix$a]} {
2267 if {$path ne {}} usage
2268 set path $_prefix$a
2269 break
2270 } elseif {$a eq {--}} {
2271 if {$path ne {}} {
2272 if {$head ne {}} usage
2273 set head $path
2274 set path {}
2276 set is_path 1
2277 } elseif {$head eq {}} {
2278 if {$head ne {}} usage
2279 set head $a
2280 set is_path 1
2281 } else {
2282 usage
2285 unset is_path
2287 if {$head ne {} && $path eq {}} {
2288 set path $_prefix$head
2289 set head {}
2292 if {$head eq {}} {
2293 load_current_branch
2294 } else {
2295 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2296 if {[catch {
2297 set head [git rev-parse --verify $head]
2298 } err]} {
2299 puts stderr $err
2300 exit 1
2303 set current_branch $head
2306 switch -- $subcommand {
2307 browser {
2308 if {$head eq {}} {
2309 if {$path ne {} && [file isdirectory $path]} {
2310 set head $current_branch
2311 } else {
2312 set head $path
2313 set path {}
2316 browser::new $head $path
2318 blame {
2319 if {$head eq {} && ![file exists $path]} {
2320 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2321 exit 1
2323 blame::new $head $path
2326 return
2328 citool -
2329 gui {
2330 if {[llength $argv] != 0} {
2331 puts -nonewline stderr "usage: $argv0"
2332 if {$subcommand ne {gui}
2333 && [file tail $argv0] ne "git-$subcommand"} {
2334 puts -nonewline stderr " $subcommand"
2336 puts stderr {}
2337 exit 1
2339 # fall through to setup UI for commits
2341 default {
2342 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2343 exit 1
2347 # -- Branch Control
2349 frame .branch \
2350 -borderwidth 1 \
2351 -relief sunken
2352 label .branch.l1 \
2353 -text [mc "Current Branch:"] \
2354 -anchor w \
2355 -justify left
2356 label .branch.cb \
2357 -textvariable current_branch \
2358 -anchor w \
2359 -justify left
2360 pack .branch.l1 -side left
2361 pack .branch.cb -side left -fill x
2362 pack .branch -side top -fill x
2364 # -- Main Window Layout
2366 panedwindow .vpane -orient horizontal
2367 panedwindow .vpane.files -orient vertical
2368 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2369 pack .vpane -anchor n -side top -fill both -expand 1
2371 # -- Index File List
2373 frame .vpane.files.index -height 100 -width 200
2374 label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2375 -background lightgreen -foreground black
2376 text $ui_index -background white -foreground black \
2377 -borderwidth 0 \
2378 -width 20 -height 10 \
2379 -wrap none \
2380 -cursor $cursor_ptr \
2381 -xscrollcommand {.vpane.files.index.sx set} \
2382 -yscrollcommand {.vpane.files.index.sy set} \
2383 -state disabled
2384 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2385 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2386 pack .vpane.files.index.title -side top -fill x
2387 pack .vpane.files.index.sx -side bottom -fill x
2388 pack .vpane.files.index.sy -side right -fill y
2389 pack $ui_index -side left -fill both -expand 1
2391 # -- Working Directory File List
2393 frame .vpane.files.workdir -height 100 -width 200
2394 label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2395 -background lightsalmon -foreground black
2396 text $ui_workdir -background white -foreground black \
2397 -borderwidth 0 \
2398 -width 20 -height 10 \
2399 -wrap none \
2400 -cursor $cursor_ptr \
2401 -xscrollcommand {.vpane.files.workdir.sx set} \
2402 -yscrollcommand {.vpane.files.workdir.sy set} \
2403 -state disabled
2404 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2405 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2406 pack .vpane.files.workdir.title -side top -fill x
2407 pack .vpane.files.workdir.sx -side bottom -fill x
2408 pack .vpane.files.workdir.sy -side right -fill y
2409 pack $ui_workdir -side left -fill both -expand 1
2411 .vpane.files add .vpane.files.workdir -sticky nsew
2412 .vpane.files add .vpane.files.index -sticky nsew
2414 foreach i [list $ui_index $ui_workdir] {
2415 rmsel_tag $i
2416 $i tag conf in_diff -background [$i tag cget in_sel -background]
2418 unset i
2420 # -- Diff and Commit Area
2422 frame .vpane.lower -height 300 -width 400
2423 frame .vpane.lower.commarea
2424 frame .vpane.lower.diff -relief sunken -borderwidth 1
2425 pack .vpane.lower.diff -fill both -expand 1
2426 pack .vpane.lower.commarea -side bottom -fill x
2427 .vpane add .vpane.lower -sticky nsew
2429 # -- Commit Area Buttons
2431 frame .vpane.lower.commarea.buttons
2432 label .vpane.lower.commarea.buttons.l -text {} \
2433 -anchor w \
2434 -justify left
2435 pack .vpane.lower.commarea.buttons.l -side top -fill x
2436 pack .vpane.lower.commarea.buttons -side left -fill y
2438 button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2439 -command do_rescan
2440 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2441 lappend disable_on_lock \
2442 {.vpane.lower.commarea.buttons.rescan conf -state}
2444 button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2445 -command do_add_all
2446 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2447 lappend disable_on_lock \
2448 {.vpane.lower.commarea.buttons.incall conf -state}
2450 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2451 -command do_signoff
2452 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2454 button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
2455 -command do_commit
2456 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2457 lappend disable_on_lock \
2458 {.vpane.lower.commarea.buttons.commit conf -state}
2460 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2461 -command do_push_anywhere
2462 pack .vpane.lower.commarea.buttons.push -side top -fill x
2464 # -- Commit Message Buffer
2466 frame .vpane.lower.commarea.buffer
2467 frame .vpane.lower.commarea.buffer.header
2468 set ui_comm .vpane.lower.commarea.buffer.t
2469 set ui_coml .vpane.lower.commarea.buffer.header.l
2470 radiobutton .vpane.lower.commarea.buffer.header.new \
2471 -text [mc "New Commit"] \
2472 -command do_select_commit_type \
2473 -variable selected_commit_type \
2474 -value new
2475 lappend disable_on_lock \
2476 [list .vpane.lower.commarea.buffer.header.new conf -state]
2477 radiobutton .vpane.lower.commarea.buffer.header.amend \
2478 -text [mc "Amend Last Commit"] \
2479 -command do_select_commit_type \
2480 -variable selected_commit_type \
2481 -value amend
2482 lappend disable_on_lock \
2483 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2484 label $ui_coml \
2485 -anchor w \
2486 -justify left
2487 proc trace_commit_type {varname args} {
2488 global ui_coml commit_type
2489 switch -glob -- $commit_type {
2490 initial {set txt [mc "Initial Commit Message:"]}
2491 amend {set txt [mc "Amended Commit Message:"]}
2492 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2493 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2494 merge {set txt [mc "Merge Commit Message:"]}
2495 * {set txt [mc "Commit Message:"]}
2497 $ui_coml conf -text $txt
2499 trace add variable commit_type write trace_commit_type
2500 pack $ui_coml -side left -fill x
2501 pack .vpane.lower.commarea.buffer.header.amend -side right
2502 pack .vpane.lower.commarea.buffer.header.new -side right
2504 text $ui_comm -background white -foreground black \
2505 -borderwidth 1 \
2506 -undo true \
2507 -maxundo 20 \
2508 -autoseparators true \
2509 -relief sunken \
2510 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
2511 -font font_diff \
2512 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2513 scrollbar .vpane.lower.commarea.buffer.sby \
2514 -command [list $ui_comm yview]
2515 pack .vpane.lower.commarea.buffer.header -side top -fill x
2516 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2517 pack $ui_comm -side left -fill y
2518 pack .vpane.lower.commarea.buffer -side left -fill y
2520 # -- Commit Message Buffer Context Menu
2522 set ctxm .vpane.lower.commarea.buffer.ctxm
2523 menu $ctxm -tearoff 0
2524 $ctxm add command \
2525 -label [mc Cut] \
2526 -command {tk_textCut $ui_comm}
2527 $ctxm add command \
2528 -label [mc Copy] \
2529 -command {tk_textCopy $ui_comm}
2530 $ctxm add command \
2531 -label [mc Paste] \
2532 -command {tk_textPaste $ui_comm}
2533 $ctxm add command \
2534 -label [mc Delete] \
2535 -command {$ui_comm delete sel.first sel.last}
2536 $ctxm add separator
2537 $ctxm add command \
2538 -label [mc "Select All"] \
2539 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2540 $ctxm add command \
2541 -label [mc "Copy All"] \
2542 -command {
2543 $ui_comm tag add sel 0.0 end
2544 tk_textCopy $ui_comm
2545 $ui_comm tag remove sel 0.0 end
2547 $ctxm add separator
2548 $ctxm add command \
2549 -label [mc "Sign Off"] \
2550 -command do_signoff
2551 set ui_comm_ctxm $ctxm
2553 # -- Diff Header
2555 proc trace_current_diff_path {varname args} {
2556 global current_diff_path diff_actions file_states
2557 if {$current_diff_path eq {}} {
2558 set s {}
2559 set f {}
2560 set p {}
2561 set o disabled
2562 } else {
2563 set p $current_diff_path
2564 set s [mapdesc [lindex $file_states($p) 0] $p]
2565 set f [mc "File:"]
2566 set p [escape_path $p]
2567 set o normal
2570 .vpane.lower.diff.header.status configure -text $s
2571 .vpane.lower.diff.header.file configure -text $f
2572 .vpane.lower.diff.header.path configure -text $p
2573 foreach w $diff_actions {
2574 uplevel #0 $w $o
2577 trace add variable current_diff_path write trace_current_diff_path
2579 frame .vpane.lower.diff.header -background gold
2580 label .vpane.lower.diff.header.status \
2581 -background gold \
2582 -foreground black \
2583 -width $max_status_desc \
2584 -anchor w \
2585 -justify left
2586 label .vpane.lower.diff.header.file \
2587 -background gold \
2588 -foreground black \
2589 -anchor w \
2590 -justify left
2591 label .vpane.lower.diff.header.path \
2592 -background gold \
2593 -foreground black \
2594 -anchor w \
2595 -justify left
2596 pack .vpane.lower.diff.header.status -side left
2597 pack .vpane.lower.diff.header.file -side left
2598 pack .vpane.lower.diff.header.path -fill x
2599 set ctxm .vpane.lower.diff.header.ctxm
2600 menu $ctxm -tearoff 0
2601 $ctxm add command \
2602 -label [mc Copy] \
2603 -command {
2604 clipboard clear
2605 clipboard append \
2606 -format STRING \
2607 -type STRING \
2608 -- $current_diff_path
2610 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2611 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2613 # -- Diff Body
2615 frame .vpane.lower.diff.body
2616 set ui_diff .vpane.lower.diff.body.t
2617 text $ui_diff -background white -foreground black \
2618 -borderwidth 0 \
2619 -width 80 -height 15 -wrap none \
2620 -font font_diff \
2621 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2622 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2623 -state disabled
2624 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2625 -command [list $ui_diff xview]
2626 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2627 -command [list $ui_diff yview]
2628 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2629 pack .vpane.lower.diff.body.sby -side right -fill y
2630 pack $ui_diff -side left -fill both -expand 1
2631 pack .vpane.lower.diff.header -side top -fill x
2632 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2634 $ui_diff tag conf d_cr -elide true
2635 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2636 $ui_diff tag conf d_+ -foreground {#00a000}
2637 $ui_diff tag conf d_- -foreground red
2639 $ui_diff tag conf d_++ -foreground {#00a000}
2640 $ui_diff tag conf d_-- -foreground red
2641 $ui_diff tag conf d_+s \
2642 -foreground {#00a000} \
2643 -background {#e2effa}
2644 $ui_diff tag conf d_-s \
2645 -foreground red \
2646 -background {#e2effa}
2647 $ui_diff tag conf d_s+ \
2648 -foreground {#00a000} \
2649 -background ivory1
2650 $ui_diff tag conf d_s- \
2651 -foreground red \
2652 -background ivory1
2654 $ui_diff tag conf d<<<<<<< \
2655 -foreground orange \
2656 -font font_diffbold
2657 $ui_diff tag conf d======= \
2658 -foreground orange \
2659 -font font_diffbold
2660 $ui_diff tag conf d>>>>>>> \
2661 -foreground orange \
2662 -font font_diffbold
2664 $ui_diff tag raise sel
2666 # -- Diff Body Context Menu
2668 set ctxm .vpane.lower.diff.body.ctxm
2669 menu $ctxm -tearoff 0
2670 $ctxm add command \
2671 -label [mc "Apply/Reverse Hunk"] \
2672 -command {apply_hunk $cursorX $cursorY}
2673 set ui_diff_applyhunk [$ctxm index last]
2674 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2675 $ctxm add command \
2676 -label [mc "Apply/Reverse Line"] \
2677 -command {apply_line $cursorX $cursorY; do_rescan}
2678 set ui_diff_applyline [$ctxm index last]
2679 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
2680 $ctxm add separator
2681 $ctxm add command \
2682 -label [mc "Show Less Context"] \
2683 -command show_less_context
2684 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2685 $ctxm add command \
2686 -label [mc "Show More Context"] \
2687 -command show_more_context
2688 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2689 $ctxm add separator
2690 $ctxm add command \
2691 -label [mc Refresh] \
2692 -command reshow_diff
2693 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2694 $ctxm add command \
2695 -label [mc Copy] \
2696 -command {tk_textCopy $ui_diff}
2697 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2698 $ctxm add command \
2699 -label [mc "Select All"] \
2700 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2701 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2702 $ctxm add command \
2703 -label [mc "Copy All"] \
2704 -command {
2705 $ui_diff tag add sel 0.0 end
2706 tk_textCopy $ui_diff
2707 $ui_diff tag remove sel 0.0 end
2709 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2710 $ctxm add separator
2711 $ctxm add command \
2712 -label [mc "Decrease Font Size"] \
2713 -command {incr_font_size font_diff -1}
2714 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2715 $ctxm add command \
2716 -label [mc "Increase Font Size"] \
2717 -command {incr_font_size font_diff 1}
2718 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2719 $ctxm add separator
2720 $ctxm add command -label [mc "Options..."] \
2721 -command do_options
2722 proc popup_diff_menu {ctxm x y X Y} {
2723 global current_diff_path file_states
2724 set ::cursorX $x
2725 set ::cursorY $y
2726 if {$::ui_index eq $::current_diff_side} {
2727 set l [mc "Unstage Hunk From Commit"]
2728 set t [mc "Unstage Line From Commit"]
2729 } else {
2730 set l [mc "Stage Hunk For Commit"]
2731 set t [mc "Stage Line For Commit"]
2733 if {$::is_3way_diff
2734 || $current_diff_path eq {}
2735 || ![info exists file_states($current_diff_path)]
2736 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2737 set s disabled
2738 } else {
2739 set s normal
2741 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2742 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
2743 tk_popup $ctxm $X $Y
2745 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2747 # -- Status Bar
2749 set main_status [::status_bar::new .status]
2750 pack .status -anchor w -side bottom -fill x
2751 $main_status show [mc "Initializing..."]
2753 # -- Load geometry
2755 catch {
2756 set gm $repo_config(gui.geometry)
2757 wm geometry . [lindex $gm 0]
2758 .vpane sash place 0 \
2759 [lindex $gm 1] \
2760 [lindex [.vpane sash coord 0] 1]
2761 .vpane.files sash place 0 \
2762 [lindex [.vpane.files sash coord 0] 0] \
2763 [lindex $gm 2]
2764 unset gm
2767 # -- Key Bindings
2769 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2770 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
2771 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
2772 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2773 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2774 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2775 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2776 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2777 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2778 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2779 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2780 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2781 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2782 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
2783 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
2784 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
2785 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
2786 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
2788 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2789 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2790 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2791 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2792 bind $ui_diff <$M1B-Key-v> {break}
2793 bind $ui_diff <$M1B-Key-V> {break}
2794 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2795 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2796 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2797 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2798 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2799 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2800 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2801 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2802 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2803 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2804 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2805 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2806 bind $ui_diff <Button-1> {focus %W}
2808 if {[is_enabled branch]} {
2809 bind . <$M1B-Key-n> branch_create::dialog
2810 bind . <$M1B-Key-N> branch_create::dialog
2811 bind . <$M1B-Key-o> branch_checkout::dialog
2812 bind . <$M1B-Key-O> branch_checkout::dialog
2813 bind . <$M1B-Key-m> merge::dialog
2814 bind . <$M1B-Key-M> merge::dialog
2816 if {[is_enabled transport]} {
2817 bind . <$M1B-Key-p> do_push_anywhere
2818 bind . <$M1B-Key-P> do_push_anywhere
2821 bind . <Key-F5> do_rescan
2822 bind . <$M1B-Key-r> do_rescan
2823 bind . <$M1B-Key-R> do_rescan
2824 bind . <$M1B-Key-s> do_signoff
2825 bind . <$M1B-Key-S> do_signoff
2826 bind . <$M1B-Key-t> do_add_selection
2827 bind . <$M1B-Key-T> do_add_selection
2828 bind . <$M1B-Key-i> do_add_all
2829 bind . <$M1B-Key-I> do_add_all
2830 bind . <$M1B-Key-minus> {show_less_context;break}
2831 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
2832 bind . <$M1B-Key-equal> {show_more_context;break}
2833 bind . <$M1B-Key-plus> {show_more_context;break}
2834 bind . <$M1B-Key-KP_Add> {show_more_context;break}
2835 bind . <$M1B-Key-Return> do_commit
2836 foreach i [list $ui_index $ui_workdir] {
2837 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2838 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2839 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2841 unset i
2843 set file_lists($ui_index) [list]
2844 set file_lists($ui_workdir) [list]
2846 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2847 focus -force $ui_comm
2849 # -- Warn the user about environmental problems. Cygwin's Tcl
2850 # does *not* pass its env array onto any processes it spawns.
2851 # This means that git processes get none of our environment.
2853 if {[is_Cygwin]} {
2854 set ignored_env 0
2855 set suggest_user {}
2856 set msg [mc "Possible environment issues exist.
2858 The following environment variables are probably
2859 going to be ignored by any Git subprocess run
2860 by %s:
2862 " [appname]]
2863 foreach name [array names env] {
2864 switch -regexp -- $name {
2865 {^GIT_INDEX_FILE$} -
2866 {^GIT_OBJECT_DIRECTORY$} -
2867 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2868 {^GIT_DIFF_OPTS$} -
2869 {^GIT_EXTERNAL_DIFF$} -
2870 {^GIT_PAGER$} -
2871 {^GIT_TRACE$} -
2872 {^GIT_CONFIG$} -
2873 {^GIT_CONFIG_LOCAL$} -
2874 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2875 append msg " - $name\n"
2876 incr ignored_env
2878 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2879 append msg " - $name\n"
2880 incr ignored_env
2881 set suggest_user $name
2885 if {$ignored_env > 0} {
2886 append msg [mc "
2887 This is due to a known issue with the
2888 Tcl binary distributed by Cygwin."]
2890 if {$suggest_user ne {}} {
2891 append msg [mc "
2893 A good replacement for %s
2894 is placing values for the user.name and
2895 user.email settings into your personal
2896 ~/.gitconfig file.
2897 " $suggest_user]
2899 warn_popup $msg
2901 unset ignored_env msg suggest_user name
2904 # -- Only initialize complex UI if we are going to stay running.
2906 if {[is_enabled transport]} {
2907 load_all_remotes
2909 set n [.mbar.remote index end]
2910 populate_push_menu
2911 populate_fetch_menu
2912 set n [expr {[.mbar.remote index end] - $n}]
2913 if {$n > 0} {
2914 .mbar.remote insert $n separator
2916 unset n
2919 if {[winfo exists $ui_comm]} {
2920 set GITGUI_BCK_exists [load_message GITGUI_BCK]
2922 # -- If both our backup and message files exist use the
2923 # newer of the two files to initialize the buffer.
2925 if {$GITGUI_BCK_exists} {
2926 set m [gitdir GITGUI_MSG]
2927 if {[file isfile $m]} {
2928 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2929 catch {file delete [gitdir GITGUI_MSG]}
2930 } else {
2931 $ui_comm delete 0.0 end
2932 $ui_comm edit reset
2933 $ui_comm edit modified false
2934 catch {file delete [gitdir GITGUI_BCK]}
2935 set GITGUI_BCK_exists 0
2938 unset m
2941 proc backup_commit_buffer {} {
2942 global ui_comm GITGUI_BCK_exists
2944 set m [$ui_comm edit modified]
2945 if {$m || $GITGUI_BCK_exists} {
2946 set msg [string trim [$ui_comm get 0.0 end]]
2947 regsub -all -line {[ \r\t]+$} $msg {} msg
2949 if {$msg eq {}} {
2950 if {$GITGUI_BCK_exists} {
2951 catch {file delete [gitdir GITGUI_BCK]}
2952 set GITGUI_BCK_exists 0
2954 } elseif {$m} {
2955 catch {
2956 set fd [open [gitdir GITGUI_BCK] w]
2957 puts -nonewline $fd $msg
2958 close $fd
2959 set GITGUI_BCK_exists 1
2963 $ui_comm edit modified false
2966 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2969 backup_commit_buffer
2971 # -- If the user has aspell available we can drive it
2972 # in pipe mode to spellcheck the commit message.
2974 set spell_cmd [list |]
2975 set spell_dict [get_config gui.spellingdictionary]
2976 lappend spell_cmd aspell
2977 if {$spell_dict ne {}} {
2978 lappend spell_cmd --master=$spell_dict
2980 lappend spell_cmd --mode=none
2981 lappend spell_cmd --encoding=utf-8
2982 lappend spell_cmd pipe
2983 if {$spell_dict eq {none}
2984 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
2985 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
2986 } else {
2987 set ui_comm_spell [spellcheck::init \
2988 $spell_fd \
2989 $ui_comm \
2990 $ui_comm_ctxm \
2993 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
2996 lock_index begin-read
2997 if {![winfo ismapped .]} {
2998 wm deiconify .
3000 after 1 do_rescan
3001 if {[is_enabled multicommit]} {
3002 after 1000 hint_gc