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)}]} {
303 set v
[string tolower
$v]
304 if {$v eq
{} ||
$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes} ||
$v eq
{on
}} {
311 proc is_config_false
{name
} {
313 if {[catch
{set v
$repo_config($name)}]} {
316 set v
[string tolower
$v]
317 if {$v eq
{false
} ||
$v eq
{0} ||
$v eq
{no
} ||
$v eq
{off
}} {
324 proc get_config
{name
} {
326 if {[catch
{set v
$repo_config($name)}]} {
338 if {$_isbare eq
{}} {
340 set _bare
[git rev-parse
--is-bare-repository]
342 true
{ set _isbare
1 }
343 false
{ set _isbare
0}
347 if {[is_config_true core.bare
]
348 ||
($_gitworktree eq
{}
349 && [lindex
[file split $_gitdir] end
] ne
{.git
})} {
359 ######################################################################
363 proc _trace_exec
{cmd
} {
364 if {!$
::_trace
} return
370 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
378 #'" fix poor old emacs font-lock mode
380 proc _git_cmd {name} {
383 if {[catch {set v $_git_cmd_path($name)}]} {
387 --exec-path { return [list $::_git $name] }
390 set p [gitexec git-$name$::_search_exe]
391 if {[file exists $p]} {
393 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
394 # Try to determine what sort of magic will make
395 # git-$name go and do its thing, because native
396 # Tcl on Windows doesn't know it.
398 set p [gitexec git-$name]
403 switch -glob -- [lindex $s 0] {
405 #!*perl { set i perl }
406 #!*python { set i python }
407 default { error "git-
$name is not supported
: $s" }
411 if {![info exists interp]} {
412 set interp [_which $i]
415 error "git-
$name requires
$i (not
in PATH
)"
417 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
419 # Assume it is builtin to git somehow and we
420 # aren't actually able to see a file for it.
422 set v [list $::_git $name]
424 set _git_cmd_path($name) $v
429 proc _which {what args} {
430 global env _search_exe _search_path
432 if {$_search_path eq {}} {
433 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
434 set _search_path [split [exec cygpath \
440 } elseif {[is_Windows]} {
441 set gitguidir [file dirname [info script]]
442 regsub -all ";" $gitguidir "\\;" gitguidir
443 set env(PATH) "$gitguidir;$env(PATH
)"
444 set _search_path [split $env(PATH) {;}]
447 set _search_path [split $env(PATH) :]
452 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
455 set suffix $_search_exe
458 foreach p $_search_path {
459 set p [file join $p $what$suffix]
460 if {[file exists $p]} {
461 return [file normalize $p]
467 # Test a file for a hashbang to identify executable scripts on Windows.
468 proc is_shellscript {filename} {
469 if {![file exists $filename]} {return 0}
470 set f [open $filename r]
471 fconfigure $f -encoding binary
472 set magic [read $f 2]
474 return [expr {$magic eq "#!"}]
477 # Run a command connected via pipes on stdout.
478 # This is for use with textconv filters and uses sh -c "..." to allow it to
479 # contain a command with arguments. On windows we must check for shell
480 # scripts specifically otherwise just call the filter command.
481 proc open_cmd_pipe
{cmd path
} {
483 if {![file executable
[shellpath
]]} {
484 set exe
[auto_execok
[lindex
$cmd 0]]
485 if {[is_shellscript
[lindex
$exe 0]]} {
486 set run
[linsert
[auto_execok sh
] end
-c "$cmd \"\$0\"" $path]
488 set run
[concat
$exe [lrange
$cmd 1 end
] $path]
491 set run
[list
[shellpath
] -c "$cmd \"\$0\"" $path]
493 return [open |
$run r
]
496 proc _lappend_nice
{cmd_var
} {
500 if {![info exists _nice
]} {
501 set _nice
[_which nice
]
502 if {[catch
{exec $_nice git version
}]} {
504 } elseif
{[is_Windows
] && [file dirname $_nice] ne
[file dirname $
::_git
]} {
517 switch
-- [lindex
$args 0] {
528 set args
[lrange
$args 1 end
]
531 set cmdp
[_git_cmd
[lindex
$args 0]]
532 set args
[lrange
$args 1 end
]
534 _trace_exec
[concat
$opt $cmdp $args]
535 set result
[eval exec $opt $cmdp $args]
537 puts stderr
"< $result"
542 proc _open_stdout_stderr
{cmd
} {
545 set fd
[open
[concat
[list |
] $cmd] r
]
547 if { [lindex
$cmd end
] eq
{2>@
1}
548 && $err eq
{can not
find channel named
"1"}
550 # Older versions of Tcl 8.4 don't have this 2>@1 IO
551 # redirect operator. Fallback to |& cat for those.
552 # The command was not actually started, so its safe
553 # to try to start it a second time.
555 set fd
[open
[concat \
557 [lrange
$cmd 0 end-1
] \
564 fconfigure
$fd -eofchar {}
568 proc git_read
{args
} {
572 switch
-- [lindex
$args 0] {
587 set args
[lrange
$args 1 end
]
590 set cmdp
[_git_cmd
[lindex
$args 0]]
591 set args
[lrange
$args 1 end
]
593 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
596 proc git_write
{args
} {
600 switch
-- [lindex
$args 0] {
611 set args
[lrange
$args 1 end
]
614 set cmdp
[_git_cmd
[lindex
$args 0]]
615 set args
[lrange
$args 1 end
]
617 _trace_exec
[concat
$opt $cmdp $args]
618 return [open
[concat
[list |
] $opt $cmdp $args] w
]
621 proc githook_read
{hook_name args
} {
622 set pchook
[gitdir hooks
$hook_name]
625 # On Windows [file executable] might lie so we need to ask
626 # the shell if the hook is executable. Yes that's annoying.
630 if {![info exists interp
]} {
631 set interp
[_which sh
]
634 error
"hook execution requires sh (not in PATH)"
637 set scr
{if test -x "$1";then exec "$@";fi}
638 set sh_c
[list
$interp -c $scr $interp $pchook]
639 return [_open_stdout_stderr
[concat
$sh_c $args]]
642 if {[file executable
$pchook]} {
643 return [_open_stdout_stderr
[concat
[list
$pchook] $args]]
649 proc kill_file_process
{fd
} {
650 set process
[pid
$fd]
654 # Use a Cygwin-specific flag to allow killing
655 # native Windows processes
656 exec kill -f $process
663 proc gitattr
{path attr default
} {
664 if {[catch
{set r
[git check-attr
$attr -- $path]}]} {
667 set r
[join [lrange
[split $r :] 2 end
] :]
670 if {$r eq
{unspecified
}} {
677 regsub
-all ' $value "'\\''" value
681 proc load_current_branch {} {
682 global current_branch is_detached
684 set fd [open [gitdir HEAD] r]
685 if {[gets $fd ref] < 1} {
690 set pfx {ref: refs/heads/}
691 set len [string length $pfx]
692 if {[string equal -length $len $pfx $ref]} {
693 # We're on a branch. It might not exist. But
694 # HEAD looks good enough to be a branch.
696 set current_branch [string range $ref $len end]
699 # Assume this is a detached head.
701 set current_branch HEAD
706 auto_load tk_optionMenu
707 rename tk_optionMenu real__tkOptionMenu
708 proc tk_optionMenu {w varName args} {
709 set m [eval real__tkOptionMenu $w $varName $args]
710 $m configure -font font_ui
711 $w configure -font font_ui
715 proc rmsel_tag {text} {
717 -background [$text cget -background] \
718 -foreground [$text cget -foreground] \
720 $text tag conf in_sel -background lightgray
721 bind $text <Motion> break
727 bind . <Visibility> {
728 bind . <Visibility> {}
733 wm iconbitmap . -default $oguilib/git-gui.ico
734 set ::tk::AlwaysShowSelection 1
735 bind . <Control-F2> {console show}
737 # Spoof an X11 display for SSH
738 if {![info exists env(DISPLAY)]} {
739 set env(DISPLAY) :9999
743 image create photo gitlogo -width 16 -height 16
745 gitlogo put #33CC33 -to 7 0 9 2
746 gitlogo put #33CC33 -to 4 2 12 4
747 gitlogo put #33CC33 -to 7 4 9 6
748 gitlogo put #CC3333 -to 4 6 12 8
749 gitlogo put gray26 -to 4 9 6 10
750 gitlogo put gray26 -to 3 10 6 12
751 gitlogo put gray26 -to 8 9 13 11
752 gitlogo put gray26 -to 8 11 10 12
753 gitlogo put gray26 -to 11 11 13 14
754 gitlogo put gray26 -to 3 12 5 14
755 gitlogo put gray26 -to 5 13
756 gitlogo put gray26 -to 10 13
757 gitlogo put gray26 -to 4 14 12 15
758 gitlogo put gray26 -to 5 15 11 16
761 image create photo gitlogo32 -width 32 -height 32
762 gitlogo32 copy gitlogo -zoom 2 2
764 wm iconphoto . -default gitlogo gitlogo32
768 ######################################################################
774 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
775 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
776 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
778 font create font_diff -family Courier -size 10
781 eval font configure font_ui [font actual [.dummy cget -font]]
786 font create font_uiitalic
787 font create font_uibold
788 font create font_diffbold
789 font create font_diffitalic
791 foreach class {Button Checkbutton Entry Label
792 Labelframe Listbox Message
793 Radiobutton Spinbox Text} {
794 option add *$class.font font_ui
797 option add *Menu.font font_ui
798 option add *Entry.borderWidth 1 startupFile
799 option add *Entry.relief sunken startupFile
800 option add *RadioButton.anchor w startupFile
804 if {[is_Windows] || [is_MacOSX]} {
805 option add *Menu.tearOff 0
816 proc bind_button3 {w cmd} {
817 bind $w <Any-Button-3> $cmd
819 # Mac OS X sends Button-2 on right click through three-button mouse,
820 # or through trackpad right-clicking (two-finger touch + click).
821 bind $w <Any-Button-2> $cmd
822 bind $w <Control-Button-1> $cmd
826 proc apply_config {} {
827 global repo_config font_descs
829 foreach option $font_descs {
830 set name [lindex $option 0]
831 set font [lindex $option 1]
834 foreach {cn cv} $repo_config(gui.$name) {
835 if {$cn eq {-weight}} {
838 font configure $font $cn $cv
841 font configure $font -weight normal
844 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
846 foreach {cn cv} [font configure $font] {
847 font configure ${font}bold $cn $cv
848 font configure ${font}italic $cn $cv
850 font configure ${font}bold -weight bold
851 font configure ${font}italic -slant italic
857 if {$repo_config(gui.usettk)} {
858 set use_ttk [package vsatisfies [package provide Tk] 8.5]
861 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
867 set default_config(branch.autosetupmerge) true
868 set default_config(merge.tool) {}
869 set default_config(mergetool.keepbackup) true
870 set default_config(merge.diffstat) true
871 set default_config(merge.summary) false
872 set default_config(merge.verbosity) 2
873 set default_config(user.name) {}
874 set default_config(user.email) {}
876 set default_config(gui.encoding) [encoding system]
877 set default_config(gui.matchtrackingbranch) false
878 set default_config(gui.textconv) true
879 set default_config(gui.pruneduringfetch) false
880 set default_config(gui.trustmtime) false
881 set default_config(gui.fastcopyblame) false
882 set default_config(gui.copyblamethreshold) 40
883 set default_config(gui.blamehistoryctx) 7
884 set default_config(gui.diffcontext) 5
885 set default_config(gui.diffopts) {}
886 set default_config(gui.commitmsgwidth) 75
887 set default_config(gui.newbranchtemplate) {}
888 set default_config(gui.spellingdictionary) {}
889 set default_config(gui.fontui) [font configure font_ui]
890 set default_config(gui.fontdiff) [font configure font_diff]
891 # TODO: this option should be added to the git-config documentation
892 set default_config(gui.maxfilesdisplayed) 5000
893 set default_config(gui.usettk) 1
894 set default_config(gui.warndetachedcommit) 1
896 {fontui font_ui {mc "Main Font
"}}
897 {fontdiff font_diff {mc "Diff
/Console Font
"}}
899 set default_config(gui.stageuntracked) ask
901 ######################################################################
905 set _git [_which git]
907 catch {wm withdraw .}
911 -title [mc "git-gui
: fatal error
"] \
912 -message [mc "Cannot
find git
in PATH.
"]
916 ######################################################################
920 if {[catch {set _git_version [git --version]} err]} {
921 catch {wm withdraw .}
925 -title [mc "git-gui
: fatal error
"] \
926 -message "Cannot determine Git version
:
930 [appname
] requires Git
1.5.0 or later.
"
933 if {![regsub {^git version } $_git_version {} _git_version]} {
934 catch {wm withdraw .}
938 -title [mc "git-gui
: fatal error
"] \
939 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
943 proc get_trimmed_version {s} {
945 foreach x [split $s -._] {
946 if {[string is integer -strict $x]} {
954 set _real_git_version $_git_version
955 set _git_version [get_trimmed_version $_git_version]
957 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
958 catch {wm withdraw .}
963 -title "[appname
]: warning
" \
964 -message [mc "Git version cannot be determined.
966 %s claims it is version
'%s'.
968 %s requires
at least Git
1.5.0 or later.
970 Assume
'%s' is version
1.5.0?
971 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
972 set _git_version 1.5.0
977 unset _real_git_version
979 proc git-version {args} {
982 switch [llength $args] {
988 set op [lindex $args 0]
989 set vr [lindex $args 1]
990 set cm [package vcompare $_git_version $vr]
991 return [expr $cm $op 0]
995 set type [lindex $args 0]
996 set name [lindex $args 1]
997 set parm [lindex $args 2]
998 set body [lindex $args 3]
1000 if {($type ne {proc} && $type ne {method})} {
1001 error "Invalid arguments to git-version
"
1003 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
1004 error "Last arm of
$type $name must be default
"
1007 foreach {op vr cb} [lrange $body 0 end-2] {
1008 if {[git-version $op $vr]} {
1009 return [uplevel [list $type $name $parm $cb]]
1013 return [uplevel [list $type $name $parm [lindex $body end]]]
1017 error "git-version
>= x
"
1023 if {[git-version < 1.5]} {
1024 catch {wm withdraw .}
1028 -title [mc "git-gui
: fatal error
"] \
1029 -message "[appname
] requires Git
1.5.0 or later.
1031 You are using
[git-version
]:
1037 ######################################################################
1039 ## configure our library
1041 set idx [file join $oguilib tclIndex]
1042 if {[catch {set fd [open $idx r]} err]} {
1043 catch {wm withdraw .}
1047 -title [mc "git-gui
: fatal error
"] \
1051 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1053 while {[gets $fd n] >= 0} {
1054 if {$n ne {} && ![string match #* $n]} {
1066 if {[lsearch -exact $loaded $p] >= 0} continue
1067 source [file join $oguilib $p]
1072 set auto_path [concat [list $oguilib] $auto_path]
1074 unset -nocomplain idx fd
1076 ######################################################################
1078 ## config file parsing
1080 git-version proc _parse_config {arr_name args} {
1087 [list git_read config] \
1089 [list --null --list]]
1090 fconfigure $fd_rc -translation binary
1091 set buf [read $fd_rc]
1094 foreach line [split $buf "\
0"] {
1095 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1096 if {[is_many_config $name]} {
1097 lappend arr($name) $value
1099 set arr($name) $value
1101 } elseif {[regexp {^([^\n]+)$} $line line name]} {
1102 # no value given, but interpreting them as
1103 # boolean will be handled as true
1112 set fd_rc [eval [list git_read config --list] $args]
1113 while {[gets $fd_rc line] >= 0} {
1114 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1115 if {[is_many_config $name]} {
1116 lappend arr($name) $value
1118 set arr($name) $value
1120 } elseif {[regexp {^([^=]+)$} $line line name]} {
1121 # no value given, but interpreting them as
1122 # boolean will be handled as true
1131 proc load_config {include_global} {
1132 global repo_config global_config system_config default_config
1134 if {$include_global} {
1135 _parse_config system_config --system
1136 _parse_config global_config --global
1138 _parse_config repo_config
1140 foreach name [array names default_config] {
1141 if {[catch {set v $system_config($name)}]} {
1142 set system_config($name) $default_config($name)
1145 foreach name [array names system_config] {
1146 if {[catch {set v $global_config($name)}]} {
1147 set global_config($name) $system_config($name)
1149 if {[catch {set v $repo_config($name)}]} {
1150 set repo_config($name) $system_config($name)
1155 ######################################################################
1157 ## feature option selection
1159 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1164 if {$subcommand eq {gui.sh}} {
1167 if {$subcommand eq {gui} && [llength $argv] > 0} {
1168 set subcommand [lindex $argv 0]
1169 set argv [lrange $argv 1 end]
1172 enable_option multicommit
1173 enable_option branch
1174 enable_option transport
1177 switch -- $subcommand {
1182 disable_option multicommit
1183 disable_option branch
1184 disable_option transport
1187 enable_option singlecommit
1188 enable_option retcode
1190 disable_option multicommit
1191 disable_option branch
1192 disable_option transport
1194 while {[llength $argv] > 0} {
1195 set a [lindex $argv 0]
1198 enable_option initialamend
1201 enable_option nocommit
1202 enable_option nocommitmsg
1205 disable_option nocommitmsg
1212 set argv [lrange $argv 1 end]
1217 ######################################################################
1219 ## execution environment
1221 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1223 # Suggest our implementation of askpass, if none is set
1224 if {![info exists env(SSH_ASKPASS)]} {
1225 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1227 if {![info exists env(GIT_ASKPASS)]} {
1228 set env(GIT_ASKPASS) [gitexec git-gui--askpass]
1230 if {![info exists env(GIT_ASK_YESNO)]} {
1231 set env(GIT_ASK_YESNO) [gitexec git-gui--askyesno]
1234 ######################################################################
1240 set _gitdir $env(GIT_DIR)
1244 # beware that from the .git dir this sets _gitdir to .
1245 # and _prefix to the empty string
1246 set _gitdir [git rev-parse --git-dir]
1247 set _prefix [git rev-parse --show-prefix]
1251 choose_repository::pick
1255 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1256 # run from the .git dir itself) lest the routines to find the worktree
1258 if {$_gitdir eq ".
"} {
1262 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1263 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1265 if {![file isdirectory $_gitdir]} {
1266 catch {wm withdraw .}
1267 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1270 # _gitdir exists, so try loading the config
1274 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
1275 if {[package vsatisfies $_git_version 1.7.0]} {
1276 set _gitworktree [git rev-parse --show-toplevel]
1278 # try to set work tree from environment, core.worktree or use
1279 # cdup to obtain a relative path to the top of the worktree. If
1280 # run from the top, the ./ prefix ensures normalize expands pwd.
1281 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1282 set _gitworktree [get_config core.worktree]
1283 if {$_gitworktree eq ""} {
1284 set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1289 if {$_prefix ne {}} {
1290 if {$_gitworktree eq {}} {
1291 regsub -all {[^/]+/} $_prefix ../ cdup
1293 set cdup $_gitworktree
1295 if {[catch {cd $cdup} err]} {
1296 catch {wm withdraw .}
1297 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1300 set _gitworktree [pwd]
1302 } elseif {![is_enabled bare]} {
1304 catch {wm withdraw .}
1305 error_popup [strcat [mc "Cannot use bare repository
:"] "\n\n$_gitdir"]
1308 if {$_gitworktree eq {}} {
1309 set _gitworktree [file dirname $_gitdir]
1311 if {[catch {cd $_gitworktree} err]} {
1312 catch {wm withdraw .}
1313 error_popup [strcat [mc "No working directory
"] " $_gitworktree:\n\n$err"]
1316 set _gitworktree [pwd]
1318 set _reponame [file split [file normalize $_gitdir]]
1319 if {[lindex $_reponame end] eq {.git}} {
1320 set _reponame [lindex $_reponame end-1]
1322 set _reponame [lindex $_reponame end]
1325 ######################################################################
1329 set current_diff_path {}
1330 set current_diff_side {}
1331 set diff_actions [list]
1335 set MERGE_HEAD [list]
1338 set current_branch {}
1340 set current_diff_path {}
1342 set is_submodule_diff 0
1343 set is_conflict_diff 0
1344 set selected_commit_type new
1345 set diff_empty_count 0
1347 set nullid "0000000000000000000000000000000000000000"
1348 set nullid2 "0000000000000000000000000000000000000001"
1350 ######################################################################
1358 set disable_on_lock [list]
1359 set index_lock_type none
1361 proc lock_index {type} {
1362 global index_lock_type disable_on_lock
1364 if {$index_lock_type eq {none}} {
1365 set index_lock_type $type
1366 foreach w $disable_on_lock {
1367 uplevel #0 $w disabled
1370 } elseif {$index_lock_type eq "begin-
$type"} {
1371 set index_lock_type $type
1377 proc unlock_index {} {
1378 global index_lock_type disable_on_lock
1380 set index_lock_type none
1381 foreach w $disable_on_lock {
1382 uplevel #0 $w normal
1386 ######################################################################
1390 proc repository_state {ctvar hdvar mhvar} {
1391 global current_branch
1392 upvar $ctvar ct $hdvar hd $mhvar mh
1397 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1403 set merge_head [gitdir MERGE_HEAD]
1404 if {[file exists $merge_head]} {
1406 set fd_mh [open $merge_head r]
1407 while {[gets $fd_mh line] >= 0} {
1418 global PARENT empty_tree
1420 set p [lindex $PARENT 0]
1424 if {$empty_tree eq {}} {
1425 set empty_tree [git mktree << {}]
1430 proc force_amend {} {
1431 global selected_commit_type
1432 global HEAD PARENT MERGE_HEAD commit_type
1434 repository_state newType newHEAD newMERGE_HEAD
1437 set MERGE_HEAD $newMERGE_HEAD
1438 set commit_type $newType
1440 set selected_commit_type amend
1441 do_select_commit_type
1444 proc rescan {after {honor_trustmtime 1}} {
1445 global HEAD PARENT MERGE_HEAD commit_type
1446 global ui_index ui_workdir ui_comm
1447 global rescan_active file_states
1450 if {$rescan_active > 0 || ![lock_index read]} return
1452 repository_state newType newHEAD newMERGE_HEAD
1453 if {[string match amend* $commit_type]
1454 && $newType eq {normal}
1455 && $newHEAD eq $HEAD} {
1459 set MERGE_HEAD $newMERGE_HEAD
1460 set commit_type $newType
1463 array unset file_states
1465 if {!$::GITGUI_BCK_exists &&
1466 (![$ui_comm edit modified]
1467 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1468 if {[string match amend* $commit_type]} {
1469 } elseif {[load_message GITGUI_MSG]} {
1470 } elseif {[run_prepare_commit_msg_hook]} {
1471 } elseif {[load_message MERGE_MSG]} {
1472 } elseif {[load_message SQUASH_MSG]} {
1475 $ui_comm edit modified false
1478 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1479 rescan_stage2 {} $after
1482 ui_status [mc "Refreshing
file status...
"]
1483 set fd_rf [git_read update-index \
1489 fconfigure $fd_rf -blocking 0 -translation binary
1490 fileevent $fd_rf readable \
1491 [list rescan_stage2 $fd_rf $after]
1496 set is_git_info_exclude {}
1497 proc have_info_exclude {} {
1498 global is_git_info_exclude
1500 if {$is_git_info_exclude eq {}} {
1501 if {[catch {exec test -f [gitdir info exclude]}]} {
1502 set is_git_info_exclude 0
1504 set is_git_info_exclude 1
1507 return $is_git_info_exclude
1510 proc have_info_exclude {} {
1511 return [file readable [gitdir info exclude]]
1515 proc rescan_stage2 {fd after} {
1516 global rescan_active buf_rdi buf_rdf buf_rlo
1520 if {![eof $fd]} return
1524 if {[package vsatisfies $::_git_version 1.6.3]} {
1525 set ls_others [list --exclude-standard]
1527 set ls_others [list --exclude-per-directory=.gitignore]
1528 if {[have_info_exclude]} {
1529 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1531 set user_exclude [get_config core.excludesfile]
1532 if {$user_exclude ne {} && [file readable $user_exclude]} {
1533 lappend ls_others "--exclude-from=[file normalize
$user_exclude]"
1542 ui_status [mc "Scanning
for modified files ...
"]
1543 set fd_di [git_read diff-index --cached -z [PARENT]]
1544 set fd_df [git_read diff-files -z]
1545 set fd_lo [eval git_read ls-files --others -z $ls_others]
1547 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1548 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1549 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1550 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1551 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1552 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1555 proc load_message {file} {
1558 set f [gitdir $file]
1559 if {[file isfile $f]} {
1560 if {[catch {set fd [open $f r]}]} {
1563 fconfigure $fd -eofchar {}
1564 set content [string trim [read $fd]]
1566 regsub -all -line {[ \r\t]+$} $content {} content
1567 $ui_comm delete 0.0 end
1568 $ui_comm insert end $content
1574 proc run_prepare_commit_msg_hook {} {
1577 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1578 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1579 # empty file but existent file.
1581 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1583 if {[file isfile [gitdir MERGE_MSG]]} {
1584 set pcm_source "merge
"
1585 set fd_mm [open [gitdir MERGE_MSG] r]
1586 puts -nonewline $fd_pcm [read $fd_mm]
1588 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1589 set pcm_source "squash
"
1590 set fd_sm [open [gitdir SQUASH_MSG] r]
1591 puts -nonewline $fd_pcm [read $fd_sm]
1599 set fd_ph [githook_read prepare-commit-msg \
1600 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1602 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1606 ui_status [mc "Calling prepare-commit-msg hook...
"]
1609 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1610 fileevent $fd_ph readable \
1611 [list prepare_commit_msg_hook_wait $fd_ph]
1616 proc prepare_commit_msg_hook_wait {fd_ph} {
1619 append pch_error [read $fd_ph]
1620 fconfigure $fd_ph -blocking 1
1622 if {[catch {close $fd_ph}]} {
1623 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1624 hook_failed_popup prepare-commit-msg $pch_error
1625 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1628 load_message PREPARE_COMMIT_MSG
1631 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1634 fconfigure $fd_ph -blocking 0
1635 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1638 proc read_diff_index {fd after} {
1641 append buf_rdi [read $fd]
1643 set n [string length $buf_rdi]
1645 set z1 [string first "\
0" $buf_rdi $c]
1646 if {$z1 == -1} break
1648 set z2 [string first "\
0" $buf_rdi $z1]
1649 if {$z2 == -1} break
1652 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1653 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1655 [encoding convertfrom $p] \
1657 [list [lindex $i 0] [lindex $i 2]] \
1663 set buf_rdi [string range $buf_rdi $c end]
1668 rescan_done $fd buf_rdi $after
1671 proc read_diff_files {fd after} {
1674 append buf_rdf [read $fd]
1676 set n [string length $buf_rdf]
1678 set z1 [string first "\
0" $buf_rdf $c]
1679 if {$z1 == -1} break
1681 set z2 [string first "\
0" $buf_rdf $z1]
1682 if {$z2 == -1} break
1685 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1686 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1688 [encoding convertfrom $p] \
1691 [list [lindex $i 0] [lindex $i 2]]
1696 set buf_rdf [string range $buf_rdf $c end]
1701 rescan_done $fd buf_rdf $after
1704 proc read_ls_others {fd after} {
1707 append buf_rlo [read $fd]
1708 set pck [split $buf_rlo "\
0"]
1709 set buf_rlo [lindex $pck end]
1710 foreach p [lrange $pck 0 end-1] {
1711 set p [encoding convertfrom $p]
1712 if {[string index $p end] eq {/}} {
1713 set p [string range $p 0 end-1]
1717 rescan_done $fd buf_rlo $after
1720 proc rescan_done {fd buf after} {
1721 global rescan_active current_diff_path
1722 global file_states repo_config
1725 if {![eof $fd]} return
1728 if {[incr rescan_active -1] > 0} return
1733 if {$current_diff_path ne {}} { reshow_diff $after }
1734 if {$current_diff_path eq {}} { select_first_diff $after }
1737 proc prune_selection {} {
1738 global file_states selected_paths
1740 foreach path [array names selected_paths] {
1741 if {[catch {set still_here $file_states($path)}]} {
1742 unset selected_paths($path)
1747 ######################################################################
1751 proc mapicon {w state path} {
1754 if {[catch {set r $all_icons($state$w)}]} {
1755 puts "error
: no icon
for $w state
={$state} $path"
1761 proc mapdesc {state path} {
1764 if {[catch {set r $all_descs($state)}]} {
1765 puts "error
: no desc
for state
={$state} $path"
1771 proc ui_status {msg} {
1773 if {[info exists main_status]} {
1774 $main_status show $msg
1778 proc ui_ready {{test {}}} {
1780 if {[info exists main_status]} {
1781 $main_status show [mc "Ready.
"] $test
1785 proc escape_path {path} {
1786 regsub -all {\\} $path "\\\\" path
1787 regsub -all "\n" $path "\\n
" path
1791 proc short_path {path} {
1792 return [escape_path [lindex [file split $path] end]]
1796 set null_sha1 [string repeat 0 40]
1798 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1799 global file_states next_icon_id null_sha1
1801 set s0 [string index $new_state 0]
1802 set s1 [string index $new_state 1]
1804 if {[catch {set info $file_states($path)}]} {
1806 set icon n[incr next_icon_id]
1808 set state [lindex $info 0]
1809 set icon [lindex $info 1]
1810 if {$head_info eq {}} {set head_info [lindex $info 2]}
1811 if {$index_info eq {}} {set index_info [lindex $info 3]}
1814 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1815 elseif {$s0 eq {_}} {set s0 _}
1817 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1818 elseif {$s1 eq {_}} {set s1 _}
1820 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1821 set head_info [list 0 $null_sha1]
1822 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1823 && $head_info eq {}} {
1824 set head_info $index_info
1825 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1826 set index_info $head_info
1830 set file_states($path) [list $s0$s1 $icon \
1831 $head_info $index_info \
1836 proc display_file_helper {w path icon_name old_m new_m} {
1839 if {$new_m eq {_}} {
1840 set lno [lsearch -sorted -exact $file_lists($w) $path]
1842 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1844 $w conf -state normal
1845 $w delete $lno.0 [expr {$lno + 1}].0
1846 $w conf -state disabled
1848 } elseif {$old_m eq {_} && $new_m ne {_}} {
1849 lappend file_lists($w) $path
1850 set file_lists($w) [lsort -unique $file_lists($w)]
1851 set lno [lsearch -sorted -exact $file_lists($w) $path]
1853 $w conf -state normal
1854 $w image create $lno.0 \
1855 -align center -padx 5 -pady 1 \
1857 -image [mapicon $w $new_m $path]
1858 $w insert $lno.1 "[escape_path
$path]\n"
1859 $w conf -state disabled
1860 } elseif {$old_m ne $new_m} {
1861 $w conf -state normal
1862 $w image conf $icon_name -image [mapicon $w $new_m $path]
1863 $w conf -state disabled
1867 proc display_file {path state} {
1868 global file_states selected_paths
1869 global ui_index ui_workdir
1871 set old_m [merge_state $path $state]
1872 set s $file_states($path)
1873 set new_m [lindex $s 0]
1874 set icon_name [lindex $s 1]
1876 set o [string index $old_m 0]
1877 set n [string index $new_m 0]
1884 display_file_helper $ui_index $path $icon_name $o $n
1886 if {[string index $old_m 0] eq {U}} {
1889 set o [string index $old_m 1]
1891 if {[string index $new_m 0] eq {U}} {
1894 set n [string index $new_m 1]
1896 display_file_helper $ui_workdir $path $icon_name $o $n
1898 if {$new_m eq {__}} {
1899 unset file_states($path)
1900 catch {unset selected_paths($path)}
1904 proc display_all_files_helper {w path icon_name m} {
1907 lappend file_lists($w) $path
1908 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1909 $w image create end \
1910 -align center -padx 5 -pady 1 \
1912 -image [mapicon $w $m $path]
1913 $w insert end "[escape_path
$path]\n"
1917 proc display_all_files {} {
1918 global ui_index ui_workdir
1919 global file_states file_lists
1921 global files_warning
1923 $ui_index conf -state normal
1924 $ui_workdir conf -state normal
1926 $ui_index delete 0.0 end
1927 $ui_workdir delete 0.0 end
1930 set file_lists($ui_index) [list]
1931 set file_lists($ui_workdir) [list]
1933 set to_display [lsort [array names file_states]]
1934 set display_limit [get_config gui.maxfilesdisplayed]
1935 if {[llength $to_display] > $display_limit} {
1936 if {!$files_warning} {
1937 # do not repeatedly warn:
1939 info_popup [mc "Displaying only
%s of
%s files.
" \
1940 $display_limit [llength $to_display]]
1942 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1944 foreach path $to_display {
1945 set s $file_states($path)
1947 set icon_name [lindex $s 1]
1949 set s [string index $m 0]
1950 if {$s ne {U} && $s ne {_}} {
1951 display_all_files_helper $ui_index $path \
1955 if {[string index $m 0] eq {U}} {
1958 set s [string index $m 1]
1961 display_all_files_helper $ui_workdir $path \
1966 $ui_index conf -state disabled
1967 $ui_workdir conf -state disabled
1970 ######################################################################
1975 #define mask_width 14
1976 #define mask_height 15
1977 static unsigned char mask_bits[] = {
1978 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1979 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1980 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1983 image create bitmap file_plain -background white -foreground black -data {
1984 #define plain_width 14
1985 #define plain_height 15
1986 static unsigned char plain_bits[] = {
1987 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1988 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1989 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1990 } -maskdata $filemask
1992 image create bitmap file_mod -background white -foreground blue -data {
1993 #define mod_width 14
1994 #define mod_height 15
1995 static unsigned char mod_bits[] = {
1996 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1997 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1998 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1999 } -maskdata $filemask
2001 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2002 #define file_fulltick_width 14
2003 #define file_fulltick_height 15
2004 static unsigned char file_fulltick_bits
[] = {
2005 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2006 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2007 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2008 } -maskdata $filemask
2010 image create bitmap file_question
-background white
-foreground black
-data {
2011 #define file_question_width 14
2012 #define file_question_height 15
2013 static unsigned char file_question_bits
[] = {
2014 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2015 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2016 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2017 } -maskdata $filemask
2019 image create bitmap file_removed
-background white
-foreground red
-data {
2020 #define file_removed_width 14
2021 #define file_removed_height 15
2022 static unsigned char file_removed_bits
[] = {
2023 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2024 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2025 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2026 } -maskdata $filemask
2028 image create bitmap file_merge
-background white
-foreground blue
-data {
2029 #define file_merge_width 14
2030 #define file_merge_height 15
2031 static unsigned char file_merge_bits
[] = {
2032 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2033 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2034 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2035 } -maskdata $filemask
2037 image create bitmap file_statechange
-background white
-foreground green
-data {
2038 #define file_statechange_width 14
2039 #define file_statechange_height 15
2040 static unsigned char file_statechange_bits
[] = {
2041 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2042 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2043 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2044 } -maskdata $filemask
2046 set ui_index .vpane.files.index.list
2047 set ui_workdir .vpane.files.workdir.list
2049 set all_icons
(_
$ui_index) file_plain
2050 set all_icons
(A
$ui_index) file_plain
2051 set all_icons
(M
$ui_index) file_fulltick
2052 set all_icons
(D
$ui_index) file_removed
2053 set all_icons
(U
$ui_index) file_merge
2054 set all_icons
(T
$ui_index) file_statechange
2056 set all_icons
(_
$ui_workdir) file_plain
2057 set all_icons
(M
$ui_workdir) file_mod
2058 set all_icons
(D
$ui_workdir) file_question
2059 set all_icons
(U
$ui_workdir) file_merge
2060 set all_icons
(O
$ui_workdir) file_plain
2061 set all_icons
(T
$ui_workdir) file_statechange
2063 set max_status_desc
0
2065 {__
{mc
"Unmodified"}}
2067 {_M
{mc
"Modified, not staged"}}
2068 {M_
{mc
"Staged for commit"}}
2069 {MM
{mc
"Portions staged for commit"}}
2070 {MD
{mc
"Staged for commit, missing"}}
2072 {_T
{mc
"File type changed, not staged"}}
2073 {MT
{mc
"File type changed, old type staged for commit"}}
2074 {AT
{mc
"File type changed, old type staged for commit"}}
2075 {T_
{mc
"File type changed, staged"}}
2076 {TM
{mc
"File type change staged, modification not staged"}}
2077 {TD
{mc
"File type change staged, file missing"}}
2079 {_O
{mc
"Untracked, not staged"}}
2080 {A_
{mc
"Staged for commit"}}
2081 {AM
{mc
"Portions staged for commit"}}
2082 {AD
{mc
"Staged for commit, missing"}}
2085 {D_
{mc
"Staged for removal"}}
2086 {DO
{mc
"Staged for removal, still present"}}
2088 {_U
{mc
"Requires merge resolution"}}
2089 {U_
{mc
"Requires merge resolution"}}
2090 {UU
{mc
"Requires merge resolution"}}
2091 {UM
{mc
"Requires merge resolution"}}
2092 {UD
{mc
"Requires merge resolution"}}
2093 {UT
{mc
"Requires merge resolution"}}
2095 set text
[eval [lindex
$i 1]]
2096 if {$max_status_desc < [string length
$text]} {
2097 set max_status_desc
[string length
$text]
2099 set all_descs
([lindex
$i 0]) $text
2103 ######################################################################
2107 proc scrollbar2many
{list mode args
} {
2108 foreach w
$list {eval $w $mode $args}
2111 proc many2scrollbar
{list mode sb top bottom
} {
2112 $sb set $top $bottom
2113 foreach w
$list {$w $mode moveto
$top}
2116 proc incr_font_size
{font
{amt
1}} {
2117 set sz
[font configure
$font -size]
2119 font configure
$font -size $sz
2120 font configure
${font}bold
-size $sz
2121 font configure
${font}italic
-size $sz
2124 ######################################################################
2128 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
2130 proc do_gitk
{revs
{is_submodule false
}} {
2131 global current_diff_path file_states current_diff_side ui_index
2134 # -- Always start gitk through whatever we were loaded with. This
2135 # lets us bypass using shell process on Windows systems.
2137 set exe
[_which gitk
-script]
2138 set cmd
[list
[info nameofexecutable
] $exe]
2140 error_popup
[mc
"Couldn't find gitk in PATH"]
2144 if {[info exists env
(GIT_DIR
)]} {
2145 set old_GIT_DIR
$env(GIT_DIR
)
2152 if {!$is_submodule} {
2156 set env
(GIT_DIR
) [file normalize
[gitdir
]]
2158 cd $current_diff_path
2159 if {$revs eq
{--}} {
2160 set s
$file_states($current_diff_path)
2163 switch
-glob -- [lindex
$s 0] {
2164 M_
{ set old_sha1
[lindex
[lindex
$s 2] 1] }
2165 _M
{ set old_sha1
[lindex
[lindex
$s 3] 1] }
2167 if {$current_diff_side eq
$ui_index} {
2168 set old_sha1
[lindex
[lindex
$s 2] 1]
2169 set new_sha1
[lindex
[lindex
$s 3] 1]
2171 set old_sha1
[lindex
[lindex
$s 3] 1]
2175 set revs
$old_sha1...
$new_sha1
2177 if {[info exists env
(GIT_DIR
)]} {
2181 eval exec $cmd $revs "--" "--" &
2183 if {$old_GIT_DIR ne
{}} {
2184 set env
(GIT_DIR
) $old_GIT_DIR
2188 ui_status $
::starting_gitk_msg
2190 ui_ready
$starting_gitk_msg
2195 proc do_git_gui
{} {
2196 global current_diff_path
2198 # -- Always start git gui through whatever we were loaded with. This
2199 # lets us bypass using shell process on Windows systems.
2201 set exe
[list
[_which git
]]
2203 error_popup
[mc
"Couldn't find git gui in PATH"]
2207 if {[info exists env
(GIT_DIR
)]} {
2208 set old_GIT_DIR
$env(GIT_DIR
)
2215 cd $current_diff_path
2217 eval exec $exe gui
&
2219 if {$old_GIT_DIR ne
{}} {
2220 set env
(GIT_DIR
) $old_GIT_DIR
2224 ui_status $
::starting_gitk_msg
2226 ui_ready
$starting_gitk_msg
2231 proc do_explore
{} {
2234 if {[is_Cygwin
] ||
[is_Windows
]} {
2235 set explorer
"explorer.exe"
2236 } elseif
{[is_MacOSX
]} {
2239 # freedesktop.org-conforming system is our best shot
2240 set explorer
"xdg-open"
2242 eval exec $explorer [list
[file nativename
$_gitworktree]] &
2248 proc terminate_me
{win
} {
2250 if {$win ne
{.
}} return
2254 proc do_quit
{{rc
{1}}} {
2255 global ui_comm is_quitting repo_config commit_type
2256 global GITGUI_BCK_exists GITGUI_BCK_i
2257 global ui_comm_spell
2258 global ret_code use_ttk
2260 if {$is_quitting} return
2263 if {[winfo exists
$ui_comm]} {
2264 # -- Stash our current commit buffer.
2266 set save
[gitdir GITGUI_MSG
]
2267 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
2268 file rename
-force [gitdir GITGUI_BCK
] $save
2269 set GITGUI_BCK_exists
0
2271 set msg
[string trim
[$ui_comm get
0.0 end
]]
2272 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2273 if {(![string match amend
* $commit_type]
2274 ||
[$ui_comm edit modified
])
2277 set fd
[open
$save w
]
2278 puts
-nonewline $fd $msg
2282 catch
{file delete
$save}
2286 # -- Cancel our spellchecker if its running.
2288 if {[info exists ui_comm_spell
]} {
2292 # -- Remove our editor backup, its not needed.
2294 after cancel
$GITGUI_BCK_i
2295 if {$GITGUI_BCK_exists} {
2296 catch
{file delete
[gitdir GITGUI_BCK
]}
2299 # -- Stash our current window geometry into this repository.
2301 set cfg_wmstate
[wm state .
]
2302 if {[catch
{set rc_wmstate
$repo_config(gui.wmstate
)}]} {
2305 if {$cfg_wmstate ne
$rc_wmstate} {
2306 catch
{git config gui.wmstate
$cfg_wmstate}
2308 if {$cfg_wmstate eq
{zoomed
}} {
2309 # on Windows wm geometry will lie about window
2310 # position (but not size) when window is zoomed
2311 # restore the window before querying wm geometry
2314 set cfg_geometry
[list
]
2315 lappend cfg_geometry
[wm geometry .
]
2317 lappend cfg_geometry
[.vpane sashpos
0]
2318 lappend cfg_geometry
[.vpane.files sashpos
0]
2320 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
2321 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
2323 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2326 if {$cfg_geometry ne
$rc_geometry} {
2327 catch
{git config gui.geometry
$cfg_geometry}
2333 # Briefly enable send again, working around Tk bug
2334 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2335 tk appname
[appname
]
2344 proc ui_do_rescan
{} {
2345 rescan
{force_first_diff ui_ready
}
2352 proc next_diff
{{after
{}}} {
2353 global next_diff_p next_diff_w next_diff_i
2354 show_diff
$next_diff_p $next_diff_w {} {} $after
2357 proc find_anchor_pos
{lst name
} {
2358 set lid
[lsearch
-sorted -exact $lst $name]
2362 foreach lname
$lst {
2363 if {$lname >= $name} break
2371 proc find_file_from
{flist idx delta path mmask
} {
2374 set len
[llength
$flist]
2375 while {$idx >= 0 && $idx < $len} {
2376 set name
[lindex
$flist $idx]
2378 if {$name ne
$path && [info exists file_states
($name)]} {
2379 set state
[lindex
$file_states($name) 0]
2381 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2392 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2393 global next_diff_p next_diff_w next_diff_i
2394 global file_lists ui_index ui_workdir
2396 set flist
$file_lists($w)
2398 set lno
[find_anchor_pos
$flist $path]
2403 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2404 if {$w eq
$ui_index} {
2407 set mmask
"$mmask\$"
2411 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2414 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2419 set next_diff_p
[lindex
$flist $idx]
2420 set next_diff_i
[expr {$idx+1}]
2427 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2428 global current_diff_path
2430 if {$path ne
$current_diff_path} {
2432 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2435 return {reshow_diff
;}
2439 proc select_first_diff
{after
} {
2442 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2443 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2450 proc force_first_diff
{after
} {
2451 global ui_workdir current_diff_path file_states
2453 if {[info exists file_states
($current_diff_path)]} {
2454 set state
[lindex
$file_states($current_diff_path) 0]
2460 if {[string first
{U
} $state] >= 0} {
2461 # Already a conflict, do nothing
2462 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {^_?U
}]} {
2464 } elseif
{[string index
$state 1] ne
{O
}} {
2465 # Already a diff & no conflicts, do nothing
2466 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {[^O
]$
}]} {
2477 proc toggle_or_diff
{w x y
} {
2478 global file_states file_lists current_diff_path ui_index ui_workdir
2479 global last_clicked selected_paths
2481 set pos
[split [$w index @
$x,$y] .
]
2482 set lno
[lindex
$pos 0]
2483 set col [lindex
$pos 1]
2484 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2490 set last_clicked
[list
$w $lno]
2491 array
unset selected_paths
2492 $ui_index tag remove in_sel
0.0 end
2493 $ui_workdir tag remove in_sel
0.0 end
2495 # Determine the state of the file
2496 if {[info exists file_states
($path)]} {
2497 set state
[lindex
$file_states($path) 0]
2502 # Restage the file, or simply show the diff
2503 if {$col == 0 && $y > 1} {
2504 # Conflicts need special handling
2505 if {[string first
{U
} $state] >= 0} {
2506 # $w must always be $ui_workdir, but...
2507 if {$w ne
$ui_workdir} { set lno
{} }
2508 merge_stage_workdir
$path $lno
2512 if {[string index
$state 1] eq
{O
}} {
2518 set after
[next_diff_after_action
$w $path $lno $mmask]
2520 if {$w eq
$ui_index} {
2522 "Unstaging [short_path $path] from commit" \
2524 [concat
$after [list ui_ready
]]
2525 } elseif
{$w eq
$ui_workdir} {
2527 "Adding [short_path $path]" \
2529 [concat
$after [list ui_ready
]]
2532 set selected_paths
($path) 1
2533 show_diff
$path $w $lno
2537 proc add_one_to_selection
{w x y
} {
2538 global file_lists last_clicked selected_paths
2540 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2541 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2547 if {$last_clicked ne
{}
2548 && [lindex
$last_clicked 0] ne
$w} {
2549 array
unset selected_paths
2550 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2553 set last_clicked
[list
$w $lno]
2554 if {[catch
{set in_sel
$selected_paths($path)}]} {
2558 unset selected_paths
($path)
2559 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2561 set selected_paths
($path) 1
2562 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2566 proc add_range_to_selection
{w x y
} {
2567 global file_lists last_clicked selected_paths
2569 if {[lindex
$last_clicked 0] ne
$w} {
2570 toggle_or_diff
$w $x $y
2574 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2575 set lc
[lindex
$last_clicked 1]
2584 foreach path
[lrange
$file_lists($w) \
2585 [expr {$begin - 1}] \
2586 [expr {$end - 1}]] {
2587 set selected_paths
($path) 1
2589 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2592 proc show_more_context
{} {
2594 if {$repo_config(gui.diffcontext
) < 99} {
2595 incr repo_config
(gui.diffcontext
)
2600 proc show_less_context
{} {
2602 if {$repo_config(gui.diffcontext
) > 1} {
2603 incr repo_config
(gui.diffcontext
) -1
2608 ######################################################################
2616 menu .mbar
-tearoff 0
2618 # -- Apple Menu (Mac OS X only)
2620 .mbar add cascade
-label Apple
-menu .mbar.apple
2623 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2624 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2625 if {[is_enabled branch
]} {
2626 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2628 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2629 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2631 if {[is_enabled transport
]} {
2632 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2633 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2635 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2636 .mbar add cascade
-label [mc Tools
] -menu .mbar.tools
2639 # -- Repository Menu
2641 menu .mbar.repository
2644 .mbar.repository add
command \
2645 -label [mc
"Explore Working Copy"] \
2646 -command {do_explore
}
2647 .mbar.repository add separator
2650 .mbar.repository add
command \
2651 -label [mc
"Browse Current Branch's Files"] \
2652 -command {browser
::new
$current_branch}
2653 set ui_browse_current
[.mbar.repository index last
]
2654 .mbar.repository add
command \
2655 -label [mc
"Browse Branch Files..."] \
2656 -command browser_open
::dialog
2657 .mbar.repository add separator
2659 .mbar.repository add
command \
2660 -label [mc
"Visualize Current Branch's History"] \
2661 -command {do_gitk
$current_branch}
2662 set ui_visualize_current
[.mbar.repository index last
]
2663 .mbar.repository add
command \
2664 -label [mc
"Visualize All Branch History"] \
2665 -command {do_gitk
--all}
2666 .mbar.repository add separator
2668 proc current_branch_write
{args
} {
2669 global current_branch
2670 .mbar.repository entryconf $
::ui_browse_current \
2671 -label [mc
"Browse %s's Files" $current_branch]
2672 .mbar.repository entryconf $
::ui_visualize_current \
2673 -label [mc
"Visualize %s's History" $current_branch]
2675 trace add variable current_branch
write current_branch_write
2677 if {[is_enabled multicommit
]} {
2678 .mbar.repository add
command -label [mc
"Database Statistics"] \
2681 .mbar.repository add
command -label [mc
"Compress Database"] \
2684 .mbar.repository add
command -label [mc
"Verify Database"] \
2685 -command do_fsck_objects
2687 .mbar.repository add separator
2690 .mbar.repository add
command \
2691 -label [mc
"Create Desktop Icon"] \
2692 -command do_cygwin_shortcut
2693 } elseif
{[is_Windows
]} {
2694 .mbar.repository add
command \
2695 -label [mc
"Create Desktop Icon"] \
2696 -command do_windows_shortcut
2697 } elseif
{[is_MacOSX
]} {
2698 .mbar.repository add
command \
2699 -label [mc
"Create Desktop Icon"] \
2700 -command do_macosx_app
2705 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2707 .mbar.repository add
command -label [mc Quit
] \
2715 .mbar.edit add
command -label [mc Undo
] \
2716 -command {catch
{[focus
] edit undo
}} \
2718 .mbar.edit add
command -label [mc Redo
] \
2719 -command {catch
{[focus
] edit redo
}} \
2721 .mbar.edit add separator
2722 .mbar.edit add
command -label [mc Cut
] \
2723 -command {catch
{tk_textCut
[focus
]}} \
2725 .mbar.edit add
command -label [mc Copy
] \
2726 -command {catch
{tk_textCopy
[focus
]}} \
2728 .mbar.edit add
command -label [mc Paste
] \
2729 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2731 .mbar.edit add
command -label [mc Delete
] \
2732 -command {catch
{[focus
] delete sel.first sel.last
}} \
2734 .mbar.edit add separator
2735 .mbar.edit add
command -label [mc
"Select All"] \
2736 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2741 if {[is_enabled branch
]} {
2744 .mbar.branch add
command -label [mc
"Create..."] \
2745 -command branch_create
::dialog \
2747 lappend disable_on_lock
[list .mbar.branch entryconf \
2748 [.mbar.branch index last
] -state]
2750 .mbar.branch add
command -label [mc
"Checkout..."] \
2751 -command branch_checkout
::dialog \
2753 lappend disable_on_lock
[list .mbar.branch entryconf \
2754 [.mbar.branch index last
] -state]
2756 .mbar.branch add
command -label [mc
"Rename..."] \
2757 -command branch_rename
::dialog
2758 lappend disable_on_lock
[list .mbar.branch entryconf \
2759 [.mbar.branch index last
] -state]
2761 .mbar.branch add
command -label [mc
"Delete..."] \
2762 -command branch_delete
::dialog
2763 lappend disable_on_lock
[list .mbar.branch entryconf \
2764 [.mbar.branch index last
] -state]
2766 .mbar.branch add
command -label [mc
"Reset..."] \
2767 -command merge
::reset_hard
2768 lappend disable_on_lock
[list .mbar.branch entryconf \
2769 [.mbar.branch index last
] -state]
2774 proc commit_btn_caption
{} {
2775 if {[is_enabled nocommit
]} {
2778 return [mc Commit@@verb
]
2782 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2785 if {![is_enabled nocommit
]} {
2786 .mbar.commit add radiobutton \
2787 -label [mc
"New Commit"] \
2788 -command do_select_commit_type \
2789 -variable selected_commit_type \
2791 lappend disable_on_lock \
2792 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2794 .mbar.commit add radiobutton \
2795 -label [mc
"Amend Last Commit"] \
2796 -command do_select_commit_type \
2797 -variable selected_commit_type \
2799 lappend disable_on_lock \
2800 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2802 .mbar.commit add separator
2805 .mbar.commit add
command -label [mc Rescan
] \
2806 -command ui_do_rescan \
2808 lappend disable_on_lock \
2809 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2811 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2812 -command do_add_selection \
2814 lappend disable_on_lock \
2815 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2817 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2818 -command do_add_all \
2820 lappend disable_on_lock \
2821 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2823 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2824 -command do_unstage_selection \
2826 lappend disable_on_lock \
2827 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2829 .mbar.commit add
command -label [mc
"Revert Changes"] \
2830 -command do_revert_selection \
2832 lappend disable_on_lock \
2833 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2835 .mbar.commit add separator
2837 .mbar.commit add
command -label [mc
"Show Less Context"] \
2838 -command show_less_context \
2839 -accelerator $M1T-\
-
2841 .mbar.commit add
command -label [mc
"Show More Context"] \
2842 -command show_more_context \
2845 .mbar.commit add separator
2847 if {![is_enabled nocommitmsg
]} {
2848 .mbar.commit add
command -label [mc
"Sign Off"] \
2849 -command do_signoff \
2853 .mbar.commit add
command -label [commit_btn_caption
] \
2854 -command do_commit \
2855 -accelerator $M1T-Return
2856 lappend disable_on_lock \
2857 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2862 if {[is_enabled branch
]} {
2864 .mbar.merge add
command -label [mc
"Local Merge..."] \
2865 -command merge
::dialog \
2867 lappend disable_on_lock \
2868 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2869 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2870 -command merge
::reset_hard
2871 lappend disable_on_lock \
2872 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2877 if {[is_enabled transport
]} {
2880 .mbar.remote add
command \
2881 -label [mc
"Add..."] \
2882 -command remote_add
::dialog \
2884 .mbar.remote add
command \
2885 -label [mc
"Push..."] \
2886 -command do_push_anywhere \
2888 .mbar.remote add
command \
2889 -label [mc
"Delete Branch..."] \
2890 -command remote_branch_delete
::dialog
2894 proc
::tk
::mac
::ShowPreferences
{} {do_options
}
2898 .mbar.edit add separator
2899 .mbar.edit add
command -label [mc
"Options..."] \
2905 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2906 set tools_menubar .mbar.tools
2908 $tools_menubar add separator
2909 $tools_menubar add
command -label [mc
"Add..."] -command tools_add
::dialog
2910 $tools_menubar add
command -label [mc
"Remove..."] -command tools_remove
::dialog
2912 if {[array names repo_config guitool.
*.cmd
] ne
{}} {
2919 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2923 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2925 .mbar.apple add separator
2927 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2930 . configure
-menu .mbar
2932 set doc_path
[githtmldir
]
2933 if {$doc_path ne
{}} {
2934 set doc_path
[file join $doc_path index.html
]
2937 set doc_path
[exec cygpath
--mixed $doc_path]
2941 if {[file isfile
$doc_path]} {
2942 set doc_url
"file:$doc_path"
2944 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2947 proc start_browser
{url
} {
2948 git
"web--browse" $url
2951 .mbar.
help add
command -label [mc
"Online Documentation"] \
2952 -command [list start_browser
$doc_url]
2954 .mbar.
help add
command -label [mc
"Show SSH Key"] \
2957 unset doc_path doc_url
2959 # -- Standard bindings
2961 wm protocol . WM_DELETE_WINDOW do_quit
2962 bind all
<$M1B-Key-q> do_quit
2963 bind all
<$M1B-Key-Q> do_quit
2964 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2965 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2967 set subcommand_args
{}
2969 set s
"usage: $::argv0 $::subcommand $::subcommand_args"
2970 if {[tk windowingsystem
] eq
"win32"} {
2972 tk_messageBox
-icon info
-message $s \
2980 proc normalize_relpath
{path
} {
2982 foreach item
[file split $path] {
2983 if {$item eq
{.
}} continue
2984 if {$item eq
{..
} && [llength
$elements] > 0
2985 && [lindex
$elements end
] ne
{..
}} {
2986 set elements
[lrange
$elements 0 end-1
]
2989 lappend elements
$item
2991 return [eval file join $elements]
2994 # -- Not a normal commit type invocation? Do that instead!
2996 switch
-- $subcommand {
2999 if {$subcommand eq
"blame"} {
3000 set subcommand_args
{[--line=<num
>] rev? path
}
3002 set subcommand_args
{rev? path
}
3004 if {$argv eq
{}} usage
3010 if {$is_path ||
[file exists
$_prefix$a]} {
3011 if {$path ne
{}} usage
3012 set path
[normalize_relpath
$_prefix$a]
3014 } elseif
{$a eq
{--}} {
3016 if {$head ne
{}} usage
3021 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
3022 if {$jump_spec ne
{} ||
$head ne
{}} usage
3023 set jump_spec
[list
$lnum]
3024 } elseif
{$head eq
{}} {
3025 if {$head ne
{}} usage
3034 if {$head ne
{} && $path eq
{}} {
3035 set path
[normalize_relpath
$_prefix$head]
3042 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
3044 set head [git rev-parse
--verify $head]
3046 if {[tk windowingsystem
] eq
"win32"} {
3047 tk_messageBox
-icon error
-title [mc Error
] -message $err
3054 set current_branch
$head
3058 switch
-- $subcommand {
3060 if {$jump_spec ne
{}} usage
3062 if {$path ne
{} && [file isdirectory
$path]} {
3063 set head $current_branch
3069 browser
::new
$head $path
3072 if {$head eq
{} && ![file exists
$path]} {
3073 catch
{wm withdraw .
}
3077 -title [mc
"git-gui: fatal error"] \
3078 -message [mc
"fatal: cannot stat path %s: No such file or directory" $path]
3081 blame
::new
$head $path $jump_spec
3088 if {[llength
$argv] != 0} {
3091 # fall through to setup UI for commits
3094 set err
"usage: $argv0 \[{blame|browser|citool}\]"
3095 if {[tk windowingsystem
] eq
"win32"} {
3097 tk_messageBox
-icon error
-message $err \
3108 ${NS}::frame .branch
3109 if {!$use_ttk} {.branch configure
-borderwidth 1 -relief sunken
}
3110 ${NS}::label .branch.l1 \
3111 -text [mc
"Current Branch:"] \
3114 ${NS}::label .branch.cb \
3115 -textvariable current_branch \
3118 pack .branch.l1
-side left
3119 pack .branch.cb
-side left
-fill x
3120 pack .branch
-side top
-fill x
3122 # -- Main Window Layout
3124 ${NS}::panedwindow .vpane
-orient horizontal
3125 ${NS}::panedwindow .vpane.files
-orient vertical
3127 .vpane add .vpane.files
3129 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
3131 pack .vpane
-anchor n
-side top
-fill both
-expand 1
3133 # -- Index File List
3135 ${NS}::frame .vpane.files.index
-height 100 -width 200
3136 tlabel .vpane.files.index.title \
3137 -text [mc
"Staged Changes (Will Commit)"] \
3138 -background lightgreen
-foreground black
3139 text
$ui_index -background white
-foreground black \
3141 -width 20 -height 10 \
3143 -cursor $cursor_ptr \
3144 -xscrollcommand {.vpane.files.index.sx
set} \
3145 -yscrollcommand {.vpane.files.index.sy
set} \
3147 ${NS}::scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
3148 ${NS}::scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
3149 pack .vpane.files.index.title
-side top
-fill x
3150 pack .vpane.files.index.sx
-side bottom
-fill x
3151 pack .vpane.files.index.sy
-side right
-fill y
3152 pack
$ui_index -side left
-fill both
-expand 1
3154 # -- Working Directory File List
3156 ${NS}::frame .vpane.files.workdir
-height 100 -width 200
3157 tlabel .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
3158 -background lightsalmon
-foreground black
3159 text
$ui_workdir -background white
-foreground black \
3161 -width 20 -height 10 \
3163 -cursor $cursor_ptr \
3164 -xscrollcommand {.vpane.files.workdir.sx
set} \
3165 -yscrollcommand {.vpane.files.workdir.sy
set} \
3167 ${NS}::scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
3168 ${NS}::scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
3169 pack .vpane.files.workdir.title
-side top
-fill x
3170 pack .vpane.files.workdir.sx
-side bottom
-fill x
3171 pack .vpane.files.workdir.sy
-side right
-fill y
3172 pack
$ui_workdir -side left
-fill both
-expand 1
3174 .vpane.files add .vpane.files.workdir
3175 .vpane.files add .vpane.files.index
3177 .vpane.files paneconfigure .vpane.files.workdir
-sticky news
3178 .vpane.files paneconfigure .vpane.files.index
-sticky news
3181 foreach i
[list
$ui_index $ui_workdir] {
3183 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
3187 # -- Diff and Commit Area
3189 ${NS}::frame .vpane.lower
-height 300 -width 400
3190 ${NS}::frame .vpane.lower.commarea
3191 ${NS}::frame .vpane.lower.
diff -relief sunken
-borderwidth 1
3192 pack .vpane.lower.
diff -fill both
-expand 1
3193 pack .vpane.lower.commarea
-side bottom
-fill x
3194 .vpane add .vpane.lower
3195 if {!$use_ttk} {.vpane paneconfigure .vpane.lower
-sticky nsew
}
3197 # -- Commit Area Buttons
3199 ${NS}::frame .vpane.lower.commarea.buttons
3200 ${NS}::label .vpane.lower.commarea.buttons.l
-text {} \
3203 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
3204 pack .vpane.lower.commarea.buttons
-side left
-fill y
3206 ${NS}::button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
3207 -command ui_do_rescan
3208 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
3209 lappend disable_on_lock \
3210 {.vpane.lower.commarea.buttons.rescan conf
-state}
3212 ${NS}::button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
3214 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
3215 lappend disable_on_lock \
3216 {.vpane.lower.commarea.buttons.incall conf
-state}
3218 if {![is_enabled nocommitmsg
]} {
3219 ${NS}::button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
3221 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
3224 ${NS}::button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
3226 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
3227 lappend disable_on_lock \
3228 {.vpane.lower.commarea.buttons.commit conf
-state}
3230 if {![is_enabled nocommit
]} {
3231 ${NS}::button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
3232 -command do_push_anywhere
3233 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
3236 # -- Commit Message Buffer
3238 ${NS}::frame .vpane.lower.commarea.buffer
3239 ${NS}::frame .vpane.lower.commarea.buffer.header
3240 set ui_comm .vpane.lower.commarea.buffer.t
3241 set ui_coml .vpane.lower.commarea.buffer.header.l
3243 if {![is_enabled nocommit
]} {
3244 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3245 -text [mc
"New Commit"] \
3246 -command do_select_commit_type \
3247 -variable selected_commit_type \
3249 lappend disable_on_lock \
3250 [list .vpane.lower.commarea.buffer.header.new conf
-state]
3251 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3252 -text [mc
"Amend Last Commit"] \
3253 -command do_select_commit_type \
3254 -variable selected_commit_type \
3256 lappend disable_on_lock \
3257 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
3260 ${NS}::label
$ui_coml \
3263 proc trace_commit_type
{varname args
} {
3264 global ui_coml commit_type
3265 switch
-glob -- $commit_type {
3266 initial
{set txt
[mc
"Initial Commit Message:"]}
3267 amend
{set txt
[mc
"Amended Commit Message:"]}
3268 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
3269 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
3270 merge
{set txt
[mc
"Merge Commit Message:"]}
3271 * {set txt
[mc
"Commit Message:"]}
3273 $ui_coml conf
-text $txt
3275 trace add variable commit_type
write trace_commit_type
3276 pack
$ui_coml -side left
-fill x
3278 if {![is_enabled nocommit
]} {
3279 pack .vpane.lower.commarea.buffer.header.amend
-side right
3280 pack .vpane.lower.commarea.buffer.header.new
-side right
3283 text
$ui_comm -background white
-foreground black \
3287 -autoseparators true \
3289 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
3291 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
3292 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3293 -command [list
$ui_comm yview
]
3294 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
3295 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
3296 pack
$ui_comm -side left
-fill y
3297 pack .vpane.lower.commarea.buffer
-side left
-fill y
3299 # -- Commit Message Buffer Context Menu
3301 set ctxm .vpane.lower.commarea.buffer.ctxm
3302 menu
$ctxm -tearoff 0
3305 -command {tk_textCut
$ui_comm}
3308 -command {tk_textCopy
$ui_comm}
3311 -command {tk_textPaste
$ui_comm}
3313 -label [mc Delete
] \
3314 -command {catch
{$ui_comm delete sel.first sel.last
}}
3317 -label [mc
"Select All"] \
3318 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
3320 -label [mc
"Copy All"] \
3322 $ui_comm tag add sel
0.0 end
3323 tk_textCopy
$ui_comm
3324 $ui_comm tag remove sel
0.0 end
3328 -label [mc
"Sign Off"] \
3330 set ui_comm_ctxm
$ctxm
3334 proc trace_current_diff_path
{varname args
} {
3335 global current_diff_path diff_actions file_states
3336 if {$current_diff_path eq
{}} {
3342 set p
$current_diff_path
3343 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
3345 set p
[escape_path
$p]
3349 .vpane.lower.
diff.header.status configure
-text $s
3350 .vpane.lower.
diff.header.
file configure
-text $f
3351 .vpane.lower.
diff.header.path configure
-text $p
3352 foreach w
$diff_actions {
3356 trace add variable current_diff_path
write trace_current_diff_path
3358 gold_frame .vpane.lower.
diff.header
3359 tlabel .vpane.lower.
diff.header.status \
3362 -width $max_status_desc \
3365 tlabel .vpane.lower.
diff.header.
file \
3370 tlabel .vpane.lower.
diff.header.path \
3375 pack .vpane.lower.
diff.header.status
-side left
3376 pack .vpane.lower.
diff.header.
file -side left
3377 pack .vpane.lower.
diff.header.path
-fill x
3378 set ctxm .vpane.lower.
diff.header.ctxm
3379 menu
$ctxm -tearoff 0
3387 -- $current_diff_path
3389 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3390 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
3394 ${NS}::frame .vpane.lower.
diff.body
3395 set ui_diff .vpane.lower.
diff.body.t
3396 text
$ui_diff -background white
-foreground black \
3398 -width 80 -height 5 -wrap none \
3400 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
3401 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
3403 catch
{$ui_diff configure
-tabstyle wordprocessor
}
3404 ${NS}::scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
3405 -command [list
$ui_diff xview
]
3406 ${NS}::scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
3407 -command [list
$ui_diff yview
]
3408 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
3409 pack .vpane.lower.
diff.body.sby
-side right
-fill y
3410 pack
$ui_diff -side left
-fill both
-expand 1
3411 pack .vpane.lower.
diff.header
-side top
-fill x
3412 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
3414 foreach
{n c
} {0 black
1 red4
2 green4
3 yellow4
4 blue4
5 magenta4
6 cyan4
7 grey60
} {
3415 $ui_diff tag configure clr4
$n -background $c
3416 $ui_diff tag configure clri4
$n -foreground $c
3417 $ui_diff tag configure clr3
$n -foreground $c
3418 $ui_diff tag configure clri3
$n -background $c
3420 $ui_diff tag configure clr1
-font font_diffbold
3421 $ui_diff tag configure clr4
-underline 1
3423 $ui_diff tag conf d_info
-foreground blue
-font font_diffbold
3425 $ui_diff tag conf d_cr
-elide true
3426 $ui_diff tag conf d_@
-font font_diffbold
3427 $ui_diff tag conf d_
+ -foreground {#00a000}
3428 $ui_diff tag conf d_-
-foreground red
3430 $ui_diff tag conf d_
++ -foreground {#00a000}
3431 $ui_diff tag conf d_--
-foreground red
3432 $ui_diff tag conf d_
+s \
3433 -foreground {#00a000} \
3434 -background {#e2effa}
3435 $ui_diff tag conf d_-s \
3437 -background {#e2effa}
3438 $ui_diff tag conf d_s
+ \
3439 -foreground {#00a000} \
3441 $ui_diff tag conf d_s- \
3445 $ui_diff tag conf d
< \
3446 -foreground orange \
3448 $ui_diff tag conf d
= \
3449 -foreground orange \
3451 $ui_diff tag conf d
> \
3452 -foreground orange \
3455 $ui_diff tag raise sel
3457 # -- Diff Body Context Menu
3460 proc create_common_diff_popup
{ctxm
} {
3462 -label [mc Refresh
] \
3463 -command reshow_diff
3464 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3467 -command {tk_textCopy
$ui_diff}
3468 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3470 -label [mc
"Select All"] \
3471 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3472 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3474 -label [mc
"Copy All"] \
3476 $ui_diff tag add sel
0.0 end
3477 tk_textCopy
$ui_diff
3478 $ui_diff tag remove sel
0.0 end
3480 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3483 -label [mc
"Decrease Font Size"] \
3484 -command {incr_font_size font_diff
-1}
3485 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3487 -label [mc
"Increase Font Size"] \
3488 -command {incr_font_size font_diff
1}
3489 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3493 build_encoding_menu
$emenu [list force_diff_encoding
]
3495 -label [mc
"Encoding"] \
3497 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3499 $ctxm add
command -label [mc
"Options..."] \
3503 set ctxm .vpane.lower.
diff.body.ctxm
3504 menu
$ctxm -tearoff 0
3506 -label [mc
"Apply/Reverse Hunk"] \
3507 -command {apply_hunk
$cursorX $cursorY}
3508 set ui_diff_applyhunk
[$ctxm index last
]
3509 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3511 -label [mc
"Apply/Reverse Line"] \
3512 -command {apply_range_or_line
$cursorX $cursorY; do_rescan
}
3513 set ui_diff_applyline
[$ctxm index last
]
3514 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3517 -label [mc
"Show Less Context"] \
3518 -command show_less_context
3519 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3521 -label [mc
"Show More Context"] \
3522 -command show_more_context
3523 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3525 create_common_diff_popup
$ctxm
3527 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3528 menu
$ctxmmg -tearoff 0
3529 $ctxmmg add
command \
3530 -label [mc
"Run Merge Tool"] \
3531 -command {merge_resolve_tool
}
3532 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3533 $ctxmmg add separator
3534 $ctxmmg add
command \
3535 -label [mc
"Use Remote Version"] \
3536 -command {merge_resolve_one
3}
3537 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3538 $ctxmmg add
command \
3539 -label [mc
"Use Local Version"] \
3540 -command {merge_resolve_one
2}
3541 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3542 $ctxmmg add
command \
3543 -label [mc
"Revert To Base"] \
3544 -command {merge_resolve_one
1}
3545 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3546 $ctxmmg add separator
3547 $ctxmmg add
command \
3548 -label [mc
"Show Less Context"] \
3549 -command show_less_context
3550 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3551 $ctxmmg add
command \
3552 -label [mc
"Show More Context"] \
3553 -command show_more_context
3554 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3555 $ctxmmg add separator
3556 create_common_diff_popup
$ctxmmg
3558 set ctxmsm .vpane.lower.
diff.body.ctxmsm
3559 menu
$ctxmsm -tearoff 0
3560 $ctxmsm add
command \
3561 -label [mc
"Visualize These Changes In The Submodule"] \
3562 -command {do_gitk
-- true
}
3563 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3564 $ctxmsm add
command \
3565 -label [mc
"Visualize Current Branch History In The Submodule"] \
3566 -command {do_gitk
{} true
}
3567 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3568 $ctxmsm add
command \
3569 -label [mc
"Visualize All Branch History In The Submodule"] \
3570 -command {do_gitk
--all true
}
3571 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3572 $ctxmsm add separator
3573 $ctxmsm add
command \
3574 -label [mc
"Start git gui In The Submodule"] \
3575 -command {do_git_gui
}
3576 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3577 $ctxmsm add separator
3578 create_common_diff_popup
$ctxmsm
3580 proc has_textconv
{path
} {
3581 if {[is_config_false gui.textconv
]} {
3584 set filter
[gitattr
$path diff set]
3585 set textconv
[get_config
[join [list
diff $filter textconv
] .
]]
3586 if {$filter ne
{set} && $textconv ne
{}} {
3593 proc popup_diff_menu
{ctxm ctxmmg ctxmsm x y X Y
} {
3594 global current_diff_path file_states
3597 if {[info exists file_states
($current_diff_path)]} {
3598 set state
[lindex
$file_states($current_diff_path) 0]
3602 if {[string first
{U
} $state] >= 0} {
3603 tk_popup
$ctxmmg $X $Y
3604 } elseif
{$
::is_submodule_diff
} {
3605 tk_popup
$ctxmsm $X $Y
3607 set has_range
[expr {[$
::ui_diff tag nextrange sel
0.0] != {}}]
3608 if {$
::ui_index eq $
::current_diff_side
} {
3609 set l
[mc
"Unstage Hunk From Commit"]
3611 set t
[mc
"Unstage Lines From Commit"]
3613 set t
[mc
"Unstage Line From Commit"]
3616 set l
[mc
"Stage Hunk For Commit"]
3618 set t
[mc
"Stage Lines For Commit"]
3620 set t
[mc
"Stage Line For Commit"]
3624 ||
$current_diff_path eq
{}
3627 ||
[string match
{?T
} $state]
3628 ||
[string match
{T?
} $state]
3629 ||
[has_textconv
$current_diff_path]} {
3634 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3635 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3636 tk_popup
$ctxm $X $Y
3639 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg $ctxmsm %x
%y
%X
%Y
]
3643 set main_status
[::status_bar
::new .status
]
3644 pack .status
-anchor w
-side bottom
-fill x
3645 $main_status show
[mc
"Initializing..."]
3649 proc on_ttk_pane_mapped
{w pane pos
} {
3651 after
0 [list after idle
[list
$w sashpos
$pane $pos]]
3653 proc on_tk_pane_mapped
{w pane x y
} {
3655 after
0 [list after idle
[list
$w sash place
$pane $x $y]]
3657 proc on_application_mapped
{} {
3658 global repo_config use_ttk
3660 set gm
$repo_config(gui.geometry
)
3663 [list on_ttk_pane_mapped
%W
0 [lindex
$gm 1]]
3664 bind .vpane.files
<Map
> \
3665 [list on_ttk_pane_mapped
%W
0 [lindex
$gm 2]]
3668 [list on_tk_pane_mapped
%W
0 \
3670 [lindex
[.vpane sash coord
0] 1]]
3671 bind .vpane.files
<Map
> \
3672 [list on_tk_pane_mapped
%W
0 \
3673 [lindex
[.vpane.files sash coord
0] 0] \
3676 wm geometry .
[lindex
$gm 0]
3678 if {[info exists repo_config
(gui.geometry
)]} {
3679 bind .
<Map
> [list on_application_mapped
]
3680 wm geometry .
[lindex
$repo_config(gui.geometry
) 0]
3683 # -- Load window state
3685 if {[info exists repo_config
(gui.wmstate
)]} {
3686 catch
{wm state .
$repo_config(gui.wmstate
)}
3691 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3692 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3693 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3694 bind $ui_comm <$M1B-Key-u> {do_unstage_selection
;break}
3695 bind $ui_comm <$M1B-Key-U> {do_unstage_selection
;break}
3696 bind $ui_comm <$M1B-Key-j> {do_revert_selection
;break}
3697 bind $ui_comm <$M1B-Key-J> {do_revert_selection
;break}
3698 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3699 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3700 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3701 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3702 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3703 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3704 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3705 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3706 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3707 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3708 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3709 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3710 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3711 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3712 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3714 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3715 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3716 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3717 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3718 bind $ui_diff <$M1B-Key-v> {break}
3719 bind $ui_diff <$M1B-Key-V> {break}
3720 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3721 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3722 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3723 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3724 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3725 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3726 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3727 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3728 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3729 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3730 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3731 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3732 bind $ui_diff <Button-1
> {focus
%W
}
3734 if {[is_enabled branch
]} {
3735 bind .
<$M1B-Key-n> branch_create
::dialog
3736 bind .
<$M1B-Key-N> branch_create
::dialog
3737 bind .
<$M1B-Key-o> branch_checkout
::dialog
3738 bind .
<$M1B-Key-O> branch_checkout
::dialog
3739 bind .
<$M1B-Key-m> merge
::dialog
3740 bind .
<$M1B-Key-M> merge
::dialog
3742 if {[is_enabled transport
]} {
3743 bind .
<$M1B-Key-p> do_push_anywhere
3744 bind .
<$M1B-Key-P> do_push_anywhere
3747 bind .
<Key-F5
> ui_do_rescan
3748 bind .
<$M1B-Key-r> ui_do_rescan
3749 bind .
<$M1B-Key-R> ui_do_rescan
3750 bind .
<$M1B-Key-s> do_signoff
3751 bind .
<$M1B-Key-S> do_signoff
3752 bind .
<$M1B-Key-t> do_add_selection
3753 bind .
<$M1B-Key-T> do_add_selection
3754 bind .
<$M1B-Key-j> do_revert_selection
3755 bind .
<$M1B-Key-J> do_revert_selection
3756 bind .
<$M1B-Key-i> do_add_all
3757 bind .
<$M1B-Key-I> do_add_all
3758 bind .
<$M1B-Key-minus> {show_less_context
;break}
3759 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3760 bind .
<$M1B-Key-equal> {show_more_context
;break}
3761 bind .
<$M1B-Key-plus> {show_more_context
;break}
3762 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3763 bind .
<$M1B-Key-Return> do_commit
3764 foreach i
[list
$ui_index $ui_workdir] {
3765 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
3766 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3767 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
3771 set file_lists
($ui_index) [list
]
3772 set file_lists
($ui_workdir) [list
]
3774 wm title .
"[appname] ([reponame]) [file normalize $_gitworktree]"
3775 focus
-force $ui_comm
3777 # -- Warn the user about environmental problems. Cygwin's Tcl
3778 # does *not* pass its env array onto any processes it spawns.
3779 # This means that git processes get none of our environment.
3784 set msg
[mc
"Possible environment issues exist.
3786 The following environment variables are probably
3787 going to be ignored by any Git subprocess run
3791 foreach name
[array names env
] {
3792 switch
-regexp -- $name {
3793 {^GIT_INDEX_FILE$
} -
3794 {^GIT_OBJECT_DIRECTORY$
} -
3795 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3797 {^GIT_EXTERNAL_DIFF$
} -
3801 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3802 append msg
" - $name\n"
3805 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3806 append msg
" - $name\n"
3808 set suggest_user
$name
3812 if {$ignored_env > 0} {
3814 This is due to a known issue with the
3815 Tcl binary distributed by Cygwin."]
3817 if {$suggest_user ne
{}} {
3820 A good replacement for %s
3821 is placing values for the user.name and
3822 user.email settings into your personal
3828 unset ignored_env msg suggest_user name
3831 # -- Only initialize complex UI if we are going to stay running.
3833 if {[is_enabled transport
]} {
3836 set n
[.mbar.remote index end
]
3837 populate_remotes_menu
3838 set n
[expr {[.mbar.remote index end
] - $n}]
3840 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3841 .mbar.remote insert
$n separator
3846 if {[winfo exists
$ui_comm]} {
3847 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
3849 # -- If both our backup and message files exist use the
3850 # newer of the two files to initialize the buffer.
3852 if {$GITGUI_BCK_exists} {
3853 set m
[gitdir GITGUI_MSG
]
3854 if {[file isfile
$m]} {
3855 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3856 catch
{file delete
[gitdir GITGUI_MSG
]}
3858 $ui_comm delete
0.0 end
3860 $ui_comm edit modified false
3861 catch
{file delete
[gitdir GITGUI_BCK
]}
3862 set GITGUI_BCK_exists
0
3868 proc backup_commit_buffer
{} {
3869 global ui_comm GITGUI_BCK_exists
3871 set m
[$ui_comm edit modified
]
3872 if {$m ||
$GITGUI_BCK_exists} {
3873 set msg
[string trim
[$ui_comm get
0.0 end
]]
3874 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3877 if {$GITGUI_BCK_exists} {
3878 catch
{file delete
[gitdir GITGUI_BCK
]}
3879 set GITGUI_BCK_exists
0
3883 set fd
[open
[gitdir GITGUI_BCK
] w
]
3884 puts
-nonewline $fd $msg
3886 set GITGUI_BCK_exists
1
3890 $ui_comm edit modified false
3893 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3896 backup_commit_buffer
3898 # -- If the user has aspell available we can drive it
3899 # in pipe mode to spellcheck the commit message.
3901 set spell_cmd
[list |
]
3902 set spell_dict
[get_config gui.spellingdictionary
]
3903 lappend spell_cmd aspell
3904 if {$spell_dict ne
{}} {
3905 lappend spell_cmd
--master=$spell_dict
3907 lappend spell_cmd
--mode=none
3908 lappend spell_cmd
--encoding=utf-8
3909 lappend spell_cmd pipe
3910 if {$spell_dict eq
{none
}
3911 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3912 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3914 set ui_comm_spell
[spellcheck
::init \
3920 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3923 lock_index begin-read
3924 if {![winfo ismapped .
]} {
3928 if {[is_enabled initialamend
]} {
3934 if {[is_enabled nocommitmsg
]} {
3935 $ui_comm configure
-state disabled
-background gray
3938 if {[is_enabled multicommit
] && ![is_config_false gui.gcwarning
]} {
3941 if {[is_enabled retcode
]} {
3942 bind .
<Destroy
> {+terminate_me
%W
}
3944 if {$picked && [is_config_true gui.autoexplore
]} {
3950 # indent-tabs-mode: t