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]
1118 if {![info exists env(GIT_ASK_YESNO)]} {
1119 set env(GIT_ASK_YESNO) [gitexec git-gui--askyesno]
1122 ######################################################################
1128 set _gitdir $env(GIT_DIR)
1132 # beware that from the .git dir this sets _gitdir to .
1133 # and _prefix to the empty string
1134 set _gitdir [git rev-parse --git-dir]
1135 set _prefix [git rev-parse --show-prefix]
1139 choose_repository::pick
1143 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1144 # run from the .git dir itself) lest the routines to find the worktree
1146 if {$_gitdir eq ".
"} {
1150 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1151 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1153 if {![file isdirectory $_gitdir]} {
1154 catch {wm withdraw .}
1155 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1158 # _gitdir exists, so try loading the config
1161 # try to set work tree from environment, falling back to core.worktree
1162 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1163 set _gitworktree [get_config core.worktree]
1164 if {$_gitworktree eq ""} {
1165 set _gitworktree [file dirname [file normalize $_gitdir]]
1168 if {$_prefix ne {}} {
1169 if {$_gitworktree eq {}} {
1170 regsub -all {[^/]+/} $_prefix ../ cdup
1172 set cdup $_gitworktree
1174 if {[catch {cd $cdup} err]} {
1175 catch {wm withdraw .}
1176 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1179 set _gitworktree [pwd]
1181 } elseif {![is_enabled bare]} {
1183 catch {wm withdraw .}
1184 error_popup [strcat [mc "Cannot use bare repository
:"] "\n\n$_gitdir"]
1187 if {$_gitworktree eq {}} {
1188 set _gitworktree [file dirname $_gitdir]
1190 if {[catch {cd $_gitworktree} err]} {
1191 catch {wm withdraw .}
1192 error_popup [strcat [mc "No working directory
"] " $_gitworktree:\n\n$err"]
1195 set _gitworktree [pwd]
1197 set _reponame [file split [file normalize $_gitdir]]
1198 if {[lindex $_reponame end] eq {.git}} {
1199 set _reponame [lindex $_reponame end-1]
1201 set _reponame [lindex $_reponame end]
1204 ######################################################################
1208 set current_diff_path {}
1209 set current_diff_side {}
1210 set diff_actions [list]
1214 set MERGE_HEAD [list]
1217 set current_branch {}
1219 set current_diff_path {}
1221 set is_submodule_diff 0
1222 set is_conflict_diff 0
1223 set selected_commit_type new
1224 set diff_empty_count 0
1226 set nullid "0000000000000000000000000000000000000000"
1227 set nullid2 "0000000000000000000000000000000000000001"
1229 ######################################################################
1237 set disable_on_lock [list]
1238 set index_lock_type none
1240 proc lock_index {type} {
1241 global index_lock_type disable_on_lock
1243 if {$index_lock_type eq {none}} {
1244 set index_lock_type $type
1245 foreach w $disable_on_lock {
1246 uplevel #0 $w disabled
1249 } elseif {$index_lock_type eq "begin-
$type"} {
1250 set index_lock_type $type
1256 proc unlock_index {} {
1257 global index_lock_type disable_on_lock
1259 set index_lock_type none
1260 foreach w $disable_on_lock {
1261 uplevel #0 $w normal
1265 ######################################################################
1269 proc repository_state {ctvar hdvar mhvar} {
1270 global current_branch
1271 upvar $ctvar ct $hdvar hd $mhvar mh
1276 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1282 set merge_head [gitdir MERGE_HEAD]
1283 if {[file exists $merge_head]} {
1285 set fd_mh [open $merge_head r]
1286 while {[gets $fd_mh line] >= 0} {
1297 global PARENT empty_tree
1299 set p [lindex $PARENT 0]
1303 if {$empty_tree eq {}} {
1304 set empty_tree [git mktree << {}]
1309 proc force_amend {} {
1310 global selected_commit_type
1311 global HEAD PARENT MERGE_HEAD commit_type
1313 repository_state newType newHEAD newMERGE_HEAD
1316 set MERGE_HEAD $newMERGE_HEAD
1317 set commit_type $newType
1319 set selected_commit_type amend
1320 do_select_commit_type
1323 proc rescan {after {honor_trustmtime 1}} {
1324 global HEAD PARENT MERGE_HEAD commit_type
1325 global ui_index ui_workdir ui_comm
1326 global rescan_active file_states
1329 if {$rescan_active > 0 || ![lock_index read]} return
1331 repository_state newType newHEAD newMERGE_HEAD
1332 if {[string match amend* $commit_type]
1333 && $newType eq {normal}
1334 && $newHEAD eq $HEAD} {
1338 set MERGE_HEAD $newMERGE_HEAD
1339 set commit_type $newType
1342 array unset file_states
1344 if {!$::GITGUI_BCK_exists &&
1345 (![$ui_comm edit modified]
1346 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1347 if {[string match amend* $commit_type]} {
1348 } elseif {[load_message GITGUI_MSG]} {
1349 } elseif {[run_prepare_commit_msg_hook]} {
1350 } elseif {[load_message MERGE_MSG]} {
1351 } elseif {[load_message SQUASH_MSG]} {
1354 $ui_comm edit modified false
1357 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1358 rescan_stage2 {} $after
1361 ui_status [mc "Refreshing
file status...
"]
1362 set fd_rf [git_read update-index \
1368 fconfigure $fd_rf -blocking 0 -translation binary
1369 fileevent $fd_rf readable \
1370 [list rescan_stage2 $fd_rf $after]
1375 set is_git_info_exclude {}
1376 proc have_info_exclude {} {
1377 global is_git_info_exclude
1379 if {$is_git_info_exclude eq {}} {
1380 if {[catch {exec test -f [gitdir info exclude]}]} {
1381 set is_git_info_exclude 0
1383 set is_git_info_exclude 1
1386 return $is_git_info_exclude
1389 proc have_info_exclude {} {
1390 return [file readable [gitdir info exclude]]
1394 proc rescan_stage2 {fd after} {
1395 global rescan_active buf_rdi buf_rdf buf_rlo
1399 if {![eof $fd]} return
1403 set ls_others [list --exclude-per-directory=.gitignore]
1404 if {[have_info_exclude]} {
1405 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1407 set user_exclude [get_config core.excludesfile]
1408 if {$user_exclude ne {} && [file readable $user_exclude]} {
1409 lappend ls_others "--exclude-from=$user_exclude"
1417 ui_status [mc "Scanning
for modified files ...
"]
1418 set fd_di [git_read diff-index --cached -z [PARENT]]
1419 set fd_df [git_read diff-files -z]
1420 set fd_lo [eval git_read ls-files --others -z $ls_others]
1422 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1423 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1424 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1425 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1426 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1427 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1430 proc load_message {file} {
1433 set f [gitdir $file]
1434 if {[file isfile $f]} {
1435 if {[catch {set fd [open $f r]}]} {
1438 fconfigure $fd -eofchar {}
1439 set content [string trim [read $fd]]
1441 regsub -all -line {[ \r\t]+$} $content {} content
1442 $ui_comm delete 0.0 end
1443 $ui_comm insert end $content
1449 proc run_prepare_commit_msg_hook {} {
1452 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1453 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1454 # empty file but existant file.
1456 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1458 if {[file isfile [gitdir MERGE_MSG]]} {
1459 set pcm_source "merge
"
1460 set fd_mm [open [gitdir MERGE_MSG] r]
1461 puts -nonewline $fd_pcm [read $fd_mm]
1463 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1464 set pcm_source "squash
"
1465 set fd_sm [open [gitdir SQUASH_MSG] r]
1466 puts -nonewline $fd_pcm [read $fd_sm]
1474 set fd_ph [githook_read prepare-commit-msg \
1475 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1477 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1481 ui_status [mc "Calling prepare-commit-msg hook...
"]
1484 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1485 fileevent $fd_ph readable \
1486 [list prepare_commit_msg_hook_wait $fd_ph]
1491 proc prepare_commit_msg_hook_wait {fd_ph} {
1494 append pch_error [read $fd_ph]
1495 fconfigure $fd_ph -blocking 1
1497 if {[catch {close $fd_ph}]} {
1498 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1499 hook_failed_popup prepare-commit-msg $pch_error
1500 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1503 load_message PREPARE_COMMIT_MSG
1506 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1509 fconfigure $fd_ph -blocking 0
1510 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1513 proc read_diff_index {fd after} {
1516 append buf_rdi [read $fd]
1518 set n [string length $buf_rdi]
1520 set z1 [string first "\
0" $buf_rdi $c]
1521 if {$z1 == -1} break
1523 set z2 [string first "\
0" $buf_rdi $z1]
1524 if {$z2 == -1} break
1527 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1528 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1530 [encoding convertfrom $p] \
1532 [list [lindex $i 0] [lindex $i 2]] \
1538 set buf_rdi [string range $buf_rdi $c end]
1543 rescan_done $fd buf_rdi $after
1546 proc read_diff_files {fd after} {
1549 append buf_rdf [read $fd]
1551 set n [string length $buf_rdf]
1553 set z1 [string first "\
0" $buf_rdf $c]
1554 if {$z1 == -1} break
1556 set z2 [string first "\
0" $buf_rdf $z1]
1557 if {$z2 == -1} break
1560 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1561 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1563 [encoding convertfrom $p] \
1566 [list [lindex $i 0] [lindex $i 2]]
1571 set buf_rdf [string range $buf_rdf $c end]
1576 rescan_done $fd buf_rdf $after
1579 proc read_ls_others {fd after} {
1582 append buf_rlo [read $fd]
1583 set pck [split $buf_rlo "\
0"]
1584 set buf_rlo [lindex $pck end]
1585 foreach p [lrange $pck 0 end-1] {
1586 set p [encoding convertfrom $p]
1587 if {[string index $p end] eq {/}} {
1588 set p [string range $p 0 end-1]
1592 rescan_done $fd buf_rlo $after
1595 proc rescan_done {fd buf after} {
1596 global rescan_active current_diff_path
1597 global file_states repo_config
1600 if {![eof $fd]} return
1603 if {[incr rescan_active -1] > 0} return
1608 if {$current_diff_path ne {}} { reshow_diff $after }
1609 if {$current_diff_path eq {}} { select_first_diff $after }
1612 proc prune_selection {} {
1613 global file_states selected_paths
1615 foreach path [array names selected_paths] {
1616 if {[catch {set still_here $file_states($path)}]} {
1617 unset selected_paths($path)
1622 ######################################################################
1626 proc mapicon {w state path} {
1629 if {[catch {set r $all_icons($state$w)}]} {
1630 puts "error
: no icon
for $w state
={$state} $path"
1636 proc mapdesc {state path} {
1639 if {[catch {set r $all_descs($state)}]} {
1640 puts "error
: no desc
for state
={$state} $path"
1646 proc ui_status {msg} {
1648 if {[info exists main_status]} {
1649 $main_status show $msg
1653 proc ui_ready {{test {}}} {
1655 if {[info exists main_status]} {
1656 $main_status show [mc "Ready.
"] $test
1660 proc escape_path {path} {
1661 regsub -all {\\} $path "\\\\" path
1662 regsub -all "\n" $path "\\n
" path
1666 proc short_path {path} {
1667 return [escape_path [lindex [file split $path] end]]
1671 set null_sha1 [string repeat 0 40]
1673 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1674 global file_states next_icon_id null_sha1
1676 set s0 [string index $new_state 0]
1677 set s1 [string index $new_state 1]
1679 if {[catch {set info $file_states($path)}]} {
1681 set icon n[incr next_icon_id]
1683 set state [lindex $info 0]
1684 set icon [lindex $info 1]
1685 if {$head_info eq {}} {set head_info [lindex $info 2]}
1686 if {$index_info eq {}} {set index_info [lindex $info 3]}
1689 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1690 elseif {$s0 eq {_}} {set s0 _}
1692 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1693 elseif {$s1 eq {_}} {set s1 _}
1695 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1696 set head_info [list 0 $null_sha1]
1697 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1698 && $head_info eq {}} {
1699 set head_info $index_info
1700 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1701 set index_info $head_info
1705 set file_states($path) [list $s0$s1 $icon \
1706 $head_info $index_info \
1711 proc display_file_helper {w path icon_name old_m new_m} {
1714 if {$new_m eq {_}} {
1715 set lno [lsearch -sorted -exact $file_lists($w) $path]
1717 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1719 $w conf -state normal
1720 $w delete $lno.0 [expr {$lno + 1}].0
1721 $w conf -state disabled
1723 } elseif {$old_m eq {_} && $new_m ne {_}} {
1724 lappend file_lists($w) $path
1725 set file_lists($w) [lsort -unique $file_lists($w)]
1726 set lno [lsearch -sorted -exact $file_lists($w) $path]
1728 $w conf -state normal
1729 $w image create $lno.0 \
1730 -align center -padx 5 -pady 1 \
1732 -image [mapicon $w $new_m $path]
1733 $w insert $lno.1 "[escape_path
$path]\n"
1734 $w conf -state disabled
1735 } elseif {$old_m ne $new_m} {
1736 $w conf -state normal
1737 $w image conf $icon_name -image [mapicon $w $new_m $path]
1738 $w conf -state disabled
1742 proc display_file {path state} {
1743 global file_states selected_paths
1744 global ui_index ui_workdir
1746 set old_m [merge_state $path $state]
1747 set s $file_states($path)
1748 set new_m [lindex $s 0]
1749 set icon_name [lindex $s 1]
1751 set o [string index $old_m 0]
1752 set n [string index $new_m 0]
1759 display_file_helper $ui_index $path $icon_name $o $n
1761 if {[string index $old_m 0] eq {U}} {
1764 set o [string index $old_m 1]
1766 if {[string index $new_m 0] eq {U}} {
1769 set n [string index $new_m 1]
1771 display_file_helper $ui_workdir $path $icon_name $o $n
1773 if {$new_m eq {__}} {
1774 unset file_states($path)
1775 catch {unset selected_paths($path)}
1779 proc display_all_files_helper {w path icon_name m} {
1782 lappend file_lists($w) $path
1783 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1784 $w image create end \
1785 -align center -padx 5 -pady 1 \
1787 -image [mapicon $w $m $path]
1788 $w insert end "[escape_path
$path]\n"
1792 proc display_all_files {} {
1793 global ui_index ui_workdir
1794 global file_states file_lists
1796 global files_warning
1798 $ui_index conf -state normal
1799 $ui_workdir conf -state normal
1801 $ui_index delete 0.0 end
1802 $ui_workdir delete 0.0 end
1805 set file_lists($ui_index) [list]
1806 set file_lists($ui_workdir) [list]
1808 set to_display [lsort [array names file_states]]
1809 set display_limit [get_config gui.maxfilesdisplayed]
1810 if {[llength $to_display] > $display_limit} {
1811 if {!$files_warning} {
1812 # do not repeatedly warn:
1814 info_popup [mc "Displaying only
%s of
%s files.
" \
1815 $display_limit [llength $to_display]]
1817 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1819 foreach path $to_display {
1820 set s $file_states($path)
1822 set icon_name [lindex $s 1]
1824 set s [string index $m 0]
1825 if {$s ne {U} && $s ne {_}} {
1826 display_all_files_helper $ui_index $path \
1830 if {[string index $m 0] eq {U}} {
1833 set s [string index $m 1]
1836 display_all_files_helper $ui_workdir $path \
1841 $ui_index conf -state disabled
1842 $ui_workdir conf -state disabled
1845 ######################################################################
1850 #define mask_width 14
1851 #define mask_height 15
1852 static unsigned char mask_bits[] = {
1853 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1854 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1855 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1858 image create bitmap file_plain -background white -foreground black -data {
1859 #define plain_width 14
1860 #define plain_height 15
1861 static unsigned char plain_bits[] = {
1862 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1863 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1864 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1865 } -maskdata $filemask
1867 image create bitmap file_mod -background white -foreground blue -data {
1868 #define mod_width 14
1869 #define mod_height 15
1870 static unsigned char mod_bits[] = {
1871 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1872 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1873 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1874 } -maskdata $filemask
1876 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1877 #define file_fulltick_width 14
1878 #define file_fulltick_height 15
1879 static unsigned char file_fulltick_bits
[] = {
1880 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1881 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1882 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1883 } -maskdata $filemask
1885 image create bitmap file_question
-background white
-foreground black
-data {
1886 #define file_question_width 14
1887 #define file_question_height 15
1888 static unsigned char file_question_bits
[] = {
1889 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1890 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1891 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1892 } -maskdata $filemask
1894 image create bitmap file_removed
-background white
-foreground red
-data {
1895 #define file_removed_width 14
1896 #define file_removed_height 15
1897 static unsigned char file_removed_bits
[] = {
1898 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1899 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1900 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1901 } -maskdata $filemask
1903 image create bitmap file_merge
-background white
-foreground blue
-data {
1904 #define file_merge_width 14
1905 #define file_merge_height 15
1906 static unsigned char file_merge_bits
[] = {
1907 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1908 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1909 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1910 } -maskdata $filemask
1912 image create bitmap file_statechange
-background white
-foreground green
-data {
1913 #define file_merge_width 14
1914 #define file_merge_height 15
1915 static unsigned char file_statechange_bits
[] = {
1916 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1917 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1918 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1919 } -maskdata $filemask
1921 set ui_index .vpane.files.index.list
1922 set ui_workdir .vpane.files.workdir.list
1924 set all_icons
(_
$ui_index) file_plain
1925 set all_icons
(A
$ui_index) file_plain
1926 set all_icons
(M
$ui_index) file_fulltick
1927 set all_icons
(D
$ui_index) file_removed
1928 set all_icons
(U
$ui_index) file_merge
1929 set all_icons
(T
$ui_index) file_statechange
1931 set all_icons
(_
$ui_workdir) file_plain
1932 set all_icons
(M
$ui_workdir) file_mod
1933 set all_icons
(D
$ui_workdir) file_question
1934 set all_icons
(U
$ui_workdir) file_merge
1935 set all_icons
(O
$ui_workdir) file_plain
1936 set all_icons
(T
$ui_workdir) file_statechange
1938 set max_status_desc
0
1940 {__
{mc
"Unmodified"}}
1942 {_M
{mc
"Modified, not staged"}}
1943 {M_
{mc
"Staged for commit"}}
1944 {MM
{mc
"Portions staged for commit"}}
1945 {MD
{mc
"Staged for commit, missing"}}
1947 {_T
{mc
"File type changed, not staged"}}
1948 {T_
{mc
"File type changed, staged"}}
1950 {_O
{mc
"Untracked, not staged"}}
1951 {A_
{mc
"Staged for commit"}}
1952 {AM
{mc
"Portions staged for commit"}}
1953 {AD
{mc
"Staged for commit, missing"}}
1956 {D_
{mc
"Staged for removal"}}
1957 {DO
{mc
"Staged for removal, still present"}}
1959 {_U
{mc
"Requires merge resolution"}}
1960 {U_
{mc
"Requires merge resolution"}}
1961 {UU
{mc
"Requires merge resolution"}}
1962 {UM
{mc
"Requires merge resolution"}}
1963 {UD
{mc
"Requires merge resolution"}}
1964 {UT
{mc
"Requires merge resolution"}}
1966 set text
[eval [lindex
$i 1]]
1967 if {$max_status_desc < [string length
$text]} {
1968 set max_status_desc
[string length
$text]
1970 set all_descs
([lindex
$i 0]) $text
1974 ######################################################################
1978 proc scrollbar2many
{list mode args
} {
1979 foreach w
$list {eval $w $mode $args}
1982 proc many2scrollbar
{list mode sb top bottom
} {
1983 $sb set $top $bottom
1984 foreach w
$list {$w $mode moveto
$top}
1987 proc incr_font_size
{font
{amt
1}} {
1988 set sz
[font configure
$font -size]
1990 font configure
$font -size $sz
1991 font configure
${font}bold
-size $sz
1992 font configure
${font}italic
-size $sz
1995 ######################################################################
1999 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
2001 proc do_gitk
{revs
{is_submodule false
}} {
2002 global current_diff_path file_states current_diff_side ui_index
2005 # -- Always start gitk through whatever we were loaded with. This
2006 # lets us bypass using shell process on Windows systems.
2008 set exe
[_which gitk
-script]
2009 set cmd
[list
[info nameofexecutable
] $exe]
2011 error_popup
[mc
"Couldn't find gitk in PATH"]
2015 if {[info exists env
(GIT_DIR
)]} {
2016 set old_GIT_DIR
$env(GIT_DIR
)
2023 if {!$is_submodule} {
2027 set env
(GIT_DIR
) [file normalize
[gitdir
]]
2029 cd $current_diff_path
2030 if {$revs eq
{--}} {
2031 set s
$file_states($current_diff_path)
2034 switch
-glob -- [lindex
$s 0] {
2035 M_
{ set old_sha1
[lindex
[lindex
$s 2] 1] }
2036 _M
{ set old_sha1
[lindex
[lindex
$s 3] 1] }
2038 if {$current_diff_side eq
$ui_index} {
2039 set old_sha1
[lindex
[lindex
$s 2] 1]
2040 set new_sha1
[lindex
[lindex
$s 3] 1]
2042 set old_sha1
[lindex
[lindex
$s 3] 1]
2046 set revs
$old_sha1...
$new_sha1
2048 if {[info exists env
(GIT_DIR
)]} {
2052 eval exec $cmd $revs "--" "--" &
2054 if {$old_GIT_DIR ne
{}} {
2055 set env
(GIT_DIR
) $old_GIT_DIR
2059 ui_status $
::starting_gitk_msg
2061 ui_ready
$starting_gitk_msg
2066 proc do_git_gui
{} {
2067 global current_diff_path
2069 # -- Always start git gui through whatever we were loaded with. This
2070 # lets us bypass using shell process on Windows systems.
2072 set exe
[list
[_which git
]]
2074 error_popup
[mc
"Couldn't find git gui in PATH"]
2078 if {[info exists env
(GIT_DIR
)]} {
2079 set old_GIT_DIR
$env(GIT_DIR
)
2086 cd $current_diff_path
2088 eval exec $exe gui
&
2090 if {$old_GIT_DIR ne
{}} {
2091 set env
(GIT_DIR
) $old_GIT_DIR
2095 ui_status $
::starting_gitk_msg
2097 ui_ready
$starting_gitk_msg
2102 proc do_explore
{} {
2105 if {[is_Cygwin
] ||
[is_Windows
]} {
2106 set explorer
"explorer.exe"
2107 } elseif
{[is_MacOSX
]} {
2110 # freedesktop.org-conforming system is our best shot
2111 set explorer
"xdg-open"
2113 eval exec $explorer [list
[file nativename
$_gitworktree]] &
2119 proc terminate_me
{win
} {
2121 if {$win ne
{.
}} return
2125 proc do_quit
{{rc
{1}}} {
2126 global ui_comm is_quitting repo_config commit_type
2127 global GITGUI_BCK_exists GITGUI_BCK_i
2128 global ui_comm_spell
2129 global ret_code use_ttk
2131 if {$is_quitting} return
2134 if {[winfo exists
$ui_comm]} {
2135 # -- Stash our current commit buffer.
2137 set save
[gitdir GITGUI_MSG
]
2138 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
2139 file rename
-force [gitdir GITGUI_BCK
] $save
2140 set GITGUI_BCK_exists
0
2142 set msg
[string trim
[$ui_comm get
0.0 end
]]
2143 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2144 if {(![string match amend
* $commit_type]
2145 ||
[$ui_comm edit modified
])
2148 set fd
[open
$save w
]
2149 puts
-nonewline $fd $msg
2153 catch
{file delete
$save}
2157 # -- Cancel our spellchecker if its running.
2159 if {[info exists ui_comm_spell
]} {
2163 # -- Remove our editor backup, its not needed.
2165 after cancel
$GITGUI_BCK_i
2166 if {$GITGUI_BCK_exists} {
2167 catch
{file delete
[gitdir GITGUI_BCK
]}
2170 # -- Stash our current window geometry into this repository.
2172 set cfg_wmstate
[wm state .
]
2173 if {[catch
{set rc_wmstate
$repo_config(gui.wmstate
)}]} {
2176 if {$cfg_wmstate ne
$rc_wmstate} {
2177 catch
{git config gui.wmstate
$cfg_wmstate}
2179 if {$cfg_wmstate eq
{zoomed
}} {
2180 # on Windows wm geometry will lie about window
2181 # position (but not size) when window is zoomed
2182 # restore the window before querying wm geometry
2185 set cfg_geometry
[list
]
2186 lappend cfg_geometry
[wm geometry .
]
2188 lappend cfg_geometry
[.vpane sashpos
0]
2189 lappend cfg_geometry
[.vpane.files sashpos
0]
2191 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
2192 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
2194 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2197 if {$cfg_geometry ne
$rc_geometry} {
2198 catch
{git config gui.geometry
$cfg_geometry}
2204 # Briefly enable send again, working around Tk bug
2205 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2206 tk appname
[appname
]
2215 proc ui_do_rescan
{} {
2216 rescan
{force_first_diff ui_ready
}
2223 proc next_diff
{{after
{}}} {
2224 global next_diff_p next_diff_w next_diff_i
2225 show_diff
$next_diff_p $next_diff_w {} {} $after
2228 proc find_anchor_pos
{lst name
} {
2229 set lid
[lsearch
-sorted -exact $lst $name]
2233 foreach lname
$lst {
2234 if {$lname >= $name} break
2242 proc find_file_from
{flist idx delta path mmask
} {
2245 set len
[llength
$flist]
2246 while {$idx >= 0 && $idx < $len} {
2247 set name
[lindex
$flist $idx]
2249 if {$name ne
$path && [info exists file_states
($name)]} {
2250 set state
[lindex
$file_states($name) 0]
2252 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2263 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2264 global next_diff_p next_diff_w next_diff_i
2265 global file_lists ui_index ui_workdir
2267 set flist
$file_lists($w)
2269 set lno
[find_anchor_pos
$flist $path]
2274 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2275 if {$w eq
$ui_index} {
2278 set mmask
"$mmask\$"
2282 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2285 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2290 set next_diff_p
[lindex
$flist $idx]
2291 set next_diff_i
[expr {$idx+1}]
2298 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2299 global current_diff_path
2301 if {$path ne
$current_diff_path} {
2303 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2306 return {reshow_diff
;}
2310 proc select_first_diff
{after
} {
2313 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2314 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2321 proc force_first_diff
{after
} {
2322 global ui_workdir current_diff_path file_states
2324 if {[info exists file_states
($current_diff_path)]} {
2325 set state
[lindex
$file_states($current_diff_path) 0]
2331 if {[string first
{U
} $state] >= 0} {
2332 # Already a conflict, do nothing
2333 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {^_?U
}]} {
2335 } elseif
{[string index
$state 1] ne
{O
}} {
2336 # Already a diff & no conflicts, do nothing
2337 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {[^O
]$
}]} {
2348 proc toggle_or_diff
{w x y
} {
2349 global file_states file_lists current_diff_path ui_index ui_workdir
2350 global last_clicked selected_paths
2352 set pos
[split [$w index @
$x,$y] .
]
2353 set lno
[lindex
$pos 0]
2354 set col [lindex
$pos 1]
2355 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2361 set last_clicked
[list
$w $lno]
2362 array
unset selected_paths
2363 $ui_index tag remove in_sel
0.0 end
2364 $ui_workdir tag remove in_sel
0.0 end
2366 # Determine the state of the file
2367 if {[info exists file_states
($path)]} {
2368 set state
[lindex
$file_states($path) 0]
2373 # Restage the file, or simply show the diff
2374 if {$col == 0 && $y > 1} {
2375 # Conflicts need special handling
2376 if {[string first
{U
} $state] >= 0} {
2377 # $w must always be $ui_workdir, but...
2378 if {$w ne
$ui_workdir} { set lno
{} }
2379 merge_stage_workdir
$path $lno
2383 if {[string index
$state 1] eq
{O
}} {
2389 set after
[next_diff_after_action
$w $path $lno $mmask]
2391 if {$w eq
$ui_index} {
2393 "Unstaging [short_path $path] from commit" \
2395 [concat
$after [list ui_ready
]]
2396 } elseif
{$w eq
$ui_workdir} {
2398 "Adding [short_path $path]" \
2400 [concat
$after [list ui_ready
]]
2403 show_diff
$path $w $lno
2407 proc add_one_to_selection
{w x y
} {
2408 global file_lists last_clicked selected_paths
2410 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2411 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2417 if {$last_clicked ne
{}
2418 && [lindex
$last_clicked 0] ne
$w} {
2419 array
unset selected_paths
2420 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2423 set last_clicked
[list
$w $lno]
2424 if {[catch
{set in_sel
$selected_paths($path)}]} {
2428 unset selected_paths
($path)
2429 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2431 set selected_paths
($path) 1
2432 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2436 proc add_range_to_selection
{w x y
} {
2437 global file_lists last_clicked selected_paths
2439 if {[lindex
$last_clicked 0] ne
$w} {
2440 toggle_or_diff
$w $x $y
2444 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2445 set lc
[lindex
$last_clicked 1]
2454 foreach path
[lrange
$file_lists($w) \
2455 [expr {$begin - 1}] \
2456 [expr {$end - 1}]] {
2457 set selected_paths
($path) 1
2459 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2462 proc show_more_context
{} {
2464 if {$repo_config(gui.diffcontext
) < 99} {
2465 incr repo_config
(gui.diffcontext
)
2470 proc show_less_context
{} {
2472 if {$repo_config(gui.diffcontext
) > 1} {
2473 incr repo_config
(gui.diffcontext
) -1
2478 ######################################################################
2486 menu .mbar
-tearoff 0
2488 # -- Apple Menu (Mac OS X only)
2490 .mbar add cascade
-label Apple
-menu .mbar.apple
2493 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2494 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2495 if {[is_enabled branch
]} {
2496 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2498 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2499 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2501 if {[is_enabled transport
]} {
2502 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2503 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2505 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2506 .mbar add cascade
-label [mc Tools
] -menu .mbar.tools
2509 # -- Repository Menu
2511 menu .mbar.repository
2514 .mbar.repository add
command \
2515 -label [mc
"Explore Working Copy"] \
2516 -command {do_explore
}
2517 .mbar.repository add separator
2520 .mbar.repository add
command \
2521 -label [mc
"Browse Current Branch's Files"] \
2522 -command {browser
::new
$current_branch}
2523 set ui_browse_current
[.mbar.repository index last
]
2524 .mbar.repository add
command \
2525 -label [mc
"Browse Branch Files..."] \
2526 -command browser_open
::dialog
2527 .mbar.repository add separator
2529 .mbar.repository add
command \
2530 -label [mc
"Visualize Current Branch's History"] \
2531 -command {do_gitk
$current_branch}
2532 set ui_visualize_current
[.mbar.repository index last
]
2533 .mbar.repository add
command \
2534 -label [mc
"Visualize All Branch History"] \
2535 -command {do_gitk
--all}
2536 .mbar.repository add separator
2538 proc current_branch_write
{args
} {
2539 global current_branch
2540 .mbar.repository entryconf $
::ui_browse_current \
2541 -label [mc
"Browse %s's Files" $current_branch]
2542 .mbar.repository entryconf $
::ui_visualize_current \
2543 -label [mc
"Visualize %s's History" $current_branch]
2545 trace add variable current_branch
write current_branch_write
2547 if {[is_enabled multicommit
]} {
2548 .mbar.repository add
command -label [mc
"Database Statistics"] \
2551 .mbar.repository add
command -label [mc
"Compress Database"] \
2554 .mbar.repository add
command -label [mc
"Verify Database"] \
2555 -command do_fsck_objects
2557 .mbar.repository add separator
2560 .mbar.repository add
command \
2561 -label [mc
"Create Desktop Icon"] \
2562 -command do_cygwin_shortcut
2563 } elseif
{[is_Windows
]} {
2564 .mbar.repository add
command \
2565 -label [mc
"Create Desktop Icon"] \
2566 -command do_windows_shortcut
2567 } elseif
{[is_MacOSX
]} {
2568 .mbar.repository add
command \
2569 -label [mc
"Create Desktop Icon"] \
2570 -command do_macosx_app
2575 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2577 .mbar.repository add
command -label [mc Quit
] \
2585 .mbar.edit add
command -label [mc Undo
] \
2586 -command {catch
{[focus
] edit undo
}} \
2588 .mbar.edit add
command -label [mc Redo
] \
2589 -command {catch
{[focus
] edit redo
}} \
2591 .mbar.edit add separator
2592 .mbar.edit add
command -label [mc Cut
] \
2593 -command {catch
{tk_textCut
[focus
]}} \
2595 .mbar.edit add
command -label [mc Copy
] \
2596 -command {catch
{tk_textCopy
[focus
]}} \
2598 .mbar.edit add
command -label [mc Paste
] \
2599 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2601 .mbar.edit add
command -label [mc Delete
] \
2602 -command {catch
{[focus
] delete sel.first sel.last
}} \
2604 .mbar.edit add separator
2605 .mbar.edit add
command -label [mc
"Select All"] \
2606 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2611 if {[is_enabled branch
]} {
2614 .mbar.branch add
command -label [mc
"Create..."] \
2615 -command branch_create
::dialog \
2617 lappend disable_on_lock
[list .mbar.branch entryconf \
2618 [.mbar.branch index last
] -state]
2620 .mbar.branch add
command -label [mc
"Checkout..."] \
2621 -command branch_checkout
::dialog \
2623 lappend disable_on_lock
[list .mbar.branch entryconf \
2624 [.mbar.branch index last
] -state]
2626 .mbar.branch add
command -label [mc
"Rename..."] \
2627 -command branch_rename
::dialog
2628 lappend disable_on_lock
[list .mbar.branch entryconf \
2629 [.mbar.branch index last
] -state]
2631 .mbar.branch add
command -label [mc
"Delete..."] \
2632 -command branch_delete
::dialog
2633 lappend disable_on_lock
[list .mbar.branch entryconf \
2634 [.mbar.branch index last
] -state]
2636 .mbar.branch add
command -label [mc
"Reset..."] \
2637 -command merge
::reset_hard
2638 lappend disable_on_lock
[list .mbar.branch entryconf \
2639 [.mbar.branch index last
] -state]
2644 proc commit_btn_caption
{} {
2645 if {[is_enabled nocommit
]} {
2648 return [mc Commit@@verb
]
2652 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2655 if {![is_enabled nocommit
]} {
2656 .mbar.commit add radiobutton \
2657 -label [mc
"New Commit"] \
2658 -command do_select_commit_type \
2659 -variable selected_commit_type \
2661 lappend disable_on_lock \
2662 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2664 .mbar.commit add radiobutton \
2665 -label [mc
"Amend Last Commit"] \
2666 -command do_select_commit_type \
2667 -variable selected_commit_type \
2669 lappend disable_on_lock \
2670 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2672 .mbar.commit add separator
2675 .mbar.commit add
command -label [mc Rescan
] \
2676 -command ui_do_rescan \
2678 lappend disable_on_lock \
2679 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2681 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2682 -command do_add_selection \
2684 lappend disable_on_lock \
2685 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2687 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2688 -command do_add_all \
2690 lappend disable_on_lock \
2691 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2693 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2694 -command do_unstage_selection \
2696 lappend disable_on_lock \
2697 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2699 .mbar.commit add
command -label [mc
"Revert Changes"] \
2700 -command do_revert_selection \
2702 lappend disable_on_lock \
2703 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2705 .mbar.commit add separator
2707 .mbar.commit add
command -label [mc
"Show Less Context"] \
2708 -command show_less_context \
2709 -accelerator $M1T-\
-
2711 .mbar.commit add
command -label [mc
"Show More Context"] \
2712 -command show_more_context \
2715 .mbar.commit add separator
2717 if {![is_enabled nocommitmsg
]} {
2718 .mbar.commit add
command -label [mc
"Sign Off"] \
2719 -command do_signoff \
2723 .mbar.commit add
command -label [commit_btn_caption
] \
2724 -command do_commit \
2725 -accelerator $M1T-Return
2726 lappend disable_on_lock \
2727 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2732 if {[is_enabled branch
]} {
2734 .mbar.merge add
command -label [mc
"Local Merge..."] \
2735 -command merge
::dialog \
2737 lappend disable_on_lock \
2738 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2739 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2740 -command merge
::reset_hard
2741 lappend disable_on_lock \
2742 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2747 if {[is_enabled transport
]} {
2750 .mbar.remote add
command \
2751 -label [mc
"Add..."] \
2752 -command remote_add
::dialog \
2754 .mbar.remote add
command \
2755 -label [mc
"Push..."] \
2756 -command do_push_anywhere \
2758 .mbar.remote add
command \
2759 -label [mc
"Delete Branch..."] \
2760 -command remote_branch_delete
::dialog
2764 proc
::tk
::mac
::ShowPreferences
{} {do_options
}
2768 .mbar.edit add separator
2769 .mbar.edit add
command -label [mc
"Options..."] \
2775 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2776 set tools_menubar .mbar.tools
2778 $tools_menubar add separator
2779 $tools_menubar add
command -label [mc
"Add..."] -command tools_add
::dialog
2780 $tools_menubar add
command -label [mc
"Remove..."] -command tools_remove
::dialog
2782 if {[array names repo_config guitool.
*.cmd
] ne
{}} {
2789 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2793 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2795 .mbar.apple add separator
2797 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2800 . configure
-menu .mbar
2802 set doc_path
[githtmldir
]
2803 if {$doc_path ne
{}} {
2804 set doc_path
[file join $doc_path index.html
]
2807 set doc_path
[exec cygpath
--mixed $doc_path]
2811 if {[file isfile
$doc_path]} {
2812 set doc_url
"file:$doc_path"
2814 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2817 proc start_browser
{url
} {
2818 git
"web--browse" $url
2821 .mbar.
help add
command -label [mc
"Online Documentation"] \
2822 -command [list start_browser
$doc_url]
2824 .mbar.
help add
command -label [mc
"Show SSH Key"] \
2827 unset doc_path doc_url
2829 # -- Standard bindings
2831 wm protocol . WM_DELETE_WINDOW do_quit
2832 bind all
<$M1B-Key-q> do_quit
2833 bind all
<$M1B-Key-Q> do_quit
2834 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2835 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2837 set subcommand_args
{}
2839 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2843 proc normalize_relpath
{path
} {
2845 foreach item
[file split $path] {
2846 if {$item eq
{.
}} continue
2847 if {$item eq
{..
} && [llength
$elements] > 0
2848 && [lindex
$elements end
] ne
{..
}} {
2849 set elements
[lrange
$elements 0 end-1
]
2852 lappend elements
$item
2854 return [eval file join $elements]
2857 # -- Not a normal commit type invocation? Do that instead!
2859 switch
-- $subcommand {
2862 if {$subcommand eq
"blame"} {
2863 set subcommand_args
{[--line=<num
>] rev? path
}
2865 set subcommand_args
{rev? path
}
2867 if {$argv eq
{}} usage
2873 if {$is_path ||
[file exists
$_prefix$a]} {
2874 if {$path ne
{}} usage
2875 set path
[normalize_relpath
$_prefix$a]
2877 } elseif
{$a eq
{--}} {
2879 if {$head ne
{}} usage
2884 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
2885 if {$jump_spec ne
{} ||
$head ne
{}} usage
2886 set jump_spec
[list
$lnum]
2887 } elseif
{$head eq
{}} {
2888 if {$head ne
{}} usage
2897 if {$head ne
{} && $path eq
{}} {
2898 set path
[normalize_relpath
$_prefix$head]
2905 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2907 set head [git rev-parse
--verify $head]
2913 set current_branch
$head
2916 switch
-- $subcommand {
2918 if {$jump_spec ne
{}} usage
2920 if {$path ne
{} && [file isdirectory
$path]} {
2921 set head $current_branch
2927 browser
::new
$head $path
2930 if {$head eq
{} && ![file exists
$path]} {
2931 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2934 blame
::new
$head $path $jump_spec
2941 if {[llength
$argv] != 0} {
2942 puts
-nonewline stderr
"usage: $argv0"
2943 if {$subcommand ne
{gui
}
2944 && [file tail $argv0] ne
"git-$subcommand"} {
2945 puts
-nonewline stderr
" $subcommand"
2950 # fall through to setup UI for commits
2953 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2960 ${NS}::frame .branch
2961 if {!$use_ttk} {.branch configure
-borderwidth 1 -relief sunken
}
2962 ${NS}::label .branch.l1 \
2963 -text [mc
"Current Branch:"] \
2966 ${NS}::label .branch.cb \
2967 -textvariable current_branch \
2970 pack .branch.l1
-side left
2971 pack .branch.cb
-side left
-fill x
2972 pack .branch
-side top
-fill x
2974 # -- Main Window Layout
2976 ${NS}::panedwindow .vpane
-orient horizontal
2977 ${NS}::panedwindow .vpane.files
-orient vertical
2979 .vpane add .vpane.files
2981 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2983 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2985 # -- Index File List
2987 ${NS}::frame .vpane.files.index
-height 100 -width 200
2988 tlabel .vpane.files.index.title \
2989 -text [mc
"Staged Changes (Will Commit)"] \
2990 -background lightgreen
-foreground black
2991 text
$ui_index -background white
-foreground black \
2993 -width 20 -height 10 \
2995 -cursor $cursor_ptr \
2996 -xscrollcommand {.vpane.files.index.sx
set} \
2997 -yscrollcommand {.vpane.files.index.sy
set} \
2999 ${NS}::scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
3000 ${NS}::scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
3001 pack .vpane.files.index.title
-side top
-fill x
3002 pack .vpane.files.index.sx
-side bottom
-fill x
3003 pack .vpane.files.index.sy
-side right
-fill y
3004 pack
$ui_index -side left
-fill both
-expand 1
3006 # -- Working Directory File List
3008 ${NS}::frame .vpane.files.workdir
-height 100 -width 200
3009 tlabel .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
3010 -background lightsalmon
-foreground black
3011 text
$ui_workdir -background white
-foreground black \
3013 -width 20 -height 10 \
3015 -cursor $cursor_ptr \
3016 -xscrollcommand {.vpane.files.workdir.sx
set} \
3017 -yscrollcommand {.vpane.files.workdir.sy
set} \
3019 ${NS}::scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
3020 ${NS}::scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
3021 pack .vpane.files.workdir.title
-side top
-fill x
3022 pack .vpane.files.workdir.sx
-side bottom
-fill x
3023 pack .vpane.files.workdir.sy
-side right
-fill y
3024 pack
$ui_workdir -side left
-fill both
-expand 1
3026 .vpane.files add .vpane.files.workdir
3027 .vpane.files add .vpane.files.index
3029 .vpane.files paneconfigure .vpane.files.workdir
-sticky news
3030 .vpane.files paneconfigure .vpane.files.index
-sticky news
3033 foreach i
[list
$ui_index $ui_workdir] {
3035 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
3039 # -- Diff and Commit Area
3041 ${NS}::frame .vpane.lower
-height 300 -width 400
3042 ${NS}::frame .vpane.lower.commarea
3043 ${NS}::frame .vpane.lower.
diff -relief sunken
-borderwidth 1
3044 pack .vpane.lower.
diff -fill both
-expand 1
3045 pack .vpane.lower.commarea
-side bottom
-fill x
3046 .vpane add .vpane.lower
3047 if {!$use_ttk} {.vpane paneconfigure .vpane.lower
-sticky nsew
}
3049 # -- Commit Area Buttons
3051 ${NS}::frame .vpane.lower.commarea.buttons
3052 ${NS}::label .vpane.lower.commarea.buttons.l
-text {} \
3055 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
3056 pack .vpane.lower.commarea.buttons
-side left
-fill y
3058 ${NS}::button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
3059 -command ui_do_rescan
3060 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
3061 lappend disable_on_lock \
3062 {.vpane.lower.commarea.buttons.rescan conf
-state}
3064 ${NS}::button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
3066 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
3067 lappend disable_on_lock \
3068 {.vpane.lower.commarea.buttons.incall conf
-state}
3070 if {![is_enabled nocommitmsg
]} {
3071 ${NS}::button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
3073 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
3076 ${NS}::button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
3078 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
3079 lappend disable_on_lock \
3080 {.vpane.lower.commarea.buttons.commit conf
-state}
3082 if {![is_enabled nocommit
]} {
3083 ${NS}::button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
3084 -command do_push_anywhere
3085 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
3088 # -- Commit Message Buffer
3090 ${NS}::frame .vpane.lower.commarea.buffer
3091 ${NS}::frame .vpane.lower.commarea.buffer.header
3092 set ui_comm .vpane.lower.commarea.buffer.t
3093 set ui_coml .vpane.lower.commarea.buffer.header.l
3095 if {![is_enabled nocommit
]} {
3096 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3097 -text [mc
"New Commit"] \
3098 -command do_select_commit_type \
3099 -variable selected_commit_type \
3101 lappend disable_on_lock \
3102 [list .vpane.lower.commarea.buffer.header.new conf
-state]
3103 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3104 -text [mc
"Amend Last Commit"] \
3105 -command do_select_commit_type \
3106 -variable selected_commit_type \
3108 lappend disable_on_lock \
3109 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
3112 ${NS}::label
$ui_coml \
3115 proc trace_commit_type
{varname args
} {
3116 global ui_coml commit_type
3117 switch
-glob -- $commit_type {
3118 initial
{set txt
[mc
"Initial Commit Message:"]}
3119 amend
{set txt
[mc
"Amended Commit Message:"]}
3120 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
3121 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
3122 merge
{set txt
[mc
"Merge Commit Message:"]}
3123 * {set txt
[mc
"Commit Message:"]}
3125 $ui_coml conf
-text $txt
3127 trace add variable commit_type
write trace_commit_type
3128 pack
$ui_coml -side left
-fill x
3130 if {![is_enabled nocommit
]} {
3131 pack .vpane.lower.commarea.buffer.header.amend
-side right
3132 pack .vpane.lower.commarea.buffer.header.new
-side right
3135 text
$ui_comm -background white
-foreground black \
3139 -autoseparators true \
3141 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
3143 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
3144 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3145 -command [list
$ui_comm yview
]
3146 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
3147 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
3148 pack
$ui_comm -side left
-fill y
3149 pack .vpane.lower.commarea.buffer
-side left
-fill y
3151 # -- Commit Message Buffer Context Menu
3153 set ctxm .vpane.lower.commarea.buffer.ctxm
3154 menu
$ctxm -tearoff 0
3157 -command {tk_textCut
$ui_comm}
3160 -command {tk_textCopy
$ui_comm}
3163 -command {tk_textPaste
$ui_comm}
3165 -label [mc Delete
] \
3166 -command {catch
{$ui_comm delete sel.first sel.last
}}
3169 -label [mc
"Select All"] \
3170 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
3172 -label [mc
"Copy All"] \
3174 $ui_comm tag add sel
0.0 end
3175 tk_textCopy
$ui_comm
3176 $ui_comm tag remove sel
0.0 end
3180 -label [mc
"Sign Off"] \
3182 set ui_comm_ctxm
$ctxm
3186 proc trace_current_diff_path
{varname args
} {
3187 global current_diff_path diff_actions file_states
3188 if {$current_diff_path eq
{}} {
3194 set p
$current_diff_path
3195 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
3197 set p
[escape_path
$p]
3201 .vpane.lower.
diff.header.status configure
-text $s
3202 .vpane.lower.
diff.header.
file configure
-text $f
3203 .vpane.lower.
diff.header.path configure
-text $p
3204 foreach w
$diff_actions {
3208 trace add variable current_diff_path
write trace_current_diff_path
3210 gold_frame .vpane.lower.
diff.header
3211 tlabel .vpane.lower.
diff.header.status \
3214 -width $max_status_desc \
3217 tlabel .vpane.lower.
diff.header.
file \
3222 tlabel .vpane.lower.
diff.header.path \
3227 pack .vpane.lower.
diff.header.status
-side left
3228 pack .vpane.lower.
diff.header.
file -side left
3229 pack .vpane.lower.
diff.header.path
-fill x
3230 set ctxm .vpane.lower.
diff.header.ctxm
3231 menu
$ctxm -tearoff 0
3239 -- $current_diff_path
3241 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3242 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
3246 ${NS}::frame .vpane.lower.
diff.body
3247 set ui_diff .vpane.lower.
diff.body.t
3248 text
$ui_diff -background white
-foreground black \
3250 -width 80 -height 5 -wrap none \
3252 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
3253 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
3255 ${NS}::scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
3256 -command [list
$ui_diff xview
]
3257 ${NS}::scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
3258 -command [list
$ui_diff yview
]
3259 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
3260 pack .vpane.lower.
diff.body.sby
-side right
-fill y
3261 pack
$ui_diff -side left
-fill both
-expand 1
3262 pack .vpane.lower.
diff.header
-side top
-fill x
3263 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
3265 $ui_diff tag conf d_cr
-elide true
3266 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
3267 $ui_diff tag conf d_
+ -foreground {#00a000}
3268 $ui_diff tag conf d_-
-foreground red
3270 $ui_diff tag conf d_
++ -foreground {#00a000}
3271 $ui_diff tag conf d_--
-foreground red
3272 $ui_diff tag conf d_
+s \
3273 -foreground {#00a000} \
3274 -background {#e2effa}
3275 $ui_diff tag conf d_-s \
3277 -background {#e2effa}
3278 $ui_diff tag conf d_s
+ \
3279 -foreground {#00a000} \
3281 $ui_diff tag conf d_s- \
3285 $ui_diff tag conf d
<<<<<<< \
3286 -foreground orange \
3288 $ui_diff tag conf d
======= \
3289 -foreground orange \
3291 $ui_diff tag conf d
>>>>>>> \
3292 -foreground orange \
3295 $ui_diff tag raise sel
3297 # -- Diff Body Context Menu
3300 proc create_common_diff_popup
{ctxm
} {
3302 -label [mc Refresh
] \
3303 -command reshow_diff
3304 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3307 -command {tk_textCopy
$ui_diff}
3308 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3310 -label [mc
"Select All"] \
3311 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3312 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3314 -label [mc
"Copy All"] \
3316 $ui_diff tag add sel
0.0 end
3317 tk_textCopy
$ui_diff
3318 $ui_diff tag remove sel
0.0 end
3320 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3323 -label [mc
"Decrease Font Size"] \
3324 -command {incr_font_size font_diff
-1}
3325 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3327 -label [mc
"Increase Font Size"] \
3328 -command {incr_font_size font_diff
1}
3329 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3333 build_encoding_menu
$emenu [list force_diff_encoding
]
3335 -label [mc
"Encoding"] \
3337 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3339 $ctxm add
command -label [mc
"Options..."] \
3343 set ctxm .vpane.lower.
diff.body.ctxm
3344 menu
$ctxm -tearoff 0
3346 -label [mc
"Apply/Reverse Hunk"] \
3347 -command {apply_hunk
$cursorX $cursorY}
3348 set ui_diff_applyhunk
[$ctxm index last
]
3349 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3351 -label [mc
"Apply/Reverse Line"] \
3352 -command {apply_range_or_line
$cursorX $cursorY; do_rescan
}
3353 set ui_diff_applyline
[$ctxm index last
]
3354 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3357 -label [mc
"Show Less Context"] \
3358 -command show_less_context
3359 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3361 -label [mc
"Show More Context"] \
3362 -command show_more_context
3363 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3365 create_common_diff_popup
$ctxm
3367 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3368 menu
$ctxmmg -tearoff 0
3369 $ctxmmg add
command \
3370 -label [mc
"Run Merge Tool"] \
3371 -command {merge_resolve_tool
}
3372 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3373 $ctxmmg add separator
3374 $ctxmmg add
command \
3375 -label [mc
"Use Remote Version"] \
3376 -command {merge_resolve_one
3}
3377 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3378 $ctxmmg add
command \
3379 -label [mc
"Use Local Version"] \
3380 -command {merge_resolve_one
2}
3381 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3382 $ctxmmg add
command \
3383 -label [mc
"Revert To Base"] \
3384 -command {merge_resolve_one
1}
3385 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3386 $ctxmmg add separator
3387 $ctxmmg add
command \
3388 -label [mc
"Show Less Context"] \
3389 -command show_less_context
3390 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3391 $ctxmmg add
command \
3392 -label [mc
"Show More Context"] \
3393 -command show_more_context
3394 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3395 $ctxmmg add separator
3396 create_common_diff_popup
$ctxmmg
3398 set ctxmsm .vpane.lower.
diff.body.ctxmsm
3399 menu
$ctxmsm -tearoff 0
3400 $ctxmsm add
command \
3401 -label [mc
"Visualize These Changes In The Submodule"] \
3402 -command {do_gitk
-- true
}
3403 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3404 $ctxmsm add
command \
3405 -label [mc
"Visualize Current Branch History In The Submodule"] \
3406 -command {do_gitk
{} true
}
3407 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3408 $ctxmsm add
command \
3409 -label [mc
"Visualize All Branch History In The Submodule"] \
3410 -command {do_gitk
--all true
}
3411 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3412 $ctxmsm add separator
3413 $ctxmsm add
command \
3414 -label [mc
"Start git gui In The Submodule"] \
3415 -command {do_git_gui
}
3416 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3417 $ctxmsm add separator
3418 create_common_diff_popup
$ctxmsm
3420 proc popup_diff_menu
{ctxm ctxmmg ctxmsm x y X Y
} {
3421 global current_diff_path file_states
3424 if {[info exists file_states
($current_diff_path)]} {
3425 set state
[lindex
$file_states($current_diff_path) 0]
3429 if {[string first
{U
} $state] >= 0} {
3430 tk_popup
$ctxmmg $X $Y
3431 } elseif
{$
::is_submodule_diff
} {
3432 tk_popup
$ctxmsm $X $Y
3434 set has_range
[expr {[$
::ui_diff tag nextrange sel
0.0] != {}}]
3435 if {$
::ui_index eq $
::current_diff_side
} {
3436 set l
[mc
"Unstage Hunk From Commit"]
3438 set t
[mc
"Unstage Lines From Commit"]
3440 set t
[mc
"Unstage Line From Commit"]
3443 set l
[mc
"Stage Hunk For Commit"]
3445 set t
[mc
"Stage Lines For Commit"]
3447 set t
[mc
"Stage Line For Commit"]
3451 ||
$current_diff_path eq
{}
3455 ||
{T_
} eq
$state} {
3460 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3461 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3462 tk_popup
$ctxm $X $Y
3465 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg $ctxmsm %x
%y
%X
%Y
]
3469 set main_status
[::status_bar
::new .status
]
3470 pack .status
-anchor w
-side bottom
-fill x
3471 $main_status show
[mc
"Initializing..."]
3476 set gm
$repo_config(gui.geometry
)
3477 wm geometry .
[lindex
$gm 0]
3479 .vpane sashpos
0 [lindex
$gm 1]
3480 .vpane.files sashpos
0 [lindex
$gm 2]
3482 .vpane sash place
0 \
3484 [lindex
[.vpane sash coord
0] 1]
3485 .vpane.files sash place
0 \
3486 [lindex
[.vpane.files sash coord
0] 0] \
3492 # -- Load window state
3495 set gws
$repo_config(gui.wmstate
)
3502 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3503 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3504 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3505 bind $ui_comm <$M1B-Key-u> {do_unstage_selection
;break}
3506 bind $ui_comm <$M1B-Key-U> {do_unstage_selection
;break}
3507 bind $ui_comm <$M1B-Key-j> {do_revert_selection
;break}
3508 bind $ui_comm <$M1B-Key-J> {do_revert_selection
;break}
3509 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3510 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3511 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3512 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3513 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3514 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3515 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3516 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3517 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3518 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3519 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3520 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3521 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3522 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3523 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3525 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3526 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3527 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3528 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3529 bind $ui_diff <$M1B-Key-v> {break}
3530 bind $ui_diff <$M1B-Key-V> {break}
3531 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3532 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3533 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3534 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3535 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3536 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3537 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3538 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3539 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3540 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3541 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3542 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3543 bind $ui_diff <Button-1
> {focus
%W
}
3545 if {[is_enabled branch
]} {
3546 bind .
<$M1B-Key-n> branch_create
::dialog
3547 bind .
<$M1B-Key-N> branch_create
::dialog
3548 bind .
<$M1B-Key-o> branch_checkout
::dialog
3549 bind .
<$M1B-Key-O> branch_checkout
::dialog
3550 bind .
<$M1B-Key-m> merge
::dialog
3551 bind .
<$M1B-Key-M> merge
::dialog
3553 if {[is_enabled transport
]} {
3554 bind .
<$M1B-Key-p> do_push_anywhere
3555 bind .
<$M1B-Key-P> do_push_anywhere
3558 bind .
<Key-F5
> ui_do_rescan
3559 bind .
<$M1B-Key-r> ui_do_rescan
3560 bind .
<$M1B-Key-R> ui_do_rescan
3561 bind .
<$M1B-Key-s> do_signoff
3562 bind .
<$M1B-Key-S> do_signoff
3563 bind .
<$M1B-Key-t> do_add_selection
3564 bind .
<$M1B-Key-T> do_add_selection
3565 bind .
<$M1B-Key-j> do_revert_selection
3566 bind .
<$M1B-Key-J> do_revert_selection
3567 bind .
<$M1B-Key-i> do_add_all
3568 bind .
<$M1B-Key-I> do_add_all
3569 bind .
<$M1B-Key-minus> {show_less_context
;break}
3570 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3571 bind .
<$M1B-Key-equal> {show_more_context
;break}
3572 bind .
<$M1B-Key-plus> {show_more_context
;break}
3573 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3574 bind .
<$M1B-Key-Return> do_commit
3575 foreach i
[list
$ui_index $ui_workdir] {
3576 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
3577 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3578 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
3582 set file_lists
($ui_index) [list
]
3583 set file_lists
($ui_workdir) [list
]
3585 wm title .
"[appname] ([reponame]) [file normalize $_gitworktree]"
3586 focus
-force $ui_comm
3588 # -- Warn the user about environmental problems. Cygwin's Tcl
3589 # does *not* pass its env array onto any processes it spawns.
3590 # This means that git processes get none of our environment.
3595 set msg
[mc
"Possible environment issues exist.
3597 The following environment variables are probably
3598 going to be ignored by any Git subprocess run
3602 foreach name
[array names env
] {
3603 switch
-regexp -- $name {
3604 {^GIT_INDEX_FILE$
} -
3605 {^GIT_OBJECT_DIRECTORY$
} -
3606 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3608 {^GIT_EXTERNAL_DIFF$
} -
3612 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3613 append msg
" - $name\n"
3616 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3617 append msg
" - $name\n"
3619 set suggest_user
$name
3623 if {$ignored_env > 0} {
3625 This is due to a known issue with the
3626 Tcl binary distributed by Cygwin."]
3628 if {$suggest_user ne
{}} {
3631 A good replacement for %s
3632 is placing values for the user.name and
3633 user.email settings into your personal
3639 unset ignored_env msg suggest_user name
3642 # -- Only initialize complex UI if we are going to stay running.
3644 if {[is_enabled transport
]} {
3647 set n
[.mbar.remote index end
]
3648 populate_remotes_menu
3649 set n
[expr {[.mbar.remote index end
] - $n}]
3651 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3652 .mbar.remote insert
$n separator
3657 if {[winfo exists
$ui_comm]} {
3658 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
3660 # -- If both our backup and message files exist use the
3661 # newer of the two files to initialize the buffer.
3663 if {$GITGUI_BCK_exists} {
3664 set m
[gitdir GITGUI_MSG
]
3665 if {[file isfile
$m]} {
3666 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3667 catch
{file delete
[gitdir GITGUI_MSG
]}
3669 $ui_comm delete
0.0 end
3671 $ui_comm edit modified false
3672 catch
{file delete
[gitdir GITGUI_BCK
]}
3673 set GITGUI_BCK_exists
0
3679 proc backup_commit_buffer
{} {
3680 global ui_comm GITGUI_BCK_exists
3682 set m
[$ui_comm edit modified
]
3683 if {$m ||
$GITGUI_BCK_exists} {
3684 set msg
[string trim
[$ui_comm get
0.0 end
]]
3685 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3688 if {$GITGUI_BCK_exists} {
3689 catch
{file delete
[gitdir GITGUI_BCK
]}
3690 set GITGUI_BCK_exists
0
3694 set fd
[open
[gitdir GITGUI_BCK
] w
]
3695 puts
-nonewline $fd $msg
3697 set GITGUI_BCK_exists
1
3701 $ui_comm edit modified false
3704 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3707 backup_commit_buffer
3709 # -- If the user has aspell available we can drive it
3710 # in pipe mode to spellcheck the commit message.
3712 set spell_cmd
[list |
]
3713 set spell_dict
[get_config gui.spellingdictionary
]
3714 lappend spell_cmd aspell
3715 if {$spell_dict ne
{}} {
3716 lappend spell_cmd
--master=$spell_dict
3718 lappend spell_cmd
--mode=none
3719 lappend spell_cmd
--encoding=utf-8
3720 lappend spell_cmd pipe
3721 if {$spell_dict eq
{none
}
3722 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3723 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3725 set ui_comm_spell
[spellcheck
::init \
3731 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3734 lock_index begin-read
3735 if {![winfo ismapped .
]} {
3739 if {[is_enabled initialamend
]} {
3745 if {[is_enabled nocommitmsg
]} {
3746 $ui_comm configure
-state disabled
-background gray
3749 if {[is_enabled multicommit
]} {
3752 if {[is_enabled retcode
]} {
3753 bind .
<Destroy
> {+terminate_me
%W
}
3755 if {$picked && [is_config_true gui.autoexplore
]} {
3761 # indent-tabs-mode: t