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 Menu Message
667 Radiobutton Spinbox Text} {
668 option add *$class.font font_ui
672 if {[is_Windows] || [is_MacOSX]} {
673 option add *Menu.tearOff 0
684 proc bind_button3 {w cmd} {
685 bind $w <Any-Button-3> $cmd
687 # Mac OS X sends Button-2 on right click through three-button mouse,
688 # or through trackpad right-clicking (two-finger touch + click).
689 bind $w <Any-Button-2> $cmd
690 bind $w <Control-Button-1> $cmd
694 proc apply_config {} {
695 global repo_config font_descs
697 foreach option $font_descs {
698 set name [lindex $option 0]
699 set font [lindex $option 1]
702 foreach {cn cv} $repo_config(gui.$name) {
703 if {$cn eq {-weight}} {
706 font configure $font $cn $cv
709 font configure $font -weight normal
712 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
714 foreach {cn cv} [font configure $font] {
715 font configure ${font}bold $cn $cv
716 font configure ${font}italic $cn $cv
718 font configure ${font}bold -weight bold
719 font configure ${font}italic -slant italic
723 set default_config(branch.autosetupmerge) true
724 set default_config(merge.tool) {}
725 set default_config(mergetool.keepbackup) true
726 set default_config(merge.diffstat) true
727 set default_config(merge.summary) false
728 set default_config(merge.verbosity) 2
729 set default_config(user.name) {}
730 set default_config(user.email) {}
732 set default_config(gui.encoding) [encoding system]
733 set default_config(gui.matchtrackingbranch) false
734 set default_config(gui.pruneduringfetch) false
735 set default_config(gui.trustmtime) false
736 set default_config(gui.fastcopyblame) false
737 set default_config(gui.copyblamethreshold) 40
738 set default_config(gui.blamehistoryctx) 7
739 set default_config(gui.diffcontext) 5
740 set default_config(gui.commitmsgwidth) 75
741 set default_config(gui.newbranchtemplate) {}
742 set default_config(gui.spellingdictionary) {}
743 set default_config(gui.fontui) [font configure font_ui]
744 set default_config(gui.fontdiff) [font configure font_diff]
746 {fontui font_ui {mc "Main Font
"}}
747 {fontdiff font_diff {mc "Diff
/Console Font
"}}
750 ######################################################################
754 set _git [_which git]
756 catch {wm withdraw .}
760 -title [mc "git-gui
: fatal error
"] \
761 -message [mc "Cannot
find git
in PATH.
"]
765 ######################################################################
769 if {[catch {set _git_version [git --version]} err]} {
770 catch {wm withdraw .}
774 -title [mc "git-gui
: fatal error
"] \
775 -message "Cannot determine Git version
:
779 [appname
] requires Git
1.5.0 or later.
"
782 if {![regsub {^git version } $_git_version {} _git_version]} {
783 catch {wm withdraw .}
787 -title [mc "git-gui
: fatal error
"] \
788 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
792 set _real_git_version $_git_version
793 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
794 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
795 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
796 regsub {\.GIT$} $_git_version {} _git_version
797 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
799 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
800 catch {wm withdraw .}
805 -title "[appname
]: warning
" \
806 -message [mc "Git version cannot be determined.
808 %s claims it is version
'%s'.
810 %s requires
at least Git
1.5.0 or later.
812 Assume
'%s' is version
1.5.0?
813 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
814 set _git_version 1.5.0
819 unset _real_git_version
821 proc git-version {args} {
824 switch [llength $args] {
830 set op [lindex $args 0]
831 set vr [lindex $args 1]
832 set cm [package vcompare $_git_version $vr]
833 return [expr $cm $op 0]
837 set type [lindex $args 0]
838 set name [lindex $args 1]
839 set parm [lindex $args 2]
840 set body [lindex $args 3]
842 if {($type ne {proc} && $type ne {method})} {
843 error "Invalid arguments to git-version
"
845 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
846 error "Last arm of
$type $name must be default
"
849 foreach {op vr cb} [lrange $body 0 end-2] {
850 if {[git-version $op $vr]} {
851 return [uplevel [list $type $name $parm $cb]]
855 return [uplevel [list $type $name $parm [lindex $body end]]]
859 error "git-version
>= x
"
865 if {[git-version < 1.5]} {
866 catch {wm withdraw .}
870 -title [mc "git-gui
: fatal error
"] \
871 -message "[appname
] requires Git
1.5.0 or later.
873 You are using
[git-version
]:
879 ######################################################################
881 ## configure our library
883 set idx [file join $oguilib tclIndex]
884 if {[catch {set fd [open $idx r]} err]} {
885 catch {wm withdraw .}
889 -title [mc "git-gui
: fatal error
"] \
893 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
895 while {[gets $fd n] >= 0} {
896 if {$n ne {} && ![string match #* $n]} {
908 if {[lsearch -exact $loaded $p] >= 0} continue
909 source [file join $oguilib $p]
914 set auto_path [concat [list $oguilib] $auto_path]
916 unset -nocomplain idx fd
918 ######################################################################
920 ## config file parsing
922 git-version proc _parse_config {arr_name args} {
929 [list git_read config] \
931 [list --null --list]]
932 fconfigure $fd_rc -translation binary
933 set buf [read $fd_rc]
936 foreach line [split $buf "\
0"] {
937 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
938 if {[is_many_config $name]} {
939 lappend arr($name) $value
941 set arr($name) $value
950 set fd_rc [eval [list git_read config --list] $args]
951 while {[gets $fd_rc line] >= 0} {
952 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
953 if {[is_many_config $name]} {
954 lappend arr($name) $value
956 set arr($name) $value
965 proc load_config {include_global} {
966 global repo_config global_config system_config default_config
968 if {$include_global} {
969 _parse_config system_config --system
970 _parse_config global_config --global
972 _parse_config repo_config
974 foreach name [array names default_config] {
975 if {[catch {set v $system_config($name)}]} {
976 set system_config($name) $default_config($name)
979 foreach name [array names system_config] {
980 if {[catch {set v $global_config($name)}]} {
981 set global_config($name) $system_config($name)
983 if {[catch {set v $repo_config($name)}]} {
984 set repo_config($name) $system_config($name)
989 ######################################################################
991 ## feature option selection
993 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
998 if {$subcommand eq {gui.sh}} {
1001 if {$subcommand eq {gui} && [llength $argv] > 0} {
1002 set subcommand [lindex $argv 0]
1003 set argv [lrange $argv 1 end]
1006 enable_option multicommit
1007 enable_option branch
1008 enable_option transport
1011 switch -- $subcommand {
1016 disable_option multicommit
1017 disable_option branch
1018 disable_option transport
1021 enable_option singlecommit
1022 enable_option retcode
1024 disable_option multicommit
1025 disable_option branch
1026 disable_option transport
1028 while {[llength $argv] > 0} {
1029 set a [lindex $argv 0]
1032 enable_option initialamend
1035 enable_option nocommit
1036 enable_option nocommitmsg
1039 disable_option nocommitmsg
1046 set argv [lrange $argv 1 end]
1051 ######################################################################
1053 ## execution environment
1055 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1057 # Suggest our implementation of askpass, if none is set
1058 if {![info exists env(SSH_ASKPASS)]} {
1059 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1062 ######################################################################
1068 set _gitdir $env(GIT_DIR)
1072 set _gitdir [git rev-parse --git-dir]
1073 set _prefix [git rev-parse --show-prefix]
1077 choose_repository::pick
1080 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1081 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1083 if {![file isdirectory $_gitdir]} {
1084 catch {wm withdraw .}
1085 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1088 if {$_prefix ne {}} {
1089 regsub -all {[^/]+/} $_prefix ../ cdup
1090 if {[catch {cd $cdup} err]} {
1091 catch {wm withdraw .}
1092 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1096 } elseif {![is_enabled bare]} {
1097 if {[lindex [file split $_gitdir] end] ne {.git}} {
1098 catch {wm withdraw .}
1099 error_popup [strcat [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
1102 if {[catch {cd [file dirname $_gitdir]} err]} {
1103 catch {wm withdraw .}
1104 error_popup [strcat [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
1108 set _reponame [file split [file normalize $_gitdir]]
1109 if {[lindex $_reponame end] eq {.git}} {
1110 set _reponame [lindex $_reponame end-1]
1112 set _reponame [lindex $_reponame end]
1115 ######################################################################
1119 set current_diff_path {}
1120 set current_diff_side {}
1121 set diff_actions [list]
1125 set MERGE_HEAD [list]
1128 set current_branch {}
1130 set current_diff_path {}
1132 set is_conflict_diff 0
1133 set selected_commit_type new
1134 set diff_empty_count 0
1136 set nullid "0000000000000000000000000000000000000000"
1137 set nullid2 "0000000000000000000000000000000000000001"
1139 ######################################################################
1147 set disable_on_lock [list]
1148 set index_lock_type none
1150 proc lock_index {type} {
1151 global index_lock_type disable_on_lock
1153 if {$index_lock_type eq {none}} {
1154 set index_lock_type $type
1155 foreach w $disable_on_lock {
1156 uplevel #0 $w disabled
1159 } elseif {$index_lock_type eq "begin-
$type"} {
1160 set index_lock_type $type
1166 proc unlock_index {} {
1167 global index_lock_type disable_on_lock
1169 set index_lock_type none
1170 foreach w $disable_on_lock {
1171 uplevel #0 $w normal
1175 ######################################################################
1179 proc repository_state {ctvar hdvar mhvar} {
1180 global current_branch
1181 upvar $ctvar ct $hdvar hd $mhvar mh
1186 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1192 set merge_head [gitdir MERGE_HEAD]
1193 if {[file exists $merge_head]} {
1195 set fd_mh [open $merge_head r]
1196 while {[gets $fd_mh line] >= 0} {
1207 global PARENT empty_tree
1209 set p [lindex $PARENT 0]
1213 if {$empty_tree eq {}} {
1214 set empty_tree [git mktree << {}]
1219 proc force_amend {} {
1220 global selected_commit_type
1221 global HEAD PARENT MERGE_HEAD commit_type
1223 repository_state newType newHEAD newMERGE_HEAD
1226 set MERGE_HEAD $newMERGE_HEAD
1227 set commit_type $newType
1229 set selected_commit_type amend
1230 do_select_commit_type
1233 proc rescan {after {honor_trustmtime 1}} {
1234 global HEAD PARENT MERGE_HEAD commit_type
1235 global ui_index ui_workdir ui_comm
1236 global rescan_active file_states
1239 if {$rescan_active > 0 || ![lock_index read]} return
1241 repository_state newType newHEAD newMERGE_HEAD
1242 if {[string match amend* $commit_type]
1243 && $newType eq {normal}
1244 && $newHEAD eq $HEAD} {
1248 set MERGE_HEAD $newMERGE_HEAD
1249 set commit_type $newType
1252 array unset file_states
1254 if {!$::GITGUI_BCK_exists &&
1255 (![$ui_comm edit modified]
1256 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1257 if {[string match amend* $commit_type]} {
1258 } elseif {[load_message GITGUI_MSG]} {
1259 } elseif {[run_prepare_commit_msg_hook]} {
1260 } elseif {[load_message MERGE_MSG]} {
1261 } elseif {[load_message SQUASH_MSG]} {
1264 $ui_comm edit modified false
1267 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1268 rescan_stage2 {} $after
1271 ui_status [mc "Refreshing
file status...
"]
1272 set fd_rf [git_read update-index \
1278 fconfigure $fd_rf -blocking 0 -translation binary
1279 fileevent $fd_rf readable \
1280 [list rescan_stage2 $fd_rf $after]
1285 set is_git_info_exclude {}
1286 proc have_info_exclude {} {
1287 global is_git_info_exclude
1289 if {$is_git_info_exclude eq {}} {
1290 if {[catch {exec test -f [gitdir info exclude]}]} {
1291 set is_git_info_exclude 0
1293 set is_git_info_exclude 1
1296 return $is_git_info_exclude
1299 proc have_info_exclude {} {
1300 return [file readable [gitdir info exclude]]
1304 proc rescan_stage2 {fd after} {
1305 global rescan_active buf_rdi buf_rdf buf_rlo
1309 if {![eof $fd]} return
1313 set ls_others [list --exclude-per-directory=.gitignore]
1314 if {[have_info_exclude]} {
1315 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1317 set user_exclude [get_config core.excludesfile]
1318 if {$user_exclude ne {} && [file readable $user_exclude]} {
1319 lappend ls_others "--exclude-from=$user_exclude"
1327 ui_status [mc "Scanning
for modified files ...
"]
1328 set fd_di [git_read diff-index --cached -z [PARENT]]
1329 set fd_df [git_read diff-files -z]
1330 set fd_lo [eval git_read ls-files --others -z $ls_others]
1332 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1333 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1334 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1335 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1336 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1337 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1340 proc load_message {file} {
1343 set f [gitdir $file]
1344 if {[file isfile $f]} {
1345 if {[catch {set fd [open $f r]}]} {
1348 fconfigure $fd -eofchar {}
1349 set content [string trim [read $fd]]
1351 regsub -all -line {[ \r\t]+$} $content {} content
1352 $ui_comm delete 0.0 end
1353 $ui_comm insert end $content
1359 proc run_prepare_commit_msg_hook {} {
1362 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1363 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1364 # empty file but existant file.
1366 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1368 if {[file isfile [gitdir MERGE_MSG]]} {
1369 set pcm_source "merge
"
1370 set fd_mm [open [gitdir MERGE_MSG] r]
1371 puts -nonewline $fd_pcm [read $fd_mm]
1373 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1374 set pcm_source "squash
"
1375 set fd_sm [open [gitdir SQUASH_MSG] r]
1376 puts -nonewline $fd_pcm [read $fd_sm]
1384 set fd_ph [githook_read prepare-commit-msg \
1385 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1387 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1391 ui_status [mc "Calling prepare-commit-msg hook...
"]
1394 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1395 fileevent $fd_ph readable \
1396 [list prepare_commit_msg_hook_wait $fd_ph]
1401 proc prepare_commit_msg_hook_wait {fd_ph} {
1404 append pch_error [read $fd_ph]
1405 fconfigure $fd_ph -blocking 1
1407 if {[catch {close $fd_ph}]} {
1408 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1409 hook_failed_popup prepare-commit-msg $pch_error
1410 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1413 load_message PREPARE_COMMIT_MSG
1416 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1419 fconfigure $fd_ph -blocking 0
1420 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1423 proc read_diff_index {fd after} {
1426 append buf_rdi [read $fd]
1428 set n [string length $buf_rdi]
1430 set z1 [string first "\
0" $buf_rdi $c]
1431 if {$z1 == -1} break
1433 set z2 [string first "\
0" $buf_rdi $z1]
1434 if {$z2 == -1} break
1437 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1438 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1440 [encoding convertfrom $p] \
1442 [list [lindex $i 0] [lindex $i 2]] \
1448 set buf_rdi [string range $buf_rdi $c end]
1453 rescan_done $fd buf_rdi $after
1456 proc read_diff_files {fd after} {
1459 append buf_rdf [read $fd]
1461 set n [string length $buf_rdf]
1463 set z1 [string first "\
0" $buf_rdf $c]
1464 if {$z1 == -1} break
1466 set z2 [string first "\
0" $buf_rdf $z1]
1467 if {$z2 == -1} break
1470 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1471 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1473 [encoding convertfrom $p] \
1476 [list [lindex $i 0] [lindex $i 2]]
1481 set buf_rdf [string range $buf_rdf $c end]
1486 rescan_done $fd buf_rdf $after
1489 proc read_ls_others {fd after} {
1492 append buf_rlo [read $fd]
1493 set pck [split $buf_rlo "\
0"]
1494 set buf_rlo [lindex $pck end]
1495 foreach p [lrange $pck 0 end-1] {
1496 set p [encoding convertfrom $p]
1497 if {[string index $p end] eq {/}} {
1498 set p [string range $p 0 end-1]
1502 rescan_done $fd buf_rlo $after
1505 proc rescan_done {fd buf after} {
1506 global rescan_active current_diff_path
1507 global file_states repo_config
1510 if {![eof $fd]} return
1513 if {[incr rescan_active -1] > 0} return
1518 if {$current_diff_path ne {}} { reshow_diff $after }
1519 if {$current_diff_path eq {}} { select_first_diff $after }
1522 proc prune_selection {} {
1523 global file_states selected_paths
1525 foreach path [array names selected_paths] {
1526 if {[catch {set still_here $file_states($path)}]} {
1527 unset selected_paths($path)
1532 ######################################################################
1536 proc mapicon {w state path} {
1539 if {[catch {set r $all_icons($state$w)}]} {
1540 puts "error
: no icon
for $w state
={$state} $path"
1546 proc mapdesc {state path} {
1549 if {[catch {set r $all_descs($state)}]} {
1550 puts "error
: no desc
for state
={$state} $path"
1556 proc ui_status {msg} {
1558 if {[info exists main_status]} {
1559 $main_status show $msg
1563 proc ui_ready {{test {}}} {
1565 if {[info exists main_status]} {
1566 $main_status show [mc "Ready.
"] $test
1570 proc escape_path {path} {
1571 regsub -all {\\} $path "\\\\" path
1572 regsub -all "\n" $path "\\n
" path
1576 proc short_path {path} {
1577 return [escape_path [lindex [file split $path] end]]
1581 set null_sha1 [string repeat 0 40]
1583 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1584 global file_states next_icon_id null_sha1
1586 set s0 [string index $new_state 0]
1587 set s1 [string index $new_state 1]
1589 if {[catch {set info $file_states($path)}]} {
1591 set icon n[incr next_icon_id]
1593 set state [lindex $info 0]
1594 set icon [lindex $info 1]
1595 if {$head_info eq {}} {set head_info [lindex $info 2]}
1596 if {$index_info eq {}} {set index_info [lindex $info 3]}
1599 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1600 elseif {$s0 eq {_}} {set s0 _}
1602 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1603 elseif {$s1 eq {_}} {set s1 _}
1605 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1606 set head_info [list 0 $null_sha1]
1607 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1608 && $head_info eq {}} {
1609 set head_info $index_info
1612 set file_states($path) [list $s0$s1 $icon \
1613 $head_info $index_info \
1618 proc display_file_helper {w path icon_name old_m new_m} {
1621 if {$new_m eq {_}} {
1622 set lno [lsearch -sorted -exact $file_lists($w) $path]
1624 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1626 $w conf -state normal
1627 $w delete $lno.0 [expr {$lno + 1}].0
1628 $w conf -state disabled
1630 } elseif {$old_m eq {_} && $new_m ne {_}} {
1631 lappend file_lists($w) $path
1632 set file_lists($w) [lsort -unique $file_lists($w)]
1633 set lno [lsearch -sorted -exact $file_lists($w) $path]
1635 $w conf -state normal
1636 $w image create $lno.0 \
1637 -align center -padx 5 -pady 1 \
1639 -image [mapicon $w $new_m $path]
1640 $w insert $lno.1 "[escape_path
$path]\n"
1641 $w conf -state disabled
1642 } elseif {$old_m ne $new_m} {
1643 $w conf -state normal
1644 $w image conf $icon_name -image [mapicon $w $new_m $path]
1645 $w conf -state disabled
1649 proc display_file {path state} {
1650 global file_states selected_paths
1651 global ui_index ui_workdir
1653 set old_m [merge_state $path $state]
1654 set s $file_states($path)
1655 set new_m [lindex $s 0]
1656 set icon_name [lindex $s 1]
1658 set o [string index $old_m 0]
1659 set n [string index $new_m 0]
1666 display_file_helper $ui_index $path $icon_name $o $n
1668 if {[string index $old_m 0] eq {U}} {
1671 set o [string index $old_m 1]
1673 if {[string index $new_m 0] eq {U}} {
1676 set n [string index $new_m 1]
1678 display_file_helper $ui_workdir $path $icon_name $o $n
1680 if {$new_m eq {__}} {
1681 unset file_states($path)
1682 catch {unset selected_paths($path)}
1686 proc display_all_files_helper {w path icon_name m} {
1689 lappend file_lists($w) $path
1690 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1691 $w image create end \
1692 -align center -padx 5 -pady 1 \
1694 -image [mapicon $w $m $path]
1695 $w insert end "[escape_path
$path]\n"
1698 proc display_all_files {} {
1699 global ui_index ui_workdir
1700 global file_states file_lists
1703 $ui_index conf -state normal
1704 $ui_workdir conf -state normal
1706 $ui_index delete 0.0 end
1707 $ui_workdir delete 0.0 end
1710 set file_lists($ui_index) [list]
1711 set file_lists($ui_workdir) [list]
1713 foreach path [lsort [array names file_states]] {
1714 set s $file_states($path)
1716 set icon_name [lindex $s 1]
1718 set s [string index $m 0]
1719 if {$s ne {U} && $s ne {_}} {
1720 display_all_files_helper $ui_index $path \
1724 if {[string index $m 0] eq {U}} {
1727 set s [string index $m 1]
1730 display_all_files_helper $ui_workdir $path \
1735 $ui_index conf -state disabled
1736 $ui_workdir conf -state disabled
1739 ######################################################################
1744 #define mask_width 14
1745 #define mask_height 15
1746 static unsigned char mask_bits[] = {
1747 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1748 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1749 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1752 image create bitmap file_plain -background white -foreground black -data {
1753 #define plain_width 14
1754 #define plain_height 15
1755 static unsigned char plain_bits[] = {
1756 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1757 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1758 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1759 } -maskdata $filemask
1761 image create bitmap file_mod -background white -foreground blue -data {
1762 #define mod_width 14
1763 #define mod_height 15
1764 static unsigned char mod_bits[] = {
1765 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1766 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1767 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1768 } -maskdata $filemask
1770 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1771 #define file_fulltick_width 14
1772 #define file_fulltick_height 15
1773 static unsigned char file_fulltick_bits
[] = {
1774 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1775 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1776 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1777 } -maskdata $filemask
1779 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1780 #define parttick_width 14
1781 #define parttick_height 15
1782 static unsigned char parttick_bits
[] = {
1783 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1784 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1785 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1786 } -maskdata $filemask
1788 image create bitmap file_question
-background white
-foreground black
-data {
1789 #define file_question_width 14
1790 #define file_question_height 15
1791 static unsigned char file_question_bits
[] = {
1792 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1793 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1794 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1795 } -maskdata $filemask
1797 image create bitmap file_removed
-background white
-foreground red
-data {
1798 #define file_removed_width 14
1799 #define file_removed_height 15
1800 static unsigned char file_removed_bits
[] = {
1801 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1802 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1803 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1804 } -maskdata $filemask
1806 image create bitmap file_merge
-background white
-foreground blue
-data {
1807 #define file_merge_width 14
1808 #define file_merge_height 15
1809 static unsigned char file_merge_bits
[] = {
1810 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1811 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1812 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1813 } -maskdata $filemask
1815 image create bitmap file_statechange
-background white
-foreground green
-data {
1816 #define file_merge_width 14
1817 #define file_merge_height 15
1818 static unsigned char file_statechange_bits
[] = {
1819 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1820 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1821 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1822 } -maskdata $filemask
1824 set ui_index .vpane.files.index.list
1825 set ui_workdir .vpane.files.workdir.list
1827 set all_icons
(_
$ui_index) file_plain
1828 set all_icons
(A
$ui_index) file_fulltick
1829 set all_icons
(M
$ui_index) file_fulltick
1830 set all_icons
(D
$ui_index) file_removed
1831 set all_icons
(U
$ui_index) file_merge
1832 set all_icons
(T
$ui_index) file_statechange
1834 set all_icons
(_
$ui_workdir) file_plain
1835 set all_icons
(M
$ui_workdir) file_mod
1836 set all_icons
(D
$ui_workdir) file_question
1837 set all_icons
(U
$ui_workdir) file_merge
1838 set all_icons
(O
$ui_workdir) file_plain
1839 set all_icons
(T
$ui_workdir) file_statechange
1841 set max_status_desc
0
1843 {__
{mc
"Unmodified"}}
1845 {_M
{mc
"Modified, not staged"}}
1846 {M_
{mc
"Staged for commit"}}
1847 {MM
{mc
"Portions staged for commit"}}
1848 {MD
{mc
"Staged for commit, missing"}}
1850 {_T
{mc
"File type changed, not staged"}}
1851 {T_
{mc
"File type changed, staged"}}
1853 {_O
{mc
"Untracked, not staged"}}
1854 {A_
{mc
"Staged for commit"}}
1855 {AM
{mc
"Portions staged for commit"}}
1856 {AD
{mc
"Staged for commit, missing"}}
1859 {D_
{mc
"Staged for removal"}}
1860 {DO
{mc
"Staged for removal, still present"}}
1862 {_U
{mc
"Requires merge resolution"}}
1863 {U_
{mc
"Requires merge resolution"}}
1864 {UU
{mc
"Requires merge resolution"}}
1865 {UM
{mc
"Requires merge resolution"}}
1866 {UD
{mc
"Requires merge resolution"}}
1867 {UT
{mc
"Requires merge resolution"}}
1869 set text
[eval [lindex
$i 1]]
1870 if {$max_status_desc < [string length
$text]} {
1871 set max_status_desc
[string length
$text]
1873 set all_descs
([lindex
$i 0]) $text
1877 ######################################################################
1881 proc scrollbar2many
{list mode args
} {
1882 foreach w
$list {eval $w $mode $args}
1885 proc many2scrollbar
{list mode sb top bottom
} {
1886 $sb set $top $bottom
1887 foreach w
$list {$w $mode moveto
$top}
1890 proc incr_font_size
{font
{amt
1}} {
1891 set sz
[font configure
$font -size]
1893 font configure
$font -size $sz
1894 font configure
${font}bold
-size $sz
1895 font configure
${font}italic
-size $sz
1898 ######################################################################
1902 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1904 proc do_gitk
{revs
} {
1905 # -- Always start gitk through whatever we were loaded with. This
1906 # lets us bypass using shell process on Windows systems.
1908 set exe
[_which gitk
-script]
1909 set cmd
[list
[info nameofexecutable
] $exe]
1911 error_popup
[mc
"Couldn't find gitk in PATH"]
1915 if {[info exists env
(GIT_DIR
)]} {
1916 set old_GIT_DIR
$env(GIT_DIR
)
1922 cd [file dirname [gitdir
]]
1923 set env
(GIT_DIR
) [file tail [gitdir
]]
1925 eval exec $cmd $revs &
1927 if {$old_GIT_DIR eq
{}} {
1930 set env
(GIT_DIR
) $old_GIT_DIR
1934 ui_status $
::starting_gitk_msg
1936 ui_ready
$starting_gitk_msg
1941 proc do_explore
{} {
1943 if {[is_Cygwin
] ||
[is_Windows
]} {
1944 set explorer
"explorer.exe"
1945 } elseif
{[is_MacOSX
]} {
1948 # freedesktop.org-conforming system is our best shot
1949 set explorer
"xdg-open"
1951 eval exec $explorer [list
[file nativename
[file dirname [gitdir
]]]] &
1957 proc terminate_me
{win
} {
1959 if {$win ne
{.
}} return
1963 proc do_quit
{{rc
{1}}} {
1964 global ui_comm is_quitting repo_config commit_type
1965 global GITGUI_BCK_exists GITGUI_BCK_i
1966 global ui_comm_spell
1969 if {$is_quitting} return
1972 if {[winfo exists
$ui_comm]} {
1973 # -- Stash our current commit buffer.
1975 set save
[gitdir GITGUI_MSG
]
1976 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1977 file rename
-force [gitdir GITGUI_BCK
] $save
1978 set GITGUI_BCK_exists
0
1980 set msg
[string trim
[$ui_comm get
0.0 end
]]
1981 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1982 if {(![string match amend
* $commit_type]
1983 ||
[$ui_comm edit modified
])
1986 set fd
[open
$save w
]
1987 puts
-nonewline $fd $msg
1991 catch
{file delete
$save}
1995 # -- Cancel our spellchecker if its running.
1997 if {[info exists ui_comm_spell
]} {
2001 # -- Remove our editor backup, its not needed.
2003 after cancel
$GITGUI_BCK_i
2004 if {$GITGUI_BCK_exists} {
2005 catch
{file delete
[gitdir GITGUI_BCK
]}
2008 # -- Stash our current window geometry into this repository.
2010 set cfg_geometry
[list
]
2011 lappend cfg_geometry
[wm geometry .
]
2012 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
2013 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
2014 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2017 if {$cfg_geometry ne
$rc_geometry} {
2018 catch
{git config gui.geometry
$cfg_geometry}
2030 proc ui_do_rescan
{} {
2031 rescan
{force_first_diff ui_ready
}
2038 proc next_diff
{{after
{}}} {
2039 global next_diff_p next_diff_w next_diff_i
2040 show_diff
$next_diff_p $next_diff_w {} {} $after
2043 proc find_anchor_pos
{lst name
} {
2044 set lid
[lsearch
-sorted -exact $lst $name]
2048 foreach lname
$lst {
2049 if {$lname >= $name} break
2057 proc find_file_from
{flist idx delta path mmask
} {
2060 set len
[llength
$flist]
2061 while {$idx >= 0 && $idx < $len} {
2062 set name
[lindex
$flist $idx]
2064 if {$name ne
$path && [info exists file_states
($name)]} {
2065 set state
[lindex
$file_states($name) 0]
2067 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2078 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2079 global next_diff_p next_diff_w next_diff_i
2080 global file_lists ui_index ui_workdir
2082 set flist
$file_lists($w)
2084 set lno
[find_anchor_pos
$flist $path]
2089 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2090 if {$w eq
$ui_index} {
2093 set mmask
"$mmask\$"
2097 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2100 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2105 set next_diff_p
[lindex
$flist $idx]
2106 set next_diff_i
[expr {$idx+1}]
2113 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2114 global current_diff_path
2116 if {$path ne
$current_diff_path} {
2118 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2121 return {reshow_diff
;}
2125 proc select_first_diff
{after
} {
2128 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2129 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2136 proc force_first_diff
{after
} {
2137 global ui_workdir current_diff_path file_states
2139 if {[info exists file_states
($current_diff_path)]} {
2140 set state
[lindex
$file_states($current_diff_path) 0]
2146 if {[string first
{U
} $state] >= 0} {
2147 # Already a conflict, do nothing
2148 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {^_?U
}]} {
2150 } elseif
{[string index
$state 1] ne
{O
}} {
2151 # Already a diff & no conflicts, do nothing
2152 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {[^O
]$
}]} {
2163 proc toggle_or_diff
{w x y
} {
2164 global file_states file_lists current_diff_path ui_index ui_workdir
2165 global last_clicked selected_paths
2167 set pos
[split [$w index @
$x,$y] .
]
2168 set lno
[lindex
$pos 0]
2169 set col [lindex
$pos 1]
2170 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2176 set last_clicked
[list
$w $lno]
2177 array
unset selected_paths
2178 $ui_index tag remove in_sel
0.0 end
2179 $ui_workdir tag remove in_sel
0.0 end
2181 # Determine the state of the file
2182 if {[info exists file_states
($path)]} {
2183 set state
[lindex
$file_states($path) 0]
2188 # Restage the file, or simply show the diff
2189 if {$col == 0 && $y > 1} {
2190 # Conflicts need special handling
2191 if {[string first
{U
} $state] >= 0} {
2192 # $w must always be $ui_workdir, but...
2193 if {$w ne
$ui_workdir} { set lno
{} }
2194 merge_stage_workdir
$path $lno
2198 if {[string index
$state 1] eq
{O
}} {
2204 set after
[next_diff_after_action
$w $path $lno $mmask]
2206 if {$w eq
$ui_index} {
2208 "Unstaging [short_path $path] from commit" \
2210 [concat
$after [list ui_ready
]]
2211 } elseif
{$w eq
$ui_workdir} {
2213 "Adding [short_path $path]" \
2215 [concat
$after [list ui_ready
]]
2218 show_diff
$path $w $lno
2222 proc add_one_to_selection
{w x y
} {
2223 global file_lists last_clicked selected_paths
2225 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2226 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2232 if {$last_clicked ne
{}
2233 && [lindex
$last_clicked 0] ne
$w} {
2234 array
unset selected_paths
2235 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2238 set last_clicked
[list
$w $lno]
2239 if {[catch
{set in_sel
$selected_paths($path)}]} {
2243 unset selected_paths
($path)
2244 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2246 set selected_paths
($path) 1
2247 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2251 proc add_range_to_selection
{w x y
} {
2252 global file_lists last_clicked selected_paths
2254 if {[lindex
$last_clicked 0] ne
$w} {
2255 toggle_or_diff
$w $x $y
2259 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2260 set lc
[lindex
$last_clicked 1]
2269 foreach path
[lrange
$file_lists($w) \
2270 [expr {$begin - 1}] \
2271 [expr {$end - 1}]] {
2272 set selected_paths
($path) 1
2274 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2277 proc show_more_context
{} {
2279 if {$repo_config(gui.diffcontext
) < 99} {
2280 incr repo_config
(gui.diffcontext
)
2285 proc show_less_context
{} {
2287 if {$repo_config(gui.diffcontext
) > 1} {
2288 incr repo_config
(gui.diffcontext
) -1
2293 ######################################################################
2303 menu .mbar
-tearoff 0
2304 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2305 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2306 if {[is_enabled branch
]} {
2307 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2309 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2310 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2312 if {[is_enabled transport
]} {
2313 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2314 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2316 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2317 .mbar add cascade
-label [mc Tools
] -menu .mbar.tools
2319 . configure
-menu .mbar
2321 # -- Repository Menu
2323 menu .mbar.repository
2325 .mbar.repository add
command \
2326 -label [mc
"Explore Working Copy"] \
2327 -command {do_explore
}
2328 .mbar.repository add separator
2330 .mbar.repository add
command \
2331 -label [mc
"Browse Current Branch's Files"] \
2332 -command {browser
::new
$current_branch}
2333 set ui_browse_current
[.mbar.repository index last
]
2334 .mbar.repository add
command \
2335 -label [mc
"Browse Branch Files..."] \
2336 -command browser_open
::dialog
2337 .mbar.repository add separator
2339 .mbar.repository add
command \
2340 -label [mc
"Visualize Current Branch's History"] \
2341 -command {do_gitk
$current_branch}
2342 set ui_visualize_current
[.mbar.repository index last
]
2343 .mbar.repository add
command \
2344 -label [mc
"Visualize All Branch History"] \
2345 -command {do_gitk
--all}
2346 .mbar.repository add separator
2348 proc current_branch_write
{args
} {
2349 global current_branch
2350 .mbar.repository entryconf $
::ui_browse_current \
2351 -label [mc
"Browse %s's Files" $current_branch]
2352 .mbar.repository entryconf $
::ui_visualize_current \
2353 -label [mc
"Visualize %s's History" $current_branch]
2355 trace add variable current_branch
write current_branch_write
2357 if {[is_enabled multicommit
]} {
2358 .mbar.repository add
command -label [mc
"Database Statistics"] \
2361 .mbar.repository add
command -label [mc
"Compress Database"] \
2364 .mbar.repository add
command -label [mc
"Verify Database"] \
2365 -command do_fsck_objects
2367 .mbar.repository add separator
2370 .mbar.repository add
command \
2371 -label [mc
"Create Desktop Icon"] \
2372 -command do_cygwin_shortcut
2373 } elseif
{[is_Windows
]} {
2374 .mbar.repository add
command \
2375 -label [mc
"Create Desktop Icon"] \
2376 -command do_windows_shortcut
2377 } elseif
{[is_MacOSX
]} {
2378 .mbar.repository add
command \
2379 -label [mc
"Create Desktop Icon"] \
2380 -command do_macosx_app
2385 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2387 .mbar.repository add
command -label [mc Quit
] \
2395 .mbar.edit add
command -label [mc Undo
] \
2396 -command {catch
{[focus
] edit undo
}} \
2398 .mbar.edit add
command -label [mc Redo
] \
2399 -command {catch
{[focus
] edit redo
}} \
2401 .mbar.edit add separator
2402 .mbar.edit add
command -label [mc Cut
] \
2403 -command {catch
{tk_textCut
[focus
]}} \
2405 .mbar.edit add
command -label [mc Copy
] \
2406 -command {catch
{tk_textCopy
[focus
]}} \
2408 .mbar.edit add
command -label [mc Paste
] \
2409 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2411 .mbar.edit add
command -label [mc Delete
] \
2412 -command {catch
{[focus
] delete sel.first sel.last
}} \
2414 .mbar.edit add separator
2415 .mbar.edit add
command -label [mc
"Select All"] \
2416 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2421 if {[is_enabled branch
]} {
2424 .mbar.branch add
command -label [mc
"Create..."] \
2425 -command branch_create
::dialog \
2427 lappend disable_on_lock
[list .mbar.branch entryconf \
2428 [.mbar.branch index last
] -state]
2430 .mbar.branch add
command -label [mc
"Checkout..."] \
2431 -command branch_checkout
::dialog \
2433 lappend disable_on_lock
[list .mbar.branch entryconf \
2434 [.mbar.branch index last
] -state]
2436 .mbar.branch add
command -label [mc
"Rename..."] \
2437 -command branch_rename
::dialog
2438 lappend disable_on_lock
[list .mbar.branch entryconf \
2439 [.mbar.branch index last
] -state]
2441 .mbar.branch add
command -label [mc
"Delete..."] \
2442 -command branch_delete
::dialog
2443 lappend disable_on_lock
[list .mbar.branch entryconf \
2444 [.mbar.branch index last
] -state]
2446 .mbar.branch add
command -label [mc
"Reset..."] \
2447 -command merge
::reset_hard
2448 lappend disable_on_lock
[list .mbar.branch entryconf \
2449 [.mbar.branch index last
] -state]
2454 proc commit_btn_caption
{} {
2455 if {[is_enabled nocommit
]} {
2458 return [mc Commit@@verb
]
2462 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2465 if {![is_enabled nocommit
]} {
2466 .mbar.commit add radiobutton \
2467 -label [mc
"New Commit"] \
2468 -command do_select_commit_type \
2469 -variable selected_commit_type \
2471 lappend disable_on_lock \
2472 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2474 .mbar.commit add radiobutton \
2475 -label [mc
"Amend Last Commit"] \
2476 -command do_select_commit_type \
2477 -variable selected_commit_type \
2479 lappend disable_on_lock \
2480 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2482 .mbar.commit add separator
2485 .mbar.commit add
command -label [mc Rescan
] \
2486 -command ui_do_rescan \
2488 lappend disable_on_lock \
2489 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2491 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2492 -command do_add_selection \
2494 lappend disable_on_lock \
2495 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2497 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2498 -command do_add_all \
2500 lappend disable_on_lock \
2501 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2503 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2504 -command do_unstage_selection
2505 lappend disable_on_lock \
2506 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2508 .mbar.commit add
command -label [mc
"Revert Changes"] \
2509 -command do_revert_selection
2510 lappend disable_on_lock \
2511 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2513 .mbar.commit add separator
2515 .mbar.commit add
command -label [mc
"Show Less Context"] \
2516 -command show_less_context \
2517 -accelerator $M1T-\
-
2519 .mbar.commit add
command -label [mc
"Show More Context"] \
2520 -command show_more_context \
2523 .mbar.commit add separator
2525 if {![is_enabled nocommitmsg
]} {
2526 .mbar.commit add
command -label [mc
"Sign Off"] \
2527 -command do_signoff \
2531 .mbar.commit add
command -label [commit_btn_caption
] \
2532 -command do_commit \
2533 -accelerator $M1T-Return
2534 lappend disable_on_lock \
2535 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2540 if {[is_enabled branch
]} {
2542 .mbar.merge add
command -label [mc
"Local Merge..."] \
2543 -command merge
::dialog \
2545 lappend disable_on_lock \
2546 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2547 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2548 -command merge
::reset_hard
2549 lappend disable_on_lock \
2550 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2555 if {[is_enabled transport
]} {
2558 .mbar.remote add
command \
2559 -label [mc
"Add..."] \
2560 -command remote_add
::dialog \
2562 .mbar.remote add
command \
2563 -label [mc
"Push..."] \
2564 -command do_push_anywhere \
2566 .mbar.remote add
command \
2567 -label [mc
"Delete Branch..."] \
2568 -command remote_branch_delete
::dialog
2572 # -- Apple Menu (Mac OS X only)
2574 .mbar add cascade
-label Apple
-menu .mbar.apple
2577 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2579 .mbar.apple add separator
2580 .mbar.apple add
command \
2581 -label [mc
"Preferences..."] \
2582 -command do_options \
2584 bind .
<$M1B-,> do_options
2588 .mbar.edit add separator
2589 .mbar.edit add
command -label [mc
"Options..."] \
2595 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2596 set tools_menubar .mbar.tools
2598 $tools_menubar add separator
2599 $tools_menubar add
command -label [mc
"Add..."] -command tools_add
::dialog
2600 $tools_menubar add
command -label [mc
"Remove..."] -command tools_remove
::dialog
2602 if {[array names repo_config guitool.
*.cmd
] ne
{}} {
2609 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2613 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2618 set doc_path
[githtmldir
]
2619 if {$doc_path ne
{}} {
2620 set doc_path
[file join $doc_path index.html
]
2623 set doc_path
[exec cygpath
--mixed $doc_path]
2627 if {[file isfile
$doc_path]} {
2628 set doc_url
"file:$doc_path"
2630 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2633 proc start_browser
{url
} {
2634 git
"web--browse" $url
2637 .mbar.
help add
command -label [mc
"Online Documentation"] \
2638 -command [list start_browser
$doc_url]
2640 .mbar.
help add
command -label [mc
"Show SSH Key"] \
2643 unset doc_path doc_url
2645 # -- Standard bindings
2647 wm protocol . WM_DELETE_WINDOW do_quit
2648 bind all
<$M1B-Key-q> do_quit
2649 bind all
<$M1B-Key-Q> do_quit
2650 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2651 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2653 set subcommand_args
{}
2655 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2659 proc normalize_relpath
{path
} {
2661 foreach item
[file split $path] {
2662 if {$item eq
{.
}} continue
2663 if {$item eq
{..
} && [llength
$elements] > 0
2664 && [lindex
$elements end
] ne
{..
}} {
2665 set elements
[lrange
$elements 0 end-1
]
2668 lappend elements
$item
2670 return [eval file join $elements]
2673 # -- Not a normal commit type invocation? Do that instead!
2675 switch
-- $subcommand {
2678 if {$subcommand eq
"blame"} {
2679 set subcommand_args
{[--line=<num
>] rev? path
}
2681 set subcommand_args
{rev? path
}
2683 if {$argv eq
{}} usage
2689 if {$is_path ||
[file exists
$_prefix$a]} {
2690 if {$path ne
{}} usage
2691 set path
[normalize_relpath
$_prefix$a]
2693 } elseif
{$a eq
{--}} {
2695 if {$head ne
{}} usage
2700 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
2701 if {$jump_spec ne
{} ||
$head ne
{}} usage
2702 set jump_spec
[list
$lnum]
2703 } elseif
{$head eq
{}} {
2704 if {$head ne
{}} usage
2713 if {$head ne
{} && $path eq
{}} {
2714 set path
[normalize_relpath
$_prefix$head]
2721 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2723 set head [git rev-parse
--verify $head]
2729 set current_branch
$head
2732 switch
-- $subcommand {
2734 if {$jump_spec ne
{}} usage
2736 if {$path ne
{} && [file isdirectory
$path]} {
2737 set head $current_branch
2743 browser
::new
$head $path
2746 if {$head eq
{} && ![file exists
$path]} {
2747 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2750 blame
::new
$head $path $jump_spec
2757 if {[llength
$argv] != 0} {
2758 puts
-nonewline stderr
"usage: $argv0"
2759 if {$subcommand ne
{gui
}
2760 && [file tail $argv0] ne
"git-$subcommand"} {
2761 puts
-nonewline stderr
" $subcommand"
2766 # fall through to setup UI for commits
2769 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2780 -text [mc
"Current Branch:"] \
2784 -textvariable current_branch \
2787 pack .branch.l1
-side left
2788 pack .branch.cb
-side left
-fill x
2789 pack .branch
-side top
-fill x
2791 # -- Main Window Layout
2793 panedwindow .vpane
-orient horizontal
2794 panedwindow .vpane.files
-orient vertical
2795 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2796 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2798 # -- Index File List
2800 frame .vpane.files.index
-height 100 -width 200
2801 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Commit)"] \
2802 -background lightgreen
-foreground black
2803 text
$ui_index -background white
-foreground black \
2805 -width 20 -height 10 \
2807 -cursor $cursor_ptr \
2808 -xscrollcommand {.vpane.files.index.sx
set} \
2809 -yscrollcommand {.vpane.files.index.sy
set} \
2811 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2812 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2813 pack .vpane.files.index.title
-side top
-fill x
2814 pack .vpane.files.index.sx
-side bottom
-fill x
2815 pack .vpane.files.index.sy
-side right
-fill y
2816 pack
$ui_index -side left
-fill both
-expand 1
2818 # -- Working Directory File List
2820 frame .vpane.files.workdir
-height 100 -width 200
2821 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
2822 -background lightsalmon
-foreground black
2823 text
$ui_workdir -background white
-foreground black \
2825 -width 20 -height 10 \
2827 -cursor $cursor_ptr \
2828 -xscrollcommand {.vpane.files.workdir.sx
set} \
2829 -yscrollcommand {.vpane.files.workdir.sy
set} \
2831 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2832 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2833 pack .vpane.files.workdir.title
-side top
-fill x
2834 pack .vpane.files.workdir.sx
-side bottom
-fill x
2835 pack .vpane.files.workdir.sy
-side right
-fill y
2836 pack
$ui_workdir -side left
-fill both
-expand 1
2838 .vpane.files add .vpane.files.workdir
-sticky nsew
2839 .vpane.files add .vpane.files.index
-sticky nsew
2841 foreach i
[list
$ui_index $ui_workdir] {
2843 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2847 # -- Diff and Commit Area
2849 frame .vpane.lower
-height 300 -width 400
2850 frame .vpane.lower.commarea
2851 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2852 pack .vpane.lower.
diff -fill both
-expand 1
2853 pack .vpane.lower.commarea
-side bottom
-fill x
2854 .vpane add .vpane.lower
-sticky nsew
2856 # -- Commit Area Buttons
2858 frame .vpane.lower.commarea.buttons
2859 label .vpane.lower.commarea.buttons.l
-text {} \
2862 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2863 pack .vpane.lower.commarea.buttons
-side left
-fill y
2865 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2866 -command ui_do_rescan
2867 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2868 lappend disable_on_lock \
2869 {.vpane.lower.commarea.buttons.rescan conf
-state}
2871 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2873 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2874 lappend disable_on_lock \
2875 {.vpane.lower.commarea.buttons.incall conf
-state}
2877 if {![is_enabled nocommitmsg
]} {
2878 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2880 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2883 button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
2885 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2886 lappend disable_on_lock \
2887 {.vpane.lower.commarea.buttons.commit conf
-state}
2889 if {![is_enabled nocommit
]} {
2890 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2891 -command do_push_anywhere
2892 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2895 # -- Commit Message Buffer
2897 frame .vpane.lower.commarea.buffer
2898 frame .vpane.lower.commarea.buffer.header
2899 set ui_comm .vpane.lower.commarea.buffer.t
2900 set ui_coml .vpane.lower.commarea.buffer.header.l
2902 if {![is_enabled nocommit
]} {
2903 radiobutton .vpane.lower.commarea.buffer.header.new \
2904 -text [mc
"New Commit"] \
2905 -command do_select_commit_type \
2906 -variable selected_commit_type \
2908 lappend disable_on_lock \
2909 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2910 radiobutton .vpane.lower.commarea.buffer.header.amend \
2911 -text [mc
"Amend Last Commit"] \
2912 -command do_select_commit_type \
2913 -variable selected_commit_type \
2915 lappend disable_on_lock \
2916 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2922 proc trace_commit_type
{varname args
} {
2923 global ui_coml commit_type
2924 switch
-glob -- $commit_type {
2925 initial
{set txt
[mc
"Initial Commit Message:"]}
2926 amend
{set txt
[mc
"Amended Commit Message:"]}
2927 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2928 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2929 merge
{set txt
[mc
"Merge Commit Message:"]}
2930 * {set txt
[mc
"Commit Message:"]}
2932 $ui_coml conf
-text $txt
2934 trace add variable commit_type
write trace_commit_type
2935 pack
$ui_coml -side left
-fill x
2937 if {![is_enabled nocommit
]} {
2938 pack .vpane.lower.commarea.buffer.header.amend
-side right
2939 pack .vpane.lower.commarea.buffer.header.new
-side right
2942 text
$ui_comm -background white
-foreground black \
2946 -autoseparators true \
2948 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
2950 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2951 scrollbar .vpane.lower.commarea.buffer.sby \
2952 -command [list
$ui_comm yview
]
2953 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2954 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2955 pack
$ui_comm -side left
-fill y
2956 pack .vpane.lower.commarea.buffer
-side left
-fill y
2958 # -- Commit Message Buffer Context Menu
2960 set ctxm .vpane.lower.commarea.buffer.ctxm
2961 menu
$ctxm -tearoff 0
2964 -command {tk_textCut
$ui_comm}
2967 -command {tk_textCopy
$ui_comm}
2970 -command {tk_textPaste
$ui_comm}
2972 -label [mc Delete
] \
2973 -command {catch
{$ui_comm delete sel.first sel.last
}}
2976 -label [mc
"Select All"] \
2977 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2979 -label [mc
"Copy All"] \
2981 $ui_comm tag add sel
0.0 end
2982 tk_textCopy
$ui_comm
2983 $ui_comm tag remove sel
0.0 end
2987 -label [mc
"Sign Off"] \
2989 set ui_comm_ctxm
$ctxm
2993 proc trace_current_diff_path
{varname args
} {
2994 global current_diff_path diff_actions file_states
2995 if {$current_diff_path eq
{}} {
3001 set p
$current_diff_path
3002 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
3004 set p
[escape_path
$p]
3008 .vpane.lower.
diff.header.status configure
-text $s
3009 .vpane.lower.
diff.header.
file configure
-text $f
3010 .vpane.lower.
diff.header.path configure
-text $p
3011 foreach w
$diff_actions {
3015 trace add variable current_diff_path
write trace_current_diff_path
3017 frame .vpane.lower.
diff.header
-background gold
3018 label .vpane.lower.
diff.header.status \
3021 -width $max_status_desc \
3024 label .vpane.lower.
diff.header.
file \
3029 label .vpane.lower.
diff.header.path \
3034 pack .vpane.lower.
diff.header.status
-side left
3035 pack .vpane.lower.
diff.header.
file -side left
3036 pack .vpane.lower.
diff.header.path
-fill x
3037 set ctxm .vpane.lower.
diff.header.ctxm
3038 menu
$ctxm -tearoff 0
3046 -- $current_diff_path
3048 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3049 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
3053 frame .vpane.lower.
diff.body
3054 set ui_diff .vpane.lower.
diff.body.t
3055 text
$ui_diff -background white
-foreground black \
3057 -width 80 -height 15 -wrap none \
3059 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
3060 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
3062 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
3063 -command [list
$ui_diff xview
]
3064 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
3065 -command [list
$ui_diff yview
]
3066 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
3067 pack .vpane.lower.
diff.body.sby
-side right
-fill y
3068 pack
$ui_diff -side left
-fill both
-expand 1
3069 pack .vpane.lower.
diff.header
-side top
-fill x
3070 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
3072 $ui_diff tag conf d_cr
-elide true
3073 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
3074 $ui_diff tag conf d_
+ -foreground {#00a000}
3075 $ui_diff tag conf d_-
-foreground red
3077 $ui_diff tag conf d_
++ -foreground {#00a000}
3078 $ui_diff tag conf d_--
-foreground red
3079 $ui_diff tag conf d_
+s \
3080 -foreground {#00a000} \
3081 -background {#e2effa}
3082 $ui_diff tag conf d_-s \
3084 -background {#e2effa}
3085 $ui_diff tag conf d_s
+ \
3086 -foreground {#00a000} \
3088 $ui_diff tag conf d_s- \
3092 $ui_diff tag conf d
<<<<<<< \
3093 -foreground orange \
3095 $ui_diff tag conf d
======= \
3096 -foreground orange \
3098 $ui_diff tag conf d
>>>>>>> \
3099 -foreground orange \
3102 $ui_diff tag raise sel
3104 # -- Diff Body Context Menu
3107 proc create_common_diff_popup
{ctxm
} {
3109 -label [mc
"Show Less Context"] \
3110 -command show_less_context
3111 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3113 -label [mc
"Show More Context"] \
3114 -command show_more_context
3115 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3118 -label [mc Refresh
] \
3119 -command reshow_diff
3120 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3123 -command {tk_textCopy
$ui_diff}
3124 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3126 -label [mc
"Select All"] \
3127 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3128 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3130 -label [mc
"Copy All"] \
3132 $ui_diff tag add sel
0.0 end
3133 tk_textCopy
$ui_diff
3134 $ui_diff tag remove sel
0.0 end
3136 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3139 -label [mc
"Decrease Font Size"] \
3140 -command {incr_font_size font_diff
-1}
3141 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3143 -label [mc
"Increase Font Size"] \
3144 -command {incr_font_size font_diff
1}
3145 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3149 build_encoding_menu
$emenu [list force_diff_encoding
]
3151 -label [mc
"Encoding"] \
3153 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3155 $ctxm add
command -label [mc
"Options..."] \
3159 set ctxm .vpane.lower.
diff.body.ctxm
3160 menu
$ctxm -tearoff 0
3162 -label [mc
"Apply/Reverse Hunk"] \
3163 -command {apply_hunk
$cursorX $cursorY}
3164 set ui_diff_applyhunk
[$ctxm index last
]
3165 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3167 -label [mc
"Apply/Reverse Line"] \
3168 -command {apply_line
$cursorX $cursorY; do_rescan
}
3169 set ui_diff_applyline
[$ctxm index last
]
3170 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3172 create_common_diff_popup
$ctxm
3174 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3175 menu
$ctxmmg -tearoff 0
3176 $ctxmmg add
command \
3177 -label [mc
"Run Merge Tool"] \
3178 -command {merge_resolve_tool
}
3179 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3180 $ctxmmg add separator
3181 $ctxmmg add
command \
3182 -label [mc
"Use Remote Version"] \
3183 -command {merge_resolve_one
3}
3184 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3185 $ctxmmg add
command \
3186 -label [mc
"Use Local Version"] \
3187 -command {merge_resolve_one
2}
3188 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3189 $ctxmmg add
command \
3190 -label [mc
"Revert To Base"] \
3191 -command {merge_resolve_one
1}
3192 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3193 $ctxmmg add separator
3194 create_common_diff_popup
$ctxmmg
3196 proc popup_diff_menu
{ctxm ctxmmg x y X Y
} {
3197 global current_diff_path file_states
3200 if {[info exists file_states
($current_diff_path)]} {
3201 set state
[lindex
$file_states($current_diff_path) 0]
3205 if {[string first
{U
} $state] >= 0} {
3206 tk_popup
$ctxmmg $X $Y
3208 if {$
::ui_index eq $
::current_diff_side
} {
3209 set l
[mc
"Unstage Hunk From Commit"]
3210 set t
[mc
"Unstage Line From Commit"]
3212 set l
[mc
"Stage Hunk For Commit"]
3213 set t
[mc
"Stage Line For Commit"]
3216 ||
$current_diff_path eq
{}
3220 ||
{T_
} eq
$state} {
3225 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3226 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3227 tk_popup
$ctxm $X $Y
3230 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg %x
%y
%X
%Y
]
3234 set main_status
[::status_bar
::new .status
]
3235 pack .status
-anchor w
-side bottom
-fill x
3236 $main_status show
[mc
"Initializing..."]
3241 set gm
$repo_config(gui.geometry
)
3242 wm geometry .
[lindex
$gm 0]
3243 .vpane sash place
0 \
3245 [lindex
[.vpane sash coord
0] 1]
3246 .vpane.files sash place
0 \
3247 [lindex
[.vpane.files sash coord
0] 0] \
3254 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3255 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3256 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3257 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3258 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3259 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3260 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3261 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3262 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3263 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3264 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3265 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3266 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3267 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3268 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3269 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3270 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3271 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3273 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3274 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3275 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3276 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3277 bind $ui_diff <$M1B-Key-v> {break}
3278 bind $ui_diff <$M1B-Key-V> {break}
3279 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3280 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3281 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3282 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3283 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3284 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3285 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3286 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3287 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3288 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3289 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3290 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3291 bind $ui_diff <Button-1
> {focus
%W
}
3293 if {[is_enabled branch
]} {
3294 bind .
<$M1B-Key-n> branch_create
::dialog
3295 bind .
<$M1B-Key-N> branch_create
::dialog
3296 bind .
<$M1B-Key-o> branch_checkout
::dialog
3297 bind .
<$M1B-Key-O> branch_checkout
::dialog
3298 bind .
<$M1B-Key-m> merge
::dialog
3299 bind .
<$M1B-Key-M> merge
::dialog
3301 if {[is_enabled transport
]} {
3302 bind .
<$M1B-Key-p> do_push_anywhere
3303 bind .
<$M1B-Key-P> do_push_anywhere
3306 bind .
<Key-F5
> ui_do_rescan
3307 bind .
<$M1B-Key-r> ui_do_rescan
3308 bind .
<$M1B-Key-R> ui_do_rescan
3309 bind .
<$M1B-Key-s> do_signoff
3310 bind .
<$M1B-Key-S> do_signoff
3311 bind .
<$M1B-Key-t> do_add_selection
3312 bind .
<$M1B-Key-T> do_add_selection
3313 bind .
<$M1B-Key-i> do_add_all
3314 bind .
<$M1B-Key-I> do_add_all
3315 bind .
<$M1B-Key-minus> {show_less_context
;break}
3316 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3317 bind .
<$M1B-Key-equal> {show_more_context
;break}
3318 bind .
<$M1B-Key-plus> {show_more_context
;break}
3319 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3320 bind .
<$M1B-Key-Return> do_commit
3321 foreach i
[list
$ui_index $ui_workdir] {
3322 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
3323 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3324 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
3328 set file_lists
($ui_index) [list
]
3329 set file_lists
($ui_workdir) [list
]
3331 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3332 focus
-force $ui_comm
3334 # -- Warn the user about environmental problems. Cygwin's Tcl
3335 # does *not* pass its env array onto any processes it spawns.
3336 # This means that git processes get none of our environment.
3341 set msg
[mc
"Possible environment issues exist.
3343 The following environment variables are probably
3344 going to be ignored by any Git subprocess run
3348 foreach name
[array names env
] {
3349 switch
-regexp -- $name {
3350 {^GIT_INDEX_FILE$
} -
3351 {^GIT_OBJECT_DIRECTORY$
} -
3352 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3354 {^GIT_EXTERNAL_DIFF$
} -
3358 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3359 append msg
" - $name\n"
3362 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3363 append msg
" - $name\n"
3365 set suggest_user
$name
3369 if {$ignored_env > 0} {
3371 This is due to a known issue with the
3372 Tcl binary distributed by Cygwin."]
3374 if {$suggest_user ne
{}} {
3377 A good replacement for %s
3378 is placing values for the user.name and
3379 user.email settings into your personal
3385 unset ignored_env msg suggest_user name
3388 # -- Only initialize complex UI if we are going to stay running.
3390 if {[is_enabled transport
]} {
3393 set n
[.mbar.remote index end
]
3394 populate_remotes_menu
3395 set n
[expr {[.mbar.remote index end
] - $n}]
3397 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3398 .mbar.remote insert
$n separator
3403 if {[winfo exists
$ui_comm]} {
3404 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
3406 # -- If both our backup and message files exist use the
3407 # newer of the two files to initialize the buffer.
3409 if {$GITGUI_BCK_exists} {
3410 set m
[gitdir GITGUI_MSG
]
3411 if {[file isfile
$m]} {
3412 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3413 catch
{file delete
[gitdir GITGUI_MSG
]}
3415 $ui_comm delete
0.0 end
3417 $ui_comm edit modified false
3418 catch
{file delete
[gitdir GITGUI_BCK
]}
3419 set GITGUI_BCK_exists
0
3425 proc backup_commit_buffer
{} {
3426 global ui_comm GITGUI_BCK_exists
3428 set m
[$ui_comm edit modified
]
3429 if {$m ||
$GITGUI_BCK_exists} {
3430 set msg
[string trim
[$ui_comm get
0.0 end
]]
3431 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3434 if {$GITGUI_BCK_exists} {
3435 catch
{file delete
[gitdir GITGUI_BCK
]}
3436 set GITGUI_BCK_exists
0
3440 set fd
[open
[gitdir GITGUI_BCK
] w
]
3441 puts
-nonewline $fd $msg
3443 set GITGUI_BCK_exists
1
3447 $ui_comm edit modified false
3450 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3453 backup_commit_buffer
3455 # -- If the user has aspell available we can drive it
3456 # in pipe mode to spellcheck the commit message.
3458 set spell_cmd
[list |
]
3459 set spell_dict
[get_config gui.spellingdictionary
]
3460 lappend spell_cmd aspell
3461 if {$spell_dict ne
{}} {
3462 lappend spell_cmd
--master=$spell_dict
3464 lappend spell_cmd
--mode=none
3465 lappend spell_cmd
--encoding=utf-8
3466 lappend spell_cmd pipe
3467 if {$spell_dict eq
{none
}
3468 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3469 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3471 set ui_comm_spell
[spellcheck
::init \
3477 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3480 lock_index begin-read
3481 if {![winfo ismapped .
]} {
3485 if {[is_enabled initialamend
]} {
3491 if {[is_enabled nocommitmsg
]} {
3492 $ui_comm configure
-state disabled
-background gray
3495 if {[is_enabled multicommit
]} {
3498 if {[is_enabled retcode
]} {
3499 bind .
<Destroy
> {+terminate_me
%W
}
3501 if {$picked && [is_config_true gui.autoexplore
]} {