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