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 if { [info exists
::env
(GIT_GUI_LIB_DIR
) ] } {
53 set oguilib $
::env
(GIT_GUI_LIB_DIR
)
55 set oguilib
{@@GITGUI_LIBDIR@@
}
57 set oguirel
{@@GITGUI_RELATIVE@@
}
58 if {$oguirel eq
{1}} {
59 set oguilib
[file dirname [file normalize
$argv0]]
60 if {[file tail $oguilib] eq
{git-core
}} {
61 set oguilib
[file dirname $oguilib]
63 set oguilib
[file dirname $oguilib]
64 set oguilib
[file join $oguilib share git-gui lib
]
65 set oguimsg
[file join $oguilib msgs
]
66 } elseif
{[string match @@
* $oguirel]} {
67 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
68 set oguimsg
[file join [file dirname [file normalize
$argv0]] po
]
70 set oguimsg
[file join $oguilib msgs
]
74 ######################################################################
76 ## enable verbose loading?
78 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
80 rename auto_load real__auto_load
81 proc auto_load
{name args
} {
82 puts stderr
"auto_load $name"
83 return [uplevel
1 real__auto_load
$name $args]
85 rename
source real__source
87 puts stderr
"source $args"
88 uplevel
1 [linsert
$args 0 real__source
]
90 if {[tk windowingsystem
] eq
"win32"} { console show
}
93 ######################################################################
95 ## Internationalization (i18n) through msgcat and gettext. See
96 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
98 package require msgcat
100 # Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
101 if {[tk windowingsystem
] eq
"win32"
102 && [package vcompare
[package provide msgcat
] 1.4.4] < 0
104 proc _mc_update_locale
{} {
105 set key
{HKEY_CURRENT_USER\Control Panel\Desktop
}
107 package require registry
108 set uilocale
[registry get
$key "PreferredUILanguages"]
109 msgcat
::ConvertLocale
[string map
{- _
} [lindex
$uilocale 0]]
111 if {[string length
$uilocale] > 0} {
112 msgcat
::mclocale
$uilocale
119 proc _mc_trim
{fmt} {
120 set cmk
[string first @@
$fmt]
122 return [string range
$fmt 0 [expr {$cmk - 1}]]
127 proc mc
{en_fmt args
} {
128 set fmt [_mc_trim
[::msgcat
::mc
$en_fmt]]
129 if {[catch
{set msg
[eval [list format
$fmt] $args]} err
]} {
130 set msg
[eval [list format
[_mc_trim
$en_fmt]] $args]
136 return [join $args {}]
139 ::msgcat
::mcload
$oguimsg
142 ######################################################################
144 ## On Mac, bring the current Wish process window to front
146 if {[tk windowingsystem
] eq
"aqua"} {
148 exec osascript
-e [format
{
149 tell application
"System Events"
150 set frontmost of processes whose unix id is
%d to true
156 ######################################################################
160 set _appname
{Git Gui
}
169 set _shellpath
{@@SHELL_PATH@@
}
171 set _trace
[lsearch
-exact $argv --trace]
173 set argv
[lreplace
$argv $_trace $_trace]
175 if {[tk windowingsystem
] eq
"win32"} { console show
}
180 # variable for the last merged branch (useful for a default when deleting
182 set _last_merged_branch
{}
185 global _shellpath env
186 if {[string match @@
* $_shellpath]} {
187 if {[info exists env
(SHELL
)]} {
206 return [eval [list
file join $_gitdir] $args]
209 proc gitexec
{args
} {
211 if {$_gitexec eq
{}} {
212 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
213 error
"Git not installed?\n\n$err"
216 set _gitexec
[exec cygpath \
221 set _gitexec
[file normalize
$_gitexec]
227 return [eval [list
file join $_gitexec] $args]
230 proc githtmldir
{args
} {
232 if {$_githtmldir eq
{}} {
233 if {[catch
{set _githtmldir
[git
--html-path]}]} {
234 # Git not installed or option not yet supported
238 set _githtmldir
[exec cygpath \
243 set _githtmldir
[file normalize
$_githtmldir]
249 return [eval [list
file join $_githtmldir] $args]
257 if {[tk windowingsystem
] eq
{aqua
}} {
264 if {$
::tcl_platform
(platform
) eq
{windows
}} {
272 if {$_iscygwin eq
{}} {
273 if {$
::tcl_platform
(platform
) eq
{windows
}} {
274 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
278 # Handle MSys2 which is only cygwin when MSYSTEM is MSYS.
279 if {[info exists
::env
(MSYSTEM
)] && $
::env
(MSYSTEM
) ne
"MSYS"} {
290 proc is_enabled
{option
} {
291 global enabled_options
292 if {[catch
{set on
$enabled_options($option)}]} {return 0}
296 proc enable_option
{option
} {
297 global enabled_options
298 set enabled_options
($option) 1
301 proc disable_option
{option
} {
302 global enabled_options
303 set enabled_options
($option) 0
306 ######################################################################
310 proc is_many_config
{name
} {
311 switch
-glob -- $name {
321 proc is_config_true
{name
} {
323 if {[catch
{set v
$repo_config($name)}]} {
326 set v
[string tolower
$v]
327 if {$v eq
{} ||
$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes} ||
$v eq
{on
}} {
334 proc is_config_false
{name
} {
336 if {[catch
{set v
$repo_config($name)}]} {
339 set v
[string tolower
$v]
340 if {$v eq
{false
} ||
$v eq
{0} ||
$v eq
{no
} ||
$v eq
{off
}} {
347 proc get_config
{name
} {
349 if {[catch
{set v
$repo_config($name)}]} {
361 if {$_isbare eq
{}} {
363 set _bare
[git rev-parse
--is-bare-repository]
365 true
{ set _isbare
1 }
366 false
{ set _isbare
0}
370 if {[is_config_true core.bare
]
371 ||
($_gitworktree eq
{}
372 && [lindex
[file split $_gitdir] end
] ne
{.git
})} {
382 ######################################################################
386 proc _trace_exec
{cmd
} {
387 if {!$
::_trace
} return
393 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
401 #'" fix poor old emacs font-lock mode
403 proc _git_cmd {name} {
406 if {[catch {set v $_git_cmd_path($name)}]} {
410 --exec-path { return [list $::_git $name] }
413 set p [gitexec git-$name$::_search_exe]
414 if {[file exists $p]} {
416 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
417 # Try to determine what sort of magic will make
418 # git-$name go and do its thing, because native
419 # Tcl on Windows doesn't know it.
421 set p [gitexec git-$name]
426 switch -glob -- [lindex $s 0] {
428 #!*perl { set i perl }
429 #!*python { set i python }
430 default { error "git-
$name is not supported
: $s" }
434 if {![info exists interp]} {
435 set interp [_which $i]
438 error "git-
$name requires
$i (not
in PATH
)"
440 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
442 # Assume it is builtin to git somehow and we
443 # aren't actually able to see a file for it.
445 set v [list $::_git $name]
447 set _git_cmd_path($name) $v
452 proc _which {what args} {
453 global env _search_exe _search_path
455 if {$_search_path eq {}} {
456 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
457 set _search_path [split [exec cygpath \
463 } elseif {[is_Windows]} {
464 set gitguidir [file dirname [info script]]
465 regsub -all ";" $gitguidir "\\;" gitguidir
466 set env(PATH) "$gitguidir;$env(PATH
)"
467 set _search_path [split $env(PATH) {;}]
470 set _search_path [split $env(PATH) :]
475 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
478 set suffix $_search_exe
481 foreach p $_search_path {
482 set p [file join $p $what$suffix]
483 if {[file exists $p]} {
484 return [file normalize $p]
490 # Test a file for a hashbang to identify executable scripts on Windows.
491 proc is_shellscript {filename} {
492 if {![file exists $filename]} {return 0}
493 set f [open $filename r]
494 fconfigure $f -encoding binary
495 set magic [read $f 2]
497 return [expr {$magic eq "#!"}]
500 # Run a command connected via pipes on stdout.
501 # This is for use with textconv filters and uses sh -c "..." to allow it to
502 # contain a command with arguments. On windows we must check for shell
503 # scripts specifically otherwise just call the filter command.
504 proc open_cmd_pipe
{cmd path
} {
506 if {![file executable
[shellpath
]]} {
507 set exe
[auto_execok
[lindex
$cmd 0]]
508 if {[is_shellscript
[lindex
$exe 0]]} {
509 set run
[linsert
[auto_execok sh
] end
-c "$cmd \"\$0\"" $path]
511 set run
[concat
$exe [lrange
$cmd 1 end
] $path]
514 set run
[list
[shellpath
] -c "$cmd \"\$0\"" $path]
516 return [open |
$run r
]
519 proc _lappend_nice
{cmd_var
} {
523 if {![info exists _nice
]} {
524 set _nice
[_which nice
]
525 if {[catch
{exec $_nice git version
}]} {
527 } elseif
{[is_Windows
] && [file dirname $_nice] ne
[file dirname $
::_git
]} {
540 switch
-- [lindex
$args 0] {
551 set args
[lrange
$args 1 end
]
554 set cmdp
[_git_cmd
[lindex
$args 0]]
555 set args
[lrange
$args 1 end
]
557 _trace_exec
[concat
$opt $cmdp $args]
558 set result
[eval exec $opt $cmdp $args]
559 if {[encoding system
] != "utf-8"} {
560 set result
[encoding convertfrom utf-8
[encoding convertto
$result]]
563 puts stderr
"< $result"
568 proc _open_stdout_stderr
{cmd
} {
571 set fd
[open
[concat
[list |
] $cmd] r
]
573 if { [lindex
$cmd end
] eq
{2>@
1}
574 && $err eq
{can not
find channel named
"1"}
576 # Older versions of Tcl 8.4 don't have this 2>@1 IO
577 # redirect operator. Fallback to |& cat for those.
578 # The command was not actually started, so its safe
579 # to try to start it a second time.
581 set fd
[open
[concat \
583 [lrange
$cmd 0 end-1
] \
590 fconfigure
$fd -eofchar {}
594 proc git_read
{args
} {
598 switch
-- [lindex
$args 0] {
613 set args
[lrange
$args 1 end
]
616 set cmdp
[_git_cmd
[lindex
$args 0]]
617 set args
[lrange
$args 1 end
]
619 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
622 proc git_write
{args
} {
626 switch
-- [lindex
$args 0] {
637 set args
[lrange
$args 1 end
]
640 set cmdp
[_git_cmd
[lindex
$args 0]]
641 set args
[lrange
$args 1 end
]
643 _trace_exec
[concat
$opt $cmdp $args]
644 return [open
[concat
[list |
] $opt $cmdp $args] w
]
647 proc githook_read
{hook_name args
} {
648 set pchook
[gitdir hooks
$hook_name]
651 # On Windows [file executable] might lie so we need to ask
652 # the shell if the hook is executable. Yes that's annoying.
656 if {![info exists interp
]} {
657 set interp
[_which sh
]
660 error
"hook execution requires sh (not in PATH)"
663 set scr
{if test -x "$1";then exec "$@";fi}
664 set sh_c
[list
$interp -c $scr $interp $pchook]
665 return [_open_stdout_stderr
[concat
$sh_c $args]]
668 if {[file executable
$pchook]} {
669 return [_open_stdout_stderr
[concat
[list
$pchook] $args]]
675 proc kill_file_process
{fd
} {
676 set process
[pid
$fd]
680 exec taskkill
/pid
$process
687 proc gitattr
{path attr default
} {
688 if {[catch
{set r
[git check-attr
$attr -- $path]}]} {
691 set r
[join [lrange
[split $r :] 2 end
] :]
694 if {$r eq
{unspecified
}} {
701 regsub
-all ' $value "'\\''" value
705 proc load_current_branch {} {
706 global current_branch is_detached
708 set fd [open [gitdir HEAD] r]
709 if {[gets $fd ref] < 1} {
714 set pfx {ref: refs/heads/}
715 set len [string length $pfx]
716 if {[string equal -length $len $pfx $ref]} {
717 # We're on a branch. It might not exist. But
718 # HEAD looks good enough to be a branch.
720 set current_branch [string range $ref $len end]
723 # Assume this is a detached head.
725 set current_branch HEAD
730 auto_load tk_optionMenu
731 rename tk_optionMenu real__tkOptionMenu
732 proc tk_optionMenu {w varName args} {
733 set m [eval real__tkOptionMenu $w $varName $args]
734 $m configure -font font_ui
735 $w configure -font font_ui
739 proc rmsel_tag {text} {
741 -background [$text cget -background] \
742 -foreground [$text cget -foreground] \
744 $text tag conf in_sel -background lightgray
745 bind $text <Motion> break
751 bind . <Visibility> {
752 bind . <Visibility> {}
757 wm iconbitmap . -default $oguilib/git-gui.ico
758 set ::tk::AlwaysShowSelection 1
759 bind . <Control-F2> {console show}
761 # Spoof an X11 display for SSH
762 if {![info exists env(DISPLAY)]} {
763 set env(DISPLAY) :9999
767 image create photo gitlogo -width 16 -height 16
769 gitlogo put #33CC33 -to 7 0 9 2
770 gitlogo put #33CC33 -to 4 2 12 4
771 gitlogo put #33CC33 -to 7 4 9 6
772 gitlogo put #CC3333 -to 4 6 12 8
773 gitlogo put gray26 -to 4 9 6 10
774 gitlogo put gray26 -to 3 10 6 12
775 gitlogo put gray26 -to 8 9 13 11
776 gitlogo put gray26 -to 8 11 10 12
777 gitlogo put gray26 -to 11 11 13 14
778 gitlogo put gray26 -to 3 12 5 14
779 gitlogo put gray26 -to 5 13
780 gitlogo put gray26 -to 10 13
781 gitlogo put gray26 -to 4 14 12 15
782 gitlogo put gray26 -to 5 15 11 16
785 image create photo gitlogo32 -width 32 -height 32
786 gitlogo32 copy gitlogo -zoom 2 2
788 wm iconphoto . -default gitlogo gitlogo32
792 ######################################################################
798 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
799 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
800 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
802 font create font_diff -family Courier -size 10
805 eval font configure font_ui [font actual [.dummy cget -font]]
810 font create font_uiitalic
811 font create font_uibold
812 font create font_diffbold
813 font create font_diffitalic
815 foreach class {Button Checkbutton Entry Label
816 Labelframe Listbox Message
817 Radiobutton Spinbox Text} {
818 option add *$class.font font_ui
821 option add *Menu.font font_ui
822 option add *Entry.borderWidth 1 startupFile
823 option add *Entry.relief sunken startupFile
824 option add *RadioButton.anchor w startupFile
828 if {[is_Windows] || [is_MacOSX]} {
829 option add *Menu.tearOff 0
840 proc bind_button3 {w cmd} {
841 bind $w <Any-Button-3> $cmd
843 # Mac OS X sends Button-2 on right click through three-button mouse,
844 # or through trackpad right-clicking (two-finger touch + click).
845 bind $w <Any-Button-2> $cmd
846 bind $w <Control-Button-1> $cmd
850 proc apply_config {} {
851 global repo_config font_descs
853 foreach option $font_descs {
854 set name [lindex $option 0]
855 set font [lindex $option 1]
858 foreach {cn cv} $repo_config(gui.$name) {
859 if {$cn eq {-weight}} {
862 font configure $font $cn $cv
865 font configure $font -weight normal
868 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
870 foreach {cn cv} [font configure $font] {
871 font configure ${font}bold $cn $cv
872 font configure ${font}italic $cn $cv
874 font configure ${font}bold -weight bold
875 font configure ${font}italic -slant italic
881 if {$repo_config(gui.usettk)} {
882 set use_ttk [package vsatisfies [package provide Tk] 8.5]
885 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
891 set default_config(branch.autosetupmerge) true
892 set default_config(merge.tool) {}
893 set default_config(mergetool.keepbackup) true
894 set default_config(merge.diffstat) true
895 set default_config(merge.summary) false
896 set default_config(merge.verbosity) 2
897 set default_config(user.name) {}
898 set default_config(user.email) {}
900 set default_config(gui.encoding) [encoding system]
901 set default_config(gui.matchtrackingbranch) false
902 set default_config(gui.textconv) true
903 set default_config(gui.pruneduringfetch) false
904 set default_config(gui.trustmtime) false
905 set default_config(gui.fastcopyblame) false
906 set default_config(gui.maxrecentrepo) 10
907 set default_config(gui.copyblamethreshold) 40
908 set default_config(gui.blamehistoryctx) 7
909 set default_config(gui.diffcontext) 5
910 set default_config(gui.diffopts) {}
911 set default_config(gui.commitmsgwidth) 75
912 set default_config(gui.newbranchtemplate) {}
913 set default_config(gui.spellingdictionary) {}
914 set default_config(gui.fontui) [font configure font_ui]
915 set default_config(gui.fontdiff) [font configure font_diff]
916 # TODO: this option should be added to the git-config documentation
917 set default_config(gui.maxfilesdisplayed) 5000
918 set default_config(gui.usettk) 1
919 set default_config(gui.warndetachedcommit) 1
920 set default_config(gui.tabsize) 8
922 {fontui font_ui {mc "Main Font
"}}
923 {fontdiff font_diff {mc "Diff
/Console Font
"}}
925 set default_config(gui.stageuntracked) ask
926 set default_config(gui.displayuntracked) true
928 ######################################################################
932 set _git [_which git]
934 catch {wm withdraw .}
938 -title [mc "git-gui
: fatal error
"] \
939 -message [mc "Cannot
find git
in PATH.
"]
943 ######################################################################
947 if {[catch {set _git_version [git --version]} err]} {
948 catch {wm withdraw .}
952 -title [mc "git-gui
: fatal error
"] \
953 -message "Cannot determine Git version
:
957 [appname
] requires Git
1.5.0 or later.
"
960 if {![regsub {^git version } $_git_version {} _git_version]} {
961 catch {wm withdraw .}
965 -title [mc "git-gui
: fatal error
"] \
966 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
970 proc get_trimmed_version {s} {
972 foreach x [split $s -._] {
973 if {[string is integer -strict $x]} {
981 set _real_git_version $_git_version
982 set _git_version [get_trimmed_version $_git_version]
984 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
985 catch {wm withdraw .}
990 -title "[appname
]: warning
" \
991 -message [mc "Git version cannot be determined.
993 %s claims it is version
'%s'.
995 %s requires
at least Git
1.5.0 or later.
997 Assume
'%s' is version
1.5.0?
998 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
999 set _git_version 1.5.0
1004 unset _real_git_version
1006 proc git-version {args} {
1009 switch [llength $args] {
1011 return $_git_version
1015 set op [lindex $args 0]
1016 set vr [lindex $args 1]
1017 set cm [package vcompare $_git_version $vr]
1018 return [expr $cm $op 0]
1022 set type [lindex $args 0]
1023 set name [lindex $args 1]
1024 set parm [lindex $args 2]
1025 set body [lindex $args 3]
1027 if {($type ne {proc} && $type ne {method})} {
1028 error "Invalid arguments to git-version
"
1030 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
1031 error "Last arm of
$type $name must be default
"
1034 foreach {op vr cb} [lrange $body 0 end-2] {
1035 if {[git-version $op $vr]} {
1036 return [uplevel [list $type $name $parm $cb]]
1040 return [uplevel [list $type $name $parm [lindex $body end]]]
1044 error "git-version
>= x
"
1050 if {[git-version < 1.5]} {
1051 catch {wm withdraw .}
1055 -title [mc "git-gui
: fatal error
"] \
1056 -message "[appname
] requires Git
1.5.0 or later.
1058 You are using
[git-version
]:
1064 ######################################################################
1066 ## configure our library
1068 set idx [file join $oguilib tclIndex]
1069 if {[catch {set fd [open $idx r]} err]} {
1070 catch {wm withdraw .}
1074 -title [mc "git-gui
: fatal error
"] \
1078 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1080 while {[gets $fd n] >= 0} {
1081 if {$n ne {} && ![string match #* $n]} {
1093 if {[lsearch -exact $loaded $p] >= 0} continue
1094 source [file join $oguilib $p]
1099 set auto_path [concat [list $oguilib] $auto_path]
1101 unset -nocomplain idx fd
1103 ######################################################################
1105 ## config file parsing
1107 git-version proc _parse_config {arr_name args} {
1114 [list git_read config] \
1116 [list --null --list]]
1117 fconfigure $fd_rc -translation binary -encoding utf-8
1118 set buf [read $fd_rc]
1121 foreach line [split $buf "\
0"] {
1122 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1123 if {[is_many_config $name]} {
1124 lappend arr($name) $value
1126 set arr($name) $value
1128 } elseif {[regexp {^([^\n]+)$} $line line name]} {
1129 # no value given, but interpreting them as
1130 # boolean will be handled as true
1139 set fd_rc [eval [list git_read config --list] $args]
1140 while {[gets $fd_rc line] >= 0} {
1141 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1142 if {[is_many_config $name]} {
1143 lappend arr($name) $value
1145 set arr($name) $value
1147 } elseif {[regexp {^([^=]+)$} $line line name]} {
1148 # no value given, but interpreting them as
1149 # boolean will be handled as true
1158 proc load_config {include_global} {
1159 global repo_config global_config system_config default_config
1161 if {$include_global} {
1162 _parse_config system_config --system
1163 _parse_config global_config --global
1165 _parse_config repo_config
1167 foreach name [array names default_config] {
1168 if {[catch {set v $system_config($name)}]} {
1169 set system_config($name) $default_config($name)
1172 foreach name [array names system_config] {
1173 if {[catch {set v $global_config($name)}]} {
1174 set global_config($name) $system_config($name)
1176 if {[catch {set v $repo_config($name)}]} {
1177 set repo_config($name) $system_config($name)
1182 ######################################################################
1184 ## feature option selection
1186 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1191 if {$subcommand eq {gui.sh}} {
1194 if {$subcommand eq {gui} && [llength $argv] > 0} {
1195 set subcommand [lindex $argv 0]
1196 set argv [lrange $argv 1 end]
1199 enable_option multicommit
1200 enable_option branch
1201 enable_option transport
1204 switch -- $subcommand {
1209 disable_option multicommit
1210 disable_option branch
1211 disable_option transport
1214 enable_option singlecommit
1215 enable_option retcode
1217 disable_option multicommit
1218 disable_option branch
1219 disable_option transport
1221 while {[llength $argv] > 0} {
1222 set a [lindex $argv 0]
1225 enable_option initialamend
1228 enable_option nocommit
1229 enable_option nocommitmsg
1232 disable_option nocommitmsg
1239 set argv [lrange $argv 1 end]
1244 ######################################################################
1246 ## execution environment
1248 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1250 # Suggest our implementation of askpass, if none is set
1251 if {![info exists env(SSH_ASKPASS)]} {
1252 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1255 ######################################################################
1261 set _gitdir $env(GIT_DIR)
1265 # beware that from the .git dir this sets _gitdir to .
1266 # and _prefix to the empty string
1267 set _gitdir [git rev-parse --git-dir]
1268 set _prefix [git rev-parse --show-prefix]
1272 choose_repository::pick
1276 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1277 # run from the .git dir itself) lest the routines to find the worktree
1279 if {$_gitdir eq ".
"} {
1283 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1284 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1286 if {![file isdirectory $_gitdir]} {
1287 catch {wm withdraw .}
1288 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1291 # _gitdir exists, so try loading the config
1295 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
1296 if {[package vcompare $_git_version 1.7.0] >= 0} {
1297 if { [is_Cygwin] } {
1298 catch {set _gitworktree [exec cygpath --windows [git rev-parse --show-toplevel]]}
1300 set _gitworktree [git rev-parse --show-toplevel]
1303 # try to set work tree from environment, core.worktree or use
1304 # cdup to obtain a relative path to the top of the worktree. If
1305 # run from the top, the ./ prefix ensures normalize expands pwd.
1306 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1307 set _gitworktree [get_config core.worktree]
1308 if {$_gitworktree eq ""} {
1309 set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1314 if {$_prefix ne {}} {
1315 if {$_gitworktree eq {}} {
1316 regsub -all {[^/]+/} $_prefix ../ cdup
1318 set cdup $_gitworktree
1320 if {[catch {cd $cdup} err]} {
1321 catch {wm withdraw .}
1322 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1325 set _gitworktree [pwd]
1327 } elseif {![is_enabled bare]} {
1329 catch {wm withdraw .}
1330 error_popup [strcat [mc "Cannot use bare repository
:"] "\n\n$_gitdir"]
1333 if {$_gitworktree eq {}} {
1334 set _gitworktree [file dirname $_gitdir]
1336 if {[catch {cd $_gitworktree} err]} {
1337 catch {wm withdraw .}
1338 error_popup [strcat [mc "No working directory
"] " $_gitworktree:\n\n$err"]
1341 set _gitworktree [pwd]
1343 set _reponame [file split [file normalize $_gitdir]]
1344 if {[lindex $_reponame end] eq {.git}} {
1345 set _reponame [lindex $_reponame end-1]
1347 set _reponame [lindex $_reponame end]
1350 set env(GIT_DIR) $_gitdir
1351 set env(GIT_WORK_TREE) $_gitworktree
1353 ######################################################################
1357 set current_diff_path {}
1358 set current_diff_side {}
1359 set diff_actions [list]
1363 set MERGE_HEAD [list]
1366 set current_branch {}
1368 set current_diff_path {}
1370 set is_submodule_diff 0
1371 set is_conflict_diff 0
1372 set selected_commit_type new
1373 set diff_empty_count 0
1375 set nullid "0000000000000000000000000000000000000000"
1376 set nullid2 "0000000000000000000000000000000000000001"
1378 ######################################################################
1386 set disable_on_lock [list]
1387 set index_lock_type none
1389 proc lock_index {type} {
1390 global index_lock_type disable_on_lock
1392 if {$index_lock_type eq {none}} {
1393 set index_lock_type $type
1394 foreach w $disable_on_lock {
1395 uplevel #0 $w disabled
1398 } elseif {$index_lock_type eq "begin-
$type"} {
1399 set index_lock_type $type
1405 proc unlock_index {} {
1406 global index_lock_type disable_on_lock
1408 set index_lock_type none
1409 foreach w $disable_on_lock {
1410 uplevel #0 $w normal
1414 ######################################################################
1418 proc repository_state {ctvar hdvar mhvar} {
1419 global current_branch
1420 upvar $ctvar ct $hdvar hd $mhvar mh
1425 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1431 set merge_head [gitdir MERGE_HEAD]
1432 if {[file exists $merge_head]} {
1434 set fd_mh [open $merge_head r]
1435 while {[gets $fd_mh line] >= 0} {
1446 global PARENT empty_tree
1448 set p [lindex $PARENT 0]
1452 if {$empty_tree eq {}} {
1453 set empty_tree [git mktree << {}]
1458 proc force_amend {} {
1459 global selected_commit_type
1460 global HEAD PARENT MERGE_HEAD commit_type
1462 repository_state newType newHEAD newMERGE_HEAD
1465 set MERGE_HEAD $newMERGE_HEAD
1466 set commit_type $newType
1468 set selected_commit_type amend
1469 do_select_commit_type
1472 proc rescan {after {honor_trustmtime 1}} {
1473 global HEAD PARENT MERGE_HEAD commit_type
1474 global ui_index ui_workdir ui_comm
1475 global rescan_active file_states
1478 if {$rescan_active > 0 || ![lock_index read]} return
1480 repository_state newType newHEAD newMERGE_HEAD
1481 if {[string match amend* $commit_type]
1482 && $newType eq {normal}
1483 && $newHEAD eq $HEAD} {
1487 set MERGE_HEAD $newMERGE_HEAD
1488 set commit_type $newType
1491 array unset file_states
1493 if {!$::GITGUI_BCK_exists &&
1494 (![$ui_comm edit modified]
1495 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1496 if {[string match amend* $commit_type]} {
1497 } elseif {[load_message GITGUI_MSG utf-8]} {
1498 } elseif {[run_prepare_commit_msg_hook]} {
1499 } elseif {[load_message MERGE_MSG]} {
1500 } elseif {[load_message SQUASH_MSG]} {
1503 $ui_comm edit modified false
1506 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1507 rescan_stage2 {} $after
1510 ui_status [mc "Refreshing
file status...
"]
1511 set fd_rf [git_read update-index \
1517 fconfigure $fd_rf -blocking 0 -translation binary
1518 fileevent $fd_rf readable \
1519 [list rescan_stage2 $fd_rf $after]
1524 set is_git_info_exclude {}
1525 proc have_info_exclude {} {
1526 global is_git_info_exclude
1528 if {$is_git_info_exclude eq {}} {
1529 if {[catch {exec test -f [gitdir info exclude]}]} {
1530 set is_git_info_exclude 0
1532 set is_git_info_exclude 1
1535 return $is_git_info_exclude
1538 proc have_info_exclude {} {
1539 return [file readable [gitdir info exclude]]
1543 proc rescan_stage2 {fd after} {
1544 global rescan_active buf_rdi buf_rdf buf_rlo
1548 if {![eof $fd]} return
1552 if {[package vcompare $::_git_version 1.6.3] >= 0} {
1553 set ls_others [list --exclude-standard]
1555 set ls_others [list --exclude-per-directory=.gitignore]
1556 if {[have_info_exclude]} {
1557 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1559 set user_exclude [get_config core.excludesfile]
1560 if {$user_exclude ne {} && [file readable $user_exclude]} {
1561 lappend ls_others "--exclude-from=[file normalize
$user_exclude]"
1570 ui_status [mc "Scanning
for modified files ...
"]
1571 if {[git-version >= "1.7.2"]} {
1572 set fd_di [git_read diff-index --cached --ignore-submodules=dirty -z [PARENT]]
1574 set fd_di [git_read diff-index --cached -z [PARENT]]
1576 set fd_df [git_read diff-files -z]
1578 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1579 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1581 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1582 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1584 if {[is_config_true gui.displayuntracked]} {
1585 set fd_lo [eval git_read ls-files --others -z $ls_others]
1586 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1587 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1592 proc load_message {file {encoding {}}} {
1595 set f [gitdir $file]
1596 if {[file isfile $f]} {
1597 if {[catch {set fd [open $f r]}]} {
1600 fconfigure $fd -eofchar {}
1601 if {$encoding ne {}} {
1602 fconfigure $fd -encoding $encoding
1604 set content [string trim [read $fd]]
1606 regsub -all -line {[ \r\t]+$} $content {} content
1607 $ui_comm delete 0.0 end
1608 $ui_comm insert end $content
1614 proc run_prepare_commit_msg_hook {} {
1617 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1618 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1619 # empty file but existent file.
1621 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1623 if {[file isfile [gitdir MERGE_MSG]]} {
1624 set pcm_source "merge
"
1625 set fd_mm [open [gitdir MERGE_MSG] r]
1626 fconfigure $fd_mm -encoding utf-8
1627 puts -nonewline $fd_pcm [read $fd_mm]
1629 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1630 set pcm_source "squash
"
1631 set fd_sm [open [gitdir SQUASH_MSG] r]
1632 fconfigure $fd_sm -encoding utf-8
1633 puts -nonewline $fd_pcm [read $fd_sm]
1641 set fd_ph [githook_read prepare-commit-msg \
1642 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1644 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1648 ui_status [mc "Calling prepare-commit-msg hook...
"]
1651 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1652 fileevent $fd_ph readable \
1653 [list prepare_commit_msg_hook_wait $fd_ph]
1658 proc prepare_commit_msg_hook_wait {fd_ph} {
1661 append pch_error [read $fd_ph]
1662 fconfigure $fd_ph -blocking 1
1664 if {[catch {close $fd_ph}]} {
1665 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1666 hook_failed_popup prepare-commit-msg $pch_error
1667 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1670 load_message PREPARE_COMMIT_MSG
1673 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1676 fconfigure $fd_ph -blocking 0
1677 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1680 proc read_diff_index {fd after} {
1683 append buf_rdi [read $fd]
1685 set n [string length $buf_rdi]
1687 set z1 [string first "\
0" $buf_rdi $c]
1688 if {$z1 == -1} break
1690 set z2 [string first "\
0" $buf_rdi $z1]
1691 if {$z2 == -1} break
1694 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1695 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1697 [encoding convertfrom utf-8 $p] \
1699 [list [lindex $i 0] [lindex $i 2]] \
1705 set buf_rdi [string range $buf_rdi $c end]
1710 rescan_done $fd buf_rdi $after
1713 proc read_diff_files {fd after} {
1716 append buf_rdf [read $fd]
1718 set n [string length $buf_rdf]
1720 set z1 [string first "\
0" $buf_rdf $c]
1721 if {$z1 == -1} break
1723 set z2 [string first "\
0" $buf_rdf $z1]
1724 if {$z2 == -1} break
1727 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1728 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1730 [encoding convertfrom utf-8 $p] \
1733 [list [lindex $i 0] [lindex $i 2]]
1738 set buf_rdf [string range $buf_rdf $c end]
1743 rescan_done $fd buf_rdf $after
1746 proc read_ls_others {fd after} {
1749 append buf_rlo [read $fd]
1750 set pck [split $buf_rlo "\
0"]
1751 set buf_rlo [lindex $pck end]
1752 foreach p [lrange $pck 0 end-1] {
1753 set p [encoding convertfrom utf-8 $p]
1754 if {[string index $p end] eq {/}} {
1755 set p [string range $p 0 end-1]
1759 rescan_done $fd buf_rlo $after
1762 proc rescan_done {fd buf after} {
1763 global rescan_active current_diff_path
1764 global file_states repo_config
1767 if {![eof $fd]} return
1770 if {[incr rescan_active -1] > 0} return
1775 if {$current_diff_path ne {}} { reshow_diff $after }
1776 if {$current_diff_path eq {}} { select_first_diff $after }
1779 proc prune_selection {} {
1780 global file_states selected_paths
1782 foreach path [array names selected_paths] {
1783 if {[catch {set still_here $file_states($path)}]} {
1784 unset selected_paths($path)
1789 ######################################################################
1793 proc mapicon {w state path} {
1796 if {[catch {set r $all_icons($state$w)}]} {
1797 puts "error
: no icon
for $w state
={$state} $path"
1803 proc mapdesc {state path} {
1806 if {[catch {set r $all_descs($state)}]} {
1807 puts "error
: no desc
for state
={$state} $path"
1813 proc ui_status {msg} {
1815 if {[info exists main_status]} {
1816 $main_status show $msg
1820 proc ui_ready {{test {}}} {
1822 if {[info exists main_status]} {
1823 $main_status show [mc "Ready.
"] $test
1827 proc escape_path {path} {
1828 regsub -all {\\} $path "\\\\" path
1829 regsub -all "\n" $path "\\n
" path
1833 proc short_path {path} {
1834 return [escape_path [lindex [file split $path] end]]
1838 set null_sha1 [string repeat 0 40]
1840 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1841 global file_states next_icon_id null_sha1
1843 set s0 [string index $new_state 0]
1844 set s1 [string index $new_state 1]
1846 if {[catch {set info $file_states($path)}]} {
1848 set icon n[incr next_icon_id]
1850 set state [lindex $info 0]
1851 set icon [lindex $info 1]
1852 if {$head_info eq {}} {set head_info [lindex $info 2]}
1853 if {$index_info eq {}} {set index_info [lindex $info 3]}
1856 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1857 elseif {$s0 eq {_}} {set s0 _}
1859 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1860 elseif {$s1 eq {_}} {set s1 _}
1862 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1863 set head_info [list 0 $null_sha1]
1864 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1865 && $head_info eq {}} {
1866 set head_info $index_info
1867 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1868 set index_info $head_info
1872 set file_states($path) [list $s0$s1 $icon \
1873 $head_info $index_info \
1878 proc display_file_helper {w path icon_name old_m new_m} {
1881 if {$new_m eq {_}} {
1882 set lno [lsearch -sorted -exact $file_lists($w) $path]
1884 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1886 $w conf -state normal
1887 $w delete $lno.0 [expr {$lno + 1}].0
1888 $w conf -state disabled
1890 } elseif {$old_m eq {_} && $new_m ne {_}} {
1891 lappend file_lists($w) $path
1892 set file_lists($w) [lsort -unique $file_lists($w)]
1893 set lno [lsearch -sorted -exact $file_lists($w) $path]
1895 $w conf -state normal
1896 $w image create $lno.0 \
1897 -align center -padx 5 -pady 1 \
1899 -image [mapicon $w $new_m $path]
1900 $w insert $lno.1 "[escape_path
$path]\n"
1901 $w conf -state disabled
1902 } elseif {$old_m ne $new_m} {
1903 $w conf -state normal
1904 $w image conf $icon_name -image [mapicon $w $new_m $path]
1905 $w conf -state disabled
1909 proc display_file {path state} {
1910 global file_states selected_paths
1911 global ui_index ui_workdir
1913 set old_m [merge_state $path $state]
1914 set s $file_states($path)
1915 set new_m [lindex $s 0]
1916 set icon_name [lindex $s 1]
1918 set o [string index $old_m 0]
1919 set n [string index $new_m 0]
1926 display_file_helper $ui_index $path $icon_name $o $n
1928 if {[string index $old_m 0] eq {U}} {
1931 set o [string index $old_m 1]
1933 if {[string index $new_m 0] eq {U}} {
1936 set n [string index $new_m 1]
1938 display_file_helper $ui_workdir $path $icon_name $o $n
1940 if {$new_m eq {__}} {
1941 unset file_states($path)
1942 catch {unset selected_paths($path)}
1946 proc display_all_files_helper {w path icon_name m} {
1949 lappend file_lists($w) $path
1950 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1951 $w image create end \
1952 -align center -padx 5 -pady 1 \
1954 -image [mapicon $w $m $path]
1955 $w insert end "[escape_path
$path]\n"
1959 proc display_all_files {} {
1960 global ui_index ui_workdir
1961 global file_states file_lists
1963 global files_warning
1965 $ui_index conf -state normal
1966 $ui_workdir conf -state normal
1968 $ui_index delete 0.0 end
1969 $ui_workdir delete 0.0 end
1972 set file_lists($ui_index) [list]
1973 set file_lists($ui_workdir) [list]
1975 set to_display [lsort [array names file_states]]
1976 set display_limit [get_config gui.maxfilesdisplayed]
1978 foreach path $to_display {
1979 set s $file_states($path)
1981 set icon_name [lindex $s 1]
1983 if {$displayed > $display_limit && [string index $m 1] eq {O} } {
1984 if {!$files_warning} {
1985 # do not repeatedly warn:
1987 info_popup [mc "Display limit
(gui.maxfilesdisplayed
= %s
) reached
, not showing all
%s files.
" \
1988 $display_limit [llength $to_display]]
1993 set s [string index $m 0]
1994 if {$s ne {U} && $s ne {_}} {
1995 display_all_files_helper $ui_index $path \
1999 if {[string index $m 0] eq {U}} {
2002 set s [string index $m 1]
2005 display_all_files_helper $ui_workdir $path \
2011 $ui_index conf -state disabled
2012 $ui_workdir conf -state disabled
2015 ######################################################################
2020 #define mask_width 14
2021 #define mask_height 15
2022 static unsigned char mask_bits[] = {
2023 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2024 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2025 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2028 image create bitmap file_plain -background white -foreground black -data {
2029 #define plain_width 14
2030 #define plain_height 15
2031 static unsigned char plain_bits[] = {
2032 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2033 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2034 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2035 } -maskdata $filemask
2037 image create bitmap file_mod -background white -foreground blue -data {
2038 #define mod_width 14
2039 #define mod_height 15
2040 static unsigned char mod_bits[] = {
2041 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2042 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2043 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2044 } -maskdata $filemask
2046 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2047 #define file_fulltick_width 14
2048 #define file_fulltick_height 15
2049 static unsigned char file_fulltick_bits
[] = {
2050 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2051 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2052 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2053 } -maskdata $filemask
2055 image create bitmap file_question
-background white
-foreground black
-data {
2056 #define file_question_width 14
2057 #define file_question_height 15
2058 static unsigned char file_question_bits
[] = {
2059 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2060 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2061 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2062 } -maskdata $filemask
2064 image create bitmap file_removed
-background white
-foreground red
-data {
2065 #define file_removed_width 14
2066 #define file_removed_height 15
2067 static unsigned char file_removed_bits
[] = {
2068 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2069 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2070 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2071 } -maskdata $filemask
2073 image create bitmap file_merge
-background white
-foreground blue
-data {
2074 #define file_merge_width 14
2075 #define file_merge_height 15
2076 static unsigned char file_merge_bits
[] = {
2077 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2078 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2079 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2080 } -maskdata $filemask
2082 image create bitmap file_statechange
-background white
-foreground green
-data {
2083 #define file_statechange_width 14
2084 #define file_statechange_height 15
2085 static unsigned char file_statechange_bits
[] = {
2086 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2087 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2088 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2089 } -maskdata $filemask
2091 set ui_index .vpane.files.index.list
2092 set ui_workdir .vpane.files.workdir.list
2094 set all_icons
(_
$ui_index) file_plain
2095 set all_icons
(A
$ui_index) file_plain
2096 set all_icons
(M
$ui_index) file_fulltick
2097 set all_icons
(D
$ui_index) file_removed
2098 set all_icons
(U
$ui_index) file_merge
2099 set all_icons
(T
$ui_index) file_statechange
2101 set all_icons
(_
$ui_workdir) file_plain
2102 set all_icons
(M
$ui_workdir) file_mod
2103 set all_icons
(D
$ui_workdir) file_question
2104 set all_icons
(U
$ui_workdir) file_merge
2105 set all_icons
(O
$ui_workdir) file_plain
2106 set all_icons
(T
$ui_workdir) file_statechange
2108 set max_status_desc
0
2110 {__
{mc
"Unmodified"}}
2112 {_M
{mc
"Modified, not staged"}}
2113 {M_
{mc
"Staged for commit"}}
2114 {MM
{mc
"Portions staged for commit"}}
2115 {MD
{mc
"Staged for commit, missing"}}
2117 {_T
{mc
"File type changed, not staged"}}
2118 {MT
{mc
"File type changed, old type staged for commit"}}
2119 {AT
{mc
"File type changed, old type staged for commit"}}
2120 {T_
{mc
"File type changed, staged"}}
2121 {TM
{mc
"File type change staged, modification not staged"}}
2122 {TD
{mc
"File type change staged, file missing"}}
2124 {_O
{mc
"Untracked, not staged"}}
2125 {A_
{mc
"Staged for commit"}}
2126 {AM
{mc
"Portions staged for commit"}}
2127 {AD
{mc
"Staged for commit, missing"}}
2130 {D_
{mc
"Staged for removal"}}
2131 {DO
{mc
"Staged for removal, still present"}}
2133 {_U
{mc
"Requires merge resolution"}}
2134 {U_
{mc
"Requires merge resolution"}}
2135 {UU
{mc
"Requires merge resolution"}}
2136 {UM
{mc
"Requires merge resolution"}}
2137 {UD
{mc
"Requires merge resolution"}}
2138 {UT
{mc
"Requires merge resolution"}}
2140 set text
[eval [lindex
$i 1]]
2141 if {$max_status_desc < [string length
$text]} {
2142 set max_status_desc
[string length
$text]
2144 set all_descs
([lindex
$i 0]) $text
2148 ######################################################################
2152 proc scrollbar2many
{list mode args
} {
2153 foreach w
$list {eval $w $mode $args}
2156 proc many2scrollbar
{list mode sb top bottom
} {
2157 $sb set $top $bottom
2158 foreach w
$list {$w $mode moveto
$top}
2161 proc incr_font_size
{font
{amt
1}} {
2162 set sz
[font configure
$font -size]
2164 font configure
$font -size $sz
2165 font configure
${font}bold
-size $sz
2166 font configure
${font}italic
-size $sz
2169 ######################################################################
2173 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
2175 proc do_gitk
{revs
{is_submodule false
}} {
2176 global current_diff_path file_states current_diff_side ui_index
2177 global _gitdir _gitworktree
2179 # -- Always start gitk through whatever we were loaded with. This
2180 # lets us bypass using shell process on Windows systems.
2182 set exe
[_which gitk
-script]
2183 set cmd
[list
[info nameofexecutable
] $exe]
2185 error_popup
[mc
"Couldn't find gitk in PATH"]
2191 if {!$is_submodule} {
2196 cd $current_diff_path
2197 if {$revs eq
{--}} {
2198 set s
$file_states($current_diff_path)
2201 switch
-glob -- [lindex
$s 0] {
2202 M_
{ set old_sha1
[lindex
[lindex
$s 2] 1] }
2203 _M
{ set old_sha1
[lindex
[lindex
$s 3] 1] }
2205 if {$current_diff_side eq
$ui_index} {
2206 set old_sha1
[lindex
[lindex
$s 2] 1]
2207 set new_sha1
[lindex
[lindex
$s 3] 1]
2209 set old_sha1
[lindex
[lindex
$s 3] 1]
2213 set revs
$old_sha1...
$new_sha1
2215 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2216 # we've been using for the main repository, so unset them.
2217 # TODO we could make life easier (start up faster?) for gitk
2218 # by setting these to the appropriate values to allow gitk
2219 # to skip the heuristics to find their proper value
2221 unset env
(GIT_WORK_TREE
)
2223 eval exec $cmd $revs "--" "--" &
2225 set env
(GIT_DIR
) $_gitdir
2226 set env
(GIT_WORK_TREE
) $_gitworktree
2229 ui_status $
::starting_gitk_msg
2231 ui_ready
$starting_gitk_msg
2236 proc do_git_gui
{} {
2237 global current_diff_path
2239 # -- Always start git gui through whatever we were loaded with. This
2240 # lets us bypass using shell process on Windows systems.
2242 set exe
[list
[_which git
]]
2244 error_popup
[mc
"Couldn't find git gui in PATH"]
2247 global _gitdir _gitworktree
2249 # see note in do_gitk about unsetting these vars when
2250 # running tools in a submodule
2252 unset env
(GIT_WORK_TREE
)
2255 cd $current_diff_path
2257 eval exec $exe gui
&
2259 set env
(GIT_DIR
) $_gitdir
2260 set env
(GIT_WORK_TREE
) $_gitworktree
2263 ui_status $
::starting_gitk_msg
2265 ui_ready
$starting_gitk_msg
2270 proc do_explore
{} {
2273 if {[is_Cygwin
] ||
[is_Windows
]} {
2274 set explorer
"explorer.exe"
2275 } elseif
{[is_MacOSX
]} {
2278 # freedesktop.org-conforming system is our best shot
2279 set explorer
"xdg-open"
2281 eval exec $explorer [list
[file nativename
$_gitworktree]] &
2287 proc terminate_me
{win
} {
2289 if {$win ne
{.
}} return
2293 proc do_quit
{{rc
{1}}} {
2294 global ui_comm is_quitting repo_config commit_type
2295 global GITGUI_BCK_exists GITGUI_BCK_i
2296 global ui_comm_spell
2297 global ret_code use_ttk
2299 if {$is_quitting} return
2302 if {[winfo exists
$ui_comm]} {
2303 # -- Stash our current commit buffer.
2305 set save
[gitdir GITGUI_MSG
]
2306 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
2307 file rename
-force [gitdir GITGUI_BCK
] $save
2308 set GITGUI_BCK_exists
0
2310 set msg
[string trim
[$ui_comm get
0.0 end
]]
2311 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2312 if {(![string match amend
* $commit_type]
2313 ||
[$ui_comm edit modified
])
2316 set fd
[open
$save w
]
2317 fconfigure
$fd -encoding utf-8
2318 puts
-nonewline $fd $msg
2322 catch
{file delete
$save}
2326 # -- Cancel our spellchecker if its running.
2328 if {[info exists ui_comm_spell
]} {
2332 # -- Remove our editor backup, its not needed.
2334 after cancel
$GITGUI_BCK_i
2335 if {$GITGUI_BCK_exists} {
2336 catch
{file delete
[gitdir GITGUI_BCK
]}
2339 # -- Stash our current window geometry into this repository.
2341 set cfg_wmstate
[wm state .
]
2342 if {[catch
{set rc_wmstate
$repo_config(gui.wmstate
)}]} {
2345 if {$cfg_wmstate ne
$rc_wmstate} {
2346 catch
{git config gui.wmstate
$cfg_wmstate}
2348 if {$cfg_wmstate eq
{zoomed
}} {
2349 # on Windows wm geometry will lie about window
2350 # position (but not size) when window is zoomed
2351 # restore the window before querying wm geometry
2354 set cfg_geometry
[list
]
2355 lappend cfg_geometry
[wm geometry .
]
2357 lappend cfg_geometry
[.vpane sashpos
0]
2358 lappend cfg_geometry
[.vpane.files sashpos
0]
2360 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
2361 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
2363 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2366 if {$cfg_geometry ne
$rc_geometry} {
2367 catch
{git config gui.geometry
$cfg_geometry}
2373 # Briefly enable send again, working around Tk bug
2374 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2375 tk appname
[appname
]
2384 proc ui_do_rescan
{} {
2385 rescan
{force_first_diff ui_ready
}
2392 proc next_diff
{{after
{}}} {
2393 global next_diff_p next_diff_w next_diff_i
2394 show_diff
$next_diff_p $next_diff_w {} {} $after
2397 proc find_anchor_pos
{lst name
} {
2398 set lid
[lsearch
-sorted -exact $lst $name]
2402 foreach lname
$lst {
2403 if {$lname >= $name} break
2411 proc find_file_from
{flist idx delta path mmask
} {
2414 set len
[llength
$flist]
2415 while {$idx >= 0 && $idx < $len} {
2416 set name
[lindex
$flist $idx]
2418 if {$name ne
$path && [info exists file_states
($name)]} {
2419 set state
[lindex
$file_states($name) 0]
2421 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2432 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2433 global next_diff_p next_diff_w next_diff_i
2434 global file_lists ui_index ui_workdir
2436 set flist
$file_lists($w)
2438 set lno
[find_anchor_pos
$flist $path]
2443 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2444 if {$w eq
$ui_index} {
2447 set mmask
"$mmask\$"
2451 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2454 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2459 set next_diff_p
[lindex
$flist $idx]
2460 set next_diff_i
[expr {$idx+1}]
2467 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2468 global current_diff_path
2470 if {$path ne
$current_diff_path} {
2472 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2475 return {reshow_diff
;}
2479 proc select_first_diff
{after
} {
2482 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2483 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2490 proc force_first_diff
{after
} {
2491 global ui_workdir current_diff_path file_states
2493 if {[info exists file_states
($current_diff_path)]} {
2494 set state
[lindex
$file_states($current_diff_path) 0]
2500 if {[string first
{U
} $state] >= 0} {
2501 # Already a conflict, do nothing
2502 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {^_?U
}]} {
2504 } elseif
{[string index
$state 1] ne
{O
}} {
2505 # Already a diff & no conflicts, do nothing
2506 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {[^O
]$
}]} {
2517 proc toggle_or_diff
{mode w args
} {
2518 global file_states file_lists current_diff_path ui_index ui_workdir
2519 global last_clicked selected_paths
2521 if {$mode eq
"click"} {
2522 foreach
{x y
} $args break
2523 set pos
[split [$w index @
$x,$y] .
]
2524 foreach
{lno
col} $pos break
2526 if {$last_clicked ne
{}} {
2527 set lno
[lindex
$last_clicked 1]
2529 set lno
[expr {int
([lindex
[$w tag ranges in_diff
] 0])}]
2531 if {$mode eq
"toggle"} {
2534 incr lno
[expr {$mode eq
"up" ?
-1 : 1}]
2539 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2545 set last_clicked
[list
$w $lno]
2547 array
unset selected_paths
2548 $ui_index tag remove in_sel
0.0 end
2549 $ui_workdir tag remove in_sel
0.0 end
2551 # Determine the state of the file
2552 if {[info exists file_states
($path)]} {
2553 set state
[lindex
$file_states($path) 0]
2558 # Restage the file, or simply show the diff
2559 if {$col == 0 && $y > 1} {
2560 # Conflicts need special handling
2561 if {[string first
{U
} $state] >= 0} {
2562 # $w must always be $ui_workdir, but...
2563 if {$w ne
$ui_workdir} { set lno
{} }
2564 merge_stage_workdir
$path $lno
2568 if {[string index
$state 1] eq
{O
}} {
2574 set after
[next_diff_after_action
$w $path $lno $mmask]
2576 if {$w eq
$ui_index} {
2578 "Unstaging [short_path $path] from commit" \
2580 [concat
$after [list ui_ready
]]
2581 } elseif
{$w eq
$ui_workdir} {
2583 "Adding [short_path $path]" \
2585 [concat
$after [list ui_ready
]]
2588 set selected_paths
($path) 1
2589 show_diff
$path $w $lno
2593 proc add_one_to_selection
{w x y
} {
2594 global file_lists last_clicked selected_paths
2596 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2597 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2603 if {$last_clicked ne
{}
2604 && [lindex
$last_clicked 0] ne
$w} {
2605 array
unset selected_paths
2606 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2609 set last_clicked
[list
$w $lno]
2610 if {[catch
{set in_sel
$selected_paths($path)}]} {
2614 unset selected_paths
($path)
2615 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2617 set selected_paths
($path) 1
2618 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2622 proc add_range_to_selection
{w x y
} {
2623 global file_lists last_clicked selected_paths
2625 if {[lindex
$last_clicked 0] ne
$w} {
2626 toggle_or_diff click
$w $x $y
2630 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2631 set lc
[lindex
$last_clicked 1]
2640 foreach path
[lrange
$file_lists($w) \
2641 [expr {$begin - 1}] \
2642 [expr {$end - 1}]] {
2643 set selected_paths
($path) 1
2645 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2648 proc show_more_context
{} {
2650 if {$repo_config(gui.diffcontext
) < 99} {
2651 incr repo_config
(gui.diffcontext
)
2656 proc show_less_context
{} {
2658 if {$repo_config(gui.diffcontext
) > 1} {
2659 incr repo_config
(gui.diffcontext
) -1
2664 ######################################################################
2672 menu .mbar
-tearoff 0
2674 # -- Apple Menu (Mac OS X only)
2676 .mbar add cascade
-label Apple
-menu .mbar.apple
2679 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2680 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2681 if {[is_enabled branch
]} {
2682 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2684 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2685 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2687 if {[is_enabled transport
]} {
2688 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2689 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2691 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2692 .mbar add cascade
-label [mc Tools
] -menu .mbar.tools
2695 # -- Repository Menu
2697 menu .mbar.repository
2700 .mbar.repository add
command \
2701 -label [mc
"Explore Working Copy"] \
2702 -command {do_explore
}
2706 .mbar.repository add
command \
2707 -label [mc
"Git Bash"] \
2708 -command {eval exec [auto_execok start
] \
2709 [list
"Git Bash" bash
--login -l &]}
2712 if {[is_Windows
] ||
![is_bare
]} {
2713 .mbar.repository add separator
2716 .mbar.repository add
command \
2717 -label [mc
"Browse Current Branch's Files"] \
2718 -command {browser
::new
$current_branch}
2719 set ui_browse_current
[.mbar.repository index last
]
2720 .mbar.repository add
command \
2721 -label [mc
"Browse Branch Files..."] \
2722 -command browser_open
::dialog
2723 .mbar.repository add separator
2725 .mbar.repository add
command \
2726 -label [mc
"Visualize Current Branch's History"] \
2727 -command {do_gitk
$current_branch}
2728 set ui_visualize_current
[.mbar.repository index last
]
2729 .mbar.repository add
command \
2730 -label [mc
"Visualize All Branch History"] \
2731 -command {do_gitk
--all}
2732 .mbar.repository add separator
2734 proc current_branch_write
{args
} {
2735 global current_branch
2736 .mbar.repository entryconf $
::ui_browse_current \
2737 -label [mc
"Browse %s's Files" $current_branch]
2738 .mbar.repository entryconf $
::ui_visualize_current \
2739 -label [mc
"Visualize %s's History" $current_branch]
2741 trace add variable current_branch
write current_branch_write
2743 if {[is_enabled multicommit
]} {
2744 .mbar.repository add
command -label [mc
"Database Statistics"] \
2747 .mbar.repository add
command -label [mc
"Compress Database"] \
2750 .mbar.repository add
command -label [mc
"Verify Database"] \
2751 -command do_fsck_objects
2753 .mbar.repository add separator
2756 .mbar.repository add
command \
2757 -label [mc
"Create Desktop Icon"] \
2758 -command do_cygwin_shortcut
2759 } elseif
{[is_Windows
]} {
2760 .mbar.repository add
command \
2761 -label [mc
"Create Desktop Icon"] \
2762 -command do_windows_shortcut
2763 } elseif
{[is_MacOSX
]} {
2764 .mbar.repository add
command \
2765 -label [mc
"Create Desktop Icon"] \
2766 -command do_macosx_app
2771 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2773 .mbar.repository add
command -label [mc Quit
] \
2781 .mbar.edit add
command -label [mc Undo
] \
2782 -command {catch
{[focus
] edit undo
}} \
2784 .mbar.edit add
command -label [mc Redo
] \
2785 -command {catch
{[focus
] edit redo
}} \
2787 .mbar.edit add separator
2788 .mbar.edit add
command -label [mc Cut
] \
2789 -command {catch
{tk_textCut
[focus
]}} \
2791 .mbar.edit add
command -label [mc Copy
] \
2792 -command {catch
{tk_textCopy
[focus
]}} \
2794 .mbar.edit add
command -label [mc Paste
] \
2795 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2797 .mbar.edit add
command -label [mc Delete
] \
2798 -command {catch
{[focus
] delete sel.first sel.last
}} \
2800 .mbar.edit add separator
2801 .mbar.edit add
command -label [mc
"Select All"] \
2802 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2807 if {[is_enabled branch
]} {
2810 .mbar.branch add
command -label [mc
"Create..."] \
2811 -command branch_create
::dialog \
2813 lappend disable_on_lock
[list .mbar.branch entryconf \
2814 [.mbar.branch index last
] -state]
2816 .mbar.branch add
command -label [mc
"Checkout..."] \
2817 -command branch_checkout
::dialog \
2819 lappend disable_on_lock
[list .mbar.branch entryconf \
2820 [.mbar.branch index last
] -state]
2822 .mbar.branch add
command -label [mc
"Rename..."] \
2823 -command branch_rename
::dialog
2824 lappend disable_on_lock
[list .mbar.branch entryconf \
2825 [.mbar.branch index last
] -state]
2827 .mbar.branch add
command -label [mc
"Delete..."] \
2828 -command branch_delete
::dialog
2829 lappend disable_on_lock
[list .mbar.branch entryconf \
2830 [.mbar.branch index last
] -state]
2832 .mbar.branch add
command -label [mc
"Reset..."] \
2833 -command merge
::reset_hard
2834 lappend disable_on_lock
[list .mbar.branch entryconf \
2835 [.mbar.branch index last
] -state]
2840 proc commit_btn_caption
{} {
2841 if {[is_enabled nocommit
]} {
2844 return [mc Commit@@verb
]
2848 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2851 if {![is_enabled nocommit
]} {
2852 .mbar.commit add radiobutton \
2853 -label [mc
"New Commit"] \
2854 -command do_select_commit_type \
2855 -variable selected_commit_type \
2857 lappend disable_on_lock \
2858 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2860 .mbar.commit add radiobutton \
2861 -label [mc
"Amend Last Commit"] \
2862 -command do_select_commit_type \
2863 -variable selected_commit_type \
2865 lappend disable_on_lock \
2866 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2868 .mbar.commit add separator
2871 .mbar.commit add
command -label [mc Rescan
] \
2872 -command ui_do_rescan \
2874 lappend disable_on_lock \
2875 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2877 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2878 -command do_add_selection \
2880 lappend disable_on_lock \
2881 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2883 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2884 -command do_add_all \
2886 lappend disable_on_lock \
2887 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2889 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2890 -command do_unstage_selection \
2892 lappend disable_on_lock \
2893 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2895 .mbar.commit add
command -label [mc
"Revert Changes"] \
2896 -command do_revert_selection \
2898 lappend disable_on_lock \
2899 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2901 .mbar.commit add separator
2903 .mbar.commit add
command -label [mc
"Show Less Context"] \
2904 -command show_less_context \
2905 -accelerator $M1T-\
-
2907 .mbar.commit add
command -label [mc
"Show More Context"] \
2908 -command show_more_context \
2911 .mbar.commit add separator
2913 if {![is_enabled nocommitmsg
]} {
2914 .mbar.commit add
command -label [mc
"Sign Off"] \
2915 -command do_signoff \
2919 .mbar.commit add
command -label [commit_btn_caption
] \
2920 -command do_commit \
2921 -accelerator $M1T-Return
2922 lappend disable_on_lock \
2923 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2928 if {[is_enabled branch
]} {
2930 .mbar.merge add
command -label [mc
"Local Merge..."] \
2931 -command merge
::dialog \
2933 lappend disable_on_lock \
2934 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2935 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2936 -command merge
::reset_hard
2937 lappend disable_on_lock \
2938 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2943 if {[is_enabled transport
]} {
2946 .mbar.remote add
command \
2947 -label [mc
"Add..."] \
2948 -command remote_add
::dialog \
2950 .mbar.remote add
command \
2951 -label [mc
"Push..."] \
2952 -command do_push_anywhere \
2954 .mbar.remote add
command \
2955 -label [mc
"Delete Branch..."] \
2956 -command remote_branch_delete
::dialog
2960 proc
::tk
::mac
::ShowPreferences
{} {do_options
}
2964 .mbar.edit add separator
2965 .mbar.edit add
command -label [mc
"Options..."] \
2971 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2972 set tools_menubar .mbar.tools
2974 $tools_menubar add separator
2975 $tools_menubar add
command -label [mc
"Add..."] -command tools_add
::dialog
2976 $tools_menubar add
command -label [mc
"Remove..."] -command tools_remove
::dialog
2978 if {[array names repo_config guitool.
*.cmd
] ne
{}} {
2985 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2989 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2991 .mbar.apple add separator
2993 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2996 . configure
-menu .mbar
2998 set doc_path
[githtmldir
]
2999 if {$doc_path ne
{}} {
3000 set doc_path
[file join $doc_path index.html
]
3003 set doc_path
[exec cygpath
--mixed $doc_path]
3007 if {[file isfile
$doc_path]} {
3008 set doc_url
"file:$doc_path"
3010 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
3013 proc start_browser
{url
} {
3014 git
"web--browse" $url
3017 .mbar.
help add
command -label [mc
"Online Documentation"] \
3018 -command [list start_browser
$doc_url]
3020 .mbar.
help add
command -label [mc
"Show SSH Key"] \
3023 unset doc_path doc_url
3025 # -- Standard bindings
3027 wm protocol . WM_DELETE_WINDOW do_quit
3028 bind all
<$M1B-Key-q> do_quit
3029 bind all
<$M1B-Key-Q> do_quit
3030 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
3031 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
3033 set subcommand_args
{}
3035 set s
"[mc usage:] $::argv0 $::subcommand $::subcommand_args"
3036 if {[tk windowingsystem
] eq
"win32"} {
3038 tk_messageBox
-icon info
-message $s \
3046 proc normalize_relpath
{path
} {
3048 foreach item
[file split $path] {
3049 if {$item eq
{.
}} continue
3050 if {$item eq
{..
} && [llength
$elements] > 0
3051 && [lindex
$elements end
] ne
{..
}} {
3052 set elements
[lrange
$elements 0 end-1
]
3055 lappend elements
$item
3057 return [eval file join $elements]
3060 # -- Not a normal commit type invocation? Do that instead!
3062 switch
-- $subcommand {
3065 if {$subcommand eq
"blame"} {
3066 set subcommand_args
{[--line=<num
>] rev? path
}
3068 set subcommand_args
{rev? path
}
3070 if {$argv eq
{}} usage
3076 set p
[file join $_prefix $a]
3078 if {$is_path ||
[file exists
$p]} {
3079 if {$path ne
{}} usage
3080 set path
[normalize_relpath
$p]
3082 } elseif
{$a eq
{--}} {
3084 if {$head ne
{}} usage
3089 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
3090 if {$jump_spec ne
{} ||
$head ne
{}} usage
3091 set jump_spec
[list
$lnum]
3092 } elseif
{$head eq
{}} {
3093 if {$head ne
{}} usage
3102 if {$head ne
{} && $path eq
{}} {
3103 if {[string index
$head 0] eq
{/}} {
3104 set path
[normalize_relpath
$head]
3107 set path
[normalize_relpath
$_prefix$head]
3115 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
3117 set head [git rev-parse
--verify $head]
3119 if {[tk windowingsystem
] eq
"win32"} {
3120 tk_messageBox
-icon error
-title [mc Error
] -message $err
3127 set current_branch
$head
3131 switch
-- $subcommand {
3133 if {$jump_spec ne
{}} usage
3135 if {$path ne
{} && [file isdirectory
$path]} {
3136 set head $current_branch
3142 browser
::new
$head $path
3145 if {$head eq
{} && ![file exists
$path]} {
3146 catch
{wm withdraw .
}
3150 -title [mc
"git-gui: fatal error"] \
3151 -message [mc
"fatal: cannot stat path %s: No such file or directory" $path]
3154 blame
::new
$head $path $jump_spec
3161 if {[llength
$argv] != 0} {
3164 # fall through to setup UI for commits
3167 set err
"[mc usage:] $argv0 \[{blame|browser|citool}\]"
3168 if {[tk windowingsystem
] eq
"win32"} {
3170 tk_messageBox
-icon error
-message $err \
3181 ${NS}::frame .branch
3182 if {!$use_ttk} {.branch configure
-borderwidth 1 -relief sunken
}
3183 ${NS}::label .branch.l1 \
3184 -text [mc
"Current Branch:"] \
3187 ${NS}::label .branch.cb \
3188 -textvariable current_branch \
3191 pack .branch.l1
-side left
3192 pack .branch.cb
-side left
-fill x
3193 pack .branch
-side top
-fill x
3195 # -- Main Window Layout
3197 ${NS}::panedwindow .vpane
-orient horizontal
3198 ${NS}::panedwindow .vpane.files
-orient vertical
3200 .vpane add .vpane.files
3202 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
3204 pack .vpane
-anchor n
-side top
-fill both
-expand 1
3206 # -- Working Directory File List
3208 textframe .vpane.files.workdir
-height 100 -width 200
3209 tlabel .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
3210 -background lightsalmon
-foreground black
3211 ttext
$ui_workdir -background white
-foreground black \
3213 -width 20 -height 10 \
3215 -takefocus 1 -highlightthickness 1\
3216 -cursor $cursor_ptr \
3217 -xscrollcommand {.vpane.files.workdir.sx
set} \
3218 -yscrollcommand {.vpane.files.workdir.sy
set} \
3220 ${NS}::scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
3221 ${NS}::scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
3222 pack .vpane.files.workdir.title
-side top
-fill x
3223 pack .vpane.files.workdir.sx
-side bottom
-fill x
3224 pack .vpane.files.workdir.sy
-side right
-fill y
3225 pack
$ui_workdir -side left
-fill both
-expand 1
3227 # -- Index File List
3229 textframe .vpane.files.index
-height 100 -width 200
3230 tlabel .vpane.files.index.title \
3231 -text [mc
"Staged Changes (Will Commit)"] \
3232 -background lightgreen
-foreground black
3233 ttext
$ui_index -background white
-foreground black \
3235 -width 20 -height 10 \
3237 -takefocus 1 -highlightthickness 1\
3238 -cursor $cursor_ptr \
3239 -xscrollcommand {.vpane.files.index.sx
set} \
3240 -yscrollcommand {.vpane.files.index.sy
set} \
3242 ${NS}::scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
3243 ${NS}::scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
3244 pack .vpane.files.index.title
-side top
-fill x
3245 pack .vpane.files.index.sx
-side bottom
-fill x
3246 pack .vpane.files.index.sy
-side right
-fill y
3247 pack
$ui_index -side left
-fill both
-expand 1
3249 # -- Insert the workdir and index into the panes
3251 .vpane.files add .vpane.files.workdir
3252 .vpane.files add .vpane.files.index
3254 .vpane.files paneconfigure .vpane.files.workdir
-sticky news
3255 .vpane.files paneconfigure .vpane.files.index
-sticky news
3258 foreach i
[list
$ui_index $ui_workdir] {
3260 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
3264 # -- Diff and Commit Area
3267 ${NS}::panedwindow .vpane.lower
-orient vertical
3268 ${NS}::frame .vpane.lower.commarea
3269 ${NS}::frame .vpane.lower.
diff -relief sunken
-borderwidth 1 -height 500
3270 .vpane.lower add .vpane.lower.
diff
3271 .vpane.lower add .vpane.lower.commarea
3272 .vpane add .vpane.lower
3274 .vpane.lower pane .vpane.lower.
diff -weight 1
3275 .vpane.lower pane .vpane.lower.commarea
-weight 0
3277 .vpane.lower paneconfigure .vpane.lower.
diff -stretch always
3278 .vpane.lower paneconfigure .vpane.lower.commarea
-stretch never
3281 frame .vpane.lower
-height 300 -width 400
3282 frame .vpane.lower.commarea
3283 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
3284 pack .vpane.lower.
diff -fill both
-expand 1
3285 pack .vpane.lower.commarea
-side bottom
-fill x
3286 .vpane add .vpane.lower
3287 .vpane paneconfigure .vpane.lower
-sticky nsew
3290 # -- Commit Area Buttons
3292 ${NS}::frame .vpane.lower.commarea.buttons
3293 ${NS}::label .vpane.lower.commarea.buttons.l
-text {} \
3296 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
3297 pack .vpane.lower.commarea.buttons
-side left
-fill y
3299 ${NS}::button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
3300 -command ui_do_rescan
3301 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
3302 lappend disable_on_lock \
3303 {.vpane.lower.commarea.buttons.rescan conf
-state}
3305 ${NS}::button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
3307 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
3308 lappend disable_on_lock \
3309 {.vpane.lower.commarea.buttons.incall conf
-state}
3311 if {![is_enabled nocommitmsg
]} {
3312 ${NS}::button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
3314 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
3317 ${NS}::button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
3319 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
3320 lappend disable_on_lock \
3321 {.vpane.lower.commarea.buttons.commit conf
-state}
3323 if {![is_enabled nocommit
]} {
3324 ${NS}::button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
3325 -command do_push_anywhere
3326 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
3329 # -- Commit Message Buffer
3331 ${NS}::frame .vpane.lower.commarea.buffer
3332 ${NS}::frame .vpane.lower.commarea.buffer.header
3333 set ui_comm .vpane.lower.commarea.buffer.frame.t
3334 set ui_coml .vpane.lower.commarea.buffer.header.l
3336 if {![is_enabled nocommit
]} {
3337 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3338 -text [mc
"New Commit"] \
3339 -command do_select_commit_type \
3340 -variable selected_commit_type \
3342 lappend disable_on_lock \
3343 [list .vpane.lower.commarea.buffer.header.new conf
-state]
3344 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3345 -text [mc
"Amend Last Commit"] \
3346 -command do_select_commit_type \
3347 -variable selected_commit_type \
3349 lappend disable_on_lock \
3350 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
3353 ${NS}::label
$ui_coml \
3356 proc trace_commit_type
{varname args
} {
3357 global ui_coml commit_type
3358 switch
-glob -- $commit_type {
3359 initial
{set txt
[mc
"Initial Commit Message:"]}
3360 amend
{set txt
[mc
"Amended Commit Message:"]}
3361 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
3362 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
3363 merge
{set txt
[mc
"Merge Commit Message:"]}
3364 * {set txt
[mc
"Commit Message:"]}
3366 $ui_coml conf
-text $txt
3368 trace add variable commit_type
write trace_commit_type
3369 pack
$ui_coml -side left
-fill x
3371 if {![is_enabled nocommit
]} {
3372 pack .vpane.lower.commarea.buffer.header.amend
-side right
3373 pack .vpane.lower.commarea.buffer.header.new
-side right
3376 textframe .vpane.lower.commarea.buffer.frame
3377 ttext
$ui_comm -background white
-foreground black \
3381 -autoseparators true \
3383 -highlightthickness 1 \
3385 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
3387 -yscrollcommand {.vpane.lower.commarea.buffer.frame.sby
set}
3388 ${NS}::scrollbar .vpane.lower.commarea.buffer.frame.sby \
3389 -command [list
$ui_comm yview
]
3391 pack .vpane.lower.commarea.buffer.frame.sby
-side right
-fill y
3392 pack
$ui_comm -side left
-fill y
3393 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
3394 pack .vpane.lower.commarea.buffer.frame
-side left
-fill y
3395 pack .vpane.lower.commarea.buffer
-side left
-fill y
3397 # -- Commit Message Buffer Context Menu
3399 set ctxm .vpane.lower.commarea.buffer.ctxm
3400 menu
$ctxm -tearoff 0
3403 -command {tk_textCut
$ui_comm}
3406 -command {tk_textCopy
$ui_comm}
3409 -command {tk_textPaste
$ui_comm}
3411 -label [mc Delete
] \
3412 -command {catch
{$ui_comm delete sel.first sel.last
}}
3415 -label [mc
"Select All"] \
3416 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
3418 -label [mc
"Copy All"] \
3420 $ui_comm tag add sel
0.0 end
3421 tk_textCopy
$ui_comm
3422 $ui_comm tag remove sel
0.0 end
3426 -label [mc
"Sign Off"] \
3428 set ui_comm_ctxm
$ctxm
3432 proc trace_current_diff_path
{varname args
} {
3433 global current_diff_path diff_actions file_states
3434 if {$current_diff_path eq
{}} {
3440 set p
$current_diff_path
3441 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
3443 set p
[escape_path
$p]
3447 .vpane.lower.
diff.header.status configure
-text $s
3448 .vpane.lower.
diff.header.
file configure
-text $f
3449 .vpane.lower.
diff.header.path configure
-text $p
3450 foreach w
$diff_actions {
3454 trace add variable current_diff_path
write trace_current_diff_path
3456 gold_frame .vpane.lower.
diff.header
3457 tlabel .vpane.lower.
diff.header.status \
3460 -width $max_status_desc \
3463 tlabel .vpane.lower.
diff.header.
file \
3468 tlabel .vpane.lower.
diff.header.path \
3473 pack .vpane.lower.
diff.header.status
-side left
3474 pack .vpane.lower.
diff.header.
file -side left
3475 pack .vpane.lower.
diff.header.path
-fill x
3476 set ctxm .vpane.lower.
diff.header.ctxm
3477 menu
$ctxm -tearoff 0
3485 -- $current_diff_path
3487 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3488 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
3492 textframe .vpane.lower.
diff.body
3493 set ui_diff .vpane.lower.
diff.body.t
3494 ttext
$ui_diff -background white
-foreground black \
3496 -width 80 -height 5 -wrap none \
3498 -takefocus 1 -highlightthickness 1 \
3499 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
3500 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
3502 catch
{$ui_diff configure
-tabstyle wordprocessor
}
3503 ${NS}::scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
3504 -command [list
$ui_diff xview
]
3505 ${NS}::scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
3506 -command [list
$ui_diff yview
]
3507 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
3508 pack .vpane.lower.
diff.body.sby
-side right
-fill y
3509 pack
$ui_diff -side left
-fill both
-expand 1
3510 pack .vpane.lower.
diff.header
-side top
-fill x
3511 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
3513 foreach
{n c
} {0 black
1 red4
2 green4
3 yellow4
4 blue4
5 magenta4
6 cyan4
7 grey60
} {
3514 $ui_diff tag configure clr4
$n -background $c
3515 $ui_diff tag configure clri4
$n -foreground $c
3516 $ui_diff tag configure clr3
$n -foreground $c
3517 $ui_diff tag configure clri3
$n -background $c
3519 $ui_diff tag configure clr1
-font font_diffbold
3520 $ui_diff tag configure clr4
-underline 1
3522 $ui_diff tag conf d_info
-foreground blue
-font font_diffbold
3524 $ui_diff tag conf d_cr
-elide true
3525 $ui_diff tag conf d_@
-font font_diffbold
3526 $ui_diff tag conf d_
+ -foreground {#00a000}
3527 $ui_diff tag conf d_-
-foreground red
3529 $ui_diff tag conf d_
++ -foreground {#00a000}
3530 $ui_diff tag conf d_--
-foreground red
3531 $ui_diff tag conf d_
+s \
3532 -foreground {#00a000} \
3533 -background {#e2effa}
3534 $ui_diff tag conf d_-s \
3536 -background {#e2effa}
3537 $ui_diff tag conf d_s
+ \
3538 -foreground {#00a000} \
3540 $ui_diff tag conf d_s- \
3544 $ui_diff tag conf d
< \
3545 -foreground orange \
3547 $ui_diff tag conf d
= \
3548 -foreground orange \
3550 $ui_diff tag conf d
> \
3551 -foreground orange \
3554 $ui_diff tag raise sel
3556 # -- Diff Body Context Menu
3559 proc create_common_diff_popup
{ctxm
} {
3561 -label [mc Refresh
] \
3562 -command reshow_diff
3563 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3566 -command {tk_textCopy
$ui_diff}
3567 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3569 -label [mc
"Select All"] \
3570 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3571 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3573 -label [mc
"Copy All"] \
3575 $ui_diff tag add sel
0.0 end
3576 tk_textCopy
$ui_diff
3577 $ui_diff tag remove sel
0.0 end
3579 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3582 -label [mc
"Decrease Font Size"] \
3583 -command {incr_font_size font_diff
-1}
3584 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3586 -label [mc
"Increase Font Size"] \
3587 -command {incr_font_size font_diff
1}
3588 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3592 build_encoding_menu
$emenu [list force_diff_encoding
]
3594 -label [mc
"Encoding"] \
3596 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3598 $ctxm add
command -label [mc
"Options..."] \
3602 set ctxm .vpane.lower.
diff.body.ctxm
3603 menu
$ctxm -tearoff 0
3605 -label [mc
"Apply/Reverse Hunk"] \
3606 -command {apply_hunk
$cursorX $cursorY}
3607 set ui_diff_applyhunk
[$ctxm index last
]
3608 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3610 -label [mc
"Apply/Reverse Line"] \
3611 -command {apply_range_or_line
$cursorX $cursorY; do_rescan
}
3612 set ui_diff_applyline
[$ctxm index last
]
3613 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3616 -label [mc
"Show Less Context"] \
3617 -command show_less_context
3618 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3620 -label [mc
"Show More Context"] \
3621 -command show_more_context
3622 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3624 create_common_diff_popup
$ctxm
3626 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3627 menu
$ctxmmg -tearoff 0
3628 $ctxmmg add
command \
3629 -label [mc
"Run Merge Tool"] \
3630 -command {merge_resolve_tool
}
3631 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3632 $ctxmmg add separator
3633 $ctxmmg add
command \
3634 -label [mc
"Use Remote Version"] \
3635 -command {merge_resolve_one
3}
3636 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3637 $ctxmmg add
command \
3638 -label [mc
"Use Local Version"] \
3639 -command {merge_resolve_one
2}
3640 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3641 $ctxmmg add
command \
3642 -label [mc
"Revert To Base"] \
3643 -command {merge_resolve_one
1}
3644 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3645 $ctxmmg add separator
3646 $ctxmmg add
command \
3647 -label [mc
"Show Less Context"] \
3648 -command show_less_context
3649 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3650 $ctxmmg add
command \
3651 -label [mc
"Show More Context"] \
3652 -command show_more_context
3653 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3654 $ctxmmg add separator
3655 create_common_diff_popup
$ctxmmg
3657 set ctxmsm .vpane.lower.
diff.body.ctxmsm
3658 menu
$ctxmsm -tearoff 0
3659 $ctxmsm add
command \
3660 -label [mc
"Visualize These Changes In The Submodule"] \
3661 -command {do_gitk
-- true
}
3662 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3663 $ctxmsm add
command \
3664 -label [mc
"Visualize Current Branch History In The Submodule"] \
3665 -command {do_gitk
{} true
}
3666 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3667 $ctxmsm add
command \
3668 -label [mc
"Visualize All Branch History In The Submodule"] \
3669 -command {do_gitk
--all true
}
3670 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3671 $ctxmsm add separator
3672 $ctxmsm add
command \
3673 -label [mc
"Start git gui In The Submodule"] \
3674 -command {do_git_gui
}
3675 lappend diff_actions
[list
$ctxmsm entryconf
[$ctxmsm index last
] -state]
3676 $ctxmsm add separator
3677 create_common_diff_popup
$ctxmsm
3679 proc has_textconv
{path
} {
3680 if {[is_config_false gui.textconv
]} {
3683 set filter
[gitattr
$path diff set]
3684 set textconv
[get_config
[join [list
diff $filter textconv
] .
]]
3685 if {$filter ne
{set} && $textconv ne
{}} {
3692 proc popup_diff_menu
{ctxm ctxmmg ctxmsm x y X Y
} {
3693 global current_diff_path file_states
3696 if {[info exists file_states
($current_diff_path)]} {
3697 set state
[lindex
$file_states($current_diff_path) 0]
3701 if {[string first
{U
} $state] >= 0} {
3702 tk_popup
$ctxmmg $X $Y
3703 } elseif
{$
::is_submodule_diff
} {
3704 tk_popup
$ctxmsm $X $Y
3706 set has_range
[expr {[$
::ui_diff tag nextrange sel
0.0] != {}}]
3707 if {$
::ui_index eq $
::current_diff_side
} {
3708 set l
[mc
"Unstage Hunk From Commit"]
3710 set t
[mc
"Unstage Lines From Commit"]
3712 set t
[mc
"Unstage Line From Commit"]
3715 set l
[mc
"Stage Hunk For Commit"]
3717 set t
[mc
"Stage Lines For Commit"]
3719 set t
[mc
"Stage Line For Commit"]
3723 ||
$current_diff_path eq
{}
3726 ||
[string match
{?T
} $state]
3727 ||
[string match
{T?
} $state]
3728 ||
[has_textconv
$current_diff_path]} {
3733 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3734 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3735 tk_popup
$ctxm $X $Y
3738 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg $ctxmsm %x
%y
%X
%Y
]
3742 set main_status
[::status_bar
::new .status
]
3743 pack .status
-anchor w
-side bottom
-fill x
3744 $main_status show
[mc
"Initializing..."]
3748 proc on_ttk_pane_mapped
{w pane pos
} {
3750 after
0 [list after idle
[list
$w sashpos
$pane $pos]]
3752 proc on_tk_pane_mapped
{w pane x y
} {
3754 after
0 [list after idle
[list
$w sash place
$pane $x $y]]
3756 proc on_application_mapped
{} {
3757 global repo_config use_ttk
3759 set gm
$repo_config(gui.geometry
)
3762 [list on_ttk_pane_mapped
%W
0 [lindex
$gm 1]]
3763 bind .vpane.files
<Map
> \
3764 [list on_ttk_pane_mapped
%W
0 [lindex
$gm 2]]
3767 [list on_tk_pane_mapped
%W
0 \
3769 [lindex
[.vpane sash coord
0] 1]]
3770 bind .vpane.files
<Map
> \
3771 [list on_tk_pane_mapped
%W
0 \
3772 [lindex
[.vpane.files sash coord
0] 0] \
3775 wm geometry .
[lindex
$gm 0]
3777 if {[info exists repo_config
(gui.geometry
)]} {
3778 bind .
<Map
> [list on_application_mapped
]
3779 wm geometry .
[lindex
$repo_config(gui.geometry
) 0]
3782 # -- Load window state
3784 if {[info exists repo_config
(gui.wmstate
)]} {
3785 catch
{wm state .
$repo_config(gui.wmstate
)}
3790 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3791 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3792 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3793 bind $ui_comm <$M1B-Key-u> {do_unstage_selection
;break}
3794 bind $ui_comm <$M1B-Key-U> {do_unstage_selection
;break}
3795 bind $ui_comm <$M1B-Key-j> {do_revert_selection
;break}
3796 bind $ui_comm <$M1B-Key-J> {do_revert_selection
;break}
3797 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3798 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3799 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3800 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3801 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3802 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3803 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3804 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3805 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3806 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3807 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3808 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3809 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3810 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3811 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3813 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3814 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3815 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3816 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3817 bind $ui_diff <$M1B-Key-v> {break}
3818 bind $ui_diff <$M1B-Key-V> {break}
3819 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3820 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3821 bind $ui_diff <$M1B-Key-j> {do_revert_selection
;break}
3822 bind $ui_diff <$M1B-Key-J> {do_revert_selection
;break}
3823 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3824 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3825 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3826 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3827 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3828 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3829 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3830 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3831 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3832 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3833 bind $ui_diff <Button-1
> {focus
%W
}
3835 if {[is_enabled branch
]} {
3836 bind .
<$M1B-Key-n> branch_create
::dialog
3837 bind .
<$M1B-Key-N> branch_create
::dialog
3838 bind .
<$M1B-Key-o> branch_checkout
::dialog
3839 bind .
<$M1B-Key-O> branch_checkout
::dialog
3840 bind .
<$M1B-Key-m> merge
::dialog
3841 bind .
<$M1B-Key-M> merge
::dialog
3843 if {[is_enabled transport
]} {
3844 bind .
<$M1B-Key-p> do_push_anywhere
3845 bind .
<$M1B-Key-P> do_push_anywhere
3848 bind .
<Key-F5
> ui_do_rescan
3849 bind .
<$M1B-Key-r> ui_do_rescan
3850 bind .
<$M1B-Key-R> ui_do_rescan
3851 bind .
<$M1B-Key-s> do_signoff
3852 bind .
<$M1B-Key-S> do_signoff
3853 bind .
<$M1B-Key-t> { toggle_or_diff toggle
%W
}
3854 bind .
<$M1B-Key-T> { toggle_or_diff toggle
%W
}
3855 bind .
<$M1B-Key-u> { toggle_or_diff toggle
%W
}
3856 bind .
<$M1B-Key-U> { toggle_or_diff toggle
%W
}
3857 bind .
<$M1B-Key-j> do_revert_selection
3858 bind .
<$M1B-Key-J> do_revert_selection
3859 bind .
<$M1B-Key-i> do_add_all
3860 bind .
<$M1B-Key-I> do_add_all
3861 bind .
<$M1B-Key-minus> {show_less_context
;break}
3862 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3863 bind .
<$M1B-Key-equal> {show_more_context
;break}
3864 bind .
<$M1B-Key-plus> {show_more_context
;break}
3865 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3866 bind .
<$M1B-Key-Return> do_commit
3867 foreach i
[list
$ui_index $ui_workdir] {
3868 bind $i <Button-1
> { toggle_or_diff click
%W
%x
%y
; break }
3869 bind $i <$M1B-Button-1> { add_one_to_selection
%W
%x
%y
; break }
3870 bind $i <Shift-Button-1
> { add_range_to_selection
%W
%x
%y
; break }
3871 bind $i <Key-Up
> { toggle_or_diff up
%W
; break }
3872 bind $i <Key-Down
> { toggle_or_diff down
%W
; break }
3876 set file_lists
($ui_index) [list
]
3877 set file_lists
($ui_workdir) [list
]
3879 wm title .
"[appname] ([reponame]) [file normalize $_gitworktree]"
3880 focus
-force $ui_comm
3882 # -- Warn the user about environmental problems. Cygwin's Tcl
3883 # does *not* pass its env array onto any processes it spawns.
3884 # This means that git processes get none of our environment.
3889 set msg
[mc
"Possible environment issues exist.
3891 The following environment variables are probably
3892 going to be ignored by any Git subprocess run
3896 foreach name
[array names env
] {
3897 switch
-regexp -- $name {
3898 {^GIT_INDEX_FILE$
} -
3899 {^GIT_OBJECT_DIRECTORY$
} -
3900 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3902 {^GIT_EXTERNAL_DIFF$
} -
3906 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3907 append msg
" - $name\n"
3910 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3911 append msg
" - $name\n"
3913 set suggest_user
$name
3917 if {$ignored_env > 0} {
3919 This is due to a known issue with the
3920 Tcl binary distributed by Cygwin."]
3922 if {$suggest_user ne
{}} {
3925 A good replacement for %s
3926 is placing values for the user.name and
3927 user.email settings into your personal
3933 unset ignored_env msg suggest_user name
3936 # -- Only initialize complex UI if we are going to stay running.
3938 if {[is_enabled transport
]} {
3941 set n
[.mbar.remote index end
]
3942 populate_remotes_menu
3943 set n
[expr {[.mbar.remote index end
] - $n}]
3945 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3946 .mbar.remote insert
$n separator
3951 if {[winfo exists
$ui_comm]} {
3952 set GITGUI_BCK_exists
[load_message GITGUI_BCK utf-8
]
3954 # -- If both our backup and message files exist use the
3955 # newer of the two files to initialize the buffer.
3957 if {$GITGUI_BCK_exists} {
3958 set m
[gitdir GITGUI_MSG
]
3959 if {[file isfile
$m]} {
3960 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3961 catch
{file delete
[gitdir GITGUI_MSG
]}
3963 $ui_comm delete
0.0 end
3965 $ui_comm edit modified false
3966 catch
{file delete
[gitdir GITGUI_BCK
]}
3967 set GITGUI_BCK_exists
0
3973 proc backup_commit_buffer
{} {
3974 global ui_comm GITGUI_BCK_exists
3976 set m
[$ui_comm edit modified
]
3977 if {$m ||
$GITGUI_BCK_exists} {
3978 set msg
[string trim
[$ui_comm get
0.0 end
]]
3979 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3982 if {$GITGUI_BCK_exists} {
3983 catch
{file delete
[gitdir GITGUI_BCK
]}
3984 set GITGUI_BCK_exists
0
3988 set fd
[open
[gitdir GITGUI_BCK
] w
]
3989 fconfigure
$fd -encoding utf-8
3990 puts
-nonewline $fd $msg
3992 set GITGUI_BCK_exists
1
3996 $ui_comm edit modified false
3999 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
4002 backup_commit_buffer
4004 # -- If the user has aspell available we can drive it
4005 # in pipe mode to spellcheck the commit message.
4007 set spell_cmd
[list |
]
4008 set spell_dict
[get_config gui.spellingdictionary
]
4009 lappend spell_cmd aspell
4010 if {$spell_dict ne
{}} {
4011 lappend spell_cmd
--master=$spell_dict
4013 lappend spell_cmd
--mode=none
4014 lappend spell_cmd
--encoding=utf-8
4015 lappend spell_cmd pipe
4016 if {$spell_dict eq
{none
}
4017 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
4018 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
4020 set ui_comm_spell
[spellcheck
::init \
4026 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
4029 lock_index begin-read
4030 if {![winfo ismapped .
]} {
4034 if {[is_enabled initialamend
]} {
4040 if {[is_enabled nocommitmsg
]} {
4041 $ui_comm configure
-state disabled
-background gray
4044 if {[is_enabled multicommit
] && ![is_config_false gui.gcwarning
]} {
4047 if {[is_enabled retcode
]} {
4048 bind .
<Destroy
> {+terminate_me
%W
}
4050 if {$picked && [is_config_true gui.autoexplore
]} {
4056 # indent-tabs-mode: t