git-gui (Windows): Switch to relative discovery of oguilib
[git/raj.git] / git-gui.sh
blob14b2d9aacd1d28084f195365b434747df2ddc95d
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 args} {
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 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
344 set suffix {}
345 } else {
346 set suffix $_search_exe
349 foreach p $_search_path {
350 set p [file join $p $what$suffix]
351 if {[file exists $p]} {
352 return [file normalize $p]
355 return {}
358 proc _lappend_nice {cmd_var} {
359 global _nice
360 upvar $cmd_var cmd
362 if {![info exists _nice]} {
363 set _nice [_which nice]
365 if {$_nice ne {}} {
366 lappend cmd $_nice
370 proc git {args} {
371 set opt [list]
373 while {1} {
374 switch -- [lindex $args 0] {
375 --nice {
376 _lappend_nice opt
379 default {
380 break
385 set args [lrange $args 1 end]
388 set cmdp [_git_cmd [lindex $args 0]]
389 set args [lrange $args 1 end]
391 _trace_exec [concat $opt $cmdp $args]
392 set result [eval exec $opt $cmdp $args]
393 if {$::_trace} {
394 puts stderr "< $result"
396 return $result
399 proc _open_stdout_stderr {cmd} {
400 _trace_exec $cmd
401 if {[catch {
402 set fd [open [concat [list | ] $cmd] r]
403 } err]} {
404 if { [lindex $cmd end] eq {2>@1}
405 && $err eq {can not find channel named "1"}
407 # Older versions of Tcl 8.4 don't have this 2>@1 IO
408 # redirect operator. Fallback to |& cat for those.
409 # The command was not actually started, so its safe
410 # to try to start it a second time.
412 set fd [open [concat \
413 [list | ] \
414 [lrange $cmd 0 end-1] \
415 [list |& cat] \
416 ] r]
417 } else {
418 error $err
421 fconfigure $fd -eofchar {}
422 return $fd
425 proc git_read {args} {
426 set opt [list]
428 while {1} {
429 switch -- [lindex $args 0] {
430 --nice {
431 _lappend_nice opt
434 --stderr {
435 lappend args 2>@1
438 default {
439 break
444 set args [lrange $args 1 end]
447 set cmdp [_git_cmd [lindex $args 0]]
448 set args [lrange $args 1 end]
450 return [_open_stdout_stderr [concat $opt $cmdp $args]]
453 proc git_write {args} {
454 set opt [list]
456 while {1} {
457 switch -- [lindex $args 0] {
458 --nice {
459 _lappend_nice opt
462 default {
463 break
468 set args [lrange $args 1 end]
471 set cmdp [_git_cmd [lindex $args 0]]
472 set args [lrange $args 1 end]
474 _trace_exec [concat $opt $cmdp $args]
475 return [open [concat [list | ] $opt $cmdp $args] w]
478 proc githook_read {hook_name args} {
479 set pchook [gitdir hooks $hook_name]
480 lappend args 2>@1
482 # On Windows [file executable] might lie so we need to ask
483 # the shell if the hook is executable. Yes that's annoying.
485 if {[is_Windows]} {
486 upvar #0 _sh interp
487 if {![info exists interp]} {
488 set interp [_which sh]
490 if {$interp eq {}} {
491 error "hook execution requires sh (not in PATH)"
494 set scr {if test -x "$1";then exec "$@";fi}
495 set sh_c [list $interp -c $scr $interp $pchook]
496 return [_open_stdout_stderr [concat $sh_c $args]]
499 if {[file executable $pchook]} {
500 return [_open_stdout_stderr [concat [list $pchook] $args]]
503 return {}
506 proc kill_file_process {fd} {
507 set process [pid $fd]
509 catch {
510 if {[is_Windows]} {
511 # Use a Cygwin-specific flag to allow killing
512 # native Windows processes
513 exec kill -f $process
514 } else {
515 exec kill $process
520 proc sq {value} {
521 regsub -all ' $value "'\\''" value
522 return "'$value'"
525 proc load_current_branch {} {
526 global current_branch is_detached
528 set fd [open [gitdir HEAD] r]
529 if {[gets $fd ref] < 1} {
530 set ref {}
532 close $fd
534 set pfx {ref: refs/heads/}
535 set len [string length $pfx]
536 if {[string equal -length $len $pfx $ref]} {
537 # We're on a branch. It might not exist. But
538 # HEAD looks good enough to be a branch.
540 set current_branch [string range $ref $len end]
541 set is_detached 0
542 } else {
543 # Assume this is a detached head.
545 set current_branch HEAD
546 set is_detached 1
550 auto_load tk_optionMenu
551 rename tk_optionMenu real__tkOptionMenu
552 proc tk_optionMenu {w varName args} {
553 set m [eval real__tkOptionMenu $w $varName $args]
554 $m configure -font font_ui
555 $w configure -font font_ui
556 return $m
559 proc rmsel_tag {text} {
560 $text tag conf sel \
561 -background [$text cget -background] \
562 -foreground [$text cget -foreground] \
563 -borderwidth 0
564 $text tag conf in_sel -background lightgray
565 bind $text <Motion> break
566 return $text
569 set root_exists 0
570 bind . <Visibility> {
571 bind . <Visibility> {}
572 set root_exists 1
575 if {[is_Windows]} {
576 wm iconbitmap . -default $oguilib/git-gui.ico
579 ######################################################################
581 ## config defaults
583 set cursor_ptr arrow
584 font create font_diff -family Courier -size 10
585 font create font_ui
586 catch {
587 label .dummy
588 eval font configure font_ui [font actual [.dummy cget -font]]
589 destroy .dummy
592 font create font_uiitalic
593 font create font_uibold
594 font create font_diffbold
595 font create font_diffitalic
597 foreach class {Button Checkbutton Entry Label
598 Labelframe Listbox Menu Message
599 Radiobutton Spinbox Text} {
600 option add *$class.font font_ui
602 unset class
604 if {[is_Windows] || [is_MacOSX]} {
605 option add *Menu.tearOff 0
608 if {[is_MacOSX]} {
609 set M1B M1
610 set M1T Cmd
611 } else {
612 set M1B Control
613 set M1T Ctrl
616 proc bind_button3 {w cmd} {
617 bind $w <Any-Button-3> $cmd
618 if {[is_MacOSX]} {
619 # Mac OS X sends Button-2 on right click through three-button mouse,
620 # or through trackpad right-clicking (two-finger touch + click).
621 bind $w <Any-Button-2> $cmd
622 bind $w <Control-Button-1> $cmd
626 proc apply_config {} {
627 global repo_config font_descs
629 foreach option $font_descs {
630 set name [lindex $option 0]
631 set font [lindex $option 1]
632 if {[catch {
633 set need_weight 1
634 foreach {cn cv} $repo_config(gui.$name) {
635 if {$cn eq {-weight}} {
636 set need_weight 0
638 font configure $font $cn $cv
640 if {$need_weight} {
641 font configure $font -weight normal
643 } err]} {
644 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
646 foreach {cn cv} [font configure $font] {
647 font configure ${font}bold $cn $cv
648 font configure ${font}italic $cn $cv
650 font configure ${font}bold -weight bold
651 font configure ${font}italic -slant italic
655 set default_config(branch.autosetupmerge) true
656 set default_config(merge.diffstat) true
657 set default_config(merge.summary) false
658 set default_config(merge.verbosity) 2
659 set default_config(user.name) {}
660 set default_config(user.email) {}
662 set default_config(gui.matchtrackingbranch) false
663 set default_config(gui.pruneduringfetch) false
664 set default_config(gui.trustmtime) false
665 set default_config(gui.fastcopyblame) false
666 set default_config(gui.copyblamethreshold) 40
667 set default_config(gui.diffcontext) 5
668 set default_config(gui.commitmsgwidth) 75
669 set default_config(gui.newbranchtemplate) {}
670 set default_config(gui.spellingdictionary) {}
671 set default_config(gui.fontui) [font configure font_ui]
672 set default_config(gui.fontdiff) [font configure font_diff]
673 set font_descs {
674 {fontui font_ui {mc "Main Font"}}
675 {fontdiff font_diff {mc "Diff/Console Font"}}
678 ######################################################################
680 ## find git
682 set _git [_which git]
683 if {$_git eq {}} {
684 catch {wm withdraw .}
685 tk_messageBox \
686 -icon error \
687 -type ok \
688 -title [mc "git-gui: fatal error"] \
689 -message [mc "Cannot find git in PATH."]
690 exit 1
693 ######################################################################
695 ## version check
697 if {[catch {set _git_version [git --version]} err]} {
698 catch {wm withdraw .}
699 tk_messageBox \
700 -icon error \
701 -type ok \
702 -title [mc "git-gui: fatal error"] \
703 -message "Cannot determine Git version:
705 $err
707 [appname] requires Git 1.5.0 or later."
708 exit 1
710 if {![regsub {^git version } $_git_version {} _git_version]} {
711 catch {wm withdraw .}
712 tk_messageBox \
713 -icon error \
714 -type ok \
715 -title [mc "git-gui: fatal error"] \
716 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
717 exit 1
720 set _real_git_version $_git_version
721 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
722 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
723 regsub {\.rc[0-9]+$} $_git_version {} _git_version
724 regsub {\.GIT$} $_git_version {} _git_version
725 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
727 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
728 catch {wm withdraw .}
729 if {[tk_messageBox \
730 -icon warning \
731 -type yesno \
732 -default no \
733 -title "[appname]: warning" \
734 -message [mc "Git version cannot be determined.
736 %s claims it is version '%s'.
738 %s requires at least Git 1.5.0 or later.
740 Assume '%s' is version 1.5.0?
741 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
742 set _git_version 1.5.0
743 } else {
744 exit 1
747 unset _real_git_version
749 proc git-version {args} {
750 global _git_version
752 switch [llength $args] {
754 return $_git_version
758 set op [lindex $args 0]
759 set vr [lindex $args 1]
760 set cm [package vcompare $_git_version $vr]
761 return [expr $cm $op 0]
765 set type [lindex $args 0]
766 set name [lindex $args 1]
767 set parm [lindex $args 2]
768 set body [lindex $args 3]
770 if {($type ne {proc} && $type ne {method})} {
771 error "Invalid arguments to git-version"
773 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
774 error "Last arm of $type $name must be default"
777 foreach {op vr cb} [lrange $body 0 end-2] {
778 if {[git-version $op $vr]} {
779 return [uplevel [list $type $name $parm $cb]]
783 return [uplevel [list $type $name $parm [lindex $body end]]]
786 default {
787 error "git-version >= x"
793 if {[git-version < 1.5]} {
794 catch {wm withdraw .}
795 tk_messageBox \
796 -icon error \
797 -type ok \
798 -title [mc "git-gui: fatal error"] \
799 -message "[appname] requires Git 1.5.0 or later.
801 You are using [git-version]:
803 [git --version]"
804 exit 1
807 ######################################################################
809 ## configure our library
811 set idx [file join $oguilib tclIndex]
812 if {[catch {set fd [open $idx r]} err]} {
813 catch {wm withdraw .}
814 tk_messageBox \
815 -icon error \
816 -type ok \
817 -title [mc "git-gui: fatal error"] \
818 -message $err
819 exit 1
821 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
822 set idx [list]
823 while {[gets $fd n] >= 0} {
824 if {$n ne {} && ![string match #* $n]} {
825 lappend idx $n
828 } else {
829 set idx {}
831 close $fd
833 if {$idx ne {}} {
834 set loaded [list]
835 foreach p $idx {
836 if {[lsearch -exact $loaded $p] >= 0} continue
837 source [file join $oguilib $p]
838 lappend loaded $p
840 unset loaded p
841 } else {
842 set auto_path [concat [list $oguilib] $auto_path]
844 unset -nocomplain idx fd
846 ######################################################################
848 ## config file parsing
850 git-version proc _parse_config {arr_name args} {
851 >= 1.5.3 {
852 upvar $arr_name arr
853 array unset arr
854 set buf {}
855 catch {
856 set fd_rc [eval \
857 [list git_read config] \
858 $args \
859 [list --null --list]]
860 fconfigure $fd_rc -translation binary
861 set buf [read $fd_rc]
862 close $fd_rc
864 foreach line [split $buf "\0"] {
865 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
866 if {[is_many_config $name]} {
867 lappend arr($name) $value
868 } else {
869 set arr($name) $value
874 default {
875 upvar $arr_name arr
876 array unset arr
877 catch {
878 set fd_rc [eval [list git_read config --list] $args]
879 while {[gets $fd_rc line] >= 0} {
880 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
881 if {[is_many_config $name]} {
882 lappend arr($name) $value
883 } else {
884 set arr($name) $value
888 close $fd_rc
893 proc load_config {include_global} {
894 global repo_config global_config default_config
896 if {$include_global} {
897 _parse_config global_config --global
899 _parse_config repo_config
901 foreach name [array names default_config] {
902 if {[catch {set v $global_config($name)}]} {
903 set global_config($name) $default_config($name)
905 if {[catch {set v $repo_config($name)}]} {
906 set repo_config($name) $default_config($name)
911 ######################################################################
913 ## feature option selection
915 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
916 unset _junk
917 } else {
918 set subcommand gui
920 if {$subcommand eq {gui.sh}} {
921 set subcommand gui
923 if {$subcommand eq {gui} && [llength $argv] > 0} {
924 set subcommand [lindex $argv 0]
925 set argv [lrange $argv 1 end]
928 enable_option multicommit
929 enable_option branch
930 enable_option transport
931 disable_option bare
933 switch -- $subcommand {
934 browser -
935 blame {
936 enable_option bare
938 disable_option multicommit
939 disable_option branch
940 disable_option transport
942 citool {
943 enable_option singlecommit
945 disable_option multicommit
946 disable_option branch
947 disable_option transport
951 ######################################################################
953 ## repository setup
955 if {[catch {
956 set _gitdir $env(GIT_DIR)
957 set _prefix {}
959 && [catch {
960 set _gitdir [git rev-parse --git-dir]
961 set _prefix [git rev-parse --show-prefix]
962 } err]} {
963 load_config 1
964 apply_config
965 choose_repository::pick
967 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
968 catch {set _gitdir [exec cygpath --windows $_gitdir]}
970 if {![file isdirectory $_gitdir]} {
971 catch {wm withdraw .}
972 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
973 exit 1
975 if {$_prefix ne {}} {
976 regsub -all {[^/]+/} $_prefix ../ cdup
977 if {[catch {cd $cdup} err]} {
978 catch {wm withdraw .}
979 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
980 exit 1
982 unset cdup
983 } elseif {![is_enabled bare]} {
984 if {[lindex [file split $_gitdir] end] ne {.git}} {
985 catch {wm withdraw .}
986 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
987 exit 1
989 if {[catch {cd [file dirname $_gitdir]} err]} {
990 catch {wm withdraw .}
991 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
992 exit 1
995 set _reponame [file split [file normalize $_gitdir]]
996 if {[lindex $_reponame end] eq {.git}} {
997 set _reponame [lindex $_reponame end-1]
998 } else {
999 set _reponame [lindex $_reponame end]
1002 ######################################################################
1004 ## global init
1006 set current_diff_path {}
1007 set current_diff_side {}
1008 set diff_actions [list]
1010 set HEAD {}
1011 set PARENT {}
1012 set MERGE_HEAD [list]
1013 set commit_type {}
1014 set empty_tree {}
1015 set current_branch {}
1016 set is_detached 0
1017 set current_diff_path {}
1018 set is_3way_diff 0
1019 set selected_commit_type new
1021 ######################################################################
1023 ## task management
1025 set rescan_active 0
1026 set diff_active 0
1027 set last_clicked {}
1029 set disable_on_lock [list]
1030 set index_lock_type none
1032 proc lock_index {type} {
1033 global index_lock_type disable_on_lock
1035 if {$index_lock_type eq {none}} {
1036 set index_lock_type $type
1037 foreach w $disable_on_lock {
1038 uplevel #0 $w disabled
1040 return 1
1041 } elseif {$index_lock_type eq "begin-$type"} {
1042 set index_lock_type $type
1043 return 1
1045 return 0
1048 proc unlock_index {} {
1049 global index_lock_type disable_on_lock
1051 set index_lock_type none
1052 foreach w $disable_on_lock {
1053 uplevel #0 $w normal
1057 ######################################################################
1059 ## status
1061 proc repository_state {ctvar hdvar mhvar} {
1062 global current_branch
1063 upvar $ctvar ct $hdvar hd $mhvar mh
1065 set mh [list]
1067 load_current_branch
1068 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1069 set hd {}
1070 set ct initial
1071 return
1074 set merge_head [gitdir MERGE_HEAD]
1075 if {[file exists $merge_head]} {
1076 set ct merge
1077 set fd_mh [open $merge_head r]
1078 while {[gets $fd_mh line] >= 0} {
1079 lappend mh $line
1081 close $fd_mh
1082 return
1085 set ct normal
1088 proc PARENT {} {
1089 global PARENT empty_tree
1091 set p [lindex $PARENT 0]
1092 if {$p ne {}} {
1093 return $p
1095 if {$empty_tree eq {}} {
1096 set empty_tree [git mktree << {}]
1098 return $empty_tree
1101 proc rescan {after {honor_trustmtime 1}} {
1102 global HEAD PARENT MERGE_HEAD commit_type
1103 global ui_index ui_workdir ui_comm
1104 global rescan_active file_states
1105 global repo_config
1107 if {$rescan_active > 0 || ![lock_index read]} return
1109 repository_state newType newHEAD newMERGE_HEAD
1110 if {[string match amend* $commit_type]
1111 && $newType eq {normal}
1112 && $newHEAD eq $HEAD} {
1113 } else {
1114 set HEAD $newHEAD
1115 set PARENT $newHEAD
1116 set MERGE_HEAD $newMERGE_HEAD
1117 set commit_type $newType
1120 array unset file_states
1122 if {!$::GITGUI_BCK_exists &&
1123 (![$ui_comm edit modified]
1124 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1125 if {[string match amend* $commit_type]} {
1126 } elseif {[load_message GITGUI_MSG]} {
1127 } elseif {[load_message MERGE_MSG]} {
1128 } elseif {[load_message SQUASH_MSG]} {
1130 $ui_comm edit reset
1131 $ui_comm edit modified false
1134 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1135 rescan_stage2 {} $after
1136 } else {
1137 set rescan_active 1
1138 ui_status [mc "Refreshing file status..."]
1139 set fd_rf [git_read update-index \
1140 -q \
1141 --unmerged \
1142 --ignore-missing \
1143 --refresh \
1145 fconfigure $fd_rf -blocking 0 -translation binary
1146 fileevent $fd_rf readable \
1147 [list rescan_stage2 $fd_rf $after]
1151 if {[is_Cygwin]} {
1152 set is_git_info_exclude {}
1153 proc have_info_exclude {} {
1154 global is_git_info_exclude
1156 if {$is_git_info_exclude eq {}} {
1157 if {[catch {exec test -f [gitdir info exclude]}]} {
1158 set is_git_info_exclude 0
1159 } else {
1160 set is_git_info_exclude 1
1163 return $is_git_info_exclude
1165 } else {
1166 proc have_info_exclude {} {
1167 return [file readable [gitdir info exclude]]
1171 proc rescan_stage2 {fd after} {
1172 global rescan_active buf_rdi buf_rdf buf_rlo
1174 if {$fd ne {}} {
1175 read $fd
1176 if {![eof $fd]} return
1177 close $fd
1180 set ls_others [list --exclude-per-directory=.gitignore]
1181 if {[have_info_exclude]} {
1182 lappend ls_others "--exclude-from=[gitdir info exclude]"
1184 set user_exclude [get_config core.excludesfile]
1185 if {$user_exclude ne {} && [file readable $user_exclude]} {
1186 lappend ls_others "--exclude-from=$user_exclude"
1189 set buf_rdi {}
1190 set buf_rdf {}
1191 set buf_rlo {}
1193 set rescan_active 3
1194 ui_status [mc "Scanning for modified files ..."]
1195 set fd_di [git_read diff-index --cached -z [PARENT]]
1196 set fd_df [git_read diff-files -z]
1197 set fd_lo [eval git_read ls-files --others -z $ls_others]
1199 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1200 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1201 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1202 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1203 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1204 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1207 proc load_message {file} {
1208 global ui_comm
1210 set f [gitdir $file]
1211 if {[file isfile $f]} {
1212 if {[catch {set fd [open $f r]}]} {
1213 return 0
1215 fconfigure $fd -eofchar {}
1216 set content [string trim [read $fd]]
1217 close $fd
1218 regsub -all -line {[ \r\t]+$} $content {} content
1219 $ui_comm delete 0.0 end
1220 $ui_comm insert end $content
1221 return 1
1223 return 0
1226 proc read_diff_index {fd after} {
1227 global buf_rdi
1229 append buf_rdi [read $fd]
1230 set c 0
1231 set n [string length $buf_rdi]
1232 while {$c < $n} {
1233 set z1 [string first "\0" $buf_rdi $c]
1234 if {$z1 == -1} break
1235 incr z1
1236 set z2 [string first "\0" $buf_rdi $z1]
1237 if {$z2 == -1} break
1239 incr c
1240 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1241 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1242 merge_state \
1243 [encoding convertfrom $p] \
1244 [lindex $i 4]? \
1245 [list [lindex $i 0] [lindex $i 2]] \
1246 [list]
1247 set c $z2
1248 incr c
1250 if {$c < $n} {
1251 set buf_rdi [string range $buf_rdi $c end]
1252 } else {
1253 set buf_rdi {}
1256 rescan_done $fd buf_rdi $after
1259 proc read_diff_files {fd after} {
1260 global buf_rdf
1262 append buf_rdf [read $fd]
1263 set c 0
1264 set n [string length $buf_rdf]
1265 while {$c < $n} {
1266 set z1 [string first "\0" $buf_rdf $c]
1267 if {$z1 == -1} break
1268 incr z1
1269 set z2 [string first "\0" $buf_rdf $z1]
1270 if {$z2 == -1} break
1272 incr c
1273 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1274 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1275 merge_state \
1276 [encoding convertfrom $p] \
1277 ?[lindex $i 4] \
1278 [list] \
1279 [list [lindex $i 0] [lindex $i 2]]
1280 set c $z2
1281 incr c
1283 if {$c < $n} {
1284 set buf_rdf [string range $buf_rdf $c end]
1285 } else {
1286 set buf_rdf {}
1289 rescan_done $fd buf_rdf $after
1292 proc read_ls_others {fd after} {
1293 global buf_rlo
1295 append buf_rlo [read $fd]
1296 set pck [split $buf_rlo "\0"]
1297 set buf_rlo [lindex $pck end]
1298 foreach p [lrange $pck 0 end-1] {
1299 set p [encoding convertfrom $p]
1300 if {[string index $p end] eq {/}} {
1301 set p [string range $p 0 end-1]
1303 merge_state $p ?O
1305 rescan_done $fd buf_rlo $after
1308 proc rescan_done {fd buf after} {
1309 global rescan_active current_diff_path
1310 global file_states repo_config
1311 upvar $buf to_clear
1313 if {![eof $fd]} return
1314 set to_clear {}
1315 close $fd
1316 if {[incr rescan_active -1] > 0} return
1318 prune_selection
1319 unlock_index
1320 display_all_files
1321 if {$current_diff_path ne {}} reshow_diff
1322 uplevel #0 $after
1325 proc prune_selection {} {
1326 global file_states selected_paths
1328 foreach path [array names selected_paths] {
1329 if {[catch {set still_here $file_states($path)}]} {
1330 unset selected_paths($path)
1335 ######################################################################
1337 ## ui helpers
1339 proc mapicon {w state path} {
1340 global all_icons
1342 if {[catch {set r $all_icons($state$w)}]} {
1343 puts "error: no icon for $w state={$state} $path"
1344 return file_plain
1346 return $r
1349 proc mapdesc {state path} {
1350 global all_descs
1352 if {[catch {set r $all_descs($state)}]} {
1353 puts "error: no desc for state={$state} $path"
1354 return $state
1356 return $r
1359 proc ui_status {msg} {
1360 global main_status
1361 if {[info exists main_status]} {
1362 $main_status show $msg
1366 proc ui_ready {{test {}}} {
1367 global main_status
1368 if {[info exists main_status]} {
1369 $main_status show [mc "Ready."] $test
1373 proc escape_path {path} {
1374 regsub -all {\\} $path "\\\\" path
1375 regsub -all "\n" $path "\\n" path
1376 return $path
1379 proc short_path {path} {
1380 return [escape_path [lindex [file split $path] end]]
1383 set next_icon_id 0
1384 set null_sha1 [string repeat 0 40]
1386 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1387 global file_states next_icon_id null_sha1
1389 set s0 [string index $new_state 0]
1390 set s1 [string index $new_state 1]
1392 if {[catch {set info $file_states($path)}]} {
1393 set state __
1394 set icon n[incr next_icon_id]
1395 } else {
1396 set state [lindex $info 0]
1397 set icon [lindex $info 1]
1398 if {$head_info eq {}} {set head_info [lindex $info 2]}
1399 if {$index_info eq {}} {set index_info [lindex $info 3]}
1402 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1403 elseif {$s0 eq {_}} {set s0 _}
1405 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1406 elseif {$s1 eq {_}} {set s1 _}
1408 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1409 set head_info [list 0 $null_sha1]
1410 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1411 && $head_info eq {}} {
1412 set head_info $index_info
1415 set file_states($path) [list $s0$s1 $icon \
1416 $head_info $index_info \
1418 return $state
1421 proc display_file_helper {w path icon_name old_m new_m} {
1422 global file_lists
1424 if {$new_m eq {_}} {
1425 set lno [lsearch -sorted -exact $file_lists($w) $path]
1426 if {$lno >= 0} {
1427 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1428 incr lno
1429 $w conf -state normal
1430 $w delete $lno.0 [expr {$lno + 1}].0
1431 $w conf -state disabled
1433 } elseif {$old_m eq {_} && $new_m ne {_}} {
1434 lappend file_lists($w) $path
1435 set file_lists($w) [lsort -unique $file_lists($w)]
1436 set lno [lsearch -sorted -exact $file_lists($w) $path]
1437 incr lno
1438 $w conf -state normal
1439 $w image create $lno.0 \
1440 -align center -padx 5 -pady 1 \
1441 -name $icon_name \
1442 -image [mapicon $w $new_m $path]
1443 $w insert $lno.1 "[escape_path $path]\n"
1444 $w conf -state disabled
1445 } elseif {$old_m ne $new_m} {
1446 $w conf -state normal
1447 $w image conf $icon_name -image [mapicon $w $new_m $path]
1448 $w conf -state disabled
1452 proc display_file {path state} {
1453 global file_states selected_paths
1454 global ui_index ui_workdir
1456 set old_m [merge_state $path $state]
1457 set s $file_states($path)
1458 set new_m [lindex $s 0]
1459 set icon_name [lindex $s 1]
1461 set o [string index $old_m 0]
1462 set n [string index $new_m 0]
1463 if {$o eq {U}} {
1464 set o _
1466 if {$n eq {U}} {
1467 set n _
1469 display_file_helper $ui_index $path $icon_name $o $n
1471 if {[string index $old_m 0] eq {U}} {
1472 set o U
1473 } else {
1474 set o [string index $old_m 1]
1476 if {[string index $new_m 0] eq {U}} {
1477 set n U
1478 } else {
1479 set n [string index $new_m 1]
1481 display_file_helper $ui_workdir $path $icon_name $o $n
1483 if {$new_m eq {__}} {
1484 unset file_states($path)
1485 catch {unset selected_paths($path)}
1489 proc display_all_files_helper {w path icon_name m} {
1490 global file_lists
1492 lappend file_lists($w) $path
1493 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1494 $w image create end \
1495 -align center -padx 5 -pady 1 \
1496 -name $icon_name \
1497 -image [mapicon $w $m $path]
1498 $w insert end "[escape_path $path]\n"
1501 proc display_all_files {} {
1502 global ui_index ui_workdir
1503 global file_states file_lists
1504 global last_clicked
1506 $ui_index conf -state normal
1507 $ui_workdir conf -state normal
1509 $ui_index delete 0.0 end
1510 $ui_workdir delete 0.0 end
1511 set last_clicked {}
1513 set file_lists($ui_index) [list]
1514 set file_lists($ui_workdir) [list]
1516 foreach path [lsort [array names file_states]] {
1517 set s $file_states($path)
1518 set m [lindex $s 0]
1519 set icon_name [lindex $s 1]
1521 set s [string index $m 0]
1522 if {$s ne {U} && $s ne {_}} {
1523 display_all_files_helper $ui_index $path \
1524 $icon_name $s
1527 if {[string index $m 0] eq {U}} {
1528 set s U
1529 } else {
1530 set s [string index $m 1]
1532 if {$s ne {_}} {
1533 display_all_files_helper $ui_workdir $path \
1534 $icon_name $s
1538 $ui_index conf -state disabled
1539 $ui_workdir conf -state disabled
1542 ######################################################################
1544 ## icons
1546 set filemask {
1547 #define mask_width 14
1548 #define mask_height 15
1549 static unsigned char mask_bits[] = {
1550 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1551 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1552 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1555 image create bitmap file_plain -background white -foreground black -data {
1556 #define plain_width 14
1557 #define plain_height 15
1558 static unsigned char plain_bits[] = {
1559 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1560 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1561 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1562 } -maskdata $filemask
1564 image create bitmap file_mod -background white -foreground blue -data {
1565 #define mod_width 14
1566 #define mod_height 15
1567 static unsigned char mod_bits[] = {
1568 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1569 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1570 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1571 } -maskdata $filemask
1573 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1574 #define file_fulltick_width 14
1575 #define file_fulltick_height 15
1576 static unsigned char file_fulltick_bits[] = {
1577 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1578 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1579 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1580 } -maskdata $filemask
1582 image create bitmap file_parttick -background white -foreground "#005050" -data {
1583 #define parttick_width 14
1584 #define parttick_height 15
1585 static unsigned char parttick_bits[] = {
1586 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1587 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1588 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1589 } -maskdata $filemask
1591 image create bitmap file_question -background white -foreground black -data {
1592 #define file_question_width 14
1593 #define file_question_height 15
1594 static unsigned char file_question_bits[] = {
1595 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1596 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1597 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1598 } -maskdata $filemask
1600 image create bitmap file_removed -background white -foreground red -data {
1601 #define file_removed_width 14
1602 #define file_removed_height 15
1603 static unsigned char file_removed_bits[] = {
1604 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1605 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1606 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1607 } -maskdata $filemask
1609 image create bitmap file_merge -background white -foreground blue -data {
1610 #define file_merge_width 14
1611 #define file_merge_height 15
1612 static unsigned char file_merge_bits[] = {
1613 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1614 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1615 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1616 } -maskdata $filemask
1618 set ui_index .vpane.files.index.list
1619 set ui_workdir .vpane.files.workdir.list
1621 set all_icons(_$ui_index) file_plain
1622 set all_icons(A$ui_index) file_fulltick
1623 set all_icons(M$ui_index) file_fulltick
1624 set all_icons(D$ui_index) file_removed
1625 set all_icons(U$ui_index) file_merge
1627 set all_icons(_$ui_workdir) file_plain
1628 set all_icons(M$ui_workdir) file_mod
1629 set all_icons(D$ui_workdir) file_question
1630 set all_icons(U$ui_workdir) file_merge
1631 set all_icons(O$ui_workdir) file_plain
1633 set max_status_desc 0
1634 foreach i {
1635 {__ {mc "Unmodified"}}
1637 {_M {mc "Modified, not staged"}}
1638 {M_ {mc "Staged for commit"}}
1639 {MM {mc "Portions staged for commit"}}
1640 {MD {mc "Staged for commit, missing"}}
1642 {_O {mc "Untracked, not staged"}}
1643 {A_ {mc "Staged for commit"}}
1644 {AM {mc "Portions staged for commit"}}
1645 {AD {mc "Staged for commit, missing"}}
1647 {_D {mc "Missing"}}
1648 {D_ {mc "Staged for removal"}}
1649 {DO {mc "Staged for removal, still present"}}
1651 {U_ {mc "Requires merge resolution"}}
1652 {UU {mc "Requires merge resolution"}}
1653 {UM {mc "Requires merge resolution"}}
1654 {UD {mc "Requires merge resolution"}}
1656 set text [eval [lindex $i 1]]
1657 if {$max_status_desc < [string length $text]} {
1658 set max_status_desc [string length $text]
1660 set all_descs([lindex $i 0]) $text
1662 unset i
1664 ######################################################################
1666 ## util
1668 proc scrollbar2many {list mode args} {
1669 foreach w $list {eval $w $mode $args}
1672 proc many2scrollbar {list mode sb top bottom} {
1673 $sb set $top $bottom
1674 foreach w $list {$w $mode moveto $top}
1677 proc incr_font_size {font {amt 1}} {
1678 set sz [font configure $font -size]
1679 incr sz $amt
1680 font configure $font -size $sz
1681 font configure ${font}bold -size $sz
1682 font configure ${font}italic -size $sz
1685 ######################################################################
1687 ## ui commands
1689 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1691 proc do_gitk {revs} {
1692 # -- Always start gitk through whatever we were loaded with. This
1693 # lets us bypass using shell process on Windows systems.
1695 set exe [_which gitk -script]
1696 set cmd [list [info nameofexecutable] $exe]
1697 if {$exe eq {}} {
1698 error_popup [mc "Couldn't find gitk in PATH"]
1699 } else {
1700 global env
1702 if {[info exists env(GIT_DIR)]} {
1703 set old_GIT_DIR $env(GIT_DIR)
1704 } else {
1705 set old_GIT_DIR {}
1708 set pwd [pwd]
1709 cd [file dirname [gitdir]]
1710 set env(GIT_DIR) [file tail [gitdir]]
1712 eval exec $cmd $revs &
1714 if {$old_GIT_DIR eq {}} {
1715 unset env(GIT_DIR)
1716 } else {
1717 set env(GIT_DIR) $old_GIT_DIR
1719 cd $pwd
1721 ui_status $::starting_gitk_msg
1722 after 10000 {
1723 ui_ready $starting_gitk_msg
1728 set is_quitting 0
1730 proc do_quit {} {
1731 global ui_comm is_quitting repo_config commit_type
1732 global GITGUI_BCK_exists GITGUI_BCK_i
1733 global ui_comm_spell
1735 if {$is_quitting} return
1736 set is_quitting 1
1738 if {[winfo exists $ui_comm]} {
1739 # -- Stash our current commit buffer.
1741 set save [gitdir GITGUI_MSG]
1742 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1743 file rename -force [gitdir GITGUI_BCK] $save
1744 set GITGUI_BCK_exists 0
1745 } else {
1746 set msg [string trim [$ui_comm get 0.0 end]]
1747 regsub -all -line {[ \r\t]+$} $msg {} msg
1748 if {(![string match amend* $commit_type]
1749 || [$ui_comm edit modified])
1750 && $msg ne {}} {
1751 catch {
1752 set fd [open $save w]
1753 puts -nonewline $fd $msg
1754 close $fd
1756 } else {
1757 catch {file delete $save}
1761 # -- Cancel our spellchecker if its running.
1763 if {[info exists ui_comm_spell]} {
1764 $ui_comm_spell stop
1767 # -- Remove our editor backup, its not needed.
1769 after cancel $GITGUI_BCK_i
1770 if {$GITGUI_BCK_exists} {
1771 catch {file delete [gitdir GITGUI_BCK]}
1774 # -- Stash our current window geometry into this repository.
1776 set cfg_geometry [list]
1777 lappend cfg_geometry [wm geometry .]
1778 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
1779 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
1780 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1781 set rc_geometry {}
1783 if {$cfg_geometry ne $rc_geometry} {
1784 catch {git config gui.geometry $cfg_geometry}
1788 destroy .
1791 proc do_rescan {} {
1792 rescan ui_ready
1795 proc do_commit {} {
1796 commit_tree
1799 proc next_diff {} {
1800 global next_diff_p next_diff_w next_diff_i
1801 show_diff $next_diff_p $next_diff_w $next_diff_i
1804 proc toggle_or_diff {w x y} {
1805 global file_states file_lists current_diff_path ui_index ui_workdir
1806 global last_clicked selected_paths
1808 set pos [split [$w index @$x,$y] .]
1809 set lno [lindex $pos 0]
1810 set col [lindex $pos 1]
1811 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1812 if {$path eq {}} {
1813 set last_clicked {}
1814 return
1817 set last_clicked [list $w $lno]
1818 array unset selected_paths
1819 $ui_index tag remove in_sel 0.0 end
1820 $ui_workdir tag remove in_sel 0.0 end
1822 if {$col == 0 && $y > 1} {
1823 set i [expr {$lno-1}]
1824 set ll [expr {[llength $file_lists($w)]-1}]
1826 if {$i == $ll && $i == 0} {
1827 set after {reshow_diff;}
1828 } else {
1829 global next_diff_p next_diff_w next_diff_i
1831 set next_diff_w $w
1833 if {$i < $ll} {
1834 set i [expr {$i + 1}]
1835 set next_diff_i $i
1836 } else {
1837 set next_diff_i $i
1838 set i [expr {$i - 1}]
1841 set next_diff_p [lindex $file_lists($w) $i]
1843 if {$next_diff_p ne {} && $current_diff_path ne {}} {
1844 set after {next_diff;}
1845 } else {
1846 set after {}
1850 if {$w eq $ui_index} {
1851 update_indexinfo \
1852 "Unstaging [short_path $path] from commit" \
1853 [list $path] \
1854 [concat $after [list ui_ready]]
1855 } elseif {$w eq $ui_workdir} {
1856 update_index \
1857 "Adding [short_path $path]" \
1858 [list $path] \
1859 [concat $after [list ui_ready]]
1861 } else {
1862 show_diff $path $w $lno
1866 proc add_one_to_selection {w x y} {
1867 global file_lists last_clicked selected_paths
1869 set lno [lindex [split [$w index @$x,$y] .] 0]
1870 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1871 if {$path eq {}} {
1872 set last_clicked {}
1873 return
1876 if {$last_clicked ne {}
1877 && [lindex $last_clicked 0] ne $w} {
1878 array unset selected_paths
1879 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1882 set last_clicked [list $w $lno]
1883 if {[catch {set in_sel $selected_paths($path)}]} {
1884 set in_sel 0
1886 if {$in_sel} {
1887 unset selected_paths($path)
1888 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1889 } else {
1890 set selected_paths($path) 1
1891 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1895 proc add_range_to_selection {w x y} {
1896 global file_lists last_clicked selected_paths
1898 if {[lindex $last_clicked 0] ne $w} {
1899 toggle_or_diff $w $x $y
1900 return
1903 set lno [lindex [split [$w index @$x,$y] .] 0]
1904 set lc [lindex $last_clicked 1]
1905 if {$lc < $lno} {
1906 set begin $lc
1907 set end $lno
1908 } else {
1909 set begin $lno
1910 set end $lc
1913 foreach path [lrange $file_lists($w) \
1914 [expr {$begin - 1}] \
1915 [expr {$end - 1}]] {
1916 set selected_paths($path) 1
1918 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1921 proc show_more_context {} {
1922 global repo_config
1923 if {$repo_config(gui.diffcontext) < 99} {
1924 incr repo_config(gui.diffcontext)
1925 reshow_diff
1929 proc show_less_context {} {
1930 global repo_config
1931 if {$repo_config(gui.diffcontext) >= 1} {
1932 incr repo_config(gui.diffcontext) -1
1933 reshow_diff
1937 ######################################################################
1939 ## ui construction
1941 load_config 0
1942 apply_config
1943 set ui_comm {}
1945 # -- Menu Bar
1947 menu .mbar -tearoff 0
1948 .mbar add cascade -label [mc Repository] -menu .mbar.repository
1949 .mbar add cascade -label [mc Edit] -menu .mbar.edit
1950 if {[is_enabled branch]} {
1951 .mbar add cascade -label [mc Branch] -menu .mbar.branch
1953 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1954 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
1956 if {[is_enabled transport]} {
1957 .mbar add cascade -label [mc Merge] -menu .mbar.merge
1958 .mbar add cascade -label [mc Remote] -menu .mbar.remote
1960 . configure -menu .mbar
1962 # -- Repository Menu
1964 menu .mbar.repository
1966 .mbar.repository add command \
1967 -label [mc "Browse Current Branch's Files"] \
1968 -command {browser::new $current_branch}
1969 set ui_browse_current [.mbar.repository index last]
1970 .mbar.repository add command \
1971 -label [mc "Browse Branch Files..."] \
1972 -command browser_open::dialog
1973 .mbar.repository add separator
1975 .mbar.repository add command \
1976 -label [mc "Visualize Current Branch's History"] \
1977 -command {do_gitk $current_branch}
1978 set ui_visualize_current [.mbar.repository index last]
1979 .mbar.repository add command \
1980 -label [mc "Visualize All Branch History"] \
1981 -command {do_gitk --all}
1982 .mbar.repository add separator
1984 proc current_branch_write {args} {
1985 global current_branch
1986 .mbar.repository entryconf $::ui_browse_current \
1987 -label [mc "Browse %s's Files" $current_branch]
1988 .mbar.repository entryconf $::ui_visualize_current \
1989 -label [mc "Visualize %s's History" $current_branch]
1991 trace add variable current_branch write current_branch_write
1993 if {[is_enabled multicommit]} {
1994 .mbar.repository add command -label [mc "Database Statistics"] \
1995 -command do_stats
1997 .mbar.repository add command -label [mc "Compress Database"] \
1998 -command do_gc
2000 .mbar.repository add command -label [mc "Verify Database"] \
2001 -command do_fsck_objects
2003 .mbar.repository add separator
2005 if {[is_Cygwin]} {
2006 .mbar.repository add command \
2007 -label [mc "Create Desktop Icon"] \
2008 -command do_cygwin_shortcut
2009 } elseif {[is_Windows]} {
2010 .mbar.repository add command \
2011 -label [mc "Create Desktop Icon"] \
2012 -command do_windows_shortcut
2013 } elseif {[is_MacOSX]} {
2014 .mbar.repository add command \
2015 -label [mc "Create Desktop Icon"] \
2016 -command do_macosx_app
2020 if {[is_MacOSX]} {
2021 proc ::tk::mac::Quit {args} { do_quit }
2022 } else {
2023 .mbar.repository add command -label [mc Quit] \
2024 -command do_quit \
2025 -accelerator $M1T-Q
2028 # -- Edit Menu
2030 menu .mbar.edit
2031 .mbar.edit add command -label [mc Undo] \
2032 -command {catch {[focus] edit undo}} \
2033 -accelerator $M1T-Z
2034 .mbar.edit add command -label [mc Redo] \
2035 -command {catch {[focus] edit redo}} \
2036 -accelerator $M1T-Y
2037 .mbar.edit add separator
2038 .mbar.edit add command -label [mc Cut] \
2039 -command {catch {tk_textCut [focus]}} \
2040 -accelerator $M1T-X
2041 .mbar.edit add command -label [mc Copy] \
2042 -command {catch {tk_textCopy [focus]}} \
2043 -accelerator $M1T-C
2044 .mbar.edit add command -label [mc Paste] \
2045 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2046 -accelerator $M1T-V
2047 .mbar.edit add command -label [mc Delete] \
2048 -command {catch {[focus] delete sel.first sel.last}} \
2049 -accelerator Del
2050 .mbar.edit add separator
2051 .mbar.edit add command -label [mc "Select All"] \
2052 -command {catch {[focus] tag add sel 0.0 end}} \
2053 -accelerator $M1T-A
2055 # -- Branch Menu
2057 if {[is_enabled branch]} {
2058 menu .mbar.branch
2060 .mbar.branch add command -label [mc "Create..."] \
2061 -command branch_create::dialog \
2062 -accelerator $M1T-N
2063 lappend disable_on_lock [list .mbar.branch entryconf \
2064 [.mbar.branch index last] -state]
2066 .mbar.branch add command -label [mc "Checkout..."] \
2067 -command branch_checkout::dialog \
2068 -accelerator $M1T-O
2069 lappend disable_on_lock [list .mbar.branch entryconf \
2070 [.mbar.branch index last] -state]
2072 .mbar.branch add command -label [mc "Rename..."] \
2073 -command branch_rename::dialog
2074 lappend disable_on_lock [list .mbar.branch entryconf \
2075 [.mbar.branch index last] -state]
2077 .mbar.branch add command -label [mc "Delete..."] \
2078 -command branch_delete::dialog
2079 lappend disable_on_lock [list .mbar.branch entryconf \
2080 [.mbar.branch index last] -state]
2082 .mbar.branch add command -label [mc "Reset..."] \
2083 -command merge::reset_hard
2084 lappend disable_on_lock [list .mbar.branch entryconf \
2085 [.mbar.branch index last] -state]
2088 # -- Commit Menu
2090 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2091 menu .mbar.commit
2093 .mbar.commit add radiobutton \
2094 -label [mc "New Commit"] \
2095 -command do_select_commit_type \
2096 -variable selected_commit_type \
2097 -value new
2098 lappend disable_on_lock \
2099 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2101 .mbar.commit add radiobutton \
2102 -label [mc "Amend Last Commit"] \
2103 -command do_select_commit_type \
2104 -variable selected_commit_type \
2105 -value amend
2106 lappend disable_on_lock \
2107 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2109 .mbar.commit add separator
2111 .mbar.commit add command -label [mc Rescan] \
2112 -command do_rescan \
2113 -accelerator F5
2114 lappend disable_on_lock \
2115 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2117 .mbar.commit add command -label [mc "Stage To Commit"] \
2118 -command do_add_selection \
2119 -accelerator $M1T-T
2120 lappend disable_on_lock \
2121 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2123 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2124 -command do_add_all \
2125 -accelerator $M1T-I
2126 lappend disable_on_lock \
2127 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2129 .mbar.commit add command -label [mc "Unstage From Commit"] \
2130 -command do_unstage_selection
2131 lappend disable_on_lock \
2132 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2134 .mbar.commit add command -label [mc "Revert Changes"] \
2135 -command do_revert_selection
2136 lappend disable_on_lock \
2137 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2139 .mbar.commit add separator
2141 .mbar.commit add command -label [mc "Show Less Context"] \
2142 -command show_less_context \
2143 -accelerator $M1T-\-
2145 .mbar.commit add command -label [mc "Show More Context"] \
2146 -command show_more_context \
2147 -accelerator $M1T-=
2149 .mbar.commit add separator
2151 .mbar.commit add command -label [mc "Sign Off"] \
2152 -command do_signoff \
2153 -accelerator $M1T-S
2155 .mbar.commit add command -label [mc Commit@@verb] \
2156 -command do_commit \
2157 -accelerator $M1T-Return
2158 lappend disable_on_lock \
2159 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2162 # -- Merge Menu
2164 if {[is_enabled branch]} {
2165 menu .mbar.merge
2166 .mbar.merge add command -label [mc "Local Merge..."] \
2167 -command merge::dialog \
2168 -accelerator $M1T-M
2169 lappend disable_on_lock \
2170 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2171 .mbar.merge add command -label [mc "Abort Merge..."] \
2172 -command merge::reset_hard
2173 lappend disable_on_lock \
2174 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2177 # -- Transport Menu
2179 if {[is_enabled transport]} {
2180 menu .mbar.remote
2182 .mbar.remote add command \
2183 -label [mc "Push..."] \
2184 -command do_push_anywhere \
2185 -accelerator $M1T-P
2186 .mbar.remote add command \
2187 -label [mc "Delete..."] \
2188 -command remote_branch_delete::dialog
2191 if {[is_MacOSX]} {
2192 # -- Apple Menu (Mac OS X only)
2194 .mbar add cascade -label Apple -menu .mbar.apple
2195 menu .mbar.apple
2197 .mbar.apple add command -label [mc "About %s" [appname]] \
2198 -command do_about
2199 .mbar.apple add separator
2200 .mbar.apple add command \
2201 -label [mc "Preferences..."] \
2202 -command do_options \
2203 -accelerator $M1T-,
2204 bind . <$M1B-,> do_options
2205 } else {
2206 # -- Edit Menu
2208 .mbar.edit add separator
2209 .mbar.edit add command -label [mc "Options..."] \
2210 -command do_options
2213 # -- Help Menu
2215 .mbar add cascade -label [mc Help] -menu .mbar.help
2216 menu .mbar.help
2218 if {![is_MacOSX]} {
2219 .mbar.help add command -label [mc "About %s" [appname]] \
2220 -command do_about
2223 set browser {}
2224 catch {set browser $repo_config(instaweb.browser)}
2225 set doc_path [file dirname [gitexec]]
2226 set doc_path [file join $doc_path Documentation index.html]
2228 if {[is_Cygwin]} {
2229 set doc_path [exec cygpath --mixed $doc_path]
2232 if {$browser eq {}} {
2233 if {[is_MacOSX]} {
2234 set browser open
2235 } elseif {[is_Cygwin]} {
2236 set program_files [file dirname [exec cygpath --windir]]
2237 set program_files [file join $program_files {Program Files}]
2238 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2239 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2240 if {[file exists $firefox]} {
2241 set browser $firefox
2242 } elseif {[file exists $ie]} {
2243 set browser $ie
2245 unset program_files firefox ie
2249 if {[file isfile $doc_path]} {
2250 set doc_url "file:$doc_path"
2251 } else {
2252 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2255 if {$browser ne {}} {
2256 .mbar.help add command -label [mc "Online Documentation"] \
2257 -command [list exec $browser $doc_url &]
2259 unset browser doc_path doc_url
2261 # -- Standard bindings
2263 wm protocol . WM_DELETE_WINDOW do_quit
2264 bind all <$M1B-Key-q> do_quit
2265 bind all <$M1B-Key-Q> do_quit
2266 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2267 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2269 set subcommand_args {}
2270 proc usage {} {
2271 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2272 exit 1
2275 # -- Not a normal commit type invocation? Do that instead!
2277 switch -- $subcommand {
2278 browser -
2279 blame {
2280 set subcommand_args {rev? path}
2281 if {$argv eq {}} usage
2282 set head {}
2283 set path {}
2284 set is_path 0
2285 foreach a $argv {
2286 if {$is_path || [file exists $_prefix$a]} {
2287 if {$path ne {}} usage
2288 set path $_prefix$a
2289 break
2290 } elseif {$a eq {--}} {
2291 if {$path ne {}} {
2292 if {$head ne {}} usage
2293 set head $path
2294 set path {}
2296 set is_path 1
2297 } elseif {$head eq {}} {
2298 if {$head ne {}} usage
2299 set head $a
2300 set is_path 1
2301 } else {
2302 usage
2305 unset is_path
2307 if {$head ne {} && $path eq {}} {
2308 set path $_prefix$head
2309 set head {}
2312 if {$head eq {}} {
2313 load_current_branch
2314 } else {
2315 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2316 if {[catch {
2317 set head [git rev-parse --verify $head]
2318 } err]} {
2319 puts stderr $err
2320 exit 1
2323 set current_branch $head
2326 switch -- $subcommand {
2327 browser {
2328 if {$head eq {}} {
2329 if {$path ne {} && [file isdirectory $path]} {
2330 set head $current_branch
2331 } else {
2332 set head $path
2333 set path {}
2336 browser::new $head $path
2338 blame {
2339 if {$head eq {} && ![file exists $path]} {
2340 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2341 exit 1
2343 blame::new $head $path
2346 return
2348 citool -
2349 gui {
2350 if {[llength $argv] != 0} {
2351 puts -nonewline stderr "usage: $argv0"
2352 if {$subcommand ne {gui}
2353 && [file tail $argv0] ne "git-$subcommand"} {
2354 puts -nonewline stderr " $subcommand"
2356 puts stderr {}
2357 exit 1
2359 # fall through to setup UI for commits
2361 default {
2362 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2363 exit 1
2367 # -- Branch Control
2369 frame .branch \
2370 -borderwidth 1 \
2371 -relief sunken
2372 label .branch.l1 \
2373 -text [mc "Current Branch:"] \
2374 -anchor w \
2375 -justify left
2376 label .branch.cb \
2377 -textvariable current_branch \
2378 -anchor w \
2379 -justify left
2380 pack .branch.l1 -side left
2381 pack .branch.cb -side left -fill x
2382 pack .branch -side top -fill x
2384 # -- Main Window Layout
2386 panedwindow .vpane -orient horizontal
2387 panedwindow .vpane.files -orient vertical
2388 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2389 pack .vpane -anchor n -side top -fill both -expand 1
2391 # -- Index File List
2393 frame .vpane.files.index -height 100 -width 200
2394 label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2395 -background lightgreen -foreground black
2396 text $ui_index -background white -foreground black \
2397 -borderwidth 0 \
2398 -width 20 -height 10 \
2399 -wrap none \
2400 -cursor $cursor_ptr \
2401 -xscrollcommand {.vpane.files.index.sx set} \
2402 -yscrollcommand {.vpane.files.index.sy set} \
2403 -state disabled
2404 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2405 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2406 pack .vpane.files.index.title -side top -fill x
2407 pack .vpane.files.index.sx -side bottom -fill x
2408 pack .vpane.files.index.sy -side right -fill y
2409 pack $ui_index -side left -fill both -expand 1
2411 # -- Working Directory File List
2413 frame .vpane.files.workdir -height 100 -width 200
2414 label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2415 -background lightsalmon -foreground black
2416 text $ui_workdir -background white -foreground black \
2417 -borderwidth 0 \
2418 -width 20 -height 10 \
2419 -wrap none \
2420 -cursor $cursor_ptr \
2421 -xscrollcommand {.vpane.files.workdir.sx set} \
2422 -yscrollcommand {.vpane.files.workdir.sy set} \
2423 -state disabled
2424 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2425 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2426 pack .vpane.files.workdir.title -side top -fill x
2427 pack .vpane.files.workdir.sx -side bottom -fill x
2428 pack .vpane.files.workdir.sy -side right -fill y
2429 pack $ui_workdir -side left -fill both -expand 1
2431 .vpane.files add .vpane.files.workdir -sticky nsew
2432 .vpane.files add .vpane.files.index -sticky nsew
2434 foreach i [list $ui_index $ui_workdir] {
2435 rmsel_tag $i
2436 $i tag conf in_diff -background [$i tag cget in_sel -background]
2438 unset i
2440 # -- Diff and Commit Area
2442 frame .vpane.lower -height 300 -width 400
2443 frame .vpane.lower.commarea
2444 frame .vpane.lower.diff -relief sunken -borderwidth 1
2445 pack .vpane.lower.diff -fill both -expand 1
2446 pack .vpane.lower.commarea -side bottom -fill x
2447 .vpane add .vpane.lower -sticky nsew
2449 # -- Commit Area Buttons
2451 frame .vpane.lower.commarea.buttons
2452 label .vpane.lower.commarea.buttons.l -text {} \
2453 -anchor w \
2454 -justify left
2455 pack .vpane.lower.commarea.buttons.l -side top -fill x
2456 pack .vpane.lower.commarea.buttons -side left -fill y
2458 button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2459 -command do_rescan
2460 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2461 lappend disable_on_lock \
2462 {.vpane.lower.commarea.buttons.rescan conf -state}
2464 button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2465 -command do_add_all
2466 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2467 lappend disable_on_lock \
2468 {.vpane.lower.commarea.buttons.incall conf -state}
2470 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2471 -command do_signoff
2472 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2474 button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
2475 -command do_commit
2476 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2477 lappend disable_on_lock \
2478 {.vpane.lower.commarea.buttons.commit conf -state}
2480 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2481 -command do_push_anywhere
2482 pack .vpane.lower.commarea.buttons.push -side top -fill x
2484 # -- Commit Message Buffer
2486 frame .vpane.lower.commarea.buffer
2487 frame .vpane.lower.commarea.buffer.header
2488 set ui_comm .vpane.lower.commarea.buffer.t
2489 set ui_coml .vpane.lower.commarea.buffer.header.l
2490 radiobutton .vpane.lower.commarea.buffer.header.new \
2491 -text [mc "New Commit"] \
2492 -command do_select_commit_type \
2493 -variable selected_commit_type \
2494 -value new
2495 lappend disable_on_lock \
2496 [list .vpane.lower.commarea.buffer.header.new conf -state]
2497 radiobutton .vpane.lower.commarea.buffer.header.amend \
2498 -text [mc "Amend Last Commit"] \
2499 -command do_select_commit_type \
2500 -variable selected_commit_type \
2501 -value amend
2502 lappend disable_on_lock \
2503 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2504 label $ui_coml \
2505 -anchor w \
2506 -justify left
2507 proc trace_commit_type {varname args} {
2508 global ui_coml commit_type
2509 switch -glob -- $commit_type {
2510 initial {set txt [mc "Initial Commit Message:"]}
2511 amend {set txt [mc "Amended Commit Message:"]}
2512 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2513 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2514 merge {set txt [mc "Merge Commit Message:"]}
2515 * {set txt [mc "Commit Message:"]}
2517 $ui_coml conf -text $txt
2519 trace add variable commit_type write trace_commit_type
2520 pack $ui_coml -side left -fill x
2521 pack .vpane.lower.commarea.buffer.header.amend -side right
2522 pack .vpane.lower.commarea.buffer.header.new -side right
2524 text $ui_comm -background white -foreground black \
2525 -borderwidth 1 \
2526 -undo true \
2527 -maxundo 20 \
2528 -autoseparators true \
2529 -relief sunken \
2530 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
2531 -font font_diff \
2532 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2533 scrollbar .vpane.lower.commarea.buffer.sby \
2534 -command [list $ui_comm yview]
2535 pack .vpane.lower.commarea.buffer.header -side top -fill x
2536 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2537 pack $ui_comm -side left -fill y
2538 pack .vpane.lower.commarea.buffer -side left -fill y
2540 # -- Commit Message Buffer Context Menu
2542 set ctxm .vpane.lower.commarea.buffer.ctxm
2543 menu $ctxm -tearoff 0
2544 $ctxm add command \
2545 -label [mc Cut] \
2546 -command {tk_textCut $ui_comm}
2547 $ctxm add command \
2548 -label [mc Copy] \
2549 -command {tk_textCopy $ui_comm}
2550 $ctxm add command \
2551 -label [mc Paste] \
2552 -command {tk_textPaste $ui_comm}
2553 $ctxm add command \
2554 -label [mc Delete] \
2555 -command {$ui_comm delete sel.first sel.last}
2556 $ctxm add separator
2557 $ctxm add command \
2558 -label [mc "Select All"] \
2559 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2560 $ctxm add command \
2561 -label [mc "Copy All"] \
2562 -command {
2563 $ui_comm tag add sel 0.0 end
2564 tk_textCopy $ui_comm
2565 $ui_comm tag remove sel 0.0 end
2567 $ctxm add separator
2568 $ctxm add command \
2569 -label [mc "Sign Off"] \
2570 -command do_signoff
2571 set ui_comm_ctxm $ctxm
2573 # -- Diff Header
2575 proc trace_current_diff_path {varname args} {
2576 global current_diff_path diff_actions file_states
2577 if {$current_diff_path eq {}} {
2578 set s {}
2579 set f {}
2580 set p {}
2581 set o disabled
2582 } else {
2583 set p $current_diff_path
2584 set s [mapdesc [lindex $file_states($p) 0] $p]
2585 set f [mc "File:"]
2586 set p [escape_path $p]
2587 set o normal
2590 .vpane.lower.diff.header.status configure -text $s
2591 .vpane.lower.diff.header.file configure -text $f
2592 .vpane.lower.diff.header.path configure -text $p
2593 foreach w $diff_actions {
2594 uplevel #0 $w $o
2597 trace add variable current_diff_path write trace_current_diff_path
2599 frame .vpane.lower.diff.header -background gold
2600 label .vpane.lower.diff.header.status \
2601 -background gold \
2602 -foreground black \
2603 -width $max_status_desc \
2604 -anchor w \
2605 -justify left
2606 label .vpane.lower.diff.header.file \
2607 -background gold \
2608 -foreground black \
2609 -anchor w \
2610 -justify left
2611 label .vpane.lower.diff.header.path \
2612 -background gold \
2613 -foreground black \
2614 -anchor w \
2615 -justify left
2616 pack .vpane.lower.diff.header.status -side left
2617 pack .vpane.lower.diff.header.file -side left
2618 pack .vpane.lower.diff.header.path -fill x
2619 set ctxm .vpane.lower.diff.header.ctxm
2620 menu $ctxm -tearoff 0
2621 $ctxm add command \
2622 -label [mc Copy] \
2623 -command {
2624 clipboard clear
2625 clipboard append \
2626 -format STRING \
2627 -type STRING \
2628 -- $current_diff_path
2630 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2631 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2633 # -- Diff Body
2635 frame .vpane.lower.diff.body
2636 set ui_diff .vpane.lower.diff.body.t
2637 text $ui_diff -background white -foreground black \
2638 -borderwidth 0 \
2639 -width 80 -height 15 -wrap none \
2640 -font font_diff \
2641 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2642 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2643 -state disabled
2644 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2645 -command [list $ui_diff xview]
2646 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2647 -command [list $ui_diff yview]
2648 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2649 pack .vpane.lower.diff.body.sby -side right -fill y
2650 pack $ui_diff -side left -fill both -expand 1
2651 pack .vpane.lower.diff.header -side top -fill x
2652 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2654 $ui_diff tag conf d_cr -elide true
2655 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2656 $ui_diff tag conf d_+ -foreground {#00a000}
2657 $ui_diff tag conf d_- -foreground red
2659 $ui_diff tag conf d_++ -foreground {#00a000}
2660 $ui_diff tag conf d_-- -foreground red
2661 $ui_diff tag conf d_+s \
2662 -foreground {#00a000} \
2663 -background {#e2effa}
2664 $ui_diff tag conf d_-s \
2665 -foreground red \
2666 -background {#e2effa}
2667 $ui_diff tag conf d_s+ \
2668 -foreground {#00a000} \
2669 -background ivory1
2670 $ui_diff tag conf d_s- \
2671 -foreground red \
2672 -background ivory1
2674 $ui_diff tag conf d<<<<<<< \
2675 -foreground orange \
2676 -font font_diffbold
2677 $ui_diff tag conf d======= \
2678 -foreground orange \
2679 -font font_diffbold
2680 $ui_diff tag conf d>>>>>>> \
2681 -foreground orange \
2682 -font font_diffbold
2684 $ui_diff tag raise sel
2686 # -- Diff Body Context Menu
2688 set ctxm .vpane.lower.diff.body.ctxm
2689 menu $ctxm -tearoff 0
2690 $ctxm add command \
2691 -label [mc "Apply/Reverse Hunk"] \
2692 -command {apply_hunk $cursorX $cursorY}
2693 set ui_diff_applyhunk [$ctxm index last]
2694 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2695 $ctxm add command \
2696 -label [mc "Apply/Reverse Line"] \
2697 -command {apply_line $cursorX $cursorY; do_rescan}
2698 set ui_diff_applyline [$ctxm index last]
2699 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
2700 $ctxm add separator
2701 $ctxm add command \
2702 -label [mc "Show Less Context"] \
2703 -command show_less_context
2704 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2705 $ctxm add command \
2706 -label [mc "Show More Context"] \
2707 -command show_more_context
2708 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2709 $ctxm add separator
2710 $ctxm add command \
2711 -label [mc Refresh] \
2712 -command reshow_diff
2713 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2714 $ctxm add command \
2715 -label [mc Copy] \
2716 -command {tk_textCopy $ui_diff}
2717 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2718 $ctxm add command \
2719 -label [mc "Select All"] \
2720 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2721 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2722 $ctxm add command \
2723 -label [mc "Copy All"] \
2724 -command {
2725 $ui_diff tag add sel 0.0 end
2726 tk_textCopy $ui_diff
2727 $ui_diff tag remove sel 0.0 end
2729 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2730 $ctxm add separator
2731 $ctxm add command \
2732 -label [mc "Decrease Font Size"] \
2733 -command {incr_font_size font_diff -1}
2734 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2735 $ctxm add command \
2736 -label [mc "Increase Font Size"] \
2737 -command {incr_font_size font_diff 1}
2738 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2739 $ctxm add separator
2740 $ctxm add command -label [mc "Options..."] \
2741 -command do_options
2742 proc popup_diff_menu {ctxm x y X Y} {
2743 global current_diff_path file_states
2744 set ::cursorX $x
2745 set ::cursorY $y
2746 if {$::ui_index eq $::current_diff_side} {
2747 set l [mc "Unstage Hunk From Commit"]
2748 set t [mc "Unstage Line From Commit"]
2749 } else {
2750 set l [mc "Stage Hunk For Commit"]
2751 set t [mc "Stage Line For Commit"]
2753 if {$::is_3way_diff
2754 || $current_diff_path eq {}
2755 || ![info exists file_states($current_diff_path)]
2756 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2757 set s disabled
2758 } else {
2759 set s normal
2761 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2762 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
2763 tk_popup $ctxm $X $Y
2765 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2767 # -- Status Bar
2769 set main_status [::status_bar::new .status]
2770 pack .status -anchor w -side bottom -fill x
2771 $main_status show [mc "Initializing..."]
2773 # -- Load geometry
2775 catch {
2776 set gm $repo_config(gui.geometry)
2777 wm geometry . [lindex $gm 0]
2778 .vpane sash place 0 \
2779 [lindex $gm 1] \
2780 [lindex [.vpane sash coord 0] 1]
2781 .vpane.files sash place 0 \
2782 [lindex [.vpane.files sash coord 0] 0] \
2783 [lindex $gm 2]
2784 unset gm
2787 # -- Key Bindings
2789 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2790 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
2791 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
2792 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2793 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2794 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2795 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2796 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2797 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2798 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2799 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2800 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2801 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2802 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
2803 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
2804 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
2805 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
2806 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
2808 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2809 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2810 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2811 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2812 bind $ui_diff <$M1B-Key-v> {break}
2813 bind $ui_diff <$M1B-Key-V> {break}
2814 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2815 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2816 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2817 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2818 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2819 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2820 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2821 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2822 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2823 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2824 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2825 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2826 bind $ui_diff <Button-1> {focus %W}
2828 if {[is_enabled branch]} {
2829 bind . <$M1B-Key-n> branch_create::dialog
2830 bind . <$M1B-Key-N> branch_create::dialog
2831 bind . <$M1B-Key-o> branch_checkout::dialog
2832 bind . <$M1B-Key-O> branch_checkout::dialog
2833 bind . <$M1B-Key-m> merge::dialog
2834 bind . <$M1B-Key-M> merge::dialog
2836 if {[is_enabled transport]} {
2837 bind . <$M1B-Key-p> do_push_anywhere
2838 bind . <$M1B-Key-P> do_push_anywhere
2841 bind . <Key-F5> do_rescan
2842 bind . <$M1B-Key-r> do_rescan
2843 bind . <$M1B-Key-R> do_rescan
2844 bind . <$M1B-Key-s> do_signoff
2845 bind . <$M1B-Key-S> do_signoff
2846 bind . <$M1B-Key-t> do_add_selection
2847 bind . <$M1B-Key-T> do_add_selection
2848 bind . <$M1B-Key-i> do_add_all
2849 bind . <$M1B-Key-I> do_add_all
2850 bind . <$M1B-Key-minus> {show_less_context;break}
2851 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
2852 bind . <$M1B-Key-equal> {show_more_context;break}
2853 bind . <$M1B-Key-plus> {show_more_context;break}
2854 bind . <$M1B-Key-KP_Add> {show_more_context;break}
2855 bind . <$M1B-Key-Return> do_commit
2856 foreach i [list $ui_index $ui_workdir] {
2857 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2858 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2859 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2861 unset i
2863 set file_lists($ui_index) [list]
2864 set file_lists($ui_workdir) [list]
2866 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2867 focus -force $ui_comm
2869 # -- Warn the user about environmental problems. Cygwin's Tcl
2870 # does *not* pass its env array onto any processes it spawns.
2871 # This means that git processes get none of our environment.
2873 if {[is_Cygwin]} {
2874 set ignored_env 0
2875 set suggest_user {}
2876 set msg [mc "Possible environment issues exist.
2878 The following environment variables are probably
2879 going to be ignored by any Git subprocess run
2880 by %s:
2882 " [appname]]
2883 foreach name [array names env] {
2884 switch -regexp -- $name {
2885 {^GIT_INDEX_FILE$} -
2886 {^GIT_OBJECT_DIRECTORY$} -
2887 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2888 {^GIT_DIFF_OPTS$} -
2889 {^GIT_EXTERNAL_DIFF$} -
2890 {^GIT_PAGER$} -
2891 {^GIT_TRACE$} -
2892 {^GIT_CONFIG$} -
2893 {^GIT_CONFIG_LOCAL$} -
2894 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2895 append msg " - $name\n"
2896 incr ignored_env
2898 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2899 append msg " - $name\n"
2900 incr ignored_env
2901 set suggest_user $name
2905 if {$ignored_env > 0} {
2906 append msg [mc "
2907 This is due to a known issue with the
2908 Tcl binary distributed by Cygwin."]
2910 if {$suggest_user ne {}} {
2911 append msg [mc "
2913 A good replacement for %s
2914 is placing values for the user.name and
2915 user.email settings into your personal
2916 ~/.gitconfig file.
2917 " $suggest_user]
2919 warn_popup $msg
2921 unset ignored_env msg suggest_user name
2924 # -- Only initialize complex UI if we are going to stay running.
2926 if {[is_enabled transport]} {
2927 load_all_remotes
2929 set n [.mbar.remote index end]
2930 populate_push_menu
2931 populate_fetch_menu
2932 set n [expr {[.mbar.remote index end] - $n}]
2933 if {$n > 0} {
2934 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
2935 .mbar.remote insert $n separator
2937 unset n
2940 if {[winfo exists $ui_comm]} {
2941 set GITGUI_BCK_exists [load_message GITGUI_BCK]
2943 # -- If both our backup and message files exist use the
2944 # newer of the two files to initialize the buffer.
2946 if {$GITGUI_BCK_exists} {
2947 set m [gitdir GITGUI_MSG]
2948 if {[file isfile $m]} {
2949 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2950 catch {file delete [gitdir GITGUI_MSG]}
2951 } else {
2952 $ui_comm delete 0.0 end
2953 $ui_comm edit reset
2954 $ui_comm edit modified false
2955 catch {file delete [gitdir GITGUI_BCK]}
2956 set GITGUI_BCK_exists 0
2959 unset m
2962 proc backup_commit_buffer {} {
2963 global ui_comm GITGUI_BCK_exists
2965 set m [$ui_comm edit modified]
2966 if {$m || $GITGUI_BCK_exists} {
2967 set msg [string trim [$ui_comm get 0.0 end]]
2968 regsub -all -line {[ \r\t]+$} $msg {} msg
2970 if {$msg eq {}} {
2971 if {$GITGUI_BCK_exists} {
2972 catch {file delete [gitdir GITGUI_BCK]}
2973 set GITGUI_BCK_exists 0
2975 } elseif {$m} {
2976 catch {
2977 set fd [open [gitdir GITGUI_BCK] w]
2978 puts -nonewline $fd $msg
2979 close $fd
2980 set GITGUI_BCK_exists 1
2984 $ui_comm edit modified false
2987 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2990 backup_commit_buffer
2992 # -- If the user has aspell available we can drive it
2993 # in pipe mode to spellcheck the commit message.
2995 set spell_cmd [list |]
2996 set spell_dict [get_config gui.spellingdictionary]
2997 lappend spell_cmd aspell
2998 if {$spell_dict ne {}} {
2999 lappend spell_cmd --master=$spell_dict
3001 lappend spell_cmd --mode=none
3002 lappend spell_cmd --encoding=utf-8
3003 lappend spell_cmd pipe
3004 if {$spell_dict eq {none}
3005 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3006 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3007 } else {
3008 set ui_comm_spell [spellcheck::init \
3009 $spell_fd \
3010 $ui_comm \
3011 $ui_comm_ctxm \
3014 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3017 lock_index begin-read
3018 if {![winfo ismapped .]} {
3019 wm deiconify .
3021 after 1 do_rescan
3022 if {[is_enabled multicommit]} {
3023 after 1000 hint_gc