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
}
129 set _trace
[lsearch
-exact $argv --trace]
131 set argv
[lreplace
$argv $_trace $_trace]
147 return [eval [list
file join $_gitdir] $args]
150 proc gitexec
{args
} {
152 if {$_gitexec eq
{}} {
153 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
154 error
"Git not installed?\n\n$err"
157 set _gitexec
[exec cygpath \
162 set _gitexec
[file normalize
$_gitexec]
168 return [eval [list
file join $_gitexec] $args]
176 if {[tk windowingsystem
] eq
{aqua
}} {
183 if {$
::tcl_platform
(platform
) eq
{windows
}} {
191 if {$_iscygwin eq
{}} {
192 if {$
::tcl_platform
(platform
) eq
{windows
}} {
193 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
205 proc is_enabled
{option
} {
206 global enabled_options
207 if {[catch
{set on
$enabled_options($option)}]} {return 0}
211 proc enable_option
{option
} {
212 global enabled_options
213 set enabled_options
($option) 1
216 proc disable_option
{option
} {
217 global enabled_options
218 set enabled_options
($option) 0
221 ######################################################################
225 proc is_many_config
{name
} {
226 switch
-glob -- $name {
236 proc is_config_true
{name
} {
238 if {[catch
{set v
$repo_config($name)}]} {
240 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
247 proc get_config
{name
} {
249 if {[catch
{set v
$repo_config($name)}]} {
256 ######################################################################
260 proc _trace_exec
{cmd
} {
261 if {!$
::_trace
} return
267 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
275 proc _git_cmd {name} {
278 if {[catch {set v $_git_cmd_path($name)}]} {
282 --exec-path { return [list $::_git $name] }
285 set p [gitexec git-$name$::_search_exe]
286 if {[file exists $p]} {
288 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
289 # Try to determine what sort of magic will make
290 # git-$name go and do its thing, because native
291 # Tcl on Windows doesn't know it.
293 set p
[gitexec git-
$name]
298 switch
-glob -- [lindex
$s 0] {
300 #!*perl { set i perl }
301 #!*python { set i python }
302 default
{ error
"git-$name is not supported: $s" }
306 if {![info exists interp
]} {
307 set interp
[_which
$i]
310 error
"git-$name requires $i (not in PATH)"
312 set v
[concat
[list
$interp] [lrange
$s 1 end
] [list
$p]]
314 # Assume it is builtin to git somehow and we
315 # aren't actually able to see a file for it.
317 set v
[list $
::_git
$name]
319 set _git_cmd_path
($name) $v
324 proc _which
{what args
} {
325 global env _search_exe _search_path
327 if {$_search_path eq
{}} {
328 if {[is_Cygwin
] && [regexp
{^
(/|\.
:)} $env(PATH
)]} {
329 set _search_path
[split [exec cygpath \
335 } elseif
{[is_Windows
]} {
336 set gitguidir
[file dirname [info
script]]
337 regsub
-all ";" $gitguidir "\\;" gitguidir
338 set env
(PATH
) "$gitguidir;$env(PATH)"
339 set _search_path
[split $env(PATH
) {;}]
342 set _search_path
[split $env(PATH
) :]
347 if {[is_Windows
] && [lsearch
-exact $args -script] >= 0} {
350 set suffix
$_search_exe
353 foreach p
$_search_path {
354 set p
[file join $p $what$suffix]
355 if {[file exists
$p]} {
356 return [file normalize
$p]
362 proc _lappend_nice
{cmd_var
} {
366 if {![info exists _nice
]} {
367 set _nice
[_which nice
]
378 switch
-- [lindex
$args 0] {
389 set args
[lrange
$args 1 end
]
392 set cmdp
[_git_cmd
[lindex
$args 0]]
393 set args
[lrange
$args 1 end
]
395 _trace_exec
[concat
$opt $cmdp $args]
396 set result
[eval exec $opt $cmdp $args]
398 puts stderr
"< $result"
403 proc _open_stdout_stderr
{cmd
} {
406 set fd
[open
[concat
[list |
] $cmd] r
]
408 if { [lindex
$cmd end
] eq
{2>@
1}
409 && $err eq
{can not
find channel named
"1"}
411 # Older versions of Tcl 8.4 don't have this 2>@1 IO
412 # redirect operator. Fallback to |& cat for those.
413 # The command was not actually started, so its safe
414 # to try to start it a second time.
416 set fd
[open
[concat \
418 [lrange
$cmd 0 end-1
] \
425 fconfigure
$fd -eofchar {}
429 proc git_read
{args
} {
433 switch
-- [lindex
$args 0] {
448 set args
[lrange
$args 1 end
]
451 set cmdp
[_git_cmd
[lindex
$args 0]]
452 set args
[lrange
$args 1 end
]
454 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
457 proc git_write
{args
} {
461 switch
-- [lindex
$args 0] {
472 set args
[lrange
$args 1 end
]
475 set cmdp
[_git_cmd
[lindex
$args 0]]
476 set args
[lrange
$args 1 end
]
478 _trace_exec
[concat
$opt $cmdp $args]
479 return [open
[concat
[list |
] $opt $cmdp $args] w
]
482 proc githook_read
{hook_name args
} {
483 set pchook
[gitdir hooks
$hook_name]
486 # On Windows [file executable] might lie so we need to ask
487 # the shell if the hook is executable. Yes that's annoying.
491 if {![info exists interp
]} {
492 set interp
[_which sh
]
495 error
"hook execution requires sh (not in PATH)"
498 set scr
{if test -x "$1";then exec "$@";fi}
499 set sh_c
[list
$interp -c $scr $interp $pchook]
500 return [_open_stdout_stderr
[concat
$sh_c $args]]
503 if {[file executable
$pchook]} {
504 return [_open_stdout_stderr
[concat
[list
$pchook] $args]]
510 proc kill_file_process
{fd
} {
511 set process
[pid
$fd]
515 # Use a Cygwin-specific flag to allow killing
516 # native Windows processes
517 exec kill -f $process
524 proc gitattr
{path attr default
} {
525 if {[catch
{set r
[git check-attr
$attr -- $path]}]} {
528 set r
[join [lrange
[split $r :] 2 end
] :]
531 if {$r eq
{unspecified
}} {
538 regsub
-all ' $value "'\\''" value
542 proc load_current_branch {} {
543 global current_branch is_detached
545 set fd [open [gitdir HEAD] r]
546 if {[gets $fd ref] < 1} {
551 set pfx {ref: refs/heads/}
552 set len [string length $pfx]
553 if {[string equal -length $len $pfx $ref]} {
554 # We're on a branch. It might not exist. But
555 # HEAD looks good enough to be a branch.
557 set current_branch [string range $ref $len end]
560 # Assume this is a detached head.
562 set current_branch HEAD
567 auto_load tk_optionMenu
568 rename tk_optionMenu real__tkOptionMenu
569 proc tk_optionMenu {w varName args} {
570 set m [eval real__tkOptionMenu $w $varName $args]
571 $m configure -font font_ui
572 $w configure -font font_ui
576 proc rmsel_tag {text} {
578 -background [$text cget -background] \
579 -foreground [$text cget -foreground] \
581 $text tag conf in_sel -background lightgray
582 bind $text <Motion> break
587 bind . <Visibility> {
588 bind . <Visibility> {}
593 wm iconbitmap . -default $oguilib/git-gui.ico
594 set ::tk::AlwaysShowSelection 1
596 # Spoof an X11 display for SSH
597 if {![info exists env(DISPLAY)]} {
598 set env(DISPLAY) :9999
602 image create photo gitlogo -width 16 -height 16
604 gitlogo put #33CC33 -to 7 0 9 2
605 gitlogo put #33CC33 -to 4 2 12 4
606 gitlogo put #33CC33 -to 7 4 9 6
607 gitlogo put #CC3333 -to 4 6 12 8
608 gitlogo put gray26 -to 4 9 6 10
609 gitlogo put gray26 -to 3 10 6 12
610 gitlogo put gray26 -to 8 9 13 11
611 gitlogo put gray26 -to 8 11 10 12
612 gitlogo put gray26 -to 11 11 13 14
613 gitlogo put gray26 -to 3 12 5 14
614 gitlogo put gray26 -to 5 13
615 gitlogo put gray26 -to 10 13
616 gitlogo put gray26 -to 4 14 12 15
617 gitlogo put gray26 -to 5 15 11 16
620 wm iconphoto . -default gitlogo
624 ######################################################################
629 font create font_diff -family Courier -size 10
633 eval font configure font_ui [font actual [.dummy cget -font]]
637 font create font_uiitalic
638 font create font_uibold
639 font create font_diffbold
640 font create font_diffitalic
642 foreach class {Button Checkbutton Entry Label
643 Labelframe Listbox Menu Message
644 Radiobutton Spinbox Text} {
645 option add *$class.font font_ui
649 if {[is_Windows] || [is_MacOSX]} {
650 option add *Menu.tearOff 0
661 proc bind_button3 {w cmd} {
662 bind $w <Any-Button-3> $cmd
664 # Mac OS X sends Button-2 on right click through three-button mouse,
665 # or through trackpad right-clicking (two-finger touch + click).
666 bind $w <Any-Button-2> $cmd
667 bind $w <Control-Button-1> $cmd
671 proc apply_config {} {
672 global repo_config font_descs
674 foreach option $font_descs {
675 set name [lindex $option 0]
676 set font [lindex $option 1]
679 foreach {cn cv} $repo_config(gui.$name) {
680 if {$cn eq {-weight}} {
683 font configure $font $cn $cv
686 font configure $font -weight normal
689 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
691 foreach {cn cv} [font configure $font] {
692 font configure ${font}bold $cn $cv
693 font configure ${font}italic $cn $cv
695 font configure ${font}bold -weight bold
696 font configure ${font}italic -slant italic
700 set default_config(branch.autosetupmerge) true
701 set default_config(merge.tool) {}
702 set default_config(merge.keepbackup) true
703 set default_config(merge.diffstat) true
704 set default_config(merge.summary) false
705 set default_config(merge.verbosity) 2
706 set default_config(user.name) {}
707 set default_config(user.email) {}
709 set default_config(gui.encoding) [encoding system]
710 set default_config(gui.matchtrackingbranch) false
711 set default_config(gui.pruneduringfetch) false
712 set default_config(gui.trustmtime) false
713 set default_config(gui.fastcopyblame) false
714 set default_config(gui.copyblamethreshold) 40
715 set default_config(gui.blamehistoryctx) 7
716 set default_config(gui.diffcontext) 5
717 set default_config(gui.commitmsgwidth) 75
718 set default_config(gui.newbranchtemplate) {}
719 set default_config(gui.spellingdictionary) {}
720 set default_config(gui.fontui) [font configure font_ui]
721 set default_config(gui.fontdiff) [font configure font_diff]
723 {fontui font_ui {mc "Main Font
"}}
724 {fontdiff font_diff {mc "Diff
/Console Font
"}}
727 ######################################################################
731 set _git [_which git]
733 catch {wm withdraw .}
737 -title [mc "git-gui
: fatal error
"] \
738 -message [mc "Cannot
find git
in PATH.
"]
742 ######################################################################
746 if {[catch {set _git_version [git --version]} err]} {
747 catch {wm withdraw .}
751 -title [mc "git-gui
: fatal error
"] \
752 -message "Cannot determine Git version
:
756 [appname
] requires Git
1.5.0 or later.
"
759 if {![regsub {^git version } $_git_version {} _git_version]} {
760 catch {wm withdraw .}
764 -title [mc "git-gui
: fatal error
"] \
765 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
769 set _real_git_version $_git_version
770 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
771 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
772 regsub {\.rc[0-9]+$} $_git_version {} _git_version
773 regsub {\.GIT$} $_git_version {} _git_version
774 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
776 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
777 catch {wm withdraw .}
782 -title "[appname
]: warning
" \
783 -message [mc "Git version cannot be determined.
785 %s claims it is version
'%s'.
787 %s requires
at least Git
1.5.0 or later.
789 Assume
'%s' is version
1.5.0?
790 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
791 set _git_version 1.5.0
796 unset _real_git_version
798 proc git-version {args} {
801 switch [llength $args] {
807 set op [lindex $args 0]
808 set vr [lindex $args 1]
809 set cm [package vcompare $_git_version $vr]
810 return [expr $cm $op 0]
814 set type [lindex $args 0]
815 set name [lindex $args 1]
816 set parm [lindex $args 2]
817 set body [lindex $args 3]
819 if {($type ne {proc} && $type ne {method})} {
820 error "Invalid arguments to git-version
"
822 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
823 error "Last arm of
$type $name must be default
"
826 foreach {op vr cb} [lrange $body 0 end-2] {
827 if {[git-version $op $vr]} {
828 return [uplevel [list $type $name $parm $cb]]
832 return [uplevel [list $type $name $parm [lindex $body end]]]
836 error "git-version
>= x
"
842 if {[git-version < 1.5]} {
843 catch {wm withdraw .}
847 -title [mc "git-gui
: fatal error
"] \
848 -message "[appname
] requires Git
1.5.0 or later.
850 You are using
[git-version
]:
856 ######################################################################
858 ## configure our library
860 set idx [file join $oguilib tclIndex]
861 if {[catch {set fd [open $idx r]} err]} {
862 catch {wm withdraw .}
866 -title [mc "git-gui
: fatal error
"] \
870 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
872 while {[gets $fd n] >= 0} {
873 if {$n ne {} && ![string match #* $n]} {
885 if {[lsearch -exact $loaded $p] >= 0} continue
886 source [file join $oguilib $p]
891 set auto_path [concat [list $oguilib] $auto_path]
893 unset -nocomplain idx fd
895 ######################################################################
897 ## config file parsing
899 git-version proc _parse_config {arr_name args} {
906 [list git_read config] \
908 [list --null --list]]
909 fconfigure $fd_rc -translation binary
910 set buf [read $fd_rc]
913 foreach line [split $buf "\
0"] {
914 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
915 if {[is_many_config $name]} {
916 lappend arr($name) $value
918 set arr($name) $value
927 set fd_rc [eval [list git_read config --list] $args]
928 while {[gets $fd_rc line] >= 0} {
929 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
930 if {[is_many_config $name]} {
931 lappend arr($name) $value
933 set arr($name) $value
942 proc load_config {include_global} {
943 global repo_config global_config system_config default_config
945 if {$include_global} {
946 _parse_config system_config --system
947 _parse_config global_config --global
949 _parse_config repo_config
951 foreach name [array names default_config] {
952 if {[catch {set v $system_config($name)}]} {
953 set system_config($name) $default_config($name)
956 foreach name [array names system_config] {
957 if {[catch {set v $global_config($name)}]} {
958 set global_config($name) $system_config($name)
960 if {[catch {set v $repo_config($name)}]} {
961 set repo_config($name) $system_config($name)
966 ######################################################################
968 ## feature option selection
970 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
975 if {$subcommand eq {gui.sh}} {
978 if {$subcommand eq {gui} && [llength $argv] > 0} {
979 set subcommand [lindex $argv 0]
980 set argv [lrange $argv 1 end]
983 enable_option multicommit
985 enable_option transport
988 switch -- $subcommand {
993 disable_option multicommit
994 disable_option branch
995 disable_option transport
998 enable_option singlecommit
999 enable_option retcode
1001 disable_option multicommit
1002 disable_option branch
1003 disable_option transport
1005 while {[llength $argv] > 0} {
1006 set a [lindex $argv 0]
1009 enable_option initialamend
1012 enable_option nocommit
1013 enable_option nocommitmsg
1016 disable_option nocommitmsg
1023 set argv [lrange $argv 1 end]
1028 ######################################################################
1030 ## execution environment
1032 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1034 # Suggest our implementation of askpass, if none is set
1035 if {![info exists env(SSH_ASKPASS)]} {
1036 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1039 ######################################################################
1045 set _gitdir $env(GIT_DIR)
1049 set _gitdir [git rev-parse --git-dir]
1050 set _prefix [git rev-parse --show-prefix]
1054 choose_repository::pick
1057 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1058 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1060 if {![file isdirectory $_gitdir]} {
1061 catch {wm withdraw .}
1062 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1065 if {$_prefix ne {}} {
1066 regsub -all {[^/]+/} $_prefix ../ cdup
1067 if {[catch {cd $cdup} err]} {
1068 catch {wm withdraw .}
1069 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1073 } elseif {![is_enabled bare]} {
1074 if {[lindex [file split $_gitdir] end] ne {.git}} {
1075 catch {wm withdraw .}
1076 error_popup [strcat [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
1079 if {[catch {cd [file dirname $_gitdir]} err]} {
1080 catch {wm withdraw .}
1081 error_popup [strcat [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
1085 set _reponame [file split [file normalize $_gitdir]]
1086 if {[lindex $_reponame end] eq {.git}} {
1087 set _reponame [lindex $_reponame end-1]
1089 set _reponame [lindex $_reponame end]
1092 ######################################################################
1096 set current_diff_path {}
1097 set current_diff_side {}
1098 set diff_actions [list]
1102 set MERGE_HEAD [list]
1105 set current_branch {}
1107 set current_diff_path {}
1109 set is_conflict_diff 0
1110 set selected_commit_type new
1112 set nullid "0000000000000000000000000000000000000000"
1113 set nullid2 "0000000000000000000000000000000000000001"
1115 ######################################################################
1123 set disable_on_lock [list]
1124 set index_lock_type none
1126 proc lock_index {type} {
1127 global index_lock_type disable_on_lock
1129 if {$index_lock_type eq {none}} {
1130 set index_lock_type $type
1131 foreach w $disable_on_lock {
1132 uplevel #0 $w disabled
1135 } elseif {$index_lock_type eq "begin-
$type"} {
1136 set index_lock_type $type
1142 proc unlock_index {} {
1143 global index_lock_type disable_on_lock
1145 set index_lock_type none
1146 foreach w $disable_on_lock {
1147 uplevel #0 $w normal
1151 ######################################################################
1155 proc repository_state {ctvar hdvar mhvar} {
1156 global current_branch
1157 upvar $ctvar ct $hdvar hd $mhvar mh
1162 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1168 set merge_head [gitdir MERGE_HEAD]
1169 if {[file exists $merge_head]} {
1171 set fd_mh [open $merge_head r]
1172 while {[gets $fd_mh line] >= 0} {
1183 global PARENT empty_tree
1185 set p [lindex $PARENT 0]
1189 if {$empty_tree eq {}} {
1190 set empty_tree [git mktree << {}]
1195 proc force_amend {} {
1196 global selected_commit_type
1197 global HEAD PARENT MERGE_HEAD commit_type
1199 repository_state newType newHEAD newMERGE_HEAD
1202 set MERGE_HEAD $newMERGE_HEAD
1203 set commit_type $newType
1205 set selected_commit_type amend
1206 do_select_commit_type
1209 proc rescan {after {honor_trustmtime 1}} {
1210 global HEAD PARENT MERGE_HEAD commit_type
1211 global ui_index ui_workdir ui_comm
1212 global rescan_active file_states
1215 if {$rescan_active > 0 || ![lock_index read]} return
1217 repository_state newType newHEAD newMERGE_HEAD
1218 if {[string match amend* $commit_type]
1219 && $newType eq {normal}
1220 && $newHEAD eq $HEAD} {
1224 set MERGE_HEAD $newMERGE_HEAD
1225 set commit_type $newType
1228 array unset file_states
1230 if {!$::GITGUI_BCK_exists &&
1231 (![$ui_comm edit modified]
1232 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1233 if {[string match amend* $commit_type]} {
1234 } elseif {[load_message GITGUI_MSG]} {
1235 } elseif {[run_prepare_commit_msg_hook]} {
1236 } elseif {[load_message MERGE_MSG]} {
1237 } elseif {[load_message SQUASH_MSG]} {
1240 $ui_comm edit modified false
1243 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1244 rescan_stage2 {} $after
1247 ui_status [mc "Refreshing
file status...
"]
1248 set fd_rf [git_read update-index \
1254 fconfigure $fd_rf -blocking 0 -translation binary
1255 fileevent $fd_rf readable \
1256 [list rescan_stage2 $fd_rf $after]
1261 set is_git_info_exclude {}
1262 proc have_info_exclude {} {
1263 global is_git_info_exclude
1265 if {$is_git_info_exclude eq {}} {
1266 if {[catch {exec test -f [gitdir info exclude]}]} {
1267 set is_git_info_exclude 0
1269 set is_git_info_exclude 1
1272 return $is_git_info_exclude
1275 proc have_info_exclude {} {
1276 return [file readable [gitdir info exclude]]
1280 proc rescan_stage2 {fd after} {
1281 global rescan_active buf_rdi buf_rdf buf_rlo
1285 if {![eof $fd]} return
1289 set ls_others [list --exclude-per-directory=.gitignore]
1290 if {[have_info_exclude]} {
1291 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1293 set user_exclude [get_config core.excludesfile]
1294 if {$user_exclude ne {} && [file readable $user_exclude]} {
1295 lappend ls_others "--exclude-from=$user_exclude"
1303 ui_status [mc "Scanning
for modified files ...
"]
1304 set fd_di [git_read diff-index --cached -z [PARENT]]
1305 set fd_df [git_read diff-files -z]
1306 set fd_lo [eval git_read ls-files --others -z $ls_others]
1308 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1309 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1310 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1311 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1312 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1313 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1316 proc load_message {file} {
1319 set f [gitdir $file]
1320 if {[file isfile $f]} {
1321 if {[catch {set fd [open $f r]}]} {
1324 fconfigure $fd -eofchar {}
1325 set content [string trim [read $fd]]
1327 regsub -all -line {[ \r\t]+$} $content {} content
1328 $ui_comm delete 0.0 end
1329 $ui_comm insert end $content
1335 proc run_prepare_commit_msg_hook {} {
1338 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1339 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1340 # empty file but existant file.
1342 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1344 if {[file isfile [gitdir MERGE_MSG]]} {
1345 set pcm_source "merge
"
1346 set fd_mm [open [gitdir MERGE_MSG] r]
1347 puts -nonewline $fd_pcm [read $fd_mm]
1349 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1350 set pcm_source "squash
"
1351 set fd_sm [open [gitdir SQUASH_MSG] r]
1352 puts -nonewline $fd_pcm [read $fd_sm]
1360 set fd_ph [githook_read prepare-commit-msg \
1361 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1363 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1367 ui_status [mc "Calling prepare-commit-msg hook...
"]
1370 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1371 fileevent $fd_ph readable \
1372 [list prepare_commit_msg_hook_wait $fd_ph]
1377 proc prepare_commit_msg_hook_wait {fd_ph} {
1380 append pch_error [read $fd_ph]
1381 fconfigure $fd_ph -blocking 1
1383 if {[catch {close $fd_ph}]} {
1384 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1385 hook_failed_popup prepare-commit-msg $pch_error
1386 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1389 load_message PREPARE_COMMIT_MSG
1392 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1395 fconfigure $fd_ph -blocking 0
1396 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1399 proc read_diff_index {fd after} {
1402 append buf_rdi [read $fd]
1404 set n [string length $buf_rdi]
1406 set z1 [string first "\
0" $buf_rdi $c]
1407 if {$z1 == -1} break
1409 set z2 [string first "\
0" $buf_rdi $z1]
1410 if {$z2 == -1} break
1413 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1414 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1416 [encoding convertfrom $p] \
1418 [list [lindex $i 0] [lindex $i 2]] \
1424 set buf_rdi [string range $buf_rdi $c end]
1429 rescan_done $fd buf_rdi $after
1432 proc read_diff_files {fd after} {
1435 append buf_rdf [read $fd]
1437 set n [string length $buf_rdf]
1439 set z1 [string first "\
0" $buf_rdf $c]
1440 if {$z1 == -1} break
1442 set z2 [string first "\
0" $buf_rdf $z1]
1443 if {$z2 == -1} break
1446 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1447 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1449 [encoding convertfrom $p] \
1452 [list [lindex $i 0] [lindex $i 2]]
1457 set buf_rdf [string range $buf_rdf $c end]
1462 rescan_done $fd buf_rdf $after
1465 proc read_ls_others {fd after} {
1468 append buf_rlo [read $fd]
1469 set pck [split $buf_rlo "\
0"]
1470 set buf_rlo [lindex $pck end]
1471 foreach p [lrange $pck 0 end-1] {
1472 set p [encoding convertfrom $p]
1473 if {[string index $p end] eq {/}} {
1474 set p [string range $p 0 end-1]
1478 rescan_done $fd buf_rlo $after
1481 proc rescan_done {fd buf after} {
1482 global rescan_active current_diff_path
1483 global file_states repo_config
1486 if {![eof $fd]} return
1489 if {[incr rescan_active -1] > 0} return
1494 if {$current_diff_path ne {}} reshow_diff
1495 if {$current_diff_path eq {}} select_first_diff
1500 proc prune_selection {} {
1501 global file_states selected_paths
1503 foreach path [array names selected_paths] {
1504 if {[catch {set still_here $file_states($path)}]} {
1505 unset selected_paths($path)
1510 ######################################################################
1514 proc mapicon {w state path} {
1517 if {[catch {set r $all_icons($state$w)}]} {
1518 puts "error
: no icon
for $w state
={$state} $path"
1524 proc mapdesc {state path} {
1527 if {[catch {set r $all_descs($state)}]} {
1528 puts "error
: no desc
for state
={$state} $path"
1534 proc ui_status {msg} {
1536 if {[info exists main_status]} {
1537 $main_status show $msg
1541 proc ui_ready {{test {}}} {
1543 if {[info exists main_status]} {
1544 $main_status show [mc "Ready.
"] $test
1548 proc escape_path {path} {
1549 regsub -all {\\} $path "\\\\" path
1550 regsub -all "\n" $path "\\n
" path
1554 proc short_path {path} {
1555 return [escape_path [lindex [file split $path] end]]
1559 set null_sha1 [string repeat 0 40]
1561 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1562 global file_states next_icon_id null_sha1
1564 set s0 [string index $new_state 0]
1565 set s1 [string index $new_state 1]
1567 if {[catch {set info $file_states($path)}]} {
1569 set icon n[incr next_icon_id]
1571 set state [lindex $info 0]
1572 set icon [lindex $info 1]
1573 if {$head_info eq {}} {set head_info [lindex $info 2]}
1574 if {$index_info eq {}} {set index_info [lindex $info 3]}
1577 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1578 elseif {$s0 eq {_}} {set s0 _}
1580 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1581 elseif {$s1 eq {_}} {set s1 _}
1583 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1584 set head_info [list 0 $null_sha1]
1585 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1586 && $head_info eq {}} {
1587 set head_info $index_info
1590 set file_states($path) [list $s0$s1 $icon \
1591 $head_info $index_info \
1596 proc display_file_helper {w path icon_name old_m new_m} {
1599 if {$new_m eq {_}} {
1600 set lno [lsearch -sorted -exact $file_lists($w) $path]
1602 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1604 $w conf -state normal
1605 $w delete $lno.0 [expr {$lno + 1}].0
1606 $w conf -state disabled
1608 } elseif {$old_m eq {_} && $new_m ne {_}} {
1609 lappend file_lists($w) $path
1610 set file_lists($w) [lsort -unique $file_lists($w)]
1611 set lno [lsearch -sorted -exact $file_lists($w) $path]
1613 $w conf -state normal
1614 $w image create $lno.0 \
1615 -align center -padx 5 -pady 1 \
1617 -image [mapicon $w $new_m $path]
1618 $w insert $lno.1 "[escape_path
$path]\n"
1619 $w conf -state disabled
1620 } elseif {$old_m ne $new_m} {
1621 $w conf -state normal
1622 $w image conf $icon_name -image [mapicon $w $new_m $path]
1623 $w conf -state disabled
1627 proc display_file {path state} {
1628 global file_states selected_paths
1629 global ui_index ui_workdir
1631 set old_m [merge_state $path $state]
1632 set s $file_states($path)
1633 set new_m [lindex $s 0]
1634 set icon_name [lindex $s 1]
1636 set o [string index $old_m 0]
1637 set n [string index $new_m 0]
1644 display_file_helper $ui_index $path $icon_name $o $n
1646 if {[string index $old_m 0] eq {U}} {
1649 set o [string index $old_m 1]
1651 if {[string index $new_m 0] eq {U}} {
1654 set n [string index $new_m 1]
1656 display_file_helper $ui_workdir $path $icon_name $o $n
1658 if {$new_m eq {__}} {
1659 unset file_states($path)
1660 catch {unset selected_paths($path)}
1664 proc display_all_files_helper {w path icon_name m} {
1667 lappend file_lists($w) $path
1668 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1669 $w image create end \
1670 -align center -padx 5 -pady 1 \
1672 -image [mapicon $w $m $path]
1673 $w insert end "[escape_path
$path]\n"
1676 proc display_all_files {} {
1677 global ui_index ui_workdir
1678 global file_states file_lists
1681 $ui_index conf -state normal
1682 $ui_workdir conf -state normal
1684 $ui_index delete 0.0 end
1685 $ui_workdir delete 0.0 end
1688 set file_lists($ui_index) [list]
1689 set file_lists($ui_workdir) [list]
1691 foreach path [lsort [array names file_states]] {
1692 set s $file_states($path)
1694 set icon_name [lindex $s 1]
1696 set s [string index $m 0]
1697 if {$s ne {U} && $s ne {_}} {
1698 display_all_files_helper $ui_index $path \
1702 if {[string index $m 0] eq {U}} {
1705 set s [string index $m 1]
1708 display_all_files_helper $ui_workdir $path \
1713 $ui_index conf -state disabled
1714 $ui_workdir conf -state disabled
1717 ######################################################################
1722 #define mask_width 14
1723 #define mask_height 15
1724 static unsigned char mask_bits[] = {
1725 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1726 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1727 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1730 image create bitmap file_plain -background white -foreground black -data {
1731 #define plain_width 14
1732 #define plain_height 15
1733 static unsigned char plain_bits[] = {
1734 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1735 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1736 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1737 } -maskdata $filemask
1739 image create bitmap file_mod -background white -foreground blue -data {
1740 #define mod_width 14
1741 #define mod_height 15
1742 static unsigned char mod_bits[] = {
1743 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1744 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1745 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1746 } -maskdata $filemask
1748 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1749 #define file_fulltick_width 14
1750 #define file_fulltick_height 15
1751 static unsigned char file_fulltick_bits
[] = {
1752 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1753 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1754 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1755 } -maskdata $filemask
1757 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1758 #define parttick_width 14
1759 #define parttick_height 15
1760 static unsigned char parttick_bits
[] = {
1761 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1762 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1763 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1764 } -maskdata $filemask
1766 image create bitmap file_question
-background white
-foreground black
-data {
1767 #define file_question_width 14
1768 #define file_question_height 15
1769 static unsigned char file_question_bits
[] = {
1770 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1771 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1772 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1773 } -maskdata $filemask
1775 image create bitmap file_removed
-background white
-foreground red
-data {
1776 #define file_removed_width 14
1777 #define file_removed_height 15
1778 static unsigned char file_removed_bits
[] = {
1779 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1780 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1781 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1782 } -maskdata $filemask
1784 image create bitmap file_merge
-background white
-foreground blue
-data {
1785 #define file_merge_width 14
1786 #define file_merge_height 15
1787 static unsigned char file_merge_bits
[] = {
1788 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1789 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1790 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1791 } -maskdata $filemask
1793 image create bitmap file_statechange
-background white
-foreground green
-data {
1794 #define file_merge_width 14
1795 #define file_merge_height 15
1796 static unsigned char file_statechange_bits
[] = {
1797 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1798 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1799 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1800 } -maskdata $filemask
1802 set ui_index .vpane.files.index.list
1803 set ui_workdir .vpane.files.workdir.list
1805 set all_icons
(_
$ui_index) file_plain
1806 set all_icons
(A
$ui_index) file_fulltick
1807 set all_icons
(M
$ui_index) file_fulltick
1808 set all_icons
(D
$ui_index) file_removed
1809 set all_icons
(U
$ui_index) file_merge
1810 set all_icons
(T
$ui_index) file_statechange
1812 set all_icons
(_
$ui_workdir) file_plain
1813 set all_icons
(M
$ui_workdir) file_mod
1814 set all_icons
(D
$ui_workdir) file_question
1815 set all_icons
(U
$ui_workdir) file_merge
1816 set all_icons
(O
$ui_workdir) file_plain
1817 set all_icons
(T
$ui_workdir) file_statechange
1819 set max_status_desc
0
1821 {__
{mc
"Unmodified"}}
1823 {_M
{mc
"Modified, not staged"}}
1824 {M_
{mc
"Staged for commit"}}
1825 {MM
{mc
"Portions staged for commit"}}
1826 {MD
{mc
"Staged for commit, missing"}}
1828 {_T
{mc
"File type changed, not staged"}}
1829 {T_
{mc
"File type changed, staged"}}
1831 {_O
{mc
"Untracked, not staged"}}
1832 {A_
{mc
"Staged for commit"}}
1833 {AM
{mc
"Portions staged for commit"}}
1834 {AD
{mc
"Staged for commit, missing"}}
1837 {D_
{mc
"Staged for removal"}}
1838 {DO
{mc
"Staged for removal, still present"}}
1840 {_U
{mc
"Requires merge resolution"}}
1841 {U_
{mc
"Requires merge resolution"}}
1842 {UU
{mc
"Requires merge resolution"}}
1843 {UM
{mc
"Requires merge resolution"}}
1844 {UD
{mc
"Requires merge resolution"}}
1845 {UT
{mc
"Requires merge resolution"}}
1847 set text
[eval [lindex
$i 1]]
1848 if {$max_status_desc < [string length
$text]} {
1849 set max_status_desc
[string length
$text]
1851 set all_descs
([lindex
$i 0]) $text
1855 ######################################################################
1859 proc scrollbar2many
{list mode args
} {
1860 foreach w
$list {eval $w $mode $args}
1863 proc many2scrollbar
{list mode sb top bottom
} {
1864 $sb set $top $bottom
1865 foreach w
$list {$w $mode moveto
$top}
1868 proc incr_font_size
{font
{amt
1}} {
1869 set sz
[font configure
$font -size]
1871 font configure
$font -size $sz
1872 font configure
${font}bold
-size $sz
1873 font configure
${font}italic
-size $sz
1876 ######################################################################
1880 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1882 proc do_gitk
{revs
} {
1883 # -- Always start gitk through whatever we were loaded with. This
1884 # lets us bypass using shell process on Windows systems.
1886 set exe
[_which gitk
-script]
1887 set cmd
[list
[info nameofexecutable
] $exe]
1889 error_popup
[mc
"Couldn't find gitk in PATH"]
1893 if {[info exists env
(GIT_DIR
)]} {
1894 set old_GIT_DIR
$env(GIT_DIR
)
1900 cd [file dirname [gitdir
]]
1901 set env
(GIT_DIR
) [file tail [gitdir
]]
1903 eval exec $cmd $revs &
1905 if {$old_GIT_DIR eq
{}} {
1908 set env
(GIT_DIR
) $old_GIT_DIR
1912 ui_status $
::starting_gitk_msg
1914 ui_ready
$starting_gitk_msg
1919 proc do_explore
{} {
1921 if {[is_Cygwin
] ||
[is_Windows
]} {
1922 set explorer
"explorer.exe"
1923 } elseif
{[is_MacOSX
]} {
1926 # freedesktop.org-conforming system is our best shot
1927 set explorer
"xdg-open"
1929 eval exec $explorer [file dirname [gitdir
]] &
1935 proc terminate_me
{win
} {
1937 if {$win ne
{.
}} return
1941 proc do_quit
{{rc
{1}}} {
1942 global ui_comm is_quitting repo_config commit_type
1943 global GITGUI_BCK_exists GITGUI_BCK_i
1944 global ui_comm_spell
1947 if {$is_quitting} return
1950 if {[winfo exists
$ui_comm]} {
1951 # -- Stash our current commit buffer.
1953 set save
[gitdir GITGUI_MSG
]
1954 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1955 file rename
-force [gitdir GITGUI_BCK
] $save
1956 set GITGUI_BCK_exists
0
1958 set msg
[string trim
[$ui_comm get
0.0 end
]]
1959 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1960 if {(![string match amend
* $commit_type]
1961 ||
[$ui_comm edit modified
])
1964 set fd
[open
$save w
]
1965 puts
-nonewline $fd $msg
1969 catch
{file delete
$save}
1973 # -- Cancel our spellchecker if its running.
1975 if {[info exists ui_comm_spell
]} {
1979 # -- Remove our editor backup, its not needed.
1981 after cancel
$GITGUI_BCK_i
1982 if {$GITGUI_BCK_exists} {
1983 catch
{file delete
[gitdir GITGUI_BCK
]}
1986 # -- Stash our current window geometry into this repository.
1988 set cfg_geometry
[list
]
1989 lappend cfg_geometry
[wm geometry .
]
1990 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
1991 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
1992 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1995 if {$cfg_geometry ne
$rc_geometry} {
1996 catch
{git config gui.geometry
$cfg_geometry}
2008 proc ui_do_rescan
{} {
2009 rescan
{force_first_diff
; ui_ready
}
2017 global next_diff_p next_diff_w next_diff_i
2018 show_diff
$next_diff_p $next_diff_w {}
2021 proc find_anchor_pos
{lst name
} {
2022 set lid
[lsearch
-sorted -exact $lst $name]
2026 foreach lname
$lst {
2027 if {$lname >= $name} break
2035 proc find_file_from
{flist idx delta path mmask
} {
2038 set len
[llength
$flist]
2039 while {$idx >= 0 && $idx < $len} {
2040 set name
[lindex
$flist $idx]
2042 if {$name ne
$path && [info exists file_states
($name)]} {
2043 set state
[lindex
$file_states($name) 0]
2045 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2056 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2057 global next_diff_p next_diff_w next_diff_i
2058 global file_lists ui_index ui_workdir
2060 set flist
$file_lists($w)
2062 set lno
[find_anchor_pos
$flist $path]
2067 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2068 if {$w eq
$ui_index} {
2071 set mmask
"$mmask\$"
2075 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2078 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2083 set next_diff_p
[lindex
$flist $idx]
2084 set next_diff_i
[expr {$idx+1}]
2091 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2092 global current_diff_path
2094 if {$path ne
$current_diff_path} {
2096 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2099 return {reshow_diff
;}
2103 proc select_first_diff
{} {
2106 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2107 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2112 proc force_first_diff
{} {
2113 global current_diff_path
2115 if {[info exists file_states
($current_diff_path)]} {
2116 set state
[lindex
$file_states($current_diff_path) 0]
2118 if {[string index
$state 1] ne
{O
}} return
2124 proc toggle_or_diff
{w x y
} {
2125 global file_states file_lists current_diff_path ui_index ui_workdir
2126 global last_clicked selected_paths
2128 set pos
[split [$w index @
$x,$y] .
]
2129 set lno
[lindex
$pos 0]
2130 set col [lindex
$pos 1]
2131 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2137 set last_clicked
[list
$w $lno]
2138 array
unset selected_paths
2139 $ui_index tag remove in_sel
0.0 end
2140 $ui_workdir tag remove in_sel
0.0 end
2142 # Determine the state of the file
2143 if {[info exists file_states
($path)]} {
2144 set state
[lindex
$file_states($path) 0]
2149 # Restage the file, or simply show the diff
2150 if {$col == 0 && $y > 1} {
2151 # Conflicts need special handling
2152 if {[string first
{U
} $state] >= 0} {
2153 # $w must always be $ui_workdir, but...
2154 if {$w ne
$ui_workdir} { set lno
{} }
2155 merge_stage_workdir
$path $lno
2159 if {[string index
$state 1] eq
{O
}} {
2165 set after
[next_diff_after_action
$w $path $lno $mmask]
2167 if {$w eq
$ui_index} {
2169 "Unstaging [short_path $path] from commit" \
2171 [concat
$after [list ui_ready
]]
2172 } elseif
{$w eq
$ui_workdir} {
2174 "Adding [short_path $path]" \
2176 [concat
$after [list ui_ready
]]
2179 show_diff
$path $w $lno
2183 proc add_one_to_selection
{w x y
} {
2184 global file_lists last_clicked selected_paths
2186 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2187 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2193 if {$last_clicked ne
{}
2194 && [lindex
$last_clicked 0] ne
$w} {
2195 array
unset selected_paths
2196 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2199 set last_clicked
[list
$w $lno]
2200 if {[catch
{set in_sel
$selected_paths($path)}]} {
2204 unset selected_paths
($path)
2205 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2207 set selected_paths
($path) 1
2208 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2212 proc add_range_to_selection
{w x y
} {
2213 global file_lists last_clicked selected_paths
2215 if {[lindex
$last_clicked 0] ne
$w} {
2216 toggle_or_diff
$w $x $y
2220 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2221 set lc
[lindex
$last_clicked 1]
2230 foreach path
[lrange
$file_lists($w) \
2231 [expr {$begin - 1}] \
2232 [expr {$end - 1}]] {
2233 set selected_paths
($path) 1
2235 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2238 proc show_more_context
{} {
2240 if {$repo_config(gui.diffcontext
) < 99} {
2241 incr repo_config
(gui.diffcontext
)
2246 proc show_less_context
{} {
2248 if {$repo_config(gui.diffcontext
) > 1} {
2249 incr repo_config
(gui.diffcontext
) -1
2254 ######################################################################
2264 menu .mbar
-tearoff 0
2265 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2266 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2267 if {[is_enabled branch
]} {
2268 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2270 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2271 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2273 if {[is_enabled transport
]} {
2274 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2275 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2277 . configure
-menu .mbar
2279 # -- Repository Menu
2281 menu .mbar.repository
2283 .mbar.repository add
command \
2284 -label [mc
"Explore Working Copy"] \
2285 -command {do_explore
}
2286 .mbar.repository add separator
2288 .mbar.repository add
command \
2289 -label [mc
"Browse Current Branch's Files"] \
2290 -command {browser
::new
$current_branch}
2291 set ui_browse_current
[.mbar.repository index last
]
2292 .mbar.repository add
command \
2293 -label [mc
"Browse Branch Files..."] \
2294 -command browser_open
::dialog
2295 .mbar.repository add separator
2297 .mbar.repository add
command \
2298 -label [mc
"Visualize Current Branch's History"] \
2299 -command {do_gitk
$current_branch}
2300 set ui_visualize_current
[.mbar.repository index last
]
2301 .mbar.repository add
command \
2302 -label [mc
"Visualize All Branch History"] \
2303 -command {do_gitk
--all}
2304 .mbar.repository add separator
2306 proc current_branch_write
{args
} {
2307 global current_branch
2308 .mbar.repository entryconf $
::ui_browse_current \
2309 -label [mc
"Browse %s's Files" $current_branch]
2310 .mbar.repository entryconf $
::ui_visualize_current \
2311 -label [mc
"Visualize %s's History" $current_branch]
2313 trace add variable current_branch
write current_branch_write
2315 if {[is_enabled multicommit
]} {
2316 .mbar.repository add
command -label [mc
"Database Statistics"] \
2319 .mbar.repository add
command -label [mc
"Compress Database"] \
2322 .mbar.repository add
command -label [mc
"Verify Database"] \
2323 -command do_fsck_objects
2325 .mbar.repository add separator
2328 .mbar.repository add
command \
2329 -label [mc
"Create Desktop Icon"] \
2330 -command do_cygwin_shortcut
2331 } elseif
{[is_Windows
]} {
2332 .mbar.repository add
command \
2333 -label [mc
"Create Desktop Icon"] \
2334 -command do_windows_shortcut
2335 } elseif
{[is_MacOSX
]} {
2336 .mbar.repository add
command \
2337 -label [mc
"Create Desktop Icon"] \
2338 -command do_macosx_app
2343 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2345 .mbar.repository add
command -label [mc Quit
] \
2353 .mbar.edit add
command -label [mc Undo
] \
2354 -command {catch
{[focus
] edit undo
}} \
2356 .mbar.edit add
command -label [mc Redo
] \
2357 -command {catch
{[focus
] edit redo
}} \
2359 .mbar.edit add separator
2360 .mbar.edit add
command -label [mc Cut
] \
2361 -command {catch
{tk_textCut
[focus
]}} \
2363 .mbar.edit add
command -label [mc Copy
] \
2364 -command {catch
{tk_textCopy
[focus
]}} \
2366 .mbar.edit add
command -label [mc Paste
] \
2367 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2369 .mbar.edit add
command -label [mc Delete
] \
2370 -command {catch
{[focus
] delete sel.first sel.last
}} \
2372 .mbar.edit add separator
2373 .mbar.edit add
command -label [mc
"Select All"] \
2374 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2379 if {[is_enabled branch
]} {
2382 .mbar.branch add
command -label [mc
"Create..."] \
2383 -command branch_create
::dialog \
2385 lappend disable_on_lock
[list .mbar.branch entryconf \
2386 [.mbar.branch index last
] -state]
2388 .mbar.branch add
command -label [mc
"Checkout..."] \
2389 -command branch_checkout
::dialog \
2391 lappend disable_on_lock
[list .mbar.branch entryconf \
2392 [.mbar.branch index last
] -state]
2394 .mbar.branch add
command -label [mc
"Rename..."] \
2395 -command branch_rename
::dialog
2396 lappend disable_on_lock
[list .mbar.branch entryconf \
2397 [.mbar.branch index last
] -state]
2399 .mbar.branch add
command -label [mc
"Delete..."] \
2400 -command branch_delete
::dialog
2401 lappend disable_on_lock
[list .mbar.branch entryconf \
2402 [.mbar.branch index last
] -state]
2404 .mbar.branch add
command -label [mc
"Reset..."] \
2405 -command merge
::reset_hard
2406 lappend disable_on_lock
[list .mbar.branch entryconf \
2407 [.mbar.branch index last
] -state]
2412 proc commit_btn_caption
{} {
2413 if {[is_enabled nocommit
]} {
2416 return [mc Commit@@verb
]
2420 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2423 if {![is_enabled nocommit
]} {
2424 .mbar.commit add radiobutton \
2425 -label [mc
"New Commit"] \
2426 -command do_select_commit_type \
2427 -variable selected_commit_type \
2429 lappend disable_on_lock \
2430 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2432 .mbar.commit add radiobutton \
2433 -label [mc
"Amend Last Commit"] \
2434 -command do_select_commit_type \
2435 -variable selected_commit_type \
2437 lappend disable_on_lock \
2438 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2440 .mbar.commit add separator
2443 .mbar.commit add
command -label [mc Rescan
] \
2444 -command ui_do_rescan \
2446 lappend disable_on_lock \
2447 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2449 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2450 -command do_add_selection \
2452 lappend disable_on_lock \
2453 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2455 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2456 -command do_add_all \
2458 lappend disable_on_lock \
2459 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2461 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2462 -command do_unstage_selection
2463 lappend disable_on_lock \
2464 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2466 .mbar.commit add
command -label [mc
"Revert Changes"] \
2467 -command do_revert_selection
2468 lappend disable_on_lock \
2469 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2471 .mbar.commit add separator
2473 .mbar.commit add
command -label [mc
"Show Less Context"] \
2474 -command show_less_context \
2475 -accelerator $M1T-\
-
2477 .mbar.commit add
command -label [mc
"Show More Context"] \
2478 -command show_more_context \
2481 .mbar.commit add separator
2483 if {![is_enabled nocommitmsg
]} {
2484 .mbar.commit add
command -label [mc
"Sign Off"] \
2485 -command do_signoff \
2489 .mbar.commit add
command -label [commit_btn_caption
] \
2490 -command do_commit \
2491 -accelerator $M1T-Return
2492 lappend disable_on_lock \
2493 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2498 if {[is_enabled branch
]} {
2500 .mbar.merge add
command -label [mc
"Local Merge..."] \
2501 -command merge
::dialog \
2503 lappend disable_on_lock \
2504 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2505 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2506 -command merge
::reset_hard
2507 lappend disable_on_lock \
2508 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2513 if {[is_enabled transport
]} {
2516 .mbar.remote add
command \
2517 -label [mc
"Add..."] \
2518 -command remote_add
::dialog \
2520 .mbar.remote add
command \
2521 -label [mc
"Push..."] \
2522 -command do_push_anywhere \
2524 .mbar.remote add
command \
2525 -label [mc
"Delete Branch..."] \
2526 -command remote_branch_delete
::dialog
2530 # -- Apple Menu (Mac OS X only)
2532 .mbar add cascade
-label Apple
-menu .mbar.apple
2535 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2537 .mbar.apple add separator
2538 .mbar.apple add
command \
2539 -label [mc
"Preferences..."] \
2540 -command do_options \
2542 bind .
<$M1B-,> do_options
2546 .mbar.edit add separator
2547 .mbar.edit add
command -label [mc
"Options..."] \
2553 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2557 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2562 set doc_path
[file dirname [gitexec
]]
2563 set doc_path
[file join $doc_path Documentation index.html
]
2566 set doc_path
[exec cygpath
--mixed $doc_path]
2569 if {[file isfile
$doc_path]} {
2570 set doc_url
"file:$doc_path"
2572 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2575 proc start_browser
{url
} {
2576 git
"web--browse" $url
2579 .mbar.
help add
command -label [mc
"Online Documentation"] \
2580 -command [list start_browser
$doc_url]
2582 .mbar.
help add
command -label [mc
"Show SSH Key"] \
2585 unset doc_path doc_url
2587 # -- Standard bindings
2589 wm protocol . WM_DELETE_WINDOW do_quit
2590 bind all
<$M1B-Key-q> do_quit
2591 bind all
<$M1B-Key-Q> do_quit
2592 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2593 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2595 set subcommand_args
{}
2597 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2601 # -- Not a normal commit type invocation? Do that instead!
2603 switch
-- $subcommand {
2606 if {$subcommand eq
"blame"} {
2607 set subcommand_args
{[--line=<num
>] rev? path
}
2609 set subcommand_args
{rev? path
}
2611 if {$argv eq
{}} usage
2617 if {$is_path ||
[file exists
$_prefix$a]} {
2618 if {$path ne
{}} usage
2621 } elseif
{$a eq
{--}} {
2623 if {$head ne
{}} usage
2628 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
2629 if {$jump_spec ne
{} ||
$head ne
{}} usage
2630 set jump_spec
[list
$lnum]
2631 } elseif
{$head eq
{}} {
2632 if {$head ne
{}} usage
2641 if {$head ne
{} && $path eq
{}} {
2642 set path
$_prefix$head
2649 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2651 set head [git rev-parse
--verify $head]
2657 set current_branch
$head
2660 switch
-- $subcommand {
2662 if {$jump_spec ne
{}} usage
2664 if {$path ne
{} && [file isdirectory
$path]} {
2665 set head $current_branch
2671 browser
::new
$head $path
2674 if {$head eq
{} && ![file exists
$path]} {
2675 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2678 blame
::new
$head $path $jump_spec
2685 if {[llength
$argv] != 0} {
2686 puts
-nonewline stderr
"usage: $argv0"
2687 if {$subcommand ne
{gui
}
2688 && [file tail $argv0] ne
"git-$subcommand"} {
2689 puts
-nonewline stderr
" $subcommand"
2694 # fall through to setup UI for commits
2697 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2708 -text [mc
"Current Branch:"] \
2712 -textvariable current_branch \
2715 pack .branch.l1
-side left
2716 pack .branch.cb
-side left
-fill x
2717 pack .branch
-side top
-fill x
2719 # -- Main Window Layout
2721 panedwindow .vpane
-orient horizontal
2722 panedwindow .vpane.files
-orient vertical
2723 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2724 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2726 # -- Index File List
2728 frame .vpane.files.index
-height 100 -width 200
2729 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Commit)"] \
2730 -background lightgreen
-foreground black
2731 text
$ui_index -background white
-foreground black \
2733 -width 20 -height 10 \
2735 -cursor $cursor_ptr \
2736 -xscrollcommand {.vpane.files.index.sx
set} \
2737 -yscrollcommand {.vpane.files.index.sy
set} \
2739 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2740 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2741 pack .vpane.files.index.title
-side top
-fill x
2742 pack .vpane.files.index.sx
-side bottom
-fill x
2743 pack .vpane.files.index.sy
-side right
-fill y
2744 pack
$ui_index -side left
-fill both
-expand 1
2746 # -- Working Directory File List
2748 frame .vpane.files.workdir
-height 100 -width 200
2749 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
2750 -background lightsalmon
-foreground black
2751 text
$ui_workdir -background white
-foreground black \
2753 -width 20 -height 10 \
2755 -cursor $cursor_ptr \
2756 -xscrollcommand {.vpane.files.workdir.sx
set} \
2757 -yscrollcommand {.vpane.files.workdir.sy
set} \
2759 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2760 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2761 pack .vpane.files.workdir.title
-side top
-fill x
2762 pack .vpane.files.workdir.sx
-side bottom
-fill x
2763 pack .vpane.files.workdir.sy
-side right
-fill y
2764 pack
$ui_workdir -side left
-fill both
-expand 1
2766 .vpane.files add .vpane.files.workdir
-sticky nsew
2767 .vpane.files add .vpane.files.index
-sticky nsew
2769 foreach i
[list
$ui_index $ui_workdir] {
2771 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2775 # -- Diff and Commit Area
2777 frame .vpane.lower
-height 300 -width 400
2778 frame .vpane.lower.commarea
2779 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2780 pack .vpane.lower.
diff -fill both
-expand 1
2781 pack .vpane.lower.commarea
-side bottom
-fill x
2782 .vpane add .vpane.lower
-sticky nsew
2784 # -- Commit Area Buttons
2786 frame .vpane.lower.commarea.buttons
2787 label .vpane.lower.commarea.buttons.l
-text {} \
2790 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2791 pack .vpane.lower.commarea.buttons
-side left
-fill y
2793 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2794 -command ui_do_rescan
2795 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2796 lappend disable_on_lock \
2797 {.vpane.lower.commarea.buttons.rescan conf
-state}
2799 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2801 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2802 lappend disable_on_lock \
2803 {.vpane.lower.commarea.buttons.incall conf
-state}
2805 if {![is_enabled nocommitmsg
]} {
2806 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2808 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2811 button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
2813 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2814 lappend disable_on_lock \
2815 {.vpane.lower.commarea.buttons.commit conf
-state}
2817 if {![is_enabled nocommit
]} {
2818 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2819 -command do_push_anywhere
2820 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2823 # -- Commit Message Buffer
2825 frame .vpane.lower.commarea.buffer
2826 frame .vpane.lower.commarea.buffer.header
2827 set ui_comm .vpane.lower.commarea.buffer.t
2828 set ui_coml .vpane.lower.commarea.buffer.header.l
2830 if {![is_enabled nocommit
]} {
2831 radiobutton .vpane.lower.commarea.buffer.header.new \
2832 -text [mc
"New Commit"] \
2833 -command do_select_commit_type \
2834 -variable selected_commit_type \
2836 lappend disable_on_lock \
2837 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2838 radiobutton .vpane.lower.commarea.buffer.header.amend \
2839 -text [mc
"Amend Last Commit"] \
2840 -command do_select_commit_type \
2841 -variable selected_commit_type \
2843 lappend disable_on_lock \
2844 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2850 proc trace_commit_type
{varname args
} {
2851 global ui_coml commit_type
2852 switch
-glob -- $commit_type {
2853 initial
{set txt
[mc
"Initial Commit Message:"]}
2854 amend
{set txt
[mc
"Amended Commit Message:"]}
2855 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2856 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2857 merge
{set txt
[mc
"Merge Commit Message:"]}
2858 * {set txt
[mc
"Commit Message:"]}
2860 $ui_coml conf
-text $txt
2862 trace add variable commit_type
write trace_commit_type
2863 pack
$ui_coml -side left
-fill x
2865 if {![is_enabled nocommit
]} {
2866 pack .vpane.lower.commarea.buffer.header.amend
-side right
2867 pack .vpane.lower.commarea.buffer.header.new
-side right
2870 text
$ui_comm -background white
-foreground black \
2874 -autoseparators true \
2876 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
2878 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2879 scrollbar .vpane.lower.commarea.buffer.sby \
2880 -command [list
$ui_comm yview
]
2881 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2882 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2883 pack
$ui_comm -side left
-fill y
2884 pack .vpane.lower.commarea.buffer
-side left
-fill y
2886 # -- Commit Message Buffer Context Menu
2888 set ctxm .vpane.lower.commarea.buffer.ctxm
2889 menu
$ctxm -tearoff 0
2892 -command {tk_textCut
$ui_comm}
2895 -command {tk_textCopy
$ui_comm}
2898 -command {tk_textPaste
$ui_comm}
2900 -label [mc Delete
] \
2901 -command {$ui_comm delete sel.first sel.last
}
2904 -label [mc
"Select All"] \
2905 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2907 -label [mc
"Copy All"] \
2909 $ui_comm tag add sel
0.0 end
2910 tk_textCopy
$ui_comm
2911 $ui_comm tag remove sel
0.0 end
2915 -label [mc
"Sign Off"] \
2917 set ui_comm_ctxm
$ctxm
2921 proc trace_current_diff_path
{varname args
} {
2922 global current_diff_path diff_actions file_states
2923 if {$current_diff_path eq
{}} {
2929 set p
$current_diff_path
2930 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2932 set p
[escape_path
$p]
2936 .vpane.lower.
diff.header.status configure
-text $s
2937 .vpane.lower.
diff.header.
file configure
-text $f
2938 .vpane.lower.
diff.header.path configure
-text $p
2939 foreach w
$diff_actions {
2943 trace add variable current_diff_path
write trace_current_diff_path
2945 frame .vpane.lower.
diff.header
-background gold
2946 label .vpane.lower.
diff.header.status \
2949 -width $max_status_desc \
2952 label .vpane.lower.
diff.header.
file \
2957 label .vpane.lower.
diff.header.path \
2962 pack .vpane.lower.
diff.header.status
-side left
2963 pack .vpane.lower.
diff.header.
file -side left
2964 pack .vpane.lower.
diff.header.path
-fill x
2965 set ctxm .vpane.lower.
diff.header.ctxm
2966 menu
$ctxm -tearoff 0
2974 -- $current_diff_path
2976 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2977 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2981 frame .vpane.lower.
diff.body
2982 set ui_diff .vpane.lower.
diff.body.t
2983 text
$ui_diff -background white
-foreground black \
2985 -width 80 -height 15 -wrap none \
2987 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2988 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2990 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2991 -command [list
$ui_diff xview
]
2992 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2993 -command [list
$ui_diff yview
]
2994 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2995 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2996 pack
$ui_diff -side left
-fill both
-expand 1
2997 pack .vpane.lower.
diff.header
-side top
-fill x
2998 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
3000 $ui_diff tag conf d_cr
-elide true
3001 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
3002 $ui_diff tag conf d_
+ -foreground {#00a000}
3003 $ui_diff tag conf d_-
-foreground red
3005 $ui_diff tag conf d_
++ -foreground {#00a000}
3006 $ui_diff tag conf d_--
-foreground red
3007 $ui_diff tag conf d_
+s \
3008 -foreground {#00a000} \
3009 -background {#e2effa}
3010 $ui_diff tag conf d_-s \
3012 -background {#e2effa}
3013 $ui_diff tag conf d_s
+ \
3014 -foreground {#00a000} \
3016 $ui_diff tag conf d_s- \
3020 $ui_diff tag conf d
<<<<<<< \
3021 -foreground orange \
3023 $ui_diff tag conf d
======= \
3024 -foreground orange \
3026 $ui_diff tag conf d
>>>>>>> \
3027 -foreground orange \
3030 $ui_diff tag raise sel
3032 # -- Diff Body Context Menu
3035 proc create_common_diff_popup
{ctxm
} {
3037 -label [mc
"Show Less Context"] \
3038 -command show_less_context
3039 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3041 -label [mc
"Show More Context"] \
3042 -command show_more_context
3043 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3046 -label [mc Refresh
] \
3047 -command reshow_diff
3048 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3051 -command {tk_textCopy
$ui_diff}
3052 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3054 -label [mc
"Select All"] \
3055 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3056 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3058 -label [mc
"Copy All"] \
3060 $ui_diff tag add sel
0.0 end
3061 tk_textCopy
$ui_diff
3062 $ui_diff tag remove sel
0.0 end
3064 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3067 -label [mc
"Decrease Font Size"] \
3068 -command {incr_font_size font_diff
-1}
3069 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3071 -label [mc
"Increase Font Size"] \
3072 -command {incr_font_size font_diff
1}
3073 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3077 build_encoding_menu
$emenu [list force_diff_encoding
]
3079 -label [mc
"Encoding"] \
3081 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3083 $ctxm add
command -label [mc
"Options..."] \
3087 set ctxm .vpane.lower.
diff.body.ctxm
3088 menu
$ctxm -tearoff 0
3090 -label [mc
"Apply/Reverse Hunk"] \
3091 -command {apply_hunk
$cursorX $cursorY}
3092 set ui_diff_applyhunk
[$ctxm index last
]
3093 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3095 -label [mc
"Apply/Reverse Line"] \
3096 -command {apply_line
$cursorX $cursorY; do_rescan
}
3097 set ui_diff_applyline
[$ctxm index last
]
3098 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3100 create_common_diff_popup
$ctxm
3102 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3103 menu
$ctxmmg -tearoff 0
3104 $ctxmmg add
command \
3105 -label [mc
"Run Merge Tool"] \
3106 -command {merge_resolve_tool
}
3107 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3108 $ctxmmg add separator
3109 $ctxmmg add
command \
3110 -label [mc
"Use Remote Version"] \
3111 -command {merge_resolve_one
3}
3112 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3113 $ctxmmg add
command \
3114 -label [mc
"Use Local Version"] \
3115 -command {merge_resolve_one
2}
3116 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3117 $ctxmmg add
command \
3118 -label [mc
"Revert To Base"] \
3119 -command {merge_resolve_one
1}
3120 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3121 $ctxmmg add separator
3122 create_common_diff_popup
$ctxmmg
3124 proc popup_diff_menu
{ctxm ctxmmg x y X Y
} {
3125 global current_diff_path file_states
3128 if {[info exists file_states
($current_diff_path)]} {
3129 set state
[lindex
$file_states($current_diff_path) 0]
3133 if {[string first
{U
} $state] >= 0} {
3134 tk_popup
$ctxmmg $X $Y
3136 if {$
::ui_index eq $
::current_diff_side
} {
3137 set l
[mc
"Unstage Hunk From Commit"]
3138 set t
[mc
"Unstage Line From Commit"]
3140 set l
[mc
"Stage Hunk For Commit"]
3141 set t
[mc
"Stage Line For Commit"]
3144 ||
$current_diff_path eq
{}
3148 ||
{T_
} eq
$state} {
3153 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3154 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3155 tk_popup
$ctxm $X $Y
3158 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg %x
%y
%X
%Y
]
3162 set main_status
[::status_bar
::new .status
]
3163 pack .status
-anchor w
-side bottom
-fill x
3164 $main_status show
[mc
"Initializing..."]
3169 set gm
$repo_config(gui.geometry
)
3170 wm geometry .
[lindex
$gm 0]
3171 .vpane sash place
0 \
3173 [lindex
[.vpane sash coord
0] 1]
3174 .vpane.files sash place
0 \
3175 [lindex
[.vpane.files sash coord
0] 0] \
3182 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3183 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3184 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3185 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3186 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3187 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3188 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3189 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3190 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3191 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3192 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3193 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3194 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3195 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3196 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3197 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3198 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3199 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3201 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3202 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3203 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3204 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3205 bind $ui_diff <$M1B-Key-v> {break}
3206 bind $ui_diff <$M1B-Key-V> {break}
3207 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3208 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3209 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3210 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3211 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3212 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3213 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3214 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3215 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3216 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3217 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3218 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3219 bind $ui_diff <Button-1
> {focus
%W
}
3221 if {[is_enabled branch
]} {
3222 bind .
<$M1B-Key-n> branch_create
::dialog
3223 bind .
<$M1B-Key-N> branch_create
::dialog
3224 bind .
<$M1B-Key-o> branch_checkout
::dialog
3225 bind .
<$M1B-Key-O> branch_checkout
::dialog
3226 bind .
<$M1B-Key-m> merge
::dialog
3227 bind .
<$M1B-Key-M> merge
::dialog
3229 if {[is_enabled transport
]} {
3230 bind .
<$M1B-Key-p> do_push_anywhere
3231 bind .
<$M1B-Key-P> do_push_anywhere
3234 bind .
<Key-F5
> ui_do_rescan
3235 bind .
<$M1B-Key-r> ui_do_rescan
3236 bind .
<$M1B-Key-R> ui_do_rescan
3237 bind .
<$M1B-Key-s> do_signoff
3238 bind .
<$M1B-Key-S> do_signoff
3239 bind .
<$M1B-Key-t> do_add_selection
3240 bind .
<$M1B-Key-T> do_add_selection
3241 bind .
<$M1B-Key-i> do_add_all
3242 bind .
<$M1B-Key-I> do_add_all
3243 bind .
<$M1B-Key-minus> {show_less_context
;break}
3244 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3245 bind .
<$M1B-Key-equal> {show_more_context
;break}
3246 bind .
<$M1B-Key-plus> {show_more_context
;break}
3247 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3248 bind .
<$M1B-Key-Return> do_commit
3249 foreach i
[list
$ui_index $ui_workdir] {
3250 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
3251 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3252 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
3256 set file_lists
($ui_index) [list
]
3257 set file_lists
($ui_workdir) [list
]
3259 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3260 focus
-force $ui_comm
3262 # -- Warn the user about environmental problems. Cygwin's Tcl
3263 # does *not* pass its env array onto any processes it spawns.
3264 # This means that git processes get none of our environment.
3269 set msg
[mc
"Possible environment issues exist.
3271 The following environment variables are probably
3272 going to be ignored by any Git subprocess run
3276 foreach name
[array names env
] {
3277 switch
-regexp -- $name {
3278 {^GIT_INDEX_FILE$
} -
3279 {^GIT_OBJECT_DIRECTORY$
} -
3280 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3282 {^GIT_EXTERNAL_DIFF$
} -
3286 {^GIT_CONFIG_LOCAL$
} -
3287 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3288 append msg
" - $name\n"
3291 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3292 append msg
" - $name\n"
3294 set suggest_user
$name
3298 if {$ignored_env > 0} {
3300 This is due to a known issue with the
3301 Tcl binary distributed by Cygwin."]
3303 if {$suggest_user ne
{}} {
3306 A good replacement for %s
3307 is placing values for the user.name and
3308 user.email settings into your personal
3314 unset ignored_env msg suggest_user name
3317 # -- Only initialize complex UI if we are going to stay running.
3319 if {[is_enabled transport
]} {
3322 set n
[.mbar.remote index end
]
3323 populate_remotes_menu
3324 set n
[expr {[.mbar.remote index end
] - $n}]
3326 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3327 .mbar.remote insert
$n separator
3332 if {[winfo exists
$ui_comm]} {
3333 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
3335 # -- If both our backup and message files exist use the
3336 # newer of the two files to initialize the buffer.
3338 if {$GITGUI_BCK_exists} {
3339 set m
[gitdir GITGUI_MSG
]
3340 if {[file isfile
$m]} {
3341 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3342 catch
{file delete
[gitdir GITGUI_MSG
]}
3344 $ui_comm delete
0.0 end
3346 $ui_comm edit modified false
3347 catch
{file delete
[gitdir GITGUI_BCK
]}
3348 set GITGUI_BCK_exists
0
3354 proc backup_commit_buffer
{} {
3355 global ui_comm GITGUI_BCK_exists
3357 set m
[$ui_comm edit modified
]
3358 if {$m ||
$GITGUI_BCK_exists} {
3359 set msg
[string trim
[$ui_comm get
0.0 end
]]
3360 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3363 if {$GITGUI_BCK_exists} {
3364 catch
{file delete
[gitdir GITGUI_BCK
]}
3365 set GITGUI_BCK_exists
0
3369 set fd
[open
[gitdir GITGUI_BCK
] w
]
3370 puts
-nonewline $fd $msg
3372 set GITGUI_BCK_exists
1
3376 $ui_comm edit modified false
3379 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3382 backup_commit_buffer
3384 # -- If the user has aspell available we can drive it
3385 # in pipe mode to spellcheck the commit message.
3387 set spell_cmd
[list |
]
3388 set spell_dict
[get_config gui.spellingdictionary
]
3389 lappend spell_cmd aspell
3390 if {$spell_dict ne
{}} {
3391 lappend spell_cmd
--master=$spell_dict
3393 lappend spell_cmd
--mode=none
3394 lappend spell_cmd
--encoding=utf-8
3395 lappend spell_cmd pipe
3396 if {$spell_dict eq
{none
}
3397 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3398 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3400 set ui_comm_spell
[spellcheck
::init \
3406 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3409 lock_index begin-read
3410 if {![winfo ismapped .
]} {
3414 if {[is_enabled initialamend
]} {
3420 if {[is_enabled nocommitmsg
]} {
3421 $ui_comm configure
-state disabled
-background gray
3424 if {[is_enabled multicommit
]} {
3427 if {[is_enabled retcode
]} {
3428 bind .
<Destroy
> {+terminate_me
%W
}
3430 if {$picked && [is_config_true gui.autoexplore
]} {