2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 ||
test "z$*" = z--version
; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
10 exec wish
"$argv0" -- "$@"
12 set appvers
{@@GITGUI_VERSION@@
}
13 set copyright
[encoding convertfrom utf-8
{
14 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
16 This program is free software
; you can redistribute it and
/or modify
17 it under the terms of the GNU General Public License as published by
18 the Free Software Foundation
; either version
2 of the License
, or
19 (at your option
) any later version.
21 This program is distributed
in the hope that it will be useful
,
22 but WITHOUT ANY WARRANTY
; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License
for more details.
26 You should have received a copy of the GNU General Public License
27 along with this program
; if not
, write to the Free Software
28 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}]
30 ######################################################################
32 ## Tcl/Tk sanity check
34 if {[catch
{package require Tcl
8.4} err
]
35 ||
[catch
{package require Tk
8.4} err
]
41 -title [mc
"git-gui: fatal error"] \
46 catch
{rename send
{}} ; # What an evil concept...
48 ######################################################################
52 set oguilib
{@@GITGUI_LIBDIR@@
}
53 set oguirel
{@@GITGUI_RELATIVE@@
}
54 if {$oguirel eq
{1}} {
55 set oguilib
[file dirname [file normalize
$argv0]]
56 if {[file tail $oguilib] eq
{git-core
}} {
57 set oguilib
[file dirname $oguilib]
59 set oguilib
[file dirname $oguilib]
60 set oguilib
[file join $oguilib share git-gui lib
]
61 set oguimsg
[file join $oguilib msgs
]
62 } elseif
{[string match @@
* $oguirel]} {
63 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
64 set oguimsg
[file join [file dirname [file normalize
$argv0]] po
]
66 set oguimsg
[file join $oguilib msgs
]
70 ######################################################################
72 ## enable verbose loading?
74 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
76 rename auto_load real__auto_load
77 proc auto_load
{name args
} {
78 puts stderr
"auto_load $name"
79 return [uplevel
1 real__auto_load
$name $args]
81 rename
source real__source
83 puts stderr
"source $name"
84 uplevel
1 real__source
$name
88 ######################################################################
90 ## Internationalization (i18n) through msgcat and gettext. See
91 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93 package require msgcat
96 set cmk
[string first @@
$fmt]
98 return [string range
$fmt 0 [expr {$cmk - 1}]]
103 proc mc
{en_fmt args
} {
104 set fmt [_mc_trim
[::msgcat
::mc
$en_fmt]]
105 if {[catch
{set msg
[eval [list format
$fmt] $args]} err
]} {
106 set msg
[eval [list format
[_mc_trim
$en_fmt]] $args]
112 return [join $args {}]
115 ::msgcat
::mcload
$oguimsg
118 ######################################################################
122 set _appname
{Git Gui
}
130 set _trace
[lsearch
-exact $argv --trace]
132 set argv
[lreplace
$argv $_trace $_trace]
148 return [eval [list
file join $_gitdir] $args]
151 proc gitexec
{args
} {
153 if {$_gitexec eq
{}} {
154 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
155 error
"Git not installed?\n\n$err"
158 set _gitexec
[exec cygpath \
163 set _gitexec
[file normalize
$_gitexec]
169 return [eval [list
file join $_gitexec] $args]
172 proc githtmldir
{args
} {
174 if {$_githtmldir eq
{}} {
175 if {[catch
{set _githtmldir
[git
--html-path]}]} {
176 # Git not installed or option not yet supported
180 set _githtmldir
[exec cygpath \
185 set _githtmldir
[file normalize
$_githtmldir]
191 return [eval [list
file join $_githtmldir] $args]
199 if {[tk windowingsystem
] eq
{aqua
}} {
206 if {$
::tcl_platform
(platform
) eq
{windows
}} {
214 if {$_iscygwin eq
{}} {
215 if {$
::tcl_platform
(platform
) eq
{windows
}} {
216 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
228 proc is_enabled
{option
} {
229 global enabled_options
230 if {[catch
{set on
$enabled_options($option)}]} {return 0}
234 proc enable_option
{option
} {
235 global enabled_options
236 set enabled_options
($option) 1
239 proc disable_option
{option
} {
240 global enabled_options
241 set enabled_options
($option) 0
244 ######################################################################
248 proc is_many_config
{name
} {
249 switch
-glob -- $name {
259 proc is_config_true
{name
} {
261 if {[catch
{set v
$repo_config($name)}]} {
263 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
270 proc get_config
{name
} {
272 if {[catch
{set v
$repo_config($name)}]} {
279 ######################################################################
283 proc _trace_exec
{cmd
} {
284 if {!$
::_trace
} return
290 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
298 proc _git_cmd {name} {
301 if {[catch {set v $_git_cmd_path($name)}]} {
305 --exec-path { return [list $::_git $name] }
308 set p [gitexec git-$name$::_search_exe]
309 if {[file exists $p]} {
311 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
312 # Try to determine what sort of magic will make
313 # git-$name go and do its thing, because native
314 # Tcl on Windows doesn't know it.
316 set p
[gitexec git-
$name]
321 switch
-glob -- [lindex
$s 0] {
323 #!*perl { set i perl }
324 #!*python { set i python }
325 default
{ error
"git-$name is not supported: $s" }
329 if {![info exists interp
]} {
330 set interp
[_which
$i]
333 error
"git-$name requires $i (not in PATH)"
335 set v
[concat
[list
$interp] [lrange
$s 1 end
] [list
$p]]
337 # Assume it is builtin to git somehow and we
338 # aren't actually able to see a file for it.
340 set v
[list $
::_git
$name]
342 set _git_cmd_path
($name) $v
347 proc _which
{what args
} {
348 global env _search_exe _search_path
350 if {$_search_path eq
{}} {
351 if {[is_Cygwin
] && [regexp
{^
(/|\.
:)} $env(PATH
)]} {
352 set _search_path
[split [exec cygpath \
358 } elseif
{[is_Windows
]} {
359 set gitguidir
[file dirname [info
script]]
360 regsub
-all ";" $gitguidir "\\;" gitguidir
361 set env
(PATH
) "$gitguidir;$env(PATH)"
362 set _search_path
[split $env(PATH
) {;}]
365 set _search_path
[split $env(PATH
) :]
370 if {[is_Windows
] && [lsearch
-exact $args -script] >= 0} {
373 set suffix
$_search_exe
376 foreach p
$_search_path {
377 set p
[file join $p $what$suffix]
378 if {[file exists
$p]} {
379 return [file normalize
$p]
385 proc _lappend_nice
{cmd_var
} {
389 if {![info exists _nice
]} {
390 set _nice
[_which nice
]
401 switch
-- [lindex
$args 0] {
412 set args
[lrange
$args 1 end
]
415 set cmdp
[_git_cmd
[lindex
$args 0]]
416 set args
[lrange
$args 1 end
]
418 _trace_exec
[concat
$opt $cmdp $args]
419 set result
[eval exec $opt $cmdp $args]
421 puts stderr
"< $result"
426 proc _open_stdout_stderr
{cmd
} {
429 set fd
[open
[concat
[list |
] $cmd] r
]
431 if { [lindex
$cmd end
] eq
{2>@
1}
432 && $err eq
{can not
find channel named
"1"}
434 # Older versions of Tcl 8.4 don't have this 2>@1 IO
435 # redirect operator. Fallback to |& cat for those.
436 # The command was not actually started, so its safe
437 # to try to start it a second time.
439 set fd
[open
[concat \
441 [lrange
$cmd 0 end-1
] \
448 fconfigure
$fd -eofchar {}
452 proc git_read
{args
} {
456 switch
-- [lindex
$args 0] {
471 set args
[lrange
$args 1 end
]
474 set cmdp
[_git_cmd
[lindex
$args 0]]
475 set args
[lrange
$args 1 end
]
477 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
480 proc git_write
{args
} {
484 switch
-- [lindex
$args 0] {
495 set args
[lrange
$args 1 end
]
498 set cmdp
[_git_cmd
[lindex
$args 0]]
499 set args
[lrange
$args 1 end
]
501 _trace_exec
[concat
$opt $cmdp $args]
502 return [open
[concat
[list |
] $opt $cmdp $args] w
]
505 proc githook_read
{hook_name args
} {
506 set pchook
[gitdir hooks
$hook_name]
509 # On Windows [file executable] might lie so we need to ask
510 # the shell if the hook is executable. Yes that's annoying.
514 if {![info exists interp
]} {
515 set interp
[_which sh
]
518 error
"hook execution requires sh (not in PATH)"
521 set scr
{if test -x "$1";then exec "$@";fi}
522 set sh_c
[list
$interp -c $scr $interp $pchook]
523 return [_open_stdout_stderr
[concat
$sh_c $args]]
526 if {[file executable
$pchook]} {
527 return [_open_stdout_stderr
[concat
[list
$pchook] $args]]
533 proc kill_file_process
{fd
} {
534 set process
[pid
$fd]
538 # Use a Cygwin-specific flag to allow killing
539 # native Windows processes
540 exec kill -f $process
547 proc gitattr
{path attr default
} {
548 if {[catch
{set r
[git check-attr
$attr -- $path]}]} {
551 set r
[join [lrange
[split $r :] 2 end
] :]
554 if {$r eq
{unspecified
}} {
561 regsub
-all ' $value "'\\''" value
565 proc load_current_branch {} {
566 global current_branch is_detached
568 set fd [open [gitdir HEAD] r]
569 if {[gets $fd ref] < 1} {
574 set pfx {ref: refs/heads/}
575 set len [string length $pfx]
576 if {[string equal -length $len $pfx $ref]} {
577 # We're on a branch. It might not exist. But
578 # HEAD looks good enough to be a branch.
580 set current_branch [string range $ref $len end]
583 # Assume this is a detached head.
585 set current_branch HEAD
590 auto_load tk_optionMenu
591 rename tk_optionMenu real__tkOptionMenu
592 proc tk_optionMenu {w varName args} {
593 set m [eval real__tkOptionMenu $w $varName $args]
594 $m configure -font font_ui
595 $w configure -font font_ui
599 proc rmsel_tag {text} {
601 -background [$text cget -background] \
602 -foreground [$text cget -foreground] \
604 $text tag conf in_sel -background lightgray
605 bind $text <Motion> break
610 bind . <Visibility> {
611 bind . <Visibility> {}
616 wm iconbitmap . -default $oguilib/git-gui.ico
617 set ::tk::AlwaysShowSelection 1
619 # Spoof an X11 display for SSH
620 if {![info exists env(DISPLAY)]} {
621 set env(DISPLAY) :9999
625 image create photo gitlogo -width 16 -height 16
627 gitlogo put #33CC33 -to 7 0 9 2
628 gitlogo put #33CC33 -to 4 2 12 4
629 gitlogo put #33CC33 -to 7 4 9 6
630 gitlogo put #CC3333 -to 4 6 12 8
631 gitlogo put gray26 -to 4 9 6 10
632 gitlogo put gray26 -to 3 10 6 12
633 gitlogo put gray26 -to 8 9 13 11
634 gitlogo put gray26 -to 8 11 10 12
635 gitlogo put gray26 -to 11 11 13 14
636 gitlogo put gray26 -to 3 12 5 14
637 gitlogo put gray26 -to 5 13
638 gitlogo put gray26 -to 10 13
639 gitlogo put gray26 -to 4 14 12 15
640 gitlogo put gray26 -to 5 15 11 16
643 wm iconphoto . -default gitlogo
647 ######################################################################
652 font create font_diff -family Courier -size 10
656 eval font configure font_ui [font actual [.dummy cget -font]]
660 font create font_uiitalic
661 font create font_uibold
662 font create font_diffbold
663 font create font_diffitalic
665 foreach class {Button Checkbutton Entry Label
666 Labelframe Listbox Message
667 Radiobutton Spinbox Text} {
668 option add *$class.font font_ui
671 option add *Menu.font font_ui
675 if {[is_Windows] || [is_MacOSX]} {
676 option add *Menu.tearOff 0
687 proc bind_button3 {w cmd} {
688 bind $w <Any-Button-3> $cmd
690 # Mac OS X sends Button-2 on right click through three-button mouse,
691 # or through trackpad right-clicking (two-finger touch + click).
692 bind $w <Any-Button-2> $cmd
693 bind $w <Control-Button-1> $cmd
697 proc apply_config {} {
698 global repo_config font_descs
700 foreach option $font_descs {
701 set name [lindex $option 0]
702 set font [lindex $option 1]
705 foreach {cn cv} $repo_config(gui.$name) {
706 if {$cn eq {-weight}} {
709 font configure $font $cn $cv
712 font configure $font -weight normal
715 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
717 foreach {cn cv} [font configure $font] {
718 font configure ${font}bold $cn $cv
719 font configure ${font}italic $cn $cv
721 font configure ${font}bold -weight bold
722 font configure ${font}italic -slant italic
726 set default_config(branch.autosetupmerge) true
727 set default_config(merge.tool) {}
728 set default_config(mergetool.keepbackup) true
729 set default_config(merge.diffstat) true
730 set default_config(merge.summary) false
731 set default_config(merge.verbosity) 2
732 set default_config(user.name) {}
733 set default_config(user.email) {}
735 set default_config(gui.encoding) [encoding system]
736 set default_config(gui.matchtrackingbranch) false
737 set default_config(gui.pruneduringfetch) false
738 set default_config(gui.trustmtime) false
739 set default_config(gui.fastcopyblame) false
740 set default_config(gui.copyblamethreshold) 40
741 set default_config(gui.blamehistoryctx) 7
742 set default_config(gui.diffcontext) 5
743 set default_config(gui.commitmsgwidth) 75
744 set default_config(gui.newbranchtemplate) {}
745 set default_config(gui.spellingdictionary) {}
746 set default_config(gui.fontui) [font configure font_ui]
747 set default_config(gui.fontdiff) [font configure font_diff]
748 # TODO: this option should be added to the git-config documentation
749 set default_config(gui.maxfilesdisplayed) 5000
751 {fontui font_ui {mc "Main Font
"}}
752 {fontdiff font_diff {mc "Diff
/Console Font
"}}
755 ######################################################################
759 set _git [_which git]
761 catch {wm withdraw .}
765 -title [mc "git-gui
: fatal error
"] \
766 -message [mc "Cannot
find git
in PATH.
"]
770 ######################################################################
774 if {[catch {set _git_version [git --version]} err]} {
775 catch {wm withdraw .}
779 -title [mc "git-gui
: fatal error
"] \
780 -message "Cannot determine Git version
:
784 [appname
] requires Git
1.5.0 or later.
"
787 if {![regsub {^git version } $_git_version {} _git_version]} {
788 catch {wm withdraw .}
792 -title [mc "git-gui
: fatal error
"] \
793 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
797 set _real_git_version $_git_version
798 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
799 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
800 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
801 regsub {\.GIT$} $_git_version {} _git_version
802 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
804 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
805 catch {wm withdraw .}
810 -title "[appname
]: warning
" \
811 -message [mc "Git version cannot be determined.
813 %s claims it is version
'%s'.
815 %s requires
at least Git
1.5.0 or later.
817 Assume
'%s' is version
1.5.0?
818 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
819 set _git_version 1.5.0
824 unset _real_git_version
826 proc git-version {args} {
829 switch [llength $args] {
835 set op [lindex $args 0]
836 set vr [lindex $args 1]
837 set cm [package vcompare $_git_version $vr]
838 return [expr $cm $op 0]
842 set type [lindex $args 0]
843 set name [lindex $args 1]
844 set parm [lindex $args 2]
845 set body [lindex $args 3]
847 if {($type ne {proc} && $type ne {method})} {
848 error "Invalid arguments to git-version
"
850 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
851 error "Last arm of
$type $name must be default
"
854 foreach {op vr cb} [lrange $body 0 end-2] {
855 if {[git-version $op $vr]} {
856 return [uplevel [list $type $name $parm $cb]]
860 return [uplevel [list $type $name $parm [lindex $body end]]]
864 error "git-version
>= x
"
870 if {[git-version < 1.5]} {
871 catch {wm withdraw .}
875 -title [mc "git-gui
: fatal error
"] \
876 -message "[appname
] requires Git
1.5.0 or later.
878 You are using
[git-version
]:
884 ######################################################################
886 ## configure our library
888 set idx [file join $oguilib tclIndex]
889 if {[catch {set fd [open $idx r]} err]} {
890 catch {wm withdraw .}
894 -title [mc "git-gui
: fatal error
"] \
898 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
900 while {[gets $fd n] >= 0} {
901 if {$n ne {} && ![string match #* $n]} {
913 if {[lsearch -exact $loaded $p] >= 0} continue
914 source [file join $oguilib $p]
919 set auto_path [concat [list $oguilib] $auto_path]
921 unset -nocomplain idx fd
923 ######################################################################
925 ## config file parsing
927 git-version proc _parse_config {arr_name args} {
934 [list git_read config] \
936 [list --null --list]]
937 fconfigure $fd_rc -translation binary
938 set buf [read $fd_rc]
941 foreach line [split $buf "\
0"] {
942 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
943 if {[is_many_config $name]} {
944 lappend arr($name) $value
946 set arr($name) $value
955 set fd_rc [eval [list git_read config --list] $args]
956 while {[gets $fd_rc line] >= 0} {
957 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
958 if {[is_many_config $name]} {
959 lappend arr($name) $value
961 set arr($name) $value
970 proc load_config {include_global} {
971 global repo_config global_config system_config default_config
973 if {$include_global} {
974 _parse_config system_config --system
975 _parse_config global_config --global
977 _parse_config repo_config
979 foreach name [array names default_config] {
980 if {[catch {set v $system_config($name)}]} {
981 set system_config($name) $default_config($name)
984 foreach name [array names system_config] {
985 if {[catch {set v $global_config($name)}]} {
986 set global_config($name) $system_config($name)
988 if {[catch {set v $repo_config($name)}]} {
989 set repo_config($name) $system_config($name)
994 ######################################################################
996 ## feature option selection
998 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1003 if {$subcommand eq {gui.sh}} {
1006 if {$subcommand eq {gui} && [llength $argv] > 0} {
1007 set subcommand [lindex $argv 0]
1008 set argv [lrange $argv 1 end]
1011 enable_option multicommit
1012 enable_option branch
1013 enable_option transport
1016 switch -- $subcommand {
1021 disable_option multicommit
1022 disable_option branch
1023 disable_option transport
1026 enable_option singlecommit
1027 enable_option retcode
1029 disable_option multicommit
1030 disable_option branch
1031 disable_option transport
1033 while {[llength $argv] > 0} {
1034 set a [lindex $argv 0]
1037 enable_option initialamend
1040 enable_option nocommit
1041 enable_option nocommitmsg
1044 disable_option nocommitmsg
1051 set argv [lrange $argv 1 end]
1056 ######################################################################
1058 ## execution environment
1060 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1062 # Suggest our implementation of askpass, if none is set
1063 if {![info exists env(SSH_ASKPASS)]} {
1064 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1067 ######################################################################
1073 set _gitdir $env(GIT_DIR)
1077 set _gitdir [git rev-parse --git-dir]
1078 set _prefix [git rev-parse --show-prefix]
1082 choose_repository::pick
1085 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1086 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1088 if {![file isdirectory $_gitdir]} {
1089 catch {wm withdraw .}
1090 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
1093 if {$_prefix ne {}} {
1094 regsub -all {[^/]+/} $_prefix ../ cdup
1095 if {[catch {cd $cdup} err]} {
1096 catch {wm withdraw .}
1097 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
1101 } elseif {![is_enabled bare]} {
1102 if {[lindex [file split $_gitdir] end] ne {.git}} {
1103 catch {wm withdraw .}
1104 error_popup [strcat [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
1107 if {[catch {cd [file dirname $_gitdir]} err]} {
1108 catch {wm withdraw .}
1109 error_popup [strcat [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
1113 set _reponame [file split [file normalize $_gitdir]]
1114 if {[lindex $_reponame end] eq {.git}} {
1115 set _reponame [lindex $_reponame end-1]
1117 set _reponame [lindex $_reponame end]
1120 ######################################################################
1124 set current_diff_path {}
1125 set current_diff_side {}
1126 set diff_actions [list]
1130 set MERGE_HEAD [list]
1133 set current_branch {}
1135 set current_diff_path {}
1137 set is_conflict_diff 0
1138 set selected_commit_type new
1139 set diff_empty_count 0
1141 set nullid "0000000000000000000000000000000000000000"
1142 set nullid2 "0000000000000000000000000000000000000001"
1144 ######################################################################
1152 set disable_on_lock [list]
1153 set index_lock_type none
1155 proc lock_index {type} {
1156 global index_lock_type disable_on_lock
1158 if {$index_lock_type eq {none}} {
1159 set index_lock_type $type
1160 foreach w $disable_on_lock {
1161 uplevel #0 $w disabled
1164 } elseif {$index_lock_type eq "begin-
$type"} {
1165 set index_lock_type $type
1171 proc unlock_index {} {
1172 global index_lock_type disable_on_lock
1174 set index_lock_type none
1175 foreach w $disable_on_lock {
1176 uplevel #0 $w normal
1180 ######################################################################
1184 proc repository_state {ctvar hdvar mhvar} {
1185 global current_branch
1186 upvar $ctvar ct $hdvar hd $mhvar mh
1191 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1197 set merge_head [gitdir MERGE_HEAD]
1198 if {[file exists $merge_head]} {
1200 set fd_mh [open $merge_head r]
1201 while {[gets $fd_mh line] >= 0} {
1212 global PARENT empty_tree
1214 set p [lindex $PARENT 0]
1218 if {$empty_tree eq {}} {
1219 set empty_tree [git mktree << {}]
1224 proc force_amend {} {
1225 global selected_commit_type
1226 global HEAD PARENT MERGE_HEAD commit_type
1228 repository_state newType newHEAD newMERGE_HEAD
1231 set MERGE_HEAD $newMERGE_HEAD
1232 set commit_type $newType
1234 set selected_commit_type amend
1235 do_select_commit_type
1238 proc rescan {after {honor_trustmtime 1}} {
1239 global HEAD PARENT MERGE_HEAD commit_type
1240 global ui_index ui_workdir ui_comm
1241 global rescan_active file_states
1244 if {$rescan_active > 0 || ![lock_index read]} return
1246 repository_state newType newHEAD newMERGE_HEAD
1247 if {[string match amend* $commit_type]
1248 && $newType eq {normal}
1249 && $newHEAD eq $HEAD} {
1253 set MERGE_HEAD $newMERGE_HEAD
1254 set commit_type $newType
1257 array unset file_states
1259 if {!$::GITGUI_BCK_exists &&
1260 (![$ui_comm edit modified]
1261 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1262 if {[string match amend* $commit_type]} {
1263 } elseif {[load_message GITGUI_MSG]} {
1264 } elseif {[run_prepare_commit_msg_hook]} {
1265 } elseif {[load_message MERGE_MSG]} {
1266 } elseif {[load_message SQUASH_MSG]} {
1269 $ui_comm edit modified false
1272 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1273 rescan_stage2 {} $after
1276 ui_status [mc "Refreshing
file status...
"]
1277 set fd_rf [git_read update-index \
1283 fconfigure $fd_rf -blocking 0 -translation binary
1284 fileevent $fd_rf readable \
1285 [list rescan_stage2 $fd_rf $after]
1290 set is_git_info_exclude {}
1291 proc have_info_exclude {} {
1292 global is_git_info_exclude
1294 if {$is_git_info_exclude eq {}} {
1295 if {[catch {exec test -f [gitdir info exclude]}]} {
1296 set is_git_info_exclude 0
1298 set is_git_info_exclude 1
1301 return $is_git_info_exclude
1304 proc have_info_exclude {} {
1305 return [file readable [gitdir info exclude]]
1309 proc rescan_stage2 {fd after} {
1310 global rescan_active buf_rdi buf_rdf buf_rlo
1314 if {![eof $fd]} return
1318 set ls_others [list --exclude-per-directory=.gitignore]
1319 if {[have_info_exclude]} {
1320 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1322 set user_exclude [get_config core.excludesfile]
1323 if {$user_exclude ne {} && [file readable $user_exclude]} {
1324 lappend ls_others "--exclude-from=$user_exclude"
1332 ui_status [mc "Scanning
for modified files ...
"]
1333 set fd_di [git_read diff-index --cached -z [PARENT]]
1334 set fd_df [git_read diff-files -z]
1335 set fd_lo [eval git_read ls-files --others -z $ls_others]
1337 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1338 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1339 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1340 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1341 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1342 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1345 proc load_message {file} {
1348 set f [gitdir $file]
1349 if {[file isfile $f]} {
1350 if {[catch {set fd [open $f r]}]} {
1353 fconfigure $fd -eofchar {}
1354 set content [string trim [read $fd]]
1356 regsub -all -line {[ \r\t]+$} $content {} content
1357 $ui_comm delete 0.0 end
1358 $ui_comm insert end $content
1364 proc run_prepare_commit_msg_hook {} {
1367 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1368 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1369 # empty file but existant file.
1371 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1373 if {[file isfile [gitdir MERGE_MSG]]} {
1374 set pcm_source "merge
"
1375 set fd_mm [open [gitdir MERGE_MSG] r]
1376 puts -nonewline $fd_pcm [read $fd_mm]
1378 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1379 set pcm_source "squash
"
1380 set fd_sm [open [gitdir SQUASH_MSG] r]
1381 puts -nonewline $fd_pcm [read $fd_sm]
1389 set fd_ph [githook_read prepare-commit-msg \
1390 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1392 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1396 ui_status [mc "Calling prepare-commit-msg hook...
"]
1399 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1400 fileevent $fd_ph readable \
1401 [list prepare_commit_msg_hook_wait $fd_ph]
1406 proc prepare_commit_msg_hook_wait {fd_ph} {
1409 append pch_error [read $fd_ph]
1410 fconfigure $fd_ph -blocking 1
1412 if {[catch {close $fd_ph}]} {
1413 ui_status [mc "Commit declined by prepare-commit-msg hook.
"]
1414 hook_failed_popup prepare-commit-msg $pch_error
1415 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1418 load_message PREPARE_COMMIT_MSG
1421 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1424 fconfigure $fd_ph -blocking 0
1425 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1428 proc read_diff_index {fd after} {
1431 append buf_rdi [read $fd]
1433 set n [string length $buf_rdi]
1435 set z1 [string first "\
0" $buf_rdi $c]
1436 if {$z1 == -1} break
1438 set z2 [string first "\
0" $buf_rdi $z1]
1439 if {$z2 == -1} break
1442 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1443 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1445 [encoding convertfrom $p] \
1447 [list [lindex $i 0] [lindex $i 2]] \
1453 set buf_rdi [string range $buf_rdi $c end]
1458 rescan_done $fd buf_rdi $after
1461 proc read_diff_files {fd after} {
1464 append buf_rdf [read $fd]
1466 set n [string length $buf_rdf]
1468 set z1 [string first "\
0" $buf_rdf $c]
1469 if {$z1 == -1} break
1471 set z2 [string first "\
0" $buf_rdf $z1]
1472 if {$z2 == -1} break
1475 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1476 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1478 [encoding convertfrom $p] \
1481 [list [lindex $i 0] [lindex $i 2]]
1486 set buf_rdf [string range $buf_rdf $c end]
1491 rescan_done $fd buf_rdf $after
1494 proc read_ls_others {fd after} {
1497 append buf_rlo [read $fd]
1498 set pck [split $buf_rlo "\
0"]
1499 set buf_rlo [lindex $pck end]
1500 foreach p [lrange $pck 0 end-1] {
1501 set p [encoding convertfrom $p]
1502 if {[string index $p end] eq {/}} {
1503 set p [string range $p 0 end-1]
1507 rescan_done $fd buf_rlo $after
1510 proc rescan_done {fd buf after} {
1511 global rescan_active current_diff_path
1512 global file_states repo_config
1515 if {![eof $fd]} return
1518 if {[incr rescan_active -1] > 0} return
1523 if {$current_diff_path ne {}} { reshow_diff $after }
1524 if {$current_diff_path eq {}} { select_first_diff $after }
1527 proc prune_selection {} {
1528 global file_states selected_paths
1530 foreach path [array names selected_paths] {
1531 if {[catch {set still_here $file_states($path)}]} {
1532 unset selected_paths($path)
1537 ######################################################################
1541 proc mapicon {w state path} {
1544 if {[catch {set r $all_icons($state$w)}]} {
1545 puts "error
: no icon
for $w state
={$state} $path"
1551 proc mapdesc {state path} {
1554 if {[catch {set r $all_descs($state)}]} {
1555 puts "error
: no desc
for state
={$state} $path"
1561 proc ui_status {msg} {
1563 if {[info exists main_status]} {
1564 $main_status show $msg
1568 proc ui_ready {{test {}}} {
1570 if {[info exists main_status]} {
1571 $main_status show [mc "Ready.
"] $test
1575 proc escape_path {path} {
1576 regsub -all {\\} $path "\\\\" path
1577 regsub -all "\n" $path "\\n
" path
1581 proc short_path {path} {
1582 return [escape_path [lindex [file split $path] end]]
1586 set null_sha1 [string repeat 0 40]
1588 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1589 global file_states next_icon_id null_sha1
1591 set s0 [string index $new_state 0]
1592 set s1 [string index $new_state 1]
1594 if {[catch {set info $file_states($path)}]} {
1596 set icon n[incr next_icon_id]
1598 set state [lindex $info 0]
1599 set icon [lindex $info 1]
1600 if {$head_info eq {}} {set head_info [lindex $info 2]}
1601 if {$index_info eq {}} {set index_info [lindex $info 3]}
1604 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1605 elseif {$s0 eq {_}} {set s0 _}
1607 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1608 elseif {$s1 eq {_}} {set s1 _}
1610 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1611 set head_info [list 0 $null_sha1]
1612 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1613 && $head_info eq {}} {
1614 set head_info $index_info
1617 set file_states($path) [list $s0$s1 $icon \
1618 $head_info $index_info \
1623 proc display_file_helper {w path icon_name old_m new_m} {
1626 if {$new_m eq {_}} {
1627 set lno [lsearch -sorted -exact $file_lists($w) $path]
1629 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1631 $w conf -state normal
1632 $w delete $lno.0 [expr {$lno + 1}].0
1633 $w conf -state disabled
1635 } elseif {$old_m eq {_} && $new_m ne {_}} {
1636 lappend file_lists($w) $path
1637 set file_lists($w) [lsort -unique $file_lists($w)]
1638 set lno [lsearch -sorted -exact $file_lists($w) $path]
1640 $w conf -state normal
1641 $w image create $lno.0 \
1642 -align center -padx 5 -pady 1 \
1644 -image [mapicon $w $new_m $path]
1645 $w insert $lno.1 "[escape_path
$path]\n"
1646 $w conf -state disabled
1647 } elseif {$old_m ne $new_m} {
1648 $w conf -state normal
1649 $w image conf $icon_name -image [mapicon $w $new_m $path]
1650 $w conf -state disabled
1654 proc display_file {path state} {
1655 global file_states selected_paths
1656 global ui_index ui_workdir
1658 set old_m [merge_state $path $state]
1659 set s $file_states($path)
1660 set new_m [lindex $s 0]
1661 set icon_name [lindex $s 1]
1663 set o [string index $old_m 0]
1664 set n [string index $new_m 0]
1671 display_file_helper $ui_index $path $icon_name $o $n
1673 if {[string index $old_m 0] eq {U}} {
1676 set o [string index $old_m 1]
1678 if {[string index $new_m 0] eq {U}} {
1681 set n [string index $new_m 1]
1683 display_file_helper $ui_workdir $path $icon_name $o $n
1685 if {$new_m eq {__}} {
1686 unset file_states($path)
1687 catch {unset selected_paths($path)}
1691 proc display_all_files_helper {w path icon_name m} {
1694 lappend file_lists($w) $path
1695 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1696 $w image create end \
1697 -align center -padx 5 -pady 1 \
1699 -image [mapicon $w $m $path]
1700 $w insert end "[escape_path
$path]\n"
1704 proc display_all_files {} {
1705 global ui_index ui_workdir
1706 global file_states file_lists
1708 global files_warning
1710 $ui_index conf -state normal
1711 $ui_workdir conf -state normal
1713 $ui_index delete 0.0 end
1714 $ui_workdir delete 0.0 end
1717 set file_lists($ui_index) [list]
1718 set file_lists($ui_workdir) [list]
1720 set to_display [lsort [array names file_states]]
1721 set display_limit [get_config gui.maxfilesdisplayed]
1722 if {[llength $to_display] > $display_limit} {
1723 if {!$files_warning} {
1724 # do not repeatedly warn:
1726 info_popup [mc "Displaying only
%s of
%s files.
" \
1727 $display_limit [llength $to_display]]
1729 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1731 foreach path $to_display {
1732 set s $file_states($path)
1734 set icon_name [lindex $s 1]
1736 set s [string index $m 0]
1737 if {$s ne {U} && $s ne {_}} {
1738 display_all_files_helper $ui_index $path \
1742 if {[string index $m 0] eq {U}} {
1745 set s [string index $m 1]
1748 display_all_files_helper $ui_workdir $path \
1753 $ui_index conf -state disabled
1754 $ui_workdir conf -state disabled
1757 ######################################################################
1762 #define mask_width 14
1763 #define mask_height 15
1764 static unsigned char mask_bits[] = {
1765 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1766 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1767 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1770 image create bitmap file_plain -background white -foreground black -data {
1771 #define plain_width 14
1772 #define plain_height 15
1773 static unsigned char plain_bits[] = {
1774 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1775 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1776 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1777 } -maskdata $filemask
1779 image create bitmap file_mod -background white -foreground blue -data {
1780 #define mod_width 14
1781 #define mod_height 15
1782 static unsigned char mod_bits[] = {
1783 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1784 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1785 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1786 } -maskdata $filemask
1788 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1789 #define file_fulltick_width 14
1790 #define file_fulltick_height 15
1791 static unsigned char file_fulltick_bits
[] = {
1792 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1793 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1794 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1795 } -maskdata $filemask
1797 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1798 #define parttick_width 14
1799 #define parttick_height 15
1800 static unsigned char parttick_bits
[] = {
1801 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1802 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1803 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1804 } -maskdata $filemask
1806 image create bitmap file_question
-background white
-foreground black
-data {
1807 #define file_question_width 14
1808 #define file_question_height 15
1809 static unsigned char file_question_bits
[] = {
1810 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1811 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1812 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1813 } -maskdata $filemask
1815 image create bitmap file_removed
-background white
-foreground red
-data {
1816 #define file_removed_width 14
1817 #define file_removed_height 15
1818 static unsigned char file_removed_bits
[] = {
1819 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1820 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1821 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1822 } -maskdata $filemask
1824 image create bitmap file_merge
-background white
-foreground blue
-data {
1825 #define file_merge_width 14
1826 #define file_merge_height 15
1827 static unsigned char file_merge_bits
[] = {
1828 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1829 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1830 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1831 } -maskdata $filemask
1833 image create bitmap file_statechange
-background white
-foreground green
-data {
1834 #define file_merge_width 14
1835 #define file_merge_height 15
1836 static unsigned char file_statechange_bits
[] = {
1837 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1838 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1839 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1840 } -maskdata $filemask
1842 set ui_index .vpane.files.index.list
1843 set ui_workdir .vpane.files.workdir.list
1845 set all_icons
(_
$ui_index) file_plain
1846 set all_icons
(A
$ui_index) file_fulltick
1847 set all_icons
(M
$ui_index) file_fulltick
1848 set all_icons
(D
$ui_index) file_removed
1849 set all_icons
(U
$ui_index) file_merge
1850 set all_icons
(T
$ui_index) file_statechange
1852 set all_icons
(_
$ui_workdir) file_plain
1853 set all_icons
(M
$ui_workdir) file_mod
1854 set all_icons
(D
$ui_workdir) file_question
1855 set all_icons
(U
$ui_workdir) file_merge
1856 set all_icons
(O
$ui_workdir) file_plain
1857 set all_icons
(T
$ui_workdir) file_statechange
1859 set max_status_desc
0
1861 {__
{mc
"Unmodified"}}
1863 {_M
{mc
"Modified, not staged"}}
1864 {M_
{mc
"Staged for commit"}}
1865 {MM
{mc
"Portions staged for commit"}}
1866 {MD
{mc
"Staged for commit, missing"}}
1868 {_T
{mc
"File type changed, not staged"}}
1869 {T_
{mc
"File type changed, staged"}}
1871 {_O
{mc
"Untracked, not staged"}}
1872 {A_
{mc
"Staged for commit"}}
1873 {AM
{mc
"Portions staged for commit"}}
1874 {AD
{mc
"Staged for commit, missing"}}
1877 {D_
{mc
"Staged for removal"}}
1878 {DO
{mc
"Staged for removal, still present"}}
1880 {_U
{mc
"Requires merge resolution"}}
1881 {U_
{mc
"Requires merge resolution"}}
1882 {UU
{mc
"Requires merge resolution"}}
1883 {UM
{mc
"Requires merge resolution"}}
1884 {UD
{mc
"Requires merge resolution"}}
1885 {UT
{mc
"Requires merge resolution"}}
1887 set text
[eval [lindex
$i 1]]
1888 if {$max_status_desc < [string length
$text]} {
1889 set max_status_desc
[string length
$text]
1891 set all_descs
([lindex
$i 0]) $text
1895 ######################################################################
1899 proc scrollbar2many
{list mode args
} {
1900 foreach w
$list {eval $w $mode $args}
1903 proc many2scrollbar
{list mode sb top bottom
} {
1904 $sb set $top $bottom
1905 foreach w
$list {$w $mode moveto
$top}
1908 proc incr_font_size
{font
{amt
1}} {
1909 set sz
[font configure
$font -size]
1911 font configure
$font -size $sz
1912 font configure
${font}bold
-size $sz
1913 font configure
${font}italic
-size $sz
1916 ######################################################################
1920 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1922 proc do_gitk
{revs
} {
1923 # -- Always start gitk through whatever we were loaded with. This
1924 # lets us bypass using shell process on Windows systems.
1926 set exe
[_which gitk
-script]
1927 set cmd
[list
[info nameofexecutable
] $exe]
1929 error_popup
[mc
"Couldn't find gitk in PATH"]
1933 if {[info exists env
(GIT_DIR
)]} {
1934 set old_GIT_DIR
$env(GIT_DIR
)
1940 cd [file dirname [gitdir
]]
1941 set env
(GIT_DIR
) [file tail [gitdir
]]
1943 eval exec $cmd $revs &
1945 if {$old_GIT_DIR eq
{}} {
1948 set env
(GIT_DIR
) $old_GIT_DIR
1952 ui_status $
::starting_gitk_msg
1954 ui_ready
$starting_gitk_msg
1959 proc do_explore
{} {
1961 if {[is_Cygwin
] ||
[is_Windows
]} {
1962 set explorer
"explorer.exe"
1963 } elseif
{[is_MacOSX
]} {
1966 # freedesktop.org-conforming system is our best shot
1967 set explorer
"xdg-open"
1969 eval exec $explorer [list
[file nativename
[file dirname [gitdir
]]]] &
1975 proc terminate_me
{win
} {
1977 if {$win ne
{.
}} return
1981 proc do_quit
{{rc
{1}}} {
1982 global ui_comm is_quitting repo_config commit_type
1983 global GITGUI_BCK_exists GITGUI_BCK_i
1984 global ui_comm_spell
1987 if {$is_quitting} return
1990 if {[winfo exists
$ui_comm]} {
1991 # -- Stash our current commit buffer.
1993 set save
[gitdir GITGUI_MSG
]
1994 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1995 file rename
-force [gitdir GITGUI_BCK
] $save
1996 set GITGUI_BCK_exists
0
1998 set msg
[string trim
[$ui_comm get
0.0 end
]]
1999 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2000 if {(![string match amend
* $commit_type]
2001 ||
[$ui_comm edit modified
])
2004 set fd
[open
$save w
]
2005 puts
-nonewline $fd $msg
2009 catch
{file delete
$save}
2013 # -- Cancel our spellchecker if its running.
2015 if {[info exists ui_comm_spell
]} {
2019 # -- Remove our editor backup, its not needed.
2021 after cancel
$GITGUI_BCK_i
2022 if {$GITGUI_BCK_exists} {
2023 catch
{file delete
[gitdir GITGUI_BCK
]}
2026 # -- Stash our current window geometry into this repository.
2028 set cfg_geometry
[list
]
2029 lappend cfg_geometry
[wm geometry .
]
2030 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
2031 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
2032 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2035 if {$cfg_geometry ne
$rc_geometry} {
2036 catch
{git config gui.geometry
$cfg_geometry}
2048 proc ui_do_rescan
{} {
2049 rescan
{force_first_diff ui_ready
}
2056 proc next_diff
{{after
{}}} {
2057 global next_diff_p next_diff_w next_diff_i
2058 show_diff
$next_diff_p $next_diff_w {} {} $after
2061 proc find_anchor_pos
{lst name
} {
2062 set lid
[lsearch
-sorted -exact $lst $name]
2066 foreach lname
$lst {
2067 if {$lname >= $name} break
2075 proc find_file_from
{flist idx delta path mmask
} {
2078 set len
[llength
$flist]
2079 while {$idx >= 0 && $idx < $len} {
2080 set name
[lindex
$flist $idx]
2082 if {$name ne
$path && [info exists file_states
($name)]} {
2083 set state
[lindex
$file_states($name) 0]
2085 if {$mmask eq
{} ||
[regexp
$mmask $state]} {
2096 proc find_next_diff
{w path
{lno
{}} {mmask
{}}} {
2097 global next_diff_p next_diff_w next_diff_i
2098 global file_lists ui_index ui_workdir
2100 set flist
$file_lists($w)
2102 set lno
[find_anchor_pos
$flist $path]
2107 if {$mmask ne
{} && ![regexp
{(^\^
)|
(\$$
)} $mmask]} {
2108 if {$w eq
$ui_index} {
2111 set mmask
"$mmask\$"
2115 set idx
[find_file_from
$flist $lno 1 $path $mmask]
2118 set idx
[find_file_from
$flist $lno -1 $path $mmask]
2123 set next_diff_p
[lindex
$flist $idx]
2124 set next_diff_i
[expr {$idx+1}]
2131 proc next_diff_after_action
{w path
{lno
{}} {mmask
{}}} {
2132 global current_diff_path
2134 if {$path ne
$current_diff_path} {
2136 } elseif
{[find_next_diff
$w $path $lno $mmask]} {
2139 return {reshow_diff
;}
2143 proc select_first_diff
{after
} {
2146 if {[find_next_diff
$ui_workdir {} 1 {^_?U
}] ||
2147 [find_next_diff
$ui_workdir {} 1 {[^O
]$
}]} {
2154 proc force_first_diff
{after
} {
2155 global ui_workdir current_diff_path file_states
2157 if {[info exists file_states
($current_diff_path)]} {
2158 set state
[lindex
$file_states($current_diff_path) 0]
2164 if {[string first
{U
} $state] >= 0} {
2165 # Already a conflict, do nothing
2166 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {^_?U
}]} {
2168 } elseif
{[string index
$state 1] ne
{O
}} {
2169 # Already a diff & no conflicts, do nothing
2170 } elseif
{[find_next_diff
$ui_workdir $current_diff_path {} {[^O
]$
}]} {
2181 proc toggle_or_diff
{w x y
} {
2182 global file_states file_lists current_diff_path ui_index ui_workdir
2183 global last_clicked selected_paths
2185 set pos
[split [$w index @
$x,$y] .
]
2186 set lno
[lindex
$pos 0]
2187 set col [lindex
$pos 1]
2188 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2194 set last_clicked
[list
$w $lno]
2195 array
unset selected_paths
2196 $ui_index tag remove in_sel
0.0 end
2197 $ui_workdir tag remove in_sel
0.0 end
2199 # Determine the state of the file
2200 if {[info exists file_states
($path)]} {
2201 set state
[lindex
$file_states($path) 0]
2206 # Restage the file, or simply show the diff
2207 if {$col == 0 && $y > 1} {
2208 # Conflicts need special handling
2209 if {[string first
{U
} $state] >= 0} {
2210 # $w must always be $ui_workdir, but...
2211 if {$w ne
$ui_workdir} { set lno
{} }
2212 merge_stage_workdir
$path $lno
2216 if {[string index
$state 1] eq
{O
}} {
2222 set after
[next_diff_after_action
$w $path $lno $mmask]
2224 if {$w eq
$ui_index} {
2226 "Unstaging [short_path $path] from commit" \
2228 [concat
$after [list ui_ready
]]
2229 } elseif
{$w eq
$ui_workdir} {
2231 "Adding [short_path $path]" \
2233 [concat
$after [list ui_ready
]]
2236 show_diff
$path $w $lno
2240 proc add_one_to_selection
{w x y
} {
2241 global file_lists last_clicked selected_paths
2243 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2244 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2250 if {$last_clicked ne
{}
2251 && [lindex
$last_clicked 0] ne
$w} {
2252 array
unset selected_paths
2253 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
2256 set last_clicked
[list
$w $lno]
2257 if {[catch
{set in_sel
$selected_paths($path)}]} {
2261 unset selected_paths
($path)
2262 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2264 set selected_paths
($path) 1
2265 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2269 proc add_range_to_selection
{w x y
} {
2270 global file_lists last_clicked selected_paths
2272 if {[lindex
$last_clicked 0] ne
$w} {
2273 toggle_or_diff
$w $x $y
2277 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
2278 set lc
[lindex
$last_clicked 1]
2287 foreach path
[lrange
$file_lists($w) \
2288 [expr {$begin - 1}] \
2289 [expr {$end - 1}]] {
2290 set selected_paths
($path) 1
2292 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2295 proc show_more_context
{} {
2297 if {$repo_config(gui.diffcontext
) < 99} {
2298 incr repo_config
(gui.diffcontext
)
2303 proc show_less_context
{} {
2305 if {$repo_config(gui.diffcontext
) > 1} {
2306 incr repo_config
(gui.diffcontext
) -1
2311 ######################################################################
2321 menu .mbar
-tearoff 0
2323 # -- Apple Menu (Mac OS X only)
2325 .mbar add cascade
-label Apple
-menu .mbar.apple
2328 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
2329 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
2330 if {[is_enabled branch
]} {
2331 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
2333 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2334 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
2336 if {[is_enabled transport
]} {
2337 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
2338 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
2340 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2341 .mbar add cascade
-label [mc Tools
] -menu .mbar.tools
2344 # -- Repository Menu
2346 menu .mbar.repository
2348 .mbar.repository add
command \
2349 -label [mc
"Explore Working Copy"] \
2350 -command {do_explore
}
2351 .mbar.repository add separator
2353 .mbar.repository add
command \
2354 -label [mc
"Browse Current Branch's Files"] \
2355 -command {browser
::new
$current_branch}
2356 set ui_browse_current
[.mbar.repository index last
]
2357 .mbar.repository add
command \
2358 -label [mc
"Browse Branch Files..."] \
2359 -command browser_open
::dialog
2360 .mbar.repository add separator
2362 .mbar.repository add
command \
2363 -label [mc
"Visualize Current Branch's History"] \
2364 -command {do_gitk
$current_branch}
2365 set ui_visualize_current
[.mbar.repository index last
]
2366 .mbar.repository add
command \
2367 -label [mc
"Visualize All Branch History"] \
2368 -command {do_gitk
--all}
2369 .mbar.repository add separator
2371 proc current_branch_write
{args
} {
2372 global current_branch
2373 .mbar.repository entryconf $
::ui_browse_current \
2374 -label [mc
"Browse %s's Files" $current_branch]
2375 .mbar.repository entryconf $
::ui_visualize_current \
2376 -label [mc
"Visualize %s's History" $current_branch]
2378 trace add variable current_branch
write current_branch_write
2380 if {[is_enabled multicommit
]} {
2381 .mbar.repository add
command -label [mc
"Database Statistics"] \
2384 .mbar.repository add
command -label [mc
"Compress Database"] \
2387 .mbar.repository add
command -label [mc
"Verify Database"] \
2388 -command do_fsck_objects
2390 .mbar.repository add separator
2393 .mbar.repository add
command \
2394 -label [mc
"Create Desktop Icon"] \
2395 -command do_cygwin_shortcut
2396 } elseif
{[is_Windows
]} {
2397 .mbar.repository add
command \
2398 -label [mc
"Create Desktop Icon"] \
2399 -command do_windows_shortcut
2400 } elseif
{[is_MacOSX
]} {
2401 .mbar.repository add
command \
2402 -label [mc
"Create Desktop Icon"] \
2403 -command do_macosx_app
2408 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2410 .mbar.repository add
command -label [mc Quit
] \
2418 .mbar.edit add
command -label [mc Undo
] \
2419 -command {catch
{[focus
] edit undo
}} \
2421 .mbar.edit add
command -label [mc Redo
] \
2422 -command {catch
{[focus
] edit redo
}} \
2424 .mbar.edit add separator
2425 .mbar.edit add
command -label [mc Cut
] \
2426 -command {catch
{tk_textCut
[focus
]}} \
2428 .mbar.edit add
command -label [mc Copy
] \
2429 -command {catch
{tk_textCopy
[focus
]}} \
2431 .mbar.edit add
command -label [mc Paste
] \
2432 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2434 .mbar.edit add
command -label [mc Delete
] \
2435 -command {catch
{[focus
] delete sel.first sel.last
}} \
2437 .mbar.edit add separator
2438 .mbar.edit add
command -label [mc
"Select All"] \
2439 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2444 if {[is_enabled branch
]} {
2447 .mbar.branch add
command -label [mc
"Create..."] \
2448 -command branch_create
::dialog \
2450 lappend disable_on_lock
[list .mbar.branch entryconf \
2451 [.mbar.branch index last
] -state]
2453 .mbar.branch add
command -label [mc
"Checkout..."] \
2454 -command branch_checkout
::dialog \
2456 lappend disable_on_lock
[list .mbar.branch entryconf \
2457 [.mbar.branch index last
] -state]
2459 .mbar.branch add
command -label [mc
"Rename..."] \
2460 -command branch_rename
::dialog
2461 lappend disable_on_lock
[list .mbar.branch entryconf \
2462 [.mbar.branch index last
] -state]
2464 .mbar.branch add
command -label [mc
"Delete..."] \
2465 -command branch_delete
::dialog
2466 lappend disable_on_lock
[list .mbar.branch entryconf \
2467 [.mbar.branch index last
] -state]
2469 .mbar.branch add
command -label [mc
"Reset..."] \
2470 -command merge
::reset_hard
2471 lappend disable_on_lock
[list .mbar.branch entryconf \
2472 [.mbar.branch index last
] -state]
2477 proc commit_btn_caption
{} {
2478 if {[is_enabled nocommit
]} {
2481 return [mc Commit@@verb
]
2485 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2488 if {![is_enabled nocommit
]} {
2489 .mbar.commit add radiobutton \
2490 -label [mc
"New Commit"] \
2491 -command do_select_commit_type \
2492 -variable selected_commit_type \
2494 lappend disable_on_lock \
2495 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2497 .mbar.commit add radiobutton \
2498 -label [mc
"Amend Last Commit"] \
2499 -command do_select_commit_type \
2500 -variable selected_commit_type \
2502 lappend disable_on_lock \
2503 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2505 .mbar.commit add separator
2508 .mbar.commit add
command -label [mc Rescan
] \
2509 -command ui_do_rescan \
2511 lappend disable_on_lock \
2512 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2514 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2515 -command do_add_selection \
2517 lappend disable_on_lock \
2518 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2520 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2521 -command do_add_all \
2523 lappend disable_on_lock \
2524 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2526 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2527 -command do_unstage_selection
2528 lappend disable_on_lock \
2529 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2531 .mbar.commit add
command -label [mc
"Revert Changes"] \
2532 -command do_revert_selection
2533 lappend disable_on_lock \
2534 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2536 .mbar.commit add separator
2538 .mbar.commit add
command -label [mc
"Show Less Context"] \
2539 -command show_less_context \
2540 -accelerator $M1T-\
-
2542 .mbar.commit add
command -label [mc
"Show More Context"] \
2543 -command show_more_context \
2546 .mbar.commit add separator
2548 if {![is_enabled nocommitmsg
]} {
2549 .mbar.commit add
command -label [mc
"Sign Off"] \
2550 -command do_signoff \
2554 .mbar.commit add
command -label [commit_btn_caption
] \
2555 -command do_commit \
2556 -accelerator $M1T-Return
2557 lappend disable_on_lock \
2558 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2563 if {[is_enabled branch
]} {
2565 .mbar.merge add
command -label [mc
"Local Merge..."] \
2566 -command merge
::dialog \
2568 lappend disable_on_lock \
2569 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2570 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2571 -command merge
::reset_hard
2572 lappend disable_on_lock \
2573 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2578 if {[is_enabled transport
]} {
2581 .mbar.remote add
command \
2582 -label [mc
"Add..."] \
2583 -command remote_add
::dialog \
2585 .mbar.remote add
command \
2586 -label [mc
"Push..."] \
2587 -command do_push_anywhere \
2589 .mbar.remote add
command \
2590 -label [mc
"Delete Branch..."] \
2591 -command remote_branch_delete
::dialog
2595 proc
::tk
::mac
::ShowPreferences
{} {do_options
}
2599 .mbar.edit add separator
2600 .mbar.edit add
command -label [mc
"Options..."] \
2606 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2607 set tools_menubar .mbar.tools
2609 $tools_menubar add separator
2610 $tools_menubar add
command -label [mc
"Add..."] -command tools_add
::dialog
2611 $tools_menubar add
command -label [mc
"Remove..."] -command tools_remove
::dialog
2613 if {[array names repo_config guitool.
*.cmd
] ne
{}} {
2620 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2624 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2626 .mbar.apple add separator
2628 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2631 . configure
-menu .mbar
2633 set doc_path
[githtmldir
]
2634 if {$doc_path ne
{}} {
2635 set doc_path
[file join $doc_path index.html
]
2638 set doc_path
[exec cygpath
--mixed $doc_path]
2642 if {[file isfile
$doc_path]} {
2643 set doc_url
"file:$doc_path"
2645 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2648 proc start_browser
{url
} {
2649 git
"web--browse" $url
2652 .mbar.
help add
command -label [mc
"Online Documentation"] \
2653 -command [list start_browser
$doc_url]
2655 .mbar.
help add
command -label [mc
"Show SSH Key"] \
2658 unset doc_path doc_url
2660 # -- Standard bindings
2662 wm protocol . WM_DELETE_WINDOW do_quit
2663 bind all
<$M1B-Key-q> do_quit
2664 bind all
<$M1B-Key-Q> do_quit
2665 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2666 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2668 set subcommand_args
{}
2670 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2674 proc normalize_relpath
{path
} {
2676 foreach item
[file split $path] {
2677 if {$item eq
{.
}} continue
2678 if {$item eq
{..
} && [llength
$elements] > 0
2679 && [lindex
$elements end
] ne
{..
}} {
2680 set elements
[lrange
$elements 0 end-1
]
2683 lappend elements
$item
2685 return [eval file join $elements]
2688 # -- Not a normal commit type invocation? Do that instead!
2690 switch
-- $subcommand {
2693 if {$subcommand eq
"blame"} {
2694 set subcommand_args
{[--line=<num
>] rev? path
}
2696 set subcommand_args
{rev? path
}
2698 if {$argv eq
{}} usage
2704 if {$is_path ||
[file exists
$_prefix$a]} {
2705 if {$path ne
{}} usage
2706 set path
[normalize_relpath
$_prefix$a]
2708 } elseif
{$a eq
{--}} {
2710 if {$head ne
{}} usage
2715 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
2716 if {$jump_spec ne
{} ||
$head ne
{}} usage
2717 set jump_spec
[list
$lnum]
2718 } elseif
{$head eq
{}} {
2719 if {$head ne
{}} usage
2728 if {$head ne
{} && $path eq
{}} {
2729 set path
[normalize_relpath
$_prefix$head]
2736 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2738 set head [git rev-parse
--verify $head]
2744 set current_branch
$head
2747 switch
-- $subcommand {
2749 if {$jump_spec ne
{}} usage
2751 if {$path ne
{} && [file isdirectory
$path]} {
2752 set head $current_branch
2758 browser
::new
$head $path
2761 if {$head eq
{} && ![file exists
$path]} {
2762 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2765 blame
::new
$head $path $jump_spec
2772 if {[llength
$argv] != 0} {
2773 puts
-nonewline stderr
"usage: $argv0"
2774 if {$subcommand ne
{gui
}
2775 && [file tail $argv0] ne
"git-$subcommand"} {
2776 puts
-nonewline stderr
" $subcommand"
2781 # fall through to setup UI for commits
2784 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2795 -text [mc
"Current Branch:"] \
2799 -textvariable current_branch \
2802 pack .branch.l1
-side left
2803 pack .branch.cb
-side left
-fill x
2804 pack .branch
-side top
-fill x
2806 # -- Main Window Layout
2808 panedwindow .vpane
-orient horizontal
2809 panedwindow .vpane.files
-orient vertical
2810 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2811 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2813 # -- Index File List
2815 frame .vpane.files.index
-height 100 -width 200
2816 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Commit)"] \
2817 -background lightgreen
-foreground black
2818 text
$ui_index -background white
-foreground black \
2820 -width 20 -height 10 \
2822 -cursor $cursor_ptr \
2823 -xscrollcommand {.vpane.files.index.sx
set} \
2824 -yscrollcommand {.vpane.files.index.sy
set} \
2826 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2827 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2828 pack .vpane.files.index.title
-side top
-fill x
2829 pack .vpane.files.index.sx
-side bottom
-fill x
2830 pack .vpane.files.index.sy
-side right
-fill y
2831 pack
$ui_index -side left
-fill both
-expand 1
2833 # -- Working Directory File List
2835 frame .vpane.files.workdir
-height 100 -width 200
2836 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
2837 -background lightsalmon
-foreground black
2838 text
$ui_workdir -background white
-foreground black \
2840 -width 20 -height 10 \
2842 -cursor $cursor_ptr \
2843 -xscrollcommand {.vpane.files.workdir.sx
set} \
2844 -yscrollcommand {.vpane.files.workdir.sy
set} \
2846 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2847 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2848 pack .vpane.files.workdir.title
-side top
-fill x
2849 pack .vpane.files.workdir.sx
-side bottom
-fill x
2850 pack .vpane.files.workdir.sy
-side right
-fill y
2851 pack
$ui_workdir -side left
-fill both
-expand 1
2853 .vpane.files add .vpane.files.workdir
-sticky nsew
2854 .vpane.files add .vpane.files.index
-sticky nsew
2856 foreach i
[list
$ui_index $ui_workdir] {
2858 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2862 # -- Diff and Commit Area
2864 frame .vpane.lower
-height 300 -width 400
2865 frame .vpane.lower.commarea
2866 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2867 pack .vpane.lower.
diff -fill both
-expand 1
2868 pack .vpane.lower.commarea
-side bottom
-fill x
2869 .vpane add .vpane.lower
-sticky nsew
2871 # -- Commit Area Buttons
2873 frame .vpane.lower.commarea.buttons
2874 label .vpane.lower.commarea.buttons.l
-text {} \
2877 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2878 pack .vpane.lower.commarea.buttons
-side left
-fill y
2880 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2881 -command ui_do_rescan
2882 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2883 lappend disable_on_lock \
2884 {.vpane.lower.commarea.buttons.rescan conf
-state}
2886 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2888 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2889 lappend disable_on_lock \
2890 {.vpane.lower.commarea.buttons.incall conf
-state}
2892 if {![is_enabled nocommitmsg
]} {
2893 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2895 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2898 button .vpane.lower.commarea.buttons.commit
-text [commit_btn_caption
] \
2900 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2901 lappend disable_on_lock \
2902 {.vpane.lower.commarea.buttons.commit conf
-state}
2904 if {![is_enabled nocommit
]} {
2905 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2906 -command do_push_anywhere
2907 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2910 # -- Commit Message Buffer
2912 frame .vpane.lower.commarea.buffer
2913 frame .vpane.lower.commarea.buffer.header
2914 set ui_comm .vpane.lower.commarea.buffer.t
2915 set ui_coml .vpane.lower.commarea.buffer.header.l
2917 if {![is_enabled nocommit
]} {
2918 radiobutton .vpane.lower.commarea.buffer.header.new \
2919 -text [mc
"New Commit"] \
2920 -command do_select_commit_type \
2921 -variable selected_commit_type \
2923 lappend disable_on_lock \
2924 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2925 radiobutton .vpane.lower.commarea.buffer.header.amend \
2926 -text [mc
"Amend Last Commit"] \
2927 -command do_select_commit_type \
2928 -variable selected_commit_type \
2930 lappend disable_on_lock \
2931 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2937 proc trace_commit_type
{varname args
} {
2938 global ui_coml commit_type
2939 switch
-glob -- $commit_type {
2940 initial
{set txt
[mc
"Initial Commit Message:"]}
2941 amend
{set txt
[mc
"Amended Commit Message:"]}
2942 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2943 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2944 merge
{set txt
[mc
"Merge Commit Message:"]}
2945 * {set txt
[mc
"Commit Message:"]}
2947 $ui_coml conf
-text $txt
2949 trace add variable commit_type
write trace_commit_type
2950 pack
$ui_coml -side left
-fill x
2952 if {![is_enabled nocommit
]} {
2953 pack .vpane.lower.commarea.buffer.header.amend
-side right
2954 pack .vpane.lower.commarea.buffer.header.new
-side right
2957 text
$ui_comm -background white
-foreground black \
2961 -autoseparators true \
2963 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
2965 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2966 scrollbar .vpane.lower.commarea.buffer.sby \
2967 -command [list
$ui_comm yview
]
2968 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2969 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2970 pack
$ui_comm -side left
-fill y
2971 pack .vpane.lower.commarea.buffer
-side left
-fill y
2973 # -- Commit Message Buffer Context Menu
2975 set ctxm .vpane.lower.commarea.buffer.ctxm
2976 menu
$ctxm -tearoff 0
2979 -command {tk_textCut
$ui_comm}
2982 -command {tk_textCopy
$ui_comm}
2985 -command {tk_textPaste
$ui_comm}
2987 -label [mc Delete
] \
2988 -command {catch
{$ui_comm delete sel.first sel.last
}}
2991 -label [mc
"Select All"] \
2992 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2994 -label [mc
"Copy All"] \
2996 $ui_comm tag add sel
0.0 end
2997 tk_textCopy
$ui_comm
2998 $ui_comm tag remove sel
0.0 end
3002 -label [mc
"Sign Off"] \
3004 set ui_comm_ctxm
$ctxm
3008 proc trace_current_diff_path
{varname args
} {
3009 global current_diff_path diff_actions file_states
3010 if {$current_diff_path eq
{}} {
3016 set p
$current_diff_path
3017 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
3019 set p
[escape_path
$p]
3023 .vpane.lower.
diff.header.status configure
-text $s
3024 .vpane.lower.
diff.header.
file configure
-text $f
3025 .vpane.lower.
diff.header.path configure
-text $p
3026 foreach w
$diff_actions {
3030 trace add variable current_diff_path
write trace_current_diff_path
3032 frame .vpane.lower.
diff.header
-background gold
3033 label .vpane.lower.
diff.header.status \
3036 -width $max_status_desc \
3039 label .vpane.lower.
diff.header.
file \
3044 label .vpane.lower.
diff.header.path \
3049 pack .vpane.lower.
diff.header.status
-side left
3050 pack .vpane.lower.
diff.header.
file -side left
3051 pack .vpane.lower.
diff.header.path
-fill x
3052 set ctxm .vpane.lower.
diff.header.ctxm
3053 menu
$ctxm -tearoff 0
3061 -- $current_diff_path
3063 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3064 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
3068 frame .vpane.lower.
diff.body
3069 set ui_diff .vpane.lower.
diff.body.t
3070 text
$ui_diff -background white
-foreground black \
3072 -width 80 -height 15 -wrap none \
3074 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
3075 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
3077 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
3078 -command [list
$ui_diff xview
]
3079 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
3080 -command [list
$ui_diff yview
]
3081 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
3082 pack .vpane.lower.
diff.body.sby
-side right
-fill y
3083 pack
$ui_diff -side left
-fill both
-expand 1
3084 pack .vpane.lower.
diff.header
-side top
-fill x
3085 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
3087 $ui_diff tag conf d_cr
-elide true
3088 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
3089 $ui_diff tag conf d_
+ -foreground {#00a000}
3090 $ui_diff tag conf d_-
-foreground red
3092 $ui_diff tag conf d_
++ -foreground {#00a000}
3093 $ui_diff tag conf d_--
-foreground red
3094 $ui_diff tag conf d_
+s \
3095 -foreground {#00a000} \
3096 -background {#e2effa}
3097 $ui_diff tag conf d_-s \
3099 -background {#e2effa}
3100 $ui_diff tag conf d_s
+ \
3101 -foreground {#00a000} \
3103 $ui_diff tag conf d_s- \
3107 $ui_diff tag conf d
<<<<<<< \
3108 -foreground orange \
3110 $ui_diff tag conf d
======= \
3111 -foreground orange \
3113 $ui_diff tag conf d
>>>>>>> \
3114 -foreground orange \
3117 $ui_diff tag raise sel
3119 # -- Diff Body Context Menu
3122 proc create_common_diff_popup
{ctxm
} {
3124 -label [mc
"Show Less Context"] \
3125 -command show_less_context
3126 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3128 -label [mc
"Show More Context"] \
3129 -command show_more_context
3130 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3133 -label [mc Refresh
] \
3134 -command reshow_diff
3135 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3138 -command {tk_textCopy
$ui_diff}
3139 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3141 -label [mc
"Select All"] \
3142 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
3143 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3145 -label [mc
"Copy All"] \
3147 $ui_diff tag add sel
0.0 end
3148 tk_textCopy
$ui_diff
3149 $ui_diff tag remove sel
0.0 end
3151 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3154 -label [mc
"Decrease Font Size"] \
3155 -command {incr_font_size font_diff
-1}
3156 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3158 -label [mc
"Increase Font Size"] \
3159 -command {incr_font_size font_diff
1}
3160 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3164 build_encoding_menu
$emenu [list force_diff_encoding
]
3166 -label [mc
"Encoding"] \
3168 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
3170 $ctxm add
command -label [mc
"Options..."] \
3174 set ctxm .vpane.lower.
diff.body.ctxm
3175 menu
$ctxm -tearoff 0
3177 -label [mc
"Apply/Reverse Hunk"] \
3178 -command {apply_hunk
$cursorX $cursorY}
3179 set ui_diff_applyhunk
[$ctxm index last
]
3180 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
3182 -label [mc
"Apply/Reverse Line"] \
3183 -command {apply_line
$cursorX $cursorY; do_rescan
}
3184 set ui_diff_applyline
[$ctxm index last
]
3185 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
3187 create_common_diff_popup
$ctxm
3189 set ctxmmg .vpane.lower.
diff.body.ctxmmg
3190 menu
$ctxmmg -tearoff 0
3191 $ctxmmg add
command \
3192 -label [mc
"Run Merge Tool"] \
3193 -command {merge_resolve_tool
}
3194 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3195 $ctxmmg add separator
3196 $ctxmmg add
command \
3197 -label [mc
"Use Remote Version"] \
3198 -command {merge_resolve_one
3}
3199 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3200 $ctxmmg add
command \
3201 -label [mc
"Use Local Version"] \
3202 -command {merge_resolve_one
2}
3203 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3204 $ctxmmg add
command \
3205 -label [mc
"Revert To Base"] \
3206 -command {merge_resolve_one
1}
3207 lappend diff_actions
[list
$ctxmmg entryconf
[$ctxmmg index last
] -state]
3208 $ctxmmg add separator
3209 create_common_diff_popup
$ctxmmg
3211 proc popup_diff_menu
{ctxm ctxmmg x y X Y
} {
3212 global current_diff_path file_states
3215 if {[info exists file_states
($current_diff_path)]} {
3216 set state
[lindex
$file_states($current_diff_path) 0]
3220 if {[string first
{U
} $state] >= 0} {
3221 tk_popup
$ctxmmg $X $Y
3223 if {$
::ui_index eq $
::current_diff_side
} {
3224 set l
[mc
"Unstage Hunk From Commit"]
3225 set t
[mc
"Unstage Line From Commit"]
3227 set l
[mc
"Stage Hunk For Commit"]
3228 set t
[mc
"Stage Line For Commit"]
3230 if {$
::is_3way_diff || $
::is_submodule_diff
3231 ||
$current_diff_path eq
{}
3235 ||
{T_
} eq
$state} {
3240 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
3241 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
3242 tk_popup
$ctxm $X $Y
3245 bind_button3
$ui_diff [list popup_diff_menu
$ctxm $ctxmmg %x
%y
%X
%Y
]
3249 set main_status
[::status_bar
::new .status
]
3250 pack .status
-anchor w
-side bottom
-fill x
3251 $main_status show
[mc
"Initializing..."]
3256 set gm
$repo_config(gui.geometry
)
3257 wm geometry .
[lindex
$gm 0]
3258 .vpane sash place
0 \
3260 [lindex
[.vpane sash coord
0] 1]
3261 .vpane.files sash place
0 \
3262 [lindex
[.vpane.files sash coord
0] 0] \
3269 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
3270 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
3271 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
3272 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
3273 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
3274 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
3275 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
3276 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
3277 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
3278 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
3279 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
3280 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3281 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3282 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
3283 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
3284 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
3285 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
3286 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
3288 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
3289 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
3290 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
3291 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
3292 bind $ui_diff <$M1B-Key-v> {break}
3293 bind $ui_diff <$M1B-Key-V> {break}
3294 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
3295 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
3296 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
3297 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
3298 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
3299 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
3300 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
3301 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
3302 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
3303 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
3304 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
3305 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
3306 bind $ui_diff <Button-1
> {focus
%W
}
3308 if {[is_enabled branch
]} {
3309 bind .
<$M1B-Key-n> branch_create
::dialog
3310 bind .
<$M1B-Key-N> branch_create
::dialog
3311 bind .
<$M1B-Key-o> branch_checkout
::dialog
3312 bind .
<$M1B-Key-O> branch_checkout
::dialog
3313 bind .
<$M1B-Key-m> merge
::dialog
3314 bind .
<$M1B-Key-M> merge
::dialog
3316 if {[is_enabled transport
]} {
3317 bind .
<$M1B-Key-p> do_push_anywhere
3318 bind .
<$M1B-Key-P> do_push_anywhere
3321 bind .
<Key-F5
> ui_do_rescan
3322 bind .
<$M1B-Key-r> ui_do_rescan
3323 bind .
<$M1B-Key-R> ui_do_rescan
3324 bind .
<$M1B-Key-s> do_signoff
3325 bind .
<$M1B-Key-S> do_signoff
3326 bind .
<$M1B-Key-t> do_add_selection
3327 bind .
<$M1B-Key-T> do_add_selection
3328 bind .
<$M1B-Key-i> do_add_all
3329 bind .
<$M1B-Key-I> do_add_all
3330 bind .
<$M1B-Key-minus> {show_less_context
;break}
3331 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
3332 bind .
<$M1B-Key-equal> {show_more_context
;break}
3333 bind .
<$M1B-Key-plus> {show_more_context
;break}
3334 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
3335 bind .
<$M1B-Key-Return> do_commit
3336 foreach i
[list
$ui_index $ui_workdir] {
3337 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
3338 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3339 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
3343 set file_lists
($ui_index) [list
]
3344 set file_lists
($ui_workdir) [list
]
3346 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3347 focus
-force $ui_comm
3349 # -- Warn the user about environmental problems. Cygwin's Tcl
3350 # does *not* pass its env array onto any processes it spawns.
3351 # This means that git processes get none of our environment.
3356 set msg
[mc
"Possible environment issues exist.
3358 The following environment variables are probably
3359 going to be ignored by any Git subprocess run
3363 foreach name
[array names env
] {
3364 switch
-regexp -- $name {
3365 {^GIT_INDEX_FILE$
} -
3366 {^GIT_OBJECT_DIRECTORY$
} -
3367 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
3369 {^GIT_EXTERNAL_DIFF$
} -
3373 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
3374 append msg
" - $name\n"
3377 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
3378 append msg
" - $name\n"
3380 set suggest_user
$name
3384 if {$ignored_env > 0} {
3386 This is due to a known issue with the
3387 Tcl binary distributed by Cygwin."]
3389 if {$suggest_user ne
{}} {
3392 A good replacement for %s
3393 is placing values for the user.name and
3394 user.email settings into your personal
3400 unset ignored_env msg suggest_user name
3403 # -- Only initialize complex UI if we are going to stay running.
3405 if {[is_enabled transport
]} {
3408 set n
[.mbar.remote index end
]
3409 populate_remotes_menu
3410 set n
[expr {[.mbar.remote index end
] - $n}]
3412 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
3413 .mbar.remote insert
$n separator
3418 if {[winfo exists
$ui_comm]} {
3419 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
3421 # -- If both our backup and message files exist use the
3422 # newer of the two files to initialize the buffer.
3424 if {$GITGUI_BCK_exists} {
3425 set m
[gitdir GITGUI_MSG
]
3426 if {[file isfile
$m]} {
3427 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
3428 catch
{file delete
[gitdir GITGUI_MSG
]}
3430 $ui_comm delete
0.0 end
3432 $ui_comm edit modified false
3433 catch
{file delete
[gitdir GITGUI_BCK
]}
3434 set GITGUI_BCK_exists
0
3440 proc backup_commit_buffer
{} {
3441 global ui_comm GITGUI_BCK_exists
3443 set m
[$ui_comm edit modified
]
3444 if {$m ||
$GITGUI_BCK_exists} {
3445 set msg
[string trim
[$ui_comm get
0.0 end
]]
3446 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3449 if {$GITGUI_BCK_exists} {
3450 catch
{file delete
[gitdir GITGUI_BCK
]}
3451 set GITGUI_BCK_exists
0
3455 set fd
[open
[gitdir GITGUI_BCK
] w
]
3456 puts
-nonewline $fd $msg
3458 set GITGUI_BCK_exists
1
3462 $ui_comm edit modified false
3465 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3468 backup_commit_buffer
3470 # -- If the user has aspell available we can drive it
3471 # in pipe mode to spellcheck the commit message.
3473 set spell_cmd
[list |
]
3474 set spell_dict
[get_config gui.spellingdictionary
]
3475 lappend spell_cmd aspell
3476 if {$spell_dict ne
{}} {
3477 lappend spell_cmd
--master=$spell_dict
3479 lappend spell_cmd
--mode=none
3480 lappend spell_cmd
--encoding=utf-8
3481 lappend spell_cmd pipe
3482 if {$spell_dict eq
{none
}
3483 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3484 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3486 set ui_comm_spell
[spellcheck
::init \
3492 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3495 lock_index begin-read
3496 if {![winfo ismapped .
]} {
3500 if {[is_enabled initialamend
]} {
3506 if {[is_enabled nocommitmsg
]} {
3507 $ui_comm configure
-state disabled
-background gray
3510 if {[is_enabled multicommit
]} {
3513 if {[is_enabled retcode
]} {
3514 bind .
<Destroy
> {+terminate_me
%W
}
3516 if {$picked && [is_config_true gui.autoexplore
]} {