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 ######################################################################
49 set oguilib
{@@GITGUI_LIBDIR@@
}
50 set oguirel
{@@GITGUI_RELATIVE@@
}
51 if {$oguirel eq
{1}} {
52 set oguilib
[file dirname [file dirname [file normalize
$argv0]]]
53 set oguilib
[file join $oguilib share git-gui lib
]
54 } elseif
{[string match @@
* $oguirel]} {
55 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
59 ######################################################################
61 ## enable verbose loading?
63 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
65 rename auto_load real__auto_load
66 proc auto_load
{name args
} {
67 puts stderr
"auto_load $name"
68 return [uplevel
1 real__auto_load
$name $args]
70 rename
source real__source
72 puts stderr
"source $name"
73 uplevel
1 real__source
$name
77 ######################################################################
81 set _appname
[lindex
[file split $argv0] end
]
98 return [eval [list
file join $_gitdir] $args]
101 proc gitexec
{args
} {
103 if {$_gitexec eq
{}} {
104 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
105 error
"Git not installed?\n\n$err"
108 set _gitexec
[exec cygpath \
113 set _gitexec
[file normalize
$_gitexec]
119 return [eval [list
file join $_gitexec] $args]
127 if {[tk windowingsystem
] eq
{aqua
}} {
134 if {$
::tcl_platform
(platform
) eq
{windows
}} {
142 if {$_iscygwin eq
{}} {
143 if {$
::tcl_platform
(platform
) eq
{windows
}} {
144 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
156 proc is_enabled
{option
} {
157 global enabled_options
158 if {[catch
{set on
$enabled_options($option)}]} {return 0}
162 proc enable_option
{option
} {
163 global enabled_options
164 set enabled_options
($option) 1
167 proc disable_option
{option
} {
168 global enabled_options
169 set enabled_options
($option) 0
172 ######################################################################
176 proc is_many_config
{name
} {
177 switch
-glob -- $name {
186 proc is_config_true
{name
} {
188 if {[catch
{set v
$repo_config($name)}]} {
190 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
197 proc get_config
{name
} {
199 if {[catch
{set v
$repo_config($name)}]} {
206 proc load_config
{include_global
} {
207 global repo_config global_config default_config
209 array
unset global_config
210 if {$include_global} {
212 set fd_rc
[git_read config
--global --list]
213 while {[gets
$fd_rc line
] >= 0} {
214 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
215 if {[is_many_config
$name]} {
216 lappend global_config
($name) $value
218 set global_config
($name) $value
226 array
unset repo_config
228 set fd_rc
[git_read config
--list]
229 while {[gets
$fd_rc line
] >= 0} {
230 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
231 if {[is_many_config
$name]} {
232 lappend repo_config
($name) $value
234 set repo_config
($name) $value
241 foreach name
[array names default_config
] {
242 if {[catch
{set v
$global_config($name)}]} {
243 set global_config
($name) $default_config($name)
245 if {[catch
{set v
$repo_config($name)}]} {
246 set repo_config
($name) $default_config($name)
251 ######################################################################
255 proc _git_cmd
{name
} {
258 if {[catch
{set v
$_git_cmd_path($name)}]} {
262 --exec-path { return [list $
::_git
$name] }
265 set p
[gitexec git-
$name$
::_search_exe
]
266 if {[file exists
$p]} {
268 } elseif
{[is_Windows
] && [file exists
[gitexec git-
$name]]} {
269 # Try to determine what sort of magic will make
270 # git-$name go and do its thing, because native
271 # Tcl on Windows doesn't know it.
273 set p
[gitexec git-
$name]
280 #!*perl { set i perl }
281 #!*python { set i python }
282 default
{ error
"git-$name is not supported: $s" }
286 if {![info exists interp
]} {
287 set interp
[_which
$i]
290 error
"git-$name requires $i (not in PATH)"
292 set v
[list
$interp $p]
294 # Assume it is builtin to git somehow and we
295 # aren't actually able to see a file for it.
297 set v
[list $
::_git
$name]
299 set _git_cmd_path
($name) $v
305 global env _search_exe _search_path
307 if {$_search_path eq
{}} {
309 set _search_path
[split [exec cygpath \
315 } elseif
{[is_Windows
]} {
316 set _search_path
[split $env(PATH
) {;}]
319 set _search_path
[split $env(PATH
) :]
324 foreach p
$_search_path {
325 set p
[file join $p $what$_search_exe]
326 if {[file exists
$p]} {
327 return [file normalize
$p]
333 proc _lappend_nice
{cmd_var
} {
337 if {![info exists _nice
]} {
338 set _nice
[_which nice
]
349 switch
-- [lindex
$args 0] {
360 set args
[lrange
$args 1 end
]
363 set cmdp
[_git_cmd
[lindex
$args 0]]
364 set args
[lrange
$args 1 end
]
366 return [eval $opt $cmdp $args]
369 proc _open_stdout_stderr
{cmd
} {
373 if { [lindex
$cmd end
] eq
{2>@
1}
374 && $err eq
{can not
find channel named
"1"}
376 # Older versions of Tcl 8.4 don't have this 2>@1 IO
377 # redirect operator. Fallback to |& cat for those.
378 # The command was not actually started, so its safe
379 # to try to start it a second time.
381 set fd
[open
[concat \
382 [lrange
$cmd 0 end-1
] \
389 fconfigure
$fd -eofchar {}
393 proc git_read
{args
} {
397 switch
-- [lindex
$args 0] {
412 set args
[lrange
$args 1 end
]
415 set cmdp
[_git_cmd
[lindex
$args 0]]
416 set args
[lrange
$args 1 end
]
418 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
421 proc git_write
{args
} {
425 switch
-- [lindex
$args 0] {
436 set args
[lrange
$args 1 end
]
439 set cmdp
[_git_cmd
[lindex
$args 0]]
440 set args
[lrange
$args 1 end
]
442 return [open
[concat
$opt $cmdp $args] w
]
446 regsub
-all ' $value "'\\''" value
450 proc load_current_branch {} {
451 global current_branch is_detached
453 set fd [open [gitdir HEAD] r]
454 if {[gets $fd ref] < 1} {
459 set pfx {ref: refs/heads/}
460 set len [string length $pfx]
461 if {[string equal -length $len $pfx $ref]} {
462 # We're on a branch. It might not exist. But
463 # HEAD looks good enough to be a branch.
465 set current_branch [string range $ref $len end]
468 # Assume this is a detached head.
470 set current_branch HEAD
475 auto_load tk_optionMenu
476 rename tk_optionMenu real__tkOptionMenu
477 proc tk_optionMenu {w varName args} {
478 set m [eval real__tkOptionMenu $w $varName $args]
479 $m configure -font font_ui
480 $w configure -font font_ui
484 ######################################################################
488 set _git [_which git]
490 catch {wm withdraw .}
491 error_popup "Cannot
find git
in PATH.
"
495 ######################################################################
499 if {[catch {set _git_version [git --version]} err]} {
500 catch {wm withdraw .}
504 -title "git-gui
: fatal error
" \
505 -message "Cannot determine Git version
:
509 [appname
] requires Git
1.5.0 or later.
"
512 if {![regsub {^git version } $_git_version {} _git_version]} {
513 catch {wm withdraw .}
517 -title "git-gui
: fatal error
" \
518 -message "Cannot parse Git version string
:\n\n$_git_version"
522 set _real_git_version $_git_version
523 regsub -- {-dirty$} $_git_version {} _git_version
524 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
525 regsub {\.rc[0-9]+$} $_git_version {} _git_version
526 regsub {\.GIT$} $_git_version {} _git_version
528 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
529 catch {wm withdraw .}
534 -title "[appname
]: warning
" \
535 -message "Git version cannot be determined.
537 $_git claims it is version
'$_real_git_version'.
539 [appname
] requires
at least Git
1.5.0 or later.
541 Assume
'$_real_git_version' is version
1.5.0?
543 set _git_version 1.5.0
548 unset _real_git_version
550 proc git-version {args} {
553 switch [llength $args] {
559 set op [lindex $args 0]
560 set vr [lindex $args 1]
561 set cm [package vcompare $_git_version $vr]
562 return [expr $cm $op 0]
566 set type [lindex $args 0]
567 set name [lindex $args 1]
568 set parm [lindex $args 2]
569 set body [lindex $args 3]
571 if {($type ne {proc} && $type ne {method})} {
572 error "Invalid arguments to git-version
"
574 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
575 error "Last arm of
$type $name must be default
"
578 foreach {op vr cb} [lrange $body 0 end-2] {
579 if {[git-version $op $vr]} {
580 return [uplevel [list $type $name $parm $cb]]
584 return [uplevel [list $type $name $parm [lindex $body end]]]
588 error "git-version
>= x
"
594 if {[git-version < 1.5]} {
595 catch {wm withdraw .}
599 -title "git-gui
: fatal error
" \
600 -message "[appname
] requires Git
1.5.0 or later.
602 You are using
[git-version
]:
608 ######################################################################
610 ## configure our library
612 set idx [file join $oguilib tclIndex]
613 if {[catch {set fd [open $idx r]} err]} {
614 catch {wm withdraw .}
618 -title "git-gui
: fatal error
" \
622 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
624 while {[gets $fd n] >= 0} {
625 if {$n ne {} && ![string match #* $n]} {
637 if {[lsearch -exact $loaded $p] >= 0} continue
638 source [file join $oguilib $p]
643 set auto_path [concat [list $oguilib] $auto_path]
645 unset -nocomplain idx fd
647 ######################################################################
649 ## feature option selection
651 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
656 if {$subcommand eq {gui.sh}} {
659 if {$subcommand eq {gui} && [llength $argv] > 0} {
660 set subcommand [lindex $argv 0]
661 set argv [lrange $argv 1 end]
664 enable_option multicommit
666 enable_option transport
669 switch -- $subcommand {
674 disable_option multicommit
675 disable_option branch
676 disable_option transport
679 enable_option singlecommit
681 disable_option multicommit
682 disable_option branch
683 disable_option transport
687 ######################################################################
692 set _gitdir $env(GIT_DIR)
696 set _gitdir [git rev-parse --git-dir]
697 set _prefix [git rev-parse --show-prefix]
699 catch {wm withdraw .}
700 error_popup "Cannot
find the git directory
:\n\n$err"
703 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
704 catch {set _gitdir [exec cygpath --unix $_gitdir]}
706 if {![file isdirectory $_gitdir]} {
707 catch {wm withdraw .}
708 error_popup "Git directory not found
:\n\n$_gitdir"
711 if {$_prefix ne {}} {
712 regsub -all {[^/]+/} $_prefix ../ cdup
713 if {[catch {cd $cdup} err]} {
714 catch {wm withdraw .}
715 error_popup "Cannot move to top of working directory
:\n\n$err"
719 } elseif {![is_enabled bare]} {
720 if {[lindex [file split $_gitdir] end] ne {.git}} {
721 catch {wm withdraw .}
722 error_popup "Cannot use funny .git directory
:\n\n$_gitdir"
725 if {[catch {cd [file dirname $_gitdir]} err]} {
726 catch {wm withdraw .}
727 error_popup "No working directory
[file dirname $_gitdir]:\n\n$err"
731 set _reponame [file split [file normalize $_gitdir]]
732 if {[lindex $_reponame end] eq {.git}} {
733 set _reponame [lindex $_reponame end-1]
735 set _reponame [lindex $_reponame end]
738 ######################################################################
742 set current_diff_path {}
743 set current_diff_side {}
744 set diff_actions [list]
748 set MERGE_HEAD [list]
751 set current_branch {}
753 set current_diff_path {}
755 set selected_commit_type new
757 ######################################################################
765 set disable_on_lock [list]
766 set index_lock_type none
768 proc lock_index {type} {
769 global index_lock_type disable_on_lock
771 if {$index_lock_type eq {none}} {
772 set index_lock_type $type
773 foreach w $disable_on_lock {
774 uplevel #0 $w disabled
777 } elseif {$index_lock_type eq "begin-
$type"} {
778 set index_lock_type $type
784 proc unlock_index {} {
785 global index_lock_type disable_on_lock
787 set index_lock_type none
788 foreach w $disable_on_lock {
793 ######################################################################
797 proc repository_state {ctvar hdvar mhvar} {
798 global current_branch
799 upvar $ctvar ct $hdvar hd $mhvar mh
804 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
810 set merge_head [gitdir MERGE_HEAD]
811 if {[file exists $merge_head]} {
813 set fd_mh [open $merge_head r]
814 while {[gets $fd_mh line] >= 0} {
825 global PARENT empty_tree
827 set p [lindex $PARENT 0]
831 if {$empty_tree eq {}} {
832 set empty_tree [git mktree << {}]
837 proc rescan {after {honor_trustmtime 1}} {
838 global HEAD PARENT MERGE_HEAD commit_type
839 global ui_index ui_workdir ui_comm
840 global rescan_active file_states
843 if {$rescan_active > 0 || ![lock_index read]} return
845 repository_state newType newHEAD newMERGE_HEAD
846 if {[string match amend* $commit_type]
847 && $newType eq {normal}
848 && $newHEAD eq $HEAD} {
852 set MERGE_HEAD $newMERGE_HEAD
853 set commit_type $newType
856 array unset file_states
858 if {!$::GITGUI_BCK_exists &&
859 (![$ui_comm edit modified]
860 || [string trim [$ui_comm get 0.0 end]] eq {})} {
861 if {[string match amend* $commit_type]} {
862 } elseif {[load_message GITGUI_MSG]} {
863 } elseif {[load_message MERGE_MSG]} {
864 } elseif {[load_message SQUASH_MSG]} {
867 $ui_comm edit modified false
870 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
871 rescan_stage2 {} $after
874 ui_status {Refreshing file status...}
875 set fd_rf [git_read update-index \
881 fconfigure $fd_rf -blocking 0 -translation binary
882 fileevent $fd_rf readable \
883 [list rescan_stage2 $fd_rf $after]
887 proc rescan_stage2 {fd after} {
888 global rescan_active buf_rdi buf_rdf buf_rlo
892 if {![eof $fd]} return
896 set ls_others [list --exclude-per-directory=.gitignore]
897 set info_exclude [gitdir info exclude]
898 if {[file readable $info_exclude]} {
899 lappend ls_others "--exclude-from=$info_exclude"
901 set user_exclude [get_config core.excludesfile]
902 if {$user_exclude ne {} && [file readable $user_exclude]} {
903 lappend ls_others "--exclude-from=$user_exclude"
911 ui_status {Scanning for modified files ...}
912 set fd_di [git_read diff-index --cached -z [PARENT]]
913 set fd_df [git_read diff-files -z]
914 set fd_lo [eval git_read ls-files --others -z $ls_others]
916 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
917 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
918 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
919 fileevent $fd_di readable [list read_diff_index $fd_di $after]
920 fileevent $fd_df readable [list read_diff_files $fd_df $after]
921 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
924 proc load_message {file} {
928 if {[file isfile $f]} {
929 if {[catch {set fd [open $f r]}]} {
932 fconfigure $fd -eofchar {}
933 set content [string trim [read $fd]]
935 regsub -all -line {[ \r\t]+$} $content {} content
936 $ui_comm delete 0.0 end
937 $ui_comm insert end $content
943 proc read_diff_index {fd after} {
946 append buf_rdi [read $fd]
948 set n [string length $buf_rdi]
950 set z1 [string first "\
0" $buf_rdi $c]
953 set z2 [string first "\
0" $buf_rdi $z1]
957 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
958 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
960 [encoding convertfrom $p] \
962 [list [lindex $i 0] [lindex $i 2]] \
968 set buf_rdi [string range $buf_rdi $c end]
973 rescan_done $fd buf_rdi $after
976 proc read_diff_files {fd after} {
979 append buf_rdf [read $fd]
981 set n [string length $buf_rdf]
983 set z1 [string first "\
0" $buf_rdf $c]
986 set z2 [string first "\
0" $buf_rdf $z1]
990 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
991 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
993 [encoding convertfrom $p] \
996 [list [lindex $i 0] [lindex $i 2]]
1001 set buf_rdf [string range $buf_rdf $c end]
1006 rescan_done $fd buf_rdf $after
1009 proc read_ls_others {fd after} {
1012 append buf_rlo [read $fd]
1013 set pck [split $buf_rlo "\
0"]
1014 set buf_rlo [lindex $pck end]
1015 foreach p [lrange $pck 0 end-1] {
1016 merge_state [encoding convertfrom $p] ?O
1018 rescan_done $fd buf_rlo $after
1021 proc rescan_done {fd buf after} {
1022 global rescan_active current_diff_path
1023 global file_states repo_config
1026 if {![eof $fd]} return
1029 if {[incr rescan_active -1] > 0} return
1034 if {$current_diff_path ne {}} reshow_diff
1038 proc prune_selection {} {
1039 global file_states selected_paths
1041 foreach path [array names selected_paths] {
1042 if {[catch {set still_here $file_states($path)}]} {
1043 unset selected_paths($path)
1048 ######################################################################
1052 proc mapicon {w state path} {
1055 if {[catch {set r $all_icons($state$w)}]} {
1056 puts "error
: no icon
for $w state
={$state} $path"
1062 proc mapdesc {state path} {
1065 if {[catch {set r $all_descs($state)}]} {
1066 puts "error
: no desc
for state
={$state} $path"
1072 proc ui_status {msg} {
1073 $::main_status show $msg
1076 proc ui_ready {{test {}}} {
1077 $::main_status show {Ready.} $test
1080 proc escape_path {path} {
1081 regsub -all {\\} $path "\\\\" path
1082 regsub -all "\n" $path "\\n
" path
1086 proc short_path {path} {
1087 return [escape_path [lindex [file split $path] end]]
1091 set null_sha1 [string repeat 0 40]
1093 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1094 global file_states next_icon_id null_sha1
1096 set s0 [string index $new_state 0]
1097 set s1 [string index $new_state 1]
1099 if {[catch {set info $file_states($path)}]} {
1101 set icon n[incr next_icon_id]
1103 set state [lindex $info 0]
1104 set icon [lindex $info 1]
1105 if {$head_info eq {}} {set head_info [lindex $info 2]}
1106 if {$index_info eq {}} {set index_info [lindex $info 3]}
1109 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1110 elseif {$s0 eq {_}} {set s0 _}
1112 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1113 elseif {$s1 eq {_}} {set s1 _}
1115 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1116 set head_info [list 0 $null_sha1]
1117 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1118 && $head_info eq {}} {
1119 set head_info $index_info
1122 set file_states($path) [list $s0$s1 $icon \
1123 $head_info $index_info \
1128 proc display_file_helper {w path icon_name old_m new_m} {
1131 if {$new_m eq {_}} {
1132 set lno [lsearch -sorted -exact $file_lists($w) $path]
1134 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1136 $w conf -state normal
1137 $w delete $lno.0 [expr {$lno + 1}].0
1138 $w conf -state disabled
1140 } elseif {$old_m eq {_} && $new_m ne {_}} {
1141 lappend file_lists($w) $path
1142 set file_lists($w) [lsort -unique $file_lists($w)]
1143 set lno [lsearch -sorted -exact $file_lists($w) $path]
1145 $w conf -state normal
1146 $w image create $lno.0 \
1147 -align center -padx 5 -pady 1 \
1149 -image [mapicon $w $new_m $path]
1150 $w insert $lno.1 "[escape_path
$path]\n"
1151 $w conf -state disabled
1152 } elseif {$old_m ne $new_m} {
1153 $w conf -state normal
1154 $w image conf $icon_name -image [mapicon $w $new_m $path]
1155 $w conf -state disabled
1159 proc display_file {path state} {
1160 global file_states selected_paths
1161 global ui_index ui_workdir
1163 set old_m [merge_state $path $state]
1164 set s $file_states($path)
1165 set new_m [lindex $s 0]
1166 set icon_name [lindex $s 1]
1168 set o [string index $old_m 0]
1169 set n [string index $new_m 0]
1176 display_file_helper $ui_index $path $icon_name $o $n
1178 if {[string index $old_m 0] eq {U}} {
1181 set o [string index $old_m 1]
1183 if {[string index $new_m 0] eq {U}} {
1186 set n [string index $new_m 1]
1188 display_file_helper $ui_workdir $path $icon_name $o $n
1190 if {$new_m eq {__}} {
1191 unset file_states($path)
1192 catch {unset selected_paths($path)}
1196 proc display_all_files_helper {w path icon_name m} {
1199 lappend file_lists($w) $path
1200 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1201 $w image create end \
1202 -align center -padx 5 -pady 1 \
1204 -image [mapicon $w $m $path]
1205 $w insert end "[escape_path
$path]\n"
1208 proc display_all_files {} {
1209 global ui_index ui_workdir
1210 global file_states file_lists
1213 $ui_index conf -state normal
1214 $ui_workdir conf -state normal
1216 $ui_index delete 0.0 end
1217 $ui_workdir delete 0.0 end
1220 set file_lists($ui_index) [list]
1221 set file_lists($ui_workdir) [list]
1223 foreach path [lsort [array names file_states]] {
1224 set s $file_states($path)
1226 set icon_name [lindex $s 1]
1228 set s [string index $m 0]
1229 if {$s ne {U} && $s ne {_}} {
1230 display_all_files_helper $ui_index $path \
1234 if {[string index $m 0] eq {U}} {
1237 set s [string index $m 1]
1240 display_all_files_helper $ui_workdir $path \
1245 $ui_index conf -state disabled
1246 $ui_workdir conf -state disabled
1249 ######################################################################
1254 #define mask_width 14
1255 #define mask_height 15
1256 static unsigned char mask_bits[] = {
1257 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1258 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1259 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1262 image create bitmap file_plain -background white -foreground black -data {
1263 #define plain_width 14
1264 #define plain_height 15
1265 static unsigned char plain_bits[] = {
1266 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1267 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1268 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1269 } -maskdata $filemask
1271 image create bitmap file_mod -background white -foreground blue -data {
1272 #define mod_width 14
1273 #define mod_height 15
1274 static unsigned char mod_bits[] = {
1275 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1276 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1277 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1278 } -maskdata $filemask
1280 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1281 #define file_fulltick_width 14
1282 #define file_fulltick_height 15
1283 static unsigned char file_fulltick_bits
[] = {
1284 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1285 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1286 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1287 } -maskdata $filemask
1289 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1290 #define parttick_width 14
1291 #define parttick_height 15
1292 static unsigned char parttick_bits
[] = {
1293 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1294 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1295 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1296 } -maskdata $filemask
1298 image create bitmap file_question
-background white
-foreground black
-data {
1299 #define file_question_width 14
1300 #define file_question_height 15
1301 static unsigned char file_question_bits
[] = {
1302 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1303 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1304 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1305 } -maskdata $filemask
1307 image create bitmap file_removed
-background white
-foreground red
-data {
1308 #define file_removed_width 14
1309 #define file_removed_height 15
1310 static unsigned char file_removed_bits
[] = {
1311 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1312 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1313 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1314 } -maskdata $filemask
1316 image create bitmap file_merge
-background white
-foreground blue
-data {
1317 #define file_merge_width 14
1318 #define file_merge_height 15
1319 static unsigned char file_merge_bits
[] = {
1320 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1321 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1322 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1323 } -maskdata $filemask
1325 set ui_index .vpane.files.index.list
1326 set ui_workdir .vpane.files.workdir.list
1328 set all_icons
(_
$ui_index) file_plain
1329 set all_icons
(A
$ui_index) file_fulltick
1330 set all_icons
(M
$ui_index) file_fulltick
1331 set all_icons
(D
$ui_index) file_removed
1332 set all_icons
(U
$ui_index) file_merge
1334 set all_icons
(_
$ui_workdir) file_plain
1335 set all_icons
(M
$ui_workdir) file_mod
1336 set all_icons
(D
$ui_workdir) file_question
1337 set all_icons
(U
$ui_workdir) file_merge
1338 set all_icons
(O
$ui_workdir) file_plain
1340 set max_status_desc
0
1344 {_M
"Modified, not staged"}
1345 {M_
"Staged for commit"}
1346 {MM
"Portions staged for commit"}
1347 {MD
"Staged for commit, missing"}
1349 {_O
"Untracked, not staged"}
1350 {A_
"Staged for commit"}
1351 {AM
"Portions staged for commit"}
1352 {AD
"Staged for commit, missing"}
1355 {D_
"Staged for removal"}
1356 {DO
"Staged for removal, still present"}
1358 {U_
"Requires merge resolution"}
1359 {UU
"Requires merge resolution"}
1360 {UM
"Requires merge resolution"}
1361 {UD
"Requires merge resolution"}
1363 if {$max_status_desc < [string length
[lindex
$i 1]]} {
1364 set max_status_desc
[string length
[lindex
$i 1]]
1366 set all_descs
([lindex
$i 0]) [lindex
$i 1]
1370 ######################################################################
1374 proc bind_button3
{w cmd
} {
1375 bind $w <Any-Button-3
> $cmd
1377 # Mac OS X sends Button-2 on right click through three-button mouse,
1378 # or through trackpad right-clicking (two-finger touch + click).
1379 bind $w <Any-Button-2
> $cmd
1380 bind $w <Control-Button-1
> $cmd
1384 proc scrollbar2many
{list mode args
} {
1385 foreach w
$list {eval $w $mode $args}
1388 proc many2scrollbar
{list mode sb top bottom
} {
1389 $sb set $top $bottom
1390 foreach w
$list {$w $mode moveto
$top}
1393 proc incr_font_size
{font
{amt
1}} {
1394 set sz
[font configure
$font -size]
1396 font configure
$font -size $sz
1397 font configure
${font}bold
-size $sz
1398 font configure
${font}italic
-size $sz
1401 ######################################################################
1405 set starting_gitk_msg
{Starting gitk... please
wait...
}
1407 proc do_gitk
{revs
} {
1408 # -- Always start gitk through whatever we were loaded with. This
1409 # lets us bypass using shell process on Windows systems.
1411 set exe
[file join [file dirname $
::_git
] gitk
]
1412 set cmd
[list
[info nameofexecutable
] $exe]
1413 if {! [file exists
$exe]} {
1414 error_popup
"Unable to start gitk:\n\n$exe does not exist"
1416 eval exec $cmd $revs &
1417 ui_status $
::starting_gitk_msg
1419 ui_ready
$starting_gitk_msg
1427 global ui_comm is_quitting repo_config commit_type
1428 global GITGUI_BCK_exists GITGUI_BCK_i
1430 if {$is_quitting} return
1433 if {[winfo exists
$ui_comm]} {
1434 # -- Stash our current commit buffer.
1436 set save
[gitdir GITGUI_MSG
]
1437 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1438 file rename
-force [gitdir GITGUI_BCK
] $save
1439 set GITGUI_BCK_exists
0
1441 set msg
[string trim
[$ui_comm get
0.0 end
]]
1442 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1443 if {(![string match amend
* $commit_type]
1444 ||
[$ui_comm edit modified
])
1447 set fd
[open
$save w
]
1448 puts
-nonewline $fd $msg
1452 catch
{file delete
$save}
1456 # -- Remove our editor backup, its not needed.
1458 after cancel
$GITGUI_BCK_i
1459 if {$GITGUI_BCK_exists} {
1460 catch
{file delete
[gitdir GITGUI_BCK
]}
1463 # -- Stash our current window geometry into this repository.
1465 set cfg_geometry
[list
]
1466 lappend cfg_geometry
[wm geometry .
]
1467 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1468 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1469 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1472 if {$cfg_geometry ne
$rc_geometry} {
1473 catch
{git config gui.geometry
$cfg_geometry}
1488 proc toggle_or_diff
{w x y
} {
1489 global file_states file_lists current_diff_path ui_index ui_workdir
1490 global last_clicked selected_paths
1492 set pos
[split [$w index @
$x,$y] .
]
1493 set lno
[lindex
$pos 0]
1494 set col [lindex
$pos 1]
1495 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1501 set last_clicked
[list
$w $lno]
1502 array
unset selected_paths
1503 $ui_index tag remove in_sel
0.0 end
1504 $ui_workdir tag remove in_sel
0.0 end
1507 if {$current_diff_path eq
$path} {
1508 set after
{reshow_diff
;}
1512 if {$w eq
$ui_index} {
1514 "Unstaging [short_path $path] from commit" \
1516 [concat
$after [list ui_ready
]]
1517 } elseif
{$w eq
$ui_workdir} {
1519 "Adding [short_path $path]" \
1521 [concat
$after [list ui_ready
]]
1524 show_diff
$path $w $lno
1528 proc add_one_to_selection
{w x y
} {
1529 global file_lists last_clicked selected_paths
1531 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1532 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1538 if {$last_clicked ne
{}
1539 && [lindex
$last_clicked 0] ne
$w} {
1540 array
unset selected_paths
1541 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1544 set last_clicked
[list
$w $lno]
1545 if {[catch
{set in_sel
$selected_paths($path)}]} {
1549 unset selected_paths
($path)
1550 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1552 set selected_paths
($path) 1
1553 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1557 proc add_range_to_selection
{w x y
} {
1558 global file_lists last_clicked selected_paths
1560 if {[lindex
$last_clicked 0] ne
$w} {
1561 toggle_or_diff
$w $x $y
1565 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1566 set lc
[lindex
$last_clicked 1]
1575 foreach path
[lrange
$file_lists($w) \
1576 [expr {$begin - 1}] \
1577 [expr {$end - 1}]] {
1578 set selected_paths
($path) 1
1580 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1583 ######################################################################
1587 set cursor_ptr arrow
1588 font create font_diff
-family Courier
-size 10
1592 eval font configure font_ui
[font actual
[.dummy cget
-font]]
1596 font create font_uiitalic
1597 font create font_uibold
1598 font create font_diffbold
1599 font create font_diffitalic
1601 foreach class
{Button Checkbutton Entry Label
1602 Labelframe Listbox Menu Message
1603 Radiobutton Spinbox Text
} {
1604 option add
*$class.font font_ui
1608 if {[is_Windows
] ||
[is_MacOSX
]} {
1609 option add
*Menu.tearOff
0
1620 proc apply_config
{} {
1621 global repo_config font_descs
1623 foreach option
$font_descs {
1624 set name
[lindex
$option 0]
1625 set font
[lindex
$option 1]
1627 foreach
{cn cv
} $repo_config(gui.
$name) {
1628 font configure
$font $cn $cv
1631 error_popup
"Invalid font specified in gui.$name:\n\n$err"
1633 foreach
{cn cv
} [font configure
$font] {
1634 font configure
${font}bold
$cn $cv
1635 font configure
${font}italic
$cn $cv
1637 font configure
${font}bold
-weight bold
1638 font configure
${font}italic
-slant italic
1642 set default_config
(merge.diffstat
) true
1643 set default_config
(merge.summary
) false
1644 set default_config
(merge.verbosity
) 2
1645 set default_config
(user.name
) {}
1646 set default_config
(user.email
) {}
1648 set default_config
(gui.matchtrackingbranch
) false
1649 set default_config
(gui.pruneduringfetch
) false
1650 set default_config
(gui.trustmtime
) false
1651 set default_config
(gui.diffcontext
) 5
1652 set default_config
(gui.newbranchtemplate
) {}
1653 set default_config
(gui.fontui
) [font configure font_ui
]
1654 set default_config
(gui.fontdiff
) [font configure font_diff
]
1656 {fontui font_ui
{Main Font
}}
1657 {fontdiff font_diff
{Diff
/Console Font
}}
1662 ######################################################################
1670 menu .mbar
-tearoff 0
1671 .mbar add cascade
-label Repository
-menu .mbar.repository
1672 .mbar add cascade
-label Edit
-menu .mbar.edit
1673 if {[is_enabled branch
]} {
1674 .mbar add cascade
-label Branch
-menu .mbar.branch
1676 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1677 .mbar add cascade
-label Commit
-menu .mbar.commit
1679 if {[is_enabled transport
]} {
1680 .mbar add cascade
-label Merge
-menu .mbar.merge
1681 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1682 .mbar add cascade
-label Push
-menu .mbar.push
1684 . configure
-menu .mbar
1686 # -- Repository Menu
1688 menu .mbar.repository
1690 .mbar.repository add
command \
1691 -label {Browse Current Branch
's Files} \
1692 -command {browser::new $current_branch}
1693 set ui_browse_current [.mbar.repository index last]
1694 .mbar.repository add command \
1695 -label {Browse Branch Files...} \
1696 -command browser_open::dialog
1697 .mbar.repository add separator
1699 .mbar.repository add command \
1700 -label {Visualize Current Branch's History
} \
1701 -command {do_gitk
$current_branch}
1702 set ui_visualize_current
[.mbar.repository index last
]
1703 .mbar.repository add
command \
1704 -label {Visualize All Branch History
} \
1705 -command {do_gitk
--all}
1706 .mbar.repository add separator
1708 proc current_branch_write
{args
} {
1709 global current_branch
1710 .mbar.repository entryconf $
::ui_browse_current \
1711 -label "Browse $current_branch's Files"
1712 .mbar.repository entryconf $
::ui_visualize_current \
1713 -label "Visualize $current_branch's History"
1715 trace add variable current_branch
write current_branch_write
1717 if {[is_enabled multicommit
]} {
1718 .mbar.repository add
command -label {Database Statistics
} \
1721 .mbar.repository add
command -label {Compress Database
} \
1724 .mbar.repository add
command -label {Verify Database
} \
1725 -command do_fsck_objects
1727 .mbar.repository add separator
1730 .mbar.repository add
command \
1731 -label {Create Desktop Icon
} \
1732 -command do_cygwin_shortcut
1733 } elseif
{[is_Windows
]} {
1734 .mbar.repository add
command \
1735 -label {Create Desktop Icon
} \
1736 -command do_windows_shortcut
1737 } elseif
{[is_MacOSX
]} {
1738 .mbar.repository add
command \
1739 -label {Create Desktop Icon
} \
1740 -command do_macosx_app
1744 .mbar.repository add
command -label Quit \
1751 .mbar.edit add
command -label Undo \
1752 -command {catch
{[focus
] edit undo
}} \
1754 .mbar.edit add
command -label Redo \
1755 -command {catch
{[focus
] edit redo
}} \
1757 .mbar.edit add separator
1758 .mbar.edit add
command -label Cut \
1759 -command {catch
{tk_textCut
[focus
]}} \
1761 .mbar.edit add
command -label Copy \
1762 -command {catch
{tk_textCopy
[focus
]}} \
1764 .mbar.edit add
command -label Paste \
1765 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1767 .mbar.edit add
command -label Delete \
1768 -command {catch
{[focus
] delete sel.first sel.last
}} \
1770 .mbar.edit add separator
1771 .mbar.edit add
command -label {Select All
} \
1772 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1777 if {[is_enabled branch
]} {
1780 .mbar.branch add
command -label {Create...
} \
1781 -command branch_create
::dialog \
1783 lappend disable_on_lock
[list .mbar.branch entryconf \
1784 [.mbar.branch index last
] -state]
1786 .mbar.branch add
command -label {Checkout...
} \
1787 -command branch_checkout
::dialog \
1789 lappend disable_on_lock
[list .mbar.branch entryconf \
1790 [.mbar.branch index last
] -state]
1792 .mbar.branch add
command -label {Rename...
} \
1793 -command branch_rename
::dialog
1794 lappend disable_on_lock
[list .mbar.branch entryconf \
1795 [.mbar.branch index last
] -state]
1797 .mbar.branch add
command -label {Delete...
} \
1798 -command branch_delete
::dialog
1799 lappend disable_on_lock
[list .mbar.branch entryconf \
1800 [.mbar.branch index last
] -state]
1802 .mbar.branch add
command -label {Reset...
} \
1803 -command merge
::reset_hard
1804 lappend disable_on_lock
[list .mbar.branch entryconf \
1805 [.mbar.branch index last
] -state]
1810 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1813 .mbar.commit add radiobutton \
1814 -label {New Commit
} \
1815 -command do_select_commit_type \
1816 -variable selected_commit_type \
1818 lappend disable_on_lock \
1819 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1821 .mbar.commit add radiobutton \
1822 -label {Amend Last Commit
} \
1823 -command do_select_commit_type \
1824 -variable selected_commit_type \
1826 lappend disable_on_lock \
1827 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1829 .mbar.commit add separator
1831 .mbar.commit add
command -label Rescan \
1832 -command do_rescan \
1834 lappend disable_on_lock \
1835 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1837 .mbar.commit add
command -label {Stage To Commit
} \
1838 -command do_add_selection
1839 lappend disable_on_lock \
1840 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1842 .mbar.commit add
command -label {Stage Changed Files To Commit
} \
1843 -command do_add_all \
1845 lappend disable_on_lock \
1846 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1848 .mbar.commit add
command -label {Unstage From Commit
} \
1849 -command do_unstage_selection
1850 lappend disable_on_lock \
1851 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1853 .mbar.commit add
command -label {Revert Changes
} \
1854 -command do_revert_selection
1855 lappend disable_on_lock \
1856 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1858 .mbar.commit add separator
1860 .mbar.commit add
command -label {Sign Off
} \
1861 -command do_signoff \
1864 .mbar.commit add
command -label Commit \
1865 -command do_commit \
1866 -accelerator $M1T-Return
1867 lappend disable_on_lock \
1868 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1873 if {[is_enabled branch
]} {
1875 .mbar.merge add
command -label {Local Merge...
} \
1876 -command merge
::dialog \
1878 lappend disable_on_lock \
1879 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1880 .mbar.merge add
command -label {Abort Merge...
} \
1881 -command merge
::reset_hard
1882 lappend disable_on_lock \
1883 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1888 if {[is_enabled transport
]} {
1892 .mbar.push add
command -label {Push...
} \
1893 -command do_push_anywhere \
1895 .mbar.push add
command -label {Delete...
} \
1896 -command remote_branch_delete
::dialog
1900 # -- Apple Menu (Mac OS X only)
1902 .mbar add cascade
-label Apple
-menu .mbar.apple
1905 .mbar.apple add
command -label "About [appname]" \
1907 .mbar.apple add
command -label "Options..." \
1912 .mbar.edit add separator
1913 .mbar.edit add
command -label {Options...
} \
1919 .mbar add cascade
-label Help
-menu .mbar.
help
1923 .mbar.
help add
command -label "About [appname]" \
1928 catch
{set browser
$repo_config(instaweb.browser
)}
1929 set doc_path
[file dirname [gitexec
]]
1930 set doc_path
[file join $doc_path Documentation index.html
]
1933 set doc_path
[exec cygpath
--mixed $doc_path]
1936 if {$browser eq
{}} {
1939 } elseif
{[is_Cygwin
]} {
1940 set program_files
[file dirname [exec cygpath
--windir]]
1941 set program_files
[file join $program_files {Program Files
}]
1942 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
1943 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
1944 if {[file exists
$firefox]} {
1945 set browser
$firefox
1946 } elseif
{[file exists
$ie]} {
1949 unset program_files firefox ie
1953 if {[file isfile
$doc_path]} {
1954 set doc_url
"file:$doc_path"
1956 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
1959 if {$browser ne
{}} {
1960 .mbar.
help add
command -label {Online Documentation
} \
1961 -command [list
exec $browser $doc_url &]
1963 unset browser doc_path doc_url
1966 bind .
<Visibility
> {
1967 bind .
<Visibility
> {}
1971 # -- Standard bindings
1973 wm protocol . WM_DELETE_WINDOW do_quit
1974 bind all
<$M1B-Key-q> do_quit
1975 bind all
<$M1B-Key-Q> do_quit
1976 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1977 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1979 set subcommand_args
{}
1981 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
1985 # -- Not a normal commit type invocation? Do that instead!
1987 switch
-- $subcommand {
1990 set subcommand_args
{rev? path
}
1991 if {$argv eq
{}} usage
1996 if {$is_path ||
[file exists
$_prefix$a]} {
1997 if {$path ne
{}} usage
2000 } elseif
{$a eq
{--}} {
2002 if {$head ne
{}} usage
2007 } elseif
{$head eq
{}} {
2008 if {$head ne
{}} usage
2017 if {$head ne
{} && $path eq
{}} {
2018 set path
$_prefix$head
2025 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2027 set head [git rev-parse
--verify $head]
2033 set current_branch
$head
2036 switch
-- $subcommand {
2039 if {$path ne
{} && [file isdirectory
$path]} {
2040 set head $current_branch
2046 browser
::new
$head $path
2049 if {$head eq
{} && ![file exists
$path]} {
2050 puts stderr
"fatal: cannot stat path $path: No such file or directory"
2053 blame
::new
$head $path
2060 if {[llength
$argv] != 0} {
2061 puts
-nonewline stderr
"usage: $argv0"
2062 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
2063 puts
-nonewline stderr
" $subcommand"
2068 # fall through to setup UI for commits
2071 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2082 -text {Current Branch
:} \
2086 -textvariable current_branch \
2089 pack .branch.l1
-side left
2090 pack .branch.cb
-side left
-fill x
2091 pack .branch
-side top
-fill x
2093 # -- Main Window Layout
2095 panedwindow .vpane
-orient vertical
2096 panedwindow .vpane.files
-orient horizontal
2097 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2098 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2100 # -- Index File List
2102 frame .vpane.files.index
-height 100 -width 200
2103 label .vpane.files.index.title
-text {Staged Changes
(Will Be Committed
)} \
2104 -background lightgreen
2105 text
$ui_index -background white
-borderwidth 0 \
2106 -width 20 -height 10 \
2108 -cursor $cursor_ptr \
2109 -xscrollcommand {.vpane.files.index.sx
set} \
2110 -yscrollcommand {.vpane.files.index.sy
set} \
2112 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2113 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2114 pack .vpane.files.index.title
-side top
-fill x
2115 pack .vpane.files.index.sx
-side bottom
-fill x
2116 pack .vpane.files.index.sy
-side right
-fill y
2117 pack
$ui_index -side left
-fill both
-expand 1
2118 .vpane.files add .vpane.files.index
-sticky nsew
2120 # -- Working Directory File List
2122 frame .vpane.files.workdir
-height 100 -width 200
2123 label .vpane.files.workdir.title
-text {Unstaged Changes
(Will Not Be Committed
)} \
2124 -background lightsalmon
2125 text
$ui_workdir -background white
-borderwidth 0 \
2126 -width 20 -height 10 \
2128 -cursor $cursor_ptr \
2129 -xscrollcommand {.vpane.files.workdir.sx
set} \
2130 -yscrollcommand {.vpane.files.workdir.sy
set} \
2132 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2133 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2134 pack .vpane.files.workdir.title
-side top
-fill x
2135 pack .vpane.files.workdir.sx
-side bottom
-fill x
2136 pack .vpane.files.workdir.sy
-side right
-fill y
2137 pack
$ui_workdir -side left
-fill both
-expand 1
2138 .vpane.files add .vpane.files.workdir
-sticky nsew
2140 foreach i
[list
$ui_index $ui_workdir] {
2141 $i tag conf in_diff
-background lightgray
2142 $i tag conf in_sel
-background lightgray
2146 # -- Diff and Commit Area
2148 frame .vpane.lower
-height 300 -width 400
2149 frame .vpane.lower.commarea
2150 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2151 pack .vpane.lower.commarea
-side top
-fill x
2152 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
2153 .vpane add .vpane.lower
-sticky nsew
2155 # -- Commit Area Buttons
2157 frame .vpane.lower.commarea.buttons
2158 label .vpane.lower.commarea.buttons.l
-text {} \
2161 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2162 pack .vpane.lower.commarea.buttons
-side left
-fill y
2164 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
2166 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2167 lappend disable_on_lock \
2168 {.vpane.lower.commarea.buttons.rescan conf
-state}
2170 button .vpane.lower.commarea.buttons.incall
-text {Stage Changed
} \
2172 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2173 lappend disable_on_lock \
2174 {.vpane.lower.commarea.buttons.incall conf
-state}
2176 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
2178 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2180 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
2182 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2183 lappend disable_on_lock \
2184 {.vpane.lower.commarea.buttons.commit conf
-state}
2186 button .vpane.lower.commarea.buttons.push
-text {Push
} \
2187 -command do_push_anywhere
2188 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2190 # -- Commit Message Buffer
2192 frame .vpane.lower.commarea.buffer
2193 frame .vpane.lower.commarea.buffer.header
2194 set ui_comm .vpane.lower.commarea.buffer.t
2195 set ui_coml .vpane.lower.commarea.buffer.header.l
2196 radiobutton .vpane.lower.commarea.buffer.header.new \
2197 -text {New Commit
} \
2198 -command do_select_commit_type \
2199 -variable selected_commit_type \
2201 lappend disable_on_lock \
2202 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2203 radiobutton .vpane.lower.commarea.buffer.header.amend \
2204 -text {Amend Last Commit
} \
2205 -command do_select_commit_type \
2206 -variable selected_commit_type \
2208 lappend disable_on_lock \
2209 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2213 proc trace_commit_type
{varname args
} {
2214 global ui_coml commit_type
2215 switch
-glob -- $commit_type {
2216 initial
{set txt
{Initial Commit Message
:}}
2217 amend
{set txt
{Amended Commit Message
:}}
2218 amend-initial
{set txt
{Amended Initial Commit Message
:}}
2219 amend-merge
{set txt
{Amended Merge Commit Message
:}}
2220 merge
{set txt
{Merge Commit Message
:}}
2221 * {set txt
{Commit Message
:}}
2223 $ui_coml conf
-text $txt
2225 trace add variable commit_type
write trace_commit_type
2226 pack
$ui_coml -side left
-fill x
2227 pack .vpane.lower.commarea.buffer.header.amend
-side right
2228 pack .vpane.lower.commarea.buffer.header.new
-side right
2230 text
$ui_comm -background white
-borderwidth 1 \
2233 -autoseparators true \
2235 -width 75 -height 9 -wrap none \
2237 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2238 scrollbar .vpane.lower.commarea.buffer.sby \
2239 -command [list
$ui_comm yview
]
2240 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2241 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2242 pack
$ui_comm -side left
-fill y
2243 pack .vpane.lower.commarea.buffer
-side left
-fill y
2245 # -- Commit Message Buffer Context Menu
2247 set ctxm .vpane.lower.commarea.buffer.ctxm
2248 menu
$ctxm -tearoff 0
2251 -command {tk_textCut
$ui_comm}
2254 -command {tk_textCopy
$ui_comm}
2257 -command {tk_textPaste
$ui_comm}
2260 -command {$ui_comm delete sel.first sel.last
}
2263 -label {Select All
} \
2264 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2268 $ui_comm tag add sel
0.0 end
2269 tk_textCopy
$ui_comm
2270 $ui_comm tag remove sel
0.0 end
2276 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
2280 proc trace_current_diff_path
{varname args
} {
2281 global current_diff_path diff_actions file_states
2282 if {$current_diff_path eq
{}} {
2288 set p
$current_diff_path
2289 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2291 set p
[escape_path
$p]
2295 .vpane.lower.
diff.header.status configure
-text $s
2296 .vpane.lower.
diff.header.
file configure
-text $f
2297 .vpane.lower.
diff.header.path configure
-text $p
2298 foreach w
$diff_actions {
2302 trace add variable current_diff_path
write trace_current_diff_path
2304 frame .vpane.lower.
diff.header
-background gold
2305 label .vpane.lower.
diff.header.status \
2307 -width $max_status_desc \
2310 label .vpane.lower.
diff.header.
file \
2314 label .vpane.lower.
diff.header.path \
2318 pack .vpane.lower.
diff.header.status
-side left
2319 pack .vpane.lower.
diff.header.
file -side left
2320 pack .vpane.lower.
diff.header.path
-fill x
2321 set ctxm .vpane.lower.
diff.header.ctxm
2322 menu
$ctxm -tearoff 0
2330 -- $current_diff_path
2332 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2333 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2337 frame .vpane.lower.
diff.body
2338 set ui_diff .vpane.lower.
diff.body.t
2339 text
$ui_diff -background white
-borderwidth 0 \
2340 -width 80 -height 15 -wrap none \
2342 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2343 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2345 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2346 -command [list
$ui_diff xview
]
2347 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2348 -command [list
$ui_diff yview
]
2349 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2350 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2351 pack
$ui_diff -side left
-fill both
-expand 1
2352 pack .vpane.lower.
diff.header
-side top
-fill x
2353 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2355 $ui_diff tag conf d_cr
-elide true
2356 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2357 $ui_diff tag conf d_
+ -foreground {#00a000}
2358 $ui_diff tag conf d_-
-foreground red
2360 $ui_diff tag conf d_
++ -foreground {#00a000}
2361 $ui_diff tag conf d_--
-foreground red
2362 $ui_diff tag conf d_
+s \
2363 -foreground {#00a000} \
2364 -background {#e2effa}
2365 $ui_diff tag conf d_-s \
2367 -background {#e2effa}
2368 $ui_diff tag conf d_s
+ \
2369 -foreground {#00a000} \
2371 $ui_diff tag conf d_s- \
2375 $ui_diff tag conf d
<<<<<<< \
2376 -foreground orange \
2378 $ui_diff tag conf d
======= \
2379 -foreground orange \
2381 $ui_diff tag conf d
>>>>>>> \
2382 -foreground orange \
2385 $ui_diff tag raise sel
2387 # -- Diff Body Context Menu
2389 set ctxm .vpane.lower.
diff.body.ctxm
2390 menu
$ctxm -tearoff 0
2393 -command reshow_diff
2394 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2397 -command {tk_textCopy
$ui_diff}
2398 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2400 -label {Select All
} \
2401 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2402 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2406 $ui_diff tag add sel
0.0 end
2407 tk_textCopy
$ui_diff
2408 $ui_diff tag remove sel
0.0 end
2410 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2413 -label {Apply
/Reverse Hunk
} \
2414 -command {apply_hunk
$cursorX $cursorY}
2415 set ui_diff_applyhunk
[$ctxm index last
]
2416 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2419 -label {Decrease Font Size
} \
2420 -command {incr_font_size font_diff
-1}
2421 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2423 -label {Increase Font Size
} \
2424 -command {incr_font_size font_diff
1}
2425 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2428 -label {Show Less Context
} \
2429 -command {if {$repo_config(gui.diffcontext
) >= 1} {
2430 incr repo_config
(gui.diffcontext
) -1
2433 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2435 -label {Show More Context
} \
2436 -command {if {$repo_config(gui.diffcontext
) < 99} {
2437 incr repo_config
(gui.diffcontext
)
2440 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2442 $ctxm add
command -label {Options...
} \
2444 proc popup_diff_menu
{ctxm x y X Y
} {
2445 global current_diff_path file_states
2448 if {$
::ui_index eq $
::current_diff_side
} {
2450 set l
"Unstage Hunk From Commit"
2452 if {$current_diff_path eq
{}
2453 ||
![info exists file_states
($current_diff_path)]
2454 ||
{_O
} eq
[lindex
$file_states($current_diff_path) 0]} {
2459 set l
"Stage Hunk For Commit"
2461 if {$
::is_3way_diff
} {
2464 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
2465 tk_popup
$ctxm $X $Y
2467 bind_button3
$ui_diff [list popup_diff_menu
$ctxm %x
%y
%X
%Y
]
2471 set main_status
[::status_bar
::new .status
]
2472 pack .status
-anchor w
-side bottom
-fill x
2473 $main_status show
{Initializing...
}
2478 set gm
$repo_config(gui.geometry
)
2479 wm geometry .
[lindex
$gm 0]
2480 .vpane sash place
0 \
2481 [lindex
[.vpane sash coord
0] 0] \
2483 .vpane.files sash place
0 \
2485 [lindex
[.vpane.files sash coord
0] 1]
2491 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2492 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2493 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2494 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2495 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2496 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2497 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2498 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2499 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2500 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2501 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2503 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2504 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2505 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2506 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2507 bind $ui_diff <$M1B-Key-v> {break}
2508 bind $ui_diff <$M1B-Key-V> {break}
2509 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2510 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2511 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2512 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2513 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2514 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2515 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2516 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2517 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2518 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2519 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2520 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2521 bind $ui_diff <Button-1
> {focus
%W
}
2523 if {[is_enabled branch
]} {
2524 bind .
<$M1B-Key-n> branch_create
::dialog
2525 bind .
<$M1B-Key-N> branch_create
::dialog
2526 bind .
<$M1B-Key-o> branch_checkout
::dialog
2527 bind .
<$M1B-Key-O> branch_checkout
::dialog
2528 bind .
<$M1B-Key-m> merge
::dialog
2529 bind .
<$M1B-Key-M> merge
::dialog
2531 if {[is_enabled transport
]} {
2532 bind .
<$M1B-Key-p> do_push_anywhere
2533 bind .
<$M1B-Key-P> do_push_anywhere
2536 bind .
<Key-F5
> do_rescan
2537 bind .
<$M1B-Key-r> do_rescan
2538 bind .
<$M1B-Key-R> do_rescan
2539 bind .
<$M1B-Key-s> do_signoff
2540 bind .
<$M1B-Key-S> do_signoff
2541 bind .
<$M1B-Key-i> do_add_all
2542 bind .
<$M1B-Key-I> do_add_all
2543 bind .
<$M1B-Key-Return> do_commit
2544 foreach i
[list
$ui_index $ui_workdir] {
2545 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2546 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2547 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2551 set file_lists
($ui_index) [list
]
2552 set file_lists
($ui_workdir) [list
]
2554 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2555 focus
-force $ui_comm
2557 # -- Warn the user about environmental problems. Cygwin's Tcl
2558 # does *not* pass its env array onto any processes it spawns.
2559 # This means that git processes get none of our environment.
2564 set msg
"Possible environment issues exist.
2566 The following environment variables are probably
2567 going to be ignored by any Git subprocess run
2571 foreach name
[array names env
] {
2572 switch
-regexp -- $name {
2573 {^GIT_INDEX_FILE$
} -
2574 {^GIT_OBJECT_DIRECTORY$
} -
2575 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2577 {^GIT_EXTERNAL_DIFF$
} -
2581 {^GIT_CONFIG_LOCAL$
} -
2582 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2583 append msg
" - $name\n"
2586 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2587 append msg
" - $name\n"
2589 set suggest_user
$name
2593 if {$ignored_env > 0} {
2595 This is due to a known issue with the
2596 Tcl binary distributed by Cygwin."
2598 if {$suggest_user ne
{}} {
2601 A good replacement for $suggest_user
2602 is placing values for the user.name and
2603 user.email settings into your personal
2609 unset ignored_env msg suggest_user name
2612 # -- Only initialize complex UI if we are going to stay running.
2614 if {[is_enabled transport
]} {
2621 if {[winfo exists
$ui_comm]} {
2622 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
2624 # -- If both our backup and message files exist use the
2625 # newer of the two files to initialize the buffer.
2627 if {$GITGUI_BCK_exists} {
2628 set m
[gitdir GITGUI_MSG
]
2629 if {[file isfile
$m]} {
2630 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
2631 catch
{file delete
[gitdir GITGUI_MSG
]}
2633 $ui_comm delete
0.0 end
2635 $ui_comm edit modified false
2636 catch
{file delete
[gitdir GITGUI_BCK
]}
2637 set GITGUI_BCK_exists
0
2643 proc backup_commit_buffer
{} {
2644 global ui_comm GITGUI_BCK_exists
2646 set m
[$ui_comm edit modified
]
2647 if {$m ||
$GITGUI_BCK_exists} {
2648 set msg
[string trim
[$ui_comm get
0.0 end
]]
2649 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2652 if {$GITGUI_BCK_exists} {
2653 catch
{file delete
[gitdir GITGUI_BCK
]}
2654 set GITGUI_BCK_exists
0
2658 set fd
[open
[gitdir GITGUI_BCK
] w
]
2659 puts
-nonewline $fd $msg
2661 set GITGUI_BCK_exists
1
2665 $ui_comm edit modified false
2668 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
2671 backup_commit_buffer
2674 lock_index begin-read
2675 if {![winfo ismapped .
]} {
2679 if {[is_enabled multicommit
]} {