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