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
[string map
[list
(c
) \u00a9] {
14 Copyright
(c
) 2006-2010 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 "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
86 if {[tk windowingsystem
] eq
"win32"} { console show
}
89 ######################################################################
91 ## Internationalization (i18n) through msgcat and gettext. See
92 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
94 package require msgcat
97 set cmk
[string first @@
$fmt]
99 return [string range
$fmt 0 [expr {$cmk - 1}]]
104 proc mc
{en_fmt args
} {
105 set fmt [_mc_trim
[::msgcat
::mc
$en_fmt]]
106 if {[catch
{set msg
[eval [list format
$fmt] $args]} err
]} {
107 set msg
[eval [list format
[_mc_trim
$en_fmt]] $args]
113 return [join $args {}]
116 ::msgcat
::mcload
$oguimsg
119 ######################################################################
123 set _appname
{Git Gui
}
132 set _shellpath
{@@SHELL_PATH@@
}
134 set _trace
[lsearch
-exact $argv --trace]
136 set argv
[lreplace
$argv $_trace $_trace]
143 global _shellpath env
144 if {[string match @@
* $_shellpath]} {
145 if {[info exists env
(SHELL
)]} {
164 return [eval [list
file join $_gitdir] $args]
167 proc gitexec
{args
} {
169 if {$_gitexec eq
{}} {
170 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
171 error
"Git not installed?\n\n$err"
174 set _gitexec
[exec cygpath \
179 set _gitexec
[file normalize
$_gitexec]
185 return [eval [list
file join $_gitexec] $args]
188 proc githtmldir
{args
} {
190 if {$_githtmldir eq
{}} {
191 if {[catch
{set _githtmldir
[git
--html-path]}]} {
192 # Git not installed or option not yet supported
196 set _githtmldir
[exec cygpath \
201 set _githtmldir
[file normalize
$_githtmldir]
207 return [eval [list
file join $_githtmldir] $args]
215 if {[tk windowingsystem
] eq
{aqua
}} {
222 if {$
::tcl_platform
(platform
) eq
{windows
}} {
230 if {$_iscygwin eq
{}} {
231 if {$
::tcl_platform
(platform
) eq
{windows
}} {
232 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
244 proc is_enabled
{option
} {
245 global enabled_options
246 if {[catch
{set on
$enabled_options($option)}]} {return 0}
250 proc enable_option
{option
} {
251 global enabled_options
252 set enabled_options
($option) 1
255 proc disable_option
{option
} {
256 global enabled_options
257 set enabled_options
($option) 0
260 ######################################################################
264 proc is_many_config
{name
} {
265 switch
-glob -- $name {
275 proc is_config_true
{name
} {
277 if {[catch
{set v
$repo_config($name)}]} {
279 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
286 proc is_config_false
{name
} {
288 if {[catch
{set v
$repo_config($name)}]} {
290 } elseif
{$v eq
{false
} ||
$v eq
{0} ||
$v eq
{no
}} {
297 proc get_config
{name
} {
299 if {[catch
{set v
$repo_config($name)}]} {
311 if {$_isbare eq
{}} {
313 set _bare
[git rev-parse
--is-bare-repository]
315 true
{ set _isbare
1 }
316 false
{ set _isbare
0}
320 if {[is_config_true core.bare
]
321 ||
($_gitworktree eq
{}
322 && [lindex
[file split $_gitdir] end
] ne
{.git
})} {
332 ######################################################################
336 proc _trace_exec
{cmd
} {
337 if {!$
::_trace
} return
343 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
351 #'" fix poor old emacs font-lock mode
353 proc _git_cmd {name} {
356 if {[catch {set v $_git_cmd_path($name)}]} {
360 --exec-path { return [list $::_git $name] }
363 set p [gitexec git-$name$::_search_exe]
364 if {[file exists $p]} {
366 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
367 # Try to determine what sort of magic will make
368 # git-$name go and do its thing, because native
369 # Tcl on Windows doesn't know it.
371 set p [gitexec git-$name]
376 switch -glob -- [lindex $s 0] {
378 #!*perl { set i perl }
379 #!*python { set i python }
380 default { error "git-
$name is not supported
: $s" }
384 if {![info exists interp]} {
385 set interp [_which $i]
388 error "git-
$name requires
$i (not
in PATH
)"
390 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
392 # Assume it is builtin to git somehow and we
393 # aren't actually able to see a file for it.
395 set v [list $::_git $name]
397 set _git_cmd_path($name) $v
402 proc _which {what args} {
403 global env _search_exe _search_path
405 if {$_search_path eq {}} {
406 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
407 set _search_path [split [exec cygpath \
413 } elseif {[is_Windows]} {
414 set gitguidir [file dirname [info script]]
415 regsub -all ";" $gitguidir "\\;" gitguidir
416 set env(PATH) "$gitguidir;$env(PATH
)"
417 set _search_path [split $env(PATH) {;}]
420 set _search_path [split $env(PATH) :]
425 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
428 set suffix $_search_exe
431 foreach p $_search_path {
432 set p [file join $p $what$suffix]
433 if {[file exists $p]} {
434 return [file normalize $p]
440 proc _lappend_nice {cmd_var} {
444 if {![info exists _nice]} {
445 set _nice [_which nice]
446 if {[catch {exec $_nice git version}]} {
448 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
461 switch -- [lindex $args 0] {
472 set args [lrange $args 1 end]
475 set cmdp [_git_cmd [lindex $args 0]]
476 set args [lrange $args 1 end]
478 _trace_exec [concat $opt $cmdp $args]
479 set result [eval exec $opt $cmdp $args]
481 puts stderr "< $result"
486 proc _open_stdout_stderr {cmd} {
489 set fd [open [concat [list | ] $cmd] r]
491 if { [lindex $cmd end] eq {2>@1}
492 && $err eq {can not find channel named "1"}
494 # Older versions of Tcl 8.4 don't have this 2>@1 IO
495 # redirect operator. Fallback to |& cat for those.
496 # The command was not actually started, so its safe
497 # to try to start it a second time.
499 set fd [open [concat \
501 [lrange $cmd 0 end-1] \
508 fconfigure $fd -eofchar {}
512 proc git_read {args} {
516 switch -- [lindex $args 0] {
531 set args [lrange $args 1 end]
534 set cmdp [_git_cmd [lindex $args 0]]
535 set args [lrange $args 1 end]
537 return [_open_stdout_stderr [concat $opt $cmdp $args]]
540 proc git_write {args} {
544 switch -- [lindex $args 0] {
555 set args [lrange $args 1 end]
558 set cmdp [_git_cmd [lindex $args 0]]
559 set args [lrange $args 1 end]
561 _trace_exec [concat $opt $cmdp $args]
562 return [open [concat [list | ] $opt $cmdp $args] w]
565 proc githook_read {hook_name args} {
566 set pchook [gitdir hooks $hook_name]
569 # On Windows [file executable] might lie so we need to ask
570 # the shell if the hook is executable. Yes that's annoying.
574 if {![info exists interp]} {
575 set interp [_which sh]
578 error "hook execution requires sh
(not
in PATH
)"
581 set scr {if test -x "$1";then exec "$@
";fi}
582 set sh_c [list $interp -c $scr $interp $pchook]
583 return [_open_stdout_stderr [concat $sh_c $args]]
586 if {[file executable $pchook]} {
587 return [_open_stdout_stderr [concat [list $pchook] $args]]
593 proc kill_file_process {fd} {
594 set process [pid $fd]
598 # Use a Cygwin-specific flag to allow killing
599 # native Windows processes
600 exec kill -f $process
607 proc gitattr {path attr default} {
608 if {[catch {set r [git check-attr $attr -- $path]}]} {
611 set r [join [lrange [split $r :] 2 end] :]
614 if {$r eq {unspecified}} {
621 regsub -all ' $value "'\\''" value
625 proc load_current_branch {} {
626 global current_branch is_detached
628 set fd [open [gitdir HEAD] r]
629 if {[gets $fd ref] < 1} {
634 set pfx {ref: refs/heads/}
635 set len [string length $pfx]
636 if {[string equal -length $len $pfx $ref]} {
637 # We're on a branch. It might not exist. But
638 # HEAD looks good enough to be a branch.
640 set current_branch
[string range
$ref $len end
]
643 # Assume this is a detached head.
645 set current_branch HEAD
650 auto_load tk_optionMenu
651 rename tk_optionMenu real__tkOptionMenu
652 proc tk_optionMenu
{w varName args
} {
653 set m
[eval real__tkOptionMenu
$w $varName $args]
654 $m configure
-font font_ui
655 $w configure
-font font_ui
659 proc rmsel_tag
{text
} {
661 -background [$text cget
-background] \
662 -foreground [$text cget
-foreground] \
664 $text tag conf in_sel
-background lightgray
665 bind $text <Motion
> break
671 bind .
<Visibility
> {
672 bind .
<Visibility
> {}
677 wm iconbitmap .
-default $oguilib/git-gui.ico
678 set ::tk
::AlwaysShowSelection
1
679 bind .
<Control-F2
> {console show
}
681 # Spoof an X11 display for SSH
682 if {![info exists env
(DISPLAY
)]} {
683 set env
(DISPLAY
) :9999
687 image create photo gitlogo
-width 16 -height 16
689 gitlogo put
#33CC33 -to 7 0 9 2
690 gitlogo put
#33CC33 -to 4 2 12 4
691 gitlogo put
#33CC33 -to 7 4 9 6
692 gitlogo put
#CC3333 -to 4 6 12 8
693 gitlogo put gray26
-to 4 9 6 10
694 gitlogo put gray26
-to 3 10 6 12
695 gitlogo put gray26
-to 8 9 13 11
696 gitlogo put gray26
-to 8 11 10 12
697 gitlogo put gray26
-to 11 11 13 14
698 gitlogo put gray26
-to 3 12 5 14
699 gitlogo put gray26
-to 5 13
700 gitlogo put gray26
-to 10 13
701 gitlogo put gray26
-to 4 14 12 15
702 gitlogo put gray26
-to 5 15 11 16
705 wm iconphoto .
-default gitlogo
709 ######################################################################
715 if {[lsearch
-exact [font names
] TkDefaultFont
] != -1} {
716 eval [linsert
[font actual TkDefaultFont
] 0 font configure font_ui
]
717 eval [linsert
[font actual TkFixedFont
] 0 font create font_diff
]
719 font create font_diff
-family Courier
-size 10
722 eval font configure font_ui
[font actual
[.dummy cget
-font]]
727 font create font_uiitalic
728 font create font_uibold
729 font create font_diffbold
730 font create font_diffitalic
732 foreach class
{Button Checkbutton Entry Label
733 Labelframe Listbox Message
734 Radiobutton Spinbox Text
} {
735 option add
*$class.font font_ui
738 option add
*Menu.font font_ui
739 option add
*Entry.borderWidth
1 startupFile
740 option add
*Entry.relief sunken startupFile
741 option add
*RadioButton.anchor w startupFile
745 if {[is_Windows
] ||
[is_MacOSX
]} {
746 option add
*Menu.tearOff
0
757 proc bind_button3
{w cmd
} {
758 bind $w <Any-Button-3
> $cmd
760 # Mac OS X sends Button-2 on right click through three-button mouse,
761 # or through trackpad right-clicking (two-finger touch + click).
762 bind $w <Any-Button-2
> $cmd
763 bind $w <Control-Button-1
> $cmd
767 proc apply_config
{} {
768 global repo_config font_descs
770 foreach option
$font_descs {
771 set name
[lindex
$option 0]
772 set font
[lindex
$option 1]
775 foreach
{cn cv
} $repo_config(gui.
$name) {
776 if {$cn eq
{-weight}} {
779 font configure
$font $cn $cv
782 font configure
$font -weight normal
785 error_popup
[strcat
[mc
"Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
787 foreach
{cn cv
} [font configure
$font] {
788 font configure
${font}bold
$cn $cv
789 font configure
${font}italic
$cn $cv
791 font configure
${font}bold
-weight bold
792 font configure
${font}italic
-slant italic
798 if {$repo_config(gui.usettk
)} {
799 set use_ttk
[package vsatisfies
[package provide Tk
] 8.5]
802 bind [winfo class .
] <<ThemeChanged>> [list InitTheme]
808 set default_config(branch.autosetupmerge) true
809 set default_config(merge.tool) {}
810 set default_config(mergetool.keepbackup) true
811 set default_config(merge.diffstat) true
812 set default_config(merge.summary) false
813 set default_config(merge.verbosity) 2
814 set default_config(user.name) {}
815 set default_config(user.email) {}
817 set default_config(gui.encoding) [encoding system]
818 set default_config(gui.matchtrackingbranch) false
819 set default_config(gui.textconv) true
820 set default_config(gui.pruneduringfetch) false
821 set default_config(gui.trustmtime) false
822 set default_config(gui.fastcopyblame) false
823 set default_config(gui.copyblamethreshold) 40
824 set default_config(gui.blamehistoryctx) 7
825 set default_config(gui.diffcontext) 5
826 set default_config(gui.commitmsgwidth) 75
827 set default_config(gui.newbranchtemplate) {}
828 set default_config(gui.spellingdictionary) {}
829 set default_config(gui.fontui) [font configure font_ui]
830 set default_config(gui.fontdiff) [font configure font_diff]
831 # TODO: this option should be added to the git-config documentation
832 set default_config(gui.maxfilesdisplayed) 5000
833 set default_config(gui.usettk) 1
835 {fontui font_ui {mc "Main Font"}}
836 {fontdiff font_diff {mc "Diff/Console Font"}}
839 ######################################################################
843 set _git [_which git]
845 catch {wm withdraw .}
849 -title [mc "git-gui: fatal error"] \
850 -message [mc "Cannot find git in PATH."]
854 ######################################################################
858 if {[catch {set _git_version [git --version]} err]} {
859 catch {wm withdraw .}
863 -title [mc "git-gui: fatal error"] \
864 -message "Cannot determine Git version:
868 [appname] requires Git 1.5.0 or later."
871 if {![regsub {^git version } $_git_version {} _git_version]} {
872 catch {wm withdraw .}
876 -title [mc "git-gui: fatal error"] \
877 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
881 set _real_git_version $_git_version
882 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
883 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
884 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
885 regsub {\.GIT$} $_git_version {} _git_version
886 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
888 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
889 catch {wm withdraw .}
894 -title "[appname]: warning" \
895 -message [mc "Git version cannot be determined.
897 %s claims it is version '%s'.
899 %s requires at least Git 1.5.0 or later.
901 Assume '%s' is version 1.5.0?
902 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
903 set _git_version 1.5.0
908 unset _real_git_version
910 proc git-version {args} {
913 switch [llength $args] {
919 set op [lindex $args 0]
920 set vr [lindex $args 1]
921 set cm [package vcompare $_git_version $vr]
922 return [expr $cm $op 0]
926 set type [lindex $args 0]
927 set name [lindex $args 1]
928 set parm [lindex $args 2]
929 set body [lindex $args 3]
931 if {($type ne {proc} && $type ne {method})} {
932 error "Invalid arguments to git-version"
934 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
935 error "Last arm of $type $name must be default"
938 foreach {op vr cb} [lrange $body 0 end-2] {
939 if {[git-version $op $vr]} {
940 return [uplevel [list $type $name $parm $cb]]
944 return [uplevel [list $type $name $parm [lindex $body end]]]
948 error "git-version >= x"
954 if {[git-version < 1.5]} {
955 catch {wm withdraw .}
959 -title [mc "git-gui: fatal error"] \
960 -message "[appname] requires Git 1.5.0 or later.
962 You are using [git-version]:
968 ######################################################################
970 ## configure our library
972 set idx [file join $oguilib tclIndex]
973 if {[catch {set fd [open $idx r]} err]} {
974 catch {wm withdraw .}
978 -title [mc "git-gui: fatal error"] \
982 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
984 while {[gets $fd n] >= 0} {
985 if {$n ne {} && ![string match #* $n]} {
997 if {[lsearch -exact $loaded $p] >= 0} continue
998 source [file join $oguilib $p]
1003 set auto_path [concat [list $oguilib] $auto_path]
1005 unset -nocomplain idx fd
1007 ######################################################################
1009 ## config file parsing
1011 git-version proc _parse_config {arr_name args} {
1018 [list git_read config] \
1020 [list --null --list]]
1021 fconfigure $fd_rc -translation binary
1022 set buf [read $fd_rc]
1025 foreach line [split $buf "\0"] {
1026 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1027 if {[is_many_config $name]} {
1028 lappend arr($name) $value
1030 set arr($name) $value
1039 set fd_rc [eval [list git_read config --list] $args]
1040 while {[gets $fd_rc line] >= 0} {
1041 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1042 if {[is_many_config $name]} {
1043 lappend arr($name) $value
1045 set arr($name) $value
1054 proc load_config {include_global} {
1055 global repo_config global_config system_config default_config
1057 if {$include_global} {
1058 _parse_config system_config --system
1059 _parse_config global_config --global
1061 _parse_config repo_config
1063 foreach name [array names default_config] {
1064 if {[catch {set v $system_config($name)}]} {
1065 set system_config($name) $default_config($name)
1068 foreach name [array names system_config] {
1069 if {[catch {set v $global_config($name)}]} {
1070 set global_config($name) $system_config($name)
1072 if {[catch {set v $repo_config($name)}]} {
1073 set repo_config($name) $system_config($name)
1078 ######################################################################
1080 ## feature option selection
1082 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1087 if {$subcommand eq {gui.sh}} {
1090 if {$subcommand eq {gui} && [llength $argv] > 0} {
1091 set subcommand [lindex $argv 0]
1092 set argv [lrange $argv 1 end]
1095 enable_option multicommit
1096 enable_option branch
1097 enable_option transport
1100 switch -- $subcommand {
1105 disable_option multicommit
1106 disable_option branch
1107 disable_option transport
1110 enable_option singlecommit
1111 enable_option retcode
1113 disable_option multicommit
1114 disable_option branch
1115 disable_option transport
1117 while {[llength $argv] > 0} {
1118 set a [lindex $argv 0]
1121 enable_option initialamend
1124 enable_option nocommit
1125 enable_option nocommitmsg
1128 disable_option nocommitmsg
1135 set argv [lrange $argv 1 end]
1140 ######################################################################
1142 ## execution environment
1144 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1146 # Suggest our implementation of askpass, if none is set
1147 if {![info exists env(SSH_ASKPASS)]} {
1148 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1151 ######################################################################
1157 set _gitdir $env(GIT_DIR)
1161 # beware that from the .git dir this sets _gitdir to .
1162 # and _prefix to the empty string
1163 set _gitdir [git rev-parse --git-dir]
1164 set _prefix [git rev-parse --show-prefix]
1168 choose_repository::pick
1172 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1173 # run from the .git dir itself) lest the routines to find the worktree
1175 if {$_gitdir eq "."} {
1179 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1180 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1182 if {![file isdirectory $_gitdir]} {
1183 catch {wm withdraw .}
1184 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1187 # _gitdir exists, so try loading the config
1190 # try to set work tree from environment, falling back to core.worktree
1191 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1192 set _gitworktree [get_config core.worktree]
1193 if {$_gitworktree eq ""} {
1194 set _gitworktree [file dirname [file normalize $_gitdir]]
1197 if {$_prefix ne {}} {
1198 if {$_gitworktree eq {}} {
1199 regsub -all {[^/]+/} $_prefix ../ cdup
1201 set cdup $_gitworktree
1203 if {[catch {cd $cdup} err]} {
1204 catch {wm withdraw .}
1205 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1208 set _gitworktree [pwd]
1210 } elseif {![is_enabled bare]} {
1212 catch {wm withdraw .}
1213 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1216 if {$_gitworktree eq {}} {
1217 set _gitworktree [file dirname $_gitdir]
1219 if {[catch {cd $_gitworktree} err]} {
1220 catch {wm withdraw .}
1221 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1224 set _gitworktree [pwd]
1226 set _reponame [file split [file normalize $_gitdir]]
1227 if {[lindex $_reponame end] eq {.git}} {
1228 set _reponame [lindex $_reponame end-1]
1230 set _reponame [lindex $_reponame end]
1233 set env(GIT_DIR) $_gitdir
1234 set env(GIT_WORK_TREE) $_gitworktree
1236 ######################################################################
1240 set current_diff_path {}
1241 set current_diff_side {}
1242 set diff_actions [list]
1246 set MERGE_HEAD [list]
1249 set current_branch {}
1251 set current_diff_path {}
1253 set is_submodule_diff 0
1254 set is_conflict_diff 0
1255 set selected_commit_type new
1256 set diff_empty_count 0
1258 set nullid "0000000000000000000000000000000000000000"
1259 set nullid2 "0000000000000000000000000000000000000001"
1261 ######################################################################
1269 set disable_on_lock [list]
1270 set index_lock_type none
1272 proc lock_index {type} {
1273 global index_lock_type disable_on_lock
1275 if {$index_lock_type eq {none}} {
1276 set index_lock_type $type
1277 foreach w $disable_on_lock {
1278 uplevel #0 $w disabled
1281 } elseif {$index_lock_type eq "begin-$type"} {
1282 set index_lock_type $type
1288 proc unlock_index {} {
1289 global index_lock_type disable_on_lock
1291 set index_lock_type none
1292 foreach w $disable_on_lock {
1293 uplevel #0 $w normal
1297 ######################################################################
1301 proc repository_state {ctvar hdvar mhvar} {
1302 global current_branch
1303 upvar $ctvar ct $hdvar hd $mhvar mh
1308 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1314 set merge_head [gitdir MERGE_HEAD]
1315 if {[file exists $merge_head]} {
1317 set fd_mh [open $merge_head r]
1318 while {[gets $fd_mh line] >= 0} {
1329 global PARENT empty_tree
1331 set p [lindex $PARENT 0]
1335 if {$empty_tree eq {}} {
1336 set empty_tree [git mktree << {}]
1341 proc force_amend {} {
1342 global selected_commit_type
1343 global HEAD PARENT MERGE_HEAD commit_type
1345 repository_state newType newHEAD newMERGE_HEAD
1348 set MERGE_HEAD $newMERGE_HEAD
1349 set commit_type $newType
1351 set selected_commit_type amend
1352 do_select_commit_type
1355 proc rescan {after {honor_trustmtime 1}} {
1356 global HEAD PARENT MERGE_HEAD commit_type
1357 global ui_index ui_workdir ui_comm
1358 global rescan_active file_states
1361 if {$rescan_active > 0 || ![lock_index read]} return
1363 repository_state newType newHEAD newMERGE_HEAD
1364 if {[string match amend* $commit_type]
1365 && $newType eq {normal}
1366 && $newHEAD eq $HEAD} {
1370 set MERGE_HEAD $newMERGE_HEAD
1371 set commit_type $newType
1374 array unset file_states
1376 if {!$::GITGUI_BCK_exists &&
1377 (![$ui_comm edit modified]
1378 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1379 if {[string match amend* $commit_type]} {
1380 } elseif {[load_message GITGUI_MSG]} {
1381 } elseif {[run_prepare_commit_msg_hook]} {
1382 } elseif {[load_message MERGE_MSG]} {
1383 } elseif {[load_message SQUASH_MSG]} {
1386 $ui_comm edit modified false
1389 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1390 rescan_stage2 {} $after
1393 ui_status [mc "Refreshing file status..."]
1394 set fd_rf [git_read update-index \
1400 fconfigure $fd_rf -blocking 0 -translation binary
1401 fileevent $fd_rf readable \
1402 [list rescan_stage2 $fd_rf $after]
1407 set is_git_info_exclude {}
1408 proc have_info_exclude {} {
1409 global is_git_info_exclude
1411 if {$is_git_info_exclude eq {}} {
1412 if {[catch {exec test -f [gitdir info exclude]}]} {
1413 set is_git_info_exclude 0
1415 set is_git_info_exclude 1
1418 return $is_git_info_exclude
1421 proc have_info_exclude {} {
1422 return [file readable [gitdir info exclude]]
1426 proc rescan_stage2 {fd after} {
1427 global rescan_active buf_rdi buf_rdf buf_rlo
1431 if {![eof $fd]} return
1435 set ls_others [list --exclude-per-directory=.gitignore]
1436 if {[have_info_exclude]} {
1437 lappend ls_others "--exclude-from=[gitdir info exclude]"
1439 set user_exclude [get_config core.excludesfile]
1440 if {$user_exclude ne {} && [file readable $user_exclude]} {
1441 lappend ls_others "--exclude-from=$user_exclude"
1449 ui_status [mc "Scanning for modified files ..."]
1450 set fd_di [git_read diff-index --cached -z [PARENT]]
1451 set fd_df [git_read diff-files -z]
1452 set fd_lo [eval git_read ls-files --others -z $ls_others]
1454 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1455 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1456 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1457 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1458 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1459 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1462 proc load_message {file} {
1465 set f [gitdir $file]
1466 if {[file isfile $f]} {
1467 if {[catch {set fd [open $f r]}]} {
1470 fconfigure $fd -eofchar {}
1471 set content [string trim [read $fd]]
1473 regsub -all -line {[ \r\t]+$} $content {} content
1474 $ui_comm delete 0.0 end
1475 $ui_comm insert end $content
1481 proc run_prepare_commit_msg_hook {} {
1484 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1485 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1486 # empty file but existant file.
1488 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1490 if {[file isfile [gitdir MERGE_MSG]]} {
1491 set pcm_source "merge"
1492 set fd_mm [open [gitdir MERGE_MSG] r]
1493 puts -nonewline $fd_pcm [read $fd_mm]
1495 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1496 set pcm_source "squash"
1497 set fd_sm [open [gitdir SQUASH_MSG] r]
1498 puts -nonewline $fd_pcm [read $fd_sm]
1506 set fd_ph [githook_read prepare-commit-msg \
1507 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1509 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1513 ui_status [mc "Calling prepare-commit-msg hook..."]
1516 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1517 fileevent $fd_ph readable \
1518 [list prepare_commit_msg_hook_wait $fd_ph]
1523 proc prepare_commit_msg_hook_wait {fd_ph} {
1526 append pch_error [read $fd_ph]
1527 fconfigure $fd_ph -blocking 1
1529 if {[catch {close $fd_ph}]} {
1530 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1531 hook_failed_popup prepare-commit-msg $pch_error
1532 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1535 load_message PREPARE_COMMIT_MSG
1538 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1541 fconfigure $fd_ph -blocking 0
1542 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1545 proc read_diff_index {fd after} {
1548 append buf_rdi [read $fd]
1550 set n [string length $buf_rdi]
1552 set z1 [string first "\0" $buf_rdi $c]
1553 if {$z1 == -1} break
1555 set z2 [string first "\0" $buf_rdi $z1]
1556 if {$z2 == -1} break
1559 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1560 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1562 [encoding convertfrom $p] \
1564 [list [lindex $i 0] [lindex $i 2]] \
1570 set buf_rdi [string range $buf_rdi $c end]
1575 rescan_done $fd buf_rdi $after
1578 proc read_diff_files {fd after} {
1581 append buf_rdf [read $fd]
1583 set n [string length $buf_rdf]
1585 set z1 [string first "\0" $buf_rdf $c]
1586 if {$z1 == -1} break
1588 set z2 [string first "\0" $buf_rdf $z1]
1589 if {$z2 == -1} break
1592 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1593 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1595 [encoding convertfrom $p] \
1598 [list [lindex $i 0] [lindex $i 2]]
1603 set buf_rdf [string range $buf_rdf $c end]
1608 rescan_done $fd buf_rdf $after
1611 proc read_ls_others {fd after} {
1614 append buf_rlo [read $fd]
1615 set pck [split $buf_rlo "\0"]
1616 set buf_rlo [lindex $pck end]
1617 foreach p [lrange $pck 0 end-1] {
1618 set p [encoding convertfrom $p]
1619 if {[string index $p end] eq {/}} {
1620 set p [string range $p 0 end-1]
1624 rescan_done $fd buf_rlo $after
1627 proc rescan_done {fd buf after} {
1628 global rescan_active current_diff_path
1629 global file_states repo_config
1632 if {![eof $fd]} return
1635 if {[incr rescan_active -1] > 0} return
1640 if {$current_diff_path ne {}} { reshow_diff $after }
1641 if {$current_diff_path eq {}} { select_first_diff $after }
1644 proc prune_selection {} {
1645 global file_states selected_paths
1647 foreach path [array names selected_paths] {
1648 if {[catch {set still_here $file_states($path)}]} {
1649 unset selected_paths($path)
1654 ######################################################################
1658 proc mapicon {w state path} {
1661 if {[catch {set r $all_icons($state$w)}]} {
1662 puts "error: no icon for $w state={$state} $path"
1668 proc mapdesc {state path} {
1671 if {[catch {set r $all_descs($state)}]} {
1672 puts "error: no desc for state={$state} $path"
1678 proc ui_status {msg} {
1680 if {[info exists main_status]} {
1681 $main_status show $msg
1685 proc ui_ready {{test {}}} {
1687 if {[info exists main_status]} {
1688 $main_status show [mc "Ready."] $test
1692 proc escape_path {path} {
1693 regsub -all {\\} $path "\\\\" path
1694 regsub -all "\n" $path "\\n" path
1698 proc short_path {path} {
1699 return [escape_path [lindex [file split $path] end]]
1703 set null_sha1 [string repeat 0 40]
1705 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1706 global file_states next_icon_id null_sha1
1708 set s0 [string index $new_state 0]
1709 set s1 [string index $new_state 1]
1711 if {[catch {set info $file_states($path)}]} {
1713 set icon n[incr next_icon_id]
1715 set state [lindex $info 0]
1716 set icon [lindex $info 1]
1717 if {$head_info eq {}} {set head_info [lindex $info 2]}
1718 if {$index_info eq {}} {set index_info [lindex $info 3]}
1721 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1722 elseif {$s0 eq {_}} {set s0 _}
1724 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1725 elseif {$s1 eq {_}} {set s1 _}
1727 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1728 set head_info [list 0 $null_sha1]
1729 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1730 && $head_info eq {}} {
1731 set head_info $index_info
1732 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1733 set index_info $head_info
1737 set file_states($path) [list $s0$s1 $icon \
1738 $head_info $index_info \
1743 proc display_file_helper {w path icon_name old_m new_m} {
1746 if {$new_m eq {_}} {
1747 set lno [lsearch -sorted -exact $file_lists($w) $path]
1749 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1751 $w conf -state normal
1752 $w delete $lno.0 [expr {$lno + 1}].0
1753 $w conf -state disabled
1755 } elseif {$old_m eq {_} && $new_m ne {_}} {
1756 lappend file_lists($w) $path
1757 set file_lists($w) [lsort -unique $file_lists($w)]
1758 set lno [lsearch -sorted -exact $file_lists($w) $path]
1760 $w conf -state normal
1761 $w image create $lno.0 \
1762 -align center -padx 5 -pady 1 \
1764 -image [mapicon $w $new_m $path]
1765 $w insert $lno.1 "[escape_path $path]\n"
1766 $w conf -state disabled
1767 } elseif {$old_m ne $new_m} {
1768 $w conf -state normal
1769 $w image conf $icon_name -image [mapicon $w $new_m $path]
1770 $w conf -state disabled
1774 proc display_file {path state} {
1775 global file_states selected_paths
1776 global ui_index ui_workdir
1778 set old_m [merge_state $path $state]
1779 set s $file_states($path)
1780 set new_m [lindex $s 0]
1781 set icon_name [lindex $s 1]
1783 set o [string index $old_m 0]
1784 set n [string index $new_m 0]
1791 display_file_helper $ui_index $path $icon_name $o $n
1793 if {[string index $old_m 0] eq {U}} {
1796 set o [string index $old_m 1]
1798 if {[string index $new_m 0] eq {U}} {
1801 set n [string index $new_m 1]
1803 display_file_helper $ui_workdir $path $icon_name $o $n
1805 if {$new_m eq {__}} {
1806 unset file_states($path)
1807 catch {unset selected_paths($path)}
1811 proc display_all_files_helper {w path icon_name m} {
1814 lappend file_lists($w) $path
1815 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1816 $w image create end \
1817 -align center -padx 5 -pady 1 \
1819 -image [mapicon $w $m $path]
1820 $w insert end "[escape_path $path]\n"
1824 proc display_all_files {} {
1825 global ui_index ui_workdir
1826 global file_states file_lists
1828 global files_warning
1830 $ui_index conf -state normal
1831 $ui_workdir conf -state normal
1833 $ui_index delete 0.0 end
1834 $ui_workdir delete 0.0 end
1837 set file_lists($ui_index) [list]
1838 set file_lists($ui_workdir) [list]
1840 set to_display [lsort [array names file_states]]
1841 set display_limit [get_config gui.maxfilesdisplayed]
1842 if {[llength $to_display] > $display_limit} {
1843 if {!$files_warning} {
1844 # do not repeatedly warn:
1846 info_popup [mc "Displaying only %s of %s files." \
1847 $display_limit [llength $to_display]]
1849 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1851 foreach path $to_display {
1852 set s $file_states($path)
1854 set icon_name [lindex $s 1]
1856 set s [string index $m 0]
1857 if {$s ne {U} && $s ne {_}} {
1858 display_all_files_helper $ui_index $path \
1862 if {[string index $m 0] eq {U}} {
1865 set s [string index $m 1]
1868 display_all_files_helper $ui_workdir $path \
1873 $ui_index conf -state disabled
1874 $ui_workdir conf -state disabled
1877 ######################################################################
1882 #define mask_width 14
1883 #define mask_height 15
1884 static unsigned char mask_bits[] = {
1885 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1886 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1887 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1890 image create bitmap file_plain -background white -foreground black -data {
1891 #define plain_width 14
1892 #define plain_height 15
1893 static unsigned char plain_bits[] = {
1894 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1895 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1896 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1897 } -maskdata $filemask
1899 image create bitmap file_mod -background white -foreground blue -data {
1900 #define mod_width 14
1901 #define mod_height 15
1902 static unsigned char mod_bits[] = {
1903 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1904 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1905 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1906 } -maskdata $filemask
1908 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1909 #define file_fulltick_width 14
1910 #define file_fulltick_height 15
1911 static unsigned char file_fulltick_bits[] = {
1912 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1913 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1914 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1915 } -maskdata $filemask
1917 image create bitmap file_question -background white -foreground black -data {
1918 #define file_question_width 14
1919 #define file_question_height 15
1920 static unsigned char file_question_bits[] = {
1921 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1922 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1923 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1924 } -maskdata $filemask
1926 image create bitmap file_removed -background white -foreground red -data {
1927 #define file_removed_width 14
1928 #define file_removed_height 15
1929 static unsigned char file_removed_bits[] = {
1930 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1931 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1932 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1933 } -maskdata $filemask
1935 image create bitmap file_merge -background white -foreground blue -data {
1936 #define file_merge_width 14
1937 #define file_merge_height 15
1938 static unsigned char file_merge_bits[] = {
1939 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1940 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1941 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1942 } -maskdata $filemask
1944 image create bitmap file_statechange -background white -foreground green -data {
1945 #define file_merge_width 14
1946 #define file_merge_height 15
1947 static unsigned char file_statechange_bits[] = {
1948 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1949 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1950 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1951 } -maskdata $filemask
1953 set ui_index .vpane.files.index.list
1954 set ui_workdir .vpane.files.workdir.list
1956 set all_icons(_$ui_index) file_plain
1957 set all_icons(A$ui_index) file_plain
1958 set all_icons(M$ui_index) file_fulltick
1959 set all_icons(D$ui_index) file_removed
1960 set all_icons(U$ui_index) file_merge
1961 set all_icons(T$ui_index) file_statechange
1963 set all_icons(_$ui_workdir) file_plain
1964 set all_icons(M$ui_workdir) file_mod
1965 set all_icons(D$ui_workdir) file_question
1966 set all_icons(U$ui_workdir) file_merge
1967 set all_icons(O$ui_workdir) file_plain
1968 set all_icons(T$ui_workdir) file_statechange
1970 set max_status_desc 0
1972 {__ {mc "Unmodified"}}
1974 {_M {mc "Modified, not staged"}}
1975 {M_ {mc "Staged for commit"}}
1976 {MM {mc "Portions staged for commit"}}
1977 {MD {mc "Staged for commit, missing"}}
1979 {_T {mc "File type changed, not staged"}}
1980 {T_ {mc "File type changed, staged"}}
1982 {_O {mc "Untracked, not staged"}}
1983 {A_ {mc "Staged for commit"}}
1984 {AM {mc "Portions staged for commit"}}
1985 {AD {mc "Staged for commit, missing"}}
1988 {D_ {mc "Staged for removal"}}
1989 {DO {mc "Staged for removal, still present"}}
1991 {_U {mc "Requires merge resolution"}}
1992 {U_ {mc "Requires merge resolution"}}
1993 {UU {mc "Requires merge resolution"}}
1994 {UM {mc "Requires merge resolution"}}
1995 {UD {mc "Requires merge resolution"}}
1996 {UT {mc "Requires merge resolution"}}
1998 set text [eval [lindex $i 1]]
1999 if {$max_status_desc < [string length $text]} {
2000 set max_status_desc [string length $text]
2002 set all_descs([lindex $i 0]) $text
2006 ######################################################################
2010 proc scrollbar2many {list mode args} {
2011 foreach w $list {eval $w $mode $args}
2014 proc many2scrollbar {list mode sb top bottom} {
2015 $sb set $top $bottom
2016 foreach w $list {$w $mode moveto $top}
2019 proc incr_font_size {font {amt 1}} {
2020 set sz [font configure $font -size]
2022 font configure $font -size $sz
2023 font configure ${font}bold -size $sz
2024 font configure ${font}italic -size $sz
2027 ######################################################################
2031 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2033 proc do_gitk {revs {is_submodule false}} {
2034 global current_diff_path file_states current_diff_side ui_index
2035 global _gitdir _gitworktree
2037 # -- Always start gitk through whatever we were loaded with. This
2038 # lets us bypass using shell process on Windows systems.
2040 set exe [_which gitk -script]
2041 set cmd [list [info nameofexecutable] $exe]
2043 error_popup [mc "Couldn't find gitk in PATH"]
2049 if {!$is_submodule} {
2054 cd $current_diff_path
2055 if {$revs eq {--}} {
2056 set s $file_states($current_diff_path)
2059 switch -glob -- [lindex $s 0] {
2060 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2061 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2063 if {$current_diff_side eq $ui_index} {
2064 set old_sha1 [lindex [lindex $s 2] 1]
2065 set new_sha1 [lindex [lindex $s 3] 1]
2067 set old_sha1 [lindex [lindex $s 3] 1]
2071 set revs $old_sha1...$new_sha1
2073 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2074 # we've been using for the main repository, so unset them.
2075 # TODO we could make life easier (start up faster?) for gitk
2076 # by setting these to the appropriate values to allow gitk
2077 # to skip the heuristics to find their proper value
2079 unset env(GIT_WORK_TREE)
2081 eval exec $cmd $revs "--" "--" &
2083 set env(GIT_DIR) $_gitdir
2084 set env(GIT_WORK_TREE) $_gitworktree
2087 ui_status $::starting_gitk_msg
2089 ui_ready $starting_gitk_msg
2094 proc do_git_gui {} {
2095 global current_diff_path
2097 # -- Always start git gui through whatever we were loaded with. This
2098 # lets us bypass using shell process on Windows systems.
2100 set exe [list [_which git]]
2102 error_popup [mc "Couldn't find git gui in PATH"]
2105 global _gitdir _gitworktree
2107 # see note in do_gitk about unsetting these vars when
2108 # running tools in a submodule
2110 unset env(GIT_WORK_TREE)
2113 cd $current_diff_path
2115 eval exec $exe gui &
2117 set env(GIT_DIR) $_gitdir
2118 set env(GIT_WORK_TREE) $_gitworktree
2121 ui_status $::starting_gitk_msg
2123 ui_ready $starting_gitk_msg
2128 proc do_explore {} {
2131 if {[is_Cygwin] || [is_Windows]} {
2132 set explorer "explorer.exe"
2133 } elseif {[is_MacOSX]} {
2136 # freedesktop.org-conforming system is our best shot
2137 set explorer "xdg-open"
2139 eval exec $explorer [list [file nativename $_gitworktree]] &
2145 proc terminate_me {win} {
2147 if {$win ne {.}} return
2151 proc do_quit {{rc {1}}} {
2152 global ui_comm is_quitting repo_config commit_type
2153 global GITGUI_BCK_exists GITGUI_BCK_i
2154 global ui_comm_spell
2155 global ret_code use_ttk
2157 if {$is_quitting} return
2160 if {[winfo exists $ui_comm]} {
2161 # -- Stash our current commit buffer.
2163 set save [gitdir GITGUI_MSG]
2164 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2165 file rename -force [gitdir GITGUI_BCK] $save
2166 set GITGUI_BCK_exists 0
2168 set msg [string trim [$ui_comm get 0.0 end]]
2169 regsub -all -line {[ \r\t]+$} $msg {} msg
2170 if {(![string match amend* $commit_type]
2171 || [$ui_comm edit modified])
2174 set fd [open $save w]
2175 puts -nonewline $fd $msg
2179 catch {file delete $save}
2183 # -- Cancel our spellchecker if its running.
2185 if {[info exists ui_comm_spell]} {
2189 # -- Remove our editor backup, its not needed.
2191 after cancel $GITGUI_BCK_i
2192 if {$GITGUI_BCK_exists} {
2193 catch {file delete [gitdir GITGUI_BCK]}
2196 # -- Stash our current window geometry into this repository.
2198 set cfg_wmstate [wm state .]
2199 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2202 if {$cfg_wmstate ne $rc_wmstate} {
2203 catch {git config gui.wmstate $cfg_wmstate}
2205 if {$cfg_wmstate eq {zoomed}} {
2206 # on Windows wm geometry will lie about window
2207 # position (but not size) when window is zoomed
2208 # restore the window before querying wm geometry
2211 set cfg_geometry [list]
2212 lappend cfg_geometry [wm geometry .]
2214 lappend cfg_geometry [.vpane sashpos 0]
2215 lappend cfg_geometry [.vpane.files sashpos 0]
2217 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2218 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2220 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2223 if {$cfg_geometry ne $rc_geometry} {
2224 catch {git config gui.geometry $cfg_geometry}
2230 # Briefly enable send again, working around Tk bug
2231 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2232 tk appname [appname]
2241 proc ui_do_rescan {} {
2242 rescan {force_first_diff ui_ready}
2249 proc next_diff {{after {}}} {
2250 global next_diff_p next_diff_w next_diff_i
2251 show_diff $next_diff_p $next_diff_w {} {} $after
2254 proc find_anchor_pos {lst name} {
2255 set lid [lsearch -sorted -exact $lst $name]
2259 foreach lname $lst {
2260 if {$lname >= $name} break
2268 proc find_file_from {flist idx delta path mmask} {
2271 set len [llength $flist]
2272 while {$idx >= 0 && $idx < $len} {
2273 set name [lindex $flist $idx]
2275 if {$name ne $path && [info exists file_states($name)]} {
2276 set state [lindex $file_states($name) 0]
2278 if {$mmask eq {} || [regexp $mmask $state]} {
2289 proc find_next_diff {w path {lno {}} {mmask {}}} {
2290 global next_diff_p next_diff_w next_diff_i
2291 global file_lists ui_index ui_workdir
2293 set flist $file_lists($w)
2295 set lno [find_anchor_pos $flist $path]
2300 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2301 if {$w eq $ui_index} {
2304 set mmask "$mmask\$"
2308 set idx [find_file_from $flist $lno 1 $path $mmask]
2311 set idx [find_file_from $flist $lno -1 $path $mmask]
2316 set next_diff_p [lindex $flist $idx]
2317 set next_diff_i [expr {$idx+1}]
2324 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2325 global current_diff_path
2327 if {$path ne $current_diff_path} {
2329 } elseif {[find_next_diff $w $path $lno $mmask]} {
2332 return {reshow_diff;}
2336 proc select_first_diff {after} {
2339 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2340 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2347 proc force_first_diff {after} {
2348 global ui_workdir current_diff_path file_states
2350 if {[info exists file_states($current_diff_path)]} {
2351 set state [lindex $file_states($current_diff_path) 0]
2357 if {[string first {U} $state] >= 0} {
2358 # Already a conflict, do nothing
2359 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2361 } elseif {[string index $state 1] ne {O}} {
2362 # Already a diff & no conflicts, do nothing
2363 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2374 proc toggle_or_diff {w x y} {
2375 global file_states file_lists current_diff_path ui_index ui_workdir
2376 global last_clicked selected_paths
2378 set pos [split [$w index @$x,$y] .]
2379 set lno [lindex $pos 0]
2380 set col [lindex $pos 1]
2381 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2387 set last_clicked [list $w $lno]
2388 array unset selected_paths
2389 $ui_index tag remove in_sel 0.0 end
2390 $ui_workdir tag remove in_sel 0.0 end
2392 # Determine the state of the file
2393 if {[info exists file_states($path)]} {
2394 set state [lindex $file_states($path) 0]
2399 # Restage the file, or simply show the diff
2400 if {$col == 0 && $y > 1} {
2401 # Conflicts need special handling
2402 if {[string first {U} $state] >= 0} {
2403 # $w must always be $ui_workdir, but...
2404 if {$w ne $ui_workdir} { set lno {} }
2405 merge_stage_workdir $path $lno
2409 if {[string index $state 1] eq {O}} {
2415 set after [next_diff_after_action $w $path $lno $mmask]
2417 if {$w eq $ui_index} {
2419 "Unstaging [short_path $path] from commit" \
2421 [concat $after [list ui_ready]]
2422 } elseif {$w eq $ui_workdir} {
2424 "Adding [short_path $path]" \
2426 [concat $after [list ui_ready]]
2429 show_diff $path $w $lno
2433 proc add_one_to_selection {w x y} {
2434 global file_lists last_clicked selected_paths
2436 set lno [lindex [split [$w index @$x,$y] .] 0]
2437 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2443 if {$last_clicked ne {}
2444 && [lindex $last_clicked 0] ne $w} {
2445 array unset selected_paths
2446 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2449 set last_clicked [list $w $lno]
2450 if {[catch {set in_sel $selected_paths($path)}]} {
2454 unset selected_paths($path)
2455 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2457 set selected_paths($path) 1
2458 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2462 proc add_range_to_selection {w x y} {
2463 global file_lists last_clicked selected_paths
2465 if {[lindex $last_clicked 0] ne $w} {
2466 toggle_or_diff $w $x $y
2470 set lno [lindex [split [$w index @$x,$y] .] 0]
2471 set lc [lindex $last_clicked 1]
2480 foreach path [lrange $file_lists($w) \
2481 [expr {$begin - 1}] \
2482 [expr {$end - 1}]] {
2483 set selected_paths($path) 1
2485 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2488 proc show_more_context {} {
2490 if {$repo_config(gui.diffcontext) < 99} {
2491 incr repo_config(gui.diffcontext)
2496 proc show_less_context {} {
2498 if {$repo_config(gui.diffcontext) > 1} {
2499 incr repo_config(gui.diffcontext) -1
2504 ######################################################################
2512 menu .mbar -tearoff 0
2514 # -- Apple Menu (Mac OS X only)
2516 .mbar add cascade -label Apple -menu .mbar.apple
2519 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2520 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2521 if {[is_enabled branch]} {
2522 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2524 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2525 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2527 if {[is_enabled transport]} {
2528 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2529 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2531 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2532 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2535 # -- Repository Menu
2537 menu .mbar.repository
2540 .mbar.repository add command \
2541 -label [mc "Explore Working Copy"] \
2542 -command {do_explore}
2543 .mbar.repository add separator
2546 .mbar.repository add command \
2547 -label [mc "Browse Current Branch's Files"] \
2548 -command {browser::new $current_branch}
2549 set ui_browse_current [.mbar.repository index last]
2550 .mbar.repository add command \
2551 -label [mc "Browse Branch Files..."] \
2552 -command browser_open::dialog
2553 .mbar.repository add separator
2555 .mbar.repository add command \
2556 -label [mc "Visualize Current Branch's History"] \
2557 -command {do_gitk $current_branch}
2558 set ui_visualize_current [.mbar.repository index last]
2559 .mbar.repository add command \
2560 -label [mc "Visualize All Branch History"] \
2561 -command {do_gitk --all}
2562 .mbar.repository add separator
2564 proc current_branch_write {args} {
2565 global current_branch
2566 .mbar.repository entryconf $::ui_browse_current \
2567 -label [mc "Browse %s's Files" $current_branch]
2568 .mbar.repository entryconf $::ui_visualize_current \
2569 -label [mc "Visualize %s's History" $current_branch]
2571 trace add variable current_branch write current_branch_write
2573 if {[is_enabled multicommit]} {
2574 .mbar.repository add command -label [mc "Database Statistics"] \
2577 .mbar.repository add command -label [mc "Compress Database"] \
2580 .mbar.repository add command -label [mc "Verify Database"] \
2581 -command do_fsck_objects
2583 .mbar.repository add separator
2586 .mbar.repository add command \
2587 -label [mc "Create Desktop Icon"] \
2588 -command do_cygwin_shortcut
2589 } elseif {[is_Windows]} {
2590 .mbar.repository add command \
2591 -label [mc "Create Desktop Icon"] \
2592 -command do_windows_shortcut
2593 } elseif {[is_MacOSX]} {
2594 .mbar.repository add command \
2595 -label [mc "Create Desktop Icon"] \
2596 -command do_macosx_app
2601 proc ::tk::mac::Quit {args} { do_quit }
2603 .mbar.repository add command -label [mc Quit] \
2611 .mbar.edit add command -label [mc Undo] \
2612 -command {catch {[focus] edit undo}} \
2614 .mbar.edit add command -label [mc Redo] \
2615 -command {catch {[focus] edit redo}} \
2617 .mbar.edit add separator
2618 .mbar.edit add command -label [mc Cut] \
2619 -command {catch {tk_textCut [focus]}} \
2621 .mbar.edit add command -label [mc Copy] \
2622 -command {catch {tk_textCopy [focus]}} \
2624 .mbar.edit add command -label [mc Paste] \
2625 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2627 .mbar.edit add command -label [mc Delete] \
2628 -command {catch {[focus] delete sel.first sel.last}} \
2630 .mbar.edit add separator
2631 .mbar.edit add command -label [mc "Select All"] \
2632 -command {catch {[focus] tag add sel 0.0 end}} \
2637 if {[is_enabled branch]} {
2640 .mbar.branch add command -label [mc "Create..."] \
2641 -command branch_create::dialog \
2643 lappend disable_on_lock [list .mbar.branch entryconf \
2644 [.mbar.branch index last] -state]
2646 .mbar.branch add command -label [mc "Checkout..."] \
2647 -command branch_checkout::dialog \
2649 lappend disable_on_lock [list .mbar.branch entryconf \
2650 [.mbar.branch index last] -state]
2652 .mbar.branch add command -label [mc "Rename..."] \
2653 -command branch_rename::dialog
2654 lappend disable_on_lock [list .mbar.branch entryconf \
2655 [.mbar.branch index last] -state]
2657 .mbar.branch add command -label [mc "Delete..."] \
2658 -command branch_delete::dialog
2659 lappend disable_on_lock [list .mbar.branch entryconf \
2660 [.mbar.branch index last] -state]
2662 .mbar.branch add command -label [mc "Reset..."] \
2663 -command merge::reset_hard
2664 lappend disable_on_lock [list .mbar.branch entryconf \
2665 [.mbar.branch index last] -state]
2670 proc commit_btn_caption {} {
2671 if {[is_enabled nocommit]} {
2674 return [mc Commit@@verb]
2678 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2681 if {![is_enabled nocommit]} {
2682 .mbar.commit add radiobutton \
2683 -label [mc "New Commit"] \
2684 -command do_select_commit_type \
2685 -variable selected_commit_type \
2687 lappend disable_on_lock \
2688 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2690 .mbar.commit add radiobutton \
2691 -label [mc "Amend Last Commit"] \
2692 -command do_select_commit_type \
2693 -variable selected_commit_type \
2695 lappend disable_on_lock \
2696 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2698 .mbar.commit add separator
2701 .mbar.commit add command -label [mc Rescan] \
2702 -command ui_do_rescan \
2704 lappend disable_on_lock \
2705 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2707 .mbar.commit add command -label [mc "Stage To Commit"] \
2708 -command do_add_selection \
2710 lappend disable_on_lock \
2711 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2713 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2714 -command do_add_all \
2716 lappend disable_on_lock \
2717 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2719 .mbar.commit add command -label [mc "Unstage From Commit"] \
2720 -command do_unstage_selection \
2722 lappend disable_on_lock \
2723 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2725 .mbar.commit add command -label [mc "Revert Changes"] \
2726 -command do_revert_selection \
2728 lappend disable_on_lock \
2729 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2731 .mbar.commit add separator
2733 .mbar.commit add command -label [mc "Show Less Context"] \
2734 -command show_less_context \
2735 -accelerator $M1T-\-
2737 .mbar.commit add command -label [mc "Show More Context"] \
2738 -command show_more_context \
2741 .mbar.commit add separator
2743 if {![is_enabled nocommitmsg]} {
2744 .mbar.commit add command -label [mc "Sign Off"] \
2745 -command do_signoff \
2749 .mbar.commit add command -label [commit_btn_caption] \
2750 -command do_commit \
2751 -accelerator $M1T-Return
2752 lappend disable_on_lock \
2753 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2758 if {[is_enabled branch]} {
2760 .mbar.merge add command -label [mc "Local Merge..."] \
2761 -command merge::dialog \
2763 lappend disable_on_lock \
2764 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2765 .mbar.merge add command -label [mc "Abort Merge..."] \
2766 -command merge::reset_hard
2767 lappend disable_on_lock \
2768 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2773 if {[is_enabled transport]} {
2776 .mbar.remote add command \
2777 -label [mc "Add..."] \
2778 -command remote_add::dialog \
2780 .mbar.remote add command \
2781 -label [mc "Push..."] \
2782 -command do_push_anywhere \
2784 .mbar.remote add command \
2785 -label [mc "Delete Branch..."] \
2786 -command remote_branch_delete::dialog
2790 proc ::tk::mac::ShowPreferences {} {do_options}
2794 .mbar.edit add separator
2795 .mbar.edit add command -label [mc "Options..."] \
2801 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2802 set tools_menubar .mbar.tools
2804 $tools_menubar add separator
2805 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2806 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2808 if {[array names repo_config guitool.*.cmd] ne {}} {
2815 .mbar add cascade -label [mc Help] -menu .mbar.help
2819 .mbar.apple add command -label [mc "About %s" [appname]] \
2821 .mbar.apple add separator
2823 .mbar.help add command -label [mc "About %s" [appname]] \
2826 . configure -menu .mbar
2828 set doc_path [githtmldir]
2829 if {$doc_path ne {}} {
2830 set doc_path [file join $doc_path index.html]
2833 set doc_path [exec cygpath --mixed $doc_path]
2837 if {[file isfile $doc_path]} {
2838 set doc_url "file:$doc_path"
2840 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2843 proc start_browser {url} {
2844 git "web--browse" $url
2847 .mbar.help add command -label [mc "Online Documentation"] \
2848 -command [list start_browser $doc_url]
2850 .mbar.help add command -label [mc "Show SSH Key"] \
2853 unset doc_path doc_url
2855 # -- Standard bindings
2857 wm protocol . WM_DELETE_WINDOW do_quit
2858 bind all <$M1B-Key-q> do_quit
2859 bind all <$M1B-Key-Q> do_quit
2860 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2861 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2863 set subcommand_args {}
2865 set s "usage: $::argv0 $::subcommand $::subcommand_args"
2866 if {[tk windowingsystem] eq "win32"} {
2868 tk_messageBox -icon info -message $s \
2876 proc normalize_relpath {path} {
2878 foreach item [file split $path] {
2879 if {$item eq {.}} continue
2880 if {$item eq {..} && [llength $elements] > 0
2881 && [lindex $elements end] ne {..}} {
2882 set elements [lrange $elements 0 end-1]
2885 lappend elements $item
2887 return [eval file join $elements]
2890 # -- Not a normal commit type invocation? Do that instead!
2892 switch -- $subcommand {
2895 if {$subcommand eq "blame"} {
2896 set subcommand_args {[--line=<num>] rev? path}
2898 set subcommand_args {rev? path}
2900 if {$argv eq {}} usage
2906 if {$is_path || [file exists $_prefix$a]} {
2907 if {$path ne {}} usage
2908 set path [normalize_relpath $_prefix$a]
2910 } elseif {$a eq {--}} {
2912 if {$head ne {}} usage
2917 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2918 if {$jump_spec ne {} || $head ne {}} usage
2919 set jump_spec [list $lnum]
2920 } elseif {$head eq {}} {
2921 if {$head ne {}} usage
2930 if {$head ne {} && $path eq {}} {
2931 set path [normalize_relpath $_prefix$head]
2938 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2940 set head [git rev-parse --verify $head]
2942 if {[tk windowingsystem] eq "win32"} {
2943 tk_messageBox -icon error -title [mc Error] -message $err
2950 set current_branch $head
2954 switch -- $subcommand {
2956 if {$jump_spec ne {}} usage
2958 if {$path ne {} && [file isdirectory $path]} {
2959 set head $current_branch
2965 browser::new $head $path
2968 if {$head eq {} && ![file exists $path]} {
2969 catch {wm withdraw .}
2973 -title [mc "git-gui: fatal error"] \
2974 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
2977 blame::new $head $path $jump_spec
2984 if {[llength $argv] != 0} {
2987 # fall through to setup UI for commits
2990 set err "usage: $argv0 \[{blame|browser|citool}\]"
2991 if {[tk windowingsystem] eq "win32"} {
2993 tk_messageBox -icon error -message $err \
3004 ${NS}::frame .branch
3005 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3006 ${NS}::label .branch.l1 \
3007 -text [mc "Current Branch:"] \
3010 ${NS}::label .branch.cb \
3011 -textvariable current_branch \
3014 pack .branch.l1 -side left
3015 pack .branch.cb -side left -fill x
3016 pack .branch -side top -fill x
3018 # -- Main Window Layout
3020 ${NS}::panedwindow .vpane -orient horizontal
3021 ${NS}::panedwindow .vpane.files -orient vertical
3023 .vpane add .vpane.files
3025 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3027 pack .vpane -anchor n -side top -fill both -expand 1
3029 # -- Index File List
3031 ${NS}::frame .vpane.files.index -height 100 -width 200
3032 tlabel .vpane.files.index.title \
3033 -text [mc "Staged Changes (Will Commit)"] \
3034 -background lightgreen -foreground black
3035 text $ui_index -background white -foreground black \
3037 -width 20 -height 10 \
3039 -cursor $cursor_ptr \
3040 -xscrollcommand {.vpane.files.index.sx set} \
3041 -yscrollcommand {.vpane.files.index.sy set} \
3043 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3044 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3045 pack .vpane.files.index.title -side top -fill x
3046 pack .vpane.files.index.sx -side bottom -fill x
3047 pack .vpane.files.index.sy -side right -fill y
3048 pack $ui_index -side left -fill both -expand 1
3050 # -- Working Directory File List
3052 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3053 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3054 -background lightsalmon -foreground black
3055 text $ui_workdir -background white -foreground black \
3057 -width 20 -height 10 \
3059 -cursor $cursor_ptr \
3060 -xscrollcommand {.vpane.files.workdir.sx set} \
3061 -yscrollcommand {.vpane.files.workdir.sy set} \
3063 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3064 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3065 pack .vpane.files.workdir.title -side top -fill x
3066 pack .vpane.files.workdir.sx -side bottom -fill x
3067 pack .vpane.files.workdir.sy -side right -fill y
3068 pack $ui_workdir -side left -fill both -expand 1
3070 .vpane.files add .vpane.files.workdir
3071 .vpane.files add .vpane.files.index
3073 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3074 .vpane.files paneconfigure .vpane.files.index -sticky news
3077 foreach i [list $ui_index $ui_workdir] {
3079 $i tag conf in_diff -background [$i tag cget in_sel -background]
3083 # -- Diff and Commit Area
3085 ${NS}::frame .vpane.lower -height 300 -width 400
3086 ${NS}::frame .vpane.lower.commarea
3087 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3088 pack .vpane.lower.diff -fill both -expand 1
3089 pack .vpane.lower.commarea -side bottom -fill x
3090 .vpane add .vpane.lower
3091 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3093 # -- Commit Area Buttons
3095 ${NS}::frame .vpane.lower.commarea.buttons
3096 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3099 pack .vpane.lower.commarea.buttons.l -side top -fill x
3100 pack .vpane.lower.commarea.buttons -side left -fill y
3102 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3103 -command ui_do_rescan
3104 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3105 lappend disable_on_lock \
3106 {.vpane.lower.commarea.buttons.rescan conf -state}
3108 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3110 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3111 lappend disable_on_lock \
3112 {.vpane.lower.commarea.buttons.incall conf -state}
3114 if {![is_enabled nocommitmsg]} {
3115 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3117 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3120 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3122 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3123 lappend disable_on_lock \
3124 {.vpane.lower.commarea.buttons.commit conf -state}
3126 if {![is_enabled nocommit]} {
3127 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3128 -command do_push_anywhere
3129 pack .vpane.lower.commarea.buttons.push -side top -fill x
3132 # -- Commit Message Buffer
3134 ${NS}::frame .vpane.lower.commarea.buffer
3135 ${NS}::frame .vpane.lower.commarea.buffer.header
3136 set ui_comm .vpane.lower.commarea.buffer.t
3137 set ui_coml .vpane.lower.commarea.buffer.header.l
3139 if {![is_enabled nocommit]} {
3140 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3141 -text [mc "New Commit"] \
3142 -command do_select_commit_type \
3143 -variable selected_commit_type \
3145 lappend disable_on_lock \
3146 [list .vpane.lower.commarea.buffer.header.new conf -state]
3147 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3148 -text [mc "Amend Last Commit"] \
3149 -command do_select_commit_type \
3150 -variable selected_commit_type \
3152 lappend disable_on_lock \
3153 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3156 ${NS}::label $ui_coml \
3159 proc trace_commit_type {varname args} {
3160 global ui_coml commit_type
3161 switch -glob -- $commit_type {
3162 initial {set txt [mc "Initial Commit Message:"]}
3163 amend {set txt [mc "Amended Commit Message:"]}
3164 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3165 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3166 merge {set txt [mc "Merge Commit Message:"]}
3167 * {set txt [mc "Commit Message:"]}
3169 $ui_coml conf -text $txt
3171 trace add variable commit_type write trace_commit_type
3172 pack $ui_coml -side left -fill x
3174 if {![is_enabled nocommit]} {
3175 pack .vpane.lower.commarea.buffer.header.amend -side right
3176 pack .vpane.lower.commarea.buffer.header.new -side right
3179 text $ui_comm -background white -foreground black \
3183 -autoseparators true \
3185 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3187 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3188 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3189 -command [list $ui_comm yview]
3190 pack .vpane.lower.commarea.buffer.header -side top -fill x
3191 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3192 pack $ui_comm -side left -fill y
3193 pack .vpane.lower.commarea.buffer -side left -fill y
3195 # -- Commit Message Buffer Context Menu
3197 set ctxm .vpane.lower.commarea.buffer.ctxm
3198 menu $ctxm -tearoff 0
3201 -command {tk_textCut $ui_comm}
3204 -command {tk_textCopy $ui_comm}
3207 -command {tk_textPaste $ui_comm}
3209 -label [mc Delete] \
3210 -command {catch {$ui_comm delete sel.first sel.last}}
3213 -label [mc "Select All"] \
3214 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3216 -label [mc "Copy All"] \
3218 $ui_comm tag add sel 0.0 end
3219 tk_textCopy $ui_comm
3220 $ui_comm tag remove sel 0.0 end
3224 -label [mc "Sign Off"] \
3226 set ui_comm_ctxm $ctxm
3230 proc trace_current_diff_path {varname args} {
3231 global current_diff_path diff_actions file_states
3232 if {$current_diff_path eq {}} {
3238 set p $current_diff_path
3239 set s [mapdesc [lindex $file_states($p) 0] $p]
3241 set p [escape_path $p]
3245 .vpane.lower.diff.header.status configure -text $s
3246 .vpane.lower.diff.header.file configure -text $f
3247 .vpane.lower.diff.header.path configure -text $p
3248 foreach w $diff_actions {
3252 trace add variable current_diff_path write trace_current_diff_path
3254 gold_frame .vpane.lower.diff.header
3255 tlabel .vpane.lower.diff.header.status \
3258 -width $max_status_desc \
3261 tlabel .vpane.lower.diff.header.file \
3266 tlabel .vpane.lower.diff.header.path \
3271 pack .vpane.lower.diff.header.status -side left
3272 pack .vpane.lower.diff.header.file -side left
3273 pack .vpane.lower.diff.header.path -fill x
3274 set ctxm .vpane.lower.diff.header.ctxm
3275 menu $ctxm -tearoff 0
3283 -- $current_diff_path
3285 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3286 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3290 ${NS}::frame .vpane.lower.diff.body
3291 set ui_diff .vpane.lower.diff.body.t
3292 text $ui_diff -background white -foreground black \
3294 -width 80 -height 5 -wrap none \
3296 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3297 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3299 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3300 -command [list $ui_diff xview]
3301 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3302 -command [list $ui_diff yview]
3303 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3304 pack .vpane.lower.diff.body.sby -side right -fill y
3305 pack $ui_diff -side left -fill both -expand 1
3306 pack .vpane.lower.diff.header -side top -fill x
3307 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3309 $ui_diff tag conf d_cr -elide true
3310 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
3311 $ui_diff tag conf d_+ -foreground {#00a000}
3312 $ui_diff tag conf d_- -foreground red
3314 $ui_diff tag conf d_++ -foreground {#00a000}
3315 $ui_diff tag conf d_-- -foreground red
3316 $ui_diff tag conf d_+s \
3317 -foreground {#00a000} \
3318 -background {#e2effa}
3319 $ui_diff tag conf d_-s \
3321 -background {#e2effa}
3322 $ui_diff tag conf d_s+ \
3323 -foreground {#00a000} \
3325 $ui_diff tag conf d_s- \
3329 $ui_diff tag conf d<<<<<<< \
3330 -foreground orange \
3332 $ui_diff tag conf d======= \
3333 -foreground orange \
3335 $ui_diff tag conf d>>>>>>> \
3336 -foreground orange \
3339 $ui_diff tag raise sel
3341 # -- Diff Body Context Menu
3344 proc create_common_diff_popup {ctxm} {
3346 -label [mc Refresh] \
3347 -command reshow_diff
3348 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3351 -command {tk_textCopy $ui_diff}
3352 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3354 -label [mc "Select All"] \
3355 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3356 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3358 -label [mc "Copy All"] \
3360 $ui_diff tag add sel 0.0 end
3361 tk_textCopy $ui_diff
3362 $ui_diff tag remove sel 0.0 end
3364 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3367 -label [mc "Decrease Font Size"] \
3368 -command {incr_font_size font_diff -1}
3369 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3371 -label [mc "Increase Font Size"] \
3372 -command {incr_font_size font_diff 1}
3373 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3377 build_encoding_menu $emenu [list force_diff_encoding]
3379 -label [mc "Encoding"] \
3381 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3383 $ctxm add command -label [mc "Options..."] \
3387 set ctxm .vpane.lower.diff.body.ctxm
3388 menu $ctxm -tearoff 0
3390 -label [mc "Apply/Reverse Hunk"] \
3391 -command {apply_hunk $cursorX $cursorY}
3392 set ui_diff_applyhunk [$ctxm index last]
3393 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3395 -label [mc "Apply/Reverse Line"] \
3396 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3397 set ui_diff_applyline [$ctxm index last]
3398 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3401 -label [mc "Show Less Context"] \
3402 -command show_less_context
3403 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3405 -label [mc "Show More Context"] \
3406 -command show_more_context
3407 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3409 create_common_diff_popup $ctxm
3411 set ctxmmg .vpane.lower.diff.body.ctxmmg
3412 menu $ctxmmg -tearoff 0
3413 $ctxmmg add command \
3414 -label [mc "Run Merge Tool"] \
3415 -command {merge_resolve_tool}
3416 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3417 $ctxmmg add separator
3418 $ctxmmg add command \
3419 -label [mc "Use Remote Version"] \
3420 -command {merge_resolve_one 3}
3421 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3422 $ctxmmg add command \
3423 -label [mc "Use Local Version"] \
3424 -command {merge_resolve_one 2}
3425 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3426 $ctxmmg add command \
3427 -label [mc "Revert To Base"] \
3428 -command {merge_resolve_one 1}
3429 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3430 $ctxmmg add separator
3431 $ctxmmg add command \
3432 -label [mc "Show Less Context"] \
3433 -command show_less_context
3434 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3435 $ctxmmg add command \
3436 -label [mc "Show More Context"] \
3437 -command show_more_context
3438 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3439 $ctxmmg add separator
3440 create_common_diff_popup $ctxmmg
3442 set ctxmsm .vpane.lower.diff.body.ctxmsm
3443 menu $ctxmsm -tearoff 0
3444 $ctxmsm add command \
3445 -label [mc "Visualize These Changes In The Submodule"] \
3446 -command {do_gitk -- true}
3447 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3448 $ctxmsm add command \
3449 -label [mc "Visualize Current Branch History In The Submodule"] \
3450 -command {do_gitk {} true}
3451 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3452 $ctxmsm add command \
3453 -label [mc "Visualize All Branch History In The Submodule"] \
3454 -command {do_gitk --all true}
3455 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3456 $ctxmsm add separator
3457 $ctxmsm add command \
3458 -label [mc "Start git gui In The Submodule"] \
3459 -command {do_git_gui}
3460 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3461 $ctxmsm add separator
3462 create_common_diff_popup $ctxmsm
3464 proc has_textconv {path} {
3465 if {[is_config_false gui.textconv]} {
3468 set filter [gitattr $path diff set]
3469 set textconv [get_config [join [list diff $filter textconv] .]]
3470 if {$filter ne {set} && $textconv ne {}} {
3477 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3478 global current_diff_path file_states
3481 if {[info exists file_states($current_diff_path)]} {
3482 set state [lindex $file_states($current_diff_path) 0]
3486 if {[string first {U} $state] >= 0} {
3487 tk_popup $ctxmmg $X $Y
3488 } elseif {$::is_submodule_diff} {
3489 tk_popup $ctxmsm $X $Y
3491 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3492 if {$::ui_index eq $::current_diff_side} {
3493 set l [mc "Unstage Hunk From Commit"]
3495 set t [mc "Unstage Lines From Commit"]
3497 set t [mc "Unstage Line From Commit"]
3500 set l [mc "Stage Hunk For Commit"]
3502 set t [mc "Stage Lines For Commit"]
3504 set t [mc "Stage Line For Commit"]
3508 || $current_diff_path eq {}
3513 || [has_textconv $current_diff_path]} {
3518 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3519 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3520 tk_popup $ctxm $X $Y
3523 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3527 set main_status [::status_bar::new .status]
3528 pack .status -anchor w -side bottom -fill x
3529 $main_status show [mc "Initializing..."]
3533 proc on_ttk_pane_mapped {w pane pos} {
3535 after 0 [list after idle [list $w sashpos $pane $pos]]
3537 proc on_tk_pane_mapped {w pane x y} {
3539 after 0 [list after idle [list $w sash place $pane $x $y]]
3541 proc on_application_mapped {} {
3542 global repo_config use_ttk
3544 set gm $repo_config(gui.geometry)
3547 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3548 bind .vpane.files <Map> \
3549 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3552 [list on_tk_pane_mapped %W 0 \
3554 [lindex [.vpane sash coord 0] 1]]
3555 bind .vpane.files <Map> \
3556 [list on_tk_pane_mapped %W 0 \
3557 [lindex [.vpane.files sash coord 0] 0] \
3560 wm geometry . [lindex $gm 0]
3562 if {[info exists repo_config(gui.geometry)]} {
3563 bind . <Map> [list on_application_mapped]
3564 wm geometry . [lindex $repo_config(gui.geometry) 0]
3567 # -- Load window state
3569 if {[info exists repo_config(gui.wmstate)]} {
3570 catch {wm state . $repo_config(gui.wmstate)}
3575 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3576 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3577 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3578 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3579 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3580 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3581 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3582 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3583 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3584 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3585 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3586 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3587 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3588 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3589 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3590 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3591 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3592 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3593 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3594 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3595 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3596 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3598 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3599 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3600 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3601 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3602 bind $ui_diff <$M1B-Key-v> {break}
3603 bind $ui_diff <$M1B-Key-V> {break}
3604 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3605 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3606 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3607 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3608 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3609 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3610 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3611 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3612 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3613 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3614 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3615 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3616 bind $ui_diff <Button-1> {focus %W}
3618 if {[is_enabled branch]} {
3619 bind . <$M1B-Key-n> branch_create::dialog
3620 bind . <$M1B-Key-N> branch_create::dialog
3621 bind . <$M1B-Key-o> branch_checkout::dialog
3622 bind . <$M1B-Key-O> branch_checkout::dialog
3623 bind . <$M1B-Key-m> merge::dialog
3624 bind . <$M1B-Key-M> merge::dialog
3626 if {[is_enabled transport]} {
3627 bind . <$M1B-Key-p> do_push_anywhere
3628 bind . <$M1B-Key-P> do_push_anywhere
3631 bind . <Key-F5> ui_do_rescan
3632 bind . <$M1B-Key-r> ui_do_rescan
3633 bind . <$M1B-Key-R> ui_do_rescan
3634 bind . <$M1B-Key-s> do_signoff
3635 bind . <$M1B-Key-S> do_signoff
3636 bind . <$M1B-Key-t> do_add_selection
3637 bind . <$M1B-Key-T> do_add_selection
3638 bind . <$M1B-Key-j> do_revert_selection
3639 bind . <$M1B-Key-J> do_revert_selection
3640 bind . <$M1B-Key-i> do_add_all
3641 bind . <$M1B-Key-I> do_add_all
3642 bind . <$M1B-Key-minus> {show_less_context;break}
3643 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3644 bind . <$M1B-Key-equal> {show_more_context;break}
3645 bind . <$M1B-Key-plus> {show_more_context;break}
3646 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3647 bind . <$M1B-Key-Return> do_commit
3648 foreach i [list $ui_index $ui_workdir] {
3649 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3650 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3651 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3655 set file_lists($ui_index) [list]
3656 set file_lists($ui_workdir) [list]
3658 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3659 focus -force $ui_comm
3661 # -- Warn the user about environmental problems. Cygwin's Tcl
3662 # does *not* pass its env array onto any processes it spawns.
3663 # This means that git processes get none of our environment.
3668 set msg [mc "Possible environment issues exist.
3670 The following environment variables are probably
3671 going to be ignored by any Git subprocess run
3675 foreach name [array names env] {
3676 switch -regexp -- $name {
3677 {^GIT_INDEX_FILE$} -
3678 {^GIT_OBJECT_DIRECTORY$} -
3679 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3681 {^GIT_EXTERNAL_DIFF$} -
3685 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3686 append msg " - $name\n"
3689 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3690 append msg " - $name\n"
3692 set suggest_user $name
3696 if {$ignored_env > 0} {
3698 This is due to a known issue with the
3699 Tcl binary distributed by Cygwin."]
3701 if {$suggest_user ne {}} {
3704 A good replacement for %s
3705 is placing values for the user.name and
3706 user.email settings into your personal
3712 unset ignored_env msg suggest_user name
3715 # -- Only initialize complex UI if we are going to stay running.
3717 if {[is_enabled transport]} {
3720 set n [.mbar.remote index end]
3721 populate_remotes_menu
3722 set n [expr {[.mbar.remote index end] - $n}]
3724 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3725 .mbar.remote insert $n separator
3730 if {[winfo exists $ui_comm]} {
3731 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3733 # -- If both our backup and message files exist use the
3734 # newer of the two files to initialize the buffer.
3736 if {$GITGUI_BCK_exists} {
3737 set m [gitdir GITGUI_MSG]
3738 if {[file isfile $m]} {
3739 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3740 catch {file delete [gitdir GITGUI_MSG]}
3742 $ui_comm delete 0.0 end
3744 $ui_comm edit modified false
3745 catch {file delete [gitdir GITGUI_BCK]}
3746 set GITGUI_BCK_exists 0
3752 proc backup_commit_buffer {} {
3753 global ui_comm GITGUI_BCK_exists
3755 set m [$ui_comm edit modified]
3756 if {$m || $GITGUI_BCK_exists} {
3757 set msg [string trim [$ui_comm get 0.0 end]]
3758 regsub -all -line {[ \r\t]+$} $msg {} msg
3761 if {$GITGUI_BCK_exists} {
3762 catch {file delete [gitdir GITGUI_BCK]}
3763 set GITGUI_BCK_exists 0
3767 set fd [open [gitdir GITGUI_BCK] w]
3768 puts -nonewline $fd $msg
3770 set GITGUI_BCK_exists 1
3774 $ui_comm edit modified false
3777 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3780 backup_commit_buffer
3782 # -- If the user has aspell available we can drive it
3783 # in pipe mode to spellcheck the commit message.
3785 set spell_cmd [list |]
3786 set spell_dict [get_config gui.spellingdictionary]
3787 lappend spell_cmd aspell
3788 if {$spell_dict ne {}} {
3789 lappend spell_cmd --master=$spell_dict
3791 lappend spell_cmd --mode=none
3792 lappend spell_cmd --encoding=utf-8
3793 lappend spell_cmd pipe
3794 if {$spell_dict eq {none}
3795 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3796 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3798 set ui_comm_spell [spellcheck::init \
3804 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3807 lock_index begin-read
3808 if {![winfo ismapped .]} {
3812 if {[is_enabled initialamend]} {
3818 if {[is_enabled nocommitmsg]} {
3819 $ui_comm configure -state disabled -background gray
3822 if {[is_enabled multicommit]} {
3825 if {[is_enabled retcode]} {
3826 bind . <Destroy> {+terminate_me %W}
3828 if {$picked && [is_config_true gui.autoexplore]} {
3834 # indent-tabs-mode: t