2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 ||
test "z$*" = z--version
; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
10 exec wish
"$argv0" -- "$@"
12 set appvers
{@@GITGUI_VERSION@@
}
13 set copyright
[encoding convertfrom utf-8
{
14 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
16 This program is free software
; you can redistribute it and
/or modify
17 it under the terms of the GNU General Public License as published by
18 the Free Software Foundation
; either version
2 of the License
, or
19 (at your option
) any later version.
21 This program is distributed
in the hope that it will be useful
,
22 but WITHOUT ANY WARRANTY
; without even the implied warranty of
23 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 GNU General Public License
for more details.
26 You should have received a copy of the GNU General Public License
27 along with this program
; if not
, write to the Free Software
28 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}]
30 ######################################################################
32 ## Tcl/Tk sanity check
34 if {[catch
{package require Tcl
8.4} err
]
35 ||
[catch
{package require Tk
8.4} err
]
41 -title [mc
"git-gui: fatal error"] \
46 catch
{rename send
{}} ; # What an evil concept...
48 ######################################################################
52 set oguilib
{@@GITGUI_LIBDIR@@
}
53 set oguirel
{@@GITGUI_RELATIVE@@
}
54 if {$oguirel eq
{1}} {
55 set oguilib
[file dirname [file normalize
$argv0]]
56 if {[file tail $oguilib] eq
{git-core
}} {
57 set oguilib
[file dirname $oguilib]
59 set oguilib
[file dirname $oguilib]
60 set oguilib
[file join $oguilib share git-gui lib
]
61 set oguimsg
[file join $oguilib msgs
]
62 } elseif
{[string match @@
* $oguirel]} {
63 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
64 set oguimsg
[file join [file dirname [file normalize
$argv0]] po
]
66 set oguimsg
[file join $oguilib msgs
]
70 ######################################################################
72 ## enable verbose loading?
74 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
76 rename auto_load real__auto_load
77 proc auto_load
{name args
} {
78 puts stderr
"auto_load $name"
79 return [uplevel
1 real__auto_load
$name $args]
81 rename
source real__source
83 puts stderr
"source $name"
84 uplevel
1 real__source
$name
88 ######################################################################
90 ## Internationalization (i18n) through msgcat and gettext. See
91 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93 package require msgcat
96 set cmk
[string first @@
$fmt]
98 return [string range
$fmt 0 [expr {$cmk - 1}]]
103 proc mc
{en_fmt args
} {
104 set fmt [_mc_trim
[::msgcat
::mc
$en_fmt]]
105 if {[catch
{set msg
[eval [list format
$fmt] $args]} err
]} {
106 set msg
[eval [list format
[_mc_trim
$en_fmt]] $args]
112 return [join $args {}]
115 ::msgcat
::mcload
$oguimsg
118 ######################################################################
122 set _appname
{Git Gui
}
129 set _trace
[lsearch
-exact $argv --trace]
131 set argv
[lreplace
$argv $_trace $_trace]
147 return [eval [list
file join $_gitdir] $args]
150 proc gitexec
{args
} {
152 if {$_gitexec eq
{}} {
153 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
154 error
"Git not installed?\n\n$err"
157 set _gitexec
[exec cygpath \
162 set _gitexec
[file normalize
$_gitexec]
168 return [eval [list
file join $_gitexec] $args]
176 if {[tk windowingsystem
] eq
{aqua
}} {
183 if {$
::tcl_platform
(platform
) eq
{windows
}} {
191 if {$_iscygwin eq
{}} {
192 if {$
::tcl_platform
(platform
) eq
{windows
}} {
193 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
205 proc is_enabled
{option
} {
206 global enabled_options
207 if {[catch
{set on
$enabled_options($option)}]} {return 0}
211 proc enable_option
{option
} {
212 global enabled_options
213 set enabled_options
($option) 1
216 proc disable_option
{option
} {
217 global enabled_options
218 set enabled_options
($option) 0
221 ######################################################################
225 proc is_many_config
{name
} {
226 switch
-glob -- $name {
236 proc is_config_true
{name
} {
238 if {[catch
{set v
$repo_config($name)}]} {
240 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
247 proc get_config
{name
} {
249 if {[catch
{set v
$repo_config($name)}]} {
256 ######################################################################
260 proc _trace_exec
{cmd
} {
261 if {!$
::_trace
} return
267 if {[regexp
{[ \t\r\n'"$?*]} $v]} {
275 proc _git_cmd {name} {
278 if {[catch {set v $_git_cmd_path($name)}]} {
282 --exec-path { return [list $::_git $name] }
285 set p [gitexec git-$name$::_search_exe]
286 if {[file exists $p]} {
288 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
289 # Try to determine what sort of magic will make
290 # git-$name go and do its thing, because native
291 # Tcl on Windows doesn't know it.
293 set p
[gitexec git-
$name]
298 switch
-glob -- [lindex
$s 0] {
300 #!*perl { set i perl }
301 #!*python { set i python }
302 default
{ error
"git-$name is not supported: $s" }
306 if {![info exists interp
]} {
307 set interp
[_which
$i]
310 error
"git-$name requires $i (not in PATH)"
312 set v
[concat
[list
$interp] [lrange
$s 1 end
] [list
$p]]
314 # Assume it is builtin to git somehow and we
315 # aren't actually able to see a file for it.
317 set v
[list $
::_git
$name]
319 set _git_cmd_path
($name) $v
324 proc _which
{what args
} {
325 global env _search_exe _search_path
327 if {$_search_path eq
{}} {
328 if {[is_Cygwin
] && [regexp
{^
(/|\.
:)} $env(PATH
)]} {
329 set _search_path
[split [exec cygpath \
335 } elseif
{[is_Windows
]} {
336 set gitguidir
[file dirname [info
script]]
337 regsub
-all ";" $gitguidir "\\;" gitguidir
338 set env
(PATH
) "$gitguidir;$env(PATH)"
339 set _search_path
[split $env(PATH
) {;}]
342 set _search_path
[split $env(PATH
) :]
347 if {[is_Windows
] && [lsearch
-exact $args -script] >= 0} {
350 set suffix
$_search_exe
353 foreach p
$_search_path {
354 set p
[file join $p $what$suffix]
355 if {[file exists
$p]} {
356 return [file normalize
$p]
362 proc _lappend_nice
{cmd_var
} {
366 if {![info exists _nice
]} {
367 set _nice
[_which nice
]
378 switch
-- [lindex
$args 0] {
389 set args
[lrange
$args 1 end
]
392 set cmdp
[_git_cmd
[lindex
$args 0]]
393 set args
[lrange
$args 1 end
]
395 _trace_exec
[concat
$opt $cmdp $args]
396 set result
[eval exec $opt $cmdp $args]
398 puts stderr
"< $result"
403 proc _open_stdout_stderr
{cmd
} {
406 set fd
[open
[concat
[list |
] $cmd] r
]
408 if { [lindex
$cmd end
] eq
{2>@
1}
409 && $err eq
{can not
find channel named
"1"}
411 # Older versions of Tcl 8.4 don't have this 2>@1 IO
412 # redirect operator. Fallback to |& cat for those.
413 # The command was not actually started, so its safe
414 # to try to start it a second time.
416 set fd
[open
[concat \
418 [lrange
$cmd 0 end-1
] \
425 fconfigure
$fd -eofchar {}
429 proc git_read
{args
} {
433 switch
-- [lindex
$args 0] {
448 set args
[lrange
$args 1 end
]
451 set cmdp
[_git_cmd
[lindex
$args 0]]
452 set args
[lrange
$args 1 end
]
454 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
457 proc git_write
{args
} {
461 switch
-- [lindex
$args 0] {
472 set args
[lrange
$args 1 end
]
475 set cmdp
[_git_cmd
[lindex
$args 0]]
476 set args
[lrange
$args 1 end
]
478 _trace_exec
[concat
$opt $cmdp $args]
479 return [open
[concat
[list |
] $opt $cmdp $args] w
]
482 proc githook_read
{hook_name args
} {
483 set pchook
[gitdir hooks
$hook_name]
486 # On Windows [file executable] might lie so we need to ask
487 # the shell if the hook is executable. Yes that's annoying.
491 if {![info exists interp
]} {
492 set interp
[_which sh
]
495 error
"hook execution requires sh (not in PATH)"
498 set scr
{if test -x "$1";then exec "$@";fi}
499 set sh_c
[list
$interp -c $scr $interp $pchook]
500 return [_open_stdout_stderr
[concat
$sh_c $args]]
503 if {[file executable
$pchook]} {
504 return [_open_stdout_stderr
[concat
[list
$pchook] $args]]
510 proc kill_file_process
{fd
} {
511 set process
[pid
$fd]
515 # Use a Cygwin-specific flag to allow killing
516 # native Windows processes
517 exec kill -f $process
525 regsub
-all ' $value "'\\''" value
529 proc load_current_branch {} {
530 global current_branch is_detached
532 set fd [open [gitdir HEAD] r]
533 if {[gets $fd ref] < 1} {
538 set pfx {ref: refs/heads/}
539 set len [string length $pfx]
540 if {[string equal -length $len $pfx $ref]} {
541 # We're on a branch. It might not exist. But
542 # HEAD looks good enough to be a branch.
544 set current_branch [string range $ref $len end]
547 # Assume this is a detached head.
549 set current_branch HEAD
554 auto_load tk_optionMenu
555 rename tk_optionMenu real__tkOptionMenu
556 proc tk_optionMenu {w varName args} {
557 set m [eval real__tkOptionMenu $w $varName $args]
558 $m configure -font font_ui
559 $w configure -font font_ui
563 proc rmsel_tag {text} {
565 -background [$text cget -background] \
566 -foreground [$text cget -foreground] \
568 $text tag conf in_sel -background lightgray
569 bind $text <Motion> break
574 bind . <Visibility> {
575 bind . <Visibility> {}
580 wm iconbitmap . -default $oguilib/git-gui.ico
583 ######################################################################
588 font create font_diff -family Courier -size 10
592 eval font configure font_ui [font actual [.dummy cget -font]]
596 font create font_uiitalic
597 font create font_uibold
598 font create font_diffbold
599 font create font_diffitalic
601 foreach class {Button Checkbutton Entry Label
602 Labelframe Listbox Menu Message
603 Radiobutton Spinbox Text} {
604 option add *$class.font font_ui
608 if {[is_Windows] || [is_MacOSX]} {
609 option add *Menu.tearOff 0
620 proc bind_button3 {w cmd} {
621 bind $w <Any-Button-3> $cmd
623 # Mac OS X sends Button-2 on right click through three-button mouse,
624 # or through trackpad right-clicking (two-finger touch + click).
625 bind $w <Any-Button-2> $cmd
626 bind $w <Control-Button-1> $cmd
630 proc apply_config {} {
631 global repo_config font_descs
633 foreach option $font_descs {
634 set name [lindex $option 0]
635 set font [lindex $option 1]
638 foreach {cn cv} $repo_config(gui.$name) {
639 if {$cn eq {-weight}} {
642 font configure $font $cn $cv
645 font configure $font -weight normal
648 error_popup [strcat [mc "Invalid font specified
in %s
:" "gui.
$name"] "\n\n$err"]
650 foreach {cn cv} [font configure $font] {
651 font configure ${font}bold $cn $cv
652 font configure ${font}italic $cn $cv
654 font configure ${font}bold -weight bold
655 font configure ${font}italic -slant italic
659 set default_config(branch.autosetupmerge) true
660 set default_config(merge.diffstat) true
661 set default_config(merge.summary) false
662 set default_config(merge.verbosity) 2
663 set default_config(user.name) {}
664 set default_config(user.email) {}
666 set default_config(gui.matchtrackingbranch) false
667 set default_config(gui.pruneduringfetch) false
668 set default_config(gui.trustmtime) false
669 set default_config(gui.fastcopyblame) false
670 set default_config(gui.copyblamethreshold) 40
671 set default_config(gui.blamehistoryctx) 7
672 set default_config(gui.diffcontext) 5
673 set default_config(gui.commitmsgwidth) 75
674 set default_config(gui.newbranchtemplate) {}
675 set default_config(gui.spellingdictionary) {}
676 set default_config(gui.fontui) [font configure font_ui]
677 set default_config(gui.fontdiff) [font configure font_diff]
679 {fontui font_ui {mc "Main Font
"}}
680 {fontdiff font_diff {mc "Diff
/Console Font
"}}
683 ######################################################################
687 set _git [_which git]
689 catch {wm withdraw .}
693 -title [mc "git-gui
: fatal error
"] \
694 -message [mc "Cannot
find git
in PATH.
"]
698 ######################################################################
702 if {[catch {set _git_version [git --version]} err]} {
703 catch {wm withdraw .}
707 -title [mc "git-gui
: fatal error
"] \
708 -message "Cannot determine Git version
:
712 [appname
] requires Git
1.5.0 or later.
"
715 if {![regsub {^git version } $_git_version {} _git_version]} {
716 catch {wm withdraw .}
720 -title [mc "git-gui
: fatal error
"] \
721 -message [strcat [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
725 set _real_git_version $_git_version
726 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
727 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
728 regsub {\.rc[0-9]+$} $_git_version {} _git_version
729 regsub {\.GIT$} $_git_version {} _git_version
730 regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
732 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
733 catch {wm withdraw .}
738 -title "[appname
]: warning
" \
739 -message [mc "Git version cannot be determined.
741 %s claims it is version
'%s'.
743 %s requires
at least Git
1.5.0 or later.
745 Assume
'%s' is version
1.5.0?
746 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
747 set _git_version 1.5.0
752 unset _real_git_version
754 proc git-version {args} {
757 switch [llength $args] {
763 set op [lindex $args 0]
764 set vr [lindex $args 1]
765 set cm [package vcompare $_git_version $vr]
766 return [expr $cm $op 0]
770 set type [lindex $args 0]
771 set name [lindex $args 1]
772 set parm [lindex $args 2]
773 set body [lindex $args 3]
775 if {($type ne {proc} && $type ne {method})} {
776 error "Invalid arguments to git-version
"
778 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
779 error "Last arm of
$type $name must be default
"
782 foreach {op vr cb} [lrange $body 0 end-2] {
783 if {[git-version $op $vr]} {
784 return [uplevel [list $type $name $parm $cb]]
788 return [uplevel [list $type $name $parm [lindex $body end]]]
792 error "git-version
>= x
"
798 if {[git-version < 1.5]} {
799 catch {wm withdraw .}
803 -title [mc "git-gui
: fatal error
"] \
804 -message "[appname
] requires Git
1.5.0 or later.
806 You are using
[git-version
]:
812 ######################################################################
814 ## configure our library
816 set idx [file join $oguilib tclIndex]
817 if {[catch {set fd [open $idx r]} err]} {
818 catch {wm withdraw .}
822 -title [mc "git-gui
: fatal error
"] \
826 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
828 while {[gets $fd n] >= 0} {
829 if {$n ne {} && ![string match #* $n]} {
841 if {[lsearch -exact $loaded $p] >= 0} continue
842 source [file join $oguilib $p]
847 set auto_path [concat [list $oguilib] $auto_path]
849 unset -nocomplain idx fd
851 ######################################################################
853 ## config file parsing
855 git-version proc _parse_config {arr_name args} {
862 [list git_read config] \
864 [list --null --list]]
865 fconfigure $fd_rc -translation binary
866 set buf [read $fd_rc]
869 foreach line [split $buf "\
0"] {
870 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
871 if {[is_many_config $name]} {
872 lappend arr($name) $value
874 set arr($name) $value
883 set fd_rc [eval [list git_read config --list] $args]
884 while {[gets $fd_rc line] >= 0} {
885 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
886 if {[is_many_config $name]} {
887 lappend arr($name) $value
889 set arr($name) $value
898 proc load_config {include_global} {
899 global repo_config global_config default_config
901 if {$include_global} {
902 _parse_config global_config --global
904 _parse_config repo_config
906 foreach name [array names default_config] {
907 if {[catch {set v $global_config($name)}]} {
908 set global_config($name) $default_config($name)
910 if {[catch {set v $repo_config($name)}]} {
911 set repo_config($name) $default_config($name)
916 ######################################################################
918 ## feature option selection
920 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
925 if {$subcommand eq {gui.sh}} {
928 if {$subcommand eq {gui} && [llength $argv] > 0} {
929 set subcommand [lindex $argv 0]
930 set argv [lrange $argv 1 end]
933 enable_option multicommit
935 enable_option transport
938 switch -- $subcommand {
943 disable_option multicommit
944 disable_option branch
945 disable_option transport
948 enable_option singlecommit
950 disable_option multicommit
951 disable_option branch
952 disable_option transport
956 ######################################################################
961 set _gitdir $env(GIT_DIR)
965 set _gitdir [git rev-parse --git-dir]
966 set _prefix [git rev-parse --show-prefix]
970 choose_repository::pick
972 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
973 catch {set _gitdir [exec cygpath --windows $_gitdir]}
975 if {![file isdirectory $_gitdir]} {
976 catch {wm withdraw .}
977 error_popup [strcat [mc "Git directory not found
:"] "\n\n$_gitdir"]
980 if {$_prefix ne {}} {
981 regsub -all {[^/]+/} $_prefix ../ cdup
982 if {[catch {cd $cdup} err]} {
983 catch {wm withdraw .}
984 error_popup [strcat [mc "Cannot move to top of working directory
:"] "\n\n$err"]
988 } elseif {![is_enabled bare]} {
989 if {[lindex [file split $_gitdir] end] ne {.git}} {
990 catch {wm withdraw .}
991 error_popup [strcat [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
994 if {[catch {cd [file dirname $_gitdir]} err]} {
995 catch {wm withdraw .}
996 error_popup [strcat [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
1000 set _reponame [file split [file normalize $_gitdir]]
1001 if {[lindex $_reponame end] eq {.git}} {
1002 set _reponame [lindex $_reponame end-1]
1004 set _reponame [lindex $_reponame end]
1007 ######################################################################
1011 set current_diff_path {}
1012 set current_diff_side {}
1013 set diff_actions [list]
1017 set MERGE_HEAD [list]
1020 set current_branch {}
1022 set current_diff_path {}
1024 set selected_commit_type new
1026 ######################################################################
1034 set disable_on_lock [list]
1035 set index_lock_type none
1037 proc lock_index {type} {
1038 global index_lock_type disable_on_lock
1040 if {$index_lock_type eq {none}} {
1041 set index_lock_type $type
1042 foreach w $disable_on_lock {
1043 uplevel #0 $w disabled
1046 } elseif {$index_lock_type eq "begin-
$type"} {
1047 set index_lock_type $type
1053 proc unlock_index {} {
1054 global index_lock_type disable_on_lock
1056 set index_lock_type none
1057 foreach w $disable_on_lock {
1058 uplevel #0 $w normal
1062 ######################################################################
1066 proc repository_state {ctvar hdvar mhvar} {
1067 global current_branch
1068 upvar $ctvar ct $hdvar hd $mhvar mh
1073 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1079 set merge_head [gitdir MERGE_HEAD]
1080 if {[file exists $merge_head]} {
1082 set fd_mh [open $merge_head r]
1083 while {[gets $fd_mh line] >= 0} {
1094 global PARENT empty_tree
1096 set p [lindex $PARENT 0]
1100 if {$empty_tree eq {}} {
1101 set empty_tree [git mktree << {}]
1106 proc rescan {after {honor_trustmtime 1}} {
1107 global HEAD PARENT MERGE_HEAD commit_type
1108 global ui_index ui_workdir ui_comm
1109 global rescan_active file_states
1112 if {$rescan_active > 0 || ![lock_index read]} return
1114 repository_state newType newHEAD newMERGE_HEAD
1115 if {[string match amend* $commit_type]
1116 && $newType eq {normal}
1117 && $newHEAD eq $HEAD} {
1121 set MERGE_HEAD $newMERGE_HEAD
1122 set commit_type $newType
1125 array unset file_states
1127 if {!$::GITGUI_BCK_exists &&
1128 (![$ui_comm edit modified]
1129 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1130 if {[string match amend* $commit_type]} {
1131 } elseif {[load_message GITGUI_MSG]} {
1132 } elseif {[load_message MERGE_MSG]} {
1133 } elseif {[load_message SQUASH_MSG]} {
1136 $ui_comm edit modified false
1139 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1140 rescan_stage2 {} $after
1143 ui_status [mc "Refreshing
file status...
"]
1144 set fd_rf [git_read update-index \
1150 fconfigure $fd_rf -blocking 0 -translation binary
1151 fileevent $fd_rf readable \
1152 [list rescan_stage2 $fd_rf $after]
1157 set is_git_info_exclude {}
1158 proc have_info_exclude {} {
1159 global is_git_info_exclude
1161 if {$is_git_info_exclude eq {}} {
1162 if {[catch {exec test -f [gitdir info exclude]}]} {
1163 set is_git_info_exclude 0
1165 set is_git_info_exclude 1
1168 return $is_git_info_exclude
1171 proc have_info_exclude {} {
1172 return [file readable [gitdir info exclude]]
1176 proc rescan_stage2 {fd after} {
1177 global rescan_active buf_rdi buf_rdf buf_rlo
1181 if {![eof $fd]} return
1185 set ls_others [list --exclude-per-directory=.gitignore]
1186 if {[have_info_exclude]} {
1187 lappend ls_others "--exclude-from=[gitdir info exclude
]"
1189 set user_exclude [get_config core.excludesfile]
1190 if {$user_exclude ne {} && [file readable $user_exclude]} {
1191 lappend ls_others "--exclude-from=$user_exclude"
1199 ui_status [mc "Scanning
for modified files ...
"]
1200 set fd_di [git_read diff-index --cached -z [PARENT]]
1201 set fd_df [git_read diff-files -z]
1202 set fd_lo [eval git_read ls-files --others -z $ls_others]
1204 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1205 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1206 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1207 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1208 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1209 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1212 proc load_message {file} {
1215 set f [gitdir $file]
1216 if {[file isfile $f]} {
1217 if {[catch {set fd [open $f r]}]} {
1220 fconfigure $fd -eofchar {}
1221 set content [string trim [read $fd]]
1223 regsub -all -line {[ \r\t]+$} $content {} content
1224 $ui_comm delete 0.0 end
1225 $ui_comm insert end $content
1231 proc read_diff_index {fd after} {
1234 append buf_rdi [read $fd]
1236 set n [string length $buf_rdi]
1238 set z1 [string first "\
0" $buf_rdi $c]
1239 if {$z1 == -1} break
1241 set z2 [string first "\
0" $buf_rdi $z1]
1242 if {$z2 == -1} break
1245 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1246 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1248 [encoding convertfrom $p] \
1250 [list [lindex $i 0] [lindex $i 2]] \
1256 set buf_rdi [string range $buf_rdi $c end]
1261 rescan_done $fd buf_rdi $after
1264 proc read_diff_files {fd after} {
1267 append buf_rdf [read $fd]
1269 set n [string length $buf_rdf]
1271 set z1 [string first "\
0" $buf_rdf $c]
1272 if {$z1 == -1} break
1274 set z2 [string first "\
0" $buf_rdf $z1]
1275 if {$z2 == -1} break
1278 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1279 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1281 [encoding convertfrom $p] \
1284 [list [lindex $i 0] [lindex $i 2]]
1289 set buf_rdf [string range $buf_rdf $c end]
1294 rescan_done $fd buf_rdf $after
1297 proc read_ls_others {fd after} {
1300 append buf_rlo [read $fd]
1301 set pck [split $buf_rlo "\
0"]
1302 set buf_rlo [lindex $pck end]
1303 foreach p [lrange $pck 0 end-1] {
1304 set p [encoding convertfrom $p]
1305 if {[string index $p end] eq {/}} {
1306 set p [string range $p 0 end-1]
1310 rescan_done $fd buf_rlo $after
1313 proc rescan_done {fd buf after} {
1314 global rescan_active current_diff_path
1315 global file_states repo_config
1318 if {![eof $fd]} return
1321 if {[incr rescan_active -1] > 0} return
1326 if {$current_diff_path ne {}} reshow_diff
1330 proc prune_selection {} {
1331 global file_states selected_paths
1333 foreach path [array names selected_paths] {
1334 if {[catch {set still_here $file_states($path)}]} {
1335 unset selected_paths($path)
1340 ######################################################################
1344 proc mapicon {w state path} {
1347 if {[catch {set r $all_icons($state$w)}]} {
1348 puts "error
: no icon
for $w state
={$state} $path"
1354 proc mapdesc {state path} {
1357 if {[catch {set r $all_descs($state)}]} {
1358 puts "error
: no desc
for state
={$state} $path"
1364 proc ui_status {msg} {
1366 if {[info exists main_status]} {
1367 $main_status show $msg
1371 proc ui_ready {{test {}}} {
1373 if {[info exists main_status]} {
1374 $main_status show [mc "Ready.
"] $test
1378 proc escape_path {path} {
1379 regsub -all {\\} $path "\\\\" path
1380 regsub -all "\n" $path "\\n
" path
1384 proc short_path {path} {
1385 return [escape_path [lindex [file split $path] end]]
1389 set null_sha1 [string repeat 0 40]
1391 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1392 global file_states next_icon_id null_sha1
1394 set s0 [string index $new_state 0]
1395 set s1 [string index $new_state 1]
1397 if {[catch {set info $file_states($path)}]} {
1399 set icon n[incr next_icon_id]
1401 set state [lindex $info 0]
1402 set icon [lindex $info 1]
1403 if {$head_info eq {}} {set head_info [lindex $info 2]}
1404 if {$index_info eq {}} {set index_info [lindex $info 3]}
1407 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1408 elseif {$s0 eq {_}} {set s0 _}
1410 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1411 elseif {$s1 eq {_}} {set s1 _}
1413 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1414 set head_info [list 0 $null_sha1]
1415 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1416 && $head_info eq {}} {
1417 set head_info $index_info
1420 set file_states($path) [list $s0$s1 $icon \
1421 $head_info $index_info \
1426 proc display_file_helper {w path icon_name old_m new_m} {
1429 if {$new_m eq {_}} {
1430 set lno [lsearch -sorted -exact $file_lists($w) $path]
1432 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1434 $w conf -state normal
1435 $w delete $lno.0 [expr {$lno + 1}].0
1436 $w conf -state disabled
1438 } elseif {$old_m eq {_} && $new_m ne {_}} {
1439 lappend file_lists($w) $path
1440 set file_lists($w) [lsort -unique $file_lists($w)]
1441 set lno [lsearch -sorted -exact $file_lists($w) $path]
1443 $w conf -state normal
1444 $w image create $lno.0 \
1445 -align center -padx 5 -pady 1 \
1447 -image [mapicon $w $new_m $path]
1448 $w insert $lno.1 "[escape_path
$path]\n"
1449 $w conf -state disabled
1450 } elseif {$old_m ne $new_m} {
1451 $w conf -state normal
1452 $w image conf $icon_name -image [mapicon $w $new_m $path]
1453 $w conf -state disabled
1457 proc display_file {path state} {
1458 global file_states selected_paths
1459 global ui_index ui_workdir
1461 set old_m [merge_state $path $state]
1462 set s $file_states($path)
1463 set new_m [lindex $s 0]
1464 set icon_name [lindex $s 1]
1466 set o [string index $old_m 0]
1467 set n [string index $new_m 0]
1474 display_file_helper $ui_index $path $icon_name $o $n
1476 if {[string index $old_m 0] eq {U}} {
1479 set o [string index $old_m 1]
1481 if {[string index $new_m 0] eq {U}} {
1484 set n [string index $new_m 1]
1486 display_file_helper $ui_workdir $path $icon_name $o $n
1488 if {$new_m eq {__}} {
1489 unset file_states($path)
1490 catch {unset selected_paths($path)}
1494 proc display_all_files_helper {w path icon_name m} {
1497 lappend file_lists($w) $path
1498 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1499 $w image create end \
1500 -align center -padx 5 -pady 1 \
1502 -image [mapicon $w $m $path]
1503 $w insert end "[escape_path
$path]\n"
1506 proc display_all_files {} {
1507 global ui_index ui_workdir
1508 global file_states file_lists
1511 $ui_index conf -state normal
1512 $ui_workdir conf -state normal
1514 $ui_index delete 0.0 end
1515 $ui_workdir delete 0.0 end
1518 set file_lists($ui_index) [list]
1519 set file_lists($ui_workdir) [list]
1521 foreach path [lsort [array names file_states]] {
1522 set s $file_states($path)
1524 set icon_name [lindex $s 1]
1526 set s [string index $m 0]
1527 if {$s ne {U} && $s ne {_}} {
1528 display_all_files_helper $ui_index $path \
1532 if {[string index $m 0] eq {U}} {
1535 set s [string index $m 1]
1538 display_all_files_helper $ui_workdir $path \
1543 $ui_index conf -state disabled
1544 $ui_workdir conf -state disabled
1547 ######################################################################
1552 #define mask_width 14
1553 #define mask_height 15
1554 static unsigned char mask_bits[] = {
1555 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1556 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1557 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1560 image create bitmap file_plain -background white -foreground black -data {
1561 #define plain_width 14
1562 #define plain_height 15
1563 static unsigned char plain_bits[] = {
1564 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1565 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1566 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1567 } -maskdata $filemask
1569 image create bitmap file_mod -background white -foreground blue -data {
1570 #define mod_width 14
1571 #define mod_height 15
1572 static unsigned char mod_bits[] = {
1573 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1574 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1575 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1576 } -maskdata $filemask
1578 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1579 #define file_fulltick_width 14
1580 #define file_fulltick_height 15
1581 static unsigned char file_fulltick_bits
[] = {
1582 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1583 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1584 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1585 } -maskdata $filemask
1587 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1588 #define parttick_width 14
1589 #define parttick_height 15
1590 static unsigned char parttick_bits
[] = {
1591 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1592 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1593 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1594 } -maskdata $filemask
1596 image create bitmap file_question
-background white
-foreground black
-data {
1597 #define file_question_width 14
1598 #define file_question_height 15
1599 static unsigned char file_question_bits
[] = {
1600 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1601 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1602 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1603 } -maskdata $filemask
1605 image create bitmap file_removed
-background white
-foreground red
-data {
1606 #define file_removed_width 14
1607 #define file_removed_height 15
1608 static unsigned char file_removed_bits
[] = {
1609 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1610 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1611 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1612 } -maskdata $filemask
1614 image create bitmap file_merge
-background white
-foreground blue
-data {
1615 #define file_merge_width 14
1616 #define file_merge_height 15
1617 static unsigned char file_merge_bits
[] = {
1618 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1619 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1620 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1621 } -maskdata $filemask
1623 image create bitmap file_statechange
-background white
-foreground green
-data {
1624 #define file_merge_width 14
1625 #define file_merge_height 15
1626 static unsigned char file_statechange_bits
[] = {
1627 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1628 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1629 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1630 } -maskdata $filemask
1632 set ui_index .vpane.files.index.list
1633 set ui_workdir .vpane.files.workdir.list
1635 set all_icons
(_
$ui_index) file_plain
1636 set all_icons
(A
$ui_index) file_fulltick
1637 set all_icons
(M
$ui_index) file_fulltick
1638 set all_icons
(D
$ui_index) file_removed
1639 set all_icons
(U
$ui_index) file_merge
1640 set all_icons
(T
$ui_index) file_statechange
1642 set all_icons
(_
$ui_workdir) file_plain
1643 set all_icons
(M
$ui_workdir) file_mod
1644 set all_icons
(D
$ui_workdir) file_question
1645 set all_icons
(U
$ui_workdir) file_merge
1646 set all_icons
(O
$ui_workdir) file_plain
1647 set all_icons
(T
$ui_workdir) file_statechange
1649 set max_status_desc
0
1651 {__
{mc
"Unmodified"}}
1653 {_M
{mc
"Modified, not staged"}}
1654 {M_
{mc
"Staged for commit"}}
1655 {MM
{mc
"Portions staged for commit"}}
1656 {MD
{mc
"Staged for commit, missing"}}
1658 {_T
{mc
"File type changed, not staged"}}
1659 {T_
{mc
"File type changed, staged"}}
1661 {_O
{mc
"Untracked, not staged"}}
1662 {A_
{mc
"Staged for commit"}}
1663 {AM
{mc
"Portions staged for commit"}}
1664 {AD
{mc
"Staged for commit, missing"}}
1667 {D_
{mc
"Staged for removal"}}
1668 {DO
{mc
"Staged for removal, still present"}}
1670 {U_
{mc
"Requires merge resolution"}}
1671 {UU
{mc
"Requires merge resolution"}}
1672 {UM
{mc
"Requires merge resolution"}}
1673 {UD
{mc
"Requires merge resolution"}}
1675 set text
[eval [lindex
$i 1]]
1676 if {$max_status_desc < [string length
$text]} {
1677 set max_status_desc
[string length
$text]
1679 set all_descs
([lindex
$i 0]) $text
1683 ######################################################################
1687 proc scrollbar2many
{list mode args
} {
1688 foreach w
$list {eval $w $mode $args}
1691 proc many2scrollbar
{list mode sb top bottom
} {
1692 $sb set $top $bottom
1693 foreach w
$list {$w $mode moveto
$top}
1696 proc incr_font_size
{font
{amt
1}} {
1697 set sz
[font configure
$font -size]
1699 font configure
$font -size $sz
1700 font configure
${font}bold
-size $sz
1701 font configure
${font}italic
-size $sz
1704 ######################################################################
1708 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1710 proc do_gitk
{revs
} {
1711 # -- Always start gitk through whatever we were loaded with. This
1712 # lets us bypass using shell process on Windows systems.
1714 set exe
[_which gitk
-script]
1715 set cmd
[list
[info nameofexecutable
] $exe]
1717 error_popup
[mc
"Couldn't find gitk in PATH"]
1721 if {[info exists env
(GIT_DIR
)]} {
1722 set old_GIT_DIR
$env(GIT_DIR
)
1728 cd [file dirname [gitdir
]]
1729 set env
(GIT_DIR
) [file tail [gitdir
]]
1731 eval exec $cmd $revs &
1733 if {$old_GIT_DIR eq
{}} {
1736 set env
(GIT_DIR
) $old_GIT_DIR
1740 ui_status $
::starting_gitk_msg
1742 ui_ready
$starting_gitk_msg
1750 global ui_comm is_quitting repo_config commit_type
1751 global GITGUI_BCK_exists GITGUI_BCK_i
1752 global ui_comm_spell
1754 if {$is_quitting} return
1757 if {[winfo exists
$ui_comm]} {
1758 # -- Stash our current commit buffer.
1760 set save
[gitdir GITGUI_MSG
]
1761 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1762 file rename
-force [gitdir GITGUI_BCK
] $save
1763 set GITGUI_BCK_exists
0
1765 set msg
[string trim
[$ui_comm get
0.0 end
]]
1766 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1767 if {(![string match amend
* $commit_type]
1768 ||
[$ui_comm edit modified
])
1771 set fd
[open
$save w
]
1772 puts
-nonewline $fd $msg
1776 catch
{file delete
$save}
1780 # -- Cancel our spellchecker if its running.
1782 if {[info exists ui_comm_spell
]} {
1786 # -- Remove our editor backup, its not needed.
1788 after cancel
$GITGUI_BCK_i
1789 if {$GITGUI_BCK_exists} {
1790 catch
{file delete
[gitdir GITGUI_BCK
]}
1793 # -- Stash our current window geometry into this repository.
1795 set cfg_geometry
[list
]
1796 lappend cfg_geometry
[wm geometry .
]
1797 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 0]
1798 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 1]
1799 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1802 if {$cfg_geometry ne
$rc_geometry} {
1803 catch
{git config gui.geometry
$cfg_geometry}
1819 global next_diff_p next_diff_w next_diff_i
1820 show_diff
$next_diff_p $next_diff_w $next_diff_i
1823 proc toggle_or_diff
{w x y
} {
1824 global file_states file_lists current_diff_path ui_index ui_workdir
1825 global last_clicked selected_paths
1827 set pos
[split [$w index @
$x,$y] .
]
1828 set lno
[lindex
$pos 0]
1829 set col [lindex
$pos 1]
1830 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1836 set last_clicked
[list
$w $lno]
1837 array
unset selected_paths
1838 $ui_index tag remove in_sel
0.0 end
1839 $ui_workdir tag remove in_sel
0.0 end
1841 if {$col == 0 && $y > 1} {
1842 set i
[expr {$lno-1}]
1843 set ll
[expr {[llength
$file_lists($w)]-1}]
1845 if {$i == $ll && $i == 0} {
1846 set after
{reshow_diff
;}
1848 global next_diff_p next_diff_w next_diff_i
1853 set i
[expr {$i + 1}]
1857 set i
[expr {$i - 1}]
1860 set next_diff_p
[lindex
$file_lists($w) $i]
1862 if {$next_diff_p ne
{} && $current_diff_path ne
{}} {
1863 set after
{next_diff
;}
1869 if {$w eq
$ui_index} {
1871 "Unstaging [short_path $path] from commit" \
1873 [concat
$after [list ui_ready
]]
1874 } elseif
{$w eq
$ui_workdir} {
1876 "Adding [short_path $path]" \
1878 [concat
$after [list ui_ready
]]
1881 show_diff
$path $w $lno
1885 proc add_one_to_selection
{w x y
} {
1886 global file_lists last_clicked selected_paths
1888 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1889 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1895 if {$last_clicked ne
{}
1896 && [lindex
$last_clicked 0] ne
$w} {
1897 array
unset selected_paths
1898 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1901 set last_clicked
[list
$w $lno]
1902 if {[catch
{set in_sel
$selected_paths($path)}]} {
1906 unset selected_paths
($path)
1907 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1909 set selected_paths
($path) 1
1910 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1914 proc add_range_to_selection
{w x y
} {
1915 global file_lists last_clicked selected_paths
1917 if {[lindex
$last_clicked 0] ne
$w} {
1918 toggle_or_diff
$w $x $y
1922 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1923 set lc
[lindex
$last_clicked 1]
1932 foreach path
[lrange
$file_lists($w) \
1933 [expr {$begin - 1}] \
1934 [expr {$end - 1}]] {
1935 set selected_paths
($path) 1
1937 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1940 proc show_more_context
{} {
1942 if {$repo_config(gui.diffcontext
) < 99} {
1943 incr repo_config
(gui.diffcontext
)
1948 proc show_less_context
{} {
1950 if {$repo_config(gui.diffcontext
) > 1} {
1951 incr repo_config
(gui.diffcontext
) -1
1956 ######################################################################
1966 menu .mbar
-tearoff 0
1967 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
1968 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
1969 if {[is_enabled branch
]} {
1970 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
1972 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1973 .mbar add cascade
-label [mc Commit@@noun
] -menu .mbar.commit
1975 if {[is_enabled transport
]} {
1976 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
1977 .mbar add cascade
-label [mc Remote
] -menu .mbar.remote
1979 . configure
-menu .mbar
1981 # -- Repository Menu
1983 menu .mbar.repository
1985 .mbar.repository add
command \
1986 -label [mc
"Browse Current Branch's Files"] \
1987 -command {browser
::new
$current_branch}
1988 set ui_browse_current
[.mbar.repository index last
]
1989 .mbar.repository add
command \
1990 -label [mc
"Browse Branch Files..."] \
1991 -command browser_open
::dialog
1992 .mbar.repository add separator
1994 .mbar.repository add
command \
1995 -label [mc
"Visualize Current Branch's History"] \
1996 -command {do_gitk
$current_branch}
1997 set ui_visualize_current
[.mbar.repository index last
]
1998 .mbar.repository add
command \
1999 -label [mc
"Visualize All Branch History"] \
2000 -command {do_gitk
--all}
2001 .mbar.repository add separator
2003 proc current_branch_write
{args
} {
2004 global current_branch
2005 .mbar.repository entryconf $
::ui_browse_current \
2006 -label [mc
"Browse %s's Files" $current_branch]
2007 .mbar.repository entryconf $
::ui_visualize_current \
2008 -label [mc
"Visualize %s's History" $current_branch]
2010 trace add variable current_branch
write current_branch_write
2012 if {[is_enabled multicommit
]} {
2013 .mbar.repository add
command -label [mc
"Database Statistics"] \
2016 .mbar.repository add
command -label [mc
"Compress Database"] \
2019 .mbar.repository add
command -label [mc
"Verify Database"] \
2020 -command do_fsck_objects
2022 .mbar.repository add separator
2025 .mbar.repository add
command \
2026 -label [mc
"Create Desktop Icon"] \
2027 -command do_cygwin_shortcut
2028 } elseif
{[is_Windows
]} {
2029 .mbar.repository add
command \
2030 -label [mc
"Create Desktop Icon"] \
2031 -command do_windows_shortcut
2032 } elseif
{[is_MacOSX
]} {
2033 .mbar.repository add
command \
2034 -label [mc
"Create Desktop Icon"] \
2035 -command do_macosx_app
2040 proc
::tk
::mac
::Quit
{args
} { do_quit
}
2042 .mbar.repository add
command -label [mc Quit
] \
2050 .mbar.edit add
command -label [mc Undo
] \
2051 -command {catch
{[focus
] edit undo
}} \
2053 .mbar.edit add
command -label [mc Redo
] \
2054 -command {catch
{[focus
] edit redo
}} \
2056 .mbar.edit add separator
2057 .mbar.edit add
command -label [mc Cut
] \
2058 -command {catch
{tk_textCut
[focus
]}} \
2060 .mbar.edit add
command -label [mc Copy
] \
2061 -command {catch
{tk_textCopy
[focus
]}} \
2063 .mbar.edit add
command -label [mc Paste
] \
2064 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2066 .mbar.edit add
command -label [mc Delete
] \
2067 -command {catch
{[focus
] delete sel.first sel.last
}} \
2069 .mbar.edit add separator
2070 .mbar.edit add
command -label [mc
"Select All"] \
2071 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2076 if {[is_enabled branch
]} {
2079 .mbar.branch add
command -label [mc
"Create..."] \
2080 -command branch_create
::dialog \
2082 lappend disable_on_lock
[list .mbar.branch entryconf \
2083 [.mbar.branch index last
] -state]
2085 .mbar.branch add
command -label [mc
"Checkout..."] \
2086 -command branch_checkout
::dialog \
2088 lappend disable_on_lock
[list .mbar.branch entryconf \
2089 [.mbar.branch index last
] -state]
2091 .mbar.branch add
command -label [mc
"Rename..."] \
2092 -command branch_rename
::dialog
2093 lappend disable_on_lock
[list .mbar.branch entryconf \
2094 [.mbar.branch index last
] -state]
2096 .mbar.branch add
command -label [mc
"Delete..."] \
2097 -command branch_delete
::dialog
2098 lappend disable_on_lock
[list .mbar.branch entryconf \
2099 [.mbar.branch index last
] -state]
2101 .mbar.branch add
command -label [mc
"Reset..."] \
2102 -command merge
::reset_hard
2103 lappend disable_on_lock
[list .mbar.branch entryconf \
2104 [.mbar.branch index last
] -state]
2109 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
2112 .mbar.commit add radiobutton \
2113 -label [mc
"New Commit"] \
2114 -command do_select_commit_type \
2115 -variable selected_commit_type \
2117 lappend disable_on_lock \
2118 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2120 .mbar.commit add radiobutton \
2121 -label [mc
"Amend Last Commit"] \
2122 -command do_select_commit_type \
2123 -variable selected_commit_type \
2125 lappend disable_on_lock \
2126 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2128 .mbar.commit add separator
2130 .mbar.commit add
command -label [mc Rescan
] \
2131 -command do_rescan \
2133 lappend disable_on_lock \
2134 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2136 .mbar.commit add
command -label [mc
"Stage To Commit"] \
2137 -command do_add_selection \
2139 lappend disable_on_lock \
2140 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2142 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
2143 -command do_add_all \
2145 lappend disable_on_lock \
2146 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2148 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
2149 -command do_unstage_selection
2150 lappend disable_on_lock \
2151 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2153 .mbar.commit add
command -label [mc
"Revert Changes"] \
2154 -command do_revert_selection
2155 lappend disable_on_lock \
2156 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2158 .mbar.commit add separator
2160 .mbar.commit add
command -label [mc
"Show Less Context"] \
2161 -command show_less_context \
2162 -accelerator $M1T-\
-
2164 .mbar.commit add
command -label [mc
"Show More Context"] \
2165 -command show_more_context \
2168 .mbar.commit add separator
2170 .mbar.commit add
command -label [mc
"Sign Off"] \
2171 -command do_signoff \
2174 .mbar.commit add
command -label [mc Commit@@verb
] \
2175 -command do_commit \
2176 -accelerator $M1T-Return
2177 lappend disable_on_lock \
2178 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2183 if {[is_enabled branch
]} {
2185 .mbar.merge add
command -label [mc
"Local Merge..."] \
2186 -command merge
::dialog \
2188 lappend disable_on_lock \
2189 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2190 .mbar.merge add
command -label [mc
"Abort Merge..."] \
2191 -command merge
::reset_hard
2192 lappend disable_on_lock \
2193 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
2198 if {[is_enabled transport
]} {
2201 .mbar.remote add
command \
2202 -label [mc
"Push..."] \
2203 -command do_push_anywhere \
2205 .mbar.remote add
command \
2206 -label [mc
"Delete..."] \
2207 -command remote_branch_delete
::dialog
2211 # -- Apple Menu (Mac OS X only)
2213 .mbar add cascade
-label Apple
-menu .mbar.apple
2216 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
2218 .mbar.apple add separator
2219 .mbar.apple add
command \
2220 -label [mc
"Preferences..."] \
2221 -command do_options \
2223 bind .
<$M1B-,> do_options
2227 .mbar.edit add separator
2228 .mbar.edit add
command -label [mc
"Options..."] \
2234 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
2238 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
2243 catch
{set browser
$repo_config(instaweb.browser
)}
2244 set doc_path
[file dirname [gitexec
]]
2245 set doc_path
[file join $doc_path Documentation index.html
]
2248 set doc_path
[exec cygpath
--mixed $doc_path]
2251 if {$browser eq
{}} {
2254 } elseif
{[is_Cygwin
]} {
2255 set program_files
[file dirname [exec cygpath
--windir]]
2256 set program_files
[file join $program_files {Program Files
}]
2257 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
2258 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
2259 if {[file exists
$firefox]} {
2260 set browser
$firefox
2261 } elseif
{[file exists
$ie]} {
2264 unset program_files firefox ie
2268 if {[file isfile
$doc_path]} {
2269 set doc_url
"file:$doc_path"
2271 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2274 if {$browser ne
{}} {
2275 .mbar.
help add
command -label [mc
"Online Documentation"] \
2276 -command [list
exec $browser $doc_url &]
2278 unset browser doc_path doc_url
2280 # -- Standard bindings
2282 wm protocol . WM_DELETE_WINDOW do_quit
2283 bind all
<$M1B-Key-q> do_quit
2284 bind all
<$M1B-Key-Q> do_quit
2285 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2286 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2288 set subcommand_args
{}
2290 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2294 # -- Not a normal commit type invocation? Do that instead!
2296 switch
-- $subcommand {
2299 if {$subcommand eq
"blame"} {
2300 set subcommand_args
{[--line=<num
>] rev? path
}
2302 set subcommand_args
{rev? path
}
2304 if {$argv eq
{}} usage
2310 if {$is_path ||
[file exists
$_prefix$a]} {
2311 if {$path ne
{}} usage
2314 } elseif
{$a eq
{--}} {
2316 if {$head ne
{}} usage
2321 } elseif
{[regexp
{^
--line=(\d
+)$
} $a a lnum
]} {
2322 if {$jump_spec ne
{} ||
$head ne
{}} usage
2323 set jump_spec
[list
$lnum]
2324 } elseif
{$head eq
{}} {
2325 if {$head ne
{}} usage
2334 if {$head ne
{} && $path eq
{}} {
2335 set path
$_prefix$head
2342 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2344 set head [git rev-parse
--verify $head]
2350 set current_branch
$head
2353 switch
-- $subcommand {
2355 if {$jump_spec ne
{}} usage
2357 if {$path ne
{} && [file isdirectory
$path]} {
2358 set head $current_branch
2364 browser
::new
$head $path
2367 if {$head eq
{} && ![file exists
$path]} {
2368 puts stderr
[mc
"fatal: cannot stat path %s: No such file or directory" $path]
2371 blame
::new
$head $path $jump_spec
2378 if {[llength
$argv] != 0} {
2379 puts
-nonewline stderr
"usage: $argv0"
2380 if {$subcommand ne
{gui
}
2381 && [file tail $argv0] ne
"git-$subcommand"} {
2382 puts
-nonewline stderr
" $subcommand"
2387 # fall through to setup UI for commits
2390 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2401 -text [mc
"Current Branch:"] \
2405 -textvariable current_branch \
2408 pack .branch.l1
-side left
2409 pack .branch.cb
-side left
-fill x
2410 pack .branch
-side top
-fill x
2412 # -- Main Window Layout
2414 panedwindow .vpane
-orient horizontal
2415 panedwindow .vpane.files
-orient vertical
2416 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2417 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2419 # -- Index File List
2421 frame .vpane.files.index
-height 100 -width 200
2422 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Commit)"] \
2423 -background lightgreen
-foreground black
2424 text
$ui_index -background white
-foreground black \
2426 -width 20 -height 10 \
2428 -cursor $cursor_ptr \
2429 -xscrollcommand {.vpane.files.index.sx
set} \
2430 -yscrollcommand {.vpane.files.index.sy
set} \
2432 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2433 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2434 pack .vpane.files.index.title
-side top
-fill x
2435 pack .vpane.files.index.sx
-side bottom
-fill x
2436 pack .vpane.files.index.sy
-side right
-fill y
2437 pack
$ui_index -side left
-fill both
-expand 1
2439 # -- Working Directory File List
2441 frame .vpane.files.workdir
-height 100 -width 200
2442 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes"] \
2443 -background lightsalmon
-foreground black
2444 text
$ui_workdir -background white
-foreground black \
2446 -width 20 -height 10 \
2448 -cursor $cursor_ptr \
2449 -xscrollcommand {.vpane.files.workdir.sx
set} \
2450 -yscrollcommand {.vpane.files.workdir.sy
set} \
2452 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2453 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2454 pack .vpane.files.workdir.title
-side top
-fill x
2455 pack .vpane.files.workdir.sx
-side bottom
-fill x
2456 pack .vpane.files.workdir.sy
-side right
-fill y
2457 pack
$ui_workdir -side left
-fill both
-expand 1
2459 .vpane.files add .vpane.files.workdir
-sticky nsew
2460 .vpane.files add .vpane.files.index
-sticky nsew
2462 foreach i
[list
$ui_index $ui_workdir] {
2464 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2468 # -- Diff and Commit Area
2470 frame .vpane.lower
-height 300 -width 400
2471 frame .vpane.lower.commarea
2472 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2473 pack .vpane.lower.
diff -fill both
-expand 1
2474 pack .vpane.lower.commarea
-side bottom
-fill x
2475 .vpane add .vpane.lower
-sticky nsew
2477 # -- Commit Area Buttons
2479 frame .vpane.lower.commarea.buttons
2480 label .vpane.lower.commarea.buttons.l
-text {} \
2483 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2484 pack .vpane.lower.commarea.buttons
-side left
-fill y
2486 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2488 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2489 lappend disable_on_lock \
2490 {.vpane.lower.commarea.buttons.rescan conf
-state}
2492 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2494 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2495 lappend disable_on_lock \
2496 {.vpane.lower.commarea.buttons.incall conf
-state}
2498 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2500 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2502 button .vpane.lower.commarea.buttons.commit
-text [mc Commit@@verb
] \
2504 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2505 lappend disable_on_lock \
2506 {.vpane.lower.commarea.buttons.commit conf
-state}
2508 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2509 -command do_push_anywhere
2510 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2512 # -- Commit Message Buffer
2514 frame .vpane.lower.commarea.buffer
2515 frame .vpane.lower.commarea.buffer.header
2516 set ui_comm .vpane.lower.commarea.buffer.t
2517 set ui_coml .vpane.lower.commarea.buffer.header.l
2518 radiobutton .vpane.lower.commarea.buffer.header.new \
2519 -text [mc
"New Commit"] \
2520 -command do_select_commit_type \
2521 -variable selected_commit_type \
2523 lappend disable_on_lock \
2524 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2525 radiobutton .vpane.lower.commarea.buffer.header.amend \
2526 -text [mc
"Amend Last Commit"] \
2527 -command do_select_commit_type \
2528 -variable selected_commit_type \
2530 lappend disable_on_lock \
2531 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2535 proc trace_commit_type
{varname args
} {
2536 global ui_coml commit_type
2537 switch
-glob -- $commit_type {
2538 initial
{set txt
[mc
"Initial Commit Message:"]}
2539 amend
{set txt
[mc
"Amended Commit Message:"]}
2540 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2541 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2542 merge
{set txt
[mc
"Merge Commit Message:"]}
2543 * {set txt
[mc
"Commit Message:"]}
2545 $ui_coml conf
-text $txt
2547 trace add variable commit_type
write trace_commit_type
2548 pack
$ui_coml -side left
-fill x
2549 pack .vpane.lower.commarea.buffer.header.amend
-side right
2550 pack .vpane.lower.commarea.buffer.header.new
-side right
2552 text
$ui_comm -background white
-foreground black \
2556 -autoseparators true \
2558 -width $repo_config(gui.commitmsgwidth
) -height 9 -wrap none \
2560 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2561 scrollbar .vpane.lower.commarea.buffer.sby \
2562 -command [list
$ui_comm yview
]
2563 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2564 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2565 pack
$ui_comm -side left
-fill y
2566 pack .vpane.lower.commarea.buffer
-side left
-fill y
2568 # -- Commit Message Buffer Context Menu
2570 set ctxm .vpane.lower.commarea.buffer.ctxm
2571 menu
$ctxm -tearoff 0
2574 -command {tk_textCut
$ui_comm}
2577 -command {tk_textCopy
$ui_comm}
2580 -command {tk_textPaste
$ui_comm}
2582 -label [mc Delete
] \
2583 -command {$ui_comm delete sel.first sel.last
}
2586 -label [mc
"Select All"] \
2587 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2589 -label [mc
"Copy All"] \
2591 $ui_comm tag add sel
0.0 end
2592 tk_textCopy
$ui_comm
2593 $ui_comm tag remove sel
0.0 end
2597 -label [mc
"Sign Off"] \
2599 set ui_comm_ctxm
$ctxm
2603 proc trace_current_diff_path
{varname args
} {
2604 global current_diff_path diff_actions file_states
2605 if {$current_diff_path eq
{}} {
2611 set p
$current_diff_path
2612 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2614 set p
[escape_path
$p]
2618 .vpane.lower.
diff.header.status configure
-text $s
2619 .vpane.lower.
diff.header.
file configure
-text $f
2620 .vpane.lower.
diff.header.path configure
-text $p
2621 foreach w
$diff_actions {
2625 trace add variable current_diff_path
write trace_current_diff_path
2627 frame .vpane.lower.
diff.header
-background gold
2628 label .vpane.lower.
diff.header.status \
2631 -width $max_status_desc \
2634 label .vpane.lower.
diff.header.
file \
2639 label .vpane.lower.
diff.header.path \
2644 pack .vpane.lower.
diff.header.status
-side left
2645 pack .vpane.lower.
diff.header.
file -side left
2646 pack .vpane.lower.
diff.header.path
-fill x
2647 set ctxm .vpane.lower.
diff.header.ctxm
2648 menu
$ctxm -tearoff 0
2656 -- $current_diff_path
2658 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2659 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2663 frame .vpane.lower.
diff.body
2664 set ui_diff .vpane.lower.
diff.body.t
2665 text
$ui_diff -background white
-foreground black \
2667 -width 80 -height 15 -wrap none \
2669 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2670 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2672 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2673 -command [list
$ui_diff xview
]
2674 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2675 -command [list
$ui_diff yview
]
2676 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2677 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2678 pack
$ui_diff -side left
-fill both
-expand 1
2679 pack .vpane.lower.
diff.header
-side top
-fill x
2680 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2682 $ui_diff tag conf d_cr
-elide true
2683 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2684 $ui_diff tag conf d_
+ -foreground {#00a000}
2685 $ui_diff tag conf d_-
-foreground red
2687 $ui_diff tag conf d_
++ -foreground {#00a000}
2688 $ui_diff tag conf d_--
-foreground red
2689 $ui_diff tag conf d_
+s \
2690 -foreground {#00a000} \
2691 -background {#e2effa}
2692 $ui_diff tag conf d_-s \
2694 -background {#e2effa}
2695 $ui_diff tag conf d_s
+ \
2696 -foreground {#00a000} \
2698 $ui_diff tag conf d_s- \
2702 $ui_diff tag conf d
<<<<<<< \
2703 -foreground orange \
2705 $ui_diff tag conf d
======= \
2706 -foreground orange \
2708 $ui_diff tag conf d
>>>>>>> \
2709 -foreground orange \
2712 $ui_diff tag raise sel
2714 # -- Diff Body Context Menu
2716 set ctxm .vpane.lower.
diff.body.ctxm
2717 menu
$ctxm -tearoff 0
2719 -label [mc
"Apply/Reverse Hunk"] \
2720 -command {apply_hunk
$cursorX $cursorY}
2721 set ui_diff_applyhunk
[$ctxm index last
]
2722 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2724 -label [mc
"Apply/Reverse Line"] \
2725 -command {apply_line
$cursorX $cursorY; do_rescan
}
2726 set ui_diff_applyline
[$ctxm index last
]
2727 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyline -state]
2730 -label [mc
"Show Less Context"] \
2731 -command show_less_context
2732 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2734 -label [mc
"Show More Context"] \
2735 -command show_more_context
2736 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2739 -label [mc Refresh
] \
2740 -command reshow_diff
2741 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2744 -command {tk_textCopy
$ui_diff}
2745 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2747 -label [mc
"Select All"] \
2748 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2749 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2751 -label [mc
"Copy All"] \
2753 $ui_diff tag add sel
0.0 end
2754 tk_textCopy
$ui_diff
2755 $ui_diff tag remove sel
0.0 end
2757 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2760 -label [mc
"Decrease Font Size"] \
2761 -command {incr_font_size font_diff
-1}
2762 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2764 -label [mc
"Increase Font Size"] \
2765 -command {incr_font_size font_diff
1}
2766 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2768 $ctxm add
command -label [mc
"Options..."] \
2770 proc popup_diff_menu
{ctxm x y X Y
} {
2771 global current_diff_path file_states
2774 if {$
::ui_index eq $
::current_diff_side
} {
2775 set l
[mc
"Unstage Hunk From Commit"]
2776 set t
[mc
"Unstage Line From Commit"]
2778 set l
[mc
"Stage Hunk For Commit"]
2779 set t
[mc
"Stage Line For Commit"]
2782 ||
$current_diff_path eq
{}
2783 ||
![info exists file_states
($current_diff_path)]
2784 ||
{_O
} eq
[lindex
$file_states($current_diff_path) 0]
2785 ||
{_T
} eq
[lindex
$file_states($current_diff_path) 0]
2786 ||
{T_
} eq
[lindex
$file_states($current_diff_path) 0]} {
2791 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
2792 $ctxm entryconf $
::ui_diff_applyline
-state $s -label $t
2793 tk_popup
$ctxm $X $Y
2795 bind_button3
$ui_diff [list popup_diff_menu
$ctxm %x
%y
%X
%Y
]
2799 set main_status
[::status_bar
::new .status
]
2800 pack .status
-anchor w
-side bottom
-fill x
2801 $main_status show
[mc
"Initializing..."]
2806 set gm
$repo_config(gui.geometry
)
2807 wm geometry .
[lindex
$gm 0]
2808 .vpane sash place
0 \
2810 [lindex
[.vpane sash coord
0] 1]
2811 .vpane.files sash place
0 \
2812 [lindex
[.vpane.files sash coord
0] 0] \
2819 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2820 bind $ui_comm <$M1B-Key-t> {do_add_selection
;break}
2821 bind $ui_comm <$M1B-Key-T> {do_add_selection
;break}
2822 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2823 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2824 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2825 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2826 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2827 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2828 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2829 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2830 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2831 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2832 bind $ui_comm <$M1B-Key-minus> {show_less_context
;break}
2833 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context
;break}
2834 bind $ui_comm <$M1B-Key-equal> {show_more_context
;break}
2835 bind $ui_comm <$M1B-Key-plus> {show_more_context
;break}
2836 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context
;break}
2838 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2839 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2840 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2841 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2842 bind $ui_diff <$M1B-Key-v> {break}
2843 bind $ui_diff <$M1B-Key-V> {break}
2844 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2845 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2846 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2847 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2848 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2849 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2850 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2851 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2852 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2853 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2854 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2855 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2856 bind $ui_diff <Button-1
> {focus
%W
}
2858 if {[is_enabled branch
]} {
2859 bind .
<$M1B-Key-n> branch_create
::dialog
2860 bind .
<$M1B-Key-N> branch_create
::dialog
2861 bind .
<$M1B-Key-o> branch_checkout
::dialog
2862 bind .
<$M1B-Key-O> branch_checkout
::dialog
2863 bind .
<$M1B-Key-m> merge
::dialog
2864 bind .
<$M1B-Key-M> merge
::dialog
2866 if {[is_enabled transport
]} {
2867 bind .
<$M1B-Key-p> do_push_anywhere
2868 bind .
<$M1B-Key-P> do_push_anywhere
2871 bind .
<Key-F5
> do_rescan
2872 bind .
<$M1B-Key-r> do_rescan
2873 bind .
<$M1B-Key-R> do_rescan
2874 bind .
<$M1B-Key-s> do_signoff
2875 bind .
<$M1B-Key-S> do_signoff
2876 bind .
<$M1B-Key-t> do_add_selection
2877 bind .
<$M1B-Key-T> do_add_selection
2878 bind .
<$M1B-Key-i> do_add_all
2879 bind .
<$M1B-Key-I> do_add_all
2880 bind .
<$M1B-Key-minus> {show_less_context
;break}
2881 bind .
<$M1B-Key-KP_Subtract> {show_less_context
;break}
2882 bind .
<$M1B-Key-equal> {show_more_context
;break}
2883 bind .
<$M1B-Key-plus> {show_more_context
;break}
2884 bind .
<$M1B-Key-KP_Add> {show_more_context
;break}
2885 bind .
<$M1B-Key-Return> do_commit
2886 foreach i
[list
$ui_index $ui_workdir] {
2887 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2888 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2889 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2893 set file_lists
($ui_index) [list
]
2894 set file_lists
($ui_workdir) [list
]
2896 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2897 focus
-force $ui_comm
2899 # -- Warn the user about environmental problems. Cygwin's Tcl
2900 # does *not* pass its env array onto any processes it spawns.
2901 # This means that git processes get none of our environment.
2906 set msg
[mc
"Possible environment issues exist.
2908 The following environment variables are probably
2909 going to be ignored by any Git subprocess run
2913 foreach name
[array names env
] {
2914 switch
-regexp -- $name {
2915 {^GIT_INDEX_FILE$
} -
2916 {^GIT_OBJECT_DIRECTORY$
} -
2917 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2919 {^GIT_EXTERNAL_DIFF$
} -
2923 {^GIT_CONFIG_LOCAL$
} -
2924 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2925 append msg
" - $name\n"
2928 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2929 append msg
" - $name\n"
2931 set suggest_user
$name
2935 if {$ignored_env > 0} {
2937 This is due to a known issue with the
2938 Tcl binary distributed by Cygwin."]
2940 if {$suggest_user ne
{}} {
2943 A good replacement for %s
2944 is placing values for the user.name and
2945 user.email settings into your personal
2951 unset ignored_env msg suggest_user name
2954 # -- Only initialize complex UI if we are going to stay running.
2956 if {[is_enabled transport
]} {
2959 set n
[.mbar.remote index end
]
2962 set n
[expr {[.mbar.remote index end
] - $n}]
2964 if {[.mbar.remote
type 0] eq
"tearoff"} { incr n
}
2965 .mbar.remote insert
$n separator
2970 if {[winfo exists
$ui_comm]} {
2971 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
2973 # -- If both our backup and message files exist use the
2974 # newer of the two files to initialize the buffer.
2976 if {$GITGUI_BCK_exists} {
2977 set m
[gitdir GITGUI_MSG
]
2978 if {[file isfile
$m]} {
2979 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
2980 catch
{file delete
[gitdir GITGUI_MSG
]}
2982 $ui_comm delete
0.0 end
2984 $ui_comm edit modified false
2985 catch
{file delete
[gitdir GITGUI_BCK
]}
2986 set GITGUI_BCK_exists
0
2992 proc backup_commit_buffer
{} {
2993 global ui_comm GITGUI_BCK_exists
2995 set m
[$ui_comm edit modified
]
2996 if {$m ||
$GITGUI_BCK_exists} {
2997 set msg
[string trim
[$ui_comm get
0.0 end
]]
2998 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3001 if {$GITGUI_BCK_exists} {
3002 catch
{file delete
[gitdir GITGUI_BCK
]}
3003 set GITGUI_BCK_exists
0
3007 set fd
[open
[gitdir GITGUI_BCK
] w
]
3008 puts
-nonewline $fd $msg
3010 set GITGUI_BCK_exists
1
3014 $ui_comm edit modified false
3017 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
3020 backup_commit_buffer
3022 # -- If the user has aspell available we can drive it
3023 # in pipe mode to spellcheck the commit message.
3025 set spell_cmd
[list |
]
3026 set spell_dict
[get_config gui.spellingdictionary
]
3027 lappend spell_cmd aspell
3028 if {$spell_dict ne
{}} {
3029 lappend spell_cmd
--master=$spell_dict
3031 lappend spell_cmd
--mode=none
3032 lappend spell_cmd
--encoding=utf-8
3033 lappend spell_cmd pipe
3034 if {$spell_dict eq
{none
}
3035 ||
[catch
{set spell_fd
[open
$spell_cmd r
+]} spell_err
]} {
3036 bind_button3
$ui_comm [list tk_popup
$ui_comm_ctxm %X
%Y
]
3038 set ui_comm_spell
[spellcheck
::init \
3044 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3047 lock_index begin-read
3048 if {![winfo ismapped .
]} {
3052 if {[is_enabled multicommit
]} {