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 ######################################################################
47 ## enable verbose loading?
49 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
51 rename auto_load real__auto_load
52 proc auto_load
{name args
} {
53 puts stderr
"auto_load $name"
54 return [uplevel
1 real__auto_load
$name $args]
56 rename
source real__source
58 puts stderr
"source $name"
59 uplevel
1 real__source
$name
63 ######################################################################
65 ## configure our library
67 set oguilib
{@@GITGUI_LIBDIR@@
}
68 set oguirel
{@@GITGUI_RELATIVE@@
}
69 if {$oguirel eq
{1}} {
70 set oguilib
[file dirname [file dirname [file normalize
$argv0]]]
71 set oguilib
[file join $oguilib share git-gui lib
]
72 } elseif
{[string match @@
* $oguirel]} {
73 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
76 set idx
[file join $oguilib tclIndex
]
77 if {[catch
{set fd
[open
$idx r
]} err
]} {
82 -title "git-gui: fatal error" \
86 if {[gets
$fd] eq
{# Autogenerated by git-gui Makefile}} {
88 while {[gets
$fd n
] >= 0} {
89 if {$n ne
{} && ![string match
#* $n]} {
101 if {[lsearch
-exact $loaded $p] >= 0} continue
102 source [file join $oguilib $p]
107 set auto_path
[concat
[list
$oguilib] $auto_path]
109 unset -nocomplain oguirel idx fd
111 ######################################################################
115 set _appname
[lindex
[file split $argv0] end
]
132 return [eval [list
file join $_gitdir] $args]
135 proc gitexec
{args
} {
137 if {$_gitexec eq
{}} {
138 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
139 error
"Git not installed?\n\n$err"
142 set _gitexec
[exec cygpath \
147 set _gitexec
[file normalize
$_gitexec]
153 return [eval [list
file join $_gitexec] $args]
162 global tcl_platform tk_library
163 if {[tk windowingsystem
] eq
{aqua
}} {
171 if {$tcl_platform(platform
) eq
{windows
}} {
178 global tcl_platform _iscygwin
179 if {$_iscygwin eq
{}} {
180 if {$tcl_platform(platform
) eq
{windows
}} {
181 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
193 proc is_enabled
{option
} {
194 global enabled_options
195 if {[catch
{set on
$enabled_options($option)}]} {return 0}
199 proc enable_option
{option
} {
200 global enabled_options
201 set enabled_options
($option) 1
204 proc disable_option
{option
} {
205 global enabled_options
206 set enabled_options
($option) 0
209 ######################################################################
213 proc is_many_config
{name
} {
214 switch
-glob -- $name {
223 proc is_config_true
{name
} {
225 if {[catch
{set v
$repo_config($name)}]} {
227 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
234 proc get_config
{name
} {
236 if {[catch
{set v
$repo_config($name)}]} {
243 proc load_config
{include_global
} {
244 global repo_config global_config default_config
246 array
unset global_config
247 if {$include_global} {
249 set fd_rc
[git_read config
--global --list]
250 while {[gets
$fd_rc line
] >= 0} {
251 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
252 if {[is_many_config
$name]} {
253 lappend global_config
($name) $value
255 set global_config
($name) $value
263 array
unset repo_config
265 set fd_rc
[git_read config
--list]
266 while {[gets
$fd_rc line
] >= 0} {
267 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
268 if {[is_many_config
$name]} {
269 lappend repo_config
($name) $value
271 set repo_config
($name) $value
278 foreach name
[array names default_config
] {
279 if {[catch
{set v
$global_config($name)}]} {
280 set global_config
($name) $default_config($name)
282 if {[catch
{set v
$repo_config($name)}]} {
283 set repo_config
($name) $default_config($name)
288 ######################################################################
292 proc _git_cmd
{name
} {
295 if {[catch
{set v
$_git_cmd_path($name)}]} {
299 --exec-path { return [list $
::_git
$name] }
302 set p
[gitexec git-
$name$
::_search_exe
]
303 if {[file exists
$p]} {
305 } elseif
{[is_Windows
] && [file exists
[gitexec git-
$name]]} {
306 # Try to determine what sort of magic will make
307 # git-$name go and do its thing, because native
308 # Tcl on Windows doesn't know it.
310 set p
[gitexec git-
$name]
317 #!*perl { set i perl }
318 #!*python { set i python }
319 default
{ error
"git-$name is not supported: $s" }
323 if {![info exists interp
]} {
324 set interp
[_which
$i]
327 error
"git-$name requires $i (not in PATH)"
329 set v
[list
$interp $p]
331 # Assume it is builtin to git somehow and we
332 # aren't actually able to see a file for it.
334 set v
[list $
::_git
$name]
336 set _git_cmd_path
($name) $v
342 global env _search_exe _search_path
344 if {$_search_path eq
{}} {
346 set _search_path
[split [exec cygpath \
352 } elseif
{[is_Windows
]} {
353 set _search_path
[split $env(PATH
) {;}]
356 set _search_path
[split $env(PATH
) :]
361 foreach p
$_search_path {
362 set p
[file join $p $what$_search_exe]
363 if {[file exists
$p]} {
364 return [file normalize
$p]
374 switch
-- [lindex
$args 0] {
388 set args
[lrange
$args 1 end
]
391 set cmdp
[_git_cmd
[lindex
$args 0]]
392 set args
[lrange
$args 1 end
]
394 return [eval $opt $cmdp $args]
397 proc _open_stdout_stderr
{cmd
} {
401 if { [lindex
$cmd end
] eq
{2>@
1}
402 && $err eq
{can not
find channel named
"1"}
404 # Older versions of Tcl 8.4 don't have this 2>@1 IO
405 # redirect operator. Fallback to |& cat for those.
406 # The command was not actually started, so its safe
407 # to try to start it a second time.
409 set fd
[open
[concat \
410 [lrange
$cmd 0 end-1
] \
420 proc git_read
{args
} {
424 switch
-- [lindex
$args 0] {
442 set args
[lrange
$args 1 end
]
445 set cmdp
[_git_cmd
[lindex
$args 0]]
446 set args
[lrange
$args 1 end
]
448 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
451 proc git_write
{args
} {
455 switch
-- [lindex
$args 0] {
469 set args
[lrange
$args 1 end
]
472 set cmdp
[_git_cmd
[lindex
$args 0]]
473 set args
[lrange
$args 1 end
]
475 return [open
[concat
$opt $cmdp $args] w
]
479 regsub
-all ' $value "'\\''" value
483 proc load_current_branch {} {
484 global current_branch is_detached
486 set fd [open [gitdir HEAD] r]
487 if {[gets $fd ref] < 1} {
492 set pfx {ref: refs/heads/}
493 set len [string length $pfx]
494 if {[string equal -length $len $pfx $ref]} {
495 # We're on a branch. It might not exist. But
496 # HEAD looks good enough to be a branch.
498 set current_branch [string range $ref $len end]
501 # Assume this is a detached head.
503 set current_branch HEAD
508 auto_load tk_optionMenu
509 rename tk_optionMenu real__tkOptionMenu
510 proc tk_optionMenu {w varName args} {
511 set m [eval real__tkOptionMenu $w $varName $args]
512 $m configure -font font_ui
513 $w configure -font font_ui
517 ######################################################################
521 set _git [_which git]
523 catch {wm withdraw .}
524 error_popup "Cannot
find git
in PATH.
"
527 set _nice [_which nice]
529 ######################################################################
533 if {[catch {set _git_version [git --version]} err]} {
534 catch {wm withdraw .}
535 error_popup "Cannot determine Git version
:
539 [appname
] requires Git
1.5.0 or later.
"
542 if {![regsub {^git version } $_git_version {} _git_version]} {
543 catch {wm withdraw .}
544 error_popup "Cannot parse Git version string
:\n\n$_git_version"
547 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
548 regsub {\.rc[0-9]+$} $_git_version {} _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 .}
596 error_popup "[appname
] requires Git
1.5.0 or later.
598 You are using
[git-version
]:
604 ######################################################################
609 set _gitdir $env(GIT_DIR)
613 set _gitdir [git rev-parse --git-dir]
614 set _prefix [git rev-parse --show-prefix]
616 catch {wm withdraw .}
617 error_popup "Cannot
find the git directory
:\n\n$err"
620 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
621 catch {set _gitdir [exec cygpath --unix $_gitdir]}
623 if {![file isdirectory $_gitdir]} {
624 catch {wm withdraw .}
625 error_popup "Git directory not found
:\n\n$_gitdir"
628 if {[lindex [file split $_gitdir] end] ne {.git}} {
629 catch {wm withdraw .}
630 error_popup "Cannot use funny .git directory
:\n\n$_gitdir"
633 if {[catch {cd [file dirname $_gitdir]} err]} {
634 catch {wm withdraw .}
635 error_popup "No working directory
[file dirname $_gitdir]:\n\n$err"
638 set _reponame [lindex [file split \
639 [file normalize [file dirname $_gitdir]]] \
642 ######################################################################
646 set current_diff_path {}
647 set current_diff_side {}
648 set diff_actions [list]
652 set MERGE_HEAD [list]
655 set current_branch {}
657 set current_diff_path {}
658 set selected_commit_type new
660 ######################################################################
668 set disable_on_lock [list]
669 set index_lock_type none
671 proc lock_index {type} {
672 global index_lock_type disable_on_lock
674 if {$index_lock_type eq {none}} {
675 set index_lock_type $type
676 foreach w $disable_on_lock {
677 uplevel #0 $w disabled
680 } elseif {$index_lock_type eq "begin-
$type"} {
681 set index_lock_type $type
687 proc unlock_index {} {
688 global index_lock_type disable_on_lock
690 set index_lock_type none
691 foreach w $disable_on_lock {
696 ######################################################################
700 proc repository_state {ctvar hdvar mhvar} {
701 global current_branch
702 upvar $ctvar ct $hdvar hd $mhvar mh
707 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
713 set merge_head [gitdir MERGE_HEAD]
714 if {[file exists $merge_head]} {
716 set fd_mh [open $merge_head r]
717 while {[gets $fd_mh line] >= 0} {
728 global PARENT empty_tree
730 set p [lindex $PARENT 0]
734 if {$empty_tree eq {}} {
735 set empty_tree [git mktree << {}]
740 proc rescan {after {honor_trustmtime 1}} {
741 global HEAD PARENT MERGE_HEAD commit_type
742 global ui_index ui_workdir ui_comm
743 global rescan_active file_states
746 if {$rescan_active > 0 || ![lock_index read]} return
748 repository_state newType newHEAD newMERGE_HEAD
749 if {[string match amend* $commit_type]
750 && $newType eq {normal}
751 && $newHEAD eq $HEAD} {
755 set MERGE_HEAD $newMERGE_HEAD
756 set commit_type $newType
759 array unset file_states
761 if {![$ui_comm edit modified]
762 || [string trim [$ui_comm get 0.0 end]] eq {}} {
763 if {[string match amend* $commit_type]} {
764 } elseif {[load_message GITGUI_MSG]} {
765 } elseif {[load_message MERGE_MSG]} {
766 } elseif {[load_message SQUASH_MSG]} {
769 $ui_comm edit modified false
772 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
773 rescan_stage2 {} $after
776 ui_status {Refreshing file status...}
777 set fd_rf [git_read update-index \
783 fconfigure $fd_rf -blocking 0 -translation binary
784 fileevent $fd_rf readable \
785 [list rescan_stage2 $fd_rf $after]
789 proc rescan_stage2 {fd after} {
790 global rescan_active buf_rdi buf_rdf buf_rlo
794 if {![eof $fd]} return
798 set ls_others [list --exclude-per-directory=.gitignore]
799 set info_exclude [gitdir info exclude]
800 if {[file readable $info_exclude]} {
801 lappend ls_others "--exclude-from=$info_exclude"
809 ui_status {Scanning for modified files ...}
810 set fd_di [git_read diff-index --cached -z [PARENT]]
811 set fd_df [git_read diff-files -z]
812 set fd_lo [eval git_read ls-files --others -z $ls_others]
814 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
815 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
816 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
817 fileevent $fd_di readable [list read_diff_index $fd_di $after]
818 fileevent $fd_df readable [list read_diff_files $fd_df $after]
819 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
822 proc load_message {file} {
826 if {[file isfile $f]} {
827 if {[catch {set fd [open $f r]}]} {
830 set content [string trim [read $fd]]
832 regsub -all -line {[ \r\t]+$} $content {} content
833 $ui_comm delete 0.0 end
834 $ui_comm insert end $content
840 proc read_diff_index {fd after} {
843 append buf_rdi [read $fd]
845 set n [string length $buf_rdi]
847 set z1 [string first "\
0" $buf_rdi $c]
850 set z2 [string first "\
0" $buf_rdi $z1]
854 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
855 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
857 [encoding convertfrom $p] \
859 [list [lindex $i 0] [lindex $i 2]] \
865 set buf_rdi [string range $buf_rdi $c end]
870 rescan_done $fd buf_rdi $after
873 proc read_diff_files {fd after} {
876 append buf_rdf [read $fd]
878 set n [string length $buf_rdf]
880 set z1 [string first "\
0" $buf_rdf $c]
883 set z2 [string first "\
0" $buf_rdf $z1]
887 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
888 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
890 [encoding convertfrom $p] \
893 [list [lindex $i 0] [lindex $i 2]]
898 set buf_rdf [string range $buf_rdf $c end]
903 rescan_done $fd buf_rdf $after
906 proc read_ls_others {fd after} {
909 append buf_rlo [read $fd]
910 set pck [split $buf_rlo "\
0"]
911 set buf_rlo [lindex $pck end]
912 foreach p [lrange $pck 0 end-1] {
913 merge_state [encoding convertfrom $p] ?O
915 rescan_done $fd buf_rlo $after
918 proc rescan_done {fd buf after} {
919 global rescan_active current_diff_path
920 global file_states repo_config
923 if {![eof $fd]} return
926 if {[incr rescan_active -1] > 0} return
931 if {$current_diff_path ne {}} reshow_diff
935 proc prune_selection {} {
936 global file_states selected_paths
938 foreach path [array names selected_paths] {
939 if {[catch {set still_here $file_states($path)}]} {
940 unset selected_paths($path)
945 ######################################################################
949 proc mapicon {w state path} {
952 if {[catch {set r $all_icons($state$w)}]} {
953 puts "error
: no icon
for $w state
={$state} $path"
959 proc mapdesc {state path} {
962 if {[catch {set r $all_descs($state)}]} {
963 puts "error
: no desc
for state
={$state} $path"
969 proc ui_status {msg} {
970 $::main_status show $msg
973 proc ui_ready {{test {}}} {
974 $::main_status show {Ready.} $test
977 proc escape_path {path} {
978 regsub -all {\\} $path "\\\\" path
979 regsub -all "\n" $path "\\n
" path
983 proc short_path {path} {
984 return [escape_path [lindex [file split $path] end]]
988 set null_sha1 [string repeat 0 40]
990 proc merge_state {path new_state {head_info {}} {index_info {}}} {
991 global file_states next_icon_id null_sha1
993 set s0 [string index $new_state 0]
994 set s1 [string index $new_state 1]
996 if {[catch {set info $file_states($path)}]} {
998 set icon n[incr next_icon_id]
1000 set state [lindex $info 0]
1001 set icon [lindex $info 1]
1002 if {$head_info eq {}} {set head_info [lindex $info 2]}
1003 if {$index_info eq {}} {set index_info [lindex $info 3]}
1006 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1007 elseif {$s0 eq {_}} {set s0 _}
1009 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1010 elseif {$s1 eq {_}} {set s1 _}
1012 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1013 set head_info [list 0 $null_sha1]
1014 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1015 && $head_info eq {}} {
1016 set head_info $index_info
1019 set file_states($path) [list $s0$s1 $icon \
1020 $head_info $index_info \
1025 proc display_file_helper {w path icon_name old_m new_m} {
1028 if {$new_m eq {_}} {
1029 set lno [lsearch -sorted -exact $file_lists($w) $path]
1031 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1033 $w conf -state normal
1034 $w delete $lno.0 [expr {$lno + 1}].0
1035 $w conf -state disabled
1037 } elseif {$old_m eq {_} && $new_m ne {_}} {
1038 lappend file_lists($w) $path
1039 set file_lists($w) [lsort -unique $file_lists($w)]
1040 set lno [lsearch -sorted -exact $file_lists($w) $path]
1042 $w conf -state normal
1043 $w image create $lno.0 \
1044 -align center -padx 5 -pady 1 \
1046 -image [mapicon $w $new_m $path]
1047 $w insert $lno.1 "[escape_path
$path]\n"
1048 $w conf -state disabled
1049 } elseif {$old_m ne $new_m} {
1050 $w conf -state normal
1051 $w image conf $icon_name -image [mapicon $w $new_m $path]
1052 $w conf -state disabled
1056 proc display_file {path state} {
1057 global file_states selected_paths
1058 global ui_index ui_workdir
1060 set old_m [merge_state $path $state]
1061 set s $file_states($path)
1062 set new_m [lindex $s 0]
1063 set icon_name [lindex $s 1]
1065 set o [string index $old_m 0]
1066 set n [string index $new_m 0]
1073 display_file_helper $ui_index $path $icon_name $o $n
1075 if {[string index $old_m 0] eq {U}} {
1078 set o [string index $old_m 1]
1080 if {[string index $new_m 0] eq {U}} {
1083 set n [string index $new_m 1]
1085 display_file_helper $ui_workdir $path $icon_name $o $n
1087 if {$new_m eq {__}} {
1088 unset file_states($path)
1089 catch {unset selected_paths($path)}
1093 proc display_all_files_helper {w path icon_name m} {
1096 lappend file_lists($w) $path
1097 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1098 $w image create end \
1099 -align center -padx 5 -pady 1 \
1101 -image [mapicon $w $m $path]
1102 $w insert end "[escape_path
$path]\n"
1105 proc display_all_files {} {
1106 global ui_index ui_workdir
1107 global file_states file_lists
1110 $ui_index conf -state normal
1111 $ui_workdir conf -state normal
1113 $ui_index delete 0.0 end
1114 $ui_workdir delete 0.0 end
1117 set file_lists($ui_index) [list]
1118 set file_lists($ui_workdir) [list]
1120 foreach path [lsort [array names file_states]] {
1121 set s $file_states($path)
1123 set icon_name [lindex $s 1]
1125 set s [string index $m 0]
1126 if {$s ne {U} && $s ne {_}} {
1127 display_all_files_helper $ui_index $path \
1131 if {[string index $m 0] eq {U}} {
1134 set s [string index $m 1]
1137 display_all_files_helper $ui_workdir $path \
1142 $ui_index conf -state disabled
1143 $ui_workdir conf -state disabled
1146 ######################################################################
1151 #define mask_width 14
1152 #define mask_height 15
1153 static unsigned char mask_bits[] = {
1154 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1155 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1156 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1159 image create bitmap file_plain -background white -foreground black -data {
1160 #define plain_width 14
1161 #define plain_height 15
1162 static unsigned char plain_bits[] = {
1163 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1164 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1165 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1166 } -maskdata $filemask
1168 image create bitmap file_mod -background white -foreground blue -data {
1169 #define mod_width 14
1170 #define mod_height 15
1171 static unsigned char mod_bits[] = {
1172 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1173 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1174 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1175 } -maskdata $filemask
1177 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1178 #define file_fulltick_width 14
1179 #define file_fulltick_height 15
1180 static unsigned char file_fulltick_bits
[] = {
1181 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1182 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1183 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1184 } -maskdata $filemask
1186 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1187 #define parttick_width 14
1188 #define parttick_height 15
1189 static unsigned char parttick_bits
[] = {
1190 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1191 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1192 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1193 } -maskdata $filemask
1195 image create bitmap file_question
-background white
-foreground black
-data {
1196 #define file_question_width 14
1197 #define file_question_height 15
1198 static unsigned char file_question_bits
[] = {
1199 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1200 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1201 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1202 } -maskdata $filemask
1204 image create bitmap file_removed
-background white
-foreground red
-data {
1205 #define file_removed_width 14
1206 #define file_removed_height 15
1207 static unsigned char file_removed_bits
[] = {
1208 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1209 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1210 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1211 } -maskdata $filemask
1213 image create bitmap file_merge
-background white
-foreground blue
-data {
1214 #define file_merge_width 14
1215 #define file_merge_height 15
1216 static unsigned char file_merge_bits
[] = {
1217 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1218 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1219 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1220 } -maskdata $filemask
1223 #define file_width 18
1224 #define file_height 18
1225 static unsigned char file_bits
[] = {
1226 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
1227 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
1228 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
1229 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
1230 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
1232 image create bitmap file_dir
-background white
-foreground blue \
1233 -data $file_dir_data -maskdata $file_dir_data
1236 set file_uplevel_data
{
1238 #define up_height 15
1239 static unsigned char up_bits
[] = {
1240 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
1241 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
1242 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
1244 image create bitmap file_uplevel
-background white
-foreground red \
1245 -data $file_uplevel_data -maskdata $file_uplevel_data
1246 unset file_uplevel_data
1248 set ui_index .vpane.files.index.list
1249 set ui_workdir .vpane.files.workdir.list
1251 set all_icons
(_
$ui_index) file_plain
1252 set all_icons
(A
$ui_index) file_fulltick
1253 set all_icons
(M
$ui_index) file_fulltick
1254 set all_icons
(D
$ui_index) file_removed
1255 set all_icons
(U
$ui_index) file_merge
1257 set all_icons
(_
$ui_workdir) file_plain
1258 set all_icons
(M
$ui_workdir) file_mod
1259 set all_icons
(D
$ui_workdir) file_question
1260 set all_icons
(U
$ui_workdir) file_merge
1261 set all_icons
(O
$ui_workdir) file_plain
1263 set max_status_desc
0
1267 {_M
"Modified, not staged"}
1268 {M_
"Staged for commit"}
1269 {MM
"Portions staged for commit"}
1270 {MD
"Staged for commit, missing"}
1272 {_O
"Untracked, not staged"}
1273 {A_
"Staged for commit"}
1274 {AM
"Portions staged for commit"}
1275 {AD
"Staged for commit, missing"}
1278 {D_
"Staged for removal"}
1279 {DO
"Staged for removal, still present"}
1281 {U_
"Requires merge resolution"}
1282 {UU
"Requires merge resolution"}
1283 {UM
"Requires merge resolution"}
1284 {UD
"Requires merge resolution"}
1286 if {$max_status_desc < [string length
[lindex
$i 1]]} {
1287 set max_status_desc
[string length
[lindex
$i 1]]
1289 set all_descs
([lindex
$i 0]) [lindex
$i 1]
1293 ######################################################################
1297 proc bind_button3
{w cmd
} {
1298 bind $w <Any-Button-3
> $cmd
1300 bind $w <Control-Button-1
> $cmd
1304 proc scrollbar2many
{list mode args
} {
1305 foreach w
$list {eval $w $mode $args}
1308 proc many2scrollbar
{list mode sb top bottom
} {
1309 $sb set $top $bottom
1310 foreach w
$list {$w $mode moveto
$top}
1313 proc incr_font_size
{font
{amt
1}} {
1314 set sz
[font configure
$font -size]
1316 font configure
$font -size $sz
1317 font configure
${font}bold
-size $sz
1318 font configure
${font}italic
-size $sz
1321 ######################################################################
1325 set starting_gitk_msg
{Starting gitk... please
wait...
}
1327 proc do_gitk
{revs
} {
1328 # -- Always start gitk through whatever we were loaded with. This
1329 # lets us bypass using shell process on Windows systems.
1331 set exe
[file join [file dirname $
::_git
] gitk
]
1332 set cmd
[list
[info nameofexecutable
] $exe]
1333 if {! [file exists
$exe]} {
1334 error_popup
"Unable to start gitk:\n\n$exe does not exist"
1336 eval exec $cmd $revs &
1337 ui_status $
::starting_gitk_msg
1339 ui_ready
$starting_gitk_msg
1347 global ui_comm is_quitting repo_config commit_type
1349 if {$is_quitting} return
1352 if {[winfo exists
$ui_comm]} {
1353 # -- Stash our current commit buffer.
1355 set save
[gitdir GITGUI_MSG
]
1356 set msg
[string trim
[$ui_comm get
0.0 end
]]
1357 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1358 if {(![string match amend
* $commit_type]
1359 ||
[$ui_comm edit modified
])
1362 set fd
[open
$save w
]
1363 puts
-nonewline $fd $msg
1367 catch
{file delete
$save}
1370 # -- Stash our current window geometry into this repository.
1372 set cfg_geometry
[list
]
1373 lappend cfg_geometry
[wm geometry .
]
1374 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1375 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1376 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1379 if {$cfg_geometry ne
$rc_geometry} {
1380 catch
{git config gui.geometry
$cfg_geometry}
1395 proc toggle_or_diff
{w x y
} {
1396 global file_states file_lists current_diff_path ui_index ui_workdir
1397 global last_clicked selected_paths
1399 set pos
[split [$w index @
$x,$y] .
]
1400 set lno
[lindex
$pos 0]
1401 set col [lindex
$pos 1]
1402 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1408 set last_clicked
[list
$w $lno]
1409 array
unset selected_paths
1410 $ui_index tag remove in_sel
0.0 end
1411 $ui_workdir tag remove in_sel
0.0 end
1414 if {$current_diff_path eq
$path} {
1415 set after
{reshow_diff
;}
1419 if {$w eq
$ui_index} {
1421 "Unstaging [short_path $path] from commit" \
1423 [concat
$after [list ui_ready
]]
1424 } elseif
{$w eq
$ui_workdir} {
1426 "Adding [short_path $path]" \
1428 [concat
$after [list ui_ready
]]
1431 show_diff
$path $w $lno
1435 proc add_one_to_selection
{w x y
} {
1436 global file_lists last_clicked selected_paths
1438 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1439 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1445 if {$last_clicked ne
{}
1446 && [lindex
$last_clicked 0] ne
$w} {
1447 array
unset selected_paths
1448 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1451 set last_clicked
[list
$w $lno]
1452 if {[catch
{set in_sel
$selected_paths($path)}]} {
1456 unset selected_paths
($path)
1457 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1459 set selected_paths
($path) 1
1460 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1464 proc add_range_to_selection
{w x y
} {
1465 global file_lists last_clicked selected_paths
1467 if {[lindex
$last_clicked 0] ne
$w} {
1468 toggle_or_diff
$w $x $y
1472 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1473 set lc
[lindex
$last_clicked 1]
1482 foreach path
[lrange
$file_lists($w) \
1483 [expr {$begin - 1}] \
1484 [expr {$end - 1}]] {
1485 set selected_paths
($path) 1
1487 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1490 ######################################################################
1494 set cursor_ptr arrow
1495 font create font_diff
-family Courier
-size 10
1499 eval font configure font_ui
[font actual
[.dummy cget
-font]]
1503 font create font_uiitalic
1504 font create font_uibold
1505 font create font_diffbold
1506 font create font_diffitalic
1508 foreach class
{Button Checkbutton Entry Label
1509 Labelframe Listbox Menu Message
1510 Radiobutton Spinbox Text
} {
1511 option add
*$class.font font_ui
1515 if {[is_Windows
] ||
[is_MacOSX
]} {
1516 option add
*Menu.tearOff
0
1527 proc apply_config
{} {
1528 global repo_config font_descs
1530 foreach option
$font_descs {
1531 set name
[lindex
$option 0]
1532 set font
[lindex
$option 1]
1534 foreach
{cn cv
} $repo_config(gui.
$name) {
1535 font configure
$font $cn $cv
1538 error_popup
"Invalid font specified in gui.$name:\n\n$err"
1540 foreach
{cn cv
} [font configure
$font] {
1541 font configure
${font}bold
$cn $cv
1542 font configure
${font}italic
$cn $cv
1544 font configure
${font}bold
-weight bold
1545 font configure
${font}italic
-slant italic
1549 set default_config
(merge.diffstat
) true
1550 set default_config
(merge.summary
) false
1551 set default_config
(merge.verbosity
) 2
1552 set default_config
(user.name
) {}
1553 set default_config
(user.email
) {}
1555 set default_config
(gui.matchtrackingbranch
) false
1556 set default_config
(gui.pruneduringfetch
) false
1557 set default_config
(gui.trustmtime
) false
1558 set default_config
(gui.diffcontext
) 5
1559 set default_config
(gui.newbranchtemplate
) {}
1560 set default_config
(gui.fontui
) [font configure font_ui
]
1561 set default_config
(gui.fontdiff
) [font configure font_diff
]
1563 {fontui font_ui
{Main Font
}}
1564 {fontdiff font_diff
{Diff
/Console Font
}}
1569 ######################################################################
1571 ## feature option selection
1573 if {[regexp
{^git-
(.
+)$
} [appname
] _junk subcommand
]} {
1578 if {$subcommand eq
{gui.sh
}} {
1581 if {$subcommand eq
{gui
} && [llength
$argv] > 0} {
1582 set subcommand
[lindex
$argv 0]
1583 set argv
[lrange
$argv 1 end
]
1586 enable_option multicommit
1587 enable_option branch
1588 enable_option transport
1590 switch
-- $subcommand {
1593 disable_option multicommit
1594 disable_option branch
1595 disable_option transport
1598 enable_option singlecommit
1600 disable_option multicommit
1601 disable_option branch
1602 disable_option transport
1606 ######################################################################
1614 menu .mbar
-tearoff 0
1615 .mbar add cascade
-label Repository
-menu .mbar.repository
1616 .mbar add cascade
-label Edit
-menu .mbar.edit
1617 if {[is_enabled branch
]} {
1618 .mbar add cascade
-label Branch
-menu .mbar.branch
1620 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1621 .mbar add cascade
-label Commit
-menu .mbar.commit
1623 if {[is_enabled transport
]} {
1624 .mbar add cascade
-label Merge
-menu .mbar.merge
1625 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1626 .mbar add cascade
-label Push
-menu .mbar.push
1628 . configure
-menu .mbar
1630 # -- Repository Menu
1632 menu .mbar.repository
1634 .mbar.repository add
command \
1635 -label {Browse Current Branch
} \
1636 -command {browser
::new
$current_branch}
1637 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1638 .mbar.repository add separator
1640 .mbar.repository add
command \
1641 -label {Visualize Current Branch
} \
1642 -command {do_gitk
$current_branch}
1643 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1644 .mbar.repository add
command \
1645 -label {Visualize All Branches
} \
1646 -command {do_gitk
--all}
1647 .mbar.repository add separator
1649 if {[is_enabled multicommit
]} {
1650 .mbar.repository add
command -label {Database Statistics
} \
1653 .mbar.repository add
command -label {Compress Database
} \
1656 .mbar.repository add
command -label {Verify Database
} \
1657 -command do_fsck_objects
1659 .mbar.repository add separator
1662 .mbar.repository add
command \
1663 -label {Create Desktop Icon
} \
1664 -command do_cygwin_shortcut
1665 } elseif
{[is_Windows
]} {
1666 .mbar.repository add
command \
1667 -label {Create Desktop Icon
} \
1668 -command do_windows_shortcut
1669 } elseif
{[is_MacOSX
]} {
1670 .mbar.repository add
command \
1671 -label {Create Desktop Icon
} \
1672 -command do_macosx_app
1676 .mbar.repository add
command -label Quit \
1683 .mbar.edit add
command -label Undo \
1684 -command {catch
{[focus
] edit undo
}} \
1686 .mbar.edit add
command -label Redo \
1687 -command {catch
{[focus
] edit redo
}} \
1689 .mbar.edit add separator
1690 .mbar.edit add
command -label Cut \
1691 -command {catch
{tk_textCut
[focus
]}} \
1693 .mbar.edit add
command -label Copy \
1694 -command {catch
{tk_textCopy
[focus
]}} \
1696 .mbar.edit add
command -label Paste \
1697 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1699 .mbar.edit add
command -label Delete \
1700 -command {catch
{[focus
] delete sel.first sel.last
}} \
1702 .mbar.edit add separator
1703 .mbar.edit add
command -label {Select All
} \
1704 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1709 if {[is_enabled branch
]} {
1712 .mbar.branch add
command -label {Create...
} \
1713 -command branch_create
::dialog \
1715 lappend disable_on_lock
[list .mbar.branch entryconf \
1716 [.mbar.branch index last
] -state]
1718 .mbar.branch add
command -label {Checkout...
} \
1719 -command branch_checkout
::dialog \
1721 lappend disable_on_lock
[list .mbar.branch entryconf \
1722 [.mbar.branch index last
] -state]
1724 .mbar.branch add
command -label {Rename...
} \
1725 -command branch_rename
::dialog
1726 lappend disable_on_lock
[list .mbar.branch entryconf \
1727 [.mbar.branch index last
] -state]
1729 .mbar.branch add
command -label {Delete...
} \
1730 -command branch_delete
::dialog
1731 lappend disable_on_lock
[list .mbar.branch entryconf \
1732 [.mbar.branch index last
] -state]
1734 .mbar.branch add
command -label {Reset...
} \
1735 -command merge
::reset_hard
1736 lappend disable_on_lock
[list .mbar.branch entryconf \
1737 [.mbar.branch index last
] -state]
1742 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1745 .mbar.commit add radiobutton \
1746 -label {New Commit
} \
1747 -command do_select_commit_type \
1748 -variable selected_commit_type \
1750 lappend disable_on_lock \
1751 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1753 .mbar.commit add radiobutton \
1754 -label {Amend Last Commit
} \
1755 -command do_select_commit_type \
1756 -variable selected_commit_type \
1758 lappend disable_on_lock \
1759 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1761 .mbar.commit add separator
1763 .mbar.commit add
command -label Rescan \
1764 -command do_rescan \
1766 lappend disable_on_lock \
1767 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1769 .mbar.commit add
command -label {Add To Commit
} \
1770 -command do_add_selection
1771 lappend disable_on_lock \
1772 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1774 .mbar.commit add
command -label {Add Existing To Commit
} \
1775 -command do_add_all \
1777 lappend disable_on_lock \
1778 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1780 .mbar.commit add
command -label {Unstage From Commit
} \
1781 -command do_unstage_selection
1782 lappend disable_on_lock \
1783 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1785 .mbar.commit add
command -label {Revert Changes
} \
1786 -command do_revert_selection
1787 lappend disable_on_lock \
1788 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1790 .mbar.commit add separator
1792 .mbar.commit add
command -label {Sign Off
} \
1793 -command do_signoff \
1796 .mbar.commit add
command -label Commit \
1797 -command do_commit \
1798 -accelerator $M1T-Return
1799 lappend disable_on_lock \
1800 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1805 if {[is_enabled branch
]} {
1807 .mbar.merge add
command -label {Local Merge...
} \
1808 -command merge
::dialog
1809 lappend disable_on_lock \
1810 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1811 .mbar.merge add
command -label {Abort Merge...
} \
1812 -command merge
::reset_hard
1813 lappend disable_on_lock \
1814 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1820 if {[is_enabled transport
]} {
1824 .mbar.push add
command -label {Push...
} \
1825 -command do_push_anywhere \
1827 .mbar.push add
command -label {Delete...
} \
1828 -command remote_branch_delete
::dialog
1832 # -- Apple Menu (Mac OS X only)
1834 .mbar add cascade
-label Apple
-menu .mbar.apple
1837 .mbar.apple add
command -label "About [appname]" \
1839 .mbar.apple add
command -label "Options..." \
1844 .mbar.edit add separator
1845 .mbar.edit add
command -label {Options...
} \
1850 if {[is_Cygwin
] && [file exists
/usr
/local
/miga
/lib
/gui-miga
]} {
1852 if {![lock_index update
]} return
1853 set cmd
[list sh
--login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1854 set miga_fd
[open
"|$cmd" r
]
1855 fconfigure
$miga_fd -blocking 0
1856 fileevent
$miga_fd readable
[list miga_done
$miga_fd]
1857 ui_status
{Running miga...
}
1859 proc miga_done
{fd
} {
1867 .mbar add cascade
-label Tools
-menu .mbar.tools
1869 .mbar.tools add
command -label "Migrate" \
1871 lappend disable_on_lock \
1872 [list .mbar.tools entryconf
[.mbar.tools index last
] -state]
1878 .mbar add cascade
-label Help
-menu .mbar.
help
1882 .mbar.
help add
command -label "About [appname]" \
1887 catch
{set browser
$repo_config(instaweb.browser
)}
1888 set doc_path
[file dirname [gitexec
]]
1889 set doc_path
[file join $doc_path Documentation index.html
]
1892 set doc_path
[exec cygpath
--mixed $doc_path]
1895 if {$browser eq
{}} {
1898 } elseif
{[is_Cygwin
]} {
1899 set program_files
[file dirname [exec cygpath
--windir]]
1900 set program_files
[file join $program_files {Program Files
}]
1901 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
1902 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
1903 if {[file exists
$firefox]} {
1904 set browser
$firefox
1905 } elseif
{[file exists
$ie]} {
1908 unset program_files firefox ie
1912 if {[file isfile
$doc_path]} {
1913 set doc_url
"file:$doc_path"
1915 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
1918 if {$browser ne
{}} {
1919 .mbar.
help add
command -label {Online Documentation
} \
1920 -command [list
exec $browser $doc_url &]
1922 unset browser doc_path doc_url
1924 # -- Standard bindings
1926 wm protocol . WM_DELETE_WINDOW do_quit
1927 bind all
<$M1B-Key-q> do_quit
1928 bind all
<$M1B-Key-Q> do_quit
1929 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1930 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1932 set subcommand_args
{}
1934 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
1938 # -- Not a normal commit type invocation? Do that instead!
1940 switch
-- $subcommand {
1942 set subcommand_args
{rev?
}
1943 switch
[llength
$argv] {
1944 0 { load_current_branch
}
1946 set current_branch
[lindex
$argv 0]
1947 if {[regexp
{^
[0-9a-f]{1,39}$
} $current_branch]} {
1949 set current_branch \
1950 [git rev-parse
--verify $current_branch]
1959 browser
::new
$current_branch
1963 set subcommand_args
{rev? path?
}
1968 if {$is_path ||
[file exists
$_prefix$a]} {
1969 if {$path ne
{}} usage
1972 } elseif
{$a eq
{--}} {
1974 if {$head ne
{}} usage
1979 } elseif
{$head eq
{}} {
1980 if {$head ne
{}} usage
1991 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
1993 set head [git rev-parse
--verify $head]
1999 set current_branch
$head
2002 if {$path eq
{}} usage
2003 blame
::new
$head $path
2008 if {[llength
$argv] != 0} {
2009 puts
-nonewline stderr
"usage: $argv0"
2010 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
2011 puts
-nonewline stderr
" $subcommand"
2016 # fall through to setup UI for commits
2019 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2030 -text {Current Branch
:} \
2034 -textvariable current_branch \
2037 pack .branch.l1
-side left
2038 pack .branch.cb
-side left
-fill x
2039 pack .branch
-side top
-fill x
2041 # -- Main Window Layout
2043 panedwindow .vpane
-orient vertical
2044 panedwindow .vpane.files
-orient horizontal
2045 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2046 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2048 # -- Index File List
2050 frame .vpane.files.index
-height 100 -width 200
2051 label .vpane.files.index.title
-text {Staged Changes
(Will Be Committed
)} \
2052 -background lightgreen
2053 text
$ui_index -background white
-borderwidth 0 \
2054 -width 20 -height 10 \
2056 -cursor $cursor_ptr \
2057 -xscrollcommand {.vpane.files.index.sx
set} \
2058 -yscrollcommand {.vpane.files.index.sy
set} \
2060 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2061 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2062 pack .vpane.files.index.title
-side top
-fill x
2063 pack .vpane.files.index.sx
-side bottom
-fill x
2064 pack .vpane.files.index.sy
-side right
-fill y
2065 pack
$ui_index -side left
-fill both
-expand 1
2066 .vpane.files add .vpane.files.index
-sticky nsew
2068 # -- Working Directory File List
2070 frame .vpane.files.workdir
-height 100 -width 200
2071 label .vpane.files.workdir.title
-text {Unstaged Changes
(Will Not Be Committed
)} \
2072 -background lightsalmon
2073 text
$ui_workdir -background white
-borderwidth 0 \
2074 -width 20 -height 10 \
2076 -cursor $cursor_ptr \
2077 -xscrollcommand {.vpane.files.workdir.sx
set} \
2078 -yscrollcommand {.vpane.files.workdir.sy
set} \
2080 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2081 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2082 pack .vpane.files.workdir.title
-side top
-fill x
2083 pack .vpane.files.workdir.sx
-side bottom
-fill x
2084 pack .vpane.files.workdir.sy
-side right
-fill y
2085 pack
$ui_workdir -side left
-fill both
-expand 1
2086 .vpane.files add .vpane.files.workdir
-sticky nsew
2088 foreach i
[list
$ui_index $ui_workdir] {
2089 $i tag conf in_diff
-background lightgray
2090 $i tag conf in_sel
-background lightgray
2094 # -- Diff and Commit Area
2096 frame .vpane.lower
-height 300 -width 400
2097 frame .vpane.lower.commarea
2098 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2099 pack .vpane.lower.commarea
-side top
-fill x
2100 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
2101 .vpane add .vpane.lower
-sticky nsew
2103 # -- Commit Area Buttons
2105 frame .vpane.lower.commarea.buttons
2106 label .vpane.lower.commarea.buttons.l
-text {} \
2109 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2110 pack .vpane.lower.commarea.buttons
-side left
-fill y
2112 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
2114 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2115 lappend disable_on_lock \
2116 {.vpane.lower.commarea.buttons.rescan conf
-state}
2118 button .vpane.lower.commarea.buttons.incall
-text {Add Existing
} \
2120 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2121 lappend disable_on_lock \
2122 {.vpane.lower.commarea.buttons.incall conf
-state}
2124 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
2126 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2128 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
2130 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2131 lappend disable_on_lock \
2132 {.vpane.lower.commarea.buttons.commit conf
-state}
2134 button .vpane.lower.commarea.buttons.push
-text {Push
} \
2135 -command do_push_anywhere
2136 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2138 # -- Commit Message Buffer
2140 frame .vpane.lower.commarea.buffer
2141 frame .vpane.lower.commarea.buffer.header
2142 set ui_comm .vpane.lower.commarea.buffer.t
2143 set ui_coml .vpane.lower.commarea.buffer.header.l
2144 radiobutton .vpane.lower.commarea.buffer.header.new \
2145 -text {New Commit
} \
2146 -command do_select_commit_type \
2147 -variable selected_commit_type \
2149 lappend disable_on_lock \
2150 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2151 radiobutton .vpane.lower.commarea.buffer.header.amend \
2152 -text {Amend Last Commit
} \
2153 -command do_select_commit_type \
2154 -variable selected_commit_type \
2156 lappend disable_on_lock \
2157 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2161 proc trace_commit_type
{varname args
} {
2162 global ui_coml commit_type
2163 switch
-glob -- $commit_type {
2164 initial
{set txt
{Initial Commit Message
:}}
2165 amend
{set txt
{Amended Commit Message
:}}
2166 amend-initial
{set txt
{Amended Initial Commit Message
:}}
2167 amend-merge
{set txt
{Amended Merge Commit Message
:}}
2168 merge
{set txt
{Merge Commit Message
:}}
2169 * {set txt
{Commit Message
:}}
2171 $ui_coml conf
-text $txt
2173 trace add variable commit_type
write trace_commit_type
2174 pack
$ui_coml -side left
-fill x
2175 pack .vpane.lower.commarea.buffer.header.amend
-side right
2176 pack .vpane.lower.commarea.buffer.header.new
-side right
2178 text
$ui_comm -background white
-borderwidth 1 \
2181 -autoseparators true \
2183 -width 75 -height 9 -wrap none \
2185 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2186 scrollbar .vpane.lower.commarea.buffer.sby \
2187 -command [list
$ui_comm yview
]
2188 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2189 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2190 pack
$ui_comm -side left
-fill y
2191 pack .vpane.lower.commarea.buffer
-side left
-fill y
2193 # -- Commit Message Buffer Context Menu
2195 set ctxm .vpane.lower.commarea.buffer.ctxm
2196 menu
$ctxm -tearoff 0
2199 -command {tk_textCut
$ui_comm}
2202 -command {tk_textCopy
$ui_comm}
2205 -command {tk_textPaste
$ui_comm}
2208 -command {$ui_comm delete sel.first sel.last
}
2211 -label {Select All
} \
2212 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2216 $ui_comm tag add sel
0.0 end
2217 tk_textCopy
$ui_comm
2218 $ui_comm tag remove sel
0.0 end
2224 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
2228 proc trace_current_diff_path
{varname args
} {
2229 global current_diff_path diff_actions file_states
2230 if {$current_diff_path eq
{}} {
2236 set p
$current_diff_path
2237 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2239 set p
[escape_path
$p]
2243 .vpane.lower.
diff.header.status configure
-text $s
2244 .vpane.lower.
diff.header.
file configure
-text $f
2245 .vpane.lower.
diff.header.path configure
-text $p
2246 foreach w
$diff_actions {
2250 trace add variable current_diff_path
write trace_current_diff_path
2252 frame .vpane.lower.
diff.header
-background gold
2253 label .vpane.lower.
diff.header.status \
2255 -width $max_status_desc \
2258 label .vpane.lower.
diff.header.
file \
2262 label .vpane.lower.
diff.header.path \
2266 pack .vpane.lower.
diff.header.status
-side left
2267 pack .vpane.lower.
diff.header.
file -side left
2268 pack .vpane.lower.
diff.header.path
-fill x
2269 set ctxm .vpane.lower.
diff.header.ctxm
2270 menu
$ctxm -tearoff 0
2278 -- $current_diff_path
2280 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2281 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2285 frame .vpane.lower.
diff.body
2286 set ui_diff .vpane.lower.
diff.body.t
2287 text
$ui_diff -background white
-borderwidth 0 \
2288 -width 80 -height 15 -wrap none \
2290 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2291 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2293 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2294 -command [list
$ui_diff xview
]
2295 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2296 -command [list
$ui_diff yview
]
2297 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2298 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2299 pack
$ui_diff -side left
-fill both
-expand 1
2300 pack .vpane.lower.
diff.header
-side top
-fill x
2301 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2303 $ui_diff tag conf d_cr
-elide true
2304 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2305 $ui_diff tag conf d_
+ -foreground {#00a000}
2306 $ui_diff tag conf d_-
-foreground red
2308 $ui_diff tag conf d_
++ -foreground {#00a000}
2309 $ui_diff tag conf d_--
-foreground red
2310 $ui_diff tag conf d_
+s \
2311 -foreground {#00a000} \
2312 -background {#e2effa}
2313 $ui_diff tag conf d_-s \
2315 -background {#e2effa}
2316 $ui_diff tag conf d_s
+ \
2317 -foreground {#00a000} \
2319 $ui_diff tag conf d_s- \
2323 $ui_diff tag conf d
<<<<<<< \
2324 -foreground orange \
2326 $ui_diff tag conf d
======= \
2327 -foreground orange \
2329 $ui_diff tag conf d
>>>>>>> \
2330 -foreground orange \
2333 $ui_diff tag raise sel
2335 # -- Diff Body Context Menu
2337 set ctxm .vpane.lower.
diff.body.ctxm
2338 menu
$ctxm -tearoff 0
2341 -command reshow_diff
2342 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2345 -command {tk_textCopy
$ui_diff}
2346 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2348 -label {Select All
} \
2349 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2350 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2354 $ui_diff tag add sel
0.0 end
2355 tk_textCopy
$ui_diff
2356 $ui_diff tag remove sel
0.0 end
2358 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2361 -label {Apply
/Reverse Hunk
} \
2362 -command {apply_hunk
$cursorX $cursorY}
2363 set ui_diff_applyhunk
[$ctxm index last
]
2364 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2367 -label {Decrease Font Size
} \
2368 -command {incr_font_size font_diff
-1}
2369 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2371 -label {Increase Font Size
} \
2372 -command {incr_font_size font_diff
1}
2373 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2376 -label {Show Less Context
} \
2377 -command {if {$repo_config(gui.diffcontext
) >= 1} {
2378 incr repo_config
(gui.diffcontext
) -1
2381 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2383 -label {Show More Context
} \
2384 -command {if {$repo_config(gui.diffcontext
) < 99} {
2385 incr repo_config
(gui.diffcontext
)
2388 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2390 $ctxm add
command -label {Options...
} \
2392 bind_button3
$ui_diff "
2395 if {\$ui_index eq \$current_diff_side} {
2396 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2398 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2400 tk_popup $ctxm %X %Y
2402 unset ui_diff_applyhunk
2406 set main_status
[::status_bar
::new .status
]
2407 pack .status
-anchor w
-side bottom
-fill x
2408 $main_status show
{Initializing...
}
2413 set gm
$repo_config(gui.geometry
)
2414 wm geometry .
[lindex
$gm 0]
2415 .vpane sash place
0 \
2416 [lindex
[.vpane sash coord
0] 0] \
2418 .vpane.files sash place
0 \
2420 [lindex
[.vpane.files sash coord
0] 1]
2426 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2427 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2428 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2429 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2430 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2431 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2432 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2433 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2434 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2435 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2436 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2438 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2439 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2440 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2441 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2442 bind $ui_diff <$M1B-Key-v> {break}
2443 bind $ui_diff <$M1B-Key-V> {break}
2444 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2445 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2446 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2447 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2448 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2449 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2450 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2451 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2452 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2453 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2454 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2455 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2456 bind $ui_diff <Button-1
> {focus
%W
}
2458 if {[is_enabled branch
]} {
2459 bind .
<$M1B-Key-n> branch_create
::dialog
2460 bind .
<$M1B-Key-N> branch_create
::dialog
2461 bind .
<$M1B-Key-o> branch_checkout
::dialog
2462 bind .
<$M1B-Key-O> branch_checkout
::dialog
2464 if {[is_enabled transport
]} {
2465 bind .
<$M1B-Key-p> do_push_anywhere
2466 bind .
<$M1B-Key-P> do_push_anywhere
2469 bind .
<Key-F5
> do_rescan
2470 bind .
<$M1B-Key-r> do_rescan
2471 bind .
<$M1B-Key-R> do_rescan
2472 bind .
<$M1B-Key-s> do_signoff
2473 bind .
<$M1B-Key-S> do_signoff
2474 bind .
<$M1B-Key-i> do_add_all
2475 bind .
<$M1B-Key-I> do_add_all
2476 bind .
<$M1B-Key-Return> do_commit
2477 foreach i
[list
$ui_index $ui_workdir] {
2478 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2479 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2480 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2484 set file_lists
($ui_index) [list
]
2485 set file_lists
($ui_workdir) [list
]
2487 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2488 focus
-force $ui_comm
2490 # -- Warn the user about environmental problems. Cygwin's Tcl
2491 # does *not* pass its env array onto any processes it spawns.
2492 # This means that git processes get none of our environment.
2497 set msg
"Possible environment issues exist.
2499 The following environment variables are probably
2500 going to be ignored by any Git subprocess run
2504 foreach name
[array names env
] {
2505 switch
-regexp -- $name {
2506 {^GIT_INDEX_FILE$
} -
2507 {^GIT_OBJECT_DIRECTORY$
} -
2508 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2510 {^GIT_EXTERNAL_DIFF$
} -
2514 {^GIT_CONFIG_LOCAL$
} -
2515 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2516 append msg
" - $name\n"
2519 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2520 append msg
" - $name\n"
2522 set suggest_user
$name
2526 if {$ignored_env > 0} {
2528 This is due to a known issue with the
2529 Tcl binary distributed by Cygwin."
2531 if {$suggest_user ne
{}} {
2534 A good replacement for $suggest_user
2535 is placing values for the user.name and
2536 user.email settings into your personal
2542 unset ignored_env msg suggest_user name
2545 # -- Only initialize complex UI if we are going to stay running.
2547 if {[is_enabled transport
]} {
2554 # -- Only suggest a gc run if we are going to stay running.
2556 if {[is_enabled multicommit
]} {
2557 set object_limit
2000
2558 if {[is_Windows
]} {set object_limit
200}
2559 regexp
{^
([0-9]+) objects
,} [git count-objects
] _junk objects_current
2560 if {$objects_current >= $object_limit} {
2562 "This repository currently has $objects_current loose objects.
2564 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2566 Compress the database now?"] eq
yes} {
2570 unset object_limit _junk objects_current
2573 lock_index begin-read