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 ######################################################################
607 font create font_diff -family Courier -size 10
611 eval font configure font_ui [font actual [.dummy cget -font]]
615 font create font_uiitalic
616 font create font_uibold
617 font create font_diffbold
618 font create font_diffitalic
620 foreach class {Button Checkbutton Entry Label
621 Labelframe Listbox Menu Message
622 Radiobutton Spinbox Text} {
623 option add *$class.font font_ui
627 if {[is_Windows] || [is_MacOSX]} {
628 option add *Menu.tearOff 0
639 proc bind_button3 {w cmd} {
640 bind $w <Any-Button-3> $cmd
642 # Mac OS X sends Button-2 on right click through three-button mouse,
643 # or through trackpad right-clicking (two-finger touch + click).
644 bind $w <Any-Button-2> $cmd
645 bind $w <Control-Button-1> $cmd
649 proc apply_config {} {
650 global repo_config font_descs
652 foreach option $font_descs {
653 set name [lindex $option 0]
654 set font [lindex $option 1]
657 foreach {cn cv} $repo_config(gui.$name) {
658 if {$cn eq {-weight}} {
661 font configure $font $cn $cv
664 font configure $font -weight normal
667 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
669 foreach {cn cv} [font configure $font] {
670 font configure ${font}bold $cn $cv
671 font configure ${font}italic $cn $cv
673 font configure ${font}bold -weight bold
674 font configure ${font}italic -slant italic
678 set default_config(branch.autosetupmerge) true
679 set default_config(merge.tool) {}
680 set default_config(merge.keepbackup) true
681 set default_config(merge.diffstat) true
682 set default_config(merge.summary) false
683 set default_config(merge.verbosity) 2
684 set default_config(user.name) {}
685 set default_config(user.email) {}
687 set default_config(gui.encoding) [encoding system]
688 set default_config(gui.matchtrackingbranch) false
689 set default_config(gui.pruneduringfetch) false
690 set default_config(gui.trustmtime) false
691 set default_config(gui.fastcopyblame) false
692 set default_config(gui.copyblamethreshold) 40
693 set default_config(gui.blamehistoryctx) 7
694 set default_config(gui.diffcontext) 5
695 set default_config(gui.commitmsgwidth) 75
696 set default_config(gui.newbranchtemplate) {}
697 set default_config(gui.spellingdictionary) {}
698 set default_config(gui.fontui) [font configure font_ui]
699 set default_config(gui.fontdiff) [font configure font_diff]
701 {fontui font_ui {mc "Main Font
"}}
702 {fontdiff font_diff {mc "Diff
/Console Font
"}}
705 ######################################################################
709 set _git [_which git]
711 catch {wm withdraw .}
715 -title [mc "git-gui
: fatal error
"] \
716 -message [mc "Cannot
find git
in PATH.
"]
720 ######################################################################
724 if {[catch {set _git_version [git --version]} err]} {
725 catch {wm withdraw .}
729 -title [mc "git-gui
: fatal error
"] \
730 -message "Cannot determine Git version
:
734 [appname
] requires Git
1.5.0 or later.
"
737 if {![regsub {^git version } $_git_version {} _git_version]} {
738 catch {wm withdraw .}
742 -title [mc "git-gui
: fatal error
"] \
743 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
747 set _real_git_version $_git_version
748 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
749 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
750 regsub {\.rc[0-9]+$} $_git_version {} _git_version
751 regsub {\.GIT$} $_git_version {} _git_version
752 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
754 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
755 catch {wm withdraw .}
760 -title "[appname
]: warning
" \
761 -message [mc "Git version cannot be determined.
763 %s claims it is version
'%s'.
765 %s requires
at least Git
1.5.0 or later.
767 Assume
'%s' is version
1.5.0?
768 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
769 set _git_version 1.5.0
774 unset _real_git_version
776 proc git-version {args} {
779 switch [llength $args] {
785 set op [lindex $args 0]
786 set vr [lindex $args 1]
787 set cm [package vcompare $_git_version $vr]
788 return [expr $cm $op 0]
792 set type [lindex $args 0]
793 set name [lindex $args 1]
794 set parm [lindex $args 2]
795 set body [lindex $args 3]
797 if {($type ne {proc} && $type ne {method})} {
798 error "Invalid arguments to git-version
"
800 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
801 error "Last arm of
$type $name must be default
"
804 foreach {op vr cb} [lrange $body 0 end-2] {
805 if {[git-version $op $vr]} {
806 return [uplevel [list $type $name $parm $cb]]
810 return [uplevel [list $type $name $parm [lindex $body end]]]
814 error "git-version
>= x
"
820 if {[git-version < 1.5]} {
821 catch {wm withdraw .}
825 -title [mc "git-gui
: fatal error
"] \
826 -message "[appname
] requires Git
1.5.0 or later.
828 You are using
[git-version
]:
834 ######################################################################
836 ## configure our library
838 set idx [file join $oguilib tclIndex]
839 if {[catch {set fd [open $idx r]} err]} {
840 catch {wm withdraw .}
844 -title [mc "git-gui
: fatal error
"] \
848 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
850 while {[gets $fd n] >= 0} {
851 if {$n ne {} && ![string match #* $n]} {
863 if {[lsearch -exact $loaded $p] >= 0} continue
864 source [file join $oguilib $p]
869 set auto_path [concat [list $oguilib] $auto_path]
871 unset -nocomplain idx fd
873 ######################################################################
875 ## config file parsing
877 git-version proc _parse_config {arr_name args} {
884 [list git_read config] \
886 [list --null --list]]
887 fconfigure $fd_rc -translation binary
888 set buf [read $fd_rc]
891 foreach line [split $buf "\
0"] {
892 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
893 if {[is_many_config $name]} {
894 lappend arr($name) $value
896 set arr($name) $value
905 set fd_rc [eval [list git_read config --list] $args]
906 while {[gets $fd_rc line] >= 0} {
907 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
908 if {[is_many_config $name]} {
909 lappend arr($name) $value
911 set arr($name) $value
920 proc load_config {include_global} {
921 global repo_config global_config default_config
923 if {$include_global} {
924 _parse_config global_config --global
926 _parse_config repo_config
928 foreach name [array names default_config] {
929 if {[catch {set v $global_config($name)}]} {
930 set global_config($name) $default_config($name)
932 if {[catch {set v $repo_config($name)}]} {
933 set repo_config($name) $default_config($name)
938 ######################################################################
940 ## feature option selection
942 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
947 if {$subcommand eq {gui.sh}} {
950 if {$subcommand eq {gui} && [llength $argv] > 0} {
951 set subcommand [lindex $argv 0]
952 set argv [lrange $argv 1 end]
955 enable_option multicommit
957 enable_option transport
960 switch -- $subcommand {
965 disable_option multicommit
966 disable_option branch
967 disable_option transport
970 enable_option singlecommit
971 enable_option retcode
973 disable_option multicommit
974 disable_option branch
975 disable_option transport
977 while {[llength $argv] > 0} {
978 set a [lindex $argv 0]
981 enable_option initialamend
984 enable_option nocommit
985 enable_option nocommitmsg
988 disable_option nocommitmsg
995 set argv [lrange $argv 1 end]
1000 ######################################################################
1002 ## execution environment
1004 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1006 # Suggest our implementation of askpass, if none is set
1007 if {![info exists env(SSH_ASKPASS)]} {
1008 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1011 ######################################################################
1017 set _gitdir $env(GIT_DIR)
1021 set _gitdir [git rev-parse --git-dir]
1022 set _prefix [git rev-parse --show-prefix]
1026 choose_repository::pick
1029 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1030 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1032 if {![file isdirectory $_gitdir]} {
1033 catch {wm withdraw .}
1034 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1037 if {$_prefix ne {}} {
1038 regsub -all {[^/]+/} $_prefix ../ cdup
1039 if {[catch {cd $cdup} err]} {
1040 catch {wm withdraw .}
1041 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1045 } elseif {![is_enabled bare]} {
1046 if {[lindex [file split $_gitdir] end] ne {.git}} {
1047 catch {wm withdraw .}
1048 error_popup [strcat [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
1051 if {[catch {cd [file dirname $_gitdir]} err]} {
1052 catch {wm withdraw .}
1053 error_popup [strcat [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
1057 set _reponame [file split [file normalize $_gitdir]]
1058 if {[lindex $_reponame end] eq {.git}} {
1059 set _reponame [lindex $_reponame end-1]
1061 set _reponame [lindex $_reponame end]
1064 ######################################################################
1068 set current_diff_path {}
1069 set current_diff_side {}
1070 set diff_actions [list]
1074 set MERGE_HEAD [list]
1077 set current_branch {}
1079 set current_diff_path {}
1081 set is_conflict_diff 0
1082 set selected_commit_type new
1084 set nullid "0000000000000000000000000000000000000000"
1085 set nullid2 "0000000000000000000000000000000000000001"
1087 ######################################################################
1095 set disable_on_lock [list]
1096 set index_lock_type none
1098 proc lock_index {type} {
1099 global index_lock_type disable_on_lock
1101 if {$index_lock_type eq {none}} {
1102 set index_lock_type $type
1103 foreach w $disable_on_lock {
1104 uplevel #0 $w disabled
1107 } elseif {$index_lock_type eq "begin-
$type"} {
1108 set index_lock_type $type
1114 proc unlock_index {} {
1115 global index_lock_type disable_on_lock
1117 set index_lock_type none
1118 foreach w $disable_on_lock {
1119 uplevel #0 $w normal
1123 ######################################################################
1127 proc repository_state {ctvar hdvar mhvar} {
1128 global current_branch
1129 upvar $ctvar ct $hdvar hd $mhvar mh
1134 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1140 set merge_head [gitdir MERGE_HEAD]
1141 if {[file exists $merge_head]} {
1143 set fd_mh [open $merge_head r]
1144 while {[gets $fd_mh line] >= 0} {
1155 global PARENT empty_tree
1157 set p [lindex $PARENT 0]
1161 if {$empty_tree eq {}} {
1162 set empty_tree [git mktree << {}]
1167 proc force_amend {} {
1168 global selected_commit_type
1169 global HEAD PARENT MERGE_HEAD commit_type
1171 repository_state newType newHEAD newMERGE_HEAD
1174 set MERGE_HEAD $newMERGE_HEAD
1175 set commit_type $newType
1177 set selected_commit_type amend
1178 do_select_commit_type
1181 proc rescan {after {honor_trustmtime 1}} {
1182 global HEAD PARENT MERGE_HEAD commit_type
1183 global ui_index ui_workdir ui_comm
1184 global rescan_active file_states
1187 if {$rescan_active > 0 || ![lock_index read]} return
1189 repository_state newType newHEAD newMERGE_HEAD
1190 if {[string match amend* $commit_type]
1191 && $newType eq {normal}
1192 && $newHEAD eq $HEAD} {
1196 set MERGE_HEAD $newMERGE_HEAD
1197 set commit_type $newType
1200 array unset file_states
1202 if {!$::GITGUI_BCK_exists &&
1203 (![$ui_comm edit modified]
1204 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1205 if {[string match amend* $commit_type]} {
1206 } elseif {[load_message GITGUI_MSG]} {
1207 } elseif {[run_prepare_commit_msg_hook]} {
1208 } elseif {[load_message MERGE_MSG]} {
1209 } elseif {[load_message SQUASH_MSG]} {
1212 $ui_comm edit modified false
1215 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1216 rescan_stage2 {} $after
1219 ui_status [mc "Refreshing
file status...
"]
1220 set fd_rf [git_read update-index \
1226 fconfigure $fd_rf -blocking 0 -translation binary
1227 fileevent $fd_rf readable \
1228 [list rescan_stage2 $fd_rf $after]
1233 set is_git_info_exclude {}
1234 proc have_info_exclude {} {
1235 global is_git_info_exclude
1237 if {$is_git_info_exclude eq {}} {
1238 if {[catch {exec test -f [gitdir info exclude]}]} {
1239 set is_git_info_exclude 0
1241 set is_git_info_exclude 1
1244 return $is_git_info_exclude
1247 proc have_info_exclude {} {
1248 return [file readable [gitdir info exclude]]
1252 proc rescan_stage2 {fd after} {
1253 global rescan_active buf_rdi buf_rdf buf_rlo
1257 if {![eof $fd]} return
1261 set ls_others [list --exclude-per-directory=.gitignore]
1262 if {[have_info_exclude]} {
1263 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1265 set user_exclude [get_config core.excludesfile]
1266 if {$user_exclude ne {} && [file readable $user_exclude]} {
1267 lappend ls_others "--exclude-from=$user_exclude"
1275 ui_status [mc "Scanning
for modified files ...
"]
1276 set fd_di [git_read diff-index --cached -z [PARENT]]
1277 set fd_df [git_read diff-files -z]
1278 set fd_lo [eval git_read ls-files --others -z $ls_others]
1280 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1281 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1282 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1283 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1284 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1285 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1288 proc load_message {file} {
1291 set f [gitdir $file]
1292 if {[file isfile $f]} {
1293 if {[catch {set fd [open $f r]}]} {
1296 fconfigure $fd -eofchar {}
1297 set content [string trim [read $fd]]
1299 regsub -all -line {[ \r\t]+$} $content {} content
1300 $ui_comm delete 0.0 end
1301 $ui_comm insert end $content
1307 proc run_prepare_commit_msg_hook {} {
1310 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1311 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1312 # empty file but existant file.
1314 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1316 if {[file isfile [gitdir MERGE_MSG]]} {
1317 set pcm_source "merge
"
1318 set fd_mm [open [gitdir MERGE_MSG] r]
1319 puts -nonewline $fd_pcm [read $fd_mm]
1321 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1322 set pcm_source "squash
"
1323 set fd_sm [open [gitdir SQUASH_MSG] r]
1324 puts -nonewline $fd_pcm [read $fd_sm]
1332 set fd_ph [githook_read prepare-commit-msg \
1333 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1335 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1339 ui_status [mc "Calling prepare-commit-msg hook...
"]
1342 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1343 fileevent $fd_ph readable \
1344 [list prepare_commit_msg_hook_wait $fd_ph]
1349 proc prepare_commit_msg_hook_wait {fd_ph} {
1352 append pch_error [read $fd_ph]
1353 fconfigure $fd_ph -blocking 1
1355 if {[catch {close $fd_ph}]} {
1356 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1357 hook_failed_popup prepare-commit-msg $pch_error
1358 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1361 load_message PREPARE_COMMIT_MSG
1364 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1367 fconfigure $fd_ph -blocking 0
1368 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1371 proc read_diff_index {fd after} {
1374 append buf_rdi [read $fd]
1376 set n [string length $buf_rdi]
1378 set z1 [string first "\
0" $buf_rdi $c]
1379 if {$z1 == -1} break
1381 set z2 [string first "\
0" $buf_rdi $z1]
1382 if {$z2 == -1} break
1385 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1386 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1388 [encoding convertfrom $p] \
1390 [list [lindex $i 0] [lindex $i 2]] \
1396 set buf_rdi [string range $buf_rdi $c end]
1401 rescan_done $fd buf_rdi $after
1404 proc read_diff_files {fd after} {
1407 append buf_rdf [read $fd]
1409 set n [string length $buf_rdf]
1411 set z1 [string first "\
0" $buf_rdf $c]
1412 if {$z1 == -1} break
1414 set z2 [string first "\
0" $buf_rdf $z1]
1415 if {$z2 == -1} break
1418 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1419 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1421 [encoding convertfrom $p] \
1424 [list [lindex $i 0] [lindex $i 2]]
1429 set buf_rdf [string range $buf_rdf $c end]
1434 rescan_done $fd buf_rdf $after
1437 proc read_ls_others {fd after} {
1440 append buf_rlo [read $fd]
1441 set pck [split $buf_rlo "\
0"]
1442 set buf_rlo [lindex $pck end]
1443 foreach p [lrange $pck 0 end-1] {
1444 set p [encoding convertfrom $p]
1445 if {[string index $p end] eq {/}} {
1446 set p [string range $p 0 end-1]
1450 rescan_done $fd buf_rlo $after
1453 proc rescan_done {fd buf after} {
1454 global rescan_active current_diff_path
1455 global file_states repo_config
1458 if {![eof $fd]} return
1461 if {[incr rescan_active -1] > 0} return
1466 if {$current_diff_path ne {}} reshow_diff
1467 if {$current_diff_path eq {}} select_first_diff
1472 proc prune_selection {} {
1473 global file_states selected_paths
1475 foreach path [array names selected_paths] {
1476 if {[catch {set still_here $file_states($path)}]} {
1477 unset selected_paths($path)
1482 ######################################################################
1486 proc mapicon {w state path} {
1489 if {[catch {set r $all_icons($state$w)}]} {
1490 puts "error
: no icon
for $w state
={$state} $path"
1496 proc mapdesc {state path} {
1499 if {[catch {set r $all_descs($state)}]} {
1500 puts "error
: no desc
for state
={$state} $path"
1506 proc ui_status {msg} {
1508 if {[info exists main_status]} {
1509 $main_status show $msg
1513 proc ui_ready {{test {}}} {
1515 if {[info exists main_status]} {
1516 $main_status show [mc "Ready.
"] $test
1520 proc escape_path {path} {
1521 regsub -all {\\} $path "\\\\" path
1522 regsub -all "\n" $path "\\n
" path
1526 proc short_path {path} {
1527 return [escape_path [lindex [file split $path] end]]
1531 set null_sha1 [string repeat 0 40]
1533 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1534 global file_states next_icon_id null_sha1
1536 set s0 [string index $new_state 0]
1537 set s1 [string index $new_state 1]
1539 if {[catch {set info $file_states($path)}]} {
1541 set icon n[incr next_icon_id]
1543 set state [lindex $info 0]
1544 set icon [lindex $info 1]
1545 if {$head_info eq {}} {set head_info [lindex $info 2]}
1546 if {$index_info eq {}} {set index_info [lindex $info 3]}
1549 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1550 elseif {$s0 eq {_}} {set s0 _}
1552 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1553 elseif {$s1 eq {_}} {set s1 _}
1555 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1556 set head_info [list 0 $null_sha1]
1557 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1558 && $head_info eq {}} {
1559 set head_info $index_info
1562 set file_states($path) [list $s0$s1 $icon \
1563 $head_info $index_info \
1568 proc display_file_helper {w path icon_name old_m new_m} {
1571 if {$new_m eq {_}} {
1572 set lno [lsearch -sorted -exact $file_lists($w) $path]
1574 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1576 $w conf -state normal
1577 $w delete $lno.0 [expr {$lno + 1}].0
1578 $w conf -state disabled
1580 } elseif {$old_m eq {_} && $new_m ne {_}} {
1581 lappend file_lists($w) $path
1582 set file_lists($w) [lsort -unique $file_lists($w)]
1583 set lno [lsearch -sorted -exact $file_lists($w) $path]
1585 $w conf -state normal
1586 $w image create $lno.0 \
1587 -align center -padx 5 -pady 1 \
1589 -image [mapicon $w $new_m $path]
1590 $w insert $lno.1 "[escape_path
$path]\n"
1591 $w conf -state disabled
1592 } elseif {$old_m ne $new_m} {
1593 $w conf -state normal
1594 $w image conf $icon_name -image [mapicon $w $new_m $path]
1595 $w conf -state disabled
1599 proc display_file {path state} {
1600 global file_states selected_paths
1601 global ui_index ui_workdir
1603 set old_m [merge_state $path $state]
1604 set s $file_states($path)
1605 set new_m [lindex $s 0]
1606 set icon_name [lindex $s 1]
1608 set o [string index $old_m 0]
1609 set n [string index $new_m 0]
1616 display_file_helper $ui_index $path $icon_name $o $n
1618 if {[string index $old_m 0] eq {U}} {
1621 set o [string index $old_m 1]
1623 if {[string index $new_m 0] eq {U}} {
1626 set n [string index $new_m 1]
1628 display_file_helper $ui_workdir $path $icon_name $o $n
1630 if {$new_m eq {__}} {
1631 unset file_states($path)
1632 catch {unset selected_paths($path)}
1636 proc display_all_files_helper {w path icon_name m} {
1639 lappend file_lists($w) $path
1640 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1641 $w image create end \
1642 -align center -padx 5 -pady 1 \
1644 -image [mapicon $w $m $path]
1645 $w insert end "[escape_path
$path]\n"
1648 proc display_all_files {} {
1649 global ui_index ui_workdir
1650 global file_states file_lists
1653 $ui_index conf -state normal
1654 $ui_workdir conf -state normal
1656 $ui_index delete 0.0 end
1657 $ui_workdir delete 0.0 end
1660 set file_lists($ui_index) [list]
1661 set file_lists($ui_workdir) [list]
1663 foreach path [lsort [array names file_states]] {
1664 set s $file_states($path)
1666 set icon_name [lindex $s 1]
1668 set s [string index $m 0]
1669 if {$s ne {U} && $s ne {_}} {
1670 display_all_files_helper $ui_index $path \
1674 if {[string index $m 0] eq {U}} {
1677 set s [string index $m 1]
1680 display_all_files_helper $ui_workdir $path \
1685 $ui_index conf -state disabled
1686 $ui_workdir conf -state disabled
1689 ######################################################################
1694 #define mask_width 14
1695 #define mask_height 15
1696 static unsigned char mask_bits[] = {
1697 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1698 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1699 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1702 image create bitmap file_plain -background white -foreground black -data {
1703 #define plain_width 14
1704 #define plain_height 15
1705 static unsigned char plain_bits[] = {
1706 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1707 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1708 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1709 } -maskdata $filemask
1711 image create bitmap file_mod -background white -foreground blue -data {
1712 #define mod_width 14
1713 #define mod_height 15
1714 static unsigned char mod_bits[] = {
1715 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1716 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1717 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1718 } -maskdata $filemask
1720 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1721 #define file_fulltick_width 14
1722 #define file_fulltick_height 15
1723 static unsigned char file_fulltick_bits
[] = {
1724 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1725 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1726 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1727 } -maskdata $filemask
1729 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1730 #define parttick_width 14
1731 #define parttick_height 15
1732 static unsigned char parttick_bits
[] = {
1733 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1734 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1735 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1736 } -maskdata $filemask
1738 image create bitmap file_question
-background white
-foreground black
-data {
1739 #define file_question_width 14
1740 #define file_question_height 15
1741 static unsigned char file_question_bits
[] = {
1742 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1743 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1744 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1745 } -maskdata $filemask
1747 image create bitmap file_removed
-background white
-foreground red
-data {
1748 #define file_removed_width 14
1749 #define file_removed_height 15
1750 static unsigned char file_removed_bits
[] = {
1751 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1752 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1753 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1754 } -maskdata $filemask
1756 image create bitmap file_merge
-background white
-foreground blue
-data {
1757 #define file_merge_width 14
1758 #define file_merge_height 15
1759 static unsigned char file_merge_bits
[] = {
1760 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1761 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1762 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1763 } -maskdata $filemask
1765 image create bitmap file_statechange
-background white
-foreground green
-data {
1766 #define file_merge_width 14
1767 #define file_merge_height 15
1768 static unsigned char file_statechange_bits
[] = {
1769 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1770 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1771 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1772 } -maskdata $filemask
1774 set ui_index .vpane.files.index.list
1775 set ui_workdir .vpane.files.workdir.list
1777 set all_icons
(_
$ui_index) file_plain
1778 set all_icons
(A
$ui_index) file_fulltick
1779 set all_icons
(M
$ui_index) file_fulltick
1780 set all_icons
(D
$ui_index) file_removed
1781 set all_icons
(U
$ui_index) file_merge
1782 set all_icons
(T
$ui_index) file_statechange
1784 set all_icons
(_
$ui_workdir) file_plain
1785 set all_icons
(M
$ui_workdir) file_mod
1786 set all_icons
(D
$ui_workdir) file_question
1787 set all_icons
(U
$ui_workdir) file_merge
1788 set all_icons
(O
$ui_workdir) file_plain
1789 set all_icons
(T
$ui_workdir) file_statechange
1791 set max_status_desc
0
1793 {__
{mc
"Unmodified"}}
1795 {_M
{mc
"Modified, not staged"}}
1796 {M_
{mc
"Staged for commit"}}
1797 {MM
{mc
"Portions staged for commit"}}
1798 {MD
{mc
"Staged for commit, missing"}}
1800 {_T
{mc
"File type changed, not staged"}}
1801 {T_
{mc
"File type changed, staged"}}
1803 {_O
{mc
"Untracked, not staged"}}
1804 {A_
{mc
"Staged for commit"}}
1805 {AM
{mc
"Portions staged for commit"}}
1806 {AD
{mc
"Staged for commit, missing"}}
1809 {D_
{mc
"Staged for removal"}}
1810 {DO
{mc
"Staged for removal, still present"}}
1812 {_U
{mc
"Requires merge resolution"}}
1813 {U_
{mc
"Requires merge resolution"}}
1814 {UU
{mc
"Requires merge resolution"}}
1815 {UM
{mc
"Requires merge resolution"}}
1816 {UD
{mc
"Requires merge resolution"}}
1817 {UT
{mc
"Requires merge resolution"}}
1819 set text
[eval [lindex
$i 1]]
1820 if {$max_status_desc < [string length
$text]} {
1821 set max_status_desc
[string length
$text]
1823 set all_descs
([lindex
$i 0]) $text
1827 ######################################################################
1831 proc scrollbar2many
{list mode args
} {
1832 foreach w
$list {eval $w $mode $args}
1835 proc many2scrollbar
{list mode sb top bottom
} {
1836 $sb set $top $bottom
1837 foreach w
$list {$w $mode moveto
$top}
1840 proc incr_font_size
{font
{amt
1}} {
1841 set sz
[font configure
$font -size]
1843 font configure
$font -size $sz
1844 font configure
${font}bold
-size $sz
1845 font configure
${font}italic
-size $sz
1848 ######################################################################
1852 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1854 proc do_gitk
{revs
} {
1855 # -- Always start gitk through whatever we were loaded with. This
1856 # lets us bypass using shell process on Windows systems.
1858 set exe
[_which gitk
-script]
1859 set cmd
[list
[info nameofexecutable
] $exe]
1861 error_popup
[mc
"Couldn't find gitk in PATH"]
1865 if {[info exists env
(GIT_DIR
)]} {
1866 set old_GIT_DIR
$env(GIT_DIR
)
1872 cd [file dirname [gitdir
]]
1873 set env
(GIT_DIR
) [file tail [gitdir
]]
1875 eval exec $cmd $revs &
1877 if {$old_GIT_DIR eq
{}} {
1880 set env
(GIT_DIR
) $old_GIT_DIR
1884 ui_status $
::starting_gitk_msg
1886 ui_ready
$starting_gitk_msg
1891 proc do_explore
{} {
1893 if {[is_Cygwin
] ||
[is_Windows
]} {
1894 set explorer
"explorer.exe"
1895 } elseif
{[is_MacOSX
]} {
1898 # freedesktop.org-conforming system is our best shot
1899 set explorer
"xdg-open"
1901 eval exec $explorer [file dirname [gitdir
]] &
1907 proc terminate_me
{win
} {
1909 if {$win ne
{.
}} return
1913 proc do_quit
{{rc
{1}}} {
1914 global ui_comm is_quitting repo_config commit_type
1915 global GITGUI_BCK_exists GITGUI_BCK_i
1916 global ui_comm_spell
1919 if {$is_quitting} return
1922 if {[winfo exists
$ui_comm]} {
1923 # -- Stash our current commit buffer.
1925 set save
[gitdir GITGUI_MSG
]
1926 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1927 file rename
-force [gitdir GITGUI_BCK
] $save
1928 set GITGUI_BCK_exists
0
1930 set msg
[string trim
[$ui_comm get
0.0 end
]]
1931 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1932 if {(![string match amend
* $commit_type]
1933 ||
[$ui_comm edit modified
])
1936 set fd
[open
$save w
]
1937 puts
-nonewline $fd $msg
1941 catch
{file delete
$save}
1945 # -- Cancel our spellchecker if its running.
1947 if {[info exists ui_comm_spell
]} {
1951 # -- Remove our editor backup, its not needed.
1953 after cancel
$GITGUI_BCK_i
1954 if {$GITGUI_BCK_exists} {
1955 catch
{file delete
[gitdir GITGUI_BCK
]}
1958 # -- Stash our current window geometry into this repository.
1960 set cfg_geometry
[list
]
1961 lappend cfg_geometry
[wm geometry .
]
1962 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
1963 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
1964 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1967 if {$cfg_geometry ne
$rc_geometry} {
1968 catch
{git config gui.geometry
$cfg_geometry}
1980 proc ui_do_rescan
{} {
1981 rescan
{force_first_diff
; ui_ready
}
1989 global next_diff_p next_diff_w next_diff_i
1990 show_diff
$next_diff_p $next_diff_w {}
1993 proc find_anchor_pos
{lst name
} {
1994 set lid
[lsearch
-sorted -exact $lst $name]
1998 foreach lname
$lst {
1999 if {$lname >= $name} break
2007 proc find_file_from
{flist idx delta path mmask
} {
2010 set len
[llength
$flist]
2011 while {$idx >= 0 && $idx < $len} {
2012 set name
[lindex
$flist $idx]
2014 if {$name ne
$path && [info exists file_states
($name)]} {
2015 set state
[lindex
$file_states($name) 0]
2017 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2028 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2029 global next_diff_p next_diff_w next_diff_i
2030 global file_lists ui_index ui_workdir
2032 set flist
$file_lists($w)
2034 set lno
[find_anchor_pos
$flist $path]
2039 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2040 if {$w eq
$ui_index} {
2043 set mmask
"$mmask\$"
2047 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2050 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2055 set next_diff_p
[lindex
$flist $idx]
2056 set next_diff_i
[expr {$idx+1}]
2063 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2064 global current_diff_path
2066 if {$path ne
$current_diff_path} {
2068 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2071 return {reshow_diff
;}
2075 proc select_first_diff
{} {
2078 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2079 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2084 proc force_first_diff
{} {
2085 global current_diff_path
2087 if {[info exists file_states
($current_diff_path)]} {
2088 set state
[lindex
$file_states($current_diff_path) 0]
2090 if {[string index
$state 1] ne
{O
}} return
2096 proc toggle_or_diff
{w x y
} {
2097 global file_states file_lists current_diff_path ui_index ui_workdir
2098 global last_clicked selected_paths
2100 set pos
[split [$w index @
$x,$y] .
]
2101 set lno
[lindex
$pos 0]
2102 set col [lindex
$pos 1]
2103 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2109 set last_clicked
[list
$w $lno]
2110 array
unset selected_paths
2111 $ui_index tag remove in_sel
0.0 end
2112 $ui_workdir tag remove in_sel
0.0 end
2114 # Determine the state of the file
2115 if {[info exists file_states
($path)]} {
2116 set state
[lindex
$file_states($path) 0]
2121 # Restage the file, or simply show the diff
2122 if {$col == 0 && $y > 1} {
2123 # Conflicts need special handling
2124 if {[string first
{U
} $state] >= 0} {
2125 # $w must always be $ui_workdir, but...
2126 if {$w ne
$ui_workdir} { set lno
{} }
2127 merge_stage_workdir
$path $lno
2131 if {[string index
$state 1] eq
{O
}} {
2137 set after
[next_diff_after_action
$w $path $lno $mmask]
2139 if {$w eq
$ui_index} {
2141 "Unstaging [short_path $path] from commit" \
2143 [concat
$after [list ui_ready
]]
2144 } elseif
{$w eq
$ui_workdir} {
2146 "Adding [short_path $path]" \
2148 [concat
$after [list ui_ready
]]
2151 show_diff
$path $w $lno
2155 proc add_one_to_selection
{w x y
} {
2156 global file_lists last_clicked selected_paths
2158 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2159 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2165 if {$last_clicked ne
{}
2166 && [lindex
$last_clicked 0] ne
$w} {
2167 array
unset selected_paths
2168 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2171 set last_clicked
[list
$w $lno]
2172 if {[catch
{set in_sel
$selected_paths($path)}]} {
2176 unset selected_paths
($path)
2177 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2179 set selected_paths
($path) 1
2180 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2184 proc add_range_to_selection
{w x y
} {
2185 global file_lists last_clicked selected_paths
2187 if {[lindex
$last_clicked 0] ne
$w} {
2188 toggle_or_diff
$w $x $y
2192 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2193 set lc
[lindex
$last_clicked 1]
2202 foreach path
[lrange
$file_lists($w) \
2203 [expr {$begin - 1}] \
2204 [expr {$end - 1}]] {
2205 set selected_paths
($path) 1
2207 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2210 proc show_more_context
{} {
2212 if {$repo_config(gui.diffcontext
) < 99} {
2213 incr repo_config
(gui.diffcontext
)
2218 proc show_less_context
{} {
2220 if {$repo_config(gui.diffcontext
) > 1} {
2221 incr repo_config
(gui.diffcontext
) -1
2226 ######################################################################
2236 menu .mbar
-tearoff 0
2237 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2238 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2239 if {[is_enabled branch
]} {
2240 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2242 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2243 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2245 if {[is_enabled transport
]} {
2246 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2247 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2249 . configure
-menu .mbar
2251 # -- Repository Menu
2253 menu .mbar.repository
2255 .mbar.repository add
command \
2256 -label [mc
"Explore Working Copy"] \
2257 -command {do_explore
}
2258 .mbar.repository add separator
2260 .mbar.repository add
command \
2261 -label [mc
"Browse Current Branch's Files"] \
2262 -command {browser
::new
$current_branch}
2263 set ui_browse_current
[.mbar.repository index last
]
2264 .mbar.repository add
command \
2265 -label [mc
"Browse Branch Files..."] \
2266 -command browser_open
::dialog
2267 .mbar.repository add separator
2269 .mbar.repository add
command \
2270 -label [mc
"Visualize Current Branch's History"] \
2271 -command {do_gitk
$current_branch}
2272 set ui_visualize_current
[.mbar.repository index last
]
2273 .mbar.repository add
command \
2274 -label [mc
"Visualize All Branch History"] \
2275 -command {do_gitk
--all}
2276 .mbar.repository add separator
2278 proc current_branch_write
{args
} {
2279 global current_branch
2280 .mbar.repository entryconf $
::ui_browse_current \
2281 -label [mc
"Browse %s's Files" $current_branch]
2282 .mbar.repository entryconf $
::ui_visualize_current \
2283 -label [mc
"Visualize %s's History" $current_branch]
2285 trace add variable current_branch
write current_branch_write
2287 if {[is_enabled multicommit
]} {
2288 .mbar.repository add
command -label [mc
"Database Statistics"] \
2291 .mbar.repository add
command -label [mc
"Compress Database"] \
2294 .mbar.repository add
command -label [mc
"Verify Database"] \
2295 -command do_fsck_objects
2297 .mbar.repository add separator
2300 .mbar.repository add
command \
2301 -label [mc
"Create Desktop Icon"] \
2302 -command do_cygwin_shortcut
2303 } elseif
{[is_Windows
]} {
2304 .mbar.repository add
command \
2305 -label [mc
"Create Desktop Icon"] \
2306 -command do_windows_shortcut
2307 } elseif
{[is_MacOSX
]} {
2308 .mbar.repository add
command \
2309 -label [mc
"Create Desktop Icon"] \
2310 -command do_macosx_app
2315 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2317 .mbar.repository add
command -label [mc Quit
] \
2325 .mbar.edit add
command -label [mc Undo
] \
2326 -command {catch
{[focus
] edit undo
}} \
2328 .mbar.edit add
command -label [mc Redo
] \
2329 -command {catch
{[focus
] edit redo
}} \
2331 .mbar.edit add separator
2332 .mbar.edit add
command -label [mc Cut
] \
2333 -command {catch
{tk_textCut
[focus
]}} \
2335 .mbar.edit add
command -label [mc Copy
] \
2336 -command {catch
{tk_textCopy
[focus
]}} \
2338 .mbar.edit add
command -label [mc Paste
] \
2339 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2341 .mbar.edit add
command -label [mc Delete
] \
2342 -command {catch
{[focus
] delete sel.first sel.last
}} \
2344 .mbar.edit add separator
2345 .mbar.edit add
command -label [mc
"Select All"] \
2346 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2351 if {[is_enabled branch
]} {
2354 .mbar.branch add
command -label [mc
"Create..."] \
2355 -command branch_create
::dialog \
2357 lappend disable_on_lock
[list .mbar.branch entryconf \
2358 [.mbar.branch index last
] -state]
2360 .mbar.branch add
command -label [mc
"Checkout..."] \
2361 -command branch_checkout
::dialog \
2363 lappend disable_on_lock
[list .mbar.branch entryconf \
2364 [.mbar.branch index last
] -state]
2366 .mbar.branch add
command -label [mc
"Rename..."] \
2367 -command branch_rename
::dialog
2368 lappend disable_on_lock
[list .mbar.branch entryconf \
2369 [.mbar.branch index last
] -state]
2371 .mbar.branch add
command -label [mc
"Delete..."] \
2372 -command branch_delete
::dialog
2373 lappend disable_on_lock
[list .mbar.branch entryconf \
2374 [.mbar.branch index last
] -state]
2376 .mbar.branch add
command -label [mc
"Reset..."] \
2377 -command merge
::reset_hard
2378 lappend disable_on_lock
[list .mbar.branch entryconf \
2379 [.mbar.branch index last
] -state]
2384 proc commit_btn_caption
{} {
2385 if {[is_enabled nocommit
]} {
2388 return [mc Commit@@verb
]
2392 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2395 if {![is_enabled nocommit
]} {
2396 .mbar.commit add radiobutton \
2397 -label [mc
"New Commit"] \
2398 -command do_select_commit_type \
2399 -variable selected_commit_type \
2401 lappend disable_on_lock \
2402 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2404 .mbar.commit add radiobutton \
2405 -label [mc
"Amend Last Commit"] \
2406 -command do_select_commit_type \
2407 -variable selected_commit_type \
2409 lappend disable_on_lock \
2410 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2412 .mbar.commit add separator
2415 .mbar.commit add
command -label [mc Rescan
] \
2416 -command ui_do_rescan \
2418 lappend disable_on_lock \
2419 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2421 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2422 -command do_add_selection \
2424 lappend disable_on_lock \
2425 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2427 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2428 -command do_add_all \
2430 lappend disable_on_lock \
2431 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2433 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2434 -command do_unstage_selection
2435 lappend disable_on_lock \
2436 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2438 .mbar.commit add
command -label [mc
"Revert Changes"] \
2439 -command do_revert_selection
2440 lappend disable_on_lock \
2441 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2443 .mbar.commit add separator
2445 .mbar.commit add
command -label [mc
"Show Less Context"] \
2446 -command show_less_context \
2447 -accelerator $M1T-\
-
2449 .mbar.commit add
command -label [mc
"Show More Context"] \
2450 -command show_more_context \
2453 .mbar.commit add separator
2455 if {![is_enabled nocommitmsg
]} {
2456 .mbar.commit add
command -label [mc
"Sign Off"] \
2457 -command do_signoff \
2461 .mbar.commit add
command -label [commit_btn_caption
] \
2462 -command do_commit \
2463 -accelerator $M1T-Return
2464 lappend disable_on_lock \
2465 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2470 if {[is_enabled branch
]} {
2472 .mbar.merge add
command -label [mc
"Local Merge..."] \
2473 -command merge
::dialog \
2475 lappend disable_on_lock \
2476 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2477 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2478 -command merge
::reset_hard
2479 lappend disable_on_lock \
2480 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2485 if {[is_enabled transport
]} {
2488 .mbar.remote add
command \
2489 -label [mc
"Add..."] \
2490 -command remote_add
::dialog \
2492 .mbar.remote add
command \
2493 -label [mc
"Push..."] \
2494 -command do_push_anywhere \
2496 .mbar.remote add
command \
2497 -label [mc
"Delete Branch..."] \
2498 -command remote_branch_delete
::dialog
2502 # -- Apple Menu (Mac OS X only)
2504 .mbar add cascade
-label Apple
-menu .mbar.apple
2507 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2509 .mbar.apple add separator
2510 .mbar.apple add
command \
2511 -label [mc
"Preferences..."] \
2512 -command do_options \
2514 bind .
<$M1B-,> do_options
2518 .mbar.edit add separator
2519 .mbar.edit add
command -label [mc
"Options..."] \
2525 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2529 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2534 set doc_path
[file dirname [gitexec
]]
2535 set doc_path
[file join $doc_path Documentation index.html
]
2538 set doc_path
[exec cygpath
--mixed $doc_path]
2541 if {[file isfile
$doc_path]} {
2542 set doc_url
"file:$doc_path"
2544 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2547 proc start_browser
{url
} {
2548 git
"web--browse" $url
2551 .mbar.
help add
command -label [mc
"Online Documentation"] \
2552 -command [list start_browser
$doc_url]
2554 .mbar.
help add
command -label [mc
"Show SSH Key"] \
2557 unset doc_path doc_url
2559 # -- Standard bindings
2561 wm protocol . WM_DELETE_WINDOW do_quit
2562 bind all
<$M1B-Key-q> do_quit
2563 bind all
<$M1B-Key-Q> do_quit
2564 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2565 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2567 set subcommand_args
{}
2569 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2573 # -- Not a normal commit type invocation? Do that instead!
2575 switch
-- $subcommand {
2578 if {$subcommand eq
"blame"} {
2579 set subcommand_args
{[--line=<num
>] rev? path
}
2581 set subcommand_args
{rev? path
}
2583 if {$argv eq
{}} usage
2589 if {$is_path ||
[file exists
$_prefix$a]} {
2590 if {$path ne
{}} usage
2593 } elseif
{$a eq
{--}} {
2595 if {$head ne
{}} usage
2600 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
2601 if {$jump_spec ne
{} ||
$head ne
{}} usage
2602 set jump_spec
[list
$lnum]
2603 } elseif
{$head eq
{}} {
2604 if {$head ne
{}} usage
2613 if {$head ne
{} && $path eq
{}} {
2614 set path
$_prefix$head
2621 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2623 set head [git rev-parse
--verify $head]
2629 set current_branch
$head
2632 switch
-- $subcommand {
2634 if {$jump_spec ne
{}} usage
2636 if {$path ne
{} && [file isdirectory
$path]} {
2637 set head $current_branch
2643 browser
::new
$head $path
2646 if {$head eq
{} && ![file exists
$path]} {
2647 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2650 blame
::new
$head $path $jump_spec
2657 if {[llength
$argv] != 0} {
2658 puts
-nonewline stderr
"usage: $argv0"
2659 if {$subcommand ne
{gui
}
2660 && [file tail $argv0] ne
"git-$subcommand"} {
2661 puts
-nonewline stderr
" $subcommand"
2666 # fall through to setup UI for commits
2669 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2680 -text [mc
"Current Branch:"] \
2684 -textvariable current_branch \
2687 pack .branch.l1
-side left
2688 pack .branch.cb
-side left
-fill x
2689 pack .branch
-side top
-fill x
2691 # -- Main Window Layout
2693 panedwindow .vpane
-orient horizontal
2694 panedwindow .vpane.files
-orient vertical
2695 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2696 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2698 # -- Index File List
2700 frame .vpane.files.index
-height 100 -width 200
2701 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Commit)"] \
2702 -background lightgreen
-foreground black
2703 text
$ui_index -background white
-foreground black \
2705 -width 20 -height 10 \
2707 -cursor $cursor_ptr \
2708 -xscrollcommand {.vpane.files.index.sx
set} \
2709 -yscrollcommand {.vpane.files.index.sy
set} \
2711 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2712 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2713 pack .vpane.files.index.title
-side top
-fill x
2714 pack .vpane.files.index.sx
-side bottom
-fill x
2715 pack .vpane.files.index.sy
-side right
-fill y
2716 pack
$ui_index -side left
-fill both
-expand 1
2718 # -- Working Directory File List
2720 frame .vpane.files.workdir
-height 100 -width 200
2721 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
2722 -background lightsalmon
-foreground black
2723 text
$ui_workdir -background white
-foreground black \
2725 -width 20 -height 10 \
2727 -cursor $cursor_ptr \
2728 -xscrollcommand {.vpane.files.workdir.sx
set} \
2729 -yscrollcommand {.vpane.files.workdir.sy
set} \
2731 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2732 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2733 pack .vpane.files.workdir.title
-side top
-fill x
2734 pack .vpane.files.workdir.sx
-side bottom
-fill x
2735 pack .vpane.files.workdir.sy
-side right
-fill y
2736 pack
$ui_workdir -side left
-fill both
-expand 1
2738 .vpane.files add .vpane.files.workdir
-sticky nsew
2739 .vpane.files add .vpane.files.index
-sticky nsew
2741 foreach i
[list
$ui_index $ui_workdir] {
2743 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2747 # -- Diff and Commit Area
2749 frame .vpane.lower
-height 300 -width 400
2750 frame .vpane.lower.commarea
2751 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2752 pack .vpane.lower.
diff -fill both
-expand 1
2753 pack .vpane.lower.commarea
-side bottom
-fill x
2754 .vpane add .vpane.lower
-sticky nsew
2756 # -- Commit Area Buttons
2758 frame .vpane.lower.commarea.buttons
2759 label .vpane.lower.commarea.buttons.l
-text {} \
2762 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2763 pack .vpane.lower.commarea.buttons
-side left
-fill y
2765 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2766 -command ui_do_rescan
2767 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2768 lappend disable_on_lock \
2769 {.vpane.lower.commarea.buttons.rescan conf
-state}
2771 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2773 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2774 lappend disable_on_lock \
2775 {.vpane.lower.commarea.buttons.incall conf
-state}
2777 if {![is_enabled nocommitmsg
]} {
2778 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2780 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2783 button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
2785 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2786 lappend disable_on_lock \
2787 {.vpane.lower.commarea.buttons.commit conf
-state}
2789 if {![is_enabled nocommit
]} {
2790 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2791 -command do_push_anywhere
2792 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2795 # -- Commit Message Buffer
2797 frame .vpane.lower.commarea.buffer
2798 frame .vpane.lower.commarea.buffer.header
2799 set ui_comm .vpane.lower.commarea.buffer.t
2800 set ui_coml .vpane.lower.commarea.buffer.header.l
2802 if {![is_enabled nocommit
]} {
2803 radiobutton .vpane.lower.commarea.buffer.header.new \
2804 -text [mc
"New Commit"] \
2805 -command do_select_commit_type \
2806 -variable selected_commit_type \
2808 lappend disable_on_lock \
2809 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2810 radiobutton .vpane.lower.commarea.buffer.header.amend \
2811 -text [mc
"Amend Last Commit"] \
2812 -command do_select_commit_type \
2813 -variable selected_commit_type \
2815 lappend disable_on_lock \
2816 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2822 proc trace_commit_type
{varname args
} {
2823 global ui_coml commit_type
2824 switch
-glob -- $commit_type {
2825 initial
{set txt
[mc
"Initial Commit Message:"]}
2826 amend
{set txt
[mc
"Amended Commit Message:"]}
2827 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2828 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2829 merge
{set txt
[mc
"Merge Commit Message:"]}
2830 * {set txt
[mc
"Commit Message:"]}
2832 $ui_coml conf
-text $txt
2834 trace add variable commit_type
write trace_commit_type
2835 pack
$ui_coml -side left
-fill x
2837 if {![is_enabled nocommit
]} {
2838 pack .vpane.lower.commarea.buffer.header.amend
-side right
2839 pack .vpane.lower.commarea.buffer.header.new
-side right
2842 text
$ui_comm -background white
-foreground black \
2846 -autoseparators true \
2848 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
2850 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2851 scrollbar .vpane.lower.commarea.buffer.sby \
2852 -command [list
$ui_comm yview
]
2853 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2854 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2855 pack
$ui_comm -side left
-fill y
2856 pack .vpane.lower.commarea.buffer
-side left
-fill y
2858 # -- Commit Message Buffer Context Menu
2860 set ctxm .vpane.lower.commarea.buffer.ctxm
2861 menu
$ctxm -tearoff 0
2864 -command {tk_textCut
$ui_comm}
2867 -command {tk_textCopy
$ui_comm}
2870 -command {tk_textPaste
$ui_comm}
2872 -label [mc Delete
] \
2873 -command {$ui_comm delete sel.first sel.last
}
2876 -label [mc
"Select All"] \
2877 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2879 -label [mc
"Copy All"] \
2881 $ui_comm tag add sel
0.0 end
2882 tk_textCopy
$ui_comm
2883 $ui_comm tag remove sel
0.0 end
2887 -label [mc
"Sign Off"] \
2889 set ui_comm_ctxm
$ctxm
2893 proc trace_current_diff_path
{varname args
} {
2894 global current_diff_path diff_actions file_states
2895 if {$current_diff_path eq
{}} {
2901 set p
$current_diff_path
2902 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2904 set p
[escape_path
$p]
2908 .vpane.lower.
diff.header.status configure
-text $s
2909 .vpane.lower.
diff.header.
file configure
-text $f
2910 .vpane.lower.
diff.header.path configure
-text $p
2911 foreach w
$diff_actions {
2915 trace add variable current_diff_path
write trace_current_diff_path
2917 frame .vpane.lower.
diff.header
-background gold
2918 label .vpane.lower.
diff.header.status \
2921 -width $max_status_desc \
2924 label .vpane.lower.
diff.header.
file \
2929 label .vpane.lower.
diff.header.path \
2934 pack .vpane.lower.
diff.header.status
-side left
2935 pack .vpane.lower.
diff.header.
file -side left
2936 pack .vpane.lower.
diff.header.path
-fill x
2937 set ctxm .vpane.lower.
diff.header.ctxm
2938 menu
$ctxm -tearoff 0
2946 -- $current_diff_path
2948 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2949 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2953 frame .vpane.lower.
diff.body
2954 set ui_diff .vpane.lower.
diff.body.t
2955 text
$ui_diff -background white
-foreground black \
2957 -width 80 -height 15 -wrap none \
2959 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2960 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2962 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2963 -command [list
$ui_diff xview
]
2964 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2965 -command [list
$ui_diff yview
]
2966 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2967 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2968 pack
$ui_diff -side left
-fill both
-expand 1
2969 pack .vpane.lower.
diff.header
-side top
-fill x
2970 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2972 $ui_diff tag conf d_cr
-elide true
2973 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2974 $ui_diff tag conf d_
+ -foreground {#00a000}
2975 $ui_diff tag conf d_-
-foreground red
2977 $ui_diff tag conf d_
++ -foreground {#00a000}
2978 $ui_diff tag conf d_--
-foreground red
2979 $ui_diff tag conf d_
+s \
2980 -foreground {#00a000} \
2981 -background {#e2effa}
2982 $ui_diff tag conf d_-s \
2984 -background {#e2effa}
2985 $ui_diff tag conf d_s
+ \
2986 -foreground {#00a000} \
2988 $ui_diff tag conf d_s- \
2992 $ui_diff tag conf d
<<<<<<< \
2993 -foreground orange \
2995 $ui_diff tag conf d
======= \
2996 -foreground orange \
2998 $ui_diff tag conf d
>>>>>>> \
2999 -foreground orange \
3002 $ui_diff tag raise sel
3004 # -- Diff Body Context Menu
3007 proc create_common_diff_popup
{ctxm
} {
3009 -label [mc
"Show Less Context"] \
3010 -command show_less_context
3011 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3013 -label [mc
"Show More Context"] \
3014 -command show_more_context
3015 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3018 -label [mc Refresh
] \
3019 -command reshow_diff
3020 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3023 -command {tk_textCopy
$ui_diff}
3024 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3026 -label [mc
"Select All"] \
3027 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3028 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3030 -label [mc
"Copy All"] \
3032 $ui_diff tag add sel
0.0 end
3033 tk_textCopy
$ui_diff
3034 $ui_diff tag remove sel
0.0 end
3036 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3039 -label [mc
"Decrease Font Size"] \
3040 -command {incr_font_size font_diff
-1}
3041 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3043 -label [mc
"Increase Font Size"] \
3044 -command {incr_font_size font_diff
1}
3045 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3049 build_encoding_menu
$emenu [list force_diff_encoding
]
3051 -label [mc
"Encoding"] \
3053 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3055 $ctxm add
command -label [mc
"Options..."] \
3059 set ctxm .vpane.lower.
diff.body.ctxm
3060 menu
$ctxm -tearoff 0
3062 -label [mc
"Apply/Reverse Hunk"] \
3063 -command {apply_hunk
$cursorX $cursorY}
3064 set ui_diff_applyhunk
[$ctxm index last
]
3065 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3067 -label [mc
"Apply/Reverse Line"] \
3068 -command {apply_line
$cursorX $cursorY; do_rescan
}
3069 set ui_diff_applyline
[$ctxm index last
]
3070 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3072 create_common_diff_popup
$ctxm
3074 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3075 menu
$ctxmmg -tearoff 0
3076 $ctxmmg add
command \
3077 -label [mc
"Run Merge Tool"] \
3078 -command {merge_resolve_tool
}
3079 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3080 $ctxmmg add separator
3081 $ctxmmg add
command \
3082 -label [mc
"Use Remote Version"] \
3083 -command {merge_resolve_one
3}
3084 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3085 $ctxmmg add
command \
3086 -label [mc
"Use Local Version"] \
3087 -command {merge_resolve_one
2}
3088 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3089 $ctxmmg add
command \
3090 -label [mc
"Revert To Base"] \
3091 -command {merge_resolve_one
1}
3092 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3093 $ctxmmg add separator
3094 create_common_diff_popup
$ctxmmg
3096 proc popup_diff_menu
{ctxm ctxmmg x y X Y
} {
3097 global current_diff_path file_states
3100 if {[info exists file_states
($current_diff_path)]} {
3101 set state
[lindex
$file_states($current_diff_path) 0]
3105 if {[string first
{U
} $state] >= 0} {
3106 tk_popup
$ctxmmg $X $Y
3108 if {$
::ui_index eq $
::current_diff_side
} {
3109 set l
[mc
"Unstage Hunk From Commit"]
3110 set t
[mc
"Unstage Line From Commit"]
3112 set l
[mc
"Stage Hunk For Commit"]
3113 set t
[mc
"Stage Line For Commit"]
3116 ||
$current_diff_path eq
{}
3120 ||
{T_
} eq
$state} {
3125 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3126 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3127 tk_popup
$ctxm $X $Y
3130 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg %x
%y
%X
%Y
]
3134 set main_status
[::status_bar
::new .status
]
3135 pack .status
-anchor w
-side bottom
-fill x
3136 $main_status show
[mc
"Initializing..."]
3141 set gm
$repo_config(gui.geometry
)
3142 wm geometry .
[lindex
$gm 0]
3143 .vpane sash place
0 \
3145 [lindex
[.vpane sash coord
0] 1]
3146 .vpane.files sash place
0 \
3147 [lindex
[.vpane.files sash coord
0] 0] \
3154 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3155 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3156 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3157 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3158 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3159 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3160 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3161 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3162 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3163 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3164 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3165 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3166 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3167 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3168 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3169 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3170 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3171 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3173 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3174 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3175 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3176 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3177 bind $ui_diff <$M1B-Key-v> {break}
3178 bind $ui_diff <$M1B-Key-V> {break}
3179 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3180 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3181 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3182 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3183 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3184 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3185 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3186 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3187 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3188 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3189 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3190 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3191 bind $ui_diff <Button-1
> {focus
%W
}
3193 if {[is_enabled branch
]} {
3194 bind .
<$M1B-Key-n> branch_create
::dialog
3195 bind .
<$M1B-Key-N> branch_create
::dialog
3196 bind .
<$M1B-Key-o> branch_checkout
::dialog
3197 bind .
<$M1B-Key-O> branch_checkout
::dialog
3198 bind .
<$M1B-Key-m> merge
::dialog
3199 bind .
<$M1B-Key-M> merge
::dialog
3201 if {[is_enabled transport
]} {
3202 bind .
<$M1B-Key-p> do_push_anywhere
3203 bind .
<$M1B-Key-P> do_push_anywhere
3206 bind .
<Key-F5
> ui_do_rescan
3207 bind .
<$M1B-Key-r> ui_do_rescan
3208 bind .
<$M1B-Key-R> ui_do_rescan
3209 bind .
<$M1B-Key-s> do_signoff
3210 bind .
<$M1B-Key-S> do_signoff
3211 bind .
<$M1B-Key-t> do_add_selection
3212 bind .
<$M1B-Key-T> do_add_selection
3213 bind .
<$M1B-Key-i> do_add_all
3214 bind .
<$M1B-Key-I> do_add_all
3215 bind .
<$M1B-Key-minus> {show_less_context
;break}
3216 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3217 bind .
<$M1B-Key-equal> {show_more_context
;break}
3218 bind .
<$M1B-Key-plus> {show_more_context
;break}
3219 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3220 bind .
<$M1B-Key-Return> do_commit
3221 foreach i
[list
$ui_index $ui_workdir] {
3222 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
3223 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3224 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
3228 set file_lists
($ui_index) [list
]
3229 set file_lists
($ui_workdir) [list
]
3231 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3232 focus
-force $ui_comm
3234 # -- Warn the user about environmental problems. Cygwin's Tcl
3235 # does *not* pass its env array onto any processes it spawns.
3236 # This means that git processes get none of our environment.
3241 set msg
[mc
"Possible environment issues exist.
3243 The following environment variables are probably
3244 going to be ignored by any Git subprocess run
3248 foreach name
[array names env
] {
3249 switch
-regexp -- $name {
3250 {^GIT_INDEX_FILE$
} -
3251 {^GIT_OBJECT_DIRECTORY$
} -
3252 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3254 {^GIT_EXTERNAL_DIFF$
} -
3258 {^GIT_CONFIG_LOCAL$
} -
3259 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3260 append msg
" - $name\n"
3263 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3264 append msg
" - $name\n"
3266 set suggest_user
$name
3270 if {$ignored_env > 0} {
3272 This is due to a known issue with the
3273 Tcl binary distributed by Cygwin."]
3275 if {$suggest_user ne
{}} {
3278 A good replacement for %s
3279 is placing values for the user.name and
3280 user.email settings into your personal
3286 unset ignored_env msg suggest_user name
3289 # -- Only initialize complex UI if we are going to stay running.
3291 if {[is_enabled transport
]} {
3294 set n
[.mbar.remote index end
]
3295 populate_remotes_menu
3296 set n
[expr {[.mbar.remote index end
] - $n}]
3298 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3299 .mbar.remote insert
$n separator
3304 if {[winfo exists
$ui_comm]} {
3305 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
3307 # -- If both our backup and message files exist use the
3308 # newer of the two files to initialize the buffer.
3310 if {$GITGUI_BCK_exists} {
3311 set m
[gitdir GITGUI_MSG
]
3312 if {[file isfile
$m]} {
3313 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3314 catch
{file delete
[gitdir GITGUI_MSG
]}
3316 $ui_comm delete
0.0 end
3318 $ui_comm edit modified false
3319 catch
{file delete
[gitdir GITGUI_BCK
]}
3320 set GITGUI_BCK_exists
0
3326 proc backup_commit_buffer
{} {
3327 global ui_comm GITGUI_BCK_exists
3329 set m
[$ui_comm edit modified
]
3330 if {$m ||
$GITGUI_BCK_exists} {
3331 set msg
[string trim
[$ui_comm get
0.0 end
]]
3332 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3335 if {$GITGUI_BCK_exists} {
3336 catch
{file delete
[gitdir GITGUI_BCK
]}
3337 set GITGUI_BCK_exists
0
3341 set fd
[open
[gitdir GITGUI_BCK
] w
]
3342 puts
-nonewline $fd $msg
3344 set GITGUI_BCK_exists
1
3348 $ui_comm edit modified false
3351 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3354 backup_commit_buffer
3356 # -- If the user has aspell available we can drive it
3357 # in pipe mode to spellcheck the commit message.
3359 set spell_cmd
[list |
]
3360 set spell_dict
[get_config gui.spellingdictionary
]
3361 lappend spell_cmd aspell
3362 if {$spell_dict ne
{}} {
3363 lappend spell_cmd
--master=$spell_dict
3365 lappend spell_cmd
--mode=none
3366 lappend spell_cmd
--encoding=utf-8
3367 lappend spell_cmd pipe
3368 if {$spell_dict eq
{none
}
3369 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3370 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3372 set ui_comm_spell
[spellcheck
::init \
3378 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3381 lock_index begin-read
3382 if {![winfo ismapped .
]} {
3386 if {[is_enabled initialamend
]} {
3392 if {[is_enabled nocommitmsg
]} {
3393 $ui_comm configure
-state disabled
-background gray
3396 if {[is_enabled multicommit
]} {
3399 if {[is_enabled retcode
]} {
3400 bind .
<Destroy
> {+terminate_me
%W
}
3402 if {$picked && [is_config_true gui.autoexplore
]} {