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_ASKPASS)]} {
1119 set env(GIT_ASKPASS) [gitexec git-gui--askpass]
1121 if {![info exists env(GIT_ASK_YESNO)]} {
1122 set env(GIT_ASK_YESNO) [gitexec git-gui--askyesno]
1125 ######################################################################
1131 set _gitdir $env(GIT_DIR)
1135 # beware that from the .git dir this sets _gitdir to .
1136 # and _prefix to the empty string
1137 set _gitdir [git rev-parse --git-dir]
1138 set _prefix [git rev-parse --show-prefix]
1142 choose_repository::pick
1146 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1147 # run from the .git dir itself) lest the routines to find the worktree
1149 if {$_gitdir eq ".
"} {
1153 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1154 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1156 if {![file isdirectory $_gitdir]} {
1157 catch {wm withdraw .}
1158 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1161 # _gitdir exists, so try loading the config
1164 # try to set work tree from environment, falling back to core.worktree
1165 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1166 set _gitworktree [get_config core.worktree]
1167 if {$_gitworktree eq ""} {
1168 set _gitworktree [file dirname [file normalize $_gitdir]]
1171 if {$_prefix ne {}} {
1172 if {$_gitworktree eq {}} {
1173 regsub -all {[^/]+/} $_prefix ../ cdup
1175 set cdup $_gitworktree
1177 if {[catch {cd $cdup} err]} {
1178 catch {wm withdraw .}
1179 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1182 set _gitworktree [pwd]
1184 } elseif {![is_enabled bare]} {
1186 catch {wm withdraw .}
1187 error_popup [strcat [mc "Cannot use bare repository
:"] "\n\n$_gitdir"]
1190 if {$_gitworktree eq {}} {
1191 set _gitworktree [file dirname $_gitdir]
1193 if {[catch {cd $_gitworktree} err]} {
1194 catch {wm withdraw .}
1195 error_popup [strcat [mc "No working directory
"] " $_gitworktree:\n\n$err"]
1198 set _gitworktree [pwd]
1200 set _reponame [file split [file normalize $_gitdir]]
1201 if {[lindex $_reponame end] eq {.git}} {
1202 set _reponame [lindex $_reponame end-1]
1204 set _reponame [lindex $_reponame end]
1207 ######################################################################
1211 set current_diff_path {}
1212 set current_diff_side {}
1213 set diff_actions [list]
1217 set MERGE_HEAD [list]
1220 set current_branch {}
1222 set current_diff_path {}
1224 set is_submodule_diff 0
1225 set is_conflict_diff 0
1226 set selected_commit_type new
1227 set diff_empty_count 0
1229 set nullid "0000000000000000000000000000000000000000"
1230 set nullid2 "0000000000000000000000000000000000000001"
1232 ######################################################################
1240 set disable_on_lock [list]
1241 set index_lock_type none
1243 proc lock_index {type} {
1244 global index_lock_type disable_on_lock
1246 if {$index_lock_type eq {none}} {
1247 set index_lock_type $type
1248 foreach w $disable_on_lock {
1249 uplevel #0 $w disabled
1252 } elseif {$index_lock_type eq "begin-
$type"} {
1253 set index_lock_type $type
1259 proc unlock_index {} {
1260 global index_lock_type disable_on_lock
1262 set index_lock_type none
1263 foreach w $disable_on_lock {
1264 uplevel #0 $w normal
1268 ######################################################################
1272 proc repository_state {ctvar hdvar mhvar} {
1273 global current_branch
1274 upvar $ctvar ct $hdvar hd $mhvar mh
1279 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1285 set merge_head [gitdir MERGE_HEAD]
1286 if {[file exists $merge_head]} {
1288 set fd_mh [open $merge_head r]
1289 while {[gets $fd_mh line] >= 0} {
1300 global PARENT empty_tree
1302 set p [lindex $PARENT 0]
1306 if {$empty_tree eq {}} {
1307 set empty_tree [git mktree << {}]
1312 proc force_amend {} {
1313 global selected_commit_type
1314 global HEAD PARENT MERGE_HEAD commit_type
1316 repository_state newType newHEAD newMERGE_HEAD
1319 set MERGE_HEAD $newMERGE_HEAD
1320 set commit_type $newType
1322 set selected_commit_type amend
1323 do_select_commit_type
1326 proc rescan {after {honor_trustmtime 1}} {
1327 global HEAD PARENT MERGE_HEAD commit_type
1328 global ui_index ui_workdir ui_comm
1329 global rescan_active file_states
1332 if {$rescan_active > 0 || ![lock_index read]} return
1334 repository_state newType newHEAD newMERGE_HEAD
1335 if {[string match amend* $commit_type]
1336 && $newType eq {normal}
1337 && $newHEAD eq $HEAD} {
1341 set MERGE_HEAD $newMERGE_HEAD
1342 set commit_type $newType
1345 array unset file_states
1347 if {!$::GITGUI_BCK_exists &&
1348 (![$ui_comm edit modified]
1349 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1350 if {[string match amend* $commit_type]} {
1351 } elseif {[load_message GITGUI_MSG]} {
1352 } elseif {[run_prepare_commit_msg_hook]} {
1353 } elseif {[load_message MERGE_MSG]} {
1354 } elseif {[load_message SQUASH_MSG]} {
1357 $ui_comm edit modified false
1360 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1361 rescan_stage2 {} $after
1364 ui_status [mc "Refreshing
file status...
"]
1365 set fd_rf [git_read update-index \
1371 fconfigure $fd_rf -blocking 0 -translation binary
1372 fileevent $fd_rf readable \
1373 [list rescan_stage2 $fd_rf $after]
1378 set is_git_info_exclude {}
1379 proc have_info_exclude {} {
1380 global is_git_info_exclude
1382 if {$is_git_info_exclude eq {}} {
1383 if {[catch {exec test -f [gitdir info exclude]}]} {
1384 set is_git_info_exclude 0
1386 set is_git_info_exclude 1
1389 return $is_git_info_exclude
1392 proc have_info_exclude {} {
1393 return [file readable [gitdir info exclude]]
1397 proc rescan_stage2 {fd after} {
1398 global rescan_active buf_rdi buf_rdf buf_rlo
1402 if {![eof $fd]} return
1406 set ls_others [list --exclude-per-directory=.gitignore]
1407 if {[have_info_exclude]} {
1408 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1410 set user_exclude [get_config core.excludesfile]
1411 if {$user_exclude ne {} && [file readable $user_exclude]} {
1412 lappend ls_others "--exclude-from=$user_exclude"
1420 ui_status [mc "Scanning
for modified files ...
"]
1421 set fd_di [git_read diff-index --cached -z [PARENT]]
1422 set fd_df [git_read diff-files -z]
1423 set fd_lo [eval git_read ls-files --others -z $ls_others]
1425 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1426 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1427 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1428 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1429 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1430 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1433 proc load_message {file} {
1436 set f [gitdir $file]
1437 if {[file isfile $f]} {
1438 if {[catch {set fd [open $f r]}]} {
1441 fconfigure $fd -eofchar {}
1442 set content [string trim [read $fd]]
1444 regsub -all -line {[ \r\t]+$} $content {} content
1445 $ui_comm delete 0.0 end
1446 $ui_comm insert end $content
1452 proc run_prepare_commit_msg_hook {} {
1455 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1456 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1457 # empty file but existant file.
1459 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1461 if {[file isfile [gitdir MERGE_MSG]]} {
1462 set pcm_source "merge
"
1463 set fd_mm [open [gitdir MERGE_MSG] r]
1464 puts -nonewline $fd_pcm [read $fd_mm]
1466 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1467 set pcm_source "squash
"
1468 set fd_sm [open [gitdir SQUASH_MSG] r]
1469 puts -nonewline $fd_pcm [read $fd_sm]
1477 set fd_ph [githook_read prepare-commit-msg \
1478 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1480 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1484 ui_status [mc "Calling prepare-commit-msg hook...
"]
1487 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1488 fileevent $fd_ph readable \
1489 [list prepare_commit_msg_hook_wait $fd_ph]
1494 proc prepare_commit_msg_hook_wait {fd_ph} {
1497 append pch_error [read $fd_ph]
1498 fconfigure $fd_ph -blocking 1
1500 if {[catch {close $fd_ph}]} {
1501 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1502 hook_failed_popup prepare-commit-msg $pch_error
1503 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1506 load_message PREPARE_COMMIT_MSG
1509 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1512 fconfigure $fd_ph -blocking 0
1513 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1516 proc read_diff_index {fd after} {
1519 append buf_rdi [read $fd]
1521 set n [string length $buf_rdi]
1523 set z1 [string first "\
0" $buf_rdi $c]
1524 if {$z1 == -1} break
1526 set z2 [string first "\
0" $buf_rdi $z1]
1527 if {$z2 == -1} break
1530 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1531 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1533 [encoding convertfrom $p] \
1535 [list [lindex $i 0] [lindex $i 2]] \
1541 set buf_rdi [string range $buf_rdi $c end]
1546 rescan_done $fd buf_rdi $after
1549 proc read_diff_files {fd after} {
1552 append buf_rdf [read $fd]
1554 set n [string length $buf_rdf]
1556 set z1 [string first "\
0" $buf_rdf $c]
1557 if {$z1 == -1} break
1559 set z2 [string first "\
0" $buf_rdf $z1]
1560 if {$z2 == -1} break
1563 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1564 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1566 [encoding convertfrom $p] \
1569 [list [lindex $i 0] [lindex $i 2]]
1574 set buf_rdf [string range $buf_rdf $c end]
1579 rescan_done $fd buf_rdf $after
1582 proc read_ls_others {fd after} {
1585 append buf_rlo [read $fd]
1586 set pck [split $buf_rlo "\
0"]
1587 set buf_rlo [lindex $pck end]
1588 foreach p [lrange $pck 0 end-1] {
1589 set p [encoding convertfrom $p]
1590 if {[string index $p end] eq {/}} {
1591 set p [string range $p 0 end-1]
1595 rescan_done $fd buf_rlo $after
1598 proc rescan_done {fd buf after} {
1599 global rescan_active current_diff_path
1600 global file_states repo_config
1603 if {![eof $fd]} return
1606 if {[incr rescan_active -1] > 0} return
1611 if {$current_diff_path ne {}} { reshow_diff $after }
1612 if {$current_diff_path eq {}} { select_first_diff $after }
1615 proc prune_selection {} {
1616 global file_states selected_paths
1618 foreach path [array names selected_paths] {
1619 if {[catch {set still_here $file_states($path)}]} {
1620 unset selected_paths($path)
1625 ######################################################################
1629 proc mapicon {w state path} {
1632 if {[catch {set r $all_icons($state$w)}]} {
1633 puts "error
: no icon
for $w state
={$state} $path"
1639 proc mapdesc {state path} {
1642 if {[catch {set r $all_descs($state)}]} {
1643 puts "error
: no desc
for state
={$state} $path"
1649 proc ui_status {msg} {
1651 if {[info exists main_status]} {
1652 $main_status show $msg
1656 proc ui_ready {{test {}}} {
1658 if {[info exists main_status]} {
1659 $main_status show [mc "Ready.
"] $test
1663 proc escape_path {path} {
1664 regsub -all {\\} $path "\\\\" path
1665 regsub -all "\n" $path "\\n
" path
1669 proc short_path {path} {
1670 return [escape_path [lindex [file split $path] end]]
1674 set null_sha1 [string repeat 0 40]
1676 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1677 global file_states next_icon_id null_sha1
1679 set s0 [string index $new_state 0]
1680 set s1 [string index $new_state 1]
1682 if {[catch {set info $file_states($path)}]} {
1684 set icon n[incr next_icon_id]
1686 set state [lindex $info 0]
1687 set icon [lindex $info 1]
1688 if {$head_info eq {}} {set head_info [lindex $info 2]}
1689 if {$index_info eq {}} {set index_info [lindex $info 3]}
1692 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1693 elseif {$s0 eq {_}} {set s0 _}
1695 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1696 elseif {$s1 eq {_}} {set s1 _}
1698 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1699 set head_info [list 0 $null_sha1]
1700 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1701 && $head_info eq {}} {
1702 set head_info $index_info
1703 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1704 set index_info $head_info
1708 set file_states($path) [list $s0$s1 $icon \
1709 $head_info $index_info \
1714 proc display_file_helper {w path icon_name old_m new_m} {
1717 if {$new_m eq {_}} {
1718 set lno [lsearch -sorted -exact $file_lists($w) $path]
1720 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1722 $w conf -state normal
1723 $w delete $lno.0 [expr {$lno + 1}].0
1724 $w conf -state disabled
1726 } elseif {$old_m eq {_} && $new_m ne {_}} {
1727 lappend file_lists($w) $path
1728 set file_lists($w) [lsort -unique $file_lists($w)]
1729 set lno [lsearch -sorted -exact $file_lists($w) $path]
1731 $w conf -state normal
1732 $w image create $lno.0 \
1733 -align center -padx 5 -pady 1 \
1735 -image [mapicon $w $new_m $path]
1736 $w insert $lno.1 "[escape_path
$path]\n"
1737 $w conf -state disabled
1738 } elseif {$old_m ne $new_m} {
1739 $w conf -state normal
1740 $w image conf $icon_name -image [mapicon $w $new_m $path]
1741 $w conf -state disabled
1745 proc display_file {path state} {
1746 global file_states selected_paths
1747 global ui_index ui_workdir
1749 set old_m [merge_state $path $state]
1750 set s $file_states($path)
1751 set new_m [lindex $s 0]
1752 set icon_name [lindex $s 1]
1754 set o [string index $old_m 0]
1755 set n [string index $new_m 0]
1762 display_file_helper $ui_index $path $icon_name $o $n
1764 if {[string index $old_m 0] eq {U}} {
1767 set o [string index $old_m 1]
1769 if {[string index $new_m 0] eq {U}} {
1772 set n [string index $new_m 1]
1774 display_file_helper $ui_workdir $path $icon_name $o $n
1776 if {$new_m eq {__}} {
1777 unset file_states($path)
1778 catch {unset selected_paths($path)}
1782 proc display_all_files_helper {w path icon_name m} {
1785 lappend file_lists($w) $path
1786 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1787 $w image create end \
1788 -align center -padx 5 -pady 1 \
1790 -image [mapicon $w $m $path]
1791 $w insert end "[escape_path
$path]\n"
1795 proc display_all_files {} {
1796 global ui_index ui_workdir
1797 global file_states file_lists
1799 global files_warning
1801 $ui_index conf -state normal
1802 $ui_workdir conf -state normal
1804 $ui_index delete 0.0 end
1805 $ui_workdir delete 0.0 end
1808 set file_lists($ui_index) [list]
1809 set file_lists($ui_workdir) [list]
1811 set to_display [lsort [array names file_states]]
1812 set display_limit [get_config gui.maxfilesdisplayed]
1813 if {[llength $to_display] > $display_limit} {
1814 if {!$files_warning} {
1815 # do not repeatedly warn:
1817 info_popup [mc "Displaying only
%s of
%s files.
" \
1818 $display_limit [llength $to_display]]
1820 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1822 foreach path $to_display {
1823 set s $file_states($path)
1825 set icon_name [lindex $s 1]
1827 set s [string index $m 0]
1828 if {$s ne {U} && $s ne {_}} {
1829 display_all_files_helper $ui_index $path \
1833 if {[string index $m 0] eq {U}} {
1836 set s [string index $m 1]
1839 display_all_files_helper $ui_workdir $path \
1844 $ui_index conf -state disabled
1845 $ui_workdir conf -state disabled
1848 ######################################################################
1853 #define mask_width 14
1854 #define mask_height 15
1855 static unsigned char mask_bits[] = {
1856 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1857 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1858 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1861 image create bitmap file_plain -background white -foreground black -data {
1862 #define plain_width 14
1863 #define plain_height 15
1864 static unsigned char plain_bits[] = {
1865 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1866 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1867 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1868 } -maskdata $filemask
1870 image create bitmap file_mod -background white -foreground blue -data {
1871 #define mod_width 14
1872 #define mod_height 15
1873 static unsigned char mod_bits[] = {
1874 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1875 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1876 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1877 } -maskdata $filemask
1879 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1880 #define file_fulltick_width 14
1881 #define file_fulltick_height 15
1882 static unsigned char file_fulltick_bits
[] = {
1883 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1884 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1885 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1886 } -maskdata $filemask
1888 image create bitmap file_question
-background white
-foreground black
-data {
1889 #define file_question_width 14
1890 #define file_question_height 15
1891 static unsigned char file_question_bits
[] = {
1892 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1893 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1894 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1895 } -maskdata $filemask
1897 image create bitmap file_removed
-background white
-foreground red
-data {
1898 #define file_removed_width 14
1899 #define file_removed_height 15
1900 static unsigned char file_removed_bits
[] = {
1901 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1902 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1903 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1904 } -maskdata $filemask
1906 image create bitmap file_merge
-background white
-foreground blue
-data {
1907 #define file_merge_width 14
1908 #define file_merge_height 15
1909 static unsigned char file_merge_bits
[] = {
1910 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1911 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1912 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1913 } -maskdata $filemask
1915 image create bitmap file_statechange
-background white
-foreground green
-data {
1916 #define file_merge_width 14
1917 #define file_merge_height 15
1918 static unsigned char file_statechange_bits
[] = {
1919 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1920 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1921 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1922 } -maskdata $filemask
1924 set ui_index .vpane.files.index.list
1925 set ui_workdir .vpane.files.workdir.list
1927 set all_icons
(_
$ui_index) file_plain
1928 set all_icons
(A
$ui_index) file_plain
1929 set all_icons
(M
$ui_index) file_fulltick
1930 set all_icons
(D
$ui_index) file_removed
1931 set all_icons
(U
$ui_index) file_merge
1932 set all_icons
(T
$ui_index) file_statechange
1934 set all_icons
(_
$ui_workdir) file_plain
1935 set all_icons
(M
$ui_workdir) file_mod
1936 set all_icons
(D
$ui_workdir) file_question
1937 set all_icons
(U
$ui_workdir) file_merge
1938 set all_icons
(O
$ui_workdir) file_plain
1939 set all_icons
(T
$ui_workdir) file_statechange
1941 set max_status_desc
0
1943 {__
{mc
"Unmodified"}}
1945 {_M
{mc
"Modified, not staged"}}
1946 {M_
{mc
"Staged for commit"}}
1947 {MM
{mc
"Portions staged for commit"}}
1948 {MD
{mc
"Staged for commit, missing"}}
1950 {_T
{mc
"File type changed, not staged"}}
1951 {T_
{mc
"File type changed, staged"}}
1953 {_O
{mc
"Untracked, not staged"}}
1954 {A_
{mc
"Staged for commit"}}
1955 {AM
{mc
"Portions staged for commit"}}
1956 {AD
{mc
"Staged for commit, missing"}}
1959 {D_
{mc
"Staged for removal"}}
1960 {DO
{mc
"Staged for removal, still present"}}
1962 {_U
{mc
"Requires merge resolution"}}
1963 {U_
{mc
"Requires merge resolution"}}
1964 {UU
{mc
"Requires merge resolution"}}
1965 {UM
{mc
"Requires merge resolution"}}
1966 {UD
{mc
"Requires merge resolution"}}
1967 {UT
{mc
"Requires merge resolution"}}
1969 set text
[eval [lindex
$i 1]]
1970 if {$max_status_desc < [string length
$text]} {
1971 set max_status_desc
[string length
$text]
1973 set all_descs
([lindex
$i 0]) $text
1977 ######################################################################
1981 proc scrollbar2many
{list mode args
} {
1982 foreach w
$list {eval $w $mode $args}
1985 proc many2scrollbar
{list mode sb top bottom
} {
1986 $sb set $top $bottom
1987 foreach w
$list {$w $mode moveto
$top}
1990 proc incr_font_size
{font
{amt
1}} {
1991 set sz
[font configure
$font -size]
1993 font configure
$font -size $sz
1994 font configure
${font}bold
-size $sz
1995 font configure
${font}italic
-size $sz
1998 ######################################################################
2002 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
2004 proc do_gitk
{revs
{is_submodule false
}} {
2005 global current_diff_path file_states current_diff_side ui_index
2008 # -- Always start gitk through whatever we were loaded with. This
2009 # lets us bypass using shell process on Windows systems.
2011 set exe
[_which gitk
-script]
2012 set cmd
[list
[info nameofexecutable
] $exe]
2014 error_popup
[mc
"Couldn't find gitk in PATH"]
2018 if {[info exists env
(GIT_DIR
)]} {
2019 set old_GIT_DIR
$env(GIT_DIR
)
2026 if {!$is_submodule} {
2030 set env
(GIT_DIR
) [file normalize
[gitdir
]]
2032 cd $current_diff_path
2033 if {$revs eq
{--}} {
2034 set s
$file_states($current_diff_path)
2037 switch
-glob -- [lindex
$s 0] {
2038 M_
{ set old_sha1
[lindex
[lindex
$s 2] 1] }
2039 _M
{ set old_sha1
[lindex
[lindex
$s 3] 1] }
2041 if {$current_diff_side eq
$ui_index} {
2042 set old_sha1
[lindex
[lindex
$s 2] 1]
2043 set new_sha1
[lindex
[lindex
$s 3] 1]
2045 set old_sha1
[lindex
[lindex
$s 3] 1]
2049 set revs
$old_sha1...
$new_sha1
2051 if {[info exists env
(GIT_DIR
)]} {
2055 eval exec $cmd $revs "--" "--" &
2057 if {$old_GIT_DIR ne
{}} {
2058 set env
(GIT_DIR
) $old_GIT_DIR
2062 ui_status $
::starting_gitk_msg
2064 ui_ready
$starting_gitk_msg
2069 proc do_git_gui
{} {
2070 global current_diff_path
2072 # -- Always start git gui through whatever we were loaded with. This
2073 # lets us bypass using shell process on Windows systems.
2075 set exe
[list
[_which git
]]
2077 error_popup
[mc
"Couldn't find git gui in PATH"]
2081 if {[info exists env
(GIT_DIR
)]} {
2082 set old_GIT_DIR
$env(GIT_DIR
)
2089 cd $current_diff_path
2091 eval exec $exe gui
&
2093 if {$old_GIT_DIR ne
{}} {
2094 set env
(GIT_DIR
) $old_GIT_DIR
2098 ui_status $
::starting_gitk_msg
2100 ui_ready
$starting_gitk_msg
2105 proc do_explore
{} {
2108 if {[is_Cygwin
] ||
[is_Windows
]} {
2109 set explorer
"explorer.exe"
2110 } elseif
{[is_MacOSX
]} {
2113 # freedesktop.org-conforming system is our best shot
2114 set explorer
"xdg-open"
2116 eval exec $explorer [list
[file nativename
$_gitworktree]] &
2122 proc terminate_me
{win
} {
2124 if {$win ne
{.
}} return
2128 proc do_quit
{{rc
{1}}} {
2129 global ui_comm is_quitting repo_config commit_type
2130 global GITGUI_BCK_exists GITGUI_BCK_i
2131 global ui_comm_spell
2132 global ret_code use_ttk
2134 if {$is_quitting} return
2137 if {[winfo exists
$ui_comm]} {
2138 # -- Stash our current commit buffer.
2140 set save
[gitdir GITGUI_MSG
]
2141 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
2142 file rename
-force [gitdir GITGUI_BCK
] $save
2143 set GITGUI_BCK_exists
0
2145 set msg
[string trim
[$ui_comm get
0.0 end
]]
2146 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2147 if {(![string match amend
* $commit_type]
2148 ||
[$ui_comm edit modified
])
2151 set fd
[open
$save w
]
2152 puts
-nonewline $fd $msg
2156 catch
{file delete
$save}
2160 # -- Cancel our spellchecker if its running.
2162 if {[info exists ui_comm_spell
]} {
2166 # -- Remove our editor backup, its not needed.
2168 after cancel
$GITGUI_BCK_i
2169 if {$GITGUI_BCK_exists} {
2170 catch
{file delete
[gitdir GITGUI_BCK
]}
2173 # -- Stash our current window geometry into this repository.
2175 set cfg_wmstate
[wm state .
]
2176 if {[catch
{set rc_wmstate
$repo_config(gui.wmstate
)}]} {
2179 if {$cfg_wmstate ne
$rc_wmstate} {
2180 catch
{git config gui.wmstate
$cfg_wmstate}
2182 if {$cfg_wmstate eq
{zoomed
}} {
2183 # on Windows wm geometry will lie about window
2184 # position (but not size) when window is zoomed
2185 # restore the window before querying wm geometry
2188 set cfg_geometry
[list
]
2189 lappend cfg_geometry
[wm geometry .
]
2191 lappend cfg_geometry
[.vpane sashpos
0]
2192 lappend cfg_geometry
[.vpane.files sashpos
0]
2194 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
2195 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
2197 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2200 if {$cfg_geometry ne
$rc_geometry} {
2201 catch
{git config gui.geometry
$cfg_geometry}
2207 # Briefly enable send again, working around Tk bug
2208 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2209 tk appname
[appname
]
2218 proc ui_do_rescan
{} {
2219 rescan
{force_first_diff ui_ready
}
2226 proc next_diff
{{after
{}}} {
2227 global next_diff_p next_diff_w next_diff_i
2228 show_diff
$next_diff_p $next_diff_w {} {} $after
2231 proc find_anchor_pos
{lst name
} {
2232 set lid
[lsearch
-sorted -exact $lst $name]
2236 foreach lname
$lst {
2237 if {$lname >= $name} break
2245 proc find_file_from
{flist idx delta path mmask
} {
2248 set len
[llength
$flist]
2249 while {$idx >= 0 && $idx < $len} {
2250 set name
[lindex
$flist $idx]
2252 if {$name ne
$path && [info exists file_states
($name)]} {
2253 set state
[lindex
$file_states($name) 0]
2255 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2266 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2267 global next_diff_p next_diff_w next_diff_i
2268 global file_lists ui_index ui_workdir
2270 set flist
$file_lists($w)
2272 set lno
[find_anchor_pos
$flist $path]
2277 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2278 if {$w eq
$ui_index} {
2281 set mmask
"$mmask\$"
2285 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2288 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2293 set next_diff_p
[lindex
$flist $idx]
2294 set next_diff_i
[expr {$idx+1}]
2301 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2302 global current_diff_path
2304 if {$path ne
$current_diff_path} {
2306 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2309 return {reshow_diff
;}
2313 proc select_first_diff
{after
} {
2316 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2317 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2324 proc force_first_diff
{after
} {
2325 global ui_workdir current_diff_path file_states
2327 if {[info exists file_states
($current_diff_path)]} {
2328 set state
[lindex
$file_states($current_diff_path) 0]
2334 if {[string first
{U
} $state] >= 0} {
2335 # Already a conflict, do nothing
2336 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {^_?U
}]} {
2338 } elseif
{[string index
$state 1] ne
{O
}} {
2339 # Already a diff & no conflicts, do nothing
2340 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {[^O
]$
}]} {
2351 proc toggle_or_diff
{w x y
} {
2352 global file_states file_lists current_diff_path ui_index ui_workdir
2353 global last_clicked selected_paths
2355 set pos
[split [$w index @
$x,$y] .
]
2356 set lno
[lindex
$pos 0]
2357 set col [lindex
$pos 1]
2358 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2364 set last_clicked
[list
$w $lno]
2365 array
unset selected_paths
2366 $ui_index tag remove in_sel
0.0 end
2367 $ui_workdir tag remove in_sel
0.0 end
2369 # Determine the state of the file
2370 if {[info exists file_states
($path)]} {
2371 set state
[lindex
$file_states($path) 0]
2376 # Restage the file, or simply show the diff
2377 if {$col == 0 && $y > 1} {
2378 # Conflicts need special handling
2379 if {[string first
{U
} $state] >= 0} {
2380 # $w must always be $ui_workdir, but...
2381 if {$w ne
$ui_workdir} { set lno
{} }
2382 merge_stage_workdir
$path $lno
2386 if {[string index
$state 1] eq
{O
}} {
2392 set after
[next_diff_after_action
$w $path $lno $mmask]
2394 if {$w eq
$ui_index} {
2396 "Unstaging [short_path $path] from commit" \
2398 [concat
$after [list ui_ready
]]
2399 } elseif
{$w eq
$ui_workdir} {
2401 "Adding [short_path $path]" \
2403 [concat
$after [list ui_ready
]]
2406 show_diff
$path $w $lno
2410 proc add_one_to_selection
{w x y
} {
2411 global file_lists last_clicked selected_paths
2413 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2414 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2420 if {$last_clicked ne
{}
2421 && [lindex
$last_clicked 0] ne
$w} {
2422 array
unset selected_paths
2423 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2426 set last_clicked
[list
$w $lno]
2427 if {[catch
{set in_sel
$selected_paths($path)}]} {
2431 unset selected_paths
($path)
2432 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2434 set selected_paths
($path) 1
2435 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2439 proc add_range_to_selection
{w x y
} {
2440 global file_lists last_clicked selected_paths
2442 if {[lindex
$last_clicked 0] ne
$w} {
2443 toggle_or_diff
$w $x $y
2447 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2448 set lc
[lindex
$last_clicked 1]
2457 foreach path
[lrange
$file_lists($w) \
2458 [expr {$begin - 1}] \
2459 [expr {$end - 1}]] {
2460 set selected_paths
($path) 1
2462 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2465 proc show_more_context
{} {
2467 if {$repo_config(gui.diffcontext
) < 99} {
2468 incr repo_config
(gui.diffcontext
)
2473 proc show_less_context
{} {
2475 if {$repo_config(gui.diffcontext
) > 1} {
2476 incr repo_config
(gui.diffcontext
) -1
2481 ######################################################################
2489 menu .mbar
-tearoff 0
2491 # -- Apple Menu (Mac OS X only)
2493 .mbar add cascade
-label Apple
-menu .mbar.apple
2496 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2497 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2498 if {[is_enabled branch
]} {
2499 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2501 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2502 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2504 if {[is_enabled transport
]} {
2505 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2506 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2508 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2509 .mbar add cascade
-label [mc Tools
] -menu .mbar.tools
2512 # -- Repository Menu
2514 menu .mbar.repository
2517 .mbar.repository add
command \
2518 -label [mc
"Explore Working Copy"] \
2519 -command {do_explore
}
2520 .mbar.repository add separator
2523 .mbar.repository add
command \
2524 -label [mc
"Browse Current Branch's Files"] \
2525 -command {browser
::new
$current_branch}
2526 set ui_browse_current
[.mbar.repository index last
]
2527 .mbar.repository add
command \
2528 -label [mc
"Browse Branch Files..."] \
2529 -command browser_open
::dialog
2530 .mbar.repository add separator
2532 .mbar.repository add
command \
2533 -label [mc
"Visualize Current Branch's History"] \
2534 -command {do_gitk
$current_branch}
2535 set ui_visualize_current
[.mbar.repository index last
]
2536 .mbar.repository add
command \
2537 -label [mc
"Visualize All Branch History"] \
2538 -command {do_gitk
--all}
2539 .mbar.repository add separator
2541 proc current_branch_write
{args
} {
2542 global current_branch
2543 .mbar.repository entryconf $
::ui_browse_current \
2544 -label [mc
"Browse %s's Files" $current_branch]
2545 .mbar.repository entryconf $
::ui_visualize_current \
2546 -label [mc
"Visualize %s's History" $current_branch]
2548 trace add variable current_branch
write current_branch_write
2550 if {[is_enabled multicommit
]} {
2551 .mbar.repository add
command -label [mc
"Database Statistics"] \
2554 .mbar.repository add
command -label [mc
"Compress Database"] \
2557 .mbar.repository add
command -label [mc
"Verify Database"] \
2558 -command do_fsck_objects
2560 .mbar.repository add separator
2563 .mbar.repository add
command \
2564 -label [mc
"Create Desktop Icon"] \
2565 -command do_cygwin_shortcut
2566 } elseif
{[is_Windows
]} {
2567 .mbar.repository add
command \
2568 -label [mc
"Create Desktop Icon"] \
2569 -command do_windows_shortcut
2570 } elseif
{[is_MacOSX
]} {
2571 .mbar.repository add
command \
2572 -label [mc
"Create Desktop Icon"] \
2573 -command do_macosx_app
2578 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2580 .mbar.repository add
command -label [mc Quit
] \
2588 .mbar.edit add
command -label [mc Undo
] \
2589 -command {catch
{[focus
] edit undo
}} \
2591 .mbar.edit add
command -label [mc Redo
] \
2592 -command {catch
{[focus
] edit redo
}} \
2594 .mbar.edit add separator
2595 .mbar.edit add
command -label [mc Cut
] \
2596 -command {catch
{tk_textCut
[focus
]}} \
2598 .mbar.edit add
command -label [mc Copy
] \
2599 -command {catch
{tk_textCopy
[focus
]}} \
2601 .mbar.edit add
command -label [mc Paste
] \
2602 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2604 .mbar.edit add
command -label [mc Delete
] \
2605 -command {catch
{[focus
] delete sel.first sel.last
}} \
2607 .mbar.edit add separator
2608 .mbar.edit add
command -label [mc
"Select All"] \
2609 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2614 if {[is_enabled branch
]} {
2617 .mbar.branch add
command -label [mc
"Create..."] \
2618 -command branch_create
::dialog \
2620 lappend disable_on_lock
[list .mbar.branch entryconf \
2621 [.mbar.branch index last
] -state]
2623 .mbar.branch add
command -label [mc
"Checkout..."] \
2624 -command branch_checkout
::dialog \
2626 lappend disable_on_lock
[list .mbar.branch entryconf \
2627 [.mbar.branch index last
] -state]
2629 .mbar.branch add
command -label [mc
"Rename..."] \
2630 -command branch_rename
::dialog
2631 lappend disable_on_lock
[list .mbar.branch entryconf \
2632 [.mbar.branch index last
] -state]
2634 .mbar.branch add
command -label [mc
"Delete..."] \
2635 -command branch_delete
::dialog
2636 lappend disable_on_lock
[list .mbar.branch entryconf \
2637 [.mbar.branch index last
] -state]
2639 .mbar.branch add
command -label [mc
"Reset..."] \
2640 -command merge
::reset_hard
2641 lappend disable_on_lock
[list .mbar.branch entryconf \
2642 [.mbar.branch index last
] -state]
2647 proc commit_btn_caption
{} {
2648 if {[is_enabled nocommit
]} {
2651 return [mc Commit@@verb
]
2655 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2658 if {![is_enabled nocommit
]} {
2659 .mbar.commit add radiobutton \
2660 -label [mc
"New Commit"] \
2661 -command do_select_commit_type \
2662 -variable selected_commit_type \
2664 lappend disable_on_lock \
2665 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2667 .mbar.commit add radiobutton \
2668 -label [mc
"Amend Last Commit"] \
2669 -command do_select_commit_type \
2670 -variable selected_commit_type \
2672 lappend disable_on_lock \
2673 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2675 .mbar.commit add separator
2678 .mbar.commit add
command -label [mc Rescan
] \
2679 -command ui_do_rescan \
2681 lappend disable_on_lock \
2682 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2684 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2685 -command do_add_selection \
2687 lappend disable_on_lock \
2688 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2690 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2691 -command do_add_all \
2693 lappend disable_on_lock \
2694 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2696 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2697 -command do_unstage_selection \
2699 lappend disable_on_lock \
2700 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2702 .mbar.commit add
command -label [mc
"Revert Changes"] \
2703 -command do_revert_selection \
2705 lappend disable_on_lock \
2706 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2708 .mbar.commit add separator
2710 .mbar.commit add
command -label [mc
"Show Less Context"] \
2711 -command show_less_context \
2712 -accelerator $M1T-\
-
2714 .mbar.commit add
command -label [mc
"Show More Context"] \
2715 -command show_more_context \
2718 .mbar.commit add separator
2720 if {![is_enabled nocommitmsg
]} {
2721 .mbar.commit add
command -label [mc
"Sign Off"] \
2722 -command do_signoff \
2726 .mbar.commit add
command -label [commit_btn_caption
] \
2727 -command do_commit \
2728 -accelerator $M1T-Return
2729 lappend disable_on_lock \
2730 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2735 if {[is_enabled branch
]} {
2737 .mbar.merge add
command -label [mc
"Local Merge..."] \
2738 -command merge
::dialog \
2740 lappend disable_on_lock \
2741 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2742 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2743 -command merge
::reset_hard
2744 lappend disable_on_lock \
2745 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2750 if {[is_enabled transport
]} {
2753 .mbar.remote add
command \
2754 -label [mc
"Add..."] \
2755 -command remote_add
::dialog \
2757 .mbar.remote add
command \
2758 -label [mc
"Push..."] \
2759 -command do_push_anywhere \
2761 .mbar.remote add
command \
2762 -label [mc
"Delete Branch..."] \
2763 -command remote_branch_delete
::dialog
2767 proc
::tk
::mac
::ShowPreferences
{} {do_options
}
2771 .mbar.edit add separator
2772 .mbar.edit add
command -label [mc
"Options..."] \
2778 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2779 set tools_menubar .mbar.tools
2781 $tools_menubar add separator
2782 $tools_menubar add
command -label [mc
"Add..."] -command tools_add
::dialog
2783 $tools_menubar add
command -label [mc
"Remove..."] -command tools_remove
::dialog
2785 if {[array names repo_config guitool.
*.cmd
] ne
{}} {
2792 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2796 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2798 .mbar.apple add separator
2800 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2803 . configure
-menu .mbar
2805 set doc_path
[githtmldir
]
2806 if {$doc_path ne
{}} {
2807 set doc_path
[file join $doc_path index.html
]
2810 set doc_path
[exec cygpath
--mixed $doc_path]
2814 if {[file isfile
$doc_path]} {
2815 set doc_url
"file:$doc_path"
2817 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2820 proc start_browser
{url
} {
2821 git
"web--browse" $url
2824 .mbar.
help add
command -label [mc
"Online Documentation"] \
2825 -command [list start_browser
$doc_url]
2827 .mbar.
help add
command -label [mc
"Show SSH Key"] \
2830 unset doc_path doc_url
2832 # -- Standard bindings
2834 wm protocol . WM_DELETE_WINDOW do_quit
2835 bind all
<$M1B-Key-q> do_quit
2836 bind all
<$M1B-Key-Q> do_quit
2837 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2838 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2840 set subcommand_args
{}
2842 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2846 proc normalize_relpath
{path
} {
2848 foreach item
[file split $path] {
2849 if {$item eq
{.
}} continue
2850 if {$item eq
{..
} && [llength
$elements] > 0
2851 && [lindex
$elements end
] ne
{..
}} {
2852 set elements
[lrange
$elements 0 end-1
]
2855 lappend elements
$item
2857 return [eval file join $elements]
2860 # -- Not a normal commit type invocation? Do that instead!
2862 switch
-- $subcommand {
2865 if {$subcommand eq
"blame"} {
2866 set subcommand_args
{[--line=<num
>] rev? path
}
2868 set subcommand_args
{rev? path
}
2870 if {$argv eq
{}} usage
2876 if {$is_path ||
[file exists
$_prefix$a]} {
2877 if {$path ne
{}} usage
2878 set path
[normalize_relpath
$_prefix$a]
2880 } elseif
{$a eq
{--}} {
2882 if {$head ne
{}} usage
2887 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
2888 if {$jump_spec ne
{} ||
$head ne
{}} usage
2889 set jump_spec
[list
$lnum]
2890 } elseif
{$head eq
{}} {
2891 if {$head ne
{}} usage
2900 if {$head ne
{} && $path eq
{}} {
2901 set path
[normalize_relpath
$_prefix$head]
2908 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2910 set head [git rev-parse
--verify $head]
2916 set current_branch
$head
2919 switch
-- $subcommand {
2921 if {$jump_spec ne
{}} usage
2923 if {$path ne
{} && [file isdirectory
$path]} {
2924 set head $current_branch
2930 browser
::new
$head $path
2933 if {$head eq
{} && ![file exists
$path]} {
2934 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2937 blame
::new
$head $path $jump_spec
2944 if {[llength
$argv] != 0} {
2945 puts
-nonewline stderr
"usage: $argv0"
2946 if {$subcommand ne
{gui
}
2947 && [file tail $argv0] ne
"git-$subcommand"} {
2948 puts
-nonewline stderr
" $subcommand"
2953 # fall through to setup UI for commits
2956 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2963 ${NS}::frame .branch
2964 if {!$use_ttk} {.branch configure
-borderwidth 1 -relief sunken
}
2965 ${NS}::label .branch.l1 \
2966 -text [mc
"Current Branch:"] \
2969 ${NS}::label .branch.cb \
2970 -textvariable current_branch \
2973 pack .branch.l1
-side left
2974 pack .branch.cb
-side left
-fill x
2975 pack .branch
-side top
-fill x
2977 # -- Main Window Layout
2979 ${NS}::panedwindow .vpane
-orient horizontal
2980 ${NS}::panedwindow .vpane.files
-orient vertical
2982 .vpane add .vpane.files
2984 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2986 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2988 # -- Index File List
2990 ${NS}::frame .vpane.files.index
-height 100 -width 200
2991 tlabel .vpane.files.index.title \
2992 -text [mc
"Staged Changes (Will Commit)"] \
2993 -background lightgreen
-foreground black
2994 text
$ui_index -background white
-foreground black \
2996 -width 20 -height 10 \
2998 -cursor $cursor_ptr \
2999 -xscrollcommand {.vpane.files.index.sx
set} \
3000 -yscrollcommand {.vpane.files.index.sy
set} \
3002 ${NS}::scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
3003 ${NS}::scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
3004 pack .vpane.files.index.title
-side top
-fill x
3005 pack .vpane.files.index.sx
-side bottom
-fill x
3006 pack .vpane.files.index.sy
-side right
-fill y
3007 pack
$ui_index -side left
-fill both
-expand 1
3009 # -- Working Directory File List
3011 ${NS}::frame .vpane.files.workdir
-height 100 -width 200
3012 tlabel .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
3013 -background lightsalmon
-foreground black
3014 text
$ui_workdir -background white
-foreground black \
3016 -width 20 -height 10 \
3018 -cursor $cursor_ptr \
3019 -xscrollcommand {.vpane.files.workdir.sx
set} \
3020 -yscrollcommand {.vpane.files.workdir.sy
set} \
3022 ${NS}::scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
3023 ${NS}::scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
3024 pack .vpane.files.workdir.title
-side top
-fill x
3025 pack .vpane.files.workdir.sx
-side bottom
-fill x
3026 pack .vpane.files.workdir.sy
-side right
-fill y
3027 pack
$ui_workdir -side left
-fill both
-expand 1
3029 .vpane.files add .vpane.files.workdir
3030 .vpane.files add .vpane.files.index
3032 .vpane.files paneconfigure .vpane.files.workdir
-sticky news
3033 .vpane.files paneconfigure .vpane.files.index
-sticky news
3036 foreach i
[list
$ui_index $ui_workdir] {
3038 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
3042 # -- Diff and Commit Area
3044 ${NS}::frame .vpane.lower
-height 300 -width 400
3045 ${NS}::frame .vpane.lower.commarea
3046 ${NS}::frame .vpane.lower.
diff -relief sunken
-borderwidth 1
3047 pack .vpane.lower.
diff -fill both
-expand 1
3048 pack .vpane.lower.commarea
-side bottom
-fill x
3049 .vpane add .vpane.lower
3050 if {!$use_ttk} {.vpane paneconfigure .vpane.lower
-sticky nsew
}
3052 # -- Commit Area Buttons
3054 ${NS}::frame .vpane.lower.commarea.buttons
3055 ${NS}::label .vpane.lower.commarea.buttons.l
-text {} \
3058 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
3059 pack .vpane.lower.commarea.buttons
-side left
-fill y
3061 ${NS}::button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
3062 -command ui_do_rescan
3063 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
3064 lappend disable_on_lock \
3065 {.vpane.lower.commarea.buttons.rescan conf
-state}
3067 ${NS}::button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
3069 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
3070 lappend disable_on_lock \
3071 {.vpane.lower.commarea.buttons.incall conf
-state}
3073 if {![is_enabled nocommitmsg
]} {
3074 ${NS}::button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
3076 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
3079 ${NS}::button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
3081 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
3082 lappend disable_on_lock \
3083 {.vpane.lower.commarea.buttons.commit conf
-state}
3085 if {![is_enabled nocommit
]} {
3086 ${NS}::button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
3087 -command do_push_anywhere
3088 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
3091 # -- Commit Message Buffer
3093 ${NS}::frame .vpane.lower.commarea.buffer
3094 ${NS}::frame .vpane.lower.commarea.buffer.header
3095 set ui_comm .vpane.lower.commarea.buffer.t
3096 set ui_coml .vpane.lower.commarea.buffer.header.l
3098 if {![is_enabled nocommit
]} {
3099 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3100 -text [mc
"New Commit"] \
3101 -command do_select_commit_type \
3102 -variable selected_commit_type \
3104 lappend disable_on_lock \
3105 [list .vpane.lower.commarea.buffer.header.new conf
-state]
3106 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3107 -text [mc
"Amend Last Commit"] \
3108 -command do_select_commit_type \
3109 -variable selected_commit_type \
3111 lappend disable_on_lock \
3112 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
3115 ${NS}::label
$ui_coml \
3118 proc trace_commit_type
{varname args
} {
3119 global ui_coml commit_type
3120 switch
-glob -- $commit_type {
3121 initial
{set txt
[mc
"Initial Commit Message:"]}
3122 amend
{set txt
[mc
"Amended Commit Message:"]}
3123 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
3124 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
3125 merge
{set txt
[mc
"Merge Commit Message:"]}
3126 * {set txt
[mc
"Commit Message:"]}
3128 $ui_coml conf
-text $txt
3130 trace add variable commit_type
write trace_commit_type
3131 pack
$ui_coml -side left
-fill x
3133 if {![is_enabled nocommit
]} {
3134 pack .vpane.lower.commarea.buffer.header.amend
-side right
3135 pack .vpane.lower.commarea.buffer.header.new
-side right
3138 text
$ui_comm -background white
-foreground black \
3142 -autoseparators true \
3144 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
3146 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
3147 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3148 -command [list
$ui_comm yview
]
3149 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
3150 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
3151 pack
$ui_comm -side left
-fill y
3152 pack .vpane.lower.commarea.buffer
-side left
-fill y
3154 # -- Commit Message Buffer Context Menu
3156 set ctxm .vpane.lower.commarea.buffer.ctxm
3157 menu
$ctxm -tearoff 0
3160 -command {tk_textCut
$ui_comm}
3163 -command {tk_textCopy
$ui_comm}
3166 -command {tk_textPaste
$ui_comm}
3168 -label [mc Delete
] \
3169 -command {catch
{$ui_comm delete sel.first sel.last
}}
3172 -label [mc
"Select All"] \
3173 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
3175 -label [mc
"Copy All"] \
3177 $ui_comm tag add sel
0.0 end
3178 tk_textCopy
$ui_comm
3179 $ui_comm tag remove sel
0.0 end
3183 -label [mc
"Sign Off"] \
3185 set ui_comm_ctxm
$ctxm
3189 proc trace_current_diff_path
{varname args
} {
3190 global current_diff_path diff_actions file_states
3191 if {$current_diff_path eq
{}} {
3197 set p
$current_diff_path
3198 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
3200 set p
[escape_path
$p]
3204 .vpane.lower.
diff.header.status configure
-text $s
3205 .vpane.lower.
diff.header.
file configure
-text $f
3206 .vpane.lower.
diff.header.path configure
-text $p
3207 foreach w
$diff_actions {
3211 trace add variable current_diff_path
write trace_current_diff_path
3213 gold_frame .vpane.lower.
diff.header
3214 tlabel .vpane.lower.
diff.header.status \
3217 -width $max_status_desc \
3220 tlabel .vpane.lower.
diff.header.
file \
3225 tlabel .vpane.lower.
diff.header.path \
3230 pack .vpane.lower.
diff.header.status
-side left
3231 pack .vpane.lower.
diff.header.
file -side left
3232 pack .vpane.lower.
diff.header.path
-fill x
3233 set ctxm .vpane.lower.
diff.header.ctxm
3234 menu
$ctxm -tearoff 0
3242 -- $current_diff_path
3244 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3245 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
3249 ${NS}::frame .vpane.lower.
diff.body
3250 set ui_diff .vpane.lower.
diff.body.t
3251 text
$ui_diff -background white
-foreground black \
3253 -width 80 -height 5 -wrap none \
3255 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
3256 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
3258 ${NS}::scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
3259 -command [list
$ui_diff xview
]
3260 ${NS}::scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
3261 -command [list
$ui_diff yview
]
3262 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
3263 pack .vpane.lower.
diff.body.sby
-side right
-fill y
3264 pack
$ui_diff -side left
-fill both
-expand 1
3265 pack .vpane.lower.
diff.header
-side top
-fill x
3266 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
3268 $ui_diff tag conf d_cr
-elide true
3269 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
3270 $ui_diff tag conf d_
+ -foreground {#00a000}
3271 $ui_diff tag conf d_-
-foreground red
3273 $ui_diff tag conf d_
++ -foreground {#00a000}
3274 $ui_diff tag conf d_--
-foreground red
3275 $ui_diff tag conf d_
+s \
3276 -foreground {#00a000} \
3277 -background {#e2effa}
3278 $ui_diff tag conf d_-s \
3280 -background {#e2effa}
3281 $ui_diff tag conf d_s
+ \
3282 -foreground {#00a000} \
3284 $ui_diff tag conf d_s- \
3288 $ui_diff tag conf d
<<<<<<< \
3289 -foreground orange \
3291 $ui_diff tag conf d
======= \
3292 -foreground orange \
3294 $ui_diff tag conf d
>>>>>>> \
3295 -foreground orange \
3298 $ui_diff tag raise sel
3300 # -- Diff Body Context Menu
3303 proc create_common_diff_popup
{ctxm
} {
3305 -label [mc Refresh
] \
3306 -command reshow_diff
3307 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3310 -command {tk_textCopy
$ui_diff}
3311 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3313 -label [mc
"Select All"] \
3314 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3315 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3317 -label [mc
"Copy All"] \
3319 $ui_diff tag add sel
0.0 end
3320 tk_textCopy
$ui_diff
3321 $ui_diff tag remove sel
0.0 end
3323 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3326 -label [mc
"Decrease Font Size"] \
3327 -command {incr_font_size font_diff
-1}
3328 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3330 -label [mc
"Increase Font Size"] \
3331 -command {incr_font_size font_diff
1}
3332 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3336 build_encoding_menu
$emenu [list force_diff_encoding
]
3338 -label [mc
"Encoding"] \
3340 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3342 $ctxm add
command -label [mc
"Options..."] \
3346 set ctxm .vpane.lower.
diff.body.ctxm
3347 menu
$ctxm -tearoff 0
3349 -label [mc
"Apply/Reverse Hunk"] \
3350 -command {apply_hunk
$cursorX $cursorY}
3351 set ui_diff_applyhunk
[$ctxm index last
]
3352 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3354 -label [mc
"Apply/Reverse Line"] \
3355 -command {apply_range_or_line
$cursorX $cursorY; do_rescan
}
3356 set ui_diff_applyline
[$ctxm index last
]
3357 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3360 -label [mc
"Show Less Context"] \
3361 -command show_less_context
3362 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3364 -label [mc
"Show More Context"] \
3365 -command show_more_context
3366 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3368 create_common_diff_popup
$ctxm
3370 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3371 menu
$ctxmmg -tearoff 0
3372 $ctxmmg add
command \
3373 -label [mc
"Run Merge Tool"] \
3374 -command {merge_resolve_tool
}
3375 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3376 $ctxmmg add separator
3377 $ctxmmg add
command \
3378 -label [mc
"Use Remote Version"] \
3379 -command {merge_resolve_one
3}
3380 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3381 $ctxmmg add
command \
3382 -label [mc
"Use Local Version"] \
3383 -command {merge_resolve_one
2}
3384 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3385 $ctxmmg add
command \
3386 -label [mc
"Revert To Base"] \
3387 -command {merge_resolve_one
1}
3388 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3389 $ctxmmg add separator
3390 $ctxmmg add
command \
3391 -label [mc
"Show Less Context"] \
3392 -command show_less_context
3393 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3394 $ctxmmg add
command \
3395 -label [mc
"Show More Context"] \
3396 -command show_more_context
3397 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3398 $ctxmmg add separator
3399 create_common_diff_popup
$ctxmmg
3401 set ctxmsm .vpane.lower.
diff.body.ctxmsm
3402 menu
$ctxmsm -tearoff 0
3403 $ctxmsm add
command \
3404 -label [mc
"Visualize These Changes In The Submodule"] \
3405 -command {do_gitk
-- true
}
3406 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3407 $ctxmsm add
command \
3408 -label [mc
"Visualize Current Branch History In The Submodule"] \
3409 -command {do_gitk
{} true
}
3410 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3411 $ctxmsm add
command \
3412 -label [mc
"Visualize All Branch History In The Submodule"] \
3413 -command {do_gitk
--all true
}
3414 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3415 $ctxmsm add separator
3416 $ctxmsm add
command \
3417 -label [mc
"Start git gui In The Submodule"] \
3418 -command {do_git_gui
}
3419 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3420 $ctxmsm add separator
3421 create_common_diff_popup
$ctxmsm
3423 proc popup_diff_menu
{ctxm ctxmmg ctxmsm x y X Y
} {
3424 global current_diff_path file_states
3427 if {[info exists file_states
($current_diff_path)]} {
3428 set state
[lindex
$file_states($current_diff_path) 0]
3432 if {[string first
{U
} $state] >= 0} {
3433 tk_popup
$ctxmmg $X $Y
3434 } elseif
{$
::is_submodule_diff
} {
3435 tk_popup
$ctxmsm $X $Y
3437 set has_range
[expr {[$
::ui_diff tag nextrange sel
0.0] != {}}]
3438 if {$
::ui_index eq $
::current_diff_side
} {
3439 set l
[mc
"Unstage Hunk From Commit"]
3441 set t
[mc
"Unstage Lines From Commit"]
3443 set t
[mc
"Unstage Line From Commit"]
3446 set l
[mc
"Stage Hunk For Commit"]
3448 set t
[mc
"Stage Lines For Commit"]
3450 set t
[mc
"Stage Line For Commit"]
3454 ||
$current_diff_path eq
{}
3458 ||
{T_
} eq
$state} {
3463 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3464 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3465 tk_popup
$ctxm $X $Y
3468 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg $ctxmsm %x
%y
%X
%Y
]
3472 set main_status
[::status_bar
::new .status
]
3473 pack .status
-anchor w
-side bottom
-fill x
3474 $main_status show
[mc
"Initializing..."]
3479 set gm
$repo_config(gui.geometry
)
3480 wm geometry .
[lindex
$gm 0]
3482 .vpane sashpos
0 [lindex
$gm 1]
3483 .vpane.files sashpos
0 [lindex
$gm 2]
3485 .vpane sash place
0 \
3487 [lindex
[.vpane sash coord
0] 1]
3488 .vpane.files sash place
0 \
3489 [lindex
[.vpane.files sash coord
0] 0] \
3495 # -- Load window state
3498 set gws
$repo_config(gui.wmstate
)
3505 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3506 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3507 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3508 bind $ui_comm <$M1B-Key-u> {do_unstage_selection
;break}
3509 bind $ui_comm <$M1B-Key-U> {do_unstage_selection
;break}
3510 bind $ui_comm <$M1B-Key-j> {do_revert_selection
;break}
3511 bind $ui_comm <$M1B-Key-J> {do_revert_selection
;break}
3512 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3513 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3514 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3515 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3516 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3517 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3518 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3519 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3520 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3521 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3522 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3523 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3524 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3525 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3526 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3528 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3529 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3530 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3531 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3532 bind $ui_diff <$M1B-Key-v> {break}
3533 bind $ui_diff <$M1B-Key-V> {break}
3534 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3535 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3536 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3537 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3538 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3539 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3540 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3541 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3542 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3543 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3544 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3545 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3546 bind $ui_diff <Button-1
> {focus
%W
}
3548 if {[is_enabled branch
]} {
3549 bind .
<$M1B-Key-n> branch_create
::dialog
3550 bind .
<$M1B-Key-N> branch_create
::dialog
3551 bind .
<$M1B-Key-o> branch_checkout
::dialog
3552 bind .
<$M1B-Key-O> branch_checkout
::dialog
3553 bind .
<$M1B-Key-m> merge
::dialog
3554 bind .
<$M1B-Key-M> merge
::dialog
3556 if {[is_enabled transport
]} {
3557 bind .
<$M1B-Key-p> do_push_anywhere
3558 bind .
<$M1B-Key-P> do_push_anywhere
3561 bind .
<Key-F5
> ui_do_rescan
3562 bind .
<$M1B-Key-r> ui_do_rescan
3563 bind .
<$M1B-Key-R> ui_do_rescan
3564 bind .
<$M1B-Key-s> do_signoff
3565 bind .
<$M1B-Key-S> do_signoff
3566 bind .
<$M1B-Key-t> do_add_selection
3567 bind .
<$M1B-Key-T> do_add_selection
3568 bind .
<$M1B-Key-j> do_revert_selection
3569 bind .
<$M1B-Key-J> do_revert_selection
3570 bind .
<$M1B-Key-i> do_add_all
3571 bind .
<$M1B-Key-I> do_add_all
3572 bind .
<$M1B-Key-minus> {show_less_context
;break}
3573 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3574 bind .
<$M1B-Key-equal> {show_more_context
;break}
3575 bind .
<$M1B-Key-plus> {show_more_context
;break}
3576 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3577 bind .
<$M1B-Key-Return> do_commit
3578 foreach i
[list
$ui_index $ui_workdir] {
3579 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
3580 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3581 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
3585 set file_lists
($ui_index) [list
]
3586 set file_lists
($ui_workdir) [list
]
3588 wm title .
"[appname] ([reponame]) [file normalize $_gitworktree]"
3589 focus
-force $ui_comm
3591 # -- Warn the user about environmental problems. Cygwin's Tcl
3592 # does *not* pass its env array onto any processes it spawns.
3593 # This means that git processes get none of our environment.
3598 set msg
[mc
"Possible environment issues exist.
3600 The following environment variables are probably
3601 going to be ignored by any Git subprocess run
3605 foreach name
[array names env
] {
3606 switch
-regexp -- $name {
3607 {^GIT_INDEX_FILE$
} -
3608 {^GIT_OBJECT_DIRECTORY$
} -
3609 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3611 {^GIT_EXTERNAL_DIFF$
} -
3615 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3616 append msg
" - $name\n"
3619 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3620 append msg
" - $name\n"
3622 set suggest_user
$name
3626 if {$ignored_env > 0} {
3628 This is due to a known issue with the
3629 Tcl binary distributed by Cygwin."]
3631 if {$suggest_user ne
{}} {
3634 A good replacement for %s
3635 is placing values for the user.name and
3636 user.email settings into your personal
3642 unset ignored_env msg suggest_user name
3645 # -- Only initialize complex UI if we are going to stay running.
3647 if {[is_enabled transport
]} {
3650 set n
[.mbar.remote index end
]
3651 populate_remotes_menu
3652 set n
[expr {[.mbar.remote index end
] - $n}]
3654 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3655 .mbar.remote insert
$n separator
3660 if {[winfo exists
$ui_comm]} {
3661 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
3663 # -- If both our backup and message files exist use the
3664 # newer of the two files to initialize the buffer.
3666 if {$GITGUI_BCK_exists} {
3667 set m
[gitdir GITGUI_MSG
]
3668 if {[file isfile
$m]} {
3669 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3670 catch
{file delete
[gitdir GITGUI_MSG
]}
3672 $ui_comm delete
0.0 end
3674 $ui_comm edit modified false
3675 catch
{file delete
[gitdir GITGUI_BCK
]}
3676 set GITGUI_BCK_exists
0
3682 proc backup_commit_buffer
{} {
3683 global ui_comm GITGUI_BCK_exists
3685 set m
[$ui_comm edit modified
]
3686 if {$m ||
$GITGUI_BCK_exists} {
3687 set msg
[string trim
[$ui_comm get
0.0 end
]]
3688 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3691 if {$GITGUI_BCK_exists} {
3692 catch
{file delete
[gitdir GITGUI_BCK
]}
3693 set GITGUI_BCK_exists
0
3697 set fd
[open
[gitdir GITGUI_BCK
] w
]
3698 puts
-nonewline $fd $msg
3700 set GITGUI_BCK_exists
1
3704 $ui_comm edit modified false
3707 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3710 backup_commit_buffer
3712 # -- If the user has aspell available we can drive it
3713 # in pipe mode to spellcheck the commit message.
3715 set spell_cmd
[list |
]
3716 set spell_dict
[get_config gui.spellingdictionary
]
3717 lappend spell_cmd aspell
3718 if {$spell_dict ne
{}} {
3719 lappend spell_cmd
--master=$spell_dict
3721 lappend spell_cmd
--mode=none
3722 lappend spell_cmd
--encoding=utf-8
3723 lappend spell_cmd pipe
3724 if {$spell_dict eq
{none
}
3725 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3726 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3728 set ui_comm_spell
[spellcheck
::init \
3734 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3737 lock_index begin-read
3738 if {![winfo ismapped .
]} {
3742 if {[is_enabled initialamend
]} {
3748 if {[is_enabled nocommitmsg
]} {
3749 $ui_comm configure
-state disabled
-background gray
3752 if {[is_enabled multicommit
]} {
3755 if {[is_enabled retcode
]} {
3756 bind .
<Destroy
> {+terminate_me
%W
}
3758 if {$picked && [is_config_true gui.autoexplore
]} {
3764 # indent-tabs-mode: t