2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 ||
test "z$*" = z--version
; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
10 exec wish
"$argv0" -- "$@"
12 set appvers
{@@GITGUI_VERSION@@
}
13 set copyright
[encoding convertfrom utf-8
{
14 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
16 This program is free software
; you can redistribute it and
/or modify
17 it under the terms of the GNU General Public License as published by
18 the Free Software Foundation
; either version
2 of the License
, or
19 (at your option
) any later version.
21 This program is distributed
in the hope that it will be useful
,
22 but WITHOUT ANY WARRANTY
; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License
for more details.
26 You should have received a copy of the GNU General Public License
27 along with this program
; if not
, write to the Free Software
28 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}]
30 ######################################################################
32 ## Tcl/Tk sanity check
34 if {[catch
{package require Tcl
8.4} err
]
35 ||
[catch
{package require Tk
8.4} err
]
41 -title [mc
"git-gui: fatal error"] \
46 catch
{rename send
{}} ; # What an evil concept...
48 ######################################################################
52 set oguilib
{@@GITGUI_LIBDIR@@
}
53 set oguirel
{@@GITGUI_RELATIVE@@
}
54 if {$oguirel eq
{1}} {
55 set oguilib
[file dirname [file normalize
$argv0]]
56 if {[file tail $oguilib] eq
{git-core
}} {
57 set oguilib
[file dirname $oguilib]
59 set oguilib
[file dirname $oguilib]
60 set oguilib
[file join $oguilib share git-gui lib
]
61 set oguimsg
[file join $oguilib msgs
]
62 } elseif
{[string match @@
* $oguirel]} {
63 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
64 set oguimsg
[file join [file dirname [file normalize
$argv0]] po
]
66 set oguimsg
[file join $oguilib msgs
]
70 ######################################################################
72 ## enable verbose loading?
74 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
76 rename auto_load real__auto_load
77 proc auto_load
{name args
} {
78 puts stderr
"auto_load $name"
79 return [uplevel
1 real__auto_load
$name $args]
81 rename
source real__source
83 puts stderr
"source $name"
84 uplevel
1 real__source
$name
88 ######################################################################
90 ## Internationalization (i18n) through msgcat and gettext. See
91 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93 package require msgcat
96 set cmk
[string first @@
$fmt]
98 return [string range
$fmt 0 [expr {$cmk - 1}]]
103 proc mc
{en_fmt args
} {
104 set fmt [_mc_trim
[::msgcat
::mc
$en_fmt]]
105 if {[catch
{set msg
[eval [list format
$fmt] $args]} err
]} {
106 set msg
[eval [list format
[_mc_trim
$en_fmt]] $args]
112 return [join $args {}]
115 ::msgcat
::mcload
$oguimsg
118 ######################################################################
122 set _appname
{Git Gui
}
132 set _trace
[lsearch
-exact $argv --trace]
134 set argv
[lreplace
$argv $_trace $_trace]
150 return [eval [list
file join $_gitdir] $args]
153 proc gitexec
{args
} {
155 if {$_gitexec eq
{}} {
156 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
157 error
"Git not installed?\n\n$err"
160 set _gitexec
[exec cygpath \
165 set _gitexec
[file normalize
$_gitexec]
171 return [eval [list
file join $_gitexec] $args]
174 proc githtmldir
{args
} {
176 if {$_githtmldir eq
{}} {
177 if {[catch
{set _githtmldir
[git
--html-path]}]} {
178 # Git not installed or option not yet supported
182 set _githtmldir
[exec cygpath \
187 set _githtmldir
[file normalize
$_githtmldir]
193 return [eval [list
file join $_githtmldir] $args]
201 if {[tk windowingsystem
] eq
{aqua
}} {
208 if {$
::tcl_platform
(platform
) eq
{windows
}} {
216 if {$_iscygwin eq
{}} {
217 if {$
::tcl_platform
(platform
) eq
{windows
}} {
218 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
230 proc is_enabled
{option
} {
231 global enabled_options
232 if {[catch
{set on
$enabled_options($option)}]} {return 0}
236 proc enable_option
{option
} {
237 global enabled_options
238 set enabled_options
($option) 1
241 proc disable_option
{option
} {
242 global enabled_options
243 set enabled_options
($option) 0
246 ######################################################################
250 proc is_many_config
{name
} {
251 switch
-glob -- $name {
261 proc is_config_true
{name
} {
263 if {[catch
{set v
$repo_config($name)}]} {
265 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
272 proc get_config
{name
} {
274 if {[catch
{set v
$repo_config($name)}]} {
286 if {$_isbare eq
{}} {
288 set _bare
[git rev-parse
--is-bare-repository]
290 true
{ set _isbare
1 }
291 false
{ set _isbare
0}
295 if {[is_config_true core.bare
]
296 ||
($_gitworktree eq
{}
297 && [lindex
[file split $_gitdir] end
] ne
{.git
})} {
307 ######################################################################
311 proc _trace_exec
{cmd
} {
312 if {!$
::_trace
} return
318 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
326 proc _git_cmd {name} {
329 if {[catch {set v $_git_cmd_path($name)}]} {
333 --exec-path { return [list $::_git $name] }
336 set p [gitexec git-$name$::_search_exe]
337 if {[file exists $p]} {
339 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
340 # Try to determine what sort of magic will make
341 # git-$name go and do its thing, because native
342 # Tcl on Windows doesn't know it.
344 set p
[gitexec git-
$name]
349 switch
-glob -- [lindex
$s 0] {
351 #!*perl { set i perl }
352 #!*python { set i python }
353 default
{ error
"git-$name is not supported: $s" }
357 if {![info exists interp
]} {
358 set interp
[_which
$i]
361 error
"git-$name requires $i (not in PATH)"
363 set v
[concat
[list
$interp] [lrange
$s 1 end
] [list
$p]]
365 # Assume it is builtin to git somehow and we
366 # aren't actually able to see a file for it.
368 set v
[list $
::_git
$name]
370 set _git_cmd_path
($name) $v
375 proc _which
{what args
} {
376 global env _search_exe _search_path
378 if {$_search_path eq
{}} {
379 if {[is_Cygwin
] && [regexp
{^
(/|\.
:)} $env(PATH
)]} {
380 set _search_path
[split [exec cygpath \
386 } elseif
{[is_Windows
]} {
387 set gitguidir
[file dirname [info
script]]
388 regsub
-all ";" $gitguidir "\\;" gitguidir
389 set env
(PATH
) "$gitguidir;$env(PATH)"
390 set _search_path
[split $env(PATH
) {;}]
393 set _search_path
[split $env(PATH
) :]
398 if {[is_Windows
] && [lsearch
-exact $args -script] >= 0} {
401 set suffix
$_search_exe
404 foreach p
$_search_path {
405 set p
[file join $p $what$suffix]
406 if {[file exists
$p]} {
407 return [file normalize
$p]
413 proc _lappend_nice
{cmd_var
} {
417 if {![info exists _nice
]} {
418 set _nice
[_which nice
]
419 if {[catch
{exec $_nice git version
}]} {
432 switch
-- [lindex
$args 0] {
443 set args
[lrange
$args 1 end
]
446 set cmdp
[_git_cmd
[lindex
$args 0]]
447 set args
[lrange
$args 1 end
]
449 _trace_exec
[concat
$opt $cmdp $args]
450 set result
[eval exec $opt $cmdp $args]
452 puts stderr
"< $result"
457 proc _open_stdout_stderr
{cmd
} {
460 set fd
[open
[concat
[list |
] $cmd] r
]
462 if { [lindex
$cmd end
] eq
{2>@
1}
463 && $err eq
{can not
find channel named
"1"}
465 # Older versions of Tcl 8.4 don't have this 2>@1 IO
466 # redirect operator. Fallback to |& cat for those.
467 # The command was not actually started, so its safe
468 # to try to start it a second time.
470 set fd
[open
[concat \
472 [lrange
$cmd 0 end-1
] \
479 fconfigure
$fd -eofchar {}
483 proc git_read
{args
} {
487 switch
-- [lindex
$args 0] {
502 set args
[lrange
$args 1 end
]
505 set cmdp
[_git_cmd
[lindex
$args 0]]
506 set args
[lrange
$args 1 end
]
508 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
511 proc git_write
{args
} {
515 switch
-- [lindex
$args 0] {
526 set args
[lrange
$args 1 end
]
529 set cmdp
[_git_cmd
[lindex
$args 0]]
530 set args
[lrange
$args 1 end
]
532 _trace_exec
[concat
$opt $cmdp $args]
533 return [open
[concat
[list |
] $opt $cmdp $args] w
]
536 proc githook_read
{hook_name args
} {
537 set pchook
[gitdir hooks
$hook_name]
540 # On Windows [file executable] might lie so we need to ask
541 # the shell if the hook is executable. Yes that's annoying.
545 if {![info exists interp
]} {
546 set interp
[_which sh
]
549 error
"hook execution requires sh (not in PATH)"
552 set scr
{if test -x "$1";then exec "$@";fi}
553 set sh_c
[list
$interp -c $scr $interp $pchook]
554 return [_open_stdout_stderr
[concat
$sh_c $args]]
557 if {[file executable
$pchook]} {
558 return [_open_stdout_stderr
[concat
[list
$pchook] $args]]
564 proc kill_file_process
{fd
} {
565 set process
[pid
$fd]
569 # Use a Cygwin-specific flag to allow killing
570 # native Windows processes
571 exec kill -f $process
578 proc gitattr
{path attr default
} {
579 if {[catch
{set r
[git check-attr
$attr -- $path]}]} {
582 set r
[join [lrange
[split $r :] 2 end
] :]
585 if {$r eq
{unspecified
}} {
592 regsub
-all ' $value "'\\''" value
596 proc load_current_branch {} {
597 global current_branch is_detached
599 set fd [open [gitdir HEAD] r]
600 if {[gets $fd ref] < 1} {
605 set pfx {ref: refs/heads/}
606 set len [string length $pfx]
607 if {[string equal -length $len $pfx $ref]} {
608 # We're on a branch. It might not exist. But
609 # HEAD looks good enough to be a branch.
611 set current_branch [string range $ref $len end]
614 # Assume this is a detached head.
616 set current_branch HEAD
621 auto_load tk_optionMenu
622 rename tk_optionMenu real__tkOptionMenu
623 proc tk_optionMenu {w varName args} {
624 set m [eval real__tkOptionMenu $w $varName $args]
625 $m configure -font font_ui
626 $w configure -font font_ui
630 proc rmsel_tag {text} {
632 -background [$text cget -background] \
633 -foreground [$text cget -foreground] \
635 $text tag conf in_sel -background lightgray
636 bind $text <Motion> break
641 bind . <Visibility> {
642 bind . <Visibility> {}
647 wm iconbitmap . -default $oguilib/git-gui.ico
648 set ::tk::AlwaysShowSelection 1
650 # Spoof an X11 display for SSH
651 if {![info exists env(DISPLAY)]} {
652 set env(DISPLAY) :9999
656 image create photo gitlogo -width 16 -height 16
658 gitlogo put #33CC33 -to 7 0 9 2
659 gitlogo put #33CC33 -to 4 2 12 4
660 gitlogo put #33CC33 -to 7 4 9 6
661 gitlogo put #CC3333 -to 4 6 12 8
662 gitlogo put gray26 -to 4 9 6 10
663 gitlogo put gray26 -to 3 10 6 12
664 gitlogo put gray26 -to 8 9 13 11
665 gitlogo put gray26 -to 8 11 10 12
666 gitlogo put gray26 -to 11 11 13 14
667 gitlogo put gray26 -to 3 12 5 14
668 gitlogo put gray26 -to 5 13
669 gitlogo put gray26 -to 10 13
670 gitlogo put gray26 -to 4 14 12 15
671 gitlogo put gray26 -to 5 15 11 16
674 wm iconphoto . -default gitlogo
678 ######################################################################
684 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
685 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
686 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
688 font create font_diff -family Courier -size 10
691 eval font configure font_ui [font actual [.dummy cget -font]]
696 font create font_uiitalic
697 font create font_uibold
698 font create font_diffbold
699 font create font_diffitalic
701 foreach class {Button Checkbutton Entry Label
702 Labelframe Listbox Message
703 Radiobutton Spinbox Text} {
704 option add *$class.font font_ui
707 option add *Menu.font font_ui
708 option add *Entry.borderWidth 1 startupFile
709 option add *Entry.relief sunken startupFile
710 option add *RadioButton.anchor w startupFile
714 if {[is_Windows] || [is_MacOSX]} {
715 option add *Menu.tearOff 0
726 proc bind_button3 {w cmd} {
727 bind $w <Any-Button-3> $cmd
729 # Mac OS X sends Button-2 on right click through three-button mouse,
730 # or through trackpad right-clicking (two-finger touch + click).
731 bind $w <Any-Button-2> $cmd
732 bind $w <Control-Button-1> $cmd
736 proc apply_config {} {
737 global repo_config font_descs
739 foreach option $font_descs {
740 set name [lindex $option 0]
741 set font [lindex $option 1]
744 foreach {cn cv} $repo_config(gui.$name) {
745 if {$cn eq {-weight}} {
748 font configure $font $cn $cv
751 font configure $font -weight normal
754 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
756 foreach {cn cv} [font configure $font] {
757 font configure ${font}bold $cn $cv
758 font configure ${font}italic $cn $cv
760 font configure ${font}bold -weight bold
761 font configure ${font}italic -slant italic
767 if {$repo_config(gui.usettk)} {
768 set use_ttk [package vsatisfies [package provide Tk] 8.5]
771 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
777 set default_config(branch.autosetupmerge) true
778 set default_config(merge.tool) {}
779 set default_config(mergetool.keepbackup) true
780 set default_config(merge.diffstat) true
781 set default_config(merge.summary) false
782 set default_config(merge.verbosity) 2
783 set default_config(user.name) {}
784 set default_config(user.email) {}
786 set default_config(gui.encoding) [encoding system]
787 set default_config(gui.matchtrackingbranch) false
788 set default_config(gui.pruneduringfetch) false
789 set default_config(gui.trustmtime) false
790 set default_config(gui.fastcopyblame) false
791 set default_config(gui.copyblamethreshold) 40
792 set default_config(gui.blamehistoryctx) 7
793 set default_config(gui.diffcontext) 5
794 set default_config(gui.commitmsgwidth) 75
795 set default_config(gui.newbranchtemplate) {}
796 set default_config(gui.spellingdictionary) {}
797 set default_config(gui.fontui) [font configure font_ui]
798 set default_config(gui.fontdiff) [font configure font_diff]
799 # TODO: this option should be added to the git-config documentation
800 set default_config(gui.maxfilesdisplayed) 5000
801 set default_config(gui.usettk) 1
803 {fontui font_ui {mc "Main Font
"}}
804 {fontdiff font_diff {mc "Diff
/Console Font
"}}
807 ######################################################################
811 set _git [_which git]
813 catch {wm withdraw .}
817 -title [mc "git-gui
: fatal error
"] \
818 -message [mc "Cannot
find git
in PATH.
"]
822 ######################################################################
826 if {[catch {set _git_version [git --version]} err]} {
827 catch {wm withdraw .}
831 -title [mc "git-gui
: fatal error
"] \
832 -message "Cannot determine Git version
:
836 [appname
] requires Git
1.5.0 or later.
"
839 if {![regsub {^git version } $_git_version {} _git_version]} {
840 catch {wm withdraw .}
844 -title [mc "git-gui
: fatal error
"] \
845 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
849 set _real_git_version $_git_version
850 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
851 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
852 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
853 regsub {\.GIT$} $_git_version {} _git_version
854 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
856 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
857 catch {wm withdraw .}
862 -title "[appname
]: warning
" \
863 -message [mc "Git version cannot be determined.
865 %s claims it is version
'%s'.
867 %s requires
at least Git
1.5.0 or later.
869 Assume
'%s' is version
1.5.0?
870 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
871 set _git_version 1.5.0
876 unset _real_git_version
878 proc git-version {args} {
881 switch [llength $args] {
887 set op [lindex $args 0]
888 set vr [lindex $args 1]
889 set cm [package vcompare $_git_version $vr]
890 return [expr $cm $op 0]
894 set type [lindex $args 0]
895 set name [lindex $args 1]
896 set parm [lindex $args 2]
897 set body [lindex $args 3]
899 if {($type ne {proc} && $type ne {method})} {
900 error "Invalid arguments to git-version
"
902 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
903 error "Last arm of
$type $name must be default
"
906 foreach {op vr cb} [lrange $body 0 end-2] {
907 if {[git-version $op $vr]} {
908 return [uplevel [list $type $name $parm $cb]]
912 return [uplevel [list $type $name $parm [lindex $body end]]]
916 error "git-version
>= x
"
922 if {[git-version < 1.5]} {
923 catch {wm withdraw .}
927 -title [mc "git-gui
: fatal error
"] \
928 -message "[appname
] requires Git
1.5.0 or later.
930 You are using
[git-version
]:
936 ######################################################################
938 ## configure our library
940 set idx [file join $oguilib tclIndex]
941 if {[catch {set fd [open $idx r]} err]} {
942 catch {wm withdraw .}
946 -title [mc "git-gui
: fatal error
"] \
950 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
952 while {[gets $fd n] >= 0} {
953 if {$n ne {} && ![string match #* $n]} {
965 if {[lsearch -exact $loaded $p] >= 0} continue
966 source [file join $oguilib $p]
971 set auto_path [concat [list $oguilib] $auto_path]
973 unset -nocomplain idx fd
975 ######################################################################
977 ## config file parsing
979 git-version proc _parse_config {arr_name args} {
986 [list git_read config] \
988 [list --null --list]]
989 fconfigure $fd_rc -translation binary
990 set buf [read $fd_rc]
993 foreach line [split $buf "\
0"] {
994 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
995 if {[is_many_config $name]} {
996 lappend arr($name) $value
998 set arr($name) $value
1007 set fd_rc [eval [list git_read config --list] $args]
1008 while {[gets $fd_rc line] >= 0} {
1009 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1010 if {[is_many_config $name]} {
1011 lappend arr($name) $value
1013 set arr($name) $value
1022 proc load_config {include_global} {
1023 global repo_config global_config system_config default_config
1025 if {$include_global} {
1026 _parse_config system_config --system
1027 _parse_config global_config --global
1029 _parse_config repo_config
1031 foreach name [array names default_config] {
1032 if {[catch {set v $system_config($name)}]} {
1033 set system_config($name) $default_config($name)
1036 foreach name [array names system_config] {
1037 if {[catch {set v $global_config($name)}]} {
1038 set global_config($name) $system_config($name)
1040 if {[catch {set v $repo_config($name)}]} {
1041 set repo_config($name) $system_config($name)
1046 ######################################################################
1048 ## feature option selection
1050 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1055 if {$subcommand eq {gui.sh}} {
1058 if {$subcommand eq {gui} && [llength $argv] > 0} {
1059 set subcommand [lindex $argv 0]
1060 set argv [lrange $argv 1 end]
1063 enable_option multicommit
1064 enable_option branch
1065 enable_option transport
1068 switch -- $subcommand {
1073 disable_option multicommit
1074 disable_option branch
1075 disable_option transport
1078 enable_option singlecommit
1079 enable_option retcode
1081 disable_option multicommit
1082 disable_option branch
1083 disable_option transport
1085 while {[llength $argv] > 0} {
1086 set a [lindex $argv 0]
1089 enable_option initialamend
1092 enable_option nocommit
1093 enable_option nocommitmsg
1096 disable_option nocommitmsg
1103 set argv [lrange $argv 1 end]
1108 ######################################################################
1110 ## execution environment
1112 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1114 # Suggest our implementation of askpass, if none is set
1115 if {![info exists env(SSH_ASKPASS)]} {
1116 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1119 ######################################################################
1125 set _gitdir $env(GIT_DIR)
1129 # beware that from the .git dir this sets _gitdir to .
1130 # and _prefix to the empty string
1131 set _gitdir [git rev-parse --git-dir]
1132 set _prefix [git rev-parse --show-prefix]
1136 choose_repository::pick
1140 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1141 # run from the .git dir itself) lest the routines to find the worktree
1143 if {$_gitdir eq ".
"} {
1147 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1148 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1150 if {![file isdirectory $_gitdir]} {
1151 catch {wm withdraw .}
1152 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1155 # _gitdir exists, so try loading the config
1158 # try to set work tree from environment, falling back to core.worktree
1159 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1160 set _gitworktree [get_config core.worktree]
1161 if {$_gitworktree eq ""} {
1162 set _gitworktree [file dirname [file normalize $_gitdir]]
1165 if {$_prefix ne {}} {
1166 if {$_gitworktree eq {}} {
1167 regsub -all {[^/]+/} $_prefix ../ cdup
1169 set cdup $_gitworktree
1171 if {[catch {cd $cdup} err]} {
1172 catch {wm withdraw .}
1173 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1176 set _gitworktree [pwd]
1178 } elseif {![is_enabled bare]} {
1180 catch {wm withdraw .}
1181 error_popup [strcat [mc "Cannot use bare repository
:"] "\n\n$_gitdir"]
1184 if {$_gitworktree eq {}} {
1185 set _gitworktree [file dirname $_gitdir]
1187 if {[catch {cd $_gitworktree} err]} {
1188 catch {wm withdraw .}
1189 error_popup [strcat [mc "No working directory
"] " $_gitworktree:\n\n$err"]
1192 set _gitworktree [pwd]
1194 set _reponame [file split [file normalize $_gitdir]]
1195 if {[lindex $_reponame end] eq {.git}} {
1196 set _reponame [lindex $_reponame end-1]
1198 set _reponame [lindex $_reponame end]
1201 ######################################################################
1205 set current_diff_path {}
1206 set current_diff_side {}
1207 set diff_actions [list]
1211 set MERGE_HEAD [list]
1214 set current_branch {}
1216 set current_diff_path {}
1218 set is_submodule_diff 0
1219 set is_conflict_diff 0
1220 set selected_commit_type new
1221 set diff_empty_count 0
1223 set nullid "0000000000000000000000000000000000000000"
1224 set nullid2 "0000000000000000000000000000000000000001"
1226 ######################################################################
1234 set disable_on_lock [list]
1235 set index_lock_type none
1237 proc lock_index {type} {
1238 global index_lock_type disable_on_lock
1240 if {$index_lock_type eq {none}} {
1241 set index_lock_type $type
1242 foreach w $disable_on_lock {
1243 uplevel #0 $w disabled
1246 } elseif {$index_lock_type eq "begin-
$type"} {
1247 set index_lock_type $type
1253 proc unlock_index {} {
1254 global index_lock_type disable_on_lock
1256 set index_lock_type none
1257 foreach w $disable_on_lock {
1258 uplevel #0 $w normal
1262 ######################################################################
1266 proc repository_state {ctvar hdvar mhvar} {
1267 global current_branch
1268 upvar $ctvar ct $hdvar hd $mhvar mh
1273 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1279 set merge_head [gitdir MERGE_HEAD]
1280 if {[file exists $merge_head]} {
1282 set fd_mh [open $merge_head r]
1283 while {[gets $fd_mh line] >= 0} {
1294 global PARENT empty_tree
1296 set p [lindex $PARENT 0]
1300 if {$empty_tree eq {}} {
1301 set empty_tree [git mktree << {}]
1306 proc force_amend {} {
1307 global selected_commit_type
1308 global HEAD PARENT MERGE_HEAD commit_type
1310 repository_state newType newHEAD newMERGE_HEAD
1313 set MERGE_HEAD $newMERGE_HEAD
1314 set commit_type $newType
1316 set selected_commit_type amend
1317 do_select_commit_type
1320 proc rescan {after {honor_trustmtime 1}} {
1321 global HEAD PARENT MERGE_HEAD commit_type
1322 global ui_index ui_workdir ui_comm
1323 global rescan_active file_states
1326 if {$rescan_active > 0 || ![lock_index read]} return
1328 repository_state newType newHEAD newMERGE_HEAD
1329 if {[string match amend* $commit_type]
1330 && $newType eq {normal}
1331 && $newHEAD eq $HEAD} {
1335 set MERGE_HEAD $newMERGE_HEAD
1336 set commit_type $newType
1339 array unset file_states
1341 if {!$::GITGUI_BCK_exists &&
1342 (![$ui_comm edit modified]
1343 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1344 if {[string match amend* $commit_type]} {
1345 } elseif {[load_message GITGUI_MSG]} {
1346 } elseif {[run_prepare_commit_msg_hook]} {
1347 } elseif {[load_message MERGE_MSG]} {
1348 } elseif {[load_message SQUASH_MSG]} {
1351 $ui_comm edit modified false
1354 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1355 rescan_stage2 {} $after
1358 ui_status [mc "Refreshing
file status...
"]
1359 set fd_rf [git_read update-index \
1365 fconfigure $fd_rf -blocking 0 -translation binary
1366 fileevent $fd_rf readable \
1367 [list rescan_stage2 $fd_rf $after]
1372 set is_git_info_exclude {}
1373 proc have_info_exclude {} {
1374 global is_git_info_exclude
1376 if {$is_git_info_exclude eq {}} {
1377 if {[catch {exec test -f [gitdir info exclude]}]} {
1378 set is_git_info_exclude 0
1380 set is_git_info_exclude 1
1383 return $is_git_info_exclude
1386 proc have_info_exclude {} {
1387 return [file readable [gitdir info exclude]]
1391 proc rescan_stage2 {fd after} {
1392 global rescan_active buf_rdi buf_rdf buf_rlo
1396 if {![eof $fd]} return
1400 set ls_others [list --exclude-per-directory=.gitignore]
1401 if {[have_info_exclude]} {
1402 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1404 set user_exclude [get_config core.excludesfile]
1405 if {$user_exclude ne {} && [file readable $user_exclude]} {
1406 lappend ls_others "--exclude-from=$user_exclude"
1414 ui_status [mc "Scanning
for modified files ...
"]
1415 set fd_di [git_read diff-index --cached -z [PARENT]]
1416 set fd_df [git_read diff-files -z]
1417 set fd_lo [eval git_read ls-files --others -z $ls_others]
1419 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1420 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1421 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1422 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1423 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1424 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1427 proc load_message {file} {
1430 set f [gitdir $file]
1431 if {[file isfile $f]} {
1432 if {[catch {set fd [open $f r]}]} {
1435 fconfigure $fd -eofchar {}
1436 set content [string trim [read $fd]]
1438 regsub -all -line {[ \r\t]+$} $content {} content
1439 $ui_comm delete 0.0 end
1440 $ui_comm insert end $content
1446 proc run_prepare_commit_msg_hook {} {
1449 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1450 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1451 # empty file but existant file.
1453 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1455 if {[file isfile [gitdir MERGE_MSG]]} {
1456 set pcm_source "merge
"
1457 set fd_mm [open [gitdir MERGE_MSG] r]
1458 puts -nonewline $fd_pcm [read $fd_mm]
1460 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1461 set pcm_source "squash
"
1462 set fd_sm [open [gitdir SQUASH_MSG] r]
1463 puts -nonewline $fd_pcm [read $fd_sm]
1471 set fd_ph [githook_read prepare-commit-msg \
1472 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1474 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1478 ui_status [mc "Calling prepare-commit-msg hook...
"]
1481 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1482 fileevent $fd_ph readable \
1483 [list prepare_commit_msg_hook_wait $fd_ph]
1488 proc prepare_commit_msg_hook_wait {fd_ph} {
1491 append pch_error [read $fd_ph]
1492 fconfigure $fd_ph -blocking 1
1494 if {[catch {close $fd_ph}]} {
1495 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1496 hook_failed_popup prepare-commit-msg $pch_error
1497 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1500 load_message PREPARE_COMMIT_MSG
1503 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1506 fconfigure $fd_ph -blocking 0
1507 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1510 proc read_diff_index {fd after} {
1513 append buf_rdi [read $fd]
1515 set n [string length $buf_rdi]
1517 set z1 [string first "\
0" $buf_rdi $c]
1518 if {$z1 == -1} break
1520 set z2 [string first "\
0" $buf_rdi $z1]
1521 if {$z2 == -1} break
1524 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1525 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1527 [encoding convertfrom $p] \
1529 [list [lindex $i 0] [lindex $i 2]] \
1535 set buf_rdi [string range $buf_rdi $c end]
1540 rescan_done $fd buf_rdi $after
1543 proc read_diff_files {fd after} {
1546 append buf_rdf [read $fd]
1548 set n [string length $buf_rdf]
1550 set z1 [string first "\
0" $buf_rdf $c]
1551 if {$z1 == -1} break
1553 set z2 [string first "\
0" $buf_rdf $z1]
1554 if {$z2 == -1} break
1557 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1558 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1560 [encoding convertfrom $p] \
1563 [list [lindex $i 0] [lindex $i 2]]
1568 set buf_rdf [string range $buf_rdf $c end]
1573 rescan_done $fd buf_rdf $after
1576 proc read_ls_others {fd after} {
1579 append buf_rlo [read $fd]
1580 set pck [split $buf_rlo "\
0"]
1581 set buf_rlo [lindex $pck end]
1582 foreach p [lrange $pck 0 end-1] {
1583 set p [encoding convertfrom $p]
1584 if {[string index $p end] eq {/}} {
1585 set p [string range $p 0 end-1]
1589 rescan_done $fd buf_rlo $after
1592 proc rescan_done {fd buf after} {
1593 global rescan_active current_diff_path
1594 global file_states repo_config
1597 if {![eof $fd]} return
1600 if {[incr rescan_active -1] > 0} return
1605 if {$current_diff_path ne {}} { reshow_diff $after }
1606 if {$current_diff_path eq {}} { select_first_diff $after }
1609 proc prune_selection {} {
1610 global file_states selected_paths
1612 foreach path [array names selected_paths] {
1613 if {[catch {set still_here $file_states($path)}]} {
1614 unset selected_paths($path)
1619 ######################################################################
1623 proc mapicon {w state path} {
1626 if {[catch {set r $all_icons($state$w)}]} {
1627 puts "error
: no icon
for $w state
={$state} $path"
1633 proc mapdesc {state path} {
1636 if {[catch {set r $all_descs($state)}]} {
1637 puts "error
: no desc
for state
={$state} $path"
1643 proc ui_status {msg} {
1645 if {[info exists main_status]} {
1646 $main_status show $msg
1650 proc ui_ready {{test {}}} {
1652 if {[info exists main_status]} {
1653 $main_status show [mc "Ready.
"] $test
1657 proc escape_path {path} {
1658 regsub -all {\\} $path "\\\\" path
1659 regsub -all "\n" $path "\\n
" path
1663 proc short_path {path} {
1664 return [escape_path [lindex [file split $path] end]]
1668 set null_sha1 [string repeat 0 40]
1670 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1671 global file_states next_icon_id null_sha1
1673 set s0 [string index $new_state 0]
1674 set s1 [string index $new_state 1]
1676 if {[catch {set info $file_states($path)}]} {
1678 set icon n[incr next_icon_id]
1680 set state [lindex $info 0]
1681 set icon [lindex $info 1]
1682 if {$head_info eq {}} {set head_info [lindex $info 2]}
1683 if {$index_info eq {}} {set index_info [lindex $info 3]}
1686 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1687 elseif {$s0 eq {_}} {set s0 _}
1689 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1690 elseif {$s1 eq {_}} {set s1 _}
1692 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1693 set head_info [list 0 $null_sha1]
1694 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1695 && $head_info eq {}} {
1696 set head_info $index_info
1697 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1698 set index_info $head_info
1702 set file_states($path) [list $s0$s1 $icon \
1703 $head_info $index_info \
1708 proc display_file_helper {w path icon_name old_m new_m} {
1711 if {$new_m eq {_}} {
1712 set lno [lsearch -sorted -exact $file_lists($w) $path]
1714 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1716 $w conf -state normal
1717 $w delete $lno.0 [expr {$lno + 1}].0
1718 $w conf -state disabled
1720 } elseif {$old_m eq {_} && $new_m ne {_}} {
1721 lappend file_lists($w) $path
1722 set file_lists($w) [lsort -unique $file_lists($w)]
1723 set lno [lsearch -sorted -exact $file_lists($w) $path]
1725 $w conf -state normal
1726 $w image create $lno.0 \
1727 -align center -padx 5 -pady 1 \
1729 -image [mapicon $w $new_m $path]
1730 $w insert $lno.1 "[escape_path
$path]\n"
1731 $w conf -state disabled
1732 } elseif {$old_m ne $new_m} {
1733 $w conf -state normal
1734 $w image conf $icon_name -image [mapicon $w $new_m $path]
1735 $w conf -state disabled
1739 proc display_file {path state} {
1740 global file_states selected_paths
1741 global ui_index ui_workdir
1743 set old_m [merge_state $path $state]
1744 set s $file_states($path)
1745 set new_m [lindex $s 0]
1746 set icon_name [lindex $s 1]
1748 set o [string index $old_m 0]
1749 set n [string index $new_m 0]
1756 display_file_helper $ui_index $path $icon_name $o $n
1758 if {[string index $old_m 0] eq {U}} {
1761 set o [string index $old_m 1]
1763 if {[string index $new_m 0] eq {U}} {
1766 set n [string index $new_m 1]
1768 display_file_helper $ui_workdir $path $icon_name $o $n
1770 if {$new_m eq {__}} {
1771 unset file_states($path)
1772 catch {unset selected_paths($path)}
1776 proc display_all_files_helper {w path icon_name m} {
1779 lappend file_lists($w) $path
1780 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1781 $w image create end \
1782 -align center -padx 5 -pady 1 \
1784 -image [mapicon $w $m $path]
1785 $w insert end "[escape_path
$path]\n"
1789 proc display_all_files {} {
1790 global ui_index ui_workdir
1791 global file_states file_lists
1793 global files_warning
1795 $ui_index conf -state normal
1796 $ui_workdir conf -state normal
1798 $ui_index delete 0.0 end
1799 $ui_workdir delete 0.0 end
1802 set file_lists($ui_index) [list]
1803 set file_lists($ui_workdir) [list]
1805 set to_display [lsort [array names file_states]]
1806 set display_limit [get_config gui.maxfilesdisplayed]
1807 if {[llength $to_display] > $display_limit} {
1808 if {!$files_warning} {
1809 # do not repeatedly warn:
1811 info_popup [mc "Displaying only
%s of
%s files.
" \
1812 $display_limit [llength $to_display]]
1814 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1816 foreach path $to_display {
1817 set s $file_states($path)
1819 set icon_name [lindex $s 1]
1821 set s [string index $m 0]
1822 if {$s ne {U} && $s ne {_}} {
1823 display_all_files_helper $ui_index $path \
1827 if {[string index $m 0] eq {U}} {
1830 set s [string index $m 1]
1833 display_all_files_helper $ui_workdir $path \
1838 $ui_index conf -state disabled
1839 $ui_workdir conf -state disabled
1842 ######################################################################
1847 #define mask_width 14
1848 #define mask_height 15
1849 static unsigned char mask_bits[] = {
1850 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1851 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1852 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1855 image create bitmap file_plain -background white -foreground black -data {
1856 #define plain_width 14
1857 #define plain_height 15
1858 static unsigned char plain_bits[] = {
1859 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1860 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1861 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1862 } -maskdata $filemask
1864 image create bitmap file_mod -background white -foreground blue -data {
1865 #define mod_width 14
1866 #define mod_height 15
1867 static unsigned char mod_bits[] = {
1868 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1869 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1870 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1871 } -maskdata $filemask
1873 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1874 #define file_fulltick_width 14
1875 #define file_fulltick_height 15
1876 static unsigned char file_fulltick_bits
[] = {
1877 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1878 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1879 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1880 } -maskdata $filemask
1882 image create bitmap file_question
-background white
-foreground black
-data {
1883 #define file_question_width 14
1884 #define file_question_height 15
1885 static unsigned char file_question_bits
[] = {
1886 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1887 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1888 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1889 } -maskdata $filemask
1891 image create bitmap file_removed
-background white
-foreground red
-data {
1892 #define file_removed_width 14
1893 #define file_removed_height 15
1894 static unsigned char file_removed_bits
[] = {
1895 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1896 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1897 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1898 } -maskdata $filemask
1900 image create bitmap file_merge
-background white
-foreground blue
-data {
1901 #define file_merge_width 14
1902 #define file_merge_height 15
1903 static unsigned char file_merge_bits
[] = {
1904 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1905 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1906 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1907 } -maskdata $filemask
1909 image create bitmap file_statechange
-background white
-foreground green
-data {
1910 #define file_merge_width 14
1911 #define file_merge_height 15
1912 static unsigned char file_statechange_bits
[] = {
1913 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1914 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1915 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1916 } -maskdata $filemask
1918 set ui_index .vpane.files.index.list
1919 set ui_workdir .vpane.files.workdir.list
1921 set all_icons
(_
$ui_index) file_plain
1922 set all_icons
(A
$ui_index) file_plain
1923 set all_icons
(M
$ui_index) file_fulltick
1924 set all_icons
(D
$ui_index) file_removed
1925 set all_icons
(U
$ui_index) file_merge
1926 set all_icons
(T
$ui_index) file_statechange
1928 set all_icons
(_
$ui_workdir) file_plain
1929 set all_icons
(M
$ui_workdir) file_mod
1930 set all_icons
(D
$ui_workdir) file_question
1931 set all_icons
(U
$ui_workdir) file_merge
1932 set all_icons
(O
$ui_workdir) file_plain
1933 set all_icons
(T
$ui_workdir) file_statechange
1935 set max_status_desc
0
1937 {__
{mc
"Unmodified"}}
1939 {_M
{mc
"Modified, not staged"}}
1940 {M_
{mc
"Staged for commit"}}
1941 {MM
{mc
"Portions staged for commit"}}
1942 {MD
{mc
"Staged for commit, missing"}}
1944 {_T
{mc
"File type changed, not staged"}}
1945 {T_
{mc
"File type changed, staged"}}
1947 {_O
{mc
"Untracked, not staged"}}
1948 {A_
{mc
"Staged for commit"}}
1949 {AM
{mc
"Portions staged for commit"}}
1950 {AD
{mc
"Staged for commit, missing"}}
1953 {D_
{mc
"Staged for removal"}}
1954 {DO
{mc
"Staged for removal, still present"}}
1956 {_U
{mc
"Requires merge resolution"}}
1957 {U_
{mc
"Requires merge resolution"}}
1958 {UU
{mc
"Requires merge resolution"}}
1959 {UM
{mc
"Requires merge resolution"}}
1960 {UD
{mc
"Requires merge resolution"}}
1961 {UT
{mc
"Requires merge resolution"}}
1963 set text
[eval [lindex
$i 1]]
1964 if {$max_status_desc < [string length
$text]} {
1965 set max_status_desc
[string length
$text]
1967 set all_descs
([lindex
$i 0]) $text
1971 ######################################################################
1975 proc scrollbar2many
{list mode args
} {
1976 foreach w
$list {eval $w $mode $args}
1979 proc many2scrollbar
{list mode sb top bottom
} {
1980 $sb set $top $bottom
1981 foreach w
$list {$w $mode moveto
$top}
1984 proc incr_font_size
{font
{amt
1}} {
1985 set sz
[font configure
$font -size]
1987 font configure
$font -size $sz
1988 font configure
${font}bold
-size $sz
1989 font configure
${font}italic
-size $sz
1992 ######################################################################
1996 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1998 proc do_gitk
{revs
{is_submodule false
}} {
1999 global current_diff_path file_states current_diff_side ui_index
2002 # -- Always start gitk through whatever we were loaded with. This
2003 # lets us bypass using shell process on Windows systems.
2005 set exe
[_which gitk
-script]
2006 set cmd
[list
[info nameofexecutable
] $exe]
2008 error_popup
[mc
"Couldn't find gitk in PATH"]
2012 if {[info exists env
(GIT_DIR
)]} {
2013 set old_GIT_DIR
$env(GIT_DIR
)
2020 if {!$is_submodule} {
2024 set env
(GIT_DIR
) [file normalize
[gitdir
]]
2026 cd $current_diff_path
2027 if {$revs eq
{--}} {
2028 set s
$file_states($current_diff_path)
2031 switch
-glob -- [lindex
$s 0] {
2032 M_
{ set old_sha1
[lindex
[lindex
$s 2] 1] }
2033 _M
{ set old_sha1
[lindex
[lindex
$s 3] 1] }
2035 if {$current_diff_side eq
$ui_index} {
2036 set old_sha1
[lindex
[lindex
$s 2] 1]
2037 set new_sha1
[lindex
[lindex
$s 3] 1]
2039 set old_sha1
[lindex
[lindex
$s 3] 1]
2043 set revs
$old_sha1...
$new_sha1
2045 if {[info exists env
(GIT_DIR
)]} {
2049 eval exec $cmd $revs "--" "--" &
2051 if {$old_GIT_DIR ne
{}} {
2052 set env
(GIT_DIR
) $old_GIT_DIR
2056 ui_status $
::starting_gitk_msg
2058 ui_ready
$starting_gitk_msg
2063 proc do_git_gui
{} {
2064 global current_diff_path
2066 # -- Always start git gui through whatever we were loaded with. This
2067 # lets us bypass using shell process on Windows systems.
2069 set exe
[list
[_which git
]]
2071 error_popup
[mc
"Couldn't find git gui in PATH"]
2075 if {[info exists env
(GIT_DIR
)]} {
2076 set old_GIT_DIR
$env(GIT_DIR
)
2083 cd $current_diff_path
2085 eval exec $exe gui
&
2087 if {$old_GIT_DIR ne
{}} {
2088 set env
(GIT_DIR
) $old_GIT_DIR
2092 ui_status $
::starting_gitk_msg
2094 ui_ready
$starting_gitk_msg
2099 proc do_explore
{} {
2102 if {[is_Cygwin
] ||
[is_Windows
]} {
2103 set explorer
"explorer.exe"
2104 } elseif
{[is_MacOSX
]} {
2107 # freedesktop.org-conforming system is our best shot
2108 set explorer
"xdg-open"
2110 eval exec $explorer $_gitworktree &
2116 proc terminate_me
{win
} {
2118 if {$win ne
{.
}} return
2122 proc do_quit
{{rc
{1}}} {
2123 global ui_comm is_quitting repo_config commit_type
2124 global GITGUI_BCK_exists GITGUI_BCK_i
2125 global ui_comm_spell
2126 global ret_code use_ttk
2128 if {$is_quitting} return
2131 if {[winfo exists
$ui_comm]} {
2132 # -- Stash our current commit buffer.
2134 set save
[gitdir GITGUI_MSG
]
2135 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
2136 file rename
-force [gitdir GITGUI_BCK
] $save
2137 set GITGUI_BCK_exists
0
2139 set msg
[string trim
[$ui_comm get
0.0 end
]]
2140 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2141 if {(![string match amend
* $commit_type]
2142 ||
[$ui_comm edit modified
])
2145 set fd
[open
$save w
]
2146 puts
-nonewline $fd $msg
2150 catch
{file delete
$save}
2154 # -- Cancel our spellchecker if its running.
2156 if {[info exists ui_comm_spell
]} {
2160 # -- Remove our editor backup, its not needed.
2162 after cancel
$GITGUI_BCK_i
2163 if {$GITGUI_BCK_exists} {
2164 catch
{file delete
[gitdir GITGUI_BCK
]}
2167 # -- Stash our current window geometry into this repository.
2169 set cfg_wmstate
[wm state .
]
2170 if {[catch
{set rc_wmstate
$repo_config(gui.wmstate
)}]} {
2173 if {$cfg_wmstate ne
$rc_wmstate} {
2174 catch
{git config gui.wmstate
$cfg_wmstate}
2176 if {$cfg_wmstate eq
{zoomed
}} {
2177 # on Windows wm geometry will lie about window
2178 # position (but not size) when window is zoomed
2179 # restore the window before querying wm geometry
2182 set cfg_geometry
[list
]
2183 lappend cfg_geometry
[wm geometry .
]
2185 lappend cfg_geometry
[.vpane sashpos
0]
2186 lappend cfg_geometry
[.vpane.files sashpos
0]
2188 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
2189 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
2191 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2194 if {$cfg_geometry ne
$rc_geometry} {
2195 catch
{git config gui.geometry
$cfg_geometry}
2201 # Briefly enable send again, working around Tk bug
2202 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2203 tk appname
[appname
]
2212 proc ui_do_rescan
{} {
2213 rescan
{force_first_diff ui_ready
}
2220 proc next_diff
{{after
{}}} {
2221 global next_diff_p next_diff_w next_diff_i
2222 show_diff
$next_diff_p $next_diff_w {} {} $after
2225 proc find_anchor_pos
{lst name
} {
2226 set lid
[lsearch
-sorted -exact $lst $name]
2230 foreach lname
$lst {
2231 if {$lname >= $name} break
2239 proc find_file_from
{flist idx delta path mmask
} {
2242 set len
[llength
$flist]
2243 while {$idx >= 0 && $idx < $len} {
2244 set name
[lindex
$flist $idx]
2246 if {$name ne
$path && [info exists file_states
($name)]} {
2247 set state
[lindex
$file_states($name) 0]
2249 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2260 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2261 global next_diff_p next_diff_w next_diff_i
2262 global file_lists ui_index ui_workdir
2264 set flist
$file_lists($w)
2266 set lno
[find_anchor_pos
$flist $path]
2271 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2272 if {$w eq
$ui_index} {
2275 set mmask
"$mmask\$"
2279 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2282 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2287 set next_diff_p
[lindex
$flist $idx]
2288 set next_diff_i
[expr {$idx+1}]
2295 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2296 global current_diff_path
2298 if {$path ne
$current_diff_path} {
2300 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2303 return {reshow_diff
;}
2307 proc select_first_diff
{after
} {
2310 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2311 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2318 proc force_first_diff
{after
} {
2319 global ui_workdir current_diff_path file_states
2321 if {[info exists file_states
($current_diff_path)]} {
2322 set state
[lindex
$file_states($current_diff_path) 0]
2328 if {[string first
{U
} $state] >= 0} {
2329 # Already a conflict, do nothing
2330 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {^_?U
}]} {
2332 } elseif
{[string index
$state 1] ne
{O
}} {
2333 # Already a diff & no conflicts, do nothing
2334 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {[^O
]$
}]} {
2345 proc toggle_or_diff
{w x y
} {
2346 global file_states file_lists current_diff_path ui_index ui_workdir
2347 global last_clicked selected_paths
2349 set pos
[split [$w index @
$x,$y] .
]
2350 set lno
[lindex
$pos 0]
2351 set col [lindex
$pos 1]
2352 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2358 set last_clicked
[list
$w $lno]
2359 array
unset selected_paths
2360 $ui_index tag remove in_sel
0.0 end
2361 $ui_workdir tag remove in_sel
0.0 end
2363 # Determine the state of the file
2364 if {[info exists file_states
($path)]} {
2365 set state
[lindex
$file_states($path) 0]
2370 # Restage the file, or simply show the diff
2371 if {$col == 0 && $y > 1} {
2372 # Conflicts need special handling
2373 if {[string first
{U
} $state] >= 0} {
2374 # $w must always be $ui_workdir, but...
2375 if {$w ne
$ui_workdir} { set lno
{} }
2376 merge_stage_workdir
$path $lno
2380 if {[string index
$state 1] eq
{O
}} {
2386 set after
[next_diff_after_action
$w $path $lno $mmask]
2388 if {$w eq
$ui_index} {
2390 "Unstaging [short_path $path] from commit" \
2392 [concat
$after [list ui_ready
]]
2393 } elseif
{$w eq
$ui_workdir} {
2395 "Adding [short_path $path]" \
2397 [concat
$after [list ui_ready
]]
2400 show_diff
$path $w $lno
2404 proc add_one_to_selection
{w x y
} {
2405 global file_lists last_clicked selected_paths
2407 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2408 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2414 if {$last_clicked ne
{}
2415 && [lindex
$last_clicked 0] ne
$w} {
2416 array
unset selected_paths
2417 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2420 set last_clicked
[list
$w $lno]
2421 if {[catch
{set in_sel
$selected_paths($path)}]} {
2425 unset selected_paths
($path)
2426 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2428 set selected_paths
($path) 1
2429 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2433 proc add_range_to_selection
{w x y
} {
2434 global file_lists last_clicked selected_paths
2436 if {[lindex
$last_clicked 0] ne
$w} {
2437 toggle_or_diff
$w $x $y
2441 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2442 set lc
[lindex
$last_clicked 1]
2451 foreach path
[lrange
$file_lists($w) \
2452 [expr {$begin - 1}] \
2453 [expr {$end - 1}]] {
2454 set selected_paths
($path) 1
2456 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2459 proc show_more_context
{} {
2461 if {$repo_config(gui.diffcontext
) < 99} {
2462 incr repo_config
(gui.diffcontext
)
2467 proc show_less_context
{} {
2469 if {$repo_config(gui.diffcontext
) > 1} {
2470 incr repo_config
(gui.diffcontext
) -1
2475 ######################################################################
2483 menu .mbar
-tearoff 0
2485 # -- Apple Menu (Mac OS X only)
2487 .mbar add cascade
-label Apple
-menu .mbar.apple
2490 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2491 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2492 if {[is_enabled branch
]} {
2493 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2495 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2496 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2498 if {[is_enabled transport
]} {
2499 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2500 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2502 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2503 .mbar add cascade
-label [mc Tools
] -menu .mbar.tools
2506 # -- Repository Menu
2508 menu .mbar.repository
2511 .mbar.repository add
command \
2512 -label [mc
"Explore Working Copy"] \
2513 -command {do_explore
}
2514 .mbar.repository add separator
2517 .mbar.repository add
command \
2518 -label [mc
"Browse Current Branch's Files"] \
2519 -command {browser
::new
$current_branch}
2520 set ui_browse_current
[.mbar.repository index last
]
2521 .mbar.repository add
command \
2522 -label [mc
"Browse Branch Files..."] \
2523 -command browser_open
::dialog
2524 .mbar.repository add separator
2526 .mbar.repository add
command \
2527 -label [mc
"Visualize Current Branch's History"] \
2528 -command {do_gitk
$current_branch}
2529 set ui_visualize_current
[.mbar.repository index last
]
2530 .mbar.repository add
command \
2531 -label [mc
"Visualize All Branch History"] \
2532 -command {do_gitk
--all}
2533 .mbar.repository add separator
2535 proc current_branch_write
{args
} {
2536 global current_branch
2537 .mbar.repository entryconf $
::ui_browse_current \
2538 -label [mc
"Browse %s's Files" $current_branch]
2539 .mbar.repository entryconf $
::ui_visualize_current \
2540 -label [mc
"Visualize %s's History" $current_branch]
2542 trace add variable current_branch
write current_branch_write
2544 if {[is_enabled multicommit
]} {
2545 .mbar.repository add
command -label [mc
"Database Statistics"] \
2548 .mbar.repository add
command -label [mc
"Compress Database"] \
2551 .mbar.repository add
command -label [mc
"Verify Database"] \
2552 -command do_fsck_objects
2554 .mbar.repository add separator
2557 .mbar.repository add
command \
2558 -label [mc
"Create Desktop Icon"] \
2559 -command do_cygwin_shortcut
2560 } elseif
{[is_Windows
]} {
2561 .mbar.repository add
command \
2562 -label [mc
"Create Desktop Icon"] \
2563 -command do_windows_shortcut
2564 } elseif
{[is_MacOSX
]} {
2565 .mbar.repository add
command \
2566 -label [mc
"Create Desktop Icon"] \
2567 -command do_macosx_app
2572 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2574 .mbar.repository add
command -label [mc Quit
] \
2582 .mbar.edit add
command -label [mc Undo
] \
2583 -command {catch
{[focus
] edit undo
}} \
2585 .mbar.edit add
command -label [mc Redo
] \
2586 -command {catch
{[focus
] edit redo
}} \
2588 .mbar.edit add separator
2589 .mbar.edit add
command -label [mc Cut
] \
2590 -command {catch
{tk_textCut
[focus
]}} \
2592 .mbar.edit add
command -label [mc Copy
] \
2593 -command {catch
{tk_textCopy
[focus
]}} \
2595 .mbar.edit add
command -label [mc Paste
] \
2596 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2598 .mbar.edit add
command -label [mc Delete
] \
2599 -command {catch
{[focus
] delete sel.first sel.last
}} \
2601 .mbar.edit add separator
2602 .mbar.edit add
command -label [mc
"Select All"] \
2603 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2608 if {[is_enabled branch
]} {
2611 .mbar.branch add
command -label [mc
"Create..."] \
2612 -command branch_create
::dialog \
2614 lappend disable_on_lock
[list .mbar.branch entryconf \
2615 [.mbar.branch index last
] -state]
2617 .mbar.branch add
command -label [mc
"Checkout..."] \
2618 -command branch_checkout
::dialog \
2620 lappend disable_on_lock
[list .mbar.branch entryconf \
2621 [.mbar.branch index last
] -state]
2623 .mbar.branch add
command -label [mc
"Rename..."] \
2624 -command branch_rename
::dialog
2625 lappend disable_on_lock
[list .mbar.branch entryconf \
2626 [.mbar.branch index last
] -state]
2628 .mbar.branch add
command -label [mc
"Delete..."] \
2629 -command branch_delete
::dialog
2630 lappend disable_on_lock
[list .mbar.branch entryconf \
2631 [.mbar.branch index last
] -state]
2633 .mbar.branch add
command -label [mc
"Reset..."] \
2634 -command merge
::reset_hard
2635 lappend disable_on_lock
[list .mbar.branch entryconf \
2636 [.mbar.branch index last
] -state]
2641 proc commit_btn_caption
{} {
2642 if {[is_enabled nocommit
]} {
2645 return [mc Commit@@verb
]
2649 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2652 if {![is_enabled nocommit
]} {
2653 .mbar.commit add radiobutton \
2654 -label [mc
"New Commit"] \
2655 -command do_select_commit_type \
2656 -variable selected_commit_type \
2658 lappend disable_on_lock \
2659 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2661 .mbar.commit add radiobutton \
2662 -label [mc
"Amend Last Commit"] \
2663 -command do_select_commit_type \
2664 -variable selected_commit_type \
2666 lappend disable_on_lock \
2667 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2669 .mbar.commit add separator
2672 .mbar.commit add
command -label [mc Rescan
] \
2673 -command ui_do_rescan \
2675 lappend disable_on_lock \
2676 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2678 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2679 -command do_add_selection \
2681 lappend disable_on_lock \
2682 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2684 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2685 -command do_add_all \
2687 lappend disable_on_lock \
2688 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2690 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2691 -command do_unstage_selection \
2693 lappend disable_on_lock \
2694 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2696 .mbar.commit add
command -label [mc
"Revert Changes"] \
2697 -command do_revert_selection \
2699 lappend disable_on_lock \
2700 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2702 .mbar.commit add separator
2704 .mbar.commit add
command -label [mc
"Show Less Context"] \
2705 -command show_less_context \
2706 -accelerator $M1T-\
-
2708 .mbar.commit add
command -label [mc
"Show More Context"] \
2709 -command show_more_context \
2712 .mbar.commit add separator
2714 if {![is_enabled nocommitmsg
]} {
2715 .mbar.commit add
command -label [mc
"Sign Off"] \
2716 -command do_signoff \
2720 .mbar.commit add
command -label [commit_btn_caption
] \
2721 -command do_commit \
2722 -accelerator $M1T-Return
2723 lappend disable_on_lock \
2724 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2729 if {[is_enabled branch
]} {
2731 .mbar.merge add
command -label [mc
"Local Merge..."] \
2732 -command merge
::dialog \
2734 lappend disable_on_lock \
2735 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2736 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2737 -command merge
::reset_hard
2738 lappend disable_on_lock \
2739 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2744 if {[is_enabled transport
]} {
2747 .mbar.remote add
command \
2748 -label [mc
"Add..."] \
2749 -command remote_add
::dialog \
2751 .mbar.remote add
command \
2752 -label [mc
"Push..."] \
2753 -command do_push_anywhere \
2755 .mbar.remote add
command \
2756 -label [mc
"Delete Branch..."] \
2757 -command remote_branch_delete
::dialog
2761 proc
::tk
::mac
::ShowPreferences
{} {do_options
}
2765 .mbar.edit add separator
2766 .mbar.edit add
command -label [mc
"Options..."] \
2772 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2773 set tools_menubar .mbar.tools
2775 $tools_menubar add separator
2776 $tools_menubar add
command -label [mc
"Add..."] -command tools_add
::dialog
2777 $tools_menubar add
command -label [mc
"Remove..."] -command tools_remove
::dialog
2779 if {[array names repo_config guitool.
*.cmd
] ne
{}} {
2786 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2790 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2792 .mbar.apple add separator
2794 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2797 . configure
-menu .mbar
2799 set doc_path
[githtmldir
]
2800 if {$doc_path ne
{}} {
2801 set doc_path
[file join $doc_path index.html
]
2804 set doc_path
[exec cygpath
--mixed $doc_path]
2808 if {[file isfile
$doc_path]} {
2809 set doc_url
"file:$doc_path"
2811 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2814 proc start_browser
{url
} {
2815 git
"web--browse" $url
2818 .mbar.
help add
command -label [mc
"Online Documentation"] \
2819 -command [list start_browser
$doc_url]
2821 .mbar.
help add
command -label [mc
"Show SSH Key"] \
2824 unset doc_path doc_url
2826 # -- Standard bindings
2828 wm protocol . WM_DELETE_WINDOW do_quit
2829 bind all
<$M1B-Key-q> do_quit
2830 bind all
<$M1B-Key-Q> do_quit
2831 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2832 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2834 set subcommand_args
{}
2836 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2840 proc normalize_relpath
{path
} {
2842 foreach item
[file split $path] {
2843 if {$item eq
{.
}} continue
2844 if {$item eq
{..
} && [llength
$elements] > 0
2845 && [lindex
$elements end
] ne
{..
}} {
2846 set elements
[lrange
$elements 0 end-1
]
2849 lappend elements
$item
2851 return [eval file join $elements]
2854 # -- Not a normal commit type invocation? Do that instead!
2856 switch
-- $subcommand {
2859 if {$subcommand eq
"blame"} {
2860 set subcommand_args
{[--line=<num
>] rev? path
}
2862 set subcommand_args
{rev? path
}
2864 if {$argv eq
{}} usage
2870 if {$is_path ||
[file exists
$_prefix$a]} {
2871 if {$path ne
{}} usage
2872 set path
[normalize_relpath
$_prefix$a]
2874 } elseif
{$a eq
{--}} {
2876 if {$head ne
{}} usage
2881 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
2882 if {$jump_spec ne
{} ||
$head ne
{}} usage
2883 set jump_spec
[list
$lnum]
2884 } elseif
{$head eq
{}} {
2885 if {$head ne
{}} usage
2894 if {$head ne
{} && $path eq
{}} {
2895 set path
[normalize_relpath
$_prefix$head]
2902 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2904 set head [git rev-parse
--verify $head]
2910 set current_branch
$head
2913 switch
-- $subcommand {
2915 if {$jump_spec ne
{}} usage
2917 if {$path ne
{} && [file isdirectory
$path]} {
2918 set head $current_branch
2924 browser
::new
$head $path
2927 if {$head eq
{} && ![file exists
$path]} {
2928 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2931 blame
::new
$head $path $jump_spec
2938 if {[llength
$argv] != 0} {
2939 puts
-nonewline stderr
"usage: $argv0"
2940 if {$subcommand ne
{gui
}
2941 && [file tail $argv0] ne
"git-$subcommand"} {
2942 puts
-nonewline stderr
" $subcommand"
2947 # fall through to setup UI for commits
2950 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2957 ${NS}::frame .branch
2958 if {!$use_ttk} {.branch configure
-borderwidth 1 -relief sunken
}
2959 ${NS}::label .branch.l1 \
2960 -text [mc
"Current Branch:"] \
2963 ${NS}::label .branch.cb \
2964 -textvariable current_branch \
2967 pack .branch.l1
-side left
2968 pack .branch.cb
-side left
-fill x
2969 pack .branch
-side top
-fill x
2971 # -- Main Window Layout
2973 ${NS}::panedwindow .vpane
-orient horizontal
2974 ${NS}::panedwindow .vpane.files
-orient vertical
2976 .vpane add .vpane.files
2978 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2980 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2982 # -- Index File List
2984 ${NS}::frame .vpane.files.index
-height 100 -width 200
2985 tlabel .vpane.files.index.title \
2986 -text [mc
"Staged Changes (Will Commit)"] \
2987 -background lightgreen
-foreground black
2988 text
$ui_index -background white
-foreground black \
2990 -width 20 -height 10 \
2992 -cursor $cursor_ptr \
2993 -xscrollcommand {.vpane.files.index.sx
set} \
2994 -yscrollcommand {.vpane.files.index.sy
set} \
2996 ${NS}::scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2997 ${NS}::scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2998 pack .vpane.files.index.title
-side top
-fill x
2999 pack .vpane.files.index.sx
-side bottom
-fill x
3000 pack .vpane.files.index.sy
-side right
-fill y
3001 pack
$ui_index -side left
-fill both
-expand 1
3003 # -- Working Directory File List
3005 ${NS}::frame .vpane.files.workdir
-height 100 -width 200
3006 tlabel .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
3007 -background lightsalmon
-foreground black
3008 text
$ui_workdir -background white
-foreground black \
3010 -width 20 -height 10 \
3012 -cursor $cursor_ptr \
3013 -xscrollcommand {.vpane.files.workdir.sx
set} \
3014 -yscrollcommand {.vpane.files.workdir.sy
set} \
3016 ${NS}::scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
3017 ${NS}::scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
3018 pack .vpane.files.workdir.title
-side top
-fill x
3019 pack .vpane.files.workdir.sx
-side bottom
-fill x
3020 pack .vpane.files.workdir.sy
-side right
-fill y
3021 pack
$ui_workdir -side left
-fill both
-expand 1
3023 .vpane.files add .vpane.files.workdir
3024 .vpane.files add .vpane.files.index
3026 .vpane.files paneconfigure .vpane.files.workdir
-sticky news
3027 .vpane.files paneconfigure .vpane.files.index
-sticky news
3030 foreach i
[list
$ui_index $ui_workdir] {
3032 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
3036 # -- Diff and Commit Area
3038 ${NS}::frame .vpane.lower
-height 300 -width 400
3039 ${NS}::frame .vpane.lower.commarea
3040 ${NS}::frame .vpane.lower.
diff -relief sunken
-borderwidth 1
3041 pack .vpane.lower.
diff -fill both
-expand 1
3042 pack .vpane.lower.commarea
-side bottom
-fill x
3043 .vpane add .vpane.lower
3044 if {!$use_ttk} {.vpane paneconfigure .vpane.lower
-sticky nsew
}
3046 # -- Commit Area Buttons
3048 ${NS}::frame .vpane.lower.commarea.buttons
3049 ${NS}::label .vpane.lower.commarea.buttons.l
-text {} \
3052 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
3053 pack .vpane.lower.commarea.buttons
-side left
-fill y
3055 ${NS}::button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
3056 -command ui_do_rescan
3057 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
3058 lappend disable_on_lock \
3059 {.vpane.lower.commarea.buttons.rescan conf
-state}
3061 ${NS}::button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
3063 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
3064 lappend disable_on_lock \
3065 {.vpane.lower.commarea.buttons.incall conf
-state}
3067 if {![is_enabled nocommitmsg
]} {
3068 ${NS}::button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
3070 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
3073 ${NS}::button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
3075 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
3076 lappend disable_on_lock \
3077 {.vpane.lower.commarea.buttons.commit conf
-state}
3079 if {![is_enabled nocommit
]} {
3080 ${NS}::button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
3081 -command do_push_anywhere
3082 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
3085 # -- Commit Message Buffer
3087 ${NS}::frame .vpane.lower.commarea.buffer
3088 ${NS}::frame .vpane.lower.commarea.buffer.header
3089 set ui_comm .vpane.lower.commarea.buffer.t
3090 set ui_coml .vpane.lower.commarea.buffer.header.l
3092 if {![is_enabled nocommit
]} {
3093 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3094 -text [mc
"New Commit"] \
3095 -command do_select_commit_type \
3096 -variable selected_commit_type \
3098 lappend disable_on_lock \
3099 [list .vpane.lower.commarea.buffer.header.new conf
-state]
3100 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3101 -text [mc
"Amend Last Commit"] \
3102 -command do_select_commit_type \
3103 -variable selected_commit_type \
3105 lappend disable_on_lock \
3106 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
3109 ${NS}::label
$ui_coml \
3112 proc trace_commit_type
{varname args
} {
3113 global ui_coml commit_type
3114 switch
-glob -- $commit_type {
3115 initial
{set txt
[mc
"Initial Commit Message:"]}
3116 amend
{set txt
[mc
"Amended Commit Message:"]}
3117 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
3118 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
3119 merge
{set txt
[mc
"Merge Commit Message:"]}
3120 * {set txt
[mc
"Commit Message:"]}
3122 $ui_coml conf
-text $txt
3124 trace add variable commit_type
write trace_commit_type
3125 pack
$ui_coml -side left
-fill x
3127 if {![is_enabled nocommit
]} {
3128 pack .vpane.lower.commarea.buffer.header.amend
-side right
3129 pack .vpane.lower.commarea.buffer.header.new
-side right
3132 text
$ui_comm -background white
-foreground black \
3136 -autoseparators true \
3138 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
3140 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
3141 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3142 -command [list
$ui_comm yview
]
3143 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
3144 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
3145 pack
$ui_comm -side left
-fill y
3146 pack .vpane.lower.commarea.buffer
-side left
-fill y
3148 # -- Commit Message Buffer Context Menu
3150 set ctxm .vpane.lower.commarea.buffer.ctxm
3151 menu
$ctxm -tearoff 0
3154 -command {tk_textCut
$ui_comm}
3157 -command {tk_textCopy
$ui_comm}
3160 -command {tk_textPaste
$ui_comm}
3162 -label [mc Delete
] \
3163 -command {catch
{$ui_comm delete sel.first sel.last
}}
3166 -label [mc
"Select All"] \
3167 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
3169 -label [mc
"Copy All"] \
3171 $ui_comm tag add sel
0.0 end
3172 tk_textCopy
$ui_comm
3173 $ui_comm tag remove sel
0.0 end
3177 -label [mc
"Sign Off"] \
3179 set ui_comm_ctxm
$ctxm
3183 proc trace_current_diff_path
{varname args
} {
3184 global current_diff_path diff_actions file_states
3185 if {$current_diff_path eq
{}} {
3191 set p
$current_diff_path
3192 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
3194 set p
[escape_path
$p]
3198 .vpane.lower.
diff.header.status configure
-text $s
3199 .vpane.lower.
diff.header.
file configure
-text $f
3200 .vpane.lower.
diff.header.path configure
-text $p
3201 foreach w
$diff_actions {
3205 trace add variable current_diff_path
write trace_current_diff_path
3207 gold_frame .vpane.lower.
diff.header
3208 tlabel .vpane.lower.
diff.header.status \
3211 -width $max_status_desc \
3214 tlabel .vpane.lower.
diff.header.
file \
3219 tlabel .vpane.lower.
diff.header.path \
3224 pack .vpane.lower.
diff.header.status
-side left
3225 pack .vpane.lower.
diff.header.
file -side left
3226 pack .vpane.lower.
diff.header.path
-fill x
3227 set ctxm .vpane.lower.
diff.header.ctxm
3228 menu
$ctxm -tearoff 0
3236 -- $current_diff_path
3238 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3239 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
3243 ${NS}::frame .vpane.lower.
diff.body
3244 set ui_diff .vpane.lower.
diff.body.t
3245 text
$ui_diff -background white
-foreground black \
3247 -width 80 -height 5 -wrap none \
3249 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
3250 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
3252 ${NS}::scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
3253 -command [list
$ui_diff xview
]
3254 ${NS}::scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
3255 -command [list
$ui_diff yview
]
3256 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
3257 pack .vpane.lower.
diff.body.sby
-side right
-fill y
3258 pack
$ui_diff -side left
-fill both
-expand 1
3259 pack .vpane.lower.
diff.header
-side top
-fill x
3260 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
3262 $ui_diff tag conf d_cr
-elide true
3263 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
3264 $ui_diff tag conf d_
+ -foreground {#00a000}
3265 $ui_diff tag conf d_-
-foreground red
3267 $ui_diff tag conf d_
++ -foreground {#00a000}
3268 $ui_diff tag conf d_--
-foreground red
3269 $ui_diff tag conf d_
+s \
3270 -foreground {#00a000} \
3271 -background {#e2effa}
3272 $ui_diff tag conf d_-s \
3274 -background {#e2effa}
3275 $ui_diff tag conf d_s
+ \
3276 -foreground {#00a000} \
3278 $ui_diff tag conf d_s- \
3282 $ui_diff tag conf d
<<<<<<< \
3283 -foreground orange \
3285 $ui_diff tag conf d
======= \
3286 -foreground orange \
3288 $ui_diff tag conf d
>>>>>>> \
3289 -foreground orange \
3292 $ui_diff tag raise sel
3294 # -- Diff Body Context Menu
3297 proc create_common_diff_popup
{ctxm
} {
3299 -label [mc Refresh
] \
3300 -command reshow_diff
3301 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3304 -command {tk_textCopy
$ui_diff}
3305 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3307 -label [mc
"Select All"] \
3308 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3309 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3311 -label [mc
"Copy All"] \
3313 $ui_diff tag add sel
0.0 end
3314 tk_textCopy
$ui_diff
3315 $ui_diff tag remove sel
0.0 end
3317 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3320 -label [mc
"Decrease Font Size"] \
3321 -command {incr_font_size font_diff
-1}
3322 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3324 -label [mc
"Increase Font Size"] \
3325 -command {incr_font_size font_diff
1}
3326 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3330 build_encoding_menu
$emenu [list force_diff_encoding
]
3332 -label [mc
"Encoding"] \
3334 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3336 $ctxm add
command -label [mc
"Options..."] \
3340 set ctxm .vpane.lower.
diff.body.ctxm
3341 menu
$ctxm -tearoff 0
3343 -label [mc
"Apply/Reverse Hunk"] \
3344 -command {apply_hunk
$cursorX $cursorY}
3345 set ui_diff_applyhunk
[$ctxm index last
]
3346 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3348 -label [mc
"Apply/Reverse Line"] \
3349 -command {apply_range_or_line
$cursorX $cursorY; do_rescan
}
3350 set ui_diff_applyline
[$ctxm index last
]
3351 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3354 -label [mc
"Show Less Context"] \
3355 -command show_less_context
3356 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3358 -label [mc
"Show More Context"] \
3359 -command show_more_context
3360 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3362 create_common_diff_popup
$ctxm
3364 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3365 menu
$ctxmmg -tearoff 0
3366 $ctxmmg add
command \
3367 -label [mc
"Run Merge Tool"] \
3368 -command {merge_resolve_tool
}
3369 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3370 $ctxmmg add separator
3371 $ctxmmg add
command \
3372 -label [mc
"Use Remote Version"] \
3373 -command {merge_resolve_one
3}
3374 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3375 $ctxmmg add
command \
3376 -label [mc
"Use Local Version"] \
3377 -command {merge_resolve_one
2}
3378 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3379 $ctxmmg add
command \
3380 -label [mc
"Revert To Base"] \
3381 -command {merge_resolve_one
1}
3382 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3383 $ctxmmg add separator
3384 $ctxmmg add
command \
3385 -label [mc
"Show Less Context"] \
3386 -command show_less_context
3387 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3388 $ctxmmg add
command \
3389 -label [mc
"Show More Context"] \
3390 -command show_more_context
3391 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3392 $ctxmmg add separator
3393 create_common_diff_popup
$ctxmmg
3395 set ctxmsm .vpane.lower.
diff.body.ctxmsm
3396 menu
$ctxmsm -tearoff 0
3397 $ctxmsm add
command \
3398 -label [mc
"Visualize These Changes In The Submodule"] \
3399 -command {do_gitk
-- true
}
3400 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3401 $ctxmsm add
command \
3402 -label [mc
"Visualize Current Branch History In The Submodule"] \
3403 -command {do_gitk
{} true
}
3404 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3405 $ctxmsm add
command \
3406 -label [mc
"Visualize All Branch History In The Submodule"] \
3407 -command {do_gitk
--all true
}
3408 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3409 $ctxmsm add separator
3410 $ctxmsm add
command \
3411 -label [mc
"Start git gui In The Submodule"] \
3412 -command {do_git_gui
}
3413 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3414 $ctxmsm add separator
3415 create_common_diff_popup
$ctxmsm
3417 proc popup_diff_menu
{ctxm ctxmmg ctxmsm x y X Y
} {
3418 global current_diff_path file_states
3421 if {[info exists file_states
($current_diff_path)]} {
3422 set state
[lindex
$file_states($current_diff_path) 0]
3426 if {[string first
{U
} $state] >= 0} {
3427 tk_popup
$ctxmmg $X $Y
3428 } elseif
{$
::is_submodule_diff
} {
3429 tk_popup
$ctxmsm $X $Y
3431 set has_range
[expr {[$
::ui_diff tag nextrange sel
0.0] != {}}]
3432 if {$
::ui_index eq $
::current_diff_side
} {
3433 set l
[mc
"Unstage Hunk From Commit"]
3435 set t
[mc
"Unstage Lines From Commit"]
3437 set t
[mc
"Unstage Line From Commit"]
3440 set l
[mc
"Stage Hunk For Commit"]
3442 set t
[mc
"Stage Lines For Commit"]
3444 set t
[mc
"Stage Line For Commit"]
3448 ||
$current_diff_path eq
{}
3452 ||
{T_
} eq
$state} {
3457 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3458 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3459 tk_popup
$ctxm $X $Y
3462 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg $ctxmsm %x
%y
%X
%Y
]
3466 set main_status
[::status_bar
::new .status
]
3467 pack .status
-anchor w
-side bottom
-fill x
3468 $main_status show
[mc
"Initializing..."]
3473 set gm
$repo_config(gui.geometry
)
3474 wm geometry .
[lindex
$gm 0]
3476 .vpane sashpos
0 [lindex
$gm 1]
3477 .vpane.files sashpos
0 [lindex
$gm 2]
3479 .vpane sash place
0 \
3481 [lindex
[.vpane sash coord
0] 1]
3482 .vpane.files sash place
0 \
3483 [lindex
[.vpane.files sash coord
0] 0] \
3489 # -- Load window state
3492 set gws
$repo_config(gui.wmstate
)
3499 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3500 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3501 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3502 bind $ui_comm <$M1B-Key-u> {do_unstage_selection
;break}
3503 bind $ui_comm <$M1B-Key-U> {do_unstage_selection
;break}
3504 bind $ui_comm <$M1B-Key-j> {do_revert_selection
;break}
3505 bind $ui_comm <$M1B-Key-J> {do_revert_selection
;break}
3506 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3507 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3508 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3509 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3510 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3511 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3512 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3513 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3514 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3515 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3516 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3517 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3518 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3519 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3520 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3522 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3523 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3524 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3525 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3526 bind $ui_diff <$M1B-Key-v> {break}
3527 bind $ui_diff <$M1B-Key-V> {break}
3528 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3529 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3530 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3531 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3532 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3533 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3534 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3535 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3536 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3537 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3538 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3539 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3540 bind $ui_diff <Button-1
> {focus
%W
}
3542 if {[is_enabled branch
]} {
3543 bind .
<$M1B-Key-n> branch_create
::dialog
3544 bind .
<$M1B-Key-N> branch_create
::dialog
3545 bind .
<$M1B-Key-o> branch_checkout
::dialog
3546 bind .
<$M1B-Key-O> branch_checkout
::dialog
3547 bind .
<$M1B-Key-m> merge
::dialog
3548 bind .
<$M1B-Key-M> merge
::dialog
3550 if {[is_enabled transport
]} {
3551 bind .
<$M1B-Key-p> do_push_anywhere
3552 bind .
<$M1B-Key-P> do_push_anywhere
3555 bind .
<Key-F5
> ui_do_rescan
3556 bind .
<$M1B-Key-r> ui_do_rescan
3557 bind .
<$M1B-Key-R> ui_do_rescan
3558 bind .
<$M1B-Key-s> do_signoff
3559 bind .
<$M1B-Key-S> do_signoff
3560 bind .
<$M1B-Key-t> do_add_selection
3561 bind .
<$M1B-Key-T> do_add_selection
3562 bind .
<$M1B-Key-j> do_revert_selection
3563 bind .
<$M1B-Key-J> do_revert_selection
3564 bind .
<$M1B-Key-i> do_add_all
3565 bind .
<$M1B-Key-I> do_add_all
3566 bind .
<$M1B-Key-minus> {show_less_context
;break}
3567 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3568 bind .
<$M1B-Key-equal> {show_more_context
;break}
3569 bind .
<$M1B-Key-plus> {show_more_context
;break}
3570 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3571 bind .
<$M1B-Key-Return> do_commit
3572 foreach i
[list
$ui_index $ui_workdir] {
3573 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
3574 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3575 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
3579 set file_lists
($ui_index) [list
]
3580 set file_lists
($ui_workdir) [list
]
3582 wm title .
"[appname] ([reponame]) [file normalize $_gitworktree]"
3583 focus
-force $ui_comm
3585 # -- Warn the user about environmental problems. Cygwin's Tcl
3586 # does *not* pass its env array onto any processes it spawns.
3587 # This means that git processes get none of our environment.
3592 set msg
[mc
"Possible environment issues exist.
3594 The following environment variables are probably
3595 going to be ignored by any Git subprocess run
3599 foreach name
[array names env
] {
3600 switch
-regexp -- $name {
3601 {^GIT_INDEX_FILE$
} -
3602 {^GIT_OBJECT_DIRECTORY$
} -
3603 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3605 {^GIT_EXTERNAL_DIFF$
} -
3609 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3610 append msg
" - $name\n"
3613 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3614 append msg
" - $name\n"
3616 set suggest_user
$name
3620 if {$ignored_env > 0} {
3622 This is due to a known issue with the
3623 Tcl binary distributed by Cygwin."]
3625 if {$suggest_user ne
{}} {
3628 A good replacement for %s
3629 is placing values for the user.name and
3630 user.email settings into your personal
3636 unset ignored_env msg suggest_user name
3639 # -- Only initialize complex UI if we are going to stay running.
3641 if {[is_enabled transport
]} {
3644 set n
[.mbar.remote index end
]
3645 populate_remotes_menu
3646 set n
[expr {[.mbar.remote index end
] - $n}]
3648 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3649 .mbar.remote insert
$n separator
3654 if {[winfo exists
$ui_comm]} {
3655 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
3657 # -- If both our backup and message files exist use the
3658 # newer of the two files to initialize the buffer.
3660 if {$GITGUI_BCK_exists} {
3661 set m
[gitdir GITGUI_MSG
]
3662 if {[file isfile
$m]} {
3663 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3664 catch
{file delete
[gitdir GITGUI_MSG
]}
3666 $ui_comm delete
0.0 end
3668 $ui_comm edit modified false
3669 catch
{file delete
[gitdir GITGUI_BCK
]}
3670 set GITGUI_BCK_exists
0
3676 proc backup_commit_buffer
{} {
3677 global ui_comm GITGUI_BCK_exists
3679 set m
[$ui_comm edit modified
]
3680 if {$m ||
$GITGUI_BCK_exists} {
3681 set msg
[string trim
[$ui_comm get
0.0 end
]]
3682 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3685 if {$GITGUI_BCK_exists} {
3686 catch
{file delete
[gitdir GITGUI_BCK
]}
3687 set GITGUI_BCK_exists
0
3691 set fd
[open
[gitdir GITGUI_BCK
] w
]
3692 puts
-nonewline $fd $msg
3694 set GITGUI_BCK_exists
1
3698 $ui_comm edit modified false
3701 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3704 backup_commit_buffer
3706 # -- If the user has aspell available we can drive it
3707 # in pipe mode to spellcheck the commit message.
3709 set spell_cmd
[list |
]
3710 set spell_dict
[get_config gui.spellingdictionary
]
3711 lappend spell_cmd aspell
3712 if {$spell_dict ne
{}} {
3713 lappend spell_cmd
--master=$spell_dict
3715 lappend spell_cmd
--mode=none
3716 lappend spell_cmd
--encoding=utf-8
3717 lappend spell_cmd pipe
3718 if {$spell_dict eq
{none
}
3719 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3720 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3722 set ui_comm_spell
[spellcheck
::init \
3728 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3731 lock_index begin-read
3732 if {![winfo ismapped .
]} {
3736 if {[is_enabled initialamend
]} {
3742 if {[is_enabled nocommitmsg
]} {
3743 $ui_comm configure
-state disabled
-background gray
3746 if {[is_enabled multicommit
]} {
3749 if {[is_enabled retcode
]} {
3750 bind .
<Destroy
> {+terminate_me
%W
}
3752 if {$picked && [is_config_true gui.autoexplore
]} {
3758 # indent-tabs-mode: t