1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4set appvers {@@GIT_VERSION@@}
6set copyright {
7Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
8This program is free software; you can redistribute it and/or modify
10it under the terms of the GNU General Public License as published by
11the Free Software Foundation; either version 2 of the License, or
12(at your option) any later version.
13This program is distributed in the hope that it will be useful,
15but WITHOUT ANY WARRANTY; without even the implied warranty of
16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17GNU General Public License for more details.
18You should have received a copy of the GNU General Public License
20along with this program; if not, write to the Free Software
21Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
22######################################################################
24##
25## read only globals
26set _appname [lindex [file split $argv0] end]
28set _gitdir {}
29set _reponame {}
30proc appname {} {
32 global _appname
33 return $_appname
34}
35proc gitdir {args} {
37 global _gitdir
38 if {$args eq {}} {
39 return $_gitdir
40 }
41 return [eval [concat [list file join $_gitdir] $args]]
42}
43proc reponame {} {
45 global _reponame
46 return $_reponame
47}
48######################################################################
50##
51## config
52proc is_many_config {name} {
54 switch -glob -- $name {
55 remote.*.fetch -
56 remote.*.push
57 {return 1}
58 *
59 {return 0}
60 }
61}
62proc load_config {include_global} {
64 global repo_config global_config default_config
65 array unset global_config
67 if {$include_global} {
68 catch {
69 set fd_rc [open "| git repo-config --global --list" r]
70 while {[gets $fd_rc line] >= 0} {
71 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
72 if {[is_many_config $name]} {
73 lappend global_config($name) $value
74 } else {
75 set global_config($name) $value
76 }
77 }
78 }
79 close $fd_rc
80 }
81 }
82 array unset repo_config
84 catch {
85 set fd_rc [open "| git repo-config --list" r]
86 while {[gets $fd_rc line] >= 0} {
87 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
88 if {[is_many_config $name]} {
89 lappend repo_config($name) $value
90 } else {
91 set repo_config($name) $value
92 }
93 }
94 }
95 close $fd_rc
96 }
97 foreach name [array names default_config] {
99 if {[catch {set v $global_config($name)}]} {
100 set global_config($name) $default_config($name)
101 }
102 if {[catch {set v $repo_config($name)}]} {
103 set repo_config($name) $default_config($name)
104 }
105 }
106}
107proc save_config {} {
109 global default_config font_descs
110 global repo_config global_config
111 global repo_config_new global_config_new
112 foreach option $font_descs {
114 set name [lindex $option 0]
115 set font [lindex $option 1]
116 font configure $font \
117 -family $global_config_new(gui.$font^^family) \
118 -size $global_config_new(gui.$font^^size)
119 font configure ${font}bold \
120 -family $global_config_new(gui.$font^^family) \
121 -size $global_config_new(gui.$font^^size)
122 set global_config_new(gui.$name) [font configure $font]
123 unset global_config_new(gui.$font^^family)
124 unset global_config_new(gui.$font^^size)
125 }
126 foreach name [array names default_config] {
128 set value $global_config_new($name)
129 if {$value ne $global_config($name)} {
130 if {$value eq $default_config($name)} {
131 catch {exec git repo-config --global --unset $name}
132 } else {
133 regsub -all "\[{}\]" $value {"} value
134 exec git repo-config --global $name $value
135 }
136 set global_config($name) $value
137 if {$value eq $repo_config($name)} {
138 catch {exec git repo-config --unset $name}
139 set repo_config($name) $value
140 }
141 }
142 }
143 foreach name [array names default_config] {
145 set value $repo_config_new($name)
146 if {$value ne $repo_config($name)} {
147 if {$value eq $global_config($name)} {
148 catch {exec git repo-config --unset $name}
149 } else {
150 regsub -all "\[{}\]" $value {"} value
151 exec git repo-config $name $value
152 }
153 set repo_config($name) $value
154 }
155 }
156}
157proc error_popup {msg} {
159 set title [appname]
160 if {[reponame] ne {}} {
161 append title " ([reponame])"
162 }
163 set cmd [list tk_messageBox \
164 -icon error \
165 -type ok \
166 -title "$title: error" \
167 -message $msg]
168 if {[winfo ismapped .]} {
169 lappend cmd -parent .
170 }
171 eval $cmd
172}
173proc warn_popup {msg} {
175 set title [appname]
176 if {[reponame] ne {}} {
177 append title " ([reponame])"
178 }
179 set cmd [list tk_messageBox \
180 -icon warning \
181 -type ok \
182 -title "$title: warning" \
183 -message $msg]
184 if {[winfo ismapped .]} {
185 lappend cmd -parent .
186 }
187 eval $cmd
188}
189proc info_popup {msg} {
191 set title [appname]
192 if {[reponame] ne {}} {
193 append title " ([reponame])"
194 }
195 tk_messageBox \
196 -parent . \
197 -icon info \
198 -type ok \
199 -title $title \
200 -message $msg
201}
202proc ask_popup {msg} {
204 set title [appname]
205 if {[reponame] ne {}} {
206 append title " ([reponame])"
207 }
208 return [tk_messageBox \
209 -parent . \
210 -icon question \
211 -type yesno \
212 -title $title \
213 -message $msg]
214}
215######################################################################
217##
218## repository setup
219if { [catch {set _gitdir $env(GIT_DIR)}]
221 && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
222 catch {wm withdraw .}
223 error_popup "Cannot find the git directory:\n\n$err"
224 exit 1
225}
226if {![file isdirectory $_gitdir]} {
227 catch {wm withdraw .}
228 error_popup "Git directory not found:\n\n$_gitdir"
229 exit 1
230}
231if {[lindex [file split $_gitdir] end] ne {.git}} {
232 catch {wm withdraw .}
233 error_popup "Cannot use funny .git directory:\n\n$gitdir"
234 exit 1
235}
236if {[catch {cd [file dirname $_gitdir]} err]} {
237 catch {wm withdraw .}
238 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
239 exit 1
240}
241set _reponame [lindex [file split \
242 [file normalize [file dirname $_gitdir]]] \
243 end]
244set single_commit 0
246if {[appname] eq {git-citool}} {
247 set single_commit 1
248}
249######################################################################
251##
252## task management
253set rescan_active 0
255set diff_active 0
256set last_clicked {}
257set disable_on_lock [list]
259set index_lock_type none
260proc lock_index {type} {
262 global index_lock_type disable_on_lock
263 if {$index_lock_type eq {none}} {
265 set index_lock_type $type
266 foreach w $disable_on_lock {
267 uplevel #0 $w disabled
268 }
269 return 1
270 } elseif {$index_lock_type eq "begin-$type"} {
271 set index_lock_type $type
272 return 1
273 }
274 return 0
275}
276proc unlock_index {} {
278 global index_lock_type disable_on_lock
279 set index_lock_type none
281 foreach w $disable_on_lock {
282 uplevel #0 $w normal
283 }
284}
285######################################################################
287##
288## status
289proc repository_state {ctvar hdvar mhvar} {
291 global current_branch
292 upvar $ctvar ct $hdvar hd $mhvar mh
293 set mh [list]
295 if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
297 set current_branch {}
298 } else {
299 regsub ^refs/((heads|tags|remotes)/)? \
300 $current_branch \
301 {} \
302 current_branch
303 }
304 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
306 set hd {}
307 set ct initial
308 return
309 }
310 set merge_head [gitdir MERGE_HEAD]
312 if {[file exists $merge_head]} {
313 set ct merge
314 set fd_mh [open $merge_head r]
315 while {[gets $fd_mh line] >= 0} {
316 lappend mh $line
317 }
318 close $fd_mh
319 return
320 }
321 set ct normal
323}
324proc PARENT {} {
326 global PARENT empty_tree
327 set p [lindex $PARENT 0]
329 if {$p ne {}} {
330 return $p
331 }
332 if {$empty_tree eq {}} {
333 set empty_tree [exec git mktree << {}]
334 }
335 return $empty_tree
336}
337proc rescan {after {honor_trustmtime 1}} {
339 global HEAD PARENT MERGE_HEAD commit_type
340 global ui_index ui_workdir ui_status_value ui_comm
341 global rescan_active file_states
342 global repo_config
343 if {$rescan_active > 0 || ![lock_index read]} return
345 repository_state newType newHEAD newMERGE_HEAD
347 if {[string match amend* $commit_type]
348 && $newType eq {normal}
349 && $newHEAD eq $HEAD} {
350 } else {
351 set HEAD $newHEAD
352 set PARENT $newHEAD
353 set MERGE_HEAD $newMERGE_HEAD
354 set commit_type $newType
355 }
356 array unset file_states
358 if {![$ui_comm edit modified]
360 || [string trim [$ui_comm get 0.0 end]] eq {}} {
361 if {[load_message GITGUI_MSG]} {
362 } elseif {[load_message MERGE_MSG]} {
363 } elseif {[load_message SQUASH_MSG]} {
364 }
365 $ui_comm edit reset
366 $ui_comm edit modified false
367 }
368 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
370 rescan_stage2 {} $after
371 } else {
372 set rescan_active 1
373 set ui_status_value {Refreshing file status...}
374 set cmd [list git update-index]
375 lappend cmd -q
376 lappend cmd --unmerged
377 lappend cmd --ignore-missing
378 lappend cmd --refresh
379 set fd_rf [open "| $cmd" r]
380 fconfigure $fd_rf -blocking 0 -translation binary
381 fileevent $fd_rf readable \
382 [list rescan_stage2 $fd_rf $after]
383 }
384}
385proc rescan_stage2 {fd after} {
387 global ui_status_value
388 global rescan_active buf_rdi buf_rdf buf_rlo
389 if {$fd ne {}} {
391 read $fd
392 if {![eof $fd]} return
393 close $fd
394 }
395 set ls_others [list | git ls-files --others -z \
397 --exclude-per-directory=.gitignore]
398 set info_exclude [gitdir info exclude]
399 if {[file readable $info_exclude]} {
400 lappend ls_others "--exclude-from=$info_exclude"
401 }
402 set buf_rdi {}
404 set buf_rdf {}
405 set buf_rlo {}
406 set rescan_active 3
408 set ui_status_value {Scanning for modified files ...}
409 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
410 set fd_df [open "| git diff-files -z" r]
411 set fd_lo [open $ls_others r]
412 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
414 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
415 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
416 fileevent $fd_di readable [list read_diff_index $fd_di $after]
417 fileevent $fd_df readable [list read_diff_files $fd_df $after]
418 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
419}
420proc load_message {file} {
422 global ui_comm
423 set f [gitdir $file]
425 if {[file isfile $f]} {
426 if {[catch {set fd [open $f r]}]} {
427 return 0
428 }
429 set content [string trim [read $fd]]
430 close $fd
431 regsub -all -line {[ \r\t]+$} $content {} content
432 $ui_comm delete 0.0 end
433 $ui_comm insert end $content
434 return 1
435 }
436 return 0
437}
438proc read_diff_index {fd after} {
440 global buf_rdi
441 append buf_rdi [read $fd]
443 set c 0
444 set n [string length $buf_rdi]
445 while {$c < $n} {
446 set z1 [string first "\0" $buf_rdi $c]
447 if {$z1 == -1} break
448 incr z1
449 set z2 [string first "\0" $buf_rdi $z1]
450 if {$z2 == -1} break
451 incr c
453 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
454 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
455 merge_state \
456 [encoding convertfrom $p] \
457 [lindex $i 4]? \
458 [list [lindex $i 0] [lindex $i 2]] \
459 [list]
460 set c $z2
461 incr c
462 }
463 if {$c < $n} {
464 set buf_rdi [string range $buf_rdi $c end]
465 } else {
466 set buf_rdi {}
467 }
468 rescan_done $fd buf_rdi $after
470}
471proc read_diff_files {fd after} {
473 global buf_rdf
474 append buf_rdf [read $fd]
476 set c 0
477 set n [string length $buf_rdf]
478 while {$c < $n} {
479 set z1 [string first "\0" $buf_rdf $c]
480 if {$z1 == -1} break
481 incr z1
482 set z2 [string first "\0" $buf_rdf $z1]
483 if {$z2 == -1} break
484 incr c
486 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
487 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
488 merge_state \
489 [encoding convertfrom $p] \
490 ?[lindex $i 4] \
491 [list] \
492 [list [lindex $i 0] [lindex $i 2]]
493 set c $z2
494 incr c
495 }
496 if {$c < $n} {
497 set buf_rdf [string range $buf_rdf $c end]
498 } else {
499 set buf_rdf {}
500 }
501 rescan_done $fd buf_rdf $after
503}
504proc read_ls_others {fd after} {
506 global buf_rlo
507 append buf_rlo [read $fd]
509 set pck [split $buf_rlo "\0"]
510 set buf_rlo [lindex $pck end]
511 foreach p [lrange $pck 0 end-1] {
512 merge_state [encoding convertfrom $p] ?O
513 }
514 rescan_done $fd buf_rlo $after
515}
516proc rescan_done {fd buf after} {
518 global rescan_active
519 global file_states repo_config
520 upvar $buf to_clear
521 if {![eof $fd]} return
523 set to_clear {}
524 close $fd
525 if {[incr rescan_active -1] > 0} return
526 prune_selection
528 unlock_index
529 display_all_files
530 reshow_diff
531 uplevel #0 $after
532}
533proc prune_selection {} {
535 global file_states selected_paths
536 foreach path [array names selected_paths] {
538 if {[catch {set still_here $file_states($path)}]} {
539 unset selected_paths($path)
540 }
541 }
542}
543######################################################################
545##
546## diff
547proc clear_diff {} {
549 global ui_diff current_diff_path current_diff_header
550 global ui_index ui_workdir
551 $ui_diff conf -state normal
553 $ui_diff delete 0.0 end
554 $ui_diff conf -state disabled
555 set current_diff_path {}
557 set current_diff_header {}
558 $ui_index tag remove in_diff 0.0 end
560 $ui_workdir tag remove in_diff 0.0 end
561}
562proc reshow_diff {} {
564 global ui_status_value file_states file_lists
565 global current_diff_path current_diff_side
566 set p $current_diff_path
568 if {$p eq {}
569 || $current_diff_side eq {}
570 || [catch {set s $file_states($p)}]
571 || [lsearch -sorted $file_lists($current_diff_side) $p] == -1} {
572 clear_diff
573 } else {
574 show_diff $p $current_diff_side
575 }
576}
577proc handle_empty_diff {} {
579 global current_diff_path file_states file_lists
580 set path $current_diff_path
582 set s $file_states($path)
583 if {[lindex $s 0] ne {_M}} return
584 info_popup "No differences detected.
586[short_path $path] has no changes.
588The modification date of this file was updated
590by another application, but the content within
591the file was not changed.
592A rescan will be automatically started to find
594other files which may have the same state."
595 clear_diff
597 display_file $path __
598 rescan {set ui_status_value {Ready.}} 0
599}
600proc show_diff {path w {lno {}}} {
602 global file_states file_lists
603 global is_3way_diff diff_active repo_config
604 global ui_diff ui_status_value ui_index ui_workdir
605 global current_diff_path current_diff_side current_diff_header
606 if {$diff_active || ![lock_index read]} return
608 clear_diff
610 if {$w eq {} || $lno == {}} {
611 foreach w [array names file_lists] {
612 set lno [lsearch -sorted $file_lists($w) $path]
613 if {$lno >= 0} {
614 incr lno
615 break
616 }
617 }
618 }
619 if {$w ne {} && $lno >= 1} {
620 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
621 }
622 set s $file_states($path)
624 set m [lindex $s 0]
625 set is_3way_diff 0
626 set diff_active 1
627 set current_diff_path $path
628 set current_diff_side $w
629 set current_diff_header {}
630 set ui_status_value "Loading diff of [escape_path $path]..."
631 # - Git won't give us the diff, there's nothing to compare to!
633 #
634 if {$m eq {_O}} {
635 set max_sz [expr {128 * 1024}]
636 if {[catch {
637 set fd [open $path r]
638 set content [read $fd $max_sz]
639 close $fd
640 set sz [file size $path]
641 } err ]} {
642 set diff_active 0
643 unlock_index
644 set ui_status_value "Unable to display [escape_path $path]"
645 error_popup "Error loading file:\n\n$err"
646 return
647 }
648 $ui_diff conf -state normal
649 if {![catch {set type [exec file $path]}]} {
650 set n [string length $path]
651 if {[string equal -length $n $path $type]} {
652 set type [string range $type $n end]
653 regsub {^:?\s*} $type {} type
654 }
655 $ui_diff insert end "* $type\n" d_@
656 }
657 if {[string first "\0" $content] != -1} {
658 $ui_diff insert end \
659 "* Binary file (not showing content)." \
660 d_@
661 } else {
662 if {$sz > $max_sz} {
663 $ui_diff insert end \
664"* Untracked file is $sz bytes.
665* Showing only first $max_sz bytes.
666" d_@
667 }
668 $ui_diff insert end $content
669 if {$sz > $max_sz} {
670 $ui_diff insert end "
671* Untracked file clipped here by [appname].
672* To see the entire file, use an external editor.
673" d_@
674 }
675 }
676 $ui_diff conf -state disabled
677 set diff_active 0
678 unlock_index
679 set ui_status_value {Ready.}
680 return
681 }
682 set cmd [list | git]
684 if {$w eq $ui_index} {
685 lappend cmd diff-index
686 lappend cmd --cached
687 } elseif {$w eq $ui_workdir} {
688 if {[string index $m 0] eq {U}} {
689 lappend cmd diff
690 } else {
691 lappend cmd diff-files
692 }
693 }
694 lappend cmd -p
696 lappend cmd --no-color
697 if {$repo_config(gui.diffcontext) > 0} {
698 lappend cmd "-U$repo_config(gui.diffcontext)"
699 }
700 if {$w eq $ui_index} {
701 lappend cmd [PARENT]
702 }
703 lappend cmd --
704 lappend cmd $path
705 if {[catch {set fd [open $cmd r]} err]} {
707 set diff_active 0
708 unlock_index
709 set ui_status_value "Unable to display [escape_path $path]"
710 error_popup "Error loading diff:\n\n$err"
711 return
712 }
713 fconfigure $fd \
715 -blocking 0 \
716 -encoding binary \
717 -translation binary
718 fileevent $fd readable [list read_diff $fd]
719}
720proc read_diff {fd} {
722 global ui_diff ui_status_value diff_active
723 global is_3way_diff current_diff_header
724 $ui_diff conf -state normal
726 while {[gets $fd line] >= 0} {
727 # -- Cleanup uninteresting diff header lines.
728 #
729 if { [string match {diff --git *} $line]
730 || [string match {diff --cc *} $line]
731 || [string match {diff --combined *} $line]
732 || [string match {--- *} $line]
733 || [string match {+++ *} $line]} {
734 append current_diff_header $line "\n"
735 continue
736 }
737 if {[string match {index *} $line]} continue
738 if {$line eq {deleted file mode 120000}} {
739 set line "deleted symlink"
740 }
741 # -- Automatically detect if this is a 3 way diff.
743 #
744 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
745 if {[string match {mode *} $line]
747 || [string match {new file *} $line]
748 || [string match {deleted file *} $line]
749 || [string match {Binary files * and * differ} $line]
750 || $line eq {\ No newline at end of file}
751 || [regexp {^\* Unmerged path } $line]} {
752 set tags {}
753 } elseif {$is_3way_diff} {
754 set op [string range $line 0 1]
755 switch -- $op {
756 { } {set tags {}}
757 {@@} {set tags d_@}
758 { +} {set tags d_s+}
759 { -} {set tags d_s-}
760 {+ } {set tags d_+s}
761 {- } {set tags d_-s}
762 {--} {set tags d_--}
763 {++} {
764 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
765 set line [string replace $line 0 1 { }]
766 set tags d$op
767 } else {
768 set tags d_++
769 }
770 }
771 default {
772 puts "error: Unhandled 3 way diff marker: {$op}"
773 set tags {}
774 }
775 }
776 } else {
777 set op [string index $line 0]
778 switch -- $op {
779 { } {set tags {}}
780 {@} {set tags d_@}
781 {-} {set tags d_-}
782 {+} {
783 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
784 set line [string replace $line 0 0 { }]
785 set tags d$op
786 } else {
787 set tags d_+
788 }
789 }
790 default {
791 puts "error: Unhandled 2 way diff marker: {$op}"
792 set tags {}
793 }
794 }
795 }
796 $ui_diff insert end $line $tags
797 if {[string index $line end] eq "\r"} {
798 $ui_diff tag add d_cr {end - 2c}
799 }
800 $ui_diff insert end "\n" $tags
801 }
802 $ui_diff conf -state disabled
803 if {[eof $fd]} {
805 close $fd
806 set diff_active 0
807 unlock_index
808 set ui_status_value {Ready.}
809 if {[$ui_diff index end] eq {2.0}} {
811 handle_empty_diff
812 }
813 }
814}
815proc apply_hunk {x y} {
817 global current_diff_path current_diff_header current_diff_side
818 global ui_diff ui_index file_states
819 if {$current_diff_path eq {} || $current_diff_header eq {}} return
821 if {![lock_index apply_hunk]} return
822 set apply_cmd {git apply --cached --whitespace=nowarn}
824 set mi [lindex $file_states($current_diff_path) 0]
825 if {$current_diff_side eq $ui_index} {
826 set mode unstage
827 lappend apply_cmd --reverse
828 if {[string index $mi 0] ne {M}} {
829 unlock_index
830 return
831 }
832 } else {
833 set mode stage
834 if {[string index $mi 1] ne {M}} {
835 unlock_index
836 return
837 }
838 }
839 set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
841 set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
842 if {$s_lno eq {}} {
843 unlock_index
844 return
845 }
846 set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
848 if {$e_lno eq {}} {
849 set e_lno end
850 }
851 if {[catch {
853 set p [open "| $apply_cmd" w]
854 fconfigure $p -translation binary -encoding binary
855 puts -nonewline $p $current_diff_header
856 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
857 close $p} err]} {
858 error_popup "Failed to $mode selected hunk.\n\n$err"
859 unlock_index
860 return
861 }
862 $ui_diff conf -state normal
864 $ui_diff delete $s_lno $e_lno
865 $ui_diff conf -state disabled
866 if {[$ui_diff get 1.0 end] eq "\n"} {
868 set o _
869 } else {
870 set o ?
871 }
872 if {$current_diff_side eq $ui_index} {
874 set mi ${o}M
875 } elseif {[string index $mi 0] eq {_}} {
876 set mi M$o
877 } else {
878 set mi ?$o
879 }
880 unlock_index
881 display_file $current_diff_path $mi
882 if {$o eq {_}} {
883 clear_diff
884 }
885}
886######################################################################
888##
889## commit
890proc load_last_commit {} {
892 global HEAD PARENT MERGE_HEAD commit_type ui_comm
893 global repo_config
894 if {[llength $PARENT] == 0} {
896 error_popup {There is nothing to amend.
897You are about to create the initial commit.
899There is no commit before this to amend.
900}
901 return
902 }
903 repository_state curType curHEAD curMERGE_HEAD
905 if {$curType eq {merge}} {
906 error_popup {Cannot amend while merging.
907You are currently in the middle of a merge that
909has not been fully completed. You cannot amend
910the prior commit unless you first abort the
911current merge activity.
912}
913 return
914 }
915 set msg {}
917 set parents [list]
918 if {[catch {
919 set fd [open "| git cat-file commit $curHEAD" r]
920 fconfigure $fd -encoding binary -translation lf
921 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
922 set enc utf-8
923 }
924 while {[gets $fd line] > 0} {
925 if {[string match {parent *} $line]} {
926 lappend parents [string range $line 7 end]
927 } elseif {[string match {encoding *} $line]} {
928 set enc [string tolower [string range $line 9 end]]
929 }
930 }
931 fconfigure $fd -encoding $enc
932 set msg [string trim [read $fd]]
933 close $fd
934 } err]} {
935 error_popup "Error loading commit data for amend:\n\n$err"
936 return
937 }
938 set HEAD $curHEAD
940 set PARENT $parents
941 set MERGE_HEAD [list]
942 switch -- [llength $parents] {
943 0 {set commit_type amend-initial}
944 1 {set commit_type amend}
945 default {set commit_type amend-merge}
946 }
947 $ui_comm delete 0.0 end
949 $ui_comm insert end $msg
950 $ui_comm edit reset
951 $ui_comm edit modified false
952 rescan {set ui_status_value {Ready.}}
953}
954proc create_new_commit {} {
956 global commit_type ui_comm
957 set commit_type normal
959 $ui_comm delete 0.0 end
960 $ui_comm edit reset
961 $ui_comm edit modified false
962 rescan {set ui_status_value {Ready.}}
963}
964set GIT_COMMITTER_IDENT {}
966proc committer_ident {} {
968 global GIT_COMMITTER_IDENT
969 if {$GIT_COMMITTER_IDENT eq {}} {
971 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
972 error_popup "Unable to obtain your identity:\n\n$err"
973 return {}
974 }
975 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
976 $me me GIT_COMMITTER_IDENT]} {
977 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
978 return {}
979 }
980 }
981 return $GIT_COMMITTER_IDENT
983}
984proc commit_tree {} {
986 global HEAD commit_type file_states ui_comm repo_config
987 global ui_status_value pch_error
988 if {![lock_index update]} return
990 if {[committer_ident] eq {}} return
991 # -- Our in memory state should match the repository.
993 #
994 repository_state curType curHEAD curMERGE_HEAD
995 if {[string match amend* $commit_type]
996 && $curType eq {normal}
997 && $curHEAD eq $HEAD} {
998 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
999 info_popup {Last scanned state does not match repository state.
1000Another Git program has modified this repository
1002since the last scan. A rescan must be performed
1003before another commit can be created.
1004The rescan will be automatically started now.
1006}
1007 unlock_index
1008 rescan {set ui_status_value {Ready.}}
1009 return
1010 }
1011 # -- At least one file should differ in the index.
1013 #
1014 set files_ready 0
1015 foreach path [array names file_states] {
1016 switch -glob -- [lindex $file_states($path) 0] {
1017 _? {continue}
1018 A? -
1019 D? -
1020 M? {set files_ready 1}
1021 U? {
1022 error_popup "Unmerged files cannot be committed.
1023File [short_path $path] has merge conflicts.
1025You must resolve them and add the file before committing.
1026"
1027 unlock_index
1028 return
1029 }
1030 default {
1031 error_popup "Unknown file state [lindex $s 0] detected.
1032File [short_path $path] cannot be committed by this program.
1034"
1035 }
1036 }
1037 }
1038 if {!$files_ready} {
1039 info_popup {No changes to commit.
1040You must add at least 1 file before you can commit.
1042}
1043 unlock_index
1044 return
1045 }
1046 # -- A message is required.
1048 #
1049 set msg [string trim [$ui_comm get 1.0 end]]
1050 regsub -all -line {[ \t\r]+$} $msg {} msg
1051 if {$msg eq {}} {
1052 error_popup {Please supply a commit message.
1053A good commit message has the following format:
1055- First line: Describe in one sentance what you did.
1057- Second line: Blank
1058- Remaining lines: Describe why this change is good.
1059}
1060 unlock_index
1061 return
1062 }
1063 # -- Run the pre-commit hook.
1065 #
1066 set pchook [gitdir hooks pre-commit]
1067 # On Cygwin [file executable] might lie so we need to ask
1069 # the shell if the hook is executable. Yes that's annoying.
1070 #
1071 if {[is_Windows] && [file isfile $pchook]} {
1072 set pchook [list sh -c [concat \
1073 "if test -x \"$pchook\";" \
1074 "then exec \"$pchook\" 2>&1;" \
1075 "fi"]]
1076 } elseif {[file executable $pchook]} {
1077 set pchook [list $pchook |& cat]
1078 } else {
1079 commit_writetree $curHEAD $msg
1080 return
1081 }
1082 set ui_status_value {Calling pre-commit hook...}
1084 set pch_error {}
1085 set fd_ph [open "| $pchook" r]
1086 fconfigure $fd_ph -blocking 0 -translation binary
1087 fileevent $fd_ph readable \
1088 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1089}
1090proc commit_prehook_wait {fd_ph curHEAD msg} {
1092 global pch_error ui_status_value
1093 append pch_error [read $fd_ph]
1095 fconfigure $fd_ph -blocking 1
1096 if {[eof $fd_ph]} {
1097 if {[catch {close $fd_ph}]} {
1098 set ui_status_value {Commit declined by pre-commit hook.}
1099 hook_failed_popup pre-commit $pch_error
1100 unlock_index
1101 } else {
1102 commit_writetree $curHEAD $msg
1103 }
1104 set pch_error {}
1105 return
1106 }
1107 fconfigure $fd_ph -blocking 0
1108}
1109proc commit_writetree {curHEAD msg} {
1111 global ui_status_value
1112 set ui_status_value {Committing changes...}
1114 set fd_wt [open "| git write-tree" r]
1115 fileevent $fd_wt readable \
1116 [list commit_committree $fd_wt $curHEAD $msg]
1117}
1118proc commit_committree {fd_wt curHEAD msg} {
1120 global HEAD PARENT MERGE_HEAD commit_type
1121 global single_commit all_heads current_branch
1122 global ui_status_value ui_comm selected_commit_type
1123 global file_states selected_paths rescan_active
1124 global repo_config
1125 gets $fd_wt tree_id
1127 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1128 error_popup "write-tree failed:\n\n$err"
1129 set ui_status_value {Commit failed.}
1130 unlock_index
1131 return
1132 }
1133 # -- Build the message.
1135 #
1136 set msg_p [gitdir COMMIT_EDITMSG]
1137 set msg_wt [open $msg_p w]
1138 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1139 set enc utf-8
1140 }
1141 fconfigure $msg_wt -encoding $enc -translation binary
1142 puts -nonewline $msg_wt $msg
1143 close $msg_wt
1144 # -- Create the commit.
1146 #
1147 set cmd [list git commit-tree $tree_id]
1148 set parents [concat $PARENT $MERGE_HEAD]
1149 if {[llength $parents] > 0} {
1150 foreach p $parents {
1151 lappend cmd -p $p
1152 }
1153 } else {
1154 # git commit-tree writes to stderr during initial commit.
1155 lappend cmd 2>/dev/null
1156 }
1157 lappend cmd <$msg_p
1158 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1159 error_popup "commit-tree failed:\n\n$err"
1160 set ui_status_value {Commit failed.}
1161 unlock_index
1162 return
1163 }
1164 # -- Update the HEAD ref.
1166 #
1167 set reflogm commit
1168 if {$commit_type ne {normal}} {
1169 append reflogm " ($commit_type)"
1170 }
1171 set i [string first "\n" $msg]
1172 if {$i >= 0} {
1173 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1174 } else {
1175 append reflogm {: } $msg
1176 }
1177 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1178 if {[catch {eval exec $cmd} err]} {
1179 error_popup "update-ref failed:\n\n$err"
1180 set ui_status_value {Commit failed.}
1181 unlock_index
1182 return
1183 }
1184 # -- Make sure our current branch exists.
1186 #
1187 if {$commit_type eq {initial}} {
1188 lappend all_heads $current_branch
1189 set all_heads [lsort -unique $all_heads]
1190 populate_branch_menu
1191 }
1192 # -- Cleanup after ourselves.
1194 #
1195 catch {file delete $msg_p}
1196 catch {file delete [gitdir MERGE_HEAD]}
1197 catch {file delete [gitdir MERGE_MSG]}
1198 catch {file delete [gitdir SQUASH_MSG]}
1199 catch {file delete [gitdir GITGUI_MSG]}
1200 # -- Let rerere do its thing.
1202 #
1203 if {[file isdirectory [gitdir rr-cache]]} {
1204 catch {exec git rerere}
1205 }
1206 # -- Run the post-commit hook.
1208 #
1209 set pchook [gitdir hooks post-commit]
1210 if {[is_Windows] && [file isfile $pchook]} {
1211 set pchook [list sh -c [concat \
1212 "if test -x \"$pchook\";" \
1213 "then exec \"$pchook\";" \
1214 "fi"]]
1215 } elseif {![file executable $pchook]} {
1216 set pchook {}
1217 }
1218 if {$pchook ne {}} {
1219 catch {exec $pchook &}
1220 }
1221 $ui_comm delete 0.0 end
1223 $ui_comm edit reset
1224 $ui_comm edit modified false
1225 if {$single_commit} do_quit
1227 # -- Update in memory status
1229 #
1230 set selected_commit_type new
1231 set commit_type normal
1232 set HEAD $cmt_id
1233 set PARENT $cmt_id
1234 set MERGE_HEAD [list]
1235 foreach path [array names file_states] {
1237 set s $file_states($path)
1238 set m [lindex $s 0]
1239 switch -glob -- $m {
1240 _O -
1241 _M -
1242 _D {continue}
1243 __ -
1244 A_ -
1245 M_ -
1246 D_ {
1247 unset file_states($path)
1248 catch {unset selected_paths($path)}
1249 }
1250 DO {
1251 set file_states($path) [list _O [lindex $s 1] {} {}]
1252 }
1253 AM -
1254 AD -
1255 MM -
1256 MD {
1257 set file_states($path) [list \
1258 _[string index $m 1] \
1259 [lindex $s 1] \
1260 [lindex $s 3] \
1261 {}]
1262 }
1263 }
1264 }
1265 display_all_files
1267 unlock_index
1268 reshow_diff
1269 set ui_status_value \
1270 "Changes committed as [string range $cmt_id 0 7]."
1271}
1272######################################################################
1274##
1275## fetch pull push
1276proc fetch_from {remote} {
1278 set w [new_console "fetch $remote" \
1279 "Fetching new changes from $remote"]
1280 set cmd [list git fetch]
1281 lappend cmd $remote
1282 console_exec $w $cmd
1283}
1284proc pull_remote {remote branch} {
1286 global HEAD commit_type file_states repo_config
1287 if {![lock_index update]} return
1289 # -- Our in memory state should match the repository.
1291 #
1292 repository_state curType curHEAD curMERGE_HEAD
1293 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1294 info_popup {Last scanned state does not match repository state.
1295Another Git program has modified this repository
1297since the last scan. A rescan must be performed
1298before a pull operation can be started.
1299The rescan will be automatically started now.
1301}
1302 unlock_index
1303 rescan {set ui_status_value {Ready.}}
1304 return
1305 }
1306 # -- No differences should exist before a pull.
1308 #
1309 if {[array size file_states] != 0} {
1310 error_popup {Uncommitted but modified files are present.
1311You should not perform a pull with unmodified
1313files in your working directory as Git will be
1314unable to recover from an incorrect merge.
1315You should commit or revert all changes before
1317starting a pull operation.
1318}
1319 unlock_index
1320 return
1321 }
1322 set w [new_console "pull $remote $branch" \
1324 "Pulling new changes from branch $branch in $remote"]
1325 set cmd [list git pull]
1326 if {$repo_config(gui.pullsummary) eq {false}} {
1327 lappend cmd --no-summary
1328 }
1329 lappend cmd $remote
1330 lappend cmd $branch
1331 console_exec $w $cmd [list post_pull_remote $remote $branch]
1332}
1333proc post_pull_remote {remote branch success} {
1335 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1336 global ui_status_value
1337 unlock_index
1339 if {$success} {
1340 repository_state commit_type HEAD MERGE_HEAD
1341 set PARENT $HEAD
1342 set selected_commit_type new
1343 set ui_status_value "Pulling $branch from $remote complete."
1344 } else {
1345 rescan [list set ui_status_value \
1346 "Conflicts detected while pulling $branch from $remote."]
1347 }
1348}
1349proc push_to {remote} {
1351 set w [new_console "push $remote" \
1352 "Pushing changes to $remote"]
1353 set cmd [list git push]
1354 lappend cmd $remote
1355 console_exec $w $cmd
1356}
1357######################################################################
1359##
1360## ui helpers
1361proc mapicon {w state path} {
1363 global all_icons
1364 if {[catch {set r $all_icons($state$w)}]} {
1366 puts "error: no icon for $w state={$state} $path"
1367 return file_plain
1368 }
1369 return $r
1370}
1371proc mapdesc {state path} {
1373 global all_descs
1374 if {[catch {set r $all_descs($state)}]} {
1376 puts "error: no desc for state={$state} $path"
1377 return $state
1378 }
1379 return $r
1380}
1381proc escape_path {path} {
1383 regsub -all "\n" $path "\\n" path
1384 return $path
1385}
1386proc short_path {path} {
1388 return [escape_path [lindex [file split $path] end]]
1389}
1390set next_icon_id 0
1392set null_sha1 [string repeat 0 40]
1393proc merge_state {path new_state {head_info {}} {index_info {}}} {
1395 global file_states next_icon_id null_sha1
1396 set s0 [string index $new_state 0]
1398 set s1 [string index $new_state 1]
1399 if {[catch {set info $file_states($path)}]} {
1401 set state __
1402 set icon n[incr next_icon_id]
1403 } else {
1404 set state [lindex $info 0]
1405 set icon [lindex $info 1]
1406 if {$head_info eq {}} {set head_info [lindex $info 2]}
1407 if {$index_info eq {}} {set index_info [lindex $info 3]}
1408 }
1409 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1411 elseif {$s0 eq {_}} {set s0 _}
1412 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1414 elseif {$s1 eq {_}} {set s1 _}
1415 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1417 set head_info [list 0 $null_sha1]
1418 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1419 && $head_info eq {}} {
1420 set head_info $index_info
1421 }
1422 set file_states($path) [list $s0$s1 $icon \
1424 $head_info $index_info \
1425 ]
1426 return $state
1427}
1428proc display_file_helper {w path icon_name old_m new_m} {
1430 global file_lists
1431 if {$new_m eq {_}} {
1433 set lno [lsearch -sorted $file_lists($w) $path]
1434 if {$lno >= 0} {
1435 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1436 incr lno
1437 $w conf -state normal
1438 $w delete $lno.0 [expr {$lno + 1}].0
1439 $w conf -state disabled
1440 }
1441 } elseif {$old_m eq {_} && $new_m ne {_}} {
1442 lappend file_lists($w) $path
1443 set file_lists($w) [lsort -unique $file_lists($w)]
1444 set lno [lsearch -sorted $file_lists($w) $path]
1445 incr lno
1446 $w conf -state normal
1447 $w image create $lno.0 \
1448 -align center -padx 5 -pady 1 \
1449 -name $icon_name \
1450 -image [mapicon $w $new_m $path]
1451 $w insert $lno.1 "[escape_path $path]\n"
1452 $w conf -state disabled
1453 } elseif {$old_m ne $new_m} {
1454 $w conf -state normal
1455 $w image conf $icon_name -image [mapicon $w $new_m $path]
1456 $w conf -state disabled
1457 }
1458}
1459proc display_file {path state} {
1461 global file_states selected_paths
1462 global ui_index ui_workdir
1463 set old_m [merge_state $path $state]
1465 set s $file_states($path)
1466 set new_m [lindex $s 0]
1467 set icon_name [lindex $s 1]
1468 set o [string index $old_m 0]
1470 set n [string index $new_m 0]
1471 if {$o eq {U}} {
1472 set o _
1473 }
1474 if {$n eq {U}} {
1475 set n _
1476 }
1477 display_file_helper $ui_index $path $icon_name $o $n
1478 if {[string index $old_m 0] eq {U}} {
1480 set o U
1481 } else {
1482 set o [string index $old_m 1]
1483 }
1484 if {[string index $new_m 0] eq {U}} {
1485 set n U
1486 } else {
1487 set n [string index $new_m 1]
1488 }
1489 display_file_helper $ui_workdir $path $icon_name $o $n
1490 if {$new_m eq {__}} {
1492 unset file_states($path)
1493 catch {unset selected_paths($path)}
1494 }
1495}
1496proc display_all_files_helper {w path icon_name m} {
1498 global file_lists
1499 lappend file_lists($w) $path
1501 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1502 $w image create end \
1503 -align center -padx 5 -pady 1 \
1504 -name $icon_name \
1505 -image [mapicon $w $m $path]
1506 $w insert end "[escape_path $path]\n"
1507}
1508proc display_all_files {} {
1510 global ui_index ui_workdir
1511 global file_states file_lists
1512 global last_clicked
1513 $ui_index conf -state normal
1515 $ui_workdir conf -state normal
1516 $ui_index delete 0.0 end
1518 $ui_workdir delete 0.0 end
1519 set last_clicked {}
1520 set file_lists($ui_index) [list]
1522 set file_lists($ui_workdir) [list]
1523 foreach path [lsort [array names file_states]] {
1525 set s $file_states($path)
1526 set m [lindex $s 0]
1527 set icon_name [lindex $s 1]
1528 set s [string index $m 0]
1530 if {$s ne {U} && $s ne {_}} {
1531 display_all_files_helper $ui_index $path \
1532 $icon_name $s
1533 }
1534 if {[string index $m 0] eq {U}} {
1536 set s U
1537 } else {
1538 set s [string index $m 1]
1539 }
1540 if {$s ne {_}} {
1541 display_all_files_helper $ui_workdir $path \
1542 $icon_name $s
1543 }
1544 }
1545 $ui_index conf -state disabled
1547 $ui_workdir conf -state disabled
1548}
1549proc update_indexinfo {msg pathList after} {
1551 global update_index_cp ui_status_value
1552 if {![lock_index update]} return
1554 set update_index_cp 0
1556 set pathList [lsort $pathList]
1557 set totalCnt [llength $pathList]
1558 set batch [expr {int($totalCnt * .01) + 1}]
1559 if {$batch > 25} {set batch 25}
1560 set ui_status_value [format \
1562 "$msg... %i/%i files (%.2f%%)" \
1563 $update_index_cp \
1564 $totalCnt \
1565 0.0]
1566 set fd [open "| git update-index -z --index-info" w]
1567 fconfigure $fd \
1568 -blocking 0 \
1569 -buffering full \
1570 -buffersize 512 \
1571 -encoding binary \
1572 -translation binary
1573 fileevent $fd writable [list \
1574 write_update_indexinfo \
1575 $fd \
1576 $pathList \
1577 $totalCnt \
1578 $batch \
1579 $msg \
1580 $after \
1581 ]
1582}
1583proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1585 global update_index_cp ui_status_value
1586 global file_states current_diff_path
1587 if {$update_index_cp >= $totalCnt} {
1589 close $fd
1590 unlock_index
1591 uplevel #0 $after
1592 return
1593 }
1594 for {set i $batch} \
1596 {$update_index_cp < $totalCnt && $i > 0} \
1597 {incr i -1} {
1598 set path [lindex $pathList $update_index_cp]
1599 incr update_index_cp
1600 set s $file_states($path)
1602 switch -glob -- [lindex $s 0] {
1603 A? {set new _O}
1604 M? {set new _M}
1605 D_ {set new _D}
1606 D? {set new _?}
1607 ?? {continue}
1608 }
1609 set info [lindex $s 2]
1610 if {$info eq {}} continue
1611 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1613 display_file $path $new
1614 }
1615 set ui_status_value [format \
1617 "$msg... %i/%i files (%.2f%%)" \
1618 $update_index_cp \
1619 $totalCnt \
1620 [expr {100.0 * $update_index_cp / $totalCnt}]]
1621}
1622proc update_index {msg pathList after} {
1624 global update_index_cp ui_status_value
1625 if {![lock_index update]} return
1627 set update_index_cp 0
1629 set pathList [lsort $pathList]
1630 set totalCnt [llength $pathList]
1631 set batch [expr {int($totalCnt * .01) + 1}]
1632 if {$batch > 25} {set batch 25}
1633 set ui_status_value [format \
1635 "$msg... %i/%i files (%.2f%%)" \
1636 $update_index_cp \
1637 $totalCnt \
1638 0.0]
1639 set fd [open "| git update-index --add --remove -z --stdin" w]
1640 fconfigure $fd \
1641 -blocking 0 \
1642 -buffering full \
1643 -buffersize 512 \
1644 -encoding binary \
1645 -translation binary
1646 fileevent $fd writable [list \
1647 write_update_index \
1648 $fd \
1649 $pathList \
1650 $totalCnt \
1651 $batch \
1652 $msg \
1653 $after \
1654 ]
1655}
1656proc write_update_index {fd pathList totalCnt batch msg after} {
1658 global update_index_cp ui_status_value
1659 global file_states current_diff_path
1660 if {$update_index_cp >= $totalCnt} {
1662 close $fd
1663 unlock_index
1664 uplevel #0 $after
1665 return
1666 }
1667 for {set i $batch} \
1669 {$update_index_cp < $totalCnt && $i > 0} \
1670 {incr i -1} {
1671 set path [lindex $pathList $update_index_cp]
1672 incr update_index_cp
1673 switch -glob -- [lindex $file_states($path) 0] {
1675 AD {set new __}
1676 ?D {set new D_}
1677 _O -
1678 AM {set new A_}
1679 U? {
1680 if {[file exists $path]} {
1681 set new M_
1682 } else {
1683 set new D_
1684 }
1685 }
1686 ?M {set new M_}
1687 ?? {continue}
1688 }
1689 puts -nonewline $fd "[encoding convertto $path]\0"
1690 display_file $path $new
1691 }
1692 set ui_status_value [format \
1694 "$msg... %i/%i files (%.2f%%)" \
1695 $update_index_cp \
1696 $totalCnt \
1697 [expr {100.0 * $update_index_cp / $totalCnt}]]
1698}
1699proc checkout_index {msg pathList after} {
1701 global update_index_cp ui_status_value
1702 if {![lock_index update]} return
1704 set update_index_cp 0
1706 set pathList [lsort $pathList]
1707 set totalCnt [llength $pathList]
1708 set batch [expr {int($totalCnt * .01) + 1}]
1709 if {$batch > 25} {set batch 25}
1710 set ui_status_value [format \
1712 "$msg... %i/%i files (%.2f%%)" \
1713 $update_index_cp \
1714 $totalCnt \
1715 0.0]
1716 set cmd [list git checkout-index]
1717 lappend cmd --index
1718 lappend cmd --quiet
1719 lappend cmd --force
1720 lappend cmd -z
1721 lappend cmd --stdin
1722 set fd [open "| $cmd " w]
1723 fconfigure $fd \
1724 -blocking 0 \
1725 -buffering full \
1726 -buffersize 512 \
1727 -encoding binary \
1728 -translation binary
1729 fileevent $fd writable [list \
1730 write_checkout_index \
1731 $fd \
1732 $pathList \
1733 $totalCnt \
1734 $batch \
1735 $msg \
1736 $after \
1737 ]
1738}
1739proc write_checkout_index {fd pathList totalCnt batch msg after} {
1741 global update_index_cp ui_status_value
1742 global file_states current_diff_path
1743 if {$update_index_cp >= $totalCnt} {
1745 close $fd
1746 unlock_index
1747 uplevel #0 $after
1748 return
1749 }
1750 for {set i $batch} \
1752 {$update_index_cp < $totalCnt && $i > 0} \
1753 {incr i -1} {
1754 set path [lindex $pathList $update_index_cp]
1755 incr update_index_cp
1756 switch -glob -- [lindex $file_states($path) 0] {
1757 U? {continue}
1758 ?M -
1759 ?D {
1760 puts -nonewline $fd "[encoding convertto $path]\0"
1761 display_file $path ?_
1762 }
1763 }
1764 }
1765 set ui_status_value [format \
1767 "$msg... %i/%i files (%.2f%%)" \
1768 $update_index_cp \
1769 $totalCnt \
1770 [expr {100.0 * $update_index_cp / $totalCnt}]]
1771}
1772######################################################################
1774##
1775## branch management
1776proc is_tracking_branch {name} {
1778 global tracking_branches
1779 if {![catch {set info $tracking_branches($name)}]} {
1781 return 1
1782 }
1783 foreach t [array names tracking_branches] {
1784 if {[string match {*/\*} $t] && [string match $t $name]} {
1785 return 1
1786 }
1787 }
1788 return 0
1789}
1790proc load_all_heads {} {
1792 global all_heads
1793 set all_heads [list]
1795 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1796 while {[gets $fd line] > 0} {
1797 if {[is_tracking_branch $line]} continue
1798 if {![regsub ^refs/heads/ $line {} name]} continue
1799 lappend all_heads $name
1800 }
1801 close $fd
1802 set all_heads [lsort $all_heads]
1804}
1805proc populate_branch_menu {} {
1807 global all_heads disable_on_lock
1808 set m .mbar.branch
1810 set last [$m index last]
1811 for {set i 0} {$i <= $last} {incr i} {
1812 if {[$m type $i] eq {separator}} {
1813 $m delete $i last
1814 set new_dol [list]
1815 foreach a $disable_on_lock {
1816 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1817 lappend new_dol $a
1818 }
1819 }
1820 set disable_on_lock $new_dol
1821 break
1822 }
1823 }
1824 $m add separator
1826 foreach b $all_heads {
1827 $m add radiobutton \
1828 -label $b \
1829 -command [list switch_branch $b] \
1830 -variable current_branch \
1831 -value $b \
1832 -font font_ui
1833 lappend disable_on_lock \
1834 [list $m entryconf [$m index last] -state]
1835 }
1836}
1837proc all_tracking_branches {} {
1839 global tracking_branches
1840 set all_trackings {}
1842 set cmd {}
1843 foreach name [array names tracking_branches] {
1844 if {[regsub {/\*$} $name {} name]} {
1845 lappend cmd $name
1846 } else {
1847 regsub ^refs/(heads|remotes)/ $name {} name
1848 lappend all_trackings $name
1849 }
1850 }
1851 if {$cmd ne {}} {
1853 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1854 while {[gets $fd name] > 0} {
1855 regsub ^refs/(heads|remotes)/ $name {} name
1856 lappend all_trackings $name
1857 }
1858 close $fd
1859 }
1860 return [lsort -unique $all_trackings]
1862}
1863proc do_create_branch_action {w} {
1865 global all_heads null_sha1 repo_config
1866 global create_branch_checkout create_branch_revtype
1867 global create_branch_head create_branch_trackinghead
1868 set newbranch [string trim [$w.desc.name_t get 0.0 end]]
1870 if {$newbranch eq {}
1871 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1872 tk_messageBox \
1873 -icon error \
1874 -type ok \
1875 -title [wm title $w] \
1876 -parent $w \
1877 -message "Please supply a branch name."
1878 focus $w.desc.name_t
1879 return
1880 }
1881 if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1882 tk_messageBox \
1883 -icon error \
1884 -type ok \
1885 -title [wm title $w] \
1886 -parent $w \
1887 -message "Branch '$newbranch' already exists."
1888 focus $w.desc.name_t
1889 return
1890 }
1891 if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1892 tk_messageBox \
1893 -icon error \
1894 -type ok \
1895 -title [wm title $w] \
1896 -parent $w \
1897 -message "We do not like '$newbranch' as a branch name."
1898 focus $w.desc.name_t
1899 return
1900 }
1901 set rev {}
1903 switch -- $create_branch_revtype {
1904 head {set rev $create_branch_head}
1905 tracking {set rev $create_branch_trackinghead}
1906 expression {set rev [string trim [$w.from.exp_t get 0.0 end]]}
1907 }
1908 if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1909 tk_messageBox \
1910 -icon error \
1911 -type ok \
1912 -title [wm title $w] \
1913 -parent $w \
1914 -message "Invalid starting revision: $rev"
1915 return
1916 }
1917 set cmd [list git update-ref]
1918 lappend cmd -m
1919 lappend cmd "branch: Created from $rev"
1920 lappend cmd "refs/heads/$newbranch"
1921 lappend cmd $cmt
1922 lappend cmd $null_sha1
1923 if {[catch {eval exec $cmd} err]} {
1924 tk_messageBox \
1925 -icon error \
1926 -type ok \
1927 -title [wm title $w] \
1928 -parent $w \
1929 -message "Failed to create '$newbranch'.\n\n$err"
1930 return
1931 }
1932 lappend all_heads $newbranch
1934 set all_heads [lsort $all_heads]
1935 populate_branch_menu
1936 destroy $w
1937 if {$create_branch_checkout} {
1938 switch_branch $newbranch
1939 }
1940}
1941proc radio_selector {varname value args} {
1943 upvar #0 $varname var
1944 set var $value
1945}
1946trace add variable create_branch_head write \
1948 [list radio_selector create_branch_revtype head]
1949trace add variable create_branch_trackinghead write \
1950 [list radio_selector create_branch_revtype tracking]
1951trace add variable delete_branch_head write \
1953 [list radio_selector delete_branch_checktype head]
1954trace add variable delete_branch_trackinghead write \
1955 [list radio_selector delete_branch_checktype tracking]
1956proc do_create_branch {} {
1958 global all_heads current_branch repo_config
1959 global create_branch_checkout create_branch_revtype
1960 global create_branch_head create_branch_trackinghead
1961 set w .branch_editor
1963 toplevel $w
1964 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1965 label $w.header -text {Create New Branch} \
1967 -font font_uibold
1968 pack $w.header -side top -fill x
1969 frame $w.buttons
1971 button $w.buttons.create -text Create \
1972 -font font_ui \
1973 -default active \
1974 -command [list do_create_branch_action $w]
1975 pack $w.buttons.create -side right
1976 button $w.buttons.cancel -text {Cancel} \
1977 -font font_ui \
1978 -command [list destroy $w]
1979 pack $w.buttons.cancel -side right -padx 5
1980 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1981 labelframe $w.desc \
1983 -text {Branch Description} \
1984 -font font_ui
1985 label $w.desc.name_l -text {Name:} -font font_ui
1986 text $w.desc.name_t \
1987 -borderwidth 1 \
1988 -relief sunken \
1989 -height 1 \
1990 -width 40 \
1991 -font font_ui
1992 $w.desc.name_t insert 0.0 $repo_config(gui.newbranchtemplate)
1993 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
1994 bind $w.desc.name_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
1995 bind $w.desc.name_t <Key-Tab> {focus [tk_focusNext %W];break}
1996 bind $w.desc.name_t <Key-Return> "do_create_branch_action $w;break"
1997 bind $w.desc.name_t <Key> {
1998 if {{%K} ne {BackSpace}
1999 && {%K} ne {Tab}
2000 && {%K} ne {Escape}
2001 && {%K} ne {Return}} {
2002 if {%k <= 32} break
2003 if {[string first %A {~^:?*[}] >= 0} break
2004 }
2005 }
2006 grid columnconfigure $w.desc 1 -weight 1
2007 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2008 labelframe $w.from \
2010 -text {Starting Revision} \
2011 -font font_ui
2012 radiobutton $w.from.head_r \
2013 -text {Local Branch:} \
2014 -value head \
2015 -variable create_branch_revtype \
2016 -font font_ui
2017 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2018 grid $w.from.head_r $w.from.head_m -sticky w
2019 set all_trackings [all_tracking_branches]
2020 if {$all_trackings ne {}} {
2021 set create_branch_trackinghead [lindex $all_trackings 0]
2022 radiobutton $w.from.tracking_r \
2023 -text {Tracking Branch:} \
2024 -value tracking \
2025 -variable create_branch_revtype \
2026 -font font_ui
2027 eval tk_optionMenu $w.from.tracking_m \
2028 create_branch_trackinghead \
2029 $all_trackings
2030 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2031 }
2032 radiobutton $w.from.exp_r \
2033 -text {Revision Expression:} \
2034 -value expression \
2035 -variable create_branch_revtype \
2036 -font font_ui
2037 text $w.from.exp_t \
2038 -borderwidth 1 \
2039 -relief sunken \
2040 -height 1 \
2041 -width 50 \
2042 -font font_ui
2043 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2044 bind $w.from.exp_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
2045 bind $w.from.exp_t <Key-Tab> {focus [tk_focusNext %W];break}
2046 bind $w.from.exp_t <Key-Return> "do_create_branch_action $w;break"
2047 bind $w.from.exp_t <Key-space> break
2048 bind $w.from.exp_t <Key> {set create_branch_revtype expression}
2049 grid columnconfigure $w.from 1 -weight 1
2050 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2051 labelframe $w.postActions \
2053 -text {Post Creation Actions} \
2054 -font font_ui
2055 checkbutton $w.postActions.checkout \
2056 -text {Checkout after creation} \
2057 -variable create_branch_checkout \
2058 -font font_ui
2059 pack $w.postActions.checkout -anchor nw
2060 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2061 set create_branch_checkout 1
2063 set create_branch_head $current_branch
2064 set create_branch_revtype head
2065 bind $w <Visibility> "grab $w; focus $w.desc.name_t"
2067 bind $w <Key-Escape> "destroy $w"
2068 bind $w <Key-Return> "do_create_branch_action $w;break"
2069 wm title $w "[appname] ([reponame]): Create Branch"
2070 tkwait window $w
2071}
2072proc do_delete_branch_action {w} {
2074 global all_heads
2075 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2076 set check_rev {}
2078 switch -- $delete_branch_checktype {
2079 head {set check_rev $delete_branch_head}
2080 tracking {set check_rev $delete_branch_trackinghead}
2081 always {set check_rev {:none}}
2082 }
2083 if {$check_rev eq {:none}} {
2084 set check_cmt {}
2085 } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2086 tk_messageBox \
2087 -icon error \
2088 -type ok \
2089 -title [wm title $w] \
2090 -parent $w \
2091 -message "Invalid check revision: $check_rev"
2092 return
2093 }
2094 set to_delete [list]
2096 set not_merged [list]
2097 foreach i [$w.list.l curselection] {
2098 set b [$w.list.l get $i]
2099 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2100 if {$check_cmt ne {}} {
2101 if {$b eq $check_rev} continue
2102 if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2103 if {$o ne $m} {
2104 lappend not_merged $b
2105 continue
2106 }
2107 }
2108 lappend to_delete [list $b $o]
2109 }
2110 if {$not_merged ne {}} {
2111 set msg "The following branches are not completely merged into $check_rev:
2112 - [join $not_merged "\n - "]"
2114 tk_messageBox \
2115 -icon info \
2116 -type ok \
2117 -title [wm title $w] \
2118 -parent $w \
2119 -message $msg
2120 }
2121 if {$to_delete eq {}} return
2122 if {$delete_branch_checktype eq {always}} {
2123 set msg {Recovering deleted branches is difficult.
2124Delete the selected branches?}
2126 if {[tk_messageBox \
2127 -icon warning \
2128 -type yesno \
2129 -title [wm title $w] \
2130 -parent $w \
2131 -message $msg] ne yes} {
2132 return
2133 }
2134 }
2135 set failed {}
2137 foreach i $to_delete {
2138 set b [lindex $i 0]
2139 set o [lindex $i 1]
2140 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2141 append failed " - $b: $err\n"
2142 } else {
2143 set x [lsearch -sorted $all_heads $b]
2144 if {$x >= 0} {
2145 set all_heads [lreplace $all_heads $x $x]
2146 }
2147 }
2148 }
2149 if {$failed ne {}} {
2151 tk_messageBox \
2152 -icon error \
2153 -type ok \
2154 -title [wm title $w] \
2155 -parent $w \
2156 -message "Failed to delete branches:\n$failed"
2157 }
2158 set all_heads [lsort $all_heads]
2160 populate_branch_menu
2161 destroy $w
2162}
2163proc do_delete_branch {} {
2165 global all_heads tracking_branches current_branch
2166 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2167 set w .branch_editor
2169 toplevel $w
2170 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2171 label $w.header -text {Delete Local Branch} \
2173 -font font_uibold
2174 pack $w.header -side top -fill x
2175 frame $w.buttons
2177 button $w.buttons.create -text Delete \
2178 -font font_ui \
2179 -command [list do_delete_branch_action $w]
2180 pack $w.buttons.create -side right
2181 button $w.buttons.cancel -text {Cancel} \
2182 -font font_ui \
2183 -command [list destroy $w]
2184 pack $w.buttons.cancel -side right -padx 5
2185 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2186 labelframe $w.list \
2188 -text {Local Branches} \
2189 -font font_ui
2190 listbox $w.list.l \
2191 -height 10 \
2192 -width 50 \
2193 -selectmode extended \
2194 -font font_ui
2195 foreach h $all_heads {
2196 if {$h ne $current_branch} {
2197 $w.list.l insert end $h
2198 }
2199 }
2200 pack $w.list.l -fill both -pady 5 -padx 5
2201 pack $w.list -fill both -pady 5 -padx 5
2202 labelframe $w.validate \
2204 -text {Delete Only If} \
2205 -font font_ui
2206 radiobutton $w.validate.head_r \
2207 -text {Merged Into Local Branch:} \
2208 -value head \
2209 -variable delete_branch_checktype \
2210 -font font_ui
2211 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2212 grid $w.validate.head_r $w.validate.head_m -sticky w
2213 set all_trackings [all_tracking_branches]
2214 if {$all_trackings ne {}} {
2215 set delete_branch_trackinghead [lindex $all_trackings 0]
2216 radiobutton $w.validate.tracking_r \
2217 -text {Merged Into Tracking Branch:} \
2218 -value tracking \
2219 -variable delete_branch_checktype \
2220 -font font_ui
2221 eval tk_optionMenu $w.validate.tracking_m \
2222 delete_branch_trackinghead \
2223 $all_trackings
2224 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2225 }
2226 radiobutton $w.validate.always_r \
2227 -text {Always (Do not perform merge checks)} \
2228 -value always \
2229 -variable delete_branch_checktype \
2230 -font font_ui
2231 grid $w.validate.always_r -columnspan 2 -sticky w
2232 grid columnconfigure $w.validate 1 -weight 1
2233 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2234 set delete_branch_head $current_branch
2236 set delete_branch_checktype head
2237 bind $w <Visibility> "grab $w; focus $w"
2239 bind $w <Key-Escape> "destroy $w"
2240 wm title $w "[appname] ([reponame]): Delete Branch"
2241 tkwait window $w
2242}
2243proc switch_branch {new_branch} {
2245 global HEAD commit_type current_branch repo_config
2246 if {![lock_index switch]} return
2248 # -- Our in memory state should match the repository.
2250 #
2251 repository_state curType curHEAD curMERGE_HEAD
2252 if {[string match amend* $commit_type]
2253 && $curType eq {normal}
2254 && $curHEAD eq $HEAD} {
2255 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2256 info_popup {Last scanned state does not match repository state.
2257Another Git program has modified this repository
2259since the last scan. A rescan must be performed
2260before the current branch can be changed.
2261The rescan will be automatically started now.
2263}
2264 unlock_index
2265 rescan {set ui_status_value {Ready.}}
2266 return
2267 }
2268 if {$repo_config(gui.trustmtime) eq {true}} {
2270 switch_branch_stage2 {} $new_branch
2271 } else {
2272 set ui_status_value {Refreshing file status...}
2273 set cmd [list git update-index]
2274 lappend cmd -q
2275 lappend cmd --unmerged
2276 lappend cmd --ignore-missing
2277 lappend cmd --refresh
2278 set fd_rf [open "| $cmd" r]
2279 fconfigure $fd_rf -blocking 0 -translation binary
2280 fileevent $fd_rf readable \
2281 [list switch_branch_stage2 $fd_rf $new_branch]
2282 }
2283}
2284proc switch_branch_stage2 {fd_rf new_branch} {
2286 global ui_status_value HEAD
2287 if {$fd_rf ne {}} {
2289 read $fd_rf
2290 if {![eof $fd_rf]} return
2291 close $fd_rf
2292 }
2293 set ui_status_value "Updating working directory to '$new_branch'..."
2295 set cmd [list git read-tree]
2296 lappend cmd -m
2297 lappend cmd -u
2298 lappend cmd --exclude-per-directory=.gitignore
2299 lappend cmd $HEAD
2300 lappend cmd $new_branch
2301 set fd_rt [open "| $cmd" r]
2302 fconfigure $fd_rt -blocking 0 -translation binary
2303 fileevent $fd_rt readable \
2304 [list switch_branch_readtree_wait $fd_rt $new_branch]
2305}
2306proc switch_branch_readtree_wait {fd_rt new_branch} {
2308 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2309 global current_branch
2310 global ui_comm ui_status_value
2311 # -- We never get interesting output on stdout; only stderr.
2313 #
2314 read $fd_rt
2315 fconfigure $fd_rt -blocking 1
2316 if {![eof $fd_rt]} {
2317 fconfigure $fd_rt -blocking 0
2318 return
2319 }
2320 # -- The working directory wasn't in sync with the index and
2322 # we'd have to overwrite something to make the switch. A
2323 # merge is required.
2324 #
2325 if {[catch {close $fd_rt} err]} {
2326 regsub {^fatal: } $err {} err
2327 warn_popup "File level merge required.
2328$err
2330Staying on branch '$current_branch'."
2332 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2333 unlock_index
2334 return
2335 }
2336 # -- Update the symbolic ref. Core git doesn't even check for failure
2338 # here, it Just Works(tm). If it doesn't we are in some really ugly
2339 # state that is difficult to recover from within git-gui.
2340 #
2341 if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2342 error_popup "Failed to set current branch.
2343This working directory is only partially switched.
2345We successfully updated your files, but failed to
2346update an internal Git file.
2347This should not have occurred. [appname] will now
2349close and give up.
2350$err"
2352 do_quit
2353 return
2354 }
2355 # -- Update our repository state. If we were previously in amend mode
2357 # we need to toss the current buffer and do a full rescan to update
2358 # our file lists. If we weren't in amend mode our file lists are
2359 # accurate and we can avoid the rescan.
2360 #
2361 unlock_index
2362 set selected_commit_type new
2363 if {[string match amend* $commit_type]} {
2364 $ui_comm delete 0.0 end
2365 $ui_comm edit reset
2366 $ui_comm edit modified false
2367 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2368 } else {
2369 repository_state commit_type HEAD MERGE_HEAD
2370 set PARENT $HEAD
2371 set ui_status_value "Checked out branch '$current_branch'."
2372 }
2373}
2374######################################################################
2376##
2377## remote management
2378proc load_all_remotes {} {
2380 global repo_config
2381 global all_remotes tracking_branches
2382 set all_remotes [list]
2384 array unset tracking_branches
2385 set rm_dir [gitdir remotes]
2387 if {[file isdirectory $rm_dir]} {
2388 set all_remotes [glob \
2389 -types f \
2390 -tails \
2391 -nocomplain \
2392 -directory $rm_dir *]
2393 foreach name $all_remotes {
2395 catch {
2396 set fd [open [file join $rm_dir $name] r]
2397 while {[gets $fd line] >= 0} {
2398 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2399 $line line src dst]} continue
2400 if {![regexp ^refs/ $dst]} {
2401 set dst "refs/heads/$dst"
2402 }
2403 set tracking_branches($dst) [list $name $src]
2404 }
2405 close $fd
2406 }
2407 }
2408 }
2409 foreach line [array names repo_config remote.*.url] {
2411 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2412 lappend all_remotes $name
2413 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2415 set fl {}
2416 }
2417 foreach line $fl {
2418 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2419 if {![regexp ^refs/ $dst]} {
2420 set dst "refs/heads/$dst"
2421 }
2422 set tracking_branches($dst) [list $name $src]
2423 }
2424 }
2425 set all_remotes [lsort -unique $all_remotes]
2427}
2428proc populate_fetch_menu {m} {
2430 global all_remotes repo_config
2431 foreach r $all_remotes {
2433 set enable 0
2434 if {![catch {set a $repo_config(remote.$r.url)}]} {
2435 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2436 set enable 1
2437 }
2438 } else {
2439 catch {
2440 set fd [open [gitdir remotes $r] r]
2441 while {[gets $fd n] >= 0} {
2442 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2443 set enable 1
2444 break
2445 }
2446 }
2447 close $fd
2448 }
2449 }
2450 if {$enable} {
2452 $m add command \
2453 -label "Fetch from $r..." \
2454 -command [list fetch_from $r] \
2455 -font font_ui
2456 }
2457 }
2458}
2459proc populate_push_menu {m} {
2461 global all_remotes repo_config
2462 foreach r $all_remotes {
2464 set enable 0
2465 if {![catch {set a $repo_config(remote.$r.url)}]} {
2466 if {![catch {set a $repo_config(remote.$r.push)}]} {
2467 set enable 1
2468 }
2469 } else {
2470 catch {
2471 set fd [open [gitdir remotes $r] r]
2472 while {[gets $fd n] >= 0} {
2473 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2474 set enable 1
2475 break
2476 }
2477 }
2478 close $fd
2479 }
2480 }
2481 if {$enable} {
2483 $m add command \
2484 -label "Push to $r..." \
2485 -command [list push_to $r] \
2486 -font font_ui
2487 }
2488 }
2489}
2490proc populate_pull_menu {m} {
2492 global repo_config all_remotes disable_on_lock
2493 foreach remote $all_remotes {
2495 set rb_list [list]
2496 if {[array get repo_config remote.$remote.url] ne {}} {
2497 if {[array get repo_config remote.$remote.fetch] ne {}} {
2498 foreach line $repo_config(remote.$remote.fetch) {
2499 if {[regexp {^([^:]+):} $line line rb]} {
2500 lappend rb_list $rb
2501 }
2502 }
2503 }
2504 } else {
2505 catch {
2506 set fd [open [gitdir remotes $remote] r]
2507 while {[gets $fd line] >= 0} {
2508 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
2509 lappend rb_list $rb
2510 }
2511 }
2512 close $fd
2513 }
2514 }
2515 foreach rb $rb_list {
2517 regsub ^refs/heads/ $rb {} rb_short
2518 $m add command \
2519 -label "Branch $rb_short from $remote..." \
2520 -command [list pull_remote $remote $rb] \
2521 -font font_ui
2522 lappend disable_on_lock \
2523 [list $m entryconf [$m index last] -state]
2524 }
2525 }
2526}
2527######################################################################
2529##
2530## icons
2531set filemask {
2533#define mask_width 14
2534#define mask_height 15
2535static unsigned char mask_bits[] = {
2536 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2537 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2538 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2539}
2540image create bitmap file_plain -background white -foreground black -data {
2542#define plain_width 14
2543#define plain_height 15
2544static unsigned char plain_bits[] = {
2545 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2546 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2547 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2548} -maskdata $filemask
2549image create bitmap file_mod -background white -foreground blue -data {
2551#define mod_width 14
2552#define mod_height 15
2553static unsigned char mod_bits[] = {
2554 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2555 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2556 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2557} -maskdata $filemask
2558image create bitmap file_fulltick -background white -foreground "#007000" -data {
2560#define file_fulltick_width 14
2561#define file_fulltick_height 15
2562static unsigned char file_fulltick_bits[] = {
2563 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2564 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2565 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2566} -maskdata $filemask
2567image create bitmap file_parttick -background white -foreground "#005050" -data {
2569#define parttick_width 14
2570#define parttick_height 15
2571static unsigned char parttick_bits[] = {
2572 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2573 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2574 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2575} -maskdata $filemask
2576image create bitmap file_question -background white -foreground black -data {
2578#define file_question_width 14
2579#define file_question_height 15
2580static unsigned char file_question_bits[] = {
2581 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2582 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2583 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2584} -maskdata $filemask
2585image create bitmap file_removed -background white -foreground red -data {
2587#define file_removed_width 14
2588#define file_removed_height 15
2589static unsigned char file_removed_bits[] = {
2590 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2591 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2592 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2593} -maskdata $filemask
2594image create bitmap file_merge -background white -foreground blue -data {
2596#define file_merge_width 14
2597#define file_merge_height 15
2598static unsigned char file_merge_bits[] = {
2599 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2600 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2601 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2602} -maskdata $filemask
2603set ui_index .vpane.files.index.list
2605set ui_workdir .vpane.files.workdir.list
2606set all_icons(_$ui_index) file_plain
2608set all_icons(A$ui_index) file_fulltick
2609set all_icons(M$ui_index) file_fulltick
2610set all_icons(D$ui_index) file_removed
2611set all_icons(U$ui_index) file_merge
2612set all_icons(_$ui_workdir) file_plain
2614set all_icons(M$ui_workdir) file_mod
2615set all_icons(D$ui_workdir) file_question
2616set all_icons(U$ui_workdir) file_merge
2617set all_icons(O$ui_workdir) file_plain
2618set max_status_desc 0
2620foreach i {
2621 {__ "Unmodified"}
2622 {_M "Modified, not staged"}
2624 {M_ "Staged for commit"}
2625 {MM "Portions staged for commit"}
2626 {MD "Staged for commit, missing"}
2627 {_O "Untracked, not staged"}
2629 {A_ "Staged for commit"}
2630 {AM "Portions staged for commit"}
2631 {AD "Staged for commit, missing"}
2632 {_D "Missing"}
2634 {D_ "Staged for removal"}
2635 {DO "Staged for removal, still present"}
2636 {U_ "Requires merge resolution"}
2638 {UU "Requires merge resolution"}
2639 {UM "Requires merge resolution"}
2640 {UD "Requires merge resolution"}
2641 } {
2642 if {$max_status_desc < [string length [lindex $i 1]]} {
2643 set max_status_desc [string length [lindex $i 1]]
2644 }
2645 set all_descs([lindex $i 0]) [lindex $i 1]
2646}
2647unset i
2648######################################################################
2650##
2651## util
2652proc is_MacOSX {} {
2654 global tcl_platform tk_library
2655 if {[tk windowingsystem] eq {aqua}} {
2656 return 1
2657 }
2658 return 0
2659}
2660proc is_Windows {} {
2662 global tcl_platform
2663 if {$tcl_platform(platform) eq {windows}} {
2664 return 1
2665 }
2666 return 0
2667}
2668proc bind_button3 {w cmd} {
2670 bind $w <Any-Button-3> $cmd
2671 if {[is_MacOSX]} {
2672 bind $w <Control-Button-1> $cmd
2673 }
2674}
2675proc incr_font_size {font {amt 1}} {
2677 set sz [font configure $font -size]
2678 incr sz $amt
2679 font configure $font -size $sz
2680 font configure ${font}bold -size $sz
2681}
2682proc hook_failed_popup {hook msg} {
2684 set w .hookfail
2685 toplevel $w
2686 frame $w.m
2688 label $w.m.l1 -text "$hook hook failed:" \
2689 -anchor w \
2690 -justify left \
2691 -font font_uibold
2692 text $w.m.t \
2693 -background white -borderwidth 1 \
2694 -relief sunken \
2695 -width 80 -height 10 \
2696 -font font_diff \
2697 -yscrollcommand [list $w.m.sby set]
2698 label $w.m.l2 \
2699 -text {You must correct the above errors before committing.} \
2700 -anchor w \
2701 -justify left \
2702 -font font_uibold
2703 scrollbar $w.m.sby -command [list $w.m.t yview]
2704 pack $w.m.l1 -side top -fill x
2705 pack $w.m.l2 -side bottom -fill x
2706 pack $w.m.sby -side right -fill y
2707 pack $w.m.t -side left -fill both -expand 1
2708 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2709 $w.m.t insert 1.0 $msg
2711 $w.m.t conf -state disabled
2712 button $w.ok -text OK \
2714 -width 15 \
2715 -font font_ui \
2716 -command "destroy $w"
2717 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2718 bind $w <Visibility> "grab $w; focus $w"
2720 bind $w <Key-Return> "destroy $w"
2721 wm title $w "[appname] ([reponame]): error"
2722 tkwait window $w
2723}
2724set next_console_id 0
2726proc new_console {short_title long_title} {
2728 global next_console_id console_data
2729 set w .console[incr next_console_id]
2730 set console_data($w) [list $short_title $long_title]
2731 return [console_init $w]
2732}
2733proc console_init {w} {
2735 global console_cr console_data M1B
2736 set console_cr($w) 1.0
2738 toplevel $w
2739 frame $w.m
2740 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2741 -anchor w \
2742 -justify left \
2743 -font font_uibold
2744 text $w.m.t \
2745 -background white -borderwidth 1 \
2746 -relief sunken \
2747 -width 80 -height 10 \
2748 -font font_diff \
2749 -state disabled \
2750 -yscrollcommand [list $w.m.sby set]
2751 label $w.m.s -text {Working... please wait...} \
2752 -anchor w \
2753 -justify left \
2754 -font font_uibold
2755 scrollbar $w.m.sby -command [list $w.m.t yview]
2756 pack $w.m.l1 -side top -fill x
2757 pack $w.m.s -side bottom -fill x
2758 pack $w.m.sby -side right -fill y
2759 pack $w.m.t -side left -fill both -expand 1
2760 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2761 menu $w.ctxm -tearoff 0
2763 $w.ctxm add command -label "Copy" \
2764 -font font_ui \
2765 -command "tk_textCopy $w.m.t"
2766 $w.ctxm add command -label "Select All" \
2767 -font font_ui \
2768 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
2769 $w.ctxm add command -label "Copy All" \
2770 -font font_ui \
2771 -command "
2772 $w.m.t tag add sel 0.0 end
2773 tk_textCopy $w.m.t
2774 $w.m.t tag remove sel 0.0 end
2775 "
2776 button $w.ok -text {Close} \
2778 -font font_ui \
2779 -state disabled \
2780 -command "destroy $w"
2781 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2782 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2784 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2785 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2786 bind $w <Visibility> "focus $w"
2787 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2788 return $w
2789}
2790proc console_exec {w cmd {after {}}} {
2792 # -- Windows tosses the enviroment when we exec our child.
2793 # But most users need that so we have to relogin. :-(
2794 #
2795 if {[is_Windows]} {
2796 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2797 }
2798 # -- Tcl won't let us redirect both stdout and stderr to
2800 # the same pipe. So pass it through cat...
2801 #
2802 set cmd [concat | $cmd |& cat]
2803 set fd_f [open $cmd r]
2805 fconfigure $fd_f -blocking 0 -translation binary
2806 fileevent $fd_f readable [list console_read $w $fd_f $after]
2807}
2808proc console_read {w fd after} {
2810 global console_cr console_data
2811 set buf [read $fd]
2813 if {$buf ne {}} {
2814 if {![winfo exists $w]} {console_init $w}
2815 $w.m.t conf -state normal
2816 set c 0
2817 set n [string length $buf]
2818 while {$c < $n} {
2819 set cr [string first "\r" $buf $c]
2820 set lf [string first "\n" $buf $c]
2821 if {$cr < 0} {set cr [expr {$n + 1}]}
2822 if {$lf < 0} {set lf [expr {$n + 1}]}
2823 if {$lf < $cr} {
2825 $w.m.t insert end [string range $buf $c $lf]
2826 set console_cr($w) [$w.m.t index {end -1c}]
2827 set c $lf
2828 incr c
2829 } else {
2830 $w.m.t delete $console_cr($w) end
2831 $w.m.t insert end "\n"
2832 $w.m.t insert end [string range $buf $c $cr]
2833 set c $cr
2834 incr c
2835 }
2836 }
2837 $w.m.t conf -state disabled
2838 $w.m.t see end
2839 }
2840 fconfigure $fd -blocking 1
2842 if {[eof $fd]} {
2843 if {[catch {close $fd}]} {
2844 if {![winfo exists $w]} {console_init $w}
2845 $w.m.s conf -background red -text {Error: Command Failed}
2846 $w.ok conf -state normal
2847 set ok 0
2848 } elseif {[winfo exists $w]} {
2849 $w.m.s conf -background green -text {Success}
2850 $w.ok conf -state normal
2851 set ok 1
2852 }
2853 array unset console_cr $w
2854 array unset console_data $w
2855 if {$after ne {}} {
2856 uplevel #0 $after $ok
2857 }
2858 return
2859 }
2860 fconfigure $fd -blocking 0
2861}
2862######################################################################
2864##
2865## ui commands
2866set starting_gitk_msg {Starting gitk... please wait...}
2868proc do_gitk {revs} {
2870 global ui_status_value starting_gitk_msg
2871 set cmd gitk
2873 if {$revs ne {}} {
2874 append cmd { }
2875 append cmd $revs
2876 }
2877 if {[is_Windows]} {
2878 set cmd "sh -c \"exec $cmd\""
2879 }
2880 append cmd { &}
2881 if {[catch {eval exec $cmd} err]} {
2883 error_popup "Failed to start gitk:\n\n$err"
2884 } else {
2885 set ui_status_value $starting_gitk_msg
2886 after 10000 {
2887 if {$ui_status_value eq $starting_gitk_msg} {
2888 set ui_status_value {Ready.}
2889 }
2890 }
2891 }
2892}
2893proc do_stats {} {
2895 set fd [open "| git count-objects -v" r]
2896 while {[gets $fd line] > 0} {
2897 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
2898 set stats($name) $value
2899 }
2900 }
2901 close $fd
2902 set packed_sz 0
2904 foreach p [glob -directory [gitdir objects pack] \
2905 -type f \
2906 -nocomplain -- *] {
2907 incr packed_sz [file size $p]
2908 }
2909 if {$packed_sz > 0} {
2910 set stats(size-pack) [expr {$packed_sz / 1024}]
2911 }
2912 set w .stats_view
2914 toplevel $w
2915 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2916 label $w.header -text {Database Statistics} \
2918 -font font_uibold
2919 pack $w.header -side top -fill x
2920 frame $w.buttons -border 1
2922 button $w.buttons.close -text Close \
2923 -font font_ui \
2924 -command [list destroy $w]
2925 button $w.buttons.gc -text {Compress Database} \
2926 -font font_ui \
2927 -command "destroy $w;do_gc"
2928 pack $w.buttons.close -side right
2929 pack $w.buttons.gc -side left
2930 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2931 frame $w.stat -borderwidth 1 -relief solid
2933 foreach s {
2934 {count {Number of loose objects}}
2935 {size {Disk space used by loose objects} { KiB}}
2936 {in-pack {Number of packed objects}}
2937 {packs {Number of packs}}
2938 {size-pack {Disk space used by packed objects} { KiB}}
2939 {prune-packable {Packed objects waiting for pruning}}
2940 {garbage {Garbage files}}
2941 } {
2942 set name [lindex $s 0]
2943 set label [lindex $s 1]
2944 if {[catch {set value $stats($name)}]} continue
2945 if {[llength $s] > 2} {
2946 set value "$value[lindex $s 2]"
2947 }
2948 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
2950 label $w.stat.v_$name -text $value -anchor w -font font_ui
2951 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
2952 }
2953 pack $w.stat
2954 bind $w <Visibility> "grab $w; focus $w"
2956 bind $w <Key-Escape> [list destroy $w]
2957 bind $w <Key-Return> [list destroy $w]
2958 wm title $w "[appname] ([reponame]): Database Statistics"
2959 tkwait window $w
2960}
2961proc do_gc {} {
2963 set w [new_console {gc} {Compressing the object database}]
2964 console_exec $w {git gc}
2965}
2966proc do_fsck_objects {} {
2968 set w [new_console {fsck-objects} \
2969 {Verifying the object database with fsck-objects}]
2970 set cmd [list git fsck-objects]
2971 lappend cmd --full
2972 lappend cmd --cache
2973 lappend cmd --strict
2974 console_exec $w $cmd
2975}
2976set is_quitting 0
2978proc do_quit {} {
2980 global ui_comm is_quitting repo_config commit_type
2981 if {$is_quitting} return
2983 set is_quitting 1
2984 # -- Stash our current commit buffer.
2986 #
2987 set save [gitdir GITGUI_MSG]
2988 set msg [string trim [$ui_comm get 0.0 end]]
2989 regsub -all -line {[ \r\t]+$} $msg {} msg
2990 if {(![string match amend* $commit_type]
2991 || [$ui_comm edit modified])
2992 && $msg ne {}} {
2993 catch {
2994 set fd [open $save w]
2995 puts -nonewline $fd $msg
2996 close $fd
2997 }
2998 } else {
2999 catch {file delete $save}
3000 }
3001 # -- Stash our current window geometry into this repository.
3003 #
3004 set cfg_geometry [list]
3005 lappend cfg_geometry [wm geometry .]
3006 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
3007 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
3008 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
3009 set rc_geometry {}
3010 }
3011 if {$cfg_geometry ne $rc_geometry} {
3012 catch {exec git repo-config gui.geometry $cfg_geometry}
3013 }
3014 destroy .
3016}
3017proc do_rescan {} {
3019 rescan {set ui_status_value {Ready.}}
3020}
3021proc unstage_helper {txt paths} {
3023 global file_states current_diff_path
3024 if {![lock_index begin-update]} return
3026 set pathList [list]
3028 set after {}
3029 foreach path $paths {
3030 switch -glob -- [lindex $file_states($path) 0] {
3031 A? -
3032 M? -
3033 D? {
3034 lappend pathList $path
3035 if {$path eq $current_diff_path} {
3036 set after {reshow_diff;}
3037 }
3038 }
3039 }
3040 }
3041 if {$pathList eq {}} {
3042 unlock_index
3043 } else {
3044 update_indexinfo \
3045 $txt \
3046 $pathList \
3047 [concat $after {set ui_status_value {Ready.}}]
3048 }
3049}
3050proc do_unstage_selection {} {
3052 global current_diff_path selected_paths
3053 if {[array size selected_paths] > 0} {
3055 unstage_helper \
3056 {Unstaging selected files from commit} \
3057 [array names selected_paths]
3058 } elseif {$current_diff_path ne {}} {
3059 unstage_helper \
3060 "Unstaging [short_path $current_diff_path] from commit" \
3061 [list $current_diff_path]
3062 }
3063}
3064proc add_helper {txt paths} {
3066 global file_states current_diff_path
3067 if {![lock_index begin-update]} return
3069 set pathList [list]
3071 set after {}
3072 foreach path $paths {
3073 switch -glob -- [lindex $file_states($path) 0] {
3074 _O -
3075 ?M -
3076 ?D -
3077 U? {
3078 lappend pathList $path
3079 if {$path eq $current_diff_path} {
3080 set after {reshow_diff;}
3081 }
3082 }
3083 }
3084 }
3085 if {$pathList eq {}} {
3086 unlock_index
3087 } else {
3088 update_index \
3089 $txt \
3090 $pathList \
3091 [concat $after {set ui_status_value {Ready to commit.}}]
3092 }
3093}
3094proc do_add_selection {} {
3096 global current_diff_path selected_paths
3097 if {[array size selected_paths] > 0} {
3099 add_helper \
3100 {Adding selected files} \
3101 [array names selected_paths]
3102 } elseif {$current_diff_path ne {}} {
3103 add_helper \
3104 "Adding [short_path $current_diff_path]" \
3105 [list $current_diff_path]
3106 }
3107}
3108proc do_add_all {} {
3110 global file_states
3111 set paths [list]
3113 foreach path [array names file_states] {
3114 switch -glob -- [lindex $file_states($path) 0] {
3115 U? {continue}
3116 ?M -
3117 ?D {lappend paths $path}
3118 }
3119 }
3120 add_helper {Adding all changed files} $paths
3121}
3122proc revert_helper {txt paths} {
3124 global file_states current_diff_path
3125 if {![lock_index begin-update]} return
3127 set pathList [list]
3129 set after {}
3130 foreach path $paths {
3131 switch -glob -- [lindex $file_states($path) 0] {
3132 U? {continue}
3133 ?M -
3134 ?D {
3135 lappend pathList $path
3136 if {$path eq $current_diff_path} {
3137 set after {reshow_diff;}
3138 }
3139 }
3140 }
3141 }
3142 set n [llength $pathList]
3144 if {$n == 0} {
3145 unlock_index
3146 return
3147 } elseif {$n == 1} {
3148 set s "[short_path [lindex $pathList]]"
3149 } else {
3150 set s "these $n files"
3151 }
3152 set reply [tk_dialog \
3154 .confirm_revert \
3155 "[appname] ([reponame])" \
3156 "Revert changes in $s?
3157Any unadded changes will be permanently lost by the revert." \
3159 question \
3160 1 \
3161 {Do Nothing} \
3162 {Revert Changes} \
3163 ]
3164 if {$reply == 1} {
3165 checkout_index \
3166 $txt \
3167 $pathList \
3168 [concat $after {set ui_status_value {Ready.}}]
3169 } else {
3170 unlock_index
3171 }
3172}
3173proc do_revert_selection {} {
3175 global current_diff_path selected_paths
3176 if {[array size selected_paths] > 0} {
3178 revert_helper \
3179 {Reverting selected files} \
3180 [array names selected_paths]
3181 } elseif {$current_diff_path ne {}} {
3182 revert_helper \
3183 "Reverting [short_path $current_diff_path]" \
3184 [list $current_diff_path]
3185 }
3186}
3187proc do_signoff {} {
3189 global ui_comm
3190 set me [committer_ident]
3192 if {$me eq {}} return
3193 set sob "Signed-off-by: $me"
3195 set last [$ui_comm get {end -1c linestart} {end -1c}]
3196 if {$last ne $sob} {
3197 $ui_comm edit separator
3198 if {$last ne {}
3199 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
3200 $ui_comm insert end "\n"
3201 }
3202 $ui_comm insert end "\n$sob"
3203 $ui_comm edit separator
3204 $ui_comm see end
3205 }
3206}
3207proc do_select_commit_type {} {
3209 global commit_type selected_commit_type
3210 if {$selected_commit_type eq {new}
3212 && [string match amend* $commit_type]} {
3213 create_new_commit
3214 } elseif {$selected_commit_type eq {amend}
3215 && ![string match amend* $commit_type]} {
3216 load_last_commit
3217 # The amend request was rejected...
3219 #
3220 if {![string match amend* $commit_type]} {
3221 set selected_commit_type new
3222 }
3223 }
3224}
3225proc do_commit {} {
3227 commit_tree
3228}
3229proc do_about {} {
3231 global appvers copyright
3232 global tcl_patchLevel tk_patchLevel
3233 set w .about_dialog
3235 toplevel $w
3236 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3237 label $w.header -text "About [appname]" \
3239 -font font_uibold
3240 pack $w.header -side top -fill x
3241 frame $w.buttons
3243 button $w.buttons.close -text {Close} \
3244 -font font_ui \
3245 -command [list destroy $w]
3246 pack $w.buttons.close -side right
3247 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3248 label $w.desc \
3250 -text "[appname] - a commit creation tool for Git.
3251$copyright" \
3252 -padx 5 -pady 5 \
3253 -justify left \
3254 -anchor w \
3255 -borderwidth 1 \
3256 -relief solid \
3257 -font font_ui
3258 pack $w.desc -side top -fill x -padx 5 -pady 5
3259 set v {}
3261 append v "[appname] version $appvers\n"
3262 append v "[exec git version]\n"
3263 append v "\n"
3264 if {$tcl_patchLevel eq $tk_patchLevel} {
3265 append v "Tcl/Tk version $tcl_patchLevel"
3266 } else {
3267 append v "Tcl version $tcl_patchLevel"
3268 append v ", Tk version $tk_patchLevel"
3269 }
3270 label $w.vers \
3272 -text $v \
3273 -padx 5 -pady 5 \
3274 -justify left \
3275 -anchor w \
3276 -borderwidth 1 \
3277 -relief solid \
3278 -font font_ui
3279 pack $w.vers -side top -fill x -padx 5 -pady 5
3280 menu $w.ctxm -tearoff 0
3282 $w.ctxm add command \
3283 -label {Copy} \
3284 -font font_ui \
3285 -command "
3286 clipboard clear
3287 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3288 "
3289 bind $w <Visibility> "grab $w; focus $w"
3291 bind $w <Key-Escape> "destroy $w"
3292 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3293 wm title $w "About [appname]"
3294 tkwait window $w
3295}
3296proc do_options {} {
3298 global repo_config global_config font_descs
3299 global repo_config_new global_config_new
3300 array unset repo_config_new
3302 array unset global_config_new
3303 foreach name [array names repo_config] {
3304 set repo_config_new($name) $repo_config($name)
3305 }
3306 load_config 1
3307 foreach name [array names repo_config] {
3308 switch -- $name {
3309 gui.diffcontext {continue}
3310 }
3311 set repo_config_new($name) $repo_config($name)
3312 }
3313 foreach name [array names global_config] {
3314 set global_config_new($name) $global_config($name)
3315 }
3316 set w .options_editor
3318 toplevel $w
3319 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3320 label $w.header -text "[appname] Options" \
3322 -font font_uibold
3323 pack $w.header -side top -fill x
3324 frame $w.buttons
3326 button $w.buttons.restore -text {Restore Defaults} \
3327 -font font_ui \
3328 -command do_restore_defaults
3329 pack $w.buttons.restore -side left
3330 button $w.buttons.save -text Save \
3331 -font font_ui \
3332 -command "
3333 catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
3334 do_save_config $w
3335 "
3336 pack $w.buttons.save -side right
3337 button $w.buttons.cancel -text {Cancel} \
3338 -font font_ui \
3339 -command [list destroy $w]
3340 pack $w.buttons.cancel -side right -padx 5
3341 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3342 labelframe $w.repo -text "[reponame] Repository" \
3344 -font font_ui
3345 labelframe $w.global -text {Global (All Repositories)} \
3346 -font font_ui
3347 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
3348 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
3349 foreach option {
3351 {b pullsummary {Show Pull Summary}}
3352 {b trustmtime {Trust File Modification Timestamps}}
3353 {i diffcontext {Number of Diff Context Lines}}
3354 {t newbranchtemplate {New Branch Name Template}}
3355 } {
3356 set type [lindex $option 0]
3357 set name [lindex $option 1]
3358 set text [lindex $option 2]
3359 foreach f {repo global} {
3360 switch $type {
3361 b {
3362 checkbutton $w.$f.$name -text $text \
3363 -variable ${f}_config_new(gui.$name) \
3364 -onvalue true \
3365 -offvalue false \
3366 -font font_ui
3367 pack $w.$f.$name -side top -anchor w
3368 }
3369 i {
3370 frame $w.$f.$name
3371 label $w.$f.$name.l -text "$text:" -font font_ui
3372 pack $w.$f.$name.l -side left -anchor w -fill x
3373 spinbox $w.$f.$name.v \
3374 -textvariable ${f}_config_new(gui.$name) \
3375 -from 1 -to 99 -increment 1 \
3376 -width 3 \
3377 -font font_ui
3378 bind $w.$f.$name.v <FocusIn> {%W selection range 0 end}
3379 pack $w.$f.$name.v -side right -anchor e -padx 5
3380 pack $w.$f.$name -side top -anchor w -fill x
3381 }
3382 t {
3383 frame $w.$f.$name
3384 label $w.$f.$name.l -text "$text:" -font font_ui
3385 text $w.$f.$name.v \
3386 -borderwidth 1 \
3387 -relief sunken \
3388 -height 1 \
3389 -width 20 \
3390 -font font_ui
3391 $w.$f.$name.v insert 0.0 [set ${f}_config_new(gui.$name)]
3392 bind $w.$f.$name.v <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
3393 bind $w.$f.$name.v <Key-Tab> {focus [tk_focusNext %W];break}
3394 bind $w.$f.$name.v <Key-Return> break
3395 bind $w.$f.$name.v <FocusIn> "$w.$f.$name.v tag add sel 0.0 end"
3396 bind $w.$f.$name.v <FocusOut> "
3397 set ${f}_config_new(gui.$name) \
3398 \[string trim \[$w.$f.$name.v get 0.0 end\]\]
3399 "
3400 pack $w.$f.$name.l -side left -anchor w
3401 pack $w.$f.$name.v -side left -anchor w \
3402 -fill x -expand 1 \
3403 -padx 5
3404 pack $w.$f.$name -side top -anchor w -fill x
3405 }
3406 }
3407 }
3408 }
3409 set all_fonts [lsort [font families]]
3411 foreach option $font_descs {
3412 set name [lindex $option 0]
3413 set font [lindex $option 1]
3414 set text [lindex $option 2]
3415 set global_config_new(gui.$font^^family) \
3417 [font configure $font -family]
3418 set global_config_new(gui.$font^^size) \
3419 [font configure $font -size]
3420 frame $w.global.$name
3422 label $w.global.$name.l -text "$text:" -font font_ui
3423 pack $w.global.$name.l -side left -anchor w -fill x
3424 eval tk_optionMenu $w.global.$name.family \
3425 global_config_new(gui.$font^^family) \
3426 $all_fonts
3427 spinbox $w.global.$name.size \
3428 -textvariable global_config_new(gui.$font^^size) \
3429 -from 2 -to 80 -increment 1 \
3430 -width 3 \
3431 -font font_ui
3432 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3433 pack $w.global.$name.size -side right -anchor e
3434 pack $w.global.$name.family -side right -anchor e
3435 pack $w.global.$name -side top -anchor w -fill x
3436 }
3437 bind $w <Visibility> "grab $w; focus $w"
3439 bind $w <Key-Escape> "destroy $w"
3440 wm title $w "[appname] ([reponame]): Options"
3441 tkwait window $w
3442}
3443proc do_restore_defaults {} {
3445 global font_descs default_config repo_config
3446 global repo_config_new global_config_new
3447 foreach name [array names default_config] {
3449 set repo_config_new($name) $default_config($name)
3450 set global_config_new($name) $default_config($name)
3451 }
3452 foreach option $font_descs {
3454 set name [lindex $option 0]
3455 set repo_config(gui.$name) $default_config(gui.$name)
3456 }
3457 apply_config
3458 foreach option $font_descs {
3460 set name [lindex $option 0]
3461 set font [lindex $option 1]
3462 set global_config_new(gui.$font^^family) \
3463 [font configure $font -family]
3464 set global_config_new(gui.$font^^size) \
3465 [font configure $font -size]
3466 }
3467}
3468proc do_save_config {w} {
3470 if {[catch {save_config} err]} {
3471 error_popup "Failed to completely save options:\n\n$err"
3472 }
3473 reshow_diff
3474 destroy $w
3475}
3476proc do_windows_shortcut {} {
3478 global argv0
3479 if {[catch {
3481 set desktop [exec cygpath \
3482 --windows \
3483 --absolute \
3484 --long-name \
3485 --desktop]
3486 }]} {
3487 set desktop .
3488 }
3489 set fn [tk_getSaveFile \
3490 -parent . \
3491 -title "[appname] ([reponame]): Create Desktop Icon" \
3492 -initialdir $desktop \
3493 -initialfile "Git [reponame].bat"]
3494 if {$fn != {}} {
3495 if {[catch {
3496 set fd [open $fn w]
3497 set sh [exec cygpath \
3498 --windows \
3499 --absolute \
3500 /bin/sh]
3501 set me [exec cygpath \
3502 --unix \
3503 --absolute \
3504 $argv0]
3505 set gd [exec cygpath \
3506 --unix \
3507 --absolute \
3508 [gitdir]]
3509 set gw [exec cygpath \
3510 --windows \
3511 --absolute \
3512 [file dirname [gitdir]]]
3513 regsub -all ' $me "'\\''" me
3514 regsub -all ' $gd "'\\''" gd
3515 puts $fd "@ECHO Entering $gw"
3516 puts $fd "@ECHO Starting git-gui... please wait..."
3517 puts -nonewline $fd "@\"$sh\" --login -c \""
3518 puts -nonewline $fd "GIT_DIR='$gd'"
3519 puts -nonewline $fd " '$me'"
3520 puts $fd "&\""
3521 close $fd
3522 } err]} {
3523 error_popup "Cannot write script:\n\n$err"
3524 }
3525 }
3526}
3527proc do_macosx_app {} {
3529 global argv0 env
3530 set fn [tk_getSaveFile \
3532 -parent . \
3533 -title "[appname] ([reponame]): Create Desktop Icon" \
3534 -initialdir [file join $env(HOME) Desktop] \
3535 -initialfile "Git [reponame].app"]
3536 if {$fn != {}} {
3537 if {[catch {
3538 set Contents [file join $fn Contents]
3539 set MacOS [file join $Contents MacOS]
3540 set exe [file join $MacOS git-gui]
3541 file mkdir $MacOS
3543 set fd [open [file join $Contents Info.plist] w]
3545 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3546<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3547<plist version="1.0">
3548<dict>
3549 <key>CFBundleDevelopmentRegion</key>
3550 <string>English</string>
3551 <key>CFBundleExecutable</key>
3552 <string>git-gui</string>
3553 <key>CFBundleIdentifier</key>
3554 <string>org.spearce.git-gui</string>
3555 <key>CFBundleInfoDictionaryVersion</key>
3556 <string>6.0</string>
3557 <key>CFBundlePackageType</key>
3558 <string>APPL</string>
3559 <key>CFBundleSignature</key>
3560 <string>????</string>
3561 <key>CFBundleVersion</key>
3562 <string>1.0</string>
3563 <key>NSPrincipalClass</key>
3564 <string>NSApplication</string>
3565</dict>
3566</plist>}
3567 close $fd
3568 set fd [open $exe w]
3570 set gd [file normalize [gitdir]]
3571 set ep [file normalize [exec git --exec-path]]
3572 regsub -all ' $gd "'\\''" gd
3573 regsub -all ' $ep "'\\''" ep
3574 puts $fd "#!/bin/sh"
3575 foreach name [array names env] {
3576 if {[string match GIT_* $name]} {
3577 regsub -all ' $env($name) "'\\''" v
3578 puts $fd "export $name='$v'"
3579 }
3580 }
3581 puts $fd "export PATH='$ep':\$PATH"
3582 puts $fd "export GIT_DIR='$gd'"
3583 puts $fd "exec [file normalize $argv0]"
3584 close $fd
3585 file attributes $exe -permissions u+x,g+x,o+x
3587 } err]} {
3588 error_popup "Cannot write icon:\n\n$err"
3589 }
3590 }
3591}
3592proc toggle_or_diff {w x y} {
3594 global file_states file_lists current_diff_path ui_index ui_workdir
3595 global last_clicked selected_paths
3596 set pos [split [$w index @$x,$y] .]
3598 set lno [lindex $pos 0]
3599 set col [lindex $pos 1]
3600 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3601 if {$path eq {}} {
3602 set last_clicked {}
3603 return
3604 }
3605 set last_clicked [list $w $lno]
3607 array unset selected_paths
3608 $ui_index tag remove in_sel 0.0 end
3609 $ui_workdir tag remove in_sel 0.0 end
3610 if {$col == 0} {
3612 if {$current_diff_path eq $path} {
3613 set after {reshow_diff;}
3614 } else {
3615 set after {}
3616 }
3617 if {$w eq $ui_index} {
3618 update_indexinfo \
3619 "Unstaging [short_path $path] from commit" \
3620 [list $path] \
3621 [concat $after {set ui_status_value {Ready.}}]
3622 } elseif {$w eq $ui_workdir} {
3623 update_index \
3624 "Adding [short_path $path]" \
3625 [list $path] \
3626 [concat $after {set ui_status_value {Ready.}}]
3627 }
3628 } else {
3629 show_diff $path $w $lno
3630 }
3631}
3632proc add_one_to_selection {w x y} {
3634 global file_lists last_clicked selected_paths
3635 set lno [lindex [split [$w index @$x,$y] .] 0]
3637 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3638 if {$path eq {}} {
3639 set last_clicked {}
3640 return
3641 }
3642 if {$last_clicked ne {}
3644 && [lindex $last_clicked 0] ne $w} {
3645 array unset selected_paths
3646 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3647 }
3648 set last_clicked [list $w $lno]
3650 if {[catch {set in_sel $selected_paths($path)}]} {
3651 set in_sel 0
3652 }
3653 if {$in_sel} {
3654 unset selected_paths($path)
3655 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3656 } else {
3657 set selected_paths($path) 1
3658 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3659 }
3660}
3661proc add_range_to_selection {w x y} {
3663 global file_lists last_clicked selected_paths
3664 if {[lindex $last_clicked 0] ne $w} {
3666 toggle_or_diff $w $x $y
3667 return
3668 }
3669 set lno [lindex [split [$w index @$x,$y] .] 0]
3671 set lc [lindex $last_clicked 1]
3672 if {$lc < $lno} {
3673 set begin $lc
3674 set end $lno
3675 } else {
3676 set begin $lno
3677 set end $lc
3678 }
3679 foreach path [lrange $file_lists($w) \
3681 [expr {$begin - 1}] \
3682 [expr {$end - 1}]] {
3683 set selected_paths($path) 1
3684 }
3685 $w tag add in_sel $begin.0 [expr {$end + 1}].0
3686}
3687######################################################################
3689##
3690## config defaults
3691set cursor_ptr arrow
3693font create font_diff -family Courier -size 10
3694font create font_ui
3695catch {
3696 label .dummy
3697 eval font configure font_ui [font actual [.dummy cget -font]]
3698 destroy .dummy
3699}
3700font create font_uibold
3702font create font_diffbold
3703if {[is_Windows]} {
3705 set M1B Control
3706 set M1T Ctrl
3707} elseif {[is_MacOSX]} {
3708 set M1B M1
3709 set M1T Cmd
3710} else {
3711 set M1B M1
3712 set M1T M1
3713}
3714proc apply_config {} {
3716 global repo_config font_descs
3717 foreach option $font_descs {
3719 set name [lindex $option 0]
3720 set font [lindex $option 1]
3721 if {[catch {
3722 foreach {cn cv} $repo_config(gui.$name) {
3723 font configure $font $cn $cv
3724 }
3725 } err]} {
3726 error_popup "Invalid font specified in gui.$name:\n\n$err"
3727 }
3728 foreach {cn cv} [font configure $font] {
3729 font configure ${font}bold $cn $cv
3730 }
3731 font configure ${font}bold -weight bold
3732 }
3733}
3734set default_config(gui.trustmtime) false
3736set default_config(gui.pullsummary) true
3737set default_config(gui.diffcontext) 5
3738set default_config(gui.newbranchtemplate) {}
3739set default_config(gui.fontui) [font configure font_ui]
3740set default_config(gui.fontdiff) [font configure font_diff]
3741set font_descs {
3742 {fontui font_ui {Main Font}}
3743 {fontdiff font_diff {Diff/Console Font}}
3744}
3745load_config 0
3746apply_config
3747######################################################################
3749##
3750## ui construction
3751# -- Menu Bar
3753#
3754menu .mbar -tearoff 0
3755.mbar add cascade -label Repository -menu .mbar.repository
3756.mbar add cascade -label Edit -menu .mbar.edit
3757if {!$single_commit} {
3758 .mbar add cascade -label Branch -menu .mbar.branch
3759}
3760.mbar add cascade -label Commit -menu .mbar.commit
3761if {!$single_commit} {
3762 .mbar add cascade -label Fetch -menu .mbar.fetch
3763 .mbar add cascade -label Pull -menu .mbar.pull
3764 .mbar add cascade -label Push -menu .mbar.push
3765}
3766. configure -menu .mbar
3767# -- Repository Menu
3769#
3770menu .mbar.repository
3771.mbar.repository add command \
3772 -label {Visualize Current Branch} \
3773 -command {do_gitk {}} \
3774 -font font_ui
3775if {![is_MacOSX]} {
3776 .mbar.repository add command \
3777 -label {Visualize All Branches} \
3778 -command {do_gitk {--all}} \
3779 -font font_ui
3780}
3781.mbar.repository add separator
3782if {!$single_commit} {
3784 .mbar.repository add command -label {Database Statistics} \
3785 -command do_stats \
3786 -font font_ui
3787 .mbar.repository add command -label {Compress Database} \
3789 -command do_gc \
3790 -font font_ui
3791 .mbar.repository add command -label {Verify Database} \
3793 -command do_fsck_objects \
3794 -font font_ui
3795 .mbar.repository add separator
3797 if {[is_Windows]} {
3799 .mbar.repository add command \
3800 -label {Create Desktop Icon} \
3801 -command do_windows_shortcut \
3802 -font font_ui
3803 } elseif {[is_MacOSX]} {
3804 .mbar.repository add command \
3805 -label {Create Desktop Icon} \
3806 -command do_macosx_app \
3807 -font font_ui
3808 }
3809}
3810.mbar.repository add command -label Quit \
3812 -command do_quit \
3813 -accelerator $M1T-Q \
3814 -font font_ui
3815# -- Edit Menu
3817#
3818menu .mbar.edit
3819.mbar.edit add command -label Undo \
3820 -command {catch {[focus] edit undo}} \
3821 -accelerator $M1T-Z \
3822 -font font_ui
3823.mbar.edit add command -label Redo \
3824 -command {catch {[focus] edit redo}} \
3825 -accelerator $M1T-Y \
3826 -font font_ui
3827.mbar.edit add separator
3828.mbar.edit add command -label Cut \
3829 -command {catch {tk_textCut [focus]}} \
3830 -accelerator $M1T-X \
3831 -font font_ui
3832.mbar.edit add command -label Copy \
3833 -command {catch {tk_textCopy [focus]}} \
3834 -accelerator $M1T-C \
3835 -font font_ui
3836.mbar.edit add command -label Paste \
3837 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3838 -accelerator $M1T-V \
3839 -font font_ui
3840.mbar.edit add command -label Delete \
3841 -command {catch {[focus] delete sel.first sel.last}} \
3842 -accelerator Del \
3843 -font font_ui
3844.mbar.edit add separator
3845.mbar.edit add command -label {Select All} \
3846 -command {catch {[focus] tag add sel 0.0 end}} \
3847 -accelerator $M1T-A \
3848 -font font_ui
3849# -- Branch Menu
3851#
3852if {!$single_commit} {
3853 menu .mbar.branch
3854 .mbar.branch add command -label {Create...} \
3856 -command do_create_branch \
3857 -accelerator $M1T-N \
3858 -font font_ui
3859 lappend disable_on_lock [list .mbar.branch entryconf \
3860 [.mbar.branch index last] -state]
3861 .mbar.branch add command -label {Delete...} \
3863 -command do_delete_branch \
3864 -font font_ui
3865 lappend disable_on_lock [list .mbar.branch entryconf \
3866 [.mbar.branch index last] -state]
3867}
3868# -- Commit Menu
3870#
3871menu .mbar.commit
3872.mbar.commit add radiobutton \
3874 -label {New Commit} \
3875 -command do_select_commit_type \
3876 -variable selected_commit_type \
3877 -value new \
3878 -font font_ui
3879lappend disable_on_lock \
3880 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3881.mbar.commit add radiobutton \
3883 -label {Amend Last Commit} \
3884 -command do_select_commit_type \
3885 -variable selected_commit_type \
3886 -value amend \
3887 -font font_ui
3888lappend disable_on_lock \
3889 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3890.mbar.commit add separator
3892.mbar.commit add command -label Rescan \
3894 -command do_rescan \
3895 -accelerator F5 \
3896 -font font_ui
3897lappend disable_on_lock \
3898 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3899.mbar.commit add command -label {Add To Commit} \
3901 -command do_add_selection \
3902 -font font_ui
3903lappend disable_on_lock \
3904 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3905.mbar.commit add command -label {Add All To Commit} \
3907 -command do_add_all \
3908 -accelerator $M1T-I \
3909 -font font_ui
3910lappend disable_on_lock \
3911 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3912.mbar.commit add command -label {Unstage From Commit} \
3914 -command do_unstage_selection \
3915 -font font_ui
3916lappend disable_on_lock \
3917 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3918.mbar.commit add command -label {Revert Changes} \
3920 -command do_revert_selection \
3921 -font font_ui
3922lappend disable_on_lock \
3923 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3924.mbar.commit add separator
3926.mbar.commit add command -label {Sign Off} \
3928 -command do_signoff \
3929 -accelerator $M1T-S \
3930 -font font_ui
3931.mbar.commit add command -label Commit \
3933 -command do_commit \
3934 -accelerator $M1T-Return \
3935 -font font_ui
3936lappend disable_on_lock \
3937 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3938# -- Transport menus
3940#
3941if {!$single_commit} {
3942 menu .mbar.fetch
3943 menu .mbar.pull
3944 menu .mbar.push
3945}
3946if {[is_MacOSX]} {
3948 # -- Apple Menu (Mac OS X only)
3949 #
3950 .mbar add cascade -label Apple -menu .mbar.apple
3951 menu .mbar.apple
3952 .mbar.apple add command -label "About [appname]" \
3954 -command do_about \
3955 -font font_ui
3956 .mbar.apple add command -label "[appname] Options..." \
3957 -command do_options \
3958 -font font_ui
3959} else {
3960 # -- Edit Menu
3961 #
3962 .mbar.edit add separator
3963 .mbar.edit add command -label {Options...} \
3964 -command do_options \
3965 -font font_ui
3966 # -- Tools Menu
3968 #
3969 if {[file exists /usr/local/miga/lib/gui-miga]
3970 && [file exists .pvcsrc]} {
3971 proc do_miga {} {
3972 global ui_status_value
3973 if {![lock_index update]} return
3974 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3975 set miga_fd [open "|$cmd" r]
3976 fconfigure $miga_fd -blocking 0
3977 fileevent $miga_fd readable [list miga_done $miga_fd]
3978 set ui_status_value {Running miga...}
3979 }
3980 proc miga_done {fd} {
3981 read $fd 512
3982 if {[eof $fd]} {
3983 close $fd
3984 unlock_index
3985 rescan [list set ui_status_value {Ready.}]
3986 }
3987 }
3988 .mbar add cascade -label Tools -menu .mbar.tools
3989 menu .mbar.tools
3990 .mbar.tools add command -label "Migrate" \
3991 -command do_miga \
3992 -font font_ui
3993 lappend disable_on_lock \
3994 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3995 }
3996 # -- Help Menu
3998 #
3999 .mbar add cascade -label Help -menu .mbar.help
4000 menu .mbar.help
4001 .mbar.help add command -label "About [appname]" \
4003 -command do_about \
4004 -font font_ui
4005}
4006# -- Branch Control
4009#
4010frame .branch \
4011 -borderwidth 1 \
4012 -relief sunken
4013label .branch.l1 \
4014 -text {Current Branch:} \
4015 -anchor w \
4016 -justify left \
4017 -font font_ui
4018label .branch.cb \
4019 -textvariable current_branch \
4020 -anchor w \
4021 -justify left \
4022 -font font_ui
4023pack .branch.l1 -side left
4024pack .branch.cb -side left -fill x
4025pack .branch -side top -fill x
4026# -- Main Window Layout
4028#
4029panedwindow .vpane -orient vertical
4030panedwindow .vpane.files -orient horizontal
4031.vpane add .vpane.files -sticky nsew -height 100 -width 200
4032pack .vpane -anchor n -side top -fill both -expand 1
4033# -- Index File List
4035#
4036frame .vpane.files.index -height 100 -width 200
4037label .vpane.files.index.title -text {Changes To Be Committed} \
4038 -background green \
4039 -font font_ui
4040text $ui_index -background white -borderwidth 0 \
4041 -width 20 -height 10 \
4042 -wrap none \
4043 -font font_ui \
4044 -cursor $cursor_ptr \
4045 -xscrollcommand {.vpane.files.index.sx set} \
4046 -yscrollcommand {.vpane.files.index.sy set} \
4047 -state disabled
4048scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4049scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4050pack .vpane.files.index.title -side top -fill x
4051pack .vpane.files.index.sx -side bottom -fill x
4052pack .vpane.files.index.sy -side right -fill y
4053pack $ui_index -side left -fill both -expand 1
4054.vpane.files add .vpane.files.index -sticky nsew
4055# -- Working Directory File List
4057#
4058frame .vpane.files.workdir -height 100 -width 200
4059label .vpane.files.workdir.title -text {Changed But Not Updated} \
4060 -background red \
4061 -font font_ui
4062text $ui_workdir -background white -borderwidth 0 \
4063 -width 20 -height 10 \
4064 -wrap none \
4065 -font font_ui \
4066 -cursor $cursor_ptr \
4067 -xscrollcommand {.vpane.files.workdir.sx set} \
4068 -yscrollcommand {.vpane.files.workdir.sy set} \
4069 -state disabled
4070scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4071scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4072pack .vpane.files.workdir.title -side top -fill x
4073pack .vpane.files.workdir.sx -side bottom -fill x
4074pack .vpane.files.workdir.sy -side right -fill y
4075pack $ui_workdir -side left -fill both -expand 1
4076.vpane.files add .vpane.files.workdir -sticky nsew
4077foreach i [list $ui_index $ui_workdir] {
4079 $i tag conf in_diff -font font_uibold
4080 $i tag conf in_sel \
4081 -background [$i cget -foreground] \
4082 -foreground [$i cget -background]
4083}
4084unset i
4085# -- Diff and Commit Area
4087#
4088frame .vpane.lower -height 300 -width 400
4089frame .vpane.lower.commarea
4090frame .vpane.lower.diff -relief sunken -borderwidth 1
4091pack .vpane.lower.commarea -side top -fill x
4092pack .vpane.lower.diff -side bottom -fill both -expand 1
4093.vpane add .vpane.lower -sticky nsew
4094# -- Commit Area Buttons
4096#
4097frame .vpane.lower.commarea.buttons
4098label .vpane.lower.commarea.buttons.l -text {} \
4099 -anchor w \
4100 -justify left \
4101 -font font_ui
4102pack .vpane.lower.commarea.buttons.l -side top -fill x
4103pack .vpane.lower.commarea.buttons -side left -fill y
4104button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4106 -command do_rescan \
4107 -font font_ui
4108pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4109lappend disable_on_lock \
4110 {.vpane.lower.commarea.buttons.rescan conf -state}
4111button .vpane.lower.commarea.buttons.incall -text {Add All} \
4113 -command do_add_all \
4114 -font font_ui
4115pack .vpane.lower.commarea.buttons.incall -side top -fill x
4116lappend disable_on_lock \
4117 {.vpane.lower.commarea.buttons.incall conf -state}
4118button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4120 -command do_signoff \
4121 -font font_ui
4122pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4123button .vpane.lower.commarea.buttons.commit -text {Commit} \
4125 -command do_commit \
4126 -font font_ui
4127pack .vpane.lower.commarea.buttons.commit -side top -fill x
4128lappend disable_on_lock \
4129 {.vpane.lower.commarea.buttons.commit conf -state}
4130# -- Commit Message Buffer
4132#
4133frame .vpane.lower.commarea.buffer
4134frame .vpane.lower.commarea.buffer.header
4135set ui_comm .vpane.lower.commarea.buffer.t
4136set ui_coml .vpane.lower.commarea.buffer.header.l
4137radiobutton .vpane.lower.commarea.buffer.header.new \
4138 -text {New Commit} \
4139 -command do_select_commit_type \
4140 -variable selected_commit_type \
4141 -value new \
4142 -font font_ui
4143lappend disable_on_lock \
4144 [list .vpane.lower.commarea.buffer.header.new conf -state]
4145radiobutton .vpane.lower.commarea.buffer.header.amend \
4146 -text {Amend Last Commit} \
4147 -command do_select_commit_type \
4148 -variable selected_commit_type \
4149 -value amend \
4150 -font font_ui
4151lappend disable_on_lock \
4152 [list .vpane.lower.commarea.buffer.header.amend conf -state]
4153label $ui_coml \
4154 -anchor w \
4155 -justify left \
4156 -font font_ui
4157proc trace_commit_type {varname args} {
4158 global ui_coml commit_type
4159 switch -glob -- $commit_type {
4160 initial {set txt {Initial Commit Message:}}
4161 amend {set txt {Amended Commit Message:}}
4162 amend-initial {set txt {Amended Initial Commit Message:}}
4163 amend-merge {set txt {Amended Merge Commit Message:}}
4164 merge {set txt {Merge Commit Message:}}
4165 * {set txt {Commit Message:}}
4166 }
4167 $ui_coml conf -text $txt
4168}
4169trace add variable commit_type write trace_commit_type
4170pack $ui_coml -side left -fill x
4171pack .vpane.lower.commarea.buffer.header.amend -side right
4172pack .vpane.lower.commarea.buffer.header.new -side right
4173text $ui_comm -background white -borderwidth 1 \
4175 -undo true \
4176 -maxundo 20 \
4177 -autoseparators true \
4178 -relief sunken \
4179 -width 75 -height 9 -wrap none \
4180 -font font_diff \
4181 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4182scrollbar .vpane.lower.commarea.buffer.sby \
4183 -command [list $ui_comm yview]
4184pack .vpane.lower.commarea.buffer.header -side top -fill x
4185pack .vpane.lower.commarea.buffer.sby -side right -fill y
4186pack $ui_comm -side left -fill y
4187pack .vpane.lower.commarea.buffer -side left -fill y
4188# -- Commit Message Buffer Context Menu
4190#
4191set ctxm .vpane.lower.commarea.buffer.ctxm
4192menu $ctxm -tearoff 0
4193$ctxm add command \
4194 -label {Cut} \
4195 -font font_ui \
4196 -command {tk_textCut $ui_comm}
4197$ctxm add command \
4198 -label {Copy} \
4199 -font font_ui \
4200 -command {tk_textCopy $ui_comm}
4201$ctxm add command \
4202 -label {Paste} \
4203 -font font_ui \
4204 -command {tk_textPaste $ui_comm}
4205$ctxm add command \
4206 -label {Delete} \
4207 -font font_ui \
4208 -command {$ui_comm delete sel.first sel.last}
4209$ctxm add separator
4210$ctxm add command \
4211 -label {Select All} \
4212 -font font_ui \
4213 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4214$ctxm add command \
4215 -label {Copy All} \
4216 -font font_ui \
4217 -command {
4218 $ui_comm tag add sel 0.0 end
4219 tk_textCopy $ui_comm
4220 $ui_comm tag remove sel 0.0 end
4221 }
4222$ctxm add separator
4223$ctxm add command \
4224 -label {Sign Off} \
4225 -font font_ui \
4226 -command do_signoff
4227bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
4228# -- Diff Header
4230#
4231set current_diff_path {}
4232set current_diff_side {}
4233set diff_actions [list]
4234proc trace_current_diff_path {varname args} {
4235 global current_diff_path diff_actions file_states
4236 if {$current_diff_path eq {}} {
4237 set s {}
4238 set f {}
4239 set p {}
4240 set o disabled
4241 } else {
4242 set p $current_diff_path
4243 set s [mapdesc [lindex $file_states($p) 0] $p]
4244 set f {File:}
4245 set p [escape_path $p]
4246 set o normal
4247 }
4248 .vpane.lower.diff.header.status configure -text $s
4250 .vpane.lower.diff.header.file configure -text $f
4251 .vpane.lower.diff.header.path configure -text $p
4252 foreach w $diff_actions {
4253 uplevel #0 $w $o
4254 }
4255}
4256trace add variable current_diff_path write trace_current_diff_path
4257frame .vpane.lower.diff.header -background orange
4259label .vpane.lower.diff.header.status \
4260 -background orange \
4261 -width $max_status_desc \
4262 -anchor w \
4263 -justify left \
4264 -font font_ui
4265label .vpane.lower.diff.header.file \
4266 -background orange \
4267 -anchor w \
4268 -justify left \
4269 -font font_ui
4270label .vpane.lower.diff.header.path \
4271 -background orange \
4272 -anchor w \
4273 -justify left \
4274 -font font_ui
4275pack .vpane.lower.diff.header.status -side left
4276pack .vpane.lower.diff.header.file -side left
4277pack .vpane.lower.diff.header.path -fill x
4278set ctxm .vpane.lower.diff.header.ctxm
4279menu $ctxm -tearoff 0
4280$ctxm add command \
4281 -label {Copy} \
4282 -font font_ui \
4283 -command {
4284 clipboard clear
4285 clipboard append \
4286 -format STRING \
4287 -type STRING \
4288 -- $current_diff_path
4289 }
4290lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4291bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
4292# -- Diff Body
4294#
4295frame .vpane.lower.diff.body
4296set ui_diff .vpane.lower.diff.body.t
4297text $ui_diff -background white -borderwidth 0 \
4298 -width 80 -height 15 -wrap none \
4299 -font font_diff \
4300 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4301 -yscrollcommand {.vpane.lower.diff.body.sby set} \
4302 -state disabled
4303scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4304 -command [list $ui_diff xview]
4305scrollbar .vpane.lower.diff.body.sby -orient vertical \
4306 -command [list $ui_diff yview]
4307pack .vpane.lower.diff.body.sbx -side bottom -fill x
4308pack .vpane.lower.diff.body.sby -side right -fill y
4309pack $ui_diff -side left -fill both -expand 1
4310pack .vpane.lower.diff.header -side top -fill x
4311pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4312$ui_diff tag conf d_cr -elide true
4314$ui_diff tag conf d_@ -foreground blue -font font_diffbold
4315$ui_diff tag conf d_+ -foreground {#00a000}
4316$ui_diff tag conf d_- -foreground red
4317$ui_diff tag conf d_++ -foreground {#00a000}
4319$ui_diff tag conf d_-- -foreground red
4320$ui_diff tag conf d_+s \
4321 -foreground {#00a000} \
4322 -background {#e2effa}
4323$ui_diff tag conf d_-s \
4324 -foreground red \
4325 -background {#e2effa}
4326$ui_diff tag conf d_s+ \
4327 -foreground {#00a000} \
4328 -background ivory1
4329$ui_diff tag conf d_s- \
4330 -foreground red \
4331 -background ivory1
4332$ui_diff tag conf d<<<<<<< \
4334 -foreground orange \
4335 -font font_diffbold
4336$ui_diff tag conf d======= \
4337 -foreground orange \
4338 -font font_diffbold
4339$ui_diff tag conf d>>>>>>> \
4340 -foreground orange \
4341 -font font_diffbold
4342$ui_diff tag raise sel
4344# -- Diff Body Context Menu
4346#
4347set ctxm .vpane.lower.diff.body.ctxm
4348menu $ctxm -tearoff 0
4349$ctxm add command \
4350 -label {Refresh} \
4351 -font font_ui \
4352 -command reshow_diff
4353lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4354$ctxm add command \
4355 -label {Copy} \
4356 -font font_ui \
4357 -command {tk_textCopy $ui_diff}
4358lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4359$ctxm add command \
4360 -label {Select All} \
4361 -font font_ui \
4362 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4363lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4364$ctxm add command \
4365 -label {Copy All} \
4366 -font font_ui \
4367 -command {
4368 $ui_diff tag add sel 0.0 end
4369 tk_textCopy $ui_diff
4370 $ui_diff tag remove sel 0.0 end
4371 }
4372lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4373$ctxm add separator
4374$ctxm add command \
4375 -label {Apply/Reverse Hunk} \
4376 -font font_ui \
4377 -command {apply_hunk $cursorX $cursorY}
4378set ui_diff_applyhunk [$ctxm index last]
4379lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4380$ctxm add separator
4381$ctxm add command \
4382 -label {Decrease Font Size} \
4383 -font font_ui \
4384 -command {incr_font_size font_diff -1}
4385lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4386$ctxm add command \
4387 -label {Increase Font Size} \
4388 -font font_ui \
4389 -command {incr_font_size font_diff 1}
4390lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4391$ctxm add separator
4392$ctxm add command \
4393 -label {Show Less Context} \
4394 -font font_ui \
4395 -command {if {$repo_config(gui.diffcontext) >= 2} {
4396 incr repo_config(gui.diffcontext) -1
4397 reshow_diff
4398 }}
4399lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4400$ctxm add command \
4401 -label {Show More Context} \
4402 -font font_ui \
4403 -command {
4404 incr repo_config(gui.diffcontext)
4405 reshow_diff
4406 }
4407lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4408$ctxm add separator
4409$ctxm add command -label {Options...} \
4410 -font font_ui \
4411 -command do_options
4412bind_button3 $ui_diff "
4413 set cursorX %x
4414 set cursorY %y
4415 if {\$ui_index eq \$current_diff_side} {
4416 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
4417 } else {
4418 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
4419 }
4420 tk_popup $ctxm %X %Y
4421"
4422unset ui_diff_applyhunk
4423# -- Status Bar
4425#
4426set ui_status_value {Initializing...}
4427label .status -textvariable ui_status_value \
4428 -anchor w \
4429 -justify left \
4430 -borderwidth 1 \
4431 -relief sunken \
4432 -font font_ui
4433pack .status -anchor w -side bottom -fill x
4434# -- Load geometry
4436#
4437catch {
4438set gm $repo_config(gui.geometry)
4439wm geometry . [lindex $gm 0]
4440.vpane sash place 0 \
4441 [lindex [.vpane sash coord 0] 0] \
4442 [lindex $gm 1]
4443.vpane.files sash place 0 \
4444 [lindex $gm 2] \
4445 [lindex [.vpane.files sash coord 0] 1]
4446unset gm
4447}
4448# -- Key Bindings
4450#
4451bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4452bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4453bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4454bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4455bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4456bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4457bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4458bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4459bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4460bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4461bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4462bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4464bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4465bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4466bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4467bind $ui_diff <$M1B-Key-v> {break}
4468bind $ui_diff <$M1B-Key-V> {break}
4469bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4470bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4471bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
4472bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
4473bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
4474bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
4475if {!$single_commit} {
4477 bind . <$M1B-Key-n> do_create_branch
4478 bind . <$M1B-Key-N> do_create_branch
4479}
4480bind . <Destroy> do_quit
4482bind all <Key-F5> do_rescan
4483bind all <$M1B-Key-r> do_rescan
4484bind all <$M1B-Key-R> do_rescan
4485bind . <$M1B-Key-s> do_signoff
4486bind . <$M1B-Key-S> do_signoff
4487bind . <$M1B-Key-i> do_add_all
4488bind . <$M1B-Key-I> do_add_all
4489bind . <$M1B-Key-Return> do_commit
4490bind all <$M1B-Key-q> do_quit
4491bind all <$M1B-Key-Q> do_quit
4492bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4493bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4494foreach i [list $ui_index $ui_workdir] {
4495 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
4496 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
4497 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4498}
4499unset i
4500set file_lists($ui_index) [list]
4502set file_lists($ui_workdir) [list]
4503set HEAD {}
4505set PARENT {}
4506set MERGE_HEAD [list]
4507set commit_type {}
4508set empty_tree {}
4509set current_branch {}
4510set current_diff_path {}
4511set selected_commit_type new
4512wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
4514focus -force $ui_comm
4515# -- Warn the user about environmental problems. Cygwin's Tcl
4517# does *not* pass its env array onto any processes it spawns.
4518# This means that git processes get none of our environment.
4519#
4520if {[is_Windows]} {
4521 set ignored_env 0
4522 set suggest_user {}
4523 set msg "Possible environment issues exist.
4524The following environment variables are probably
4526going to be ignored by any Git subprocess run
4527by [appname]:
4528"
4530 foreach name [array names env] {
4531 switch -regexp -- $name {
4532 {^GIT_INDEX_FILE$} -
4533 {^GIT_OBJECT_DIRECTORY$} -
4534 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4535 {^GIT_DIFF_OPTS$} -
4536 {^GIT_EXTERNAL_DIFF$} -
4537 {^GIT_PAGER$} -
4538 {^GIT_TRACE$} -
4539 {^GIT_CONFIG$} -
4540 {^GIT_CONFIG_LOCAL$} -
4541 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4542 append msg " - $name\n"
4543 incr ignored_env
4544 }
4545 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4546 append msg " - $name\n"
4547 incr ignored_env
4548 set suggest_user $name
4549 }
4550 }
4551 }
4552 if {$ignored_env > 0} {
4553 append msg "
4554This is due to a known issue with the
4555Tcl binary distributed by Cygwin."
4556 if {$suggest_user ne {}} {
4558 append msg "
4559A good replacement for $suggest_user
4561is placing values for the user.name and
4562user.email settings into your personal
4563~/.gitconfig file.
4564"
4565 }
4566 warn_popup $msg
4567 }
4568 unset ignored_env msg suggest_user name
4569}
4570# -- Only initialize complex UI if we are going to stay running.
4572#
4573if {!$single_commit} {
4574 load_all_remotes
4575 load_all_heads
4576 populate_branch_menu
4578 populate_fetch_menu .mbar.fetch
4579 populate_pull_menu .mbar.pull
4580 populate_push_menu .mbar.push
4581}
4582# -- Only suggest a gc run if we are going to stay running.
4584#
4585if {!$single_commit} {
4586 set object_limit 2000
4587 if {[is_Windows]} {set object_limit 200}
4588 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4589 if {$objects_current >= $object_limit} {
4590 if {[ask_popup \
4591 "This repository currently has $objects_current loose objects.
4592To maintain optimal performance it is strongly
4594recommended that you compress the database
4595when more than $object_limit loose objects exist.
4596Compress the database now?"] eq yes} {
4598 do_gc
4599 }
4600 }
4601 unset object_limit _junk objects_current
4602}
4603lock_index begin-read
4605after 1 do_rescan