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 rename send
{} ; # What an evil concept...
47 ######################################################################
49 ## enable verbose loading?
51 if {![catch
{set _verbose
$env(GITGUI_VERBOSE
)}]} {
53 rename auto_load real__auto_load
54 proc auto_load
{name args
} {
55 puts stderr
"auto_load $name"
56 return [uplevel
1 real__auto_load
$name $args]
58 rename
source real__source
60 puts stderr
"source $name"
61 uplevel
1 real__source
$name
65 ######################################################################
69 set _appname
[lindex
[file split $argv0] end
]
86 return [eval [list
file join $_gitdir] $args]
91 if {$_gitexec eq
{}} {
92 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
93 error
"Git not installed?\n\n$err"
96 set _gitexec
[exec cygpath \
101 set _gitexec
[file normalize
$_gitexec]
107 return [eval [list
file join $_gitexec] $args]
115 if {[tk windowingsystem
] eq
{aqua
}} {
122 if {$
::tcl_platform
(platform
) eq
{windows
}} {
130 if {$_iscygwin eq
{}} {
131 if {$
::tcl_platform
(platform
) eq
{windows
}} {
132 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
144 proc is_enabled
{option
} {
145 global enabled_options
146 if {[catch
{set on
$enabled_options($option)}]} {return 0}
150 proc enable_option
{option
} {
151 global enabled_options
152 set enabled_options
($option) 1
155 proc disable_option
{option
} {
156 global enabled_options
157 set enabled_options
($option) 0
160 ######################################################################
164 proc is_many_config
{name
} {
165 switch
-glob -- $name {
174 proc is_config_true
{name
} {
176 if {[catch
{set v
$repo_config($name)}]} {
178 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
185 proc get_config
{name
} {
187 if {[catch
{set v
$repo_config($name)}]} {
194 proc load_config
{include_global
} {
195 global repo_config global_config default_config
197 array
unset global_config
198 if {$include_global} {
200 set fd_rc
[git_read config
--global --list]
201 while {[gets
$fd_rc line
] >= 0} {
202 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
203 if {[is_many_config
$name]} {
204 lappend global_config
($name) $value
206 set global_config
($name) $value
214 array
unset repo_config
216 set fd_rc
[git_read config
--list]
217 while {[gets
$fd_rc line
] >= 0} {
218 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
219 if {[is_many_config
$name]} {
220 lappend repo_config
($name) $value
222 set repo_config
($name) $value
229 foreach name
[array names default_config
] {
230 if {[catch
{set v
$global_config($name)}]} {
231 set global_config
($name) $default_config($name)
233 if {[catch
{set v
$repo_config($name)}]} {
234 set repo_config
($name) $default_config($name)
239 ######################################################################
243 proc _git_cmd
{name
} {
246 if {[catch
{set v
$_git_cmd_path($name)}]} {
250 --exec-path { return [list $
::_git
$name] }
253 set p
[gitexec git-
$name$
::_search_exe
]
254 if {[file exists
$p]} {
256 } elseif
{[is_Windows
] && [file exists
[gitexec git-
$name]]} {
257 # Try to determine what sort of magic will make
258 # git-$name go and do its thing, because native
259 # Tcl on Windows doesn't know it.
261 set p
[gitexec git-
$name]
266 switch
-glob -- [lindex
$s 0] {
268 #!*perl { set i perl }
269 #!*python { set i python }
270 default
{ error
"git-$name is not supported: $s" }
274 if {![info exists interp
]} {
275 set interp
[_which
$i]
278 error
"git-$name requires $i (not in PATH)"
280 set v
[concat
[list
$interp] [lrange
$s 1 end
] [list
$p]]
282 # Assume it is builtin to git somehow and we
283 # aren't actually able to see a file for it.
285 set v
[list $
::_git
$name]
287 set _git_cmd_path
($name) $v
293 global env _search_exe _search_path
295 if {$_search_path eq
{}} {
297 set _search_path
[split [exec cygpath \
303 } elseif
{[is_Windows
]} {
304 set _search_path
[split $env(PATH
) {;}]
307 set _search_path
[split $env(PATH
) :]
312 foreach p
$_search_path {
313 set p
[file join $p $what$_search_exe]
314 if {[file exists
$p]} {
315 return [file normalize
$p]
321 proc _lappend_nice
{cmd_var
} {
325 if {![info exists _nice
]} {
326 set _nice
[_which nice
]
337 switch
-- [lindex
$args 0] {
348 set args
[lrange
$args 1 end
]
351 set cmdp
[_git_cmd
[lindex
$args 0]]
352 set args
[lrange
$args 1 end
]
354 return [eval $opt $cmdp $args]
357 proc _open_stdout_stderr
{cmd
} {
361 if { [lindex
$cmd end
] eq
{2>@
1}
362 && $err eq
{can not
find channel named
"1"}
364 # Older versions of Tcl 8.4 don't have this 2>@1 IO
365 # redirect operator. Fallback to |& cat for those.
366 # The command was not actually started, so its safe
367 # to try to start it a second time.
369 set fd
[open
[concat \
370 [lrange
$cmd 0 end-1
] \
377 fconfigure
$fd -eofchar {}
381 proc git_read
{args
} {
385 switch
-- [lindex
$args 0] {
400 set args
[lrange
$args 1 end
]
403 set cmdp
[_git_cmd
[lindex
$args 0]]
404 set args
[lrange
$args 1 end
]
406 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
409 proc git_write
{args
} {
413 switch
-- [lindex
$args 0] {
424 set args
[lrange
$args 1 end
]
427 set cmdp
[_git_cmd
[lindex
$args 0]]
428 set args
[lrange
$args 1 end
]
430 return [open
[concat
$opt $cmdp $args] w
]
434 regsub
-all ' $value "'\\''" value
438 proc load_current_branch {} {
439 global current_branch is_detached
441 set fd [open [gitdir HEAD] r]
442 if {[gets $fd ref] < 1} {
447 set pfx {ref: refs/heads/}
448 set len [string length $pfx]
449 if {[string equal -length $len $pfx $ref]} {
450 # We're on a branch. It might not exist. But
451 # HEAD looks good enough to be a branch.
453 set current_branch [string range $ref $len end]
456 # Assume this is a detached head.
458 set current_branch HEAD
463 auto_load tk_optionMenu
464 rename tk_optionMenu real__tkOptionMenu
465 proc tk_optionMenu {w varName args} {
466 set m [eval real__tkOptionMenu $w $varName $args]
467 $m configure -font font_ui
468 $w configure -font font_ui
472 ######################################################################
476 set _git [_which git]
478 catch {wm withdraw .}
479 error_popup "Cannot
find git
in PATH.
"
483 ######################################################################
487 if {[catch {set _git_version [git --version]} err]} {
488 catch {wm withdraw .}
492 -title "git-gui
: fatal error
" \
493 -message "Cannot determine Git version
:
497 [appname
] requires Git
1.5.0 or later.
"
500 if {![regsub {^git version } $_git_version {} _git_version]} {
501 catch {wm withdraw .}
505 -title "git-gui
: fatal error
" \
506 -message "Cannot parse Git version string
:\n\n$_git_version"
510 set _real_git_version $_git_version
511 regsub -- {-dirty$} $_git_version {} _git_version
512 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
513 regsub {\.rc[0-9]+$} $_git_version {} _git_version
514 regsub {\.GIT$} $_git_version {} _git_version
516 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
517 catch {wm withdraw .}
522 -title "[appname
]: warning
" \
523 -message "Git version cannot be determined.
525 $_git claims it is version
'$_real_git_version'.
527 [appname
] requires
at least Git
1.5.0 or later.
529 Assume
'$_real_git_version' is version
1.5.0?
531 set _git_version 1.5.0
536 unset _real_git_version
538 proc git-version {args} {
541 switch [llength $args] {
547 set op [lindex $args 0]
548 set vr [lindex $args 1]
549 set cm [package vcompare $_git_version $vr]
550 return [expr $cm $op 0]
554 set type [lindex $args 0]
555 set name [lindex $args 1]
556 set parm [lindex $args 2]
557 set body [lindex $args 3]
559 if {($type ne {proc} && $type ne {method})} {
560 error "Invalid arguments to git-version
"
562 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
563 error "Last arm of
$type $name must be default
"
566 foreach {op vr cb} [lrange $body 0 end-2] {
567 if {[git-version $op $vr]} {
568 return [uplevel [list $type $name $parm $cb]]
572 return [uplevel [list $type $name $parm [lindex $body end]]]
576 error "git-version
>= x
"
582 if {[git-version < 1.5]} {
583 catch {wm withdraw .}
587 -title "git-gui
: fatal error
" \
588 -message "[appname
] requires Git
1.5.0 or later.
590 You are using
[git-version
]:
596 ######################################################################
598 ## configure our library
600 set oguilib {@@GITGUI_LIBDIR@@}
601 set oguirel {@@GITGUI_RELATIVE@@}
602 if {$oguirel eq {1}} {
603 set oguilib [file dirname [file dirname [file normalize $argv0]]]
604 set oguilib [file join $oguilib share git-gui lib]
605 } elseif {[string match @@* $oguirel]} {
606 set oguilib [file join [file dirname [file normalize $argv0]] lib]
609 set idx [file join $oguilib tclIndex]
610 if {[catch {set fd [open $idx r]} err]} {
611 catch {wm withdraw .}
615 -title "git-gui
: fatal error
" \
619 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
621 while {[gets $fd n] >= 0} {
622 if {$n ne {} && ![string match #* $n]} {
634 if {[lsearch -exact $loaded $p] >= 0} continue
635 source [file join $oguilib $p]
640 set auto_path [concat [list $oguilib] $auto_path]
642 unset -nocomplain oguirel idx fd
644 ######################################################################
646 ## feature option selection
648 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
653 if {$subcommand eq {gui.sh}} {
656 if {$subcommand eq {gui} && [llength $argv] > 0} {
657 set subcommand [lindex $argv 0]
658 set argv [lrange $argv 1 end]
661 enable_option multicommit
663 enable_option transport
666 switch -- $subcommand {
671 disable_option multicommit
672 disable_option branch
673 disable_option transport
676 enable_option singlecommit
678 disable_option multicommit
679 disable_option branch
680 disable_option transport
684 ######################################################################
689 set _gitdir $env(GIT_DIR)
693 set _gitdir [git rev-parse --git-dir]
694 set _prefix [git rev-parse --show-prefix]
696 catch {wm withdraw .}
697 error_popup "Cannot
find the git directory
:\n\n$err"
700 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
701 catch {set _gitdir [exec cygpath --unix $_gitdir]}
703 if {![file isdirectory $_gitdir]} {
704 catch {wm withdraw .}
705 error_popup "Git directory not found
:\n\n$_gitdir"
708 if {$_prefix ne {}} {
709 regsub -all {[^/]+/} $_prefix ../ cdup
710 if {[catch {cd $cdup} err]} {
711 catch {wm withdraw .}
712 error_popup "Cannot move to top of working directory
:\n\n$err"
716 } elseif {![is_enabled bare]} {
717 if {[lindex [file split $_gitdir] end] ne {.git}} {
718 catch {wm withdraw .}
719 error_popup "Cannot use funny .git directory
:\n\n$_gitdir"
722 if {[catch {cd [file dirname $_gitdir]} err]} {
723 catch {wm withdraw .}
724 error_popup "No working directory
[file dirname $_gitdir]:\n\n$err"
728 set _reponame [file split [file normalize $_gitdir]]
729 if {[lindex $_reponame end] eq {.git}} {
730 set _reponame [lindex $_reponame end-1]
732 set _reponame [lindex $_reponame end]
735 ######################################################################
739 set current_diff_path {}
740 set current_diff_side {}
741 set diff_actions [list]
745 set MERGE_HEAD [list]
748 set current_branch {}
750 set current_diff_path {}
752 set selected_commit_type new
754 ######################################################################
762 set disable_on_lock [list]
763 set index_lock_type none
765 proc lock_index {type} {
766 global index_lock_type disable_on_lock
768 if {$index_lock_type eq {none}} {
769 set index_lock_type $type
770 foreach w $disable_on_lock {
771 uplevel #0 $w disabled
774 } elseif {$index_lock_type eq "begin-
$type"} {
775 set index_lock_type $type
781 proc unlock_index {} {
782 global index_lock_type disable_on_lock
784 set index_lock_type none
785 foreach w $disable_on_lock {
790 ######################################################################
794 proc repository_state {ctvar hdvar mhvar} {
795 global current_branch
796 upvar $ctvar ct $hdvar hd $mhvar mh
801 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
807 set merge_head [gitdir MERGE_HEAD]
808 if {[file exists $merge_head]} {
810 set fd_mh [open $merge_head r]
811 while {[gets $fd_mh line] >= 0} {
822 global PARENT empty_tree
824 set p [lindex $PARENT 0]
828 if {$empty_tree eq {}} {
829 set empty_tree [git mktree << {}]
834 proc rescan {after {honor_trustmtime 1}} {
835 global HEAD PARENT MERGE_HEAD commit_type
836 global ui_index ui_workdir ui_comm
837 global rescan_active file_states
840 if {$rescan_active > 0 || ![lock_index read]} return
842 repository_state newType newHEAD newMERGE_HEAD
843 if {[string match amend* $commit_type]
844 && $newType eq {normal}
845 && $newHEAD eq $HEAD} {
849 set MERGE_HEAD $newMERGE_HEAD
850 set commit_type $newType
853 array unset file_states
855 if {!$::GITGUI_BCK_exists &&
856 (![$ui_comm edit modified]
857 || [string trim [$ui_comm get 0.0 end]] eq {})} {
858 if {[string match amend* $commit_type]} {
859 } elseif {[load_message GITGUI_MSG]} {
860 } elseif {[load_message MERGE_MSG]} {
861 } elseif {[load_message SQUASH_MSG]} {
864 $ui_comm edit modified false
867 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
868 rescan_stage2 {} $after
871 ui_status {Refreshing file status...}
872 set fd_rf [git_read update-index \
878 fconfigure $fd_rf -blocking 0 -translation binary
879 fileevent $fd_rf readable \
880 [list rescan_stage2 $fd_rf $after]
884 proc rescan_stage2 {fd after} {
885 global rescan_active buf_rdi buf_rdf buf_rlo
889 if {![eof $fd]} return
893 set ls_others [list --exclude-per-directory=.gitignore]
894 set info_exclude [gitdir info exclude]
895 if {[file readable $info_exclude]} {
896 lappend ls_others "--exclude-from=$info_exclude"
898 set user_exclude [get_config core.excludesfile]
899 if {$user_exclude ne {} && [file readable $user_exclude]} {
900 lappend ls_others "--exclude-from=$user_exclude"
908 ui_status {Scanning for modified files ...}
909 set fd_di [git_read diff-index --cached -z [PARENT]]
910 set fd_df [git_read diff-files -z]
911 set fd_lo [eval git_read ls-files --others -z $ls_others]
913 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
914 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
915 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
916 fileevent $fd_di readable [list read_diff_index $fd_di $after]
917 fileevent $fd_df readable [list read_diff_files $fd_df $after]
918 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
921 proc load_message {file} {
925 if {[file isfile $f]} {
926 if {[catch {set fd [open $f r]}]} {
929 fconfigure $fd -eofchar {}
930 set content [string trim [read $fd]]
932 regsub -all -line {[ \r\t]+$} $content {} content
933 $ui_comm delete 0.0 end
934 $ui_comm insert end $content
940 proc read_diff_index {fd after} {
943 append buf_rdi [read $fd]
945 set n [string length $buf_rdi]
947 set z1 [string first "\
0" $buf_rdi $c]
950 set z2 [string first "\
0" $buf_rdi $z1]
954 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
955 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
957 [encoding convertfrom $p] \
959 [list [lindex $i 0] [lindex $i 2]] \
965 set buf_rdi [string range $buf_rdi $c end]
970 rescan_done $fd buf_rdi $after
973 proc read_diff_files {fd after} {
976 append buf_rdf [read $fd]
978 set n [string length $buf_rdf]
980 set z1 [string first "\
0" $buf_rdf $c]
983 set z2 [string first "\
0" $buf_rdf $z1]
987 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
988 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
990 [encoding convertfrom $p] \
993 [list [lindex $i 0] [lindex $i 2]]
998 set buf_rdf [string range $buf_rdf $c end]
1003 rescan_done $fd buf_rdf $after
1006 proc read_ls_others {fd after} {
1009 append buf_rlo [read $fd]
1010 set pck [split $buf_rlo "\
0"]
1011 set buf_rlo [lindex $pck end]
1012 foreach p [lrange $pck 0 end-1] {
1013 merge_state [encoding convertfrom $p] ?O
1015 rescan_done $fd buf_rlo $after
1018 proc rescan_done {fd buf after} {
1019 global rescan_active current_diff_path
1020 global file_states repo_config
1023 if {![eof $fd]} return
1026 if {[incr rescan_active -1] > 0} return
1031 if {$current_diff_path ne {}} reshow_diff
1035 proc prune_selection {} {
1036 global file_states selected_paths
1038 foreach path [array names selected_paths] {
1039 if {[catch {set still_here $file_states($path)}]} {
1040 unset selected_paths($path)
1045 ######################################################################
1049 proc mapicon {w state path} {
1052 if {[catch {set r $all_icons($state$w)}]} {
1053 puts "error
: no icon
for $w state
={$state} $path"
1059 proc mapdesc {state path} {
1062 if {[catch {set r $all_descs($state)}]} {
1063 puts "error
: no desc
for state
={$state} $path"
1069 proc ui_status {msg} {
1070 $::main_status show $msg
1073 proc ui_ready {{test {}}} {
1074 $::main_status show {Ready.} $test
1077 proc escape_path {path} {
1078 regsub -all {\\} $path "\\\\" path
1079 regsub -all "\n" $path "\\n
" path
1083 proc short_path {path} {
1084 return [escape_path [lindex [file split $path] end]]
1088 set null_sha1 [string repeat 0 40]
1090 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1091 global file_states next_icon_id null_sha1
1093 set s0 [string index $new_state 0]
1094 set s1 [string index $new_state 1]
1096 if {[catch {set info $file_states($path)}]} {
1098 set icon n[incr next_icon_id]
1100 set state [lindex $info 0]
1101 set icon [lindex $info 1]
1102 if {$head_info eq {}} {set head_info [lindex $info 2]}
1103 if {$index_info eq {}} {set index_info [lindex $info 3]}
1106 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1107 elseif {$s0 eq {_}} {set s0 _}
1109 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1110 elseif {$s1 eq {_}} {set s1 _}
1112 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1113 set head_info [list 0 $null_sha1]
1114 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1115 && $head_info eq {}} {
1116 set head_info $index_info
1119 set file_states($path) [list $s0$s1 $icon \
1120 $head_info $index_info \
1125 proc display_file_helper {w path icon_name old_m new_m} {
1128 if {$new_m eq {_}} {
1129 set lno [lsearch -sorted -exact $file_lists($w) $path]
1131 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1133 $w conf -state normal
1134 $w delete $lno.0 [expr {$lno + 1}].0
1135 $w conf -state disabled
1137 } elseif {$old_m eq {_} && $new_m ne {_}} {
1138 lappend file_lists($w) $path
1139 set file_lists($w) [lsort -unique $file_lists($w)]
1140 set lno [lsearch -sorted -exact $file_lists($w) $path]
1142 $w conf -state normal
1143 $w image create $lno.0 \
1144 -align center -padx 5 -pady 1 \
1146 -image [mapicon $w $new_m $path]
1147 $w insert $lno.1 "[escape_path
$path]\n"
1148 $w conf -state disabled
1149 } elseif {$old_m ne $new_m} {
1150 $w conf -state normal
1151 $w image conf $icon_name -image [mapicon $w $new_m $path]
1152 $w conf -state disabled
1156 proc display_file {path state} {
1157 global file_states selected_paths
1158 global ui_index ui_workdir
1160 set old_m [merge_state $path $state]
1161 set s $file_states($path)
1162 set new_m [lindex $s 0]
1163 set icon_name [lindex $s 1]
1165 set o [string index $old_m 0]
1166 set n [string index $new_m 0]
1173 display_file_helper $ui_index $path $icon_name $o $n
1175 if {[string index $old_m 0] eq {U}} {
1178 set o [string index $old_m 1]
1180 if {[string index $new_m 0] eq {U}} {
1183 set n [string index $new_m 1]
1185 display_file_helper $ui_workdir $path $icon_name $o $n
1187 if {$new_m eq {__}} {
1188 unset file_states($path)
1189 catch {unset selected_paths($path)}
1193 proc display_all_files_helper {w path icon_name m} {
1196 lappend file_lists($w) $path
1197 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1198 $w image create end \
1199 -align center -padx 5 -pady 1 \
1201 -image [mapicon $w $m $path]
1202 $w insert end "[escape_path
$path]\n"
1205 proc display_all_files {} {
1206 global ui_index ui_workdir
1207 global file_states file_lists
1210 $ui_index conf -state normal
1211 $ui_workdir conf -state normal
1213 $ui_index delete 0.0 end
1214 $ui_workdir delete 0.0 end
1217 set file_lists($ui_index) [list]
1218 set file_lists($ui_workdir) [list]
1220 foreach path [lsort [array names file_states]] {
1221 set s $file_states($path)
1223 set icon_name [lindex $s 1]
1225 set s [string index $m 0]
1226 if {$s ne {U} && $s ne {_}} {
1227 display_all_files_helper $ui_index $path \
1231 if {[string index $m 0] eq {U}} {
1234 set s [string index $m 1]
1237 display_all_files_helper $ui_workdir $path \
1242 $ui_index conf -state disabled
1243 $ui_workdir conf -state disabled
1246 ######################################################################
1251 #define mask_width 14
1252 #define mask_height 15
1253 static unsigned char mask_bits[] = {
1254 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1255 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1256 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1259 image create bitmap file_plain -background white -foreground black -data {
1260 #define plain_width 14
1261 #define plain_height 15
1262 static unsigned char plain_bits[] = {
1263 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1264 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1265 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1266 } -maskdata $filemask
1268 image create bitmap file_mod -background white -foreground blue -data {
1269 #define mod_width 14
1270 #define mod_height 15
1271 static unsigned char mod_bits[] = {
1272 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1273 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1274 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1275 } -maskdata $filemask
1277 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1278 #define file_fulltick_width 14
1279 #define file_fulltick_height 15
1280 static unsigned char file_fulltick_bits
[] = {
1281 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1282 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1283 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1284 } -maskdata $filemask
1286 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1287 #define parttick_width 14
1288 #define parttick_height 15
1289 static unsigned char parttick_bits
[] = {
1290 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1291 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1292 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1293 } -maskdata $filemask
1295 image create bitmap file_question
-background white
-foreground black
-data {
1296 #define file_question_width 14
1297 #define file_question_height 15
1298 static unsigned char file_question_bits
[] = {
1299 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1300 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1301 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1302 } -maskdata $filemask
1304 image create bitmap file_removed
-background white
-foreground red
-data {
1305 #define file_removed_width 14
1306 #define file_removed_height 15
1307 static unsigned char file_removed_bits
[] = {
1308 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1309 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1310 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1311 } -maskdata $filemask
1313 image create bitmap file_merge
-background white
-foreground blue
-data {
1314 #define file_merge_width 14
1315 #define file_merge_height 15
1316 static unsigned char file_merge_bits
[] = {
1317 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1318 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1319 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1320 } -maskdata $filemask
1322 set ui_index .vpane.files.index.list
1323 set ui_workdir .vpane.files.workdir.list
1325 set all_icons
(_
$ui_index) file_plain
1326 set all_icons
(A
$ui_index) file_fulltick
1327 set all_icons
(M
$ui_index) file_fulltick
1328 set all_icons
(D
$ui_index) file_removed
1329 set all_icons
(U
$ui_index) file_merge
1331 set all_icons
(_
$ui_workdir) file_plain
1332 set all_icons
(M
$ui_workdir) file_mod
1333 set all_icons
(D
$ui_workdir) file_question
1334 set all_icons
(U
$ui_workdir) file_merge
1335 set all_icons
(O
$ui_workdir) file_plain
1337 set max_status_desc
0
1341 {_M
"Modified, not staged"}
1342 {M_
"Staged for commit"}
1343 {MM
"Portions staged for commit"}
1344 {MD
"Staged for commit, missing"}
1346 {_O
"Untracked, not staged"}
1347 {A_
"Staged for commit"}
1348 {AM
"Portions staged for commit"}
1349 {AD
"Staged for commit, missing"}
1352 {D_
"Staged for removal"}
1353 {DO
"Staged for removal, still present"}
1355 {U_
"Requires merge resolution"}
1356 {UU
"Requires merge resolution"}
1357 {UM
"Requires merge resolution"}
1358 {UD
"Requires merge resolution"}
1360 if {$max_status_desc < [string length
[lindex
$i 1]]} {
1361 set max_status_desc
[string length
[lindex
$i 1]]
1363 set all_descs
([lindex
$i 0]) [lindex
$i 1]
1367 ######################################################################
1371 proc bind_button3
{w cmd
} {
1372 bind $w <Any-Button-3
> $cmd
1374 # Mac OS X sends Button-2 on right click through three-button mouse,
1375 # or through trackpad right-clicking (two-finger touch + click).
1376 bind $w <Any-Button-2
> $cmd
1377 bind $w <Control-Button-1
> $cmd
1381 proc scrollbar2many
{list mode args
} {
1382 foreach w
$list {eval $w $mode $args}
1385 proc many2scrollbar
{list mode sb top bottom
} {
1386 $sb set $top $bottom
1387 foreach w
$list {$w $mode moveto
$top}
1390 proc incr_font_size
{font
{amt
1}} {
1391 set sz
[font configure
$font -size]
1393 font configure
$font -size $sz
1394 font configure
${font}bold
-size $sz
1395 font configure
${font}italic
-size $sz
1398 ######################################################################
1402 set starting_gitk_msg
{Starting gitk... please
wait...
}
1404 proc do_gitk
{revs
} {
1405 # -- Always start gitk through whatever we were loaded with. This
1406 # lets us bypass using shell process on Windows systems.
1408 set exe
[file join [file dirname $
::_git
] gitk
]
1409 set cmd
[list
[info nameofexecutable
] $exe]
1410 if {! [file exists
$exe]} {
1411 error_popup
"Unable to start gitk:\n\n$exe does not exist"
1413 eval exec $cmd $revs &
1414 ui_status $
::starting_gitk_msg
1416 ui_ready
$starting_gitk_msg
1424 global ui_comm is_quitting repo_config commit_type
1425 global GITGUI_BCK_exists GITGUI_BCK_i
1427 if {$is_quitting} return
1430 if {[winfo exists
$ui_comm]} {
1431 # -- Stash our current commit buffer.
1433 set save
[gitdir GITGUI_MSG
]
1434 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1435 file rename
-force [gitdir GITGUI_BCK
] $save
1436 set GITGUI_BCK_exists
0
1438 set msg
[string trim
[$ui_comm get
0.0 end
]]
1439 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1440 if {(![string match amend
* $commit_type]
1441 ||
[$ui_comm edit modified
])
1444 set fd
[open
$save w
]
1445 puts
-nonewline $fd $msg
1449 catch
{file delete
$save}
1453 # -- Remove our editor backup, its not needed.
1455 after cancel
$GITGUI_BCK_i
1456 if {$GITGUI_BCK_exists} {
1457 catch
{file delete
[gitdir GITGUI_BCK
]}
1460 # -- Stash our current window geometry into this repository.
1462 set cfg_geometry
[list
]
1463 lappend cfg_geometry
[wm geometry .
]
1464 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1465 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1466 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1469 if {$cfg_geometry ne
$rc_geometry} {
1470 catch
{git config gui.geometry
$cfg_geometry}
1485 proc toggle_or_diff
{w x y
} {
1486 global file_states file_lists current_diff_path ui_index ui_workdir
1487 global last_clicked selected_paths
1489 set pos
[split [$w index @
$x,$y] .
]
1490 set lno
[lindex
$pos 0]
1491 set col [lindex
$pos 1]
1492 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1498 set last_clicked
[list
$w $lno]
1499 array
unset selected_paths
1500 $ui_index tag remove in_sel
0.0 end
1501 $ui_workdir tag remove in_sel
0.0 end
1504 if {$current_diff_path eq
$path} {
1505 set after
{reshow_diff
;}
1509 if {$w eq
$ui_index} {
1511 "Unstaging [short_path $path] from commit" \
1513 [concat
$after [list ui_ready
]]
1514 } elseif
{$w eq
$ui_workdir} {
1516 "Adding [short_path $path]" \
1518 [concat
$after [list ui_ready
]]
1521 show_diff
$path $w $lno
1525 proc add_one_to_selection
{w x y
} {
1526 global file_lists last_clicked selected_paths
1528 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1529 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1535 if {$last_clicked ne
{}
1536 && [lindex
$last_clicked 0] ne
$w} {
1537 array
unset selected_paths
1538 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1541 set last_clicked
[list
$w $lno]
1542 if {[catch
{set in_sel
$selected_paths($path)}]} {
1546 unset selected_paths
($path)
1547 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1549 set selected_paths
($path) 1
1550 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1554 proc add_range_to_selection
{w x y
} {
1555 global file_lists last_clicked selected_paths
1557 if {[lindex
$last_clicked 0] ne
$w} {
1558 toggle_or_diff
$w $x $y
1562 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1563 set lc
[lindex
$last_clicked 1]
1572 foreach path
[lrange
$file_lists($w) \
1573 [expr {$begin - 1}] \
1574 [expr {$end - 1}]] {
1575 set selected_paths
($path) 1
1577 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1580 ######################################################################
1584 set cursor_ptr arrow
1585 font create font_diff
-family Courier
-size 10
1589 eval font configure font_ui
[font actual
[.dummy cget
-font]]
1593 font create font_uiitalic
1594 font create font_uibold
1595 font create font_diffbold
1596 font create font_diffitalic
1598 foreach class
{Button Checkbutton Entry Label
1599 Labelframe Listbox Menu Message
1600 Radiobutton Spinbox Text
} {
1601 option add
*$class.font font_ui
1605 if {[is_Windows
] ||
[is_MacOSX
]} {
1606 option add
*Menu.tearOff
0
1617 proc apply_config
{} {
1618 global repo_config font_descs
1620 foreach option
$font_descs {
1621 set name
[lindex
$option 0]
1622 set font
[lindex
$option 1]
1624 foreach
{cn cv
} $repo_config(gui.
$name) {
1625 font configure
$font $cn $cv
1628 error_popup
"Invalid font specified in gui.$name:\n\n$err"
1630 foreach
{cn cv
} [font configure
$font] {
1631 font configure
${font}bold
$cn $cv
1632 font configure
${font}italic
$cn $cv
1634 font configure
${font}bold
-weight bold
1635 font configure
${font}italic
-slant italic
1639 set default_config
(merge.diffstat
) true
1640 set default_config
(merge.summary
) false
1641 set default_config
(merge.verbosity
) 2
1642 set default_config
(user.name
) {}
1643 set default_config
(user.email
) {}
1645 set default_config
(gui.matchtrackingbranch
) false
1646 set default_config
(gui.pruneduringfetch
) false
1647 set default_config
(gui.trustmtime
) false
1648 set default_config
(gui.diffcontext
) 5
1649 set default_config
(gui.newbranchtemplate
) {}
1650 set default_config
(gui.fontui
) [font configure font_ui
]
1651 set default_config
(gui.fontdiff
) [font configure font_diff
]
1653 {fontui font_ui
{Main Font
}}
1654 {fontdiff font_diff
{Diff
/Console Font
}}
1659 ######################################################################
1667 menu .mbar
-tearoff 0
1668 .mbar add cascade
-label Repository
-menu .mbar.repository
1669 .mbar add cascade
-label Edit
-menu .mbar.edit
1670 if {[is_enabled branch
]} {
1671 .mbar add cascade
-label Branch
-menu .mbar.branch
1673 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1674 .mbar add cascade
-label Commit
-menu .mbar.commit
1676 if {[is_enabled transport
]} {
1677 .mbar add cascade
-label Merge
-menu .mbar.merge
1678 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1679 .mbar add cascade
-label Push
-menu .mbar.push
1681 . configure
-menu .mbar
1683 # -- Repository Menu
1685 menu .mbar.repository
1687 .mbar.repository add
command \
1688 -label {Browse Current Branch
's Files} \
1689 -command {browser::new $current_branch}
1690 set ui_browse_current [.mbar.repository index last]
1691 .mbar.repository add command \
1692 -label {Browse Branch Files...} \
1693 -command browser_open::dialog
1694 .mbar.repository add separator
1696 .mbar.repository add command \
1697 -label {Visualize Current Branch's History
} \
1698 -command {do_gitk
$current_branch}
1699 set ui_visualize_current
[.mbar.repository index last
]
1700 .mbar.repository add
command \
1701 -label {Visualize All Branch History
} \
1702 -command {do_gitk
--all}
1703 .mbar.repository add separator
1705 proc current_branch_write
{args
} {
1706 global current_branch
1707 .mbar.repository entryconf $
::ui_browse_current \
1708 -label "Browse $current_branch's Files"
1709 .mbar.repository entryconf $
::ui_visualize_current \
1710 -label "Visualize $current_branch's History"
1712 trace add variable current_branch
write current_branch_write
1714 if {[is_enabled multicommit
]} {
1715 .mbar.repository add
command -label {Database Statistics
} \
1718 .mbar.repository add
command -label {Compress Database
} \
1721 .mbar.repository add
command -label {Verify Database
} \
1722 -command do_fsck_objects
1724 .mbar.repository add separator
1727 .mbar.repository add
command \
1728 -label {Create Desktop Icon
} \
1729 -command do_cygwin_shortcut
1730 } elseif
{[is_Windows
]} {
1731 .mbar.repository add
command \
1732 -label {Create Desktop Icon
} \
1733 -command do_windows_shortcut
1734 } elseif
{[is_MacOSX
]} {
1735 .mbar.repository add
command \
1736 -label {Create Desktop Icon
} \
1737 -command do_macosx_app
1741 .mbar.repository add
command -label Quit \
1748 .mbar.edit add
command -label Undo \
1749 -command {catch
{[focus
] edit undo
}} \
1751 .mbar.edit add
command -label Redo \
1752 -command {catch
{[focus
] edit redo
}} \
1754 .mbar.edit add separator
1755 .mbar.edit add
command -label Cut \
1756 -command {catch
{tk_textCut
[focus
]}} \
1758 .mbar.edit add
command -label Copy \
1759 -command {catch
{tk_textCopy
[focus
]}} \
1761 .mbar.edit add
command -label Paste \
1762 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1764 .mbar.edit add
command -label Delete \
1765 -command {catch
{[focus
] delete sel.first sel.last
}} \
1767 .mbar.edit add separator
1768 .mbar.edit add
command -label {Select All
} \
1769 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1774 if {[is_enabled branch
]} {
1777 .mbar.branch add
command -label {Create...
} \
1778 -command branch_create
::dialog \
1780 lappend disable_on_lock
[list .mbar.branch entryconf \
1781 [.mbar.branch index last
] -state]
1783 .mbar.branch add
command -label {Checkout...
} \
1784 -command branch_checkout
::dialog \
1786 lappend disable_on_lock
[list .mbar.branch entryconf \
1787 [.mbar.branch index last
] -state]
1789 .mbar.branch add
command -label {Rename...
} \
1790 -command branch_rename
::dialog
1791 lappend disable_on_lock
[list .mbar.branch entryconf \
1792 [.mbar.branch index last
] -state]
1794 .mbar.branch add
command -label {Delete...
} \
1795 -command branch_delete
::dialog
1796 lappend disable_on_lock
[list .mbar.branch entryconf \
1797 [.mbar.branch index last
] -state]
1799 .mbar.branch add
command -label {Reset...
} \
1800 -command merge
::reset_hard
1801 lappend disable_on_lock
[list .mbar.branch entryconf \
1802 [.mbar.branch index last
] -state]
1807 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1810 .mbar.commit add radiobutton \
1811 -label {New Commit
} \
1812 -command do_select_commit_type \
1813 -variable selected_commit_type \
1815 lappend disable_on_lock \
1816 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1818 .mbar.commit add radiobutton \
1819 -label {Amend Last Commit
} \
1820 -command do_select_commit_type \
1821 -variable selected_commit_type \
1823 lappend disable_on_lock \
1824 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1826 .mbar.commit add separator
1828 .mbar.commit add
command -label Rescan \
1829 -command do_rescan \
1831 lappend disable_on_lock \
1832 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1834 .mbar.commit add
command -label {Stage To Commit
} \
1835 -command do_add_selection
1836 lappend disable_on_lock \
1837 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1839 .mbar.commit add
command -label {Stage Changed Files To Commit
} \
1840 -command do_add_all \
1842 lappend disable_on_lock \
1843 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1845 .mbar.commit add
command -label {Unstage From Commit
} \
1846 -command do_unstage_selection
1847 lappend disable_on_lock \
1848 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1850 .mbar.commit add
command -label {Revert Changes
} \
1851 -command do_revert_selection
1852 lappend disable_on_lock \
1853 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1855 .mbar.commit add separator
1857 .mbar.commit add
command -label {Sign Off
} \
1858 -command do_signoff \
1861 .mbar.commit add
command -label Commit \
1862 -command do_commit \
1863 -accelerator $M1T-Return
1864 lappend disable_on_lock \
1865 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1870 if {[is_enabled branch
]} {
1872 .mbar.merge add
command -label {Local Merge...
} \
1873 -command merge
::dialog \
1875 lappend disable_on_lock \
1876 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1877 .mbar.merge add
command -label {Abort Merge...
} \
1878 -command merge
::reset_hard
1879 lappend disable_on_lock \
1880 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1885 if {[is_enabled transport
]} {
1889 .mbar.push add
command -label {Push...
} \
1890 -command do_push_anywhere \
1892 .mbar.push add
command -label {Delete...
} \
1893 -command remote_branch_delete
::dialog
1897 # -- Apple Menu (Mac OS X only)
1899 .mbar add cascade
-label Apple
-menu .mbar.apple
1902 .mbar.apple add
command -label "About [appname]" \
1904 .mbar.apple add
command -label "Options..." \
1909 .mbar.edit add separator
1910 .mbar.edit add
command -label {Options...
} \
1916 .mbar add cascade
-label Help
-menu .mbar.
help
1920 .mbar.
help add
command -label "About [appname]" \
1925 catch
{set browser
$repo_config(instaweb.browser
)}
1926 set doc_path
[file dirname [gitexec
]]
1927 set doc_path
[file join $doc_path Documentation index.html
]
1930 set doc_path
[exec cygpath
--mixed $doc_path]
1933 if {$browser eq
{}} {
1936 } elseif
{[is_Cygwin
]} {
1937 set program_files
[file dirname [exec cygpath
--windir]]
1938 set program_files
[file join $program_files {Program Files
}]
1939 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
1940 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
1941 if {[file exists
$firefox]} {
1942 set browser
$firefox
1943 } elseif
{[file exists
$ie]} {
1946 unset program_files firefox ie
1950 if {[file isfile
$doc_path]} {
1951 set doc_url
"file:$doc_path"
1953 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
1956 if {$browser ne
{}} {
1957 .mbar.
help add
command -label {Online Documentation
} \
1958 -command [list
exec $browser $doc_url &]
1960 unset browser doc_path doc_url
1963 bind .
<Visibility
> {
1964 bind .
<Visibility
> {}
1968 # -- Standard bindings
1970 wm protocol . WM_DELETE_WINDOW do_quit
1971 bind all
<$M1B-Key-q> do_quit
1972 bind all
<$M1B-Key-Q> do_quit
1973 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1974 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1976 set subcommand_args
{}
1978 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
1982 # -- Not a normal commit type invocation? Do that instead!
1984 switch
-- $subcommand {
1987 set subcommand_args
{rev? path
}
1988 if {$argv eq
{}} usage
1993 if {$is_path ||
[file exists
$_prefix$a]} {
1994 if {$path ne
{}} usage
1997 } elseif
{$a eq
{--}} {
1999 if {$head ne
{}} usage
2004 } elseif
{$head eq
{}} {
2005 if {$head ne
{}} usage
2014 if {$head ne
{} && $path eq
{}} {
2015 set path
$_prefix$head
2022 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2024 set head [git rev-parse
--verify $head]
2030 set current_branch
$head
2033 switch
-- $subcommand {
2036 if {$path ne
{} && [file isdirectory
$path]} {
2037 set head $current_branch
2043 browser
::new
$head $path
2046 if {$head eq
{} && ![file exists
$path]} {
2047 puts stderr
"fatal: cannot stat path $path: No such file or directory"
2050 blame
::new
$head $path
2057 if {[llength
$argv] != 0} {
2058 puts
-nonewline stderr
"usage: $argv0"
2059 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
2060 puts
-nonewline stderr
" $subcommand"
2065 # fall through to setup UI for commits
2068 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2079 -text {Current Branch
:} \
2083 -textvariable current_branch \
2086 pack .branch.l1
-side left
2087 pack .branch.cb
-side left
-fill x
2088 pack .branch
-side top
-fill x
2090 # -- Main Window Layout
2092 panedwindow .vpane
-orient vertical
2093 panedwindow .vpane.files
-orient horizontal
2094 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2095 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2097 # -- Index File List
2099 frame .vpane.files.index
-height 100 -width 200
2100 label .vpane.files.index.title
-text {Staged Changes
(Will Be Committed
)} \
2101 -background lightgreen
2102 text
$ui_index -background white
-borderwidth 0 \
2103 -width 20 -height 10 \
2105 -cursor $cursor_ptr \
2106 -xscrollcommand {.vpane.files.index.sx
set} \
2107 -yscrollcommand {.vpane.files.index.sy
set} \
2109 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2110 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2111 pack .vpane.files.index.title
-side top
-fill x
2112 pack .vpane.files.index.sx
-side bottom
-fill x
2113 pack .vpane.files.index.sy
-side right
-fill y
2114 pack
$ui_index -side left
-fill both
-expand 1
2115 .vpane.files add .vpane.files.index
-sticky nsew
2117 # -- Working Directory File List
2119 frame .vpane.files.workdir
-height 100 -width 200
2120 label .vpane.files.workdir.title
-text {Unstaged Changes
(Will Not Be Committed
)} \
2121 -background lightsalmon
2122 text
$ui_workdir -background white
-borderwidth 0 \
2123 -width 20 -height 10 \
2125 -cursor $cursor_ptr \
2126 -xscrollcommand {.vpane.files.workdir.sx
set} \
2127 -yscrollcommand {.vpane.files.workdir.sy
set} \
2129 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2130 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2131 pack .vpane.files.workdir.title
-side top
-fill x
2132 pack .vpane.files.workdir.sx
-side bottom
-fill x
2133 pack .vpane.files.workdir.sy
-side right
-fill y
2134 pack
$ui_workdir -side left
-fill both
-expand 1
2135 .vpane.files add .vpane.files.workdir
-sticky nsew
2137 foreach i
[list
$ui_index $ui_workdir] {
2138 $i tag conf in_diff
-background lightgray
2139 $i tag conf in_sel
-background lightgray
2143 # -- Diff and Commit Area
2145 frame .vpane.lower
-height 300 -width 400
2146 frame .vpane.lower.commarea
2147 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2148 pack .vpane.lower.commarea
-side top
-fill x
2149 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
2150 .vpane add .vpane.lower
-sticky nsew
2152 # -- Commit Area Buttons
2154 frame .vpane.lower.commarea.buttons
2155 label .vpane.lower.commarea.buttons.l
-text {} \
2158 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2159 pack .vpane.lower.commarea.buttons
-side left
-fill y
2161 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
2163 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2164 lappend disable_on_lock \
2165 {.vpane.lower.commarea.buttons.rescan conf
-state}
2167 button .vpane.lower.commarea.buttons.incall
-text {Stage Changed
} \
2169 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2170 lappend disable_on_lock \
2171 {.vpane.lower.commarea.buttons.incall conf
-state}
2173 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
2175 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2177 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
2179 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2180 lappend disable_on_lock \
2181 {.vpane.lower.commarea.buttons.commit conf
-state}
2183 button .vpane.lower.commarea.buttons.push
-text {Push
} \
2184 -command do_push_anywhere
2185 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2187 # -- Commit Message Buffer
2189 frame .vpane.lower.commarea.buffer
2190 frame .vpane.lower.commarea.buffer.header
2191 set ui_comm .vpane.lower.commarea.buffer.t
2192 set ui_coml .vpane.lower.commarea.buffer.header.l
2193 radiobutton .vpane.lower.commarea.buffer.header.new \
2194 -text {New Commit
} \
2195 -command do_select_commit_type \
2196 -variable selected_commit_type \
2198 lappend disable_on_lock \
2199 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2200 radiobutton .vpane.lower.commarea.buffer.header.amend \
2201 -text {Amend Last Commit
} \
2202 -command do_select_commit_type \
2203 -variable selected_commit_type \
2205 lappend disable_on_lock \
2206 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2210 proc trace_commit_type
{varname args
} {
2211 global ui_coml commit_type
2212 switch
-glob -- $commit_type {
2213 initial
{set txt
{Initial Commit Message
:}}
2214 amend
{set txt
{Amended Commit Message
:}}
2215 amend-initial
{set txt
{Amended Initial Commit Message
:}}
2216 amend-merge
{set txt
{Amended Merge Commit Message
:}}
2217 merge
{set txt
{Merge Commit Message
:}}
2218 * {set txt
{Commit Message
:}}
2220 $ui_coml conf
-text $txt
2222 trace add variable commit_type
write trace_commit_type
2223 pack
$ui_coml -side left
-fill x
2224 pack .vpane.lower.commarea.buffer.header.amend
-side right
2225 pack .vpane.lower.commarea.buffer.header.new
-side right
2227 text
$ui_comm -background white
-borderwidth 1 \
2230 -autoseparators true \
2232 -width 75 -height 9 -wrap none \
2234 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2235 scrollbar .vpane.lower.commarea.buffer.sby \
2236 -command [list
$ui_comm yview
]
2237 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2238 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2239 pack
$ui_comm -side left
-fill y
2240 pack .vpane.lower.commarea.buffer
-side left
-fill y
2242 # -- Commit Message Buffer Context Menu
2244 set ctxm .vpane.lower.commarea.buffer.ctxm
2245 menu
$ctxm -tearoff 0
2248 -command {tk_textCut
$ui_comm}
2251 -command {tk_textCopy
$ui_comm}
2254 -command {tk_textPaste
$ui_comm}
2257 -command {$ui_comm delete sel.first sel.last
}
2260 -label {Select All
} \
2261 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2265 $ui_comm tag add sel
0.0 end
2266 tk_textCopy
$ui_comm
2267 $ui_comm tag remove sel
0.0 end
2273 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
2277 proc trace_current_diff_path
{varname args
} {
2278 global current_diff_path diff_actions file_states
2279 if {$current_diff_path eq
{}} {
2285 set p
$current_diff_path
2286 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2288 set p
[escape_path
$p]
2292 .vpane.lower.
diff.header.status configure
-text $s
2293 .vpane.lower.
diff.header.
file configure
-text $f
2294 .vpane.lower.
diff.header.path configure
-text $p
2295 foreach w
$diff_actions {
2299 trace add variable current_diff_path
write trace_current_diff_path
2301 frame .vpane.lower.
diff.header
-background gold
2302 label .vpane.lower.
diff.header.status \
2304 -width $max_status_desc \
2307 label .vpane.lower.
diff.header.
file \
2311 label .vpane.lower.
diff.header.path \
2315 pack .vpane.lower.
diff.header.status
-side left
2316 pack .vpane.lower.
diff.header.
file -side left
2317 pack .vpane.lower.
diff.header.path
-fill x
2318 set ctxm .vpane.lower.
diff.header.ctxm
2319 menu
$ctxm -tearoff 0
2327 -- $current_diff_path
2329 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2330 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2334 frame .vpane.lower.
diff.body
2335 set ui_diff .vpane.lower.
diff.body.t
2336 text
$ui_diff -background white
-borderwidth 0 \
2337 -width 80 -height 15 -wrap none \
2339 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2340 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2342 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2343 -command [list
$ui_diff xview
]
2344 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2345 -command [list
$ui_diff yview
]
2346 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2347 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2348 pack
$ui_diff -side left
-fill both
-expand 1
2349 pack .vpane.lower.
diff.header
-side top
-fill x
2350 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2352 $ui_diff tag conf d_cr
-elide true
2353 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2354 $ui_diff tag conf d_
+ -foreground {#00a000}
2355 $ui_diff tag conf d_-
-foreground red
2357 $ui_diff tag conf d_
++ -foreground {#00a000}
2358 $ui_diff tag conf d_--
-foreground red
2359 $ui_diff tag conf d_
+s \
2360 -foreground {#00a000} \
2361 -background {#e2effa}
2362 $ui_diff tag conf d_-s \
2364 -background {#e2effa}
2365 $ui_diff tag conf d_s
+ \
2366 -foreground {#00a000} \
2368 $ui_diff tag conf d_s- \
2372 $ui_diff tag conf d
<<<<<<< \
2373 -foreground orange \
2375 $ui_diff tag conf d
======= \
2376 -foreground orange \
2378 $ui_diff tag conf d
>>>>>>> \
2379 -foreground orange \
2382 $ui_diff tag raise sel
2384 # -- Diff Body Context Menu
2386 set ctxm .vpane.lower.
diff.body.ctxm
2387 menu
$ctxm -tearoff 0
2390 -command reshow_diff
2391 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2394 -command {tk_textCopy
$ui_diff}
2395 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2397 -label {Select All
} \
2398 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2399 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2403 $ui_diff tag add sel
0.0 end
2404 tk_textCopy
$ui_diff
2405 $ui_diff tag remove sel
0.0 end
2407 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2410 -label {Apply
/Reverse Hunk
} \
2411 -command {apply_hunk
$cursorX $cursorY}
2412 set ui_diff_applyhunk
[$ctxm index last
]
2413 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2416 -label {Decrease Font Size
} \
2417 -command {incr_font_size font_diff
-1}
2418 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2420 -label {Increase Font Size
} \
2421 -command {incr_font_size font_diff
1}
2422 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2425 -label {Show Less Context
} \
2426 -command {if {$repo_config(gui.diffcontext
) >= 1} {
2427 incr repo_config
(gui.diffcontext
) -1
2430 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2432 -label {Show More Context
} \
2433 -command {if {$repo_config(gui.diffcontext
) < 99} {
2434 incr repo_config
(gui.diffcontext
)
2437 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2439 $ctxm add
command -label {Options...
} \
2441 proc popup_diff_menu
{ctxm x y X Y
} {
2442 global current_diff_path file_states
2445 if {$
::ui_index eq $
::current_diff_side
} {
2446 set l
"Unstage Hunk From Commit"
2448 set l
"Stage Hunk For Commit"
2451 ||
$current_diff_path eq
{}
2452 ||
![info exists file_states
($current_diff_path)]
2453 ||
{_O
} eq
[lindex
$file_states($current_diff_path) 0]} {
2458 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
2459 tk_popup
$ctxm $X $Y
2461 bind_button3
$ui_diff [list popup_diff_menu
$ctxm %x
%y
%X
%Y
]
2465 set main_status
[::status_bar
::new .status
]
2466 pack .status
-anchor w
-side bottom
-fill x
2467 $main_status show
{Initializing...
}
2472 set gm
$repo_config(gui.geometry
)
2473 wm geometry .
[lindex
$gm 0]
2474 .vpane sash place
0 \
2475 [lindex
[.vpane sash coord
0] 0] \
2477 .vpane.files sash place
0 \
2479 [lindex
[.vpane.files sash coord
0] 1]
2485 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2486 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2487 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2488 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2489 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2490 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2491 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2492 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2493 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2494 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2495 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2497 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2498 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2499 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2500 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2501 bind $ui_diff <$M1B-Key-v> {break}
2502 bind $ui_diff <$M1B-Key-V> {break}
2503 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2504 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2505 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2506 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2507 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2508 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2509 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2510 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2511 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2512 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2513 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2514 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2515 bind $ui_diff <Button-1
> {focus
%W
}
2517 if {[is_enabled branch
]} {
2518 bind .
<$M1B-Key-n> branch_create
::dialog
2519 bind .
<$M1B-Key-N> branch_create
::dialog
2520 bind .
<$M1B-Key-o> branch_checkout
::dialog
2521 bind .
<$M1B-Key-O> branch_checkout
::dialog
2522 bind .
<$M1B-Key-m> merge
::dialog
2523 bind .
<$M1B-Key-M> merge
::dialog
2525 if {[is_enabled transport
]} {
2526 bind .
<$M1B-Key-p> do_push_anywhere
2527 bind .
<$M1B-Key-P> do_push_anywhere
2530 bind .
<Key-F5
> do_rescan
2531 bind .
<$M1B-Key-r> do_rescan
2532 bind .
<$M1B-Key-R> do_rescan
2533 bind .
<$M1B-Key-s> do_signoff
2534 bind .
<$M1B-Key-S> do_signoff
2535 bind .
<$M1B-Key-i> do_add_all
2536 bind .
<$M1B-Key-I> do_add_all
2537 bind .
<$M1B-Key-Return> do_commit
2538 foreach i
[list
$ui_index $ui_workdir] {
2539 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2540 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2541 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2545 set file_lists
($ui_index) [list
]
2546 set file_lists
($ui_workdir) [list
]
2548 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2549 focus
-force $ui_comm
2551 # -- Warn the user about environmental problems. Cygwin's Tcl
2552 # does *not* pass its env array onto any processes it spawns.
2553 # This means that git processes get none of our environment.
2558 set msg
"Possible environment issues exist.
2560 The following environment variables are probably
2561 going to be ignored by any Git subprocess run
2565 foreach name
[array names env
] {
2566 switch
-regexp -- $name {
2567 {^GIT_INDEX_FILE$
} -
2568 {^GIT_OBJECT_DIRECTORY$
} -
2569 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2571 {^GIT_EXTERNAL_DIFF$
} -
2575 {^GIT_CONFIG_LOCAL$
} -
2576 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2577 append msg
" - $name\n"
2580 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2581 append msg
" - $name\n"
2583 set suggest_user
$name
2587 if {$ignored_env > 0} {
2589 This is due to a known issue with the
2590 Tcl binary distributed by Cygwin."
2592 if {$suggest_user ne
{}} {
2595 A good replacement for $suggest_user
2596 is placing values for the user.name and
2597 user.email settings into your personal
2603 unset ignored_env msg suggest_user name
2606 # -- Only initialize complex UI if we are going to stay running.
2608 if {[is_enabled transport
]} {
2615 if {[winfo exists
$ui_comm]} {
2616 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
2618 # -- If both our backup and message files exist use the
2619 # newer of the two files to initialize the buffer.
2621 if {$GITGUI_BCK_exists} {
2622 set m
[gitdir GITGUI_MSG
]
2623 if {[file isfile
$m]} {
2624 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
2625 catch
{file delete
[gitdir GITGUI_MSG
]}
2627 $ui_comm delete
0.0 end
2629 $ui_comm edit modified false
2630 catch
{file delete
[gitdir GITGUI_BCK
]}
2631 set GITGUI_BCK_exists
0
2637 proc backup_commit_buffer
{} {
2638 global ui_comm GITGUI_BCK_exists
2640 set m
[$ui_comm edit modified
]
2641 if {$m ||
$GITGUI_BCK_exists} {
2642 set msg
[string trim
[$ui_comm get
0.0 end
]]
2643 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2646 if {$GITGUI_BCK_exists} {
2647 catch
{file delete
[gitdir GITGUI_BCK
]}
2648 set GITGUI_BCK_exists
0
2652 set fd
[open
[gitdir GITGUI_BCK
] w
]
2653 puts
-nonewline $fd $msg
2655 set GITGUI_BCK_exists
1
2659 $ui_comm edit modified false
2662 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
2665 backup_commit_buffer
2668 lock_index begin-read
2669 if {![winfo ismapped .
]} {
2673 if {[is_enabled multicommit
]} {