2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 || test "z$*" = z--version; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
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]
41 -title [mc "git-gui: fatal error"] \
46 catch {rename send {}} ; # What an evil concept...
48 ######################################################################
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]
66 set oguimsg [file join $oguilib msgs]
70 ######################################################################
72 ## enable verbose loading?
74 if {![catch {set _verbose $env(GITGUI_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
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
96 set cmk [string first @@ $fmt]
98 return [string range $fmt 0 [expr {$cmk - 1}]]
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]
112 return [join $args {}]
115 ::msgcat::mcload $oguimsg
118 ######################################################################
122 set _appname {Git Gui}
132 set _trace [lsearch -exact $argv --trace]
134 set argv [lreplace $argv $_trace $_trace]
150 return [eval [list file join $_gitdir] $args]
153 proc gitexec {args} {
155 if {$_gitexec eq {}} {
156 if {[catch {set _gitexec [git --exec-path]} err]} {
157 error "Git not installed?\n\n$err"
160 set _gitexec [exec cygpath \
165 set _gitexec [file normalize $_gitexec]
171 return [eval [list file join $_gitexec] $args]
174 proc githtmldir {args} {
176 if {$_githtmldir eq {}} {
177 if {[catch {set _githtmldir [git --html-path]}]} {
178 # Git not installed or option not yet supported
182 set _githtmldir [exec cygpath \
187 set _githtmldir [file normalize $_githtmldir]
193 return [eval [list file join $_githtmldir] $args]
201 if {[tk windowingsystem] eq {aqua}} {
208 if {$::tcl_platform(platform) eq {windows}} {
216 if {$_iscygwin eq {}} {
217 if {$::tcl_platform(platform) eq {windows}} {
218 if {[catch {set p [exec cygpath --windir]} err]} {
230 proc is_enabled {option} {
231 global enabled_options
232 if {[catch {set on $enabled_options($option)}]} {return 0}
236 proc enable_option {option} {
237 global enabled_options
238 set enabled_options($option) 1
241 proc disable_option {option} {
242 global enabled_options
243 set enabled_options($option) 0
246 ######################################################################
250 proc is_many_config {name} {
251 switch -glob -- $name {
261 proc is_config_true {name} {
263 if {[catch {set v $repo_config($name)}]} {
265 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
272 proc get_config {name} {
274 if {[catch {set v $repo_config($name)}]} {
286 if {$_isbare eq {}} {
288 set _bare [git rev-parse --is-bare-repository]
290 true { set _isbare 1 }
291 false { set _isbare 0}
295 if {[is_config_true core.bare]
296 || ($_gitworktree eq {}
297 && [lindex [file split $_gitdir] end] ne {.git})} {
307 ######################################################################
311 proc _trace_exec {cmd} {
312 if {!$::_trace} return
318 if {[regexp {[ \t\r\n'"$?*]} $v]} {
326 proc _git_cmd {name} {
329 if {[catch {set v $_git_cmd_path($name)}]} {
333 --exec-path { return [list $::_git $name] }
336 set p [gitexec git-$name$::_search_exe]
337 if {[file exists $p]} {
339 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
340 # Try to determine what sort of magic will make
341 # git-$name go and do its thing, because native
342 # Tcl on Windows doesn't know it.
344 set p [gitexec git-$name]
349 switch -glob -- [lindex $s 0] {
351 #!*perl { set i perl }
352 #!*python { set i python }
353 default { error "git-$name is not supported: $s" }
357 if {![info exists interp]} {
358 set interp [_which $i]
361 error "git-$name requires $i (not in PATH)"
363 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
365 # Assume it is builtin to git somehow and we
366 # aren't actually able to see a file for it.
368 set v [list $::_git $name]
370 set _git_cmd_path($name) $v
375 proc _which {what args} {
376 global env _search_exe _search_path
378 if {$_search_path eq {}} {
379 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
380 set _search_path [split [exec cygpath \
386 } elseif {[is_Windows]} {
387 set gitguidir [file dirname [info script]]
388 regsub -all ";" $gitguidir "\\;" gitguidir
389 set env(PATH) "$gitguidir;$env(PATH)"
390 set _search_path [split $env(PATH) {;}]
393 set _search_path [split $env(PATH) :]
398 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
401 set suffix $_search_exe
404 foreach p $_search_path {
405 set p [file join $p $what$suffix]
406 if {[file exists $p]} {
407 return [file normalize $p]
413 proc _lappend_nice {cmd_var} {
417 if {![info exists _nice]} {
418 set _nice [_which nice]
419 if {[catch {exec $_nice git version}]} {
432 switch -- [lindex $args 0] {
443 set args [lrange $args 1 end]
446 set cmdp [_git_cmd [lindex $args 0]]
447 set args [lrange $args 1 end]
449 _trace_exec [concat $opt $cmdp $args]
450 set result [eval exec $opt $cmdp $args]
452 puts stderr "< $result"
457 proc _open_stdout_stderr {cmd} {
460 set fd [open [concat [list | ] $cmd] r]
462 if { [lindex $cmd end] eq {2>@1}
463 && $err eq {can not find channel named "1"}
465 # Older versions of Tcl 8.4 don't have this 2>@1 IO
466 # redirect operator. Fallback to |& cat for those.
467 # The command was not actually started, so its safe
468 # to try to start it a second time.
470 set fd [open [concat \
472 [lrange $cmd 0 end-1] \
479 fconfigure $fd -eofchar {}
483 proc git_read {args} {
487 switch -- [lindex $args 0] {
502 set args [lrange $args 1 end]
505 set cmdp [_git_cmd [lindex $args 0]]
506 set args [lrange $args 1 end]
508 return [_open_stdout_stderr [concat $opt $cmdp $args]]
511 proc git_write {args} {
515 switch -- [lindex $args 0] {
526 set args [lrange $args 1 end]
529 set cmdp [_git_cmd [lindex $args 0]]
530 set args [lrange $args 1 end]
532 _trace_exec [concat $opt $cmdp $args]
533 return [open [concat [list | ] $opt $cmdp $args] w]
536 proc githook_read {hook_name args} {
537 set pchook [gitdir hooks $hook_name]
540 # On Windows [file executable] might lie so we need to ask
541 # the shell if the hook is executable. Yes that's annoying.
545 if {![info exists interp]} {
546 set interp [_which sh]
549 error "hook execution requires sh (not in PATH)"
552 set scr {if test -x "$1";then exec "$@";fi}
553 set sh_c [list $interp -c $scr $interp $pchook]
554 return [_open_stdout_stderr [concat $sh_c $args]]
557 if {[file executable $pchook]} {
558 return [_open_stdout_stderr [concat [list $pchook] $args]]
564 proc kill_file_process {fd} {
565 set process [pid $fd]
569 # Use a Cygwin-specific flag to allow killing
570 # native Windows processes
571 exec kill -f $process
578 proc gitattr {path attr default} {
579 if {[catch {set r [git check-attr $attr -- $path]}]} {
582 set r [join [lrange [split $r :] 2 end] :]
585 if {$r eq {unspecified}} {
592 regsub -all ' $value "'\\''" value
596 proc load_current_branch {} {
597 global current_branch is_detached
599 set fd [open [gitdir HEAD] r]
600 if {[gets $fd ref] < 1} {
605 set pfx {ref: refs/heads/}
606 set len [string length $pfx]
607 if {[string equal -length $len $pfx $ref]} {
608 # We're on a branch. It might not exist. But
609 # HEAD looks good enough to be a branch.
611 set current_branch [string range $ref $len end]
614 # Assume this is a detached head.
616 set current_branch HEAD
621 auto_load tk_optionMenu
622 rename tk_optionMenu real__tkOptionMenu
623 proc tk_optionMenu {w varName args} {
624 set m [eval real__tkOptionMenu $w $varName $args]
625 $m configure -font font_ui
626 $w configure -font font_ui
630 proc rmsel_tag {text} {
632 -background [$text cget -background] \
633 -foreground [$text cget -foreground] \
635 $text tag conf in_sel -background lightgray
636 bind $text <Motion> break
641 bind . <Visibility> {
642 bind . <Visibility> {}
647 wm iconbitmap . -default $oguilib/git-gui.ico
648 set ::tk::AlwaysShowSelection 1
650 # Spoof an X11 display for SSH
651 if {![info exists env(DISPLAY)]} {
652 set env(DISPLAY) :9999
656 image create photo gitlogo -width 16 -height 16
658 gitlogo put #33CC33 -to 7 0 9 2
659 gitlogo put #33CC33 -to 4 2 12 4
660 gitlogo put #33CC33 -to 7 4 9 6
661 gitlogo put #CC3333 -to 4 6 12 8
662 gitlogo put gray26 -to 4 9 6 10
663 gitlogo put gray26 -to 3 10 6 12
664 gitlogo put gray26 -to 8 9 13 11
665 gitlogo put gray26 -to 8 11 10 12
666 gitlogo put gray26 -to 11 11 13 14
667 gitlogo put gray26 -to 3 12 5 14
668 gitlogo put gray26 -to 5 13
669 gitlogo put gray26 -to 10 13
670 gitlogo put gray26 -to 4 14 12 15
671 gitlogo put gray26 -to 5 15 11 16
674 wm iconphoto . -default gitlogo
678 ######################################################################
684 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
685 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
686 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
688 font create font_diff -family Courier -size 10
691 eval font configure font_ui [font actual [.dummy cget -font]]
696 font create font_uiitalic
697 font create font_uibold
698 font create font_diffbold
699 font create font_diffitalic
701 foreach class {Button Checkbutton Entry Label
702 Labelframe Listbox Message
703 Radiobutton Spinbox Text} {
704 option add *$class.font font_ui
707 option add *Menu.font font_ui
708 option add *Entry.borderWidth 1 startupFile
709 option add *Entry.relief sunken startupFile
710 option add *RadioButton.anchor w startupFile
714 if {[is_Windows] || [is_MacOSX]} {
715 option add *Menu.tearOff 0
726 proc bind_button3 {w cmd} {
727 bind $w <Any-Button-3> $cmd
729 # Mac OS X sends Button-2 on right click through three-button mouse,
730 # or through trackpad right-clicking (two-finger touch + click).
731 bind $w <Any-Button-2> $cmd
732 bind $w <Control-Button-1> $cmd
736 proc apply_config {} {
737 global repo_config font_descs
739 foreach option $font_descs {
740 set name [lindex $option 0]
741 set font [lindex $option 1]
744 foreach {cn cv} $repo_config(gui.$name) {
745 if {$cn eq {-weight}} {
748 font configure $font $cn $cv
751 font configure $font -weight normal
754 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
756 foreach {cn cv} [font configure $font] {
757 font configure ${font}bold $cn $cv
758 font configure ${font}italic $cn $cv
760 font configure ${font}bold -weight bold
761 font configure ${font}italic -slant italic
767 if {$repo_config(gui.usettk)} {
768 set use_ttk [package vsatisfies [package provide Tk] 8.5]
771 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
777 set default_config(branch.autosetupmerge) true
778 set default_config(merge.tool) {}
779 set default_config(mergetool.keepbackup) true
780 set default_config(merge.diffstat) true
781 set default_config(merge.summary) false
782 set default_config(merge.verbosity) 2
783 set default_config(user.name) {}
784 set default_config(user.email) {}
786 set default_config(gui.encoding) [encoding system]
787 set default_config(gui.matchtrackingbranch) false
788 set default_config(gui.pruneduringfetch) false
789 set default_config(gui.trustmtime) false
790 set default_config(gui.fastcopyblame) false
791 set default_config(gui.copyblamethreshold) 40
792 set default_config(gui.blamehistoryctx) 7
793 set default_config(gui.diffcontext) 5
794 set default_config(gui.commitmsgwidth) 75
795 set default_config(gui.newbranchtemplate) {}
796 set default_config(gui.spellingdictionary) {}
797 set default_config(gui.fontui) [font configure font_ui]
798 set default_config(gui.fontdiff) [font configure font_diff]
799 # TODO: this option should be added to the git-config documentation
800 set default_config(gui.maxfilesdisplayed) 5000
801 set default_config(gui.usettk) 1
803 {fontui font_ui {mc "Main Font"}}
804 {fontdiff font_diff {mc "Diff/Console Font"}}
807 ######################################################################
811 set _git [_which git]
813 catch {wm withdraw .}
817 -title [mc "git-gui: fatal error"] \
818 -message [mc "Cannot find git in PATH."]
822 ######################################################################
826 if {[catch {set _git_version [git --version]} err]} {
827 catch {wm withdraw .}
831 -title [mc "git-gui: fatal error"] \
832 -message "Cannot determine Git version:
836 [appname] requires Git 1.5.0 or later."
839 if {![regsub {^git version } $_git_version {} _git_version]} {
840 catch {wm withdraw .}
844 -title [mc "git-gui: fatal error"] \
845 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
849 set _real_git_version $_git_version
850 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
851 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
852 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
853 regsub {\.GIT$} $_git_version {} _git_version
854 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
856 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
857 catch {wm withdraw .}
862 -title "[appname]: warning" \
863 -message [mc "Git version cannot be determined.
865 %s claims it is version '%s'.
867 %s requires at least Git 1.5.0 or later.
869 Assume '%s' is version 1.5.0?
870 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
871 set _git_version 1.5.0
876 unset _real_git_version
878 proc git-version {args} {
881 switch [llength $args] {
887 set op [lindex $args 0]
888 set vr [lindex $args 1]
889 set cm [package vcompare $_git_version $vr]
890 return [expr $cm $op 0]
894 set type [lindex $args 0]
895 set name [lindex $args 1]
896 set parm [lindex $args 2]
897 set body [lindex $args 3]
899 if {($type ne {proc} && $type ne {method})} {
900 error "Invalid arguments to git-version"
902 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
903 error "Last arm of $type $name must be default"
906 foreach {op vr cb} [lrange $body 0 end-2] {
907 if {[git-version $op $vr]} {
908 return [uplevel [list $type $name $parm $cb]]
912 return [uplevel [list $type $name $parm [lindex $body end]]]
916 error "git-version >= x"
922 if {[git-version < 1.5]} {
923 catch {wm withdraw .}
927 -title [mc "git-gui: fatal error"] \
928 -message "[appname] requires Git 1.5.0 or later.
930 You are using [git-version]:
936 ######################################################################
938 ## configure our library
940 set idx [file join $oguilib tclIndex]
941 if {[catch {set fd [open $idx r]} err]} {
942 catch {wm withdraw .}
946 -title [mc "git-gui: fatal error"] \
950 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
952 while {[gets $fd n] >= 0} {
953 if {$n ne {} && ![string match #* $n]} {
965 if {[lsearch -exact $loaded $p] >= 0} continue
966 source [file join $oguilib $p]
971 set auto_path [concat [list $oguilib] $auto_path]
973 unset -nocomplain idx fd
975 ######################################################################
977 ## config file parsing
979 git-version proc _parse_config {arr_name args} {
986 [list git_read config] \
988 [list --null --list]]
989 fconfigure $fd_rc -translation binary
990 set buf [read $fd_rc]
993 foreach line [split $buf "\0"] {
994 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
995 if {[is_many_config $name]} {
996 lappend arr($name) $value
998 set arr($name) $value
1007 set fd_rc [eval [list git_read config --list] $args]
1008 while {[gets $fd_rc line] >= 0} {
1009 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1010 if {[is_many_config $name]} {
1011 lappend arr($name) $value
1013 set arr($name) $value
1022 proc load_config {include_global} {
1023 global repo_config global_config system_config default_config
1025 if {$include_global} {
1026 _parse_config system_config --system
1027 _parse_config global_config --global
1029 _parse_config repo_config
1031 foreach name [array names default_config] {
1032 if {[catch {set v $system_config($name)}]} {
1033 set system_config($name) $default_config($name)
1036 foreach name [array names system_config] {
1037 if {[catch {set v $global_config($name)}]} {
1038 set global_config($name) $system_config($name)
1040 if {[catch {set v $repo_config($name)}]} {
1041 set repo_config($name) $system_config($name)
1046 ######################################################################
1048 ## feature option selection
1050 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1055 if {$subcommand eq {gui.sh}} {
1058 if {$subcommand eq {gui} && [llength $argv] > 0} {
1059 set subcommand [lindex $argv 0]
1060 set argv [lrange $argv 1 end]
1063 enable_option multicommit
1064 enable_option branch
1065 enable_option transport
1068 switch -- $subcommand {
1073 disable_option multicommit
1074 disable_option branch
1075 disable_option transport
1078 enable_option singlecommit
1079 enable_option retcode
1081 disable_option multicommit
1082 disable_option branch
1083 disable_option transport
1085 while {[llength $argv] > 0} {
1086 set a [lindex $argv 0]
1089 enable_option initialamend
1092 enable_option nocommit
1093 enable_option nocommitmsg
1096 disable_option nocommitmsg
1103 set argv [lrange $argv 1 end]
1108 ######################################################################
1110 ## execution environment
1112 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1114 # Suggest our implementation of askpass, if none is set
1115 if {![info exists env(SSH_ASKPASS)]} {
1116 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1119 ######################################################################
1125 set _gitdir $env(GIT_DIR)
1129 # beware that from the .git dir this sets _gitdir to .
1130 # and _prefix to the empty string
1131 set _gitdir [git rev-parse --git-dir]
1132 set _prefix [git rev-parse --show-prefix]
1136 choose_repository::pick
1140 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1141 # run from the .git dir itself) lest the routines to find the worktree
1143 if {$_gitdir eq "."} {
1147 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1148 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1150 if {![file isdirectory $_gitdir]} {
1151 catch {wm withdraw .}
1152 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1155 # _gitdir exists, so try loading the config
1158 # try to set work tree from environment, falling back to core.worktree
1159 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1160 set _gitworktree [get_config core.worktree]
1162 if {$_prefix ne {}} {
1163 if {$_gitworktree eq {}} {
1164 regsub -all {[^/]+/} $_prefix ../ cdup
1166 set cdup $_gitworktree
1168 if {[catch {cd $cdup} err]} {
1169 catch {wm withdraw .}
1170 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1173 set _gitworktree [pwd]
1175 } elseif {![is_enabled bare]} {
1177 catch {wm withdraw .}
1178 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1181 if {$_gitworktree eq {}} {
1182 set _gitworktree [file dirname $_gitdir]
1184 if {[catch {cd $_gitworktree} err]} {
1185 catch {wm withdraw .}
1186 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1189 set _gitworktree [pwd]
1191 set _reponame [file split [file normalize $_gitdir]]
1192 if {[lindex $_reponame end] eq {.git}} {
1193 set _reponame [lindex $_reponame end-1]
1195 set _reponame [lindex $_reponame end]
1198 set env(GIT_DIR) $_gitdir
1199 set env(GIT_WORK_TREE) $_gitworktree
1201 ######################################################################
1205 set current_diff_path {}
1206 set current_diff_side {}
1207 set diff_actions [list]
1211 set MERGE_HEAD [list]
1214 set current_branch {}
1216 set current_diff_path {}
1218 set is_submodule_diff 0
1219 set is_conflict_diff 0
1220 set selected_commit_type new
1221 set diff_empty_count 0
1223 set nullid "0000000000000000000000000000000000000000"
1224 set nullid2 "0000000000000000000000000000000000000001"
1226 ######################################################################
1234 set disable_on_lock [list]
1235 set index_lock_type none
1237 proc lock_index {type} {
1238 global index_lock_type disable_on_lock
1240 if {$index_lock_type eq {none}} {
1241 set index_lock_type $type
1242 foreach w $disable_on_lock {
1243 uplevel #0 $w disabled
1246 } elseif {$index_lock_type eq "begin-$type"} {
1247 set index_lock_type $type
1253 proc unlock_index {} {
1254 global index_lock_type disable_on_lock
1256 set index_lock_type none
1257 foreach w $disable_on_lock {
1258 uplevel #0 $w normal
1262 ######################################################################
1266 proc repository_state {ctvar hdvar mhvar} {
1267 global current_branch
1268 upvar $ctvar ct $hdvar hd $mhvar mh
1273 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1279 set merge_head [gitdir MERGE_HEAD]
1280 if {[file exists $merge_head]} {
1282 set fd_mh [open $merge_head r]
1283 while {[gets $fd_mh line] >= 0} {
1294 global PARENT empty_tree
1296 set p [lindex $PARENT 0]
1300 if {$empty_tree eq {}} {
1301 set empty_tree [git mktree << {}]
1306 proc force_amend {} {
1307 global selected_commit_type
1308 global HEAD PARENT MERGE_HEAD commit_type
1310 repository_state newType newHEAD newMERGE_HEAD
1313 set MERGE_HEAD $newMERGE_HEAD
1314 set commit_type $newType
1316 set selected_commit_type amend
1317 do_select_commit_type
1320 proc rescan {after {honor_trustmtime 1}} {
1321 global HEAD PARENT MERGE_HEAD commit_type
1322 global ui_index ui_workdir ui_comm
1323 global rescan_active file_states
1326 if {$rescan_active > 0 || ![lock_index read]} return
1328 repository_state newType newHEAD newMERGE_HEAD
1329 if {[string match amend* $commit_type]
1330 && $newType eq {normal}
1331 && $newHEAD eq $HEAD} {
1335 set MERGE_HEAD $newMERGE_HEAD
1336 set commit_type $newType
1339 array unset file_states
1341 if {!$::GITGUI_BCK_exists &&
1342 (![$ui_comm edit modified]
1343 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1344 if {[string match amend* $commit_type]} {
1345 } elseif {[load_message GITGUI_MSG]} {
1346 } elseif {[run_prepare_commit_msg_hook]} {
1347 } elseif {[load_message MERGE_MSG]} {
1348 } elseif {[load_message SQUASH_MSG]} {
1351 $ui_comm edit modified false
1354 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1355 rescan_stage2 {} $after
1358 ui_status [mc "Refreshing file status..."]
1359 set fd_rf [git_read update-index \
1365 fconfigure $fd_rf -blocking 0 -translation binary
1366 fileevent $fd_rf readable \
1367 [list rescan_stage2 $fd_rf $after]
1372 set is_git_info_exclude {}
1373 proc have_info_exclude {} {
1374 global is_git_info_exclude
1376 if {$is_git_info_exclude eq {}} {
1377 if {[catch {exec test -f [gitdir info exclude]}]} {
1378 set is_git_info_exclude 0
1380 set is_git_info_exclude 1
1383 return $is_git_info_exclude
1386 proc have_info_exclude {} {
1387 return [file readable [gitdir info exclude]]
1391 proc rescan_stage2 {fd after} {
1392 global rescan_active buf_rdi buf_rdf buf_rlo
1396 if {![eof $fd]} return
1400 set ls_others [list --exclude-per-directory=.gitignore]
1401 if {[have_info_exclude]} {
1402 lappend ls_others "--exclude-from=[gitdir info exclude]"
1404 set user_exclude [get_config core.excludesfile]
1405 if {$user_exclude ne {} && [file readable $user_exclude]} {
1406 lappend ls_others "--exclude-from=$user_exclude"
1414 ui_status [mc "Scanning for modified files ..."]
1415 set fd_di [git_read diff-index --cached -z [PARENT]]
1416 set fd_df [git_read diff-files -z]
1417 set fd_lo [eval git_read ls-files --others -z $ls_others]
1419 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1420 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1421 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1422 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1423 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1424 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1427 proc load_message {file} {
1430 set f [gitdir $file]
1431 if {[file isfile $f]} {
1432 if {[catch {set fd [open $f r]}]} {
1435 fconfigure $fd -eofchar {}
1436 set content [string trim [read $fd]]
1438 regsub -all -line {[ \r\t]+$} $content {} content
1439 $ui_comm delete 0.0 end
1440 $ui_comm insert end $content
1446 proc run_prepare_commit_msg_hook {} {
1449 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1450 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1451 # empty file but existant file.
1453 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1455 if {[file isfile [gitdir MERGE_MSG]]} {
1456 set pcm_source "merge"
1457 set fd_mm [open [gitdir MERGE_MSG] r]
1458 puts -nonewline $fd_pcm [read $fd_mm]
1460 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1461 set pcm_source "squash"
1462 set fd_sm [open [gitdir SQUASH_MSG] r]
1463 puts -nonewline $fd_pcm [read $fd_sm]
1471 set fd_ph [githook_read prepare-commit-msg \
1472 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1474 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1478 ui_status [mc "Calling prepare-commit-msg hook..."]
1481 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1482 fileevent $fd_ph readable \
1483 [list prepare_commit_msg_hook_wait $fd_ph]
1488 proc prepare_commit_msg_hook_wait {fd_ph} {
1491 append pch_error [read $fd_ph]
1492 fconfigure $fd_ph -blocking 1
1494 if {[catch {close $fd_ph}]} {
1495 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1496 hook_failed_popup prepare-commit-msg $pch_error
1497 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1500 load_message PREPARE_COMMIT_MSG
1503 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1506 fconfigure $fd_ph -blocking 0
1507 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1510 proc read_diff_index {fd after} {
1513 append buf_rdi [read $fd]
1515 set n [string length $buf_rdi]
1517 set z1 [string first "\0" $buf_rdi $c]
1518 if {$z1 == -1} break
1520 set z2 [string first "\0" $buf_rdi $z1]
1521 if {$z2 == -1} break
1524 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1525 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1527 [encoding convertfrom $p] \
1529 [list [lindex $i 0] [lindex $i 2]] \
1535 set buf_rdi [string range $buf_rdi $c end]
1540 rescan_done $fd buf_rdi $after
1543 proc read_diff_files {fd after} {
1546 append buf_rdf [read $fd]
1548 set n [string length $buf_rdf]
1550 set z1 [string first "\0" $buf_rdf $c]
1551 if {$z1 == -1} break
1553 set z2 [string first "\0" $buf_rdf $z1]
1554 if {$z2 == -1} break
1557 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1558 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1560 [encoding convertfrom $p] \
1563 [list [lindex $i 0] [lindex $i 2]]
1568 set buf_rdf [string range $buf_rdf $c end]
1573 rescan_done $fd buf_rdf $after
1576 proc read_ls_others {fd after} {
1579 append buf_rlo [read $fd]
1580 set pck [split $buf_rlo "\0"]
1581 set buf_rlo [lindex $pck end]
1582 foreach p [lrange $pck 0 end-1] {
1583 set p [encoding convertfrom $p]
1584 if {[string index $p end] eq {/}} {
1585 set p [string range $p 0 end-1]
1589 rescan_done $fd buf_rlo $after
1592 proc rescan_done {fd buf after} {
1593 global rescan_active current_diff_path
1594 global file_states repo_config
1597 if {![eof $fd]} return
1600 if {[incr rescan_active -1] > 0} return
1605 if {$current_diff_path ne {}} { reshow_diff $after }
1606 if {$current_diff_path eq {}} { select_first_diff $after }
1609 proc prune_selection {} {
1610 global file_states selected_paths
1612 foreach path [array names selected_paths] {
1613 if {[catch {set still_here $file_states($path)}]} {
1614 unset selected_paths($path)
1619 ######################################################################
1623 proc mapicon {w state path} {
1626 if {[catch {set r $all_icons($state$w)}]} {
1627 puts "error: no icon for $w state={$state} $path"
1633 proc mapdesc {state path} {
1636 if {[catch {set r $all_descs($state)}]} {
1637 puts "error: no desc for state={$state} $path"
1643 proc ui_status {msg} {
1645 if {[info exists main_status]} {
1646 $main_status show $msg
1650 proc ui_ready {{test {}}} {
1652 if {[info exists main_status]} {
1653 $main_status show [mc "Ready."] $test
1657 proc escape_path {path} {
1658 regsub -all {\\} $path "\\\\" path
1659 regsub -all "\n" $path "\\n" path
1663 proc short_path {path} {
1664 return [escape_path [lindex [file split $path] end]]
1668 set null_sha1 [string repeat 0 40]
1670 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1671 global file_states next_icon_id null_sha1
1673 set s0 [string index $new_state 0]
1674 set s1 [string index $new_state 1]
1676 if {[catch {set info $file_states($path)}]} {
1678 set icon n[incr next_icon_id]
1680 set state [lindex $info 0]
1681 set icon [lindex $info 1]
1682 if {$head_info eq {}} {set head_info [lindex $info 2]}
1683 if {$index_info eq {}} {set index_info [lindex $info 3]}
1686 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1687 elseif {$s0 eq {_}} {set s0 _}
1689 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1690 elseif {$s1 eq {_}} {set s1 _}
1692 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1693 set head_info [list 0 $null_sha1]
1694 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1695 && $head_info eq {}} {
1696 set head_info $index_info
1697 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1698 set index_info $head_info
1702 set file_states($path) [list $s0$s1 $icon \
1703 $head_info $index_info \
1708 proc display_file_helper {w path icon_name old_m new_m} {
1711 if {$new_m eq {_}} {
1712 set lno [lsearch -sorted -exact $file_lists($w) $path]
1714 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1716 $w conf -state normal
1717 $w delete $lno.0 [expr {$lno + 1}].0
1718 $w conf -state disabled
1720 } elseif {$old_m eq {_} && $new_m ne {_}} {
1721 lappend file_lists($w) $path
1722 set file_lists($w) [lsort -unique $file_lists($w)]
1723 set lno [lsearch -sorted -exact $file_lists($w) $path]
1725 $w conf -state normal
1726 $w image create $lno.0 \
1727 -align center -padx 5 -pady 1 \
1729 -image [mapicon $w $new_m $path]
1730 $w insert $lno.1 "[escape_path $path]\n"
1731 $w conf -state disabled
1732 } elseif {$old_m ne $new_m} {
1733 $w conf -state normal
1734 $w image conf $icon_name -image [mapicon $w $new_m $path]
1735 $w conf -state disabled
1739 proc display_file {path state} {
1740 global file_states selected_paths
1741 global ui_index ui_workdir
1743 set old_m [merge_state $path $state]
1744 set s $file_states($path)
1745 set new_m [lindex $s 0]
1746 set icon_name [lindex $s 1]
1748 set o [string index $old_m 0]
1749 set n [string index $new_m 0]
1756 display_file_helper $ui_index $path $icon_name $o $n
1758 if {[string index $old_m 0] eq {U}} {
1761 set o [string index $old_m 1]
1763 if {[string index $new_m 0] eq {U}} {
1766 set n [string index $new_m 1]
1768 display_file_helper $ui_workdir $path $icon_name $o $n
1770 if {$new_m eq {__}} {
1771 unset file_states($path)
1772 catch {unset selected_paths($path)}
1776 proc display_all_files_helper {w path icon_name m} {
1779 lappend file_lists($w) $path
1780 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1781 $w image create end \
1782 -align center -padx 5 -pady 1 \
1784 -image [mapicon $w $m $path]
1785 $w insert end "[escape_path $path]\n"
1789 proc display_all_files {} {
1790 global ui_index ui_workdir
1791 global file_states file_lists
1793 global files_warning
1795 $ui_index conf -state normal
1796 $ui_workdir conf -state normal
1798 $ui_index delete 0.0 end
1799 $ui_workdir delete 0.0 end
1802 set file_lists($ui_index) [list]
1803 set file_lists($ui_workdir) [list]
1805 set to_display [lsort [array names file_states]]
1806 set display_limit [get_config gui.maxfilesdisplayed]
1807 if {[llength $to_display] > $display_limit} {
1808 if {!$files_warning} {
1809 # do not repeatedly warn:
1811 info_popup [mc "Displaying only %s of %s files." \
1812 $display_limit [llength $to_display]]
1814 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1816 foreach path $to_display {
1817 set s $file_states($path)
1819 set icon_name [lindex $s 1]
1821 set s [string index $m 0]
1822 if {$s ne {U} && $s ne {_}} {
1823 display_all_files_helper $ui_index $path \
1827 if {[string index $m 0] eq {U}} {
1830 set s [string index $m 1]
1833 display_all_files_helper $ui_workdir $path \
1838 $ui_index conf -state disabled
1839 $ui_workdir conf -state disabled
1842 ######################################################################
1847 #define mask_width 14
1848 #define mask_height 15
1849 static unsigned char mask_bits[] = {
1850 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1851 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1852 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1855 image create bitmap file_plain -background white -foreground black -data {
1856 #define plain_width 14
1857 #define plain_height 15
1858 static unsigned char plain_bits[] = {
1859 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1860 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1861 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1862 } -maskdata $filemask
1864 image create bitmap file_mod -background white -foreground blue -data {
1865 #define mod_width 14
1866 #define mod_height 15
1867 static unsigned char mod_bits[] = {
1868 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1869 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1870 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1871 } -maskdata $filemask
1873 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1874 #define file_fulltick_width 14
1875 #define file_fulltick_height 15
1876 static unsigned char file_fulltick_bits[] = {
1877 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1878 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1879 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1880 } -maskdata $filemask
1882 image create bitmap file_question -background white -foreground black -data {
1883 #define file_question_width 14
1884 #define file_question_height 15
1885 static unsigned char file_question_bits[] = {
1886 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1887 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1888 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1889 } -maskdata $filemask
1891 image create bitmap file_removed -background white -foreground red -data {
1892 #define file_removed_width 14
1893 #define file_removed_height 15
1894 static unsigned char file_removed_bits[] = {
1895 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1896 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1897 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1898 } -maskdata $filemask
1900 image create bitmap file_merge -background white -foreground blue -data {
1901 #define file_merge_width 14
1902 #define file_merge_height 15
1903 static unsigned char file_merge_bits[] = {
1904 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1905 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1906 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1907 } -maskdata $filemask
1909 image create bitmap file_statechange -background white -foreground green -data {
1910 #define file_merge_width 14
1911 #define file_merge_height 15
1912 static unsigned char file_statechange_bits[] = {
1913 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1914 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1915 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1916 } -maskdata $filemask
1918 set ui_index .vpane.files.index.list
1919 set ui_workdir .vpane.files.workdir.list
1921 set all_icons(_$ui_index) file_plain
1922 set all_icons(A$ui_index) file_plain
1923 set all_icons(M$ui_index) file_fulltick
1924 set all_icons(D$ui_index) file_removed
1925 set all_icons(U$ui_index) file_merge
1926 set all_icons(T$ui_index) file_statechange
1928 set all_icons(_$ui_workdir) file_plain
1929 set all_icons(M$ui_workdir) file_mod
1930 set all_icons(D$ui_workdir) file_question
1931 set all_icons(U$ui_workdir) file_merge
1932 set all_icons(O$ui_workdir) file_plain
1933 set all_icons(T$ui_workdir) file_statechange
1935 set max_status_desc 0
1937 {__ {mc "Unmodified"}}
1939 {_M {mc "Modified, not staged"}}
1940 {M_ {mc "Staged for commit"}}
1941 {MM {mc "Portions staged for commit"}}
1942 {MD {mc "Staged for commit, missing"}}
1944 {_T {mc "File type changed, not staged"}}
1945 {T_ {mc "File type changed, staged"}}
1947 {_O {mc "Untracked, not staged"}}
1948 {A_ {mc "Staged for commit"}}
1949 {AM {mc "Portions staged for commit"}}
1950 {AD {mc "Staged for commit, missing"}}
1953 {D_ {mc "Staged for removal"}}
1954 {DO {mc "Staged for removal, still present"}}
1956 {_U {mc "Requires merge resolution"}}
1957 {U_ {mc "Requires merge resolution"}}
1958 {UU {mc "Requires merge resolution"}}
1959 {UM {mc "Requires merge resolution"}}
1960 {UD {mc "Requires merge resolution"}}
1961 {UT {mc "Requires merge resolution"}}
1963 set text [eval [lindex $i 1]]
1964 if {$max_status_desc < [string length $text]} {
1965 set max_status_desc [string length $text]
1967 set all_descs([lindex $i 0]) $text
1971 ######################################################################
1975 proc scrollbar2many {list mode args} {
1976 foreach w $list {eval $w $mode $args}
1979 proc many2scrollbar {list mode sb top bottom} {
1980 $sb set $top $bottom
1981 foreach w $list {$w $mode moveto $top}
1984 proc incr_font_size {font {amt 1}} {
1985 set sz [font configure $font -size]
1987 font configure $font -size $sz
1988 font configure ${font}bold -size $sz
1989 font configure ${font}italic -size $sz
1992 ######################################################################
1996 set starting_gitk_msg [mc "Starting gitk... please wait..."]
1998 proc do_gitk {revs {is_submodule false}} {
1999 global current_diff_path file_states current_diff_side ui_index
2000 global _gitdir _gitworktree
2002 # -- Always start gitk through whatever we were loaded with. This
2003 # lets us bypass using shell process on Windows systems.
2005 set exe [_which gitk -script]
2006 set cmd [list [info nameofexecutable] $exe]
2008 error_popup [mc "Couldn't find gitk in PATH"]
2014 if {!$is_submodule} {
2019 cd $current_diff_path
2020 if {$revs eq {--}} {
2021 set s $file_states($current_diff_path)
2024 switch -glob -- [lindex $s 0] {
2025 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2026 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2028 if {$current_diff_side eq $ui_index} {
2029 set old_sha1 [lindex [lindex $s 2] 1]
2030 set new_sha1 [lindex [lindex $s 3] 1]
2032 set old_sha1 [lindex [lindex $s 3] 1]
2036 set revs $old_sha1...$new_sha1
2038 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2039 # we've been using for the main repository, so unset them.
2040 # TODO we could make life easier (start up faster?) for gitk
2041 # by setting these to the appropriate values to allow gitk
2042 # to skip the heuristics to find their proper value
2044 unset env(GIT_WORK_TREE)
2046 eval exec $cmd $revs "--" "--" &
2048 set env(GIT_DIR) $_gitdir
2049 set env(GIT_WORK_TREE) $_gitworktree
2052 ui_status $::starting_gitk_msg
2054 ui_ready $starting_gitk_msg
2059 proc do_git_gui {} {
2060 global current_diff_path
2062 # -- Always start git gui through whatever we were loaded with. This
2063 # lets us bypass using shell process on Windows systems.
2065 set exe [list [_which git]]
2067 error_popup [mc "Couldn't find git gui in PATH"]
2070 global _gitdir _gitworktree
2072 # see note in do_gitk about unsetting these vars when
2073 # running tools in a submodule
2075 unset env(GIT_WORK_TREE)
2078 cd $current_diff_path
2080 eval exec $exe gui &
2082 set env(GIT_DIR) $_gitdir
2083 set env(GIT_WORK_TREE) $_gitworktree
2086 ui_status $::starting_gitk_msg
2088 ui_ready $starting_gitk_msg
2093 proc do_explore {} {
2096 if {[is_Cygwin] || [is_Windows]} {
2097 set explorer "explorer.exe"
2098 } elseif {[is_MacOSX]} {
2101 # freedesktop.org-conforming system is our best shot
2102 set explorer "xdg-open"
2104 eval exec $explorer $_gitworktree &
2110 proc terminate_me {win} {
2112 if {$win ne {.}} return
2116 proc do_quit {{rc {1}}} {
2117 global ui_comm is_quitting repo_config commit_type
2118 global GITGUI_BCK_exists GITGUI_BCK_i
2119 global ui_comm_spell
2120 global ret_code use_ttk
2122 if {$is_quitting} return
2125 if {[winfo exists $ui_comm]} {
2126 # -- Stash our current commit buffer.
2128 set save [gitdir GITGUI_MSG]
2129 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2130 file rename -force [gitdir GITGUI_BCK] $save
2131 set GITGUI_BCK_exists 0
2133 set msg [string trim [$ui_comm get 0.0 end]]
2134 regsub -all -line {[ \r\t]+$} $msg {} msg
2135 if {(![string match amend* $commit_type]
2136 || [$ui_comm edit modified])
2139 set fd [open $save w]
2140 puts -nonewline $fd $msg
2144 catch {file delete $save}
2148 # -- Cancel our spellchecker if its running.
2150 if {[info exists ui_comm_spell]} {
2154 # -- Remove our editor backup, its not needed.
2156 after cancel $GITGUI_BCK_i
2157 if {$GITGUI_BCK_exists} {
2158 catch {file delete [gitdir GITGUI_BCK]}
2161 # -- Stash our current window geometry into this repository.
2163 set cfg_wmstate [wm state .]
2164 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2167 if {$cfg_wmstate ne $rc_wmstate} {
2168 catch {git config gui.wmstate $cfg_wmstate}
2170 if {$cfg_wmstate eq {zoomed}} {
2171 # on Windows wm geometry will lie about window
2172 # position (but not size) when window is zoomed
2173 # restore the window before querying wm geometry
2176 set cfg_geometry [list]
2177 lappend cfg_geometry [wm geometry .]
2179 lappend cfg_geometry [.vpane sashpos 0]
2180 lappend cfg_geometry [.vpane.files sashpos 0]
2182 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2183 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2185 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2188 if {$cfg_geometry ne $rc_geometry} {
2189 catch {git config gui.geometry $cfg_geometry}
2195 # Briefly enable send again, working around Tk bug
2196 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2197 tk appname [appname]
2206 proc ui_do_rescan {} {
2207 rescan {force_first_diff ui_ready}
2214 proc next_diff {{after {}}} {
2215 global next_diff_p next_diff_w next_diff_i
2216 show_diff $next_diff_p $next_diff_w {} {} $after
2219 proc find_anchor_pos {lst name} {
2220 set lid [lsearch -sorted -exact $lst $name]
2224 foreach lname $lst {
2225 if {$lname >= $name} break
2233 proc find_file_from {flist idx delta path mmask} {
2236 set len [llength $flist]
2237 while {$idx >= 0 && $idx < $len} {
2238 set name [lindex $flist $idx]
2240 if {$name ne $path && [info exists file_states($name)]} {
2241 set state [lindex $file_states($name) 0]
2243 if {$mmask eq {} || [regexp $mmask $state]} {
2254 proc find_next_diff {w path {lno {}} {mmask {}}} {
2255 global next_diff_p next_diff_w next_diff_i
2256 global file_lists ui_index ui_workdir
2258 set flist $file_lists($w)
2260 set lno [find_anchor_pos $flist $path]
2265 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2266 if {$w eq $ui_index} {
2269 set mmask "$mmask\$"
2273 set idx [find_file_from $flist $lno 1 $path $mmask]
2276 set idx [find_file_from $flist $lno -1 $path $mmask]
2281 set next_diff_p [lindex $flist $idx]
2282 set next_diff_i [expr {$idx+1}]
2289 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2290 global current_diff_path
2292 if {$path ne $current_diff_path} {
2294 } elseif {[find_next_diff $w $path $lno $mmask]} {
2297 return {reshow_diff;}
2301 proc select_first_diff {after} {
2304 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2305 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2312 proc force_first_diff {after} {
2313 global ui_workdir current_diff_path file_states
2315 if {[info exists file_states($current_diff_path)]} {
2316 set state [lindex $file_states($current_diff_path) 0]
2322 if {[string first {U} $state] >= 0} {
2323 # Already a conflict, do nothing
2324 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2326 } elseif {[string index $state 1] ne {O}} {
2327 # Already a diff & no conflicts, do nothing
2328 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2339 proc toggle_or_diff {w x y} {
2340 global file_states file_lists current_diff_path ui_index ui_workdir
2341 global last_clicked selected_paths
2343 set pos [split [$w index @$x,$y] .]
2344 set lno [lindex $pos 0]
2345 set col [lindex $pos 1]
2346 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2352 set last_clicked [list $w $lno]
2353 array unset selected_paths
2354 $ui_index tag remove in_sel 0.0 end
2355 $ui_workdir tag remove in_sel 0.0 end
2357 # Determine the state of the file
2358 if {[info exists file_states($path)]} {
2359 set state [lindex $file_states($path) 0]
2364 # Restage the file, or simply show the diff
2365 if {$col == 0 && $y > 1} {
2366 # Conflicts need special handling
2367 if {[string first {U} $state] >= 0} {
2368 # $w must always be $ui_workdir, but...
2369 if {$w ne $ui_workdir} { set lno {} }
2370 merge_stage_workdir $path $lno
2374 if {[string index $state 1] eq {O}} {
2380 set after [next_diff_after_action $w $path $lno $mmask]
2382 if {$w eq $ui_index} {
2384 "Unstaging [short_path $path] from commit" \
2386 [concat $after [list ui_ready]]
2387 } elseif {$w eq $ui_workdir} {
2389 "Adding [short_path $path]" \
2391 [concat $after [list ui_ready]]
2394 show_diff $path $w $lno
2398 proc add_one_to_selection {w x y} {
2399 global file_lists last_clicked selected_paths
2401 set lno [lindex [split [$w index @$x,$y] .] 0]
2402 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2408 if {$last_clicked ne {}
2409 && [lindex $last_clicked 0] ne $w} {
2410 array unset selected_paths
2411 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2414 set last_clicked [list $w $lno]
2415 if {[catch {set in_sel $selected_paths($path)}]} {
2419 unset selected_paths($path)
2420 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2422 set selected_paths($path) 1
2423 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2427 proc add_range_to_selection {w x y} {
2428 global file_lists last_clicked selected_paths
2430 if {[lindex $last_clicked 0] ne $w} {
2431 toggle_or_diff $w $x $y
2435 set lno [lindex [split [$w index @$x,$y] .] 0]
2436 set lc [lindex $last_clicked 1]
2445 foreach path [lrange $file_lists($w) \
2446 [expr {$begin - 1}] \
2447 [expr {$end - 1}]] {
2448 set selected_paths($path) 1
2450 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2453 proc show_more_context {} {
2455 if {$repo_config(gui.diffcontext) < 99} {
2456 incr repo_config(gui.diffcontext)
2461 proc show_less_context {} {
2463 if {$repo_config(gui.diffcontext) > 1} {
2464 incr repo_config(gui.diffcontext) -1
2469 ######################################################################
2477 menu .mbar -tearoff 0
2479 # -- Apple Menu (Mac OS X only)
2481 .mbar add cascade -label Apple -menu .mbar.apple
2484 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2485 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2486 if {[is_enabled branch]} {
2487 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2489 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2490 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2492 if {[is_enabled transport]} {
2493 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2494 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2496 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2497 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2500 # -- Repository Menu
2502 menu .mbar.repository
2505 .mbar.repository add command \
2506 -label [mc "Explore Working Copy"] \
2507 -command {do_explore}
2508 .mbar.repository add separator
2511 .mbar.repository add command \
2512 -label [mc "Browse Current Branch's Files"] \
2513 -command {browser::new $current_branch}
2514 set ui_browse_current [.mbar.repository index last]
2515 .mbar.repository add command \
2516 -label [mc "Browse Branch Files..."] \
2517 -command browser_open::dialog
2518 .mbar.repository add separator
2520 .mbar.repository add command \
2521 -label [mc "Visualize Current Branch's History"] \
2522 -command {do_gitk $current_branch}
2523 set ui_visualize_current [.mbar.repository index last]
2524 .mbar.repository add command \
2525 -label [mc "Visualize All Branch History"] \
2526 -command {do_gitk --all}
2527 .mbar.repository add separator
2529 proc current_branch_write {args} {
2530 global current_branch
2531 .mbar.repository entryconf $::ui_browse_current \
2532 -label [mc "Browse %s's Files" $current_branch]
2533 .mbar.repository entryconf $::ui_visualize_current \
2534 -label [mc "Visualize %s's History" $current_branch]
2536 trace add variable current_branch write current_branch_write
2538 if {[is_enabled multicommit]} {
2539 .mbar.repository add command -label [mc "Database Statistics"] \
2542 .mbar.repository add command -label [mc "Compress Database"] \
2545 .mbar.repository add command -label [mc "Verify Database"] \
2546 -command do_fsck_objects
2548 .mbar.repository add separator
2551 .mbar.repository add command \
2552 -label [mc "Create Desktop Icon"] \
2553 -command do_cygwin_shortcut
2554 } elseif {[is_Windows]} {
2555 .mbar.repository add command \
2556 -label [mc "Create Desktop Icon"] \
2557 -command do_windows_shortcut
2558 } elseif {[is_MacOSX]} {
2559 .mbar.repository add command \
2560 -label [mc "Create Desktop Icon"] \
2561 -command do_macosx_app
2566 proc ::tk::mac::Quit {args} { do_quit }
2568 .mbar.repository add command -label [mc Quit] \
2576 .mbar.edit add command -label [mc Undo] \
2577 -command {catch {[focus] edit undo}} \
2579 .mbar.edit add command -label [mc Redo] \
2580 -command {catch {[focus] edit redo}} \
2582 .mbar.edit add separator
2583 .mbar.edit add command -label [mc Cut] \
2584 -command {catch {tk_textCut [focus]}} \
2586 .mbar.edit add command -label [mc Copy] \
2587 -command {catch {tk_textCopy [focus]}} \
2589 .mbar.edit add command -label [mc Paste] \
2590 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2592 .mbar.edit add command -label [mc Delete] \
2593 -command {catch {[focus] delete sel.first sel.last}} \
2595 .mbar.edit add separator
2596 .mbar.edit add command -label [mc "Select All"] \
2597 -command {catch {[focus] tag add sel 0.0 end}} \
2602 if {[is_enabled branch]} {
2605 .mbar.branch add command -label [mc "Create..."] \
2606 -command branch_create::dialog \
2608 lappend disable_on_lock [list .mbar.branch entryconf \
2609 [.mbar.branch index last] -state]
2611 .mbar.branch add command -label [mc "Checkout..."] \
2612 -command branch_checkout::dialog \
2614 lappend disable_on_lock [list .mbar.branch entryconf \
2615 [.mbar.branch index last] -state]
2617 .mbar.branch add command -label [mc "Rename..."] \
2618 -command branch_rename::dialog
2619 lappend disable_on_lock [list .mbar.branch entryconf \
2620 [.mbar.branch index last] -state]
2622 .mbar.branch add command -label [mc "Delete..."] \
2623 -command branch_delete::dialog
2624 lappend disable_on_lock [list .mbar.branch entryconf \
2625 [.mbar.branch index last] -state]
2627 .mbar.branch add command -label [mc "Reset..."] \
2628 -command merge::reset_hard
2629 lappend disable_on_lock [list .mbar.branch entryconf \
2630 [.mbar.branch index last] -state]
2635 proc commit_btn_caption {} {
2636 if {[is_enabled nocommit]} {
2639 return [mc Commit@@verb]
2643 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2646 if {![is_enabled nocommit]} {
2647 .mbar.commit add radiobutton \
2648 -label [mc "New Commit"] \
2649 -command do_select_commit_type \
2650 -variable selected_commit_type \
2652 lappend disable_on_lock \
2653 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2655 .mbar.commit add radiobutton \
2656 -label [mc "Amend Last Commit"] \
2657 -command do_select_commit_type \
2658 -variable selected_commit_type \
2660 lappend disable_on_lock \
2661 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2663 .mbar.commit add separator
2666 .mbar.commit add command -label [mc Rescan] \
2667 -command ui_do_rescan \
2669 lappend disable_on_lock \
2670 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2672 .mbar.commit add command -label [mc "Stage To Commit"] \
2673 -command do_add_selection \
2675 lappend disable_on_lock \
2676 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2678 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2679 -command do_add_all \
2681 lappend disable_on_lock \
2682 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2684 .mbar.commit add command -label [mc "Unstage From Commit"] \
2685 -command do_unstage_selection \
2687 lappend disable_on_lock \
2688 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2690 .mbar.commit add command -label [mc "Revert Changes"] \
2691 -command do_revert_selection \
2693 lappend disable_on_lock \
2694 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2696 .mbar.commit add separator
2698 .mbar.commit add command -label [mc "Show Less Context"] \
2699 -command show_less_context \
2700 -accelerator $M1T-\-
2702 .mbar.commit add command -label [mc "Show More Context"] \
2703 -command show_more_context \
2706 .mbar.commit add separator
2708 if {![is_enabled nocommitmsg]} {
2709 .mbar.commit add command -label [mc "Sign Off"] \
2710 -command do_signoff \
2714 .mbar.commit add command -label [commit_btn_caption] \
2715 -command do_commit \
2716 -accelerator $M1T-Return
2717 lappend disable_on_lock \
2718 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2723 if {[is_enabled branch]} {
2725 .mbar.merge add command -label [mc "Local Merge..."] \
2726 -command merge::dialog \
2728 lappend disable_on_lock \
2729 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2730 .mbar.merge add command -label [mc "Abort Merge..."] \
2731 -command merge::reset_hard
2732 lappend disable_on_lock \
2733 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2738 if {[is_enabled transport]} {
2741 .mbar.remote add command \
2742 -label [mc "Add..."] \
2743 -command remote_add::dialog \
2745 .mbar.remote add command \
2746 -label [mc "Push..."] \
2747 -command do_push_anywhere \
2749 .mbar.remote add command \
2750 -label [mc "Delete Branch..."] \
2751 -command remote_branch_delete::dialog
2755 proc ::tk::mac::ShowPreferences {} {do_options}
2759 .mbar.edit add separator
2760 .mbar.edit add command -label [mc "Options..."] \
2766 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2767 set tools_menubar .mbar.tools
2769 $tools_menubar add separator
2770 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2771 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2773 if {[array names repo_config guitool.*.cmd] ne {}} {
2780 .mbar add cascade -label [mc Help] -menu .mbar.help
2784 .mbar.apple add command -label [mc "About %s" [appname]] \
2786 .mbar.apple add separator
2788 .mbar.help add command -label [mc "About %s" [appname]] \
2791 . configure -menu .mbar
2793 set doc_path [githtmldir]
2794 if {$doc_path ne {}} {
2795 set doc_path [file join $doc_path index.html]
2798 set doc_path [exec cygpath --mixed $doc_path]
2802 if {[file isfile $doc_path]} {
2803 set doc_url "file:$doc_path"
2805 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2808 proc start_browser {url} {
2809 git "web--browse" $url
2812 .mbar.help add command -label [mc "Online Documentation"] \
2813 -command [list start_browser $doc_url]
2815 .mbar.help add command -label [mc "Show SSH Key"] \
2818 unset doc_path doc_url
2820 # -- Standard bindings
2822 wm protocol . WM_DELETE_WINDOW do_quit
2823 bind all <$M1B-Key-q> do_quit
2824 bind all <$M1B-Key-Q> do_quit
2825 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2826 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2828 set subcommand_args {}
2830 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2834 proc normalize_relpath {path} {
2836 foreach item [file split $path] {
2837 if {$item eq {.}} continue
2838 if {$item eq {..} && [llength $elements] > 0
2839 && [lindex $elements end] ne {..}} {
2840 set elements [lrange $elements 0 end-1]
2843 lappend elements $item
2845 return [eval file join $elements]
2848 # -- Not a normal commit type invocation? Do that instead!
2850 switch -- $subcommand {
2853 if {$subcommand eq "blame"} {
2854 set subcommand_args {[--line=<num>] rev? path}
2856 set subcommand_args {rev? path}
2858 if {$argv eq {}} usage
2864 if {$is_path || [file exists $_prefix$a]} {
2865 if {$path ne {}} usage
2866 set path [normalize_relpath $_prefix$a]
2868 } elseif {$a eq {--}} {
2870 if {$head ne {}} usage
2875 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2876 if {$jump_spec ne {} || $head ne {}} usage
2877 set jump_spec [list $lnum]
2878 } elseif {$head eq {}} {
2879 if {$head ne {}} usage
2888 if {$head ne {} && $path eq {}} {
2889 set path [normalize_relpath $_prefix$head]
2896 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2898 set head [git rev-parse --verify $head]
2904 set current_branch $head
2907 switch -- $subcommand {
2909 if {$jump_spec ne {}} usage
2911 if {$path ne {} && [file isdirectory $path]} {
2912 set head $current_branch
2918 browser::new $head $path
2921 if {$head eq {} && ![file exists $path]} {
2922 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2925 blame::new $head $path $jump_spec
2932 if {[llength $argv] != 0} {
2933 puts -nonewline stderr "usage: $argv0"
2934 if {$subcommand ne {gui}
2935 && [file tail $argv0] ne "git-$subcommand"} {
2936 puts -nonewline stderr " $subcommand"
2941 # fall through to setup UI for commits
2944 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2951 ${NS}::frame .branch
2952 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
2953 ${NS}::label .branch.l1 \
2954 -text [mc "Current Branch:"] \
2957 ${NS}::label .branch.cb \
2958 -textvariable current_branch \
2961 pack .branch.l1 -side left
2962 pack .branch.cb -side left -fill x
2963 pack .branch -side top -fill x
2965 # -- Main Window Layout
2967 ${NS}::panedwindow .vpane -orient horizontal
2968 ${NS}::panedwindow .vpane.files -orient vertical
2970 .vpane add .vpane.files
2972 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2974 pack .vpane -anchor n -side top -fill both -expand 1
2976 # -- Index File List
2978 ${NS}::frame .vpane.files.index -height 100 -width 200
2979 tlabel .vpane.files.index.title \
2980 -text [mc "Staged Changes (Will Commit)"] \
2981 -background lightgreen -foreground black
2982 text $ui_index -background white -foreground black \
2984 -width 20 -height 10 \
2986 -cursor $cursor_ptr \
2987 -xscrollcommand {.vpane.files.index.sx set} \
2988 -yscrollcommand {.vpane.files.index.sy set} \
2990 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2991 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2992 pack .vpane.files.index.title -side top -fill x
2993 pack .vpane.files.index.sx -side bottom -fill x
2994 pack .vpane.files.index.sy -side right -fill y
2995 pack $ui_index -side left -fill both -expand 1
2997 # -- Working Directory File List
2999 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3000 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3001 -background lightsalmon -foreground black
3002 text $ui_workdir -background white -foreground black \
3004 -width 20 -height 10 \
3006 -cursor $cursor_ptr \
3007 -xscrollcommand {.vpane.files.workdir.sx set} \
3008 -yscrollcommand {.vpane.files.workdir.sy set} \
3010 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3011 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3012 pack .vpane.files.workdir.title -side top -fill x
3013 pack .vpane.files.workdir.sx -side bottom -fill x
3014 pack .vpane.files.workdir.sy -side right -fill y
3015 pack $ui_workdir -side left -fill both -expand 1
3017 .vpane.files add .vpane.files.workdir
3018 .vpane.files add .vpane.files.index
3020 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3021 .vpane.files paneconfigure .vpane.files.index -sticky news
3024 foreach i [list $ui_index $ui_workdir] {
3026 $i tag conf in_diff -background [$i tag cget in_sel -background]
3030 # -- Diff and Commit Area
3032 ${NS}::frame .vpane.lower -height 300 -width 400
3033 ${NS}::frame .vpane.lower.commarea
3034 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3035 pack .vpane.lower.diff -fill both -expand 1
3036 pack .vpane.lower.commarea -side bottom -fill x
3037 .vpane add .vpane.lower
3038 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3040 # -- Commit Area Buttons
3042 ${NS}::frame .vpane.lower.commarea.buttons
3043 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3046 pack .vpane.lower.commarea.buttons.l -side top -fill x
3047 pack .vpane.lower.commarea.buttons -side left -fill y
3049 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3050 -command ui_do_rescan
3051 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3052 lappend disable_on_lock \
3053 {.vpane.lower.commarea.buttons.rescan conf -state}
3055 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3057 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3058 lappend disable_on_lock \
3059 {.vpane.lower.commarea.buttons.incall conf -state}
3061 if {![is_enabled nocommitmsg]} {
3062 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3064 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3067 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3069 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3070 lappend disable_on_lock \
3071 {.vpane.lower.commarea.buttons.commit conf -state}
3073 if {![is_enabled nocommit]} {
3074 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3075 -command do_push_anywhere
3076 pack .vpane.lower.commarea.buttons.push -side top -fill x
3079 # -- Commit Message Buffer
3081 ${NS}::frame .vpane.lower.commarea.buffer
3082 ${NS}::frame .vpane.lower.commarea.buffer.header
3083 set ui_comm .vpane.lower.commarea.buffer.t
3084 set ui_coml .vpane.lower.commarea.buffer.header.l
3086 if {![is_enabled nocommit]} {
3087 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3088 -text [mc "New Commit"] \
3089 -command do_select_commit_type \
3090 -variable selected_commit_type \
3092 lappend disable_on_lock \
3093 [list .vpane.lower.commarea.buffer.header.new conf -state]
3094 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3095 -text [mc "Amend Last Commit"] \
3096 -command do_select_commit_type \
3097 -variable selected_commit_type \
3099 lappend disable_on_lock \
3100 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3103 ${NS}::label $ui_coml \
3106 proc trace_commit_type {varname args} {
3107 global ui_coml commit_type
3108 switch -glob -- $commit_type {
3109 initial {set txt [mc "Initial Commit Message:"]}
3110 amend {set txt [mc "Amended Commit Message:"]}
3111 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3112 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3113 merge {set txt [mc "Merge Commit Message:"]}
3114 * {set txt [mc "Commit Message:"]}
3116 $ui_coml conf -text $txt
3118 trace add variable commit_type write trace_commit_type
3119 pack $ui_coml -side left -fill x
3121 if {![is_enabled nocommit]} {
3122 pack .vpane.lower.commarea.buffer.header.amend -side right
3123 pack .vpane.lower.commarea.buffer.header.new -side right
3126 text $ui_comm -background white -foreground black \
3130 -autoseparators true \
3132 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3134 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3135 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3136 -command [list $ui_comm yview]
3137 pack .vpane.lower.commarea.buffer.header -side top -fill x
3138 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3139 pack $ui_comm -side left -fill y
3140 pack .vpane.lower.commarea.buffer -side left -fill y
3142 # -- Commit Message Buffer Context Menu
3144 set ctxm .vpane.lower.commarea.buffer.ctxm
3145 menu $ctxm -tearoff 0
3148 -command {tk_textCut $ui_comm}
3151 -command {tk_textCopy $ui_comm}
3154 -command {tk_textPaste $ui_comm}
3156 -label [mc Delete] \
3157 -command {catch {$ui_comm delete sel.first sel.last}}
3160 -label [mc "Select All"] \
3161 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3163 -label [mc "Copy All"] \
3165 $ui_comm tag add sel 0.0 end
3166 tk_textCopy $ui_comm
3167 $ui_comm tag remove sel 0.0 end
3171 -label [mc "Sign Off"] \
3173 set ui_comm_ctxm $ctxm
3177 proc trace_current_diff_path {varname args} {
3178 global current_diff_path diff_actions file_states
3179 if {$current_diff_path eq {}} {
3185 set p $current_diff_path
3186 set s [mapdesc [lindex $file_states($p) 0] $p]
3188 set p [escape_path $p]
3192 .vpane.lower.diff.header.status configure -text $s
3193 .vpane.lower.diff.header.file configure -text $f
3194 .vpane.lower.diff.header.path configure -text $p
3195 foreach w $diff_actions {
3199 trace add variable current_diff_path write trace_current_diff_path
3201 gold_frame .vpane.lower.diff.header
3202 tlabel .vpane.lower.diff.header.status \
3205 -width $max_status_desc \
3208 tlabel .vpane.lower.diff.header.file \
3213 tlabel .vpane.lower.diff.header.path \
3218 pack .vpane.lower.diff.header.status -side left
3219 pack .vpane.lower.diff.header.file -side left
3220 pack .vpane.lower.diff.header.path -fill x
3221 set ctxm .vpane.lower.diff.header.ctxm
3222 menu $ctxm -tearoff 0
3230 -- $current_diff_path
3232 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3233 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3237 ${NS}::frame .vpane.lower.diff.body
3238 set ui_diff .vpane.lower.diff.body.t
3239 text $ui_diff -background white -foreground black \
3241 -width 80 -height 5 -wrap none \
3243 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3244 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3246 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3247 -command [list $ui_diff xview]
3248 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3249 -command [list $ui_diff yview]
3250 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3251 pack .vpane.lower.diff.body.sby -side right -fill y
3252 pack $ui_diff -side left -fill both -expand 1
3253 pack .vpane.lower.diff.header -side top -fill x
3254 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3256 $ui_diff tag conf d_cr -elide true
3257 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
3258 $ui_diff tag conf d_+ -foreground {#00a000}
3259 $ui_diff tag conf d_- -foreground red
3261 $ui_diff tag conf d_++ -foreground {#00a000}
3262 $ui_diff tag conf d_-- -foreground red
3263 $ui_diff tag conf d_+s \
3264 -foreground {#00a000} \
3265 -background {#e2effa}
3266 $ui_diff tag conf d_-s \
3268 -background {#e2effa}
3269 $ui_diff tag conf d_s+ \
3270 -foreground {#00a000} \
3272 $ui_diff tag conf d_s- \
3276 $ui_diff tag conf d<<<<<<< \
3277 -foreground orange \
3279 $ui_diff tag conf d======= \
3280 -foreground orange \
3282 $ui_diff tag conf d>>>>>>> \
3283 -foreground orange \
3286 $ui_diff tag raise sel
3288 # -- Diff Body Context Menu
3291 proc create_common_diff_popup {ctxm} {
3293 -label [mc Refresh] \
3294 -command reshow_diff
3295 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3298 -command {tk_textCopy $ui_diff}
3299 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3301 -label [mc "Select All"] \
3302 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3303 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3305 -label [mc "Copy All"] \
3307 $ui_diff tag add sel 0.0 end
3308 tk_textCopy $ui_diff
3309 $ui_diff tag remove sel 0.0 end
3311 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3314 -label [mc "Decrease Font Size"] \
3315 -command {incr_font_size font_diff -1}
3316 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3318 -label [mc "Increase Font Size"] \
3319 -command {incr_font_size font_diff 1}
3320 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3324 build_encoding_menu $emenu [list force_diff_encoding]
3326 -label [mc "Encoding"] \
3328 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3330 $ctxm add command -label [mc "Options..."] \
3334 set ctxm .vpane.lower.diff.body.ctxm
3335 menu $ctxm -tearoff 0
3337 -label [mc "Apply/Reverse Hunk"] \
3338 -command {apply_hunk $cursorX $cursorY}
3339 set ui_diff_applyhunk [$ctxm index last]
3340 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3342 -label [mc "Apply/Reverse Line"] \
3343 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3344 set ui_diff_applyline [$ctxm index last]
3345 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3348 -label [mc "Show Less Context"] \
3349 -command show_less_context
3350 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3352 -label [mc "Show More Context"] \
3353 -command show_more_context
3354 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3356 create_common_diff_popup $ctxm
3358 set ctxmmg .vpane.lower.diff.body.ctxmmg
3359 menu $ctxmmg -tearoff 0
3360 $ctxmmg add command \
3361 -label [mc "Run Merge Tool"] \
3362 -command {merge_resolve_tool}
3363 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3364 $ctxmmg add separator
3365 $ctxmmg add command \
3366 -label [mc "Use Remote Version"] \
3367 -command {merge_resolve_one 3}
3368 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3369 $ctxmmg add command \
3370 -label [mc "Use Local Version"] \
3371 -command {merge_resolve_one 2}
3372 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3373 $ctxmmg add command \
3374 -label [mc "Revert To Base"] \
3375 -command {merge_resolve_one 1}
3376 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3377 $ctxmmg add separator
3378 $ctxmmg add command \
3379 -label [mc "Show Less Context"] \
3380 -command show_less_context
3381 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3382 $ctxmmg add command \
3383 -label [mc "Show More Context"] \
3384 -command show_more_context
3385 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3386 $ctxmmg add separator
3387 create_common_diff_popup $ctxmmg
3389 set ctxmsm .vpane.lower.diff.body.ctxmsm
3390 menu $ctxmsm -tearoff 0
3391 $ctxmsm add command \
3392 -label [mc "Visualize These Changes In The Submodule"] \
3393 -command {do_gitk -- true}
3394 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3395 $ctxmsm add command \
3396 -label [mc "Visualize Current Branch History In The Submodule"] \
3397 -command {do_gitk {} true}
3398 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3399 $ctxmsm add command \
3400 -label [mc "Visualize All Branch History In The Submodule"] \
3401 -command {do_gitk --all true}
3402 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3403 $ctxmsm add separator
3404 $ctxmsm add command \
3405 -label [mc "Start git gui In The Submodule"] \
3406 -command {do_git_gui}
3407 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3408 $ctxmsm add separator
3409 create_common_diff_popup $ctxmsm
3411 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3412 global current_diff_path file_states
3415 if {[info exists file_states($current_diff_path)]} {
3416 set state [lindex $file_states($current_diff_path) 0]
3420 if {[string first {U} $state] >= 0} {
3421 tk_popup $ctxmmg $X $Y
3422 } elseif {$::is_submodule_diff} {
3423 tk_popup $ctxmsm $X $Y
3425 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3426 if {$::ui_index eq $::current_diff_side} {
3427 set l [mc "Unstage Hunk From Commit"]
3429 set t [mc "Unstage Lines From Commit"]
3431 set t [mc "Unstage Line From Commit"]
3434 set l [mc "Stage Hunk For Commit"]
3436 set t [mc "Stage Lines For Commit"]
3438 set t [mc "Stage Line For Commit"]
3442 || $current_diff_path eq {}
3446 || {T_} eq $state} {
3451 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3452 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3453 tk_popup $ctxm $X $Y
3456 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3460 set main_status [::status_bar::new .status]
3461 pack .status -anchor w -side bottom -fill x
3462 $main_status show [mc "Initializing..."]
3467 set gm $repo_config(gui.geometry)
3468 wm geometry . [lindex $gm 0]
3470 .vpane sashpos 0 [lindex $gm 1]
3471 .vpane.files sashpos 0 [lindex $gm 2]
3473 .vpane sash place 0 \
3475 [lindex [.vpane sash coord 0] 1]
3476 .vpane.files sash place 0 \
3477 [lindex [.vpane.files sash coord 0] 0] \
3483 # -- Load window state
3486 set gws $repo_config(gui.wmstate)
3493 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3494 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3495 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3496 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3497 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3498 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3499 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3500 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3501 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3502 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3503 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3504 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3505 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3506 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3507 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3508 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3509 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3510 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3511 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3512 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3513 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3514 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3516 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3517 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3518 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3519 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3520 bind $ui_diff <$M1B-Key-v> {break}
3521 bind $ui_diff <$M1B-Key-V> {break}
3522 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3523 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3524 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3525 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3526 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3527 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3528 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3529 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3530 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3531 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3532 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3533 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3534 bind $ui_diff <Button-1> {focus %W}
3536 if {[is_enabled branch]} {
3537 bind . <$M1B-Key-n> branch_create::dialog
3538 bind . <$M1B-Key-N> branch_create::dialog
3539 bind . <$M1B-Key-o> branch_checkout::dialog
3540 bind . <$M1B-Key-O> branch_checkout::dialog
3541 bind . <$M1B-Key-m> merge::dialog
3542 bind . <$M1B-Key-M> merge::dialog
3544 if {[is_enabled transport]} {
3545 bind . <$M1B-Key-p> do_push_anywhere
3546 bind . <$M1B-Key-P> do_push_anywhere
3549 bind . <Key-F5> ui_do_rescan
3550 bind . <$M1B-Key-r> ui_do_rescan
3551 bind . <$M1B-Key-R> ui_do_rescan
3552 bind . <$M1B-Key-s> do_signoff
3553 bind . <$M1B-Key-S> do_signoff
3554 bind . <$M1B-Key-t> do_add_selection
3555 bind . <$M1B-Key-T> do_add_selection
3556 bind . <$M1B-Key-j> do_revert_selection
3557 bind . <$M1B-Key-J> do_revert_selection
3558 bind . <$M1B-Key-i> do_add_all
3559 bind . <$M1B-Key-I> do_add_all
3560 bind . <$M1B-Key-minus> {show_less_context;break}
3561 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3562 bind . <$M1B-Key-equal> {show_more_context;break}
3563 bind . <$M1B-Key-plus> {show_more_context;break}
3564 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3565 bind . <$M1B-Key-Return> do_commit
3566 foreach i [list $ui_index $ui_workdir] {
3567 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3568 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3569 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3573 set file_lists($ui_index) [list]
3574 set file_lists($ui_workdir) [list]
3576 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3577 focus -force $ui_comm
3579 # -- Warn the user about environmental problems. Cygwin's Tcl
3580 # does *not* pass its env array onto any processes it spawns.
3581 # This means that git processes get none of our environment.
3586 set msg [mc "Possible environment issues exist.
3588 The following environment variables are probably
3589 going to be ignored by any Git subprocess run
3593 foreach name [array names env] {
3594 switch -regexp -- $name {
3595 {^GIT_INDEX_FILE$} -
3596 {^GIT_OBJECT_DIRECTORY$} -
3597 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3599 {^GIT_EXTERNAL_DIFF$} -
3603 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3604 append msg " - $name\n"
3607 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3608 append msg " - $name\n"
3610 set suggest_user $name
3614 if {$ignored_env > 0} {
3616 This is due to a known issue with the
3617 Tcl binary distributed by Cygwin."]
3619 if {$suggest_user ne {}} {
3622 A good replacement for %s
3623 is placing values for the user.name and
3624 user.email settings into your personal
3630 unset ignored_env msg suggest_user name
3633 # -- Only initialize complex UI if we are going to stay running.
3635 if {[is_enabled transport]} {
3638 set n [.mbar.remote index end]
3639 populate_remotes_menu
3640 set n [expr {[.mbar.remote index end] - $n}]
3642 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3643 .mbar.remote insert $n separator
3648 if {[winfo exists $ui_comm]} {
3649 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3651 # -- If both our backup and message files exist use the
3652 # newer of the two files to initialize the buffer.
3654 if {$GITGUI_BCK_exists} {
3655 set m [gitdir GITGUI_MSG]
3656 if {[file isfile $m]} {
3657 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3658 catch {file delete [gitdir GITGUI_MSG]}
3660 $ui_comm delete 0.0 end
3662 $ui_comm edit modified false
3663 catch {file delete [gitdir GITGUI_BCK]}
3664 set GITGUI_BCK_exists 0
3670 proc backup_commit_buffer {} {
3671 global ui_comm GITGUI_BCK_exists
3673 set m [$ui_comm edit modified]
3674 if {$m || $GITGUI_BCK_exists} {
3675 set msg [string trim [$ui_comm get 0.0 end]]
3676 regsub -all -line {[ \r\t]+$} $msg {} msg
3679 if {$GITGUI_BCK_exists} {
3680 catch {file delete [gitdir GITGUI_BCK]}
3681 set GITGUI_BCK_exists 0
3685 set fd [open [gitdir GITGUI_BCK] w]
3686 puts -nonewline $fd $msg
3688 set GITGUI_BCK_exists 1
3692 $ui_comm edit modified false
3695 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3698 backup_commit_buffer
3700 # -- If the user has aspell available we can drive it
3701 # in pipe mode to spellcheck the commit message.
3703 set spell_cmd [list |]
3704 set spell_dict [get_config gui.spellingdictionary]
3705 lappend spell_cmd aspell
3706 if {$spell_dict ne {}} {
3707 lappend spell_cmd --master=$spell_dict
3709 lappend spell_cmd --mode=none
3710 lappend spell_cmd --encoding=utf-8
3711 lappend spell_cmd pipe
3712 if {$spell_dict eq {none}
3713 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3714 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3716 set ui_comm_spell [spellcheck::init \
3722 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3725 lock_index begin-read
3726 if {![winfo ismapped .]} {
3730 if {[is_enabled initialamend]} {
3736 if {[is_enabled nocommitmsg]} {
3737 $ui_comm configure -state disabled -background gray
3740 if {[is_enabled multicommit]} {
3743 if {[is_enabled retcode]} {
3744 bind . <Destroy> {+terminate_me %W}
3746 if {$picked && [is_config_true gui.autoexplore]} {
3752 # indent-tabs-mode: t