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