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
96 # Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
97 if {[tk windowingsystem
] eq
"win32"
98 && [package vcompare
[package provide msgcat
] 1.4.4] < 0
100 proc _mc_update_locale
{} {
101 set key
{HKEY_CURRENT_USER\Control Panel\Desktop
}
103 package require registry
104 set uilocale
[registry get
$key "PreferredUILanguages"]
105 msgcat
::ConvertLocale
[string map
{- _
} [lindex
$uilocale 0]]
107 if {[string length
$uilocale] > 0} {
108 msgcat
::mclocale
$uilocale
115 proc _mc_trim
{fmt} {
116 set cmk
[string first @@
$fmt]
118 return [string range
$fmt 0 [expr {$cmk - 1}]]
123 proc mc
{en_fmt args
} {
124 set fmt [_mc_trim
[::msgcat
::mc
$en_fmt]]
125 if {[catch
{set msg
[eval [list format
$fmt] $args]} err
]} {
126 set msg
[eval [list format
[_mc_trim
$en_fmt]] $args]
132 return [join $args {}]
135 ::msgcat
::mcload
$oguimsg
138 ######################################################################
142 set _appname
{Git Gui
}
151 set _shellpath
{@@SHELL_PATH@@
}
153 set _trace
[lsearch
-exact $argv --trace]
155 set argv
[lreplace
$argv $_trace $_trace]
161 # variable for the last merged branch (useful for a default when deleting
163 set _last_merged_branch
{}
166 global _shellpath env
167 if {[string match @@
* $_shellpath]} {
168 if {[info exists env
(SHELL
)]} {
187 return [eval [list
file join $_gitdir] $args]
190 proc gitexec
{args
} {
192 if {$_gitexec eq
{}} {
193 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
194 error
"Git not installed?\n\n$err"
197 set _gitexec
[exec cygpath \
202 set _gitexec
[file normalize
$_gitexec]
208 return [eval [list
file join $_gitexec] $args]
211 proc githtmldir
{args
} {
213 if {$_githtmldir eq
{}} {
214 if {[catch
{set _githtmldir
[git
--html-path]}]} {
215 # Git not installed or option not yet supported
219 set _githtmldir
[exec cygpath \
224 set _githtmldir
[file normalize
$_githtmldir]
230 return [eval [list
file join $_githtmldir] $args]
238 if {[tk windowingsystem
] eq
{aqua
}} {
245 if {$
::tcl_platform
(platform
) eq
{windows
}} {
253 if {$_iscygwin eq
{}} {
254 if {$
::tcl_platform
(platform
) eq
{windows
}} {
255 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
267 proc is_enabled
{option
} {
268 global enabled_options
269 if {[catch
{set on
$enabled_options($option)}]} {return 0}
273 proc enable_option
{option
} {
274 global enabled_options
275 set enabled_options
($option) 1
278 proc disable_option
{option
} {
279 global enabled_options
280 set enabled_options
($option) 0
283 ######################################################################
287 proc is_many_config
{name
} {
288 switch
-glob -- $name {
298 proc is_config_true
{name
} {
300 if {[catch
{set v
$repo_config($name)}]} {
302 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
309 proc is_config_false
{name
} {
311 if {[catch
{set v
$repo_config($name)}]} {
313 } elseif
{$v eq
{false
} ||
$v eq
{0} ||
$v eq
{no
}} {
320 proc get_config
{name
} {
322 if {[catch
{set v
$repo_config($name)}]} {
334 if {$_isbare eq
{}} {
336 set _bare
[git rev-parse
--is-bare-repository]
338 true
{ set _isbare
1 }
339 false
{ set _isbare
0}
343 if {[is_config_true core.bare
]
344 ||
($_gitworktree eq
{}
345 && [lindex
[file split $_gitdir] end
] ne
{.git
})} {
355 ######################################################################
359 proc _trace_exec
{cmd
} {
360 if {!$
::_trace
} return
366 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
374 #'" fix poor old emacs font-lock mode
376 proc _git_cmd {name} {
379 if {[catch {set v $_git_cmd_path($name)}]} {
383 --exec-path { return [list $::_git $name] }
386 set p [gitexec git-$name$::_search_exe]
387 if {[file exists $p]} {
389 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
390 # Try to determine what sort of magic will make
391 # git-$name go and do its thing, because native
392 # Tcl on Windows doesn't know it.
394 set p [gitexec git-$name]
399 switch -glob -- [lindex $s 0] {
401 #!*perl { set i perl }
402 #!*python { set i python }
403 default { error "git-
$name is not supported
: $s" }
407 if {![info exists interp]} {
408 set interp [_which $i]
411 error "git-
$name requires
$i (not
in PATH
)"
413 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
415 # Assume it is builtin to git somehow and we
416 # aren't actually able to see a file for it.
418 set v [list $::_git $name]
420 set _git_cmd_path($name) $v
425 proc _which {what args} {
426 global env _search_exe _search_path
428 if {$_search_path eq {}} {
429 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
430 set _search_path [split [exec cygpath \
436 } elseif {[is_Windows]} {
437 set gitguidir [file dirname [info script]]
438 regsub -all ";" $gitguidir "\\;" gitguidir
439 set env(PATH) "$gitguidir;$env(PATH
)"
440 set _search_path [split $env(PATH) {;}]
443 set _search_path [split $env(PATH) :]
448 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
451 set suffix $_search_exe
454 foreach p $_search_path {
455 set p [file join $p $what$suffix]
456 if {[file exists $p]} {
457 return [file normalize $p]
463 proc _lappend_nice {cmd_var} {
467 if {![info exists _nice]} {
468 set _nice [_which nice]
469 if {[catch {exec $_nice git version}]} {
471 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
484 switch -- [lindex $args 0] {
495 set args [lrange $args 1 end]
498 set cmdp [_git_cmd [lindex $args 0]]
499 set args [lrange $args 1 end]
501 _trace_exec [concat $opt $cmdp $args]
502 set result [eval exec $opt $cmdp $args]
504 puts stderr "< $result"
509 proc _open_stdout_stderr {cmd} {
512 set fd [open [concat [list | ] $cmd] r]
514 if { [lindex $cmd end] eq {2>@1}
515 && $err eq {can not find channel named "1"}
517 # Older versions of Tcl 8.4 don't have this 2>@1 IO
518 # redirect operator. Fallback to |& cat for those.
519 # The command was not actually started, so its safe
520 # to try to start it a second time.
522 set fd [open [concat \
524 [lrange $cmd 0 end-1] \
531 fconfigure $fd -eofchar {}
535 proc git_read {args} {
539 switch -- [lindex $args 0] {
554 set args [lrange $args 1 end]
557 set cmdp [_git_cmd [lindex $args 0]]
558 set args [lrange $args 1 end]
560 return [_open_stdout_stderr [concat $opt $cmdp $args]]
563 proc git_write {args} {
567 switch -- [lindex $args 0] {
578 set args [lrange $args 1 end]
581 set cmdp [_git_cmd [lindex $args 0]]
582 set args [lrange $args 1 end]
584 _trace_exec [concat $opt $cmdp $args]
585 return [open [concat [list | ] $opt $cmdp $args] w]
588 proc githook_read {hook_name args} {
589 set pchook [gitdir hooks $hook_name]
592 # On Windows [file executable] might lie so we need to ask
593 # the shell if the hook is executable. Yes that's annoying.
597 if {![info exists interp]} {
598 set interp [_which sh]
601 error "hook execution requires sh
(not
in PATH
)"
604 set scr {if test -x "$1";then exec "$@
";fi}
605 set sh_c [list $interp -c $scr $interp $pchook]
606 return [_open_stdout_stderr [concat $sh_c $args]]
609 if {[file executable $pchook]} {
610 return [_open_stdout_stderr [concat [list $pchook] $args]]
616 proc kill_file_process {fd} {
617 set process [pid $fd]
621 # Use a Cygwin-specific flag to allow killing
622 # native Windows processes
623 exec kill -f $process
630 proc gitattr {path attr default} {
631 if {[catch {set r [git check-attr $attr -- $path]}]} {
634 set r [join [lrange [split $r :] 2 end] :]
637 if {$r eq {unspecified}} {
644 regsub -all ' $value "'\\''" value
648 proc load_current_branch {} {
649 global current_branch is_detached
651 set fd [open [gitdir HEAD] r]
652 if {[gets $fd ref] < 1} {
657 set pfx {ref: refs/heads/}
658 set len [string length $pfx]
659 if {[string equal -length $len $pfx $ref]} {
660 # We're on a branch. It might not exist. But
661 # HEAD looks good enough to be a branch.
663 set current_branch
[string range
$ref $len end
]
666 # Assume this is a detached head.
668 set current_branch HEAD
673 auto_load tk_optionMenu
674 rename tk_optionMenu real__tkOptionMenu
675 proc tk_optionMenu
{w varName args
} {
676 set m
[eval real__tkOptionMenu
$w $varName $args]
677 $m configure
-font font_ui
678 $w configure
-font font_ui
682 proc rmsel_tag
{text
} {
684 -background [$text cget
-background] \
685 -foreground [$text cget
-foreground] \
687 $text tag conf in_sel
-background lightgray
688 bind $text <Motion
> break
694 bind .
<Visibility
> {
695 bind .
<Visibility
> {}
700 wm iconbitmap .
-default $oguilib/git-gui.ico
701 set ::tk
::AlwaysShowSelection
1
702 bind .
<Control-F2
> {console show
}
704 # Spoof an X11 display for SSH
705 if {![info exists env
(DISPLAY
)]} {
706 set env
(DISPLAY
) :9999
710 image create photo gitlogo
-width 16 -height 16
712 gitlogo put
#33CC33 -to 7 0 9 2
713 gitlogo put
#33CC33 -to 4 2 12 4
714 gitlogo put
#33CC33 -to 7 4 9 6
715 gitlogo put
#CC3333 -to 4 6 12 8
716 gitlogo put gray26
-to 4 9 6 10
717 gitlogo put gray26
-to 3 10 6 12
718 gitlogo put gray26
-to 8 9 13 11
719 gitlogo put gray26
-to 8 11 10 12
720 gitlogo put gray26
-to 11 11 13 14
721 gitlogo put gray26
-to 3 12 5 14
722 gitlogo put gray26
-to 5 13
723 gitlogo put gray26
-to 10 13
724 gitlogo put gray26
-to 4 14 12 15
725 gitlogo put gray26
-to 5 15 11 16
728 wm iconphoto .
-default gitlogo
732 ######################################################################
738 if {[lsearch
-exact [font names
] TkDefaultFont
] != -1} {
739 eval [linsert
[font actual TkDefaultFont
] 0 font configure font_ui
]
740 eval [linsert
[font actual TkFixedFont
] 0 font create font_diff
]
742 font create font_diff
-family Courier
-size 10
745 eval font configure font_ui
[font actual
[.dummy cget
-font]]
750 font create font_uiitalic
751 font create font_uibold
752 font create font_diffbold
753 font create font_diffitalic
755 foreach class
{Button Checkbutton Entry Label
756 Labelframe Listbox Message
757 Radiobutton Spinbox Text
} {
758 option add
*$class.font font_ui
761 option add
*Menu.font font_ui
762 option add
*Entry.borderWidth
1 startupFile
763 option add
*Entry.relief sunken startupFile
764 option add
*RadioButton.anchor w startupFile
768 if {[is_Windows
] ||
[is_MacOSX
]} {
769 option add
*Menu.tearOff
0
780 proc bind_button3
{w cmd
} {
781 bind $w <Any-Button-3
> $cmd
783 # Mac OS X sends Button-2 on right click through three-button mouse,
784 # or through trackpad right-clicking (two-finger touch + click).
785 bind $w <Any-Button-2
> $cmd
786 bind $w <Control-Button-1
> $cmd
790 proc apply_config
{} {
791 global repo_config font_descs
793 foreach option
$font_descs {
794 set name
[lindex
$option 0]
795 set font
[lindex
$option 1]
798 foreach
{cn cv
} $repo_config(gui.
$name) {
799 if {$cn eq
{-weight}} {
802 font configure
$font $cn $cv
805 font configure
$font -weight normal
808 error_popup
[strcat
[mc
"Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
810 foreach
{cn cv
} [font configure
$font] {
811 font configure
${font}bold
$cn $cv
812 font configure
${font}italic
$cn $cv
814 font configure
${font}bold
-weight bold
815 font configure
${font}italic
-slant italic
821 if {$repo_config(gui.usettk
)} {
822 set use_ttk
[package vsatisfies
[package provide Tk
] 8.5]
825 bind [winfo class .
] <<ThemeChanged>> [list InitTheme]
831 set default_config(branch.autosetupmerge) true
832 set default_config(merge.tool) {}
833 set default_config(mergetool.keepbackup) true
834 set default_config(merge.diffstat) true
835 set default_config(merge.summary) false
836 set default_config(merge.verbosity) 2
837 set default_config(user.name) {}
838 set default_config(user.email) {}
840 set default_config(gui.encoding) [encoding system]
841 set default_config(gui.matchtrackingbranch) false
842 set default_config(gui.textconv) true
843 set default_config(gui.pruneduringfetch) false
844 set default_config(gui.trustmtime) false
845 set default_config(gui.fastcopyblame) false
846 set default_config(gui.copyblamethreshold) 40
847 set default_config(gui.blamehistoryctx) 7
848 set default_config(gui.diffcontext) 5
849 set default_config(gui.commitmsgwidth) 75
850 set default_config(gui.newbranchtemplate) {}
851 set default_config(gui.spellingdictionary) {}
852 set default_config(gui.fontui) [font configure font_ui]
853 set default_config(gui.fontdiff) [font configure font_diff]
854 # TODO: this option should be added to the git-config documentation
855 set default_config(gui.maxfilesdisplayed) 5000
856 set default_config(gui.usettk) 1
857 set default_config(gui.warndetachedcommit) 1
859 {fontui font_ui {mc "Main Font"}}
860 {fontdiff font_diff {mc "Diff/Console Font"}}
863 ######################################################################
867 set _git [_which git]
869 catch {wm withdraw .}
873 -title [mc "git-gui: fatal error"] \
874 -message [mc "Cannot find git in PATH."]
878 ######################################################################
882 if {[catch {set _git_version [git --version]} err]} {
883 catch {wm withdraw .}
887 -title [mc "git-gui: fatal error"] \
888 -message "Cannot determine Git version:
892 [appname] requires Git 1.5.0 or later."
895 if {![regsub {^git version } $_git_version {} _git_version]} {
896 catch {wm withdraw .}
900 -title [mc "git-gui: fatal error"] \
901 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
905 proc get_trimmed_version {s} {
907 foreach x [split $s -._] {
908 if {[string is integer -strict $x]} {
916 set _real_git_version $_git_version
917 set _git_version [get_trimmed_version $_git_version]
919 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
920 catch {wm withdraw .}
925 -title "[appname]: warning" \
926 -message [mc "Git version cannot be determined.
928 %s claims it is version '%s'.
930 %s requires at least Git 1.5.0 or later.
932 Assume '%s' is version 1.5.0?
933 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
934 set _git_version 1.5.0
939 unset _real_git_version
941 proc git-version {args} {
944 switch [llength $args] {
950 set op [lindex $args 0]
951 set vr [lindex $args 1]
952 set cm [package vcompare $_git_version $vr]
953 return [expr $cm $op 0]
957 set type [lindex $args 0]
958 set name [lindex $args 1]
959 set parm [lindex $args 2]
960 set body [lindex $args 3]
962 if {($type ne {proc} && $type ne {method})} {
963 error "Invalid arguments to git-version"
965 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
966 error "Last arm of $type $name must be default"
969 foreach {op vr cb} [lrange $body 0 end-2] {
970 if {[git-version $op $vr]} {
971 return [uplevel [list $type $name $parm $cb]]
975 return [uplevel [list $type $name $parm [lindex $body end]]]
979 error "git-version >= x"
985 if {[git-version < 1.5]} {
986 catch {wm withdraw .}
990 -title [mc "git-gui: fatal error"] \
991 -message "[appname] requires Git 1.5.0 or later.
993 You are using [git-version]:
999 ######################################################################
1001 ## configure our library
1003 set idx [file join $oguilib tclIndex]
1004 if {[catch {set fd [open $idx r]} err]} {
1005 catch {wm withdraw .}
1009 -title [mc "git-gui: fatal error"] \
1013 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1015 while {[gets $fd n] >= 0} {
1016 if {$n ne {} && ![string match #* $n]} {
1028 if {[lsearch -exact $loaded $p] >= 0} continue
1029 source [file join $oguilib $p]
1034 set auto_path [concat [list $oguilib] $auto_path]
1036 unset -nocomplain idx fd
1038 ######################################################################
1040 ## config file parsing
1042 git-version proc _parse_config {arr_name args} {
1049 [list git_read config] \
1051 [list --null --list]]
1052 fconfigure $fd_rc -translation binary
1053 set buf [read $fd_rc]
1056 foreach line [split $buf "\0"] {
1057 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1058 if {[is_many_config $name]} {
1059 lappend arr($name) $value
1061 set arr($name) $value
1070 set fd_rc [eval [list git_read config --list] $args]
1071 while {[gets $fd_rc line] >= 0} {
1072 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1073 if {[is_many_config $name]} {
1074 lappend arr($name) $value
1076 set arr($name) $value
1085 proc load_config {include_global} {
1086 global repo_config global_config system_config default_config
1088 if {$include_global} {
1089 _parse_config system_config --system
1090 _parse_config global_config --global
1092 _parse_config repo_config
1094 foreach name [array names default_config] {
1095 if {[catch {set v $system_config($name)}]} {
1096 set system_config($name) $default_config($name)
1099 foreach name [array names system_config] {
1100 if {[catch {set v $global_config($name)}]} {
1101 set global_config($name) $system_config($name)
1103 if {[catch {set v $repo_config($name)}]} {
1104 set repo_config($name) $system_config($name)
1109 ######################################################################
1111 ## feature option selection
1113 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1118 if {$subcommand eq {gui.sh}} {
1121 if {$subcommand eq {gui} && [llength $argv] > 0} {
1122 set subcommand [lindex $argv 0]
1123 set argv [lrange $argv 1 end]
1126 enable_option multicommit
1127 enable_option branch
1128 enable_option transport
1131 switch -- $subcommand {
1136 disable_option multicommit
1137 disable_option branch
1138 disable_option transport
1141 enable_option singlecommit
1142 enable_option retcode
1144 disable_option multicommit
1145 disable_option branch
1146 disable_option transport
1148 while {[llength $argv] > 0} {
1149 set a [lindex $argv 0]
1152 enable_option initialamend
1155 enable_option nocommit
1156 enable_option nocommitmsg
1159 disable_option nocommitmsg
1166 set argv [lrange $argv 1 end]
1171 ######################################################################
1173 ## execution environment
1175 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1177 # Suggest our implementation of askpass, if none is set
1178 if {![info exists env(SSH_ASKPASS)]} {
1179 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1182 ######################################################################
1188 set _gitdir $env(GIT_DIR)
1192 # beware that from the .git dir this sets _gitdir to .
1193 # and _prefix to the empty string
1194 set _gitdir [git rev-parse --git-dir]
1195 set _prefix [git rev-parse --show-prefix]
1199 choose_repository::pick
1203 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1204 # run from the .git dir itself) lest the routines to find the worktree
1206 if {$_gitdir eq "."} {
1210 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1211 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1213 if {![file isdirectory $_gitdir]} {
1214 catch {wm withdraw .}
1215 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1218 # _gitdir exists, so try loading the config
1222 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
1223 if {[package vsatisfies $_git_version 1.7.0]} {
1224 set _gitworktree [git rev-parse --show-toplevel]
1226 # try to set work tree from environment, core.worktree or use
1227 # cdup to obtain a relative path to the top of the worktree. If
1228 # run from the top, the ./ prefix ensures normalize expands pwd.
1229 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1230 set _gitworktree [get_config core.worktree]
1231 if {$_gitworktree eq ""} {
1232 set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1237 if {$_prefix ne {}} {
1238 if {$_gitworktree eq {}} {
1239 regsub -all {[^/]+/} $_prefix ../ cdup
1241 set cdup $_gitworktree
1243 if {[catch {cd $cdup} err]} {
1244 catch {wm withdraw .}
1245 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1248 set _gitworktree [pwd]
1250 } elseif {![is_enabled bare]} {
1252 catch {wm withdraw .}
1253 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1256 if {$_gitworktree eq {}} {
1257 set _gitworktree [file dirname $_gitdir]
1259 if {[catch {cd $_gitworktree} err]} {
1260 catch {wm withdraw .}
1261 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1264 set _gitworktree [pwd]
1266 set _reponame [file split [file normalize $_gitdir]]
1267 if {[lindex $_reponame end] eq {.git}} {
1268 set _reponame [lindex $_reponame end-1]
1270 set _reponame [lindex $_reponame end]
1273 ######################################################################
1277 set current_diff_path {}
1278 set current_diff_side {}
1279 set diff_actions [list]
1283 set MERGE_HEAD [list]
1286 set current_branch {}
1288 set current_diff_path {}
1290 set is_submodule_diff 0
1291 set is_conflict_diff 0
1292 set selected_commit_type new
1293 set diff_empty_count 0
1295 set nullid "0000000000000000000000000000000000000000"
1296 set nullid2 "0000000000000000000000000000000000000001"
1298 ######################################################################
1306 set disable_on_lock [list]
1307 set index_lock_type none
1309 proc lock_index {type} {
1310 global index_lock_type disable_on_lock
1312 if {$index_lock_type eq {none}} {
1313 set index_lock_type $type
1314 foreach w $disable_on_lock {
1315 uplevel #0 $w disabled
1318 } elseif {$index_lock_type eq "begin-$type"} {
1319 set index_lock_type $type
1325 proc unlock_index {} {
1326 global index_lock_type disable_on_lock
1328 set index_lock_type none
1329 foreach w $disable_on_lock {
1330 uplevel #0 $w normal
1334 ######################################################################
1338 proc repository_state {ctvar hdvar mhvar} {
1339 global current_branch
1340 upvar $ctvar ct $hdvar hd $mhvar mh
1345 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1351 set merge_head [gitdir MERGE_HEAD]
1352 if {[file exists $merge_head]} {
1354 set fd_mh [open $merge_head r]
1355 while {[gets $fd_mh line] >= 0} {
1366 global PARENT empty_tree
1368 set p [lindex $PARENT 0]
1372 if {$empty_tree eq {}} {
1373 set empty_tree [git mktree << {}]
1378 proc force_amend {} {
1379 global selected_commit_type
1380 global HEAD PARENT MERGE_HEAD commit_type
1382 repository_state newType newHEAD newMERGE_HEAD
1385 set MERGE_HEAD $newMERGE_HEAD
1386 set commit_type $newType
1388 set selected_commit_type amend
1389 do_select_commit_type
1392 proc rescan {after {honor_trustmtime 1}} {
1393 global HEAD PARENT MERGE_HEAD commit_type
1394 global ui_index ui_workdir ui_comm
1395 global rescan_active file_states
1398 if {$rescan_active > 0 || ![lock_index read]} return
1400 repository_state newType newHEAD newMERGE_HEAD
1401 if {[string match amend* $commit_type]
1402 && $newType eq {normal}
1403 && $newHEAD eq $HEAD} {
1407 set MERGE_HEAD $newMERGE_HEAD
1408 set commit_type $newType
1411 array unset file_states
1413 if {!$::GITGUI_BCK_exists &&
1414 (![$ui_comm edit modified]
1415 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1416 if {[string match amend* $commit_type]} {
1417 } elseif {[load_message GITGUI_MSG]} {
1418 } elseif {[run_prepare_commit_msg_hook]} {
1419 } elseif {[load_message MERGE_MSG]} {
1420 } elseif {[load_message SQUASH_MSG]} {
1423 $ui_comm edit modified false
1426 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1427 rescan_stage2 {} $after
1430 ui_status [mc "Refreshing file status..."]
1431 set fd_rf [git_read update-index \
1437 fconfigure $fd_rf -blocking 0 -translation binary
1438 fileevent $fd_rf readable \
1439 [list rescan_stage2 $fd_rf $after]
1444 set is_git_info_exclude {}
1445 proc have_info_exclude {} {
1446 global is_git_info_exclude
1448 if {$is_git_info_exclude eq {}} {
1449 if {[catch {exec test -f [gitdir info exclude]}]} {
1450 set is_git_info_exclude 0
1452 set is_git_info_exclude 1
1455 return $is_git_info_exclude
1458 proc have_info_exclude {} {
1459 return [file readable [gitdir info exclude]]
1463 proc rescan_stage2 {fd after} {
1464 global rescan_active buf_rdi buf_rdf buf_rlo
1468 if {![eof $fd]} return
1472 if {[package vsatisfies $::_git_version 1.6.3]} {
1473 set ls_others [list --exclude-standard]
1475 set ls_others [list --exclude-per-directory=.gitignore]
1476 if {[have_info_exclude]} {
1477 lappend ls_others "--exclude-from=[gitdir info exclude]"
1479 set user_exclude [get_config core.excludesfile]
1480 if {$user_exclude ne {} && [file readable $user_exclude]} {
1481 lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1490 ui_status [mc "Scanning for modified files ..."]
1491 set fd_di [git_read diff-index --cached -z [PARENT]]
1492 set fd_df [git_read diff-files -z]
1493 set fd_lo [eval git_read ls-files --others -z $ls_others]
1495 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1496 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1497 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1498 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1499 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1500 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1503 proc load_message {file} {
1506 set f [gitdir $file]
1507 if {[file isfile $f]} {
1508 if {[catch {set fd [open $f r]}]} {
1511 fconfigure $fd -eofchar {}
1512 set content [string trim [read $fd]]
1514 regsub -all -line {[ \r\t]+$} $content {} content
1515 $ui_comm delete 0.0 end
1516 $ui_comm insert end $content
1522 proc run_prepare_commit_msg_hook {} {
1525 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1526 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1527 # empty file but existent file.
1529 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1531 if {[file isfile [gitdir MERGE_MSG]]} {
1532 set pcm_source "merge"
1533 set fd_mm [open [gitdir MERGE_MSG] r]
1534 puts -nonewline $fd_pcm [read $fd_mm]
1536 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1537 set pcm_source "squash"
1538 set fd_sm [open [gitdir SQUASH_MSG] r]
1539 puts -nonewline $fd_pcm [read $fd_sm]
1547 set fd_ph [githook_read prepare-commit-msg \
1548 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1550 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1554 ui_status [mc "Calling prepare-commit-msg hook..."]
1557 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1558 fileevent $fd_ph readable \
1559 [list prepare_commit_msg_hook_wait $fd_ph]
1564 proc prepare_commit_msg_hook_wait {fd_ph} {
1567 append pch_error [read $fd_ph]
1568 fconfigure $fd_ph -blocking 1
1570 if {[catch {close $fd_ph}]} {
1571 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1572 hook_failed_popup prepare-commit-msg $pch_error
1573 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1576 load_message PREPARE_COMMIT_MSG
1579 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1582 fconfigure $fd_ph -blocking 0
1583 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1586 proc read_diff_index {fd after} {
1589 append buf_rdi [read $fd]
1591 set n [string length $buf_rdi]
1593 set z1 [string first "\0" $buf_rdi $c]
1594 if {$z1 == -1} break
1596 set z2 [string first "\0" $buf_rdi $z1]
1597 if {$z2 == -1} break
1600 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1601 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1603 [encoding convertfrom $p] \
1605 [list [lindex $i 0] [lindex $i 2]] \
1611 set buf_rdi [string range $buf_rdi $c end]
1616 rescan_done $fd buf_rdi $after
1619 proc read_diff_files {fd after} {
1622 append buf_rdf [read $fd]
1624 set n [string length $buf_rdf]
1626 set z1 [string first "\0" $buf_rdf $c]
1627 if {$z1 == -1} break
1629 set z2 [string first "\0" $buf_rdf $z1]
1630 if {$z2 == -1} break
1633 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1634 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1636 [encoding convertfrom $p] \
1639 [list [lindex $i 0] [lindex $i 2]]
1644 set buf_rdf [string range $buf_rdf $c end]
1649 rescan_done $fd buf_rdf $after
1652 proc read_ls_others {fd after} {
1655 append buf_rlo [read $fd]
1656 set pck [split $buf_rlo "\0"]
1657 set buf_rlo [lindex $pck end]
1658 foreach p [lrange $pck 0 end-1] {
1659 set p [encoding convertfrom $p]
1660 if {[string index $p end] eq {/}} {
1661 set p [string range $p 0 end-1]
1665 rescan_done $fd buf_rlo $after
1668 proc rescan_done {fd buf after} {
1669 global rescan_active current_diff_path
1670 global file_states repo_config
1673 if {![eof $fd]} return
1676 if {[incr rescan_active -1] > 0} return
1681 if {$current_diff_path ne {}} { reshow_diff $after }
1682 if {$current_diff_path eq {}} { select_first_diff $after }
1685 proc prune_selection {} {
1686 global file_states selected_paths
1688 foreach path [array names selected_paths] {
1689 if {[catch {set still_here $file_states($path)}]} {
1690 unset selected_paths($path)
1695 ######################################################################
1699 proc mapicon {w state path} {
1702 if {[catch {set r $all_icons($state$w)}]} {
1703 puts "error: no icon for $w state={$state} $path"
1709 proc mapdesc {state path} {
1712 if {[catch {set r $all_descs($state)}]} {
1713 puts "error: no desc for state={$state} $path"
1719 proc ui_status {msg} {
1721 if {[info exists main_status]} {
1722 $main_status show $msg
1726 proc ui_ready {{test {}}} {
1728 if {[info exists main_status]} {
1729 $main_status show [mc "Ready."] $test
1733 proc escape_path {path} {
1734 regsub -all {\\} $path "\\\\" path
1735 regsub -all "\n" $path "\\n" path
1739 proc short_path {path} {
1740 return [escape_path [lindex [file split $path] end]]
1744 set null_sha1 [string repeat 0 40]
1746 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1747 global file_states next_icon_id null_sha1
1749 set s0 [string index $new_state 0]
1750 set s1 [string index $new_state 1]
1752 if {[catch {set info $file_states($path)}]} {
1754 set icon n[incr next_icon_id]
1756 set state [lindex $info 0]
1757 set icon [lindex $info 1]
1758 if {$head_info eq {}} {set head_info [lindex $info 2]}
1759 if {$index_info eq {}} {set index_info [lindex $info 3]}
1762 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1763 elseif {$s0 eq {_}} {set s0 _}
1765 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1766 elseif {$s1 eq {_}} {set s1 _}
1768 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1769 set head_info [list 0 $null_sha1]
1770 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1771 && $head_info eq {}} {
1772 set head_info $index_info
1773 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1774 set index_info $head_info
1778 set file_states($path) [list $s0$s1 $icon \
1779 $head_info $index_info \
1784 proc display_file_helper {w path icon_name old_m new_m} {
1787 if {$new_m eq {_}} {
1788 set lno [lsearch -sorted -exact $file_lists($w) $path]
1790 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1792 $w conf -state normal
1793 $w delete $lno.0 [expr {$lno + 1}].0
1794 $w conf -state disabled
1796 } elseif {$old_m eq {_} && $new_m ne {_}} {
1797 lappend file_lists($w) $path
1798 set file_lists($w) [lsort -unique $file_lists($w)]
1799 set lno [lsearch -sorted -exact $file_lists($w) $path]
1801 $w conf -state normal
1802 $w image create $lno.0 \
1803 -align center -padx 5 -pady 1 \
1805 -image [mapicon $w $new_m $path]
1806 $w insert $lno.1 "[escape_path $path]\n"
1807 $w conf -state disabled
1808 } elseif {$old_m ne $new_m} {
1809 $w conf -state normal
1810 $w image conf $icon_name -image [mapicon $w $new_m $path]
1811 $w conf -state disabled
1815 proc display_file {path state} {
1816 global file_states selected_paths
1817 global ui_index ui_workdir
1819 set old_m [merge_state $path $state]
1820 set s $file_states($path)
1821 set new_m [lindex $s 0]
1822 set icon_name [lindex $s 1]
1824 set o [string index $old_m 0]
1825 set n [string index $new_m 0]
1832 display_file_helper $ui_index $path $icon_name $o $n
1834 if {[string index $old_m 0] eq {U}} {
1837 set o [string index $old_m 1]
1839 if {[string index $new_m 0] eq {U}} {
1842 set n [string index $new_m 1]
1844 display_file_helper $ui_workdir $path $icon_name $o $n
1846 if {$new_m eq {__}} {
1847 unset file_states($path)
1848 catch {unset selected_paths($path)}
1852 proc display_all_files_helper {w path icon_name m} {
1855 lappend file_lists($w) $path
1856 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1857 $w image create end \
1858 -align center -padx 5 -pady 1 \
1860 -image [mapicon $w $m $path]
1861 $w insert end "[escape_path $path]\n"
1865 proc display_all_files {} {
1866 global ui_index ui_workdir
1867 global file_states file_lists
1869 global files_warning
1871 $ui_index conf -state normal
1872 $ui_workdir conf -state normal
1874 $ui_index delete 0.0 end
1875 $ui_workdir delete 0.0 end
1878 set file_lists($ui_index) [list]
1879 set file_lists($ui_workdir) [list]
1881 set to_display [lsort [array names file_states]]
1882 set display_limit [get_config gui.maxfilesdisplayed]
1883 if {[llength $to_display] > $display_limit} {
1884 if {!$files_warning} {
1885 # do not repeatedly warn:
1887 info_popup [mc "Displaying only %s of %s files." \
1888 $display_limit [llength $to_display]]
1890 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1892 foreach path $to_display {
1893 set s $file_states($path)
1895 set icon_name [lindex $s 1]
1897 set s [string index $m 0]
1898 if {$s ne {U} && $s ne {_}} {
1899 display_all_files_helper $ui_index $path \
1903 if {[string index $m 0] eq {U}} {
1906 set s [string index $m 1]
1909 display_all_files_helper $ui_workdir $path \
1914 $ui_index conf -state disabled
1915 $ui_workdir conf -state disabled
1918 ######################################################################
1923 #define mask_width 14
1924 #define mask_height 15
1925 static unsigned char mask_bits[] = {
1926 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1927 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1928 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1931 image create bitmap file_plain -background white -foreground black -data {
1932 #define plain_width 14
1933 #define plain_height 15
1934 static unsigned char plain_bits[] = {
1935 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1936 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1937 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1938 } -maskdata $filemask
1940 image create bitmap file_mod -background white -foreground blue -data {
1941 #define mod_width 14
1942 #define mod_height 15
1943 static unsigned char mod_bits[] = {
1944 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1945 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1946 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1947 } -maskdata $filemask
1949 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1950 #define file_fulltick_width 14
1951 #define file_fulltick_height 15
1952 static unsigned char file_fulltick_bits[] = {
1953 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1954 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1955 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1956 } -maskdata $filemask
1958 image create bitmap file_question -background white -foreground black -data {
1959 #define file_question_width 14
1960 #define file_question_height 15
1961 static unsigned char file_question_bits[] = {
1962 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1963 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1964 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1965 } -maskdata $filemask
1967 image create bitmap file_removed -background white -foreground red -data {
1968 #define file_removed_width 14
1969 #define file_removed_height 15
1970 static unsigned char file_removed_bits[] = {
1971 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1972 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1973 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1974 } -maskdata $filemask
1976 image create bitmap file_merge -background white -foreground blue -data {
1977 #define file_merge_width 14
1978 #define file_merge_height 15
1979 static unsigned char file_merge_bits[] = {
1980 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1981 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1982 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1983 } -maskdata $filemask
1985 image create bitmap file_statechange -background white -foreground green -data {
1986 #define file_statechange_width 14
1987 #define file_statechange_height 15
1988 static unsigned char file_statechange_bits[] = {
1989 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1990 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1991 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1992 } -maskdata $filemask
1994 set ui_index .vpane.files.index.list
1995 set ui_workdir .vpane.files.workdir.list
1997 set all_icons(_$ui_index) file_plain
1998 set all_icons(A$ui_index) file_plain
1999 set all_icons(M$ui_index) file_fulltick
2000 set all_icons(D$ui_index) file_removed
2001 set all_icons(U$ui_index) file_merge
2002 set all_icons(T$ui_index) file_statechange
2004 set all_icons(_$ui_workdir) file_plain
2005 set all_icons(M$ui_workdir) file_mod
2006 set all_icons(D$ui_workdir) file_question
2007 set all_icons(U$ui_workdir) file_merge
2008 set all_icons(O$ui_workdir) file_plain
2009 set all_icons(T$ui_workdir) file_statechange
2011 set max_status_desc 0
2013 {__ {mc "Unmodified"}}
2015 {_M {mc "Modified, not staged"}}
2016 {M_ {mc "Staged for commit"}}
2017 {MM {mc "Portions staged for commit"}}
2018 {MD {mc "Staged for commit, missing"}}
2020 {_T {mc "File type changed, not staged"}}
2021 {MT {mc "File type changed, old type staged for commit"}}
2022 {AT {mc "File type changed, old type staged for commit"}}
2023 {T_ {mc "File type changed, staged"}}
2024 {TM {mc "File type change staged, modification not staged"}}
2025 {TD {mc "File type change staged, file missing"}}
2027 {_O {mc "Untracked, not staged"}}
2028 {A_ {mc "Staged for commit"}}
2029 {AM {mc "Portions staged for commit"}}
2030 {AD {mc "Staged for commit, missing"}}
2033 {D_ {mc "Staged for removal"}}
2034 {DO {mc "Staged for removal, still present"}}
2036 {_U {mc "Requires merge resolution"}}
2037 {U_ {mc "Requires merge resolution"}}
2038 {UU {mc "Requires merge resolution"}}
2039 {UM {mc "Requires merge resolution"}}
2040 {UD {mc "Requires merge resolution"}}
2041 {UT {mc "Requires merge resolution"}}
2043 set text [eval [lindex $i 1]]
2044 if {$max_status_desc < [string length $text]} {
2045 set max_status_desc [string length $text]
2047 set all_descs([lindex $i 0]) $text
2051 ######################################################################
2055 proc scrollbar2many {list mode args} {
2056 foreach w $list {eval $w $mode $args}
2059 proc many2scrollbar {list mode sb top bottom} {
2060 $sb set $top $bottom
2061 foreach w $list {$w $mode moveto $top}
2064 proc incr_font_size {font {amt 1}} {
2065 set sz [font configure $font -size]
2067 font configure $font -size $sz
2068 font configure ${font}bold -size $sz
2069 font configure ${font}italic -size $sz
2072 ######################################################################
2076 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2078 proc do_gitk {revs {is_submodule false}} {
2079 global current_diff_path file_states current_diff_side ui_index
2082 # -- Always start gitk through whatever we were loaded with. This
2083 # lets us bypass using shell process on Windows systems.
2085 set exe [_which gitk -script]
2086 set cmd [list [info nameofexecutable] $exe]
2088 error_popup [mc "Couldn't find gitk in PATH"]
2092 if {[info exists env(GIT_DIR)]} {
2093 set old_GIT_DIR $env(GIT_DIR)
2100 if {!$is_submodule} {
2104 set env(GIT_DIR) [file normalize [gitdir]]
2106 cd $current_diff_path
2107 if {$revs eq {--}} {
2108 set s $file_states($current_diff_path)
2111 switch -glob -- [lindex $s 0] {
2112 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2113 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2115 if {$current_diff_side eq $ui_index} {
2116 set old_sha1 [lindex [lindex $s 2] 1]
2117 set new_sha1 [lindex [lindex $s 3] 1]
2119 set old_sha1 [lindex [lindex $s 3] 1]
2123 set revs $old_sha1...$new_sha1
2125 if {[info exists env(GIT_DIR)]} {
2129 eval exec $cmd $revs "--" "--" &
2131 if {$old_GIT_DIR ne {}} {
2132 set env(GIT_DIR) $old_GIT_DIR
2136 ui_status $::starting_gitk_msg
2138 ui_ready $starting_gitk_msg
2143 proc do_git_gui {} {
2144 global current_diff_path
2146 # -- Always start git gui through whatever we were loaded with. This
2147 # lets us bypass using shell process on Windows systems.
2149 set exe [list [_which git]]
2151 error_popup [mc "Couldn't find git gui in PATH"]
2155 if {[info exists env(GIT_DIR)]} {
2156 set old_GIT_DIR $env(GIT_DIR)
2163 cd $current_diff_path
2165 eval exec $exe gui &
2167 if {$old_GIT_DIR ne {}} {
2168 set env(GIT_DIR) $old_GIT_DIR
2172 ui_status $::starting_gitk_msg
2174 ui_ready $starting_gitk_msg
2179 proc do_explore {} {
2182 if {[is_Cygwin] || [is_Windows]} {
2183 set explorer "explorer.exe"
2184 } elseif {[is_MacOSX]} {
2187 # freedesktop.org-conforming system is our best shot
2188 set explorer "xdg-open"
2190 eval exec $explorer [list [file nativename $_gitworktree]] &
2196 proc terminate_me {win} {
2198 if {$win ne {.}} return
2202 proc do_quit {{rc {1}}} {
2203 global ui_comm is_quitting repo_config commit_type
2204 global GITGUI_BCK_exists GITGUI_BCK_i
2205 global ui_comm_spell
2206 global ret_code use_ttk
2208 if {$is_quitting} return
2211 if {[winfo exists $ui_comm]} {
2212 # -- Stash our current commit buffer.
2214 set save [gitdir GITGUI_MSG]
2215 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2216 file rename -force [gitdir GITGUI_BCK] $save
2217 set GITGUI_BCK_exists 0
2219 set msg [string trim [$ui_comm get 0.0 end]]
2220 regsub -all -line {[ \r\t]+$} $msg {} msg
2221 if {(![string match amend* $commit_type]
2222 || [$ui_comm edit modified])
2225 set fd [open $save w]
2226 puts -nonewline $fd $msg
2230 catch {file delete $save}
2234 # -- Cancel our spellchecker if its running.
2236 if {[info exists ui_comm_spell]} {
2240 # -- Remove our editor backup, its not needed.
2242 after cancel $GITGUI_BCK_i
2243 if {$GITGUI_BCK_exists} {
2244 catch {file delete [gitdir GITGUI_BCK]}
2247 # -- Stash our current window geometry into this repository.
2249 set cfg_wmstate [wm state .]
2250 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2253 if {$cfg_wmstate ne $rc_wmstate} {
2254 catch {git config gui.wmstate $cfg_wmstate}
2256 if {$cfg_wmstate eq {zoomed}} {
2257 # on Windows wm geometry will lie about window
2258 # position (but not size) when window is zoomed
2259 # restore the window before querying wm geometry
2262 set cfg_geometry [list]
2263 lappend cfg_geometry [wm geometry .]
2265 lappend cfg_geometry [.vpane sashpos 0]
2266 lappend cfg_geometry [.vpane.files sashpos 0]
2268 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2269 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2271 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2274 if {$cfg_geometry ne $rc_geometry} {
2275 catch {git config gui.geometry $cfg_geometry}
2281 # Briefly enable send again, working around Tk bug
2282 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2283 tk appname [appname]
2292 proc ui_do_rescan {} {
2293 rescan {force_first_diff ui_ready}
2300 proc next_diff {{after {}}} {
2301 global next_diff_p next_diff_w next_diff_i
2302 show_diff $next_diff_p $next_diff_w {} {} $after
2305 proc find_anchor_pos {lst name} {
2306 set lid [lsearch -sorted -exact $lst $name]
2310 foreach lname $lst {
2311 if {$lname >= $name} break
2319 proc find_file_from {flist idx delta path mmask} {
2322 set len [llength $flist]
2323 while {$idx >= 0 && $idx < $len} {
2324 set name [lindex $flist $idx]
2326 if {$name ne $path && [info exists file_states($name)]} {
2327 set state [lindex $file_states($name) 0]
2329 if {$mmask eq {} || [regexp $mmask $state]} {
2340 proc find_next_diff {w path {lno {}} {mmask {}}} {
2341 global next_diff_p next_diff_w next_diff_i
2342 global file_lists ui_index ui_workdir
2344 set flist $file_lists($w)
2346 set lno [find_anchor_pos $flist $path]
2351 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2352 if {$w eq $ui_index} {
2355 set mmask "$mmask\$"
2359 set idx [find_file_from $flist $lno 1 $path $mmask]
2362 set idx [find_file_from $flist $lno -1 $path $mmask]
2367 set next_diff_p [lindex $flist $idx]
2368 set next_diff_i [expr {$idx+1}]
2375 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2376 global current_diff_path
2378 if {$path ne $current_diff_path} {
2380 } elseif {[find_next_diff $w $path $lno $mmask]} {
2383 return {reshow_diff;}
2387 proc select_first_diff {after} {
2390 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2391 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2398 proc force_first_diff {after} {
2399 global ui_workdir current_diff_path file_states
2401 if {[info exists file_states($current_diff_path)]} {
2402 set state [lindex $file_states($current_diff_path) 0]
2408 if {[string first {U} $state] >= 0} {
2409 # Already a conflict, do nothing
2410 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2412 } elseif {[string index $state 1] ne {O}} {
2413 # Already a diff & no conflicts, do nothing
2414 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2425 proc toggle_or_diff {w x y} {
2426 global file_states file_lists current_diff_path ui_index ui_workdir
2427 global last_clicked selected_paths
2429 set pos [split [$w index @$x,$y] .]
2430 set lno [lindex $pos 0]
2431 set col [lindex $pos 1]
2432 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2438 set last_clicked [list $w $lno]
2439 array unset selected_paths
2440 $ui_index tag remove in_sel 0.0 end
2441 $ui_workdir tag remove in_sel 0.0 end
2443 # Determine the state of the file
2444 if {[info exists file_states($path)]} {
2445 set state [lindex $file_states($path) 0]
2450 # Restage the file, or simply show the diff
2451 if {$col == 0 && $y > 1} {
2452 # Conflicts need special handling
2453 if {[string first {U} $state] >= 0} {
2454 # $w must always be $ui_workdir, but...
2455 if {$w ne $ui_workdir} { set lno {} }
2456 merge_stage_workdir $path $lno
2460 if {[string index $state 1] eq {O}} {
2466 set after [next_diff_after_action $w $path $lno $mmask]
2468 if {$w eq $ui_index} {
2470 "Unstaging [short_path $path] from commit" \
2472 [concat $after [list ui_ready]]
2473 } elseif {$w eq $ui_workdir} {
2475 "Adding [short_path $path]" \
2477 [concat $after [list ui_ready]]
2480 show_diff $path $w $lno
2484 proc add_one_to_selection {w x y} {
2485 global file_lists last_clicked selected_paths
2487 set lno [lindex [split [$w index @$x,$y] .] 0]
2488 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2494 if {$last_clicked ne {}
2495 && [lindex $last_clicked 0] ne $w} {
2496 array unset selected_paths
2497 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2500 set last_clicked [list $w $lno]
2501 if {[catch {set in_sel $selected_paths($path)}]} {
2505 unset selected_paths($path)
2506 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2508 set selected_paths($path) 1
2509 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2513 proc add_range_to_selection {w x y} {
2514 global file_lists last_clicked selected_paths
2516 if {[lindex $last_clicked 0] ne $w} {
2517 toggle_or_diff $w $x $y
2521 set lno [lindex [split [$w index @$x,$y] .] 0]
2522 set lc [lindex $last_clicked 1]
2531 foreach path [lrange $file_lists($w) \
2532 [expr {$begin - 1}] \
2533 [expr {$end - 1}]] {
2534 set selected_paths($path) 1
2536 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2539 proc show_more_context {} {
2541 if {$repo_config(gui.diffcontext) < 99} {
2542 incr repo_config(gui.diffcontext)
2547 proc show_less_context {} {
2549 if {$repo_config(gui.diffcontext) > 1} {
2550 incr repo_config(gui.diffcontext) -1
2555 ######################################################################
2563 menu .mbar -tearoff 0
2565 # -- Apple Menu (Mac OS X only)
2567 .mbar add cascade -label Apple -menu .mbar.apple
2570 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2571 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2572 if {[is_enabled branch]} {
2573 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2575 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2576 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2578 if {[is_enabled transport]} {
2579 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2580 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2582 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2583 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2586 # -- Repository Menu
2588 menu .mbar.repository
2591 .mbar.repository add command \
2592 -label [mc "Explore Working Copy"] \
2593 -command {do_explore}
2594 .mbar.repository add separator
2597 .mbar.repository add command \
2598 -label [mc "Browse Current Branch's Files"] \
2599 -command {browser::new $current_branch}
2600 set ui_browse_current [.mbar.repository index last]
2601 .mbar.repository add command \
2602 -label [mc "Browse Branch Files..."] \
2603 -command browser_open::dialog
2604 .mbar.repository add separator
2606 .mbar.repository add command \
2607 -label [mc "Visualize Current Branch's History"] \
2608 -command {do_gitk $current_branch}
2609 set ui_visualize_current [.mbar.repository index last]
2610 .mbar.repository add command \
2611 -label [mc "Visualize All Branch History"] \
2612 -command {do_gitk --all}
2613 .mbar.repository add separator
2615 proc current_branch_write {args} {
2616 global current_branch
2617 .mbar.repository entryconf $::ui_browse_current \
2618 -label [mc "Browse %s's Files" $current_branch]
2619 .mbar.repository entryconf $::ui_visualize_current \
2620 -label [mc "Visualize %s's History" $current_branch]
2622 trace add variable current_branch write current_branch_write
2624 if {[is_enabled multicommit]} {
2625 .mbar.repository add command -label [mc "Database Statistics"] \
2628 .mbar.repository add command -label [mc "Compress Database"] \
2631 .mbar.repository add command -label [mc "Verify Database"] \
2632 -command do_fsck_objects
2634 .mbar.repository add separator
2637 .mbar.repository add command \
2638 -label [mc "Create Desktop Icon"] \
2639 -command do_cygwin_shortcut
2640 } elseif {[is_Windows]} {
2641 .mbar.repository add command \
2642 -label [mc "Create Desktop Icon"] \
2643 -command do_windows_shortcut
2644 } elseif {[is_MacOSX]} {
2645 .mbar.repository add command \
2646 -label [mc "Create Desktop Icon"] \
2647 -command do_macosx_app
2652 proc ::tk::mac::Quit {args} { do_quit }
2654 .mbar.repository add command -label [mc Quit] \
2662 .mbar.edit add command -label [mc Undo] \
2663 -command {catch {[focus] edit undo}} \
2665 .mbar.edit add command -label [mc Redo] \
2666 -command {catch {[focus] edit redo}} \
2668 .mbar.edit add separator
2669 .mbar.edit add command -label [mc Cut] \
2670 -command {catch {tk_textCut [focus]}} \
2672 .mbar.edit add command -label [mc Copy] \
2673 -command {catch {tk_textCopy [focus]}} \
2675 .mbar.edit add command -label [mc Paste] \
2676 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2678 .mbar.edit add command -label [mc Delete] \
2679 -command {catch {[focus] delete sel.first sel.last}} \
2681 .mbar.edit add separator
2682 .mbar.edit add command -label [mc "Select All"] \
2683 -command {catch {[focus] tag add sel 0.0 end}} \
2688 if {[is_enabled branch]} {
2691 .mbar.branch add command -label [mc "Create..."] \
2692 -command branch_create::dialog \
2694 lappend disable_on_lock [list .mbar.branch entryconf \
2695 [.mbar.branch index last] -state]
2697 .mbar.branch add command -label [mc "Checkout..."] \
2698 -command branch_checkout::dialog \
2700 lappend disable_on_lock [list .mbar.branch entryconf \
2701 [.mbar.branch index last] -state]
2703 .mbar.branch add command -label [mc "Rename..."] \
2704 -command branch_rename::dialog
2705 lappend disable_on_lock [list .mbar.branch entryconf \
2706 [.mbar.branch index last] -state]
2708 .mbar.branch add command -label [mc "Delete..."] \
2709 -command branch_delete::dialog
2710 lappend disable_on_lock [list .mbar.branch entryconf \
2711 [.mbar.branch index last] -state]
2713 .mbar.branch add command -label [mc "Reset..."] \
2714 -command merge::reset_hard
2715 lappend disable_on_lock [list .mbar.branch entryconf \
2716 [.mbar.branch index last] -state]
2721 proc commit_btn_caption {} {
2722 if {[is_enabled nocommit]} {
2725 return [mc Commit@@verb]
2729 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2732 if {![is_enabled nocommit]} {
2733 .mbar.commit add radiobutton \
2734 -label [mc "New Commit"] \
2735 -command do_select_commit_type \
2736 -variable selected_commit_type \
2738 lappend disable_on_lock \
2739 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2741 .mbar.commit add radiobutton \
2742 -label [mc "Amend Last Commit"] \
2743 -command do_select_commit_type \
2744 -variable selected_commit_type \
2746 lappend disable_on_lock \
2747 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2749 .mbar.commit add separator
2752 .mbar.commit add command -label [mc Rescan] \
2753 -command ui_do_rescan \
2755 lappend disable_on_lock \
2756 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2758 .mbar.commit add command -label [mc "Stage To Commit"] \
2759 -command do_add_selection \
2761 lappend disable_on_lock \
2762 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2764 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2765 -command do_add_all \
2767 lappend disable_on_lock \
2768 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2770 .mbar.commit add command -label [mc "Unstage From Commit"] \
2771 -command do_unstage_selection \
2773 lappend disable_on_lock \
2774 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2776 .mbar.commit add command -label [mc "Revert Changes"] \
2777 -command do_revert_selection \
2779 lappend disable_on_lock \
2780 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2782 .mbar.commit add separator
2784 .mbar.commit add command -label [mc "Show Less Context"] \
2785 -command show_less_context \
2786 -accelerator $M1T-\-
2788 .mbar.commit add command -label [mc "Show More Context"] \
2789 -command show_more_context \
2792 .mbar.commit add separator
2794 if {![is_enabled nocommitmsg]} {
2795 .mbar.commit add command -label [mc "Sign Off"] \
2796 -command do_signoff \
2800 .mbar.commit add command -label [commit_btn_caption] \
2801 -command do_commit \
2802 -accelerator $M1T-Return
2803 lappend disable_on_lock \
2804 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2809 if {[is_enabled branch]} {
2811 .mbar.merge add command -label [mc "Local Merge..."] \
2812 -command merge::dialog \
2814 lappend disable_on_lock \
2815 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2816 .mbar.merge add command -label [mc "Abort Merge..."] \
2817 -command merge::reset_hard
2818 lappend disable_on_lock \
2819 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2824 if {[is_enabled transport]} {
2827 .mbar.remote add command \
2828 -label [mc "Add..."] \
2829 -command remote_add::dialog \
2831 .mbar.remote add command \
2832 -label [mc "Push..."] \
2833 -command do_push_anywhere \
2835 .mbar.remote add command \
2836 -label [mc "Delete Branch..."] \
2837 -command remote_branch_delete::dialog
2841 proc ::tk::mac::ShowPreferences {} {do_options}
2845 .mbar.edit add separator
2846 .mbar.edit add command -label [mc "Options..."] \
2852 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2853 set tools_menubar .mbar.tools
2855 $tools_menubar add separator
2856 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2857 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2859 if {[array names repo_config guitool.*.cmd] ne {}} {
2866 .mbar add cascade -label [mc Help] -menu .mbar.help
2870 .mbar.apple add command -label [mc "About %s" [appname]] \
2872 .mbar.apple add separator
2874 .mbar.help add command -label [mc "About %s" [appname]] \
2877 . configure -menu .mbar
2879 set doc_path [githtmldir]
2880 if {$doc_path ne {}} {
2881 set doc_path [file join $doc_path index.html]
2884 set doc_path [exec cygpath --mixed $doc_path]
2888 if {[file isfile $doc_path]} {
2889 set doc_url "file:$doc_path"
2891 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2894 proc start_browser {url} {
2895 git "web--browse" $url
2898 .mbar.help add command -label [mc "Online Documentation"] \
2899 -command [list start_browser $doc_url]
2901 .mbar.help add command -label [mc "Show SSH Key"] \
2904 unset doc_path doc_url
2906 # -- Standard bindings
2908 wm protocol . WM_DELETE_WINDOW do_quit
2909 bind all <$M1B-Key-q> do_quit
2910 bind all <$M1B-Key-Q> do_quit
2911 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2912 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2914 set subcommand_args {}
2916 set s "usage: $::argv0 $::subcommand $::subcommand_args"
2917 if {[tk windowingsystem] eq "win32"} {
2919 tk_messageBox -icon info -message $s \
2927 proc normalize_relpath {path} {
2929 foreach item [file split $path] {
2930 if {$item eq {.}} continue
2931 if {$item eq {..} && [llength $elements] > 0
2932 && [lindex $elements end] ne {..}} {
2933 set elements [lrange $elements 0 end-1]
2936 lappend elements $item
2938 return [eval file join $elements]
2941 # -- Not a normal commit type invocation? Do that instead!
2943 switch -- $subcommand {
2946 if {$subcommand eq "blame"} {
2947 set subcommand_args {[--line=<num>] rev? path}
2949 set subcommand_args {rev? path}
2951 if {$argv eq {}} usage
2957 if {$is_path || [file exists $_prefix$a]} {
2958 if {$path ne {}} usage
2959 set path [normalize_relpath $_prefix$a]
2961 } elseif {$a eq {--}} {
2963 if {$head ne {}} usage
2968 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2969 if {$jump_spec ne {} || $head ne {}} usage
2970 set jump_spec [list $lnum]
2971 } elseif {$head eq {}} {
2972 if {$head ne {}} usage
2981 if {$head ne {} && $path eq {}} {
2982 set path [normalize_relpath $_prefix$head]
2989 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2991 set head [git rev-parse --verify $head]
2993 if {[tk windowingsystem] eq "win32"} {
2994 tk_messageBox -icon error -title [mc Error] -message $err
3001 set current_branch $head
3005 switch -- $subcommand {
3007 if {$jump_spec ne {}} usage
3009 if {$path ne {} && [file isdirectory $path]} {
3010 set head $current_branch
3016 browser::new $head $path
3019 if {$head eq {} && ![file exists $path]} {
3020 catch {wm withdraw .}
3024 -title [mc "git-gui: fatal error"] \
3025 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3028 blame::new $head $path $jump_spec
3035 if {[llength $argv] != 0} {
3038 # fall through to setup UI for commits
3041 set err "usage: $argv0 \[{blame|browser|citool}\]"
3042 if {[tk windowingsystem] eq "win32"} {
3044 tk_messageBox -icon error -message $err \
3055 ${NS}::frame .branch
3056 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3057 ${NS}::label .branch.l1 \
3058 -text [mc "Current Branch:"] \
3061 ${NS}::label .branch.cb \
3062 -textvariable current_branch \
3065 pack .branch.l1 -side left
3066 pack .branch.cb -side left -fill x
3067 pack .branch -side top -fill x
3069 # -- Main Window Layout
3071 ${NS}::panedwindow .vpane -orient horizontal
3072 ${NS}::panedwindow .vpane.files -orient vertical
3074 .vpane add .vpane.files
3076 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3078 pack .vpane -anchor n -side top -fill both -expand 1
3080 # -- Index File List
3082 ${NS}::frame .vpane.files.index -height 100 -width 200
3083 tlabel .vpane.files.index.title \
3084 -text [mc "Staged Changes (Will Commit)"] \
3085 -background lightgreen -foreground black
3086 text $ui_index -background white -foreground black \
3088 -width 20 -height 10 \
3090 -cursor $cursor_ptr \
3091 -xscrollcommand {.vpane.files.index.sx set} \
3092 -yscrollcommand {.vpane.files.index.sy set} \
3094 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3095 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3096 pack .vpane.files.index.title -side top -fill x
3097 pack .vpane.files.index.sx -side bottom -fill x
3098 pack .vpane.files.index.sy -side right -fill y
3099 pack $ui_index -side left -fill both -expand 1
3101 # -- Working Directory File List
3103 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3104 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3105 -background lightsalmon -foreground black
3106 text $ui_workdir -background white -foreground black \
3108 -width 20 -height 10 \
3110 -cursor $cursor_ptr \
3111 -xscrollcommand {.vpane.files.workdir.sx set} \
3112 -yscrollcommand {.vpane.files.workdir.sy set} \
3114 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3115 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3116 pack .vpane.files.workdir.title -side top -fill x
3117 pack .vpane.files.workdir.sx -side bottom -fill x
3118 pack .vpane.files.workdir.sy -side right -fill y
3119 pack $ui_workdir -side left -fill both -expand 1
3121 .vpane.files add .vpane.files.workdir
3122 .vpane.files add .vpane.files.index
3124 .vpane.files paneconfigure .vpane.files.workdir -sticky news
3125 .vpane.files paneconfigure .vpane.files.index -sticky news
3128 foreach i [list $ui_index $ui_workdir] {
3130 $i tag conf in_diff -background [$i tag cget in_sel -background]
3134 # -- Diff and Commit Area
3136 ${NS}::frame .vpane.lower -height 300 -width 400
3137 ${NS}::frame .vpane.lower.commarea
3138 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3139 pack .vpane.lower.diff -fill both -expand 1
3140 pack .vpane.lower.commarea -side bottom -fill x
3141 .vpane add .vpane.lower
3142 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3144 # -- Commit Area Buttons
3146 ${NS}::frame .vpane.lower.commarea.buttons
3147 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3150 pack .vpane.lower.commarea.buttons.l -side top -fill x
3151 pack .vpane.lower.commarea.buttons -side left -fill y
3153 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3154 -command ui_do_rescan
3155 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3156 lappend disable_on_lock \
3157 {.vpane.lower.commarea.buttons.rescan conf -state}
3159 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3161 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3162 lappend disable_on_lock \
3163 {.vpane.lower.commarea.buttons.incall conf -state}
3165 if {![is_enabled nocommitmsg]} {
3166 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3168 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3171 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3173 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3174 lappend disable_on_lock \
3175 {.vpane.lower.commarea.buttons.commit conf -state}
3177 if {![is_enabled nocommit]} {
3178 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3179 -command do_push_anywhere
3180 pack .vpane.lower.commarea.buttons.push -side top -fill x
3183 # -- Commit Message Buffer
3185 ${NS}::frame .vpane.lower.commarea.buffer
3186 ${NS}::frame .vpane.lower.commarea.buffer.header
3187 set ui_comm .vpane.lower.commarea.buffer.t
3188 set ui_coml .vpane.lower.commarea.buffer.header.l
3190 if {![is_enabled nocommit]} {
3191 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3192 -text [mc "New Commit"] \
3193 -command do_select_commit_type \
3194 -variable selected_commit_type \
3196 lappend disable_on_lock \
3197 [list .vpane.lower.commarea.buffer.header.new conf -state]
3198 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3199 -text [mc "Amend Last Commit"] \
3200 -command do_select_commit_type \
3201 -variable selected_commit_type \
3203 lappend disable_on_lock \
3204 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3207 ${NS}::label $ui_coml \
3210 proc trace_commit_type {varname args} {
3211 global ui_coml commit_type
3212 switch -glob -- $commit_type {
3213 initial {set txt [mc "Initial Commit Message:"]}
3214 amend {set txt [mc "Amended Commit Message:"]}
3215 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3216 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3217 merge {set txt [mc "Merge Commit Message:"]}
3218 * {set txt [mc "Commit Message:"]}
3220 $ui_coml conf -text $txt
3222 trace add variable commit_type write trace_commit_type
3223 pack $ui_coml -side left -fill x
3225 if {![is_enabled nocommit]} {
3226 pack .vpane.lower.commarea.buffer.header.amend -side right
3227 pack .vpane.lower.commarea.buffer.header.new -side right
3230 text $ui_comm -background white -foreground black \
3234 -autoseparators true \
3236 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3238 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3239 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3240 -command [list $ui_comm yview]
3241 pack .vpane.lower.commarea.buffer.header -side top -fill x
3242 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3243 pack $ui_comm -side left -fill y
3244 pack .vpane.lower.commarea.buffer -side left -fill y
3246 # -- Commit Message Buffer Context Menu
3248 set ctxm .vpane.lower.commarea.buffer.ctxm
3249 menu $ctxm -tearoff 0
3252 -command {tk_textCut $ui_comm}
3255 -command {tk_textCopy $ui_comm}
3258 -command {tk_textPaste $ui_comm}
3260 -label [mc Delete] \
3261 -command {catch {$ui_comm delete sel.first sel.last}}
3264 -label [mc "Select All"] \
3265 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3267 -label [mc "Copy All"] \
3269 $ui_comm tag add sel 0.0 end
3270 tk_textCopy $ui_comm
3271 $ui_comm tag remove sel 0.0 end
3275 -label [mc "Sign Off"] \
3277 set ui_comm_ctxm $ctxm
3281 proc trace_current_diff_path {varname args} {
3282 global current_diff_path diff_actions file_states
3283 if {$current_diff_path eq {}} {
3289 set p $current_diff_path
3290 set s [mapdesc [lindex $file_states($p) 0] $p]
3292 set p [escape_path $p]
3296 .vpane.lower.diff.header.status configure -text $s
3297 .vpane.lower.diff.header.file configure -text $f
3298 .vpane.lower.diff.header.path configure -text $p
3299 foreach w $diff_actions {
3303 trace add variable current_diff_path write trace_current_diff_path
3305 gold_frame .vpane.lower.diff.header
3306 tlabel .vpane.lower.diff.header.status \
3309 -width $max_status_desc \
3312 tlabel .vpane.lower.diff.header.file \
3317 tlabel .vpane.lower.diff.header.path \
3322 pack .vpane.lower.diff.header.status -side left
3323 pack .vpane.lower.diff.header.file -side left
3324 pack .vpane.lower.diff.header.path -fill x
3325 set ctxm .vpane.lower.diff.header.ctxm
3326 menu $ctxm -tearoff 0
3334 -- $current_diff_path
3336 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3337 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3341 ${NS}::frame .vpane.lower.diff.body
3342 set ui_diff .vpane.lower.diff.body.t
3343 text $ui_diff -background white -foreground black \
3345 -width 80 -height 5 -wrap none \
3347 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3348 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3350 catch {$ui_diff configure -tabstyle wordprocessor}
3351 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3352 -command [list $ui_diff xview]
3353 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3354 -command [list $ui_diff yview]
3355 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3356 pack .vpane.lower.diff.body.sby -side right -fill y
3357 pack $ui_diff -side left -fill both -expand 1
3358 pack .vpane.lower.diff.header -side top -fill x
3359 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3361 foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3362 $ui_diff tag configure clr4$n -background $c
3363 $ui_diff tag configure clri4$n -foreground $c
3364 $ui_diff tag configure clr3$n -foreground $c
3365 $ui_diff tag configure clri3$n -background $c
3367 $ui_diff tag configure clr1 -font font_diffbold
3369 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3371 $ui_diff tag conf d_cr -elide true
3372 $ui_diff tag conf d_@ -font font_diffbold
3373 $ui_diff tag conf d_+ -foreground {#00a000}
3374 $ui_diff tag conf d_- -foreground red
3376 $ui_diff tag conf d_++ -foreground {#00a000}
3377 $ui_diff tag conf d_-- -foreground red
3378 $ui_diff tag conf d_+s \
3379 -foreground {#00a000} \
3380 -background {#e2effa}
3381 $ui_diff tag conf d_-s \
3383 -background {#e2effa}
3384 $ui_diff tag conf d_s+ \
3385 -foreground {#00a000} \
3387 $ui_diff tag conf d_s- \
3391 $ui_diff tag conf d< \
3392 -foreground orange \
3394 $ui_diff tag conf d= \
3395 -foreground orange \
3397 $ui_diff tag conf d> \
3398 -foreground orange \
3401 $ui_diff tag raise sel
3403 # -- Diff Body Context Menu
3406 proc create_common_diff_popup {ctxm} {
3408 -label [mc Refresh] \
3409 -command reshow_diff
3410 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3413 -command {tk_textCopy $ui_diff}
3414 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3416 -label [mc "Select All"] \
3417 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3418 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3420 -label [mc "Copy All"] \
3422 $ui_diff tag add sel 0.0 end
3423 tk_textCopy $ui_diff
3424 $ui_diff tag remove sel 0.0 end
3426 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3429 -label [mc "Decrease Font Size"] \
3430 -command {incr_font_size font_diff -1}
3431 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3433 -label [mc "Increase Font Size"] \
3434 -command {incr_font_size font_diff 1}
3435 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3439 build_encoding_menu $emenu [list force_diff_encoding]
3441 -label [mc "Encoding"] \
3443 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3445 $ctxm add command -label [mc "Options..."] \
3449 set ctxm .vpane.lower.diff.body.ctxm
3450 menu $ctxm -tearoff 0
3452 -label [mc "Apply/Reverse Hunk"] \
3453 -command {apply_hunk $cursorX $cursorY}
3454 set ui_diff_applyhunk [$ctxm index last]
3455 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3457 -label [mc "Apply/Reverse Line"] \
3458 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3459 set ui_diff_applyline [$ctxm index last]
3460 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3463 -label [mc "Show Less Context"] \
3464 -command show_less_context
3465 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3467 -label [mc "Show More Context"] \
3468 -command show_more_context
3469 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3471 create_common_diff_popup $ctxm
3473 set ctxmmg .vpane.lower.diff.body.ctxmmg
3474 menu $ctxmmg -tearoff 0
3475 $ctxmmg add command \
3476 -label [mc "Run Merge Tool"] \
3477 -command {merge_resolve_tool}
3478 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3479 $ctxmmg add separator
3480 $ctxmmg add command \
3481 -label [mc "Use Remote Version"] \
3482 -command {merge_resolve_one 3}
3483 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3484 $ctxmmg add command \
3485 -label [mc "Use Local Version"] \
3486 -command {merge_resolve_one 2}
3487 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3488 $ctxmmg add command \
3489 -label [mc "Revert To Base"] \
3490 -command {merge_resolve_one 1}
3491 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3492 $ctxmmg add separator
3493 $ctxmmg add command \
3494 -label [mc "Show Less Context"] \
3495 -command show_less_context
3496 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3497 $ctxmmg add command \
3498 -label [mc "Show More Context"] \
3499 -command show_more_context
3500 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3501 $ctxmmg add separator
3502 create_common_diff_popup $ctxmmg
3504 set ctxmsm .vpane.lower.diff.body.ctxmsm
3505 menu $ctxmsm -tearoff 0
3506 $ctxmsm add command \
3507 -label [mc "Visualize These Changes In The Submodule"] \
3508 -command {do_gitk -- true}
3509 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3510 $ctxmsm add command \
3511 -label [mc "Visualize Current Branch History In The Submodule"] \
3512 -command {do_gitk {} true}
3513 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3514 $ctxmsm add command \
3515 -label [mc "Visualize All Branch History In The Submodule"] \
3516 -command {do_gitk --all true}
3517 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3518 $ctxmsm add separator
3519 $ctxmsm add command \
3520 -label [mc "Start git gui In The Submodule"] \
3521 -command {do_git_gui}
3522 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3523 $ctxmsm add separator
3524 create_common_diff_popup $ctxmsm
3526 proc has_textconv {path} {
3527 if {[is_config_false gui.textconv]} {
3530 set filter [gitattr $path diff set]
3531 set textconv [get_config [join [list diff $filter textconv] .]]
3532 if {$filter ne {set} && $textconv ne {}} {
3539 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3540 global current_diff_path file_states
3543 if {[info exists file_states($current_diff_path)]} {
3544 set state [lindex $file_states($current_diff_path) 0]
3548 if {[string first {U} $state] >= 0} {
3549 tk_popup $ctxmmg $X $Y
3550 } elseif {$::is_submodule_diff} {
3551 tk_popup $ctxmsm $X $Y
3553 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3554 if {$::ui_index eq $::current_diff_side} {
3555 set l [mc "Unstage Hunk From Commit"]
3557 set t [mc "Unstage Lines From Commit"]
3559 set t [mc "Unstage Line From Commit"]
3562 set l [mc "Stage Hunk For Commit"]
3564 set t [mc "Stage Lines For Commit"]
3566 set t [mc "Stage Line For Commit"]
3570 || $current_diff_path eq {}
3573 || [string match {?T} $state]
3574 || [string match {T?} $state]
3575 || [has_textconv $current_diff_path]} {
3580 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3581 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3582 tk_popup $ctxm $X $Y
3585 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3589 set main_status [::status_bar::new .status]
3590 pack .status -anchor w -side bottom -fill x
3591 $main_status show [mc "Initializing..."]
3595 proc on_ttk_pane_mapped {w pane pos} {
3597 after 0 [list after idle [list $w sashpos $pane $pos]]
3599 proc on_tk_pane_mapped {w pane x y} {
3601 after 0 [list after idle [list $w sash place $pane $x $y]]
3603 proc on_application_mapped {} {
3604 global repo_config use_ttk
3606 set gm $repo_config(gui.geometry)
3609 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3610 bind .vpane.files <Map> \
3611 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3614 [list on_tk_pane_mapped %W 0 \
3616 [lindex [.vpane sash coord 0] 1]]
3617 bind .vpane.files <Map> \
3618 [list on_tk_pane_mapped %W 0 \
3619 [lindex [.vpane.files sash coord 0] 0] \
3622 wm geometry . [lindex $gm 0]
3624 if {[info exists repo_config(gui.geometry)]} {
3625 bind . <Map> [list on_application_mapped]
3626 wm geometry . [lindex $repo_config(gui.geometry) 0]
3629 # -- Load window state
3631 if {[info exists repo_config(gui.wmstate)]} {
3632 catch {wm state . $repo_config(gui.wmstate)}
3637 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3638 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3639 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3640 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3641 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3642 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3643 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3644 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3645 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3646 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3647 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3648 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3649 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3650 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3651 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3652 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3653 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3654 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3655 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3656 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3657 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3658 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3660 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3661 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3662 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3663 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3664 bind $ui_diff <$M1B-Key-v> {break}
3665 bind $ui_diff <$M1B-Key-V> {break}
3666 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3667 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3668 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3669 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3670 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3671 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3672 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3673 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3674 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3675 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3676 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3677 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3678 bind $ui_diff <Button-1> {focus %W}
3680 if {[is_enabled branch]} {
3681 bind . <$M1B-Key-n> branch_create::dialog
3682 bind . <$M1B-Key-N> branch_create::dialog
3683 bind . <$M1B-Key-o> branch_checkout::dialog
3684 bind . <$M1B-Key-O> branch_checkout::dialog
3685 bind . <$M1B-Key-m> merge::dialog
3686 bind . <$M1B-Key-M> merge::dialog
3688 if {[is_enabled transport]} {
3689 bind . <$M1B-Key-p> do_push_anywhere
3690 bind . <$M1B-Key-P> do_push_anywhere
3693 bind . <Key-F5> ui_do_rescan
3694 bind . <$M1B-Key-r> ui_do_rescan
3695 bind . <$M1B-Key-R> ui_do_rescan
3696 bind . <$M1B-Key-s> do_signoff
3697 bind . <$M1B-Key-S> do_signoff
3698 bind . <$M1B-Key-t> do_add_selection
3699 bind . <$M1B-Key-T> do_add_selection
3700 bind . <$M1B-Key-j> do_revert_selection
3701 bind . <$M1B-Key-J> do_revert_selection
3702 bind . <$M1B-Key-i> do_add_all
3703 bind . <$M1B-Key-I> do_add_all
3704 bind . <$M1B-Key-minus> {show_less_context;break}
3705 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3706 bind . <$M1B-Key-equal> {show_more_context;break}
3707 bind . <$M1B-Key-plus> {show_more_context;break}
3708 bind . <$M1B-Key-KP_Add> {show_more_context;break}
3709 bind . <$M1B-Key-Return> do_commit
3710 foreach i [list $ui_index $ui_workdir] {
3711 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3712 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3713 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3717 set file_lists($ui_index) [list]
3718 set file_lists($ui_workdir) [list]
3720 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3721 focus -force $ui_comm
3723 # -- Warn the user about environmental problems. Cygwin's Tcl
3724 # does *not* pass its env array onto any processes it spawns.
3725 # This means that git processes get none of our environment.
3730 set msg [mc "Possible environment issues exist.
3732 The following environment variables are probably
3733 going to be ignored by any Git subprocess run
3737 foreach name [array names env] {
3738 switch -regexp -- $name {
3739 {^GIT_INDEX_FILE$} -
3740 {^GIT_OBJECT_DIRECTORY$} -
3741 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3743 {^GIT_EXTERNAL_DIFF$} -
3747 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3748 append msg " - $name\n"
3751 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3752 append msg " - $name\n"
3754 set suggest_user $name
3758 if {$ignored_env > 0} {
3760 This is due to a known issue with the
3761 Tcl binary distributed by Cygwin."]
3763 if {$suggest_user ne {}} {
3766 A good replacement for %s
3767 is placing values for the user.name and
3768 user.email settings into your personal
3774 unset ignored_env msg suggest_user name
3777 # -- Only initialize complex UI if we are going to stay running.
3779 if {[is_enabled transport]} {
3782 set n [.mbar.remote index end]
3783 populate_remotes_menu
3784 set n [expr {[.mbar.remote index end] - $n}]
3786 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3787 .mbar.remote insert $n separator
3792 if {[winfo exists $ui_comm]} {
3793 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3795 # -- If both our backup and message files exist use the
3796 # newer of the two files to initialize the buffer.
3798 if {$GITGUI_BCK_exists} {
3799 set m [gitdir GITGUI_MSG]
3800 if {[file isfile $m]} {
3801 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3802 catch {file delete [gitdir GITGUI_MSG]}
3804 $ui_comm delete 0.0 end
3806 $ui_comm edit modified false
3807 catch {file delete [gitdir GITGUI_BCK]}
3808 set GITGUI_BCK_exists 0
3814 proc backup_commit_buffer {} {
3815 global ui_comm GITGUI_BCK_exists
3817 set m [$ui_comm edit modified]
3818 if {$m || $GITGUI_BCK_exists} {
3819 set msg [string trim [$ui_comm get 0.0 end]]
3820 regsub -all -line {[ \r\t]+$} $msg {} msg
3823 if {$GITGUI_BCK_exists} {
3824 catch {file delete [gitdir GITGUI_BCK]}
3825 set GITGUI_BCK_exists 0
3829 set fd [open [gitdir GITGUI_BCK] w]
3830 puts -nonewline $fd $msg
3832 set GITGUI_BCK_exists 1
3836 $ui_comm edit modified false
3839 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3842 backup_commit_buffer
3844 # -- If the user has aspell available we can drive it
3845 # in pipe mode to spellcheck the commit message.
3847 set spell_cmd [list |]
3848 set spell_dict [get_config gui.spellingdictionary]
3849 lappend spell_cmd aspell
3850 if {$spell_dict ne {}} {
3851 lappend spell_cmd --master=$spell_dict
3853 lappend spell_cmd --mode=none
3854 lappend spell_cmd --encoding=utf-8
3855 lappend spell_cmd pipe
3856 if {$spell_dict eq {none}
3857 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3858 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3860 set ui_comm_spell [spellcheck::init \
3866 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3869 lock_index begin-read
3870 if {![winfo ismapped .]} {
3874 if {[is_enabled initialamend]} {
3880 if {[is_enabled nocommitmsg]} {
3881 $ui_comm configure -state disabled -background gray
3884 if {[is_enabled multicommit]} {
3887 if {[is_enabled retcode]} {
3888 bind . <Destroy> {+terminate_me %W}
3890 if {$picked && [is_config_true gui.autoexplore]} {
3896 # indent-tabs-mode: t