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 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 cmk
[string first @@
$fmt]
94 return [string range
$fmt 0 [expr {$cmk - 1}]]
99 proc mc
{en_fmt args
} {
100 set fmt [_mc_trim
[::msgcat
::mc
$en_fmt]]
101 if {[catch
{set msg
[eval [list format
$fmt] $args]} err
]} {
102 set msg
[eval [list format
[_mc_trim
$en_fmt]] $args]
108 return [join $args {}]
111 ::msgcat
::mcload
$oguimsg
114 ######################################################################
118 set _appname
{Git Gui
}
125 set _trace
[lsearch
-exact $argv --trace]
127 set argv
[lreplace
$argv $_trace $_trace]
143 return [eval [list
file join $_gitdir] $args]
146 proc gitexec
{args
} {
148 if {$_gitexec eq
{}} {
149 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
150 error
"Git not installed?\n\n$err"
153 set _gitexec
[exec cygpath \
158 set _gitexec
[file normalize
$_gitexec]
164 return [eval [list
file join $_gitexec] $args]
172 if {[tk windowingsystem
] eq
{aqua
}} {
179 if {$
::tcl_platform
(platform
) eq
{windows
}} {
187 if {$_iscygwin eq
{}} {
188 if {$
::tcl_platform
(platform
) eq
{windows
}} {
189 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
201 proc is_enabled
{option
} {
202 global enabled_options
203 if {[catch
{set on
$enabled_options($option)}]} {return 0}
207 proc enable_option
{option
} {
208 global enabled_options
209 set enabled_options
($option) 1
212 proc disable_option
{option
} {
213 global enabled_options
214 set enabled_options
($option) 0
217 ######################################################################
221 proc is_many_config
{name
} {
222 switch
-glob -- $name {
232 proc is_config_true
{name
} {
234 if {[catch
{set v
$repo_config($name)}]} {
236 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
243 proc get_config
{name
} {
245 if {[catch
{set v
$repo_config($name)}]} {
252 ######################################################################
256 proc _trace_exec
{cmd
} {
257 if {!$
::_trace
} return
263 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
271 proc _git_cmd {name} {
274 if {[catch {set v $_git_cmd_path($name)}]} {
278 --exec-path { return [list $::_git $name] }
281 set p [gitexec git-$name$::_search_exe]
282 if {[file exists $p]} {
284 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
285 # Try to determine what sort of magic will make
286 # git-$name go and do its thing, because native
287 # Tcl on Windows doesn't know it.
289 set p
[gitexec git-
$name]
294 switch
-glob -- [lindex
$s 0] {
296 #!*perl { set i perl }
297 #!*python { set i python }
298 default
{ error
"git-$name is not supported: $s" }
302 if {![info exists interp
]} {
303 set interp
[_which
$i]
306 error
"git-$name requires $i (not in PATH)"
308 set v
[concat
[list
$interp] [lrange
$s 1 end
] [list
$p]]
310 # Assume it is builtin to git somehow and we
311 # aren't actually able to see a file for it.
313 set v
[list $
::_git
$name]
315 set _git_cmd_path
($name) $v
320 proc _which
{what args
} {
321 global env _search_exe _search_path
323 if {$_search_path eq
{}} {
324 if {[is_Cygwin
] && [regexp
{^
(/|\.
:)} $env(PATH
)]} {
325 set _search_path
[split [exec cygpath \
331 } elseif
{[is_Windows
]} {
332 set gitguidir
[file dirname [info
script]]
333 regsub
-all ";" $gitguidir "\\;" gitguidir
334 set env
(PATH
) "$gitguidir;$env(PATH)"
335 set _search_path
[split $env(PATH
) {;}]
338 set _search_path
[split $env(PATH
) :]
343 if {[is_Windows
] && [lsearch
-exact $args -script] >= 0} {
346 set suffix
$_search_exe
349 foreach p
$_search_path {
350 set p
[file join $p $what$suffix]
351 if {[file exists
$p]} {
352 return [file normalize
$p]
358 proc _lappend_nice
{cmd_var
} {
362 if {![info exists _nice
]} {
363 set _nice
[_which nice
]
374 switch
-- [lindex
$args 0] {
385 set args
[lrange
$args 1 end
]
388 set cmdp
[_git_cmd
[lindex
$args 0]]
389 set args
[lrange
$args 1 end
]
391 _trace_exec
[concat
$opt $cmdp $args]
392 set result
[eval exec $opt $cmdp $args]
394 puts stderr
"< $result"
399 proc _open_stdout_stderr
{cmd
} {
402 set fd
[open
[concat
[list |
] $cmd] r
]
404 if { [lindex
$cmd end
] eq
{2>@
1}
405 && $err eq
{can not
find channel named
"1"}
407 # Older versions of Tcl 8.4 don't have this 2>@1 IO
408 # redirect operator. Fallback to |& cat for those.
409 # The command was not actually started, so its safe
410 # to try to start it a second time.
412 set fd
[open
[concat \
414 [lrange
$cmd 0 end-1
] \
421 fconfigure
$fd -eofchar {}
425 proc git_read
{args
} {
429 switch
-- [lindex
$args 0] {
444 set args
[lrange
$args 1 end
]
447 set cmdp
[_git_cmd
[lindex
$args 0]]
448 set args
[lrange
$args 1 end
]
450 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
453 proc git_write
{args
} {
457 switch
-- [lindex
$args 0] {
468 set args
[lrange
$args 1 end
]
471 set cmdp
[_git_cmd
[lindex
$args 0]]
472 set args
[lrange
$args 1 end
]
474 _trace_exec
[concat
$opt $cmdp $args]
475 return [open
[concat
[list |
] $opt $cmdp $args] w
]
478 proc githook_read
{hook_name args
} {
479 set pchook
[gitdir hooks
$hook_name]
482 # On Windows [file executable] might lie so we need to ask
483 # the shell if the hook is executable. Yes that's annoying.
487 if {![info exists interp
]} {
488 set interp
[_which sh
]
491 error
"hook execution requires sh (not in PATH)"
494 set scr
{if test -x "$1";then exec "$@";fi}
495 set sh_c
[list
$interp -c $scr $interp $pchook]
496 return [_open_stdout_stderr
[concat
$sh_c $args]]
499 if {[file executable
$pchook]} {
500 return [_open_stdout_stderr
[concat
[list
$pchook] $args]]
506 proc kill_file_process
{fd
} {
507 set process
[pid
$fd]
511 # Use a Cygwin-specific flag to allow killing
512 # native Windows processes
513 exec kill -f $process
521 regsub
-all ' $value "'\\''" value
525 proc load_current_branch {} {
526 global current_branch is_detached
528 set fd [open [gitdir HEAD] r]
529 if {[gets $fd ref] < 1} {
534 set pfx {ref: refs/heads/}
535 set len [string length $pfx]
536 if {[string equal -length $len $pfx $ref]} {
537 # We're on a branch. It might not exist. But
538 # HEAD looks good enough to be a branch.
540 set current_branch [string range $ref $len end]
543 # Assume this is a detached head.
545 set current_branch HEAD
550 auto_load tk_optionMenu
551 rename tk_optionMenu real__tkOptionMenu
552 proc tk_optionMenu {w varName args} {
553 set m [eval real__tkOptionMenu $w $varName $args]
554 $m configure -font font_ui
555 $w configure -font font_ui
559 proc rmsel_tag {text} {
561 -background [$text cget -background] \
562 -foreground [$text cget -foreground] \
564 $text tag conf in_sel -background lightgray
565 bind $text <Motion> break
570 bind . <Visibility> {
571 bind . <Visibility> {}
576 wm iconbitmap . -default $oguilib/git-gui.ico
579 ######################################################################
584 font create font_diff -family Courier -size 10
588 eval font configure font_ui [font actual [.dummy cget -font]]
592 font create font_uiitalic
593 font create font_uibold
594 font create font_diffbold
595 font create font_diffitalic
597 foreach class {Button Checkbutton Entry Label
598 Labelframe Listbox Menu Message
599 Radiobutton Spinbox Text} {
600 option add *$class.font font_ui
604 if {[is_Windows] || [is_MacOSX]} {
605 option add *Menu.tearOff 0
616 proc bind_button3 {w cmd} {
617 bind $w <Any-Button-3> $cmd
619 # Mac OS X sends Button-2 on right click through three-button mouse,
620 # or through trackpad right-clicking (two-finger touch + click).
621 bind $w <Any-Button-2> $cmd
622 bind $w <Control-Button-1> $cmd
626 proc apply_config {} {
627 global repo_config font_descs
629 foreach option $font_descs {
630 set name [lindex $option 0]
631 set font [lindex $option 1]
634 foreach {cn cv} $repo_config(gui.$name) {
635 if {$cn eq {-weight}} {
638 font configure $font $cn $cv
641 font configure $font -weight normal
644 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
646 foreach {cn cv} [font configure $font] {
647 font configure ${font}bold $cn $cv
648 font configure ${font}italic $cn $cv
650 font configure ${font}bold -weight bold
651 font configure ${font}italic -slant italic
655 set default_config(branch.autosetupmerge) true
656 set default_config(merge.diffstat) true
657 set default_config(merge.summary) false
658 set default_config(merge.verbosity) 2
659 set default_config(user.name) {}
660 set default_config(user.email) {}
662 set default_config(gui.matchtrackingbranch) false
663 set default_config(gui.pruneduringfetch) false
664 set default_config(gui.trustmtime) false
665 set default_config(gui.fastcopyblame) false
666 set default_config(gui.copyblamethreshold) 40
667 set default_config(gui.diffcontext) 5
668 set default_config(gui.commitmsgwidth) 75
669 set default_config(gui.newbranchtemplate) {}
670 set default_config(gui.spellingdictionary) {}
671 set default_config(gui.fontui) [font configure font_ui]
672 set default_config(gui.fontdiff) [font configure font_diff]
674 {fontui font_ui {mc "Main Font
"}}
675 {fontdiff font_diff {mc "Diff
/Console Font
"}}
678 ######################################################################
682 set _git [_which git]
684 catch {wm withdraw .}
688 -title [mc "git-gui
: fatal error
"] \
689 -message [mc "Cannot
find git
in PATH.
"]
693 ######################################################################
697 if {[catch {set _git_version [git --version]} err]} {
698 catch {wm withdraw .}
702 -title [mc "git-gui
: fatal error
"] \
703 -message "Cannot determine Git version
:
707 [appname
] requires Git
1.5.0 or later.
"
710 if {![regsub {^git version } $_git_version {} _git_version]} {
711 catch {wm withdraw .}
715 -title [mc "git-gui
: fatal error
"] \
716 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
720 set _real_git_version $_git_version
721 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
722 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
723 regsub {\.rc[0-9]+$} $_git_version {} _git_version
724 regsub {\.GIT$} $_git_version {} _git_version
725 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
727 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
728 catch {wm withdraw .}
733 -title "[appname
]: warning
" \
734 -message [mc "Git version cannot be determined.
736 %s claims it is version
'%s'.
738 %s requires
at least Git
1.5.0 or later.
740 Assume
'%s' is version
1.5.0?
741 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
742 set _git_version 1.5.0
747 unset _real_git_version
749 proc git-version {args} {
752 switch [llength $args] {
758 set op [lindex $args 0]
759 set vr [lindex $args 1]
760 set cm [package vcompare $_git_version $vr]
761 return [expr $cm $op 0]
765 set type [lindex $args 0]
766 set name [lindex $args 1]
767 set parm [lindex $args 2]
768 set body [lindex $args 3]
770 if {($type ne {proc} && $type ne {method})} {
771 error "Invalid arguments to git-version
"
773 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
774 error "Last arm of
$type $name must be default
"
777 foreach {op vr cb} [lrange $body 0 end-2] {
778 if {[git-version $op $vr]} {
779 return [uplevel [list $type $name $parm $cb]]
783 return [uplevel [list $type $name $parm [lindex $body end]]]
787 error "git-version
>= x
"
793 if {[git-version < 1.5]} {
794 catch {wm withdraw .}
798 -title [mc "git-gui
: fatal error
"] \
799 -message "[appname
] requires Git
1.5.0 or later.
801 You are using
[git-version
]:
807 ######################################################################
809 ## configure our library
811 set idx [file join $oguilib tclIndex]
812 if {[catch {set fd [open $idx r]} err]} {
813 catch {wm withdraw .}
817 -title [mc "git-gui
: fatal error
"] \
821 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
823 while {[gets $fd n] >= 0} {
824 if {$n ne {} && ![string match #* $n]} {
836 if {[lsearch -exact $loaded $p] >= 0} continue
837 source [file join $oguilib $p]
842 set auto_path [concat [list $oguilib] $auto_path]
844 unset -nocomplain idx fd
846 ######################################################################
848 ## config file parsing
850 git-version proc _parse_config {arr_name args} {
857 [list git_read config] \
859 [list --null --list]]
860 fconfigure $fd_rc -translation binary
861 set buf [read $fd_rc]
864 foreach line [split $buf "\
0"] {
865 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
866 if {[is_many_config $name]} {
867 lappend arr($name) $value
869 set arr($name) $value
878 set fd_rc [eval [list git_read config --list] $args]
879 while {[gets $fd_rc line] >= 0} {
880 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
881 if {[is_many_config $name]} {
882 lappend arr($name) $value
884 set arr($name) $value
893 proc load_config {include_global} {
894 global repo_config global_config default_config
896 if {$include_global} {
897 _parse_config global_config --global
899 _parse_config repo_config
901 foreach name [array names default_config] {
902 if {[catch {set v $global_config($name)}]} {
903 set global_config($name) $default_config($name)
905 if {[catch {set v $repo_config($name)}]} {
906 set repo_config($name) $default_config($name)
911 ######################################################################
913 ## feature option selection
915 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
920 if {$subcommand eq {gui.sh}} {
923 if {$subcommand eq {gui} && [llength $argv] > 0} {
924 set subcommand [lindex $argv 0]
925 set argv [lrange $argv 1 end]
928 enable_option multicommit
930 enable_option transport
933 switch -- $subcommand {
938 disable_option multicommit
939 disable_option branch
940 disable_option transport
943 enable_option singlecommit
945 disable_option multicommit
946 disable_option branch
947 disable_option transport
951 ######################################################################
956 set _gitdir $env(GIT_DIR)
960 set _gitdir [git rev-parse --git-dir]
961 set _prefix [git rev-parse --show-prefix]
965 choose_repository::pick
967 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
968 catch {set _gitdir [exec cygpath --windows $_gitdir]}
970 if {![file isdirectory $_gitdir]} {
971 catch {wm withdraw .}
972 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
975 if {$_prefix ne {}} {
976 regsub -all {[^/]+/} $_prefix ../ cdup
977 if {[catch {cd $cdup} err]} {
978 catch {wm withdraw .}
979 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
983 } elseif {![is_enabled bare]} {
984 if {[lindex [file split $_gitdir] end] ne {.git}} {
985 catch {wm withdraw .}
986 error_popup [strcat [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
989 if {[catch {cd [file dirname $_gitdir]} err]} {
990 catch {wm withdraw .}
991 error_popup [strcat [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
995 set _reponame [file split [file normalize $_gitdir]]
996 if {[lindex $_reponame end] eq {.git}} {
997 set _reponame [lindex $_reponame end-1]
999 set _reponame [lindex $_reponame end]
1002 ######################################################################
1006 set current_diff_path {}
1007 set current_diff_side {}
1008 set diff_actions [list]
1012 set MERGE_HEAD [list]
1015 set current_branch {}
1017 set current_diff_path {}
1019 set selected_commit_type new
1021 ######################################################################
1029 set disable_on_lock [list]
1030 set index_lock_type none
1032 proc lock_index {type} {
1033 global index_lock_type disable_on_lock
1035 if {$index_lock_type eq {none}} {
1036 set index_lock_type $type
1037 foreach w $disable_on_lock {
1038 uplevel #0 $w disabled
1041 } elseif {$index_lock_type eq "begin-
$type"} {
1042 set index_lock_type $type
1048 proc unlock_index {} {
1049 global index_lock_type disable_on_lock
1051 set index_lock_type none
1052 foreach w $disable_on_lock {
1053 uplevel #0 $w normal
1057 ######################################################################
1061 proc repository_state {ctvar hdvar mhvar} {
1062 global current_branch
1063 upvar $ctvar ct $hdvar hd $mhvar mh
1068 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1074 set merge_head [gitdir MERGE_HEAD]
1075 if {[file exists $merge_head]} {
1077 set fd_mh [open $merge_head r]
1078 while {[gets $fd_mh line] >= 0} {
1089 global PARENT empty_tree
1091 set p [lindex $PARENT 0]
1095 if {$empty_tree eq {}} {
1096 set empty_tree [git mktree << {}]
1101 proc rescan {after {honor_trustmtime 1}} {
1102 global HEAD PARENT MERGE_HEAD commit_type
1103 global ui_index ui_workdir ui_comm
1104 global rescan_active file_states
1107 if {$rescan_active > 0 || ![lock_index read]} return
1109 repository_state newType newHEAD newMERGE_HEAD
1110 if {[string match amend* $commit_type]
1111 && $newType eq {normal}
1112 && $newHEAD eq $HEAD} {
1116 set MERGE_HEAD $newMERGE_HEAD
1117 set commit_type $newType
1120 array unset file_states
1122 if {!$::GITGUI_BCK_exists &&
1123 (![$ui_comm edit modified]
1124 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1125 if {[string match amend* $commit_type]} {
1126 } elseif {[load_message GITGUI_MSG]} {
1127 } elseif {[load_message MERGE_MSG]} {
1128 } elseif {[load_message SQUASH_MSG]} {
1131 $ui_comm edit modified false
1134 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1135 rescan_stage2 {} $after
1138 ui_status [mc "Refreshing
file status...
"]
1139 set fd_rf [git_read update-index \
1145 fconfigure $fd_rf -blocking 0 -translation binary
1146 fileevent $fd_rf readable \
1147 [list rescan_stage2 $fd_rf $after]
1152 set is_git_info_exclude {}
1153 proc have_info_exclude {} {
1154 global is_git_info_exclude
1156 if {$is_git_info_exclude eq {}} {
1157 if {[catch {exec test -f [gitdir info exclude]}]} {
1158 set is_git_info_exclude 0
1160 set is_git_info_exclude 1
1163 return $is_git_info_exclude
1166 proc have_info_exclude {} {
1167 return [file readable [gitdir info exclude]]
1171 proc rescan_stage2 {fd after} {
1172 global rescan_active buf_rdi buf_rdf buf_rlo
1176 if {![eof $fd]} return
1180 set ls_others [list --exclude-per-directory=.gitignore]
1181 if {[have_info_exclude]} {
1182 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1184 set user_exclude [get_config core.excludesfile]
1185 if {$user_exclude ne {} && [file readable $user_exclude]} {
1186 lappend ls_others "--exclude-from=$user_exclude"
1194 ui_status [mc "Scanning
for modified files ...
"]
1195 set fd_di [git_read diff-index --cached -z [PARENT]]
1196 set fd_df [git_read diff-files -z]
1197 set fd_lo [eval git_read ls-files --others -z $ls_others]
1199 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1200 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1201 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1202 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1203 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1204 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1207 proc load_message {file} {
1210 set f [gitdir $file]
1211 if {[file isfile $f]} {
1212 if {[catch {set fd [open $f r]}]} {
1215 fconfigure $fd -eofchar {}
1216 set content [string trim [read $fd]]
1218 regsub -all -line {[ \r\t]+$} $content {} content
1219 $ui_comm delete 0.0 end
1220 $ui_comm insert end $content
1226 proc read_diff_index {fd after} {
1229 append buf_rdi [read $fd]
1231 set n [string length $buf_rdi]
1233 set z1 [string first "\
0" $buf_rdi $c]
1234 if {$z1 == -1} break
1236 set z2 [string first "\
0" $buf_rdi $z1]
1237 if {$z2 == -1} break
1240 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1241 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1243 [encoding convertfrom $p] \
1245 [list [lindex $i 0] [lindex $i 2]] \
1251 set buf_rdi [string range $buf_rdi $c end]
1256 rescan_done $fd buf_rdi $after
1259 proc read_diff_files {fd after} {
1262 append buf_rdf [read $fd]
1264 set n [string length $buf_rdf]
1266 set z1 [string first "\
0" $buf_rdf $c]
1267 if {$z1 == -1} break
1269 set z2 [string first "\
0" $buf_rdf $z1]
1270 if {$z2 == -1} break
1273 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1274 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1276 [encoding convertfrom $p] \
1279 [list [lindex $i 0] [lindex $i 2]]
1284 set buf_rdf [string range $buf_rdf $c end]
1289 rescan_done $fd buf_rdf $after
1292 proc read_ls_others {fd after} {
1295 append buf_rlo [read $fd]
1296 set pck [split $buf_rlo "\
0"]
1297 set buf_rlo [lindex $pck end]
1298 foreach p [lrange $pck 0 end-1] {
1299 set p [encoding convertfrom $p]
1300 if {[string index $p end] eq {/}} {
1301 set p [string range $p 0 end-1]
1305 rescan_done $fd buf_rlo $after
1308 proc rescan_done {fd buf after} {
1309 global rescan_active current_diff_path
1310 global file_states repo_config
1313 if {![eof $fd]} return
1316 if {[incr rescan_active -1] > 0} return
1321 if {$current_diff_path ne {}} reshow_diff
1325 proc prune_selection {} {
1326 global file_states selected_paths
1328 foreach path [array names selected_paths] {
1329 if {[catch {set still_here $file_states($path)}]} {
1330 unset selected_paths($path)
1335 ######################################################################
1339 proc mapicon {w state path} {
1342 if {[catch {set r $all_icons($state$w)}]} {
1343 puts "error
: no icon
for $w state
={$state} $path"
1349 proc mapdesc {state path} {
1352 if {[catch {set r $all_descs($state)}]} {
1353 puts "error
: no desc
for state
={$state} $path"
1359 proc ui_status {msg} {
1361 if {[info exists main_status]} {
1362 $main_status show $msg
1366 proc ui_ready {{test {}}} {
1368 if {[info exists main_status]} {
1369 $main_status show [mc "Ready.
"] $test
1373 proc escape_path {path} {
1374 regsub -all {\\} $path "\\\\" path
1375 regsub -all "\n" $path "\\n
" path
1379 proc short_path {path} {
1380 return [escape_path [lindex [file split $path] end]]
1384 set null_sha1 [string repeat 0 40]
1386 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1387 global file_states next_icon_id null_sha1
1389 set s0 [string index $new_state 0]
1390 set s1 [string index $new_state 1]
1392 if {[catch {set info $file_states($path)}]} {
1394 set icon n[incr next_icon_id]
1396 set state [lindex $info 0]
1397 set icon [lindex $info 1]
1398 if {$head_info eq {}} {set head_info [lindex $info 2]}
1399 if {$index_info eq {}} {set index_info [lindex $info 3]}
1402 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1403 elseif {$s0 eq {_}} {set s0 _}
1405 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1406 elseif {$s1 eq {_}} {set s1 _}
1408 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1409 set head_info [list 0 $null_sha1]
1410 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1411 && $head_info eq {}} {
1412 set head_info $index_info
1415 set file_states($path) [list $s0$s1 $icon \
1416 $head_info $index_info \
1421 proc display_file_helper {w path icon_name old_m new_m} {
1424 if {$new_m eq {_}} {
1425 set lno [lsearch -sorted -exact $file_lists($w) $path]
1427 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1429 $w conf -state normal
1430 $w delete $lno.0 [expr {$lno + 1}].0
1431 $w conf -state disabled
1433 } elseif {$old_m eq {_} && $new_m ne {_}} {
1434 lappend file_lists($w) $path
1435 set file_lists($w) [lsort -unique $file_lists($w)]
1436 set lno [lsearch -sorted -exact $file_lists($w) $path]
1438 $w conf -state normal
1439 $w image create $lno.0 \
1440 -align center -padx 5 -pady 1 \
1442 -image [mapicon $w $new_m $path]
1443 $w insert $lno.1 "[escape_path
$path]\n"
1444 $w conf -state disabled
1445 } elseif {$old_m ne $new_m} {
1446 $w conf -state normal
1447 $w image conf $icon_name -image [mapicon $w $new_m $path]
1448 $w conf -state disabled
1452 proc display_file {path state} {
1453 global file_states selected_paths
1454 global ui_index ui_workdir
1456 set old_m [merge_state $path $state]
1457 set s $file_states($path)
1458 set new_m [lindex $s 0]
1459 set icon_name [lindex $s 1]
1461 set o [string index $old_m 0]
1462 set n [string index $new_m 0]
1469 display_file_helper $ui_index $path $icon_name $o $n
1471 if {[string index $old_m 0] eq {U}} {
1474 set o [string index $old_m 1]
1476 if {[string index $new_m 0] eq {U}} {
1479 set n [string index $new_m 1]
1481 display_file_helper $ui_workdir $path $icon_name $o $n
1483 if {$new_m eq {__}} {
1484 unset file_states($path)
1485 catch {unset selected_paths($path)}
1489 proc display_all_files_helper {w path icon_name m} {
1492 lappend file_lists($w) $path
1493 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1494 $w image create end \
1495 -align center -padx 5 -pady 1 \
1497 -image [mapicon $w $m $path]
1498 $w insert end "[escape_path
$path]\n"
1501 proc display_all_files {} {
1502 global ui_index ui_workdir
1503 global file_states file_lists
1506 $ui_index conf -state normal
1507 $ui_workdir conf -state normal
1509 $ui_index delete 0.0 end
1510 $ui_workdir delete 0.0 end
1513 set file_lists($ui_index) [list]
1514 set file_lists($ui_workdir) [list]
1516 foreach path [lsort [array names file_states]] {
1517 set s $file_states($path)
1519 set icon_name [lindex $s 1]
1521 set s [string index $m 0]
1522 if {$s ne {U} && $s ne {_}} {
1523 display_all_files_helper $ui_index $path \
1527 if {[string index $m 0] eq {U}} {
1530 set s [string index $m 1]
1533 display_all_files_helper $ui_workdir $path \
1538 $ui_index conf -state disabled
1539 $ui_workdir conf -state disabled
1542 ######################################################################
1547 #define mask_width 14
1548 #define mask_height 15
1549 static unsigned char mask_bits[] = {
1550 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1551 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1552 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1555 image create bitmap file_plain -background white -foreground black -data {
1556 #define plain_width 14
1557 #define plain_height 15
1558 static unsigned char plain_bits[] = {
1559 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1560 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1561 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1562 } -maskdata $filemask
1564 image create bitmap file_mod -background white -foreground blue -data {
1565 #define mod_width 14
1566 #define mod_height 15
1567 static unsigned char mod_bits[] = {
1568 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1569 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1570 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1571 } -maskdata $filemask
1573 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1574 #define file_fulltick_width 14
1575 #define file_fulltick_height 15
1576 static unsigned char file_fulltick_bits
[] = {
1577 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1578 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1579 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1580 } -maskdata $filemask
1582 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1583 #define parttick_width 14
1584 #define parttick_height 15
1585 static unsigned char parttick_bits
[] = {
1586 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1587 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1588 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1589 } -maskdata $filemask
1591 image create bitmap file_question
-background white
-foreground black
-data {
1592 #define file_question_width 14
1593 #define file_question_height 15
1594 static unsigned char file_question_bits
[] = {
1595 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1596 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1597 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1598 } -maskdata $filemask
1600 image create bitmap file_removed
-background white
-foreground red
-data {
1601 #define file_removed_width 14
1602 #define file_removed_height 15
1603 static unsigned char file_removed_bits
[] = {
1604 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1605 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1606 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1607 } -maskdata $filemask
1609 image create bitmap file_merge
-background white
-foreground blue
-data {
1610 #define file_merge_width 14
1611 #define file_merge_height 15
1612 static unsigned char file_merge_bits
[] = {
1613 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1614 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1615 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1616 } -maskdata $filemask
1618 set ui_index .vpane.files.index.list
1619 set ui_workdir .vpane.files.workdir.list
1621 set all_icons
(_
$ui_index) file_plain
1622 set all_icons
(A
$ui_index) file_fulltick
1623 set all_icons
(M
$ui_index) file_fulltick
1624 set all_icons
(D
$ui_index) file_removed
1625 set all_icons
(U
$ui_index) file_merge
1627 set all_icons
(_
$ui_workdir) file_plain
1628 set all_icons
(M
$ui_workdir) file_mod
1629 set all_icons
(D
$ui_workdir) file_question
1630 set all_icons
(U
$ui_workdir) file_merge
1631 set all_icons
(O
$ui_workdir) file_plain
1633 set max_status_desc
0
1635 {__
{mc
"Unmodified"}}
1637 {_M
{mc
"Modified, not staged"}}
1638 {M_
{mc
"Staged for commit"}}
1639 {MM
{mc
"Portions staged for commit"}}
1640 {MD
{mc
"Staged for commit, missing"}}
1642 {_O
{mc
"Untracked, not staged"}}
1643 {A_
{mc
"Staged for commit"}}
1644 {AM
{mc
"Portions staged for commit"}}
1645 {AD
{mc
"Staged for commit, missing"}}
1648 {D_
{mc
"Staged for removal"}}
1649 {DO
{mc
"Staged for removal, still present"}}
1651 {U_
{mc
"Requires merge resolution"}}
1652 {UU
{mc
"Requires merge resolution"}}
1653 {UM
{mc
"Requires merge resolution"}}
1654 {UD
{mc
"Requires merge resolution"}}
1656 set text
[eval [lindex
$i 1]]
1657 if {$max_status_desc < [string length
$text]} {
1658 set max_status_desc
[string length
$text]
1660 set all_descs
([lindex
$i 0]) $text
1664 ######################################################################
1668 proc scrollbar2many
{list mode args
} {
1669 foreach w
$list {eval $w $mode $args}
1672 proc many2scrollbar
{list mode sb top bottom
} {
1673 $sb set $top $bottom
1674 foreach w
$list {$w $mode moveto
$top}
1677 proc incr_font_size
{font
{amt
1}} {
1678 set sz
[font configure
$font -size]
1680 font configure
$font -size $sz
1681 font configure
${font}bold
-size $sz
1682 font configure
${font}italic
-size $sz
1685 ######################################################################
1689 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1691 proc do_gitk
{revs
} {
1692 # -- Always start gitk through whatever we were loaded with. This
1693 # lets us bypass using shell process on Windows systems.
1695 set exe
[_which gitk
-script]
1696 set cmd
[list
[info nameofexecutable
] $exe]
1698 error_popup
[mc
"Couldn't find gitk in PATH"]
1702 if {[info exists env
(GIT_DIR
)]} {
1703 set old_GIT_DIR
$env(GIT_DIR
)
1709 cd [file dirname [gitdir
]]
1710 set env
(GIT_DIR
) [file tail [gitdir
]]
1712 eval exec $cmd $revs &
1714 if {$old_GIT_DIR eq
{}} {
1717 set env
(GIT_DIR
) $old_GIT_DIR
1721 ui_status $
::starting_gitk_msg
1723 ui_ready
$starting_gitk_msg
1731 global ui_comm is_quitting repo_config commit_type
1732 global GITGUI_BCK_exists GITGUI_BCK_i
1733 global ui_comm_spell
1735 if {$is_quitting} return
1738 if {[winfo exists
$ui_comm]} {
1739 # -- Stash our current commit buffer.
1741 set save
[gitdir GITGUI_MSG
]
1742 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1743 file rename
-force [gitdir GITGUI_BCK
] $save
1744 set GITGUI_BCK_exists
0
1746 set msg
[string trim
[$ui_comm get
0.0 end
]]
1747 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1748 if {(![string match amend
* $commit_type]
1749 ||
[$ui_comm edit modified
])
1752 set fd
[open
$save w
]
1753 puts
-nonewline $fd $msg
1757 catch
{file delete
$save}
1761 # -- Cancel our spellchecker if its running.
1763 if {[info exists ui_comm_spell
]} {
1767 # -- Remove our editor backup, its not needed.
1769 after cancel
$GITGUI_BCK_i
1770 if {$GITGUI_BCK_exists} {
1771 catch
{file delete
[gitdir GITGUI_BCK
]}
1774 # -- Stash our current window geometry into this repository.
1776 set cfg_geometry
[list
]
1777 lappend cfg_geometry
[wm geometry .
]
1778 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
1779 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
1780 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1783 if {$cfg_geometry ne
$rc_geometry} {
1784 catch
{git config gui.geometry
$cfg_geometry}
1800 global next_diff_p next_diff_w next_diff_i
1801 show_diff
$next_diff_p $next_diff_w $next_diff_i
1804 proc toggle_or_diff
{w x y
} {
1805 global file_states file_lists current_diff_path ui_index ui_workdir
1806 global last_clicked selected_paths
1808 set pos
[split [$w index @
$x,$y] .
]
1809 set lno
[lindex
$pos 0]
1810 set col [lindex
$pos 1]
1811 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1817 set last_clicked
[list
$w $lno]
1818 array
unset selected_paths
1819 $ui_index tag remove in_sel
0.0 end
1820 $ui_workdir tag remove in_sel
0.0 end
1822 if {$col == 0 && $y > 1} {
1823 set i
[expr {$lno-1}]
1824 set ll
[expr {[llength
$file_lists($w)]-1}]
1826 if {$i == $ll && $i == 0} {
1827 set after
{reshow_diff
;}
1829 global next_diff_p next_diff_w next_diff_i
1834 set i
[expr {$i + 1}]
1838 set i
[expr {$i - 1}]
1841 set next_diff_p
[lindex
$file_lists($w) $i]
1843 if {$next_diff_p ne
{} && $current_diff_path ne
{}} {
1844 set after
{next_diff
;}
1850 if {$w eq
$ui_index} {
1852 "Unstaging [short_path $path] from commit" \
1854 [concat
$after [list ui_ready
]]
1855 } elseif
{$w eq
$ui_workdir} {
1857 "Adding [short_path $path]" \
1859 [concat
$after [list ui_ready
]]
1862 show_diff
$path $w $lno
1866 proc add_one_to_selection
{w x y
} {
1867 global file_lists last_clicked selected_paths
1869 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1870 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1876 if {$last_clicked ne
{}
1877 && [lindex
$last_clicked 0] ne
$w} {
1878 array
unset selected_paths
1879 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1882 set last_clicked
[list
$w $lno]
1883 if {[catch
{set in_sel
$selected_paths($path)}]} {
1887 unset selected_paths
($path)
1888 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1890 set selected_paths
($path) 1
1891 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1895 proc add_range_to_selection
{w x y
} {
1896 global file_lists last_clicked selected_paths
1898 if {[lindex
$last_clicked 0] ne
$w} {
1899 toggle_or_diff
$w $x $y
1903 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1904 set lc
[lindex
$last_clicked 1]
1913 foreach path
[lrange
$file_lists($w) \
1914 [expr {$begin - 1}] \
1915 [expr {$end - 1}]] {
1916 set selected_paths
($path) 1
1918 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1921 proc show_more_context
{} {
1923 if {$repo_config(gui.diffcontext
) < 99} {
1924 incr repo_config
(gui.diffcontext
)
1929 proc show_less_context
{} {
1931 if {$repo_config(gui.diffcontext
) >= 1} {
1932 incr repo_config
(gui.diffcontext
) -1
1937 ######################################################################
1947 menu .mbar
-tearoff 0
1948 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
1949 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
1950 if {[is_enabled branch
]} {
1951 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
1953 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1954 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
1956 if {[is_enabled transport
]} {
1957 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
1958 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
1960 . configure
-menu .mbar
1962 # -- Repository Menu
1964 menu .mbar.repository
1966 .mbar.repository add
command \
1967 -label [mc
"Browse Current Branch's Files"] \
1968 -command {browser
::new
$current_branch}
1969 set ui_browse_current
[.mbar.repository index last
]
1970 .mbar.repository add
command \
1971 -label [mc
"Browse Branch Files..."] \
1972 -command browser_open
::dialog
1973 .mbar.repository add separator
1975 .mbar.repository add
command \
1976 -label [mc
"Visualize Current Branch's History"] \
1977 -command {do_gitk
$current_branch}
1978 set ui_visualize_current
[.mbar.repository index last
]
1979 .mbar.repository add
command \
1980 -label [mc
"Visualize All Branch History"] \
1981 -command {do_gitk
--all}
1982 .mbar.repository add separator
1984 proc current_branch_write
{args
} {
1985 global current_branch
1986 .mbar.repository entryconf $
::ui_browse_current \
1987 -label [mc
"Browse %s's Files" $current_branch]
1988 .mbar.repository entryconf $
::ui_visualize_current \
1989 -label [mc
"Visualize %s's History" $current_branch]
1991 trace add variable current_branch
write current_branch_write
1993 if {[is_enabled multicommit
]} {
1994 .mbar.repository add
command -label [mc
"Database Statistics"] \
1997 .mbar.repository add
command -label [mc
"Compress Database"] \
2000 .mbar.repository add
command -label [mc
"Verify Database"] \
2001 -command do_fsck_objects
2003 .mbar.repository add separator
2006 .mbar.repository add
command \
2007 -label [mc
"Create Desktop Icon"] \
2008 -command do_cygwin_shortcut
2009 } elseif
{[is_Windows
]} {
2010 .mbar.repository add
command \
2011 -label [mc
"Create Desktop Icon"] \
2012 -command do_windows_shortcut
2013 } elseif
{[is_MacOSX
]} {
2014 .mbar.repository add
command \
2015 -label [mc
"Create Desktop Icon"] \
2016 -command do_macosx_app
2021 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2023 .mbar.repository add
command -label [mc Quit
] \
2031 .mbar.edit add
command -label [mc Undo
] \
2032 -command {catch
{[focus
] edit undo
}} \
2034 .mbar.edit add
command -label [mc Redo
] \
2035 -command {catch
{[focus
] edit redo
}} \
2037 .mbar.edit add separator
2038 .mbar.edit add
command -label [mc Cut
] \
2039 -command {catch
{tk_textCut
[focus
]}} \
2041 .mbar.edit add
command -label [mc Copy
] \
2042 -command {catch
{tk_textCopy
[focus
]}} \
2044 .mbar.edit add
command -label [mc Paste
] \
2045 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2047 .mbar.edit add
command -label [mc Delete
] \
2048 -command {catch
{[focus
] delete sel.first sel.last
}} \
2050 .mbar.edit add separator
2051 .mbar.edit add
command -label [mc
"Select All"] \
2052 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2057 if {[is_enabled branch
]} {
2060 .mbar.branch add
command -label [mc
"Create..."] \
2061 -command branch_create
::dialog \
2063 lappend disable_on_lock
[list .mbar.branch entryconf \
2064 [.mbar.branch index last
] -state]
2066 .mbar.branch add
command -label [mc
"Checkout..."] \
2067 -command branch_checkout
::dialog \
2069 lappend disable_on_lock
[list .mbar.branch entryconf \
2070 [.mbar.branch index last
] -state]
2072 .mbar.branch add
command -label [mc
"Rename..."] \
2073 -command branch_rename
::dialog
2074 lappend disable_on_lock
[list .mbar.branch entryconf \
2075 [.mbar.branch index last
] -state]
2077 .mbar.branch add
command -label [mc
"Delete..."] \
2078 -command branch_delete
::dialog
2079 lappend disable_on_lock
[list .mbar.branch entryconf \
2080 [.mbar.branch index last
] -state]
2082 .mbar.branch add
command -label [mc
"Reset..."] \
2083 -command merge
::reset_hard
2084 lappend disable_on_lock
[list .mbar.branch entryconf \
2085 [.mbar.branch index last
] -state]
2090 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2093 .mbar.commit add radiobutton \
2094 -label [mc
"New Commit"] \
2095 -command do_select_commit_type \
2096 -variable selected_commit_type \
2098 lappend disable_on_lock \
2099 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2101 .mbar.commit add radiobutton \
2102 -label [mc
"Amend Last Commit"] \
2103 -command do_select_commit_type \
2104 -variable selected_commit_type \
2106 lappend disable_on_lock \
2107 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2109 .mbar.commit add separator
2111 .mbar.commit add
command -label [mc Rescan
] \
2112 -command do_rescan \
2114 lappend disable_on_lock \
2115 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2117 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2118 -command do_add_selection \
2120 lappend disable_on_lock \
2121 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2123 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2124 -command do_add_all \
2126 lappend disable_on_lock \
2127 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2129 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2130 -command do_unstage_selection
2131 lappend disable_on_lock \
2132 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2134 .mbar.commit add
command -label [mc
"Revert Changes"] \
2135 -command do_revert_selection
2136 lappend disable_on_lock \
2137 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2139 .mbar.commit add separator
2141 .mbar.commit add
command -label [mc
"Show Less Context"] \
2142 -command show_less_context \
2143 -accelerator $M1T-\
-
2145 .mbar.commit add
command -label [mc
"Show More Context"] \
2146 -command show_more_context \
2149 .mbar.commit add separator
2151 .mbar.commit add
command -label [mc
"Sign Off"] \
2152 -command do_signoff \
2155 .mbar.commit add
command -label [mc Commit@@verb
] \
2156 -command do_commit \
2157 -accelerator $M1T-Return
2158 lappend disable_on_lock \
2159 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2164 if {[is_enabled branch
]} {
2166 .mbar.merge add
command -label [mc
"Local Merge..."] \
2167 -command merge
::dialog \
2169 lappend disable_on_lock \
2170 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2171 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2172 -command merge
::reset_hard
2173 lappend disable_on_lock \
2174 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2179 if {[is_enabled transport
]} {
2182 .mbar.remote add
command \
2183 -label [mc
"Push..."] \
2184 -command do_push_anywhere \
2186 .mbar.remote add
command \
2187 -label [mc
"Delete..."] \
2188 -command remote_branch_delete
::dialog
2192 # -- Apple Menu (Mac OS X only)
2194 .mbar add cascade
-label Apple
-menu .mbar.apple
2197 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2199 .mbar.apple add separator
2200 .mbar.apple add
command \
2201 -label [mc
"Preferences..."] \
2202 -command do_options \
2204 bind .
<$M1B-,> do_options
2208 .mbar.edit add separator
2209 .mbar.edit add
command -label [mc
"Options..."] \
2215 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2219 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2224 catch
{set browser
$repo_config(instaweb.browser
)}
2225 set doc_path
[file dirname [gitexec
]]
2226 set doc_path
[file join $doc_path Documentation index.html
]
2229 set doc_path
[exec cygpath
--mixed $doc_path]
2232 if {$browser eq
{}} {
2235 } elseif
{[is_Cygwin
]} {
2236 set program_files
[file dirname [exec cygpath
--windir]]
2237 set program_files
[file join $program_files {Program Files
}]
2238 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
2239 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
2240 if {[file exists
$firefox]} {
2241 set browser
$firefox
2242 } elseif
{[file exists
$ie]} {
2245 unset program_files firefox ie
2249 if {[file isfile
$doc_path]} {
2250 set doc_url
"file:$doc_path"
2252 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2255 if {$browser ne
{}} {
2256 .mbar.
help add
command -label [mc
"Online Documentation"] \
2257 -command [list
exec $browser $doc_url &]
2259 unset browser doc_path doc_url
2261 # -- Standard bindings
2263 wm protocol . WM_DELETE_WINDOW do_quit
2264 bind all
<$M1B-Key-q> do_quit
2265 bind all
<$M1B-Key-Q> do_quit
2266 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2267 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2269 set subcommand_args
{}
2271 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2275 # -- Not a normal commit type invocation? Do that instead!
2277 switch
-- $subcommand {
2280 set subcommand_args
{rev? path
}
2281 if {$argv eq
{}} usage
2286 if {$is_path ||
[file exists
$_prefix$a]} {
2287 if {$path ne
{}} usage
2290 } elseif
{$a eq
{--}} {
2292 if {$head ne
{}} usage
2297 } elseif
{$head eq
{}} {
2298 if {$head ne
{}} usage
2307 if {$head ne
{} && $path eq
{}} {
2308 set path
$_prefix$head
2315 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2317 set head [git rev-parse
--verify $head]
2323 set current_branch
$head
2326 switch
-- $subcommand {
2329 if {$path ne
{} && [file isdirectory
$path]} {
2330 set head $current_branch
2336 browser
::new
$head $path
2339 if {$head eq
{} && ![file exists
$path]} {
2340 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2343 blame
::new
$head $path
2350 if {[llength
$argv] != 0} {
2351 puts
-nonewline stderr
"usage: $argv0"
2352 if {$subcommand ne
{gui
}
2353 && [file tail $argv0] ne
"git-$subcommand"} {
2354 puts
-nonewline stderr
" $subcommand"
2359 # fall through to setup UI for commits
2362 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2373 -text [mc
"Current Branch:"] \
2377 -textvariable current_branch \
2380 pack .branch.l1
-side left
2381 pack .branch.cb
-side left
-fill x
2382 pack .branch
-side top
-fill x
2384 # -- Main Window Layout
2386 panedwindow .vpane
-orient horizontal
2387 panedwindow .vpane.files
-orient vertical
2388 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2389 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2391 # -- Index File List
2393 frame .vpane.files.index
-height 100 -width 200
2394 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Commit)"] \
2395 -background lightgreen
-foreground black
2396 text
$ui_index -background white
-foreground black \
2398 -width 20 -height 10 \
2400 -cursor $cursor_ptr \
2401 -xscrollcommand {.vpane.files.index.sx
set} \
2402 -yscrollcommand {.vpane.files.index.sy
set} \
2404 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2405 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2406 pack .vpane.files.index.title
-side top
-fill x
2407 pack .vpane.files.index.sx
-side bottom
-fill x
2408 pack .vpane.files.index.sy
-side right
-fill y
2409 pack
$ui_index -side left
-fill both
-expand 1
2411 # -- Working Directory File List
2413 frame .vpane.files.workdir
-height 100 -width 200
2414 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
2415 -background lightsalmon
-foreground black
2416 text
$ui_workdir -background white
-foreground black \
2418 -width 20 -height 10 \
2420 -cursor $cursor_ptr \
2421 -xscrollcommand {.vpane.files.workdir.sx
set} \
2422 -yscrollcommand {.vpane.files.workdir.sy
set} \
2424 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2425 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2426 pack .vpane.files.workdir.title
-side top
-fill x
2427 pack .vpane.files.workdir.sx
-side bottom
-fill x
2428 pack .vpane.files.workdir.sy
-side right
-fill y
2429 pack
$ui_workdir -side left
-fill both
-expand 1
2431 .vpane.files add .vpane.files.workdir
-sticky nsew
2432 .vpane.files add .vpane.files.index
-sticky nsew
2434 foreach i
[list
$ui_index $ui_workdir] {
2436 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2440 # -- Diff and Commit Area
2442 frame .vpane.lower
-height 300 -width 400
2443 frame .vpane.lower.commarea
2444 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2445 pack .vpane.lower.
diff -fill both
-expand 1
2446 pack .vpane.lower.commarea
-side bottom
-fill x
2447 .vpane add .vpane.lower
-sticky nsew
2449 # -- Commit Area Buttons
2451 frame .vpane.lower.commarea.buttons
2452 label .vpane.lower.commarea.buttons.l
-text {} \
2455 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2456 pack .vpane.lower.commarea.buttons
-side left
-fill y
2458 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2460 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2461 lappend disable_on_lock \
2462 {.vpane.lower.commarea.buttons.rescan conf
-state}
2464 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2466 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2467 lappend disable_on_lock \
2468 {.vpane.lower.commarea.buttons.incall conf
-state}
2470 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2472 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2474 button .vpane.lower.commarea.buttons.commit
-text [mc Commit@@verb
] \
2476 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2477 lappend disable_on_lock \
2478 {.vpane.lower.commarea.buttons.commit conf
-state}
2480 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2481 -command do_push_anywhere
2482 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2484 # -- Commit Message Buffer
2486 frame .vpane.lower.commarea.buffer
2487 frame .vpane.lower.commarea.buffer.header
2488 set ui_comm .vpane.lower.commarea.buffer.t
2489 set ui_coml .vpane.lower.commarea.buffer.header.l
2490 radiobutton .vpane.lower.commarea.buffer.header.new \
2491 -text [mc
"New Commit"] \
2492 -command do_select_commit_type \
2493 -variable selected_commit_type \
2495 lappend disable_on_lock \
2496 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2497 radiobutton .vpane.lower.commarea.buffer.header.amend \
2498 -text [mc
"Amend Last Commit"] \
2499 -command do_select_commit_type \
2500 -variable selected_commit_type \
2502 lappend disable_on_lock \
2503 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2507 proc trace_commit_type
{varname args
} {
2508 global ui_coml commit_type
2509 switch
-glob -- $commit_type {
2510 initial
{set txt
[mc
"Initial Commit Message:"]}
2511 amend
{set txt
[mc
"Amended Commit Message:"]}
2512 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2513 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2514 merge
{set txt
[mc
"Merge Commit Message:"]}
2515 * {set txt
[mc
"Commit Message:"]}
2517 $ui_coml conf
-text $txt
2519 trace add variable commit_type
write trace_commit_type
2520 pack
$ui_coml -side left
-fill x
2521 pack .vpane.lower.commarea.buffer.header.amend
-side right
2522 pack .vpane.lower.commarea.buffer.header.new
-side right
2524 text
$ui_comm -background white
-foreground black \
2528 -autoseparators true \
2530 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
2532 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2533 scrollbar .vpane.lower.commarea.buffer.sby \
2534 -command [list
$ui_comm yview
]
2535 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2536 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2537 pack
$ui_comm -side left
-fill y
2538 pack .vpane.lower.commarea.buffer
-side left
-fill y
2540 # -- Commit Message Buffer Context Menu
2542 set ctxm .vpane.lower.commarea.buffer.ctxm
2543 menu
$ctxm -tearoff 0
2546 -command {tk_textCut
$ui_comm}
2549 -command {tk_textCopy
$ui_comm}
2552 -command {tk_textPaste
$ui_comm}
2554 -label [mc Delete
] \
2555 -command {$ui_comm delete sel.first sel.last
}
2558 -label [mc
"Select All"] \
2559 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2561 -label [mc
"Copy All"] \
2563 $ui_comm tag add sel
0.0 end
2564 tk_textCopy
$ui_comm
2565 $ui_comm tag remove sel
0.0 end
2569 -label [mc
"Sign Off"] \
2571 set ui_comm_ctxm
$ctxm
2575 proc trace_current_diff_path
{varname args
} {
2576 global current_diff_path diff_actions file_states
2577 if {$current_diff_path eq
{}} {
2583 set p
$current_diff_path
2584 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2586 set p
[escape_path
$p]
2590 .vpane.lower.
diff.header.status configure
-text $s
2591 .vpane.lower.
diff.header.
file configure
-text $f
2592 .vpane.lower.
diff.header.path configure
-text $p
2593 foreach w
$diff_actions {
2597 trace add variable current_diff_path
write trace_current_diff_path
2599 frame .vpane.lower.
diff.header
-background gold
2600 label .vpane.lower.
diff.header.status \
2603 -width $max_status_desc \
2606 label .vpane.lower.
diff.header.
file \
2611 label .vpane.lower.
diff.header.path \
2616 pack .vpane.lower.
diff.header.status
-side left
2617 pack .vpane.lower.
diff.header.
file -side left
2618 pack .vpane.lower.
diff.header.path
-fill x
2619 set ctxm .vpane.lower.
diff.header.ctxm
2620 menu
$ctxm -tearoff 0
2628 -- $current_diff_path
2630 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2631 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2635 frame .vpane.lower.
diff.body
2636 set ui_diff .vpane.lower.
diff.body.t
2637 text
$ui_diff -background white
-foreground black \
2639 -width 80 -height 15 -wrap none \
2641 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2642 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2644 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2645 -command [list
$ui_diff xview
]
2646 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2647 -command [list
$ui_diff yview
]
2648 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2649 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2650 pack
$ui_diff -side left
-fill both
-expand 1
2651 pack .vpane.lower.
diff.header
-side top
-fill x
2652 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2654 $ui_diff tag conf d_cr
-elide true
2655 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2656 $ui_diff tag conf d_
+ -foreground {#00a000}
2657 $ui_diff tag conf d_-
-foreground red
2659 $ui_diff tag conf d_
++ -foreground {#00a000}
2660 $ui_diff tag conf d_--
-foreground red
2661 $ui_diff tag conf d_
+s \
2662 -foreground {#00a000} \
2663 -background {#e2effa}
2664 $ui_diff tag conf d_-s \
2666 -background {#e2effa}
2667 $ui_diff tag conf d_s
+ \
2668 -foreground {#00a000} \
2670 $ui_diff tag conf d_s- \
2674 $ui_diff tag conf d
<<<<<<< \
2675 -foreground orange \
2677 $ui_diff tag conf d
======= \
2678 -foreground orange \
2680 $ui_diff tag conf d
>>>>>>> \
2681 -foreground orange \
2684 $ui_diff tag raise sel
2686 # -- Diff Body Context Menu
2688 set ctxm .vpane.lower.
diff.body.ctxm
2689 menu
$ctxm -tearoff 0
2691 -label [mc
"Apply/Reverse Hunk"] \
2692 -command {apply_hunk
$cursorX $cursorY}
2693 set ui_diff_applyhunk
[$ctxm index last
]
2694 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2696 -label [mc
"Apply/Reverse Line"] \
2697 -command {apply_line
$cursorX $cursorY; do_rescan
}
2698 set ui_diff_applyline
[$ctxm index last
]
2699 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
2702 -label [mc
"Show Less Context"] \
2703 -command show_less_context
2704 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2706 -label [mc
"Show More Context"] \
2707 -command show_more_context
2708 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2711 -label [mc Refresh
] \
2712 -command reshow_diff
2713 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2716 -command {tk_textCopy
$ui_diff}
2717 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2719 -label [mc
"Select All"] \
2720 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2721 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2723 -label [mc
"Copy All"] \
2725 $ui_diff tag add sel
0.0 end
2726 tk_textCopy
$ui_diff
2727 $ui_diff tag remove sel
0.0 end
2729 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2732 -label [mc
"Decrease Font Size"] \
2733 -command {incr_font_size font_diff
-1}
2734 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2736 -label [mc
"Increase Font Size"] \
2737 -command {incr_font_size font_diff
1}
2738 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2740 $ctxm add
command -label [mc
"Options..."] \
2742 proc popup_diff_menu
{ctxm x y X Y
} {
2743 global current_diff_path file_states
2746 if {$
::ui_index eq $
::current_diff_side
} {
2747 set l
[mc
"Unstage Hunk From Commit"]
2748 set t
[mc
"Unstage Line From Commit"]
2750 set l
[mc
"Stage Hunk For Commit"]
2751 set t
[mc
"Stage Line For Commit"]
2754 ||
$current_diff_path eq
{}
2755 ||
![info exists file_states
($current_diff_path)]
2756 ||
{_O
} eq
[lindex
$file_states($current_diff_path) 0]} {
2761 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
2762 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
2763 tk_popup
$ctxm $X $Y
2765 bind_button3
$ui_diff [list popup_diff_menu
$ctxm %x
%y
%X
%Y
]
2769 set main_status
[::status_bar
::new .status
]
2770 pack .status
-anchor w
-side bottom
-fill x
2771 $main_status show
[mc
"Initializing..."]
2776 set gm
$repo_config(gui.geometry
)
2777 wm geometry .
[lindex
$gm 0]
2778 .vpane sash place
0 \
2780 [lindex
[.vpane sash coord
0] 1]
2781 .vpane.files sash place
0 \
2782 [lindex
[.vpane.files sash coord
0] 0] \
2789 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2790 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
2791 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
2792 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2793 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2794 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2795 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2796 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2797 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2798 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2799 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2800 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2801 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2802 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
2803 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
2804 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
2805 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
2806 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
2808 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2809 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2810 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2811 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2812 bind $ui_diff <$M1B-Key-v> {break}
2813 bind $ui_diff <$M1B-Key-V> {break}
2814 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2815 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2816 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2817 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2818 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2819 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2820 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2821 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2822 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2823 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2824 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2825 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2826 bind $ui_diff <Button-1
> {focus
%W
}
2828 if {[is_enabled branch
]} {
2829 bind .
<$M1B-Key-n> branch_create
::dialog
2830 bind .
<$M1B-Key-N> branch_create
::dialog
2831 bind .
<$M1B-Key-o> branch_checkout
::dialog
2832 bind .
<$M1B-Key-O> branch_checkout
::dialog
2833 bind .
<$M1B-Key-m> merge
::dialog
2834 bind .
<$M1B-Key-M> merge
::dialog
2836 if {[is_enabled transport
]} {
2837 bind .
<$M1B-Key-p> do_push_anywhere
2838 bind .
<$M1B-Key-P> do_push_anywhere
2841 bind .
<Key-F5
> do_rescan
2842 bind .
<$M1B-Key-r> do_rescan
2843 bind .
<$M1B-Key-R> do_rescan
2844 bind .
<$M1B-Key-s> do_signoff
2845 bind .
<$M1B-Key-S> do_signoff
2846 bind .
<$M1B-Key-t> do_add_selection
2847 bind .
<$M1B-Key-T> do_add_selection
2848 bind .
<$M1B-Key-i> do_add_all
2849 bind .
<$M1B-Key-I> do_add_all
2850 bind .
<$M1B-Key-minus> {show_less_context
;break}
2851 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
2852 bind .
<$M1B-Key-equal> {show_more_context
;break}
2853 bind .
<$M1B-Key-plus> {show_more_context
;break}
2854 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
2855 bind .
<$M1B-Key-Return> do_commit
2856 foreach i
[list
$ui_index $ui_workdir] {
2857 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2858 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2859 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2863 set file_lists
($ui_index) [list
]
2864 set file_lists
($ui_workdir) [list
]
2866 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2867 focus
-force $ui_comm
2869 # -- Warn the user about environmental problems. Cygwin's Tcl
2870 # does *not* pass its env array onto any processes it spawns.
2871 # This means that git processes get none of our environment.
2876 set msg
[mc
"Possible environment issues exist.
2878 The following environment variables are probably
2879 going to be ignored by any Git subprocess run
2883 foreach name
[array names env
] {
2884 switch
-regexp -- $name {
2885 {^GIT_INDEX_FILE$
} -
2886 {^GIT_OBJECT_DIRECTORY$
} -
2887 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2889 {^GIT_EXTERNAL_DIFF$
} -
2893 {^GIT_CONFIG_LOCAL$
} -
2894 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2895 append msg
" - $name\n"
2898 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2899 append msg
" - $name\n"
2901 set suggest_user
$name
2905 if {$ignored_env > 0} {
2907 This is due to a known issue with the
2908 Tcl binary distributed by Cygwin."]
2910 if {$suggest_user ne
{}} {
2913 A good replacement for %s
2914 is placing values for the user.name and
2915 user.email settings into your personal
2921 unset ignored_env msg suggest_user name
2924 # -- Only initialize complex UI if we are going to stay running.
2926 if {[is_enabled transport
]} {
2929 set n
[.mbar.remote index end
]
2932 set n
[expr {[.mbar.remote index end
] - $n}]
2934 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
2935 .mbar.remote insert
$n separator
2940 if {[winfo exists
$ui_comm]} {
2941 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
2943 # -- If both our backup and message files exist use the
2944 # newer of the two files to initialize the buffer.
2946 if {$GITGUI_BCK_exists} {
2947 set m
[gitdir GITGUI_MSG
]
2948 if {[file isfile
$m]} {
2949 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
2950 catch
{file delete
[gitdir GITGUI_MSG
]}
2952 $ui_comm delete
0.0 end
2954 $ui_comm edit modified false
2955 catch
{file delete
[gitdir GITGUI_BCK
]}
2956 set GITGUI_BCK_exists
0
2962 proc backup_commit_buffer
{} {
2963 global ui_comm GITGUI_BCK_exists
2965 set m
[$ui_comm edit modified
]
2966 if {$m ||
$GITGUI_BCK_exists} {
2967 set msg
[string trim
[$ui_comm get
0.0 end
]]
2968 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2971 if {$GITGUI_BCK_exists} {
2972 catch
{file delete
[gitdir GITGUI_BCK
]}
2973 set GITGUI_BCK_exists
0
2977 set fd
[open
[gitdir GITGUI_BCK
] w
]
2978 puts
-nonewline $fd $msg
2980 set GITGUI_BCK_exists
1
2984 $ui_comm edit modified false
2987 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
2990 backup_commit_buffer
2992 # -- If the user has aspell available we can drive it
2993 # in pipe mode to spellcheck the commit message.
2995 set spell_cmd
[list |
]
2996 set spell_dict
[get_config gui.spellingdictionary
]
2997 lappend spell_cmd aspell
2998 if {$spell_dict ne
{}} {
2999 lappend spell_cmd
--master=$spell_dict
3001 lappend spell_cmd
--mode=none
3002 lappend spell_cmd
--encoding=utf-8
3003 lappend spell_cmd pipe
3004 if {$spell_dict eq
{none
}
3005 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3006 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3008 set ui_comm_spell
[spellcheck
::init \
3014 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3017 lock_index begin-read
3018 if {![winfo ismapped .
]} {
3022 if {[is_enabled multicommit
]} {