2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 ||
test "z$*" = z--version
; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
10 exec wish
"$argv0" -- "$@"
12 set appvers
{@@GITGUI_VERSION@@
}
13 set copyright
[encoding convertfrom utf-8
{
14 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
16 This program is free software
; you can redistribute it and
/or modify
17 it under the terms of the GNU General Public License as published by
18 the Free Software Foundation
; either version
2 of the License
, or
19 (at your option
) any later version.
21 This program is distributed
in the hope that it will be useful
,
22 but WITHOUT ANY WARRANTY
; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License
for more details.
26 You should have received a copy of the GNU General Public License
27 along with this program
; if not
, write to the Free Software
28 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}]
30 ######################################################################
32 ## Tcl/Tk sanity check
34 if {[catch
{package require Tcl
8.4} err
]
35 ||
[catch
{package require Tk
8.4} err
]
41 -title [mc
"git-gui: fatal error"] \
46 catch
{rename send
{}} ; # What an evil concept...
48 ######################################################################
52 set oguilib
{@@GITGUI_LIBDIR@@
}
53 set oguirel
{@@GITGUI_RELATIVE@@
}
54 if {$oguirel eq
{1}} {
55 set oguilib
[file dirname [file normalize
$argv0]]
56 if {[file tail $oguilib] eq
{git-core
}} {
57 set oguilib
[file dirname $oguilib]
59 set oguilib
[file dirname $oguilib]
60 set oguilib
[file join $oguilib share git-gui lib
]
61 set oguimsg
[file join $oguilib msgs
]
62 } elseif
{[string match @@
* $oguirel]} {
63 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
64 set oguimsg
[file join [file dirname [file normalize
$argv0]] po
]
66 set oguimsg
[file join $oguilib msgs
]
70 ######################################################################
72 ## enable verbose loading?
74 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
76 rename auto_load real__auto_load
77 proc auto_load
{name args
} {
78 puts stderr
"auto_load $name"
79 return [uplevel
1 real__auto_load
$name $args]
81 rename
source real__source
83 puts stderr
"source $name"
84 uplevel
1 real__source
$name
88 ######################################################################
90 ## Internationalization (i18n) through msgcat and gettext. See
91 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93 package require msgcat
96 set cmk
[string first @@
$fmt]
98 return [string range
$fmt 0 [expr {$cmk - 1}]]
103 proc mc
{en_fmt args
} {
104 set fmt [_mc_trim
[::msgcat
::mc
$en_fmt]]
105 if {[catch
{set msg
[eval [list format
$fmt] $args]} err
]} {
106 set msg
[eval [list format
[_mc_trim
$en_fmt]] $args]
112 return [join $args {}]
115 ::msgcat
::mcload
$oguimsg
118 ######################################################################
122 set _appname
{Git Gui
}
130 set _trace
[lsearch
-exact $argv --trace]
132 set argv
[lreplace
$argv $_trace $_trace]
148 return [eval [list
file join $_gitdir] $args]
151 proc gitexec
{args
} {
153 if {$_gitexec eq
{}} {
154 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
155 error
"Git not installed?\n\n$err"
158 set _gitexec
[exec cygpath \
163 set _gitexec
[file normalize
$_gitexec]
169 return [eval [list
file join $_gitexec] $args]
172 proc githtmldir
{args
} {
174 if {$_githtmldir eq
{}} {
175 if {[catch
{set _githtmldir
[git
--html-path]}]} {
176 # Git not installed or option not yet supported
180 set _githtmldir
[exec cygpath \
185 set _githtmldir
[file normalize
$_githtmldir]
191 return [eval [list
file join $_githtmldir] $args]
199 if {[tk windowingsystem
] eq
{aqua
}} {
206 if {$
::tcl_platform
(platform
) eq
{windows
}} {
214 if {$_iscygwin eq
{}} {
215 if {$
::tcl_platform
(platform
) eq
{windows
}} {
216 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
228 proc is_enabled
{option
} {
229 global enabled_options
230 if {[catch
{set on
$enabled_options($option)}]} {return 0}
234 proc enable_option
{option
} {
235 global enabled_options
236 set enabled_options
($option) 1
239 proc disable_option
{option
} {
240 global enabled_options
241 set enabled_options
($option) 0
244 ######################################################################
248 proc is_many_config
{name
} {
249 switch
-glob -- $name {
259 proc is_config_true
{name
} {
261 if {[catch
{set v
$repo_config($name)}]} {
263 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
270 proc get_config
{name
} {
272 if {[catch
{set v
$repo_config($name)}]} {
279 ######################################################################
283 proc _trace_exec
{cmd
} {
284 if {!$
::_trace
} return
290 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
298 proc _git_cmd {name} {
301 if {[catch {set v $_git_cmd_path($name)}]} {
305 --exec-path { return [list $::_git $name] }
308 set p [gitexec git-$name$::_search_exe]
309 if {[file exists $p]} {
311 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
312 # Try to determine what sort of magic will make
313 # git-$name go and do its thing, because native
314 # Tcl on Windows doesn't know it.
316 set p
[gitexec git-
$name]
321 switch
-glob -- [lindex
$s 0] {
323 #!*perl { set i perl }
324 #!*python { set i python }
325 default
{ error
"git-$name is not supported: $s" }
329 if {![info exists interp
]} {
330 set interp
[_which
$i]
333 error
"git-$name requires $i (not in PATH)"
335 set v
[concat
[list
$interp] [lrange
$s 1 end
] [list
$p]]
337 # Assume it is builtin to git somehow and we
338 # aren't actually able to see a file for it.
340 set v
[list $
::_git
$name]
342 set _git_cmd_path
($name) $v
347 proc _which
{what args
} {
348 global env _search_exe _search_path
350 if {$_search_path eq
{}} {
351 if {[is_Cygwin
] && [regexp
{^
(/|\.
:)} $env(PATH
)]} {
352 set _search_path
[split [exec cygpath \
358 } elseif
{[is_Windows
]} {
359 set gitguidir
[file dirname [info
script]]
360 regsub
-all ";" $gitguidir "\\;" gitguidir
361 set env
(PATH
) "$gitguidir;$env(PATH)"
362 set _search_path
[split $env(PATH
) {;}]
365 set _search_path
[split $env(PATH
) :]
370 if {[is_Windows
] && [lsearch
-exact $args -script] >= 0} {
373 set suffix
$_search_exe
376 foreach p
$_search_path {
377 set p
[file join $p $what$suffix]
378 if {[file exists
$p]} {
379 return [file normalize
$p]
385 proc _lappend_nice
{cmd_var
} {
389 if {![info exists _nice
]} {
390 set _nice
[_which nice
]
401 switch
-- [lindex
$args 0] {
412 set args
[lrange
$args 1 end
]
415 set cmdp
[_git_cmd
[lindex
$args 0]]
416 set args
[lrange
$args 1 end
]
418 _trace_exec
[concat
$opt $cmdp $args]
419 set result
[eval exec $opt $cmdp $args]
421 puts stderr
"< $result"
426 proc _open_stdout_stderr
{cmd
} {
429 set fd
[open
[concat
[list |
] $cmd] r
]
431 if { [lindex
$cmd end
] eq
{2>@
1}
432 && $err eq
{can not
find channel named
"1"}
434 # Older versions of Tcl 8.4 don't have this 2>@1 IO
435 # redirect operator. Fallback to |& cat for those.
436 # The command was not actually started, so its safe
437 # to try to start it a second time.
439 set fd
[open
[concat \
441 [lrange
$cmd 0 end-1
] \
448 fconfigure
$fd -eofchar {}
452 proc git_read
{args
} {
456 switch
-- [lindex
$args 0] {
471 set args
[lrange
$args 1 end
]
474 set cmdp
[_git_cmd
[lindex
$args 0]]
475 set args
[lrange
$args 1 end
]
477 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
480 proc git_write
{args
} {
484 switch
-- [lindex
$args 0] {
495 set args
[lrange
$args 1 end
]
498 set cmdp
[_git_cmd
[lindex
$args 0]]
499 set args
[lrange
$args 1 end
]
501 _trace_exec
[concat
$opt $cmdp $args]
502 return [open
[concat
[list |
] $opt $cmdp $args] w
]
505 proc githook_read
{hook_name args
} {
506 set pchook
[gitdir hooks
$hook_name]
509 # On Windows [file executable] might lie so we need to ask
510 # the shell if the hook is executable. Yes that's annoying.
514 if {![info exists interp
]} {
515 set interp
[_which sh
]
518 error
"hook execution requires sh (not in PATH)"
521 set scr
{if test -x "$1";then exec "$@";fi}
522 set sh_c
[list
$interp -c $scr $interp $pchook]
523 return [_open_stdout_stderr
[concat
$sh_c $args]]
526 if {[file executable
$pchook]} {
527 return [_open_stdout_stderr
[concat
[list
$pchook] $args]]
533 proc kill_file_process
{fd
} {
534 set process
[pid
$fd]
538 # Use a Cygwin-specific flag to allow killing
539 # native Windows processes
540 exec kill -f $process
547 proc gitattr
{path attr default
} {
548 if {[catch
{set r
[git check-attr
$attr -- $path]}]} {
551 set r
[join [lrange
[split $r :] 2 end
] :]
554 if {$r eq
{unspecified
}} {
561 regsub
-all ' $value "'\\''" value
565 proc load_current_branch {} {
566 global current_branch is_detached
568 set fd [open [gitdir HEAD] r]
569 if {[gets $fd ref] < 1} {
574 set pfx {ref: refs/heads/}
575 set len [string length $pfx]
576 if {[string equal -length $len $pfx $ref]} {
577 # We're on a branch. It might not exist. But
578 # HEAD looks good enough to be a branch.
580 set current_branch [string range $ref $len end]
583 # Assume this is a detached head.
585 set current_branch HEAD
590 auto_load tk_optionMenu
591 rename tk_optionMenu real__tkOptionMenu
592 proc tk_optionMenu {w varName args} {
593 set m [eval real__tkOptionMenu $w $varName $args]
594 $m configure -font font_ui
595 $w configure -font font_ui
599 proc rmsel_tag {text} {
601 -background [$text cget -background] \
602 -foreground [$text cget -foreground] \
604 $text tag conf in_sel -background lightgray
605 bind $text <Motion> break
610 bind . <Visibility> {
611 bind . <Visibility> {}
616 wm iconbitmap . -default $oguilib/git-gui.ico
617 set ::tk::AlwaysShowSelection 1
619 # Spoof an X11 display for SSH
620 if {![info exists env(DISPLAY)]} {
621 set env(DISPLAY) :9999
625 image create photo gitlogo -width 16 -height 16
627 gitlogo put #33CC33 -to 7 0 9 2
628 gitlogo put #33CC33 -to 4 2 12 4
629 gitlogo put #33CC33 -to 7 4 9 6
630 gitlogo put #CC3333 -to 4 6 12 8
631 gitlogo put gray26 -to 4 9 6 10
632 gitlogo put gray26 -to 3 10 6 12
633 gitlogo put gray26 -to 8 9 13 11
634 gitlogo put gray26 -to 8 11 10 12
635 gitlogo put gray26 -to 11 11 13 14
636 gitlogo put gray26 -to 3 12 5 14
637 gitlogo put gray26 -to 5 13
638 gitlogo put gray26 -to 10 13
639 gitlogo put gray26 -to 4 14 12 15
640 gitlogo put gray26 -to 5 15 11 16
643 wm iconphoto . -default gitlogo
647 ######################################################################
652 font create font_diff -family Courier -size 10
656 eval font configure font_ui [font actual [.dummy cget -font]]
660 font create font_uiitalic
661 font create font_uibold
662 font create font_diffbold
663 font create font_diffitalic
665 foreach class {Button Checkbutton Entry Label
666 Labelframe Listbox Message
667 Radiobutton Spinbox Text} {
668 option add *$class.font font_ui
671 option add *Menu.font font_ui
675 if {[is_Windows] || [is_MacOSX]} {
676 option add *Menu.tearOff 0
687 proc bind_button3 {w cmd} {
688 bind $w <Any-Button-3> $cmd
690 # Mac OS X sends Button-2 on right click through three-button mouse,
691 # or through trackpad right-clicking (two-finger touch + click).
692 bind $w <Any-Button-2> $cmd
693 bind $w <Control-Button-1> $cmd
697 proc apply_config {} {
698 global repo_config font_descs
700 foreach option $font_descs {
701 set name [lindex $option 0]
702 set font [lindex $option 1]
705 foreach {cn cv} $repo_config(gui.$name) {
706 if {$cn eq {-weight}} {
709 font configure $font $cn $cv
712 font configure $font -weight normal
715 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
717 foreach {cn cv} [font configure $font] {
718 font configure ${font}bold $cn $cv
719 font configure ${font}italic $cn $cv
721 font configure ${font}bold -weight bold
722 font configure ${font}italic -slant italic
726 set default_config(branch.autosetupmerge) true
727 set default_config(merge.tool) {}
728 set default_config(mergetool.keepbackup) true
729 set default_config(merge.diffstat) true
730 set default_config(merge.summary) false
731 set default_config(merge.verbosity) 2
732 set default_config(user.name) {}
733 set default_config(user.email) {}
735 set default_config(gui.encoding) [encoding system]
736 set default_config(gui.matchtrackingbranch) false
737 set default_config(gui.pruneduringfetch) false
738 set default_config(gui.trustmtime) false
739 set default_config(gui.fastcopyblame) false
740 set default_config(gui.copyblamethreshold) 40
741 set default_config(gui.blamehistoryctx) 7
742 set default_config(gui.diffcontext) 5
743 set default_config(gui.commitmsgwidth) 75
744 set default_config(gui.newbranchtemplate) {}
745 set default_config(gui.spellingdictionary) {}
746 set default_config(gui.fontui) [font configure font_ui]
747 set default_config(gui.fontdiff) [font configure font_diff]
748 # TODO: this option should be added to the git-config documentation
749 set default_config(gui.maxfilesdisplayed) 5000
751 {fontui font_ui {mc "Main Font
"}}
752 {fontdiff font_diff {mc "Diff
/Console Font
"}}
755 ######################################################################
759 set _git [_which git]
761 catch {wm withdraw .}
765 -title [mc "git-gui
: fatal error
"] \
766 -message [mc "Cannot
find git
in PATH.
"]
770 ######################################################################
774 if {[catch {set _git_version [git --version]} err]} {
775 catch {wm withdraw .}
779 -title [mc "git-gui
: fatal error
"] \
780 -message "Cannot determine Git version
:
784 [appname
] requires Git
1.5.0 or later.
"
787 if {![regsub {^git version } $_git_version {} _git_version]} {
788 catch {wm withdraw .}
792 -title [mc "git-gui
: fatal error
"] \
793 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
797 set _real_git_version $_git_version
798 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
799 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
800 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
801 regsub {\.GIT$} $_git_version {} _git_version
802 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
804 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
805 catch {wm withdraw .}
810 -title "[appname
]: warning
" \
811 -message [mc "Git version cannot be determined.
813 %s claims it is version
'%s'.
815 %s requires
at least Git
1.5.0 or later.
817 Assume
'%s' is version
1.5.0?
818 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
819 set _git_version 1.5.0
824 unset _real_git_version
826 proc git-version {args} {
829 switch [llength $args] {
835 set op [lindex $args 0]
836 set vr [lindex $args 1]
837 set cm [package vcompare $_git_version $vr]
838 return [expr $cm $op 0]
842 set type [lindex $args 0]
843 set name [lindex $args 1]
844 set parm [lindex $args 2]
845 set body [lindex $args 3]
847 if {($type ne {proc} && $type ne {method})} {
848 error "Invalid arguments to git-version
"
850 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
851 error "Last arm of
$type $name must be default
"
854 foreach {op vr cb} [lrange $body 0 end-2] {
855 if {[git-version $op $vr]} {
856 return [uplevel [list $type $name $parm $cb]]
860 return [uplevel [list $type $name $parm [lindex $body end]]]
864 error "git-version
>= x
"
870 if {[git-version < 1.5]} {
871 catch {wm withdraw .}
875 -title [mc "git-gui
: fatal error
"] \
876 -message "[appname
] requires Git
1.5.0 or later.
878 You are using
[git-version
]:
884 ######################################################################
886 ## configure our library
888 set idx [file join $oguilib tclIndex]
889 if {[catch {set fd [open $idx r]} err]} {
890 catch {wm withdraw .}
894 -title [mc "git-gui
: fatal error
"] \
898 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
900 while {[gets $fd n] >= 0} {
901 if {$n ne {} && ![string match #* $n]} {
913 if {[lsearch -exact $loaded $p] >= 0} continue
914 source [file join $oguilib $p]
919 set auto_path [concat [list $oguilib] $auto_path]
921 unset -nocomplain idx fd
923 ######################################################################
925 ## config file parsing
927 git-version proc _parse_config {arr_name args} {
934 [list git_read config] \
936 [list --null --list]]
937 fconfigure $fd_rc -translation binary
938 set buf [read $fd_rc]
941 foreach line [split $buf "\
0"] {
942 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
943 if {[is_many_config $name]} {
944 lappend arr($name) $value
946 set arr($name) $value
955 set fd_rc [eval [list git_read config --list] $args]
956 while {[gets $fd_rc line] >= 0} {
957 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
958 if {[is_many_config $name]} {
959 lappend arr($name) $value
961 set arr($name) $value
970 proc load_config {include_global} {
971 global repo_config global_config system_config default_config
973 if {$include_global} {
974 _parse_config system_config --system
975 _parse_config global_config --global
977 _parse_config repo_config
979 foreach name [array names default_config] {
980 if {[catch {set v $system_config($name)}]} {
981 set system_config($name) $default_config($name)
984 foreach name [array names system_config] {
985 if {[catch {set v $global_config($name)}]} {
986 set global_config($name) $system_config($name)
988 if {[catch {set v $repo_config($name)}]} {
989 set repo_config($name) $system_config($name)
994 ######################################################################
996 ## feature option selection
998 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1003 if {$subcommand eq {gui.sh}} {
1006 if {$subcommand eq {gui} && [llength $argv] > 0} {
1007 set subcommand [lindex $argv 0]
1008 set argv [lrange $argv 1 end]
1011 enable_option multicommit
1012 enable_option branch
1013 enable_option transport
1016 switch -- $subcommand {
1021 disable_option multicommit
1022 disable_option branch
1023 disable_option transport
1026 enable_option singlecommit
1027 enable_option retcode
1029 disable_option multicommit
1030 disable_option branch
1031 disable_option transport
1033 while {[llength $argv] > 0} {
1034 set a [lindex $argv 0]
1037 enable_option initialamend
1040 enable_option nocommit
1041 enable_option nocommitmsg
1044 disable_option nocommitmsg
1051 set argv [lrange $argv 1 end]
1056 ######################################################################
1058 ## execution environment
1060 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1062 # Suggest our implementation of askpass, if none is set
1063 if {![info exists env(SSH_ASKPASS)]} {
1064 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1067 ######################################################################
1073 set _gitdir $env(GIT_DIR)
1077 set _gitdir [git rev-parse --git-dir]
1078 set _prefix [git rev-parse --show-prefix]
1082 choose_repository::pick
1085 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1086 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1088 if {![file isdirectory $_gitdir]} {
1089 catch {wm withdraw .}
1090 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1093 if {$_prefix ne {}} {
1094 regsub -all {[^/]+/} $_prefix ../ cdup
1095 if {[catch {cd $cdup} err]} {
1096 catch {wm withdraw .}
1097 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1101 } elseif {![is_enabled bare]} {
1102 if {[lindex [file split $_gitdir] end] ne {.git}} {
1103 catch {wm withdraw .}
1104 error_popup [strcat [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
1107 if {[catch {cd [file dirname $_gitdir]} err]} {
1108 catch {wm withdraw .}
1109 error_popup [strcat [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
1113 set _reponame [file split [file normalize $_gitdir]]
1114 if {[lindex $_reponame end] eq {.git}} {
1115 set _reponame [lindex $_reponame end-1]
1117 set _reponame [lindex $_reponame end]
1120 ######################################################################
1124 set current_diff_path {}
1125 set current_diff_side {}
1126 set diff_actions [list]
1130 set MERGE_HEAD [list]
1133 set current_branch {}
1135 set current_diff_path {}
1137 set is_submodule_diff 0
1138 set is_conflict_diff 0
1139 set selected_commit_type new
1140 set diff_empty_count 0
1142 set nullid "0000000000000000000000000000000000000000"
1143 set nullid2 "0000000000000000000000000000000000000001"
1145 ######################################################################
1153 set disable_on_lock [list]
1154 set index_lock_type none
1156 proc lock_index {type} {
1157 global index_lock_type disable_on_lock
1159 if {$index_lock_type eq {none}} {
1160 set index_lock_type $type
1161 foreach w $disable_on_lock {
1162 uplevel #0 $w disabled
1165 } elseif {$index_lock_type eq "begin-
$type"} {
1166 set index_lock_type $type
1172 proc unlock_index {} {
1173 global index_lock_type disable_on_lock
1175 set index_lock_type none
1176 foreach w $disable_on_lock {
1177 uplevel #0 $w normal
1181 ######################################################################
1185 proc repository_state {ctvar hdvar mhvar} {
1186 global current_branch
1187 upvar $ctvar ct $hdvar hd $mhvar mh
1192 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1198 set merge_head [gitdir MERGE_HEAD]
1199 if {[file exists $merge_head]} {
1201 set fd_mh [open $merge_head r]
1202 while {[gets $fd_mh line] >= 0} {
1213 global PARENT empty_tree
1215 set p [lindex $PARENT 0]
1219 if {$empty_tree eq {}} {
1220 set empty_tree [git mktree << {}]
1225 proc force_amend {} {
1226 global selected_commit_type
1227 global HEAD PARENT MERGE_HEAD commit_type
1229 repository_state newType newHEAD newMERGE_HEAD
1232 set MERGE_HEAD $newMERGE_HEAD
1233 set commit_type $newType
1235 set selected_commit_type amend
1236 do_select_commit_type
1239 proc rescan {after {honor_trustmtime 1}} {
1240 global HEAD PARENT MERGE_HEAD commit_type
1241 global ui_index ui_workdir ui_comm
1242 global rescan_active file_states
1245 if {$rescan_active > 0 || ![lock_index read]} return
1247 repository_state newType newHEAD newMERGE_HEAD
1248 if {[string match amend* $commit_type]
1249 && $newType eq {normal}
1250 && $newHEAD eq $HEAD} {
1254 set MERGE_HEAD $newMERGE_HEAD
1255 set commit_type $newType
1258 array unset file_states
1260 if {!$::GITGUI_BCK_exists &&
1261 (![$ui_comm edit modified]
1262 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1263 if {[string match amend* $commit_type]} {
1264 } elseif {[load_message GITGUI_MSG]} {
1265 } elseif {[run_prepare_commit_msg_hook]} {
1266 } elseif {[load_message MERGE_MSG]} {
1267 } elseif {[load_message SQUASH_MSG]} {
1270 $ui_comm edit modified false
1273 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1274 rescan_stage2 {} $after
1277 ui_status [mc "Refreshing
file status...
"]
1278 set fd_rf [git_read update-index \
1284 fconfigure $fd_rf -blocking 0 -translation binary
1285 fileevent $fd_rf readable \
1286 [list rescan_stage2 $fd_rf $after]
1291 set is_git_info_exclude {}
1292 proc have_info_exclude {} {
1293 global is_git_info_exclude
1295 if {$is_git_info_exclude eq {}} {
1296 if {[catch {exec test -f [gitdir info exclude]}]} {
1297 set is_git_info_exclude 0
1299 set is_git_info_exclude 1
1302 return $is_git_info_exclude
1305 proc have_info_exclude {} {
1306 return [file readable [gitdir info exclude]]
1310 proc rescan_stage2 {fd after} {
1311 global rescan_active buf_rdi buf_rdf buf_rlo
1315 if {![eof $fd]} return
1319 set ls_others [list --exclude-per-directory=.gitignore]
1320 if {[have_info_exclude]} {
1321 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1323 set user_exclude [get_config core.excludesfile]
1324 if {$user_exclude ne {} && [file readable $user_exclude]} {
1325 lappend ls_others "--exclude-from=$user_exclude"
1333 ui_status [mc "Scanning
for modified files ...
"]
1334 set fd_di [git_read diff-index --cached -z [PARENT]]
1335 set fd_df [git_read diff-files -z]
1336 set fd_lo [eval git_read ls-files --others -z $ls_others]
1338 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1339 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1340 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1341 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1342 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1343 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1346 proc load_message {file} {
1349 set f [gitdir $file]
1350 if {[file isfile $f]} {
1351 if {[catch {set fd [open $f r]}]} {
1354 fconfigure $fd -eofchar {}
1355 set content [string trim [read $fd]]
1357 regsub -all -line {[ \r\t]+$} $content {} content
1358 $ui_comm delete 0.0 end
1359 $ui_comm insert end $content
1365 proc run_prepare_commit_msg_hook {} {
1368 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1369 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1370 # empty file but existant file.
1372 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1374 if {[file isfile [gitdir MERGE_MSG]]} {
1375 set pcm_source "merge
"
1376 set fd_mm [open [gitdir MERGE_MSG] r]
1377 puts -nonewline $fd_pcm [read $fd_mm]
1379 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1380 set pcm_source "squash
"
1381 set fd_sm [open [gitdir SQUASH_MSG] r]
1382 puts -nonewline $fd_pcm [read $fd_sm]
1390 set fd_ph [githook_read prepare-commit-msg \
1391 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1393 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1397 ui_status [mc "Calling prepare-commit-msg hook...
"]
1400 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1401 fileevent $fd_ph readable \
1402 [list prepare_commit_msg_hook_wait $fd_ph]
1407 proc prepare_commit_msg_hook_wait {fd_ph} {
1410 append pch_error [read $fd_ph]
1411 fconfigure $fd_ph -blocking 1
1413 if {[catch {close $fd_ph}]} {
1414 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1415 hook_failed_popup prepare-commit-msg $pch_error
1416 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1419 load_message PREPARE_COMMIT_MSG
1422 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1425 fconfigure $fd_ph -blocking 0
1426 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1429 proc read_diff_index {fd after} {
1432 append buf_rdi [read $fd]
1434 set n [string length $buf_rdi]
1436 set z1 [string first "\
0" $buf_rdi $c]
1437 if {$z1 == -1} break
1439 set z2 [string first "\
0" $buf_rdi $z1]
1440 if {$z2 == -1} break
1443 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1444 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1446 [encoding convertfrom $p] \
1448 [list [lindex $i 0] [lindex $i 2]] \
1454 set buf_rdi [string range $buf_rdi $c end]
1459 rescan_done $fd buf_rdi $after
1462 proc read_diff_files {fd after} {
1465 append buf_rdf [read $fd]
1467 set n [string length $buf_rdf]
1469 set z1 [string first "\
0" $buf_rdf $c]
1470 if {$z1 == -1} break
1472 set z2 [string first "\
0" $buf_rdf $z1]
1473 if {$z2 == -1} break
1476 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1477 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1479 [encoding convertfrom $p] \
1482 [list [lindex $i 0] [lindex $i 2]]
1487 set buf_rdf [string range $buf_rdf $c end]
1492 rescan_done $fd buf_rdf $after
1495 proc read_ls_others {fd after} {
1498 append buf_rlo [read $fd]
1499 set pck [split $buf_rlo "\
0"]
1500 set buf_rlo [lindex $pck end]
1501 foreach p [lrange $pck 0 end-1] {
1502 set p [encoding convertfrom $p]
1503 if {[string index $p end] eq {/}} {
1504 set p [string range $p 0 end-1]
1508 rescan_done $fd buf_rlo $after
1511 proc rescan_done {fd buf after} {
1512 global rescan_active current_diff_path
1513 global file_states repo_config
1516 if {![eof $fd]} return
1519 if {[incr rescan_active -1] > 0} return
1524 if {$current_diff_path ne {}} { reshow_diff $after }
1525 if {$current_diff_path eq {}} { select_first_diff $after }
1528 proc prune_selection {} {
1529 global file_states selected_paths
1531 foreach path [array names selected_paths] {
1532 if {[catch {set still_here $file_states($path)}]} {
1533 unset selected_paths($path)
1538 ######################################################################
1542 proc mapicon {w state path} {
1545 if {[catch {set r $all_icons($state$w)}]} {
1546 puts "error
: no icon
for $w state
={$state} $path"
1552 proc mapdesc {state path} {
1555 if {[catch {set r $all_descs($state)}]} {
1556 puts "error
: no desc
for state
={$state} $path"
1562 proc ui_status {msg} {
1564 if {[info exists main_status]} {
1565 $main_status show $msg
1569 proc ui_ready {{test {}}} {
1571 if {[info exists main_status]} {
1572 $main_status show [mc "Ready.
"] $test
1576 proc escape_path {path} {
1577 regsub -all {\\} $path "\\\\" path
1578 regsub -all "\n" $path "\\n
" path
1582 proc short_path {path} {
1583 return [escape_path [lindex [file split $path] end]]
1587 set null_sha1 [string repeat 0 40]
1589 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1590 global file_states next_icon_id null_sha1
1592 set s0 [string index $new_state 0]
1593 set s1 [string index $new_state 1]
1595 if {[catch {set info $file_states($path)}]} {
1597 set icon n[incr next_icon_id]
1599 set state [lindex $info 0]
1600 set icon [lindex $info 1]
1601 if {$head_info eq {}} {set head_info [lindex $info 2]}
1602 if {$index_info eq {}} {set index_info [lindex $info 3]}
1605 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1606 elseif {$s0 eq {_}} {set s0 _}
1608 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1609 elseif {$s1 eq {_}} {set s1 _}
1611 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1612 set head_info [list 0 $null_sha1]
1613 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1614 && $head_info eq {}} {
1615 set head_info $index_info
1616 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1617 set index_info $head_info
1621 set file_states($path) [list $s0$s1 $icon \
1622 $head_info $index_info \
1627 proc display_file_helper {w path icon_name old_m new_m} {
1630 if {$new_m eq {_}} {
1631 set lno [lsearch -sorted -exact $file_lists($w) $path]
1633 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1635 $w conf -state normal
1636 $w delete $lno.0 [expr {$lno + 1}].0
1637 $w conf -state disabled
1639 } elseif {$old_m eq {_} && $new_m ne {_}} {
1640 lappend file_lists($w) $path
1641 set file_lists($w) [lsort -unique $file_lists($w)]
1642 set lno [lsearch -sorted -exact $file_lists($w) $path]
1644 $w conf -state normal
1645 $w image create $lno.0 \
1646 -align center -padx 5 -pady 1 \
1648 -image [mapicon $w $new_m $path]
1649 $w insert $lno.1 "[escape_path
$path]\n"
1650 $w conf -state disabled
1651 } elseif {$old_m ne $new_m} {
1652 $w conf -state normal
1653 $w image conf $icon_name -image [mapicon $w $new_m $path]
1654 $w conf -state disabled
1658 proc display_file {path state} {
1659 global file_states selected_paths
1660 global ui_index ui_workdir
1662 set old_m [merge_state $path $state]
1663 set s $file_states($path)
1664 set new_m [lindex $s 0]
1665 set icon_name [lindex $s 1]
1667 set o [string index $old_m 0]
1668 set n [string index $new_m 0]
1675 display_file_helper $ui_index $path $icon_name $o $n
1677 if {[string index $old_m 0] eq {U}} {
1680 set o [string index $old_m 1]
1682 if {[string index $new_m 0] eq {U}} {
1685 set n [string index $new_m 1]
1687 display_file_helper $ui_workdir $path $icon_name $o $n
1689 if {$new_m eq {__}} {
1690 unset file_states($path)
1691 catch {unset selected_paths($path)}
1695 proc display_all_files_helper {w path icon_name m} {
1698 lappend file_lists($w) $path
1699 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1700 $w image create end \
1701 -align center -padx 5 -pady 1 \
1703 -image [mapicon $w $m $path]
1704 $w insert end "[escape_path
$path]\n"
1708 proc display_all_files {} {
1709 global ui_index ui_workdir
1710 global file_states file_lists
1712 global files_warning
1714 $ui_index conf -state normal
1715 $ui_workdir conf -state normal
1717 $ui_index delete 0.0 end
1718 $ui_workdir delete 0.0 end
1721 set file_lists($ui_index) [list]
1722 set file_lists($ui_workdir) [list]
1724 set to_display [lsort [array names file_states]]
1725 set display_limit [get_config gui.maxfilesdisplayed]
1726 if {[llength $to_display] > $display_limit} {
1727 if {!$files_warning} {
1728 # do not repeatedly warn:
1730 info_popup [mc "Displaying only
%s of
%s files.
" \
1731 $display_limit [llength $to_display]]
1733 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1735 foreach path $to_display {
1736 set s $file_states($path)
1738 set icon_name [lindex $s 1]
1740 set s [string index $m 0]
1741 if {$s ne {U} && $s ne {_}} {
1742 display_all_files_helper $ui_index $path \
1746 if {[string index $m 0] eq {U}} {
1749 set s [string index $m 1]
1752 display_all_files_helper $ui_workdir $path \
1757 $ui_index conf -state disabled
1758 $ui_workdir conf -state disabled
1761 ######################################################################
1766 #define mask_width 14
1767 #define mask_height 15
1768 static unsigned char mask_bits[] = {
1769 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1770 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1771 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1774 image create bitmap file_plain -background white -foreground black -data {
1775 #define plain_width 14
1776 #define plain_height 15
1777 static unsigned char plain_bits[] = {
1778 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1779 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1780 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1781 } -maskdata $filemask
1783 image create bitmap file_mod -background white -foreground blue -data {
1784 #define mod_width 14
1785 #define mod_height 15
1786 static unsigned char mod_bits[] = {
1787 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1788 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1789 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1790 } -maskdata $filemask
1792 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1793 #define file_fulltick_width 14
1794 #define file_fulltick_height 15
1795 static unsigned char file_fulltick_bits
[] = {
1796 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1797 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1798 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1799 } -maskdata $filemask
1801 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1802 #define parttick_width 14
1803 #define parttick_height 15
1804 static unsigned char parttick_bits
[] = {
1805 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1806 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1807 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1808 } -maskdata $filemask
1810 image create bitmap file_question
-background white
-foreground black
-data {
1811 #define file_question_width 14
1812 #define file_question_height 15
1813 static unsigned char file_question_bits
[] = {
1814 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1815 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1816 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1817 } -maskdata $filemask
1819 image create bitmap file_removed
-background white
-foreground red
-data {
1820 #define file_removed_width 14
1821 #define file_removed_height 15
1822 static unsigned char file_removed_bits
[] = {
1823 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1824 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1825 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1826 } -maskdata $filemask
1828 image create bitmap file_merge
-background white
-foreground blue
-data {
1829 #define file_merge_width 14
1830 #define file_merge_height 15
1831 static unsigned char file_merge_bits
[] = {
1832 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1833 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1834 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1835 } -maskdata $filemask
1837 image create bitmap file_statechange
-background white
-foreground green
-data {
1838 #define file_merge_width 14
1839 #define file_merge_height 15
1840 static unsigned char file_statechange_bits
[] = {
1841 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1842 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1843 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1844 } -maskdata $filemask
1846 set ui_index .vpane.files.index.list
1847 set ui_workdir .vpane.files.workdir.list
1849 set all_icons
(_
$ui_index) file_plain
1850 set all_icons
(A
$ui_index) file_fulltick
1851 set all_icons
(M
$ui_index) file_fulltick
1852 set all_icons
(D
$ui_index) file_removed
1853 set all_icons
(U
$ui_index) file_merge
1854 set all_icons
(T
$ui_index) file_statechange
1856 set all_icons
(_
$ui_workdir) file_plain
1857 set all_icons
(M
$ui_workdir) file_mod
1858 set all_icons
(D
$ui_workdir) file_question
1859 set all_icons
(U
$ui_workdir) file_merge
1860 set all_icons
(O
$ui_workdir) file_plain
1861 set all_icons
(T
$ui_workdir) file_statechange
1863 set max_status_desc
0
1865 {__
{mc
"Unmodified"}}
1867 {_M
{mc
"Modified, not staged"}}
1868 {M_
{mc
"Staged for commit"}}
1869 {MM
{mc
"Portions staged for commit"}}
1870 {MD
{mc
"Staged for commit, missing"}}
1872 {_T
{mc
"File type changed, not staged"}}
1873 {T_
{mc
"File type changed, staged"}}
1875 {_O
{mc
"Untracked, not staged"}}
1876 {A_
{mc
"Staged for commit"}}
1877 {AM
{mc
"Portions staged for commit"}}
1878 {AD
{mc
"Staged for commit, missing"}}
1881 {D_
{mc
"Staged for removal"}}
1882 {DO
{mc
"Staged for removal, still present"}}
1884 {_U
{mc
"Requires merge resolution"}}
1885 {U_
{mc
"Requires merge resolution"}}
1886 {UU
{mc
"Requires merge resolution"}}
1887 {UM
{mc
"Requires merge resolution"}}
1888 {UD
{mc
"Requires merge resolution"}}
1889 {UT
{mc
"Requires merge resolution"}}
1891 set text
[eval [lindex
$i 1]]
1892 if {$max_status_desc < [string length
$text]} {
1893 set max_status_desc
[string length
$text]
1895 set all_descs
([lindex
$i 0]) $text
1899 ######################################################################
1903 proc scrollbar2many
{list mode args
} {
1904 foreach w
$list {eval $w $mode $args}
1907 proc many2scrollbar
{list mode sb top bottom
} {
1908 $sb set $top $bottom
1909 foreach w
$list {$w $mode moveto
$top}
1912 proc incr_font_size
{font
{amt
1}} {
1913 set sz
[font configure
$font -size]
1915 font configure
$font -size $sz
1916 font configure
${font}bold
-size $sz
1917 font configure
${font}italic
-size $sz
1920 ######################################################################
1924 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1926 proc do_gitk
{revs
} {
1927 # -- Always start gitk through whatever we were loaded with. This
1928 # lets us bypass using shell process on Windows systems.
1930 set exe
[_which gitk
-script]
1931 set cmd
[list
[info nameofexecutable
] $exe]
1933 error_popup
[mc
"Couldn't find gitk in PATH"]
1937 if {[info exists env
(GIT_DIR
)]} {
1938 set old_GIT_DIR
$env(GIT_DIR
)
1944 cd [file dirname [gitdir
]]
1945 set env
(GIT_DIR
) [file tail [gitdir
]]
1947 eval exec $cmd $revs "--" "--" &
1949 if {$old_GIT_DIR eq
{}} {
1952 set env
(GIT_DIR
) $old_GIT_DIR
1956 ui_status $
::starting_gitk_msg
1958 ui_ready
$starting_gitk_msg
1963 proc do_explore
{} {
1965 if {[is_Cygwin
] ||
[is_Windows
]} {
1966 set explorer
"explorer.exe"
1967 } elseif
{[is_MacOSX
]} {
1970 # freedesktop.org-conforming system is our best shot
1971 set explorer
"xdg-open"
1973 eval exec $explorer [list
[file nativename
[file dirname [gitdir
]]]] &
1979 proc terminate_me
{win
} {
1981 if {$win ne
{.
}} return
1985 proc do_quit
{{rc
{1}}} {
1986 global ui_comm is_quitting repo_config commit_type
1987 global GITGUI_BCK_exists GITGUI_BCK_i
1988 global ui_comm_spell
1991 if {$is_quitting} return
1994 if {[winfo exists
$ui_comm]} {
1995 # -- Stash our current commit buffer.
1997 set save
[gitdir GITGUI_MSG
]
1998 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1999 file rename
-force [gitdir GITGUI_BCK
] $save
2000 set GITGUI_BCK_exists
0
2002 set msg
[string trim
[$ui_comm get
0.0 end
]]
2003 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2004 if {(![string match amend
* $commit_type]
2005 ||
[$ui_comm edit modified
])
2008 set fd
[open
$save w
]
2009 puts
-nonewline $fd $msg
2013 catch
{file delete
$save}
2017 # -- Cancel our spellchecker if its running.
2019 if {[info exists ui_comm_spell
]} {
2023 # -- Remove our editor backup, its not needed.
2025 after cancel
$GITGUI_BCK_i
2026 if {$GITGUI_BCK_exists} {
2027 catch
{file delete
[gitdir GITGUI_BCK
]}
2030 # -- Stash our current window geometry into this repository.
2032 set cfg_wmstate
[wm state .
]
2033 if {[catch
{set rc_wmstate
$repo_config(gui.wmstate
)}]} {
2036 if {$cfg_wmstate ne
$rc_wmstate} {
2037 catch
{git config gui.wmstate
$cfg_wmstate}
2039 if {$cfg_wmstate eq
{zoomed
}} {
2040 # on Windows wm geometry will lie about window
2041 # position (but not size) when window is zoomed
2042 # restore the window before querying wm geometry
2045 set cfg_geometry
[list
]
2046 lappend cfg_geometry
[wm geometry .
]
2047 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
2048 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
2049 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2052 if {$cfg_geometry ne
$rc_geometry} {
2053 catch
{git config gui.geometry
$cfg_geometry}
2059 # Briefly enable send again, working around Tk bug
2060 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2061 tk appname
[appname
]
2070 proc ui_do_rescan
{} {
2071 rescan
{force_first_diff ui_ready
}
2078 proc next_diff
{{after
{}}} {
2079 global next_diff_p next_diff_w next_diff_i
2080 show_diff
$next_diff_p $next_diff_w {} {} $after
2083 proc find_anchor_pos
{lst name
} {
2084 set lid
[lsearch
-sorted -exact $lst $name]
2088 foreach lname
$lst {
2089 if {$lname >= $name} break
2097 proc find_file_from
{flist idx delta path mmask
} {
2100 set len
[llength
$flist]
2101 while {$idx >= 0 && $idx < $len} {
2102 set name
[lindex
$flist $idx]
2104 if {$name ne
$path && [info exists file_states
($name)]} {
2105 set state
[lindex
$file_states($name) 0]
2107 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2118 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2119 global next_diff_p next_diff_w next_diff_i
2120 global file_lists ui_index ui_workdir
2122 set flist
$file_lists($w)
2124 set lno
[find_anchor_pos
$flist $path]
2129 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2130 if {$w eq
$ui_index} {
2133 set mmask
"$mmask\$"
2137 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2140 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2145 set next_diff_p
[lindex
$flist $idx]
2146 set next_diff_i
[expr {$idx+1}]
2153 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2154 global current_diff_path
2156 if {$path ne
$current_diff_path} {
2158 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2161 return {reshow_diff
;}
2165 proc select_first_diff
{after
} {
2168 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2169 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2176 proc force_first_diff
{after
} {
2177 global ui_workdir current_diff_path file_states
2179 if {[info exists file_states
($current_diff_path)]} {
2180 set state
[lindex
$file_states($current_diff_path) 0]
2186 if {[string first
{U
} $state] >= 0} {
2187 # Already a conflict, do nothing
2188 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {^_?U
}]} {
2190 } elseif
{[string index
$state 1] ne
{O
}} {
2191 # Already a diff & no conflicts, do nothing
2192 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {[^O
]$
}]} {
2203 proc toggle_or_diff
{w x y
} {
2204 global file_states file_lists current_diff_path ui_index ui_workdir
2205 global last_clicked selected_paths
2207 set pos
[split [$w index @
$x,$y] .
]
2208 set lno
[lindex
$pos 0]
2209 set col [lindex
$pos 1]
2210 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2216 set last_clicked
[list
$w $lno]
2217 array
unset selected_paths
2218 $ui_index tag remove in_sel
0.0 end
2219 $ui_workdir tag remove in_sel
0.0 end
2221 # Determine the state of the file
2222 if {[info exists file_states
($path)]} {
2223 set state
[lindex
$file_states($path) 0]
2228 # Restage the file, or simply show the diff
2229 if {$col == 0 && $y > 1} {
2230 # Conflicts need special handling
2231 if {[string first
{U
} $state] >= 0} {
2232 # $w must always be $ui_workdir, but...
2233 if {$w ne
$ui_workdir} { set lno
{} }
2234 merge_stage_workdir
$path $lno
2238 if {[string index
$state 1] eq
{O
}} {
2244 set after
[next_diff_after_action
$w $path $lno $mmask]
2246 if {$w eq
$ui_index} {
2248 "Unstaging [short_path $path] from commit" \
2250 [concat
$after [list ui_ready
]]
2251 } elseif
{$w eq
$ui_workdir} {
2253 "Adding [short_path $path]" \
2255 [concat
$after [list ui_ready
]]
2258 show_diff
$path $w $lno
2262 proc add_one_to_selection
{w x y
} {
2263 global file_lists last_clicked selected_paths
2265 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2266 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2272 if {$last_clicked ne
{}
2273 && [lindex
$last_clicked 0] ne
$w} {
2274 array
unset selected_paths
2275 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2278 set last_clicked
[list
$w $lno]
2279 if {[catch
{set in_sel
$selected_paths($path)}]} {
2283 unset selected_paths
($path)
2284 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2286 set selected_paths
($path) 1
2287 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2291 proc add_range_to_selection
{w x y
} {
2292 global file_lists last_clicked selected_paths
2294 if {[lindex
$last_clicked 0] ne
$w} {
2295 toggle_or_diff
$w $x $y
2299 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2300 set lc
[lindex
$last_clicked 1]
2309 foreach path
[lrange
$file_lists($w) \
2310 [expr {$begin - 1}] \
2311 [expr {$end - 1}]] {
2312 set selected_paths
($path) 1
2314 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2317 proc show_more_context
{} {
2319 if {$repo_config(gui.diffcontext
) < 99} {
2320 incr repo_config
(gui.diffcontext
)
2325 proc show_less_context
{} {
2327 if {$repo_config(gui.diffcontext
) > 1} {
2328 incr repo_config
(gui.diffcontext
) -1
2333 ######################################################################
2343 menu .mbar
-tearoff 0
2345 # -- Apple Menu (Mac OS X only)
2347 .mbar add cascade
-label Apple
-menu .mbar.apple
2350 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2351 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2352 if {[is_enabled branch
]} {
2353 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2355 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2356 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2358 if {[is_enabled transport
]} {
2359 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2360 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2362 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2363 .mbar add cascade
-label [mc Tools
] -menu .mbar.tools
2366 # -- Repository Menu
2368 menu .mbar.repository
2370 .mbar.repository add
command \
2371 -label [mc
"Explore Working Copy"] \
2372 -command {do_explore
}
2373 .mbar.repository add separator
2375 .mbar.repository add
command \
2376 -label [mc
"Browse Current Branch's Files"] \
2377 -command {browser
::new
$current_branch}
2378 set ui_browse_current
[.mbar.repository index last
]
2379 .mbar.repository add
command \
2380 -label [mc
"Browse Branch Files..."] \
2381 -command browser_open
::dialog
2382 .mbar.repository add separator
2384 .mbar.repository add
command \
2385 -label [mc
"Visualize Current Branch's History"] \
2386 -command {do_gitk
$current_branch}
2387 set ui_visualize_current
[.mbar.repository index last
]
2388 .mbar.repository add
command \
2389 -label [mc
"Visualize All Branch History"] \
2390 -command {do_gitk
--all}
2391 .mbar.repository add separator
2393 proc current_branch_write
{args
} {
2394 global current_branch
2395 .mbar.repository entryconf $
::ui_browse_current \
2396 -label [mc
"Browse %s's Files" $current_branch]
2397 .mbar.repository entryconf $
::ui_visualize_current \
2398 -label [mc
"Visualize %s's History" $current_branch]
2400 trace add variable current_branch
write current_branch_write
2402 if {[is_enabled multicommit
]} {
2403 .mbar.repository add
command -label [mc
"Database Statistics"] \
2406 .mbar.repository add
command -label [mc
"Compress Database"] \
2409 .mbar.repository add
command -label [mc
"Verify Database"] \
2410 -command do_fsck_objects
2412 .mbar.repository add separator
2415 .mbar.repository add
command \
2416 -label [mc
"Create Desktop Icon"] \
2417 -command do_cygwin_shortcut
2418 } elseif
{[is_Windows
]} {
2419 .mbar.repository add
command \
2420 -label [mc
"Create Desktop Icon"] \
2421 -command do_windows_shortcut
2422 } elseif
{[is_MacOSX
]} {
2423 .mbar.repository add
command \
2424 -label [mc
"Create Desktop Icon"] \
2425 -command do_macosx_app
2430 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2432 .mbar.repository add
command -label [mc Quit
] \
2440 .mbar.edit add
command -label [mc Undo
] \
2441 -command {catch
{[focus
] edit undo
}} \
2443 .mbar.edit add
command -label [mc Redo
] \
2444 -command {catch
{[focus
] edit redo
}} \
2446 .mbar.edit add separator
2447 .mbar.edit add
command -label [mc Cut
] \
2448 -command {catch
{tk_textCut
[focus
]}} \
2450 .mbar.edit add
command -label [mc Copy
] \
2451 -command {catch
{tk_textCopy
[focus
]}} \
2453 .mbar.edit add
command -label [mc Paste
] \
2454 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2456 .mbar.edit add
command -label [mc Delete
] \
2457 -command {catch
{[focus
] delete sel.first sel.last
}} \
2459 .mbar.edit add separator
2460 .mbar.edit add
command -label [mc
"Select All"] \
2461 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2466 if {[is_enabled branch
]} {
2469 .mbar.branch add
command -label [mc
"Create..."] \
2470 -command branch_create
::dialog \
2472 lappend disable_on_lock
[list .mbar.branch entryconf \
2473 [.mbar.branch index last
] -state]
2475 .mbar.branch add
command -label [mc
"Checkout..."] \
2476 -command branch_checkout
::dialog \
2478 lappend disable_on_lock
[list .mbar.branch entryconf \
2479 [.mbar.branch index last
] -state]
2481 .mbar.branch add
command -label [mc
"Rename..."] \
2482 -command branch_rename
::dialog
2483 lappend disable_on_lock
[list .mbar.branch entryconf \
2484 [.mbar.branch index last
] -state]
2486 .mbar.branch add
command -label [mc
"Delete..."] \
2487 -command branch_delete
::dialog
2488 lappend disable_on_lock
[list .mbar.branch entryconf \
2489 [.mbar.branch index last
] -state]
2491 .mbar.branch add
command -label [mc
"Reset..."] \
2492 -command merge
::reset_hard
2493 lappend disable_on_lock
[list .mbar.branch entryconf \
2494 [.mbar.branch index last
] -state]
2499 proc commit_btn_caption
{} {
2500 if {[is_enabled nocommit
]} {
2503 return [mc Commit@@verb
]
2507 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2510 if {![is_enabled nocommit
]} {
2511 .mbar.commit add radiobutton \
2512 -label [mc
"New Commit"] \
2513 -command do_select_commit_type \
2514 -variable selected_commit_type \
2516 lappend disable_on_lock \
2517 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2519 .mbar.commit add radiobutton \
2520 -label [mc
"Amend Last Commit"] \
2521 -command do_select_commit_type \
2522 -variable selected_commit_type \
2524 lappend disable_on_lock \
2525 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2527 .mbar.commit add separator
2530 .mbar.commit add
command -label [mc Rescan
] \
2531 -command ui_do_rescan \
2533 lappend disable_on_lock \
2534 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2536 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2537 -command do_add_selection \
2539 lappend disable_on_lock \
2540 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2542 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2543 -command do_add_all \
2545 lappend disable_on_lock \
2546 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2548 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2549 -command do_unstage_selection \
2551 lappend disable_on_lock \
2552 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2554 .mbar.commit add
command -label [mc
"Revert Changes"] \
2555 -command do_revert_selection \
2557 lappend disable_on_lock \
2558 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2560 .mbar.commit add separator
2562 .mbar.commit add
command -label [mc
"Show Less Context"] \
2563 -command show_less_context \
2564 -accelerator $M1T-\
-
2566 .mbar.commit add
command -label [mc
"Show More Context"] \
2567 -command show_more_context \
2570 .mbar.commit add separator
2572 if {![is_enabled nocommitmsg
]} {
2573 .mbar.commit add
command -label [mc
"Sign Off"] \
2574 -command do_signoff \
2578 .mbar.commit add
command -label [commit_btn_caption
] \
2579 -command do_commit \
2580 -accelerator $M1T-Return
2581 lappend disable_on_lock \
2582 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2587 if {[is_enabled branch
]} {
2589 .mbar.merge add
command -label [mc
"Local Merge..."] \
2590 -command merge
::dialog \
2592 lappend disable_on_lock \
2593 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2594 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2595 -command merge
::reset_hard
2596 lappend disable_on_lock \
2597 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2602 if {[is_enabled transport
]} {
2605 .mbar.remote add
command \
2606 -label [mc
"Add..."] \
2607 -command remote_add
::dialog \
2609 .mbar.remote add
command \
2610 -label [mc
"Push..."] \
2611 -command do_push_anywhere \
2613 .mbar.remote add
command \
2614 -label [mc
"Delete Branch..."] \
2615 -command remote_branch_delete
::dialog
2619 proc
::tk
::mac
::ShowPreferences
{} {do_options
}
2623 .mbar.edit add separator
2624 .mbar.edit add
command -label [mc
"Options..."] \
2630 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2631 set tools_menubar .mbar.tools
2633 $tools_menubar add separator
2634 $tools_menubar add
command -label [mc
"Add..."] -command tools_add
::dialog
2635 $tools_menubar add
command -label [mc
"Remove..."] -command tools_remove
::dialog
2637 if {[array names repo_config guitool.
*.cmd
] ne
{}} {
2644 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2648 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2650 .mbar.apple add separator
2652 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2655 . configure
-menu .mbar
2657 set doc_path
[githtmldir
]
2658 if {$doc_path ne
{}} {
2659 set doc_path
[file join $doc_path index.html
]
2662 set doc_path
[exec cygpath
--mixed $doc_path]
2666 if {[file isfile
$doc_path]} {
2667 set doc_url
"file:$doc_path"
2669 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2672 proc start_browser
{url
} {
2673 git
"web--browse" $url
2676 .mbar.
help add
command -label [mc
"Online Documentation"] \
2677 -command [list start_browser
$doc_url]
2679 .mbar.
help add
command -label [mc
"Show SSH Key"] \
2682 unset doc_path doc_url
2684 # -- Standard bindings
2686 wm protocol . WM_DELETE_WINDOW do_quit
2687 bind all
<$M1B-Key-q> do_quit
2688 bind all
<$M1B-Key-Q> do_quit
2689 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2690 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2692 set subcommand_args
{}
2694 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2698 proc normalize_relpath
{path
} {
2700 foreach item
[file split $path] {
2701 if {$item eq
{.
}} continue
2702 if {$item eq
{..
} && [llength
$elements] > 0
2703 && [lindex
$elements end
] ne
{..
}} {
2704 set elements
[lrange
$elements 0 end-1
]
2707 lappend elements
$item
2709 return [eval file join $elements]
2712 # -- Not a normal commit type invocation? Do that instead!
2714 switch
-- $subcommand {
2717 if {$subcommand eq
"blame"} {
2718 set subcommand_args
{[--line=<num
>] rev? path
}
2720 set subcommand_args
{rev? path
}
2722 if {$argv eq
{}} usage
2728 if {$is_path ||
[file exists
$_prefix$a]} {
2729 if {$path ne
{}} usage
2730 set path
[normalize_relpath
$_prefix$a]
2732 } elseif
{$a eq
{--}} {
2734 if {$head ne
{}} usage
2739 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
2740 if {$jump_spec ne
{} ||
$head ne
{}} usage
2741 set jump_spec
[list
$lnum]
2742 } elseif
{$head eq
{}} {
2743 if {$head ne
{}} usage
2752 if {$head ne
{} && $path eq
{}} {
2753 set path
[normalize_relpath
$_prefix$head]
2760 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2762 set head [git rev-parse
--verify $head]
2768 set current_branch
$head
2771 switch
-- $subcommand {
2773 if {$jump_spec ne
{}} usage
2775 if {$path ne
{} && [file isdirectory
$path]} {
2776 set head $current_branch
2782 browser
::new
$head $path
2785 if {$head eq
{} && ![file exists
$path]} {
2786 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2789 blame
::new
$head $path $jump_spec
2796 if {[llength
$argv] != 0} {
2797 puts
-nonewline stderr
"usage: $argv0"
2798 if {$subcommand ne
{gui
}
2799 && [file tail $argv0] ne
"git-$subcommand"} {
2800 puts
-nonewline stderr
" $subcommand"
2805 # fall through to setup UI for commits
2808 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2819 -text [mc
"Current Branch:"] \
2823 -textvariable current_branch \
2826 pack .branch.l1
-side left
2827 pack .branch.cb
-side left
-fill x
2828 pack .branch
-side top
-fill x
2830 # -- Main Window Layout
2832 panedwindow .vpane
-orient horizontal
2833 panedwindow .vpane.files
-orient vertical
2834 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2835 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2837 # -- Index File List
2839 frame .vpane.files.index
-height 100 -width 200
2840 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Commit)"] \
2841 -background lightgreen
-foreground black
2842 text
$ui_index -background white
-foreground black \
2844 -width 20 -height 10 \
2846 -cursor $cursor_ptr \
2847 -xscrollcommand {.vpane.files.index.sx
set} \
2848 -yscrollcommand {.vpane.files.index.sy
set} \
2850 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2851 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2852 pack .vpane.files.index.title
-side top
-fill x
2853 pack .vpane.files.index.sx
-side bottom
-fill x
2854 pack .vpane.files.index.sy
-side right
-fill y
2855 pack
$ui_index -side left
-fill both
-expand 1
2857 # -- Working Directory File List
2859 frame .vpane.files.workdir
-height 100 -width 200
2860 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
2861 -background lightsalmon
-foreground black
2862 text
$ui_workdir -background white
-foreground black \
2864 -width 20 -height 10 \
2866 -cursor $cursor_ptr \
2867 -xscrollcommand {.vpane.files.workdir.sx
set} \
2868 -yscrollcommand {.vpane.files.workdir.sy
set} \
2870 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2871 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2872 pack .vpane.files.workdir.title
-side top
-fill x
2873 pack .vpane.files.workdir.sx
-side bottom
-fill x
2874 pack .vpane.files.workdir.sy
-side right
-fill y
2875 pack
$ui_workdir -side left
-fill both
-expand 1
2877 .vpane.files add .vpane.files.workdir
-sticky nsew
2878 .vpane.files add .vpane.files.index
-sticky nsew
2880 foreach i
[list
$ui_index $ui_workdir] {
2882 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2886 # -- Diff and Commit Area
2888 frame .vpane.lower
-height 300 -width 400
2889 frame .vpane.lower.commarea
2890 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2891 pack .vpane.lower.
diff -fill both
-expand 1
2892 pack .vpane.lower.commarea
-side bottom
-fill x
2893 .vpane add .vpane.lower
-sticky nsew
2895 # -- Commit Area Buttons
2897 frame .vpane.lower.commarea.buttons
2898 label .vpane.lower.commarea.buttons.l
-text {} \
2901 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2902 pack .vpane.lower.commarea.buttons
-side left
-fill y
2904 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2905 -command ui_do_rescan
2906 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2907 lappend disable_on_lock \
2908 {.vpane.lower.commarea.buttons.rescan conf
-state}
2910 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2912 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2913 lappend disable_on_lock \
2914 {.vpane.lower.commarea.buttons.incall conf
-state}
2916 if {![is_enabled nocommitmsg
]} {
2917 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2919 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2922 button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
2924 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2925 lappend disable_on_lock \
2926 {.vpane.lower.commarea.buttons.commit conf
-state}
2928 if {![is_enabled nocommit
]} {
2929 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2930 -command do_push_anywhere
2931 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2934 # -- Commit Message Buffer
2936 frame .vpane.lower.commarea.buffer
2937 frame .vpane.lower.commarea.buffer.header
2938 set ui_comm .vpane.lower.commarea.buffer.t
2939 set ui_coml .vpane.lower.commarea.buffer.header.l
2941 if {![is_enabled nocommit
]} {
2942 radiobutton .vpane.lower.commarea.buffer.header.new \
2943 -text [mc
"New Commit"] \
2944 -command do_select_commit_type \
2945 -variable selected_commit_type \
2947 lappend disable_on_lock \
2948 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2949 radiobutton .vpane.lower.commarea.buffer.header.amend \
2950 -text [mc
"Amend Last Commit"] \
2951 -command do_select_commit_type \
2952 -variable selected_commit_type \
2954 lappend disable_on_lock \
2955 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2961 proc trace_commit_type
{varname args
} {
2962 global ui_coml commit_type
2963 switch
-glob -- $commit_type {
2964 initial
{set txt
[mc
"Initial Commit Message:"]}
2965 amend
{set txt
[mc
"Amended Commit Message:"]}
2966 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2967 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2968 merge
{set txt
[mc
"Merge Commit Message:"]}
2969 * {set txt
[mc
"Commit Message:"]}
2971 $ui_coml conf
-text $txt
2973 trace add variable commit_type
write trace_commit_type
2974 pack
$ui_coml -side left
-fill x
2976 if {![is_enabled nocommit
]} {
2977 pack .vpane.lower.commarea.buffer.header.amend
-side right
2978 pack .vpane.lower.commarea.buffer.header.new
-side right
2981 text
$ui_comm -background white
-foreground black \
2985 -autoseparators true \
2987 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
2989 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2990 scrollbar .vpane.lower.commarea.buffer.sby \
2991 -command [list
$ui_comm yview
]
2992 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2993 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2994 pack
$ui_comm -side left
-fill y
2995 pack .vpane.lower.commarea.buffer
-side left
-fill y
2997 # -- Commit Message Buffer Context Menu
2999 set ctxm .vpane.lower.commarea.buffer.ctxm
3000 menu
$ctxm -tearoff 0
3003 -command {tk_textCut
$ui_comm}
3006 -command {tk_textCopy
$ui_comm}
3009 -command {tk_textPaste
$ui_comm}
3011 -label [mc Delete
] \
3012 -command {catch
{$ui_comm delete sel.first sel.last
}}
3015 -label [mc
"Select All"] \
3016 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
3018 -label [mc
"Copy All"] \
3020 $ui_comm tag add sel
0.0 end
3021 tk_textCopy
$ui_comm
3022 $ui_comm tag remove sel
0.0 end
3026 -label [mc
"Sign Off"] \
3028 set ui_comm_ctxm
$ctxm
3032 proc trace_current_diff_path
{varname args
} {
3033 global current_diff_path diff_actions file_states
3034 if {$current_diff_path eq
{}} {
3040 set p
$current_diff_path
3041 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
3043 set p
[escape_path
$p]
3047 .vpane.lower.
diff.header.status configure
-text $s
3048 .vpane.lower.
diff.header.
file configure
-text $f
3049 .vpane.lower.
diff.header.path configure
-text $p
3050 foreach w
$diff_actions {
3054 trace add variable current_diff_path
write trace_current_diff_path
3056 frame .vpane.lower.
diff.header
-background gold
3057 label .vpane.lower.
diff.header.status \
3060 -width $max_status_desc \
3063 label .vpane.lower.
diff.header.
file \
3068 label .vpane.lower.
diff.header.path \
3073 pack .vpane.lower.
diff.header.status
-side left
3074 pack .vpane.lower.
diff.header.
file -side left
3075 pack .vpane.lower.
diff.header.path
-fill x
3076 set ctxm .vpane.lower.
diff.header.ctxm
3077 menu
$ctxm -tearoff 0
3085 -- $current_diff_path
3087 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3088 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
3092 frame .vpane.lower.
diff.body
3093 set ui_diff .vpane.lower.
diff.body.t
3094 text
$ui_diff -background white
-foreground black \
3096 -width 80 -height 5 -wrap none \
3098 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
3099 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
3101 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
3102 -command [list
$ui_diff xview
]
3103 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
3104 -command [list
$ui_diff yview
]
3105 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
3106 pack .vpane.lower.
diff.body.sby
-side right
-fill y
3107 pack
$ui_diff -side left
-fill both
-expand 1
3108 pack .vpane.lower.
diff.header
-side top
-fill x
3109 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
3111 $ui_diff tag conf d_cr
-elide true
3112 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
3113 $ui_diff tag conf d_
+ -foreground {#00a000}
3114 $ui_diff tag conf d_-
-foreground red
3116 $ui_diff tag conf d_
++ -foreground {#00a000}
3117 $ui_diff tag conf d_--
-foreground red
3118 $ui_diff tag conf d_
+s \
3119 -foreground {#00a000} \
3120 -background {#e2effa}
3121 $ui_diff tag conf d_-s \
3123 -background {#e2effa}
3124 $ui_diff tag conf d_s
+ \
3125 -foreground {#00a000} \
3127 $ui_diff tag conf d_s- \
3131 $ui_diff tag conf d
<<<<<<< \
3132 -foreground orange \
3134 $ui_diff tag conf d
======= \
3135 -foreground orange \
3137 $ui_diff tag conf d
>>>>>>> \
3138 -foreground orange \
3141 $ui_diff tag raise sel
3143 # -- Diff Body Context Menu
3146 proc create_common_diff_popup
{ctxm
} {
3148 -label [mc
"Show Less Context"] \
3149 -command show_less_context
3150 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3152 -label [mc
"Show More Context"] \
3153 -command show_more_context
3154 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3157 -label [mc Refresh
] \
3158 -command reshow_diff
3159 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3162 -command {tk_textCopy
$ui_diff}
3163 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3165 -label [mc
"Select All"] \
3166 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3167 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3169 -label [mc
"Copy All"] \
3171 $ui_diff tag add sel
0.0 end
3172 tk_textCopy
$ui_diff
3173 $ui_diff tag remove sel
0.0 end
3175 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3178 -label [mc
"Decrease Font Size"] \
3179 -command {incr_font_size font_diff
-1}
3180 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3182 -label [mc
"Increase Font Size"] \
3183 -command {incr_font_size font_diff
1}
3184 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3188 build_encoding_menu
$emenu [list force_diff_encoding
]
3190 -label [mc
"Encoding"] \
3192 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3194 $ctxm add
command -label [mc
"Options..."] \
3198 set ctxm .vpane.lower.
diff.body.ctxm
3199 menu
$ctxm -tearoff 0
3201 -label [mc
"Apply/Reverse Hunk"] \
3202 -command {apply_hunk
$cursorX $cursorY}
3203 set ui_diff_applyhunk
[$ctxm index last
]
3204 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3206 -label [mc
"Apply/Reverse Line"] \
3207 -command {apply_line
$cursorX $cursorY; do_rescan
}
3208 set ui_diff_applyline
[$ctxm index last
]
3209 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3211 create_common_diff_popup
$ctxm
3213 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3214 menu
$ctxmmg -tearoff 0
3215 $ctxmmg add
command \
3216 -label [mc
"Run Merge Tool"] \
3217 -command {merge_resolve_tool
}
3218 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3219 $ctxmmg add separator
3220 $ctxmmg add
command \
3221 -label [mc
"Use Remote Version"] \
3222 -command {merge_resolve_one
3}
3223 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3224 $ctxmmg add
command \
3225 -label [mc
"Use Local Version"] \
3226 -command {merge_resolve_one
2}
3227 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3228 $ctxmmg add
command \
3229 -label [mc
"Revert To Base"] \
3230 -command {merge_resolve_one
1}
3231 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3232 $ctxmmg add separator
3233 create_common_diff_popup
$ctxmmg
3235 proc popup_diff_menu
{ctxm ctxmmg x y X Y
} {
3236 global current_diff_path file_states
3239 if {[info exists file_states
($current_diff_path)]} {
3240 set state
[lindex
$file_states($current_diff_path) 0]
3244 if {[string first
{U
} $state] >= 0} {
3245 tk_popup
$ctxmmg $X $Y
3247 if {$
::ui_index eq $
::current_diff_side
} {
3248 set l
[mc
"Unstage Hunk From Commit"]
3249 set t
[mc
"Unstage Line From Commit"]
3251 set l
[mc
"Stage Hunk For Commit"]
3252 set t
[mc
"Stage Line For Commit"]
3254 if {$
::is_3way_diff || $
::is_submodule_diff
3255 ||
$current_diff_path eq
{}
3259 ||
{T_
} eq
$state} {
3264 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3265 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3266 tk_popup
$ctxm $X $Y
3269 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg %x
%y
%X
%Y
]
3273 set main_status
[::status_bar
::new .status
]
3274 pack .status
-anchor w
-side bottom
-fill x
3275 $main_status show
[mc
"Initializing..."]
3280 set gm
$repo_config(gui.geometry
)
3281 wm geometry .
[lindex
$gm 0]
3282 .vpane sash place
0 \
3284 [lindex
[.vpane sash coord
0] 1]
3285 .vpane.files sash place
0 \
3286 [lindex
[.vpane.files sash coord
0] 0] \
3291 # -- Load window state
3294 set gws
$repo_config(gui.wmstate
)
3301 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3302 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3303 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3304 bind $ui_comm <$M1B-Key-u> {do_unstage_selection
;break}
3305 bind $ui_comm <$M1B-Key-U> {do_unstage_selection
;break}
3306 bind $ui_comm <$M1B-Key-j> {do_revert_selection
;break}
3307 bind $ui_comm <$M1B-Key-J> {do_revert_selection
;break}
3308 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3309 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3310 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3311 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3312 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3313 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3314 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3315 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3316 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3317 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3318 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3319 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3320 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3321 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3322 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3324 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3325 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3326 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3327 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3328 bind $ui_diff <$M1B-Key-v> {break}
3329 bind $ui_diff <$M1B-Key-V> {break}
3330 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3331 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3332 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3333 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3334 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3335 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3336 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3337 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3338 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3339 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3340 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3341 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3342 bind $ui_diff <Button-1
> {focus
%W
}
3344 if {[is_enabled branch
]} {
3345 bind .
<$M1B-Key-n> branch_create
::dialog
3346 bind .
<$M1B-Key-N> branch_create
::dialog
3347 bind .
<$M1B-Key-o> branch_checkout
::dialog
3348 bind .
<$M1B-Key-O> branch_checkout
::dialog
3349 bind .
<$M1B-Key-m> merge
::dialog
3350 bind .
<$M1B-Key-M> merge
::dialog
3352 if {[is_enabled transport
]} {
3353 bind .
<$M1B-Key-p> do_push_anywhere
3354 bind .
<$M1B-Key-P> do_push_anywhere
3357 bind .
<Key-F5
> ui_do_rescan
3358 bind .
<$M1B-Key-r> ui_do_rescan
3359 bind .
<$M1B-Key-R> ui_do_rescan
3360 bind .
<$M1B-Key-s> do_signoff
3361 bind .
<$M1B-Key-S> do_signoff
3362 bind .
<$M1B-Key-t> do_add_selection
3363 bind .
<$M1B-Key-T> do_add_selection
3364 bind .
<$M1B-Key-i> do_add_all
3365 bind .
<$M1B-Key-I> do_add_all
3366 bind .
<$M1B-Key-minus> {show_less_context
;break}
3367 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3368 bind .
<$M1B-Key-equal> {show_more_context
;break}
3369 bind .
<$M1B-Key-plus> {show_more_context
;break}
3370 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3371 bind .
<$M1B-Key-Return> do_commit
3372 foreach i
[list
$ui_index $ui_workdir] {
3373 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
3374 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3375 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
3379 set file_lists
($ui_index) [list
]
3380 set file_lists
($ui_workdir) [list
]
3382 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3383 focus
-force $ui_comm
3385 # -- Warn the user about environmental problems. Cygwin's Tcl
3386 # does *not* pass its env array onto any processes it spawns.
3387 # This means that git processes get none of our environment.
3392 set msg
[mc
"Possible environment issues exist.
3394 The following environment variables are probably
3395 going to be ignored by any Git subprocess run
3399 foreach name
[array names env
] {
3400 switch
-regexp -- $name {
3401 {^GIT_INDEX_FILE$
} -
3402 {^GIT_OBJECT_DIRECTORY$
} -
3403 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3405 {^GIT_EXTERNAL_DIFF$
} -
3409 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3410 append msg
" - $name\n"
3413 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3414 append msg
" - $name\n"
3416 set suggest_user
$name
3420 if {$ignored_env > 0} {
3422 This is due to a known issue with the
3423 Tcl binary distributed by Cygwin."]
3425 if {$suggest_user ne
{}} {
3428 A good replacement for %s
3429 is placing values for the user.name and
3430 user.email settings into your personal
3436 unset ignored_env msg suggest_user name
3439 # -- Only initialize complex UI if we are going to stay running.
3441 if {[is_enabled transport
]} {
3444 set n
[.mbar.remote index end
]
3445 populate_remotes_menu
3446 set n
[expr {[.mbar.remote index end
] - $n}]
3448 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3449 .mbar.remote insert
$n separator
3454 if {[winfo exists
$ui_comm]} {
3455 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
3457 # -- If both our backup and message files exist use the
3458 # newer of the two files to initialize the buffer.
3460 if {$GITGUI_BCK_exists} {
3461 set m
[gitdir GITGUI_MSG
]
3462 if {[file isfile
$m]} {
3463 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3464 catch
{file delete
[gitdir GITGUI_MSG
]}
3466 $ui_comm delete
0.0 end
3468 $ui_comm edit modified false
3469 catch
{file delete
[gitdir GITGUI_BCK
]}
3470 set GITGUI_BCK_exists
0
3476 proc backup_commit_buffer
{} {
3477 global ui_comm GITGUI_BCK_exists
3479 set m
[$ui_comm edit modified
]
3480 if {$m ||
$GITGUI_BCK_exists} {
3481 set msg
[string trim
[$ui_comm get
0.0 end
]]
3482 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3485 if {$GITGUI_BCK_exists} {
3486 catch
{file delete
[gitdir GITGUI_BCK
]}
3487 set GITGUI_BCK_exists
0
3491 set fd
[open
[gitdir GITGUI_BCK
] w
]
3492 puts
-nonewline $fd $msg
3494 set GITGUI_BCK_exists
1
3498 $ui_comm edit modified false
3501 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3504 backup_commit_buffer
3506 # -- If the user has aspell available we can drive it
3507 # in pipe mode to spellcheck the commit message.
3509 set spell_cmd
[list |
]
3510 set spell_dict
[get_config gui.spellingdictionary
]
3511 lappend spell_cmd aspell
3512 if {$spell_dict ne
{}} {
3513 lappend spell_cmd
--master=$spell_dict
3515 lappend spell_cmd
--mode=none
3516 lappend spell_cmd
--encoding=utf-8
3517 lappend spell_cmd pipe
3518 if {$spell_dict eq
{none
}
3519 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3520 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3522 set ui_comm_spell
[spellcheck
::init \
3528 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3531 lock_index begin-read
3532 if {![winfo ismapped .
]} {
3536 if {[is_enabled initialamend
]} {
3542 if {[is_enabled nocommitmsg
]} {
3543 $ui_comm configure
-state disabled
-background gray
3546 if {[is_enabled multicommit
]} {
3549 if {[is_enabled retcode
]} {
3550 bind .
<Destroy
> {+terminate_me
%W
}
3552 if {$picked && [is_config_true gui.autoexplore
]} {