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@@
}
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 dirname [file normalize
$argv0]]]
56 set oguilib
[file join $oguilib share git-gui lib
]
57 set oguimsg
[file join $oguilib msgs
]
58 } elseif
{[string match @@
* $oguirel]} {
59 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
60 set oguimsg
[file join [file dirname [file normalize
$argv0]] po
]
62 set oguimsg
[file join $oguilib msgs
]
66 ######################################################################
68 ## enable verbose loading?
70 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
72 rename auto_load real__auto_load
73 proc auto_load
{name args
} {
74 puts stderr
"auto_load $name"
75 return [uplevel
1 real__auto_load
$name $args]
77 rename
source real__source
79 puts stderr
"source $name"
80 uplevel
1 real__source
$name
84 ######################################################################
86 ## Internationalization (i18n) through msgcat and gettext. See
87 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
89 package require msgcat
92 set fmt [::msgcat
::mc
$fmt]
93 set cmk
[string first @@
$fmt]
95 set fmt [string range
$fmt 0 [expr {$cmk - 1}]]
97 return [eval [list format
$fmt] $args]
101 return [join $args {}]
104 ::msgcat
::mcload
$oguimsg
107 ######################################################################
111 set _appname
{Git Gui
}
128 return [eval [list
file join $_gitdir] $args]
131 proc gitexec
{args
} {
133 if {$_gitexec eq
{}} {
134 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
135 error
"Git not installed?\n\n$err"
138 set _gitexec
[exec cygpath \
143 set _gitexec
[file normalize
$_gitexec]
149 return [eval [list
file join $_gitexec] $args]
157 if {[tk windowingsystem
] eq
{aqua
}} {
164 if {$
::tcl_platform
(platform
) eq
{windows
}} {
172 if {$_iscygwin eq
{}} {
173 if {$
::tcl_platform
(platform
) eq
{windows
}} {
174 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
186 proc is_enabled
{option
} {
187 global enabled_options
188 if {[catch
{set on
$enabled_options($option)}]} {return 0}
192 proc enable_option
{option
} {
193 global enabled_options
194 set enabled_options
($option) 1
197 proc disable_option
{option
} {
198 global enabled_options
199 set enabled_options
($option) 0
202 ######################################################################
206 proc is_many_config
{name
} {
207 switch
-glob -- $name {
216 proc is_config_true
{name
} {
218 if {[catch
{set v
$repo_config($name)}]} {
220 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
227 proc get_config
{name
} {
229 if {[catch
{set v
$repo_config($name)}]} {
236 ######################################################################
240 proc _git_cmd
{name
} {
243 if {[catch
{set v
$_git_cmd_path($name)}]} {
247 --exec-path { return [list $
::_git
$name] }
250 set p
[gitexec git-
$name$
::_search_exe
]
251 if {[file exists
$p]} {
253 } elseif
{[is_Windows
] && [file exists
[gitexec git-
$name]]} {
254 # Try to determine what sort of magic will make
255 # git-$name go and do its thing, because native
256 # Tcl on Windows doesn't know it.
258 set p
[gitexec git-
$name]
263 switch
-glob -- [lindex
$s 0] {
265 #!*perl { set i perl }
266 #!*python { set i python }
267 default
{ error
"git-$name is not supported: $s" }
271 if {![info exists interp
]} {
272 set interp
[_which
$i]
275 error
"git-$name requires $i (not in PATH)"
277 set v
[concat
[list
$interp] [lrange
$s 1 end
] [list
$p]]
279 # Assume it is builtin to git somehow and we
280 # aren't actually able to see a file for it.
282 set v
[list $
::_git
$name]
284 set _git_cmd_path
($name) $v
290 global env _search_exe _search_path
292 if {$_search_path eq
{}} {
293 if {[is_Cygwin
] && [regexp
{^
(/|\.
:)} $env(PATH
)]} {
294 set _search_path
[split [exec cygpath \
300 } elseif
{[is_Windows
]} {
301 set gitguidir
[file dirname [info
script]]
302 regsub
-all ";" $gitguidir "\\;" gitguidir
303 set env
(PATH
) "$gitguidir;$env(PATH)"
304 set _search_path
[split $env(PATH
) {;}]
307 set _search_path
[split $env(PATH
) :]
312 foreach p
$_search_path {
313 set p
[file join $p $what$_search_exe]
314 if {[file exists
$p]} {
315 return [file normalize
$p]
321 proc _lappend_nice
{cmd_var
} {
325 if {![info exists _nice
]} {
326 set _nice
[_which nice
]
337 switch
-- [lindex
$args 0] {
348 set args
[lrange
$args 1 end
]
351 set cmdp
[_git_cmd
[lindex
$args 0]]
352 set args
[lrange
$args 1 end
]
354 return [eval $opt $cmdp $args]
357 proc _open_stdout_stderr
{cmd
} {
361 if { [lindex
$cmd end
] eq
{2>@
1}
362 && $err eq
{can not
find channel named
"1"}
364 # Older versions of Tcl 8.4 don't have this 2>@1 IO
365 # redirect operator. Fallback to |& cat for those.
366 # The command was not actually started, so its safe
367 # to try to start it a second time.
369 set fd
[open
[concat \
370 [lrange
$cmd 0 end-1
] \
377 fconfigure
$fd -eofchar {}
381 proc git_read
{args
} {
385 switch
-- [lindex
$args 0] {
400 set args
[lrange
$args 1 end
]
403 set cmdp
[_git_cmd
[lindex
$args 0]]
404 set args
[lrange
$args 1 end
]
406 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
409 proc git_write
{args
} {
413 switch
-- [lindex
$args 0] {
424 set args
[lrange
$args 1 end
]
427 set cmdp
[_git_cmd
[lindex
$args 0]]
428 set args
[lrange
$args 1 end
]
430 return [open
[concat
$opt $cmdp $args] w
]
434 regsub
-all ' $value "'\\''" value
438 proc load_current_branch {} {
439 global current_branch is_detached
441 set fd [open [gitdir HEAD] r]
442 if {[gets $fd ref] < 1} {
447 set pfx {ref: refs/heads/}
448 set len [string length $pfx]
449 if {[string equal -length $len $pfx $ref]} {
450 # We're on a branch. It might not exist. But
451 # HEAD looks good enough to be a branch.
453 set current_branch [string range $ref $len end]
456 # Assume this is a detached head.
458 set current_branch HEAD
463 auto_load tk_optionMenu
464 rename tk_optionMenu real__tkOptionMenu
465 proc tk_optionMenu {w varName args} {
466 set m [eval real__tkOptionMenu $w $varName $args]
467 $m configure -font font_ui
468 $w configure -font font_ui
472 proc rmsel_tag {text} {
474 -background [$text cget -background] \
475 -foreground [$text cget -foreground] \
477 $text tag conf in_sel -background lightgray
478 bind $text <Motion> break
483 bind . <Visibility> {
484 bind . <Visibility> {}
489 wm iconbitmap . -default $oguilib/git-gui.ico
492 ######################################################################
497 font create font_diff -family Courier -size 10
501 eval font configure font_ui [font actual [.dummy cget -font]]
505 font create font_uiitalic
506 font create font_uibold
507 font create font_diffbold
508 font create font_diffitalic
510 foreach class {Button Checkbutton Entry Label
511 Labelframe Listbox Menu Message
512 Radiobutton Spinbox Text} {
513 option add *$class.font font_ui
517 if {[is_Windows] || [is_MacOSX]} {
518 option add *Menu.tearOff 0
529 proc bind_button3 {w cmd} {
530 bind $w <Any-Button-3> $cmd
532 # Mac OS X sends Button-2 on right click through three-button mouse,
533 # or through trackpad right-clicking (two-finger touch + click).
534 bind $w <Any-Button-2> $cmd
535 bind $w <Control-Button-1> $cmd
539 proc apply_config {} {
540 global repo_config font_descs
542 foreach option $font_descs {
543 set name [lindex $option 0]
544 set font [lindex $option 1]
546 foreach {cn cv} $repo_config(gui.$name) {
547 font configure $font $cn $cv -weight normal
550 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
552 foreach {cn cv} [font configure $font] {
553 font configure ${font}bold $cn $cv
554 font configure ${font}italic $cn $cv
556 font configure ${font}bold -weight bold
557 font configure ${font}italic -slant italic
561 set default_config(merge.diffstat) true
562 set default_config(merge.summary) false
563 set default_config(merge.verbosity) 2
564 set default_config(user.name) {}
565 set default_config(user.email) {}
567 set default_config(gui.matchtrackingbranch) false
568 set default_config(gui.pruneduringfetch) false
569 set default_config(gui.trustmtime) false
570 set default_config(gui.diffcontext) 5
571 set default_config(gui.newbranchtemplate) {}
572 set default_config(gui.fontui) [font configure font_ui]
573 set default_config(gui.fontdiff) [font configure font_diff]
575 {fontui font_ui {mc "Main Font
"}}
576 {fontdiff font_diff {mc "Diff
/Console Font
"}}
579 ######################################################################
583 set _git [_which git]
585 catch {wm withdraw .}
589 -title [mc "git-gui
: fatal error
"] \
590 -message [mc "Cannot
find git
in PATH.
"]
594 ######################################################################
598 if {[catch {set _git_version [git --version]} err]} {
599 catch {wm withdraw .}
603 -title [mc "git-gui
: fatal error
"] \
604 -message "Cannot determine Git version
:
608 [appname
] requires Git
1.5.0 or later.
"
611 if {![regsub {^git version } $_git_version {} _git_version]} {
612 catch {wm withdraw .}
616 -title [mc "git-gui
: fatal error
"] \
617 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
621 set _real_git_version $_git_version
622 regsub -- {-dirty$} $_git_version {} _git_version
623 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
624 regsub {\.rc[0-9]+$} $_git_version {} _git_version
625 regsub {\.GIT$} $_git_version {} _git_version
626 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
628 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
629 catch {wm withdraw .}
634 -title "[appname
]: warning
" \
635 -message [mc "Git version cannot be determined.
637 %s claims it is version
'%s'.
639 %s requires
at least Git
1.5.0 or later.
641 Assume
'%s' is version
1.5.0?
642 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
643 set _git_version 1.5.0
648 unset _real_git_version
650 proc git-version {args} {
653 switch [llength $args] {
659 set op [lindex $args 0]
660 set vr [lindex $args 1]
661 set cm [package vcompare $_git_version $vr]
662 return [expr $cm $op 0]
666 set type [lindex $args 0]
667 set name [lindex $args 1]
668 set parm [lindex $args 2]
669 set body [lindex $args 3]
671 if {($type ne {proc} && $type ne {method})} {
672 error "Invalid arguments to git-version
"
674 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
675 error "Last arm of
$type $name must be default
"
678 foreach {op vr cb} [lrange $body 0 end-2] {
679 if {[git-version $op $vr]} {
680 return [uplevel [list $type $name $parm $cb]]
684 return [uplevel [list $type $name $parm [lindex $body end]]]
688 error "git-version
>= x
"
694 if {[git-version < 1.5]} {
695 catch {wm withdraw .}
699 -title [mc "git-gui
: fatal error
"] \
700 -message "[appname
] requires Git
1.5.0 or later.
702 You are using
[git-version
]:
708 ######################################################################
710 ## configure our library
712 set idx [file join $oguilib tclIndex]
713 if {[catch {set fd [open $idx r]} err]} {
714 catch {wm withdraw .}
718 -title [mc "git-gui
: fatal error
"] \
722 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
724 while {[gets $fd n] >= 0} {
725 if {$n ne {} && ![string match #* $n]} {
737 if {[lsearch -exact $loaded $p] >= 0} continue
738 source [file join $oguilib $p]
743 set auto_path [concat [list $oguilib] $auto_path]
745 unset -nocomplain idx fd
747 ######################################################################
749 ## config file parsing
751 proc load_config {include_global} {
752 global repo_config global_config default_config
754 array unset global_config
755 if {$include_global} {
757 set fd_rc [git_read config --global --list]
758 while {[gets $fd_rc line] >= 0} {
759 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
760 if {[is_many_config $name]} {
761 lappend global_config($name) $value
763 set global_config($name) $value
771 array unset repo_config
773 set fd_rc [git_read config --list]
774 while {[gets $fd_rc line] >= 0} {
775 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
776 if {[is_many_config $name]} {
777 lappend repo_config($name) $value
779 set repo_config($name) $value
786 foreach name [array names default_config] {
787 if {[catch {set v $global_config($name)}]} {
788 set global_config($name) $default_config($name)
790 if {[catch {set v $repo_config($name)}]} {
791 set repo_config($name) $default_config($name)
796 ######################################################################
798 ## feature option selection
800 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
805 if {$subcommand eq {gui.sh}} {
808 if {$subcommand eq {gui} && [llength $argv] > 0} {
809 set subcommand [lindex $argv 0]
810 set argv [lrange $argv 1 end]
813 enable_option multicommit
815 enable_option transport
818 switch -- $subcommand {
823 disable_option multicommit
824 disable_option branch
825 disable_option transport
828 enable_option singlecommit
830 disable_option multicommit
831 disable_option branch
832 disable_option transport
836 ######################################################################
841 set _gitdir $env(GIT_DIR)
845 set _gitdir [git rev-parse --git-dir]
846 set _prefix [git rev-parse --show-prefix]
850 choose_repository::pick
852 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
853 catch {set _gitdir [exec cygpath --windows $_gitdir]}
855 if {![file isdirectory $_gitdir]} {
856 catch {wm withdraw .}
857 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
860 if {$_prefix ne {}} {
861 regsub -all {[^/]+/} $_prefix ../ cdup
862 if {[catch {cd $cdup} err]} {
863 catch {wm withdraw .}
864 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
868 } elseif {![is_enabled bare]} {
869 if {[lindex [file split $_gitdir] end] ne {.git}} {
870 catch {wm withdraw .}
871 error_popup [strcat [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
874 if {[catch {cd [file dirname $_gitdir]} err]} {
875 catch {wm withdraw .}
876 error_popup [strcat [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
880 set _reponame [file split [file normalize $_gitdir]]
881 if {[lindex $_reponame end] eq {.git}} {
882 set _reponame [lindex $_reponame end-1]
884 set _reponame [lindex $_reponame end]
887 ######################################################################
891 set current_diff_path {}
892 set current_diff_side {}
893 set diff_actions [list]
897 set MERGE_HEAD [list]
900 set current_branch {}
902 set current_diff_path {}
904 set selected_commit_type new
906 ######################################################################
914 set disable_on_lock [list]
915 set index_lock_type none
917 proc lock_index {type} {
918 global index_lock_type disable_on_lock
920 if {$index_lock_type eq {none}} {
921 set index_lock_type $type
922 foreach w $disable_on_lock {
923 uplevel #0 $w disabled
926 } elseif {$index_lock_type eq "begin-
$type"} {
927 set index_lock_type $type
933 proc unlock_index {} {
934 global index_lock_type disable_on_lock
936 set index_lock_type none
937 foreach w $disable_on_lock {
942 ######################################################################
946 proc repository_state {ctvar hdvar mhvar} {
947 global current_branch
948 upvar $ctvar ct $hdvar hd $mhvar mh
953 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
959 set merge_head [gitdir MERGE_HEAD]
960 if {[file exists $merge_head]} {
962 set fd_mh [open $merge_head r]
963 while {[gets $fd_mh line] >= 0} {
974 global PARENT empty_tree
976 set p [lindex $PARENT 0]
980 if {$empty_tree eq {}} {
981 set empty_tree [git mktree << {}]
986 proc rescan {after {honor_trustmtime 1}} {
987 global HEAD PARENT MERGE_HEAD commit_type
988 global ui_index ui_workdir ui_comm
989 global rescan_active file_states
992 if {$rescan_active > 0 || ![lock_index read]} return
994 repository_state newType newHEAD newMERGE_HEAD
995 if {[string match amend* $commit_type]
996 && $newType eq {normal}
997 && $newHEAD eq $HEAD} {
1001 set MERGE_HEAD $newMERGE_HEAD
1002 set commit_type $newType
1005 array unset file_states
1007 if {!$::GITGUI_BCK_exists &&
1008 (![$ui_comm edit modified]
1009 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1010 if {[string match amend* $commit_type]} {
1011 } elseif {[load_message GITGUI_MSG]} {
1012 } elseif {[load_message MERGE_MSG]} {
1013 } elseif {[load_message SQUASH_MSG]} {
1016 $ui_comm edit modified false
1019 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1020 rescan_stage2 {} $after
1023 ui_status [mc "Refreshing
file status...
"]
1024 set fd_rf [git_read update-index \
1030 fconfigure $fd_rf -blocking 0 -translation binary
1031 fileevent $fd_rf readable \
1032 [list rescan_stage2 $fd_rf $after]
1037 set is_git_info_link {}
1038 set is_git_info_exclude {}
1039 proc have_info_exclude {} {
1040 global is_git_info_link is_git_info_exclude
1042 if {$is_git_info_link eq {}} {
1043 set is_git_info_link [file isfile [gitdir info.lnk]]
1046 if {$is_git_info_link} {
1047 if {$is_git_info_exclude eq {}} {
1048 if {[catch {exec test -f [gitdir info exclude]}]} {
1049 set is_git_info_exclude 0
1051 set is_git_info_exclude 1
1054 return $is_git_info_exclude
1056 return [file readable [gitdir info exclude]]
1060 proc have_info_exclude {} {
1061 return [file readable [gitdir info exclude]]
1065 proc rescan_stage2 {fd after} {
1066 global rescan_active buf_rdi buf_rdf buf_rlo
1070 if {![eof $fd]} return
1074 set ls_others [list --exclude-per-directory=.gitignore]
1075 if {[have_info_exclude]} {
1076 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1078 set user_exclude [get_config core.excludesfile]
1079 if {$user_exclude ne {} && [file readable $user_exclude]} {
1080 lappend ls_others "--exclude-from=$user_exclude"
1088 ui_status [mc "Scanning
for modified files ...
"]
1089 set fd_di [git_read diff-index --cached -z [PARENT]]
1090 set fd_df [git_read diff-files -z]
1091 set fd_lo [eval git_read ls-files --others -z $ls_others]
1093 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1094 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1095 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1096 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1097 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1098 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1101 proc load_message {file} {
1104 set f [gitdir $file]
1105 if {[file isfile $f]} {
1106 if {[catch {set fd [open $f r]}]} {
1109 fconfigure $fd -eofchar {}
1110 set content [string trim [read $fd]]
1112 regsub -all -line {[ \r\t]+$} $content {} content
1113 $ui_comm delete 0.0 end
1114 $ui_comm insert end $content
1120 proc read_diff_index {fd after} {
1123 append buf_rdi [read $fd]
1125 set n [string length $buf_rdi]
1127 set z1 [string first "\
0" $buf_rdi $c]
1128 if {$z1 == -1} break
1130 set z2 [string first "\
0" $buf_rdi $z1]
1131 if {$z2 == -1} break
1134 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1135 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1137 [encoding convertfrom $p] \
1139 [list [lindex $i 0] [lindex $i 2]] \
1145 set buf_rdi [string range $buf_rdi $c end]
1150 rescan_done $fd buf_rdi $after
1153 proc read_diff_files {fd after} {
1156 append buf_rdf [read $fd]
1158 set n [string length $buf_rdf]
1160 set z1 [string first "\
0" $buf_rdf $c]
1161 if {$z1 == -1} break
1163 set z2 [string first "\
0" $buf_rdf $z1]
1164 if {$z2 == -1} break
1167 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1168 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1170 [encoding convertfrom $p] \
1173 [list [lindex $i 0] [lindex $i 2]]
1178 set buf_rdf [string range $buf_rdf $c end]
1183 rescan_done $fd buf_rdf $after
1186 proc read_ls_others {fd after} {
1189 append buf_rlo [read $fd]
1190 set pck [split $buf_rlo "\
0"]
1191 set buf_rlo [lindex $pck end]
1192 foreach p [lrange $pck 0 end-1] {
1193 set p [encoding convertfrom $p]
1194 if {[string index $p end] eq {/}} {
1195 set p [string range $p 0 end-1]
1199 rescan_done $fd buf_rlo $after
1202 proc rescan_done {fd buf after} {
1203 global rescan_active current_diff_path
1204 global file_states repo_config
1207 if {![eof $fd]} return
1210 if {[incr rescan_active -1] > 0} return
1215 if {$current_diff_path ne {}} reshow_diff
1219 proc prune_selection {} {
1220 global file_states selected_paths
1222 foreach path [array names selected_paths] {
1223 if {[catch {set still_here $file_states($path)}]} {
1224 unset selected_paths($path)
1229 ######################################################################
1233 proc mapicon {w state path} {
1236 if {[catch {set r $all_icons($state$w)}]} {
1237 puts "error
: no icon
for $w state
={$state} $path"
1243 proc mapdesc {state path} {
1246 if {[catch {set r $all_descs($state)}]} {
1247 puts "error
: no desc
for state
={$state} $path"
1253 proc ui_status {msg} {
1255 if {[info exists main_status]} {
1256 $main_status show $msg
1260 proc ui_ready {{test {}}} {
1262 if {[info exists main_status]} {
1263 $main_status show [mc "Ready.
"] $test
1267 proc escape_path {path} {
1268 regsub -all {\\} $path "\\\\" path
1269 regsub -all "\n" $path "\\n
" path
1273 proc short_path {path} {
1274 return [escape_path [lindex [file split $path] end]]
1278 set null_sha1 [string repeat 0 40]
1280 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1281 global file_states next_icon_id null_sha1
1283 set s0 [string index $new_state 0]
1284 set s1 [string index $new_state 1]
1286 if {[catch {set info $file_states($path)}]} {
1288 set icon n[incr next_icon_id]
1290 set state [lindex $info 0]
1291 set icon [lindex $info 1]
1292 if {$head_info eq {}} {set head_info [lindex $info 2]}
1293 if {$index_info eq {}} {set index_info [lindex $info 3]}
1296 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1297 elseif {$s0 eq {_}} {set s0 _}
1299 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1300 elseif {$s1 eq {_}} {set s1 _}
1302 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1303 set head_info [list 0 $null_sha1]
1304 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1305 && $head_info eq {}} {
1306 set head_info $index_info
1309 set file_states($path) [list $s0$s1 $icon \
1310 $head_info $index_info \
1315 proc display_file_helper {w path icon_name old_m new_m} {
1318 if {$new_m eq {_}} {
1319 set lno [lsearch -sorted -exact $file_lists($w) $path]
1321 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1323 $w conf -state normal
1324 $w delete $lno.0 [expr {$lno + 1}].0
1325 $w conf -state disabled
1327 } elseif {$old_m eq {_} && $new_m ne {_}} {
1328 lappend file_lists($w) $path
1329 set file_lists($w) [lsort -unique $file_lists($w)]
1330 set lno [lsearch -sorted -exact $file_lists($w) $path]
1332 $w conf -state normal
1333 $w image create $lno.0 \
1334 -align center -padx 5 -pady 1 \
1336 -image [mapicon $w $new_m $path]
1337 $w insert $lno.1 "[escape_path
$path]\n"
1338 $w conf -state disabled
1339 } elseif {$old_m ne $new_m} {
1340 $w conf -state normal
1341 $w image conf $icon_name -image [mapicon $w $new_m $path]
1342 $w conf -state disabled
1346 proc display_file {path state} {
1347 global file_states selected_paths
1348 global ui_index ui_workdir
1350 set old_m [merge_state $path $state]
1351 set s $file_states($path)
1352 set new_m [lindex $s 0]
1353 set icon_name [lindex $s 1]
1355 set o [string index $old_m 0]
1356 set n [string index $new_m 0]
1363 display_file_helper $ui_index $path $icon_name $o $n
1365 if {[string index $old_m 0] eq {U}} {
1368 set o [string index $old_m 1]
1370 if {[string index $new_m 0] eq {U}} {
1373 set n [string index $new_m 1]
1375 display_file_helper $ui_workdir $path $icon_name $o $n
1377 if {$new_m eq {__}} {
1378 unset file_states($path)
1379 catch {unset selected_paths($path)}
1383 proc display_all_files_helper {w path icon_name m} {
1386 lappend file_lists($w) $path
1387 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1388 $w image create end \
1389 -align center -padx 5 -pady 1 \
1391 -image [mapicon $w $m $path]
1392 $w insert end "[escape_path
$path]\n"
1395 proc display_all_files {} {
1396 global ui_index ui_workdir
1397 global file_states file_lists
1400 $ui_index conf -state normal
1401 $ui_workdir conf -state normal
1403 $ui_index delete 0.0 end
1404 $ui_workdir delete 0.0 end
1407 set file_lists($ui_index) [list]
1408 set file_lists($ui_workdir) [list]
1410 foreach path [lsort [array names file_states]] {
1411 set s $file_states($path)
1413 set icon_name [lindex $s 1]
1415 set s [string index $m 0]
1416 if {$s ne {U} && $s ne {_}} {
1417 display_all_files_helper $ui_index $path \
1421 if {[string index $m 0] eq {U}} {
1424 set s [string index $m 1]
1427 display_all_files_helper $ui_workdir $path \
1432 $ui_index conf -state disabled
1433 $ui_workdir conf -state disabled
1436 ######################################################################
1441 #define mask_width 14
1442 #define mask_height 15
1443 static unsigned char mask_bits[] = {
1444 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1445 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1446 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1449 image create bitmap file_plain -background white -foreground black -data {
1450 #define plain_width 14
1451 #define plain_height 15
1452 static unsigned char plain_bits[] = {
1453 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1454 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1455 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1456 } -maskdata $filemask
1458 image create bitmap file_mod -background white -foreground blue -data {
1459 #define mod_width 14
1460 #define mod_height 15
1461 static unsigned char mod_bits[] = {
1462 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1463 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1464 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1465 } -maskdata $filemask
1467 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1468 #define file_fulltick_width 14
1469 #define file_fulltick_height 15
1470 static unsigned char file_fulltick_bits
[] = {
1471 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1472 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1473 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1474 } -maskdata $filemask
1476 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1477 #define parttick_width 14
1478 #define parttick_height 15
1479 static unsigned char parttick_bits
[] = {
1480 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1481 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1482 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1483 } -maskdata $filemask
1485 image create bitmap file_question
-background white
-foreground black
-data {
1486 #define file_question_width 14
1487 #define file_question_height 15
1488 static unsigned char file_question_bits
[] = {
1489 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1490 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1491 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1492 } -maskdata $filemask
1494 image create bitmap file_removed
-background white
-foreground red
-data {
1495 #define file_removed_width 14
1496 #define file_removed_height 15
1497 static unsigned char file_removed_bits
[] = {
1498 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1499 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1500 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1501 } -maskdata $filemask
1503 image create bitmap file_merge
-background white
-foreground blue
-data {
1504 #define file_merge_width 14
1505 #define file_merge_height 15
1506 static unsigned char file_merge_bits
[] = {
1507 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1508 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1509 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1510 } -maskdata $filemask
1512 set ui_index .vpane.files.index.list
1513 set ui_workdir .vpane.files.workdir.list
1515 set all_icons
(_
$ui_index) file_plain
1516 set all_icons
(A
$ui_index) file_fulltick
1517 set all_icons
(M
$ui_index) file_fulltick
1518 set all_icons
(D
$ui_index) file_removed
1519 set all_icons
(U
$ui_index) file_merge
1521 set all_icons
(_
$ui_workdir) file_plain
1522 set all_icons
(M
$ui_workdir) file_mod
1523 set all_icons
(D
$ui_workdir) file_question
1524 set all_icons
(U
$ui_workdir) file_merge
1525 set all_icons
(O
$ui_workdir) file_plain
1527 set max_status_desc
0
1529 {__
{mc
"Unmodified"}}
1531 {_M
{mc
"Modified, not staged"}}
1532 {M_
{mc
"Staged for commit"}}
1533 {MM
{mc
"Portions staged for commit"}}
1534 {MD
{mc
"Staged for commit, missing"}}
1536 {_O
{mc
"Untracked, not staged"}}
1537 {A_
{mc
"Staged for commit"}}
1538 {AM
{mc
"Portions staged for commit"}}
1539 {AD
{mc
"Staged for commit, missing"}}
1542 {D_
{mc
"Staged for removal"}}
1543 {DO
{mc
"Staged for removal, still present"}}
1545 {U_
{mc
"Requires merge resolution"}}
1546 {UU
{mc
"Requires merge resolution"}}
1547 {UM
{mc
"Requires merge resolution"}}
1548 {UD
{mc
"Requires merge resolution"}}
1550 set text
[eval [lindex
$i 1]]
1551 if {$max_status_desc < [string length
$text]} {
1552 set max_status_desc
[string length
$text]
1554 set all_descs
([lindex
$i 0]) $text
1558 ######################################################################
1562 proc scrollbar2many
{list mode args
} {
1563 foreach w
$list {eval $w $mode $args}
1566 proc many2scrollbar
{list mode sb top bottom
} {
1567 $sb set $top $bottom
1568 foreach w
$list {$w $mode moveto
$top}
1571 proc incr_font_size
{font
{amt
1}} {
1572 set sz
[font configure
$font -size]
1574 font configure
$font -size $sz
1575 font configure
${font}bold
-size $sz
1576 font configure
${font}italic
-size $sz
1579 ######################################################################
1583 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1585 proc do_gitk
{revs
} {
1586 # -- Always start gitk through whatever we were loaded with. This
1587 # lets us bypass using shell process on Windows systems.
1589 set exe
[file join [file dirname $
::_git
] gitk
]
1590 set cmd
[list
[info nameofexecutable
] $exe]
1591 if {! [file exists
$exe]} {
1592 error_popup
[mc
"Unable to start gitk:\n\n%s does not exist" $exe]
1596 if {[info exists env
(GIT_DIR
)]} {
1597 set old_GIT_DIR
$env(GIT_DIR
)
1603 cd [file dirname [gitdir
]]
1604 set env
(GIT_DIR
) [file tail [gitdir
]]
1606 eval exec $cmd $revs &
1608 if {$old_GIT_DIR eq
{}} {
1611 set env
(GIT_DIR
) $old_GIT_DIR
1615 ui_status $
::starting_gitk_msg
1617 ui_ready
$starting_gitk_msg
1625 global ui_comm is_quitting repo_config commit_type
1626 global GITGUI_BCK_exists GITGUI_BCK_i
1628 if {$is_quitting} return
1631 if {[winfo exists
$ui_comm]} {
1632 # -- Stash our current commit buffer.
1634 set save
[gitdir GITGUI_MSG
]
1635 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1636 file rename
-force [gitdir GITGUI_BCK
] $save
1637 set GITGUI_BCK_exists
0
1639 set msg
[string trim
[$ui_comm get
0.0 end
]]
1640 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1641 if {(![string match amend
* $commit_type]
1642 ||
[$ui_comm edit modified
])
1645 set fd
[open
$save w
]
1646 puts
-nonewline $fd $msg
1650 catch
{file delete
$save}
1654 # -- Remove our editor backup, its not needed.
1656 after cancel
$GITGUI_BCK_i
1657 if {$GITGUI_BCK_exists} {
1658 catch
{file delete
[gitdir GITGUI_BCK
]}
1661 # -- Stash our current window geometry into this repository.
1663 set cfg_geometry
[list
]
1664 lappend cfg_geometry
[wm geometry .
]
1665 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
1666 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
1667 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1670 if {$cfg_geometry ne
$rc_geometry} {
1671 catch
{git config gui.geometry
$cfg_geometry}
1686 proc toggle_or_diff
{w x y
} {
1687 global file_states file_lists current_diff_path ui_index ui_workdir
1688 global last_clicked selected_paths
1690 set pos
[split [$w index @
$x,$y] .
]
1691 set lno
[lindex
$pos 0]
1692 set col [lindex
$pos 1]
1693 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1699 set last_clicked
[list
$w $lno]
1700 array
unset selected_paths
1701 $ui_index tag remove in_sel
0.0 end
1702 $ui_workdir tag remove in_sel
0.0 end
1705 if {$current_diff_path eq
$path} {
1706 set after
{reshow_diff
;}
1710 if {$w eq
$ui_index} {
1712 "Unstaging [short_path $path] from commit" \
1714 [concat
$after [list ui_ready
]]
1715 } elseif
{$w eq
$ui_workdir} {
1717 "Adding [short_path $path]" \
1719 [concat
$after [list ui_ready
]]
1722 show_diff
$path $w $lno
1726 proc add_one_to_selection
{w x y
} {
1727 global file_lists last_clicked selected_paths
1729 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1730 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1736 if {$last_clicked ne
{}
1737 && [lindex
$last_clicked 0] ne
$w} {
1738 array
unset selected_paths
1739 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1742 set last_clicked
[list
$w $lno]
1743 if {[catch
{set in_sel
$selected_paths($path)}]} {
1747 unset selected_paths
($path)
1748 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1750 set selected_paths
($path) 1
1751 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1755 proc add_range_to_selection
{w x y
} {
1756 global file_lists last_clicked selected_paths
1758 if {[lindex
$last_clicked 0] ne
$w} {
1759 toggle_or_diff
$w $x $y
1763 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1764 set lc
[lindex
$last_clicked 1]
1773 foreach path
[lrange
$file_lists($w) \
1774 [expr {$begin - 1}] \
1775 [expr {$end - 1}]] {
1776 set selected_paths
($path) 1
1778 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1781 ######################################################################
1791 menu .mbar
-tearoff 0
1792 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
1793 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
1794 if {[is_enabled branch
]} {
1795 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
1797 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1798 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
1800 if {[is_enabled transport
]} {
1801 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
1802 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
1804 . configure
-menu .mbar
1806 # -- Repository Menu
1808 menu .mbar.repository
1810 .mbar.repository add
command \
1811 -label [mc
"Browse Current Branch's Files"] \
1812 -command {browser
::new
$current_branch}
1813 set ui_browse_current
[.mbar.repository index last
]
1814 .mbar.repository add
command \
1815 -label [mc
"Browse Branch Files..."] \
1816 -command browser_open
::dialog
1817 .mbar.repository add separator
1819 .mbar.repository add
command \
1820 -label [mc
"Visualize Current Branch's History"] \
1821 -command {do_gitk
$current_branch}
1822 set ui_visualize_current
[.mbar.repository index last
]
1823 .mbar.repository add
command \
1824 -label [mc
"Visualize All Branch History"] \
1825 -command {do_gitk
--all}
1826 .mbar.repository add separator
1828 proc current_branch_write
{args
} {
1829 global current_branch
1830 .mbar.repository entryconf $
::ui_browse_current \
1831 -label [mc
"Browse %s's Files" $current_branch]
1832 .mbar.repository entryconf $
::ui_visualize_current \
1833 -label [mc
"Visualize %s's History" $current_branch]
1835 trace add variable current_branch
write current_branch_write
1837 if {[is_enabled multicommit
]} {
1838 .mbar.repository add
command -label [mc
"Database Statistics"] \
1841 .mbar.repository add
command -label [mc
"Compress Database"] \
1844 .mbar.repository add
command -label [mc
"Verify Database"] \
1845 -command do_fsck_objects
1847 .mbar.repository add separator
1850 .mbar.repository add
command \
1851 -label [mc
"Create Desktop Icon"] \
1852 -command do_cygwin_shortcut
1853 } elseif
{[is_Windows
]} {
1854 .mbar.repository add
command \
1855 -label [mc
"Create Desktop Icon"] \
1856 -command do_windows_shortcut
1857 } elseif
{[is_MacOSX
]} {
1858 .mbar.repository add
command \
1859 -label [mc
"Create Desktop Icon"] \
1860 -command do_macosx_app
1864 .mbar.repository add
command -label [mc Quit
] \
1871 .mbar.edit add
command -label [mc Undo
] \
1872 -command {catch
{[focus
] edit undo
}} \
1874 .mbar.edit add
command -label [mc Redo
] \
1875 -command {catch
{[focus
] edit redo
}} \
1877 .mbar.edit add separator
1878 .mbar.edit add
command -label [mc Cut
] \
1879 -command {catch
{tk_textCut
[focus
]}} \
1881 .mbar.edit add
command -label [mc Copy
] \
1882 -command {catch
{tk_textCopy
[focus
]}} \
1884 .mbar.edit add
command -label [mc Paste
] \
1885 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1887 .mbar.edit add
command -label [mc Delete
] \
1888 -command {catch
{[focus
] delete sel.first sel.last
}} \
1890 .mbar.edit add separator
1891 .mbar.edit add
command -label [mc
"Select All"] \
1892 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1897 if {[is_enabled branch
]} {
1900 .mbar.branch add
command -label [mc
"Create..."] \
1901 -command branch_create
::dialog \
1903 lappend disable_on_lock
[list .mbar.branch entryconf \
1904 [.mbar.branch index last
] -state]
1906 .mbar.branch add
command -label [mc
"Checkout..."] \
1907 -command branch_checkout
::dialog \
1909 lappend disable_on_lock
[list .mbar.branch entryconf \
1910 [.mbar.branch index last
] -state]
1912 .mbar.branch add
command -label [mc
"Rename..."] \
1913 -command branch_rename
::dialog
1914 lappend disable_on_lock
[list .mbar.branch entryconf \
1915 [.mbar.branch index last
] -state]
1917 .mbar.branch add
command -label [mc
"Delete..."] \
1918 -command branch_delete
::dialog
1919 lappend disable_on_lock
[list .mbar.branch entryconf \
1920 [.mbar.branch index last
] -state]
1922 .mbar.branch add
command -label [mc
"Reset..."] \
1923 -command merge
::reset_hard
1924 lappend disable_on_lock
[list .mbar.branch entryconf \
1925 [.mbar.branch index last
] -state]
1930 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1933 .mbar.commit add radiobutton \
1934 -label [mc
"New Commit"] \
1935 -command do_select_commit_type \
1936 -variable selected_commit_type \
1938 lappend disable_on_lock \
1939 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1941 .mbar.commit add radiobutton \
1942 -label [mc
"Amend Last Commit"] \
1943 -command do_select_commit_type \
1944 -variable selected_commit_type \
1946 lappend disable_on_lock \
1947 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1949 .mbar.commit add separator
1951 .mbar.commit add
command -label [mc Rescan
] \
1952 -command do_rescan \
1954 lappend disable_on_lock \
1955 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1957 .mbar.commit add
command -label [mc
"Stage To Commit"] \
1958 -command do_add_selection
1959 lappend disable_on_lock \
1960 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1962 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
1963 -command do_add_all \
1965 lappend disable_on_lock \
1966 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1968 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
1969 -command do_unstage_selection
1970 lappend disable_on_lock \
1971 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1973 .mbar.commit add
command -label [mc
"Revert Changes"] \
1974 -command do_revert_selection
1975 lappend disable_on_lock \
1976 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1978 .mbar.commit add separator
1980 .mbar.commit add
command -label [mc
"Sign Off"] \
1981 -command do_signoff \
1984 .mbar.commit add
command -label [mc Commit@@verb
] \
1985 -command do_commit \
1986 -accelerator $M1T-Return
1987 lappend disable_on_lock \
1988 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1993 if {[is_enabled branch
]} {
1995 .mbar.merge add
command -label [mc
"Local Merge..."] \
1996 -command merge
::dialog \
1998 lappend disable_on_lock \
1999 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2000 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2001 -command merge
::reset_hard
2002 lappend disable_on_lock \
2003 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2008 if {[is_enabled transport
]} {
2011 .mbar.remote add
command \
2012 -label [mc
"Push..."] \
2013 -command do_push_anywhere \
2015 .mbar.remote add
command \
2016 -label [mc
"Delete..."] \
2017 -command remote_branch_delete
::dialog
2021 # -- Apple Menu (Mac OS X only)
2023 .mbar add cascade
-label [mc Apple
] -menu .mbar.apple
2026 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2028 .mbar.apple add separator
2029 .mbar.apple add
command \
2030 -label [mc
"Preferences..."] \
2031 -command do_options \
2033 bind .
<$M1B-,> do_options
2037 .mbar.edit add separator
2038 .mbar.edit add
command -label [mc
"Options..."] \
2044 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2048 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2053 catch
{set browser
$repo_config(instaweb.browser
)}
2054 set doc_path
[file dirname [gitexec
]]
2055 set doc_path
[file join $doc_path Documentation index.html
]
2058 set doc_path
[exec cygpath
--mixed $doc_path]
2061 if {$browser eq
{}} {
2064 } elseif
{[is_Cygwin
]} {
2065 set program_files
[file dirname [exec cygpath
--windir]]
2066 set program_files
[file join $program_files {Program Files
}]
2067 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
2068 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
2069 if {[file exists
$firefox]} {
2070 set browser
$firefox
2071 } elseif
{[file exists
$ie]} {
2074 unset program_files firefox ie
2078 if {[file isfile
$doc_path]} {
2079 set doc_url
"file:$doc_path"
2081 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2084 if {$browser ne
{}} {
2085 .mbar.
help add
command -label [mc
"Online Documentation"] \
2086 -command [list
exec $browser $doc_url &]
2088 unset browser doc_path doc_url
2090 # -- Standard bindings
2092 wm protocol . WM_DELETE_WINDOW do_quit
2093 bind all
<$M1B-Key-q> do_quit
2094 bind all
<$M1B-Key-Q> do_quit
2095 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2096 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2098 set subcommand_args
{}
2100 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2104 # -- Not a normal commit type invocation? Do that instead!
2106 switch
-- $subcommand {
2109 set subcommand_args
{rev? path
}
2110 if {$argv eq
{}} usage
2115 if {$is_path ||
[file exists
$_prefix$a]} {
2116 if {$path ne
{}} usage
2119 } elseif
{$a eq
{--}} {
2121 if {$head ne
{}} usage
2126 } elseif
{$head eq
{}} {
2127 if {$head ne
{}} usage
2136 if {$head ne
{} && $path eq
{}} {
2137 set path
$_prefix$head
2144 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2146 set head [git rev-parse
--verify $head]
2152 set current_branch
$head
2155 switch
-- $subcommand {
2158 if {$path ne
{} && [file isdirectory
$path]} {
2159 set head $current_branch
2165 browser
::new
$head $path
2168 if {$head eq
{} && ![file exists
$path]} {
2169 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2172 blame
::new
$head $path
2179 if {[llength
$argv] != 0} {
2180 puts
-nonewline stderr
"usage: $argv0"
2181 if {$subcommand ne
{gui
}
2182 && [file tail $argv0] ne
"git-$subcommand"} {
2183 puts
-nonewline stderr
" $subcommand"
2188 # fall through to setup UI for commits
2191 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2202 -text [mc
"Current Branch:"] \
2206 -textvariable current_branch \
2209 pack .branch.l1
-side left
2210 pack .branch.cb
-side left
-fill x
2211 pack .branch
-side top
-fill x
2213 # -- Main Window Layout
2215 panedwindow .vpane
-orient horizontal
2216 panedwindow .vpane.files
-orient vertical
2217 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2218 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2220 # -- Index File List
2222 frame .vpane.files.index
-height 100 -width 200
2223 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Commit)"] \
2224 -background lightgreen
2225 text
$ui_index -background white
-borderwidth 0 \
2226 -width 20 -height 10 \
2228 -cursor $cursor_ptr \
2229 -xscrollcommand {.vpane.files.index.sx
set} \
2230 -yscrollcommand {.vpane.files.index.sy
set} \
2232 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2233 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2234 pack .vpane.files.index.title
-side top
-fill x
2235 pack .vpane.files.index.sx
-side bottom
-fill x
2236 pack .vpane.files.index.sy
-side right
-fill y
2237 pack
$ui_index -side left
-fill both
-expand 1
2239 # -- Working Directory File List
2241 frame .vpane.files.workdir
-height 100 -width 200
2242 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
2243 -background lightsalmon
2244 text
$ui_workdir -background white
-borderwidth 0 \
2245 -width 20 -height 10 \
2247 -cursor $cursor_ptr \
2248 -xscrollcommand {.vpane.files.workdir.sx
set} \
2249 -yscrollcommand {.vpane.files.workdir.sy
set} \
2251 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2252 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2253 pack .vpane.files.workdir.title
-side top
-fill x
2254 pack .vpane.files.workdir.sx
-side bottom
-fill x
2255 pack .vpane.files.workdir.sy
-side right
-fill y
2256 pack
$ui_workdir -side left
-fill both
-expand 1
2258 .vpane.files add .vpane.files.workdir
-sticky nsew
2259 .vpane.files add .vpane.files.index
-sticky nsew
2261 foreach i
[list
$ui_index $ui_workdir] {
2263 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2267 # -- Diff and Commit Area
2269 frame .vpane.lower
-height 300 -width 400
2270 frame .vpane.lower.commarea
2271 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2272 pack .vpane.lower.
diff -fill both
-expand 1
2273 pack .vpane.lower.commarea
-side bottom
-fill x
2274 .vpane add .vpane.lower
-sticky nsew
2276 # -- Commit Area Buttons
2278 frame .vpane.lower.commarea.buttons
2279 label .vpane.lower.commarea.buttons.l
-text {} \
2282 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2283 pack .vpane.lower.commarea.buttons
-side left
-fill y
2285 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2287 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2288 lappend disable_on_lock \
2289 {.vpane.lower.commarea.buttons.rescan conf
-state}
2291 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2293 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2294 lappend disable_on_lock \
2295 {.vpane.lower.commarea.buttons.incall conf
-state}
2297 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2299 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2301 button .vpane.lower.commarea.buttons.commit
-text [mc Commit@@verb
] \
2303 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2304 lappend disable_on_lock \
2305 {.vpane.lower.commarea.buttons.commit conf
-state}
2307 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2308 -command do_push_anywhere
2309 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2311 # -- Commit Message Buffer
2313 frame .vpane.lower.commarea.buffer
2314 frame .vpane.lower.commarea.buffer.header
2315 set ui_comm .vpane.lower.commarea.buffer.t
2316 set ui_coml .vpane.lower.commarea.buffer.header.l
2317 radiobutton .vpane.lower.commarea.buffer.header.new \
2318 -text [mc
"New Commit"] \
2319 -command do_select_commit_type \
2320 -variable selected_commit_type \
2322 lappend disable_on_lock \
2323 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2324 radiobutton .vpane.lower.commarea.buffer.header.amend \
2325 -text [mc
"Amend Last Commit"] \
2326 -command do_select_commit_type \
2327 -variable selected_commit_type \
2329 lappend disable_on_lock \
2330 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2334 proc trace_commit_type
{varname args
} {
2335 global ui_coml commit_type
2336 switch
-glob -- $commit_type {
2337 initial
{set txt
[mc
"Initial Commit Message:"]}
2338 amend
{set txt
[mc
"Amended Commit Message:"]}
2339 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2340 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2341 merge
{set txt
[mc
"Merge Commit Message:"]}
2342 * {set txt
[mc
"Commit Message:"]}
2344 $ui_coml conf
-text $txt
2346 trace add variable commit_type
write trace_commit_type
2347 pack
$ui_coml -side left
-fill x
2348 pack .vpane.lower.commarea.buffer.header.amend
-side right
2349 pack .vpane.lower.commarea.buffer.header.new
-side right
2351 text
$ui_comm -background white
-borderwidth 1 \
2354 -autoseparators true \
2356 -width 75 -height 9 -wrap none \
2358 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2359 scrollbar .vpane.lower.commarea.buffer.sby \
2360 -command [list
$ui_comm yview
]
2361 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2362 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2363 pack
$ui_comm -side left
-fill y
2364 pack .vpane.lower.commarea.buffer
-side left
-fill y
2366 # -- Commit Message Buffer Context Menu
2368 set ctxm .vpane.lower.commarea.buffer.ctxm
2369 menu
$ctxm -tearoff 0
2372 -command {tk_textCut
$ui_comm}
2375 -command {tk_textCopy
$ui_comm}
2378 -command {tk_textPaste
$ui_comm}
2380 -label [mc Delete
] \
2381 -command {$ui_comm delete sel.first sel.last
}
2384 -label [mc
"Select All"] \
2385 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2387 -label [mc
"Copy All"] \
2389 $ui_comm tag add sel
0.0 end
2390 tk_textCopy
$ui_comm
2391 $ui_comm tag remove sel
0.0 end
2395 -label [mc
"Sign Off"] \
2397 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
2401 proc trace_current_diff_path
{varname args
} {
2402 global current_diff_path diff_actions file_states
2403 if {$current_diff_path eq
{}} {
2409 set p
$current_diff_path
2410 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2412 set p
[escape_path
$p]
2416 .vpane.lower.
diff.header.status configure
-text $s
2417 .vpane.lower.
diff.header.
file configure
-text $f
2418 .vpane.lower.
diff.header.path configure
-text $p
2419 foreach w
$diff_actions {
2423 trace add variable current_diff_path
write trace_current_diff_path
2425 frame .vpane.lower.
diff.header
-background gold
2426 label .vpane.lower.
diff.header.status \
2428 -width $max_status_desc \
2431 label .vpane.lower.
diff.header.
file \
2435 label .vpane.lower.
diff.header.path \
2439 pack .vpane.lower.
diff.header.status
-side left
2440 pack .vpane.lower.
diff.header.
file -side left
2441 pack .vpane.lower.
diff.header.path
-fill x
2442 set ctxm .vpane.lower.
diff.header.ctxm
2443 menu
$ctxm -tearoff 0
2451 -- $current_diff_path
2453 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2454 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2458 frame .vpane.lower.
diff.body
2459 set ui_diff .vpane.lower.
diff.body.t
2460 text
$ui_diff -background white
-borderwidth 0 \
2461 -width 80 -height 15 -wrap none \
2463 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2464 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2466 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2467 -command [list
$ui_diff xview
]
2468 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2469 -command [list
$ui_diff yview
]
2470 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2471 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2472 pack
$ui_diff -side left
-fill both
-expand 1
2473 pack .vpane.lower.
diff.header
-side top
-fill x
2474 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2476 $ui_diff tag conf d_cr
-elide true
2477 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2478 $ui_diff tag conf d_
+ -foreground {#00a000}
2479 $ui_diff tag conf d_-
-foreground red
2481 $ui_diff tag conf d_
++ -foreground {#00a000}
2482 $ui_diff tag conf d_--
-foreground red
2483 $ui_diff tag conf d_
+s \
2484 -foreground {#00a000} \
2485 -background {#e2effa}
2486 $ui_diff tag conf d_-s \
2488 -background {#e2effa}
2489 $ui_diff tag conf d_s
+ \
2490 -foreground {#00a000} \
2492 $ui_diff tag conf d_s- \
2496 $ui_diff tag conf d
<<<<<<< \
2497 -foreground orange \
2499 $ui_diff tag conf d
======= \
2500 -foreground orange \
2502 $ui_diff tag conf d
>>>>>>> \
2503 -foreground orange \
2506 $ui_diff tag raise sel
2508 # -- Diff Body Context Menu
2510 set ctxm .vpane.lower.
diff.body.ctxm
2511 menu
$ctxm -tearoff 0
2513 -label [mc Refresh
] \
2514 -command reshow_diff
2515 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2518 -command {tk_textCopy
$ui_diff}
2519 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2521 -label [mc
"Select All"] \
2522 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2523 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2525 -label [mc
"Copy All"] \
2527 $ui_diff tag add sel
0.0 end
2528 tk_textCopy
$ui_diff
2529 $ui_diff tag remove sel
0.0 end
2531 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2534 -label [mc
"Apply/Reverse Hunk"] \
2535 -command {apply_hunk
$cursorX $cursorY}
2536 set ui_diff_applyhunk
[$ctxm index last
]
2537 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2540 -label [mc
"Decrease Font Size"] \
2541 -command {incr_font_size font_diff
-1}
2542 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2544 -label [mc
"Increase Font Size"] \
2545 -command {incr_font_size font_diff
1}
2546 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2549 -label [mc
"Show Less Context"] \
2550 -command {if {$repo_config(gui.diffcontext
) >= 1} {
2551 incr repo_config
(gui.diffcontext
) -1
2554 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2556 -label [mc
"Show More Context"] \
2557 -command {if {$repo_config(gui.diffcontext
) < 99} {
2558 incr repo_config
(gui.diffcontext
)
2561 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2563 $ctxm add
command -label [mc
"Options..."] \
2565 proc popup_diff_menu
{ctxm x y X Y
} {
2566 global current_diff_path file_states
2569 if {$
::ui_index eq $
::current_diff_side
} {
2570 set l
[mc
"Unstage Hunk From Commit"]
2572 set l
[mc
"Stage Hunk For Commit"]
2575 ||
$current_diff_path eq
{}
2576 ||
![info exists file_states
($current_diff_path)]
2577 ||
{_O
} eq
[lindex
$file_states($current_diff_path) 0]} {
2582 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
2583 tk_popup
$ctxm $X $Y
2585 bind_button3
$ui_diff [list popup_diff_menu
$ctxm %x
%y
%X
%Y
]
2589 set main_status
[::status_bar
::new .status
]
2590 pack .status
-anchor w
-side bottom
-fill x
2591 $main_status show
[mc
"Initializing..."]
2596 set gm
$repo_config(gui.geometry
)
2597 wm geometry .
[lindex
$gm 0]
2598 .vpane sash place
0 \
2600 [lindex
[.vpane sash coord
0] 1]
2601 .vpane.files sash place
0 \
2602 [lindex
[.vpane.files sash coord
0] 0] \
2609 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2610 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2611 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2612 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2613 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2614 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2615 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2616 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2617 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2618 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2619 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2621 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2622 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2623 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2624 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2625 bind $ui_diff <$M1B-Key-v> {break}
2626 bind $ui_diff <$M1B-Key-V> {break}
2627 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2628 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2629 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2630 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2631 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2632 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2633 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2634 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2635 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2636 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2637 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2638 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2639 bind $ui_diff <Button-1
> {focus
%W
}
2641 if {[is_enabled branch
]} {
2642 bind .
<$M1B-Key-n> branch_create
::dialog
2643 bind .
<$M1B-Key-N> branch_create
::dialog
2644 bind .
<$M1B-Key-o> branch_checkout
::dialog
2645 bind .
<$M1B-Key-O> branch_checkout
::dialog
2646 bind .
<$M1B-Key-m> merge
::dialog
2647 bind .
<$M1B-Key-M> merge
::dialog
2649 if {[is_enabled transport
]} {
2650 bind .
<$M1B-Key-p> do_push_anywhere
2651 bind .
<$M1B-Key-P> do_push_anywhere
2654 bind .
<Key-F5
> do_rescan
2655 bind .
<$M1B-Key-r> do_rescan
2656 bind .
<$M1B-Key-R> do_rescan
2657 bind .
<$M1B-Key-s> do_signoff
2658 bind .
<$M1B-Key-S> do_signoff
2659 bind .
<$M1B-Key-i> do_add_all
2660 bind .
<$M1B-Key-I> do_add_all
2661 bind .
<$M1B-Key-Return> do_commit
2662 foreach i
[list
$ui_index $ui_workdir] {
2663 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2664 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2665 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2669 set file_lists
($ui_index) [list
]
2670 set file_lists
($ui_workdir) [list
]
2672 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2673 focus
-force $ui_comm
2675 # -- Warn the user about environmental problems. Cygwin's Tcl
2676 # does *not* pass its env array onto any processes it spawns.
2677 # This means that git processes get none of our environment.
2682 set msg
[mc
"Possible environment issues exist.
2684 The following environment variables are probably
2685 going to be ignored by any Git subprocess run
2689 foreach name
[array names env
] {
2690 switch
-regexp -- $name {
2691 {^GIT_INDEX_FILE$
} -
2692 {^GIT_OBJECT_DIRECTORY$
} -
2693 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2695 {^GIT_EXTERNAL_DIFF$
} -
2699 {^GIT_CONFIG_LOCAL$
} -
2700 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2701 append msg
" - $name\n"
2704 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2705 append msg
" - $name\n"
2707 set suggest_user
$name
2711 if {$ignored_env > 0} {
2713 This is due to a known issue with the
2714 Tcl binary distributed by Cygwin."]
2716 if {$suggest_user ne
{}} {
2719 A good replacement for %s
2720 is placing values for the user.name and
2721 user.email settings into your personal
2727 unset ignored_env msg suggest_user name
2730 # -- Only initialize complex UI if we are going to stay running.
2732 if {[is_enabled transport
]} {
2735 set n
[.mbar.remote index end
]
2738 set n
[expr {[.mbar.remote index end
] - $n}]
2740 .mbar.remote insert
$n separator
2745 if {[winfo exists
$ui_comm]} {
2746 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
2748 # -- If both our backup and message files exist use the
2749 # newer of the two files to initialize the buffer.
2751 if {$GITGUI_BCK_exists} {
2752 set m
[gitdir GITGUI_MSG
]
2753 if {[file isfile
$m]} {
2754 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
2755 catch
{file delete
[gitdir GITGUI_MSG
]}
2757 $ui_comm delete
0.0 end
2759 $ui_comm edit modified false
2760 catch
{file delete
[gitdir GITGUI_BCK
]}
2761 set GITGUI_BCK_exists
0
2767 proc backup_commit_buffer
{} {
2768 global ui_comm GITGUI_BCK_exists
2770 set m
[$ui_comm edit modified
]
2771 if {$m ||
$GITGUI_BCK_exists} {
2772 set msg
[string trim
[$ui_comm get
0.0 end
]]
2773 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2776 if {$GITGUI_BCK_exists} {
2777 catch
{file delete
[gitdir GITGUI_BCK
]}
2778 set GITGUI_BCK_exists
0
2782 set fd
[open
[gitdir GITGUI_BCK
] w
]
2783 puts
-nonewline $fd $msg
2785 set GITGUI_BCK_exists
1
2789 $ui_comm edit modified false
2792 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
2795 backup_commit_buffer
2798 lock_index begin-read
2799 if {![winfo ismapped .
]} {
2803 if {[is_enabled multicommit
]} {