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 "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
}
131 set _shellpath
{@@SHELL_PATH@@
}
133 set _trace
[lsearch
-exact $argv --trace]
135 set argv
[lreplace
$argv $_trace $_trace]
156 return [eval [list
file join $_gitdir] $args]
159 proc gitexec
{args
} {
161 if {$_gitexec eq
{}} {
162 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
163 error
"Git not installed?\n\n$err"
166 set _gitexec
[exec cygpath \
171 set _gitexec
[file normalize
$_gitexec]
177 return [eval [list
file join $_gitexec] $args]
180 proc githtmldir
{args
} {
182 if {$_githtmldir eq
{}} {
183 if {[catch
{set _githtmldir
[git
--html-path]}]} {
184 # Git not installed or option not yet supported
188 set _githtmldir
[exec cygpath \
193 set _githtmldir
[file normalize
$_githtmldir]
199 return [eval [list
file join $_githtmldir] $args]
207 if {[tk windowingsystem
] eq
{aqua
}} {
214 if {$
::tcl_platform
(platform
) eq
{windows
}} {
222 if {$_iscygwin eq
{}} {
223 if {$
::tcl_platform
(platform
) eq
{windows
}} {
224 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
236 proc is_enabled
{option
} {
237 global enabled_options
238 if {[catch
{set on
$enabled_options($option)}]} {return 0}
242 proc enable_option
{option
} {
243 global enabled_options
244 set enabled_options
($option) 1
247 proc disable_option
{option
} {
248 global enabled_options
249 set enabled_options
($option) 0
252 ######################################################################
256 proc is_many_config
{name
} {
257 switch
-glob -- $name {
267 proc is_config_true
{name
} {
269 if {[catch
{set v
$repo_config($name)}]} {
271 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
278 proc is_config_false
{name
} {
280 if {[catch
{set v
$repo_config($name)}]} {
282 } elseif
{$v eq
{false
} ||
$v eq
{0} ||
$v eq
{no
}} {
289 proc get_config
{name
} {
291 if {[catch
{set v
$repo_config($name)}]} {
303 if {$_isbare eq
{}} {
305 set _bare
[git rev-parse
--is-bare-repository]
307 true
{ set _isbare
1 }
308 false
{ set _isbare
0}
312 if {[is_config_true core.bare
]
313 ||
($_gitworktree eq
{}
314 && [lindex
[file split $_gitdir] end
] ne
{.git
})} {
324 ######################################################################
328 proc _trace_exec
{cmd
} {
329 if {!$
::_trace
} return
335 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
343 #'" fix poor old emacs font-lock mode
345 proc _git_cmd {name} {
348 if {[catch {set v $_git_cmd_path($name)}]} {
352 --exec-path { return [list $::_git $name] }
355 set p [gitexec git-$name$::_search_exe]
356 if {[file exists $p]} {
358 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
359 # Try to determine what sort of magic will make
360 # git-$name go and do its thing, because native
361 # Tcl on Windows doesn't know it.
363 set p [gitexec git-$name]
368 switch -glob -- [lindex $s 0] {
370 #!*perl { set i perl }
371 #!*python { set i python }
372 default { error "git-
$name is not supported
: $s" }
376 if {![info exists interp]} {
377 set interp [_which $i]
380 error "git-
$name requires
$i (not
in PATH
)"
382 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
384 # Assume it is builtin to git somehow and we
385 # aren't actually able to see a file for it.
387 set v [list $::_git $name]
389 set _git_cmd_path($name) $v
394 proc _which {what args} {
395 global env _search_exe _search_path
397 if {$_search_path eq {}} {
398 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
399 set _search_path [split [exec cygpath \
405 } elseif {[is_Windows]} {
406 set gitguidir [file dirname [info script]]
407 regsub -all ";" $gitguidir "\\;" gitguidir
408 set env(PATH) "$gitguidir;$env(PATH
)"
409 set _search_path [split $env(PATH) {;}]
412 set _search_path [split $env(PATH) :]
417 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
420 set suffix $_search_exe
423 foreach p $_search_path {
424 set p [file join $p $what$suffix]
425 if {[file exists $p]} {
426 return [file normalize $p]
432 proc _lappend_nice {cmd_var} {
436 if {![info exists _nice]} {
437 set _nice [_which nice]
438 if {[catch {exec $_nice git version}]} {
451 switch -- [lindex $args 0] {
462 set args [lrange $args 1 end]
465 set cmdp [_git_cmd [lindex $args 0]]
466 set args [lrange $args 1 end]
468 _trace_exec [concat $opt $cmdp $args]
469 set result [eval exec $opt $cmdp $args]
471 puts stderr "< $result"
476 proc _open_stdout_stderr {cmd} {
479 set fd [open [concat [list | ] $cmd] r]
481 if { [lindex $cmd end] eq {2>@1}
482 && $err eq {can not find channel named "1"}
484 # Older versions of Tcl 8.4 don't have this 2>@1 IO
485 # redirect operator. Fallback to |& cat for those.
486 # The command was not actually started, so its safe
487 # to try to start it a second time.
489 set fd [open [concat \
491 [lrange $cmd 0 end-1] \
498 fconfigure $fd -eofchar {}
502 proc git_read {args} {
506 switch -- [lindex $args 0] {
521 set args [lrange $args 1 end]
524 set cmdp [_git_cmd [lindex $args 0]]
525 set args [lrange $args 1 end]
527 return [_open_stdout_stderr [concat $opt $cmdp $args]]
530 proc git_write {args} {
534 switch -- [lindex $args 0] {
545 set args [lrange $args 1 end]
548 set cmdp [_git_cmd [lindex $args 0]]
549 set args [lrange $args 1 end]
551 _trace_exec [concat $opt $cmdp $args]
552 return [open [concat [list | ] $opt $cmdp $args] w]
555 proc githook_read {hook_name args} {
556 set pchook [gitdir hooks $hook_name]
559 # On Windows [file executable] might lie so we need to ask
560 # the shell if the hook is executable. Yes that's annoying.
564 if {![info exists interp]} {
565 set interp [_which sh]
568 error "hook execution requires sh
(not
in PATH
)"
571 set scr {if test -x "$1";then exec "$@
";fi}
572 set sh_c [list $interp -c $scr $interp $pchook]
573 return [_open_stdout_stderr [concat $sh_c $args]]
576 if {[file executable $pchook]} {
577 return [_open_stdout_stderr [concat [list $pchook] $args]]
583 proc kill_file_process {fd} {
584 set process [pid $fd]
588 # Use a Cygwin-specific flag to allow killing
589 # native Windows processes
590 exec kill -f $process
597 proc gitattr {path attr default} {
598 if {[catch {set r [git check-attr $attr -- $path]}]} {
601 set r [join [lrange [split $r :] 2 end] :]
604 if {$r eq {unspecified}} {
611 regsub -all ' $value "'\\''" value
615 proc load_current_branch {} {
616 global current_branch is_detached
618 set fd [open [gitdir HEAD] r]
619 if {[gets $fd ref] < 1} {
624 set pfx {ref: refs/heads/}
625 set len [string length $pfx]
626 if {[string equal -length $len $pfx $ref]} {
627 # We're on a branch. It might not exist. But
628 # HEAD looks good enough to be a branch.
630 set current_branch
[string range
$ref $len end
]
633 # Assume this is a detached head.
635 set current_branch HEAD
640 auto_load tk_optionMenu
641 rename tk_optionMenu real__tkOptionMenu
642 proc tk_optionMenu
{w varName args
} {
643 set m
[eval real__tkOptionMenu
$w $varName $args]
644 $m configure
-font font_ui
645 $w configure
-font font_ui
649 proc rmsel_tag
{text
} {
651 -background [$text cget
-background] \
652 -foreground [$text cget
-foreground] \
654 $text tag conf in_sel
-background lightgray
655 bind $text <Motion
> break
661 bind .
<Visibility
> {
662 bind .
<Visibility
> {}
667 wm iconbitmap .
-default $oguilib/git-gui.ico
668 set ::tk
::AlwaysShowSelection
1
670 # Spoof an X11 display for SSH
671 if {![info exists env
(DISPLAY
)]} {
672 set env
(DISPLAY
) :9999
676 image create photo gitlogo
-width 16 -height 16
678 gitlogo put
#33CC33 -to 7 0 9 2
679 gitlogo put
#33CC33 -to 4 2 12 4
680 gitlogo put
#33CC33 -to 7 4 9 6
681 gitlogo put
#CC3333 -to 4 6 12 8
682 gitlogo put gray26
-to 4 9 6 10
683 gitlogo put gray26
-to 3 10 6 12
684 gitlogo put gray26
-to 8 9 13 11
685 gitlogo put gray26
-to 8 11 10 12
686 gitlogo put gray26
-to 11 11 13 14
687 gitlogo put gray26
-to 3 12 5 14
688 gitlogo put gray26
-to 5 13
689 gitlogo put gray26
-to 10 13
690 gitlogo put gray26
-to 4 14 12 15
691 gitlogo put gray26
-to 5 15 11 16
694 wm iconphoto .
-default gitlogo
698 ######################################################################
704 if {[lsearch
-exact [font names
] TkDefaultFont
] != -1} {
705 eval [linsert
[font actual TkDefaultFont
] 0 font configure font_ui
]
706 eval [linsert
[font actual TkFixedFont
] 0 font create font_diff
]
708 font create font_diff
-family Courier
-size 10
711 eval font configure font_ui
[font actual
[.dummy cget
-font]]
716 font create font_uiitalic
717 font create font_uibold
718 font create font_diffbold
719 font create font_diffitalic
721 foreach class
{Button Checkbutton Entry Label
722 Labelframe Listbox Message
723 Radiobutton Spinbox Text
} {
724 option add
*$class.font font_ui
727 option add
*Menu.font font_ui
728 option add
*Entry.borderWidth
1 startupFile
729 option add
*Entry.relief sunken startupFile
730 option add
*RadioButton.anchor w startupFile
734 if {[is_Windows
] ||
[is_MacOSX
]} {
735 option add
*Menu.tearOff
0
746 proc bind_button3
{w cmd
} {
747 bind $w <Any-Button-3
> $cmd
749 # Mac OS X sends Button-2 on right click through three-button mouse,
750 # or through trackpad right-clicking (two-finger touch + click).
751 bind $w <Any-Button-2
> $cmd
752 bind $w <Control-Button-1
> $cmd
756 proc apply_config
{} {
757 global repo_config font_descs
759 foreach option
$font_descs {
760 set name
[lindex
$option 0]
761 set font
[lindex
$option 1]
764 foreach
{cn cv
} $repo_config(gui.
$name) {
765 if {$cn eq
{-weight}} {
768 font configure
$font $cn $cv
771 font configure
$font -weight normal
774 error_popup
[strcat
[mc
"Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
776 foreach
{cn cv
} [font configure
$font] {
777 font configure
${font}bold
$cn $cv
778 font configure
${font}italic
$cn $cv
780 font configure
${font}bold
-weight bold
781 font configure
${font}italic
-slant italic
787 if {$repo_config(gui.usettk
)} {
788 set use_ttk
[package vsatisfies
[package provide Tk
] 8.5]
791 bind [winfo class .
] <<ThemeChanged>> [list InitTheme]
797 set default_config(branch.autosetupmerge) true
798 set default_config(merge.tool) {}
799 set default_config(mergetool.keepbackup) true
800 set default_config(merge.diffstat) true
801 set default_config(merge.summary) false
802 set default_config(merge.verbosity) 2
803 set default_config(user.name) {}
804 set default_config(user.email) {}
806 set default_config(gui.encoding) [encoding system]
807 set default_config(gui.matchtrackingbranch) false
808 set default_config(gui.textconv) true
809 set default_config(gui.pruneduringfetch) false
810 set default_config(gui.trustmtime) false
811 set default_config(gui.fastcopyblame) false
812 set default_config(gui.copyblamethreshold) 40
813 set default_config(gui.blamehistoryctx) 7
814 set default_config(gui.diffcontext) 5
815 set default_config(gui.commitmsgwidth) 75
816 set default_config(gui.newbranchtemplate) {}
817 set default_config(gui.spellingdictionary) {}
818 set default_config(gui.fontui) [font configure font_ui]
819 set default_config(gui.fontdiff) [font configure font_diff]
820 # TODO: this option should be added to the git-config documentation
821 set default_config(gui.maxfilesdisplayed) 5000
822 set default_config(gui.usettk) 1
824 {fontui font_ui {mc "Main Font"}}
825 {fontdiff font_diff {mc "Diff/Console Font"}}
828 ######################################################################
832 set _git [_which git]
834 catch {wm withdraw .}
838 -title [mc "git-gui: fatal error"] \
839 -message [mc "Cannot find git in PATH."]
843 ######################################################################
847 if {[catch {set _git_version [git --version]} err]} {
848 catch {wm withdraw .}
852 -title [mc "git-gui: fatal error"] \
853 -message "Cannot determine Git version:
857 [appname] requires Git 1.5.0 or later."
860 if {![regsub {^git version } $_git_version {} _git_version]} {
861 catch {wm withdraw .}
865 -title [mc "git-gui: fatal error"] \
866 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
870 set _real_git_version $_git_version
871 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
872 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
873 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
874 regsub {\.GIT$} $_git_version {} _git_version
875 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
877 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
878 catch {wm withdraw .}
883 -title "[appname]: warning" \
884 -message [mc "Git version cannot be determined.
886 %s claims it is version '%s'.
888 %s requires at least Git 1.5.0 or later.
890 Assume '%s' is version 1.5.0?
891 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
892 set _git_version 1.5.0
897 unset _real_git_version
899 proc git-version {args} {
902 switch [llength $args] {
908 set op [lindex $args 0]
909 set vr [lindex $args 1]
910 set cm [package vcompare $_git_version $vr]
911 return [expr $cm $op 0]
915 set type [lindex $args 0]
916 set name [lindex $args 1]
917 set parm [lindex $args 2]
918 set body [lindex $args 3]
920 if {($type ne {proc} && $type ne {method})} {
921 error "Invalid arguments to git-version"
923 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
924 error "Last arm of $type $name must be default"
927 foreach {op vr cb} [lrange $body 0 end-2] {
928 if {[git-version $op $vr]} {
929 return [uplevel [list $type $name $parm $cb]]
933 return [uplevel [list $type $name $parm [lindex $body end]]]
937 error "git-version >= x"
943 if {[git-version < 1.5]} {
944 catch {wm withdraw .}
948 -title [mc "git-gui: fatal error"] \
949 -message "[appname] requires Git 1.5.0 or later.
951 You are using [git-version]:
957 ######################################################################
959 ## configure our library
961 set idx [file join $oguilib tclIndex]
962 if {[catch {set fd [open $idx r]} err]} {
963 catch {wm withdraw .}
967 -title [mc "git-gui: fatal error"] \
971 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
973 while {[gets $fd n] >= 0} {
974 if {$n ne {} && ![string match #* $n]} {
986 if {[lsearch -exact $loaded $p] >= 0} continue
987 source [file join $oguilib $p]
992 set auto_path [concat [list $oguilib] $auto_path]
994 unset -nocomplain idx fd
996 ######################################################################
998 ## config file parsing
1000 git-version proc _parse_config {arr_name args} {
1007 [list git_read config] \
1009 [list --null --list]]
1010 fconfigure $fd_rc -translation binary
1011 set buf [read $fd_rc]
1014 foreach line [split $buf "\0"] {
1015 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1016 if {[is_many_config $name]} {
1017 lappend arr($name) $value
1019 set arr($name) $value
1028 set fd_rc [eval [list git_read config --list] $args]
1029 while {[gets $fd_rc line] >= 0} {
1030 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1031 if {[is_many_config $name]} {
1032 lappend arr($name) $value
1034 set arr($name) $value
1043 proc load_config {include_global} {
1044 global repo_config global_config system_config default_config
1046 if {$include_global} {
1047 _parse_config system_config --system
1048 _parse_config global_config --global
1050 _parse_config repo_config
1052 foreach name [array names default_config] {
1053 if {[catch {set v $system_config($name)}]} {
1054 set system_config($name) $default_config($name)
1057 foreach name [array names system_config] {
1058 if {[catch {set v $global_config($name)}]} {
1059 set global_config($name) $system_config($name)
1061 if {[catch {set v $repo_config($name)}]} {
1062 set repo_config($name) $system_config($name)
1067 ######################################################################
1069 ## feature option selection
1071 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1076 if {$subcommand eq {gui.sh}} {
1079 if {$subcommand eq {gui} && [llength $argv] > 0} {
1080 set subcommand [lindex $argv 0]
1081 set argv [lrange $argv 1 end]
1084 enable_option multicommit
1085 enable_option branch
1086 enable_option transport
1089 switch -- $subcommand {
1094 disable_option multicommit
1095 disable_option branch
1096 disable_option transport
1099 enable_option singlecommit
1100 enable_option retcode
1102 disable_option multicommit
1103 disable_option branch
1104 disable_option transport
1106 while {[llength $argv] > 0} {
1107 set a [lindex $argv 0]
1110 enable_option initialamend
1113 enable_option nocommit
1114 enable_option nocommitmsg
1117 disable_option nocommitmsg
1124 set argv [lrange $argv 1 end]
1129 ######################################################################
1131 ## execution environment
1133 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1135 # Suggest our implementation of askpass, if none is set
1136 if {![info exists env(SSH_ASKPASS)]} {
1137 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1140 ######################################################################
1146 set _gitdir $env(GIT_DIR)
1150 # beware that from the .git dir this sets _gitdir to .
1151 # and _prefix to the empty string
1152 set _gitdir [git rev-parse --git-dir]
1153 set _prefix [git rev-parse --show-prefix]
1157 choose_repository::pick
1161 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1162 # run from the .git dir itself) lest the routines to find the worktree
1164 if {$_gitdir eq "."} {
1168 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1169 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1171 if {![file isdirectory $_gitdir]} {
1172 catch {wm withdraw .}
1173 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1176 # _gitdir exists, so try loading the config
1179 # try to set work tree from environment, falling back to core.worktree
1180 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1181 set _gitworktree [get_config core.worktree]
1182 if {$_gitworktree eq ""} {
1183 set _gitworktree [file dirname [file normalize $_gitdir]]
1186 if {$_prefix ne {}} {
1187 if {$_gitworktree eq {}} {
1188 regsub -all {[^/]+/} $_prefix ../ cdup
1190 set cdup $_gitworktree
1192 if {[catch {cd $cdup} err]} {
1193 catch {wm withdraw .}
1194 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1197 set _gitworktree [pwd]
1199 } elseif {![is_enabled bare]} {
1201 catch {wm withdraw .}
1202 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1205 if {$_gitworktree eq {}} {
1206 set _gitworktree [file dirname $_gitdir]
1208 if {[catch {cd $_gitworktree} err]} {
1209 catch {wm withdraw .}
1210 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1213 set _gitworktree [pwd]
1215 set _reponame [file split [file normalize $_gitdir]]
1216 if {[lindex $_reponame end] eq {.git}} {
1217 set _reponame [lindex $_reponame end-1]
1219 set _reponame [lindex $_reponame end]
1222 set env(GIT_DIR) $_gitdir
1223 set env(GIT_WORK_TREE) $_gitworktree
1225 ######################################################################
1229 set current_diff_path {}
1230 set current_diff_side {}
1231 set diff_actions [list]
1235 set MERGE_HEAD [list]
1238 set current_branch {}
1240 set current_diff_path {}
1242 set is_submodule_diff 0
1243 set is_conflict_diff 0
1244 set selected_commit_type new
1245 set diff_empty_count 0
1247 set nullid "0000000000000000000000000000000000000000"
1248 set nullid2 "0000000000000000000000000000000000000001"
1250 ######################################################################
1258 set disable_on_lock [list]
1259 set index_lock_type none
1261 proc lock_index {type} {
1262 global index_lock_type disable_on_lock
1264 if {$index_lock_type eq {none}} {
1265 set index_lock_type $type
1266 foreach w $disable_on_lock {
1267 uplevel #0 $w disabled
1270 } elseif {$index_lock_type eq "begin-$type"} {
1271 set index_lock_type $type
1277 proc unlock_index {} {
1278 global index_lock_type disable_on_lock
1280 set index_lock_type none
1281 foreach w $disable_on_lock {
1282 uplevel #0 $w normal
1286 ######################################################################
1290 proc repository_state {ctvar hdvar mhvar} {
1291 global current_branch
1292 upvar $ctvar ct $hdvar hd $mhvar mh
1297 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1303 set merge_head [gitdir MERGE_HEAD]
1304 if {[file exists $merge_head]} {
1306 set fd_mh [open $merge_head r]
1307 while {[gets $fd_mh line] >= 0} {
1318 global PARENT empty_tree
1320 set p [lindex $PARENT 0]
1324 if {$empty_tree eq {}} {
1325 set empty_tree [git mktree << {}]
1330 proc force_amend {} {
1331 global selected_commit_type
1332 global HEAD PARENT MERGE_HEAD commit_type
1334 repository_state newType newHEAD newMERGE_HEAD
1337 set MERGE_HEAD $newMERGE_HEAD
1338 set commit_type $newType
1340 set selected_commit_type amend
1341 do_select_commit_type
1344 proc rescan {after {honor_trustmtime 1}} {
1345 global HEAD PARENT MERGE_HEAD commit_type
1346 global ui_index ui_workdir ui_comm
1347 global rescan_active file_states
1350 if {$rescan_active > 0 || ![lock_index read]} return
1352 repository_state newType newHEAD newMERGE_HEAD
1353 if {[string match amend* $commit_type]
1354 && $newType eq {normal}
1355 && $newHEAD eq $HEAD} {
1359 set MERGE_HEAD $newMERGE_HEAD
1360 set commit_type $newType
1363 array unset file_states
1365 if {!$::GITGUI_BCK_exists &&
1366 (![$ui_comm edit modified]
1367 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1368 if {[string match amend* $commit_type]} {
1369 } elseif {[load_message GITGUI_MSG]} {
1370 } elseif {[run_prepare_commit_msg_hook]} {
1371 } elseif {[load_message MERGE_MSG]} {
1372 } elseif {[load_message SQUASH_MSG]} {
1375 $ui_comm edit modified false
1378 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1379 rescan_stage2 {} $after
1382 ui_status [mc "Refreshing file status..."]
1383 set fd_rf [git_read update-index \
1389 fconfigure $fd_rf -blocking 0 -translation binary
1390 fileevent $fd_rf readable \
1391 [list rescan_stage2 $fd_rf $after]
1396 set is_git_info_exclude {}
1397 proc have_info_exclude {} {
1398 global is_git_info_exclude
1400 if {$is_git_info_exclude eq {}} {
1401 if {[catch {exec test -f [gitdir info exclude]}]} {
1402 set is_git_info_exclude 0
1404 set is_git_info_exclude 1
1407 return $is_git_info_exclude
1410 proc have_info_exclude {} {
1411 return [file readable [gitdir info exclude]]
1415 proc rescan_stage2 {fd after} {
1416 global rescan_active buf_rdi buf_rdf buf_rlo
1420 if {![eof $fd]} return
1424 set ls_others [list --exclude-per-directory=.gitignore]
1425 if {[have_info_exclude]} {
1426 lappend ls_others "--exclude-from=[gitdir info exclude]"
1428 set user_exclude [get_config core.excludesfile]
1429 if {$user_exclude ne {} && [file readable $user_exclude]} {
1430 lappend ls_others "--exclude-from=$user_exclude"
1438 ui_status [mc "Scanning for modified files ..."]
1439 set fd_di [git_read diff-index --cached -z [PARENT]]
1440 set fd_df [git_read diff-files -z]
1441 set fd_lo [eval git_read ls-files --others -z $ls_others]
1443 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1444 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1445 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1446 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1447 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1448 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1451 proc load_message {file} {
1454 set f [gitdir $file]
1455 if {[file isfile $f]} {
1456 if {[catch {set fd [open $f r]}]} {
1459 fconfigure $fd -eofchar {}
1460 set content [string trim [read $fd]]
1462 regsub -all -line {[ \r\t]+$} $content {} content
1463 $ui_comm delete 0.0 end
1464 $ui_comm insert end $content
1470 proc run_prepare_commit_msg_hook {} {
1473 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1474 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1475 # empty file but existant file.
1477 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1479 if {[file isfile [gitdir MERGE_MSG]]} {
1480 set pcm_source "merge"
1481 set fd_mm [open [gitdir MERGE_MSG] r]
1482 puts -nonewline $fd_pcm [read $fd_mm]
1484 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1485 set pcm_source "squash"
1486 set fd_sm [open [gitdir SQUASH_MSG] r]
1487 puts -nonewline $fd_pcm [read $fd_sm]
1495 set fd_ph [githook_read prepare-commit-msg \
1496 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1498 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1502 ui_status [mc "Calling prepare-commit-msg hook..."]
1505 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1506 fileevent $fd_ph readable \
1507 [list prepare_commit_msg_hook_wait $fd_ph]
1512 proc prepare_commit_msg_hook_wait {fd_ph} {
1515 append pch_error [read $fd_ph]
1516 fconfigure $fd_ph -blocking 1
1518 if {[catch {close $fd_ph}]} {
1519 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1520 hook_failed_popup prepare-commit-msg $pch_error
1521 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1524 load_message PREPARE_COMMIT_MSG
1527 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1530 fconfigure $fd_ph -blocking 0
1531 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1534 proc read_diff_index {fd after} {
1537 append buf_rdi [read $fd]
1539 set n [string length $buf_rdi]
1541 set z1 [string first "\0" $buf_rdi $c]
1542 if {$z1 == -1} break
1544 set z2 [string first "\0" $buf_rdi $z1]
1545 if {$z2 == -1} break
1548 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1549 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1551 [encoding convertfrom $p] \
1553 [list [lindex $i 0] [lindex $i 2]] \
1559 set buf_rdi [string range $buf_rdi $c end]
1564 rescan_done $fd buf_rdi $after
1567 proc read_diff_files {fd after} {
1570 append buf_rdf [read $fd]
1572 set n [string length $buf_rdf]
1574 set z1 [string first "\0" $buf_rdf $c]
1575 if {$z1 == -1} break
1577 set z2 [string first "\0" $buf_rdf $z1]
1578 if {$z2 == -1} break
1581 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1582 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1584 [encoding convertfrom $p] \
1587 [list [lindex $i 0] [lindex $i 2]]
1592 set buf_rdf [string range $buf_rdf $c end]
1597 rescan_done $fd buf_rdf $after
1600 proc read_ls_others {fd after} {
1603 append buf_rlo [read $fd]
1604 set pck [split $buf_rlo "\0"]
1605 set buf_rlo [lindex $pck end]
1606 foreach p [lrange $pck 0 end-1] {
1607 set p [encoding convertfrom $p]
1608 if {[string index $p end] eq {/}} {
1609 set p [string range $p 0 end-1]
1613 rescan_done $fd buf_rlo $after
1616 proc rescan_done {fd buf after} {
1617 global rescan_active current_diff_path
1618 global file_states repo_config
1621 if {![eof $fd]} return
1624 if {[incr rescan_active -1] > 0} return
1629 if {$current_diff_path ne {}} { reshow_diff $after }
1630 if {$current_diff_path eq {}} { select_first_diff $after }
1633 proc prune_selection {} {
1634 global file_states selected_paths
1636 foreach path [array names selected_paths] {
1637 if {[catch {set still_here $file_states($path)}]} {
1638 unset selected_paths($path)
1643 ######################################################################
1647 proc mapicon {w state path} {
1650 if {[catch {set r $all_icons($state$w)}]} {
1651 puts "error: no icon for $w state={$state} $path"
1657 proc mapdesc {state path} {
1660 if {[catch {set r $all_descs($state)}]} {
1661 puts "error: no desc for state={$state} $path"
1667 proc ui_status {msg} {
1669 if {[info exists main_status]} {
1670 $main_status show $msg
1674 proc ui_ready {{test {}}} {
1676 if {[info exists main_status]} {
1677 $main_status show [mc "Ready."] $test
1681 proc escape_path {path} {
1682 regsub -all {\\} $path "\\\\" path
1683 regsub -all "\n" $path "\\n" path
1687 proc short_path {path} {
1688 return [escape_path [lindex [file split $path] end]]
1692 set null_sha1 [string repeat 0 40]
1694 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1695 global file_states next_icon_id null_sha1
1697 set s0 [string index $new_state 0]
1698 set s1 [string index $new_state 1]
1700 if {[catch {set info $file_states($path)}]} {
1702 set icon n[incr next_icon_id]
1704 set state [lindex $info 0]
1705 set icon [lindex $info 1]
1706 if {$head_info eq {}} {set head_info [lindex $info 2]}
1707 if {$index_info eq {}} {set index_info [lindex $info 3]}
1710 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1711 elseif {$s0 eq {_}} {set s0 _}
1713 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1714 elseif {$s1 eq {_}} {set s1 _}
1716 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1717 set head_info [list 0 $null_sha1]
1718 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1719 && $head_info eq {}} {
1720 set head_info $index_info
1721 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1722 set index_info $head_info
1726 set file_states($path) [list $s0$s1 $icon \
1727 $head_info $index_info \
1732 proc display_file_helper {w path icon_name old_m new_m} {
1735 if {$new_m eq {_}} {
1736 set lno [lsearch -sorted -exact $file_lists($w) $path]
1738 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1740 $w conf -state normal
1741 $w delete $lno.0 [expr {$lno + 1}].0
1742 $w conf -state disabled
1744 } elseif {$old_m eq {_} && $new_m ne {_}} {
1745 lappend file_lists($w) $path
1746 set file_lists($w) [lsort -unique $file_lists($w)]
1747 set lno [lsearch -sorted -exact $file_lists($w) $path]
1749 $w conf -state normal
1750 $w image create $lno.0 \
1751 -align center -padx 5 -pady 1 \
1753 -image [mapicon $w $new_m $path]
1754 $w insert $lno.1 "[escape_path $path]\n"
1755 $w conf -state disabled
1756 } elseif {$old_m ne $new_m} {
1757 $w conf -state normal
1758 $w image conf $icon_name -image [mapicon $w $new_m $path]
1759 $w conf -state disabled
1763 proc display_file {path state} {
1764 global file_states selected_paths
1765 global ui_index ui_workdir
1767 set old_m [merge_state $path $state]
1768 set s $file_states($path)
1769 set new_m [lindex $s 0]
1770 set icon_name [lindex $s 1]
1772 set o [string index $old_m 0]
1773 set n [string index $new_m 0]
1780 display_file_helper $ui_index $path $icon_name $o $n
1782 if {[string index $old_m 0] eq {U}} {
1785 set o [string index $old_m 1]
1787 if {[string index $new_m 0] eq {U}} {
1790 set n [string index $new_m 1]
1792 display_file_helper $ui_workdir $path $icon_name $o $n
1794 if {$new_m eq {__}} {
1795 unset file_states($path)
1796 catch {unset selected_paths($path)}
1800 proc display_all_files_helper {w path icon_name m} {
1803 lappend file_lists($w) $path
1804 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1805 $w image create end \
1806 -align center -padx 5 -pady 1 \
1808 -image [mapicon $w $m $path]
1809 $w insert end "[escape_path $path]\n"
1813 proc display_all_files {} {
1814 global ui_index ui_workdir
1815 global file_states file_lists
1817 global files_warning
1819 $ui_index conf -state normal
1820 $ui_workdir conf -state normal
1822 $ui_index delete 0.0 end
1823 $ui_workdir delete 0.0 end
1826 set file_lists($ui_index) [list]
1827 set file_lists($ui_workdir) [list]
1829 set to_display [lsort [array names file_states]]
1830 set display_limit [get_config gui.maxfilesdisplayed]
1831 if {[llength $to_display] > $display_limit} {
1832 if {!$files_warning} {
1833 # do not repeatedly warn:
1835 info_popup [mc "Displaying only %s of %s files." \
1836 $display_limit [llength $to_display]]
1838 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1840 foreach path $to_display {
1841 set s $file_states($path)
1843 set icon_name [lindex $s 1]
1845 set s [string index $m 0]
1846 if {$s ne {U} && $s ne {_}} {
1847 display_all_files_helper $ui_index $path \
1851 if {[string index $m 0] eq {U}} {
1854 set s [string index $m 1]
1857 display_all_files_helper $ui_workdir $path \
1862 $ui_index conf -state disabled
1863 $ui_workdir conf -state disabled
1866 ######################################################################
1871 #define mask_width 14
1872 #define mask_height 15
1873 static unsigned char mask_bits[] = {
1874 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1875 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1876 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1879 image create bitmap file_plain -background white -foreground black -data {
1880 #define plain_width 14
1881 #define plain_height 15
1882 static unsigned char plain_bits[] = {
1883 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1884 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1885 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1886 } -maskdata $filemask
1888 image create bitmap file_mod -background white -foreground blue -data {
1889 #define mod_width 14
1890 #define mod_height 15
1891 static unsigned char mod_bits[] = {
1892 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1893 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1894 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1895 } -maskdata $filemask
1897 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1898 #define file_fulltick_width 14
1899 #define file_fulltick_height 15
1900 static unsigned char file_fulltick_bits[] = {
1901 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1902 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1903 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1904 } -maskdata $filemask
1906 image create bitmap file_question -background white -foreground black -data {
1907 #define file_question_width 14
1908 #define file_question_height 15
1909 static unsigned char file_question_bits[] = {
1910 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1911 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1912 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1913 } -maskdata $filemask
1915 image create bitmap file_removed -background white -foreground red -data {
1916 #define file_removed_width 14
1917 #define file_removed_height 15
1918 static unsigned char file_removed_bits[] = {
1919 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1920 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1921 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1922 } -maskdata $filemask
1924 image create bitmap file_merge -background white -foreground blue -data {
1925 #define file_merge_width 14
1926 #define file_merge_height 15
1927 static unsigned char file_merge_bits[] = {
1928 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1929 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1930 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1931 } -maskdata $filemask
1933 image create bitmap file_statechange -background white -foreground green -data {
1934 #define file_merge_width 14
1935 #define file_merge_height 15
1936 static unsigned char file_statechange_bits[] = {
1937 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1938 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1939 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1940 } -maskdata $filemask
1942 set ui_index .vpane.files.index.list
1943 set ui_workdir .vpane.files.workdir.list
1945 set all_icons(_$ui_index) file_plain
1946 set all_icons(A$ui_index) file_plain
1947 set all_icons(M$ui_index) file_fulltick
1948 set all_icons(D$ui_index) file_removed
1949 set all_icons(U$ui_index) file_merge
1950 set all_icons(T$ui_index) file_statechange
1952 set all_icons(_$ui_workdir) file_plain
1953 set all_icons(M$ui_workdir) file_mod
1954 set all_icons(D$ui_workdir) file_question
1955 set all_icons(U$ui_workdir) file_merge
1956 set all_icons(O$ui_workdir) file_plain
1957 set all_icons(T$ui_workdir) file_statechange
1959 set max_status_desc 0
1961 {__ {mc "Unmodified"}}
1963 {_M {mc "Modified, not staged"}}
1964 {M_ {mc "Staged for commit"}}
1965 {MM {mc "Portions staged for commit"}}
1966 {MD {mc "Staged for commit, missing"}}
1968 {_T {mc "File type changed, not staged"}}
1969 {T_ {mc "File type changed, staged"}}
1971 {_O {mc "Untracked, not staged"}}
1972 {A_ {mc "Staged for commit"}}
1973 {AM {mc "Portions staged for commit"}}
1974 {AD {mc "Staged for commit, missing"}}
1977 {D_ {mc "Staged for removal"}}
1978 {DO {mc "Staged for removal, still present"}}
1980 {_U {mc "Requires merge resolution"}}
1981 {U_ {mc "Requires merge resolution"}}
1982 {UU {mc "Requires merge resolution"}}
1983 {UM {mc "Requires merge resolution"}}
1984 {UD {mc "Requires merge resolution"}}
1985 {UT {mc "Requires merge resolution"}}
1987 set text [eval [lindex $i 1]]
1988 if {$max_status_desc < [string length $text]} {
1989 set max_status_desc [string length $text]
1991 set all_descs([lindex $i 0]) $text
1995 ######################################################################
1999 proc scrollbar2many {list mode args} {
2000 foreach w $list {eval $w $mode $args}
2003 proc many2scrollbar {list mode sb top bottom} {
2004 $sb set $top $bottom
2005 foreach w $list {$w $mode moveto $top}
2008 proc incr_font_size {font {amt 1}} {
2009 set sz [font configure $font -size]
2011 font configure $font -size $sz
2012 font configure ${font}bold -size $sz
2013 font configure ${font}italic -size $sz
2016 ######################################################################
2020 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2022 proc do_gitk {revs {is_submodule false}} {
2023 global current_diff_path file_states current_diff_side ui_index
2024 global _gitdir _gitworktree
2026 # -- Always start gitk through whatever we were loaded with. This
2027 # lets us bypass using shell process on Windows systems.
2029 set exe [_which gitk -script]
2030 set cmd [list [info nameofexecutable] $exe]
2032 error_popup [mc "Couldn't find gitk in PATH"]
2038 if {!$is_submodule} {
2043 cd $current_diff_path
2044 if {$revs eq {--}} {
2045 set s $file_states($current_diff_path)
2048 switch -glob -- [lindex $s 0] {
2049 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2050 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2052 if {$current_diff_side eq $ui_index} {
2053 set old_sha1 [lindex [lindex $s 2] 1]
2054 set new_sha1 [lindex [lindex $s 3] 1]
2056 set old_sha1 [lindex [lindex $s 3] 1]
2060 set revs $old_sha1...$new_sha1
2062 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2063 # we've been using for the main repository, so unset them.
2064 # TODO we could make life easier (start up faster?) for gitk
2065 # by setting these to the appropriate values to allow gitk
2066 # to skip the heuristics to find their proper value
2068 unset env(GIT_WORK_TREE)
2070 eval exec $cmd $revs "--" "--" &
2072 set env(GIT_DIR) $_gitdir
2073 set env(GIT_WORK_TREE) $_gitworktree
2076 ui_status $::starting_gitk_msg
2078 ui_ready $starting_gitk_msg
2083 proc do_git_gui {} {
2084 global current_diff_path
2086 # -- Always start git gui through whatever we were loaded with. This
2087 # lets us bypass using shell process on Windows systems.
2089 set exe [list [_which git]]
2091 error_popup [mc "Couldn't find git gui in PATH"]
2094 global _gitdir _gitworktree
2096 # see note in do_gitk about unsetting these vars when
2097 # running tools in a submodule
2099 unset env(GIT_WORK_TREE)
2102 cd $current_diff_path
2104 eval exec $exe gui &
2106 set env(GIT_DIR) $_gitdir
2107 set env(GIT_WORK_TREE) $_gitworktree
2110 ui_status $::starting_gitk_msg
2112 ui_ready $starting_gitk_msg
2117 proc do_explore {} {
2120 if {[is_Cygwin] || [is_Windows]} {
2121 set explorer "explorer.exe"
2122 } elseif {[is_MacOSX]} {
2125 # freedesktop.org-conforming system is our best shot
2126 set explorer "xdg-open"
2128 eval exec $explorer [list [file nativename $_gitworktree]] &
2134 proc terminate_me {win} {
2136 if {$win ne {.}} return
2140 proc do_quit {{rc {1}}} {
2141 global ui_comm is_quitting repo_config commit_type
2142 global GITGUI_BCK_exists GITGUI_BCK_i
2143 global ui_comm_spell
2144 global ret_code use_ttk
2146 if {$is_quitting} return
2149 if {[winfo exists $ui_comm]} {
2150 # -- Stash our current commit buffer.
2152 set save [gitdir GITGUI_MSG]
2153 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2154 file rename -force [gitdir GITGUI_BCK] $save
2155 set GITGUI_BCK_exists 0
2157 set msg [string trim [$ui_comm get 0.0 end]]
2158 regsub -all -line {[ \r\t]+$} $msg {} msg
2159 if {(![string match amend* $commit_type]
2160 || [$ui_comm edit modified])
2163 set fd [open $save w]
2164 puts -nonewline $fd $msg
2168 catch {file delete $save}
2172 # -- Cancel our spellchecker if its running.
2174 if {[info exists ui_comm_spell]} {
2178 # -- Remove our editor backup, its not needed.
2180 after cancel $GITGUI_BCK_i
2181 if {$GITGUI_BCK_exists} {
2182 catch {file delete [gitdir GITGUI_BCK]}
2185 # -- Stash our current window geometry into this repository.
2187 set cfg_wmstate [wm state .]
2188 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2191 if {$cfg_wmstate ne $rc_wmstate} {
2192 catch {git config gui.wmstate $cfg_wmstate}
2194 if {$cfg_wmstate eq {zoomed}} {
2195 # on Windows wm geometry will lie about window
2196 # position (but not size) when window is zoomed
2197 # restore the window before querying wm geometry
2200 set cfg_geometry [list]
2201 lappend cfg_geometry [wm geometry .]
2203 lappend cfg_geometry [.vpane sashpos 0]
2204 lappend cfg_geometry [.vpane.files sashpos 0]
2206 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2207 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2209 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2212 if {$cfg_geometry ne $rc_geometry} {
2213 catch {git config gui.geometry $cfg_geometry}
2219 # Briefly enable send again, working around Tk bug
2220 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2221 tk appname [appname]
2230 proc ui_do_rescan {} {
2231 rescan {force_first_diff ui_ready}
2238 proc next_diff {{after {}}} {
2239 global next_diff_p next_diff_w next_diff_i
2240 show_diff $next_diff_p $next_diff_w {} {} $after
2243 proc find_anchor_pos {lst name} {
2244 set lid [lsearch -sorted -exact $lst $name]
2248 foreach lname $lst {
2249 if {$lname >= $name} break
2257 proc find_file_from {flist idx delta path mmask} {
2260 set len [llength $flist]
2261 while {$idx >= 0 && $idx < $len} {
2262 set name [lindex $flist $idx]
2264 if {$name ne $path && [info exists file_states($name)]} {
2265 set state [lindex $file_states($name) 0]
2267 if {$mmask eq {} || [regexp $mmask $state]} {
2278 proc find_next_diff {w path {lno {}} {mmask {}}} {
2279 global next_diff_p next_diff_w next_diff_i
2280 global file_lists ui_index ui_workdir
2282 set flist $file_lists($w)
2284 set lno [find_anchor_pos $flist $path]
2289 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2290 if {$w eq $ui_index} {
2293 set mmask "$mmask\$"
2297 set idx [find_file_from $flist $lno 1 $path $mmask]
2300 set idx [find_file_from $flist $lno -1 $path $mmask]
2305 set next_diff_p [lindex $flist $idx]
2306 set next_diff_i [expr {$idx+1}]
2313 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2314 global current_diff_path
2316 if {$path ne $current_diff_path} {
2318 } elseif {[find_next_diff $w $path $lno $mmask]} {
2321 return {reshow_diff;}
2325 proc select_first_diff {after} {
2328 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2329 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2336 proc force_first_diff {after} {
2337 global ui_workdir current_diff_path file_states
2339 if {[info exists file_states($current_diff_path)]} {
2340 set state [lindex $file_states($current_diff_path) 0]
2346 if {[string first {U} $state] >= 0} {
2347 # Already a conflict, do nothing
2348 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2350 } elseif {[string index $state 1] ne {O}} {
2351 # Already a diff & no conflicts, do nothing
2352 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2363 proc toggle_or_diff {w x y} {
2364 global file_states file_lists current_diff_path ui_index ui_workdir
2365 global last_clicked selected_paths
2367 set pos [split [$w index @$x,$y] .]
2368 set lno [lindex $pos 0]
2369 set col [lindex $pos 1]
2370 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2376 set last_clicked [list $w $lno]
2377 array unset selected_paths
2378 $ui_index tag remove in_sel 0.0 end
2379 $ui_workdir tag remove in_sel 0.0 end
2381 # Determine the state of the file
2382 if {[info exists file_states($path)]} {
2383 set state [lindex $file_states($path) 0]
2388 # Restage the file, or simply show the diff
2389 if {$col == 0 && $y > 1} {
2390 # Conflicts need special handling
2391 if {[string first {U} $state] >= 0} {
2392 # $w must always be $ui_workdir, but...
2393 if {$w ne $ui_workdir} { set lno {} }
2394 merge_stage_workdir $path $lno
2398 if {[string index $state 1] eq {O}} {
2404 set after [next_diff_after_action $w $path $lno $mmask]
2406 if {$w eq $ui_index} {
2408 "Unstaging [short_path $path] from commit" \
2410 [concat $after [list ui_ready]]
2411 } elseif {$w eq $ui_workdir} {
2413 "Adding [short_path $path]" \
2415 [concat $after [list ui_ready]]
2418 show_diff $path $w $lno
2422 proc add_one_to_selection {w x y} {
2423 global file_lists last_clicked selected_paths
2425 set lno [lindex [split [$w index @$x,$y] .] 0]
2426 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2432 if {$last_clicked ne {}
2433 && [lindex $last_clicked 0] ne $w} {
2434 array unset selected_paths
2435 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2438 set last_clicked [list $w $lno]
2439 if {[catch {set in_sel $selected_paths($path)}]} {
2443 unset selected_paths($path)
2444 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2446 set selected_paths($path) 1
2447 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2451 proc add_range_to_selection {w x y} {
2452 global file_lists last_clicked selected_paths
2454 if {[lindex $last_clicked 0] ne $w} {
2455 toggle_or_diff $w $x $y
2459 set lno [lindex [split [$w index @$x,$y] .] 0]
2460 set lc [lindex $last_clicked 1]
2469 foreach path [lrange $file_lists($w) \
2470 [expr {$begin - 1}] \
2471 [expr {$end - 1}]] {
2472 set selected_paths($path) 1
2474 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2477 proc show_more_context {} {
2479 if {$repo_config(gui.diffcontext) < 99} {
2480 incr repo_config(gui.diffcontext)
2485 proc show_less_context {} {
2487 if {$repo_config(gui.diffcontext) > 1} {
2488 incr repo_config(gui.diffcontext) -1
2493 ######################################################################
2501 menu .mbar -tearoff 0
2503 # -- Apple Menu (Mac OS X only)
2505 .mbar add cascade -label Apple -menu .mbar.apple
2508 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2509 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2510 if {[is_enabled branch]} {
2511 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2513 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2514 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2516 if {[is_enabled transport]} {
2517 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2518 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2520 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2521 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2524 # -- Repository Menu
2526 menu .mbar.repository
2529 .mbar.repository add command \
2530 -label [mc "Explore Working Copy"] \
2531 -command {do_explore}
2532 .mbar.repository add separator
2535 .mbar.repository add command \
2536 -label [mc "Browse Current Branch's Files"] \
2537 -command {browser::new $current_branch}
2538 set ui_browse_current [.mbar.repository index last]
2539 .mbar.repository add command \
2540 -label [mc "Browse Branch Files..."] \
2541 -command browser_open::dialog
2542 .mbar.repository add separator
2544 .mbar.repository add command \
2545 -label [mc "Visualize Current Branch's History"] \
2546 -command {do_gitk $current_branch}
2547 set ui_visualize_current [.mbar.repository index last]
2548 .mbar.repository add command \
2549 -label [mc "Visualize All Branch History"] \
2550 -command {do_gitk --all}
2551 .mbar.repository add separator
2553 proc current_branch_write {args} {
2554 global current_branch
2555 .mbar.repository entryconf $::ui_browse_current \
2556 -label [mc "Browse %s's Files" $current_branch]
2557 .mbar.repository entryconf $::ui_visualize_current \
2558 -label [mc "Visualize %s's History" $current_branch]
2560 trace add variable current_branch write current_branch_write
2562 if {[is_enabled multicommit]} {
2563 .mbar.repository add command -label [mc "Database Statistics"] \
2566 .mbar.repository add command -label [mc "Compress Database"] \
2569 .mbar.repository add command -label [mc "Verify Database"] \
2570 -command do_fsck_objects
2572 .mbar.repository add separator
2575 .mbar.repository add command \
2576 -label [mc "Create Desktop Icon"] \
2577 -command do_cygwin_shortcut
2578 } elseif {[is_Windows]} {
2579 .mbar.repository add command \
2580 -label [mc "Create Desktop Icon"] \
2581 -command do_windows_shortcut
2582 } elseif {[is_MacOSX]} {
2583 .mbar.repository add command \
2584 -label [mc "Create Desktop Icon"] \
2585 -command do_macosx_app
2590 proc ::tk::mac::Quit {args} { do_quit }
2592 .mbar.repository add command -label [mc Quit] \
2600 .mbar.edit add command -label [mc Undo] \
2601 -command {catch {[focus] edit undo}} \
2603 .mbar.edit add command -label [mc Redo] \
2604 -command {catch {[focus] edit redo}} \
2606 .mbar.edit add separator
2607 .mbar.edit add command -label [mc Cut] \
2608 -command {catch {tk_textCut [focus]}} \
2610 .mbar.edit add command -label [mc Copy] \
2611 -command {catch {tk_textCopy [focus]}} \
2613 .mbar.edit add command -label [mc Paste] \
2614 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2616 .mbar.edit add command -label [mc Delete] \
2617 -command {catch {[focus] delete sel.first sel.last}} \
2619 .mbar.edit add separator
2620 .mbar.edit add command -label [mc "Select All"] \
2621 -command {catch {[focus] tag add sel 0.0 end}} \
2626 if {[is_enabled branch]} {
2629 .mbar.branch add command -label [mc "Create..."] \
2630 -command branch_create::dialog \
2632 lappend disable_on_lock [list .mbar.branch entryconf \
2633 [.mbar.branch index last] -state]
2635 .mbar.branch add command -label [mc "Checkout..."] \
2636 -command branch_checkout::dialog \
2638 lappend disable_on_lock [list .mbar.branch entryconf \
2639 [.mbar.branch index last] -state]
2641 .mbar.branch add command -label [mc "Rename..."] \
2642 -command branch_rename::dialog
2643 lappend disable_on_lock [list .mbar.branch entryconf \
2644 [.mbar.branch index last] -state]
2646 .mbar.branch add command -label [mc "Delete..."] \
2647 -command branch_delete::dialog
2648 lappend disable_on_lock [list .mbar.branch entryconf \
2649 [.mbar.branch index last] -state]
2651 .mbar.branch add command -label [mc "Reset..."] \
2652 -command merge::reset_hard
2653 lappend disable_on_lock [list .mbar.branch entryconf \
2654 [.mbar.branch index last] -state]
2659 proc commit_btn_caption {} {
2660 if {[is_enabled nocommit]} {
2663 return [mc Commit@@verb]
2667 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2670 if {![is_enabled nocommit]} {
2671 .mbar.commit add radiobutton \
2672 -label [mc "New Commit"] \
2673 -command do_select_commit_type \
2674 -variable selected_commit_type \
2676 lappend disable_on_lock \
2677 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2679 .mbar.commit add radiobutton \
2680 -label [mc "Amend Last Commit"] \
2681 -command do_select_commit_type \
2682 -variable selected_commit_type \
2684 lappend disable_on_lock \
2685 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2687 .mbar.commit add separator
2690 .mbar.commit add command -label [mc Rescan] \
2691 -command ui_do_rescan \
2693 lappend disable_on_lock \
2694 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2696 .mbar.commit add command -label [mc "Stage To Commit"] \
2697 -command do_add_selection \
2699 lappend disable_on_lock \
2700 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2702 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2703 -command do_add_all \
2705 lappend disable_on_lock \
2706 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2708 .mbar.commit add command -label [mc "Unstage From Commit"] \
2709 -command do_unstage_selection \
2711 lappend disable_on_lock \
2712 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2714 .mbar.commit add command -label [mc "Revert Changes"] \
2715 -command do_revert_selection \
2717 lappend disable_on_lock \
2718 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2720 .mbar.commit add separator
2722 .mbar.commit add command -label [mc "Show Less Context"] \
2723 -command show_less_context \
2724 -accelerator $M1T-\-
2726 .mbar.commit add command -label [mc "Show More Context"] \
2727 -command show_more_context \
2730 .mbar.commit add separator
2732 if {![is_enabled nocommitmsg]} {
2733 .mbar.commit add command -label [mc "Sign Off"] \
2734 -command do_signoff \
2738 .mbar.commit add command -label [commit_btn_caption] \
2739 -command do_commit \
2740 -accelerator $M1T-Return
2741 lappend disable_on_lock \
2742 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2747 if {[is_enabled branch]} {
2749 .mbar.merge add command -label [mc "Local Merge..."] \
2750 -command merge::dialog \
2752 lappend disable_on_lock \
2753 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2754 .mbar.merge add command -label [mc "Abort Merge..."] \
2755 -command merge::reset_hard
2756 lappend disable_on_lock \
2757 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2762 if {[is_enabled transport]} {
2765 .mbar.remote add command \
2766 -label [mc "Add..."] \
2767 -command remote_add::dialog \
2769 .mbar.remote add command \
2770 -label [mc "Push..."] \
2771 -command do_push_anywhere \
2773 .mbar.remote add command \
2774 -label [mc "Delete Branch..."] \
2775 -command remote_branch_delete::dialog
2779 proc ::tk::mac::ShowPreferences {} {do_options}
2783 .mbar.edit add separator
2784 .mbar.edit add command -label [mc "Options..."] \
2790 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2791 set tools_menubar .mbar.tools
2793 $tools_menubar add separator
2794 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2795 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2797 if {[array names repo_config guitool.*.cmd] ne {}} {
2804 .mbar add cascade -label [mc Help] -menu .mbar.help
2808 .mbar.apple add command -label [mc "About %s" [appname]] \
2810 .mbar.apple add separator
2812 .mbar.help add command -label [mc "About %s" [appname]] \
2815 . configure -menu .mbar
2817 set doc_path [githtmldir]
2818 if {$doc_path ne {}} {
2819 set doc_path [file join $doc_path index.html]
2822 set doc_path [exec cygpath --mixed $doc_path]
2826 if {[file isfile $doc_path]} {
2827 set doc_url "file:$doc_path"
2829 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2832 proc start_browser {url} {
2833 git "web--browse" $url
2836 .mbar.help add command -label [mc "Online Documentation"] \
2837 -command [list start_browser $doc_url]
2839 .mbar.help add command -label [mc "Show SSH Key"] \
2842 unset doc_path doc_url
2844 # -- Standard bindings
2846 wm protocol . WM_DELETE_WINDOW do_quit
2847 bind all <$M1B-Key-q> do_quit
2848 bind all <$M1B-Key-Q> do_quit
2849 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2850 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2852 set subcommand_args {}
2854 set s "usage: $::argv0 $::subcommand $::subcommand_args"
2855 if {[tk windowingsystem] eq "win32"} {
2857 tk_messageBox -icon info -title "Usage" -message $s
2864 proc normalize_relpath {path} {
2866 foreach item [file split $path] {
2867 if {$item eq {.}} continue
2868 if {$item eq {..} && [llength $elements] > 0
2869 && [lindex $elements end] ne {..}} {
2870 set elements [lrange $elements 0 end-1]
2873 lappend elements $item
2875 return [eval file join $elements]
2878 # -- Not a normal commit type invocation? Do that instead!
2880 switch -- $subcommand {
2883 if {$subcommand eq "blame"} {
2884 set subcommand_args {[--line=<num>] rev? path}
2886 set subcommand_args {rev? path}
2888 if {$argv eq {}} usage
2894 if {$is_path || [file exists $_prefix$a]} {
2895 if {$path ne {}} usage
2896 set path [normalize_relpath $_prefix$a]
2898 } elseif {$a eq {--}} {
2900 if {$head ne {}} usage
2905 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2906 if {$jump_spec ne {} || $head ne {}} usage
2907 set jump_spec [list $lnum]
2908 } elseif {$head eq {}} {
2909 if {$head ne {}} usage
2918 if {$head ne {} && $path eq {}} {
2919 set path [normalize_relpath $_prefix$head]
2926 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2928 set head [git rev-parse --verify $head]
2934 set current_branch $head
2938 switch -- $subcommand {
2940 if {$jump_spec ne {}} usage
2942 if {$path ne {} && [file isdirectory $path]} {
2943 set head $current_branch
2949 browser::new $head $path
2952 if {$head eq {} && ![file exists $path]} {
2953 catch {wm withdraw .}
2957 -title [mc "git-gui: fatal error"] \
2958 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
2961 blame::new $head $path $jump_spec
2968 if {[llength $argv] != 0} {
2969 puts -nonewline stderr "usage: $argv0"
2970 if {$subcommand ne {gui}
2971 && [file tail $argv0] ne "git-$subcommand"} {
2972 puts -nonewline stderr " $subcommand"
2977 # fall through to setup UI for commits
2980 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2987 ${NS}::frame .branch
2988 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
2989 ${NS}::label .branch.l1 \
2990 -text [mc "Current Branch:"] \
2993 ${NS}::label .branch.cb \
2994 -textvariable current_branch \
2997 pack .branch.l1 -side left
2998 pack .branch.cb -side left -fill x
2999 pack .branch -side top -fill x
3001 # -- Main Window Layout
3003 ${NS}::panedwindow .vpane -orient horizontal
3004 ${NS}::panedwindow .vpane.files -orient vertical
3006 .vpane add .vpane.files
3008 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3010 pack .vpane -anchor n -side top -fill both -expand 1
3012 # -- Index File List
3014 ${NS}::frame .vpane.files.index -height 100 -width 200
3015 tlabel .vpane.files.index.title \
3016 -text [mc "Staged Changes (Will Commit)"] \
3017 -background lightgreen -foreground black
3018 text $ui_index -background white -foreground black \
3020 -width 20 -height 10 \
3022 -cursor $cursor_ptr \
3023 -xscrollcommand {.vpane.files.index.sx set} \
3024 -yscrollcommand {.vpane.files.index.sy set} \
3026 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3027 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3028 pack .vpane.files.index.title -side top -fill x
3029 pack .vpane.files.index.sx -side bottom -fill x
3030 pack .vpane.files.index.sy -side right -fill y
3031 pack $ui_index -side left -fill both -expand 1
3033 # -- Working Directory File List
3035 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3036 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3037 -background lightsalmon -foreground black
3038 text $ui_workdir -background white -foreground black \
3040 -width 20 -height 10 \
3042 -cursor $cursor_ptr \
3043 -xscrollcommand {.vpane.files.workdir.sx set} \
3044 -yscrollcommand {.vpane.files.workdir.sy set} \
3046 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3047 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3048 pack .vpane.files.workdir.title -side top -fill x
3049 pack .vpane.files.workdir.sx -side bottom -fill x
3050 pack .vpane.files.workdir.sy -side right -fill y
3051 pack $ui_workdir -side left -fill both -expand 1
3053 .vpane.files add .vpane.files.workdir
3054 .vpane.files add .vpane.files.index
3056 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3057 .vpane.files paneconfigure .vpane.files.index -sticky news
3060 foreach i [list $ui_index $ui_workdir] {
3062 $i tag conf in_diff -background [$i tag cget in_sel -background]
3066 # -- Diff and Commit Area
3068 ${NS}::frame .vpane.lower -height 300 -width 400
3069 ${NS}::frame .vpane.lower.commarea
3070 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3071 pack .vpane.lower.diff -fill both -expand 1
3072 pack .vpane.lower.commarea -side bottom -fill x
3073 .vpane add .vpane.lower
3074 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3076 # -- Commit Area Buttons
3078 ${NS}::frame .vpane.lower.commarea.buttons
3079 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3082 pack .vpane.lower.commarea.buttons.l -side top -fill x
3083 pack .vpane.lower.commarea.buttons -side left -fill y
3085 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3086 -command ui_do_rescan
3087 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3088 lappend disable_on_lock \
3089 {.vpane.lower.commarea.buttons.rescan conf -state}
3091 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3093 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3094 lappend disable_on_lock \
3095 {.vpane.lower.commarea.buttons.incall conf -state}
3097 if {![is_enabled nocommitmsg]} {
3098 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3100 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3103 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3105 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3106 lappend disable_on_lock \
3107 {.vpane.lower.commarea.buttons.commit conf -state}
3109 if {![is_enabled nocommit]} {
3110 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3111 -command do_push_anywhere
3112 pack .vpane.lower.commarea.buttons.push -side top -fill x
3115 # -- Commit Message Buffer
3117 ${NS}::frame .vpane.lower.commarea.buffer
3118 ${NS}::frame .vpane.lower.commarea.buffer.header
3119 set ui_comm .vpane.lower.commarea.buffer.t
3120 set ui_coml .vpane.lower.commarea.buffer.header.l
3122 if {![is_enabled nocommit]} {
3123 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3124 -text [mc "New Commit"] \
3125 -command do_select_commit_type \
3126 -variable selected_commit_type \
3128 lappend disable_on_lock \
3129 [list .vpane.lower.commarea.buffer.header.new conf -state]
3130 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3131 -text [mc "Amend Last Commit"] \
3132 -command do_select_commit_type \
3133 -variable selected_commit_type \
3135 lappend disable_on_lock \
3136 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3139 ${NS}::label $ui_coml \
3142 proc trace_commit_type {varname args} {
3143 global ui_coml commit_type
3144 switch -glob -- $commit_type {
3145 initial {set txt [mc "Initial Commit Message:"]}
3146 amend {set txt [mc "Amended Commit Message:"]}
3147 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3148 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3149 merge {set txt [mc "Merge Commit Message:"]}
3150 * {set txt [mc "Commit Message:"]}
3152 $ui_coml conf -text $txt
3154 trace add variable commit_type write trace_commit_type
3155 pack $ui_coml -side left -fill x
3157 if {![is_enabled nocommit]} {
3158 pack .vpane.lower.commarea.buffer.header.amend -side right
3159 pack .vpane.lower.commarea.buffer.header.new -side right
3162 text $ui_comm -background white -foreground black \
3166 -autoseparators true \
3168 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3170 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3171 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3172 -command [list $ui_comm yview]
3173 pack .vpane.lower.commarea.buffer.header -side top -fill x
3174 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3175 pack $ui_comm -side left -fill y
3176 pack .vpane.lower.commarea.buffer -side left -fill y
3178 # -- Commit Message Buffer Context Menu
3180 set ctxm .vpane.lower.commarea.buffer.ctxm
3181 menu $ctxm -tearoff 0
3184 -command {tk_textCut $ui_comm}
3187 -command {tk_textCopy $ui_comm}
3190 -command {tk_textPaste $ui_comm}
3192 -label [mc Delete] \
3193 -command {catch {$ui_comm delete sel.first sel.last}}
3196 -label [mc "Select All"] \
3197 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3199 -label [mc "Copy All"] \
3201 $ui_comm tag add sel 0.0 end
3202 tk_textCopy $ui_comm
3203 $ui_comm tag remove sel 0.0 end
3207 -label [mc "Sign Off"] \
3209 set ui_comm_ctxm $ctxm
3213 proc trace_current_diff_path {varname args} {
3214 global current_diff_path diff_actions file_states
3215 if {$current_diff_path eq {}} {
3221 set p $current_diff_path
3222 set s [mapdesc [lindex $file_states($p) 0] $p]
3224 set p [escape_path $p]
3228 .vpane.lower.diff.header.status configure -text $s
3229 .vpane.lower.diff.header.file configure -text $f
3230 .vpane.lower.diff.header.path configure -text $p
3231 foreach w $diff_actions {
3235 trace add variable current_diff_path write trace_current_diff_path
3237 gold_frame .vpane.lower.diff.header
3238 tlabel .vpane.lower.diff.header.status \
3241 -width $max_status_desc \
3244 tlabel .vpane.lower.diff.header.file \
3249 tlabel .vpane.lower.diff.header.path \
3254 pack .vpane.lower.diff.header.status -side left
3255 pack .vpane.lower.diff.header.file -side left
3256 pack .vpane.lower.diff.header.path -fill x
3257 set ctxm .vpane.lower.diff.header.ctxm
3258 menu $ctxm -tearoff 0
3266 -- $current_diff_path
3268 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3269 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3273 ${NS}::frame .vpane.lower.diff.body
3274 set ui_diff .vpane.lower.diff.body.t
3275 text $ui_diff -background white -foreground black \
3277 -width 80 -height 5 -wrap none \
3279 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3280 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3282 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3283 -command [list $ui_diff xview]
3284 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3285 -command [list $ui_diff yview]
3286 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3287 pack .vpane.lower.diff.body.sby -side right -fill y
3288 pack $ui_diff -side left -fill both -expand 1
3289 pack .vpane.lower.diff.header -side top -fill x
3290 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3292 $ui_diff tag conf d_cr -elide true
3293 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
3294 $ui_diff tag conf d_+ -foreground {#00a000}
3295 $ui_diff tag conf d_- -foreground red
3297 $ui_diff tag conf d_++ -foreground {#00a000}
3298 $ui_diff tag conf d_-- -foreground red
3299 $ui_diff tag conf d_+s \
3300 -foreground {#00a000} \
3301 -background {#e2effa}
3302 $ui_diff tag conf d_-s \
3304 -background {#e2effa}
3305 $ui_diff tag conf d_s+ \
3306 -foreground {#00a000} \
3308 $ui_diff tag conf d_s- \
3312 $ui_diff tag conf d<<<<<<< \
3313 -foreground orange \
3315 $ui_diff tag conf d======= \
3316 -foreground orange \
3318 $ui_diff tag conf d>>>>>>> \
3319 -foreground orange \
3322 $ui_diff tag raise sel
3324 # -- Diff Body Context Menu
3327 proc create_common_diff_popup {ctxm} {
3329 -label [mc Refresh] \
3330 -command reshow_diff
3331 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3334 -command {tk_textCopy $ui_diff}
3335 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3337 -label [mc "Select All"] \
3338 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3339 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3341 -label [mc "Copy All"] \
3343 $ui_diff tag add sel 0.0 end
3344 tk_textCopy $ui_diff
3345 $ui_diff tag remove sel 0.0 end
3347 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3350 -label [mc "Decrease Font Size"] \
3351 -command {incr_font_size font_diff -1}
3352 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3354 -label [mc "Increase Font Size"] \
3355 -command {incr_font_size font_diff 1}
3356 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3360 build_encoding_menu $emenu [list force_diff_encoding]
3362 -label [mc "Encoding"] \
3364 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3366 $ctxm add command -label [mc "Options..."] \
3370 set ctxm .vpane.lower.diff.body.ctxm
3371 menu $ctxm -tearoff 0
3373 -label [mc "Apply/Reverse Hunk"] \
3374 -command {apply_hunk $cursorX $cursorY}
3375 set ui_diff_applyhunk [$ctxm index last]
3376 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3378 -label [mc "Apply/Reverse Line"] \
3379 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3380 set ui_diff_applyline [$ctxm index last]
3381 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3384 -label [mc "Show Less Context"] \
3385 -command show_less_context
3386 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3388 -label [mc "Show More Context"] \
3389 -command show_more_context
3390 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3392 create_common_diff_popup $ctxm
3394 set ctxmmg .vpane.lower.diff.body.ctxmmg
3395 menu $ctxmmg -tearoff 0
3396 $ctxmmg add command \
3397 -label [mc "Run Merge Tool"] \
3398 -command {merge_resolve_tool}
3399 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3400 $ctxmmg add separator
3401 $ctxmmg add command \
3402 -label [mc "Use Remote Version"] \
3403 -command {merge_resolve_one 3}
3404 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3405 $ctxmmg add command \
3406 -label [mc "Use Local Version"] \
3407 -command {merge_resolve_one 2}
3408 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3409 $ctxmmg add command \
3410 -label [mc "Revert To Base"] \
3411 -command {merge_resolve_one 1}
3412 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3413 $ctxmmg add separator
3414 $ctxmmg add command \
3415 -label [mc "Show Less Context"] \
3416 -command show_less_context
3417 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3418 $ctxmmg add command \
3419 -label [mc "Show More Context"] \
3420 -command show_more_context
3421 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3422 $ctxmmg add separator
3423 create_common_diff_popup $ctxmmg
3425 set ctxmsm .vpane.lower.diff.body.ctxmsm
3426 menu $ctxmsm -tearoff 0
3427 $ctxmsm add command \
3428 -label [mc "Visualize These Changes In The Submodule"] \
3429 -command {do_gitk -- true}
3430 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3431 $ctxmsm add command \
3432 -label [mc "Visualize Current Branch History In The Submodule"] \
3433 -command {do_gitk {} true}
3434 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3435 $ctxmsm add command \
3436 -label [mc "Visualize All Branch History In The Submodule"] \
3437 -command {do_gitk --all true}
3438 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3439 $ctxmsm add separator
3440 $ctxmsm add command \
3441 -label [mc "Start git gui In The Submodule"] \
3442 -command {do_git_gui}
3443 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3444 $ctxmsm add separator
3445 create_common_diff_popup $ctxmsm
3447 proc has_textconv {path} {
3448 if {[is_config_false gui.textconv]} {
3451 set filter [gitattr $path diff set]
3452 set textconv [get_config [join [list diff $filter textconv] .]]
3453 if {$filter ne {set} && $textconv ne {}} {
3460 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3461 global current_diff_path file_states
3464 if {[info exists file_states($current_diff_path)]} {
3465 set state [lindex $file_states($current_diff_path) 0]
3469 if {[string first {U} $state] >= 0} {
3470 tk_popup $ctxmmg $X $Y
3471 } elseif {$::is_submodule_diff} {
3472 tk_popup $ctxmsm $X $Y
3474 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3475 if {$::ui_index eq $::current_diff_side} {
3476 set l [mc "Unstage Hunk From Commit"]
3478 set t [mc "Unstage Lines From Commit"]
3480 set t [mc "Unstage Line From Commit"]
3483 set l [mc "Stage Hunk For Commit"]
3485 set t [mc "Stage Lines For Commit"]
3487 set t [mc "Stage Line For Commit"]
3491 || $current_diff_path eq {}
3496 || [has_textconv $current_diff_path]} {
3501 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3502 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3503 tk_popup $ctxm $X $Y
3506 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3510 set main_status [::status_bar::new .status]
3511 pack .status -anchor w -side bottom -fill x
3512 $main_status show [mc "Initializing..."]
3516 proc on_ttk_pane_mapped {w pane pos} {
3518 after 0 [list after idle [list $w sashpos $pane $pos]]
3520 proc on_tk_pane_mapped {w pane x y} {
3522 after 0 [list after idle [list $w sash place $pane $x $y]]
3524 proc on_application_mapped {} {
3525 global repo_config use_ttk
3527 set gm $repo_config(gui.geometry)
3530 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3531 bind .vpane.files <Map> \
3532 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3535 [list on_tk_pane_mapped %W 0 \
3537 [lindex [.vpane sash coord 0] 1]]
3538 bind .vpane.files <Map> \
3539 [list on_tk_pane_mapped %W 0 \
3540 [lindex [.vpane.files sash coord 0] 0] \
3543 wm geometry . [lindex $gm 0]
3545 if {[info exists repo_config(gui.geometry)]} {
3546 bind . <Map> [list on_application_mapped]
3547 wm geometry . [lindex $repo_config(gui.geometry) 0]
3550 # -- Load window state
3552 if {[info exists repo_config(gui.wmstate)]} {
3553 catch {wm state . $repo_config(gui.wmstate)}
3558 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3559 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3560 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3561 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3562 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3563 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3564 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3565 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3566 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3567 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3568 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3569 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3570 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3571 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3572 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3573 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3574 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3575 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3576 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3577 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3578 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3579 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3581 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3582 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3583 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3584 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3585 bind $ui_diff <$M1B-Key-v> {break}
3586 bind $ui_diff <$M1B-Key-V> {break}
3587 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3588 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3589 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3590 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3591 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3592 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3593 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3594 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3595 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3596 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3597 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3598 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3599 bind $ui_diff <Button-1> {focus %W}
3601 if {[is_enabled branch]} {
3602 bind . <$M1B-Key-n> branch_create::dialog
3603 bind . <$M1B-Key-N> branch_create::dialog
3604 bind . <$M1B-Key-o> branch_checkout::dialog
3605 bind . <$M1B-Key-O> branch_checkout::dialog
3606 bind . <$M1B-Key-m> merge::dialog
3607 bind . <$M1B-Key-M> merge::dialog
3609 if {[is_enabled transport]} {
3610 bind . <$M1B-Key-p> do_push_anywhere
3611 bind . <$M1B-Key-P> do_push_anywhere
3614 bind . <Key-F5> ui_do_rescan
3615 bind . <$M1B-Key-r> ui_do_rescan
3616 bind . <$M1B-Key-R> ui_do_rescan
3617 bind . <$M1B-Key-s> do_signoff
3618 bind . <$M1B-Key-S> do_signoff
3619 bind . <$M1B-Key-t> do_add_selection
3620 bind . <$M1B-Key-T> do_add_selection
3621 bind . <$M1B-Key-j> do_revert_selection
3622 bind . <$M1B-Key-J> do_revert_selection
3623 bind . <$M1B-Key-i> do_add_all
3624 bind . <$M1B-Key-I> do_add_all
3625 bind . <$M1B-Key-minus> {show_less_context;break}
3626 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3627 bind . <$M1B-Key-equal> {show_more_context;break}
3628 bind . <$M1B-Key-plus> {show_more_context;break}
3629 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3630 bind . <$M1B-Key-Return> do_commit
3631 foreach i [list $ui_index $ui_workdir] {
3632 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3633 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3634 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3638 set file_lists($ui_index) [list]
3639 set file_lists($ui_workdir) [list]
3641 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3642 focus -force $ui_comm
3644 # -- Warn the user about environmental problems. Cygwin's Tcl
3645 # does *not* pass its env array onto any processes it spawns.
3646 # This means that git processes get none of our environment.
3651 set msg [mc "Possible environment issues exist.
3653 The following environment variables are probably
3654 going to be ignored by any Git subprocess run
3658 foreach name [array names env] {
3659 switch -regexp -- $name {
3660 {^GIT_INDEX_FILE$} -
3661 {^GIT_OBJECT_DIRECTORY$} -
3662 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3664 {^GIT_EXTERNAL_DIFF$} -
3668 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3669 append msg " - $name\n"
3672 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3673 append msg " - $name\n"
3675 set suggest_user $name
3679 if {$ignored_env > 0} {
3681 This is due to a known issue with the
3682 Tcl binary distributed by Cygwin."]
3684 if {$suggest_user ne {}} {
3687 A good replacement for %s
3688 is placing values for the user.name and
3689 user.email settings into your personal
3695 unset ignored_env msg suggest_user name
3698 # -- Only initialize complex UI if we are going to stay running.
3700 if {[is_enabled transport]} {
3703 set n [.mbar.remote index end]
3704 populate_remotes_menu
3705 set n [expr {[.mbar.remote index end] - $n}]
3707 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3708 .mbar.remote insert $n separator
3713 if {[winfo exists $ui_comm]} {
3714 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3716 # -- If both our backup and message files exist use the
3717 # newer of the two files to initialize the buffer.
3719 if {$GITGUI_BCK_exists} {
3720 set m [gitdir GITGUI_MSG]
3721 if {[file isfile $m]} {
3722 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3723 catch {file delete [gitdir GITGUI_MSG]}
3725 $ui_comm delete 0.0 end
3727 $ui_comm edit modified false
3728 catch {file delete [gitdir GITGUI_BCK]}
3729 set GITGUI_BCK_exists 0
3735 proc backup_commit_buffer {} {
3736 global ui_comm GITGUI_BCK_exists
3738 set m [$ui_comm edit modified]
3739 if {$m || $GITGUI_BCK_exists} {
3740 set msg [string trim [$ui_comm get 0.0 end]]
3741 regsub -all -line {[ \r\t]+$} $msg {} msg
3744 if {$GITGUI_BCK_exists} {
3745 catch {file delete [gitdir GITGUI_BCK]}
3746 set GITGUI_BCK_exists 0
3750 set fd [open [gitdir GITGUI_BCK] w]
3751 puts -nonewline $fd $msg
3753 set GITGUI_BCK_exists 1
3757 $ui_comm edit modified false
3760 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3763 backup_commit_buffer
3765 # -- If the user has aspell available we can drive it
3766 # in pipe mode to spellcheck the commit message.
3768 set spell_cmd [list |]
3769 set spell_dict [get_config gui.spellingdictionary]
3770 lappend spell_cmd aspell
3771 if {$spell_dict ne {}} {
3772 lappend spell_cmd --master=$spell_dict
3774 lappend spell_cmd --mode=none
3775 lappend spell_cmd --encoding=utf-8
3776 lappend spell_cmd pipe
3777 if {$spell_dict eq {none}
3778 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3779 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3781 set ui_comm_spell [spellcheck::init \
3787 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3790 lock_index begin-read
3791 if {![winfo ismapped .]} {
3795 if {[is_enabled initialamend]} {
3801 if {[is_enabled nocommitmsg]} {
3802 $ui_comm configure -state disabled -background gray
3805 if {[is_enabled multicommit]} {
3808 if {[is_enabled retcode]} {
3809 bind . <Destroy> {+terminate_me %W}
3811 if {$picked && [is_config_true gui.autoexplore]} {
3817 # indent-tabs-mode: t