2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 ||
test "z$*" = z--version
; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
11 set appvers
{@@GITGUI_VERSION@@
}
13 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
15 This program is free software
; you can redistribute it and
/or modify
16 it under the terms of the GNU General Public License as published by
17 the Free Software Foundation
; either version
2 of the License
, or
18 (at your option
) any later version.
20 This program is distributed
in the hope that it will be useful
,
21 but WITHOUT ANY WARRANTY
; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 GNU General Public License
for more details.
25 You should have received a copy of the GNU General Public License
26 along with this program
; if not
, write to the Free Software
27 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}
29 ######################################################################
31 ## Tcl/Tk sanity check
33 if {[catch
{package require Tcl
8.4} err
]
34 ||
[catch
{package require Tk
8.4} err
]
40 -title "git-gui: fatal error" \
45 catch
{rename send
{}} ; # What an evil concept...
47 ######################################################################
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 ######################################################################
67 ## Fake internationalization to ease backporting of changes.
70 set cmk
[string first @@
$fmt]
72 set fmt [string range
$fmt 0 [expr {$cmk - 1}]]
74 return [eval [list format
$fmt] $args]
77 ######################################################################
81 set _appname
[lindex
[file split $argv0] end
]
98 return [eval [list
file join $_gitdir] $args]
101 proc gitexec
{args
} {
103 if {$_gitexec eq
{}} {
104 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
105 error
"Git not installed?\n\n$err"
108 set _gitexec
[exec cygpath \
113 set _gitexec
[file normalize
$_gitexec]
119 return [eval [list
file join $_gitexec] $args]
127 if {[tk windowingsystem
] eq
{aqua
}} {
134 if {$
::tcl_platform
(platform
) eq
{windows
}} {
142 if {$_iscygwin eq
{}} {
143 if {$
::tcl_platform
(platform
) eq
{windows
}} {
144 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
156 proc is_enabled
{option
} {
157 global enabled_options
158 if {[catch
{set on
$enabled_options($option)}]} {return 0}
162 proc enable_option
{option
} {
163 global enabled_options
164 set enabled_options
($option) 1
167 proc disable_option
{option
} {
168 global enabled_options
169 set enabled_options
($option) 0
172 ######################################################################
176 proc is_many_config
{name
} {
177 switch
-glob -- $name {
186 proc is_config_true
{name
} {
188 if {[catch
{set v
$repo_config($name)}]} {
190 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
197 proc get_config
{name
} {
199 if {[catch
{set v
$repo_config($name)}]} {
206 proc load_config
{include_global
} {
207 global repo_config global_config default_config
209 array
unset global_config
210 if {$include_global} {
212 set fd_rc
[git_read config
--global --list]
213 while {[gets
$fd_rc line
] >= 0} {
214 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
215 if {[is_many_config
$name]} {
216 lappend global_config
($name) $value
218 set global_config
($name) $value
226 array
unset repo_config
228 set fd_rc
[git_read config
--list]
229 while {[gets
$fd_rc line
] >= 0} {
230 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
231 if {[is_many_config
$name]} {
232 lappend repo_config
($name) $value
234 set repo_config
($name) $value
241 foreach name
[array names default_config
] {
242 if {[catch
{set v
$global_config($name)}]} {
243 set global_config
($name) $default_config($name)
245 if {[catch
{set v
$repo_config($name)}]} {
246 set repo_config
($name) $default_config($name)
251 ######################################################################
255 proc _git_cmd
{name
} {
258 if {[catch
{set v
$_git_cmd_path($name)}]} {
262 --exec-path { return [list $
::_git
$name] }
265 set p
[gitexec git-
$name$
::_search_exe
]
266 if {[file exists
$p]} {
268 } elseif
{[is_Windows
] && [file exists
[gitexec git-
$name]]} {
269 # Try to determine what sort of magic will make
270 # git-$name go and do its thing, because native
271 # Tcl on Windows doesn't know it.
273 set p
[gitexec git-
$name]
278 switch
-glob -- [lindex
$s 0] {
280 #!*perl { set i perl }
281 #!*python { set i python }
282 default
{ error
"git-$name is not supported: $s" }
286 if {![info exists interp
]} {
287 set interp
[_which
$i]
290 error
"git-$name requires $i (not in PATH)"
292 set v
[concat
[list
$interp] [lrange
$s 1 end
] [list
$p]]
294 # Assume it is builtin to git somehow and we
295 # aren't actually able to see a file for it.
297 set v
[list $
::_git
$name]
299 set _git_cmd_path
($name) $v
305 global env _search_exe _search_path
307 if {$_search_path eq
{}} {
308 if {[is_Cygwin
] && [regexp
{^
(/|\.
:)} $env(PATH
)]} {
309 set _search_path
[split [exec cygpath \
315 } elseif
{[is_Windows
]} {
316 set _search_path
[split $env(PATH
) {;}]
319 set _search_path
[split $env(PATH
) :]
324 foreach p
$_search_path {
325 set p
[file join $p $what$_search_exe]
326 if {[file exists
$p]} {
327 return [file normalize
$p]
333 proc _lappend_nice
{cmd_var
} {
337 if {![info exists _nice
]} {
338 set _nice
[_which nice
]
349 switch
-- [lindex
$args 0] {
360 set args
[lrange
$args 1 end
]
363 set cmdp
[_git_cmd
[lindex
$args 0]]
364 set args
[lrange
$args 1 end
]
366 return [eval $opt $cmdp $args]
369 proc _open_stdout_stderr
{cmd
} {
373 if { [lindex
$cmd end
] eq
{2>@
1}
374 && $err eq
{can not
find channel named
"1"}
376 # Older versions of Tcl 8.4 don't have this 2>@1 IO
377 # redirect operator. Fallback to |& cat for those.
378 # The command was not actually started, so its safe
379 # to try to start it a second time.
381 set fd
[open
[concat \
382 [lrange
$cmd 0 end-1
] \
389 fconfigure
$fd -eofchar {}
393 proc git_read
{args
} {
397 switch
-- [lindex
$args 0] {
412 set args
[lrange
$args 1 end
]
415 set cmdp
[_git_cmd
[lindex
$args 0]]
416 set args
[lrange
$args 1 end
]
418 return [_open_stdout_stderr
[concat
$opt $cmdp $args]]
421 proc git_write
{args
} {
425 switch
-- [lindex
$args 0] {
436 set args
[lrange
$args 1 end
]
439 set cmdp
[_git_cmd
[lindex
$args 0]]
440 set args
[lrange
$args 1 end
]
442 return [open
[concat
$opt $cmdp $args] w
]
446 regsub
-all ' $value "'\\''" value
450 proc load_current_branch {} {
451 global current_branch is_detached
453 set fd [open [gitdir HEAD] r]
454 if {[gets $fd ref] < 1} {
459 set pfx {ref: refs/heads/}
460 set len [string length $pfx]
461 if {[string equal -length $len $pfx $ref]} {
462 # We're on a branch. It might not exist. But
463 # HEAD looks good enough to be a branch.
465 set current_branch [string range $ref $len end]
468 # Assume this is a detached head.
470 set current_branch HEAD
475 auto_load tk_optionMenu
476 rename tk_optionMenu real__tkOptionMenu
477 proc tk_optionMenu {w varName args} {
478 set m [eval real__tkOptionMenu $w $varName $args]
479 $m configure -font font_ui
480 $w configure -font font_ui
484 proc rmsel_tag {text} {
486 -background [$text cget -background] \
487 -foreground [$text cget -foreground] \
489 $text tag conf in_sel -background lightgray
490 bind $text <Motion> break
494 ######################################################################
498 set _git [_which git]
500 catch {wm withdraw .}
504 -title [mc "git-gui
: fatal error
"] \
505 -message [mc "Cannot
find git
in PATH.
"]
509 ######################################################################
513 if {[catch {set _git_version [git --version]} err]} {
514 catch {wm withdraw .}
518 -title "git-gui
: fatal error
" \
519 -message "Cannot determine Git version
:
523 [appname
] requires Git
1.5.0 or later.
"
526 if {![regsub {^git version } $_git_version {} _git_version]} {
527 catch {wm withdraw .}
531 -title "git-gui
: fatal error
" \
532 -message "Cannot parse Git version string
:\n\n$_git_version"
536 set _real_git_version $_git_version
537 regsub -- {-dirty$} $_git_version {} _git_version
538 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
539 regsub {\.rc[0-9]+$} $_git_version {} _git_version
540 regsub {\.GIT$} $_git_version {} _git_version
542 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
543 catch {wm withdraw .}
548 -title "[appname
]: warning
" \
549 -message "Git version cannot be determined.
551 $_git claims it is version
'$_real_git_version'.
553 [appname
] requires
at least Git
1.5.0 or later.
555 Assume
'$_real_git_version' is version
1.5.0?
557 set _git_version 1.5.0
562 unset _real_git_version
564 proc git-version {args} {
567 switch [llength $args] {
573 set op [lindex $args 0]
574 set vr [lindex $args 1]
575 set cm [package vcompare $_git_version $vr]
576 return [expr $cm $op 0]
580 set type [lindex $args 0]
581 set name [lindex $args 1]
582 set parm [lindex $args 2]
583 set body [lindex $args 3]
585 if {($type ne {proc} && $type ne {method})} {
586 error "Invalid arguments to git-version
"
588 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
589 error "Last arm of
$type $name must be default
"
592 foreach {op vr cb} [lrange $body 0 end-2] {
593 if {[git-version $op $vr]} {
594 return [uplevel [list $type $name $parm $cb]]
598 return [uplevel [list $type $name $parm [lindex $body end]]]
602 error "git-version
>= x
"
608 if {[git-version < 1.5]} {
609 catch {wm withdraw .}
613 -title "git-gui
: fatal error
" \
614 -message "[appname
] requires Git
1.5.0 or later.
616 You are using
[git-version
]:
622 ######################################################################
624 ## configure our library
626 set oguilib {@@GITGUI_LIBDIR@@}
627 set oguirel {@@GITGUI_RELATIVE@@}
628 if {$oguirel eq {1}} {
629 set oguilib [file dirname [file dirname [file normalize $argv0]]]
630 set oguilib [file join $oguilib share git-gui lib]
631 } elseif {[string match @@* $oguirel]} {
632 set oguilib [file join [file dirname [file normalize $argv0]] lib]
635 set idx [file join $oguilib tclIndex]
636 if {[catch {set fd [open $idx r]} err]} {
637 catch {wm withdraw .}
641 -title "git-gui
: fatal error
" \
645 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
647 while {[gets $fd n] >= 0} {
648 if {$n ne {} && ![string match #* $n]} {
660 if {[lsearch -exact $loaded $p] >= 0} continue
661 source [file join $oguilib $p]
666 set auto_path [concat [list $oguilib] $auto_path]
668 unset -nocomplain oguirel idx fd
670 ######################################################################
672 ## feature option selection
674 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
679 if {$subcommand eq {gui.sh}} {
682 if {$subcommand eq {gui} && [llength $argv] > 0} {
683 set subcommand [lindex $argv 0]
684 set argv [lrange $argv 1 end]
687 enable_option multicommit
689 enable_option transport
692 switch -- $subcommand {
697 disable_option multicommit
698 disable_option branch
699 disable_option transport
702 enable_option singlecommit
704 disable_option multicommit
705 disable_option branch
706 disable_option transport
710 ######################################################################
715 set _gitdir $env(GIT_DIR)
719 set _gitdir [git rev-parse --git-dir]
720 set _prefix [git rev-parse --show-prefix]
722 catch {wm withdraw .}
723 error_popup "Cannot
find the git directory
:\n\n$err"
726 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
727 catch {set _gitdir [exec cygpath --unix $_gitdir]}
729 if {![file isdirectory $_gitdir]} {
730 catch {wm withdraw .}
731 error_popup "Git directory not found
:\n\n$_gitdir"
734 if {$_prefix ne {}} {
735 regsub -all {[^/]+/} $_prefix ../ cdup
736 if {[catch {cd $cdup} err]} {
737 catch {wm withdraw .}
738 error_popup "Cannot move to top of working directory
:\n\n$err"
742 } elseif {![is_enabled bare]} {
743 if {[lindex [file split $_gitdir] end] ne {.git}} {
744 catch {wm withdraw .}
745 error_popup "Cannot use funny .git directory
:\n\n$_gitdir"
748 if {[catch {cd [file dirname $_gitdir]} err]} {
749 catch {wm withdraw .}
750 error_popup "No working directory
[file dirname $_gitdir]:\n\n$err"
754 set _reponame [file split [file normalize $_gitdir]]
755 if {[lindex $_reponame end] eq {.git}} {
756 set _reponame [lindex $_reponame end-1]
758 set _reponame [lindex $_reponame end]
761 ######################################################################
765 set current_diff_path {}
766 set current_diff_side {}
767 set diff_actions [list]
771 set MERGE_HEAD [list]
774 set current_branch {}
776 set current_diff_path {}
778 set selected_commit_type new
780 ######################################################################
788 set disable_on_lock [list]
789 set index_lock_type none
791 proc lock_index {type} {
792 global index_lock_type disable_on_lock
794 if {$index_lock_type eq {none}} {
795 set index_lock_type $type
796 foreach w $disable_on_lock {
797 uplevel #0 $w disabled
800 } elseif {$index_lock_type eq "begin-
$type"} {
801 set index_lock_type $type
807 proc unlock_index {} {
808 global index_lock_type disable_on_lock
810 set index_lock_type none
811 foreach w $disable_on_lock {
816 ######################################################################
820 proc repository_state {ctvar hdvar mhvar} {
821 global current_branch
822 upvar $ctvar ct $hdvar hd $mhvar mh
827 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
833 set merge_head [gitdir MERGE_HEAD]
834 if {[file exists $merge_head]} {
836 set fd_mh [open $merge_head r]
837 while {[gets $fd_mh line] >= 0} {
848 global PARENT empty_tree
850 set p [lindex $PARENT 0]
854 if {$empty_tree eq {}} {
855 set empty_tree [git mktree << {}]
860 proc rescan {after {honor_trustmtime 1}} {
861 global HEAD PARENT MERGE_HEAD commit_type
862 global ui_index ui_workdir ui_comm
863 global rescan_active file_states
866 if {$rescan_active > 0 || ![lock_index read]} return
868 repository_state newType newHEAD newMERGE_HEAD
869 if {[string match amend* $commit_type]
870 && $newType eq {normal}
871 && $newHEAD eq $HEAD} {
875 set MERGE_HEAD $newMERGE_HEAD
876 set commit_type $newType
879 array unset file_states
881 if {!$::GITGUI_BCK_exists &&
882 (![$ui_comm edit modified]
883 || [string trim [$ui_comm get 0.0 end]] eq {})} {
884 if {[string match amend* $commit_type]} {
885 } elseif {[load_message GITGUI_MSG]} {
886 } elseif {[load_message MERGE_MSG]} {
887 } elseif {[load_message SQUASH_MSG]} {
890 $ui_comm edit modified false
893 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
894 rescan_stage2 {} $after
897 ui_status {Refreshing file status...}
898 set fd_rf [git_read update-index \
904 fconfigure $fd_rf -blocking 0 -translation binary
905 fileevent $fd_rf readable \
906 [list rescan_stage2 $fd_rf $after]
911 set is_git_info_link {}
912 set is_git_info_exclude {}
913 proc have_info_exclude {} {
914 global is_git_info_link is_git_info_exclude
916 if {$is_git_info_link eq {}} {
917 set is_git_info_link [file isfile [gitdir info.lnk]]
920 if {$is_git_info_link} {
921 if {$is_git_info_exclude eq {}} {
922 if {[catch {exec test -f [gitdir info exclude]}]} {
923 set is_git_info_exclude 0
925 set is_git_info_exclude 1
928 return $is_git_info_exclude
930 return [file readable [gitdir info exclude]]
934 proc have_info_exclude {} {
935 return [file readable [gitdir info exclude]]
939 proc rescan_stage2 {fd after} {
940 global rescan_active buf_rdi buf_rdf buf_rlo
944 if {![eof $fd]} return
948 set ls_others [list --exclude-per-directory=.gitignore]
949 if {[have_info_exclude]} {
950 lappend ls_others "--exclude-from=[gitdir info exclude
]"
952 set user_exclude [get_config core.excludesfile]
953 if {$user_exclude ne {} && [file readable $user_exclude]} {
954 lappend ls_others "--exclude-from=$user_exclude"
962 ui_status {Scanning for modified files ...}
963 set fd_di [git_read diff-index --cached -z [PARENT]]
964 set fd_df [git_read diff-files -z]
965 set fd_lo [eval git_read ls-files --others -z $ls_others]
967 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
968 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
969 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
970 fileevent $fd_di readable [list read_diff_index $fd_di $after]
971 fileevent $fd_df readable [list read_diff_files $fd_df $after]
972 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
975 proc load_message {file} {
979 if {[file isfile $f]} {
980 if {[catch {set fd [open $f r]}]} {
983 fconfigure $fd -eofchar {}
984 set content [string trim [read $fd]]
986 regsub -all -line {[ \r\t]+$} $content {} content
987 $ui_comm delete 0.0 end
988 $ui_comm insert end $content
994 proc read_diff_index {fd after} {
997 append buf_rdi [read $fd]
999 set n [string length $buf_rdi]
1001 set z1 [string first "\
0" $buf_rdi $c]
1002 if {$z1 == -1} break
1004 set z2 [string first "\
0" $buf_rdi $z1]
1005 if {$z2 == -1} break
1008 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1009 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1011 [encoding convertfrom $p] \
1013 [list [lindex $i 0] [lindex $i 2]] \
1019 set buf_rdi [string range $buf_rdi $c end]
1024 rescan_done $fd buf_rdi $after
1027 proc read_diff_files {fd after} {
1030 append buf_rdf [read $fd]
1032 set n [string length $buf_rdf]
1034 set z1 [string first "\
0" $buf_rdf $c]
1035 if {$z1 == -1} break
1037 set z2 [string first "\
0" $buf_rdf $z1]
1038 if {$z2 == -1} break
1041 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1042 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1044 [encoding convertfrom $p] \
1047 [list [lindex $i 0] [lindex $i 2]]
1052 set buf_rdf [string range $buf_rdf $c end]
1057 rescan_done $fd buf_rdf $after
1060 proc read_ls_others {fd after} {
1063 append buf_rlo [read $fd]
1064 set pck [split $buf_rlo "\
0"]
1065 set buf_rlo [lindex $pck end]
1066 foreach p [lrange $pck 0 end-1] {
1067 set p [encoding convertfrom $p]
1068 if {[string index $p end] eq {/}} {
1069 set p [string range $p 0 end-1]
1073 rescan_done $fd buf_rlo $after
1076 proc rescan_done {fd buf after} {
1077 global rescan_active current_diff_path
1078 global file_states repo_config
1081 if {![eof $fd]} return
1084 if {[incr rescan_active -1] > 0} return
1089 if {$current_diff_path ne {}} reshow_diff
1093 proc prune_selection {} {
1094 global file_states selected_paths
1096 foreach path [array names selected_paths] {
1097 if {[catch {set still_here $file_states($path)}]} {
1098 unset selected_paths($path)
1103 ######################################################################
1107 proc mapicon {w state path} {
1110 if {[catch {set r $all_icons($state$w)}]} {
1111 puts "error
: no icon
for $w state
={$state} $path"
1117 proc mapdesc {state path} {
1120 if {[catch {set r $all_descs($state)}]} {
1121 puts "error
: no desc
for state
={$state} $path"
1127 proc ui_status {msg} {
1128 $::main_status show $msg
1131 proc ui_ready {{test {}}} {
1132 $::main_status show {Ready.} $test
1135 proc escape_path {path} {
1136 regsub -all {\\} $path "\\\\" path
1137 regsub -all "\n" $path "\\n
" path
1141 proc short_path {path} {
1142 return [escape_path [lindex [file split $path] end]]
1146 set null_sha1 [string repeat 0 40]
1148 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1149 global file_states next_icon_id null_sha1
1151 set s0 [string index $new_state 0]
1152 set s1 [string index $new_state 1]
1154 if {[catch {set info $file_states($path)}]} {
1156 set icon n[incr next_icon_id]
1158 set state [lindex $info 0]
1159 set icon [lindex $info 1]
1160 if {$head_info eq {}} {set head_info [lindex $info 2]}
1161 if {$index_info eq {}} {set index_info [lindex $info 3]}
1164 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1165 elseif {$s0 eq {_}} {set s0 _}
1167 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1168 elseif {$s1 eq {_}} {set s1 _}
1170 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1171 set head_info [list 0 $null_sha1]
1172 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1173 && $head_info eq {}} {
1174 set head_info $index_info
1177 set file_states($path) [list $s0$s1 $icon \
1178 $head_info $index_info \
1183 proc display_file_helper {w path icon_name old_m new_m} {
1186 if {$new_m eq {_}} {
1187 set lno [lsearch -sorted -exact $file_lists($w) $path]
1189 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1191 $w conf -state normal
1192 $w delete $lno.0 [expr {$lno + 1}].0
1193 $w conf -state disabled
1195 } elseif {$old_m eq {_} && $new_m ne {_}} {
1196 lappend file_lists($w) $path
1197 set file_lists($w) [lsort -unique $file_lists($w)]
1198 set lno [lsearch -sorted -exact $file_lists($w) $path]
1200 $w conf -state normal
1201 $w image create $lno.0 \
1202 -align center -padx 5 -pady 1 \
1204 -image [mapicon $w $new_m $path]
1205 $w insert $lno.1 "[escape_path
$path]\n"
1206 $w conf -state disabled
1207 } elseif {$old_m ne $new_m} {
1208 $w conf -state normal
1209 $w image conf $icon_name -image [mapicon $w $new_m $path]
1210 $w conf -state disabled
1214 proc display_file {path state} {
1215 global file_states selected_paths
1216 global ui_index ui_workdir
1218 set old_m [merge_state $path $state]
1219 set s $file_states($path)
1220 set new_m [lindex $s 0]
1221 set icon_name [lindex $s 1]
1223 set o [string index $old_m 0]
1224 set n [string index $new_m 0]
1231 display_file_helper $ui_index $path $icon_name $o $n
1233 if {[string index $old_m 0] eq {U}} {
1236 set o [string index $old_m 1]
1238 if {[string index $new_m 0] eq {U}} {
1241 set n [string index $new_m 1]
1243 display_file_helper $ui_workdir $path $icon_name $o $n
1245 if {$new_m eq {__}} {
1246 unset file_states($path)
1247 catch {unset selected_paths($path)}
1251 proc display_all_files_helper {w path icon_name m} {
1254 lappend file_lists($w) $path
1255 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1256 $w image create end \
1257 -align center -padx 5 -pady 1 \
1259 -image [mapicon $w $m $path]
1260 $w insert end "[escape_path
$path]\n"
1263 proc display_all_files {} {
1264 global ui_index ui_workdir
1265 global file_states file_lists
1268 $ui_index conf -state normal
1269 $ui_workdir conf -state normal
1271 $ui_index delete 0.0 end
1272 $ui_workdir delete 0.0 end
1275 set file_lists($ui_index) [list]
1276 set file_lists($ui_workdir) [list]
1278 foreach path [lsort [array names file_states]] {
1279 set s $file_states($path)
1281 set icon_name [lindex $s 1]
1283 set s [string index $m 0]
1284 if {$s ne {U} && $s ne {_}} {
1285 display_all_files_helper $ui_index $path \
1289 if {[string index $m 0] eq {U}} {
1292 set s [string index $m 1]
1295 display_all_files_helper $ui_workdir $path \
1300 $ui_index conf -state disabled
1301 $ui_workdir conf -state disabled
1304 ######################################################################
1309 #define mask_width 14
1310 #define mask_height 15
1311 static unsigned char mask_bits[] = {
1312 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1313 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1314 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1317 image create bitmap file_plain -background white -foreground black -data {
1318 #define plain_width 14
1319 #define plain_height 15
1320 static unsigned char plain_bits[] = {
1321 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1322 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1323 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1324 } -maskdata $filemask
1326 image create bitmap file_mod -background white -foreground blue -data {
1327 #define mod_width 14
1328 #define mod_height 15
1329 static unsigned char mod_bits[] = {
1330 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1331 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1332 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1333 } -maskdata $filemask
1335 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1336 #define file_fulltick_width 14
1337 #define file_fulltick_height 15
1338 static unsigned char file_fulltick_bits
[] = {
1339 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1340 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1341 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1342 } -maskdata $filemask
1344 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1345 #define parttick_width 14
1346 #define parttick_height 15
1347 static unsigned char parttick_bits
[] = {
1348 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1349 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1350 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1351 } -maskdata $filemask
1353 image create bitmap file_question
-background white
-foreground black
-data {
1354 #define file_question_width 14
1355 #define file_question_height 15
1356 static unsigned char file_question_bits
[] = {
1357 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1358 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1359 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1360 } -maskdata $filemask
1362 image create bitmap file_removed
-background white
-foreground red
-data {
1363 #define file_removed_width 14
1364 #define file_removed_height 15
1365 static unsigned char file_removed_bits
[] = {
1366 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1367 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1368 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1369 } -maskdata $filemask
1371 image create bitmap file_merge
-background white
-foreground blue
-data {
1372 #define file_merge_width 14
1373 #define file_merge_height 15
1374 static unsigned char file_merge_bits
[] = {
1375 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1376 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1377 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1378 } -maskdata $filemask
1380 set ui_index .vpane.files.index.list
1381 set ui_workdir .vpane.files.workdir.list
1383 set all_icons
(_
$ui_index) file_plain
1384 set all_icons
(A
$ui_index) file_fulltick
1385 set all_icons
(M
$ui_index) file_fulltick
1386 set all_icons
(D
$ui_index) file_removed
1387 set all_icons
(U
$ui_index) file_merge
1389 set all_icons
(_
$ui_workdir) file_plain
1390 set all_icons
(M
$ui_workdir) file_mod
1391 set all_icons
(D
$ui_workdir) file_question
1392 set all_icons
(U
$ui_workdir) file_merge
1393 set all_icons
(O
$ui_workdir) file_plain
1395 set max_status_desc
0
1399 {_M
"Modified, not staged"}
1400 {M_
"Staged for commit"}
1401 {MM
"Portions staged for commit"}
1402 {MD
"Staged for commit, missing"}
1404 {_O
"Untracked, not staged"}
1405 {A_
"Staged for commit"}
1406 {AM
"Portions staged for commit"}
1407 {AD
"Staged for commit, missing"}
1410 {D_
"Staged for removal"}
1411 {DO
"Staged for removal, still present"}
1413 {U_
"Requires merge resolution"}
1414 {UU
"Requires merge resolution"}
1415 {UM
"Requires merge resolution"}
1416 {UD
"Requires merge resolution"}
1418 if {$max_status_desc < [string length
[lindex
$i 1]]} {
1419 set max_status_desc
[string length
[lindex
$i 1]]
1421 set all_descs
([lindex
$i 0]) [lindex
$i 1]
1425 ######################################################################
1429 proc bind_button3
{w cmd
} {
1430 bind $w <Any-Button-3
> $cmd
1432 # Mac OS X sends Button-2 on right click through three-button mouse,
1433 # or through trackpad right-clicking (two-finger touch + click).
1434 bind $w <Any-Button-2
> $cmd
1435 bind $w <Control-Button-1
> $cmd
1439 proc scrollbar2many
{list mode args
} {
1440 foreach w
$list {eval $w $mode $args}
1443 proc many2scrollbar
{list mode sb top bottom
} {
1444 $sb set $top $bottom
1445 foreach w
$list {$w $mode moveto
$top}
1448 proc incr_font_size
{font
{amt
1}} {
1449 set sz
[font configure
$font -size]
1451 font configure
$font -size $sz
1452 font configure
${font}bold
-size $sz
1453 font configure
${font}italic
-size $sz
1456 ######################################################################
1460 set starting_gitk_msg
{Starting gitk... please
wait...
}
1462 proc do_gitk
{revs
} {
1463 # -- Always start gitk through whatever we were loaded with. This
1464 # lets us bypass using shell process on Windows systems.
1466 set exe
[file join [file dirname $
::_git
] gitk
]
1467 set cmd
[list
[info nameofexecutable
] $exe]
1468 if {! [file exists
$exe]} {
1469 error_popup
"Unable to start gitk:\n\n$exe does not exist"
1473 if {[info exists env
(GIT_DIR
)]} {
1474 set old_GIT_DIR
$env(GIT_DIR
)
1480 cd [file dirname [gitdir
]]
1481 set env
(GIT_DIR
) [file tail [gitdir
]]
1483 eval exec $cmd $revs &
1485 if {$old_GIT_DIR eq
{}} {
1488 set env
(GIT_DIR
) $old_GIT_DIR
1492 ui_status $
::starting_gitk_msg
1494 ui_ready
$starting_gitk_msg
1502 global ui_comm is_quitting repo_config commit_type
1503 global GITGUI_BCK_exists GITGUI_BCK_i
1505 if {$is_quitting} return
1508 if {[winfo exists
$ui_comm]} {
1509 # -- Stash our current commit buffer.
1511 set save
[gitdir GITGUI_MSG
]
1512 if {$GITGUI_BCK_exists && ![$ui_comm edit modified
]} {
1513 file rename
-force [gitdir GITGUI_BCK
] $save
1514 set GITGUI_BCK_exists
0
1516 set msg
[string trim
[$ui_comm get
0.0 end
]]
1517 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1518 if {(![string match amend
* $commit_type]
1519 ||
[$ui_comm edit modified
])
1522 set fd
[open
$save w
]
1523 puts
-nonewline $fd $msg
1527 catch
{file delete
$save}
1531 # -- Remove our editor backup, its not needed.
1533 after cancel
$GITGUI_BCK_i
1534 if {$GITGUI_BCK_exists} {
1535 catch
{file delete
[gitdir GITGUI_BCK
]}
1538 # -- Stash our current window geometry into this repository.
1540 set cfg_geometry
[list
]
1541 lappend cfg_geometry
[wm geometry .
]
1542 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1543 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1544 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1547 if {$cfg_geometry ne
$rc_geometry} {
1548 catch
{git config gui.geometry
$cfg_geometry}
1563 proc toggle_or_diff
{w x y
} {
1564 global file_states file_lists current_diff_path ui_index ui_workdir
1565 global last_clicked selected_paths
1567 set pos
[split [$w index @
$x,$y] .
]
1568 set lno
[lindex
$pos 0]
1569 set col [lindex
$pos 1]
1570 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1576 set last_clicked
[list
$w $lno]
1577 array
unset selected_paths
1578 $ui_index tag remove in_sel
0.0 end
1579 $ui_workdir tag remove in_sel
0.0 end
1582 if {$current_diff_path eq
$path} {
1583 set after
{reshow_diff
;}
1587 if {$w eq
$ui_index} {
1589 "Unstaging [short_path $path] from commit" \
1591 [concat
$after [list ui_ready
]]
1592 } elseif
{$w eq
$ui_workdir} {
1594 "Adding [short_path $path]" \
1596 [concat
$after [list ui_ready
]]
1599 show_diff
$path $w $lno
1603 proc add_one_to_selection
{w x y
} {
1604 global file_lists last_clicked selected_paths
1606 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1607 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1613 if {$last_clicked ne
{}
1614 && [lindex
$last_clicked 0] ne
$w} {
1615 array
unset selected_paths
1616 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1619 set last_clicked
[list
$w $lno]
1620 if {[catch
{set in_sel
$selected_paths($path)}]} {
1624 unset selected_paths
($path)
1625 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1627 set selected_paths
($path) 1
1628 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1632 proc add_range_to_selection
{w x y
} {
1633 global file_lists last_clicked selected_paths
1635 if {[lindex
$last_clicked 0] ne
$w} {
1636 toggle_or_diff
$w $x $y
1640 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1641 set lc
[lindex
$last_clicked 1]
1650 foreach path
[lrange
$file_lists($w) \
1651 [expr {$begin - 1}] \
1652 [expr {$end - 1}]] {
1653 set selected_paths
($path) 1
1655 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1658 ######################################################################
1662 set cursor_ptr arrow
1663 font create font_diff
-family Courier
-size 10
1667 eval font configure font_ui
[font actual
[.dummy cget
-font]]
1671 font create font_uiitalic
1672 font create font_uibold
1673 font create font_diffbold
1674 font create font_diffitalic
1676 foreach class
{Button Checkbutton Entry Label
1677 Labelframe Listbox Menu Message
1678 Radiobutton Spinbox Text
} {
1679 option add
*$class.font font_ui
1683 if {[is_Windows
] ||
[is_MacOSX
]} {
1684 option add
*Menu.tearOff
0
1695 proc apply_config
{} {
1696 global repo_config font_descs
1698 foreach option
$font_descs {
1699 set name
[lindex
$option 0]
1700 set font
[lindex
$option 1]
1702 foreach
{cn cv
} $repo_config(gui.
$name) {
1703 font configure
$font $cn $cv -weight normal
1706 error_popup
"Invalid font specified in gui.$name:\n\n$err"
1708 foreach
{cn cv
} [font configure
$font] {
1709 font configure
${font}bold
$cn $cv
1710 font configure
${font}italic
$cn $cv
1712 font configure
${font}bold
-weight bold
1713 font configure
${font}italic
-slant italic
1717 set default_config
(merge.diffstat
) true
1718 set default_config
(merge.summary
) false
1719 set default_config
(merge.verbosity
) 2
1720 set default_config
(user.name
) {}
1721 set default_config
(user.email
) {}
1723 set default_config
(gui.matchtrackingbranch
) false
1724 set default_config
(gui.pruneduringfetch
) false
1725 set default_config
(gui.trustmtime
) false
1726 set default_config
(gui.diffcontext
) 5
1727 set default_config
(gui.newbranchtemplate
) {}
1728 set default_config
(gui.fontui
) [font configure font_ui
]
1729 set default_config
(gui.fontdiff
) [font configure font_diff
]
1731 {fontui font_ui
{Main Font
}}
1732 {fontdiff font_diff
{Diff
/Console Font
}}
1737 ######################################################################
1745 menu .mbar
-tearoff 0
1746 .mbar add cascade
-label Repository
-menu .mbar.repository
1747 .mbar add cascade
-label Edit
-menu .mbar.edit
1748 if {[is_enabled branch
]} {
1749 .mbar add cascade
-label Branch
-menu .mbar.branch
1751 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1752 .mbar add cascade
-label Commit
-menu .mbar.commit
1754 if {[is_enabled transport
]} {
1755 .mbar add cascade
-label Merge
-menu .mbar.merge
1756 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1757 .mbar add cascade
-label Push
-menu .mbar.push
1759 . configure
-menu .mbar
1761 # -- Repository Menu
1763 menu .mbar.repository
1765 .mbar.repository add
command \
1766 -label {Browse Current Branch
's Files} \
1767 -command {browser::new $current_branch}
1768 set ui_browse_current [.mbar.repository index last]
1769 .mbar.repository add command \
1770 -label {Browse Branch Files...} \
1771 -command browser_open::dialog
1772 .mbar.repository add separator
1774 .mbar.repository add command \
1775 -label {Visualize Current Branch's History
} \
1776 -command {do_gitk
$current_branch}
1777 set ui_visualize_current
[.mbar.repository index last
]
1778 .mbar.repository add
command \
1779 -label {Visualize All Branch History
} \
1780 -command {do_gitk
--all}
1781 .mbar.repository add separator
1783 proc current_branch_write
{args
} {
1784 global current_branch
1785 .mbar.repository entryconf $
::ui_browse_current \
1786 -label "Browse $current_branch's Files"
1787 .mbar.repository entryconf $
::ui_visualize_current \
1788 -label "Visualize $current_branch's History"
1790 trace add variable current_branch
write current_branch_write
1792 if {[is_enabled multicommit
]} {
1793 .mbar.repository add
command -label {Database Statistics
} \
1796 .mbar.repository add
command -label {Compress Database
} \
1799 .mbar.repository add
command -label {Verify Database
} \
1800 -command do_fsck_objects
1802 .mbar.repository add separator
1805 .mbar.repository add
command \
1806 -label {Create Desktop Icon
} \
1807 -command do_cygwin_shortcut
1808 } elseif
{[is_Windows
]} {
1809 .mbar.repository add
command \
1810 -label {Create Desktop Icon
} \
1811 -command do_windows_shortcut
1812 } elseif
{[is_MacOSX
]} {
1813 .mbar.repository add
command \
1814 -label {Create Desktop Icon
} \
1815 -command do_macosx_app
1819 .mbar.repository add
command -label Quit \
1826 .mbar.edit add
command -label Undo \
1827 -command {catch
{[focus
] edit undo
}} \
1829 .mbar.edit add
command -label Redo \
1830 -command {catch
{[focus
] edit redo
}} \
1832 .mbar.edit add separator
1833 .mbar.edit add
command -label Cut \
1834 -command {catch
{tk_textCut
[focus
]}} \
1836 .mbar.edit add
command -label Copy \
1837 -command {catch
{tk_textCopy
[focus
]}} \
1839 .mbar.edit add
command -label Paste \
1840 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1842 .mbar.edit add
command -label Delete \
1843 -command {catch
{[focus
] delete sel.first sel.last
}} \
1845 .mbar.edit add separator
1846 .mbar.edit add
command -label {Select All
} \
1847 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1852 if {[is_enabled branch
]} {
1855 .mbar.branch add
command -label {Create...
} \
1856 -command branch_create
::dialog \
1858 lappend disable_on_lock
[list .mbar.branch entryconf \
1859 [.mbar.branch index last
] -state]
1861 .mbar.branch add
command -label {Checkout...
} \
1862 -command branch_checkout
::dialog \
1864 lappend disable_on_lock
[list .mbar.branch entryconf \
1865 [.mbar.branch index last
] -state]
1867 .mbar.branch add
command -label {Rename...
} \
1868 -command branch_rename
::dialog
1869 lappend disable_on_lock
[list .mbar.branch entryconf \
1870 [.mbar.branch index last
] -state]
1872 .mbar.branch add
command -label {Delete...
} \
1873 -command branch_delete
::dialog
1874 lappend disable_on_lock
[list .mbar.branch entryconf \
1875 [.mbar.branch index last
] -state]
1877 .mbar.branch add
command -label {Reset...
} \
1878 -command merge
::reset_hard
1879 lappend disable_on_lock
[list .mbar.branch entryconf \
1880 [.mbar.branch index last
] -state]
1885 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1888 .mbar.commit add radiobutton \
1889 -label {New Commit
} \
1890 -command do_select_commit_type \
1891 -variable selected_commit_type \
1893 lappend disable_on_lock \
1894 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1896 .mbar.commit add radiobutton \
1897 -label {Amend Last Commit
} \
1898 -command do_select_commit_type \
1899 -variable selected_commit_type \
1901 lappend disable_on_lock \
1902 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1904 .mbar.commit add separator
1906 .mbar.commit add
command -label Rescan \
1907 -command do_rescan \
1909 lappend disable_on_lock \
1910 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1912 .mbar.commit add
command -label {Stage To Commit
} \
1913 -command do_add_selection
1914 lappend disable_on_lock \
1915 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1917 .mbar.commit add
command -label {Stage Changed Files To Commit
} \
1918 -command do_add_all \
1920 lappend disable_on_lock \
1921 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1923 .mbar.commit add
command -label {Unstage From Commit
} \
1924 -command do_unstage_selection
1925 lappend disable_on_lock \
1926 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1928 .mbar.commit add
command -label {Revert Changes
} \
1929 -command do_revert_selection
1930 lappend disable_on_lock \
1931 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1933 .mbar.commit add separator
1935 .mbar.commit add
command -label {Sign Off
} \
1936 -command do_signoff \
1939 .mbar.commit add
command -label Commit \
1940 -command do_commit \
1941 -accelerator $M1T-Return
1942 lappend disable_on_lock \
1943 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1948 if {[is_enabled branch
]} {
1950 .mbar.merge add
command -label {Local Merge...
} \
1951 -command merge
::dialog \
1953 lappend disable_on_lock \
1954 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1955 .mbar.merge add
command -label {Abort Merge...
} \
1956 -command merge
::reset_hard
1957 lappend disable_on_lock \
1958 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1963 if {[is_enabled transport
]} {
1967 .mbar.push add
command -label {Push...
} \
1968 -command do_push_anywhere \
1970 .mbar.push add
command -label {Delete...
} \
1971 -command remote_branch_delete
::dialog
1975 # -- Apple Menu (Mac OS X only)
1977 .mbar add cascade
-label Apple
-menu .mbar.apple
1980 .mbar.apple add
command -label "About [appname]" \
1982 .mbar.apple add
command -label "Options..." \
1987 .mbar.edit add separator
1988 .mbar.edit add
command -label {Options...
} \
1994 .mbar add cascade
-label Help
-menu .mbar.
help
1998 .mbar.
help add
command -label "About [appname]" \
2003 catch
{set browser
$repo_config(instaweb.browser
)}
2004 set doc_path
[file dirname [gitexec
]]
2005 set doc_path
[file join $doc_path Documentation index.html
]
2008 set doc_path
[exec cygpath
--mixed $doc_path]
2011 if {$browser eq
{}} {
2014 } elseif
{[is_Cygwin
]} {
2015 set program_files
[file dirname [exec cygpath
--windir]]
2016 set program_files
[file join $program_files {Program Files
}]
2017 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
2018 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
2019 if {[file exists
$firefox]} {
2020 set browser
$firefox
2021 } elseif
{[file exists
$ie]} {
2024 unset program_files firefox ie
2028 if {[file isfile
$doc_path]} {
2029 set doc_url
"file:$doc_path"
2031 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
2034 if {$browser ne
{}} {
2035 .mbar.
help add
command -label {Online Documentation
} \
2036 -command [list
exec $browser $doc_url &]
2038 unset browser doc_path doc_url
2041 bind .
<Visibility
> {
2042 bind .
<Visibility
> {}
2046 # -- Standard bindings
2048 wm protocol . WM_DELETE_WINDOW do_quit
2049 bind all
<$M1B-Key-q> do_quit
2050 bind all
<$M1B-Key-Q> do_quit
2051 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2052 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2054 set subcommand_args
{}
2056 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
2060 # -- Not a normal commit type invocation? Do that instead!
2062 switch
-- $subcommand {
2065 set subcommand_args
{rev? path
}
2066 if {$argv eq
{}} usage
2071 if {$is_path ||
[file exists
$_prefix$a]} {
2072 if {$path ne
{}} usage
2075 } elseif
{$a eq
{--}} {
2077 if {$head ne
{}} usage
2082 } elseif
{$head eq
{}} {
2083 if {$head ne
{}} usage
2092 if {$head ne
{} && $path eq
{}} {
2093 set path
$_prefix$head
2100 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
2102 set head [git rev-parse
--verify $head]
2108 set current_branch
$head
2111 switch
-- $subcommand {
2114 if {$path ne
{} && [file isdirectory
$path]} {
2115 set head $current_branch
2121 browser
::new
$head $path
2124 if {$head eq
{} && ![file exists
$path]} {
2125 puts stderr
"fatal: cannot stat path $path: No such file or directory"
2128 blame
::new
$head $path
2135 if {[llength
$argv] != 0} {
2136 puts
-nonewline stderr
"usage: $argv0"
2137 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
2138 puts
-nonewline stderr
" $subcommand"
2143 # fall through to setup UI for commits
2146 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2157 -text {Current Branch
:} \
2161 -textvariable current_branch \
2164 pack .branch.l1
-side left
2165 pack .branch.cb
-side left
-fill x
2166 pack .branch
-side top
-fill x
2168 # -- Main Window Layout
2170 panedwindow .vpane
-orient vertical
2171 panedwindow .vpane.files
-orient horizontal
2172 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2173 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2175 # -- Index File List
2177 frame .vpane.files.index
-height 100 -width 200
2178 label .vpane.files.index.title
-text {Staged Changes
(Will Be Committed
)} \
2179 -background lightgreen
2180 text
$ui_index -background white
-borderwidth 0 \
2181 -width 20 -height 10 \
2183 -cursor $cursor_ptr \
2184 -xscrollcommand {.vpane.files.index.sx
set} \
2185 -yscrollcommand {.vpane.files.index.sy
set} \
2187 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2188 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2189 pack .vpane.files.index.title
-side top
-fill x
2190 pack .vpane.files.index.sx
-side bottom
-fill x
2191 pack .vpane.files.index.sy
-side right
-fill y
2192 pack
$ui_index -side left
-fill both
-expand 1
2193 .vpane.files add .vpane.files.index
-sticky nsew
2195 # -- Working Directory File List
2197 frame .vpane.files.workdir
-height 100 -width 200
2198 label .vpane.files.workdir.title
-text {Unstaged Changes
(Will Not Be Committed
)} \
2199 -background lightsalmon
2200 text
$ui_workdir -background white
-borderwidth 0 \
2201 -width 20 -height 10 \
2203 -cursor $cursor_ptr \
2204 -xscrollcommand {.vpane.files.workdir.sx
set} \
2205 -yscrollcommand {.vpane.files.workdir.sy
set} \
2207 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2208 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2209 pack .vpane.files.workdir.title
-side top
-fill x
2210 pack .vpane.files.workdir.sx
-side bottom
-fill x
2211 pack .vpane.files.workdir.sy
-side right
-fill y
2212 pack
$ui_workdir -side left
-fill both
-expand 1
2213 .vpane.files add .vpane.files.workdir
-sticky nsew
2215 foreach i
[list
$ui_index $ui_workdir] {
2217 $i tag conf in_diff
-background [$i tag cget in_sel
-background]
2221 # -- Diff and Commit Area
2223 frame .vpane.lower
-height 300 -width 400
2224 frame .vpane.lower.commarea
2225 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2226 pack .vpane.lower.commarea
-side top
-fill x
2227 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
2228 .vpane add .vpane.lower
-sticky nsew
2230 # -- Commit Area Buttons
2232 frame .vpane.lower.commarea.buttons
2233 label .vpane.lower.commarea.buttons.l
-text {} \
2236 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2237 pack .vpane.lower.commarea.buttons
-side left
-fill y
2239 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
2241 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2242 lappend disable_on_lock \
2243 {.vpane.lower.commarea.buttons.rescan conf
-state}
2245 button .vpane.lower.commarea.buttons.incall
-text {Stage Changed
} \
2247 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2248 lappend disable_on_lock \
2249 {.vpane.lower.commarea.buttons.incall conf
-state}
2251 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
2253 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2255 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
2257 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2258 lappend disable_on_lock \
2259 {.vpane.lower.commarea.buttons.commit conf
-state}
2261 button .vpane.lower.commarea.buttons.push
-text {Push
} \
2262 -command do_push_anywhere
2263 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2265 # -- Commit Message Buffer
2267 frame .vpane.lower.commarea.buffer
2268 frame .vpane.lower.commarea.buffer.header
2269 set ui_comm .vpane.lower.commarea.buffer.t
2270 set ui_coml .vpane.lower.commarea.buffer.header.l
2271 radiobutton .vpane.lower.commarea.buffer.header.new \
2272 -text {New Commit
} \
2273 -command do_select_commit_type \
2274 -variable selected_commit_type \
2276 lappend disable_on_lock \
2277 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2278 radiobutton .vpane.lower.commarea.buffer.header.amend \
2279 -text {Amend Last Commit
} \
2280 -command do_select_commit_type \
2281 -variable selected_commit_type \
2283 lappend disable_on_lock \
2284 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2288 proc trace_commit_type
{varname args
} {
2289 global ui_coml commit_type
2290 switch
-glob -- $commit_type {
2291 initial
{set txt
{Initial Commit Message
:}}
2292 amend
{set txt
{Amended Commit Message
:}}
2293 amend-initial
{set txt
{Amended Initial Commit Message
:}}
2294 amend-merge
{set txt
{Amended Merge Commit Message
:}}
2295 merge
{set txt
{Merge Commit Message
:}}
2296 * {set txt
{Commit Message
:}}
2298 $ui_coml conf
-text $txt
2300 trace add variable commit_type
write trace_commit_type
2301 pack
$ui_coml -side left
-fill x
2302 pack .vpane.lower.commarea.buffer.header.amend
-side right
2303 pack .vpane.lower.commarea.buffer.header.new
-side right
2305 text
$ui_comm -background white
-borderwidth 1 \
2308 -autoseparators true \
2310 -width 75 -height 9 -wrap none \
2312 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2313 scrollbar .vpane.lower.commarea.buffer.sby \
2314 -command [list
$ui_comm yview
]
2315 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2316 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2317 pack
$ui_comm -side left
-fill y
2318 pack .vpane.lower.commarea.buffer
-side left
-fill y
2320 # -- Commit Message Buffer Context Menu
2322 set ctxm .vpane.lower.commarea.buffer.ctxm
2323 menu
$ctxm -tearoff 0
2326 -command {tk_textCut
$ui_comm}
2329 -command {tk_textCopy
$ui_comm}
2332 -command {tk_textPaste
$ui_comm}
2335 -command {$ui_comm delete sel.first sel.last
}
2338 -label {Select All
} \
2339 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2343 $ui_comm tag add sel
0.0 end
2344 tk_textCopy
$ui_comm
2345 $ui_comm tag remove sel
0.0 end
2351 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
2355 proc trace_current_diff_path
{varname args
} {
2356 global current_diff_path diff_actions file_states
2357 if {$current_diff_path eq
{}} {
2363 set p
$current_diff_path
2364 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2366 set p
[escape_path
$p]
2370 .vpane.lower.
diff.header.status configure
-text $s
2371 .vpane.lower.
diff.header.
file configure
-text $f
2372 .vpane.lower.
diff.header.path configure
-text $p
2373 foreach w
$diff_actions {
2377 trace add variable current_diff_path
write trace_current_diff_path
2379 frame .vpane.lower.
diff.header
-background gold
2380 label .vpane.lower.
diff.header.status \
2382 -width $max_status_desc \
2385 label .vpane.lower.
diff.header.
file \
2389 label .vpane.lower.
diff.header.path \
2393 pack .vpane.lower.
diff.header.status
-side left
2394 pack .vpane.lower.
diff.header.
file -side left
2395 pack .vpane.lower.
diff.header.path
-fill x
2396 set ctxm .vpane.lower.
diff.header.ctxm
2397 menu
$ctxm -tearoff 0
2405 -- $current_diff_path
2407 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2408 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2412 frame .vpane.lower.
diff.body
2413 set ui_diff .vpane.lower.
diff.body.t
2414 text
$ui_diff -background white
-borderwidth 0 \
2415 -width 80 -height 15 -wrap none \
2417 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2418 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2420 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2421 -command [list
$ui_diff xview
]
2422 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2423 -command [list
$ui_diff yview
]
2424 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2425 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2426 pack
$ui_diff -side left
-fill both
-expand 1
2427 pack .vpane.lower.
diff.header
-side top
-fill x
2428 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2430 $ui_diff tag conf d_cr
-elide true
2431 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2432 $ui_diff tag conf d_
+ -foreground {#00a000}
2433 $ui_diff tag conf d_-
-foreground red
2435 $ui_diff tag conf d_
++ -foreground {#00a000}
2436 $ui_diff tag conf d_--
-foreground red
2437 $ui_diff tag conf d_
+s \
2438 -foreground {#00a000} \
2439 -background {#e2effa}
2440 $ui_diff tag conf d_-s \
2442 -background {#e2effa}
2443 $ui_diff tag conf d_s
+ \
2444 -foreground {#00a000} \
2446 $ui_diff tag conf d_s- \
2450 $ui_diff tag conf d
<<<<<<< \
2451 -foreground orange \
2453 $ui_diff tag conf d
======= \
2454 -foreground orange \
2456 $ui_diff tag conf d
>>>>>>> \
2457 -foreground orange \
2460 $ui_diff tag raise sel
2462 # -- Diff Body Context Menu
2464 set ctxm .vpane.lower.
diff.body.ctxm
2465 menu
$ctxm -tearoff 0
2468 -command reshow_diff
2469 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2472 -command {tk_textCopy
$ui_diff}
2473 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2475 -label {Select All
} \
2476 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2477 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2481 $ui_diff tag add sel
0.0 end
2482 tk_textCopy
$ui_diff
2483 $ui_diff tag remove sel
0.0 end
2485 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2488 -label {Apply
/Reverse Hunk
} \
2489 -command {apply_hunk
$cursorX $cursorY}
2490 set ui_diff_applyhunk
[$ctxm index last
]
2491 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2494 -label {Decrease Font Size
} \
2495 -command {incr_font_size font_diff
-1}
2496 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2498 -label {Increase Font Size
} \
2499 -command {incr_font_size font_diff
1}
2500 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2503 -label {Show Less Context
} \
2504 -command {if {$repo_config(gui.diffcontext
) >= 1} {
2505 incr repo_config
(gui.diffcontext
) -1
2508 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2510 -label {Show More Context
} \
2511 -command {if {$repo_config(gui.diffcontext
) < 99} {
2512 incr repo_config
(gui.diffcontext
)
2515 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2517 $ctxm add
command -label {Options...
} \
2519 proc popup_diff_menu
{ctxm x y X Y
} {
2520 global current_diff_path file_states
2523 if {$
::ui_index eq $
::current_diff_side
} {
2524 set l
"Unstage Hunk From Commit"
2526 set l
"Stage Hunk For Commit"
2529 ||
$current_diff_path eq
{}
2530 ||
![info exists file_states
($current_diff_path)]
2531 ||
{_O
} eq
[lindex
$file_states($current_diff_path) 0]} {
2536 $ctxm entryconf $
::ui_diff_applyhunk
-state $s -label $l
2537 tk_popup
$ctxm $X $Y
2539 bind_button3
$ui_diff [list popup_diff_menu
$ctxm %x
%y
%X
%Y
]
2543 set main_status
[::status_bar
::new .status
]
2544 pack .status
-anchor w
-side bottom
-fill x
2545 $main_status show
{Initializing...
}
2550 set gm
$repo_config(gui.geometry
)
2551 wm geometry .
[lindex
$gm 0]
2552 .vpane sash place
0 \
2553 [lindex
[.vpane sash coord
0] 0] \
2555 .vpane.files sash place
0 \
2557 [lindex
[.vpane.files sash coord
0] 1]
2563 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2564 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2565 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2566 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2567 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2568 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2569 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2570 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2571 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2572 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2573 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2575 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2576 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2577 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2578 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2579 bind $ui_diff <$M1B-Key-v> {break}
2580 bind $ui_diff <$M1B-Key-V> {break}
2581 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2582 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2583 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2584 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2585 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2586 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2587 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2588 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2589 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2590 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2591 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2592 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2593 bind $ui_diff <Button-1
> {focus
%W
}
2595 if {[is_enabled branch
]} {
2596 bind .
<$M1B-Key-n> branch_create
::dialog
2597 bind .
<$M1B-Key-N> branch_create
::dialog
2598 bind .
<$M1B-Key-o> branch_checkout
::dialog
2599 bind .
<$M1B-Key-O> branch_checkout
::dialog
2600 bind .
<$M1B-Key-m> merge
::dialog
2601 bind .
<$M1B-Key-M> merge
::dialog
2603 if {[is_enabled transport
]} {
2604 bind .
<$M1B-Key-p> do_push_anywhere
2605 bind .
<$M1B-Key-P> do_push_anywhere
2608 bind .
<Key-F5
> do_rescan
2609 bind .
<$M1B-Key-r> do_rescan
2610 bind .
<$M1B-Key-R> do_rescan
2611 bind .
<$M1B-Key-s> do_signoff
2612 bind .
<$M1B-Key-S> do_signoff
2613 bind .
<$M1B-Key-i> do_add_all
2614 bind .
<$M1B-Key-I> do_add_all
2615 bind .
<$M1B-Key-Return> do_commit
2616 foreach i
[list
$ui_index $ui_workdir] {
2617 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2618 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2619 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2623 set file_lists
($ui_index) [list
]
2624 set file_lists
($ui_workdir) [list
]
2626 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2627 focus
-force $ui_comm
2629 # -- Warn the user about environmental problems. Cygwin's Tcl
2630 # does *not* pass its env array onto any processes it spawns.
2631 # This means that git processes get none of our environment.
2636 set msg
"Possible environment issues exist.
2638 The following environment variables are probably
2639 going to be ignored by any Git subprocess run
2643 foreach name
[array names env
] {
2644 switch
-regexp -- $name {
2645 {^GIT_INDEX_FILE$
} -
2646 {^GIT_OBJECT_DIRECTORY$
} -
2647 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2649 {^GIT_EXTERNAL_DIFF$
} -
2653 {^GIT_CONFIG_LOCAL$
} -
2654 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2655 append msg
" - $name\n"
2658 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2659 append msg
" - $name\n"
2661 set suggest_user
$name
2665 if {$ignored_env > 0} {
2667 This is due to a known issue with the
2668 Tcl binary distributed by Cygwin."
2670 if {$suggest_user ne
{}} {
2673 A good replacement for $suggest_user
2674 is placing values for the user.name and
2675 user.email settings into your personal
2681 unset ignored_env msg suggest_user name
2684 # -- Only initialize complex UI if we are going to stay running.
2686 if {[is_enabled transport
]} {
2693 if {[winfo exists
$ui_comm]} {
2694 set GITGUI_BCK_exists
[load_message GITGUI_BCK
]
2696 # -- If both our backup and message files exist use the
2697 # newer of the two files to initialize the buffer.
2699 if {$GITGUI_BCK_exists} {
2700 set m
[gitdir GITGUI_MSG
]
2701 if {[file isfile
$m]} {
2702 if {[file mtime
[gitdir GITGUI_BCK
]] > [file mtime
$m]} {
2703 catch
{file delete
[gitdir GITGUI_MSG
]}
2705 $ui_comm delete
0.0 end
2707 $ui_comm edit modified false
2708 catch
{file delete
[gitdir GITGUI_BCK
]}
2709 set GITGUI_BCK_exists
0
2715 proc backup_commit_buffer
{} {
2716 global ui_comm GITGUI_BCK_exists
2718 set m
[$ui_comm edit modified
]
2719 if {$m ||
$GITGUI_BCK_exists} {
2720 set msg
[string trim
[$ui_comm get
0.0 end
]]
2721 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2724 if {$GITGUI_BCK_exists} {
2725 catch
{file delete
[gitdir GITGUI_BCK
]}
2726 set GITGUI_BCK_exists
0
2730 set fd
[open
[gitdir GITGUI_BCK
] w
]
2731 puts
-nonewline $fd $msg
2733 set GITGUI_BCK_exists
1
2737 $ui_comm edit modified false
2740 set ::GITGUI_BCK_i
[after
2000 backup_commit_buffer
]
2743 backup_commit_buffer
2746 lock_index begin-read
2747 if {![winfo ismapped .
]} {
2751 if {[is_enabled multicommit
]} {