git-gui: Support starting gitk from Gui Blame
[alt-git.git] / git-gui.sh
blobb0207ac36a7c905b909e764df9741b2d12432b96
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 || test "z$*" = z--version; \
5 then \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
7 exit; \
8 fi; \
9 argv0=$0; \
10 exec wish "$argv0" -- "$@"
12 set appvers {@@GITGUI_VERSION@@}
13 set copyright [encoding convertfrom utf-8 {
14 Copyright © 2006, 2007 Shawn Pearce, et. al.
16 This program is free software; you can redistribute it and/or modify
17 it under the terms of the GNU General Public License as published by
18 the Free Software Foundation; either version 2 of the License, or
19 (at your option) any later version.
21 This program is distributed in the hope that it will be useful,
22 but WITHOUT ANY WARRANTY; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License for more details.
26 You should have received a copy of the GNU General Public License
27 along with this program; if not, write to the Free Software
28 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}]
30 ######################################################################
32 ## Tcl/Tk sanity check
34 if {[catch {package require Tcl 8.4} err]
35 || [catch {package require Tk 8.4} err]
36 } {
37 catch {wm withdraw .}
38 tk_messageBox \
39 -icon error \
40 -type ok \
41 -title [mc "git-gui: fatal error"] \
42 -message $err
43 exit 1
46 catch {rename send {}} ; # What an evil concept...
48 ######################################################################
50 ## locate our library
52 set oguilib {@@GITGUI_LIBDIR@@}
53 set oguirel {@@GITGUI_RELATIVE@@}
54 if {$oguirel eq {1}} {
55 set oguilib [file dirname [file normalize $argv0]]
56 if {[file tail $oguilib] eq {git-core}} {
57 set oguilib [file dirname $oguilib]
59 set oguilib [file dirname $oguilib]
60 set oguilib [file join $oguilib share git-gui lib]
61 set oguimsg [file join $oguilib msgs]
62 } elseif {[string match @@* $oguirel]} {
63 set oguilib [file join [file dirname [file normalize $argv0]] lib]
64 set oguimsg [file join [file dirname [file normalize $argv0]] po]
65 } else {
66 set oguimsg [file join $oguilib msgs]
68 unset oguirel
70 ######################################################################
72 ## enable verbose loading?
74 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
75 unset _verbose
76 rename auto_load real__auto_load
77 proc auto_load {name args} {
78 puts stderr "auto_load $name"
79 return [uplevel 1 real__auto_load $name $args]
81 rename source real__source
82 proc source {name} {
83 puts stderr "source $name"
84 uplevel 1 real__source $name
88 ######################################################################
90 ## Internationalization (i18n) through msgcat and gettext. See
91 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93 package require msgcat
95 proc _mc_trim {fmt} {
96 set cmk [string first @@ $fmt]
97 if {$cmk > 0} {
98 return [string range $fmt 0 [expr {$cmk - 1}]]
100 return $fmt
103 proc mc {en_fmt args} {
104 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
105 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
106 set msg [eval [list format [_mc_trim $en_fmt]] $args]
108 return $msg
111 proc strcat {args} {
112 return [join $args {}]
115 ::msgcat::mcload $oguimsg
116 unset oguimsg
118 ######################################################################
120 ## read only globals
122 set _appname {Git Gui}
123 set _gitdir {}
124 set _gitexec {}
125 set _reponame {}
126 set _iscygwin {}
127 set _search_path {}
129 set _trace [lsearch -exact $argv --trace]
130 if {$_trace >= 0} {
131 set argv [lreplace $argv $_trace $_trace]
132 set _trace 1
133 } else {
134 set _trace 0
137 proc appname {} {
138 global _appname
139 return $_appname
142 proc gitdir {args} {
143 global _gitdir
144 if {$args eq {}} {
145 return $_gitdir
147 return [eval [list file join $_gitdir] $args]
150 proc gitexec {args} {
151 global _gitexec
152 if {$_gitexec eq {}} {
153 if {[catch {set _gitexec [git --exec-path]} err]} {
154 error "Git not installed?\n\n$err"
156 if {[is_Cygwin]} {
157 set _gitexec [exec cygpath \
158 --windows \
159 --absolute \
160 $_gitexec]
161 } else {
162 set _gitexec [file normalize $_gitexec]
165 if {$args eq {}} {
166 return $_gitexec
168 return [eval [list file join $_gitexec] $args]
171 proc reponame {} {
172 return $::_reponame
175 proc is_MacOSX {} {
176 if {[tk windowingsystem] eq {aqua}} {
177 return 1
179 return 0
182 proc is_Windows {} {
183 if {$::tcl_platform(platform) eq {windows}} {
184 return 1
186 return 0
189 proc is_Cygwin {} {
190 global _iscygwin
191 if {$_iscygwin eq {}} {
192 if {$::tcl_platform(platform) eq {windows}} {
193 if {[catch {set p [exec cygpath --windir]} err]} {
194 set _iscygwin 0
195 } else {
196 set _iscygwin 1
198 } else {
199 set _iscygwin 0
202 return $_iscygwin
205 proc is_enabled {option} {
206 global enabled_options
207 if {[catch {set on $enabled_options($option)}]} {return 0}
208 return $on
211 proc enable_option {option} {
212 global enabled_options
213 set enabled_options($option) 1
216 proc disable_option {option} {
217 global enabled_options
218 set enabled_options($option) 0
221 ######################################################################
223 ## config
225 proc is_many_config {name} {
226 switch -glob -- $name {
227 gui.recentrepo -
228 remote.*.fetch -
229 remote.*.push
230 {return 1}
232 {return 0}
236 proc is_config_true {name} {
237 global repo_config
238 if {[catch {set v $repo_config($name)}]} {
239 return 0
240 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
241 return 1
242 } else {
243 return 0
247 proc get_config {name} {
248 global repo_config
249 if {[catch {set v $repo_config($name)}]} {
250 return {}
251 } else {
252 return $v
256 ######################################################################
258 ## handy utils
260 proc _trace_exec {cmd} {
261 if {!$::_trace} return
262 set d {}
263 foreach v $cmd {
264 if {$d ne {}} {
265 append d { }
267 if {[regexp {[ \t\r\n'"$?*]} $v]} {
268 set v [sq $v]
270 append d $v
272 puts stderr $d
275 proc _git_cmd {name} {
276 global _git_cmd_path
278 if {[catch {set v $_git_cmd_path($name)}]} {
279 switch -- $name {
280 version -
281 --version -
282 --exec-path { return [list $::_git $name] }
285 set p [gitexec git-$name$::_search_exe]
286 if {[file exists $p]} {
287 set v [list $p]
288 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
289 # Try to determine what sort of magic will make
290 # git-$name go and do its thing, because native
291 # Tcl on Windows doesn't know it.
293 set p [gitexec git-$name]
294 set f [open $p r]
295 set s [gets $f]
296 close $f
298 switch -glob -- [lindex $s 0] {
299 #!*sh { set i sh }
300 #!*perl { set i perl }
301 #!*python { set i python }
302 default { error "git-$name is not supported: $s" }
305 upvar #0 _$i interp
306 if {![info exists interp]} {
307 set interp [_which $i]
309 if {$interp eq {}} {
310 error "git-$name requires $i (not in PATH)"
312 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
313 } else {
314 # Assume it is builtin to git somehow and we
315 # aren't actually able to see a file for it.
317 set v [list $::_git $name]
319 set _git_cmd_path($name) $v
321 return $v
324 proc _which {what args} {
325 global env _search_exe _search_path
327 if {$_search_path eq {}} {
328 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
329 set _search_path [split [exec cygpath \
330 --windows \
331 --path \
332 --absolute \
333 $env(PATH)] {;}]
334 set _search_exe .exe
335 } elseif {[is_Windows]} {
336 set gitguidir [file dirname [info script]]
337 regsub -all ";" $gitguidir "\\;" gitguidir
338 set env(PATH) "$gitguidir;$env(PATH)"
339 set _search_path [split $env(PATH) {;}]
340 set _search_exe .exe
341 } else {
342 set _search_path [split $env(PATH) :]
343 set _search_exe {}
347 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
348 set suffix {}
349 } else {
350 set suffix $_search_exe
353 foreach p $_search_path {
354 set p [file join $p $what$suffix]
355 if {[file exists $p]} {
356 return [file normalize $p]
359 return {}
362 proc _lappend_nice {cmd_var} {
363 global _nice
364 upvar $cmd_var cmd
366 if {![info exists _nice]} {
367 set _nice [_which nice]
369 if {$_nice ne {}} {
370 lappend cmd $_nice
374 proc git {args} {
375 set opt [list]
377 while {1} {
378 switch -- [lindex $args 0] {
379 --nice {
380 _lappend_nice opt
383 default {
384 break
389 set args [lrange $args 1 end]
392 set cmdp [_git_cmd [lindex $args 0]]
393 set args [lrange $args 1 end]
395 _trace_exec [concat $opt $cmdp $args]
396 set result [eval exec $opt $cmdp $args]
397 if {$::_trace} {
398 puts stderr "< $result"
400 return $result
403 proc _open_stdout_stderr {cmd} {
404 _trace_exec $cmd
405 if {[catch {
406 set fd [open [concat [list | ] $cmd] r]
407 } err]} {
408 if { [lindex $cmd end] eq {2>@1}
409 && $err eq {can not find channel named "1"}
411 # Older versions of Tcl 8.4 don't have this 2>@1 IO
412 # redirect operator. Fallback to |& cat for those.
413 # The command was not actually started, so its safe
414 # to try to start it a second time.
416 set fd [open [concat \
417 [list | ] \
418 [lrange $cmd 0 end-1] \
419 [list |& cat] \
420 ] r]
421 } else {
422 error $err
425 fconfigure $fd -eofchar {}
426 return $fd
429 proc git_read {args} {
430 set opt [list]
432 while {1} {
433 switch -- [lindex $args 0] {
434 --nice {
435 _lappend_nice opt
438 --stderr {
439 lappend args 2>@1
442 default {
443 break
448 set args [lrange $args 1 end]
451 set cmdp [_git_cmd [lindex $args 0]]
452 set args [lrange $args 1 end]
454 return [_open_stdout_stderr [concat $opt $cmdp $args]]
457 proc git_write {args} {
458 set opt [list]
460 while {1} {
461 switch -- [lindex $args 0] {
462 --nice {
463 _lappend_nice opt
466 default {
467 break
472 set args [lrange $args 1 end]
475 set cmdp [_git_cmd [lindex $args 0]]
476 set args [lrange $args 1 end]
478 _trace_exec [concat $opt $cmdp $args]
479 return [open [concat [list | ] $opt $cmdp $args] w]
482 proc githook_read {hook_name args} {
483 set pchook [gitdir hooks $hook_name]
484 lappend args 2>@1
486 # On Windows [file executable] might lie so we need to ask
487 # the shell if the hook is executable. Yes that's annoying.
489 if {[is_Windows]} {
490 upvar #0 _sh interp
491 if {![info exists interp]} {
492 set interp [_which sh]
494 if {$interp eq {}} {
495 error "hook execution requires sh (not in PATH)"
498 set scr {if test -x "$1";then exec "$@";fi}
499 set sh_c [list $interp -c $scr $interp $pchook]
500 return [_open_stdout_stderr [concat $sh_c $args]]
503 if {[file executable $pchook]} {
504 return [_open_stdout_stderr [concat [list $pchook] $args]]
507 return {}
510 proc kill_file_process {fd} {
511 set process [pid $fd]
513 catch {
514 if {[is_Windows]} {
515 # Use a Cygwin-specific flag to allow killing
516 # native Windows processes
517 exec kill -f $process
518 } else {
519 exec kill $process
524 proc sq {value} {
525 regsub -all ' $value "'\\''" value
526 return "'$value'"
529 proc load_current_branch {} {
530 global current_branch is_detached
532 set fd [open [gitdir HEAD] r]
533 if {[gets $fd ref] < 1} {
534 set ref {}
536 close $fd
538 set pfx {ref: refs/heads/}
539 set len [string length $pfx]
540 if {[string equal -length $len $pfx $ref]} {
541 # We're on a branch. It might not exist. But
542 # HEAD looks good enough to be a branch.
544 set current_branch [string range $ref $len end]
545 set is_detached 0
546 } else {
547 # Assume this is a detached head.
549 set current_branch HEAD
550 set is_detached 1
554 auto_load tk_optionMenu
555 rename tk_optionMenu real__tkOptionMenu
556 proc tk_optionMenu {w varName args} {
557 set m [eval real__tkOptionMenu $w $varName $args]
558 $m configure -font font_ui
559 $w configure -font font_ui
560 return $m
563 proc rmsel_tag {text} {
564 $text tag conf sel \
565 -background [$text cget -background] \
566 -foreground [$text cget -foreground] \
567 -borderwidth 0
568 $text tag conf in_sel -background lightgray
569 bind $text <Motion> break
570 return $text
573 set root_exists 0
574 bind . <Visibility> {
575 bind . <Visibility> {}
576 set root_exists 1
579 if {[is_Windows]} {
580 wm iconbitmap . -default $oguilib/git-gui.ico
583 ######################################################################
585 ## config defaults
587 set cursor_ptr arrow
588 font create font_diff -family Courier -size 10
589 font create font_ui
590 catch {
591 label .dummy
592 eval font configure font_ui [font actual [.dummy cget -font]]
593 destroy .dummy
596 font create font_uiitalic
597 font create font_uibold
598 font create font_diffbold
599 font create font_diffitalic
601 foreach class {Button Checkbutton Entry Label
602 Labelframe Listbox Menu Message
603 Radiobutton Spinbox Text} {
604 option add *$class.font font_ui
606 unset class
608 if {[is_Windows] || [is_MacOSX]} {
609 option add *Menu.tearOff 0
612 if {[is_MacOSX]} {
613 set M1B M1
614 set M1T Cmd
615 } else {
616 set M1B Control
617 set M1T Ctrl
620 proc bind_button3 {w cmd} {
621 bind $w <Any-Button-3> $cmd
622 if {[is_MacOSX]} {
623 # Mac OS X sends Button-2 on right click through three-button mouse,
624 # or through trackpad right-clicking (two-finger touch + click).
625 bind $w <Any-Button-2> $cmd
626 bind $w <Control-Button-1> $cmd
630 proc apply_config {} {
631 global repo_config font_descs
633 foreach option $font_descs {
634 set name [lindex $option 0]
635 set font [lindex $option 1]
636 if {[catch {
637 set need_weight 1
638 foreach {cn cv} $repo_config(gui.$name) {
639 if {$cn eq {-weight}} {
640 set need_weight 0
642 font configure $font $cn $cv
644 if {$need_weight} {
645 font configure $font -weight normal
647 } err]} {
648 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
650 foreach {cn cv} [font configure $font] {
651 font configure ${font}bold $cn $cv
652 font configure ${font}italic $cn $cv
654 font configure ${font}bold -weight bold
655 font configure ${font}italic -slant italic
659 set default_config(branch.autosetupmerge) true
660 set default_config(merge.diffstat) true
661 set default_config(merge.summary) false
662 set default_config(merge.verbosity) 2
663 set default_config(user.name) {}
664 set default_config(user.email) {}
666 set default_config(gui.matchtrackingbranch) false
667 set default_config(gui.pruneduringfetch) false
668 set default_config(gui.trustmtime) false
669 set default_config(gui.fastcopyblame) false
670 set default_config(gui.copyblamethreshold) 40
671 set default_config(gui.blamehistoryctx) 7
672 set default_config(gui.diffcontext) 5
673 set default_config(gui.commitmsgwidth) 75
674 set default_config(gui.newbranchtemplate) {}
675 set default_config(gui.spellingdictionary) {}
676 set default_config(gui.fontui) [font configure font_ui]
677 set default_config(gui.fontdiff) [font configure font_diff]
678 set font_descs {
679 {fontui font_ui {mc "Main Font"}}
680 {fontdiff font_diff {mc "Diff/Console Font"}}
683 ######################################################################
685 ## find git
687 set _git [_which git]
688 if {$_git eq {}} {
689 catch {wm withdraw .}
690 tk_messageBox \
691 -icon error \
692 -type ok \
693 -title [mc "git-gui: fatal error"] \
694 -message [mc "Cannot find git in PATH."]
695 exit 1
698 ######################################################################
700 ## version check
702 if {[catch {set _git_version [git --version]} err]} {
703 catch {wm withdraw .}
704 tk_messageBox \
705 -icon error \
706 -type ok \
707 -title [mc "git-gui: fatal error"] \
708 -message "Cannot determine Git version:
710 $err
712 [appname] requires Git 1.5.0 or later."
713 exit 1
715 if {![regsub {^git version } $_git_version {} _git_version]} {
716 catch {wm withdraw .}
717 tk_messageBox \
718 -icon error \
719 -type ok \
720 -title [mc "git-gui: fatal error"] \
721 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
722 exit 1
725 set _real_git_version $_git_version
726 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
727 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
728 regsub {\.rc[0-9]+$} $_git_version {} _git_version
729 regsub {\.GIT$} $_git_version {} _git_version
730 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
732 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
733 catch {wm withdraw .}
734 if {[tk_messageBox \
735 -icon warning \
736 -type yesno \
737 -default no \
738 -title "[appname]: warning" \
739 -message [mc "Git version cannot be determined.
741 %s claims it is version '%s'.
743 %s requires at least Git 1.5.0 or later.
745 Assume '%s' is version 1.5.0?
746 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
747 set _git_version 1.5.0
748 } else {
749 exit 1
752 unset _real_git_version
754 proc git-version {args} {
755 global _git_version
757 switch [llength $args] {
759 return $_git_version
763 set op [lindex $args 0]
764 set vr [lindex $args 1]
765 set cm [package vcompare $_git_version $vr]
766 return [expr $cm $op 0]
770 set type [lindex $args 0]
771 set name [lindex $args 1]
772 set parm [lindex $args 2]
773 set body [lindex $args 3]
775 if {($type ne {proc} && $type ne {method})} {
776 error "Invalid arguments to git-version"
778 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
779 error "Last arm of $type $name must be default"
782 foreach {op vr cb} [lrange $body 0 end-2] {
783 if {[git-version $op $vr]} {
784 return [uplevel [list $type $name $parm $cb]]
788 return [uplevel [list $type $name $parm [lindex $body end]]]
791 default {
792 error "git-version >= x"
798 if {[git-version < 1.5]} {
799 catch {wm withdraw .}
800 tk_messageBox \
801 -icon error \
802 -type ok \
803 -title [mc "git-gui: fatal error"] \
804 -message "[appname] requires Git 1.5.0 or later.
806 You are using [git-version]:
808 [git --version]"
809 exit 1
812 ######################################################################
814 ## configure our library
816 set idx [file join $oguilib tclIndex]
817 if {[catch {set fd [open $idx r]} err]} {
818 catch {wm withdraw .}
819 tk_messageBox \
820 -icon error \
821 -type ok \
822 -title [mc "git-gui: fatal error"] \
823 -message $err
824 exit 1
826 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
827 set idx [list]
828 while {[gets $fd n] >= 0} {
829 if {$n ne {} && ![string match #* $n]} {
830 lappend idx $n
833 } else {
834 set idx {}
836 close $fd
838 if {$idx ne {}} {
839 set loaded [list]
840 foreach p $idx {
841 if {[lsearch -exact $loaded $p] >= 0} continue
842 source [file join $oguilib $p]
843 lappend loaded $p
845 unset loaded p
846 } else {
847 set auto_path [concat [list $oguilib] $auto_path]
849 unset -nocomplain idx fd
851 ######################################################################
853 ## config file parsing
855 git-version proc _parse_config {arr_name args} {
856 >= 1.5.3 {
857 upvar $arr_name arr
858 array unset arr
859 set buf {}
860 catch {
861 set fd_rc [eval \
862 [list git_read config] \
863 $args \
864 [list --null --list]]
865 fconfigure $fd_rc -translation binary
866 set buf [read $fd_rc]
867 close $fd_rc
869 foreach line [split $buf "\0"] {
870 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
871 if {[is_many_config $name]} {
872 lappend arr($name) $value
873 } else {
874 set arr($name) $value
879 default {
880 upvar $arr_name arr
881 array unset arr
882 catch {
883 set fd_rc [eval [list git_read config --list] $args]
884 while {[gets $fd_rc line] >= 0} {
885 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
886 if {[is_many_config $name]} {
887 lappend arr($name) $value
888 } else {
889 set arr($name) $value
893 close $fd_rc
898 proc load_config {include_global} {
899 global repo_config global_config default_config
901 if {$include_global} {
902 _parse_config global_config --global
904 _parse_config repo_config
906 foreach name [array names default_config] {
907 if {[catch {set v $global_config($name)}]} {
908 set global_config($name) $default_config($name)
910 if {[catch {set v $repo_config($name)}]} {
911 set repo_config($name) $default_config($name)
916 ######################################################################
918 ## feature option selection
920 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
921 unset _junk
922 } else {
923 set subcommand gui
925 if {$subcommand eq {gui.sh}} {
926 set subcommand gui
928 if {$subcommand eq {gui} && [llength $argv] > 0} {
929 set subcommand [lindex $argv 0]
930 set argv [lrange $argv 1 end]
933 enable_option multicommit
934 enable_option branch
935 enable_option transport
936 disable_option bare
938 switch -- $subcommand {
939 browser -
940 blame {
941 enable_option bare
943 disable_option multicommit
944 disable_option branch
945 disable_option transport
947 citool {
948 enable_option singlecommit
950 disable_option multicommit
951 disable_option branch
952 disable_option transport
956 ######################################################################
958 ## repository setup
960 if {[catch {
961 set _gitdir $env(GIT_DIR)
962 set _prefix {}
964 && [catch {
965 set _gitdir [git rev-parse --git-dir]
966 set _prefix [git rev-parse --show-prefix]
967 } err]} {
968 load_config 1
969 apply_config
970 choose_repository::pick
972 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
973 catch {set _gitdir [exec cygpath --windows $_gitdir]}
975 if {![file isdirectory $_gitdir]} {
976 catch {wm withdraw .}
977 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
978 exit 1
980 if {$_prefix ne {}} {
981 regsub -all {[^/]+/} $_prefix ../ cdup
982 if {[catch {cd $cdup} err]} {
983 catch {wm withdraw .}
984 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
985 exit 1
987 unset cdup
988 } elseif {![is_enabled bare]} {
989 if {[lindex [file split $_gitdir] end] ne {.git}} {
990 catch {wm withdraw .}
991 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
992 exit 1
994 if {[catch {cd [file dirname $_gitdir]} err]} {
995 catch {wm withdraw .}
996 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
997 exit 1
1000 set _reponame [file split [file normalize $_gitdir]]
1001 if {[lindex $_reponame end] eq {.git}} {
1002 set _reponame [lindex $_reponame end-1]
1003 } else {
1004 set _reponame [lindex $_reponame end]
1007 ######################################################################
1009 ## global init
1011 set current_diff_path {}
1012 set current_diff_side {}
1013 set diff_actions [list]
1015 set HEAD {}
1016 set PARENT {}
1017 set MERGE_HEAD [list]
1018 set commit_type {}
1019 set empty_tree {}
1020 set current_branch {}
1021 set is_detached 0
1022 set current_diff_path {}
1023 set is_3way_diff 0
1024 set selected_commit_type new
1026 ######################################################################
1028 ## task management
1030 set rescan_active 0
1031 set diff_active 0
1032 set last_clicked {}
1034 set disable_on_lock [list]
1035 set index_lock_type none
1037 proc lock_index {type} {
1038 global index_lock_type disable_on_lock
1040 if {$index_lock_type eq {none}} {
1041 set index_lock_type $type
1042 foreach w $disable_on_lock {
1043 uplevel #0 $w disabled
1045 return 1
1046 } elseif {$index_lock_type eq "begin-$type"} {
1047 set index_lock_type $type
1048 return 1
1050 return 0
1053 proc unlock_index {} {
1054 global index_lock_type disable_on_lock
1056 set index_lock_type none
1057 foreach w $disable_on_lock {
1058 uplevel #0 $w normal
1062 ######################################################################
1064 ## status
1066 proc repository_state {ctvar hdvar mhvar} {
1067 global current_branch
1068 upvar $ctvar ct $hdvar hd $mhvar mh
1070 set mh [list]
1072 load_current_branch
1073 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1074 set hd {}
1075 set ct initial
1076 return
1079 set merge_head [gitdir MERGE_HEAD]
1080 if {[file exists $merge_head]} {
1081 set ct merge
1082 set fd_mh [open $merge_head r]
1083 while {[gets $fd_mh line] >= 0} {
1084 lappend mh $line
1086 close $fd_mh
1087 return
1090 set ct normal
1093 proc PARENT {} {
1094 global PARENT empty_tree
1096 set p [lindex $PARENT 0]
1097 if {$p ne {}} {
1098 return $p
1100 if {$empty_tree eq {}} {
1101 set empty_tree [git mktree << {}]
1103 return $empty_tree
1106 proc rescan {after {honor_trustmtime 1}} {
1107 global HEAD PARENT MERGE_HEAD commit_type
1108 global ui_index ui_workdir ui_comm
1109 global rescan_active file_states
1110 global repo_config
1112 if {$rescan_active > 0 || ![lock_index read]} return
1114 repository_state newType newHEAD newMERGE_HEAD
1115 if {[string match amend* $commit_type]
1116 && $newType eq {normal}
1117 && $newHEAD eq $HEAD} {
1118 } else {
1119 set HEAD $newHEAD
1120 set PARENT $newHEAD
1121 set MERGE_HEAD $newMERGE_HEAD
1122 set commit_type $newType
1125 array unset file_states
1127 if {!$::GITGUI_BCK_exists &&
1128 (![$ui_comm edit modified]
1129 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1130 if {[string match amend* $commit_type]} {
1131 } elseif {[load_message GITGUI_MSG]} {
1132 } elseif {[load_message MERGE_MSG]} {
1133 } elseif {[load_message SQUASH_MSG]} {
1135 $ui_comm edit reset
1136 $ui_comm edit modified false
1139 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1140 rescan_stage2 {} $after
1141 } else {
1142 set rescan_active 1
1143 ui_status [mc "Refreshing file status..."]
1144 set fd_rf [git_read update-index \
1145 -q \
1146 --unmerged \
1147 --ignore-missing \
1148 --refresh \
1150 fconfigure $fd_rf -blocking 0 -translation binary
1151 fileevent $fd_rf readable \
1152 [list rescan_stage2 $fd_rf $after]
1156 if {[is_Cygwin]} {
1157 set is_git_info_exclude {}
1158 proc have_info_exclude {} {
1159 global is_git_info_exclude
1161 if {$is_git_info_exclude eq {}} {
1162 if {[catch {exec test -f [gitdir info exclude]}]} {
1163 set is_git_info_exclude 0
1164 } else {
1165 set is_git_info_exclude 1
1168 return $is_git_info_exclude
1170 } else {
1171 proc have_info_exclude {} {
1172 return [file readable [gitdir info exclude]]
1176 proc rescan_stage2 {fd after} {
1177 global rescan_active buf_rdi buf_rdf buf_rlo
1179 if {$fd ne {}} {
1180 read $fd
1181 if {![eof $fd]} return
1182 close $fd
1185 set ls_others [list --exclude-per-directory=.gitignore]
1186 if {[have_info_exclude]} {
1187 lappend ls_others "--exclude-from=[gitdir info exclude]"
1189 set user_exclude [get_config core.excludesfile]
1190 if {$user_exclude ne {} && [file readable $user_exclude]} {
1191 lappend ls_others "--exclude-from=$user_exclude"
1194 set buf_rdi {}
1195 set buf_rdf {}
1196 set buf_rlo {}
1198 set rescan_active 3
1199 ui_status [mc "Scanning for modified files ..."]
1200 set fd_di [git_read diff-index --cached -z [PARENT]]
1201 set fd_df [git_read diff-files -z]
1202 set fd_lo [eval git_read ls-files --others -z $ls_others]
1204 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1205 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1206 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1207 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1208 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1209 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1212 proc load_message {file} {
1213 global ui_comm
1215 set f [gitdir $file]
1216 if {[file isfile $f]} {
1217 if {[catch {set fd [open $f r]}]} {
1218 return 0
1220 fconfigure $fd -eofchar {}
1221 set content [string trim [read $fd]]
1222 close $fd
1223 regsub -all -line {[ \r\t]+$} $content {} content
1224 $ui_comm delete 0.0 end
1225 $ui_comm insert end $content
1226 return 1
1228 return 0
1231 proc read_diff_index {fd after} {
1232 global buf_rdi
1234 append buf_rdi [read $fd]
1235 set c 0
1236 set n [string length $buf_rdi]
1237 while {$c < $n} {
1238 set z1 [string first "\0" $buf_rdi $c]
1239 if {$z1 == -1} break
1240 incr z1
1241 set z2 [string first "\0" $buf_rdi $z1]
1242 if {$z2 == -1} break
1244 incr c
1245 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1246 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1247 merge_state \
1248 [encoding convertfrom $p] \
1249 [lindex $i 4]? \
1250 [list [lindex $i 0] [lindex $i 2]] \
1251 [list]
1252 set c $z2
1253 incr c
1255 if {$c < $n} {
1256 set buf_rdi [string range $buf_rdi $c end]
1257 } else {
1258 set buf_rdi {}
1261 rescan_done $fd buf_rdi $after
1264 proc read_diff_files {fd after} {
1265 global buf_rdf
1267 append buf_rdf [read $fd]
1268 set c 0
1269 set n [string length $buf_rdf]
1270 while {$c < $n} {
1271 set z1 [string first "\0" $buf_rdf $c]
1272 if {$z1 == -1} break
1273 incr z1
1274 set z2 [string first "\0" $buf_rdf $z1]
1275 if {$z2 == -1} break
1277 incr c
1278 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1279 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1280 merge_state \
1281 [encoding convertfrom $p] \
1282 ?[lindex $i 4] \
1283 [list] \
1284 [list [lindex $i 0] [lindex $i 2]]
1285 set c $z2
1286 incr c
1288 if {$c < $n} {
1289 set buf_rdf [string range $buf_rdf $c end]
1290 } else {
1291 set buf_rdf {}
1294 rescan_done $fd buf_rdf $after
1297 proc read_ls_others {fd after} {
1298 global buf_rlo
1300 append buf_rlo [read $fd]
1301 set pck [split $buf_rlo "\0"]
1302 set buf_rlo [lindex $pck end]
1303 foreach p [lrange $pck 0 end-1] {
1304 set p [encoding convertfrom $p]
1305 if {[string index $p end] eq {/}} {
1306 set p [string range $p 0 end-1]
1308 merge_state $p ?O
1310 rescan_done $fd buf_rlo $after
1313 proc rescan_done {fd buf after} {
1314 global rescan_active current_diff_path
1315 global file_states repo_config
1316 upvar $buf to_clear
1318 if {![eof $fd]} return
1319 set to_clear {}
1320 close $fd
1321 if {[incr rescan_active -1] > 0} return
1323 prune_selection
1324 unlock_index
1325 display_all_files
1326 if {$current_diff_path ne {}} reshow_diff
1327 uplevel #0 $after
1330 proc prune_selection {} {
1331 global file_states selected_paths
1333 foreach path [array names selected_paths] {
1334 if {[catch {set still_here $file_states($path)}]} {
1335 unset selected_paths($path)
1340 ######################################################################
1342 ## ui helpers
1344 proc mapicon {w state path} {
1345 global all_icons
1347 if {[catch {set r $all_icons($state$w)}]} {
1348 puts "error: no icon for $w state={$state} $path"
1349 return file_plain
1351 return $r
1354 proc mapdesc {state path} {
1355 global all_descs
1357 if {[catch {set r $all_descs($state)}]} {
1358 puts "error: no desc for state={$state} $path"
1359 return $state
1361 return $r
1364 proc ui_status {msg} {
1365 global main_status
1366 if {[info exists main_status]} {
1367 $main_status show $msg
1371 proc ui_ready {{test {}}} {
1372 global main_status
1373 if {[info exists main_status]} {
1374 $main_status show [mc "Ready."] $test
1378 proc escape_path {path} {
1379 regsub -all {\\} $path "\\\\" path
1380 regsub -all "\n" $path "\\n" path
1381 return $path
1384 proc short_path {path} {
1385 return [escape_path [lindex [file split $path] end]]
1388 set next_icon_id 0
1389 set null_sha1 [string repeat 0 40]
1391 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1392 global file_states next_icon_id null_sha1
1394 set s0 [string index $new_state 0]
1395 set s1 [string index $new_state 1]
1397 if {[catch {set info $file_states($path)}]} {
1398 set state __
1399 set icon n[incr next_icon_id]
1400 } else {
1401 set state [lindex $info 0]
1402 set icon [lindex $info 1]
1403 if {$head_info eq {}} {set head_info [lindex $info 2]}
1404 if {$index_info eq {}} {set index_info [lindex $info 3]}
1407 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1408 elseif {$s0 eq {_}} {set s0 _}
1410 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1411 elseif {$s1 eq {_}} {set s1 _}
1413 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1414 set head_info [list 0 $null_sha1]
1415 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1416 && $head_info eq {}} {
1417 set head_info $index_info
1420 set file_states($path) [list $s0$s1 $icon \
1421 $head_info $index_info \
1423 return $state
1426 proc display_file_helper {w path icon_name old_m new_m} {
1427 global file_lists
1429 if {$new_m eq {_}} {
1430 set lno [lsearch -sorted -exact $file_lists($w) $path]
1431 if {$lno >= 0} {
1432 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1433 incr lno
1434 $w conf -state normal
1435 $w delete $lno.0 [expr {$lno + 1}].0
1436 $w conf -state disabled
1438 } elseif {$old_m eq {_} && $new_m ne {_}} {
1439 lappend file_lists($w) $path
1440 set file_lists($w) [lsort -unique $file_lists($w)]
1441 set lno [lsearch -sorted -exact $file_lists($w) $path]
1442 incr lno
1443 $w conf -state normal
1444 $w image create $lno.0 \
1445 -align center -padx 5 -pady 1 \
1446 -name $icon_name \
1447 -image [mapicon $w $new_m $path]
1448 $w insert $lno.1 "[escape_path $path]\n"
1449 $w conf -state disabled
1450 } elseif {$old_m ne $new_m} {
1451 $w conf -state normal
1452 $w image conf $icon_name -image [mapicon $w $new_m $path]
1453 $w conf -state disabled
1457 proc display_file {path state} {
1458 global file_states selected_paths
1459 global ui_index ui_workdir
1461 set old_m [merge_state $path $state]
1462 set s $file_states($path)
1463 set new_m [lindex $s 0]
1464 set icon_name [lindex $s 1]
1466 set o [string index $old_m 0]
1467 set n [string index $new_m 0]
1468 if {$o eq {U}} {
1469 set o _
1471 if {$n eq {U}} {
1472 set n _
1474 display_file_helper $ui_index $path $icon_name $o $n
1476 if {[string index $old_m 0] eq {U}} {
1477 set o U
1478 } else {
1479 set o [string index $old_m 1]
1481 if {[string index $new_m 0] eq {U}} {
1482 set n U
1483 } else {
1484 set n [string index $new_m 1]
1486 display_file_helper $ui_workdir $path $icon_name $o $n
1488 if {$new_m eq {__}} {
1489 unset file_states($path)
1490 catch {unset selected_paths($path)}
1494 proc display_all_files_helper {w path icon_name m} {
1495 global file_lists
1497 lappend file_lists($w) $path
1498 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1499 $w image create end \
1500 -align center -padx 5 -pady 1 \
1501 -name $icon_name \
1502 -image [mapicon $w $m $path]
1503 $w insert end "[escape_path $path]\n"
1506 proc display_all_files {} {
1507 global ui_index ui_workdir
1508 global file_states file_lists
1509 global last_clicked
1511 $ui_index conf -state normal
1512 $ui_workdir conf -state normal
1514 $ui_index delete 0.0 end
1515 $ui_workdir delete 0.0 end
1516 set last_clicked {}
1518 set file_lists($ui_index) [list]
1519 set file_lists($ui_workdir) [list]
1521 foreach path [lsort [array names file_states]] {
1522 set s $file_states($path)
1523 set m [lindex $s 0]
1524 set icon_name [lindex $s 1]
1526 set s [string index $m 0]
1527 if {$s ne {U} && $s ne {_}} {
1528 display_all_files_helper $ui_index $path \
1529 $icon_name $s
1532 if {[string index $m 0] eq {U}} {
1533 set s U
1534 } else {
1535 set s [string index $m 1]
1537 if {$s ne {_}} {
1538 display_all_files_helper $ui_workdir $path \
1539 $icon_name $s
1543 $ui_index conf -state disabled
1544 $ui_workdir conf -state disabled
1547 ######################################################################
1549 ## icons
1551 set filemask {
1552 #define mask_width 14
1553 #define mask_height 15
1554 static unsigned char mask_bits[] = {
1555 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1556 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1557 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1560 image create bitmap file_plain -background white -foreground black -data {
1561 #define plain_width 14
1562 #define plain_height 15
1563 static unsigned char plain_bits[] = {
1564 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1565 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1566 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1567 } -maskdata $filemask
1569 image create bitmap file_mod -background white -foreground blue -data {
1570 #define mod_width 14
1571 #define mod_height 15
1572 static unsigned char mod_bits[] = {
1573 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1574 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1575 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1576 } -maskdata $filemask
1578 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1579 #define file_fulltick_width 14
1580 #define file_fulltick_height 15
1581 static unsigned char file_fulltick_bits[] = {
1582 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1583 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1584 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1585 } -maskdata $filemask
1587 image create bitmap file_parttick -background white -foreground "#005050" -data {
1588 #define parttick_width 14
1589 #define parttick_height 15
1590 static unsigned char parttick_bits[] = {
1591 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1592 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1593 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1594 } -maskdata $filemask
1596 image create bitmap file_question -background white -foreground black -data {
1597 #define file_question_width 14
1598 #define file_question_height 15
1599 static unsigned char file_question_bits[] = {
1600 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1601 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1602 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1603 } -maskdata $filemask
1605 image create bitmap file_removed -background white -foreground red -data {
1606 #define file_removed_width 14
1607 #define file_removed_height 15
1608 static unsigned char file_removed_bits[] = {
1609 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1610 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1611 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1612 } -maskdata $filemask
1614 image create bitmap file_merge -background white -foreground blue -data {
1615 #define file_merge_width 14
1616 #define file_merge_height 15
1617 static unsigned char file_merge_bits[] = {
1618 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1619 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1620 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1621 } -maskdata $filemask
1623 image create bitmap file_statechange -background white -foreground green -data {
1624 #define file_merge_width 14
1625 #define file_merge_height 15
1626 static unsigned char file_statechange_bits[] = {
1627 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1628 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1629 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1630 } -maskdata $filemask
1632 set ui_index .vpane.files.index.list
1633 set ui_workdir .vpane.files.workdir.list
1635 set all_icons(_$ui_index) file_plain
1636 set all_icons(A$ui_index) file_fulltick
1637 set all_icons(M$ui_index) file_fulltick
1638 set all_icons(D$ui_index) file_removed
1639 set all_icons(U$ui_index) file_merge
1640 set all_icons(T$ui_index) file_statechange
1642 set all_icons(_$ui_workdir) file_plain
1643 set all_icons(M$ui_workdir) file_mod
1644 set all_icons(D$ui_workdir) file_question
1645 set all_icons(U$ui_workdir) file_merge
1646 set all_icons(O$ui_workdir) file_plain
1647 set all_icons(T$ui_workdir) file_statechange
1649 set max_status_desc 0
1650 foreach i {
1651 {__ {mc "Unmodified"}}
1653 {_M {mc "Modified, not staged"}}
1654 {M_ {mc "Staged for commit"}}
1655 {MM {mc "Portions staged for commit"}}
1656 {MD {mc "Staged for commit, missing"}}
1658 {_T {mc "File type changed, not staged"}}
1659 {T_ {mc "File type changed, staged"}}
1661 {_O {mc "Untracked, not staged"}}
1662 {A_ {mc "Staged for commit"}}
1663 {AM {mc "Portions staged for commit"}}
1664 {AD {mc "Staged for commit, missing"}}
1666 {_D {mc "Missing"}}
1667 {D_ {mc "Staged for removal"}}
1668 {DO {mc "Staged for removal, still present"}}
1670 {U_ {mc "Requires merge resolution"}}
1671 {UU {mc "Requires merge resolution"}}
1672 {UM {mc "Requires merge resolution"}}
1673 {UD {mc "Requires merge resolution"}}
1675 set text [eval [lindex $i 1]]
1676 if {$max_status_desc < [string length $text]} {
1677 set max_status_desc [string length $text]
1679 set all_descs([lindex $i 0]) $text
1681 unset i
1683 ######################################################################
1685 ## util
1687 proc scrollbar2many {list mode args} {
1688 foreach w $list {eval $w $mode $args}
1691 proc many2scrollbar {list mode sb top bottom} {
1692 $sb set $top $bottom
1693 foreach w $list {$w $mode moveto $top}
1696 proc incr_font_size {font {amt 1}} {
1697 set sz [font configure $font -size]
1698 incr sz $amt
1699 font configure $font -size $sz
1700 font configure ${font}bold -size $sz
1701 font configure ${font}italic -size $sz
1704 ######################################################################
1706 ## ui commands
1708 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1710 proc do_gitk {revs} {
1711 # -- Always start gitk through whatever we were loaded with. This
1712 # lets us bypass using shell process on Windows systems.
1714 set exe [_which gitk -script]
1715 set cmd [list [info nameofexecutable] $exe]
1716 if {$exe eq {}} {
1717 error_popup [mc "Couldn't find gitk in PATH"]
1718 } else {
1719 global env
1721 if {[info exists env(GIT_DIR)]} {
1722 set old_GIT_DIR $env(GIT_DIR)
1723 } else {
1724 set old_GIT_DIR {}
1727 set pwd [pwd]
1728 cd [file dirname [gitdir]]
1729 set env(GIT_DIR) [file tail [gitdir]]
1731 eval exec $cmd $revs &
1733 if {$old_GIT_DIR eq {}} {
1734 unset env(GIT_DIR)
1735 } else {
1736 set env(GIT_DIR) $old_GIT_DIR
1738 cd $pwd
1740 ui_status $::starting_gitk_msg
1741 after 10000 {
1742 ui_ready $starting_gitk_msg
1747 set is_quitting 0
1749 proc do_quit {} {
1750 global ui_comm is_quitting repo_config commit_type
1751 global GITGUI_BCK_exists GITGUI_BCK_i
1752 global ui_comm_spell
1754 if {$is_quitting} return
1755 set is_quitting 1
1757 if {[winfo exists $ui_comm]} {
1758 # -- Stash our current commit buffer.
1760 set save [gitdir GITGUI_MSG]
1761 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1762 file rename -force [gitdir GITGUI_BCK] $save
1763 set GITGUI_BCK_exists 0
1764 } else {
1765 set msg [string trim [$ui_comm get 0.0 end]]
1766 regsub -all -line {[ \r\t]+$} $msg {} msg
1767 if {(![string match amend* $commit_type]
1768 || [$ui_comm edit modified])
1769 && $msg ne {}} {
1770 catch {
1771 set fd [open $save w]
1772 puts -nonewline $fd $msg
1773 close $fd
1775 } else {
1776 catch {file delete $save}
1780 # -- Cancel our spellchecker if its running.
1782 if {[info exists ui_comm_spell]} {
1783 $ui_comm_spell stop
1786 # -- Remove our editor backup, its not needed.
1788 after cancel $GITGUI_BCK_i
1789 if {$GITGUI_BCK_exists} {
1790 catch {file delete [gitdir GITGUI_BCK]}
1793 # -- Stash our current window geometry into this repository.
1795 set cfg_geometry [list]
1796 lappend cfg_geometry [wm geometry .]
1797 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
1798 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
1799 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1800 set rc_geometry {}
1802 if {$cfg_geometry ne $rc_geometry} {
1803 catch {git config gui.geometry $cfg_geometry}
1807 destroy .
1810 proc do_rescan {} {
1811 rescan ui_ready
1814 proc do_commit {} {
1815 commit_tree
1818 proc next_diff {} {
1819 global next_diff_p next_diff_w next_diff_i
1820 show_diff $next_diff_p $next_diff_w $next_diff_i
1823 proc toggle_or_diff {w x y} {
1824 global file_states file_lists current_diff_path ui_index ui_workdir
1825 global last_clicked selected_paths
1827 set pos [split [$w index @$x,$y] .]
1828 set lno [lindex $pos 0]
1829 set col [lindex $pos 1]
1830 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1831 if {$path eq {}} {
1832 set last_clicked {}
1833 return
1836 set last_clicked [list $w $lno]
1837 array unset selected_paths
1838 $ui_index tag remove in_sel 0.0 end
1839 $ui_workdir tag remove in_sel 0.0 end
1841 if {$col == 0 && $y > 1} {
1842 set i [expr {$lno-1}]
1843 set ll [expr {[llength $file_lists($w)]-1}]
1845 if {$i == $ll && $i == 0} {
1846 set after {reshow_diff;}
1847 } else {
1848 global next_diff_p next_diff_w next_diff_i
1850 set next_diff_w $w
1852 if {$i < $ll} {
1853 set i [expr {$i + 1}]
1854 set next_diff_i $i
1855 } else {
1856 set next_diff_i $i
1857 set i [expr {$i - 1}]
1860 set next_diff_p [lindex $file_lists($w) $i]
1862 if {$next_diff_p ne {} && $current_diff_path ne {}} {
1863 set after {next_diff;}
1864 } else {
1865 set after {}
1869 if {$w eq $ui_index} {
1870 update_indexinfo \
1871 "Unstaging [short_path $path] from commit" \
1872 [list $path] \
1873 [concat $after [list ui_ready]]
1874 } elseif {$w eq $ui_workdir} {
1875 update_index \
1876 "Adding [short_path $path]" \
1877 [list $path] \
1878 [concat $after [list ui_ready]]
1880 } else {
1881 show_diff $path $w $lno
1885 proc add_one_to_selection {w x y} {
1886 global file_lists last_clicked selected_paths
1888 set lno [lindex [split [$w index @$x,$y] .] 0]
1889 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1890 if {$path eq {}} {
1891 set last_clicked {}
1892 return
1895 if {$last_clicked ne {}
1896 && [lindex $last_clicked 0] ne $w} {
1897 array unset selected_paths
1898 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1901 set last_clicked [list $w $lno]
1902 if {[catch {set in_sel $selected_paths($path)}]} {
1903 set in_sel 0
1905 if {$in_sel} {
1906 unset selected_paths($path)
1907 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1908 } else {
1909 set selected_paths($path) 1
1910 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1914 proc add_range_to_selection {w x y} {
1915 global file_lists last_clicked selected_paths
1917 if {[lindex $last_clicked 0] ne $w} {
1918 toggle_or_diff $w $x $y
1919 return
1922 set lno [lindex [split [$w index @$x,$y] .] 0]
1923 set lc [lindex $last_clicked 1]
1924 if {$lc < $lno} {
1925 set begin $lc
1926 set end $lno
1927 } else {
1928 set begin $lno
1929 set end $lc
1932 foreach path [lrange $file_lists($w) \
1933 [expr {$begin - 1}] \
1934 [expr {$end - 1}]] {
1935 set selected_paths($path) 1
1937 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1940 proc show_more_context {} {
1941 global repo_config
1942 if {$repo_config(gui.diffcontext) < 99} {
1943 incr repo_config(gui.diffcontext)
1944 reshow_diff
1948 proc show_less_context {} {
1949 global repo_config
1950 if {$repo_config(gui.diffcontext) >= 1} {
1951 incr repo_config(gui.diffcontext) -1
1952 reshow_diff
1956 ######################################################################
1958 ## ui construction
1960 load_config 0
1961 apply_config
1962 set ui_comm {}
1964 # -- Menu Bar
1966 menu .mbar -tearoff 0
1967 .mbar add cascade -label [mc Repository] -menu .mbar.repository
1968 .mbar add cascade -label [mc Edit] -menu .mbar.edit
1969 if {[is_enabled branch]} {
1970 .mbar add cascade -label [mc Branch] -menu .mbar.branch
1972 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1973 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
1975 if {[is_enabled transport]} {
1976 .mbar add cascade -label [mc Merge] -menu .mbar.merge
1977 .mbar add cascade -label [mc Remote] -menu .mbar.remote
1979 . configure -menu .mbar
1981 # -- Repository Menu
1983 menu .mbar.repository
1985 .mbar.repository add command \
1986 -label [mc "Browse Current Branch's Files"] \
1987 -command {browser::new $current_branch}
1988 set ui_browse_current [.mbar.repository index last]
1989 .mbar.repository add command \
1990 -label [mc "Browse Branch Files..."] \
1991 -command browser_open::dialog
1992 .mbar.repository add separator
1994 .mbar.repository add command \
1995 -label [mc "Visualize Current Branch's History"] \
1996 -command {do_gitk $current_branch}
1997 set ui_visualize_current [.mbar.repository index last]
1998 .mbar.repository add command \
1999 -label [mc "Visualize All Branch History"] \
2000 -command {do_gitk --all}
2001 .mbar.repository add separator
2003 proc current_branch_write {args} {
2004 global current_branch
2005 .mbar.repository entryconf $::ui_browse_current \
2006 -label [mc "Browse %s's Files" $current_branch]
2007 .mbar.repository entryconf $::ui_visualize_current \
2008 -label [mc "Visualize %s's History" $current_branch]
2010 trace add variable current_branch write current_branch_write
2012 if {[is_enabled multicommit]} {
2013 .mbar.repository add command -label [mc "Database Statistics"] \
2014 -command do_stats
2016 .mbar.repository add command -label [mc "Compress Database"] \
2017 -command do_gc
2019 .mbar.repository add command -label [mc "Verify Database"] \
2020 -command do_fsck_objects
2022 .mbar.repository add separator
2024 if {[is_Cygwin]} {
2025 .mbar.repository add command \
2026 -label [mc "Create Desktop Icon"] \
2027 -command do_cygwin_shortcut
2028 } elseif {[is_Windows]} {
2029 .mbar.repository add command \
2030 -label [mc "Create Desktop Icon"] \
2031 -command do_windows_shortcut
2032 } elseif {[is_MacOSX]} {
2033 .mbar.repository add command \
2034 -label [mc "Create Desktop Icon"] \
2035 -command do_macosx_app
2039 if {[is_MacOSX]} {
2040 proc ::tk::mac::Quit {args} { do_quit }
2041 } else {
2042 .mbar.repository add command -label [mc Quit] \
2043 -command do_quit \
2044 -accelerator $M1T-Q
2047 # -- Edit Menu
2049 menu .mbar.edit
2050 .mbar.edit add command -label [mc Undo] \
2051 -command {catch {[focus] edit undo}} \
2052 -accelerator $M1T-Z
2053 .mbar.edit add command -label [mc Redo] \
2054 -command {catch {[focus] edit redo}} \
2055 -accelerator $M1T-Y
2056 .mbar.edit add separator
2057 .mbar.edit add command -label [mc Cut] \
2058 -command {catch {tk_textCut [focus]}} \
2059 -accelerator $M1T-X
2060 .mbar.edit add command -label [mc Copy] \
2061 -command {catch {tk_textCopy [focus]}} \
2062 -accelerator $M1T-C
2063 .mbar.edit add command -label [mc Paste] \
2064 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2065 -accelerator $M1T-V
2066 .mbar.edit add command -label [mc Delete] \
2067 -command {catch {[focus] delete sel.first sel.last}} \
2068 -accelerator Del
2069 .mbar.edit add separator
2070 .mbar.edit add command -label [mc "Select All"] \
2071 -command {catch {[focus] tag add sel 0.0 end}} \
2072 -accelerator $M1T-A
2074 # -- Branch Menu
2076 if {[is_enabled branch]} {
2077 menu .mbar.branch
2079 .mbar.branch add command -label [mc "Create..."] \
2080 -command branch_create::dialog \
2081 -accelerator $M1T-N
2082 lappend disable_on_lock [list .mbar.branch entryconf \
2083 [.mbar.branch index last] -state]
2085 .mbar.branch add command -label [mc "Checkout..."] \
2086 -command branch_checkout::dialog \
2087 -accelerator $M1T-O
2088 lappend disable_on_lock [list .mbar.branch entryconf \
2089 [.mbar.branch index last] -state]
2091 .mbar.branch add command -label [mc "Rename..."] \
2092 -command branch_rename::dialog
2093 lappend disable_on_lock [list .mbar.branch entryconf \
2094 [.mbar.branch index last] -state]
2096 .mbar.branch add command -label [mc "Delete..."] \
2097 -command branch_delete::dialog
2098 lappend disable_on_lock [list .mbar.branch entryconf \
2099 [.mbar.branch index last] -state]
2101 .mbar.branch add command -label [mc "Reset..."] \
2102 -command merge::reset_hard
2103 lappend disable_on_lock [list .mbar.branch entryconf \
2104 [.mbar.branch index last] -state]
2107 # -- Commit Menu
2109 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2110 menu .mbar.commit
2112 .mbar.commit add radiobutton \
2113 -label [mc "New Commit"] \
2114 -command do_select_commit_type \
2115 -variable selected_commit_type \
2116 -value new
2117 lappend disable_on_lock \
2118 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2120 .mbar.commit add radiobutton \
2121 -label [mc "Amend Last Commit"] \
2122 -command do_select_commit_type \
2123 -variable selected_commit_type \
2124 -value amend
2125 lappend disable_on_lock \
2126 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2128 .mbar.commit add separator
2130 .mbar.commit add command -label [mc Rescan] \
2131 -command do_rescan \
2132 -accelerator F5
2133 lappend disable_on_lock \
2134 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2136 .mbar.commit add command -label [mc "Stage To Commit"] \
2137 -command do_add_selection \
2138 -accelerator $M1T-T
2139 lappend disable_on_lock \
2140 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2142 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2143 -command do_add_all \
2144 -accelerator $M1T-I
2145 lappend disable_on_lock \
2146 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2148 .mbar.commit add command -label [mc "Unstage From Commit"] \
2149 -command do_unstage_selection
2150 lappend disable_on_lock \
2151 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2153 .mbar.commit add command -label [mc "Revert Changes"] \
2154 -command do_revert_selection
2155 lappend disable_on_lock \
2156 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2158 .mbar.commit add separator
2160 .mbar.commit add command -label [mc "Show Less Context"] \
2161 -command show_less_context \
2162 -accelerator $M1T-\-
2164 .mbar.commit add command -label [mc "Show More Context"] \
2165 -command show_more_context \
2166 -accelerator $M1T-=
2168 .mbar.commit add separator
2170 .mbar.commit add command -label [mc "Sign Off"] \
2171 -command do_signoff \
2172 -accelerator $M1T-S
2174 .mbar.commit add command -label [mc Commit@@verb] \
2175 -command do_commit \
2176 -accelerator $M1T-Return
2177 lappend disable_on_lock \
2178 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2181 # -- Merge Menu
2183 if {[is_enabled branch]} {
2184 menu .mbar.merge
2185 .mbar.merge add command -label [mc "Local Merge..."] \
2186 -command merge::dialog \
2187 -accelerator $M1T-M
2188 lappend disable_on_lock \
2189 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2190 .mbar.merge add command -label [mc "Abort Merge..."] \
2191 -command merge::reset_hard
2192 lappend disable_on_lock \
2193 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2196 # -- Transport Menu
2198 if {[is_enabled transport]} {
2199 menu .mbar.remote
2201 .mbar.remote add command \
2202 -label [mc "Push..."] \
2203 -command do_push_anywhere \
2204 -accelerator $M1T-P
2205 .mbar.remote add command \
2206 -label [mc "Delete..."] \
2207 -command remote_branch_delete::dialog
2210 if {[is_MacOSX]} {
2211 # -- Apple Menu (Mac OS X only)
2213 .mbar add cascade -label Apple -menu .mbar.apple
2214 menu .mbar.apple
2216 .mbar.apple add command -label [mc "About %s" [appname]] \
2217 -command do_about
2218 .mbar.apple add separator
2219 .mbar.apple add command \
2220 -label [mc "Preferences..."] \
2221 -command do_options \
2222 -accelerator $M1T-,
2223 bind . <$M1B-,> do_options
2224 } else {
2225 # -- Edit Menu
2227 .mbar.edit add separator
2228 .mbar.edit add command -label [mc "Options..."] \
2229 -command do_options
2232 # -- Help Menu
2234 .mbar add cascade -label [mc Help] -menu .mbar.help
2235 menu .mbar.help
2237 if {![is_MacOSX]} {
2238 .mbar.help add command -label [mc "About %s" [appname]] \
2239 -command do_about
2242 set browser {}
2243 catch {set browser $repo_config(instaweb.browser)}
2244 set doc_path [file dirname [gitexec]]
2245 set doc_path [file join $doc_path Documentation index.html]
2247 if {[is_Cygwin]} {
2248 set doc_path [exec cygpath --mixed $doc_path]
2251 if {$browser eq {}} {
2252 if {[is_MacOSX]} {
2253 set browser open
2254 } elseif {[is_Cygwin]} {
2255 set program_files [file dirname [exec cygpath --windir]]
2256 set program_files [file join $program_files {Program Files}]
2257 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2258 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2259 if {[file exists $firefox]} {
2260 set browser $firefox
2261 } elseif {[file exists $ie]} {
2262 set browser $ie
2264 unset program_files firefox ie
2268 if {[file isfile $doc_path]} {
2269 set doc_url "file:$doc_path"
2270 } else {
2271 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2274 if {$browser ne {}} {
2275 .mbar.help add command -label [mc "Online Documentation"] \
2276 -command [list exec $browser $doc_url &]
2278 unset browser doc_path doc_url
2280 # -- Standard bindings
2282 wm protocol . WM_DELETE_WINDOW do_quit
2283 bind all <$M1B-Key-q> do_quit
2284 bind all <$M1B-Key-Q> do_quit
2285 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2286 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2288 set subcommand_args {}
2289 proc usage {} {
2290 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2291 exit 1
2294 # -- Not a normal commit type invocation? Do that instead!
2296 switch -- $subcommand {
2297 browser -
2298 blame {
2299 set subcommand_args {rev? path}
2300 if {$argv eq {}} usage
2301 set head {}
2302 set path {}
2303 set is_path 0
2304 foreach a $argv {
2305 if {$is_path || [file exists $_prefix$a]} {
2306 if {$path ne {}} usage
2307 set path $_prefix$a
2308 break
2309 } elseif {$a eq {--}} {
2310 if {$path ne {}} {
2311 if {$head ne {}} usage
2312 set head $path
2313 set path {}
2315 set is_path 1
2316 } elseif {$head eq {}} {
2317 if {$head ne {}} usage
2318 set head $a
2319 set is_path 1
2320 } else {
2321 usage
2324 unset is_path
2326 if {$head ne {} && $path eq {}} {
2327 set path $_prefix$head
2328 set head {}
2331 if {$head eq {}} {
2332 load_current_branch
2333 } else {
2334 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2335 if {[catch {
2336 set head [git rev-parse --verify $head]
2337 } err]} {
2338 puts stderr $err
2339 exit 1
2342 set current_branch $head
2345 switch -- $subcommand {
2346 browser {
2347 if {$head eq {}} {
2348 if {$path ne {} && [file isdirectory $path]} {
2349 set head $current_branch
2350 } else {
2351 set head $path
2352 set path {}
2355 browser::new $head $path
2357 blame {
2358 if {$head eq {} && ![file exists $path]} {
2359 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2360 exit 1
2362 blame::new $head $path
2365 return
2367 citool -
2368 gui {
2369 if {[llength $argv] != 0} {
2370 puts -nonewline stderr "usage: $argv0"
2371 if {$subcommand ne {gui}
2372 && [file tail $argv0] ne "git-$subcommand"} {
2373 puts -nonewline stderr " $subcommand"
2375 puts stderr {}
2376 exit 1
2378 # fall through to setup UI for commits
2380 default {
2381 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2382 exit 1
2386 # -- Branch Control
2388 frame .branch \
2389 -borderwidth 1 \
2390 -relief sunken
2391 label .branch.l1 \
2392 -text [mc "Current Branch:"] \
2393 -anchor w \
2394 -justify left
2395 label .branch.cb \
2396 -textvariable current_branch \
2397 -anchor w \
2398 -justify left
2399 pack .branch.l1 -side left
2400 pack .branch.cb -side left -fill x
2401 pack .branch -side top -fill x
2403 # -- Main Window Layout
2405 panedwindow .vpane -orient horizontal
2406 panedwindow .vpane.files -orient vertical
2407 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2408 pack .vpane -anchor n -side top -fill both -expand 1
2410 # -- Index File List
2412 frame .vpane.files.index -height 100 -width 200
2413 label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2414 -background lightgreen -foreground black
2415 text $ui_index -background white -foreground black \
2416 -borderwidth 0 \
2417 -width 20 -height 10 \
2418 -wrap none \
2419 -cursor $cursor_ptr \
2420 -xscrollcommand {.vpane.files.index.sx set} \
2421 -yscrollcommand {.vpane.files.index.sy set} \
2422 -state disabled
2423 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2424 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2425 pack .vpane.files.index.title -side top -fill x
2426 pack .vpane.files.index.sx -side bottom -fill x
2427 pack .vpane.files.index.sy -side right -fill y
2428 pack $ui_index -side left -fill both -expand 1
2430 # -- Working Directory File List
2432 frame .vpane.files.workdir -height 100 -width 200
2433 label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2434 -background lightsalmon -foreground black
2435 text $ui_workdir -background white -foreground black \
2436 -borderwidth 0 \
2437 -width 20 -height 10 \
2438 -wrap none \
2439 -cursor $cursor_ptr \
2440 -xscrollcommand {.vpane.files.workdir.sx set} \
2441 -yscrollcommand {.vpane.files.workdir.sy set} \
2442 -state disabled
2443 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2444 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2445 pack .vpane.files.workdir.title -side top -fill x
2446 pack .vpane.files.workdir.sx -side bottom -fill x
2447 pack .vpane.files.workdir.sy -side right -fill y
2448 pack $ui_workdir -side left -fill both -expand 1
2450 .vpane.files add .vpane.files.workdir -sticky nsew
2451 .vpane.files add .vpane.files.index -sticky nsew
2453 foreach i [list $ui_index $ui_workdir] {
2454 rmsel_tag $i
2455 $i tag conf in_diff -background [$i tag cget in_sel -background]
2457 unset i
2459 # -- Diff and Commit Area
2461 frame .vpane.lower -height 300 -width 400
2462 frame .vpane.lower.commarea
2463 frame .vpane.lower.diff -relief sunken -borderwidth 1
2464 pack .vpane.lower.diff -fill both -expand 1
2465 pack .vpane.lower.commarea -side bottom -fill x
2466 .vpane add .vpane.lower -sticky nsew
2468 # -- Commit Area Buttons
2470 frame .vpane.lower.commarea.buttons
2471 label .vpane.lower.commarea.buttons.l -text {} \
2472 -anchor w \
2473 -justify left
2474 pack .vpane.lower.commarea.buttons.l -side top -fill x
2475 pack .vpane.lower.commarea.buttons -side left -fill y
2477 button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2478 -command do_rescan
2479 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2480 lappend disable_on_lock \
2481 {.vpane.lower.commarea.buttons.rescan conf -state}
2483 button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2484 -command do_add_all
2485 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2486 lappend disable_on_lock \
2487 {.vpane.lower.commarea.buttons.incall conf -state}
2489 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2490 -command do_signoff
2491 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2493 button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
2494 -command do_commit
2495 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2496 lappend disable_on_lock \
2497 {.vpane.lower.commarea.buttons.commit conf -state}
2499 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2500 -command do_push_anywhere
2501 pack .vpane.lower.commarea.buttons.push -side top -fill x
2503 # -- Commit Message Buffer
2505 frame .vpane.lower.commarea.buffer
2506 frame .vpane.lower.commarea.buffer.header
2507 set ui_comm .vpane.lower.commarea.buffer.t
2508 set ui_coml .vpane.lower.commarea.buffer.header.l
2509 radiobutton .vpane.lower.commarea.buffer.header.new \
2510 -text [mc "New Commit"] \
2511 -command do_select_commit_type \
2512 -variable selected_commit_type \
2513 -value new
2514 lappend disable_on_lock \
2515 [list .vpane.lower.commarea.buffer.header.new conf -state]
2516 radiobutton .vpane.lower.commarea.buffer.header.amend \
2517 -text [mc "Amend Last Commit"] \
2518 -command do_select_commit_type \
2519 -variable selected_commit_type \
2520 -value amend
2521 lappend disable_on_lock \
2522 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2523 label $ui_coml \
2524 -anchor w \
2525 -justify left
2526 proc trace_commit_type {varname args} {
2527 global ui_coml commit_type
2528 switch -glob -- $commit_type {
2529 initial {set txt [mc "Initial Commit Message:"]}
2530 amend {set txt [mc "Amended Commit Message:"]}
2531 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2532 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2533 merge {set txt [mc "Merge Commit Message:"]}
2534 * {set txt [mc "Commit Message:"]}
2536 $ui_coml conf -text $txt
2538 trace add variable commit_type write trace_commit_type
2539 pack $ui_coml -side left -fill x
2540 pack .vpane.lower.commarea.buffer.header.amend -side right
2541 pack .vpane.lower.commarea.buffer.header.new -side right
2543 text $ui_comm -background white -foreground black \
2544 -borderwidth 1 \
2545 -undo true \
2546 -maxundo 20 \
2547 -autoseparators true \
2548 -relief sunken \
2549 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
2550 -font font_diff \
2551 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2552 scrollbar .vpane.lower.commarea.buffer.sby \
2553 -command [list $ui_comm yview]
2554 pack .vpane.lower.commarea.buffer.header -side top -fill x
2555 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2556 pack $ui_comm -side left -fill y
2557 pack .vpane.lower.commarea.buffer -side left -fill y
2559 # -- Commit Message Buffer Context Menu
2561 set ctxm .vpane.lower.commarea.buffer.ctxm
2562 menu $ctxm -tearoff 0
2563 $ctxm add command \
2564 -label [mc Cut] \
2565 -command {tk_textCut $ui_comm}
2566 $ctxm add command \
2567 -label [mc Copy] \
2568 -command {tk_textCopy $ui_comm}
2569 $ctxm add command \
2570 -label [mc Paste] \
2571 -command {tk_textPaste $ui_comm}
2572 $ctxm add command \
2573 -label [mc Delete] \
2574 -command {$ui_comm delete sel.first sel.last}
2575 $ctxm add separator
2576 $ctxm add command \
2577 -label [mc "Select All"] \
2578 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2579 $ctxm add command \
2580 -label [mc "Copy All"] \
2581 -command {
2582 $ui_comm tag add sel 0.0 end
2583 tk_textCopy $ui_comm
2584 $ui_comm tag remove sel 0.0 end
2586 $ctxm add separator
2587 $ctxm add command \
2588 -label [mc "Sign Off"] \
2589 -command do_signoff
2590 set ui_comm_ctxm $ctxm
2592 # -- Diff Header
2594 proc trace_current_diff_path {varname args} {
2595 global current_diff_path diff_actions file_states
2596 if {$current_diff_path eq {}} {
2597 set s {}
2598 set f {}
2599 set p {}
2600 set o disabled
2601 } else {
2602 set p $current_diff_path
2603 set s [mapdesc [lindex $file_states($p) 0] $p]
2604 set f [mc "File:"]
2605 set p [escape_path $p]
2606 set o normal
2609 .vpane.lower.diff.header.status configure -text $s
2610 .vpane.lower.diff.header.file configure -text $f
2611 .vpane.lower.diff.header.path configure -text $p
2612 foreach w $diff_actions {
2613 uplevel #0 $w $o
2616 trace add variable current_diff_path write trace_current_diff_path
2618 frame .vpane.lower.diff.header -background gold
2619 label .vpane.lower.diff.header.status \
2620 -background gold \
2621 -foreground black \
2622 -width $max_status_desc \
2623 -anchor w \
2624 -justify left
2625 label .vpane.lower.diff.header.file \
2626 -background gold \
2627 -foreground black \
2628 -anchor w \
2629 -justify left
2630 label .vpane.lower.diff.header.path \
2631 -background gold \
2632 -foreground black \
2633 -anchor w \
2634 -justify left
2635 pack .vpane.lower.diff.header.status -side left
2636 pack .vpane.lower.diff.header.file -side left
2637 pack .vpane.lower.diff.header.path -fill x
2638 set ctxm .vpane.lower.diff.header.ctxm
2639 menu $ctxm -tearoff 0
2640 $ctxm add command \
2641 -label [mc Copy] \
2642 -command {
2643 clipboard clear
2644 clipboard append \
2645 -format STRING \
2646 -type STRING \
2647 -- $current_diff_path
2649 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2650 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2652 # -- Diff Body
2654 frame .vpane.lower.diff.body
2655 set ui_diff .vpane.lower.diff.body.t
2656 text $ui_diff -background white -foreground black \
2657 -borderwidth 0 \
2658 -width 80 -height 15 -wrap none \
2659 -font font_diff \
2660 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2661 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2662 -state disabled
2663 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2664 -command [list $ui_diff xview]
2665 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2666 -command [list $ui_diff yview]
2667 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2668 pack .vpane.lower.diff.body.sby -side right -fill y
2669 pack $ui_diff -side left -fill both -expand 1
2670 pack .vpane.lower.diff.header -side top -fill x
2671 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2673 $ui_diff tag conf d_cr -elide true
2674 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2675 $ui_diff tag conf d_+ -foreground {#00a000}
2676 $ui_diff tag conf d_- -foreground red
2678 $ui_diff tag conf d_++ -foreground {#00a000}
2679 $ui_diff tag conf d_-- -foreground red
2680 $ui_diff tag conf d_+s \
2681 -foreground {#00a000} \
2682 -background {#e2effa}
2683 $ui_diff tag conf d_-s \
2684 -foreground red \
2685 -background {#e2effa}
2686 $ui_diff tag conf d_s+ \
2687 -foreground {#00a000} \
2688 -background ivory1
2689 $ui_diff tag conf d_s- \
2690 -foreground red \
2691 -background ivory1
2693 $ui_diff tag conf d<<<<<<< \
2694 -foreground orange \
2695 -font font_diffbold
2696 $ui_diff tag conf d======= \
2697 -foreground orange \
2698 -font font_diffbold
2699 $ui_diff tag conf d>>>>>>> \
2700 -foreground orange \
2701 -font font_diffbold
2703 $ui_diff tag raise sel
2705 # -- Diff Body Context Menu
2707 set ctxm .vpane.lower.diff.body.ctxm
2708 menu $ctxm -tearoff 0
2709 $ctxm add command \
2710 -label [mc "Apply/Reverse Hunk"] \
2711 -command {apply_hunk $cursorX $cursorY}
2712 set ui_diff_applyhunk [$ctxm index last]
2713 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2714 $ctxm add command \
2715 -label [mc "Apply/Reverse Line"] \
2716 -command {apply_line $cursorX $cursorY; do_rescan}
2717 set ui_diff_applyline [$ctxm index last]
2718 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
2719 $ctxm add separator
2720 $ctxm add command \
2721 -label [mc "Show Less Context"] \
2722 -command show_less_context
2723 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2724 $ctxm add command \
2725 -label [mc "Show More Context"] \
2726 -command show_more_context
2727 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2728 $ctxm add separator
2729 $ctxm add command \
2730 -label [mc Refresh] \
2731 -command reshow_diff
2732 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2733 $ctxm add command \
2734 -label [mc Copy] \
2735 -command {tk_textCopy $ui_diff}
2736 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2737 $ctxm add command \
2738 -label [mc "Select All"] \
2739 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2740 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2741 $ctxm add command \
2742 -label [mc "Copy All"] \
2743 -command {
2744 $ui_diff tag add sel 0.0 end
2745 tk_textCopy $ui_diff
2746 $ui_diff tag remove sel 0.0 end
2748 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2749 $ctxm add separator
2750 $ctxm add command \
2751 -label [mc "Decrease Font Size"] \
2752 -command {incr_font_size font_diff -1}
2753 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2754 $ctxm add command \
2755 -label [mc "Increase Font Size"] \
2756 -command {incr_font_size font_diff 1}
2757 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2758 $ctxm add separator
2759 $ctxm add command -label [mc "Options..."] \
2760 -command do_options
2761 proc popup_diff_menu {ctxm x y X Y} {
2762 global current_diff_path file_states
2763 set ::cursorX $x
2764 set ::cursorY $y
2765 if {$::ui_index eq $::current_diff_side} {
2766 set l [mc "Unstage Hunk From Commit"]
2767 set t [mc "Unstage Line From Commit"]
2768 } else {
2769 set l [mc "Stage Hunk For Commit"]
2770 set t [mc "Stage Line For Commit"]
2772 if {$::is_3way_diff
2773 || $current_diff_path eq {}
2774 || ![info exists file_states($current_diff_path)]
2775 || {_O} eq [lindex $file_states($current_diff_path) 0]
2776 || {_T} eq [lindex $file_states($current_diff_path) 0]
2777 || {T_} eq [lindex $file_states($current_diff_path) 0]} {
2778 set s disabled
2779 } else {
2780 set s normal
2782 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2783 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
2784 tk_popup $ctxm $X $Y
2786 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2788 # -- Status Bar
2790 set main_status [::status_bar::new .status]
2791 pack .status -anchor w -side bottom -fill x
2792 $main_status show [mc "Initializing..."]
2794 # -- Load geometry
2796 catch {
2797 set gm $repo_config(gui.geometry)
2798 wm geometry . [lindex $gm 0]
2799 .vpane sash place 0 \
2800 [lindex $gm 1] \
2801 [lindex [.vpane sash coord 0] 1]
2802 .vpane.files sash place 0 \
2803 [lindex [.vpane.files sash coord 0] 0] \
2804 [lindex $gm 2]
2805 unset gm
2808 # -- Key Bindings
2810 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2811 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
2812 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
2813 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2814 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2815 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2816 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2817 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2818 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2819 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2820 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2821 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2822 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2823 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
2824 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
2825 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
2826 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
2827 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
2829 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2830 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2831 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2832 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2833 bind $ui_diff <$M1B-Key-v> {break}
2834 bind $ui_diff <$M1B-Key-V> {break}
2835 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2836 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2837 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2838 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2839 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2840 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2841 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2842 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2843 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2844 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2845 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2846 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2847 bind $ui_diff <Button-1> {focus %W}
2849 if {[is_enabled branch]} {
2850 bind . <$M1B-Key-n> branch_create::dialog
2851 bind . <$M1B-Key-N> branch_create::dialog
2852 bind . <$M1B-Key-o> branch_checkout::dialog
2853 bind . <$M1B-Key-O> branch_checkout::dialog
2854 bind . <$M1B-Key-m> merge::dialog
2855 bind . <$M1B-Key-M> merge::dialog
2857 if {[is_enabled transport]} {
2858 bind . <$M1B-Key-p> do_push_anywhere
2859 bind . <$M1B-Key-P> do_push_anywhere
2862 bind . <Key-F5> do_rescan
2863 bind . <$M1B-Key-r> do_rescan
2864 bind . <$M1B-Key-R> do_rescan
2865 bind . <$M1B-Key-s> do_signoff
2866 bind . <$M1B-Key-S> do_signoff
2867 bind . <$M1B-Key-t> do_add_selection
2868 bind . <$M1B-Key-T> do_add_selection
2869 bind . <$M1B-Key-i> do_add_all
2870 bind . <$M1B-Key-I> do_add_all
2871 bind . <$M1B-Key-minus> {show_less_context;break}
2872 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
2873 bind . <$M1B-Key-equal> {show_more_context;break}
2874 bind . <$M1B-Key-plus> {show_more_context;break}
2875 bind . <$M1B-Key-KP_Add> {show_more_context;break}
2876 bind . <$M1B-Key-Return> do_commit
2877 foreach i [list $ui_index $ui_workdir] {
2878 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2879 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2880 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2882 unset i
2884 set file_lists($ui_index) [list]
2885 set file_lists($ui_workdir) [list]
2887 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2888 focus -force $ui_comm
2890 # -- Warn the user about environmental problems. Cygwin's Tcl
2891 # does *not* pass its env array onto any processes it spawns.
2892 # This means that git processes get none of our environment.
2894 if {[is_Cygwin]} {
2895 set ignored_env 0
2896 set suggest_user {}
2897 set msg [mc "Possible environment issues exist.
2899 The following environment variables are probably
2900 going to be ignored by any Git subprocess run
2901 by %s:
2903 " [appname]]
2904 foreach name [array names env] {
2905 switch -regexp -- $name {
2906 {^GIT_INDEX_FILE$} -
2907 {^GIT_OBJECT_DIRECTORY$} -
2908 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2909 {^GIT_DIFF_OPTS$} -
2910 {^GIT_EXTERNAL_DIFF$} -
2911 {^GIT_PAGER$} -
2912 {^GIT_TRACE$} -
2913 {^GIT_CONFIG$} -
2914 {^GIT_CONFIG_LOCAL$} -
2915 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2916 append msg " - $name\n"
2917 incr ignored_env
2919 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2920 append msg " - $name\n"
2921 incr ignored_env
2922 set suggest_user $name
2926 if {$ignored_env > 0} {
2927 append msg [mc "
2928 This is due to a known issue with the
2929 Tcl binary distributed by Cygwin."]
2931 if {$suggest_user ne {}} {
2932 append msg [mc "
2934 A good replacement for %s
2935 is placing values for the user.name and
2936 user.email settings into your personal
2937 ~/.gitconfig file.
2938 " $suggest_user]
2940 warn_popup $msg
2942 unset ignored_env msg suggest_user name
2945 # -- Only initialize complex UI if we are going to stay running.
2947 if {[is_enabled transport]} {
2948 load_all_remotes
2950 set n [.mbar.remote index end]
2951 populate_push_menu
2952 populate_fetch_menu
2953 set n [expr {[.mbar.remote index end] - $n}]
2954 if {$n > 0} {
2955 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
2956 .mbar.remote insert $n separator
2958 unset n
2961 if {[winfo exists $ui_comm]} {
2962 set GITGUI_BCK_exists [load_message GITGUI_BCK]
2964 # -- If both our backup and message files exist use the
2965 # newer of the two files to initialize the buffer.
2967 if {$GITGUI_BCK_exists} {
2968 set m [gitdir GITGUI_MSG]
2969 if {[file isfile $m]} {
2970 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2971 catch {file delete [gitdir GITGUI_MSG]}
2972 } else {
2973 $ui_comm delete 0.0 end
2974 $ui_comm edit reset
2975 $ui_comm edit modified false
2976 catch {file delete [gitdir GITGUI_BCK]}
2977 set GITGUI_BCK_exists 0
2980 unset m
2983 proc backup_commit_buffer {} {
2984 global ui_comm GITGUI_BCK_exists
2986 set m [$ui_comm edit modified]
2987 if {$m || $GITGUI_BCK_exists} {
2988 set msg [string trim [$ui_comm get 0.0 end]]
2989 regsub -all -line {[ \r\t]+$} $msg {} msg
2991 if {$msg eq {}} {
2992 if {$GITGUI_BCK_exists} {
2993 catch {file delete [gitdir GITGUI_BCK]}
2994 set GITGUI_BCK_exists 0
2996 } elseif {$m} {
2997 catch {
2998 set fd [open [gitdir GITGUI_BCK] w]
2999 puts -nonewline $fd $msg
3000 close $fd
3001 set GITGUI_BCK_exists 1
3005 $ui_comm edit modified false
3008 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3011 backup_commit_buffer
3013 # -- If the user has aspell available we can drive it
3014 # in pipe mode to spellcheck the commit message.
3016 set spell_cmd [list |]
3017 set spell_dict [get_config gui.spellingdictionary]
3018 lappend spell_cmd aspell
3019 if {$spell_dict ne {}} {
3020 lappend spell_cmd --master=$spell_dict
3022 lappend spell_cmd --mode=none
3023 lappend spell_cmd --encoding=utf-8
3024 lappend spell_cmd pipe
3025 if {$spell_dict eq {none}
3026 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3027 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3028 } else {
3029 set ui_comm_spell [spellcheck::init \
3030 $spell_fd \
3031 $ui_comm \
3032 $ui_comm_ctxm \
3035 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3038 lock_index begin-read
3039 if {![winfo ismapped .]} {
3040 wm deiconify .
3042 after 1 do_rescan
3043 if {[is_enabled multicommit]} {
3044 after 1000 hint_gc