2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 ||
test "z$*" = z--version
; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
11 set appvers
{@@GITGUI_VERSION@@
}
13 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
15 This program is free software
; you can redistribute it and
/or modify
16 it under the terms of the GNU General Public License as published by
17 the Free Software Foundation
; either version
2 of the License
, or
18 (at your option
) any later version.
20 This program is distributed
in the hope that it will be useful
,
21 but WITHOUT ANY WARRANTY
; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 GNU General Public License
for more details.
25 You should have received a copy of the GNU General Public License
26 along with this program
; if not
, write to the Free Software
27 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}
29 ######################################################################
31 ## Tcl/Tk sanity check
33 if {[catch
{package require Tcl
8.4} err
]
34 ||
[catch
{package require Tk
8.4} err
]
40 -title "git-gui: fatal error" \
45 catch
{rename send
{}} ; # What an evil concept...
47 ######################################################################
51 set oguilib
{@@GITGUI_LIBDIR@@
}
52 set oguirel
{@@GITGUI_RELATIVE@@
}
53 if {$oguirel eq
{1}} {
54 set oguilib
[file dirname [file dirname [file normalize
$argv0]]]
55 set oguilib
[file join $oguilib share git-gui lib
]
56 set oguimsg
[file join $oguilib msgs
]
57 } elseif
{[string match @@
* $oguirel]} {
58 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
59 set oguimsg
[file join [file dirname [file normalize
$argv0]] po
]
61 set oguimsg
[file join $oguilib msgs
]
65 ######################################################################
67 ## enable verbose loading?
69 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
71 rename auto_load real__auto_load
72 proc auto_load
{name args
} {
73 puts stderr
"auto_load $name"
74 return [uplevel
1 real__auto_load
$name $args]
76 rename
source real__source
78 puts stderr
"source $name"
79 uplevel
1 real__source
$name
83 ######################################################################
85 ## Internationalization (i18n) through msgcat and gettext. See
86 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
88 package require msgcat
89 namespace import
::msgcat
::mc
90 ::msgcat
::mcload
$oguimsg
93 ######################################################################
97 set _appname
[lindex
[file split $argv0] end
]
114 return [eval [list
file join $_gitdir] $args]
117 proc gitexec
{args
} {
119 if {$_gitexec eq
{}} {
120 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
121 error
"Git not installed?\n\n$err"
124 set _gitexec
[exec cygpath \
129 set _gitexec
[file normalize
$_gitexec]
135 return [eval [list
file join $_gitexec] $args]
143 if {[tk windowingsystem
] eq
{aqua
}} {
150 if {$
::tcl_platform
(platform
) eq
{windows
}} {
158 if {$_iscygwin eq
{}} {
159 if {$
::tcl_platform
(platform
) eq
{windows
}} {
160 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
172 proc is_enabled
{option
} {
173 global enabled_options
174 if {[catch
{set on
$enabled_options($option)}]} {return 0}
178 proc enable_option
{option
} {
179 global enabled_options
180 set enabled_options
($option) 1
183 proc disable_option
{option
} {
184 global enabled_options
185 set enabled_options
($option) 0
188 ######################################################################
192 proc is_many_config
{name
} {
193 switch
-glob -- $name {
202 proc is_config_true
{name
} {
204 if {[catch
{set v
$repo_config($name)}]} {
206 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
213 proc get_config
{name
} {
215 if {[catch
{set v
$repo_config($name)}]} {
222 proc load_config
{include_global
} {
223 global repo_config global_config default_config
225 array
unset global_config
226 if {$include_global} {
228 set fd_rc
[git_read config
--global --list]
229 while {[gets
$fd_rc line
] >= 0} {
230 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
231 if {[is_many_config
$name]} {
232 lappend global_config
($name) $value
234 set global_config
($name) $value
242 array
unset repo_config
244 set fd_rc
[git_read config
--list]
245 while {[gets
$fd_rc line
] >= 0} {
246 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
247 if {[is_many_config
$name]} {
248 lappend repo_config
($name) $value
250 set repo_config
($name) $value
257 foreach name
[array names default_config
] {
258 if {[catch
{set v
$global_config($name)}]} {
259 set global_config
($name) $default_config($name)
261 if {[catch
{set v
$repo_config($name)}]} {
262 set repo_config
($name) $default_config($name)
267 ######################################################################
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
{}} {
325 set _search_path
[split [exec cygpath \
331 } elseif
{[is_Windows
]} {
332 set _search_path
[split $env(PATH
) {;}]
335 set _search_path
[split $env(PATH
) :]
340 foreach p
$_search_path {
341 set p
[file join $p $what$_search_exe]
342 if {[file exists
$p]} {
343 return [file normalize
$p]
349 proc _lappend_nice
{cmd_var
} {
353 if {![info exists _nice
]} {
354 set _nice
[_which nice
]
365 switch
-- [lindex
$args 0] {
376 set args
[lrange
$args 1 end
]
379 set cmdp
[_git_cmd
[lindex
$args 0]]
380 set args
[lrange
$args 1 end
]
382 return [eval $opt $cmdp $args]
385 proc _open_stdout_stderr
{cmd
} {
389 if { [lindex
$cmd end
] eq
{2>@
1}
390 && $err eq
{can not
find channel named
"1"}
392 # Older versions of Tcl 8.4 don't have this 2>@1 IO
393 # redirect operator. Fallback to |& cat for those.
394 # The command was not actually started, so its safe
395 # to try to start it a second time.
397 set fd
[open
[concat \
398 [lrange
$cmd 0 end-1
] \
405 fconfigure
$fd -eofchar {}
409 proc git_read
{args
} {
413 switch
-- [lindex
$args 0] {
428 set args
[lrange
$args 1 end
]
431 set cmdp
[_git_cmd
[lindex
$args 0]]
432 set args
[lrange
$args 1 end
]
434 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
437 proc git_write
{args
} {
441 switch
-- [lindex
$args 0] {
452 set args
[lrange
$args 1 end
]
455 set cmdp
[_git_cmd
[lindex
$args 0]]
456 set args
[lrange
$args 1 end
]
458 return [open
[concat
$opt $cmdp $args] w
]
462 regsub
-all ' $value "'\\''" value
466 proc load_current_branch {} {
467 global current_branch is_detached
469 set fd [open [gitdir HEAD] r]
470 if {[gets $fd ref] < 1} {
475 set pfx {ref: refs/heads/}
476 set len [string length $pfx]
477 if {[string equal -length $len $pfx $ref]} {
478 # We're on a branch. It might not exist. But
479 # HEAD looks good enough to be a branch.
481 set current_branch [string range $ref $len end]
484 # Assume this is a detached head.
486 set current_branch HEAD
491 auto_load tk_optionMenu
492 rename tk_optionMenu real__tkOptionMenu
493 proc tk_optionMenu {w varName args} {
494 set m [eval real__tkOptionMenu $w $varName $args]
495 $m configure -font font_ui
496 $w configure -font font_ui
500 ######################################################################
504 set _git [_which git]
506 catch {wm withdraw .}
507 error_popup [mc "Cannot
find git
in PATH.
"]
511 ######################################################################
515 if {[catch {set _git_version [git --version]} err]} {
516 catch {wm withdraw .}
520 -title "git-gui
: fatal error
" \
521 -message "Cannot determine Git version
:
525 [appname
] requires Git
1.5.0 or later.
"
528 if {![regsub {^git version } $_git_version {} _git_version]} {
529 catch {wm withdraw .}
533 -title "git-gui
: fatal error
" \
534 -message [append [mc "Cannot parse Git version string
:"] "\n\n$_git_version"]
538 set _real_git_version $_git_version
539 regsub -- {-dirty$} $_git_version {} _git_version
540 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
541 regsub {\.rc[0-9]+$} $_git_version {} _git_version
542 regsub {\.GIT$} $_git_version {} _git_version
544 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
545 catch {wm withdraw .}
550 -title "[appname
]: warning
" \
551 -message [mc "Git version cannot be determined.
553 %s claims it is version
'%s'.
555 %s requires
at least Git
1.5.0 or later.
557 Assume
'%s' is version
1.5.0?
558 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
559 set _git_version 1.5.0
564 unset _real_git_version
566 proc git-version {args} {
569 switch [llength $args] {
575 set op [lindex $args 0]
576 set vr [lindex $args 1]
577 set cm [package vcompare $_git_version $vr]
578 return [expr $cm $op 0]
582 set type [lindex $args 0]
583 set name [lindex $args 1]
584 set parm [lindex $args 2]
585 set body [lindex $args 3]
587 if {($type ne {proc} && $type ne {method})} {
588 error "Invalid arguments to git-version
"
590 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
591 error "Last arm of
$type $name must be default
"
594 foreach {op vr cb} [lrange $body 0 end-2] {
595 if {[git-version $op $vr]} {
596 return [uplevel [list $type $name $parm $cb]]
600 return [uplevel [list $type $name $parm [lindex $body end]]]
604 error "git-version
>= x
"
610 if {[git-version < 1.5]} {
611 catch {wm withdraw .}
615 -title "git-gui
: fatal error
" \
616 -message "[appname
] requires Git
1.5.0 or later.
618 You are using
[git-version
]:
624 ######################################################################
626 ## configure our library
628 set idx [file join $oguilib tclIndex]
629 if {[catch {set fd [open $idx r]} err]} {
630 catch {wm withdraw .}
634 -title "git-gui
: fatal error
" \
638 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
640 while {[gets $fd n] >= 0} {
641 if {$n ne {} && ![string match #* $n]} {
653 if {[lsearch -exact $loaded $p] >= 0} continue
654 source [file join $oguilib $p]
659 set auto_path [concat [list $oguilib] $auto_path]
661 unset -nocomplain idx fd
663 ######################################################################
665 ## feature option selection
667 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
672 if {$subcommand eq {gui.sh}} {
675 if {$subcommand eq {gui} && [llength $argv] > 0} {
676 set subcommand [lindex $argv 0]
677 set argv [lrange $argv 1 end]
680 enable_option multicommit
682 enable_option transport
685 switch -- $subcommand {
690 disable_option multicommit
691 disable_option branch
692 disable_option transport
695 enable_option singlecommit
697 disable_option multicommit
698 disable_option branch
699 disable_option transport
703 ######################################################################
708 set _gitdir $env(GIT_DIR)
712 set _gitdir [git rev-parse --git-dir]
713 set _prefix [git rev-parse --show-prefix]
715 catch {wm withdraw .}
716 error_popup [append [mc "Cannot
find the git directory
:"] "\n\n$err"]
719 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
720 catch {set _gitdir [exec cygpath --unix $_gitdir]}
722 if {![file isdirectory $_gitdir]} {
723 catch {wm withdraw .}
724 error_popup [append [mc "Git directory not found
:"] "\n\n$_gitdir"]
727 if {$_prefix ne {}} {
728 regsub -all {[^/]+/} $_prefix ../ cdup
729 if {[catch {cd $cdup} err]} {
730 catch {wm withdraw .}
731 error_popup "Cannot move to top of working directory
:\n\n$err"
735 } elseif {![is_enabled bare]} {
736 if {[lindex [file split $_gitdir] end] ne {.git}} {
737 catch {wm withdraw .}
738 error_popup [append [mc "Cannot use funny .git directory
:"] "\n\n$_gitdir"]
741 if {[catch {cd [file dirname $_gitdir]} err]} {
742 catch {wm withdraw .}
743 error_popup [append [mc "No working directory
"] " [file dirname $_gitdir]:\n\n$err"]
747 set _reponame [file split [file normalize $_gitdir]]
748 if {[lindex $_reponame end] eq {.git}} {
749 set _reponame [lindex $_reponame end-1]
751 set _reponame [lindex $_reponame end]
754 ######################################################################
758 set current_diff_path {}
759 set current_diff_side {}
760 set diff_actions [list]
764 set MERGE_HEAD [list]
767 set current_branch {}
769 set current_diff_path {}
771 set selected_commit_type new
773 ######################################################################
781 set disable_on_lock [list]
782 set index_lock_type none
784 proc lock_index {type} {
785 global index_lock_type disable_on_lock
787 if {$index_lock_type eq {none}} {
788 set index_lock_type $type
789 foreach w $disable_on_lock {
790 uplevel #0 $w disabled
793 } elseif {$index_lock_type eq "begin-
$type"} {
794 set index_lock_type $type
800 proc unlock_index {} {
801 global index_lock_type disable_on_lock
803 set index_lock_type none
804 foreach w $disable_on_lock {
809 ######################################################################
813 proc repository_state {ctvar hdvar mhvar} {
814 global current_branch
815 upvar $ctvar ct $hdvar hd $mhvar mh
820 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
826 set merge_head [gitdir MERGE_HEAD]
827 if {[file exists $merge_head]} {
829 set fd_mh [open $merge_head r]
830 while {[gets $fd_mh line] >= 0} {
841 global PARENT empty_tree
843 set p [lindex $PARENT 0]
847 if {$empty_tree eq {}} {
848 set empty_tree [git mktree << {}]
853 proc rescan {after {honor_trustmtime 1}} {
854 global HEAD PARENT MERGE_HEAD commit_type
855 global ui_index ui_workdir ui_comm
856 global rescan_active file_states
859 if {$rescan_active > 0 || ![lock_index read]} return
861 repository_state newType newHEAD newMERGE_HEAD
862 if {[string match amend* $commit_type]
863 && $newType eq {normal}
864 && $newHEAD eq $HEAD} {
868 set MERGE_HEAD $newMERGE_HEAD
869 set commit_type $newType
872 array unset file_states
874 if {!$::GITGUI_BCK_exists &&
875 (![$ui_comm edit modified]
876 || [string trim [$ui_comm get 0.0 end]] eq {})} {
877 if {[string match amend* $commit_type]} {
878 } elseif {[load_message GITGUI_MSG]} {
879 } elseif {[load_message MERGE_MSG]} {
880 } elseif {[load_message SQUASH_MSG]} {
883 $ui_comm edit modified false
886 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
887 rescan_stage2 {} $after
890 ui_status [mc "Refreshing
file status...
"]
891 set fd_rf [git_read update-index \
897 fconfigure $fd_rf -blocking 0 -translation binary
898 fileevent $fd_rf readable \
899 [list rescan_stage2 $fd_rf $after]
903 proc rescan_stage2 {fd after} {
904 global rescan_active buf_rdi buf_rdf buf_rlo
908 if {![eof $fd]} return
912 set ls_others [list --exclude-per-directory=.gitignore]
913 set info_exclude [gitdir info exclude]
914 if {[file readable $info_exclude]} {
915 lappend ls_others "--exclude-from=$info_exclude"
917 set user_exclude [get_config core.excludesfile]
918 if {$user_exclude ne {} && [file readable $user_exclude]} {
919 lappend ls_others "--exclude-from=$user_exclude"
927 ui_status [mc "Scanning
for modified files ...
"]
928 set fd_di [git_read diff-index --cached -z [PARENT]]
929 set fd_df [git_read diff-files -z]
930 set fd_lo [eval git_read ls-files --others -z $ls_others]
932 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
933 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
934 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
935 fileevent $fd_di readable [list read_diff_index $fd_di $after]
936 fileevent $fd_df readable [list read_diff_files $fd_df $after]
937 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
940 proc load_message {file} {
944 if {[file isfile $f]} {
945 if {[catch {set fd [open $f r]}]} {
948 fconfigure $fd -eofchar {}
949 set content [string trim [read $fd]]
951 regsub -all -line {[ \r\t]+$} $content {} content
952 $ui_comm delete 0.0 end
953 $ui_comm insert end $content
959 proc read_diff_index {fd after} {
962 append buf_rdi [read $fd]
964 set n [string length $buf_rdi]
966 set z1 [string first "\
0" $buf_rdi $c]
969 set z2 [string first "\
0" $buf_rdi $z1]
973 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
974 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
976 [encoding convertfrom $p] \
978 [list [lindex $i 0] [lindex $i 2]] \
984 set buf_rdi [string range $buf_rdi $c end]
989 rescan_done $fd buf_rdi $after
992 proc read_diff_files {fd after} {
995 append buf_rdf [read $fd]
997 set n [string length $buf_rdf]
999 set z1 [string first "\
0" $buf_rdf $c]
1000 if {$z1 == -1} break
1002 set z2 [string first "\
0" $buf_rdf $z1]
1003 if {$z2 == -1} break
1006 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1007 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1009 [encoding convertfrom $p] \
1012 [list [lindex $i 0] [lindex $i 2]]
1017 set buf_rdf [string range $buf_rdf $c end]
1022 rescan_done $fd buf_rdf $after
1025 proc read_ls_others {fd after} {
1028 append buf_rlo [read $fd]
1029 set pck [split $buf_rlo "\
0"]
1030 set buf_rlo [lindex $pck end]
1031 foreach p [lrange $pck 0 end-1] {
1032 set p [encoding convertfrom $p]
1033 if {[string index $p end] eq {/}} {
1034 set p [string range $p 0 end-1]
1038 rescan_done $fd buf_rlo $after
1041 proc rescan_done {fd buf after} {
1042 global rescan_active current_diff_path
1043 global file_states repo_config
1046 if {![eof $fd]} return
1049 if {[incr rescan_active -1] > 0} return
1054 if {$current_diff_path ne {}} reshow_diff
1058 proc prune_selection {} {
1059 global file_states selected_paths
1061 foreach path [array names selected_paths] {
1062 if {[catch {set still_here $file_states($path)}]} {
1063 unset selected_paths($path)
1068 ######################################################################
1072 proc mapicon {w state path} {
1075 if {[catch {set r $all_icons($state$w)}]} {
1076 puts "error
: no icon
for $w state
={$state} $path"
1082 proc mapdesc {state path} {
1085 if {[catch {set r $all_descs($state)}]} {
1086 puts "error
: no desc
for state
={$state} $path"
1092 proc ui_status {msg} {
1093 $::main_status show $msg
1096 proc ui_ready {{test {}}} {
1097 $::main_status show [mc "Ready.
"] $test
1100 proc escape_path {path} {
1101 regsub -all {\\} $path "\\\\" path
1102 regsub -all "\n" $path "\\n
" path
1106 proc short_path {path} {
1107 return [escape_path [lindex [file split $path] end]]
1111 set null_sha1 [string repeat 0 40]
1113 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1114 global file_states next_icon_id null_sha1
1116 set s0 [string index $new_state 0]
1117 set s1 [string index $new_state 1]
1119 if {[catch {set info $file_states($path)}]} {
1121 set icon n[incr next_icon_id]
1123 set state [lindex $info 0]
1124 set icon [lindex $info 1]
1125 if {$head_info eq {}} {set head_info [lindex $info 2]}
1126 if {$index_info eq {}} {set index_info [lindex $info 3]}
1129 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1130 elseif {$s0 eq {_}} {set s0 _}
1132 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1133 elseif {$s1 eq {_}} {set s1 _}
1135 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1136 set head_info [list 0 $null_sha1]
1137 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1138 && $head_info eq {}} {
1139 set head_info $index_info
1142 set file_states($path) [list $s0$s1 $icon \
1143 $head_info $index_info \
1148 proc display_file_helper {w path icon_name old_m new_m} {
1151 if {$new_m eq {_}} {
1152 set lno [lsearch -sorted -exact $file_lists($w) $path]
1154 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1156 $w conf -state normal
1157 $w delete $lno.0 [expr {$lno + 1}].0
1158 $w conf -state disabled
1160 } elseif {$old_m eq {_} && $new_m ne {_}} {
1161 lappend file_lists($w) $path
1162 set file_lists($w) [lsort -unique $file_lists($w)]
1163 set lno [lsearch -sorted -exact $file_lists($w) $path]
1165 $w conf -state normal
1166 $w image create $lno.0 \
1167 -align center -padx 5 -pady 1 \
1169 -image [mapicon $w $new_m $path]
1170 $w insert $lno.1 "[escape_path
$path]\n"
1171 $w conf -state disabled
1172 } elseif {$old_m ne $new_m} {
1173 $w conf -state normal
1174 $w image conf $icon_name -image [mapicon $w $new_m $path]
1175 $w conf -state disabled
1179 proc display_file {path state} {
1180 global file_states selected_paths
1181 global ui_index ui_workdir
1183 set old_m [merge_state $path $state]
1184 set s $file_states($path)
1185 set new_m [lindex $s 0]
1186 set icon_name [lindex $s 1]
1188 set o [string index $old_m 0]
1189 set n [string index $new_m 0]
1196 display_file_helper $ui_index $path $icon_name $o $n
1198 if {[string index $old_m 0] eq {U}} {
1201 set o [string index $old_m 1]
1203 if {[string index $new_m 0] eq {U}} {
1206 set n [string index $new_m 1]
1208 display_file_helper $ui_workdir $path $icon_name $o $n
1210 if {$new_m eq {__}} {
1211 unset file_states($path)
1212 catch {unset selected_paths($path)}
1216 proc display_all_files_helper {w path icon_name m} {
1219 lappend file_lists($w) $path
1220 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1221 $w image create end \
1222 -align center -padx 5 -pady 1 \
1224 -image [mapicon $w $m $path]
1225 $w insert end "[escape_path
$path]\n"
1228 proc display_all_files {} {
1229 global ui_index ui_workdir
1230 global file_states file_lists
1233 $ui_index conf -state normal
1234 $ui_workdir conf -state normal
1236 $ui_index delete 0.0 end
1237 $ui_workdir delete 0.0 end
1240 set file_lists($ui_index) [list]
1241 set file_lists($ui_workdir) [list]
1243 foreach path [lsort [array names file_states]] {
1244 set s $file_states($path)
1246 set icon_name [lindex $s 1]
1248 set s [string index $m 0]
1249 if {$s ne {U} && $s ne {_}} {
1250 display_all_files_helper $ui_index $path \
1254 if {[string index $m 0] eq {U}} {
1257 set s [string index $m 1]
1260 display_all_files_helper $ui_workdir $path \
1265 $ui_index conf -state disabled
1266 $ui_workdir conf -state disabled
1269 ######################################################################
1274 #define mask_width 14
1275 #define mask_height 15
1276 static unsigned char mask_bits[] = {
1277 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1278 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1279 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1282 image create bitmap file_plain -background white -foreground black -data {
1283 #define plain_width 14
1284 #define plain_height 15
1285 static unsigned char plain_bits[] = {
1286 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1287 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1288 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1289 } -maskdata $filemask
1291 image create bitmap file_mod -background white -foreground blue -data {
1292 #define mod_width 14
1293 #define mod_height 15
1294 static unsigned char mod_bits[] = {
1295 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1296 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1297 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1298 } -maskdata $filemask
1300 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1301 #define file_fulltick_width 14
1302 #define file_fulltick_height 15
1303 static unsigned char file_fulltick_bits
[] = {
1304 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1305 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1306 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1307 } -maskdata $filemask
1309 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1310 #define parttick_width 14
1311 #define parttick_height 15
1312 static unsigned char parttick_bits
[] = {
1313 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1314 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1315 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1316 } -maskdata $filemask
1318 image create bitmap file_question
-background white
-foreground black
-data {
1319 #define file_question_width 14
1320 #define file_question_height 15
1321 static unsigned char file_question_bits
[] = {
1322 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1323 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1324 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1325 } -maskdata $filemask
1327 image create bitmap file_removed
-background white
-foreground red
-data {
1328 #define file_removed_width 14
1329 #define file_removed_height 15
1330 static unsigned char file_removed_bits
[] = {
1331 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1332 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1333 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1334 } -maskdata $filemask
1336 image create bitmap file_merge
-background white
-foreground blue
-data {
1337 #define file_merge_width 14
1338 #define file_merge_height 15
1339 static unsigned char file_merge_bits
[] = {
1340 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1341 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1342 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1343 } -maskdata $filemask
1345 set ui_index .vpane.files.index.list
1346 set ui_workdir .vpane.files.workdir.list
1348 set all_icons
(_
$ui_index) file_plain
1349 set all_icons
(A
$ui_index) file_fulltick
1350 set all_icons
(M
$ui_index) file_fulltick
1351 set all_icons
(D
$ui_index) file_removed
1352 set all_icons
(U
$ui_index) file_merge
1354 set all_icons
(_
$ui_workdir) file_plain
1355 set all_icons
(M
$ui_workdir) file_mod
1356 set all_icons
(D
$ui_workdir) file_question
1357 set all_icons
(U
$ui_workdir) file_merge
1358 set all_icons
(O
$ui_workdir) file_plain
1360 set max_status_desc
0
1362 {__
{mc
"Unmodified"}}
1364 {_M
{mc
"Modified, not staged"}}
1365 {M_
{mc
"Staged for commit"}}
1366 {MM
{mc
"Portions staged for commit"}}
1367 {MD
{mc
"Staged for commit, missing"}}
1369 {_O
{mc
"Untracked, not staged"}}
1370 {A_
{mc
"Staged for commit"}}
1371 {AM
{mc
"Portions staged for commit"}}
1372 {AD
{mc
"Staged for commit, missing"}}
1375 {D_
{mc
"Staged for removal"}}
1376 {DO
{mc
"Staged for removal, still present"}}
1378 {U_
{mc
"Requires merge resolution"}}
1379 {UU
{mc
"Requires merge resolution"}}
1380 {UM
{mc
"Requires merge resolution"}}
1381 {UD
{mc
"Requires merge resolution"}}
1383 set text
[eval [lindex
$i 1]]
1384 if {$max_status_desc < [string length
$text]} {
1385 set max_status_desc
[string length
$text]
1387 set all_descs
([lindex
$i 0]) $text
1391 ######################################################################
1395 proc bind_button3
{w cmd
} {
1396 bind $w <Any-Button-3
> $cmd
1398 # Mac OS X sends Button-2 on right click through three-button mouse,
1399 # or through trackpad right-clicking (two-finger touch + click).
1400 bind $w <Any-Button-2
> $cmd
1401 bind $w <Control-Button-1
> $cmd
1405 proc scrollbar2many
{list mode args
} {
1406 foreach w
$list {eval $w $mode $args}
1409 proc many2scrollbar
{list mode sb top bottom
} {
1410 $sb set $top $bottom
1411 foreach w
$list {$w $mode moveto
$top}
1414 proc incr_font_size
{font
{amt
1}} {
1415 set sz
[font configure
$font -size]
1417 font configure
$font -size $sz
1418 font configure
${font}bold
-size $sz
1419 font configure
${font}italic
-size $sz
1422 ######################################################################
1426 set starting_gitk_msg
[mc
"Starting gitk... please wait..."]
1428 proc do_gitk
{revs
} {
1429 # -- Always start gitk through whatever we were loaded with. This
1430 # lets us bypass using shell process on Windows systems.
1432 set exe
[file join [file dirname $
::_git
] gitk
]
1433 set cmd
[list
[info nameofexecutable
] $exe]
1434 if {! [file exists
$exe]} {
1435 error_popup
[mc
"Unable to start gitk:\n\n%s does not exist" $exe]
1437 eval exec $cmd $revs &
1438 ui_status $
::starting_gitk_msg
1440 ui_ready
$starting_gitk_msg
1448 global ui_comm is_quitting repo_config commit_type
1449 global GITGUI_BCK_exists GITGUI_BCK_i
1451 if {$is_quitting} return
1454 if {[winfo exists
$ui_comm]} {
1455 # -- Stash our current commit buffer.
1457 set save
[gitdir GITGUI_MSG
]
1458 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1459 file rename
-force [gitdir GITGUI_BCK
] $save
1460 set GITGUI_BCK_exists
0
1462 set msg
[string trim
[$ui_comm get
0.0 end
]]
1463 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1464 if {(![string match amend
* $commit_type]
1465 ||
[$ui_comm edit modified
])
1468 set fd
[open
$save w
]
1469 puts
-nonewline $fd $msg
1473 catch
{file delete
$save}
1477 # -- Remove our editor backup, its not needed.
1479 after cancel
$GITGUI_BCK_i
1480 if {$GITGUI_BCK_exists} {
1481 catch
{file delete
[gitdir GITGUI_BCK
]}
1484 # -- Stash our current window geometry into this repository.
1486 set cfg_geometry
[list
]
1487 lappend cfg_geometry
[wm geometry .
]
1488 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1489 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1490 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1493 if {$cfg_geometry ne
$rc_geometry} {
1494 catch
{git config gui.geometry
$cfg_geometry}
1509 proc toggle_or_diff
{w x y
} {
1510 global file_states file_lists current_diff_path ui_index ui_workdir
1511 global last_clicked selected_paths
1513 set pos
[split [$w index @
$x,$y] .
]
1514 set lno
[lindex
$pos 0]
1515 set col [lindex
$pos 1]
1516 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1522 set last_clicked
[list
$w $lno]
1523 array
unset selected_paths
1524 $ui_index tag remove in_sel
0.0 end
1525 $ui_workdir tag remove in_sel
0.0 end
1528 if {$current_diff_path eq
$path} {
1529 set after
{reshow_diff
;}
1533 if {$w eq
$ui_index} {
1535 "Unstaging [short_path $path] from commit" \
1537 [concat
$after [list ui_ready
]]
1538 } elseif
{$w eq
$ui_workdir} {
1540 "Adding [short_path $path]" \
1542 [concat
$after [list ui_ready
]]
1545 show_diff
$path $w $lno
1549 proc add_one_to_selection
{w x y
} {
1550 global file_lists last_clicked selected_paths
1552 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1553 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1559 if {$last_clicked ne
{}
1560 && [lindex
$last_clicked 0] ne
$w} {
1561 array
unset selected_paths
1562 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1565 set last_clicked
[list
$w $lno]
1566 if {[catch
{set in_sel
$selected_paths($path)}]} {
1570 unset selected_paths
($path)
1571 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1573 set selected_paths
($path) 1
1574 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1578 proc add_range_to_selection
{w x y
} {
1579 global file_lists last_clicked selected_paths
1581 if {[lindex
$last_clicked 0] ne
$w} {
1582 toggle_or_diff
$w $x $y
1586 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1587 set lc
[lindex
$last_clicked 1]
1596 foreach path
[lrange
$file_lists($w) \
1597 [expr {$begin - 1}] \
1598 [expr {$end - 1}]] {
1599 set selected_paths
($path) 1
1601 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1604 ######################################################################
1608 set cursor_ptr arrow
1609 font create font_diff
-family Courier
-size 10
1613 eval font configure font_ui
[font actual
[.dummy cget
-font]]
1617 font create font_uiitalic
1618 font create font_uibold
1619 font create font_diffbold
1620 font create font_diffitalic
1622 foreach class
{Button Checkbutton Entry Label
1623 Labelframe Listbox Menu Message
1624 Radiobutton Spinbox Text
} {
1625 option add
*$class.font font_ui
1629 if {[is_Windows
] ||
[is_MacOSX
]} {
1630 option add
*Menu.tearOff
0
1641 proc apply_config
{} {
1642 global repo_config font_descs
1644 foreach option
$font_descs {
1645 set name
[lindex
$option 0]
1646 set font
[lindex
$option 1]
1648 foreach
{cn cv
} $repo_config(gui.
$name) {
1649 font configure
$font $cn $cv
1652 error_popup
[append
[mc
"Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
1654 foreach
{cn cv
} [font configure
$font] {
1655 font configure
${font}bold
$cn $cv
1656 font configure
${font}italic
$cn $cv
1658 font configure
${font}bold
-weight bold
1659 font configure
${font}italic
-slant italic
1663 set default_config
(merge.diffstat
) true
1664 set default_config
(merge.summary
) false
1665 set default_config
(merge.verbosity
) 2
1666 set default_config
(user.name
) {}
1667 set default_config
(user.email
) {}
1669 set default_config
(gui.matchtrackingbranch
) false
1670 set default_config
(gui.pruneduringfetch
) false
1671 set default_config
(gui.trustmtime
) false
1672 set default_config
(gui.diffcontext
) 5
1673 set default_config
(gui.newbranchtemplate
) {}
1674 set default_config
(gui.fontui
) [font configure font_ui
]
1675 set default_config
(gui.fontdiff
) [font configure font_diff
]
1677 {fontui font_ui
{mc
"Main Font"}}
1678 {fontdiff font_diff
{mc
"Diff/Console Font"}}
1683 ######################################################################
1691 menu .mbar
-tearoff 0
1692 .mbar add cascade
-label [mc Repository
] -menu .mbar.repository
1693 .mbar add cascade
-label [mc Edit
] -menu .mbar.edit
1694 if {[is_enabled branch
]} {
1695 .mbar add cascade
-label [mc Branch
] -menu .mbar.branch
1697 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1698 .mbar add cascade
-label [mc Commit
] -menu .mbar.commit
1700 if {[is_enabled transport
]} {
1701 .mbar add cascade
-label [mc Merge
] -menu .mbar.merge
1702 .mbar add cascade
-label [mc Fetch
] -menu .mbar.fetch
1703 .mbar add cascade
-label [mc Push
] -menu .mbar.push
1705 . configure
-menu .mbar
1707 # -- Repository Menu
1709 menu .mbar.repository
1711 .mbar.repository add
command \
1712 -label [mc
"Browse Current Branch's Files"] \
1713 -command {browser
::new
$current_branch}
1714 set ui_browse_current
[.mbar.repository index last
]
1715 .mbar.repository add
command \
1716 -label [mc
"Browse Branch Files..."] \
1717 -command browser_open
::dialog
1718 .mbar.repository add separator
1720 .mbar.repository add
command \
1721 -label [mc
"Visualize Current Branch's History"] \
1722 -command {do_gitk
$current_branch}
1723 set ui_visualize_current
[.mbar.repository index last
]
1724 .mbar.repository add
command \
1725 -label [mc
"Visualize All Branch History"] \
1726 -command {do_gitk
--all}
1727 .mbar.repository add separator
1729 proc current_branch_write
{args
} {
1730 global current_branch
1731 .mbar.repository entryconf $
::ui_browse_current \
1732 -label [mc
"Browse %s's Files" $current_branch]
1733 .mbar.repository entryconf $
::ui_visualize_current \
1734 -label [mc
"Visualize %s's History" $current_branch]
1736 trace add variable current_branch
write current_branch_write
1738 if {[is_enabled multicommit
]} {
1739 .mbar.repository add
command -label [mc
"Database Statistics"] \
1742 .mbar.repository add
command -label [mc
"Compress Database"] \
1745 .mbar.repository add
command -label [mc
"Verify Database"] \
1746 -command do_fsck_objects
1748 .mbar.repository add separator
1751 .mbar.repository add
command \
1752 -label [mc
"Create Desktop Icon"] \
1753 -command do_cygwin_shortcut
1754 } elseif
{[is_Windows
]} {
1755 .mbar.repository add
command \
1756 -label [mc
"Create Desktop Icon"] \
1757 -command do_windows_shortcut
1758 } elseif
{[is_MacOSX
]} {
1759 .mbar.repository add
command \
1760 -label [mc
"Create Desktop Icon"] \
1761 -command do_macosx_app
1765 .mbar.repository add
command -label [mc Quit
] \
1772 .mbar.edit add
command -label [mc Undo
] \
1773 -command {catch
{[focus
] edit undo
}} \
1775 .mbar.edit add
command -label [mc Redo
] \
1776 -command {catch
{[focus
] edit redo
}} \
1778 .mbar.edit add separator
1779 .mbar.edit add
command -label [mc Cut
] \
1780 -command {catch
{tk_textCut
[focus
]}} \
1782 .mbar.edit add
command -label [mc Copy
] \
1783 -command {catch
{tk_textCopy
[focus
]}} \
1785 .mbar.edit add
command -label [mc Paste
] \
1786 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1788 .mbar.edit add
command -label [mc Delete
] \
1789 -command {catch
{[focus
] delete sel.first sel.last
}} \
1791 .mbar.edit add separator
1792 .mbar.edit add
command -label [mc
"Select All"] \
1793 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1798 if {[is_enabled branch
]} {
1801 .mbar.branch add
command -label [mc
"Create..."] \
1802 -command branch_create
::dialog \
1804 lappend disable_on_lock
[list .mbar.branch entryconf \
1805 [.mbar.branch index last
] -state]
1807 .mbar.branch add
command -label [mc
"Checkout..."] \
1808 -command branch_checkout
::dialog \
1810 lappend disable_on_lock
[list .mbar.branch entryconf \
1811 [.mbar.branch index last
] -state]
1813 .mbar.branch add
command -label [mc
"Rename..."] \
1814 -command branch_rename
::dialog
1815 lappend disable_on_lock
[list .mbar.branch entryconf \
1816 [.mbar.branch index last
] -state]
1818 .mbar.branch add
command -label [mc
"Delete..."] \
1819 -command branch_delete
::dialog
1820 lappend disable_on_lock
[list .mbar.branch entryconf \
1821 [.mbar.branch index last
] -state]
1823 .mbar.branch add
command -label [mc
"Reset..."] \
1824 -command merge
::reset_hard
1825 lappend disable_on_lock
[list .mbar.branch entryconf \
1826 [.mbar.branch index last
] -state]
1831 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1834 .mbar.commit add radiobutton \
1835 -label [mc
"New Commit"] \
1836 -command do_select_commit_type \
1837 -variable selected_commit_type \
1839 lappend disable_on_lock \
1840 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1842 .mbar.commit add radiobutton \
1843 -label [mc
"Amend Last Commit"] \
1844 -command do_select_commit_type \
1845 -variable selected_commit_type \
1847 lappend disable_on_lock \
1848 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1850 .mbar.commit add separator
1852 .mbar.commit add
command -label [mc Rescan
] \
1853 -command do_rescan \
1855 lappend disable_on_lock \
1856 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1858 .mbar.commit add
command -label [mc
"Stage To Commit"] \
1859 -command do_add_selection
1860 lappend disable_on_lock \
1861 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1863 .mbar.commit add
command -label [mc
"Stage Changed Files To Commit"] \
1864 -command do_add_all \
1866 lappend disable_on_lock \
1867 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1869 .mbar.commit add
command -label [mc
"Unstage From Commit"] \
1870 -command do_unstage_selection
1871 lappend disable_on_lock \
1872 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1874 .mbar.commit add
command -label [mc
"Revert Changes"] \
1875 -command do_revert_selection
1876 lappend disable_on_lock \
1877 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1879 .mbar.commit add separator
1881 .mbar.commit add
command -label [mc
"Sign Off"] \
1882 -command do_signoff \
1885 .mbar.commit add
command -label [mc Commit
] \
1886 -command do_commit \
1887 -accelerator $M1T-Return
1888 lappend disable_on_lock \
1889 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1894 if {[is_enabled branch
]} {
1896 .mbar.merge add
command -label [mc
"Local Merge..."] \
1897 -command merge
::dialog \
1899 lappend disable_on_lock \
1900 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1901 .mbar.merge add
command -label [mc
"Abort Merge..."] \
1902 -command merge
::reset_hard
1903 lappend disable_on_lock \
1904 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1909 if {[is_enabled transport
]} {
1913 .mbar.push add
command -label [mc
"Push..."] \
1914 -command do_push_anywhere \
1916 .mbar.push add
command -label [mc
"Delete..."] \
1917 -command remote_branch_delete
::dialog
1921 # -- Apple Menu (Mac OS X only)
1923 .mbar add cascade
-label [mc Apple
] -menu .mbar.apple
1926 .mbar.apple add
command -label [mc
"About %s" [appname
]] \
1928 .mbar.apple add
command -label [mc
"Options..."] \
1933 .mbar.edit add separator
1934 .mbar.edit add
command -label [mc
"Options..."] \
1940 .mbar add cascade
-label [mc Help
] -menu .mbar.
help
1944 .mbar.
help add
command -label [mc
"About %s" [appname
]] \
1949 catch
{set browser
$repo_config(instaweb.browser
)}
1950 set doc_path
[file dirname [gitexec
]]
1951 set doc_path
[file join $doc_path Documentation index.html
]
1954 set doc_path
[exec cygpath
--mixed $doc_path]
1957 if {$browser eq
{}} {
1960 } elseif
{[is_Cygwin
]} {
1961 set program_files
[file dirname [exec cygpath
--windir]]
1962 set program_files
[file join $program_files {Program Files
}]
1963 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
1964 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
1965 if {[file exists
$firefox]} {
1966 set browser
$firefox
1967 } elseif
{[file exists
$ie]} {
1970 unset program_files firefox ie
1974 if {[file isfile
$doc_path]} {
1975 set doc_url
"file:$doc_path"
1977 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
1980 if {$browser ne
{}} {
1981 .mbar.
help add
command -label [mc
"Online Documentation"] \
1982 -command [list
exec $browser $doc_url &]
1984 unset browser doc_path doc_url
1987 bind .
<Visibility
> {
1988 bind .
<Visibility
> {}
1992 # -- Standard bindings
1994 wm protocol . WM_DELETE_WINDOW do_quit
1995 bind all
<$M1B-Key-q> do_quit
1996 bind all
<$M1B-Key-Q> do_quit
1997 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1998 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2000 set subcommand_args
{}
2002 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2006 # -- Not a normal commit type invocation? Do that instead!
2008 switch
-- $subcommand {
2011 set subcommand_args
{rev? path
}
2012 if {$argv eq
{}} usage
2017 if {$is_path ||
[file exists
$_prefix$a]} {
2018 if {$path ne
{}} usage
2021 } elseif
{$a eq
{--}} {
2023 if {$head ne
{}} usage
2028 } elseif
{$head eq
{}} {
2029 if {$head ne
{}} usage
2038 if {$head ne
{} && $path eq
{}} {
2039 set path
$_prefix$head
2046 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2048 set head [git rev-parse
--verify $head]
2054 set current_branch
$head
2057 switch
-- $subcommand {
2060 if {$path ne
{} && [file isdirectory
$path]} {
2061 set head $current_branch
2067 browser
::new
$head $path
2070 if {$head eq
{} && ![file exists
$path]} {
2071 puts stderr
"fatal: cannot stat path $path: No such file or directory"
2074 blame
::new
$head $path
2081 if {[llength
$argv] != 0} {
2082 puts
-nonewline stderr
"usage: $argv0"
2083 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
2084 puts
-nonewline stderr
" $subcommand"
2089 # fall through to setup UI for commits
2092 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2103 -text [mc
"Current Branch:"] \
2107 -textvariable current_branch \
2110 pack .branch.l1
-side left
2111 pack .branch.cb
-side left
-fill x
2112 pack .branch
-side top
-fill x
2114 # -- Main Window Layout
2116 panedwindow .vpane
-orient vertical
2117 panedwindow .vpane.files
-orient horizontal
2118 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2119 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2121 # -- Index File List
2123 frame .vpane.files.index
-height 100 -width 200
2124 label .vpane.files.index.title
-text [mc
"Staged Changes (Will Be Committed)"] \
2125 -background lightgreen
2126 text
$ui_index -background white
-borderwidth 0 \
2127 -width 20 -height 10 \
2129 -cursor $cursor_ptr \
2130 -xscrollcommand {.vpane.files.index.sx
set} \
2131 -yscrollcommand {.vpane.files.index.sy
set} \
2133 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2134 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2135 pack .vpane.files.index.title
-side top
-fill x
2136 pack .vpane.files.index.sx
-side bottom
-fill x
2137 pack .vpane.files.index.sy
-side right
-fill y
2138 pack
$ui_index -side left
-fill both
-expand 1
2139 .vpane.files add .vpane.files.index
-sticky nsew
2141 # -- Working Directory File List
2143 frame .vpane.files.workdir
-height 100 -width 200
2144 label .vpane.files.workdir.title
-text [mc
"Unstaged Changes (Will Not Be Committed)"] \
2145 -background lightsalmon
2146 text
$ui_workdir -background white
-borderwidth 0 \
2147 -width 20 -height 10 \
2149 -cursor $cursor_ptr \
2150 -xscrollcommand {.vpane.files.workdir.sx
set} \
2151 -yscrollcommand {.vpane.files.workdir.sy
set} \
2153 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2154 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2155 pack .vpane.files.workdir.title
-side top
-fill x
2156 pack .vpane.files.workdir.sx
-side bottom
-fill x
2157 pack .vpane.files.workdir.sy
-side right
-fill y
2158 pack
$ui_workdir -side left
-fill both
-expand 1
2159 .vpane.files add .vpane.files.workdir
-sticky nsew
2161 foreach i
[list
$ui_index $ui_workdir] {
2162 $i tag conf in_diff
-background lightgray
2163 $i tag conf in_sel
-background lightgray
2167 # -- Diff and Commit Area
2169 frame .vpane.lower
-height 300 -width 400
2170 frame .vpane.lower.commarea
2171 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2172 pack .vpane.lower.commarea
-side top
-fill x
2173 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
2174 .vpane add .vpane.lower
-sticky nsew
2176 # -- Commit Area Buttons
2178 frame .vpane.lower.commarea.buttons
2179 label .vpane.lower.commarea.buttons.l
-text {} \
2182 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2183 pack .vpane.lower.commarea.buttons
-side left
-fill y
2185 button .vpane.lower.commarea.buttons.rescan
-text [mc Rescan
] \
2187 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2188 lappend disable_on_lock \
2189 {.vpane.lower.commarea.buttons.rescan conf
-state}
2191 button .vpane.lower.commarea.buttons.incall
-text [mc
"Stage Changed"] \
2193 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2194 lappend disable_on_lock \
2195 {.vpane.lower.commarea.buttons.incall conf
-state}
2197 button .vpane.lower.commarea.buttons.signoff
-text [mc
"Sign Off"] \
2199 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2201 button .vpane.lower.commarea.buttons.commit
-text [mc Commit
] \
2203 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2204 lappend disable_on_lock \
2205 {.vpane.lower.commarea.buttons.commit conf
-state}
2207 button .vpane.lower.commarea.buttons.push
-text [mc Push
] \
2208 -command do_push_anywhere
2209 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2211 # -- Commit Message Buffer
2213 frame .vpane.lower.commarea.buffer
2214 frame .vpane.lower.commarea.buffer.header
2215 set ui_comm .vpane.lower.commarea.buffer.t
2216 set ui_coml .vpane.lower.commarea.buffer.header.l
2217 radiobutton .vpane.lower.commarea.buffer.header.new \
2218 -text [mc
"New Commit"] \
2219 -command do_select_commit_type \
2220 -variable selected_commit_type \
2222 lappend disable_on_lock \
2223 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2224 radiobutton .vpane.lower.commarea.buffer.header.amend \
2225 -text [mc
"Amend Last Commit"] \
2226 -command do_select_commit_type \
2227 -variable selected_commit_type \
2229 lappend disable_on_lock \
2230 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2234 proc trace_commit_type
{varname args
} {
2235 global ui_coml commit_type
2236 switch
-glob -- $commit_type {
2237 initial
{set txt
[mc
"Initial Commit Message:"]}
2238 amend
{set txt
[mc
"Amended Commit Message:"]}
2239 amend-initial
{set txt
[mc
"Amended Initial Commit Message:"]}
2240 amend-merge
{set txt
[mc
"Amended Merge Commit Message:"]}
2241 merge
{set txt
[mc
"Merge Commit Message:"]}
2242 * {set txt
[mc
"Commit Message:"]}
2244 $ui_coml conf
-text $txt
2246 trace add variable commit_type
write trace_commit_type
2247 pack
$ui_coml -side left
-fill x
2248 pack .vpane.lower.commarea.buffer.header.amend
-side right
2249 pack .vpane.lower.commarea.buffer.header.new
-side right
2251 text
$ui_comm -background white
-borderwidth 1 \
2254 -autoseparators true \
2256 -width 75 -height 9 -wrap none \
2258 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2259 scrollbar .vpane.lower.commarea.buffer.sby \
2260 -command [list
$ui_comm yview
]
2261 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2262 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2263 pack
$ui_comm -side left
-fill y
2264 pack .vpane.lower.commarea.buffer
-side left
-fill y
2266 # -- Commit Message Buffer Context Menu
2268 set ctxm .vpane.lower.commarea.buffer.ctxm
2269 menu
$ctxm -tearoff 0
2272 -command {tk_textCut
$ui_comm}
2275 -command {tk_textCopy
$ui_comm}
2278 -command {tk_textPaste
$ui_comm}
2280 -label [mc Delete
] \
2281 -command {$ui_comm delete sel.first sel.last
}
2284 -label [mc
"Select All"] \
2285 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2287 -label [mc
"Copy All"] \
2289 $ui_comm tag add sel
0.0 end
2290 tk_textCopy
$ui_comm
2291 $ui_comm tag remove sel
0.0 end
2295 -label [mc
"Sign Off"] \
2297 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
2301 proc trace_current_diff_path
{varname args
} {
2302 global current_diff_path diff_actions file_states
2303 if {$current_diff_path eq
{}} {
2309 set p
$current_diff_path
2310 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2312 set p
[escape_path
$p]
2316 .vpane.lower.
diff.header.status configure
-text $s
2317 .vpane.lower.
diff.header.
file configure
-text $f
2318 .vpane.lower.
diff.header.path configure
-text $p
2319 foreach w
$diff_actions {
2323 trace add variable current_diff_path
write trace_current_diff_path
2325 frame .vpane.lower.
diff.header
-background gold
2326 label .vpane.lower.
diff.header.status \
2328 -width $max_status_desc \
2331 label .vpane.lower.
diff.header.
file \
2335 label .vpane.lower.
diff.header.path \
2339 pack .vpane.lower.
diff.header.status
-side left
2340 pack .vpane.lower.
diff.header.
file -side left
2341 pack .vpane.lower.
diff.header.path
-fill x
2342 set ctxm .vpane.lower.
diff.header.ctxm
2343 menu
$ctxm -tearoff 0
2351 -- $current_diff_path
2353 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2354 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2358 frame .vpane.lower.
diff.body
2359 set ui_diff .vpane.lower.
diff.body.t
2360 text
$ui_diff -background white
-borderwidth 0 \
2361 -width 80 -height 15 -wrap none \
2363 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2364 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2366 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2367 -command [list
$ui_diff xview
]
2368 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2369 -command [list
$ui_diff yview
]
2370 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2371 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2372 pack
$ui_diff -side left
-fill both
-expand 1
2373 pack .vpane.lower.
diff.header
-side top
-fill x
2374 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2376 $ui_diff tag conf d_cr
-elide true
2377 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2378 $ui_diff tag conf d_
+ -foreground {#00a000}
2379 $ui_diff tag conf d_-
-foreground red
2381 $ui_diff tag conf d_
++ -foreground {#00a000}
2382 $ui_diff tag conf d_--
-foreground red
2383 $ui_diff tag conf d_
+s \
2384 -foreground {#00a000} \
2385 -background {#e2effa}
2386 $ui_diff tag conf d_-s \
2388 -background {#e2effa}
2389 $ui_diff tag conf d_s
+ \
2390 -foreground {#00a000} \
2392 $ui_diff tag conf d_s- \
2396 $ui_diff tag conf d
<<<<<<< \
2397 -foreground orange \
2399 $ui_diff tag conf d
======= \
2400 -foreground orange \
2402 $ui_diff tag conf d
>>>>>>> \
2403 -foreground orange \
2406 $ui_diff tag raise sel
2408 # -- Diff Body Context Menu
2410 set ctxm .vpane.lower.
diff.body.ctxm
2411 menu
$ctxm -tearoff 0
2413 -label [mc Refresh
] \
2414 -command reshow_diff
2415 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2418 -command {tk_textCopy
$ui_diff}
2419 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2421 -label [mc
"Select All"] \
2422 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2423 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2425 -label [mc
"Copy All"] \
2427 $ui_diff tag add sel
0.0 end
2428 tk_textCopy
$ui_diff
2429 $ui_diff tag remove sel
0.0 end
2431 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2434 -label [mc
"Apply/Reverse Hunk"] \
2435 -command {apply_hunk
$cursorX $cursorY}
2436 set ui_diff_applyhunk
[$ctxm index last
]
2437 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2440 -label [mc
"Decrease Font Size"] \
2441 -command {incr_font_size font_diff
-1}
2442 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2444 -label [mc
"Increase Font Size"] \
2445 -command {incr_font_size font_diff
1}
2446 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2449 -label [mc
"Show Less Context"] \
2450 -command {if {$repo_config(gui.diffcontext
) >= 1} {
2451 incr repo_config
(gui.diffcontext
) -1
2454 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2456 -label [mc
"Show More Context"] \
2457 -command {if {$repo_config(gui.diffcontext
) < 99} {
2458 incr repo_config
(gui.diffcontext
)
2461 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2463 $ctxm add
command -label [mc
"Options..."] \
2465 proc popup_diff_menu
{ctxm x y X Y
} {
2466 global current_diff_path file_states
2469 if {$
::ui_index eq $
::current_diff_side
} {
2470 set l
[mc
"Unstage Hunk From Commit"]
2472 set l
[mc
"Stage Hunk For Commit"]
2475 ||
$current_diff_path eq
{}
2476 ||
![info exists file_states
($current_diff_path)]
2477 ||
{_O
} eq
[lindex
$file_states($current_diff_path) 0]} {
2482 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
2483 tk_popup
$ctxm $X $Y
2485 bind_button3
$ui_diff [list popup_diff_menu
$ctxm %x
%y
%X
%Y
]
2489 set main_status
[::status_bar
::new .status
]
2490 pack .status
-anchor w
-side bottom
-fill x
2491 $main_status show
[mc
"Initializing..."]
2496 set gm
$repo_config(gui.geometry
)
2497 wm geometry .
[lindex
$gm 0]
2498 .vpane sash place
0 \
2499 [lindex
[.vpane sash coord
0] 0] \
2501 .vpane.files sash place
0 \
2503 [lindex
[.vpane.files sash coord
0] 1]
2509 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2510 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2511 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2512 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2513 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2514 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2515 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2516 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2517 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2518 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2519 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2521 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2522 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2523 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2524 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2525 bind $ui_diff <$M1B-Key-v> {break}
2526 bind $ui_diff <$M1B-Key-V> {break}
2527 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2528 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2529 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2530 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2531 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2532 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2533 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2534 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2535 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2536 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2537 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2538 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2539 bind $ui_diff <Button-1
> {focus
%W
}
2541 if {[is_enabled branch
]} {
2542 bind .
<$M1B-Key-n> branch_create
::dialog
2543 bind .
<$M1B-Key-N> branch_create
::dialog
2544 bind .
<$M1B-Key-o> branch_checkout
::dialog
2545 bind .
<$M1B-Key-O> branch_checkout
::dialog
2546 bind .
<$M1B-Key-m> merge
::dialog
2547 bind .
<$M1B-Key-M> merge
::dialog
2549 if {[is_enabled transport
]} {
2550 bind .
<$M1B-Key-p> do_push_anywhere
2551 bind .
<$M1B-Key-P> do_push_anywhere
2554 bind .
<Key-F5
> do_rescan
2555 bind .
<$M1B-Key-r> do_rescan
2556 bind .
<$M1B-Key-R> do_rescan
2557 bind .
<$M1B-Key-s> do_signoff
2558 bind .
<$M1B-Key-S> do_signoff
2559 bind .
<$M1B-Key-i> do_add_all
2560 bind .
<$M1B-Key-I> do_add_all
2561 bind .
<$M1B-Key-Return> do_commit
2562 foreach i
[list
$ui_index $ui_workdir] {
2563 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2564 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2565 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2569 set file_lists
($ui_index) [list
]
2570 set file_lists
($ui_workdir) [list
]
2572 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2573 focus
-force $ui_comm
2575 # -- Warn the user about environmental problems. Cygwin's Tcl
2576 # does *not* pass its env array onto any processes it spawns.
2577 # This means that git processes get none of our environment.
2582 set msg
"Possible environment issues exist.
2584 The following environment variables are probably
2585 going to be ignored by any Git subprocess run
2589 foreach name
[array names env
] {
2590 switch
-regexp -- $name {
2591 {^GIT_INDEX_FILE$
} -
2592 {^GIT_OBJECT_DIRECTORY$
} -
2593 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2595 {^GIT_EXTERNAL_DIFF$
} -
2599 {^GIT_CONFIG_LOCAL$
} -
2600 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2601 append msg
" - $name\n"
2604 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2605 append msg
" - $name\n"
2607 set suggest_user
$name
2611 if {$ignored_env > 0} {
2613 This is due to a known issue with the
2614 Tcl binary distributed by Cygwin."
2616 if {$suggest_user ne
{}} {
2619 A good replacement for $suggest_user
2620 is placing values for the user.name and
2621 user.email settings into your personal
2627 unset ignored_env msg suggest_user name
2630 # -- Only initialize complex UI if we are going to stay running.
2632 if {[is_enabled transport
]} {
2639 if {[winfo exists
$ui_comm]} {
2640 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
2642 # -- If both our backup and message files exist use the
2643 # newer of the two files to initialize the buffer.
2645 if {$GITGUI_BCK_exists} {
2646 set m
[gitdir GITGUI_MSG
]
2647 if {[file isfile
$m]} {
2648 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
2649 catch
{file delete
[gitdir GITGUI_MSG
]}
2651 $ui_comm delete
0.0 end
2653 $ui_comm edit modified false
2654 catch
{file delete
[gitdir GITGUI_BCK
]}
2655 set GITGUI_BCK_exists
0
2661 proc backup_commit_buffer
{} {
2662 global ui_comm GITGUI_BCK_exists
2664 set m
[$ui_comm edit modified
]
2665 if {$m ||
$GITGUI_BCK_exists} {
2666 set msg
[string trim
[$ui_comm get
0.0 end
]]
2667 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2670 if {$GITGUI_BCK_exists} {
2671 catch
{file delete
[gitdir GITGUI_BCK
]}
2672 set GITGUI_BCK_exists
0
2676 set fd
[open
[gitdir GITGUI_BCK
] w
]
2677 puts
-nonewline $fd $msg
2679 set GITGUI_BCK_exists
1
2683 $ui_comm edit modified false
2686 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
2689 backup_commit_buffer
2692 lock_index begin-read
2693 if {![winfo ismapped .
]} {
2697 if {[is_enabled multicommit
]} {