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
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 foreach p
$_search_path {
344 set p
[file join $p $what$_search_exe]
345 if {[file exists
$p]} {
346 return [file normalize
$p]
352 proc _lappend_nice
{cmd_var
} {
356 if {![info exists _nice
]} {
357 set _nice
[_which nice
]
368 switch
-- [lindex
$args 0] {
379 set args
[lrange
$args 1 end
]
382 set cmdp
[_git_cmd
[lindex
$args 0]]
383 set args
[lrange
$args 1 end
]
385 _trace_exec
[concat
$opt $cmdp $args]
386 set result
[eval exec $opt $cmdp $args]
388 puts stderr
"< $result"
393 proc _open_stdout_stderr
{cmd
} {
396 set fd
[open
[concat
[list |
] $cmd] r
]
398 if { [lindex
$cmd end
] eq
{2>@
1}
399 && $err eq
{can not
find channel named
"1"}
401 # Older versions of Tcl 8.4 don't have this 2>@1 IO
402 # redirect operator. Fallback to |& cat for those.
403 # The command was not actually started, so its safe
404 # to try to start it a second time.
406 set fd
[open
[concat \
408 [lrange
$cmd 0 end-1
] \
415 fconfigure
$fd -eofchar {}
419 proc git_read
{args
} {
423 switch
-- [lindex
$args 0] {
438 set args
[lrange
$args 1 end
]
441 set cmdp
[_git_cmd
[lindex
$args 0]]
442 set args
[lrange
$args 1 end
]
444 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
447 proc git_write
{args
} {
451 switch
-- [lindex
$args 0] {
462 set args
[lrange
$args 1 end
]
465 set cmdp
[_git_cmd
[lindex
$args 0]]
466 set args
[lrange
$args 1 end
]
468 _trace_exec
[concat
$opt $cmdp $args]
469 return [open
[concat
[list |
] $opt $cmdp $args] w
]
472 proc githook_read
{hook_name args
} {
473 set pchook
[gitdir hooks
$hook_name]
476 # On Windows [file executable] might lie so we need to ask
477 # the shell if the hook is executable. Yes that's annoying.
481 if {![info exists interp
]} {
482 set interp
[_which sh
]
485 error
"hook execution requires sh (not in PATH)"
488 set scr
{if test -x "$1";then exec "$@";fi}
489 set sh_c
[list
$interp -c $scr $interp $pchook]
490 return [_open_stdout_stderr
[concat
$sh_c $args]]
493 if {[file executable
$pchook]} {
494 return [_open_stdout_stderr
[concat
[list
$pchook] $args]]
500 proc kill_file_process
{fd
} {
501 set process
[pid
$fd]
505 # Use a Cygwin-specific flag to allow killing
506 # native Windows processes
507 exec kill -f $process
515 regsub
-all ' $value "'\\''" value
519 proc load_current_branch {} {
520 global current_branch is_detached
522 set fd [open [gitdir HEAD] r]
523 if {[gets $fd ref] < 1} {
528 set pfx {ref: refs/heads/}
529 set len [string length $pfx]
530 if {[string equal -length $len $pfx $ref]} {
531 # We're on a branch. It might not exist. But
532 # HEAD looks good enough to be a branch.
534 set current_branch [string range $ref $len end]
537 # Assume this is a detached head.
539 set current_branch HEAD
544 auto_load tk_optionMenu
545 rename tk_optionMenu real__tkOptionMenu
546 proc tk_optionMenu {w varName args} {
547 set m [eval real__tkOptionMenu $w $varName $args]
548 $m configure -font font_ui
549 $w configure -font font_ui
553 proc rmsel_tag {text} {
555 -background [$text cget -background] \
556 -foreground [$text cget -foreground] \
558 $text tag conf in_sel -background lightgray
559 bind $text <Motion> break
564 bind . <Visibility> {
565 bind . <Visibility> {}
570 wm iconbitmap . -default $oguilib/git-gui.ico
573 ######################################################################
578 font create font_diff -family Courier -size 10
582 eval font configure font_ui [font actual [.dummy cget -font]]
586 font create font_uiitalic
587 font create font_uibold
588 font create font_diffbold
589 font create font_diffitalic
591 foreach class {Button Checkbutton Entry Label
592 Labelframe Listbox Menu Message
593 Radiobutton Spinbox Text} {
594 option add *$class.font font_ui
598 if {[is_Windows] || [is_MacOSX]} {
599 option add *Menu.tearOff 0
610 proc bind_button3 {w cmd} {
611 bind $w <Any-Button-3> $cmd
613 # Mac OS X sends Button-2 on right click through three-button mouse,
614 # or through trackpad right-clicking (two-finger touch + click).
615 bind $w <Any-Button-2> $cmd
616 bind $w <Control-Button-1> $cmd
620 proc apply_config {} {
621 global repo_config font_descs
623 foreach option $font_descs {
624 set name [lindex $option 0]
625 set font [lindex $option 1]
628 foreach {cn cv} $repo_config(gui.$name) {
629 if {$cn eq {-weight}} {
632 font configure $font $cn $cv
635 font configure $font -weight normal
638 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
640 foreach {cn cv} [font configure $font] {
641 font configure ${font}bold $cn $cv
642 font configure ${font}italic $cn $cv
644 font configure ${font}bold -weight bold
645 font configure ${font}italic -slant italic
649 set default_config(branch.autosetupmerge) true
650 set default_config(merge.diffstat) true
651 set default_config(merge.summary) false
652 set default_config(merge.verbosity) 2
653 set default_config(user.name) {}
654 set default_config(user.email) {}
656 set default_config(gui.matchtrackingbranch) false
657 set default_config(gui.pruneduringfetch) false
658 set default_config(gui.trustmtime) false
659 set default_config(gui.fastcopyblame) false
660 set default_config(gui.copyblamethreshold) 40
661 set default_config(gui.diffcontext) 5
662 set default_config(gui.commitmsgwidth) 75
663 set default_config(gui.newbranchtemplate) {}
664 set default_config(gui.spellingdictionary) {}
665 set default_config(gui.fontui) [font configure font_ui]
666 set default_config(gui.fontdiff) [font configure font_diff]
668 {fontui font_ui {mc "Main Font
"}}
669 {fontdiff font_diff {mc "Diff
/Console Font
"}}
672 ######################################################################
676 set _git [_which git]
678 catch {wm withdraw .}
682 -title [mc "git-gui
: fatal error
"] \
683 -message [mc "Cannot
find git
in PATH.
"]
687 ######################################################################
691 if {[catch {set _git_version [git --version]} err]} {
692 catch {wm withdraw .}
696 -title [mc "git-gui
: fatal error
"] \
697 -message "Cannot determine Git version
:
701 [appname
] requires Git
1.5.0 or later.
"
704 if {![regsub {^git version } $_git_version {} _git_version]} {
705 catch {wm withdraw .}
709 -title [mc "git-gui
: fatal error
"] \
710 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
714 set _real_git_version $_git_version
715 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
716 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
717 regsub {\.rc[0-9]+$} $_git_version {} _git_version
718 regsub {\.GIT$} $_git_version {} _git_version
719 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
721 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
722 catch {wm withdraw .}
727 -title "[appname
]: warning
" \
728 -message [mc "Git version cannot be determined.
730 %s claims it is version
'%s'.
732 %s requires
at least Git
1.5.0 or later.
734 Assume
'%s' is version
1.5.0?
735 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
736 set _git_version 1.5.0
741 unset _real_git_version
743 proc git-version {args} {
746 switch [llength $args] {
752 set op [lindex $args 0]
753 set vr [lindex $args 1]
754 set cm [package vcompare $_git_version $vr]
755 return [expr $cm $op 0]
759 set type [lindex $args 0]
760 set name [lindex $args 1]
761 set parm [lindex $args 2]
762 set body [lindex $args 3]
764 if {($type ne {proc} && $type ne {method})} {
765 error "Invalid arguments to git-version
"
767 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
768 error "Last arm of
$type $name must be default
"
771 foreach {op vr cb} [lrange $body 0 end-2] {
772 if {[git-version $op $vr]} {
773 return [uplevel [list $type $name $parm $cb]]
777 return [uplevel [list $type $name $parm [lindex $body end]]]
781 error "git-version
>= x
"
787 if {[git-version < 1.5]} {
788 catch {wm withdraw .}
792 -title [mc "git-gui
: fatal error
"] \
793 -message "[appname
] requires Git
1.5.0 or later.
795 You are using
[git-version
]:
801 ######################################################################
803 ## configure our library
805 set idx [file join $oguilib tclIndex]
806 if {[catch {set fd [open $idx r]} err]} {
807 catch {wm withdraw .}
811 -title [mc "git-gui
: fatal error
"] \
815 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
817 while {[gets $fd n] >= 0} {
818 if {$n ne {} && ![string match #* $n]} {
830 if {[lsearch -exact $loaded $p] >= 0} continue
831 source [file join $oguilib $p]
836 set auto_path [concat [list $oguilib] $auto_path]
838 unset -nocomplain idx fd
840 ######################################################################
842 ## config file parsing
844 git-version proc _parse_config {arr_name args} {
851 [list git_read config] \
853 [list --null --list]]
854 fconfigure $fd_rc -translation binary
855 set buf [read $fd_rc]
858 foreach line [split $buf "\
0"] {
859 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
860 if {[is_many_config $name]} {
861 lappend arr($name) $value
863 set arr($name) $value
872 set fd_rc [eval [list git_read config --list] $args]
873 while {[gets $fd_rc line] >= 0} {
874 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
875 if {[is_many_config $name]} {
876 lappend arr($name) $value
878 set arr($name) $value
887 proc load_config {include_global} {
888 global repo_config global_config default_config
890 if {$include_global} {
891 _parse_config global_config --global
893 _parse_config repo_config
895 foreach name [array names default_config] {
896 if {[catch {set v $global_config($name)}]} {
897 set global_config($name) $default_config($name)
899 if {[catch {set v $repo_config($name)}]} {
900 set repo_config($name) $default_config($name)
905 ######################################################################
907 ## feature option selection
909 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
914 if {$subcommand eq {gui.sh}} {
917 if {$subcommand eq {gui} && [llength $argv] > 0} {
918 set subcommand [lindex $argv 0]
919 set argv [lrange $argv 1 end]
922 enable_option multicommit
924 enable_option transport
927 switch -- $subcommand {
932 disable_option multicommit
933 disable_option branch
934 disable_option transport
937 enable_option singlecommit
939 disable_option multicommit
940 disable_option branch
941 disable_option transport
945 ######################################################################
950 set _gitdir $env(GIT_DIR)
954 set _gitdir [git rev-parse --git-dir]
955 set _prefix [git rev-parse --show-prefix]
959 choose_repository::pick
961 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
962 catch {set _gitdir [exec cygpath --windows $_gitdir]}
964 if {![file isdirectory $_gitdir]} {
965 catch {wm withdraw .}
966 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
969 if {$_prefix ne {}} {
970 regsub -all {[^/]+/} $_prefix ../ cdup
971 if {[catch {cd $cdup} err]} {
972 catch {wm withdraw .}
973 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
977 } elseif {![is_enabled bare]} {
978 if {[lindex [file split $_gitdir] end] ne {.git}} {
979 catch {wm withdraw .}
980 error_popup [strcat [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
983 if {[catch {cd [file dirname $_gitdir]} err]} {
984 catch {wm withdraw .}
985 error_popup [strcat [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
989 set _reponame [file split [file normalize $_gitdir]]
990 if {[lindex $_reponame end] eq {.git}} {
991 set _reponame [lindex $_reponame end-1]
993 set _reponame [lindex $_reponame end]
996 ######################################################################
1000 set current_diff_path {}
1001 set current_diff_side {}
1002 set diff_actions [list]
1006 set MERGE_HEAD [list]
1009 set current_branch {}
1011 set current_diff_path {}
1013 set selected_commit_type new
1015 ######################################################################
1023 set disable_on_lock [list]
1024 set index_lock_type none
1026 proc lock_index {type} {
1027 global index_lock_type disable_on_lock
1029 if {$index_lock_type eq {none}} {
1030 set index_lock_type $type
1031 foreach w $disable_on_lock {
1032 uplevel #0 $w disabled
1035 } elseif {$index_lock_type eq "begin-
$type"} {
1036 set index_lock_type $type
1042 proc unlock_index {} {
1043 global index_lock_type disable_on_lock
1045 set index_lock_type none
1046 foreach w $disable_on_lock {
1047 uplevel #0 $w normal
1051 ######################################################################
1055 proc repository_state {ctvar hdvar mhvar} {
1056 global current_branch
1057 upvar $ctvar ct $hdvar hd $mhvar mh
1062 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1068 set merge_head [gitdir MERGE_HEAD]
1069 if {[file exists $merge_head]} {
1071 set fd_mh [open $merge_head r]
1072 while {[gets $fd_mh line] >= 0} {
1083 global PARENT empty_tree
1085 set p [lindex $PARENT 0]
1089 if {$empty_tree eq {}} {
1090 set empty_tree [git mktree << {}]
1095 proc rescan {after {honor_trustmtime 1}} {
1096 global HEAD PARENT MERGE_HEAD commit_type
1097 global ui_index ui_workdir ui_comm
1098 global rescan_active file_states
1101 if {$rescan_active > 0 || ![lock_index read]} return
1103 repository_state newType newHEAD newMERGE_HEAD
1104 if {[string match amend* $commit_type]
1105 && $newType eq {normal}
1106 && $newHEAD eq $HEAD} {
1110 set MERGE_HEAD $newMERGE_HEAD
1111 set commit_type $newType
1114 array unset file_states
1116 if {!$::GITGUI_BCK_exists &&
1117 (![$ui_comm edit modified]
1118 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1119 if {[string match amend* $commit_type]} {
1120 } elseif {[load_message GITGUI_MSG]} {
1121 } elseif {[load_message MERGE_MSG]} {
1122 } elseif {[load_message SQUASH_MSG]} {
1125 $ui_comm edit modified false
1128 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1129 rescan_stage2 {} $after
1132 ui_status [mc "Refreshing
file status...
"]
1133 set fd_rf [git_read update-index \
1139 fconfigure $fd_rf -blocking 0 -translation binary
1140 fileevent $fd_rf readable \
1141 [list rescan_stage2 $fd_rf $after]
1146 set is_git_info_exclude {}
1147 proc have_info_exclude {} {
1148 global is_git_info_exclude
1150 if {$is_git_info_exclude eq {}} {
1151 if {[catch {exec test -f [gitdir info exclude]}]} {
1152 set is_git_info_exclude 0
1154 set is_git_info_exclude 1
1157 return $is_git_info_exclude
1160 proc have_info_exclude {} {
1161 return [file readable [gitdir info exclude]]
1165 proc rescan_stage2 {fd after} {
1166 global rescan_active buf_rdi buf_rdf buf_rlo
1170 if {![eof $fd]} return
1174 set ls_others [list --exclude-per-directory=.gitignore]
1175 if {[have_info_exclude]} {
1176 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1178 set user_exclude [get_config core.excludesfile]
1179 if {$user_exclude ne {} && [file readable $user_exclude]} {
1180 lappend ls_others "--exclude-from=$user_exclude"
1188 ui_status [mc "Scanning
for modified files ...
"]
1189 set fd_di [git_read diff-index --cached -z [PARENT]]
1190 set fd_df [git_read diff-files -z]
1191 set fd_lo [eval git_read ls-files --others -z $ls_others]
1193 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1194 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1195 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1196 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1197 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1198 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1201 proc load_message {file} {
1204 set f [gitdir $file]
1205 if {[file isfile $f]} {
1206 if {[catch {set fd [open $f r]}]} {
1209 fconfigure $fd -eofchar {}
1210 set content [string trim [read $fd]]
1212 regsub -all -line {[ \r\t]+$} $content {} content
1213 $ui_comm delete 0.0 end
1214 $ui_comm insert end $content
1220 proc read_diff_index {fd after} {
1223 append buf_rdi [read $fd]
1225 set n [string length $buf_rdi]
1227 set z1 [string first "\
0" $buf_rdi $c]
1228 if {$z1 == -1} break
1230 set z2 [string first "\
0" $buf_rdi $z1]
1231 if {$z2 == -1} break
1234 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1235 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1237 [encoding convertfrom $p] \
1239 [list [lindex $i 0] [lindex $i 2]] \
1245 set buf_rdi [string range $buf_rdi $c end]
1250 rescan_done $fd buf_rdi $after
1253 proc read_diff_files {fd after} {
1256 append buf_rdf [read $fd]
1258 set n [string length $buf_rdf]
1260 set z1 [string first "\
0" $buf_rdf $c]
1261 if {$z1 == -1} break
1263 set z2 [string first "\
0" $buf_rdf $z1]
1264 if {$z2 == -1} break
1267 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1268 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1270 [encoding convertfrom $p] \
1273 [list [lindex $i 0] [lindex $i 2]]
1278 set buf_rdf [string range $buf_rdf $c end]
1283 rescan_done $fd buf_rdf $after
1286 proc read_ls_others {fd after} {
1289 append buf_rlo [read $fd]
1290 set pck [split $buf_rlo "\
0"]
1291 set buf_rlo [lindex $pck end]
1292 foreach p [lrange $pck 0 end-1] {
1293 set p [encoding convertfrom $p]
1294 if {[string index $p end] eq {/}} {
1295 set p [string range $p 0 end-1]
1299 rescan_done $fd buf_rlo $after
1302 proc rescan_done {fd buf after} {
1303 global rescan_active current_diff_path
1304 global file_states repo_config
1307 if {![eof $fd]} return
1310 if {[incr rescan_active -1] > 0} return
1315 if {$current_diff_path ne {}} reshow_diff
1319 proc prune_selection {} {
1320 global file_states selected_paths
1322 foreach path [array names selected_paths] {
1323 if {[catch {set still_here $file_states($path)}]} {
1324 unset selected_paths($path)
1329 ######################################################################
1333 proc mapicon {w state path} {
1336 if {[catch {set r $all_icons($state$w)}]} {
1337 puts "error
: no icon
for $w state
={$state} $path"
1343 proc mapdesc {state path} {
1346 if {[catch {set r $all_descs($state)}]} {
1347 puts "error
: no desc
for state
={$state} $path"
1353 proc ui_status {msg} {
1355 if {[info exists main_status]} {
1356 $main_status show $msg
1360 proc ui_ready {{test {}}} {
1362 if {[info exists main_status]} {
1363 $main_status show [mc "Ready.
"] $test
1367 proc escape_path {path} {
1368 regsub -all {\\} $path "\\\\" path
1369 regsub -all "\n" $path "\\n
" path
1373 proc short_path {path} {
1374 return [escape_path [lindex [file split $path] end]]
1378 set null_sha1 [string repeat 0 40]
1380 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1381 global file_states next_icon_id null_sha1
1383 set s0 [string index $new_state 0]
1384 set s1 [string index $new_state 1]
1386 if {[catch {set info $file_states($path)}]} {
1388 set icon n[incr next_icon_id]
1390 set state [lindex $info 0]
1391 set icon [lindex $info 1]
1392 if {$head_info eq {}} {set head_info [lindex $info 2]}
1393 if {$index_info eq {}} {set index_info [lindex $info 3]}
1396 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1397 elseif {$s0 eq {_}} {set s0 _}
1399 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1400 elseif {$s1 eq {_}} {set s1 _}
1402 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1403 set head_info [list 0 $null_sha1]
1404 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1405 && $head_info eq {}} {
1406 set head_info $index_info
1409 set file_states($path) [list $s0$s1 $icon \
1410 $head_info $index_info \
1415 proc display_file_helper {w path icon_name old_m new_m} {
1418 if {$new_m eq {_}} {
1419 set lno [lsearch -sorted -exact $file_lists($w) $path]
1421 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1423 $w conf -state normal
1424 $w delete $lno.0 [expr {$lno + 1}].0
1425 $w conf -state disabled
1427 } elseif {$old_m eq {_} && $new_m ne {_}} {
1428 lappend file_lists($w) $path
1429 set file_lists($w) [lsort -unique $file_lists($w)]
1430 set lno [lsearch -sorted -exact $file_lists($w) $path]
1432 $w conf -state normal
1433 $w image create $lno.0 \
1434 -align center -padx 5 -pady 1 \
1436 -image [mapicon $w $new_m $path]
1437 $w insert $lno.1 "[escape_path
$path]\n"
1438 $w conf -state disabled
1439 } elseif {$old_m ne $new_m} {
1440 $w conf -state normal
1441 $w image conf $icon_name -image [mapicon $w $new_m $path]
1442 $w conf -state disabled
1446 proc display_file {path state} {
1447 global file_states selected_paths
1448 global ui_index ui_workdir
1450 set old_m [merge_state $path $state]
1451 set s $file_states($path)
1452 set new_m [lindex $s 0]
1453 set icon_name [lindex $s 1]
1455 set o [string index $old_m 0]
1456 set n [string index $new_m 0]
1463 display_file_helper $ui_index $path $icon_name $o $n
1465 if {[string index $old_m 0] eq {U}} {
1468 set o [string index $old_m 1]
1470 if {[string index $new_m 0] eq {U}} {
1473 set n [string index $new_m 1]
1475 display_file_helper $ui_workdir $path $icon_name $o $n
1477 if {$new_m eq {__}} {
1478 unset file_states($path)
1479 catch {unset selected_paths($path)}
1483 proc display_all_files_helper {w path icon_name m} {
1486 lappend file_lists($w) $path
1487 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1488 $w image create end \
1489 -align center -padx 5 -pady 1 \
1491 -image [mapicon $w $m $path]
1492 $w insert end "[escape_path
$path]\n"
1495 proc display_all_files {} {
1496 global ui_index ui_workdir
1497 global file_states file_lists
1500 $ui_index conf -state normal
1501 $ui_workdir conf -state normal
1503 $ui_index delete 0.0 end
1504 $ui_workdir delete 0.0 end
1507 set file_lists($ui_index) [list]
1508 set file_lists($ui_workdir) [list]
1510 foreach path [lsort [array names file_states]] {
1511 set s $file_states($path)
1513 set icon_name [lindex $s 1]
1515 set s [string index $m 0]
1516 if {$s ne {U} && $s ne {_}} {
1517 display_all_files_helper $ui_index $path \
1521 if {[string index $m 0] eq {U}} {
1524 set s [string index $m 1]
1527 display_all_files_helper $ui_workdir $path \
1532 $ui_index conf -state disabled
1533 $ui_workdir conf -state disabled
1536 ######################################################################
1541 #define mask_width 14
1542 #define mask_height 15
1543 static unsigned char mask_bits[] = {
1544 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1545 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1546 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1549 image create bitmap file_plain -background white -foreground black -data {
1550 #define plain_width 14
1551 #define plain_height 15
1552 static unsigned char plain_bits[] = {
1553 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1554 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1555 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1556 } -maskdata $filemask
1558 image create bitmap file_mod -background white -foreground blue -data {
1559 #define mod_width 14
1560 #define mod_height 15
1561 static unsigned char mod_bits[] = {
1562 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1563 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1564 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1565 } -maskdata $filemask
1567 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1568 #define file_fulltick_width 14
1569 #define file_fulltick_height 15
1570 static unsigned char file_fulltick_bits
[] = {
1571 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1572 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1573 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1574 } -maskdata $filemask
1576 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1577 #define parttick_width 14
1578 #define parttick_height 15
1579 static unsigned char parttick_bits
[] = {
1580 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1581 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1582 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1583 } -maskdata $filemask
1585 image create bitmap file_question
-background white
-foreground black
-data {
1586 #define file_question_width 14
1587 #define file_question_height 15
1588 static unsigned char file_question_bits
[] = {
1589 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1590 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1591 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1592 } -maskdata $filemask
1594 image create bitmap file_removed
-background white
-foreground red
-data {
1595 #define file_removed_width 14
1596 #define file_removed_height 15
1597 static unsigned char file_removed_bits
[] = {
1598 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1599 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1600 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1601 } -maskdata $filemask
1603 image create bitmap file_merge
-background white
-foreground blue
-data {
1604 #define file_merge_width 14
1605 #define file_merge_height 15
1606 static unsigned char file_merge_bits
[] = {
1607 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1608 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1609 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1610 } -maskdata $filemask
1612 set ui_index .vpane.files.index.list
1613 set ui_workdir .vpane.files.workdir.list
1615 set all_icons
(_
$ui_index) file_plain
1616 set all_icons
(A
$ui_index) file_fulltick
1617 set all_icons
(M
$ui_index) file_fulltick
1618 set all_icons
(D
$ui_index) file_removed
1619 set all_icons
(U
$ui_index) file_merge
1621 set all_icons
(_
$ui_workdir) file_plain
1622 set all_icons
(M
$ui_workdir) file_mod
1623 set all_icons
(D
$ui_workdir) file_question
1624 set all_icons
(U
$ui_workdir) file_merge
1625 set all_icons
(O
$ui_workdir) file_plain
1627 set max_status_desc
0
1629 {__
{mc
"Unmodified"}}
1631 {_M
{mc
"Modified, not staged"}}
1632 {M_
{mc
"Staged for commit"}}
1633 {MM
{mc
"Portions staged for commit"}}
1634 {MD
{mc
"Staged for commit, missing"}}
1636 {_O
{mc
"Untracked, not staged"}}
1637 {A_
{mc
"Staged for commit"}}
1638 {AM
{mc
"Portions staged for commit"}}
1639 {AD
{mc
"Staged for commit, missing"}}
1642 {D_
{mc
"Staged for removal"}}
1643 {DO
{mc
"Staged for removal, still present"}}
1645 {U_
{mc
"Requires merge resolution"}}
1646 {UU
{mc
"Requires merge resolution"}}
1647 {UM
{mc
"Requires merge resolution"}}
1648 {UD
{mc
"Requires merge resolution"}}
1650 set text
[eval [lindex
$i 1]]
1651 if {$max_status_desc < [string length
$text]} {
1652 set max_status_desc
[string length
$text]
1654 set all_descs
([lindex
$i 0]) $text
1658 ######################################################################
1662 proc scrollbar2many
{list mode args
} {
1663 foreach w
$list {eval $w $mode $args}
1666 proc many2scrollbar
{list mode sb top bottom
} {
1667 $sb set $top $bottom
1668 foreach w
$list {$w $mode moveto
$top}
1671 proc incr_font_size
{font
{amt
1}} {
1672 set sz
[font configure
$font -size]
1674 font configure
$font -size $sz
1675 font configure
${font}bold
-size $sz
1676 font configure
${font}italic
-size $sz
1679 ######################################################################
1683 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1685 proc do_gitk
{revs
} {
1686 # -- Always start gitk through whatever we were loaded with. This
1687 # lets us bypass using shell process on Windows systems.
1689 set exe
[file join [file dirname $
::_git
] gitk
]
1690 set cmd
[list
[info nameofexecutable
] $exe]
1691 if {! [file exists
$exe]} {
1692 error_popup
[mc
"Unable to start gitk:\n\n%s does not exist" $exe]
1696 if {[info exists env
(GIT_DIR
)]} {
1697 set old_GIT_DIR
$env(GIT_DIR
)
1703 cd [file dirname [gitdir
]]
1704 set env
(GIT_DIR
) [file tail [gitdir
]]
1706 eval exec $cmd $revs &
1708 if {$old_GIT_DIR eq
{}} {
1711 set env
(GIT_DIR
) $old_GIT_DIR
1715 ui_status $
::starting_gitk_msg
1717 ui_ready
$starting_gitk_msg
1725 global ui_comm is_quitting repo_config commit_type
1726 global GITGUI_BCK_exists GITGUI_BCK_i
1727 global ui_comm_spell
1729 if {$is_quitting} return
1732 if {[winfo exists
$ui_comm]} {
1733 # -- Stash our current commit buffer.
1735 set save
[gitdir GITGUI_MSG
]
1736 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1737 file rename
-force [gitdir GITGUI_BCK
] $save
1738 set GITGUI_BCK_exists
0
1740 set msg
[string trim
[$ui_comm get
0.0 end
]]
1741 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1742 if {(![string match amend
* $commit_type]
1743 ||
[$ui_comm edit modified
])
1746 set fd
[open
$save w
]
1747 puts
-nonewline $fd $msg
1751 catch
{file delete
$save}
1755 # -- Cancel our spellchecker if its running.
1757 if {[info exists ui_comm_spell
]} {
1761 # -- Remove our editor backup, its not needed.
1763 after cancel
$GITGUI_BCK_i
1764 if {$GITGUI_BCK_exists} {
1765 catch
{file delete
[gitdir GITGUI_BCK
]}
1768 # -- Stash our current window geometry into this repository.
1770 set cfg_geometry
[list
]
1771 lappend cfg_geometry
[wm geometry .
]
1772 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
1773 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
1774 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1777 if {$cfg_geometry ne
$rc_geometry} {
1778 catch
{git config gui.geometry
$cfg_geometry}
1794 global next_diff_p next_diff_w next_diff_i
1795 show_diff
$next_diff_p $next_diff_w $next_diff_i
1798 proc toggle_or_diff
{w x y
} {
1799 global file_states file_lists current_diff_path ui_index ui_workdir
1800 global last_clicked selected_paths
1802 set pos
[split [$w index @
$x,$y] .
]
1803 set lno
[lindex
$pos 0]
1804 set col [lindex
$pos 1]
1805 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1811 set last_clicked
[list
$w $lno]
1812 array
unset selected_paths
1813 $ui_index tag remove in_sel
0.0 end
1814 $ui_workdir tag remove in_sel
0.0 end
1816 if {$col == 0 && $y > 1} {
1817 set i
[expr {$lno-1}]
1818 set ll
[expr {[llength
$file_lists($w)]-1}]
1820 if {$i == $ll && $i == 0} {
1821 set after
{reshow_diff
;}
1823 global next_diff_p next_diff_w next_diff_i
1828 set i
[expr {$i + 1}]
1832 set i
[expr {$i - 1}]
1835 set next_diff_p
[lindex
$file_lists($w) $i]
1837 if {$next_diff_p ne
{} && $current_diff_path ne
{}} {
1838 set after
{next_diff
;}
1844 if {$w eq
$ui_index} {
1846 "Unstaging [short_path $path] from commit" \
1848 [concat
$after [list ui_ready
]]
1849 } elseif
{$w eq
$ui_workdir} {
1851 "Adding [short_path $path]" \
1853 [concat
$after [list ui_ready
]]
1856 show_diff
$path $w $lno
1860 proc add_one_to_selection
{w x y
} {
1861 global file_lists last_clicked selected_paths
1863 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1864 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1870 if {$last_clicked ne
{}
1871 && [lindex
$last_clicked 0] ne
$w} {
1872 array
unset selected_paths
1873 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1876 set last_clicked
[list
$w $lno]
1877 if {[catch
{set in_sel
$selected_paths($path)}]} {
1881 unset selected_paths
($path)
1882 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1884 set selected_paths
($path) 1
1885 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1889 proc add_range_to_selection
{w x y
} {
1890 global file_lists last_clicked selected_paths
1892 if {[lindex
$last_clicked 0] ne
$w} {
1893 toggle_or_diff
$w $x $y
1897 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1898 set lc
[lindex
$last_clicked 1]
1907 foreach path
[lrange
$file_lists($w) \
1908 [expr {$begin - 1}] \
1909 [expr {$end - 1}]] {
1910 set selected_paths
($path) 1
1912 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1915 proc show_more_context
{} {
1917 if {$repo_config(gui.diffcontext
) < 99} {
1918 incr repo_config
(gui.diffcontext
)
1923 proc show_less_context
{} {
1925 if {$repo_config(gui.diffcontext
) >= 1} {
1926 incr repo_config
(gui.diffcontext
) -1
1931 ######################################################################
1941 menu .mbar
-tearoff 0
1942 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
1943 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
1944 if {[is_enabled branch
]} {
1945 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
1947 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1948 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
1950 if {[is_enabled transport
]} {
1951 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
1952 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
1954 . configure
-menu .mbar
1956 # -- Repository Menu
1958 menu .mbar.repository
1960 .mbar.repository add
command \
1961 -label [mc
"Browse Current Branch's Files"] \
1962 -command {browser
::new
$current_branch}
1963 set ui_browse_current
[.mbar.repository index last
]
1964 .mbar.repository add
command \
1965 -label [mc
"Browse Branch Files..."] \
1966 -command browser_open
::dialog
1967 .mbar.repository add separator
1969 .mbar.repository add
command \
1970 -label [mc
"Visualize Current Branch's History"] \
1971 -command {do_gitk
$current_branch}
1972 set ui_visualize_current
[.mbar.repository index last
]
1973 .mbar.repository add
command \
1974 -label [mc
"Visualize All Branch History"] \
1975 -command {do_gitk
--all}
1976 .mbar.repository add separator
1978 proc current_branch_write
{args
} {
1979 global current_branch
1980 .mbar.repository entryconf $
::ui_browse_current \
1981 -label [mc
"Browse %s's Files" $current_branch]
1982 .mbar.repository entryconf $
::ui_visualize_current \
1983 -label [mc
"Visualize %s's History" $current_branch]
1985 trace add variable current_branch
write current_branch_write
1987 if {[is_enabled multicommit
]} {
1988 .mbar.repository add
command -label [mc
"Database Statistics"] \
1991 .mbar.repository add
command -label [mc
"Compress Database"] \
1994 .mbar.repository add
command -label [mc
"Verify Database"] \
1995 -command do_fsck_objects
1997 .mbar.repository add separator
2000 .mbar.repository add
command \
2001 -label [mc
"Create Desktop Icon"] \
2002 -command do_cygwin_shortcut
2003 } elseif
{[is_Windows
]} {
2004 .mbar.repository add
command \
2005 -label [mc
"Create Desktop Icon"] \
2006 -command do_windows_shortcut
2007 } elseif
{[is_MacOSX
]} {
2008 .mbar.repository add
command \
2009 -label [mc
"Create Desktop Icon"] \
2010 -command do_macosx_app
2015 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2017 .mbar.repository add
command -label [mc Quit
] \
2025 .mbar.edit add
command -label [mc Undo
] \
2026 -command {catch
{[focus
] edit undo
}} \
2028 .mbar.edit add
command -label [mc Redo
] \
2029 -command {catch
{[focus
] edit redo
}} \
2031 .mbar.edit add separator
2032 .mbar.edit add
command -label [mc Cut
] \
2033 -command {catch
{tk_textCut
[focus
]}} \
2035 .mbar.edit add
command -label [mc Copy
] \
2036 -command {catch
{tk_textCopy
[focus
]}} \
2038 .mbar.edit add
command -label [mc Paste
] \
2039 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2041 .mbar.edit add
command -label [mc Delete
] \
2042 -command {catch
{[focus
] delete sel.first sel.last
}} \
2044 .mbar.edit add separator
2045 .mbar.edit add
command -label [mc
"Select All"] \
2046 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2051 if {[is_enabled branch
]} {
2054 .mbar.branch add
command -label [mc
"Create..."] \
2055 -command branch_create
::dialog \
2057 lappend disable_on_lock
[list .mbar.branch entryconf \
2058 [.mbar.branch index last
] -state]
2060 .mbar.branch add
command -label [mc
"Checkout..."] \
2061 -command branch_checkout
::dialog \
2063 lappend disable_on_lock
[list .mbar.branch entryconf \
2064 [.mbar.branch index last
] -state]
2066 .mbar.branch add
command -label [mc
"Rename..."] \
2067 -command branch_rename
::dialog
2068 lappend disable_on_lock
[list .mbar.branch entryconf \
2069 [.mbar.branch index last
] -state]
2071 .mbar.branch add
command -label [mc
"Delete..."] \
2072 -command branch_delete
::dialog
2073 lappend disable_on_lock
[list .mbar.branch entryconf \
2074 [.mbar.branch index last
] -state]
2076 .mbar.branch add
command -label [mc
"Reset..."] \
2077 -command merge
::reset_hard
2078 lappend disable_on_lock
[list .mbar.branch entryconf \
2079 [.mbar.branch index last
] -state]
2084 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2087 .mbar.commit add radiobutton \
2088 -label [mc
"New Commit"] \
2089 -command do_select_commit_type \
2090 -variable selected_commit_type \
2092 lappend disable_on_lock \
2093 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2095 .mbar.commit add radiobutton \
2096 -label [mc
"Amend Last Commit"] \
2097 -command do_select_commit_type \
2098 -variable selected_commit_type \
2100 lappend disable_on_lock \
2101 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2103 .mbar.commit add separator
2105 .mbar.commit add
command -label [mc Rescan
] \
2106 -command do_rescan \
2108 lappend disable_on_lock \
2109 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2111 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2112 -command do_add_selection \
2114 lappend disable_on_lock \
2115 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2117 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2118 -command do_add_all \
2120 lappend disable_on_lock \
2121 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2123 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2124 -command do_unstage_selection
2125 lappend disable_on_lock \
2126 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2128 .mbar.commit add
command -label [mc
"Revert Changes"] \
2129 -command do_revert_selection
2130 lappend disable_on_lock \
2131 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2133 .mbar.commit add separator
2135 .mbar.commit add
command -label [mc
"Show Less Context"] \
2136 -command show_less_context \
2137 -accelerator $M1T-\
-
2139 .mbar.commit add
command -label [mc
"Show More Context"] \
2140 -command show_more_context \
2143 .mbar.commit add separator
2145 .mbar.commit add
command -label [mc
"Sign Off"] \
2146 -command do_signoff \
2149 .mbar.commit add
command -label [mc Commit@@verb
] \
2150 -command do_commit \
2151 -accelerator $M1T-Return
2152 lappend disable_on_lock \
2153 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2158 if {[is_enabled branch
]} {
2160 .mbar.merge add
command -label [mc
"Local Merge..."] \
2161 -command merge
::dialog \
2163 lappend disable_on_lock \
2164 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2165 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2166 -command merge
::reset_hard
2167 lappend disable_on_lock \
2168 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2173 if {[is_enabled transport
]} {
2176 .mbar.remote add
command \
2177 -label [mc
"Push..."] \
2178 -command do_push_anywhere \
2180 .mbar.remote add
command \
2181 -label [mc
"Delete..."] \
2182 -command remote_branch_delete
::dialog
2186 # -- Apple Menu (Mac OS X only)
2188 .mbar add cascade
-label Apple
-menu .mbar.apple
2191 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2193 .mbar.apple add separator
2194 .mbar.apple add
command \
2195 -label [mc
"Preferences..."] \
2196 -command do_options \
2198 bind .
<$M1B-,> do_options
2202 .mbar.edit add separator
2203 .mbar.edit add
command -label [mc
"Options..."] \
2209 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2213 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2218 catch
{set browser
$repo_config(instaweb.browser
)}
2219 set doc_path
[file dirname [gitexec
]]
2220 set doc_path
[file join $doc_path Documentation index.html
]
2223 set doc_path
[exec cygpath
--mixed $doc_path]
2226 if {$browser eq
{}} {
2229 } elseif
{[is_Cygwin
]} {
2230 set program_files
[file dirname [exec cygpath
--windir]]
2231 set program_files
[file join $program_files {Program Files
}]
2232 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
2233 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
2234 if {[file exists
$firefox]} {
2235 set browser
$firefox
2236 } elseif
{[file exists
$ie]} {
2239 unset program_files firefox ie
2243 if {[file isfile
$doc_path]} {
2244 set doc_url
"file:$doc_path"
2246 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2249 if {$browser ne
{}} {
2250 .mbar.
help add
command -label [mc
"Online Documentation"] \
2251 -command [list
exec $browser $doc_url &]
2253 unset browser doc_path doc_url
2255 # -- Standard bindings
2257 wm protocol . WM_DELETE_WINDOW do_quit
2258 bind all
<$M1B-Key-q> do_quit
2259 bind all
<$M1B-Key-Q> do_quit
2260 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2261 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2263 set subcommand_args
{}
2265 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2269 # -- Not a normal commit type invocation? Do that instead!
2271 switch
-- $subcommand {
2274 set subcommand_args
{rev? path
}
2275 if {$argv eq
{}} usage
2280 if {$is_path ||
[file exists
$_prefix$a]} {
2281 if {$path ne
{}} usage
2284 } elseif
{$a eq
{--}} {
2286 if {$head ne
{}} usage
2291 } elseif
{$head eq
{}} {
2292 if {$head ne
{}} usage
2301 if {$head ne
{} && $path eq
{}} {
2302 set path
$_prefix$head
2309 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2311 set head [git rev-parse
--verify $head]
2317 set current_branch
$head
2320 switch
-- $subcommand {
2323 if {$path ne
{} && [file isdirectory
$path]} {
2324 set head $current_branch
2330 browser
::new
$head $path
2333 if {$head eq
{} && ![file exists
$path]} {
2334 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2337 blame
::new
$head $path
2344 if {[llength
$argv] != 0} {
2345 puts
-nonewline stderr
"usage: $argv0"
2346 if {$subcommand ne
{gui
}
2347 && [file tail $argv0] ne
"git-$subcommand"} {
2348 puts
-nonewline stderr
" $subcommand"
2353 # fall through to setup UI for commits
2356 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2367 -text [mc
"Current Branch:"] \
2371 -textvariable current_branch \
2374 pack .branch.l1
-side left
2375 pack .branch.cb
-side left
-fill x
2376 pack .branch
-side top
-fill x
2378 # -- Main Window Layout
2380 panedwindow .vpane
-orient horizontal
2381 panedwindow .vpane.files
-orient vertical
2382 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2383 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2385 # -- Index File List
2387 frame .vpane.files.index
-height 100 -width 200
2388 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Commit)"] \
2389 -background lightgreen
-foreground black
2390 text
$ui_index -background white
-foreground black \
2392 -width 20 -height 10 \
2394 -cursor $cursor_ptr \
2395 -xscrollcommand {.vpane.files.index.sx
set} \
2396 -yscrollcommand {.vpane.files.index.sy
set} \
2398 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2399 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2400 pack .vpane.files.index.title
-side top
-fill x
2401 pack .vpane.files.index.sx
-side bottom
-fill x
2402 pack .vpane.files.index.sy
-side right
-fill y
2403 pack
$ui_index -side left
-fill both
-expand 1
2405 # -- Working Directory File List
2407 frame .vpane.files.workdir
-height 100 -width 200
2408 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
2409 -background lightsalmon
-foreground black
2410 text
$ui_workdir -background white
-foreground black \
2412 -width 20 -height 10 \
2414 -cursor $cursor_ptr \
2415 -xscrollcommand {.vpane.files.workdir.sx
set} \
2416 -yscrollcommand {.vpane.files.workdir.sy
set} \
2418 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2419 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2420 pack .vpane.files.workdir.title
-side top
-fill x
2421 pack .vpane.files.workdir.sx
-side bottom
-fill x
2422 pack .vpane.files.workdir.sy
-side right
-fill y
2423 pack
$ui_workdir -side left
-fill both
-expand 1
2425 .vpane.files add .vpane.files.workdir
-sticky nsew
2426 .vpane.files add .vpane.files.index
-sticky nsew
2428 foreach i
[list
$ui_index $ui_workdir] {
2430 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2434 # -- Diff and Commit Area
2436 frame .vpane.lower
-height 300 -width 400
2437 frame .vpane.lower.commarea
2438 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2439 pack .vpane.lower.
diff -fill both
-expand 1
2440 pack .vpane.lower.commarea
-side bottom
-fill x
2441 .vpane add .vpane.lower
-sticky nsew
2443 # -- Commit Area Buttons
2445 frame .vpane.lower.commarea.buttons
2446 label .vpane.lower.commarea.buttons.l
-text {} \
2449 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2450 pack .vpane.lower.commarea.buttons
-side left
-fill y
2452 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2454 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2455 lappend disable_on_lock \
2456 {.vpane.lower.commarea.buttons.rescan conf
-state}
2458 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2460 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2461 lappend disable_on_lock \
2462 {.vpane.lower.commarea.buttons.incall conf
-state}
2464 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2466 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2468 button .vpane.lower.commarea.buttons.commit
-text [mc Commit@@verb
] \
2470 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2471 lappend disable_on_lock \
2472 {.vpane.lower.commarea.buttons.commit conf
-state}
2474 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2475 -command do_push_anywhere
2476 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2478 # -- Commit Message Buffer
2480 frame .vpane.lower.commarea.buffer
2481 frame .vpane.lower.commarea.buffer.header
2482 set ui_comm .vpane.lower.commarea.buffer.t
2483 set ui_coml .vpane.lower.commarea.buffer.header.l
2484 radiobutton .vpane.lower.commarea.buffer.header.new \
2485 -text [mc
"New Commit"] \
2486 -command do_select_commit_type \
2487 -variable selected_commit_type \
2489 lappend disable_on_lock \
2490 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2491 radiobutton .vpane.lower.commarea.buffer.header.amend \
2492 -text [mc
"Amend Last Commit"] \
2493 -command do_select_commit_type \
2494 -variable selected_commit_type \
2496 lappend disable_on_lock \
2497 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2501 proc trace_commit_type
{varname args
} {
2502 global ui_coml commit_type
2503 switch
-glob -- $commit_type {
2504 initial
{set txt
[mc
"Initial Commit Message:"]}
2505 amend
{set txt
[mc
"Amended Commit Message:"]}
2506 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2507 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2508 merge
{set txt
[mc
"Merge Commit Message:"]}
2509 * {set txt
[mc
"Commit Message:"]}
2511 $ui_coml conf
-text $txt
2513 trace add variable commit_type
write trace_commit_type
2514 pack
$ui_coml -side left
-fill x
2515 pack .vpane.lower.commarea.buffer.header.amend
-side right
2516 pack .vpane.lower.commarea.buffer.header.new
-side right
2518 text
$ui_comm -background white
-foreground black \
2522 -autoseparators true \
2524 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
2526 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2527 scrollbar .vpane.lower.commarea.buffer.sby \
2528 -command [list
$ui_comm yview
]
2529 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2530 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2531 pack
$ui_comm -side left
-fill y
2532 pack .vpane.lower.commarea.buffer
-side left
-fill y
2534 # -- Commit Message Buffer Context Menu
2536 set ctxm .vpane.lower.commarea.buffer.ctxm
2537 menu
$ctxm -tearoff 0
2540 -command {tk_textCut
$ui_comm}
2543 -command {tk_textCopy
$ui_comm}
2546 -command {tk_textPaste
$ui_comm}
2548 -label [mc Delete
] \
2549 -command {$ui_comm delete sel.first sel.last
}
2552 -label [mc
"Select All"] \
2553 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2555 -label [mc
"Copy All"] \
2557 $ui_comm tag add sel
0.0 end
2558 tk_textCopy
$ui_comm
2559 $ui_comm tag remove sel
0.0 end
2563 -label [mc
"Sign Off"] \
2565 set ui_comm_ctxm
$ctxm
2569 proc trace_current_diff_path
{varname args
} {
2570 global current_diff_path diff_actions file_states
2571 if {$current_diff_path eq
{}} {
2577 set p
$current_diff_path
2578 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2580 set p
[escape_path
$p]
2584 .vpane.lower.
diff.header.status configure
-text $s
2585 .vpane.lower.
diff.header.
file configure
-text $f
2586 .vpane.lower.
diff.header.path configure
-text $p
2587 foreach w
$diff_actions {
2591 trace add variable current_diff_path
write trace_current_diff_path
2593 frame .vpane.lower.
diff.header
-background gold
2594 label .vpane.lower.
diff.header.status \
2597 -width $max_status_desc \
2600 label .vpane.lower.
diff.header.
file \
2605 label .vpane.lower.
diff.header.path \
2610 pack .vpane.lower.
diff.header.status
-side left
2611 pack .vpane.lower.
diff.header.
file -side left
2612 pack .vpane.lower.
diff.header.path
-fill x
2613 set ctxm .vpane.lower.
diff.header.ctxm
2614 menu
$ctxm -tearoff 0
2622 -- $current_diff_path
2624 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2625 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2629 frame .vpane.lower.
diff.body
2630 set ui_diff .vpane.lower.
diff.body.t
2631 text
$ui_diff -background white
-foreground black \
2633 -width 80 -height 15 -wrap none \
2635 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2636 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2638 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2639 -command [list
$ui_diff xview
]
2640 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2641 -command [list
$ui_diff yview
]
2642 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2643 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2644 pack
$ui_diff -side left
-fill both
-expand 1
2645 pack .vpane.lower.
diff.header
-side top
-fill x
2646 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2648 $ui_diff tag conf d_cr
-elide true
2649 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2650 $ui_diff tag conf d_
+ -foreground {#00a000}
2651 $ui_diff tag conf d_-
-foreground red
2653 $ui_diff tag conf d_
++ -foreground {#00a000}
2654 $ui_diff tag conf d_--
-foreground red
2655 $ui_diff tag conf d_
+s \
2656 -foreground {#00a000} \
2657 -background {#e2effa}
2658 $ui_diff tag conf d_-s \
2660 -background {#e2effa}
2661 $ui_diff tag conf d_s
+ \
2662 -foreground {#00a000} \
2664 $ui_diff tag conf d_s- \
2668 $ui_diff tag conf d
<<<<<<< \
2669 -foreground orange \
2671 $ui_diff tag conf d
======= \
2672 -foreground orange \
2674 $ui_diff tag conf d
>>>>>>> \
2675 -foreground orange \
2678 $ui_diff tag raise sel
2680 # -- Diff Body Context Menu
2682 set ctxm .vpane.lower.
diff.body.ctxm
2683 menu
$ctxm -tearoff 0
2685 -label [mc
"Apply/Reverse Hunk"] \
2686 -command {apply_hunk
$cursorX $cursorY}
2687 set ui_diff_applyhunk
[$ctxm index last
]
2688 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2690 -label [mc
"Apply/Reverse Line"] \
2691 -command {apply_line
$cursorX $cursorY; do_rescan
}
2692 set ui_diff_applyline
[$ctxm index last
]
2693 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
2696 -label [mc
"Show Less Context"] \
2697 -command show_less_context
2698 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2700 -label [mc
"Show More Context"] \
2701 -command show_more_context
2702 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2705 -label [mc Refresh
] \
2706 -command reshow_diff
2707 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2710 -command {tk_textCopy
$ui_diff}
2711 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2713 -label [mc
"Select All"] \
2714 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2715 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2717 -label [mc
"Copy All"] \
2719 $ui_diff tag add sel
0.0 end
2720 tk_textCopy
$ui_diff
2721 $ui_diff tag remove sel
0.0 end
2723 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2726 -label [mc
"Decrease Font Size"] \
2727 -command {incr_font_size font_diff
-1}
2728 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2730 -label [mc
"Increase Font Size"] \
2731 -command {incr_font_size font_diff
1}
2732 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2734 $ctxm add
command -label [mc
"Options..."] \
2736 proc popup_diff_menu
{ctxm x y X Y
} {
2737 global current_diff_path file_states
2740 if {$
::ui_index eq $
::current_diff_side
} {
2741 set l
[mc
"Unstage Hunk From Commit"]
2742 set t
[mc
"Unstage Line From Commit"]
2744 set l
[mc
"Stage Hunk For Commit"]
2745 set t
[mc
"Stage Line For Commit"]
2748 ||
$current_diff_path eq
{}
2749 ||
![info exists file_states
($current_diff_path)]
2750 ||
{_O
} eq
[lindex
$file_states($current_diff_path) 0]} {
2755 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
2756 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
2757 tk_popup
$ctxm $X $Y
2759 bind_button3
$ui_diff [list popup_diff_menu
$ctxm %x
%y
%X
%Y
]
2763 set main_status
[::status_bar
::new .status
]
2764 pack .status
-anchor w
-side bottom
-fill x
2765 $main_status show
[mc
"Initializing..."]
2770 set gm
$repo_config(gui.geometry
)
2771 wm geometry .
[lindex
$gm 0]
2772 .vpane sash place
0 \
2774 [lindex
[.vpane sash coord
0] 1]
2775 .vpane.files sash place
0 \
2776 [lindex
[.vpane.files sash coord
0] 0] \
2783 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2784 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
2785 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
2786 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2787 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2788 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2789 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2790 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2791 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2792 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2793 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2794 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2795 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2796 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
2797 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
2798 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
2799 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
2800 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
2802 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2803 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2804 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2805 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2806 bind $ui_diff <$M1B-Key-v> {break}
2807 bind $ui_diff <$M1B-Key-V> {break}
2808 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2809 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2810 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2811 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2812 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2813 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2814 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2815 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2816 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2817 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2818 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2819 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2820 bind $ui_diff <Button-1
> {focus
%W
}
2822 if {[is_enabled branch
]} {
2823 bind .
<$M1B-Key-n> branch_create
::dialog
2824 bind .
<$M1B-Key-N> branch_create
::dialog
2825 bind .
<$M1B-Key-o> branch_checkout
::dialog
2826 bind .
<$M1B-Key-O> branch_checkout
::dialog
2827 bind .
<$M1B-Key-m> merge
::dialog
2828 bind .
<$M1B-Key-M> merge
::dialog
2830 if {[is_enabled transport
]} {
2831 bind .
<$M1B-Key-p> do_push_anywhere
2832 bind .
<$M1B-Key-P> do_push_anywhere
2835 bind .
<Key-F5
> do_rescan
2836 bind .
<$M1B-Key-r> do_rescan
2837 bind .
<$M1B-Key-R> do_rescan
2838 bind .
<$M1B-Key-s> do_signoff
2839 bind .
<$M1B-Key-S> do_signoff
2840 bind .
<$M1B-Key-t> do_add_selection
2841 bind .
<$M1B-Key-T> do_add_selection
2842 bind .
<$M1B-Key-i> do_add_all
2843 bind .
<$M1B-Key-I> do_add_all
2844 bind .
<$M1B-Key-minus> {show_less_context
;break}
2845 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
2846 bind .
<$M1B-Key-equal> {show_more_context
;break}
2847 bind .
<$M1B-Key-plus> {show_more_context
;break}
2848 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
2849 bind .
<$M1B-Key-Return> do_commit
2850 foreach i
[list
$ui_index $ui_workdir] {
2851 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2852 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2853 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2857 set file_lists
($ui_index) [list
]
2858 set file_lists
($ui_workdir) [list
]
2860 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2861 focus
-force $ui_comm
2863 # -- Warn the user about environmental problems. Cygwin's Tcl
2864 # does *not* pass its env array onto any processes it spawns.
2865 # This means that git processes get none of our environment.
2870 set msg
[mc
"Possible environment issues exist.
2872 The following environment variables are probably
2873 going to be ignored by any Git subprocess run
2877 foreach name
[array names env
] {
2878 switch
-regexp -- $name {
2879 {^GIT_INDEX_FILE$
} -
2880 {^GIT_OBJECT_DIRECTORY$
} -
2881 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2883 {^GIT_EXTERNAL_DIFF$
} -
2887 {^GIT_CONFIG_LOCAL$
} -
2888 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2889 append msg
" - $name\n"
2892 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2893 append msg
" - $name\n"
2895 set suggest_user
$name
2899 if {$ignored_env > 0} {
2901 This is due to a known issue with the
2902 Tcl binary distributed by Cygwin."]
2904 if {$suggest_user ne
{}} {
2907 A good replacement for %s
2908 is placing values for the user.name and
2909 user.email settings into your personal
2915 unset ignored_env msg suggest_user name
2918 # -- Only initialize complex UI if we are going to stay running.
2920 if {[is_enabled transport
]} {
2923 set n
[.mbar.remote index end
]
2926 set n
[expr {[.mbar.remote index end
] - $n}]
2928 .mbar.remote insert
$n separator
2933 if {[winfo exists
$ui_comm]} {
2934 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
2936 # -- If both our backup and message files exist use the
2937 # newer of the two files to initialize the buffer.
2939 if {$GITGUI_BCK_exists} {
2940 set m
[gitdir GITGUI_MSG
]
2941 if {[file isfile
$m]} {
2942 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
2943 catch
{file delete
[gitdir GITGUI_MSG
]}
2945 $ui_comm delete
0.0 end
2947 $ui_comm edit modified false
2948 catch
{file delete
[gitdir GITGUI_BCK
]}
2949 set GITGUI_BCK_exists
0
2955 proc backup_commit_buffer
{} {
2956 global ui_comm GITGUI_BCK_exists
2958 set m
[$ui_comm edit modified
]
2959 if {$m ||
$GITGUI_BCK_exists} {
2960 set msg
[string trim
[$ui_comm get
0.0 end
]]
2961 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2964 if {$GITGUI_BCK_exists} {
2965 catch
{file delete
[gitdir GITGUI_BCK
]}
2966 set GITGUI_BCK_exists
0
2970 set fd
[open
[gitdir GITGUI_BCK
] w
]
2971 puts
-nonewline $fd $msg
2973 set GITGUI_BCK_exists
1
2977 $ui_comm edit modified false
2980 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
2983 backup_commit_buffer
2985 # -- If the user has aspell available we can drive it
2986 # in pipe mode to spellcheck the commit message.
2988 set spell_cmd
[list |
]
2989 set spell_dict
[get_config gui.spellingdictionary
]
2990 lappend spell_cmd aspell
2991 if {$spell_dict ne
{}} {
2992 lappend spell_cmd
--master=$spell_dict
2994 lappend spell_cmd
--mode=none
2995 lappend spell_cmd
--encoding=utf-8
2996 lappend spell_cmd pipe
2997 if {$spell_dict eq
{none
}
2998 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
2999 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3001 set ui_comm_spell
[spellcheck
::init \
3007 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3010 lock_index begin-read
3011 if {![winfo ismapped .
]} {
3015 if {[is_enabled multicommit
]} {