2 # Tcl ignores the next line -*- tcl -*- \
5 set appvers {@@GITGUI_VERSION@@}
7 Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
23 ######################################################################
27 set _appname [lindex [file split $argv0] end]
43 return [eval [concat [list file join $_gitdir] $args]]
48 if {$_gitexec eq {}} {
49 if {[catch {set _gitexec [git --exec-path]} err]} {
50 error "Git not installed?\n\n$err"
56 return [eval [concat [list file join $_gitexec] $args]]
65 global tcl_platform tk_library
66 if {[tk windowingsystem] eq {aqua}} {
74 if {$tcl_platform(platform) eq {windows}} {
81 global tcl_platform _iscygwin
82 if {$_iscygwin eq {}} {
83 if {$tcl_platform(platform) eq {windows}} {
84 if {[catch {set p [exec cygpath --windir]} err]} {
96 proc is_enabled {option} {
97 global enabled_options
98 if {[catch {set on $enabled_options($option)}]} {return 0}
102 proc enable_option {option} {
103 global enabled_options
104 set enabled_options($option) 1
107 proc disable_option {option} {
108 global enabled_options
109 set enabled_options($option) 0
112 ######################################################################
116 proc is_many_config {name} {
117 switch -glob -- $name {
126 proc is_config_true {name} {
128 if {[catch {set v $repo_config($name)}]} {
130 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
137 proc load_config {include_global} {
138 global repo_config global_config default_config
140 array unset global_config
141 if {$include_global} {
143 set fd_rc [open "| git config --global --list" r]
144 while {[gets $fd_rc line] >= 0} {
145 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
146 if {[is_many_config $name]} {
147 lappend global_config($name) $value
149 set global_config($name) $value
157 array unset repo_config
159 set fd_rc [open "| git config --list" r]
160 while {[gets $fd_rc line] >= 0} {
161 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
162 if {[is_many_config $name]} {
163 lappend repo_config($name) $value
165 set repo_config($name) $value
172 foreach name [array names default_config] {
173 if {[catch {set v $global_config($name)}]} {
174 set global_config($name) $default_config($name)
176 if {[catch {set v $repo_config($name)}]} {
177 set repo_config($name) $default_config($name)
182 proc save_config {} {
183 global default_config font_descs
184 global repo_config global_config
185 global repo_config_new global_config_new
187 foreach option $font_descs {
188 set name [lindex $option 0]
189 set font [lindex $option 1]
190 font configure $font \
191 -family $global_config_new(gui.$font^^family) \
192 -size $global_config_new(gui.$font^^size)
193 font configure ${font}bold \
194 -family $global_config_new(gui.$font^^family) \
195 -size $global_config_new(gui.$font^^size)
196 set global_config_new(gui.$name) [font configure $font]
197 unset global_config_new(gui.$font^^family)
198 unset global_config_new(gui.$font^^size)
201 foreach name [array names default_config] {
202 set value $global_config_new($name)
203 if {$value ne $global_config($name)} {
204 if {$value eq $default_config($name)} {
205 catch {git config --global --unset $name}
207 regsub -all "\[{}\]" $value {"} value
208 git config --global $name $value
210 set global_config($name) $value
211 if {$value eq $repo_config($name)} {
212 catch {git config --unset $name}
213 set repo_config($name) $value
218 foreach name [array names default_config] {
219 set value $repo_config_new($name)
220 if {$value ne $repo_config($name)} {
221 if {$value eq $global_config($name)} {
222 catch {git config --unset $name}
224 regsub -all "\[{}\]" $value {"} value
225 git config $name $value
227 set repo_config($name) $value
232 ######################################################################
237 return [eval exec git $args]
240 proc error_popup {msg} {
242 if {[reponame] ne {}} {
243 append title " ([reponame])"
245 set cmd [list tk_messageBox \
248 -title "$title: error" \
250 if {[winfo ismapped .]} {
251 lappend cmd -parent .
256 proc warn_popup {msg} {
258 if {[reponame] ne {}} {
259 append title " ([reponame])"
261 set cmd [list tk_messageBox \
264 -title "$title: warning" \
266 if {[winfo ismapped .]} {
267 lappend cmd -parent .
272 proc info_popup {msg {parent .}} {
274 if {[reponame] ne {}} {
275 append title " ([reponame])"
285 proc ask_popup {msg} {
287 if {[reponame] ne {}} {
288 append title " ([reponame])"
290 return [tk_messageBox \
298 ######################################################################
302 if { [catch {set _gitdir $env(GIT_DIR)}]
303 && [catch {set _gitdir [git rev-parse --git-dir]} err]} {
304 catch {wm withdraw .}
305 error_popup "Cannot find the git directory:\n\n$err"
308 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
309 catch {set _gitdir [exec cygpath --unix $_gitdir]}
311 if {![file isdirectory $_gitdir]} {
312 catch {wm withdraw .}
313 error_popup "Git directory not found:\n\n$_gitdir"
316 if {[lindex [file split $_gitdir] end] ne {.git}} {
317 catch {wm withdraw .}
318 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
321 if {[catch {cd [file dirname $_gitdir]} err]} {
322 catch {wm withdraw .}
323 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
326 set _reponame [lindex [file split \
327 [file normalize [file dirname $_gitdir]]] \
330 ######################################################################
338 set disable_on_lock [list]
339 set index_lock_type none
341 proc lock_index {type} {
342 global index_lock_type disable_on_lock
344 if {$index_lock_type eq {none}} {
345 set index_lock_type $type
346 foreach w $disable_on_lock {
347 uplevel #0 $w disabled
350 } elseif {$index_lock_type eq "begin-$type"} {
351 set index_lock_type $type
357 proc unlock_index {} {
358 global index_lock_type disable_on_lock
360 set index_lock_type none
361 foreach w $disable_on_lock {
366 ######################################################################
370 proc repository_state {ctvar hdvar mhvar} {
371 global current_branch
372 upvar $ctvar ct $hdvar hd $mhvar mh
376 if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
377 set current_branch {}
379 regsub ^refs/((heads|tags|remotes)/)? \
385 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
391 set merge_head [gitdir MERGE_HEAD]
392 if {[file exists $merge_head]} {
394 set fd_mh [open $merge_head r]
395 while {[gets $fd_mh line] >= 0} {
406 global PARENT empty_tree
408 set p [lindex $PARENT 0]
412 if {$empty_tree eq {}} {
413 set empty_tree [git mktree << {}]
418 proc rescan {after {honor_trustmtime 1}} {
419 global HEAD PARENT MERGE_HEAD commit_type
420 global ui_index ui_workdir ui_status_value ui_comm
421 global rescan_active file_states
424 if {$rescan_active > 0 || ![lock_index read]} return
426 repository_state newType newHEAD newMERGE_HEAD
427 if {[string match amend* $commit_type]
428 && $newType eq {normal}
429 && $newHEAD eq $HEAD} {
433 set MERGE_HEAD $newMERGE_HEAD
434 set commit_type $newType
437 array unset file_states
439 if {![$ui_comm edit modified]
440 || [string trim [$ui_comm get 0.0 end]] eq {}} {
441 if {[load_message GITGUI_MSG]} {
442 } elseif {[load_message MERGE_MSG]} {
443 } elseif {[load_message SQUASH_MSG]} {
446 $ui_comm edit modified false
449 if {[is_enabled branch]} {
454 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
455 rescan_stage2 {} $after
458 set ui_status_value {Refreshing file status...}
459 set cmd [list git update-index]
461 lappend cmd --unmerged
462 lappend cmd --ignore-missing
463 lappend cmd --refresh
464 set fd_rf [open "| $cmd" r]
465 fconfigure $fd_rf -blocking 0 -translation binary
466 fileevent $fd_rf readable \
467 [list rescan_stage2 $fd_rf $after]
471 proc rescan_stage2 {fd after} {
472 global ui_status_value
473 global rescan_active buf_rdi buf_rdf buf_rlo
477 if {![eof $fd]} return
481 set ls_others [list | git ls-files --others -z \
482 --exclude-per-directory=.gitignore]
483 set info_exclude [gitdir info exclude]
484 if {[file readable $info_exclude]} {
485 lappend ls_others "--exclude-from=$info_exclude"
493 set ui_status_value {Scanning for modified files ...}
494 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
495 set fd_df [open "| git diff-files -z" r]
496 set fd_lo [open $ls_others r]
498 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
499 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
500 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
501 fileevent $fd_di readable [list read_diff_index $fd_di $after]
502 fileevent $fd_df readable [list read_diff_files $fd_df $after]
503 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
506 proc load_message {file} {
510 if {[file isfile $f]} {
511 if {[catch {set fd [open $f r]}]} {
514 set content [string trim [read $fd]]
516 regsub -all -line {[ \r\t]+$} $content {} content
517 $ui_comm delete 0.0 end
518 $ui_comm insert end $content
524 proc read_diff_index {fd after} {
527 append buf_rdi [read $fd]
529 set n [string length $buf_rdi]
531 set z1 [string first "\0" $buf_rdi $c]
534 set z2 [string first "\0" $buf_rdi $z1]
538 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
539 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
541 [encoding convertfrom $p] \
543 [list [lindex $i 0] [lindex $i 2]] \
549 set buf_rdi [string range $buf_rdi $c end]
554 rescan_done $fd buf_rdi $after
557 proc read_diff_files {fd after} {
560 append buf_rdf [read $fd]
562 set n [string length $buf_rdf]
564 set z1 [string first "\0" $buf_rdf $c]
567 set z2 [string first "\0" $buf_rdf $z1]
571 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
572 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
574 [encoding convertfrom $p] \
577 [list [lindex $i 0] [lindex $i 2]]
582 set buf_rdf [string range $buf_rdf $c end]
587 rescan_done $fd buf_rdf $after
590 proc read_ls_others {fd after} {
593 append buf_rlo [read $fd]
594 set pck [split $buf_rlo "\0"]
595 set buf_rlo [lindex $pck end]
596 foreach p [lrange $pck 0 end-1] {
597 merge_state [encoding convertfrom $p] ?O
599 rescan_done $fd buf_rlo $after
602 proc rescan_done {fd buf after} {
604 global file_states repo_config
607 if {![eof $fd]} return
610 if {[incr rescan_active -1] > 0} return
619 proc prune_selection {} {
620 global file_states selected_paths
622 foreach path [array names selected_paths] {
623 if {[catch {set still_here $file_states($path)}]} {
624 unset selected_paths($path)
629 ######################################################################
634 global ui_diff current_diff_path current_diff_header
635 global ui_index ui_workdir
637 $ui_diff conf -state normal
638 $ui_diff delete 0.0 end
639 $ui_diff conf -state disabled
641 set current_diff_path {}
642 set current_diff_header {}
644 $ui_index tag remove in_diff 0.0 end
645 $ui_workdir tag remove in_diff 0.0 end
648 proc reshow_diff {} {
649 global ui_status_value file_states file_lists
650 global current_diff_path current_diff_side
652 set p $current_diff_path
654 || $current_diff_side eq {}
655 || [catch {set s $file_states($p)}]
656 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
659 show_diff $p $current_diff_side
663 proc handle_empty_diff {} {
664 global current_diff_path file_states file_lists
666 set path $current_diff_path
667 set s $file_states($path)
668 if {[lindex $s 0] ne {_M}} return
670 info_popup "No differences detected.
672 [short_path $path] has no changes.
674 The modification date of this file was updated
675 by another application, but the content within
676 the file was not changed.
678 A rescan will be automatically started to find
679 other files which may have the same state."
682 display_file $path __
683 rescan {set ui_status_value {Ready.}} 0
686 proc show_diff {path w {lno {}}} {
687 global file_states file_lists
688 global is_3way_diff diff_active repo_config
689 global ui_diff ui_status_value ui_index ui_workdir
690 global current_diff_path current_diff_side current_diff_header
692 if {$diff_active || ![lock_index read]} return
696 set lno [lsearch -sorted -exact $file_lists($w) $path]
702 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
705 set s $file_states($path)
709 set current_diff_path $path
710 set current_diff_side $w
711 set current_diff_header {}
712 set ui_status_value "Loading diff of [escape_path $path]..."
714 # - Git won't give us the diff, there's nothing to compare to!
717 set max_sz [expr {128 * 1024}]
719 set fd [open $path r]
720 set content [read $fd $max_sz]
722 set sz [file size $path]
726 set ui_status_value "Unable to display [escape_path $path]"
727 error_popup "Error loading file:\n\n$err"
730 $ui_diff conf -state normal
731 if {![catch {set type [exec file $path]}]} {
732 set n [string length $path]
733 if {[string equal -length $n $path $type]} {
734 set type [string range $type $n end]
735 regsub {^:?\s*} $type {} type
737 $ui_diff insert end "* $type\n" d_@
739 if {[string first "\0" $content] != -1} {
740 $ui_diff insert end \
741 "* Binary file (not showing content)." \
745 $ui_diff insert end \
746 "* Untracked file is $sz bytes.
747 * Showing only first $max_sz bytes.
750 $ui_diff insert end $content
752 $ui_diff insert end "
753 * Untracked file clipped here by [appname].
754 * To see the entire file, use an external editor.
758 $ui_diff conf -state disabled
761 set ui_status_value {Ready.}
766 if {$w eq $ui_index} {
767 lappend cmd diff-index
769 } elseif {$w eq $ui_workdir} {
770 if {[string index $m 0] eq {U}} {
773 lappend cmd diff-files
778 lappend cmd --no-color
779 if {$repo_config(gui.diffcontext) > 0} {
780 lappend cmd "-U$repo_config(gui.diffcontext)"
782 if {$w eq $ui_index} {
788 if {[catch {set fd [open $cmd r]} err]} {
791 set ui_status_value "Unable to display [escape_path $path]"
792 error_popup "Error loading diff:\n\n$err"
800 fileevent $fd readable [list read_diff $fd]
803 proc read_diff {fd} {
804 global ui_diff ui_status_value diff_active
805 global is_3way_diff current_diff_header
807 $ui_diff conf -state normal
808 while {[gets $fd line] >= 0} {
809 # -- Cleanup uninteresting diff header lines.
811 if { [string match {diff --git *} $line]
812 || [string match {diff --cc *} $line]
813 || [string match {diff --combined *} $line]
814 || [string match {--- *} $line]
815 || [string match {+++ *} $line]} {
816 append current_diff_header $line "\n"
819 if {[string match {index *} $line]} continue
820 if {$line eq {deleted file mode 120000}} {
821 set line "deleted symlink"
824 # -- Automatically detect if this is a 3 way diff.
826 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
828 if {[string match {mode *} $line]
829 || [string match {new file *} $line]
830 || [string match {deleted file *} $line]
831 || [string match {Binary files * and * differ} $line]
832 || $line eq {\ No newline at end of file}
833 || [regexp {^\* Unmerged path } $line]} {
835 } elseif {$is_3way_diff} {
836 set op [string range $line 0 1]
846 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
847 set line [string replace $line 0 1 { }]
854 puts "error: Unhandled 3 way diff marker: {$op}"
859 set op [string index $line 0]
865 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
866 set line [string replace $line 0 0 { }]
873 puts "error: Unhandled 2 way diff marker: {$op}"
878 $ui_diff insert end $line $tags
879 if {[string index $line end] eq "\r"} {
880 $ui_diff tag add d_cr {end - 2c}
882 $ui_diff insert end "\n" $tags
884 $ui_diff conf -state disabled
890 set ui_status_value {Ready.}
892 if {[$ui_diff index end] eq {2.0}} {
898 proc apply_hunk {x y} {
899 global current_diff_path current_diff_header current_diff_side
900 global ui_diff ui_index file_states
902 if {$current_diff_path eq {} || $current_diff_header eq {}} return
903 if {![lock_index apply_hunk]} return
905 set apply_cmd {git apply --cached --whitespace=nowarn}
906 set mi [lindex $file_states($current_diff_path) 0]
907 if {$current_diff_side eq $ui_index} {
909 lappend apply_cmd --reverse
910 if {[string index $mi 0] ne {M}} {
916 if {[string index $mi 1] ne {M}} {
922 set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
923 set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
929 set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
935 set p [open "| $apply_cmd" w]
936 fconfigure $p -translation binary -encoding binary
937 puts -nonewline $p $current_diff_header
938 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
940 error_popup "Failed to $mode selected hunk.\n\n$err"
945 $ui_diff conf -state normal
946 $ui_diff delete $s_lno $e_lno
947 $ui_diff conf -state disabled
949 if {[$ui_diff get 1.0 end] eq "\n"} {
955 if {$current_diff_side eq $ui_index} {
957 } elseif {[string index $mi 0] eq {_}} {
963 display_file $current_diff_path $mi
969 ######################################################################
973 proc load_last_commit {} {
974 global HEAD PARENT MERGE_HEAD commit_type ui_comm
977 if {[llength $PARENT] == 0} {
978 error_popup {There is nothing to amend.
980 You are about to create the initial commit.
981 There is no commit before this to amend.
986 repository_state curType curHEAD curMERGE_HEAD
987 if {$curType eq {merge}} {
988 error_popup {Cannot amend while merging.
990 You are currently in the middle of a merge that
991 has not been fully completed. You cannot amend
992 the prior commit unless you first abort the
993 current merge activity.
1001 set fd [open "| git cat-file commit $curHEAD" r]
1002 fconfigure $fd -encoding binary -translation lf
1003 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1006 while {[gets $fd line] > 0} {
1007 if {[string match {parent *} $line]} {
1008 lappend parents [string range $line 7 end]
1009 } elseif {[string match {encoding *} $line]} {
1010 set enc [string tolower [string range $line 9 end]]
1013 fconfigure $fd -encoding $enc
1014 set msg [string trim [read $fd]]
1017 error_popup "Error loading commit data for amend:\n\n$err"
1023 set MERGE_HEAD [list]
1024 switch -- [llength $parents] {
1025 0 {set commit_type amend-initial}
1026 1 {set commit_type amend}
1027 default {set commit_type amend-merge}
1030 $ui_comm delete 0.0 end
1031 $ui_comm insert end $msg
1033 $ui_comm edit modified false
1034 rescan {set ui_status_value {Ready.}}
1037 proc create_new_commit {} {
1038 global commit_type ui_comm
1040 set commit_type normal
1041 $ui_comm delete 0.0 end
1043 $ui_comm edit modified false
1044 rescan {set ui_status_value {Ready.}}
1047 set GIT_COMMITTER_IDENT {}
1049 proc committer_ident {} {
1050 global GIT_COMMITTER_IDENT
1052 if {$GIT_COMMITTER_IDENT eq {}} {
1053 if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
1054 error_popup "Unable to obtain your identity:\n\n$err"
1057 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1058 $me me GIT_COMMITTER_IDENT]} {
1059 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1064 return $GIT_COMMITTER_IDENT
1067 proc commit_tree {} {
1068 global HEAD commit_type file_states ui_comm repo_config
1069 global ui_status_value pch_error
1071 if {[committer_ident] eq {}} return
1072 if {![lock_index update]} return
1074 # -- Our in memory state should match the repository.
1076 repository_state curType curHEAD curMERGE_HEAD
1077 if {[string match amend* $commit_type]
1078 && $curType eq {normal}
1079 && $curHEAD eq $HEAD} {
1080 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1081 info_popup {Last scanned state does not match repository state.
1083 Another Git program has modified this repository
1084 since the last scan. A rescan must be performed
1085 before another commit can be created.
1087 The rescan will be automatically started now.
1090 rescan {set ui_status_value {Ready.}}
1094 # -- At least one file should differ in the index.
1097 foreach path [array names file_states] {
1098 switch -glob -- [lindex $file_states($path) 0] {
1102 M? {set files_ready 1}
1104 error_popup "Unmerged files cannot be committed.
1106 File [short_path $path] has merge conflicts.
1107 You must resolve them and add the file before committing.
1113 error_popup "Unknown file state [lindex $s 0] detected.
1115 File [short_path $path] cannot be committed by this program.
1120 if {!$files_ready} {
1121 info_popup {No changes to commit.
1123 You must add at least 1 file before you can commit.
1129 # -- A message is required.
1131 set msg [string trim [$ui_comm get 1.0 end]]
1132 regsub -all -line {[ \t\r]+$} $msg {} msg
1134 error_popup {Please supply a commit message.
1136 A good commit message has the following format:
1138 - First line: Describe in one sentance what you did.
1139 - Second line: Blank
1140 - Remaining lines: Describe why this change is good.
1146 # -- Run the pre-commit hook.
1148 set pchook [gitdir hooks pre-commit]
1150 # On Cygwin [file executable] might lie so we need to ask
1151 # the shell if the hook is executable. Yes that's annoying.
1153 if {[is_Cygwin] && [file isfile $pchook]} {
1154 set pchook [list sh -c [concat \
1155 "if test -x \"$pchook\";" \
1156 "then exec \"$pchook\" 2>&1;" \
1158 } elseif {[file executable $pchook]} {
1159 set pchook [list $pchook |& cat]
1161 commit_writetree $curHEAD $msg
1165 set ui_status_value {Calling pre-commit hook...}
1167 set fd_ph [open "| $pchook" r]
1168 fconfigure $fd_ph -blocking 0 -translation binary
1169 fileevent $fd_ph readable \
1170 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1173 proc commit_prehook_wait {fd_ph curHEAD msg} {
1174 global pch_error ui_status_value
1176 append pch_error [read $fd_ph]
1177 fconfigure $fd_ph -blocking 1
1179 if {[catch {close $fd_ph}]} {
1180 set ui_status_value {Commit declined by pre-commit hook.}
1181 hook_failed_popup pre-commit $pch_error
1184 commit_writetree $curHEAD $msg
1189 fconfigure $fd_ph -blocking 0
1192 proc commit_writetree {curHEAD msg} {
1193 global ui_status_value
1195 set ui_status_value {Committing changes...}
1196 set fd_wt [open "| git write-tree" r]
1197 fileevent $fd_wt readable \
1198 [list commit_committree $fd_wt $curHEAD $msg]
1201 proc commit_committree {fd_wt curHEAD msg} {
1202 global HEAD PARENT MERGE_HEAD commit_type
1203 global all_heads current_branch
1204 global ui_status_value ui_comm selected_commit_type
1205 global file_states selected_paths rescan_active
1209 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1210 error_popup "write-tree failed:\n\n$err"
1211 set ui_status_value {Commit failed.}
1216 # -- Build the message.
1218 set msg_p [gitdir COMMIT_EDITMSG]
1219 set msg_wt [open $msg_p w]
1220 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1223 fconfigure $msg_wt -encoding $enc -translation binary
1224 puts -nonewline $msg_wt $msg
1227 # -- Create the commit.
1229 set cmd [list git commit-tree $tree_id]
1230 set parents [concat $PARENT $MERGE_HEAD]
1231 if {[llength $parents] > 0} {
1232 foreach p $parents {
1236 # git commit-tree writes to stderr during initial commit.
1237 lappend cmd 2>/dev/null
1240 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1241 error_popup "commit-tree failed:\n\n$err"
1242 set ui_status_value {Commit failed.}
1247 # -- Update the HEAD ref.
1250 if {$commit_type ne {normal}} {
1251 append reflogm " ($commit_type)"
1253 set i [string first "\n" $msg]
1255 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1257 append reflogm {: } $msg
1259 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1260 if {[catch {eval exec $cmd} err]} {
1261 error_popup "update-ref failed:\n\n$err"
1262 set ui_status_value {Commit failed.}
1267 # -- Make sure our current branch exists.
1269 if {$commit_type eq {initial}} {
1270 lappend all_heads $current_branch
1271 set all_heads [lsort -unique $all_heads]
1272 populate_branch_menu
1275 # -- Cleanup after ourselves.
1277 catch {file delete $msg_p}
1278 catch {file delete [gitdir MERGE_HEAD]}
1279 catch {file delete [gitdir MERGE_MSG]}
1280 catch {file delete [gitdir SQUASH_MSG]}
1281 catch {file delete [gitdir GITGUI_MSG]}
1283 # -- Let rerere do its thing.
1285 if {[file isdirectory [gitdir rr-cache]]} {
1289 # -- Run the post-commit hook.
1291 set pchook [gitdir hooks post-commit]
1292 if {[is_Cygwin] && [file isfile $pchook]} {
1293 set pchook [list sh -c [concat \
1294 "if test -x \"$pchook\";" \
1295 "then exec \"$pchook\";" \
1297 } elseif {![file executable $pchook]} {
1300 if {$pchook ne {}} {
1301 catch {exec $pchook &}
1304 $ui_comm delete 0.0 end
1306 $ui_comm edit modified false
1308 if {[is_enabled singlecommit]} do_quit
1310 # -- Update in memory status
1312 set selected_commit_type new
1313 set commit_type normal
1316 set MERGE_HEAD [list]
1318 foreach path [array names file_states] {
1319 set s $file_states($path)
1321 switch -glob -- $m {
1329 unset file_states($path)
1330 catch {unset selected_paths($path)}
1333 set file_states($path) [list _O [lindex $s 1] {} {}]
1339 set file_states($path) [list \
1340 _[string index $m 1] \
1351 set ui_status_value \
1352 "Changes committed as [string range $cmt_id 0 7]."
1355 ######################################################################
1359 proc fetch_from {remote} {
1360 set w [new_console \
1362 "Fetching new changes from $remote"]
1363 set cmd [list git fetch]
1365 console_exec $w $cmd console_done
1368 proc push_to {remote} {
1369 set w [new_console \
1371 "Pushing changes to $remote"]
1372 set cmd [list git push]
1375 console_exec $w $cmd console_done
1378 ######################################################################
1382 proc mapicon {w state path} {
1385 if {[catch {set r $all_icons($state$w)}]} {
1386 puts "error: no icon for $w state={$state} $path"
1392 proc mapdesc {state path} {
1395 if {[catch {set r $all_descs($state)}]} {
1396 puts "error: no desc for state={$state} $path"
1402 proc escape_path {path} {
1403 regsub -all {\\} $path "\\\\" path
1404 regsub -all "\n" $path "\\n" path
1408 proc short_path {path} {
1409 return [escape_path [lindex [file split $path] end]]
1413 set null_sha1 [string repeat 0 40]
1415 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1416 global file_states next_icon_id null_sha1
1418 set s0 [string index $new_state 0]
1419 set s1 [string index $new_state 1]
1421 if {[catch {set info $file_states($path)}]} {
1423 set icon n[incr next_icon_id]
1425 set state [lindex $info 0]
1426 set icon [lindex $info 1]
1427 if {$head_info eq {}} {set head_info [lindex $info 2]}
1428 if {$index_info eq {}} {set index_info [lindex $info 3]}
1431 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1432 elseif {$s0 eq {_}} {set s0 _}
1434 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1435 elseif {$s1 eq {_}} {set s1 _}
1437 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1438 set head_info [list 0 $null_sha1]
1439 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1440 && $head_info eq {}} {
1441 set head_info $index_info
1444 set file_states($path) [list $s0$s1 $icon \
1445 $head_info $index_info \
1450 proc display_file_helper {w path icon_name old_m new_m} {
1453 if {$new_m eq {_}} {
1454 set lno [lsearch -sorted -exact $file_lists($w) $path]
1456 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1458 $w conf -state normal
1459 $w delete $lno.0 [expr {$lno + 1}].0
1460 $w conf -state disabled
1462 } elseif {$old_m eq {_} && $new_m ne {_}} {
1463 lappend file_lists($w) $path
1464 set file_lists($w) [lsort -unique $file_lists($w)]
1465 set lno [lsearch -sorted -exact $file_lists($w) $path]
1467 $w conf -state normal
1468 $w image create $lno.0 \
1469 -align center -padx 5 -pady 1 \
1471 -image [mapicon $w $new_m $path]
1472 $w insert $lno.1 "[escape_path $path]\n"
1473 $w conf -state disabled
1474 } elseif {$old_m ne $new_m} {
1475 $w conf -state normal
1476 $w image conf $icon_name -image [mapicon $w $new_m $path]
1477 $w conf -state disabled
1481 proc display_file {path state} {
1482 global file_states selected_paths
1483 global ui_index ui_workdir
1485 set old_m [merge_state $path $state]
1486 set s $file_states($path)
1487 set new_m [lindex $s 0]
1488 set icon_name [lindex $s 1]
1490 set o [string index $old_m 0]
1491 set n [string index $new_m 0]
1498 display_file_helper $ui_index $path $icon_name $o $n
1500 if {[string index $old_m 0] eq {U}} {
1503 set o [string index $old_m 1]
1505 if {[string index $new_m 0] eq {U}} {
1508 set n [string index $new_m 1]
1510 display_file_helper $ui_workdir $path $icon_name $o $n
1512 if {$new_m eq {__}} {
1513 unset file_states($path)
1514 catch {unset selected_paths($path)}
1518 proc display_all_files_helper {w path icon_name m} {
1521 lappend file_lists($w) $path
1522 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1523 $w image create end \
1524 -align center -padx 5 -pady 1 \
1526 -image [mapicon $w $m $path]
1527 $w insert end "[escape_path $path]\n"
1530 proc display_all_files {} {
1531 global ui_index ui_workdir
1532 global file_states file_lists
1535 $ui_index conf -state normal
1536 $ui_workdir conf -state normal
1538 $ui_index delete 0.0 end
1539 $ui_workdir delete 0.0 end
1542 set file_lists($ui_index) [list]
1543 set file_lists($ui_workdir) [list]
1545 foreach path [lsort [array names file_states]] {
1546 set s $file_states($path)
1548 set icon_name [lindex $s 1]
1550 set s [string index $m 0]
1551 if {$s ne {U} && $s ne {_}} {
1552 display_all_files_helper $ui_index $path \
1556 if {[string index $m 0] eq {U}} {
1559 set s [string index $m 1]
1562 display_all_files_helper $ui_workdir $path \
1567 $ui_index conf -state disabled
1568 $ui_workdir conf -state disabled
1571 proc update_indexinfo {msg pathList after} {
1572 global update_index_cp ui_status_value
1574 if {![lock_index update]} return
1576 set update_index_cp 0
1577 set pathList [lsort $pathList]
1578 set totalCnt [llength $pathList]
1579 set batch [expr {int($totalCnt * .01) + 1}]
1580 if {$batch > 25} {set batch 25}
1582 set ui_status_value [format \
1583 "$msg... %i/%i files (%.2f%%)" \
1587 set fd [open "| git update-index -z --index-info" w]
1594 fileevent $fd writable [list \
1595 write_update_indexinfo \
1605 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1606 global update_index_cp ui_status_value
1607 global file_states current_diff_path
1609 if {$update_index_cp >= $totalCnt} {
1616 for {set i $batch} \
1617 {$update_index_cp < $totalCnt && $i > 0} \
1619 set path [lindex $pathList $update_index_cp]
1620 incr update_index_cp
1622 set s $file_states($path)
1623 switch -glob -- [lindex $s 0] {
1630 set info [lindex $s 2]
1631 if {$info eq {}} continue
1633 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1634 display_file $path $new
1637 set ui_status_value [format \
1638 "$msg... %i/%i files (%.2f%%)" \
1641 [expr {100.0 * $update_index_cp / $totalCnt}]]
1644 proc update_index {msg pathList after} {
1645 global update_index_cp ui_status_value
1647 if {![lock_index update]} return
1649 set update_index_cp 0
1650 set pathList [lsort $pathList]
1651 set totalCnt [llength $pathList]
1652 set batch [expr {int($totalCnt * .01) + 1}]
1653 if {$batch > 25} {set batch 25}
1655 set ui_status_value [format \
1656 "$msg... %i/%i files (%.2f%%)" \
1660 set fd [open "| git update-index --add --remove -z --stdin" w]
1667 fileevent $fd writable [list \
1668 write_update_index \
1678 proc write_update_index {fd pathList totalCnt batch msg after} {
1679 global update_index_cp ui_status_value
1680 global file_states current_diff_path
1682 if {$update_index_cp >= $totalCnt} {
1689 for {set i $batch} \
1690 {$update_index_cp < $totalCnt && $i > 0} \
1692 set path [lindex $pathList $update_index_cp]
1693 incr update_index_cp
1695 switch -glob -- [lindex $file_states($path) 0] {
1701 if {[file exists $path]} {
1710 puts -nonewline $fd "[encoding convertto $path]\0"
1711 display_file $path $new
1714 set ui_status_value [format \
1715 "$msg... %i/%i files (%.2f%%)" \
1718 [expr {100.0 * $update_index_cp / $totalCnt}]]
1721 proc checkout_index {msg pathList after} {
1722 global update_index_cp ui_status_value
1724 if {![lock_index update]} return
1726 set update_index_cp 0
1727 set pathList [lsort $pathList]
1728 set totalCnt [llength $pathList]
1729 set batch [expr {int($totalCnt * .01) + 1}]
1730 if {$batch > 25} {set batch 25}
1732 set ui_status_value [format \
1733 "$msg... %i/%i files (%.2f%%)" \
1737 set cmd [list git checkout-index]
1743 set fd [open "| $cmd " w]
1750 fileevent $fd writable [list \
1751 write_checkout_index \
1761 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1762 global update_index_cp ui_status_value
1763 global file_states current_diff_path
1765 if {$update_index_cp >= $totalCnt} {
1772 for {set i $batch} \
1773 {$update_index_cp < $totalCnt && $i > 0} \
1775 set path [lindex $pathList $update_index_cp]
1776 incr update_index_cp
1777 switch -glob -- [lindex $file_states($path) 0] {
1781 puts -nonewline $fd "[encoding convertto $path]\0"
1782 display_file $path ?_
1787 set ui_status_value [format \
1788 "$msg... %i/%i files (%.2f%%)" \
1791 [expr {100.0 * $update_index_cp / $totalCnt}]]
1794 ######################################################################
1796 ## branch management
1798 proc is_tracking_branch {name} {
1799 global tracking_branches
1801 if {![catch {set info $tracking_branches($name)}]} {
1804 foreach t [array names tracking_branches] {
1805 if {[string match {*/\*} $t] && [string match $t $name]} {
1812 proc load_all_heads {} {
1815 set all_heads [list]
1816 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1817 while {[gets $fd line] > 0} {
1818 if {[is_tracking_branch $line]} continue
1819 if {![regsub ^refs/heads/ $line {} name]} continue
1820 lappend all_heads $name
1824 set all_heads [lsort $all_heads]
1827 proc populate_branch_menu {} {
1828 global all_heads disable_on_lock
1831 set last [$m index last]
1832 for {set i 0} {$i <= $last} {incr i} {
1833 if {[$m type $i] eq {separator}} {
1836 foreach a $disable_on_lock {
1837 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1841 set disable_on_lock $new_dol
1846 if {$all_heads ne {}} {
1849 foreach b $all_heads {
1850 $m add radiobutton \
1852 -command [list switch_branch $b] \
1853 -variable current_branch \
1856 lappend disable_on_lock \
1857 [list $m entryconf [$m index last] -state]
1861 proc all_tracking_branches {} {
1862 global tracking_branches
1864 set all_trackings {}
1866 foreach name [array names tracking_branches] {
1867 if {[regsub {/\*$} $name {} name]} {
1870 regsub ^refs/(heads|remotes)/ $name {} name
1871 lappend all_trackings $name
1876 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1877 while {[gets $fd name] > 0} {
1878 regsub ^refs/(heads|remotes)/ $name {} name
1879 lappend all_trackings $name
1884 return [lsort -unique $all_trackings]
1887 proc do_create_branch_action {w} {
1888 global all_heads null_sha1 repo_config
1889 global create_branch_checkout create_branch_revtype
1890 global create_branch_head create_branch_trackinghead
1891 global create_branch_name create_branch_revexp
1893 set newbranch $create_branch_name
1894 if {$newbranch eq {}
1895 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1899 -title [wm title $w] \
1901 -message "Please supply a branch name."
1902 focus $w.desc.name_t
1905 if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
1909 -title [wm title $w] \
1911 -message "Branch '$newbranch' already exists."
1912 focus $w.desc.name_t
1915 if {[catch {git check-ref-format "heads/$newbranch"}]} {
1919 -title [wm title $w] \
1921 -message "We do not like '$newbranch' as a branch name."
1922 focus $w.desc.name_t
1927 switch -- $create_branch_revtype {
1928 head {set rev $create_branch_head}
1929 tracking {set rev $create_branch_trackinghead}
1930 expression {set rev $create_branch_revexp}
1932 if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
1936 -title [wm title $w] \
1938 -message "Invalid starting revision: $rev"
1941 set cmd [list git update-ref]
1943 lappend cmd "branch: Created from $rev"
1944 lappend cmd "refs/heads/$newbranch"
1946 lappend cmd $null_sha1
1947 if {[catch {eval exec $cmd} err]} {
1951 -title [wm title $w] \
1953 -message "Failed to create '$newbranch'.\n\n$err"
1957 lappend all_heads $newbranch
1958 set all_heads [lsort $all_heads]
1959 populate_branch_menu
1961 if {$create_branch_checkout} {
1962 switch_branch $newbranch
1966 proc radio_selector {varname value args} {
1967 upvar #0 $varname var
1971 trace add variable create_branch_head write \
1972 [list radio_selector create_branch_revtype head]
1973 trace add variable create_branch_trackinghead write \
1974 [list radio_selector create_branch_revtype tracking]
1976 trace add variable delete_branch_head write \
1977 [list radio_selector delete_branch_checktype head]
1978 trace add variable delete_branch_trackinghead write \
1979 [list radio_selector delete_branch_checktype tracking]
1981 proc do_create_branch {} {
1982 global all_heads current_branch repo_config
1983 global create_branch_checkout create_branch_revtype
1984 global create_branch_head create_branch_trackinghead
1985 global create_branch_name create_branch_revexp
1987 set w .branch_editor
1989 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1991 label $w.header -text {Create New Branch} \
1993 pack $w.header -side top -fill x
1996 button $w.buttons.create -text Create \
1999 -command [list do_create_branch_action $w]
2000 pack $w.buttons.create -side right
2001 button $w.buttons.cancel -text {Cancel} \
2003 -command [list destroy $w]
2004 pack $w.buttons.cancel -side right -padx 5
2005 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2007 labelframe $w.desc \
2008 -text {Branch Description} \
2010 label $w.desc.name_l -text {Name:} -font font_ui
2011 entry $w.desc.name_t \
2015 -textvariable create_branch_name \
2019 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2022 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2023 grid columnconfigure $w.desc 1 -weight 1
2024 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2026 labelframe $w.from \
2027 -text {Starting Revision} \
2029 radiobutton $w.from.head_r \
2030 -text {Local Branch:} \
2032 -variable create_branch_revtype \
2034 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2035 grid $w.from.head_r $w.from.head_m -sticky w
2036 set all_trackings [all_tracking_branches]
2037 if {$all_trackings ne {}} {
2038 set create_branch_trackinghead [lindex $all_trackings 0]
2039 radiobutton $w.from.tracking_r \
2040 -text {Tracking Branch:} \
2042 -variable create_branch_revtype \
2044 eval tk_optionMenu $w.from.tracking_m \
2045 create_branch_trackinghead \
2047 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2049 radiobutton $w.from.exp_r \
2050 -text {Revision Expression:} \
2052 -variable create_branch_revtype \
2054 entry $w.from.exp_t \
2058 -textvariable create_branch_revexp \
2062 if {%d == 1 && [regexp {\s} %S]} {return 0}
2063 if {%d == 1 && [string length %S] > 0} {
2064 set create_branch_revtype expression
2068 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2069 grid columnconfigure $w.from 1 -weight 1
2070 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2072 labelframe $w.postActions \
2073 -text {Post Creation Actions} \
2075 checkbutton $w.postActions.checkout \
2076 -text {Checkout after creation} \
2077 -variable create_branch_checkout \
2079 pack $w.postActions.checkout -anchor nw
2080 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2082 set create_branch_checkout 1
2083 set create_branch_head $current_branch
2084 set create_branch_revtype head
2085 set create_branch_name $repo_config(gui.newbranchtemplate)
2086 set create_branch_revexp {}
2088 bind $w <Visibility> "
2090 $w.desc.name_t icursor end
2091 focus $w.desc.name_t
2093 bind $w <Key-Escape> "destroy $w"
2094 bind $w <Key-Return> "do_create_branch_action $w;break"
2095 wm title $w "[appname] ([reponame]): Create Branch"
2099 proc do_delete_branch_action {w} {
2101 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2104 switch -- $delete_branch_checktype {
2105 head {set check_rev $delete_branch_head}
2106 tracking {set check_rev $delete_branch_trackinghead}
2107 always {set check_rev {:none}}
2109 if {$check_rev eq {:none}} {
2111 } elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
2115 -title [wm title $w] \
2117 -message "Invalid check revision: $check_rev"
2121 set to_delete [list]
2122 set not_merged [list]
2123 foreach i [$w.list.l curselection] {
2124 set b [$w.list.l get $i]
2125 if {[catch {set o [git rev-parse --verify $b]}]} continue
2126 if {$check_cmt ne {}} {
2127 if {$b eq $check_rev} continue
2128 if {[catch {set m [git merge-base $o $check_cmt]}]} continue
2130 lappend not_merged $b
2134 lappend to_delete [list $b $o]
2136 if {$not_merged ne {}} {
2137 set msg "The following branches are not completely merged into $check_rev:
2139 - [join $not_merged "\n - "]"
2143 -title [wm title $w] \
2147 if {$to_delete eq {}} return
2148 if {$delete_branch_checktype eq {always}} {
2149 set msg {Recovering deleted branches is difficult.
2151 Delete the selected branches?}
2152 if {[tk_messageBox \
2155 -title [wm title $w] \
2157 -message $msg] ne yes} {
2163 foreach i $to_delete {
2166 if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
2167 append failed " - $b: $err\n"
2169 set x [lsearch -sorted -exact $all_heads $b]
2171 set all_heads [lreplace $all_heads $x $x]
2176 if {$failed ne {}} {
2180 -title [wm title $w] \
2182 -message "Failed to delete branches:\n$failed"
2185 set all_heads [lsort $all_heads]
2186 populate_branch_menu
2190 proc do_delete_branch {} {
2191 global all_heads tracking_branches current_branch
2192 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2194 set w .branch_editor
2196 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2198 label $w.header -text {Delete Local Branch} \
2200 pack $w.header -side top -fill x
2203 button $w.buttons.create -text Delete \
2205 -command [list do_delete_branch_action $w]
2206 pack $w.buttons.create -side right
2207 button $w.buttons.cancel -text {Cancel} \
2209 -command [list destroy $w]
2210 pack $w.buttons.cancel -side right -padx 5
2211 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2213 labelframe $w.list \
2214 -text {Local Branches} \
2219 -selectmode extended \
2220 -yscrollcommand [list $w.list.sby set] \
2222 foreach h $all_heads {
2223 if {$h ne $current_branch} {
2224 $w.list.l insert end $h
2227 scrollbar $w.list.sby -command [list $w.list.l yview]
2228 pack $w.list.sby -side right -fill y
2229 pack $w.list.l -side left -fill both -expand 1
2230 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2232 labelframe $w.validate \
2233 -text {Delete Only If} \
2235 radiobutton $w.validate.head_r \
2236 -text {Merged Into Local Branch:} \
2238 -variable delete_branch_checktype \
2240 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2241 grid $w.validate.head_r $w.validate.head_m -sticky w
2242 set all_trackings [all_tracking_branches]
2243 if {$all_trackings ne {}} {
2244 set delete_branch_trackinghead [lindex $all_trackings 0]
2245 radiobutton $w.validate.tracking_r \
2246 -text {Merged Into Tracking Branch:} \
2248 -variable delete_branch_checktype \
2250 eval tk_optionMenu $w.validate.tracking_m \
2251 delete_branch_trackinghead \
2253 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2255 radiobutton $w.validate.always_r \
2256 -text {Always (Do not perform merge checks)} \
2258 -variable delete_branch_checktype \
2260 grid $w.validate.always_r -columnspan 2 -sticky w
2261 grid columnconfigure $w.validate 1 -weight 1
2262 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2264 set delete_branch_head $current_branch
2265 set delete_branch_checktype head
2267 bind $w <Visibility> "grab $w; focus $w"
2268 bind $w <Key-Escape> "destroy $w"
2269 wm title $w "[appname] ([reponame]): Delete Branch"
2273 proc switch_branch {new_branch} {
2274 global HEAD commit_type current_branch repo_config
2276 if {![lock_index switch]} return
2278 # -- Our in memory state should match the repository.
2280 repository_state curType curHEAD curMERGE_HEAD
2281 if {[string match amend* $commit_type]
2282 && $curType eq {normal}
2283 && $curHEAD eq $HEAD} {
2284 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2285 info_popup {Last scanned state does not match repository state.
2287 Another Git program has modified this repository
2288 since the last scan. A rescan must be performed
2289 before the current branch can be changed.
2291 The rescan will be automatically started now.
2294 rescan {set ui_status_value {Ready.}}
2298 # -- Don't do a pointless switch.
2300 if {$current_branch eq $new_branch} {
2305 if {$repo_config(gui.trustmtime) eq {true}} {
2306 switch_branch_stage2 {} $new_branch
2308 set ui_status_value {Refreshing file status...}
2309 set cmd [list git update-index]
2311 lappend cmd --unmerged
2312 lappend cmd --ignore-missing
2313 lappend cmd --refresh
2314 set fd_rf [open "| $cmd" r]
2315 fconfigure $fd_rf -blocking 0 -translation binary
2316 fileevent $fd_rf readable \
2317 [list switch_branch_stage2 $fd_rf $new_branch]
2321 proc switch_branch_stage2 {fd_rf new_branch} {
2322 global ui_status_value HEAD
2326 if {![eof $fd_rf]} return
2330 set ui_status_value "Updating working directory to '$new_branch'..."
2331 set cmd [list git read-tree]
2334 lappend cmd --exclude-per-directory=.gitignore
2336 lappend cmd $new_branch
2337 set fd_rt [open "| $cmd" r]
2338 fconfigure $fd_rt -blocking 0 -translation binary
2339 fileevent $fd_rt readable \
2340 [list switch_branch_readtree_wait $fd_rt $new_branch]
2343 proc switch_branch_readtree_wait {fd_rt new_branch} {
2344 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2345 global current_branch
2346 global ui_comm ui_status_value
2348 # -- We never get interesting output on stdout; only stderr.
2351 fconfigure $fd_rt -blocking 1
2352 if {![eof $fd_rt]} {
2353 fconfigure $fd_rt -blocking 0
2357 # -- The working directory wasn't in sync with the index and
2358 # we'd have to overwrite something to make the switch. A
2359 # merge is required.
2361 if {[catch {close $fd_rt} err]} {
2362 regsub {^fatal: } $err {} err
2363 warn_popup "File level merge required.
2367 Staying on branch '$current_branch'."
2368 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2373 # -- Update the symbolic ref. Core git doesn't even check for failure
2374 # here, it Just Works(tm). If it doesn't we are in some really ugly
2375 # state that is difficult to recover from within git-gui.
2377 if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2378 error_popup "Failed to set current branch.
2380 This working directory is only partially switched.
2381 We successfully updated your files, but failed to
2382 update an internal Git file.
2384 This should not have occurred. [appname] will now
2392 # -- Update our repository state. If we were previously in amend mode
2393 # we need to toss the current buffer and do a full rescan to update
2394 # our file lists. If we weren't in amend mode our file lists are
2395 # accurate and we can avoid the rescan.
2398 set selected_commit_type new
2399 if {[string match amend* $commit_type]} {
2400 $ui_comm delete 0.0 end
2402 $ui_comm edit modified false
2403 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2405 repository_state commit_type HEAD MERGE_HEAD
2407 set ui_status_value "Checked out branch '$current_branch'."
2411 ######################################################################
2413 ## remote management
2415 proc load_all_remotes {} {
2417 global all_remotes tracking_branches
2419 set all_remotes [list]
2420 array unset tracking_branches
2422 set rm_dir [gitdir remotes]
2423 if {[file isdirectory $rm_dir]} {
2424 set all_remotes [glob \
2428 -directory $rm_dir *]
2430 foreach name $all_remotes {
2432 set fd [open [file join $rm_dir $name] r]
2433 while {[gets $fd line] >= 0} {
2434 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2435 $line line src dst]} continue
2436 if {![regexp ^refs/ $dst]} {
2437 set dst "refs/heads/$dst"
2439 set tracking_branches($dst) [list $name $src]
2446 foreach line [array names repo_config remote.*.url] {
2447 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2448 lappend all_remotes $name
2450 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2454 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2455 if {![regexp ^refs/ $dst]} {
2456 set dst "refs/heads/$dst"
2458 set tracking_branches($dst) [list $name $src]
2462 set all_remotes [lsort -unique $all_remotes]
2465 proc populate_fetch_menu {} {
2466 global all_remotes repo_config
2469 foreach r $all_remotes {
2471 if {![catch {set a $repo_config(remote.$r.url)}]} {
2472 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2477 set fd [open [gitdir remotes $r] r]
2478 while {[gets $fd n] >= 0} {
2479 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2490 -label "Fetch from $r..." \
2491 -command [list fetch_from $r] \
2497 proc populate_push_menu {} {
2498 global all_remotes repo_config
2502 foreach r $all_remotes {
2504 if {![catch {set a $repo_config(remote.$r.url)}]} {
2505 if {![catch {set a $repo_config(remote.$r.push)}]} {
2510 set fd [open [gitdir remotes $r] r]
2511 while {[gets $fd n] >= 0} {
2512 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2526 -label "Push to $r..." \
2527 -command [list push_to $r] \
2534 proc start_push_anywhere_action {w} {
2535 global push_urltype push_remote push_url push_thin push_tags
2538 switch -- $push_urltype {
2539 remote {set r_url $push_remote}
2540 url {set r_url $push_url}
2542 if {$r_url eq {}} return
2544 set cmd [list git push]
2554 foreach i [$w.source.l curselection] {
2555 set b [$w.source.l get $i]
2556 lappend cmd "refs/heads/$b:refs/heads/$b"
2561 } elseif {$cnt == 1} {
2567 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2568 console_exec $cons $cmd console_done
2572 trace add variable push_remote write \
2573 [list radio_selector push_urltype remote]
2575 proc do_push_anywhere {} {
2576 global all_heads all_remotes current_branch
2577 global push_urltype push_remote push_url push_thin push_tags
2581 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2583 label $w.header -text {Push Branches} -font font_uibold
2584 pack $w.header -side top -fill x
2587 button $w.buttons.create -text Push \
2589 -command [list start_push_anywhere_action $w]
2590 pack $w.buttons.create -side right
2591 button $w.buttons.cancel -text {Cancel} \
2593 -command [list destroy $w]
2594 pack $w.buttons.cancel -side right -padx 5
2595 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2597 labelframe $w.source \
2598 -text {Source Branches} \
2600 listbox $w.source.l \
2603 -selectmode extended \
2604 -yscrollcommand [list $w.source.sby set] \
2606 foreach h $all_heads {
2607 $w.source.l insert end $h
2608 if {$h eq $current_branch} {
2609 $w.source.l select set end
2612 scrollbar $w.source.sby -command [list $w.source.l yview]
2613 pack $w.source.sby -side right -fill y
2614 pack $w.source.l -side left -fill both -expand 1
2615 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2617 labelframe $w.dest \
2618 -text {Destination Repository} \
2620 if {$all_remotes ne {}} {
2621 radiobutton $w.dest.remote_r \
2624 -variable push_urltype \
2626 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2627 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2628 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2629 set push_remote origin
2631 set push_remote [lindex $all_remotes 0]
2633 set push_urltype remote
2635 set push_urltype url
2637 radiobutton $w.dest.url_r \
2638 -text {Arbitrary URL:} \
2640 -variable push_urltype \
2642 entry $w.dest.url_t \
2646 -textvariable push_url \
2650 if {%d == 1 && [regexp {\s} %S]} {return 0}
2651 if {%d == 1 && [string length %S] > 0} {
2652 set push_urltype url
2656 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2657 grid columnconfigure $w.dest 1 -weight 1
2658 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2660 labelframe $w.options \
2661 -text {Transfer Options} \
2663 checkbutton $w.options.thin \
2664 -text {Use thin pack (for slow network connections)} \
2665 -variable push_thin \
2667 grid $w.options.thin -columnspan 2 -sticky w
2668 checkbutton $w.options.tags \
2669 -text {Include tags} \
2670 -variable push_tags \
2672 grid $w.options.tags -columnspan 2 -sticky w
2673 grid columnconfigure $w.options 1 -weight 1
2674 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2680 bind $w <Visibility> "grab $w"
2681 bind $w <Key-Escape> "destroy $w"
2682 wm title $w "[appname] ([reponame]): Push"
2686 ######################################################################
2691 global HEAD commit_type file_states
2693 if {[string match amend* $commit_type]} {
2694 info_popup {Cannot merge while amending.
2696 You must finish amending this commit before
2697 starting any type of merge.
2702 if {[committer_ident] eq {}} {return 0}
2703 if {![lock_index merge]} {return 0}
2705 # -- Our in memory state should match the repository.
2707 repository_state curType curHEAD curMERGE_HEAD
2708 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2709 info_popup {Last scanned state does not match repository state.
2711 Another Git program has modified this repository
2712 since the last scan. A rescan must be performed
2713 before a merge can be performed.
2715 The rescan will be automatically started now.
2718 rescan {set ui_status_value {Ready.}}
2722 foreach path [array names file_states] {
2723 switch -glob -- [lindex $file_states($path) 0] {
2725 continue; # and pray it works!
2728 error_popup "You are in the middle of a conflicted merge.
2730 File [short_path $path] has merge conflicts.
2732 You must resolve them, add the file, and commit to
2733 complete the current merge. Only then can you
2734 begin another merge.
2740 error_popup "You are in the middle of a change.
2742 File [short_path $path] is modified.
2744 You should complete the current commit before
2745 starting a merge. Doing so will help you abort
2746 a failed merge, should the need arise.
2757 proc visualize_local_merge {w} {
2759 foreach i [$w.source.l curselection] {
2760 lappend revs [$w.source.l get $i]
2762 if {$revs eq {}} return
2763 lappend revs --not HEAD
2767 proc start_local_merge_action {w} {
2768 global HEAD ui_status_value current_branch
2770 set cmd [list git merge]
2773 foreach i [$w.source.l curselection] {
2774 set b [$w.source.l get $i]
2782 } elseif {$revcnt == 1} {
2784 } elseif {$revcnt <= 15} {
2790 -title [wm title $w] \
2792 -message "Too many branches selected.
2794 You have requested to merge $revcnt branches
2795 in an octopus merge. This exceeds Git's
2796 internal limit of 15 branches per merge.
2798 Please select fewer branches. To merge more
2799 than 15 branches, merge the branches in batches.
2804 set msg "Merging $current_branch, [join $names {, }]"
2805 set ui_status_value "$msg..."
2806 set cons [new_console "Merge" $msg]
2807 console_exec $cons $cmd [list finish_merge $revcnt]
2808 bind $w <Destroy> {}
2812 proc finish_merge {revcnt w ok} {
2815 set msg {Merge completed successfully.}
2818 info_popup "Octopus merge failed.
2820 Your merge of $revcnt branches has failed.
2822 There are file-level conflicts between the
2823 branches which must be resolved manually.
2825 The working directory will now be reset.
2827 You can attempt this merge again
2828 by merging only one branch at a time." $w
2830 set fd [open "| git read-tree --reset -u HEAD" r]
2831 fconfigure $fd -blocking 0 -translation binary
2832 fileevent $fd readable [list reset_hard_wait $fd]
2833 set ui_status_value {Aborting... please wait...}
2837 set msg {Merge failed. Conflict resolution is required.}
2840 rescan [list set ui_status_value $msg]
2843 proc do_local_merge {} {
2844 global current_branch
2846 if {![can_merge]} return
2850 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2853 -text "Merge Into $current_branch" \
2855 pack $w.header -side top -fill x
2858 button $w.buttons.visualize -text Visualize \
2860 -command [list visualize_local_merge $w]
2861 pack $w.buttons.visualize -side left
2862 button $w.buttons.create -text Merge \
2864 -command [list start_local_merge_action $w]
2865 pack $w.buttons.create -side right
2866 button $w.buttons.cancel -text {Cancel} \
2868 -command [list destroy $w]
2869 pack $w.buttons.cancel -side right -padx 5
2870 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2872 labelframe $w.source \
2873 -text {Source Branches} \
2875 listbox $w.source.l \
2878 -selectmode extended \
2879 -yscrollcommand [list $w.source.sby set] \
2881 scrollbar $w.source.sby -command [list $w.source.l yview]
2882 pack $w.source.sby -side right -fill y
2883 pack $w.source.l -side left -fill both -expand 1
2884 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2886 set cmd [list git for-each-ref]
2887 lappend cmd {--format=%(objectname) %(refname)}
2888 lappend cmd refs/heads
2889 lappend cmd refs/remotes
2890 set fr_fd [open "| $cmd" r]
2891 fconfigure $fr_fd -translation binary
2892 while {[gets $fr_fd line] > 0} {
2893 set line [split $line { }]
2894 set sha1([lindex $line 0]) [lindex $line 1]
2899 set fr_fd [open "| git rev-list --all --not HEAD"]
2900 while {[gets $fr_fd line] > 0} {
2901 if {[catch {set ref $sha1($line)}]} continue
2902 regsub ^refs/(heads|remotes)/ $ref {} ref
2903 lappend to_show $ref
2907 foreach ref [lsort -unique $to_show] {
2908 $w.source.l insert end $ref
2911 bind $w <Visibility> "grab $w"
2912 bind $w <Key-Escape> "unlock_index;destroy $w"
2913 bind $w <Destroy> unlock_index
2914 wm title $w "[appname] ([reponame]): Merge"
2918 proc do_reset_hard {} {
2919 global HEAD commit_type file_states
2921 if {[string match amend* $commit_type]} {
2922 info_popup {Cannot abort while amending.
2924 You must finish amending this commit.
2929 if {![lock_index abort]} return
2931 if {[string match *merge* $commit_type]} {
2937 if {[ask_popup "Abort $op?
2939 Aborting the current $op will cause
2940 *ALL* uncommitted changes to be lost.
2942 Continue with aborting the current $op?"] eq {yes}} {
2943 set fd [open "| git read-tree --reset -u HEAD" r]
2944 fconfigure $fd -blocking 0 -translation binary
2945 fileevent $fd readable [list reset_hard_wait $fd]
2946 set ui_status_value {Aborting... please wait...}
2952 proc reset_hard_wait {fd} {
2960 $ui_comm delete 0.0 end
2961 $ui_comm edit modified false
2963 catch {file delete [gitdir MERGE_HEAD]}
2964 catch {file delete [gitdir rr-cache MERGE_RR]}
2965 catch {file delete [gitdir SQUASH_MSG]}
2966 catch {file delete [gitdir MERGE_MSG]}
2967 catch {file delete [gitdir GITGUI_MSG]}
2969 rescan {set ui_status_value {Abort completed. Ready.}}
2973 ######################################################################
2977 set next_browser_id 0
2979 proc new_browser {commit} {
2980 global next_browser_id cursor_ptr M1B
2981 global browser_commit browser_status browser_stack browser_path browser_busy
2983 set w .browser[incr next_browser_id]
2984 set w_list $w.list.l
2985 set browser_commit($w_list) $commit
2986 set browser_status($w_list) {Starting...}
2987 set browser_stack($w_list) {}
2988 set browser_path($w_list) $browser_commit($w_list):
2989 set browser_busy($w_list) 1
2992 label $w.path -textvariable browser_path($w_list) \
2998 pack $w.path -anchor w -side top -fill x
3001 text $w_list -background white -borderwidth 0 \
3002 -cursor $cursor_ptr \
3007 -xscrollcommand [list $w.list.sbx set] \
3008 -yscrollcommand [list $w.list.sby set] \
3010 $w_list tag conf in_sel \
3011 -background [$w_list cget -foreground] \
3012 -foreground [$w_list cget -background]
3013 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3014 scrollbar $w.list.sby -orient v -command [list $w_list yview]
3015 pack $w.list.sbx -side bottom -fill x
3016 pack $w.list.sby -side right -fill y
3017 pack $w_list -side left -fill both -expand 1
3018 pack $w.list -side top -fill both -expand 1
3020 label $w.status -textvariable browser_status($w_list) \
3026 pack $w.status -anchor w -side bottom -fill x
3028 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3029 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3030 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3031 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3032 bind $w_list <Up> "browser_move -1 $w_list;break"
3033 bind $w_list <Down> "browser_move 1 $w_list;break"
3034 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3035 bind $w_list <Return> "browser_enter $w_list;break"
3036 bind $w_list <Prior> "browser_page -1 $w_list;break"
3037 bind $w_list <Next> "browser_page 1 $w_list;break"
3038 bind $w_list <Left> break
3039 bind $w_list <Right> break
3041 bind $w <Visibility> "focus $w"
3043 array unset browser_buffer $w_list
3044 array unset browser_files $w_list
3045 array unset browser_status $w_list
3046 array unset browser_stack $w_list
3047 array unset browser_path $w_list
3048 array unset browser_commit $w_list
3049 array unset browser_busy $w_list
3051 wm title $w "[appname] ([reponame]): File Browser"
3052 ls_tree $w_list $browser_commit($w_list) {}
3055 proc browser_move {dir w} {
3056 global browser_files browser_busy
3058 if {$browser_busy($w)} return
3059 set lno [lindex [split [$w index in_sel.first] .] 0]
3061 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3062 $w tag remove in_sel 0.0 end
3063 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3068 proc browser_page {dir w} {
3069 global browser_files browser_busy
3071 if {$browser_busy($w)} return
3072 $w yview scroll $dir pages
3074 [lindex [$w yview] 0]
3075 * [llength $browser_files($w)]
3077 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3078 $w tag remove in_sel 0.0 end
3079 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3084 proc browser_parent {w} {
3085 global browser_files browser_status browser_path
3086 global browser_stack browser_busy
3088 if {$browser_busy($w)} return
3089 set info [lindex $browser_files($w) 0]
3090 if {[lindex $info 0] eq {parent}} {
3091 set parent [lindex $browser_stack($w) end-1]
3092 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3093 if {$browser_stack($w) eq {}} {
3094 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3096 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3098 set browser_status($w) "Loading $browser_path($w)..."
3099 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3103 proc browser_enter {w} {
3104 global browser_files browser_status browser_path
3105 global browser_commit browser_stack browser_busy
3107 if {$browser_busy($w)} return
3108 set lno [lindex [split [$w index in_sel.first] .] 0]
3109 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3111 switch -- [lindex $info 0] {
3116 set name [lindex $info 2]
3117 set escn [escape_path $name]
3118 set browser_status($w) "Loading $escn..."
3119 append browser_path($w) $escn
3120 ls_tree $w [lindex $info 1] $name
3123 set name [lindex $info 2]
3125 foreach n $browser_stack($w) {
3126 append p [lindex $n 1]
3129 show_blame $browser_commit($w) $p
3135 proc browser_click {was_double_click w pos} {
3136 global browser_files browser_busy
3138 if {$browser_busy($w)} return
3139 set lno [lindex [split [$w index $pos] .] 0]
3142 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3143 $w tag remove in_sel 0.0 end
3144 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3145 if {$was_double_click} {
3151 proc ls_tree {w tree_id name} {
3152 global browser_buffer browser_files browser_stack browser_busy
3154 set browser_buffer($w) {}
3155 set browser_files($w) {}
3156 set browser_busy($w) 1
3158 $w conf -state normal
3159 $w tag remove in_sel 0.0 end
3161 if {$browser_stack($w) ne {}} {
3162 $w image create end \
3163 -align center -padx 5 -pady 1 \
3166 $w insert end {[Up To Parent]}
3167 lappend browser_files($w) parent
3169 lappend browser_stack($w) [list $tree_id $name]
3170 $w conf -state disabled
3172 set cmd [list git ls-tree -z $tree_id]
3173 set fd [open "| $cmd" r]
3174 fconfigure $fd -blocking 0 -translation binary -encoding binary
3175 fileevent $fd readable [list read_ls_tree $fd $w]
3178 proc read_ls_tree {fd w} {
3179 global browser_buffer browser_files browser_status browser_busy
3181 if {![winfo exists $w]} {
3186 append browser_buffer($w) [read $fd]
3187 set pck [split $browser_buffer($w) "\0"]
3188 set browser_buffer($w) [lindex $pck end]
3190 set n [llength $browser_files($w)]
3191 $w conf -state normal
3192 foreach p [lrange $pck 0 end-1] {
3193 set info [split $p "\t"]
3194 set path [lindex $info 1]
3195 set info [split [lindex $info 0] { }]
3196 set type [lindex $info 1]
3197 set object [lindex $info 2]
3208 set image file_question
3212 if {$n > 0} {$w insert end "\n"}
3213 $w image create end \
3214 -align center -padx 5 -pady 1 \
3215 -name icon[incr n] \
3217 $w insert end [escape_path $path]
3218 lappend browser_files($w) [list $type $object $path]
3220 $w conf -state disabled
3224 set browser_status($w) Ready.
3225 set browser_busy($w) 0
3226 array unset browser_buffer $w
3228 $w tag add in_sel 1.0 2.0
3234 proc show_blame {commit path} {
3235 global next_browser_id blame_status blame_data
3237 if {[winfo ismapped .]} {
3238 set w .browser[incr next_browser_id]
3245 set blame_status($w) {Loading current file content...}
3247 label $w.path -text "$commit:$path" \
3253 pack $w.path -side top -fill x
3256 text $w.out.loaded_t \
3257 -background white -borderwidth 0 \
3263 $w.out.loaded_t tag conf annotated -background grey
3265 text $w.out.linenumber_t \
3266 -background white -borderwidth 0 \
3272 $w.out.linenumber_t tag conf linenumber -justify right
3274 text $w.out.file_t \
3275 -background white -borderwidth 0 \
3280 -xscrollcommand [list $w.out.sbx set] \
3283 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3284 scrollbar $w.out.sby -orient v \
3285 -command [list scrollbar2many [list \
3287 $w.out.linenumber_t \
3291 $w.out.linenumber_t \
3296 grid conf $w.out.sbx -column 2 -sticky we
3297 grid columnconfigure $w.out 2 -weight 1
3298 grid rowconfigure $w.out 0 -weight 1
3299 pack $w.out -fill both -expand 1
3301 label $w.status -textvariable blame_status($w) \
3307 pack $w.status -side bottom -fill x
3311 -background white -borderwidth 0 \
3316 -xscrollcommand [list $w.cm.sbx set] \
3317 -yscrollcommand [list $w.cm.sby set] \
3319 scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3320 scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3321 pack $w.cm.sby -side right -fill y
3322 pack $w.cm.sbx -side bottom -fill x
3323 pack $w.cm.t -expand 1 -fill both
3324 pack $w.cm -side bottom -fill x
3326 menu $w.ctxm -tearoff 0
3327 $w.ctxm add command -label "Copy Commit" \
3329 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3333 $w.out.linenumber_t \
3335 $i tag conf in_sel \
3336 -background [$i cget -foreground] \
3337 -foreground [$i cget -background]
3338 $i conf -yscrollcommand \
3339 [list many2scrollbar [list \
3341 $w.out.linenumber_t \
3344 bind $i <Button-1> "
3347 $w.out.linenumber_t \\
3356 tk_popup $w.ctxm %X %Y
3360 bind $w.cm.t <Button-1> "focus $w.cm.t"
3361 bind $tl <Visibility> "focus $tl"
3362 bind $tl <Destroy> "
3363 array unset blame_status {$w}
3364 array unset blame_data $w,*
3366 wm title $tl "[appname] ([reponame]): File Viewer"
3368 set blame_data($w,commit_count) 0
3369 set blame_data($w,commit_list) {}
3370 set blame_data($w,total_lines) 0
3371 set blame_data($w,blame_lines) 0
3372 set blame_data($w,highlight_commit) {}
3373 set blame_data($w,highlight_line) -1
3375 set cmd [list git cat-file blob "$commit:$path"]
3376 set fd [open "| $cmd" r]
3377 fconfigure $fd -blocking 0 -translation lf -encoding binary
3378 fileevent $fd readable [list read_blame_catfile \
3379 $fd $w $commit $path \
3380 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3383 proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3384 global blame_status blame_data
3386 if {![winfo exists $w_file]} {
3391 set n $blame_data($w,total_lines)
3392 $w_load conf -state normal
3393 $w_line conf -state normal
3394 $w_file conf -state normal
3395 while {[gets $fd line] >= 0} {
3396 regsub "\r\$" $line {} line
3398 $w_load insert end "\n"
3399 $w_line insert end "$n\n" linenumber
3400 $w_file insert end "$line\n"
3402 $w_load conf -state disabled
3403 $w_line conf -state disabled
3404 $w_file conf -state disabled
3405 set blame_data($w,total_lines) $n
3409 blame_incremental_status $w
3410 set cmd [list git blame -M -C --incremental]
3411 lappend cmd $commit -- $path
3412 set fd [open "| $cmd" r]
3413 fconfigure $fd -blocking 0 -translation lf -encoding binary
3414 fileevent $fd readable [list read_blame_incremental $fd $w \
3415 $w_load $w_cmit $w_line $w_file]
3419 proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3420 global blame_status blame_data
3422 if {![winfo exists $w_file]} {
3427 while {[gets $fd line] >= 0} {
3428 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3429 cmit original_line final_line line_count]} {
3430 set blame_data($w,commit) $cmit
3431 set blame_data($w,original_line) $original_line
3432 set blame_data($w,final_line) $final_line
3433 set blame_data($w,line_count) $line_count
3435 if {[catch {set g $blame_data($w,$cmit,order)}]} {
3436 $w_line tag conf g$cmit
3437 $w_file tag conf g$cmit
3438 $w_line tag raise in_sel
3439 $w_file tag raise in_sel
3440 $w_file tag raise sel
3441 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3442 incr blame_data($w,commit_count)
3443 lappend blame_data($w,commit_list) $cmit
3445 } elseif {[string match {filename *} $line]} {
3446 set file [string range $line 9 end]
3447 set n $blame_data($w,line_count)
3448 set lno $blame_data($w,final_line)
3449 set cmit $blame_data($w,commit)
3452 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3453 $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3455 $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3456 $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3459 set blame_data($w,line$lno,commit) $cmit
3460 set blame_data($w,line$lno,file) $file
3461 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3462 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3464 if {$blame_data($w,highlight_line) == -1} {
3465 if {[lindex [$w_file yview] 0] == 0} {
3467 blame_showcommit $w $w_cmit $w_line $w_file $lno
3469 } elseif {$blame_data($w,highlight_line) == $lno} {
3470 blame_showcommit $w $w_cmit $w_line $w_file $lno
3475 incr blame_data($w,blame_lines)
3478 set hc $blame_data($w,highlight_commit)
3480 && [expr {$blame_data($w,$hc,order) + 1}]
3481 == $blame_data($w,$cmit,order)} {
3482 blame_showcommit $w $w_cmit $w_line $w_file \
3483 $blame_data($w,highlight_line)
3485 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3486 set blame_data($w,$blame_data($w,commit),$header) $data
3492 set blame_status($w) {Annotation complete.}
3494 blame_incremental_status $w
3498 proc blame_incremental_status {w} {
3499 global blame_status blame_data
3501 set blame_status($w) [format \
3502 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3503 $blame_data($w,blame_lines) \
3504 $blame_data($w,total_lines) \
3505 [expr {100 * $blame_data($w,blame_lines)
3506 / $blame_data($w,total_lines)}]]
3509 proc blame_click {w w_cmit w_line w_file cur_w pos} {
3510 set lno [lindex [split [$cur_w index $pos] .] 0]
3511 if {$lno eq {}} return
3513 $w_line tag remove in_sel 0.0 end
3514 $w_file tag remove in_sel 0.0 end
3515 $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3516 $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3518 blame_showcommit $w $w_cmit $w_line $w_file $lno
3527 proc blame_showcommit {w w_cmit w_line w_file lno} {
3528 global blame_colors blame_data repo_config
3530 set cmit $blame_data($w,highlight_commit)
3532 set idx $blame_data($w,$cmit,order)
3534 foreach c $blame_colors {
3535 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3536 $w_line tag conf g$h -background white
3537 $w_file tag conf g$h -background white
3542 $w_cmit conf -state normal
3543 $w_cmit delete 0.0 end
3544 if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3546 $w_cmit insert end "Loading annotation..."
3548 set idx $blame_data($w,$cmit,order)
3550 foreach c $blame_colors {
3551 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3552 $w_line tag conf g$h -background $c
3553 $w_file tag conf g$h -background $c
3557 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3560 set fd [open "| git cat-file commit $cmit" r]
3561 fconfigure $fd -encoding binary -translation lf
3562 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3565 while {[gets $fd line] > 0} {
3566 if {[string match {encoding *} $line]} {
3567 set enc [string tolower [string range $line 9 end]]
3570 fconfigure $fd -encoding $enc
3571 set msg [string trim [read $fd]]
3574 set blame_data($w,$cmit,message) $msg
3580 catch {set author_name $blame_data($w,$cmit,author)}
3581 catch {set author_email $blame_data($w,$cmit,author-mail)}
3582 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3584 set committer_name {}
3585 set committer_email {}
3586 set committer_time {}
3587 catch {set committer_name $blame_data($w,$cmit,committer)}
3588 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3589 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3591 $w_cmit insert end "commit $cmit\n"
3592 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3593 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3594 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3595 $w_cmit insert end "\n"
3596 $w_cmit insert end $msg
3598 $w_cmit conf -state disabled
3600 set blame_data($w,highlight_line) $lno
3601 set blame_data($w,highlight_commit) $cmit
3604 proc blame_copycommit {w i pos} {
3606 set lno [lindex [split [$i index $pos] .] 0]
3607 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3616 ######################################################################
3621 #define mask_width 14
3622 #define mask_height 15
3623 static unsigned char mask_bits[] = {
3624 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3625 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3626 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3629 image create bitmap file_plain -background white -foreground black -data {
3630 #define plain_width 14
3631 #define plain_height 15
3632 static unsigned char plain_bits[] = {
3633 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3634 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3635 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3636 } -maskdata $filemask
3638 image create bitmap file_mod -background white -foreground blue -data {
3639 #define mod_width 14
3640 #define mod_height 15
3641 static unsigned char mod_bits[] = {
3642 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3643 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3644 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3645 } -maskdata $filemask
3647 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3648 #define file_fulltick_width 14
3649 #define file_fulltick_height 15
3650 static unsigned char file_fulltick_bits[] = {
3651 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3652 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3653 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3654 } -maskdata $filemask
3656 image create bitmap file_parttick -background white -foreground "#005050" -data {
3657 #define parttick_width 14
3658 #define parttick_height 15
3659 static unsigned char parttick_bits[] = {
3660 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3661 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3662 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3663 } -maskdata $filemask
3665 image create bitmap file_question -background white -foreground black -data {
3666 #define file_question_width 14
3667 #define file_question_height 15
3668 static unsigned char file_question_bits[] = {
3669 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3670 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3671 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3672 } -maskdata $filemask
3674 image create bitmap file_removed -background white -foreground red -data {
3675 #define file_removed_width 14
3676 #define file_removed_height 15
3677 static unsigned char file_removed_bits[] = {
3678 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3679 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3680 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3681 } -maskdata $filemask
3683 image create bitmap file_merge -background white -foreground blue -data {
3684 #define file_merge_width 14
3685 #define file_merge_height 15
3686 static unsigned char file_merge_bits[] = {
3687 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3688 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3689 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3690 } -maskdata $filemask
3693 #define file_width 18
3694 #define file_height 18
3695 static unsigned char file_bits[] = {
3696 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3697 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3698 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3699 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3700 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3702 image create bitmap file_dir -background white -foreground blue \
3703 -data $file_dir_data -maskdata $file_dir_data
3706 set file_uplevel_data {
3708 #define up_height 15
3709 static unsigned char up_bits[] = {
3710 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3711 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3712 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3714 image create bitmap file_uplevel -background white -foreground red \
3715 -data $file_uplevel_data -maskdata $file_uplevel_data
3716 unset file_uplevel_data
3718 set ui_index .vpane.files.index.list
3719 set ui_workdir .vpane.files.workdir.list
3721 set all_icons(_$ui_index) file_plain
3722 set all_icons(A$ui_index) file_fulltick
3723 set all_icons(M$ui_index) file_fulltick
3724 set all_icons(D$ui_index) file_removed
3725 set all_icons(U$ui_index) file_merge
3727 set all_icons(_$ui_workdir) file_plain
3728 set all_icons(M$ui_workdir) file_mod
3729 set all_icons(D$ui_workdir) file_question
3730 set all_icons(U$ui_workdir) file_merge
3731 set all_icons(O$ui_workdir) file_plain
3733 set max_status_desc 0
3737 {_M "Modified, not staged"}
3738 {M_ "Staged for commit"}
3739 {MM "Portions staged for commit"}
3740 {MD "Staged for commit, missing"}
3742 {_O "Untracked, not staged"}
3743 {A_ "Staged for commit"}
3744 {AM "Portions staged for commit"}
3745 {AD "Staged for commit, missing"}
3748 {D_ "Staged for removal"}
3749 {DO "Staged for removal, still present"}
3751 {U_ "Requires merge resolution"}
3752 {UU "Requires merge resolution"}
3753 {UM "Requires merge resolution"}
3754 {UD "Requires merge resolution"}
3756 if {$max_status_desc < [string length [lindex $i 1]]} {
3757 set max_status_desc [string length [lindex $i 1]]
3759 set all_descs([lindex $i 0]) [lindex $i 1]
3763 ######################################################################
3767 proc bind_button3 {w cmd} {
3768 bind $w <Any-Button-3> $cmd
3770 bind $w <Control-Button-1> $cmd
3774 proc scrollbar2many {list mode args} {
3775 foreach w $list {eval $w $mode $args}
3778 proc many2scrollbar {list mode sb top bottom} {
3779 $sb set $top $bottom
3780 foreach w $list {$w $mode moveto $top}
3783 proc incr_font_size {font {amt 1}} {
3784 set sz [font configure $font -size]
3786 font configure $font -size $sz
3787 font configure ${font}bold -size $sz
3790 proc hook_failed_popup {hook msg} {
3795 label $w.m.l1 -text "$hook hook failed:" \
3800 -background white -borderwidth 1 \
3802 -width 80 -height 10 \
3804 -yscrollcommand [list $w.m.sby set]
3806 -text {You must correct the above errors before committing.} \
3810 scrollbar $w.m.sby -command [list $w.m.t yview]
3811 pack $w.m.l1 -side top -fill x
3812 pack $w.m.l2 -side bottom -fill x
3813 pack $w.m.sby -side right -fill y
3814 pack $w.m.t -side left -fill both -expand 1
3815 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3817 $w.m.t insert 1.0 $msg
3818 $w.m.t conf -state disabled
3820 button $w.ok -text OK \
3823 -command "destroy $w"
3824 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3826 bind $w <Visibility> "grab $w; focus $w"
3827 bind $w <Key-Return> "destroy $w"
3828 wm title $w "[appname] ([reponame]): error"
3832 set next_console_id 0
3834 proc new_console {short_title long_title} {
3835 global next_console_id console_data
3836 set w .console[incr next_console_id]
3837 set console_data($w) [list $short_title $long_title]
3838 return [console_init $w]
3841 proc console_init {w} {
3842 global console_cr console_data M1B
3844 set console_cr($w) 1.0
3847 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3852 -background white -borderwidth 1 \
3854 -width 80 -height 10 \
3857 -yscrollcommand [list $w.m.sby set]
3858 label $w.m.s -text {Working... please wait...} \
3862 scrollbar $w.m.sby -command [list $w.m.t yview]
3863 pack $w.m.l1 -side top -fill x
3864 pack $w.m.s -side bottom -fill x
3865 pack $w.m.sby -side right -fill y
3866 pack $w.m.t -side left -fill both -expand 1
3867 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3869 menu $w.ctxm -tearoff 0
3870 $w.ctxm add command -label "Copy" \
3872 -command "tk_textCopy $w.m.t"
3873 $w.ctxm add command -label "Select All" \
3875 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3876 $w.ctxm add command -label "Copy All" \
3879 $w.m.t tag add sel 0.0 end
3881 $w.m.t tag remove sel 0.0 end
3884 button $w.ok -text {Close} \
3887 -command "destroy $w"
3888 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3890 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3891 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3892 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3893 bind $w <Visibility> "focus $w"
3894 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3898 proc console_exec {w cmd after} {
3899 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3900 # But most users need that so we have to relogin. :-(
3903 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3906 # -- Tcl won't let us redirect both stdout and stderr to
3907 # the same pipe. So pass it through cat...
3909 set cmd [concat | $cmd |& cat]
3911 set fd_f [open $cmd r]
3912 fconfigure $fd_f -blocking 0 -translation binary
3913 fileevent $fd_f readable [list console_read $w $fd_f $after]
3916 proc console_read {w fd after} {
3921 if {![winfo exists $w]} {console_init $w}
3922 $w.m.t conf -state normal
3924 set n [string length $buf]
3926 set cr [string first "\r" $buf $c]
3927 set lf [string first "\n" $buf $c]
3928 if {$cr < 0} {set cr [expr {$n + 1}]}
3929 if {$lf < 0} {set lf [expr {$n + 1}]}
3932 $w.m.t insert end [string range $buf $c $lf]
3933 set console_cr($w) [$w.m.t index {end -1c}]
3937 $w.m.t delete $console_cr($w) end
3938 $w.m.t insert end "\n"
3939 $w.m.t insert end [string range $buf $c $cr]
3944 $w.m.t conf -state disabled
3948 fconfigure $fd -blocking 1
3950 if {[catch {close $fd}]} {
3955 uplevel #0 $after $w $ok
3958 fconfigure $fd -blocking 0
3961 proc console_chain {cmdlist w {ok 1}} {
3963 if {[llength $cmdlist] == 0} {
3968 set cmd [lindex $cmdlist 0]
3969 set cmdlist [lrange $cmdlist 1 end]
3971 if {[lindex $cmd 0] eq {console_exec}} {
3974 [list console_chain $cmdlist]
3976 uplevel #0 $cmd $cmdlist $w $ok
3983 proc console_done {args} {
3984 global console_cr console_data
3986 switch -- [llength $args] {
3988 set w [lindex $args 0]
3989 set ok [lindex $args 1]
3992 set w [lindex $args 1]
3993 set ok [lindex $args 2]
3996 error "wrong number of args: console_done ?ignored? w ok"
4001 if {[winfo exists $w]} {
4002 $w.m.s conf -background green -text {Success}
4003 $w.ok conf -state normal
4006 if {![winfo exists $w]} {
4009 $w.m.s conf -background red -text {Error: Command Failed}
4010 $w.ok conf -state normal
4013 array unset console_cr $w
4014 array unset console_data $w
4017 ######################################################################
4021 set starting_gitk_msg {Starting gitk... please wait...}
4023 proc do_gitk {revs} {
4024 global env ui_status_value starting_gitk_msg
4026 # -- Always start gitk through whatever we were loaded with. This
4027 # lets us bypass using shell process on Windows systems.
4029 set cmd [info nameofexecutable]
4030 lappend cmd [gitexec gitk]
4036 if {[catch {eval exec $cmd &} err]} {
4037 error_popup "Failed to start gitk:\n\n$err"
4039 set ui_status_value $starting_gitk_msg
4041 if {$ui_status_value eq $starting_gitk_msg} {
4042 set ui_status_value {Ready.}
4049 set fd [open "| git count-objects -v" r]
4050 while {[gets $fd line] > 0} {
4051 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4052 set stats($name) $value
4058 foreach p [glob -directory [gitdir objects pack] \
4061 incr packed_sz [file size $p]
4063 if {$packed_sz > 0} {
4064 set stats(size-pack) [expr {$packed_sz / 1024}]
4069 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4071 label $w.header -text {Database Statistics} \
4073 pack $w.header -side top -fill x
4075 frame $w.buttons -border 1
4076 button $w.buttons.close -text Close \
4078 -command [list destroy $w]
4079 button $w.buttons.gc -text {Compress Database} \
4081 -command "destroy $w;do_gc"
4082 pack $w.buttons.close -side right
4083 pack $w.buttons.gc -side left
4084 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4086 frame $w.stat -borderwidth 1 -relief solid
4088 {count {Number of loose objects}}
4089 {size {Disk space used by loose objects} { KiB}}
4090 {in-pack {Number of packed objects}}
4091 {packs {Number of packs}}
4092 {size-pack {Disk space used by packed objects} { KiB}}
4093 {prune-packable {Packed objects waiting for pruning}}
4094 {garbage {Garbage files}}
4096 set name [lindex $s 0]
4097 set label [lindex $s 1]
4098 if {[catch {set value $stats($name)}]} continue
4099 if {[llength $s] > 2} {
4100 set value "$value[lindex $s 2]"
4103 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4104 label $w.stat.v_$name -text $value -anchor w -font font_ui
4105 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4107 pack $w.stat -pady 10 -padx 10
4109 bind $w <Visibility> "grab $w; focus $w"
4110 bind $w <Key-Escape> [list destroy $w]
4111 bind $w <Key-Return> [list destroy $w]
4112 wm title $w "[appname] ([reponame]): Database Statistics"
4117 set w [new_console {gc} {Compressing the object database}]
4119 {console_exec {git pack-refs --prune}}
4120 {console_exec {git reflog expire --all}}
4121 {console_exec {git repack -a -d -l}}
4122 {console_exec {git rerere gc}}
4126 proc do_fsck_objects {} {
4127 set w [new_console {fsck-objects} \
4128 {Verifying the object database with fsck-objects}]
4129 set cmd [list git fsck-objects]
4132 lappend cmd --strict
4133 console_exec $w $cmd console_done
4139 global ui_comm is_quitting repo_config commit_type
4141 if {$is_quitting} return
4144 if {[winfo exists $ui_comm]} {
4145 # -- Stash our current commit buffer.
4147 set save [gitdir GITGUI_MSG]
4148 set msg [string trim [$ui_comm get 0.0 end]]
4149 regsub -all -line {[ \r\t]+$} $msg {} msg
4150 if {(![string match amend* $commit_type]
4151 || [$ui_comm edit modified])
4154 set fd [open $save w]
4155 puts -nonewline $fd $msg
4159 catch {file delete $save}
4162 # -- Stash our current window geometry into this repository.
4164 set cfg_geometry [list]
4165 lappend cfg_geometry [wm geometry .]
4166 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4167 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4168 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4171 if {$cfg_geometry ne $rc_geometry} {
4172 catch {git config gui.geometry $cfg_geometry}
4180 rescan {set ui_status_value {Ready.}}
4183 proc unstage_helper {txt paths} {
4184 global file_states current_diff_path
4186 if {![lock_index begin-update]} return
4190 foreach path $paths {
4191 switch -glob -- [lindex $file_states($path) 0] {
4195 lappend pathList $path
4196 if {$path eq $current_diff_path} {
4197 set after {reshow_diff;}
4202 if {$pathList eq {}} {
4208 [concat $after {set ui_status_value {Ready.}}]
4212 proc do_unstage_selection {} {
4213 global current_diff_path selected_paths
4215 if {[array size selected_paths] > 0} {
4217 {Unstaging selected files from commit} \
4218 [array names selected_paths]
4219 } elseif {$current_diff_path ne {}} {
4221 "Unstaging [short_path $current_diff_path] from commit" \
4222 [list $current_diff_path]
4226 proc add_helper {txt paths} {
4227 global file_states current_diff_path
4229 if {![lock_index begin-update]} return
4233 foreach path $paths {
4234 switch -glob -- [lindex $file_states($path) 0] {
4239 lappend pathList $path
4240 if {$path eq $current_diff_path} {
4241 set after {reshow_diff;}
4246 if {$pathList eq {}} {
4252 [concat $after {set ui_status_value {Ready to commit.}}]
4256 proc do_add_selection {} {
4257 global current_diff_path selected_paths
4259 if {[array size selected_paths] > 0} {
4261 {Adding selected files} \
4262 [array names selected_paths]
4263 } elseif {$current_diff_path ne {}} {
4265 "Adding [short_path $current_diff_path]" \
4266 [list $current_diff_path]
4270 proc do_add_all {} {
4274 foreach path [array names file_states] {
4275 switch -glob -- [lindex $file_states($path) 0] {
4278 ?D {lappend paths $path}
4281 add_helper {Adding all changed files} $paths
4284 proc revert_helper {txt paths} {
4285 global file_states current_diff_path
4287 if {![lock_index begin-update]} return
4291 foreach path $paths {
4292 switch -glob -- [lindex $file_states($path) 0] {
4296 lappend pathList $path
4297 if {$path eq $current_diff_path} {
4298 set after {reshow_diff;}
4304 set n [llength $pathList]
4308 } elseif {$n == 1} {
4309 set s "[short_path [lindex $pathList]]"
4311 set s "these $n files"
4314 set reply [tk_dialog \
4316 "[appname] ([reponame])" \
4317 "Revert changes in $s?
4319 Any unadded changes will be permanently lost by the revert." \
4329 [concat $after {set ui_status_value {Ready.}}]
4335 proc do_revert_selection {} {
4336 global current_diff_path selected_paths
4338 if {[array size selected_paths] > 0} {
4340 {Reverting selected files} \
4341 [array names selected_paths]
4342 } elseif {$current_diff_path ne {}} {
4344 "Reverting [short_path $current_diff_path]" \
4345 [list $current_diff_path]
4349 proc do_signoff {} {
4352 set me [committer_ident]
4353 if {$me eq {}} return
4355 set sob "Signed-off-by: $me"
4356 set last [$ui_comm get {end -1c linestart} {end -1c}]
4357 if {$last ne $sob} {
4358 $ui_comm edit separator
4360 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4361 $ui_comm insert end "\n"
4363 $ui_comm insert end "\n$sob"
4364 $ui_comm edit separator
4369 proc do_select_commit_type {} {
4370 global commit_type selected_commit_type
4372 if {$selected_commit_type eq {new}
4373 && [string match amend* $commit_type]} {
4375 } elseif {$selected_commit_type eq {amend}
4376 && ![string match amend* $commit_type]} {
4379 # The amend request was rejected...
4381 if {![string match amend* $commit_type]} {
4382 set selected_commit_type new
4392 global appvers copyright
4393 global tcl_patchLevel tk_patchLevel
4397 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4399 label $w.header -text "About [appname]" \
4401 pack $w.header -side top -fill x
4404 button $w.buttons.close -text {Close} \
4406 -command [list destroy $w]
4407 pack $w.buttons.close -side right
4408 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4411 -text "[appname] - a commit creation tool for Git.
4419 pack $w.desc -side top -fill x -padx 5 -pady 5
4422 append v "[appname] version $appvers\n"
4423 append v "[git version]\n"
4425 if {$tcl_patchLevel eq $tk_patchLevel} {
4426 append v "Tcl/Tk version $tcl_patchLevel"
4428 append v "Tcl version $tcl_patchLevel"
4429 append v ", Tk version $tk_patchLevel"
4440 pack $w.vers -side top -fill x -padx 5 -pady 5
4442 menu $w.ctxm -tearoff 0
4443 $w.ctxm add command \
4448 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4451 bind $w <Visibility> "grab $w; focus $w"
4452 bind $w <Key-Escape> "destroy $w"
4453 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4454 wm title $w "About [appname]"
4458 proc do_options {} {
4459 global repo_config global_config font_descs
4460 global repo_config_new global_config_new
4462 array unset repo_config_new
4463 array unset global_config_new
4464 foreach name [array names repo_config] {
4465 set repo_config_new($name) $repo_config($name)
4468 foreach name [array names repo_config] {
4470 gui.diffcontext {continue}
4472 set repo_config_new($name) $repo_config($name)
4474 foreach name [array names global_config] {
4475 set global_config_new($name) $global_config($name)
4478 set w .options_editor
4480 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4482 label $w.header -text "[appname] Options" \
4484 pack $w.header -side top -fill x
4487 button $w.buttons.restore -text {Restore Defaults} \
4489 -command do_restore_defaults
4490 pack $w.buttons.restore -side left
4491 button $w.buttons.save -text Save \
4493 -command [list do_save_config $w]
4494 pack $w.buttons.save -side right
4495 button $w.buttons.cancel -text {Cancel} \
4497 -command [list destroy $w]
4498 pack $w.buttons.cancel -side right -padx 5
4499 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4501 labelframe $w.repo -text "[reponame] Repository" \
4503 labelframe $w.global -text {Global (All Repositories)} \
4505 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4506 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4510 {t user.name {User Name}}
4511 {t user.email {Email Address}}
4513 {b merge.summary {Summarize Merge Commits}}
4514 {i-1..5 merge.verbosity {Merge Verbosity}}
4516 {b gui.trustmtime {Trust File Modification Timestamps}}
4517 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4518 {t gui.newbranchtemplate {New Branch Name Template}}
4520 set type [lindex $option 0]
4521 set name [lindex $option 1]
4522 set text [lindex $option 2]
4524 foreach f {repo global} {
4525 switch -glob -- $type {
4527 checkbutton $w.$f.$optid -text $text \
4528 -variable ${f}_config_new($name) \
4532 pack $w.$f.$optid -side top -anchor w
4535 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4537 label $w.$f.$optid.l -text "$text:" -font font_ui
4538 pack $w.$f.$optid.l -side left -anchor w -fill x
4539 spinbox $w.$f.$optid.v \
4540 -textvariable ${f}_config_new($name) \
4544 -width [expr {1 + [string length $max]}] \
4546 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4547 pack $w.$f.$optid.v -side right -anchor e -padx 5
4548 pack $w.$f.$optid -side top -anchor w -fill x
4552 label $w.$f.$optid.l -text "$text:" -font font_ui
4553 entry $w.$f.$optid.v \
4557 -textvariable ${f}_config_new($name) \
4559 pack $w.$f.$optid.l -side left -anchor w
4560 pack $w.$f.$optid.v -side left -anchor w \
4563 pack $w.$f.$optid -side top -anchor w -fill x
4569 set all_fonts [lsort [font families]]
4570 foreach option $font_descs {
4571 set name [lindex $option 0]
4572 set font [lindex $option 1]
4573 set text [lindex $option 2]
4575 set global_config_new(gui.$font^^family) \
4576 [font configure $font -family]
4577 set global_config_new(gui.$font^^size) \
4578 [font configure $font -size]
4580 frame $w.global.$name
4581 label $w.global.$name.l -text "$text:" -font font_ui
4582 pack $w.global.$name.l -side left -anchor w -fill x
4583 eval tk_optionMenu $w.global.$name.family \
4584 global_config_new(gui.$font^^family) \
4586 spinbox $w.global.$name.size \
4587 -textvariable global_config_new(gui.$font^^size) \
4588 -from 2 -to 80 -increment 1 \
4591 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4592 pack $w.global.$name.size -side right -anchor e
4593 pack $w.global.$name.family -side right -anchor e
4594 pack $w.global.$name -side top -anchor w -fill x
4597 bind $w <Visibility> "grab $w; focus $w"
4598 bind $w <Key-Escape> "destroy $w"
4599 wm title $w "[appname] ([reponame]): Options"
4603 proc do_restore_defaults {} {
4604 global font_descs default_config repo_config
4605 global repo_config_new global_config_new
4607 foreach name [array names default_config] {
4608 set repo_config_new($name) $default_config($name)
4609 set global_config_new($name) $default_config($name)
4612 foreach option $font_descs {
4613 set name [lindex $option 0]
4614 set repo_config(gui.$name) $default_config(gui.$name)
4618 foreach option $font_descs {
4619 set name [lindex $option 0]
4620 set font [lindex $option 1]
4621 set global_config_new(gui.$font^^family) \
4622 [font configure $font -family]
4623 set global_config_new(gui.$font^^size) \
4624 [font configure $font -size]
4628 proc do_save_config {w} {
4629 if {[catch {save_config} err]} {
4630 error_popup "Failed to completely save options:\n\n$err"
4636 proc do_windows_shortcut {} {
4639 set fn [tk_getSaveFile \
4641 -title "[appname] ([reponame]): Create Desktop Icon" \
4642 -initialfile "Git [reponame].bat"]
4646 puts $fd "@ECHO Entering [reponame]"
4647 puts $fd "@ECHO Starting git-gui... please wait..."
4648 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4649 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4650 puts -nonewline $fd "@\"[info nameofexecutable]\""
4651 puts $fd " \"[file normalize $argv0]\""
4654 error_popup "Cannot write script:\n\n$err"
4659 proc do_cygwin_shortcut {} {
4663 set desktop [exec cygpath \
4671 set fn [tk_getSaveFile \
4673 -title "[appname] ([reponame]): Create Desktop Icon" \
4674 -initialdir $desktop \
4675 -initialfile "Git [reponame].bat"]
4679 set sh [exec cygpath \
4683 set me [exec cygpath \
4687 set gd [exec cygpath \
4691 set gw [exec cygpath \
4694 [file dirname [gitdir]]]
4695 regsub -all ' $me "'\\''" me
4696 regsub -all ' $gd "'\\''" gd
4697 puts $fd "@ECHO Entering $gw"
4698 puts $fd "@ECHO Starting git-gui... please wait..."
4699 puts -nonewline $fd "@\"$sh\" --login -c \""
4700 puts -nonewline $fd "GIT_DIR='$gd'"
4701 puts -nonewline $fd " '$me'"
4705 error_popup "Cannot write script:\n\n$err"
4710 proc do_macosx_app {} {
4713 set fn [tk_getSaveFile \
4715 -title "[appname] ([reponame]): Create Desktop Icon" \
4716 -initialdir [file join $env(HOME) Desktop] \
4717 -initialfile "Git [reponame].app"]
4720 set Contents [file join $fn Contents]
4721 set MacOS [file join $Contents MacOS]
4722 set exe [file join $MacOS git-gui]
4726 set fd [open [file join $Contents Info.plist] w]
4727 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4728 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4729 <plist version="1.0">
4731 <key>CFBundleDevelopmentRegion</key>
4732 <string>English</string>
4733 <key>CFBundleExecutable</key>
4734 <string>git-gui</string>
4735 <key>CFBundleIdentifier</key>
4736 <string>org.spearce.git-gui</string>
4737 <key>CFBundleInfoDictionaryVersion</key>
4738 <string>6.0</string>
4739 <key>CFBundlePackageType</key>
4740 <string>APPL</string>
4741 <key>CFBundleSignature</key>
4742 <string>????</string>
4743 <key>CFBundleVersion</key>
4744 <string>1.0</string>
4745 <key>NSPrincipalClass</key>
4746 <string>NSApplication</string>
4751 set fd [open $exe w]
4752 set gd [file normalize [gitdir]]
4753 set ep [file normalize [gitexec]]
4754 regsub -all ' $gd "'\\''" gd
4755 regsub -all ' $ep "'\\''" ep
4756 puts $fd "#!/bin/sh"
4757 foreach name [array names env] {
4758 if {[string match GIT_* $name]} {
4759 regsub -all ' $env($name) "'\\''" v
4760 puts $fd "export $name='$v'"
4763 puts $fd "export PATH='$ep':\$PATH"
4764 puts $fd "export GIT_DIR='$gd'"
4765 puts $fd "exec [file normalize $argv0]"
4768 file attributes $exe -permissions u+x,g+x,o+x
4770 error_popup "Cannot write icon:\n\n$err"
4775 proc toggle_or_diff {w x y} {
4776 global file_states file_lists current_diff_path ui_index ui_workdir
4777 global last_clicked selected_paths
4779 set pos [split [$w index @$x,$y] .]
4780 set lno [lindex $pos 0]
4781 set col [lindex $pos 1]
4782 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4788 set last_clicked [list $w $lno]
4789 array unset selected_paths
4790 $ui_index tag remove in_sel 0.0 end
4791 $ui_workdir tag remove in_sel 0.0 end
4794 if {$current_diff_path eq $path} {
4795 set after {reshow_diff;}
4799 if {$w eq $ui_index} {
4801 "Unstaging [short_path $path] from commit" \
4803 [concat $after {set ui_status_value {Ready.}}]
4804 } elseif {$w eq $ui_workdir} {
4806 "Adding [short_path $path]" \
4808 [concat $after {set ui_status_value {Ready.}}]
4811 show_diff $path $w $lno
4815 proc add_one_to_selection {w x y} {
4816 global file_lists last_clicked selected_paths
4818 set lno [lindex [split [$w index @$x,$y] .] 0]
4819 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4825 if {$last_clicked ne {}
4826 && [lindex $last_clicked 0] ne $w} {
4827 array unset selected_paths
4828 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4831 set last_clicked [list $w $lno]
4832 if {[catch {set in_sel $selected_paths($path)}]} {
4836 unset selected_paths($path)
4837 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4839 set selected_paths($path) 1
4840 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4844 proc add_range_to_selection {w x y} {
4845 global file_lists last_clicked selected_paths
4847 if {[lindex $last_clicked 0] ne $w} {
4848 toggle_or_diff $w $x $y
4852 set lno [lindex [split [$w index @$x,$y] .] 0]
4853 set lc [lindex $last_clicked 1]
4862 foreach path [lrange $file_lists($w) \
4863 [expr {$begin - 1}] \
4864 [expr {$end - 1}]] {
4865 set selected_paths($path) 1
4867 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4870 ######################################################################
4874 set cursor_ptr arrow
4875 font create font_diff -family Courier -size 10
4879 eval font configure font_ui [font actual [.dummy cget -font]]
4883 font create font_uibold
4884 font create font_diffbold
4889 } elseif {[is_MacOSX]} {
4897 proc apply_config {} {
4898 global repo_config font_descs
4900 foreach option $font_descs {
4901 set name [lindex $option 0]
4902 set font [lindex $option 1]
4904 foreach {cn cv} $repo_config(gui.$name) {
4905 font configure $font $cn $cv
4908 error_popup "Invalid font specified in gui.$name:\n\n$err"
4910 foreach {cn cv} [font configure $font] {
4911 font configure ${font}bold $cn $cv
4913 font configure ${font}bold -weight bold
4917 set default_config(merge.summary) false
4918 set default_config(merge.verbosity) 2
4919 set default_config(user.name) {}
4920 set default_config(user.email) {}
4922 set default_config(gui.trustmtime) false
4923 set default_config(gui.diffcontext) 5
4924 set default_config(gui.newbranchtemplate) {}
4925 set default_config(gui.fontui) [font configure font_ui]
4926 set default_config(gui.fontdiff) [font configure font_diff]
4928 {fontui font_ui {Main Font}}
4929 {fontdiff font_diff {Diff/Console Font}}
4934 ######################################################################
4936 ## feature option selection
4938 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
4943 if {$subcommand eq {gui.sh}} {
4946 if {$subcommand eq {gui} && [llength $argv] > 0} {
4947 set subcommand [lindex $argv 0]
4948 set argv [lrange $argv 1 end]
4951 enable_option multicommit
4952 enable_option branch
4953 enable_option transport
4955 switch -- $subcommand {
4957 disable_option multicommit
4958 disable_option branch
4959 disable_option transport
4962 enable_option singlecommit
4964 disable_option multicommit
4965 disable_option branch
4966 disable_option transport
4970 ######################################################################
4978 menu .mbar -tearoff 0
4979 .mbar add cascade -label Repository -menu .mbar.repository
4980 .mbar add cascade -label Edit -menu .mbar.edit
4981 if {[is_enabled branch]} {
4982 .mbar add cascade -label Branch -menu .mbar.branch
4984 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
4985 .mbar add cascade -label Commit -menu .mbar.commit
4987 if {[is_enabled transport]} {
4988 .mbar add cascade -label Merge -menu .mbar.merge
4989 .mbar add cascade -label Fetch -menu .mbar.fetch
4990 .mbar add cascade -label Push -menu .mbar.push
4992 . configure -menu .mbar
4994 # -- Repository Menu
4996 menu .mbar.repository
4998 .mbar.repository add command \
4999 -label {Browse Current Branch} \
5000 -command {new_browser $current_branch} \
5002 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5003 .mbar.repository add separator
5005 .mbar.repository add command \
5006 -label {Visualize Current Branch} \
5007 -command {do_gitk $current_branch} \
5009 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5010 .mbar.repository add command \
5011 -label {Visualize All Branches} \
5012 -command {do_gitk --all} \
5014 .mbar.repository add separator
5016 if {[is_enabled multicommit]} {
5017 .mbar.repository add command -label {Database Statistics} \
5021 .mbar.repository add command -label {Compress Database} \
5025 .mbar.repository add command -label {Verify Database} \
5026 -command do_fsck_objects \
5029 .mbar.repository add separator
5032 .mbar.repository add command \
5033 -label {Create Desktop Icon} \
5034 -command do_cygwin_shortcut \
5036 } elseif {[is_Windows]} {
5037 .mbar.repository add command \
5038 -label {Create Desktop Icon} \
5039 -command do_windows_shortcut \
5041 } elseif {[is_MacOSX]} {
5042 .mbar.repository add command \
5043 -label {Create Desktop Icon} \
5044 -command do_macosx_app \
5049 .mbar.repository add command -label Quit \
5051 -accelerator $M1T-Q \
5057 .mbar.edit add command -label Undo \
5058 -command {catch {[focus] edit undo}} \
5059 -accelerator $M1T-Z \
5061 .mbar.edit add command -label Redo \
5062 -command {catch {[focus] edit redo}} \
5063 -accelerator $M1T-Y \
5065 .mbar.edit add separator
5066 .mbar.edit add command -label Cut \
5067 -command {catch {tk_textCut [focus]}} \
5068 -accelerator $M1T-X \
5070 .mbar.edit add command -label Copy \
5071 -command {catch {tk_textCopy [focus]}} \
5072 -accelerator $M1T-C \
5074 .mbar.edit add command -label Paste \
5075 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5076 -accelerator $M1T-V \
5078 .mbar.edit add command -label Delete \
5079 -command {catch {[focus] delete sel.first sel.last}} \
5082 .mbar.edit add separator
5083 .mbar.edit add command -label {Select All} \
5084 -command {catch {[focus] tag add sel 0.0 end}} \
5085 -accelerator $M1T-A \
5090 if {[is_enabled branch]} {
5093 .mbar.branch add command -label {Create...} \
5094 -command do_create_branch \
5095 -accelerator $M1T-N \
5097 lappend disable_on_lock [list .mbar.branch entryconf \
5098 [.mbar.branch index last] -state]
5100 .mbar.branch add command -label {Delete...} \
5101 -command do_delete_branch \
5103 lappend disable_on_lock [list .mbar.branch entryconf \
5104 [.mbar.branch index last] -state]
5109 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5112 .mbar.commit add radiobutton \
5113 -label {New Commit} \
5114 -command do_select_commit_type \
5115 -variable selected_commit_type \
5118 lappend disable_on_lock \
5119 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5121 .mbar.commit add radiobutton \
5122 -label {Amend Last Commit} \
5123 -command do_select_commit_type \
5124 -variable selected_commit_type \
5127 lappend disable_on_lock \
5128 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5130 .mbar.commit add separator
5132 .mbar.commit add command -label Rescan \
5133 -command do_rescan \
5136 lappend disable_on_lock \
5137 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5139 .mbar.commit add command -label {Add To Commit} \
5140 -command do_add_selection \
5142 lappend disable_on_lock \
5143 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5145 .mbar.commit add command -label {Add Existing To Commit} \
5146 -command do_add_all \
5147 -accelerator $M1T-I \
5149 lappend disable_on_lock \
5150 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5152 .mbar.commit add command -label {Unstage From Commit} \
5153 -command do_unstage_selection \
5155 lappend disable_on_lock \
5156 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5158 .mbar.commit add command -label {Revert Changes} \
5159 -command do_revert_selection \
5161 lappend disable_on_lock \
5162 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5164 .mbar.commit add separator
5166 .mbar.commit add command -label {Sign Off} \
5167 -command do_signoff \
5168 -accelerator $M1T-S \
5171 .mbar.commit add command -label Commit \
5172 -command do_commit \
5173 -accelerator $M1T-Return \
5175 lappend disable_on_lock \
5176 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5180 # -- Apple Menu (Mac OS X only)
5182 .mbar add cascade -label Apple -menu .mbar.apple
5185 .mbar.apple add command -label "About [appname]" \
5188 .mbar.apple add command -label "[appname] Options..." \
5189 -command do_options \
5194 .mbar.edit add separator
5195 .mbar.edit add command -label {Options...} \
5196 -command do_options \
5201 if {[file exists /usr/local/miga/lib/gui-miga]
5202 && [file exists .pvcsrc]} {
5204 global ui_status_value
5205 if {![lock_index update]} return
5206 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5207 set miga_fd [open "|$cmd" r]
5208 fconfigure $miga_fd -blocking 0
5209 fileevent $miga_fd readable [list miga_done $miga_fd]
5210 set ui_status_value {Running miga...}
5212 proc miga_done {fd} {
5217 rescan [list set ui_status_value {Ready.}]
5220 .mbar add cascade -label Tools -menu .mbar.tools
5222 .mbar.tools add command -label "Migrate" \
5225 lappend disable_on_lock \
5226 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5232 .mbar add cascade -label Help -menu .mbar.help
5236 .mbar.help add command -label "About [appname]" \
5242 catch {set browser $repo_config(instaweb.browser)}
5243 set doc_path [file dirname [gitexec]]
5244 set doc_path [file join $doc_path Documentation index.html]
5247 set doc_path [exec cygpath --windows $doc_path]
5250 if {$browser eq {}} {
5253 } elseif {[is_Cygwin]} {
5254 set program_files [file dirname [exec cygpath --windir]]
5255 set program_files [file join $program_files {Program Files}]
5256 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5257 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5258 if {[file exists $firefox]} {
5259 set browser $firefox
5260 } elseif {[file exists $ie]} {
5263 unset program_files firefox ie
5267 if {[file isfile $doc_path]} {
5268 set doc_url "file:$doc_path"
5270 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5273 if {$browser ne {}} {
5274 .mbar.help add command -label {Online Documentation} \
5275 -command [list exec $browser $doc_url &] \
5278 unset browser doc_path doc_url
5280 # -- Standard bindings
5282 bind . <Destroy> do_quit
5283 bind all <$M1B-Key-q> do_quit
5284 bind all <$M1B-Key-Q> do_quit
5285 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5286 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5288 # -- Not a normal commit type invocation? Do that instead!
5290 switch -- $subcommand {
5292 if {[llength $argv] != 2} {
5293 puts stderr "usage: $argv0 blame commit path"
5296 set current_branch [lindex $argv 0]
5297 show_blame $current_branch [lindex $argv 1]
5302 if {[llength $argv] != 0} {
5303 puts -nonewline stderr "usage: $argv0"
5304 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5305 puts -nonewline stderr " $subcommand"
5310 # fall through to setup UI for commits
5313 puts stderr "usage: $argv0 \[{blame|citool}\]"
5324 -text {Current Branch:} \
5329 -textvariable current_branch \
5333 pack .branch.l1 -side left
5334 pack .branch.cb -side left -fill x
5335 pack .branch -side top -fill x
5337 if {[is_enabled branch]} {
5339 .mbar.merge add command -label {Local Merge...} \
5340 -command do_local_merge \
5342 lappend disable_on_lock \
5343 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5344 .mbar.merge add command -label {Abort Merge...} \
5345 -command do_reset_hard \
5347 lappend disable_on_lock \
5348 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5354 .mbar.push add command -label {Push...} \
5355 -command do_push_anywhere \
5359 # -- Main Window Layout
5361 panedwindow .vpane -orient vertical
5362 panedwindow .vpane.files -orient horizontal
5363 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5364 pack .vpane -anchor n -side top -fill both -expand 1
5366 # -- Index File List
5368 frame .vpane.files.index -height 100 -width 200
5369 label .vpane.files.index.title -text {Changes To Be Committed} \
5372 text $ui_index -background white -borderwidth 0 \
5373 -width 20 -height 10 \
5376 -cursor $cursor_ptr \
5377 -xscrollcommand {.vpane.files.index.sx set} \
5378 -yscrollcommand {.vpane.files.index.sy set} \
5380 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5381 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5382 pack .vpane.files.index.title -side top -fill x
5383 pack .vpane.files.index.sx -side bottom -fill x
5384 pack .vpane.files.index.sy -side right -fill y
5385 pack $ui_index -side left -fill both -expand 1
5386 .vpane.files add .vpane.files.index -sticky nsew
5388 # -- Working Directory File List
5390 frame .vpane.files.workdir -height 100 -width 200
5391 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5394 text $ui_workdir -background white -borderwidth 0 \
5395 -width 20 -height 10 \
5398 -cursor $cursor_ptr \
5399 -xscrollcommand {.vpane.files.workdir.sx set} \
5400 -yscrollcommand {.vpane.files.workdir.sy set} \
5402 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5403 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5404 pack .vpane.files.workdir.title -side top -fill x
5405 pack .vpane.files.workdir.sx -side bottom -fill x
5406 pack .vpane.files.workdir.sy -side right -fill y
5407 pack $ui_workdir -side left -fill both -expand 1
5408 .vpane.files add .vpane.files.workdir -sticky nsew
5410 foreach i [list $ui_index $ui_workdir] {
5411 $i tag conf in_diff -font font_uibold
5412 $i tag conf in_sel \
5413 -background [$i cget -foreground] \
5414 -foreground [$i cget -background]
5418 # -- Diff and Commit Area
5420 frame .vpane.lower -height 300 -width 400
5421 frame .vpane.lower.commarea
5422 frame .vpane.lower.diff -relief sunken -borderwidth 1
5423 pack .vpane.lower.commarea -side top -fill x
5424 pack .vpane.lower.diff -side bottom -fill both -expand 1
5425 .vpane add .vpane.lower -sticky nsew
5427 # -- Commit Area Buttons
5429 frame .vpane.lower.commarea.buttons
5430 label .vpane.lower.commarea.buttons.l -text {} \
5434 pack .vpane.lower.commarea.buttons.l -side top -fill x
5435 pack .vpane.lower.commarea.buttons -side left -fill y
5437 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5438 -command do_rescan \
5440 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5441 lappend disable_on_lock \
5442 {.vpane.lower.commarea.buttons.rescan conf -state}
5444 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5445 -command do_add_all \
5447 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5448 lappend disable_on_lock \
5449 {.vpane.lower.commarea.buttons.incall conf -state}
5451 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5452 -command do_signoff \
5454 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5456 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5457 -command do_commit \
5459 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5460 lappend disable_on_lock \
5461 {.vpane.lower.commarea.buttons.commit conf -state}
5463 # -- Commit Message Buffer
5465 frame .vpane.lower.commarea.buffer
5466 frame .vpane.lower.commarea.buffer.header
5467 set ui_comm .vpane.lower.commarea.buffer.t
5468 set ui_coml .vpane.lower.commarea.buffer.header.l
5469 radiobutton .vpane.lower.commarea.buffer.header.new \
5470 -text {New Commit} \
5471 -command do_select_commit_type \
5472 -variable selected_commit_type \
5475 lappend disable_on_lock \
5476 [list .vpane.lower.commarea.buffer.header.new conf -state]
5477 radiobutton .vpane.lower.commarea.buffer.header.amend \
5478 -text {Amend Last Commit} \
5479 -command do_select_commit_type \
5480 -variable selected_commit_type \
5483 lappend disable_on_lock \
5484 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5489 proc trace_commit_type {varname args} {
5490 global ui_coml commit_type
5491 switch -glob -- $commit_type {
5492 initial {set txt {Initial Commit Message:}}
5493 amend {set txt {Amended Commit Message:}}
5494 amend-initial {set txt {Amended Initial Commit Message:}}
5495 amend-merge {set txt {Amended Merge Commit Message:}}
5496 merge {set txt {Merge Commit Message:}}
5497 * {set txt {Commit Message:}}
5499 $ui_coml conf -text $txt
5501 trace add variable commit_type write trace_commit_type
5502 pack $ui_coml -side left -fill x
5503 pack .vpane.lower.commarea.buffer.header.amend -side right
5504 pack .vpane.lower.commarea.buffer.header.new -side right
5506 text $ui_comm -background white -borderwidth 1 \
5509 -autoseparators true \
5511 -width 75 -height 9 -wrap none \
5513 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5514 scrollbar .vpane.lower.commarea.buffer.sby \
5515 -command [list $ui_comm yview]
5516 pack .vpane.lower.commarea.buffer.header -side top -fill x
5517 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5518 pack $ui_comm -side left -fill y
5519 pack .vpane.lower.commarea.buffer -side left -fill y
5521 # -- Commit Message Buffer Context Menu
5523 set ctxm .vpane.lower.commarea.buffer.ctxm
5524 menu $ctxm -tearoff 0
5528 -command {tk_textCut $ui_comm}
5532 -command {tk_textCopy $ui_comm}
5536 -command {tk_textPaste $ui_comm}
5540 -command {$ui_comm delete sel.first sel.last}
5543 -label {Select All} \
5545 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5550 $ui_comm tag add sel 0.0 end
5551 tk_textCopy $ui_comm
5552 $ui_comm tag remove sel 0.0 end
5559 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5563 set current_diff_path {}
5564 set current_diff_side {}
5565 set diff_actions [list]
5566 proc trace_current_diff_path {varname args} {
5567 global current_diff_path diff_actions file_states
5568 if {$current_diff_path eq {}} {
5574 set p $current_diff_path
5575 set s [mapdesc [lindex $file_states($p) 0] $p]
5577 set p [escape_path $p]
5581 .vpane.lower.diff.header.status configure -text $s
5582 .vpane.lower.diff.header.file configure -text $f
5583 .vpane.lower.diff.header.path configure -text $p
5584 foreach w $diff_actions {
5588 trace add variable current_diff_path write trace_current_diff_path
5590 frame .vpane.lower.diff.header -background orange
5591 label .vpane.lower.diff.header.status \
5592 -background orange \
5593 -width $max_status_desc \
5597 label .vpane.lower.diff.header.file \
5598 -background orange \
5602 label .vpane.lower.diff.header.path \
5603 -background orange \
5607 pack .vpane.lower.diff.header.status -side left
5608 pack .vpane.lower.diff.header.file -side left
5609 pack .vpane.lower.diff.header.path -fill x
5610 set ctxm .vpane.lower.diff.header.ctxm
5611 menu $ctxm -tearoff 0
5620 -- $current_diff_path
5622 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5623 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5627 frame .vpane.lower.diff.body
5628 set ui_diff .vpane.lower.diff.body.t
5629 text $ui_diff -background white -borderwidth 0 \
5630 -width 80 -height 15 -wrap none \
5632 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5633 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5635 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5636 -command [list $ui_diff xview]
5637 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5638 -command [list $ui_diff yview]
5639 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5640 pack .vpane.lower.diff.body.sby -side right -fill y
5641 pack $ui_diff -side left -fill both -expand 1
5642 pack .vpane.lower.diff.header -side top -fill x
5643 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5645 $ui_diff tag conf d_cr -elide true
5646 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5647 $ui_diff tag conf d_+ -foreground {#00a000}
5648 $ui_diff tag conf d_- -foreground red
5650 $ui_diff tag conf d_++ -foreground {#00a000}
5651 $ui_diff tag conf d_-- -foreground red
5652 $ui_diff tag conf d_+s \
5653 -foreground {#00a000} \
5654 -background {#e2effa}
5655 $ui_diff tag conf d_-s \
5657 -background {#e2effa}
5658 $ui_diff tag conf d_s+ \
5659 -foreground {#00a000} \
5661 $ui_diff tag conf d_s- \
5665 $ui_diff tag conf d<<<<<<< \
5666 -foreground orange \
5668 $ui_diff tag conf d======= \
5669 -foreground orange \
5671 $ui_diff tag conf d>>>>>>> \
5672 -foreground orange \
5675 $ui_diff tag raise sel
5677 # -- Diff Body Context Menu
5679 set ctxm .vpane.lower.diff.body.ctxm
5680 menu $ctxm -tearoff 0
5684 -command reshow_diff
5685 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5689 -command {tk_textCopy $ui_diff}
5690 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5692 -label {Select All} \
5694 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5695 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5700 $ui_diff tag add sel 0.0 end
5701 tk_textCopy $ui_diff
5702 $ui_diff tag remove sel 0.0 end
5704 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5707 -label {Apply/Reverse Hunk} \
5709 -command {apply_hunk $cursorX $cursorY}
5710 set ui_diff_applyhunk [$ctxm index last]
5711 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5714 -label {Decrease Font Size} \
5716 -command {incr_font_size font_diff -1}
5717 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5719 -label {Increase Font Size} \
5721 -command {incr_font_size font_diff 1}
5722 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5725 -label {Show Less Context} \
5727 -command {if {$repo_config(gui.diffcontext) >= 2} {
5728 incr repo_config(gui.diffcontext) -1
5731 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5733 -label {Show More Context} \
5736 incr repo_config(gui.diffcontext)
5739 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5741 $ctxm add command -label {Options...} \
5744 bind_button3 $ui_diff "
5747 if {\$ui_index eq \$current_diff_side} {
5748 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5750 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5752 tk_popup $ctxm %X %Y
5754 unset ui_diff_applyhunk
5758 set ui_status_value {Initializing...}
5759 label .status -textvariable ui_status_value \
5765 pack .status -anchor w -side bottom -fill x
5770 set gm $repo_config(gui.geometry)
5771 wm geometry . [lindex $gm 0]
5772 .vpane sash place 0 \
5773 [lindex [.vpane sash coord 0] 0] \
5775 .vpane.files sash place 0 \
5777 [lindex [.vpane.files sash coord 0] 1]
5783 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5784 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5785 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5786 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5787 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5788 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5789 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5790 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5791 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5792 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5793 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5795 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5796 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5797 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5798 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5799 bind $ui_diff <$M1B-Key-v> {break}
5800 bind $ui_diff <$M1B-Key-V> {break}
5801 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5802 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5803 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5804 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5805 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5806 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5807 bind $ui_diff <Button-1> {focus %W}
5809 if {[is_enabled branch]} {
5810 bind . <$M1B-Key-n> do_create_branch
5811 bind . <$M1B-Key-N> do_create_branch
5814 bind all <Key-F5> do_rescan
5815 bind all <$M1B-Key-r> do_rescan
5816 bind all <$M1B-Key-R> do_rescan
5817 bind . <$M1B-Key-s> do_signoff
5818 bind . <$M1B-Key-S> do_signoff
5819 bind . <$M1B-Key-i> do_add_all
5820 bind . <$M1B-Key-I> do_add_all
5821 bind . <$M1B-Key-Return> do_commit
5822 foreach i [list $ui_index $ui_workdir] {
5823 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
5824 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5825 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5829 set file_lists($ui_index) [list]
5830 set file_lists($ui_workdir) [list]
5834 set MERGE_HEAD [list]
5837 set current_branch {}
5838 set current_diff_path {}
5839 set selected_commit_type new
5841 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5842 focus -force $ui_comm
5844 # -- Warn the user about environmental problems. Cygwin's Tcl
5845 # does *not* pass its env array onto any processes it spawns.
5846 # This means that git processes get none of our environment.
5851 set msg "Possible environment issues exist.
5853 The following environment variables are probably
5854 going to be ignored by any Git subprocess run
5858 foreach name [array names env] {
5859 switch -regexp -- $name {
5860 {^GIT_INDEX_FILE$} -
5861 {^GIT_OBJECT_DIRECTORY$} -
5862 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5864 {^GIT_EXTERNAL_DIFF$} -
5868 {^GIT_CONFIG_LOCAL$} -
5869 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5870 append msg " - $name\n"
5873 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5874 append msg " - $name\n"
5876 set suggest_user $name
5880 if {$ignored_env > 0} {
5882 This is due to a known issue with the
5883 Tcl binary distributed by Cygwin."
5885 if {$suggest_user ne {}} {
5888 A good replacement for $suggest_user
5889 is placing values for the user.name and
5890 user.email settings into your personal
5896 unset ignored_env msg suggest_user name
5899 # -- Only initialize complex UI if we are going to stay running.
5901 if {[is_enabled transport]} {
5905 populate_branch_menu
5910 # -- Only suggest a gc run if we are going to stay running.
5912 if {[is_enabled multicommit]} {
5913 set object_limit 2000
5914 if {[is_Windows]} {set object_limit 200}
5915 regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
5916 if {$objects_current >= $object_limit} {
5918 "This repository currently has $objects_current loose objects.
5920 To maintain optimal performance it is strongly
5921 recommended that you compress the database
5922 when more than $object_limit loose objects exist.
5924 Compress the database now?"] eq yes} {
5928 unset object_limit _junk objects_current
5931 lock_index begin-read