1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4set appvers {@@GIT_VERSION@@}
6set copyright {
7Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
8This program is free software; you can redistribute it and/or modify
10it under the terms of the GNU General Public License as published by
11the Free Software Foundation; either version 2 of the License, or
12(at your option) any later version.
13This program is distributed in the hope that it will be useful,
15but WITHOUT ANY WARRANTY; without even the implied warranty of
16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17GNU General Public License for more details.
18You should have received a copy of the GNU General Public License
20along with this program; if not, write to the Free Software
21Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
22######################################################################
24##
25## read only globals
26set _appname [lindex [file split $argv0] end]
28set _gitdir {}
29set _reponame {}
30proc appname {} {
32 global _appname
33 return $_appname
34}
35proc gitdir {args} {
37 global _gitdir
38 if {$args eq {}} {
39 return $_gitdir
40 }
41 return [eval [concat [list file join $_gitdir] $args]]
42}
43proc reponame {} {
45 global _reponame
46 return $_reponame
47}
48######################################################################
50##
51## config
52proc is_many_config {name} {
54 switch -glob -- $name {
55 remote.*.fetch -
56 remote.*.push
57 {return 1}
58 *
59 {return 0}
60 }
61}
62proc load_config {include_global} {
64 global repo_config global_config default_config
65 array unset global_config
67 if {$include_global} {
68 catch {
69 set fd_rc [open "| git repo-config --global --list" r]
70 while {[gets $fd_rc line] >= 0} {
71 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
72 if {[is_many_config $name]} {
73 lappend global_config($name) $value
74 } else {
75 set global_config($name) $value
76 }
77 }
78 }
79 close $fd_rc
80 }
81 }
82 array unset repo_config
84 catch {
85 set fd_rc [open "| git repo-config --list" r]
86 while {[gets $fd_rc line] >= 0} {
87 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
88 if {[is_many_config $name]} {
89 lappend repo_config($name) $value
90 } else {
91 set repo_config($name) $value
92 }
93 }
94 }
95 close $fd_rc
96 }
97 foreach name [array names default_config] {
99 if {[catch {set v $global_config($name)}]} {
100 set global_config($name) $default_config($name)
101 }
102 if {[catch {set v $repo_config($name)}]} {
103 set repo_config($name) $default_config($name)
104 }
105 }
106}
107proc save_config {} {
109 global default_config font_descs
110 global repo_config global_config
111 global repo_config_new global_config_new
112 foreach option $font_descs {
114 set name [lindex $option 0]
115 set font [lindex $option 1]
116 font configure $font \
117 -family $global_config_new(gui.$font^^family) \
118 -size $global_config_new(gui.$font^^size)
119 font configure ${font}bold \
120 -family $global_config_new(gui.$font^^family) \
121 -size $global_config_new(gui.$font^^size)
122 set global_config_new(gui.$name) [font configure $font]
123 unset global_config_new(gui.$font^^family)
124 unset global_config_new(gui.$font^^size)
125 }
126 foreach name [array names default_config] {
128 set value $global_config_new($name)
129 if {$value ne $global_config($name)} {
130 if {$value eq $default_config($name)} {
131 catch {exec git repo-config --global --unset $name}
132 } else {
133 regsub -all "\[{}\]" $value {"} value
134 exec git repo-config --global $name $value
135 }
136 set global_config($name) $value
137 if {$value eq $repo_config($name)} {
138 catch {exec git repo-config --unset $name}
139 set repo_config($name) $value
140 }
141 }
142 }
143 foreach name [array names default_config] {
145 set value $repo_config_new($name)
146 if {$value ne $repo_config($name)} {
147 if {$value eq $global_config($name)} {
148 catch {exec git repo-config --unset $name}
149 } else {
150 regsub -all "\[{}\]" $value {"} value
151 exec git repo-config $name $value
152 }
153 set repo_config($name) $value
154 }
155 }
156}
157proc error_popup {msg} {
159 set title [appname]
160 if {[reponame] ne {}} {
161 append title " ([reponame])"
162 }
163 set cmd [list tk_messageBox \
164 -icon error \
165 -type ok \
166 -title "$title: error" \
167 -message $msg]
168 if {[winfo ismapped .]} {
169 lappend cmd -parent .
170 }
171 eval $cmd
172}
173proc warn_popup {msg} {
175 set title [appname]
176 if {[reponame] ne {}} {
177 append title " ([reponame])"
178 }
179 set cmd [list tk_messageBox \
180 -icon warning \
181 -type ok \
182 -title "$title: warning" \
183 -message $msg]
184 if {[winfo ismapped .]} {
185 lappend cmd -parent .
186 }
187 eval $cmd
188}
189proc info_popup {msg {parent .}} {
191 set title [appname]
192 if {[reponame] ne {}} {
193 append title " ([reponame])"
194 }
195 tk_messageBox \
196 -parent $parent \
197 -icon info \
198 -type ok \
199 -title $title \
200 -message $msg
201}
202proc ask_popup {msg} {
204 set title [appname]
205 if {[reponame] ne {}} {
206 append title " ([reponame])"
207 }
208 return [tk_messageBox \
209 -parent . \
210 -icon question \
211 -type yesno \
212 -title $title \
213 -message $msg]
214}
215######################################################################
217##
218## repository setup
219if { [catch {set _gitdir $env(GIT_DIR)}]
221 && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
222 catch {wm withdraw .}
223 error_popup "Cannot find the git directory:\n\n$err"
224 exit 1
225}
226if {![file isdirectory $_gitdir]} {
227 catch {wm withdraw .}
228 error_popup "Git directory not found:\n\n$_gitdir"
229 exit 1
230}
231if {[lindex [file split $_gitdir] end] ne {.git}} {
232 catch {wm withdraw .}
233 error_popup "Cannot use funny .git directory:\n\n$gitdir"
234 exit 1
235}
236if {[catch {cd [file dirname $_gitdir]} err]} {
237 catch {wm withdraw .}
238 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
239 exit 1
240}
241set _reponame [lindex [file split \
242 [file normalize [file dirname $_gitdir]]] \
243 end]
244set single_commit 0
246if {[appname] eq {git-citool}} {
247 set single_commit 1
248}
249######################################################################
251##
252## task management
253set rescan_active 0
255set diff_active 0
256set last_clicked {}
257set disable_on_lock [list]
259set index_lock_type none
260proc lock_index {type} {
262 global index_lock_type disable_on_lock
263 if {$index_lock_type eq {none}} {
265 set index_lock_type $type
266 foreach w $disable_on_lock {
267 uplevel #0 $w disabled
268 }
269 return 1
270 } elseif {$index_lock_type eq "begin-$type"} {
271 set index_lock_type $type
272 return 1
273 }
274 return 0
275}
276proc unlock_index {} {
278 global index_lock_type disable_on_lock
279 set index_lock_type none
281 foreach w $disable_on_lock {
282 uplevel #0 $w normal
283 }
284}
285######################################################################
287##
288## status
289proc repository_state {ctvar hdvar mhvar} {
291 global current_branch
292 upvar $ctvar ct $hdvar hd $mhvar mh
293 set mh [list]
295 if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
297 set current_branch {}
298 } else {
299 regsub ^refs/((heads|tags|remotes)/)? \
300 $current_branch \
301 {} \
302 current_branch
303 }
304 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
306 set hd {}
307 set ct initial
308 return
309 }
310 set merge_head [gitdir MERGE_HEAD]
312 if {[file exists $merge_head]} {
313 set ct merge
314 set fd_mh [open $merge_head r]
315 while {[gets $fd_mh line] >= 0} {
316 lappend mh $line
317 }
318 close $fd_mh
319 return
320 }
321 set ct normal
323}
324proc PARENT {} {
326 global PARENT empty_tree
327 set p [lindex $PARENT 0]
329 if {$p ne {}} {
330 return $p
331 }
332 if {$empty_tree eq {}} {
333 set empty_tree [exec git mktree << {}]
334 }
335 return $empty_tree
336}
337proc rescan {after {honor_trustmtime 1}} {
339 global HEAD PARENT MERGE_HEAD commit_type
340 global ui_index ui_workdir ui_status_value ui_comm
341 global rescan_active file_states
342 global repo_config
343 if {$rescan_active > 0 || ![lock_index read]} return
345 repository_state newType newHEAD newMERGE_HEAD
347 if {[string match amend* $commit_type]
348 && $newType eq {normal}
349 && $newHEAD eq $HEAD} {
350 } else {
351 set HEAD $newHEAD
352 set PARENT $newHEAD
353 set MERGE_HEAD $newMERGE_HEAD
354 set commit_type $newType
355 }
356 array unset file_states
358 if {![$ui_comm edit modified]
360 || [string trim [$ui_comm get 0.0 end]] eq {}} {
361 if {[load_message GITGUI_MSG]} {
362 } elseif {[load_message MERGE_MSG]} {
363 } elseif {[load_message SQUASH_MSG]} {
364 }
365 $ui_comm edit reset
366 $ui_comm edit modified false
367 }
368 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
370 rescan_stage2 {} $after
371 } else {
372 set rescan_active 1
373 set ui_status_value {Refreshing file status...}
374 set cmd [list git update-index]
375 lappend cmd -q
376 lappend cmd --unmerged
377 lappend cmd --ignore-missing
378 lappend cmd --refresh
379 set fd_rf [open "| $cmd" r]
380 fconfigure $fd_rf -blocking 0 -translation binary
381 fileevent $fd_rf readable \
382 [list rescan_stage2 $fd_rf $after]
383 }
384}
385proc rescan_stage2 {fd after} {
387 global ui_status_value
388 global rescan_active buf_rdi buf_rdf buf_rlo
389 if {$fd ne {}} {
391 read $fd
392 if {![eof $fd]} return
393 close $fd
394 }
395 set ls_others [list | git ls-files --others -z \
397 --exclude-per-directory=.gitignore]
398 set info_exclude [gitdir info exclude]
399 if {[file readable $info_exclude]} {
400 lappend ls_others "--exclude-from=$info_exclude"
401 }
402 set buf_rdi {}
404 set buf_rdf {}
405 set buf_rlo {}
406 set rescan_active 3
408 set ui_status_value {Scanning for modified files ...}
409 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
410 set fd_df [open "| git diff-files -z" r]
411 set fd_lo [open $ls_others r]
412 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
414 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
415 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
416 fileevent $fd_di readable [list read_diff_index $fd_di $after]
417 fileevent $fd_df readable [list read_diff_files $fd_df $after]
418 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
419}
420proc load_message {file} {
422 global ui_comm
423 set f [gitdir $file]
425 if {[file isfile $f]} {
426 if {[catch {set fd [open $f r]}]} {
427 return 0
428 }
429 set content [string trim [read $fd]]
430 close $fd
431 regsub -all -line {[ \r\t]+$} $content {} content
432 $ui_comm delete 0.0 end
433 $ui_comm insert end $content
434 return 1
435 }
436 return 0
437}
438proc read_diff_index {fd after} {
440 global buf_rdi
441 append buf_rdi [read $fd]
443 set c 0
444 set n [string length $buf_rdi]
445 while {$c < $n} {
446 set z1 [string first "\0" $buf_rdi $c]
447 if {$z1 == -1} break
448 incr z1
449 set z2 [string first "\0" $buf_rdi $z1]
450 if {$z2 == -1} break
451 incr c
453 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
454 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
455 merge_state \
456 [encoding convertfrom $p] \
457 [lindex $i 4]? \
458 [list [lindex $i 0] [lindex $i 2]] \
459 [list]
460 set c $z2
461 incr c
462 }
463 if {$c < $n} {
464 set buf_rdi [string range $buf_rdi $c end]
465 } else {
466 set buf_rdi {}
467 }
468 rescan_done $fd buf_rdi $after
470}
471proc read_diff_files {fd after} {
473 global buf_rdf
474 append buf_rdf [read $fd]
476 set c 0
477 set n [string length $buf_rdf]
478 while {$c < $n} {
479 set z1 [string first "\0" $buf_rdf $c]
480 if {$z1 == -1} break
481 incr z1
482 set z2 [string first "\0" $buf_rdf $z1]
483 if {$z2 == -1} break
484 incr c
486 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
487 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
488 merge_state \
489 [encoding convertfrom $p] \
490 ?[lindex $i 4] \
491 [list] \
492 [list [lindex $i 0] [lindex $i 2]]
493 set c $z2
494 incr c
495 }
496 if {$c < $n} {
497 set buf_rdf [string range $buf_rdf $c end]
498 } else {
499 set buf_rdf {}
500 }
501 rescan_done $fd buf_rdf $after
503}
504proc read_ls_others {fd after} {
506 global buf_rlo
507 append buf_rlo [read $fd]
509 set pck [split $buf_rlo "\0"]
510 set buf_rlo [lindex $pck end]
511 foreach p [lrange $pck 0 end-1] {
512 merge_state [encoding convertfrom $p] ?O
513 }
514 rescan_done $fd buf_rlo $after
515}
516proc rescan_done {fd buf after} {
518 global rescan_active
519 global file_states repo_config
520 upvar $buf to_clear
521 if {![eof $fd]} return
523 set to_clear {}
524 close $fd
525 if {[incr rescan_active -1] > 0} return
526 prune_selection
528 unlock_index
529 display_all_files
530 reshow_diff
531 uplevel #0 $after
532}
533proc prune_selection {} {
535 global file_states selected_paths
536 foreach path [array names selected_paths] {
538 if {[catch {set still_here $file_states($path)}]} {
539 unset selected_paths($path)
540 }
541 }
542}
543######################################################################
545##
546## diff
547proc clear_diff {} {
549 global ui_diff current_diff_path current_diff_header
550 global ui_index ui_workdir
551 $ui_diff conf -state normal
553 $ui_diff delete 0.0 end
554 $ui_diff conf -state disabled
555 set current_diff_path {}
557 set current_diff_header {}
558 $ui_index tag remove in_diff 0.0 end
560 $ui_workdir tag remove in_diff 0.0 end
561}
562proc reshow_diff {} {
564 global ui_status_value file_states file_lists
565 global current_diff_path current_diff_side
566 set p $current_diff_path
568 if {$p eq {}
569 || $current_diff_side eq {}
570 || [catch {set s $file_states($p)}]
571 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
572 clear_diff
573 } else {
574 show_diff $p $current_diff_side
575 }
576}
577proc handle_empty_diff {} {
579 global current_diff_path file_states file_lists
580 set path $current_diff_path
582 set s $file_states($path)
583 if {[lindex $s 0] ne {_M}} return
584 info_popup "No differences detected.
586[short_path $path] has no changes.
588The modification date of this file was updated
590by another application, but the content within
591the file was not changed.
592A rescan will be automatically started to find
594other files which may have the same state."
595 clear_diff
597 display_file $path __
598 rescan {set ui_status_value {Ready.}} 0
599}
600proc show_diff {path w {lno {}}} {
602 global file_states file_lists
603 global is_3way_diff diff_active repo_config
604 global ui_diff ui_status_value ui_index ui_workdir
605 global current_diff_path current_diff_side current_diff_header
606 if {$diff_active || ![lock_index read]} return
608 clear_diff
610 if {$lno == {}} {
611 set lno [lsearch -sorted -exact $file_lists($w) $path]
612 if {$lno >= 0} {
613 incr lno
614 }
615 }
616 if {$lno >= 1} {
617 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
618 }
619 set s $file_states($path)
621 set m [lindex $s 0]
622 set is_3way_diff 0
623 set diff_active 1
624 set current_diff_path $path
625 set current_diff_side $w
626 set current_diff_header {}
627 set ui_status_value "Loading diff of [escape_path $path]..."
628 # - Git won't give us the diff, there's nothing to compare to!
630 #
631 if {$m eq {_O}} {
632 set max_sz [expr {128 * 1024}]
633 if {[catch {
634 set fd [open $path r]
635 set content [read $fd $max_sz]
636 close $fd
637 set sz [file size $path]
638 } err ]} {
639 set diff_active 0
640 unlock_index
641 set ui_status_value "Unable to display [escape_path $path]"
642 error_popup "Error loading file:\n\n$err"
643 return
644 }
645 $ui_diff conf -state normal
646 if {![catch {set type [exec file $path]}]} {
647 set n [string length $path]
648 if {[string equal -length $n $path $type]} {
649 set type [string range $type $n end]
650 regsub {^:?\s*} $type {} type
651 }
652 $ui_diff insert end "* $type\n" d_@
653 }
654 if {[string first "\0" $content] != -1} {
655 $ui_diff insert end \
656 "* Binary file (not showing content)." \
657 d_@
658 } else {
659 if {$sz > $max_sz} {
660 $ui_diff insert end \
661"* Untracked file is $sz bytes.
662* Showing only first $max_sz bytes.
663" d_@
664 }
665 $ui_diff insert end $content
666 if {$sz > $max_sz} {
667 $ui_diff insert end "
668* Untracked file clipped here by [appname].
669* To see the entire file, use an external editor.
670" d_@
671 }
672 }
673 $ui_diff conf -state disabled
674 set diff_active 0
675 unlock_index
676 set ui_status_value {Ready.}
677 return
678 }
679 set cmd [list | git]
681 if {$w eq $ui_index} {
682 lappend cmd diff-index
683 lappend cmd --cached
684 } elseif {$w eq $ui_workdir} {
685 if {[string index $m 0] eq {U}} {
686 lappend cmd diff
687 } else {
688 lappend cmd diff-files
689 }
690 }
691 lappend cmd -p
693 lappend cmd --no-color
694 if {$repo_config(gui.diffcontext) > 0} {
695 lappend cmd "-U$repo_config(gui.diffcontext)"
696 }
697 if {$w eq $ui_index} {
698 lappend cmd [PARENT]
699 }
700 lappend cmd --
701 lappend cmd $path
702 if {[catch {set fd [open $cmd r]} err]} {
704 set diff_active 0
705 unlock_index
706 set ui_status_value "Unable to display [escape_path $path]"
707 error_popup "Error loading diff:\n\n$err"
708 return
709 }
710 fconfigure $fd \
712 -blocking 0 \
713 -encoding binary \
714 -translation binary
715 fileevent $fd readable [list read_diff $fd]
716}
717proc read_diff {fd} {
719 global ui_diff ui_status_value diff_active
720 global is_3way_diff current_diff_header
721 $ui_diff conf -state normal
723 while {[gets $fd line] >= 0} {
724 # -- Cleanup uninteresting diff header lines.
725 #
726 if { [string match {diff --git *} $line]
727 || [string match {diff --cc *} $line]
728 || [string match {diff --combined *} $line]
729 || [string match {--- *} $line]
730 || [string match {+++ *} $line]} {
731 append current_diff_header $line "\n"
732 continue
733 }
734 if {[string match {index *} $line]} continue
735 if {$line eq {deleted file mode 120000}} {
736 set line "deleted symlink"
737 }
738 # -- Automatically detect if this is a 3 way diff.
740 #
741 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
742 if {[string match {mode *} $line]
744 || [string match {new file *} $line]
745 || [string match {deleted file *} $line]
746 || [string match {Binary files * and * differ} $line]
747 || $line eq {\ No newline at end of file}
748 || [regexp {^\* Unmerged path } $line]} {
749 set tags {}
750 } elseif {$is_3way_diff} {
751 set op [string range $line 0 1]
752 switch -- $op {
753 { } {set tags {}}
754 {@@} {set tags d_@}
755 { +} {set tags d_s+}
756 { -} {set tags d_s-}
757 {+ } {set tags d_+s}
758 {- } {set tags d_-s}
759 {--} {set tags d_--}
760 {++} {
761 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
762 set line [string replace $line 0 1 { }]
763 set tags d$op
764 } else {
765 set tags d_++
766 }
767 }
768 default {
769 puts "error: Unhandled 3 way diff marker: {$op}"
770 set tags {}
771 }
772 }
773 } else {
774 set op [string index $line 0]
775 switch -- $op {
776 { } {set tags {}}
777 {@} {set tags d_@}
778 {-} {set tags d_-}
779 {+} {
780 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
781 set line [string replace $line 0 0 { }]
782 set tags d$op
783 } else {
784 set tags d_+
785 }
786 }
787 default {
788 puts "error: Unhandled 2 way diff marker: {$op}"
789 set tags {}
790 }
791 }
792 }
793 $ui_diff insert end $line $tags
794 if {[string index $line end] eq "\r"} {
795 $ui_diff tag add d_cr {end - 2c}
796 }
797 $ui_diff insert end "\n" $tags
798 }
799 $ui_diff conf -state disabled
800 if {[eof $fd]} {
802 close $fd
803 set diff_active 0
804 unlock_index
805 set ui_status_value {Ready.}
806 if {[$ui_diff index end] eq {2.0}} {
808 handle_empty_diff
809 }
810 }
811}
812proc apply_hunk {x y} {
814 global current_diff_path current_diff_header current_diff_side
815 global ui_diff ui_index file_states
816 if {$current_diff_path eq {} || $current_diff_header eq {}} return
818 if {![lock_index apply_hunk]} return
819 set apply_cmd {git apply --cached --whitespace=nowarn}
821 set mi [lindex $file_states($current_diff_path) 0]
822 if {$current_diff_side eq $ui_index} {
823 set mode unstage
824 lappend apply_cmd --reverse
825 if {[string index $mi 0] ne {M}} {
826 unlock_index
827 return
828 }
829 } else {
830 set mode stage
831 if {[string index $mi 1] ne {M}} {
832 unlock_index
833 return
834 }
835 }
836 set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
838 set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
839 if {$s_lno eq {}} {
840 unlock_index
841 return
842 }
843 set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
845 if {$e_lno eq {}} {
846 set e_lno end
847 }
848 if {[catch {
850 set p [open "| $apply_cmd" w]
851 fconfigure $p -translation binary -encoding binary
852 puts -nonewline $p $current_diff_header
853 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
854 close $p} err]} {
855 error_popup "Failed to $mode selected hunk.\n\n$err"
856 unlock_index
857 return
858 }
859 $ui_diff conf -state normal
861 $ui_diff delete $s_lno $e_lno
862 $ui_diff conf -state disabled
863 if {[$ui_diff get 1.0 end] eq "\n"} {
865 set o _
866 } else {
867 set o ?
868 }
869 if {$current_diff_side eq $ui_index} {
871 set mi ${o}M
872 } elseif {[string index $mi 0] eq {_}} {
873 set mi M$o
874 } else {
875 set mi ?$o
876 }
877 unlock_index
878 display_file $current_diff_path $mi
879 if {$o eq {_}} {
880 clear_diff
881 }
882}
883######################################################################
885##
886## commit
887proc load_last_commit {} {
889 global HEAD PARENT MERGE_HEAD commit_type ui_comm
890 global repo_config
891 if {[llength $PARENT] == 0} {
893 error_popup {There is nothing to amend.
894You are about to create the initial commit.
896There is no commit before this to amend.
897}
898 return
899 }
900 repository_state curType curHEAD curMERGE_HEAD
902 if {$curType eq {merge}} {
903 error_popup {Cannot amend while merging.
904You are currently in the middle of a merge that
906has not been fully completed. You cannot amend
907the prior commit unless you first abort the
908current merge activity.
909}
910 return
911 }
912 set msg {}
914 set parents [list]
915 if {[catch {
916 set fd [open "| git cat-file commit $curHEAD" r]
917 fconfigure $fd -encoding binary -translation lf
918 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
919 set enc utf-8
920 }
921 while {[gets $fd line] > 0} {
922 if {[string match {parent *} $line]} {
923 lappend parents [string range $line 7 end]
924 } elseif {[string match {encoding *} $line]} {
925 set enc [string tolower [string range $line 9 end]]
926 }
927 }
928 fconfigure $fd -encoding $enc
929 set msg [string trim [read $fd]]
930 close $fd
931 } err]} {
932 error_popup "Error loading commit data for amend:\n\n$err"
933 return
934 }
935 set HEAD $curHEAD
937 set PARENT $parents
938 set MERGE_HEAD [list]
939 switch -- [llength $parents] {
940 0 {set commit_type amend-initial}
941 1 {set commit_type amend}
942 default {set commit_type amend-merge}
943 }
944 $ui_comm delete 0.0 end
946 $ui_comm insert end $msg
947 $ui_comm edit reset
948 $ui_comm edit modified false
949 rescan {set ui_status_value {Ready.}}
950}
951proc create_new_commit {} {
953 global commit_type ui_comm
954 set commit_type normal
956 $ui_comm delete 0.0 end
957 $ui_comm edit reset
958 $ui_comm edit modified false
959 rescan {set ui_status_value {Ready.}}
960}
961set GIT_COMMITTER_IDENT {}
963proc committer_ident {} {
965 global GIT_COMMITTER_IDENT
966 if {$GIT_COMMITTER_IDENT eq {}} {
968 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
969 error_popup "Unable to obtain your identity:\n\n$err"
970 return {}
971 }
972 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
973 $me me GIT_COMMITTER_IDENT]} {
974 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
975 return {}
976 }
977 }
978 return $GIT_COMMITTER_IDENT
980}
981proc commit_tree {} {
983 global HEAD commit_type file_states ui_comm repo_config
984 global ui_status_value pch_error
985 if {[committer_ident] eq {}} return
987 if {![lock_index update]} return
988 # -- Our in memory state should match the repository.
990 #
991 repository_state curType curHEAD curMERGE_HEAD
992 if {[string match amend* $commit_type]
993 && $curType eq {normal}
994 && $curHEAD eq $HEAD} {
995 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
996 info_popup {Last scanned state does not match repository state.
997Another Git program has modified this repository
999since the last scan. A rescan must be performed
1000before another commit can be created.
1001The rescan will be automatically started now.
1003}
1004 unlock_index
1005 rescan {set ui_status_value {Ready.}}
1006 return
1007 }
1008 # -- At least one file should differ in the index.
1010 #
1011 set files_ready 0
1012 foreach path [array names file_states] {
1013 switch -glob -- [lindex $file_states($path) 0] {
1014 _? {continue}
1015 A? -
1016 D? -
1017 M? {set files_ready 1}
1018 U? {
1019 error_popup "Unmerged files cannot be committed.
1020File [short_path $path] has merge conflicts.
1022You must resolve them and add the file before committing.
1023"
1024 unlock_index
1025 return
1026 }
1027 default {
1028 error_popup "Unknown file state [lindex $s 0] detected.
1029File [short_path $path] cannot be committed by this program.
1031"
1032 }
1033 }
1034 }
1035 if {!$files_ready} {
1036 info_popup {No changes to commit.
1037You must add at least 1 file before you can commit.
1039}
1040 unlock_index
1041 return
1042 }
1043 # -- A message is required.
1045 #
1046 set msg [string trim [$ui_comm get 1.0 end]]
1047 regsub -all -line {[ \t\r]+$} $msg {} msg
1048 if {$msg eq {}} {
1049 error_popup {Please supply a commit message.
1050A good commit message has the following format:
1052- First line: Describe in one sentance what you did.
1054- Second line: Blank
1055- Remaining lines: Describe why this change is good.
1056}
1057 unlock_index
1058 return
1059 }
1060 # -- Run the pre-commit hook.
1062 #
1063 set pchook [gitdir hooks pre-commit]
1064 # On Cygwin [file executable] might lie so we need to ask
1066 # the shell if the hook is executable. Yes that's annoying.
1067 #
1068 if {[is_Windows] && [file isfile $pchook]} {
1069 set pchook [list sh -c [concat \
1070 "if test -x \"$pchook\";" \
1071 "then exec \"$pchook\" 2>&1;" \
1072 "fi"]]
1073 } elseif {[file executable $pchook]} {
1074 set pchook [list $pchook |& cat]
1075 } else {
1076 commit_writetree $curHEAD $msg
1077 return
1078 }
1079 set ui_status_value {Calling pre-commit hook...}
1081 set pch_error {}
1082 set fd_ph [open "| $pchook" r]
1083 fconfigure $fd_ph -blocking 0 -translation binary
1084 fileevent $fd_ph readable \
1085 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1086}
1087proc commit_prehook_wait {fd_ph curHEAD msg} {
1089 global pch_error ui_status_value
1090 append pch_error [read $fd_ph]
1092 fconfigure $fd_ph -blocking 1
1093 if {[eof $fd_ph]} {
1094 if {[catch {close $fd_ph}]} {
1095 set ui_status_value {Commit declined by pre-commit hook.}
1096 hook_failed_popup pre-commit $pch_error
1097 unlock_index
1098 } else {
1099 commit_writetree $curHEAD $msg
1100 }
1101 set pch_error {}
1102 return
1103 }
1104 fconfigure $fd_ph -blocking 0
1105}
1106proc commit_writetree {curHEAD msg} {
1108 global ui_status_value
1109 set ui_status_value {Committing changes...}
1111 set fd_wt [open "| git write-tree" r]
1112 fileevent $fd_wt readable \
1113 [list commit_committree $fd_wt $curHEAD $msg]
1114}
1115proc commit_committree {fd_wt curHEAD msg} {
1117 global HEAD PARENT MERGE_HEAD commit_type
1118 global single_commit all_heads current_branch
1119 global ui_status_value ui_comm selected_commit_type
1120 global file_states selected_paths rescan_active
1121 global repo_config
1122 gets $fd_wt tree_id
1124 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1125 error_popup "write-tree failed:\n\n$err"
1126 set ui_status_value {Commit failed.}
1127 unlock_index
1128 return
1129 }
1130 # -- Build the message.
1132 #
1133 set msg_p [gitdir COMMIT_EDITMSG]
1134 set msg_wt [open $msg_p w]
1135 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1136 set enc utf-8
1137 }
1138 fconfigure $msg_wt -encoding $enc -translation binary
1139 puts -nonewline $msg_wt $msg
1140 close $msg_wt
1141 # -- Create the commit.
1143 #
1144 set cmd [list git commit-tree $tree_id]
1145 set parents [concat $PARENT $MERGE_HEAD]
1146 if {[llength $parents] > 0} {
1147 foreach p $parents {
1148 lappend cmd -p $p
1149 }
1150 } else {
1151 # git commit-tree writes to stderr during initial commit.
1152 lappend cmd 2>/dev/null
1153 }
1154 lappend cmd <$msg_p
1155 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1156 error_popup "commit-tree failed:\n\n$err"
1157 set ui_status_value {Commit failed.}
1158 unlock_index
1159 return
1160 }
1161 # -- Update the HEAD ref.
1163 #
1164 set reflogm commit
1165 if {$commit_type ne {normal}} {
1166 append reflogm " ($commit_type)"
1167 }
1168 set i [string first "\n" $msg]
1169 if {$i >= 0} {
1170 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1171 } else {
1172 append reflogm {: } $msg
1173 }
1174 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1175 if {[catch {eval exec $cmd} err]} {
1176 error_popup "update-ref failed:\n\n$err"
1177 set ui_status_value {Commit failed.}
1178 unlock_index
1179 return
1180 }
1181 # -- Make sure our current branch exists.
1183 #
1184 if {$commit_type eq {initial}} {
1185 lappend all_heads $current_branch
1186 set all_heads [lsort -unique $all_heads]
1187 populate_branch_menu
1188 }
1189 # -- Cleanup after ourselves.
1191 #
1192 catch {file delete $msg_p}
1193 catch {file delete [gitdir MERGE_HEAD]}
1194 catch {file delete [gitdir MERGE_MSG]}
1195 catch {file delete [gitdir SQUASH_MSG]}
1196 catch {file delete [gitdir GITGUI_MSG]}
1197 # -- Let rerere do its thing.
1199 #
1200 if {[file isdirectory [gitdir rr-cache]]} {
1201 catch {exec git rerere}
1202 }
1203 # -- Run the post-commit hook.
1205 #
1206 set pchook [gitdir hooks post-commit]
1207 if {[is_Windows] && [file isfile $pchook]} {
1208 set pchook [list sh -c [concat \
1209 "if test -x \"$pchook\";" \
1210 "then exec \"$pchook\";" \
1211 "fi"]]
1212 } elseif {![file executable $pchook]} {
1213 set pchook {}
1214 }
1215 if {$pchook ne {}} {
1216 catch {exec $pchook &}
1217 }
1218 $ui_comm delete 0.0 end
1220 $ui_comm edit reset
1221 $ui_comm edit modified false
1222 if {$single_commit} do_quit
1224 # -- Update in memory status
1226 #
1227 set selected_commit_type new
1228 set commit_type normal
1229 set HEAD $cmt_id
1230 set PARENT $cmt_id
1231 set MERGE_HEAD [list]
1232 foreach path [array names file_states] {
1234 set s $file_states($path)
1235 set m [lindex $s 0]
1236 switch -glob -- $m {
1237 _O -
1238 _M -
1239 _D {continue}
1240 __ -
1241 A_ -
1242 M_ -
1243 D_ {
1244 unset file_states($path)
1245 catch {unset selected_paths($path)}
1246 }
1247 DO {
1248 set file_states($path) [list _O [lindex $s 1] {} {}]
1249 }
1250 AM -
1251 AD -
1252 MM -
1253 MD {
1254 set file_states($path) [list \
1255 _[string index $m 1] \
1256 [lindex $s 1] \
1257 [lindex $s 3] \
1258 {}]
1259 }
1260 }
1261 }
1262 display_all_files
1264 unlock_index
1265 reshow_diff
1266 set ui_status_value \
1267 "Changes committed as [string range $cmt_id 0 7]."
1268}
1269######################################################################
1271##
1272## fetch push
1273proc fetch_from {remote} {
1275 set w [new_console \
1276 "fetch $remote" \
1277 "Fetching new changes from $remote"]
1278 set cmd [list git fetch]
1279 lappend cmd $remote
1280 console_exec $w $cmd console_done
1281}
1282proc push_to {remote} {
1284 set w [new_console \
1285 "push $remote" \
1286 "Pushing changes to $remote"]
1287 set cmd [list git push]
1288 lappend cmd -v
1289 lappend cmd $remote
1290 console_exec $w $cmd console_done
1291}
1292######################################################################
1294##
1295## ui helpers
1296proc mapicon {w state path} {
1298 global all_icons
1299 if {[catch {set r $all_icons($state$w)}]} {
1301 puts "error: no icon for $w state={$state} $path"
1302 return file_plain
1303 }
1304 return $r
1305}
1306proc mapdesc {state path} {
1308 global all_descs
1309 if {[catch {set r $all_descs($state)}]} {
1311 puts "error: no desc for state={$state} $path"
1312 return $state
1313 }
1314 return $r
1315}
1316proc escape_path {path} {
1318 regsub -all "\n" $path "\\n" path
1319 return $path
1320}
1321proc short_path {path} {
1323 return [escape_path [lindex [file split $path] end]]
1324}
1325set next_icon_id 0
1327set null_sha1 [string repeat 0 40]
1328proc merge_state {path new_state {head_info {}} {index_info {}}} {
1330 global file_states next_icon_id null_sha1
1331 set s0 [string index $new_state 0]
1333 set s1 [string index $new_state 1]
1334 if {[catch {set info $file_states($path)}]} {
1336 set state __
1337 set icon n[incr next_icon_id]
1338 } else {
1339 set state [lindex $info 0]
1340 set icon [lindex $info 1]
1341 if {$head_info eq {}} {set head_info [lindex $info 2]}
1342 if {$index_info eq {}} {set index_info [lindex $info 3]}
1343 }
1344 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1346 elseif {$s0 eq {_}} {set s0 _}
1347 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1349 elseif {$s1 eq {_}} {set s1 _}
1350 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1352 set head_info [list 0 $null_sha1]
1353 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1354 && $head_info eq {}} {
1355 set head_info $index_info
1356 }
1357 set file_states($path) [list $s0$s1 $icon \
1359 $head_info $index_info \
1360 ]
1361 return $state
1362}
1363proc display_file_helper {w path icon_name old_m new_m} {
1365 global file_lists
1366 if {$new_m eq {_}} {
1368 set lno [lsearch -sorted -exact $file_lists($w) $path]
1369 if {$lno >= 0} {
1370 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1371 incr lno
1372 $w conf -state normal
1373 $w delete $lno.0 [expr {$lno + 1}].0
1374 $w conf -state disabled
1375 }
1376 } elseif {$old_m eq {_} && $new_m ne {_}} {
1377 lappend file_lists($w) $path
1378 set file_lists($w) [lsort -unique $file_lists($w)]
1379 set lno [lsearch -sorted -exact $file_lists($w) $path]
1380 incr lno
1381 $w conf -state normal
1382 $w image create $lno.0 \
1383 -align center -padx 5 -pady 1 \
1384 -name $icon_name \
1385 -image [mapicon $w $new_m $path]
1386 $w insert $lno.1 "[escape_path $path]\n"
1387 $w conf -state disabled
1388 } elseif {$old_m ne $new_m} {
1389 $w conf -state normal
1390 $w image conf $icon_name -image [mapicon $w $new_m $path]
1391 $w conf -state disabled
1392 }
1393}
1394proc display_file {path state} {
1396 global file_states selected_paths
1397 global ui_index ui_workdir
1398 set old_m [merge_state $path $state]
1400 set s $file_states($path)
1401 set new_m [lindex $s 0]
1402 set icon_name [lindex $s 1]
1403 set o [string index $old_m 0]
1405 set n [string index $new_m 0]
1406 if {$o eq {U}} {
1407 set o _
1408 }
1409 if {$n eq {U}} {
1410 set n _
1411 }
1412 display_file_helper $ui_index $path $icon_name $o $n
1413 if {[string index $old_m 0] eq {U}} {
1415 set o U
1416 } else {
1417 set o [string index $old_m 1]
1418 }
1419 if {[string index $new_m 0] eq {U}} {
1420 set n U
1421 } else {
1422 set n [string index $new_m 1]
1423 }
1424 display_file_helper $ui_workdir $path $icon_name $o $n
1425 if {$new_m eq {__}} {
1427 unset file_states($path)
1428 catch {unset selected_paths($path)}
1429 }
1430}
1431proc display_all_files_helper {w path icon_name m} {
1433 global file_lists
1434 lappend file_lists($w) $path
1436 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1437 $w image create end \
1438 -align center -padx 5 -pady 1 \
1439 -name $icon_name \
1440 -image [mapicon $w $m $path]
1441 $w insert end "[escape_path $path]\n"
1442}
1443proc display_all_files {} {
1445 global ui_index ui_workdir
1446 global file_states file_lists
1447 global last_clicked
1448 $ui_index conf -state normal
1450 $ui_workdir conf -state normal
1451 $ui_index delete 0.0 end
1453 $ui_workdir delete 0.0 end
1454 set last_clicked {}
1455 set file_lists($ui_index) [list]
1457 set file_lists($ui_workdir) [list]
1458 foreach path [lsort [array names file_states]] {
1460 set s $file_states($path)
1461 set m [lindex $s 0]
1462 set icon_name [lindex $s 1]
1463 set s [string index $m 0]
1465 if {$s ne {U} && $s ne {_}} {
1466 display_all_files_helper $ui_index $path \
1467 $icon_name $s
1468 }
1469 if {[string index $m 0] eq {U}} {
1471 set s U
1472 } else {
1473 set s [string index $m 1]
1474 }
1475 if {$s ne {_}} {
1476 display_all_files_helper $ui_workdir $path \
1477 $icon_name $s
1478 }
1479 }
1480 $ui_index conf -state disabled
1482 $ui_workdir conf -state disabled
1483}
1484proc update_indexinfo {msg pathList after} {
1486 global update_index_cp ui_status_value
1487 if {![lock_index update]} return
1489 set update_index_cp 0
1491 set pathList [lsort $pathList]
1492 set totalCnt [llength $pathList]
1493 set batch [expr {int($totalCnt * .01) + 1}]
1494 if {$batch > 25} {set batch 25}
1495 set ui_status_value [format \
1497 "$msg... %i/%i files (%.2f%%)" \
1498 $update_index_cp \
1499 $totalCnt \
1500 0.0]
1501 set fd [open "| git update-index -z --index-info" w]
1502 fconfigure $fd \
1503 -blocking 0 \
1504 -buffering full \
1505 -buffersize 512 \
1506 -encoding binary \
1507 -translation binary
1508 fileevent $fd writable [list \
1509 write_update_indexinfo \
1510 $fd \
1511 $pathList \
1512 $totalCnt \
1513 $batch \
1514 $msg \
1515 $after \
1516 ]
1517}
1518proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1520 global update_index_cp ui_status_value
1521 global file_states current_diff_path
1522 if {$update_index_cp >= $totalCnt} {
1524 close $fd
1525 unlock_index
1526 uplevel #0 $after
1527 return
1528 }
1529 for {set i $batch} \
1531 {$update_index_cp < $totalCnt && $i > 0} \
1532 {incr i -1} {
1533 set path [lindex $pathList $update_index_cp]
1534 incr update_index_cp
1535 set s $file_states($path)
1537 switch -glob -- [lindex $s 0] {
1538 A? {set new _O}
1539 M? {set new _M}
1540 D_ {set new _D}
1541 D? {set new _?}
1542 ?? {continue}
1543 }
1544 set info [lindex $s 2]
1545 if {$info eq {}} continue
1546 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1548 display_file $path $new
1549 }
1550 set ui_status_value [format \
1552 "$msg... %i/%i files (%.2f%%)" \
1553 $update_index_cp \
1554 $totalCnt \
1555 [expr {100.0 * $update_index_cp / $totalCnt}]]
1556}
1557proc update_index {msg pathList after} {
1559 global update_index_cp ui_status_value
1560 if {![lock_index update]} return
1562 set update_index_cp 0
1564 set pathList [lsort $pathList]
1565 set totalCnt [llength $pathList]
1566 set batch [expr {int($totalCnt * .01) + 1}]
1567 if {$batch > 25} {set batch 25}
1568 set ui_status_value [format \
1570 "$msg... %i/%i files (%.2f%%)" \
1571 $update_index_cp \
1572 $totalCnt \
1573 0.0]
1574 set fd [open "| git update-index --add --remove -z --stdin" w]
1575 fconfigure $fd \
1576 -blocking 0 \
1577 -buffering full \
1578 -buffersize 512 \
1579 -encoding binary \
1580 -translation binary
1581 fileevent $fd writable [list \
1582 write_update_index \
1583 $fd \
1584 $pathList \
1585 $totalCnt \
1586 $batch \
1587 $msg \
1588 $after \
1589 ]
1590}
1591proc write_update_index {fd pathList totalCnt batch msg after} {
1593 global update_index_cp ui_status_value
1594 global file_states current_diff_path
1595 if {$update_index_cp >= $totalCnt} {
1597 close $fd
1598 unlock_index
1599 uplevel #0 $after
1600 return
1601 }
1602 for {set i $batch} \
1604 {$update_index_cp < $totalCnt && $i > 0} \
1605 {incr i -1} {
1606 set path [lindex $pathList $update_index_cp]
1607 incr update_index_cp
1608 switch -glob -- [lindex $file_states($path) 0] {
1610 AD {set new __}
1611 ?D {set new D_}
1612 _O -
1613 AM {set new A_}
1614 U? {
1615 if {[file exists $path]} {
1616 set new M_
1617 } else {
1618 set new D_
1619 }
1620 }
1621 ?M {set new M_}
1622 ?? {continue}
1623 }
1624 puts -nonewline $fd "[encoding convertto $path]\0"
1625 display_file $path $new
1626 }
1627 set ui_status_value [format \
1629 "$msg... %i/%i files (%.2f%%)" \
1630 $update_index_cp \
1631 $totalCnt \
1632 [expr {100.0 * $update_index_cp / $totalCnt}]]
1633}
1634proc checkout_index {msg pathList after} {
1636 global update_index_cp ui_status_value
1637 if {![lock_index update]} return
1639 set update_index_cp 0
1641 set pathList [lsort $pathList]
1642 set totalCnt [llength $pathList]
1643 set batch [expr {int($totalCnt * .01) + 1}]
1644 if {$batch > 25} {set batch 25}
1645 set ui_status_value [format \
1647 "$msg... %i/%i files (%.2f%%)" \
1648 $update_index_cp \
1649 $totalCnt \
1650 0.0]
1651 set cmd [list git checkout-index]
1652 lappend cmd --index
1653 lappend cmd --quiet
1654 lappend cmd --force
1655 lappend cmd -z
1656 lappend cmd --stdin
1657 set fd [open "| $cmd " w]
1658 fconfigure $fd \
1659 -blocking 0 \
1660 -buffering full \
1661 -buffersize 512 \
1662 -encoding binary \
1663 -translation binary
1664 fileevent $fd writable [list \
1665 write_checkout_index \
1666 $fd \
1667 $pathList \
1668 $totalCnt \
1669 $batch \
1670 $msg \
1671 $after \
1672 ]
1673}
1674proc write_checkout_index {fd pathList totalCnt batch msg after} {
1676 global update_index_cp ui_status_value
1677 global file_states current_diff_path
1678 if {$update_index_cp >= $totalCnt} {
1680 close $fd
1681 unlock_index
1682 uplevel #0 $after
1683 return
1684 }
1685 for {set i $batch} \
1687 {$update_index_cp < $totalCnt && $i > 0} \
1688 {incr i -1} {
1689 set path [lindex $pathList $update_index_cp]
1690 incr update_index_cp
1691 switch -glob -- [lindex $file_states($path) 0] {
1692 U? {continue}
1693 ?M -
1694 ?D {
1695 puts -nonewline $fd "[encoding convertto $path]\0"
1696 display_file $path ?_
1697 }
1698 }
1699 }
1700 set ui_status_value [format \
1702 "$msg... %i/%i files (%.2f%%)" \
1703 $update_index_cp \
1704 $totalCnt \
1705 [expr {100.0 * $update_index_cp / $totalCnt}]]
1706}
1707######################################################################
1709##
1710## branch management
1711proc is_tracking_branch {name} {
1713 global tracking_branches
1714 if {![catch {set info $tracking_branches($name)}]} {
1716 return 1
1717 }
1718 foreach t [array names tracking_branches] {
1719 if {[string match {*/\*} $t] && [string match $t $name]} {
1720 return 1
1721 }
1722 }
1723 return 0
1724}
1725proc load_all_heads {} {
1727 global all_heads
1728 set all_heads [list]
1730 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1731 while {[gets $fd line] > 0} {
1732 if {[is_tracking_branch $line]} continue
1733 if {![regsub ^refs/heads/ $line {} name]} continue
1734 lappend all_heads $name
1735 }
1736 close $fd
1737 set all_heads [lsort $all_heads]
1739}
1740proc populate_branch_menu {} {
1742 global all_heads disable_on_lock
1743 set m .mbar.branch
1745 set last [$m index last]
1746 for {set i 0} {$i <= $last} {incr i} {
1747 if {[$m type $i] eq {separator}} {
1748 $m delete $i last
1749 set new_dol [list]
1750 foreach a $disable_on_lock {
1751 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1752 lappend new_dol $a
1753 }
1754 }
1755 set disable_on_lock $new_dol
1756 break
1757 }
1758 }
1759 if {$all_heads ne {}} {
1761 $m add separator
1762 }
1763 foreach b $all_heads {
1764 $m add radiobutton \
1765 -label $b \
1766 -command [list switch_branch $b] \
1767 -variable current_branch \
1768 -value $b \
1769 -font font_ui
1770 lappend disable_on_lock \
1771 [list $m entryconf [$m index last] -state]
1772 }
1773}
1774proc all_tracking_branches {} {
1776 global tracking_branches
1777 set all_trackings {}
1779 set cmd {}
1780 foreach name [array names tracking_branches] {
1781 if {[regsub {/\*$} $name {} name]} {
1782 lappend cmd $name
1783 } else {
1784 regsub ^refs/(heads|remotes)/ $name {} name
1785 lappend all_trackings $name
1786 }
1787 }
1788 if {$cmd ne {}} {
1790 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1791 while {[gets $fd name] > 0} {
1792 regsub ^refs/(heads|remotes)/ $name {} name
1793 lappend all_trackings $name
1794 }
1795 close $fd
1796 }
1797 return [lsort -unique $all_trackings]
1799}
1800proc do_create_branch_action {w} {
1802 global all_heads null_sha1 repo_config
1803 global create_branch_checkout create_branch_revtype
1804 global create_branch_head create_branch_trackinghead
1805 global create_branch_name create_branch_revexp
1806 set newbranch $create_branch_name
1808 if {$newbranch eq {}
1809 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1810 tk_messageBox \
1811 -icon error \
1812 -type ok \
1813 -title [wm title $w] \
1814 -parent $w \
1815 -message "Please supply a branch name."
1816 focus $w.desc.name_t
1817 return
1818 }
1819 if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1820 tk_messageBox \
1821 -icon error \
1822 -type ok \
1823 -title [wm title $w] \
1824 -parent $w \
1825 -message "Branch '$newbranch' already exists."
1826 focus $w.desc.name_t
1827 return
1828 }
1829 if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1830 tk_messageBox \
1831 -icon error \
1832 -type ok \
1833 -title [wm title $w] \
1834 -parent $w \
1835 -message "We do not like '$newbranch' as a branch name."
1836 focus $w.desc.name_t
1837 return
1838 }
1839 set rev {}
1841 switch -- $create_branch_revtype {
1842 head {set rev $create_branch_head}
1843 tracking {set rev $create_branch_trackinghead}
1844 expression {set rev $create_branch_revexp}
1845 }
1846 if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1847 tk_messageBox \
1848 -icon error \
1849 -type ok \
1850 -title [wm title $w] \
1851 -parent $w \
1852 -message "Invalid starting revision: $rev"
1853 return
1854 }
1855 set cmd [list git update-ref]
1856 lappend cmd -m
1857 lappend cmd "branch: Created from $rev"
1858 lappend cmd "refs/heads/$newbranch"
1859 lappend cmd $cmt
1860 lappend cmd $null_sha1
1861 if {[catch {eval exec $cmd} err]} {
1862 tk_messageBox \
1863 -icon error \
1864 -type ok \
1865 -title [wm title $w] \
1866 -parent $w \
1867 -message "Failed to create '$newbranch'.\n\n$err"
1868 return
1869 }
1870 lappend all_heads $newbranch
1872 set all_heads [lsort $all_heads]
1873 populate_branch_menu
1874 destroy $w
1875 if {$create_branch_checkout} {
1876 switch_branch $newbranch
1877 }
1878}
1879proc radio_selector {varname value args} {
1881 upvar #0 $varname var
1882 set var $value
1883}
1884trace add variable create_branch_head write \
1886 [list radio_selector create_branch_revtype head]
1887trace add variable create_branch_trackinghead write \
1888 [list radio_selector create_branch_revtype tracking]
1889trace add variable delete_branch_head write \
1891 [list radio_selector delete_branch_checktype head]
1892trace add variable delete_branch_trackinghead write \
1893 [list radio_selector delete_branch_checktype tracking]
1894proc do_create_branch {} {
1896 global all_heads current_branch repo_config
1897 global create_branch_checkout create_branch_revtype
1898 global create_branch_head create_branch_trackinghead
1899 global create_branch_name create_branch_revexp
1900 set w .branch_editor
1902 toplevel $w
1903 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1904 label $w.header -text {Create New Branch} \
1906 -font font_uibold
1907 pack $w.header -side top -fill x
1908 frame $w.buttons
1910 button $w.buttons.create -text Create \
1911 -font font_ui \
1912 -default active \
1913 -command [list do_create_branch_action $w]
1914 pack $w.buttons.create -side right
1915 button $w.buttons.cancel -text {Cancel} \
1916 -font font_ui \
1917 -command [list destroy $w]
1918 pack $w.buttons.cancel -side right -padx 5
1919 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1920 labelframe $w.desc \
1922 -text {Branch Description} \
1923 -font font_ui
1924 label $w.desc.name_l -text {Name:} -font font_ui
1925 entry $w.desc.name_t \
1926 -borderwidth 1 \
1927 -relief sunken \
1928 -width 40 \
1929 -textvariable create_branch_name \
1930 -font font_ui \
1931 -validate key \
1932 -validatecommand {
1933 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
1934 return 1
1935 }
1936 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
1937 grid columnconfigure $w.desc 1 -weight 1
1938 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
1939 labelframe $w.from \
1941 -text {Starting Revision} \
1942 -font font_ui
1943 radiobutton $w.from.head_r \
1944 -text {Local Branch:} \
1945 -value head \
1946 -variable create_branch_revtype \
1947 -font font_ui
1948 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
1949 grid $w.from.head_r $w.from.head_m -sticky w
1950 set all_trackings [all_tracking_branches]
1951 if {$all_trackings ne {}} {
1952 set create_branch_trackinghead [lindex $all_trackings 0]
1953 radiobutton $w.from.tracking_r \
1954 -text {Tracking Branch:} \
1955 -value tracking \
1956 -variable create_branch_revtype \
1957 -font font_ui
1958 eval tk_optionMenu $w.from.tracking_m \
1959 create_branch_trackinghead \
1960 $all_trackings
1961 grid $w.from.tracking_r $w.from.tracking_m -sticky w
1962 }
1963 radiobutton $w.from.exp_r \
1964 -text {Revision Expression:} \
1965 -value expression \
1966 -variable create_branch_revtype \
1967 -font font_ui
1968 entry $w.from.exp_t \
1969 -borderwidth 1 \
1970 -relief sunken \
1971 -width 50 \
1972 -textvariable create_branch_revexp \
1973 -font font_ui \
1974 -validate key \
1975 -validatecommand {
1976 if {%d == 1 && [regexp {\s} %S]} {return 0}
1977 if {%d == 1 && [string length %S] > 0} {
1978 set create_branch_revtype expression
1979 }
1980 return 1
1981 }
1982 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
1983 grid columnconfigure $w.from 1 -weight 1
1984 pack $w.from -anchor nw -fill x -pady 5 -padx 5
1985 labelframe $w.postActions \
1987 -text {Post Creation Actions} \
1988 -font font_ui
1989 checkbutton $w.postActions.checkout \
1990 -text {Checkout after creation} \
1991 -variable create_branch_checkout \
1992 -font font_ui
1993 pack $w.postActions.checkout -anchor nw
1994 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
1995 set create_branch_checkout 1
1997 set create_branch_head $current_branch
1998 set create_branch_revtype head
1999 set create_branch_name $repo_config(gui.newbranchtemplate)
2000 set create_branch_revexp {}
2001 bind $w <Visibility> "
2003 grab $w
2004 $w.desc.name_t icursor end
2005 focus $w.desc.name_t
2006 "
2007 bind $w <Key-Escape> "destroy $w"
2008 bind $w <Key-Return> "do_create_branch_action $w;break"
2009 wm title $w "[appname] ([reponame]): Create Branch"
2010 tkwait window $w
2011}
2012proc do_delete_branch_action {w} {
2014 global all_heads
2015 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2016 set check_rev {}
2018 switch -- $delete_branch_checktype {
2019 head {set check_rev $delete_branch_head}
2020 tracking {set check_rev $delete_branch_trackinghead}
2021 always {set check_rev {:none}}
2022 }
2023 if {$check_rev eq {:none}} {
2024 set check_cmt {}
2025 } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2026 tk_messageBox \
2027 -icon error \
2028 -type ok \
2029 -title [wm title $w] \
2030 -parent $w \
2031 -message "Invalid check revision: $check_rev"
2032 return
2033 }
2034 set to_delete [list]
2036 set not_merged [list]
2037 foreach i [$w.list.l curselection] {
2038 set b [$w.list.l get $i]
2039 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2040 if {$check_cmt ne {}} {
2041 if {$b eq $check_rev} continue
2042 if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2043 if {$o ne $m} {
2044 lappend not_merged $b
2045 continue
2046 }
2047 }
2048 lappend to_delete [list $b $o]
2049 }
2050 if {$not_merged ne {}} {
2051 set msg "The following branches are not completely merged into $check_rev:
2052 - [join $not_merged "\n - "]"
2054 tk_messageBox \
2055 -icon info \
2056 -type ok \
2057 -title [wm title $w] \
2058 -parent $w \
2059 -message $msg
2060 }
2061 if {$to_delete eq {}} return
2062 if {$delete_branch_checktype eq {always}} {
2063 set msg {Recovering deleted branches is difficult.
2064Delete the selected branches?}
2066 if {[tk_messageBox \
2067 -icon warning \
2068 -type yesno \
2069 -title [wm title $w] \
2070 -parent $w \
2071 -message $msg] ne yes} {
2072 return
2073 }
2074 }
2075 set failed {}
2077 foreach i $to_delete {
2078 set b [lindex $i 0]
2079 set o [lindex $i 1]
2080 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2081 append failed " - $b: $err\n"
2082 } else {
2083 set x [lsearch -sorted -exact $all_heads $b]
2084 if {$x >= 0} {
2085 set all_heads [lreplace $all_heads $x $x]
2086 }
2087 }
2088 }
2089 if {$failed ne {}} {
2091 tk_messageBox \
2092 -icon error \
2093 -type ok \
2094 -title [wm title $w] \
2095 -parent $w \
2096 -message "Failed to delete branches:\n$failed"
2097 }
2098 set all_heads [lsort $all_heads]
2100 populate_branch_menu
2101 destroy $w
2102}
2103proc do_delete_branch {} {
2105 global all_heads tracking_branches current_branch
2106 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2107 set w .branch_editor
2109 toplevel $w
2110 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2111 label $w.header -text {Delete Local Branch} \
2113 -font font_uibold
2114 pack $w.header -side top -fill x
2115 frame $w.buttons
2117 button $w.buttons.create -text Delete \
2118 -font font_ui \
2119 -command [list do_delete_branch_action $w]
2120 pack $w.buttons.create -side right
2121 button $w.buttons.cancel -text {Cancel} \
2122 -font font_ui \
2123 -command [list destroy $w]
2124 pack $w.buttons.cancel -side right -padx 5
2125 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2126 labelframe $w.list \
2128 -text {Local Branches} \
2129 -font font_ui
2130 listbox $w.list.l \
2131 -height 10 \
2132 -width 70 \
2133 -selectmode extended \
2134 -yscrollcommand [list $w.list.sby set] \
2135 -font font_ui
2136 foreach h $all_heads {
2137 if {$h ne $current_branch} {
2138 $w.list.l insert end $h
2139 }
2140 }
2141 scrollbar $w.list.sby -command [list $w.list.l yview]
2142 pack $w.list.sby -side right -fill y
2143 pack $w.list.l -side left -fill both -expand 1
2144 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2145 labelframe $w.validate \
2147 -text {Delete Only If} \
2148 -font font_ui
2149 radiobutton $w.validate.head_r \
2150 -text {Merged Into Local Branch:} \
2151 -value head \
2152 -variable delete_branch_checktype \
2153 -font font_ui
2154 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2155 grid $w.validate.head_r $w.validate.head_m -sticky w
2156 set all_trackings [all_tracking_branches]
2157 if {$all_trackings ne {}} {
2158 set delete_branch_trackinghead [lindex $all_trackings 0]
2159 radiobutton $w.validate.tracking_r \
2160 -text {Merged Into Tracking Branch:} \
2161 -value tracking \
2162 -variable delete_branch_checktype \
2163 -font font_ui
2164 eval tk_optionMenu $w.validate.tracking_m \
2165 delete_branch_trackinghead \
2166 $all_trackings
2167 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2168 }
2169 radiobutton $w.validate.always_r \
2170 -text {Always (Do not perform merge checks)} \
2171 -value always \
2172 -variable delete_branch_checktype \
2173 -font font_ui
2174 grid $w.validate.always_r -columnspan 2 -sticky w
2175 grid columnconfigure $w.validate 1 -weight 1
2176 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2177 set delete_branch_head $current_branch
2179 set delete_branch_checktype head
2180 bind $w <Visibility> "grab $w; focus $w"
2182 bind $w <Key-Escape> "destroy $w"
2183 wm title $w "[appname] ([reponame]): Delete Branch"
2184 tkwait window $w
2185}
2186proc switch_branch {new_branch} {
2188 global HEAD commit_type current_branch repo_config
2189 if {![lock_index switch]} return
2191 # -- Our in memory state should match the repository.
2193 #
2194 repository_state curType curHEAD curMERGE_HEAD
2195 if {[string match amend* $commit_type]
2196 && $curType eq {normal}
2197 && $curHEAD eq $HEAD} {
2198 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2199 info_popup {Last scanned state does not match repository state.
2200Another Git program has modified this repository
2202since the last scan. A rescan must be performed
2203before the current branch can be changed.
2204The rescan will be automatically started now.
2206}
2207 unlock_index
2208 rescan {set ui_status_value {Ready.}}
2209 return
2210 }
2211 # -- Don't do a pointless switch.
2213 #
2214 if {$current_branch eq $new_branch} {
2215 unlock_index
2216 return
2217 }
2218 if {$repo_config(gui.trustmtime) eq {true}} {
2220 switch_branch_stage2 {} $new_branch
2221 } else {
2222 set ui_status_value {Refreshing file status...}
2223 set cmd [list git update-index]
2224 lappend cmd -q
2225 lappend cmd --unmerged
2226 lappend cmd --ignore-missing
2227 lappend cmd --refresh
2228 set fd_rf [open "| $cmd" r]
2229 fconfigure $fd_rf -blocking 0 -translation binary
2230 fileevent $fd_rf readable \
2231 [list switch_branch_stage2 $fd_rf $new_branch]
2232 }
2233}
2234proc switch_branch_stage2 {fd_rf new_branch} {
2236 global ui_status_value HEAD
2237 if {$fd_rf ne {}} {
2239 read $fd_rf
2240 if {![eof $fd_rf]} return
2241 close $fd_rf
2242 }
2243 set ui_status_value "Updating working directory to '$new_branch'..."
2245 set cmd [list git read-tree]
2246 lappend cmd -m
2247 lappend cmd -u
2248 lappend cmd --exclude-per-directory=.gitignore
2249 lappend cmd $HEAD
2250 lappend cmd $new_branch
2251 set fd_rt [open "| $cmd" r]
2252 fconfigure $fd_rt -blocking 0 -translation binary
2253 fileevent $fd_rt readable \
2254 [list switch_branch_readtree_wait $fd_rt $new_branch]
2255}
2256proc switch_branch_readtree_wait {fd_rt new_branch} {
2258 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2259 global current_branch
2260 global ui_comm ui_status_value
2261 # -- We never get interesting output on stdout; only stderr.
2263 #
2264 read $fd_rt
2265 fconfigure $fd_rt -blocking 1
2266 if {![eof $fd_rt]} {
2267 fconfigure $fd_rt -blocking 0
2268 return
2269 }
2270 # -- The working directory wasn't in sync with the index and
2272 # we'd have to overwrite something to make the switch. A
2273 # merge is required.
2274 #
2275 if {[catch {close $fd_rt} err]} {
2276 regsub {^fatal: } $err {} err
2277 warn_popup "File level merge required.
2278$err
2280Staying on branch '$current_branch'."
2282 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2283 unlock_index
2284 return
2285 }
2286 # -- Update the symbolic ref. Core git doesn't even check for failure
2288 # here, it Just Works(tm). If it doesn't we are in some really ugly
2289 # state that is difficult to recover from within git-gui.
2290 #
2291 if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2292 error_popup "Failed to set current branch.
2293This working directory is only partially switched.
2295We successfully updated your files, but failed to
2296update an internal Git file.
2297This should not have occurred. [appname] will now
2299close and give up.
2300$err"
2302 do_quit
2303 return
2304 }
2305 # -- Update our repository state. If we were previously in amend mode
2307 # we need to toss the current buffer and do a full rescan to update
2308 # our file lists. If we weren't in amend mode our file lists are
2309 # accurate and we can avoid the rescan.
2310 #
2311 unlock_index
2312 set selected_commit_type new
2313 if {[string match amend* $commit_type]} {
2314 $ui_comm delete 0.0 end
2315 $ui_comm edit reset
2316 $ui_comm edit modified false
2317 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2318 } else {
2319 repository_state commit_type HEAD MERGE_HEAD
2320 set PARENT $HEAD
2321 set ui_status_value "Checked out branch '$current_branch'."
2322 }
2323}
2324######################################################################
2326##
2327## remote management
2328proc load_all_remotes {} {
2330 global repo_config
2331 global all_remotes tracking_branches
2332 set all_remotes [list]
2334 array unset tracking_branches
2335 set rm_dir [gitdir remotes]
2337 if {[file isdirectory $rm_dir]} {
2338 set all_remotes [glob \
2339 -types f \
2340 -tails \
2341 -nocomplain \
2342 -directory $rm_dir *]
2343 foreach name $all_remotes {
2345 catch {
2346 set fd [open [file join $rm_dir $name] r]
2347 while {[gets $fd line] >= 0} {
2348 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2349 $line line src dst]} continue
2350 if {![regexp ^refs/ $dst]} {
2351 set dst "refs/heads/$dst"
2352 }
2353 set tracking_branches($dst) [list $name $src]
2354 }
2355 close $fd
2356 }
2357 }
2358 }
2359 foreach line [array names repo_config remote.*.url] {
2361 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2362 lappend all_remotes $name
2363 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2365 set fl {}
2366 }
2367 foreach line $fl {
2368 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2369 if {![regexp ^refs/ $dst]} {
2370 set dst "refs/heads/$dst"
2371 }
2372 set tracking_branches($dst) [list $name $src]
2373 }
2374 }
2375 set all_remotes [lsort -unique $all_remotes]
2377}
2378proc populate_fetch_menu {} {
2380 global all_remotes repo_config
2381 set m .mbar.fetch
2383 foreach r $all_remotes {
2384 set enable 0
2385 if {![catch {set a $repo_config(remote.$r.url)}]} {
2386 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2387 set enable 1
2388 }
2389 } else {
2390 catch {
2391 set fd [open [gitdir remotes $r] r]
2392 while {[gets $fd n] >= 0} {
2393 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2394 set enable 1
2395 break
2396 }
2397 }
2398 close $fd
2399 }
2400 }
2401 if {$enable} {
2403 $m add command \
2404 -label "Fetch from $r..." \
2405 -command [list fetch_from $r] \
2406 -font font_ui
2407 }
2408 }
2409}
2410proc populate_push_menu {} {
2412 global all_remotes repo_config
2413 set m .mbar.push
2415 set fast_count 0
2416 foreach r $all_remotes {
2417 set enable 0
2418 if {![catch {set a $repo_config(remote.$r.url)}]} {
2419 if {![catch {set a $repo_config(remote.$r.push)}]} {
2420 set enable 1
2421 }
2422 } else {
2423 catch {
2424 set fd [open [gitdir remotes $r] r]
2425 while {[gets $fd n] >= 0} {
2426 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2427 set enable 1
2428 break
2429 }
2430 }
2431 close $fd
2432 }
2433 }
2434 if {$enable} {
2436 if {!$fast_count} {
2437 $m add separator
2438 }
2439 $m add command \
2440 -label "Push to $r..." \
2441 -command [list push_to $r] \
2442 -font font_ui
2443 incr fast_count
2444 }
2445 }
2446}
2447proc start_push_anywhere_action {w} {
2449 global push_urltype push_remote push_url push_thin push_tags
2450 set r_url {}
2452 switch -- $push_urltype {
2453 remote {set r_url $push_remote}
2454 url {set r_url $push_url}
2455 }
2456 if {$r_url eq {}} return
2457 set cmd [list git push]
2459 lappend cmd -v
2460 if {$push_thin} {
2461 lappend cmd --thin
2462 }
2463 if {$push_tags} {
2464 lappend cmd --tags
2465 }
2466 lappend cmd $r_url
2467 set cnt 0
2468 foreach i [$w.source.l curselection] {
2469 set b [$w.source.l get $i]
2470 lappend cmd "refs/heads/$b:refs/heads/$b"
2471 incr cnt
2472 }
2473 if {$cnt == 0} {
2474 return
2475 } elseif {$cnt == 1} {
2476 set unit branch
2477 } else {
2478 set unit branches
2479 }
2480 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2482 console_exec $cons $cmd console_done
2483 destroy $w
2484}
2485trace add variable push_remote write \
2487 [list radio_selector push_urltype remote]
2488proc do_push_anywhere {} {
2490 global all_heads all_remotes current_branch
2491 global push_urltype push_remote push_url push_thin push_tags
2492 set w .push_setup
2494 toplevel $w
2495 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2496 label $w.header -text {Push Branches} -font font_uibold
2498 pack $w.header -side top -fill x
2499 frame $w.buttons
2501 button $w.buttons.create -text Push \
2502 -font font_ui \
2503 -command [list start_push_anywhere_action $w]
2504 pack $w.buttons.create -side right
2505 button $w.buttons.cancel -text {Cancel} \
2506 -font font_ui \
2507 -command [list destroy $w]
2508 pack $w.buttons.cancel -side right -padx 5
2509 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2510 labelframe $w.source \
2512 -text {Source Branches} \
2513 -font font_ui
2514 listbox $w.source.l \
2515 -height 10 \
2516 -width 70 \
2517 -selectmode extended \
2518 -yscrollcommand [list $w.source.sby set] \
2519 -font font_ui
2520 foreach h $all_heads {
2521 $w.source.l insert end $h
2522 if {$h eq $current_branch} {
2523 $w.source.l select set end
2524 }
2525 }
2526 scrollbar $w.source.sby -command [list $w.source.l yview]
2527 pack $w.source.sby -side right -fill y
2528 pack $w.source.l -side left -fill both -expand 1
2529 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2530 labelframe $w.dest \
2532 -text {Destination Repository} \
2533 -font font_ui
2534 if {$all_remotes ne {}} {
2535 radiobutton $w.dest.remote_r \
2536 -text {Remote:} \
2537 -value remote \
2538 -variable push_urltype \
2539 -font font_ui
2540 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2541 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2542 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2543 set push_remote origin
2544 } else {
2545 set push_remote [lindex $all_remotes 0]
2546 }
2547 set push_urltype remote
2548 } else {
2549 set push_urltype url
2550 }
2551 radiobutton $w.dest.url_r \
2552 -text {Arbitrary URL:} \
2553 -value url \
2554 -variable push_urltype \
2555 -font font_ui
2556 entry $w.dest.url_t \
2557 -borderwidth 1 \
2558 -relief sunken \
2559 -width 50 \
2560 -textvariable push_url \
2561 -font font_ui \
2562 -validate key \
2563 -validatecommand {
2564 if {%d == 1 && [regexp {\s} %S]} {return 0}
2565 if {%d == 1 && [string length %S] > 0} {
2566 set push_urltype url
2567 }
2568 return 1
2569 }
2570 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2571 grid columnconfigure $w.dest 1 -weight 1
2572 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2573 labelframe $w.options \
2575 -text {Transfer Options} \
2576 -font font_ui
2577 checkbutton $w.options.thin \
2578 -text {Use thin pack (for slow network connections)} \
2579 -variable push_thin \
2580 -font font_ui
2581 grid $w.options.thin -columnspan 2 -sticky w
2582 checkbutton $w.options.tags \
2583 -text {Include tags} \
2584 -variable push_tags \
2585 -font font_ui
2586 grid $w.options.tags -columnspan 2 -sticky w
2587 grid columnconfigure $w.options 1 -weight 1
2588 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2589 set push_url {}
2591 set push_thin 0
2592 set push_tags 0
2593 bind $w <Visibility> "grab $w"
2595 bind $w <Key-Escape> "destroy $w"
2596 wm title $w "[appname] ([reponame]): Push"
2597 tkwait window $w
2598}
2599######################################################################
2601##
2602## merge
2603proc can_merge {} {
2605 global HEAD commit_type file_states
2606 if {[string match amend* $commit_type]} {
2608 info_popup {Cannot merge while amending.
2609You must finish amending this commit before
2611starting any type of merge.
2612}
2613 return 0
2614 }
2615 if {[committer_ident] eq {}} {return 0}
2617 if {![lock_index merge]} {return 0}
2618 # -- Our in memory state should match the repository.
2620 #
2621 repository_state curType curHEAD curMERGE_HEAD
2622 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2623 info_popup {Last scanned state does not match repository state.
2624Another Git program has modified this repository
2626since the last scan. A rescan must be performed
2627before a merge can be performed.
2628The rescan will be automatically started now.
2630}
2631 unlock_index
2632 rescan {set ui_status_value {Ready.}}
2633 return 0
2634 }
2635 foreach path [array names file_states] {
2637 switch -glob -- [lindex $file_states($path) 0] {
2638 _O {
2639 continue; # and pray it works!
2640 }
2641 U? {
2642 error_popup "You are in the middle of a conflicted merge.
2643File [short_path $path] has merge conflicts.
2645You must resolve them, add the file, and commit to
2647complete the current merge. Only then can you
2648begin another merge.
2649"
2650 unlock_index
2651 return 0
2652 }
2653 ?? {
2654 error_popup "You are in the middle of a change.
2655File [short_path $path] is modified.
2657You should complete the current commit before
2659starting a merge. Doing so will help you abort
2660a failed merge, should the need arise.
2661"
2662 unlock_index
2663 return 0
2664 }
2665 }
2666 }
2667 return 1
2669}
2670proc visualize_local_merge {w} {
2672 set revs {}
2673 foreach i [$w.source.l curselection] {
2674 lappend revs [$w.source.l get $i]
2675 }
2676 if {$revs eq {}} return
2677 lappend revs --not HEAD
2678 do_gitk $revs
2679}
2680proc start_local_merge_action {w} {
2682 global HEAD ui_status_value current_branch
2683 set cmd [list git merge]
2685 set names {}
2686 set revcnt 0
2687 foreach i [$w.source.l curselection] {
2688 set b [$w.source.l get $i]
2689 lappend cmd $b
2690 lappend names $b
2691 incr revcnt
2692 }
2693 if {$revcnt == 0} {
2695 return
2696 } elseif {$revcnt == 1} {
2697 set unit branch
2698 } elseif {$revcnt <= 15} {
2699 set unit branches
2700 } else {
2701 tk_messageBox \
2702 -icon error \
2703 -type ok \
2704 -title [wm title $w] \
2705 -parent $w \
2706 -message "Too many branches selected.
2707You have requested to merge $revcnt branches
2709in an octopus merge. This exceeds Git's
2710internal limit of 15 branches per merge.
2711Please select fewer branches. To merge more
2713than 15 branches, merge the branches in batches.
2714"
2715 return
2716 }
2717 set msg "Merging $current_branch, [join $names {, }]"
2719 set ui_status_value "$msg..."
2720 set cons [new_console "Merge" $msg]
2721 console_exec $cons $cmd [list finish_merge $revcnt]
2722 bind $w <Destroy> {}
2723 destroy $w
2724}
2725proc finish_merge {revcnt w ok} {
2727 console_done $w $ok
2728 if {$ok} {
2729 set msg {Merge completed successfully.}
2730 } else {
2731 if {$revcnt != 1} {
2732 info_popup "Octopus merge failed.
2733Your merge of $revcnt branches has failed.
2735There are file-level conflicts between the
2737branches which must be resolved manually.
2738The working directory will now be reset.
2740You can attempt this merge again
2742by merging only one branch at a time." $w
2743 set fd [open "| git read-tree --reset -u HEAD" r]
2745 fconfigure $fd -blocking 0 -translation binary
2746 fileevent $fd readable [list reset_hard_wait $fd]
2747 set ui_status_value {Aborting... please wait...}
2748 return
2749 }
2750 set msg {Merge failed. Conflict resolution is required.}
2752 }
2753 unlock_index
2754 rescan [list set ui_status_value $msg]
2755}
2756proc do_local_merge {} {
2758 global current_branch
2759 if {![can_merge]} return
2761 set w .merge_setup
2763 toplevel $w
2764 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2765 label $w.header \
2767 -text "Merge Into $current_branch" \
2768 -font font_uibold
2769 pack $w.header -side top -fill x
2770 frame $w.buttons
2772 button $w.buttons.visualize -text Visualize \
2773 -font font_ui \
2774 -command [list visualize_local_merge $w]
2775 pack $w.buttons.visualize -side left
2776 button $w.buttons.create -text Merge \
2777 -font font_ui \
2778 -command [list start_local_merge_action $w]
2779 pack $w.buttons.create -side right
2780 button $w.buttons.cancel -text {Cancel} \
2781 -font font_ui \
2782 -command [list destroy $w]
2783 pack $w.buttons.cancel -side right -padx 5
2784 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2785 labelframe $w.source \
2787 -text {Source Branches} \
2788 -font font_ui
2789 listbox $w.source.l \
2790 -height 10 \
2791 -width 70 \
2792 -selectmode extended \
2793 -yscrollcommand [list $w.source.sby set] \
2794 -font font_ui
2795 scrollbar $w.source.sby -command [list $w.source.l yview]
2796 pack $w.source.sby -side right -fill y
2797 pack $w.source.l -side left -fill both -expand 1
2798 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2799 set cmd [list git for-each-ref]
2801 lappend cmd {--format=%(objectname) %(refname)}
2802 lappend cmd refs/heads
2803 lappend cmd refs/remotes
2804 set fr_fd [open "| $cmd" r]
2805 fconfigure $fr_fd -translation binary
2806 while {[gets $fr_fd line] > 0} {
2807 set line [split $line { }]
2808 set sha1([lindex $line 0]) [lindex $line 1]
2809 }
2810 close $fr_fd
2811 set to_show {}
2813 set fr_fd [open "| git rev-list --all --not HEAD"]
2814 while {[gets $fr_fd line] > 0} {
2815 if {[catch {set ref $sha1($line)}]} continue
2816 regsub ^refs/(heads|remotes)/ $ref {} ref
2817 lappend to_show $ref
2818 }
2819 close $fr_fd
2820 foreach ref [lsort -unique $to_show] {
2822 $w.source.l insert end $ref
2823 }
2824 bind $w <Visibility> "grab $w"
2826 bind $w <Key-Escape> "unlock_index;destroy $w"
2827 bind $w <Destroy> unlock_index
2828 wm title $w "[appname] ([reponame]): Merge"
2829 tkwait window $w
2830}
2831proc do_reset_hard {} {
2833 global HEAD commit_type file_states
2834 if {[string match amend* $commit_type]} {
2836 info_popup {Cannot abort while amending.
2837You must finish amending this commit.
2839}
2840 return
2841 }
2842 if {![lock_index abort]} return
2844 if {[string match *merge* $commit_type]} {
2846 set op merge
2847 } else {
2848 set op commit
2849 }
2850 if {[ask_popup "Abort $op?
2852Aborting the current $op will cause
2854*ALL* uncommitted changes to be lost.
2855Continue with aborting the current $op?"] eq {yes}} {
2857 set fd [open "| git read-tree --reset -u HEAD" r]
2858 fconfigure $fd -blocking 0 -translation binary
2859 fileevent $fd readable [list reset_hard_wait $fd]
2860 set ui_status_value {Aborting... please wait...}
2861 } else {
2862 unlock_index
2863 }
2864}
2865proc reset_hard_wait {fd} {
2867 global ui_comm
2868 read $fd
2870 if {[eof $fd]} {
2871 close $fd
2872 unlock_index
2873 $ui_comm delete 0.0 end
2875 $ui_comm edit modified false
2876 catch {file delete [gitdir MERGE_HEAD]}
2878 catch {file delete [gitdir rr-cache MERGE_RR]}
2879 catch {file delete [gitdir SQUASH_MSG]}
2880 catch {file delete [gitdir MERGE_MSG]}
2881 catch {file delete [gitdir GITGUI_MSG]}
2882 rescan {set ui_status_value {Abort completed. Ready.}}
2884 }
2885}
2886######################################################################
2888##
2889## icons
2890set filemask {
2892#define mask_width 14
2893#define mask_height 15
2894static unsigned char mask_bits[] = {
2895 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2896 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2897 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2898}
2899image create bitmap file_plain -background white -foreground black -data {
2901#define plain_width 14
2902#define plain_height 15
2903static unsigned char plain_bits[] = {
2904 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2905 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2906 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2907} -maskdata $filemask
2908image create bitmap file_mod -background white -foreground blue -data {
2910#define mod_width 14
2911#define mod_height 15
2912static unsigned char mod_bits[] = {
2913 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2914 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2915 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2916} -maskdata $filemask
2917image create bitmap file_fulltick -background white -foreground "#007000" -data {
2919#define file_fulltick_width 14
2920#define file_fulltick_height 15
2921static unsigned char file_fulltick_bits[] = {
2922 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2923 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2924 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2925} -maskdata $filemask
2926image create bitmap file_parttick -background white -foreground "#005050" -data {
2928#define parttick_width 14
2929#define parttick_height 15
2930static unsigned char parttick_bits[] = {
2931 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2932 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2933 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2934} -maskdata $filemask
2935image create bitmap file_question -background white -foreground black -data {
2937#define file_question_width 14
2938#define file_question_height 15
2939static unsigned char file_question_bits[] = {
2940 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2941 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2942 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2943} -maskdata $filemask
2944image create bitmap file_removed -background white -foreground red -data {
2946#define file_removed_width 14
2947#define file_removed_height 15
2948static unsigned char file_removed_bits[] = {
2949 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2950 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2951 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2952} -maskdata $filemask
2953image create bitmap file_merge -background white -foreground blue -data {
2955#define file_merge_width 14
2956#define file_merge_height 15
2957static unsigned char file_merge_bits[] = {
2958 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2959 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2960 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2961} -maskdata $filemask
2962set ui_index .vpane.files.index.list
2964set ui_workdir .vpane.files.workdir.list
2965set all_icons(_$ui_index) file_plain
2967set all_icons(A$ui_index) file_fulltick
2968set all_icons(M$ui_index) file_fulltick
2969set all_icons(D$ui_index) file_removed
2970set all_icons(U$ui_index) file_merge
2971set all_icons(_$ui_workdir) file_plain
2973set all_icons(M$ui_workdir) file_mod
2974set all_icons(D$ui_workdir) file_question
2975set all_icons(U$ui_workdir) file_merge
2976set all_icons(O$ui_workdir) file_plain
2977set max_status_desc 0
2979foreach i {
2980 {__ "Unmodified"}
2981 {_M "Modified, not staged"}
2983 {M_ "Staged for commit"}
2984 {MM "Portions staged for commit"}
2985 {MD "Staged for commit, missing"}
2986 {_O "Untracked, not staged"}
2988 {A_ "Staged for commit"}
2989 {AM "Portions staged for commit"}
2990 {AD "Staged for commit, missing"}
2991 {_D "Missing"}
2993 {D_ "Staged for removal"}
2994 {DO "Staged for removal, still present"}
2995 {U_ "Requires merge resolution"}
2997 {UU "Requires merge resolution"}
2998 {UM "Requires merge resolution"}
2999 {UD "Requires merge resolution"}
3000 } {
3001 if {$max_status_desc < [string length [lindex $i 1]]} {
3002 set max_status_desc [string length [lindex $i 1]]
3003 }
3004 set all_descs([lindex $i 0]) [lindex $i 1]
3005}
3006unset i
3007######################################################################
3009##
3010## util
3011proc is_MacOSX {} {
3013 global tcl_platform tk_library
3014 if {[tk windowingsystem] eq {aqua}} {
3015 return 1
3016 }
3017 return 0
3018}
3019proc is_Windows {} {
3021 global tcl_platform
3022 if {$tcl_platform(platform) eq {windows}} {
3023 return 1
3024 }
3025 return 0
3026}
3027proc bind_button3 {w cmd} {
3029 bind $w <Any-Button-3> $cmd
3030 if {[is_MacOSX]} {
3031 bind $w <Control-Button-1> $cmd
3032 }
3033}
3034proc incr_font_size {font {amt 1}} {
3036 set sz [font configure $font -size]
3037 incr sz $amt
3038 font configure $font -size $sz
3039 font configure ${font}bold -size $sz
3040}
3041proc hook_failed_popup {hook msg} {
3043 set w .hookfail
3044 toplevel $w
3045 frame $w.m
3047 label $w.m.l1 -text "$hook hook failed:" \
3048 -anchor w \
3049 -justify left \
3050 -font font_uibold
3051 text $w.m.t \
3052 -background white -borderwidth 1 \
3053 -relief sunken \
3054 -width 80 -height 10 \
3055 -font font_diff \
3056 -yscrollcommand [list $w.m.sby set]
3057 label $w.m.l2 \
3058 -text {You must correct the above errors before committing.} \
3059 -anchor w \
3060 -justify left \
3061 -font font_uibold
3062 scrollbar $w.m.sby -command [list $w.m.t yview]
3063 pack $w.m.l1 -side top -fill x
3064 pack $w.m.l2 -side bottom -fill x
3065 pack $w.m.sby -side right -fill y
3066 pack $w.m.t -side left -fill both -expand 1
3067 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3068 $w.m.t insert 1.0 $msg
3070 $w.m.t conf -state disabled
3071 button $w.ok -text OK \
3073 -width 15 \
3074 -font font_ui \
3075 -command "destroy $w"
3076 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3077 bind $w <Visibility> "grab $w; focus $w"
3079 bind $w <Key-Return> "destroy $w"
3080 wm title $w "[appname] ([reponame]): error"
3081 tkwait window $w
3082}
3083set next_console_id 0
3085proc new_console {short_title long_title} {
3087 global next_console_id console_data
3088 set w .console[incr next_console_id]
3089 set console_data($w) [list $short_title $long_title]
3090 return [console_init $w]
3091}
3092proc console_init {w} {
3094 global console_cr console_data M1B
3095 set console_cr($w) 1.0
3097 toplevel $w
3098 frame $w.m
3099 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3100 -anchor w \
3101 -justify left \
3102 -font font_uibold
3103 text $w.m.t \
3104 -background white -borderwidth 1 \
3105 -relief sunken \
3106 -width 80 -height 10 \
3107 -font font_diff \
3108 -state disabled \
3109 -yscrollcommand [list $w.m.sby set]
3110 label $w.m.s -text {Working... please wait...} \
3111 -anchor w \
3112 -justify left \
3113 -font font_uibold
3114 scrollbar $w.m.sby -command [list $w.m.t yview]
3115 pack $w.m.l1 -side top -fill x
3116 pack $w.m.s -side bottom -fill x
3117 pack $w.m.sby -side right -fill y
3118 pack $w.m.t -side left -fill both -expand 1
3119 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3120 menu $w.ctxm -tearoff 0
3122 $w.ctxm add command -label "Copy" \
3123 -font font_ui \
3124 -command "tk_textCopy $w.m.t"
3125 $w.ctxm add command -label "Select All" \
3126 -font font_ui \
3127 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3128 $w.ctxm add command -label "Copy All" \
3129 -font font_ui \
3130 -command "
3131 $w.m.t tag add sel 0.0 end
3132 tk_textCopy $w.m.t
3133 $w.m.t tag remove sel 0.0 end
3134 "
3135 button $w.ok -text {Close} \
3137 -font font_ui \
3138 -state disabled \
3139 -command "destroy $w"
3140 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3141 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3143 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3144 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3145 bind $w <Visibility> "focus $w"
3146 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3147 return $w
3148}
3149proc console_exec {w cmd after} {
3151 # -- Windows tosses the enviroment when we exec our child.
3152 # But most users need that so we have to relogin. :-(
3153 #
3154 if {[is_Windows]} {
3155 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3156 }
3157 # -- Tcl won't let us redirect both stdout and stderr to
3159 # the same pipe. So pass it through cat...
3160 #
3161 set cmd [concat | $cmd |& cat]
3162 set fd_f [open $cmd r]
3164 fconfigure $fd_f -blocking 0 -translation binary
3165 fileevent $fd_f readable [list console_read $w $fd_f $after]
3166}
3167proc console_read {w fd after} {
3169 global console_cr
3170 set buf [read $fd]
3172 if {$buf ne {}} {
3173 if {![winfo exists $w]} {console_init $w}
3174 $w.m.t conf -state normal
3175 set c 0
3176 set n [string length $buf]
3177 while {$c < $n} {
3178 set cr [string first "\r" $buf $c]
3179 set lf [string first "\n" $buf $c]
3180 if {$cr < 0} {set cr [expr {$n + 1}]}
3181 if {$lf < 0} {set lf [expr {$n + 1}]}
3182 if {$lf < $cr} {
3184 $w.m.t insert end [string range $buf $c $lf]
3185 set console_cr($w) [$w.m.t index {end -1c}]
3186 set c $lf
3187 incr c
3188 } else {
3189 $w.m.t delete $console_cr($w) end
3190 $w.m.t insert end "\n"
3191 $w.m.t insert end [string range $buf $c $cr]
3192 set c $cr
3193 incr c
3194 }
3195 }
3196 $w.m.t conf -state disabled
3197 $w.m.t see end
3198 }
3199 fconfigure $fd -blocking 1
3201 if {[eof $fd]} {
3202 if {[catch {close $fd}]} {
3203 set ok 0
3204 } else {
3205 set ok 1
3206 }
3207 uplevel #0 $after $w $ok
3208 return
3209 }
3210 fconfigure $fd -blocking 0
3211}
3212proc console_chain {cmdlist w {ok 1}} {
3214 if {$ok} {
3215 if {[llength $cmdlist] == 0} {
3216 console_done $w $ok
3217 return
3218 }
3219 set cmd [lindex $cmdlist 0]
3221 set cmdlist [lrange $cmdlist 1 end]
3222 if {[lindex $cmd 0] eq {console_exec}} {
3224 console_exec $w \
3225 [lindex $cmd 1] \
3226 [list console_chain $cmdlist]
3227 } else {
3228 uplevel #0 $cmd $cmdlist $w $ok
3229 }
3230 } else {
3231 console_done $w $ok
3232 }
3233}
3234proc console_done {args} {
3236 global console_cr console_data
3237 switch -- [llength $args] {
3239 2 {
3240 set w [lindex $args 0]
3241 set ok [lindex $args 1]
3242 }
3243 3 {
3244 set w [lindex $args 1]
3245 set ok [lindex $args 2]
3246 }
3247 default {
3248 error "wrong number of args: console_done ?ignored? w ok"
3249 }
3250 }
3251 if {$ok} {
3253 if {[winfo exists $w]} {
3254 $w.m.s conf -background green -text {Success}
3255 $w.ok conf -state normal
3256 }
3257 } else {
3258 if {![winfo exists $w]} {
3259 console_init $w
3260 }
3261 $w.m.s conf -background red -text {Error: Command Failed}
3262 $w.ok conf -state normal
3263 }
3264 array unset console_cr $w
3266 array unset console_data $w
3267}
3268######################################################################
3270##
3271## ui commands
3272set starting_gitk_msg {Starting gitk... please wait...}
3274proc do_gitk {revs} {
3276 global ui_status_value starting_gitk_msg
3277 set cmd gitk
3279 if {$revs ne {}} {
3280 append cmd { }
3281 append cmd $revs
3282 }
3283 if {[is_Windows]} {
3284 set cmd "sh -c \"exec $cmd\""
3285 }
3286 append cmd { &}
3287 if {[catch {eval exec $cmd} err]} {
3289 error_popup "Failed to start gitk:\n\n$err"
3290 } else {
3291 set ui_status_value $starting_gitk_msg
3292 after 10000 {
3293 if {$ui_status_value eq $starting_gitk_msg} {
3294 set ui_status_value {Ready.}
3295 }
3296 }
3297 }
3298}
3299proc do_stats {} {
3301 set fd [open "| git count-objects -v" r]
3302 while {[gets $fd line] > 0} {
3303 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
3304 set stats($name) $value
3305 }
3306 }
3307 close $fd
3308 set packed_sz 0
3310 foreach p [glob -directory [gitdir objects pack] \
3311 -type f \
3312 -nocomplain -- *] {
3313 incr packed_sz [file size $p]
3314 }
3315 if {$packed_sz > 0} {
3316 set stats(size-pack) [expr {$packed_sz / 1024}]
3317 }
3318 set w .stats_view
3320 toplevel $w
3321 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3322 label $w.header -text {Database Statistics} \
3324 -font font_uibold
3325 pack $w.header -side top -fill x
3326 frame $w.buttons -border 1
3328 button $w.buttons.close -text Close \
3329 -font font_ui \
3330 -command [list destroy $w]
3331 button $w.buttons.gc -text {Compress Database} \
3332 -font font_ui \
3333 -command "destroy $w;do_gc"
3334 pack $w.buttons.close -side right
3335 pack $w.buttons.gc -side left
3336 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3337 frame $w.stat -borderwidth 1 -relief solid
3339 foreach s {
3340 {count {Number of loose objects}}
3341 {size {Disk space used by loose objects} { KiB}}
3342 {in-pack {Number of packed objects}}
3343 {packs {Number of packs}}
3344 {size-pack {Disk space used by packed objects} { KiB}}
3345 {prune-packable {Packed objects waiting for pruning}}
3346 {garbage {Garbage files}}
3347 } {
3348 set name [lindex $s 0]
3349 set label [lindex $s 1]
3350 if {[catch {set value $stats($name)}]} continue
3351 if {[llength $s] > 2} {
3352 set value "$value[lindex $s 2]"
3353 }
3354 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
3356 label $w.stat.v_$name -text $value -anchor w -font font_ui
3357 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
3358 }
3359 pack $w.stat -pady 10 -padx 10
3360 bind $w <Visibility> "grab $w; focus $w"
3362 bind $w <Key-Escape> [list destroy $w]
3363 bind $w <Key-Return> [list destroy $w]
3364 wm title $w "[appname] ([reponame]): Database Statistics"
3365 tkwait window $w
3366}
3367proc do_gc {} {
3369 set w [new_console {gc} {Compressing the object database}]
3370 console_chain {
3371 {console_exec {git pack-refs --prune}}
3372 {console_exec {git reflog expire --all}}
3373 {console_exec {git repack -a -d -l}}
3374 {console_exec {git rerere gc}}
3375 } $w
3376}
3377proc do_fsck_objects {} {
3379 set w [new_console {fsck-objects} \
3380 {Verifying the object database with fsck-objects}]
3381 set cmd [list git fsck-objects]
3382 lappend cmd --full
3383 lappend cmd --cache
3384 lappend cmd --strict
3385 console_exec $w $cmd console_done
3386}
3387set is_quitting 0
3389proc do_quit {} {
3391 global ui_comm is_quitting repo_config commit_type
3392 if {$is_quitting} return
3394 set is_quitting 1
3395 # -- Stash our current commit buffer.
3397 #
3398 set save [gitdir GITGUI_MSG]
3399 set msg [string trim [$ui_comm get 0.0 end]]
3400 regsub -all -line {[ \r\t]+$} $msg {} msg
3401 if {(![string match amend* $commit_type]
3402 || [$ui_comm edit modified])
3403 && $msg ne {}} {
3404 catch {
3405 set fd [open $save w]
3406 puts -nonewline $fd $msg
3407 close $fd
3408 }
3409 } else {
3410 catch {file delete $save}
3411 }
3412 # -- Stash our current window geometry into this repository.
3414 #
3415 set cfg_geometry [list]
3416 lappend cfg_geometry [wm geometry .]
3417 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
3418 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
3419 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
3420 set rc_geometry {}
3421 }
3422 if {$cfg_geometry ne $rc_geometry} {
3423 catch {exec git repo-config gui.geometry $cfg_geometry}
3424 }
3425 destroy .
3427}
3428proc do_rescan {} {
3430 rescan {set ui_status_value {Ready.}}
3431}
3432proc unstage_helper {txt paths} {
3434 global file_states current_diff_path
3435 if {![lock_index begin-update]} return
3437 set pathList [list]
3439 set after {}
3440 foreach path $paths {
3441 switch -glob -- [lindex $file_states($path) 0] {
3442 A? -
3443 M? -
3444 D? {
3445 lappend pathList $path
3446 if {$path eq $current_diff_path} {
3447 set after {reshow_diff;}
3448 }
3449 }
3450 }
3451 }
3452 if {$pathList eq {}} {
3453 unlock_index
3454 } else {
3455 update_indexinfo \
3456 $txt \
3457 $pathList \
3458 [concat $after {set ui_status_value {Ready.}}]
3459 }
3460}
3461proc do_unstage_selection {} {
3463 global current_diff_path selected_paths
3464 if {[array size selected_paths] > 0} {
3466 unstage_helper \
3467 {Unstaging selected files from commit} \
3468 [array names selected_paths]
3469 } elseif {$current_diff_path ne {}} {
3470 unstage_helper \
3471 "Unstaging [short_path $current_diff_path] from commit" \
3472 [list $current_diff_path]
3473 }
3474}
3475proc add_helper {txt paths} {
3477 global file_states current_diff_path
3478 if {![lock_index begin-update]} return
3480 set pathList [list]
3482 set after {}
3483 foreach path $paths {
3484 switch -glob -- [lindex $file_states($path) 0] {
3485 _O -
3486 ?M -
3487 ?D -
3488 U? {
3489 lappend pathList $path
3490 if {$path eq $current_diff_path} {
3491 set after {reshow_diff;}
3492 }
3493 }
3494 }
3495 }
3496 if {$pathList eq {}} {
3497 unlock_index
3498 } else {
3499 update_index \
3500 $txt \
3501 $pathList \
3502 [concat $after {set ui_status_value {Ready to commit.}}]
3503 }
3504}
3505proc do_add_selection {} {
3507 global current_diff_path selected_paths
3508 if {[array size selected_paths] > 0} {
3510 add_helper \
3511 {Adding selected files} \
3512 [array names selected_paths]
3513 } elseif {$current_diff_path ne {}} {
3514 add_helper \
3515 "Adding [short_path $current_diff_path]" \
3516 [list $current_diff_path]
3517 }
3518}
3519proc do_add_all {} {
3521 global file_states
3522 set paths [list]
3524 foreach path [array names file_states] {
3525 switch -glob -- [lindex $file_states($path) 0] {
3526 U? {continue}
3527 ?M -
3528 ?D {lappend paths $path}
3529 }
3530 }
3531 add_helper {Adding all changed files} $paths
3532}
3533proc revert_helper {txt paths} {
3535 global file_states current_diff_path
3536 if {![lock_index begin-update]} return
3538 set pathList [list]
3540 set after {}
3541 foreach path $paths {
3542 switch -glob -- [lindex $file_states($path) 0] {
3543 U? {continue}
3544 ?M -
3545 ?D {
3546 lappend pathList $path
3547 if {$path eq $current_diff_path} {
3548 set after {reshow_diff;}
3549 }
3550 }
3551 }
3552 }
3553 set n [llength $pathList]
3555 if {$n == 0} {
3556 unlock_index
3557 return
3558 } elseif {$n == 1} {
3559 set s "[short_path [lindex $pathList]]"
3560 } else {
3561 set s "these $n files"
3562 }
3563 set reply [tk_dialog \
3565 .confirm_revert \
3566 "[appname] ([reponame])" \
3567 "Revert changes in $s?
3568Any unadded changes will be permanently lost by the revert." \
3570 question \
3571 1 \
3572 {Do Nothing} \
3573 {Revert Changes} \
3574 ]
3575 if {$reply == 1} {
3576 checkout_index \
3577 $txt \
3578 $pathList \
3579 [concat $after {set ui_status_value {Ready.}}]
3580 } else {
3581 unlock_index
3582 }
3583}
3584proc do_revert_selection {} {
3586 global current_diff_path selected_paths
3587 if {[array size selected_paths] > 0} {
3589 revert_helper \
3590 {Reverting selected files} \
3591 [array names selected_paths]
3592 } elseif {$current_diff_path ne {}} {
3593 revert_helper \
3594 "Reverting [short_path $current_diff_path]" \
3595 [list $current_diff_path]
3596 }
3597}
3598proc do_signoff {} {
3600 global ui_comm
3601 set me [committer_ident]
3603 if {$me eq {}} return
3604 set sob "Signed-off-by: $me"
3606 set last [$ui_comm get {end -1c linestart} {end -1c}]
3607 if {$last ne $sob} {
3608 $ui_comm edit separator
3609 if {$last ne {}
3610 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
3611 $ui_comm insert end "\n"
3612 }
3613 $ui_comm insert end "\n$sob"
3614 $ui_comm edit separator
3615 $ui_comm see end
3616 }
3617}
3618proc do_select_commit_type {} {
3620 global commit_type selected_commit_type
3621 if {$selected_commit_type eq {new}
3623 && [string match amend* $commit_type]} {
3624 create_new_commit
3625 } elseif {$selected_commit_type eq {amend}
3626 && ![string match amend* $commit_type]} {
3627 load_last_commit
3628 # The amend request was rejected...
3630 #
3631 if {![string match amend* $commit_type]} {
3632 set selected_commit_type new
3633 }
3634 }
3635}
3636proc do_commit {} {
3638 commit_tree
3639}
3640proc do_about {} {
3642 global appvers copyright
3643 global tcl_patchLevel tk_patchLevel
3644 set w .about_dialog
3646 toplevel $w
3647 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3648 label $w.header -text "About [appname]" \
3650 -font font_uibold
3651 pack $w.header -side top -fill x
3652 frame $w.buttons
3654 button $w.buttons.close -text {Close} \
3655 -font font_ui \
3656 -command [list destroy $w]
3657 pack $w.buttons.close -side right
3658 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3659 label $w.desc \
3661 -text "[appname] - a commit creation tool for Git.
3662$copyright" \
3663 -padx 5 -pady 5 \
3664 -justify left \
3665 -anchor w \
3666 -borderwidth 1 \
3667 -relief solid \
3668 -font font_ui
3669 pack $w.desc -side top -fill x -padx 5 -pady 5
3670 set v {}
3672 append v "[appname] version $appvers\n"
3673 append v "[exec git version]\n"
3674 append v "\n"
3675 if {$tcl_patchLevel eq $tk_patchLevel} {
3676 append v "Tcl/Tk version $tcl_patchLevel"
3677 } else {
3678 append v "Tcl version $tcl_patchLevel"
3679 append v ", Tk version $tk_patchLevel"
3680 }
3681 label $w.vers \
3683 -text $v \
3684 -padx 5 -pady 5 \
3685 -justify left \
3686 -anchor w \
3687 -borderwidth 1 \
3688 -relief solid \
3689 -font font_ui
3690 pack $w.vers -side top -fill x -padx 5 -pady 5
3691 menu $w.ctxm -tearoff 0
3693 $w.ctxm add command \
3694 -label {Copy} \
3695 -font font_ui \
3696 -command "
3697 clipboard clear
3698 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3699 "
3700 bind $w <Visibility> "grab $w; focus $w"
3702 bind $w <Key-Escape> "destroy $w"
3703 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3704 wm title $w "About [appname]"
3705 tkwait window $w
3706}
3707proc do_options {} {
3709 global repo_config global_config font_descs
3710 global repo_config_new global_config_new
3711 array unset repo_config_new
3713 array unset global_config_new
3714 foreach name [array names repo_config] {
3715 set repo_config_new($name) $repo_config($name)
3716 }
3717 load_config 1
3718 foreach name [array names repo_config] {
3719 switch -- $name {
3720 gui.diffcontext {continue}
3721 }
3722 set repo_config_new($name) $repo_config($name)
3723 }
3724 foreach name [array names global_config] {
3725 set global_config_new($name) $global_config($name)
3726 }
3727 set w .options_editor
3729 toplevel $w
3730 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3731 label $w.header -text "[appname] Options" \
3733 -font font_uibold
3734 pack $w.header -side top -fill x
3735 frame $w.buttons
3737 button $w.buttons.restore -text {Restore Defaults} \
3738 -font font_ui \
3739 -command do_restore_defaults
3740 pack $w.buttons.restore -side left
3741 button $w.buttons.save -text Save \
3742 -font font_ui \
3743 -command [list do_save_config $w]
3744 pack $w.buttons.save -side right
3745 button $w.buttons.cancel -text {Cancel} \
3746 -font font_ui \
3747 -command [list destroy $w]
3748 pack $w.buttons.cancel -side right -padx 5
3749 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3750 labelframe $w.repo -text "[reponame] Repository" \
3752 -font font_ui
3753 labelframe $w.global -text {Global (All Repositories)} \
3754 -font font_ui
3755 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
3756 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
3757 foreach option {
3759 {b pullsummary {Show Pull Summary}}
3760 {b trustmtime {Trust File Modification Timestamps}}
3761 {i diffcontext {Number of Diff Context Lines}}
3762 {t newbranchtemplate {New Branch Name Template}}
3763 } {
3764 set type [lindex $option 0]
3765 set name [lindex $option 1]
3766 set text [lindex $option 2]
3767 foreach f {repo global} {
3768 switch $type {
3769 b {
3770 checkbutton $w.$f.$name -text $text \
3771 -variable ${f}_config_new(gui.$name) \
3772 -onvalue true \
3773 -offvalue false \
3774 -font font_ui
3775 pack $w.$f.$name -side top -anchor w
3776 }
3777 i {
3778 frame $w.$f.$name
3779 label $w.$f.$name.l -text "$text:" -font font_ui
3780 pack $w.$f.$name.l -side left -anchor w -fill x
3781 spinbox $w.$f.$name.v \
3782 -textvariable ${f}_config_new(gui.$name) \
3783 -from 1 -to 99 -increment 1 \
3784 -width 3 \
3785 -font font_ui
3786 bind $w.$f.$name.v <FocusIn> {%W selection range 0 end}
3787 pack $w.$f.$name.v -side right -anchor e -padx 5
3788 pack $w.$f.$name -side top -anchor w -fill x
3789 }
3790 t {
3791 frame $w.$f.$name
3792 label $w.$f.$name.l -text "$text:" -font font_ui
3793 entry $w.$f.$name.v \
3794 -borderwidth 1 \
3795 -relief sunken \
3796 -width 20 \
3797 -textvariable ${f}_config_new(gui.$name) \
3798 -font font_ui
3799 pack $w.$f.$name.l -side left -anchor w
3800 pack $w.$f.$name.v -side left -anchor w \
3801 -fill x -expand 1 \
3802 -padx 5
3803 pack $w.$f.$name -side top -anchor w -fill x
3804 }
3805 }
3806 }
3807 }
3808 set all_fonts [lsort [font families]]
3810 foreach option $font_descs {
3811 set name [lindex $option 0]
3812 set font [lindex $option 1]
3813 set text [lindex $option 2]
3814 set global_config_new(gui.$font^^family) \
3816 [font configure $font -family]
3817 set global_config_new(gui.$font^^size) \
3818 [font configure $font -size]
3819 frame $w.global.$name
3821 label $w.global.$name.l -text "$text:" -font font_ui
3822 pack $w.global.$name.l -side left -anchor w -fill x
3823 eval tk_optionMenu $w.global.$name.family \
3824 global_config_new(gui.$font^^family) \
3825 $all_fonts
3826 spinbox $w.global.$name.size \
3827 -textvariable global_config_new(gui.$font^^size) \
3828 -from 2 -to 80 -increment 1 \
3829 -width 3 \
3830 -font font_ui
3831 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3832 pack $w.global.$name.size -side right -anchor e
3833 pack $w.global.$name.family -side right -anchor e
3834 pack $w.global.$name -side top -anchor w -fill x
3835 }
3836 bind $w <Visibility> "grab $w; focus $w"
3838 bind $w <Key-Escape> "destroy $w"
3839 wm title $w "[appname] ([reponame]): Options"
3840 tkwait window $w
3841}
3842proc do_restore_defaults {} {
3844 global font_descs default_config repo_config
3845 global repo_config_new global_config_new
3846 foreach name [array names default_config] {
3848 set repo_config_new($name) $default_config($name)
3849 set global_config_new($name) $default_config($name)
3850 }
3851 foreach option $font_descs {
3853 set name [lindex $option 0]
3854 set repo_config(gui.$name) $default_config(gui.$name)
3855 }
3856 apply_config
3857 foreach option $font_descs {
3859 set name [lindex $option 0]
3860 set font [lindex $option 1]
3861 set global_config_new(gui.$font^^family) \
3862 [font configure $font -family]
3863 set global_config_new(gui.$font^^size) \
3864 [font configure $font -size]
3865 }
3866}
3867proc do_save_config {w} {
3869 if {[catch {save_config} err]} {
3870 error_popup "Failed to completely save options:\n\n$err"
3871 }
3872 reshow_diff
3873 destroy $w
3874}
3875proc do_windows_shortcut {} {
3877 global argv0
3878 if {[catch {
3880 set desktop [exec cygpath \
3881 --windows \
3882 --absolute \
3883 --long-name \
3884 --desktop]
3885 }]} {
3886 set desktop .
3887 }
3888 set fn [tk_getSaveFile \
3889 -parent . \
3890 -title "[appname] ([reponame]): Create Desktop Icon" \
3891 -initialdir $desktop \
3892 -initialfile "Git [reponame].bat"]
3893 if {$fn != {}} {
3894 if {[catch {
3895 set fd [open $fn w]
3896 set sh [exec cygpath \
3897 --windows \
3898 --absolute \
3899 /bin/sh]
3900 set me [exec cygpath \
3901 --unix \
3902 --absolute \
3903 $argv0]
3904 set gd [exec cygpath \
3905 --unix \
3906 --absolute \
3907 [gitdir]]
3908 set gw [exec cygpath \
3909 --windows \
3910 --absolute \
3911 [file dirname [gitdir]]]
3912 regsub -all ' $me "'\\''" me
3913 regsub -all ' $gd "'\\''" gd
3914 puts $fd "@ECHO Entering $gw"
3915 puts $fd "@ECHO Starting git-gui... please wait..."
3916 puts -nonewline $fd "@\"$sh\" --login -c \""
3917 puts -nonewline $fd "GIT_DIR='$gd'"
3918 puts -nonewline $fd " '$me'"
3919 puts $fd "&\""
3920 close $fd
3921 } err]} {
3922 error_popup "Cannot write script:\n\n$err"
3923 }
3924 }
3925}
3926proc do_macosx_app {} {
3928 global argv0 env
3929 set fn [tk_getSaveFile \
3931 -parent . \
3932 -title "[appname] ([reponame]): Create Desktop Icon" \
3933 -initialdir [file join $env(HOME) Desktop] \
3934 -initialfile "Git [reponame].app"]
3935 if {$fn != {}} {
3936 if {[catch {
3937 set Contents [file join $fn Contents]
3938 set MacOS [file join $Contents MacOS]
3939 set exe [file join $MacOS git-gui]
3940 file mkdir $MacOS
3942 set fd [open [file join $Contents Info.plist] w]
3944 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3945<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3946<plist version="1.0">
3947<dict>
3948 <key>CFBundleDevelopmentRegion</key>
3949 <string>English</string>
3950 <key>CFBundleExecutable</key>
3951 <string>git-gui</string>
3952 <key>CFBundleIdentifier</key>
3953 <string>org.spearce.git-gui</string>
3954 <key>CFBundleInfoDictionaryVersion</key>
3955 <string>6.0</string>
3956 <key>CFBundlePackageType</key>
3957 <string>APPL</string>
3958 <key>CFBundleSignature</key>
3959 <string>????</string>
3960 <key>CFBundleVersion</key>
3961 <string>1.0</string>
3962 <key>NSPrincipalClass</key>
3963 <string>NSApplication</string>
3964</dict>
3965</plist>}
3966 close $fd
3967 set fd [open $exe w]
3969 set gd [file normalize [gitdir]]
3970 set ep [file normalize [exec git --exec-path]]
3971 regsub -all ' $gd "'\\''" gd
3972 regsub -all ' $ep "'\\''" ep
3973 puts $fd "#!/bin/sh"
3974 foreach name [array names env] {
3975 if {[string match GIT_* $name]} {
3976 regsub -all ' $env($name) "'\\''" v
3977 puts $fd "export $name='$v'"
3978 }
3979 }
3980 puts $fd "export PATH='$ep':\$PATH"
3981 puts $fd "export GIT_DIR='$gd'"
3982 puts $fd "exec [file normalize $argv0]"
3983 close $fd
3984 file attributes $exe -permissions u+x,g+x,o+x
3986 } err]} {
3987 error_popup "Cannot write icon:\n\n$err"
3988 }
3989 }
3990}
3991proc toggle_or_diff {w x y} {
3993 global file_states file_lists current_diff_path ui_index ui_workdir
3994 global last_clicked selected_paths
3995 set pos [split [$w index @$x,$y] .]
3997 set lno [lindex $pos 0]
3998 set col [lindex $pos 1]
3999 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4000 if {$path eq {}} {
4001 set last_clicked {}
4002 return
4003 }
4004 set last_clicked [list $w $lno]
4006 array unset selected_paths
4007 $ui_index tag remove in_sel 0.0 end
4008 $ui_workdir tag remove in_sel 0.0 end
4009 if {$col == 0} {
4011 if {$current_diff_path eq $path} {
4012 set after {reshow_diff;}
4013 } else {
4014 set after {}
4015 }
4016 if {$w eq $ui_index} {
4017 update_indexinfo \
4018 "Unstaging [short_path $path] from commit" \
4019 [list $path] \
4020 [concat $after {set ui_status_value {Ready.}}]
4021 } elseif {$w eq $ui_workdir} {
4022 update_index \
4023 "Adding [short_path $path]" \
4024 [list $path] \
4025 [concat $after {set ui_status_value {Ready.}}]
4026 }
4027 } else {
4028 show_diff $path $w $lno
4029 }
4030}
4031proc add_one_to_selection {w x y} {
4033 global file_lists last_clicked selected_paths
4034 set lno [lindex [split [$w index @$x,$y] .] 0]
4036 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4037 if {$path eq {}} {
4038 set last_clicked {}
4039 return
4040 }
4041 if {$last_clicked ne {}
4043 && [lindex $last_clicked 0] ne $w} {
4044 array unset selected_paths
4045 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4046 }
4047 set last_clicked [list $w $lno]
4049 if {[catch {set in_sel $selected_paths($path)}]} {
4050 set in_sel 0
4051 }
4052 if {$in_sel} {
4053 unset selected_paths($path)
4054 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4055 } else {
4056 set selected_paths($path) 1
4057 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4058 }
4059}
4060proc add_range_to_selection {w x y} {
4062 global file_lists last_clicked selected_paths
4063 if {[lindex $last_clicked 0] ne $w} {
4065 toggle_or_diff $w $x $y
4066 return
4067 }
4068 set lno [lindex [split [$w index @$x,$y] .] 0]
4070 set lc [lindex $last_clicked 1]
4071 if {$lc < $lno} {
4072 set begin $lc
4073 set end $lno
4074 } else {
4075 set begin $lno
4076 set end $lc
4077 }
4078 foreach path [lrange $file_lists($w) \
4080 [expr {$begin - 1}] \
4081 [expr {$end - 1}]] {
4082 set selected_paths($path) 1
4083 }
4084 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4085}
4086######################################################################
4088##
4089## config defaults
4090set cursor_ptr arrow
4092font create font_diff -family Courier -size 10
4093font create font_ui
4094catch {
4095 label .dummy
4096 eval font configure font_ui [font actual [.dummy cget -font]]
4097 destroy .dummy
4098}
4099font create font_uibold
4101font create font_diffbold
4102if {[is_Windows]} {
4104 set M1B Control
4105 set M1T Ctrl
4106} elseif {[is_MacOSX]} {
4107 set M1B M1
4108 set M1T Cmd
4109} else {
4110 set M1B M1
4111 set M1T M1
4112}
4113proc apply_config {} {
4115 global repo_config font_descs
4116 foreach option $font_descs {
4118 set name [lindex $option 0]
4119 set font [lindex $option 1]
4120 if {[catch {
4121 foreach {cn cv} $repo_config(gui.$name) {
4122 font configure $font $cn $cv
4123 }
4124 } err]} {
4125 error_popup "Invalid font specified in gui.$name:\n\n$err"
4126 }
4127 foreach {cn cv} [font configure $font] {
4128 font configure ${font}bold $cn $cv
4129 }
4130 font configure ${font}bold -weight bold
4131 }
4132}
4133set default_config(gui.trustmtime) false
4135set default_config(gui.pullsummary) true
4136set default_config(gui.diffcontext) 5
4137set default_config(gui.newbranchtemplate) {}
4138set default_config(gui.fontui) [font configure font_ui]
4139set default_config(gui.fontdiff) [font configure font_diff]
4140set font_descs {
4141 {fontui font_ui {Main Font}}
4142 {fontdiff font_diff {Diff/Console Font}}
4143}
4144load_config 0
4145apply_config
4146######################################################################
4148##
4149## ui construction
4150# -- Menu Bar
4152#
4153menu .mbar -tearoff 0
4154.mbar add cascade -label Repository -menu .mbar.repository
4155.mbar add cascade -label Edit -menu .mbar.edit
4156if {!$single_commit} {
4157 .mbar add cascade -label Branch -menu .mbar.branch
4158}
4159.mbar add cascade -label Commit -menu .mbar.commit
4160if {!$single_commit} {
4161 .mbar add cascade -label Merge -menu .mbar.merge
4162 .mbar add cascade -label Fetch -menu .mbar.fetch
4163 .mbar add cascade -label Push -menu .mbar.push
4164}
4165. configure -menu .mbar
4166# -- Repository Menu
4168#
4169menu .mbar.repository
4170.mbar.repository add command \
4171 -label {Visualize Current Branch} \
4172 -command {do_gitk {}} \
4173 -font font_ui
4174.mbar.repository add command \
4175 -label {Visualize All Branches} \
4176 -command {do_gitk {--all}} \
4177 -font font_ui
4178.mbar.repository add separator
4179if {!$single_commit} {
4181 .mbar.repository add command -label {Database Statistics} \
4182 -command do_stats \
4183 -font font_ui
4184 .mbar.repository add command -label {Compress Database} \
4186 -command do_gc \
4187 -font font_ui
4188 .mbar.repository add command -label {Verify Database} \
4190 -command do_fsck_objects \
4191 -font font_ui
4192 .mbar.repository add separator
4194 if {[is_Windows]} {
4196 .mbar.repository add command \
4197 -label {Create Desktop Icon} \
4198 -command do_windows_shortcut \
4199 -font font_ui
4200 } elseif {[is_MacOSX]} {
4201 .mbar.repository add command \
4202 -label {Create Desktop Icon} \
4203 -command do_macosx_app \
4204 -font font_ui
4205 }
4206}
4207.mbar.repository add command -label Quit \
4209 -command do_quit \
4210 -accelerator $M1T-Q \
4211 -font font_ui
4212# -- Edit Menu
4214#
4215menu .mbar.edit
4216.mbar.edit add command -label Undo \
4217 -command {catch {[focus] edit undo}} \
4218 -accelerator $M1T-Z \
4219 -font font_ui
4220.mbar.edit add command -label Redo \
4221 -command {catch {[focus] edit redo}} \
4222 -accelerator $M1T-Y \
4223 -font font_ui
4224.mbar.edit add separator
4225.mbar.edit add command -label Cut \
4226 -command {catch {tk_textCut [focus]}} \
4227 -accelerator $M1T-X \
4228 -font font_ui
4229.mbar.edit add command -label Copy \
4230 -command {catch {tk_textCopy [focus]}} \
4231 -accelerator $M1T-C \
4232 -font font_ui
4233.mbar.edit add command -label Paste \
4234 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4235 -accelerator $M1T-V \
4236 -font font_ui
4237.mbar.edit add command -label Delete \
4238 -command {catch {[focus] delete sel.first sel.last}} \
4239 -accelerator Del \
4240 -font font_ui
4241.mbar.edit add separator
4242.mbar.edit add command -label {Select All} \
4243 -command {catch {[focus] tag add sel 0.0 end}} \
4244 -accelerator $M1T-A \
4245 -font font_ui
4246# -- Branch Menu
4248#
4249if {!$single_commit} {
4250 menu .mbar.branch
4251 .mbar.branch add command -label {Create...} \
4253 -command do_create_branch \
4254 -accelerator $M1T-N \
4255 -font font_ui
4256 lappend disable_on_lock [list .mbar.branch entryconf \
4257 [.mbar.branch index last] -state]
4258 .mbar.branch add command -label {Delete...} \
4260 -command do_delete_branch \
4261 -font font_ui
4262 lappend disable_on_lock [list .mbar.branch entryconf \
4263 [.mbar.branch index last] -state]
4264}
4265# -- Commit Menu
4267#
4268menu .mbar.commit
4269.mbar.commit add radiobutton \
4271 -label {New Commit} \
4272 -command do_select_commit_type \
4273 -variable selected_commit_type \
4274 -value new \
4275 -font font_ui
4276lappend disable_on_lock \
4277 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4278.mbar.commit add radiobutton \
4280 -label {Amend Last Commit} \
4281 -command do_select_commit_type \
4282 -variable selected_commit_type \
4283 -value amend \
4284 -font font_ui
4285lappend disable_on_lock \
4286 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4287.mbar.commit add separator
4289.mbar.commit add command -label Rescan \
4291 -command do_rescan \
4292 -accelerator F5 \
4293 -font font_ui
4294lappend disable_on_lock \
4295 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4296.mbar.commit add command -label {Add To Commit} \
4298 -command do_add_selection \
4299 -font font_ui
4300lappend disable_on_lock \
4301 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4302.mbar.commit add command -label {Add All To Commit} \
4304 -command do_add_all \
4305 -accelerator $M1T-I \
4306 -font font_ui
4307lappend disable_on_lock \
4308 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4309.mbar.commit add command -label {Unstage From Commit} \
4311 -command do_unstage_selection \
4312 -font font_ui
4313lappend disable_on_lock \
4314 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4315.mbar.commit add command -label {Revert Changes} \
4317 -command do_revert_selection \
4318 -font font_ui
4319lappend disable_on_lock \
4320 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4321.mbar.commit add separator
4323.mbar.commit add command -label {Sign Off} \
4325 -command do_signoff \
4326 -accelerator $M1T-S \
4327 -font font_ui
4328.mbar.commit add command -label Commit \
4330 -command do_commit \
4331 -accelerator $M1T-Return \
4332 -font font_ui
4333lappend disable_on_lock \
4334 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4335if {[is_MacOSX]} {
4337 # -- Apple Menu (Mac OS X only)
4338 #
4339 .mbar add cascade -label Apple -menu .mbar.apple
4340 menu .mbar.apple
4341 .mbar.apple add command -label "About [appname]" \
4343 -command do_about \
4344 -font font_ui
4345 .mbar.apple add command -label "[appname] Options..." \
4346 -command do_options \
4347 -font font_ui
4348} else {
4349 # -- Edit Menu
4350 #
4351 .mbar.edit add separator
4352 .mbar.edit add command -label {Options...} \
4353 -command do_options \
4354 -font font_ui
4355 # -- Tools Menu
4357 #
4358 if {[file exists /usr/local/miga/lib/gui-miga]
4359 && [file exists .pvcsrc]} {
4360 proc do_miga {} {
4361 global ui_status_value
4362 if {![lock_index update]} return
4363 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
4364 set miga_fd [open "|$cmd" r]
4365 fconfigure $miga_fd -blocking 0
4366 fileevent $miga_fd readable [list miga_done $miga_fd]
4367 set ui_status_value {Running miga...}
4368 }
4369 proc miga_done {fd} {
4370 read $fd 512
4371 if {[eof $fd]} {
4372 close $fd
4373 unlock_index
4374 rescan [list set ui_status_value {Ready.}]
4375 }
4376 }
4377 .mbar add cascade -label Tools -menu .mbar.tools
4378 menu .mbar.tools
4379 .mbar.tools add command -label "Migrate" \
4380 -command do_miga \
4381 -font font_ui
4382 lappend disable_on_lock \
4383 [list .mbar.tools entryconf [.mbar.tools index last] -state]
4384 }
4385 # -- Help Menu
4387 #
4388 .mbar add cascade -label Help -menu .mbar.help
4389 menu .mbar.help
4390 .mbar.help add command -label "About [appname]" \
4392 -command do_about \
4393 -font font_ui
4394}
4395# -- Branch Control
4398#
4399frame .branch \
4400 -borderwidth 1 \
4401 -relief sunken
4402label .branch.l1 \
4403 -text {Current Branch:} \
4404 -anchor w \
4405 -justify left \
4406 -font font_ui
4407label .branch.cb \
4408 -textvariable current_branch \
4409 -anchor w \
4410 -justify left \
4411 -font font_ui
4412pack .branch.l1 -side left
4413pack .branch.cb -side left -fill x
4414pack .branch -side top -fill x
4415if {!$single_commit} {
4417 menu .mbar.merge
4418 .mbar.merge add command -label {Local Merge...} \
4419 -command do_local_merge \
4420 -font font_ui
4421 lappend disable_on_lock \
4422 [list .mbar.merge entryconf [.mbar.merge index last] -state]
4423 .mbar.merge add command -label {Abort Merge...} \
4424 -command do_reset_hard \
4425 -font font_ui
4426 lappend disable_on_lock \
4427 [list .mbar.merge entryconf [.mbar.merge index last] -state]
4428 menu .mbar.fetch
4431 menu .mbar.push
4433 .mbar.push add command -label {Push...} \
4434 -command do_push_anywhere \
4435 -font font_ui
4436}
4437# -- Main Window Layout
4439#
4440panedwindow .vpane -orient vertical
4441panedwindow .vpane.files -orient horizontal
4442.vpane add .vpane.files -sticky nsew -height 100 -width 200
4443pack .vpane -anchor n -side top -fill both -expand 1
4444# -- Index File List
4446#
4447frame .vpane.files.index -height 100 -width 200
4448label .vpane.files.index.title -text {Changes To Be Committed} \
4449 -background green \
4450 -font font_ui
4451text $ui_index -background white -borderwidth 0 \
4452 -width 20 -height 10 \
4453 -wrap none \
4454 -font font_ui \
4455 -cursor $cursor_ptr \
4456 -xscrollcommand {.vpane.files.index.sx set} \
4457 -yscrollcommand {.vpane.files.index.sy set} \
4458 -state disabled
4459scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4460scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4461pack .vpane.files.index.title -side top -fill x
4462pack .vpane.files.index.sx -side bottom -fill x
4463pack .vpane.files.index.sy -side right -fill y
4464pack $ui_index -side left -fill both -expand 1
4465.vpane.files add .vpane.files.index -sticky nsew
4466# -- Working Directory File List
4468#
4469frame .vpane.files.workdir -height 100 -width 200
4470label .vpane.files.workdir.title -text {Changed But Not Updated} \
4471 -background red \
4472 -font font_ui
4473text $ui_workdir -background white -borderwidth 0 \
4474 -width 20 -height 10 \
4475 -wrap none \
4476 -font font_ui \
4477 -cursor $cursor_ptr \
4478 -xscrollcommand {.vpane.files.workdir.sx set} \
4479 -yscrollcommand {.vpane.files.workdir.sy set} \
4480 -state disabled
4481scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4482scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4483pack .vpane.files.workdir.title -side top -fill x
4484pack .vpane.files.workdir.sx -side bottom -fill x
4485pack .vpane.files.workdir.sy -side right -fill y
4486pack $ui_workdir -side left -fill both -expand 1
4487.vpane.files add .vpane.files.workdir -sticky nsew
4488foreach i [list $ui_index $ui_workdir] {
4490 $i tag conf in_diff -font font_uibold
4491 $i tag conf in_sel \
4492 -background [$i cget -foreground] \
4493 -foreground [$i cget -background]
4494}
4495unset i
4496# -- Diff and Commit Area
4498#
4499frame .vpane.lower -height 300 -width 400
4500frame .vpane.lower.commarea
4501frame .vpane.lower.diff -relief sunken -borderwidth 1
4502pack .vpane.lower.commarea -side top -fill x
4503pack .vpane.lower.diff -side bottom -fill both -expand 1
4504.vpane add .vpane.lower -sticky nsew
4505# -- Commit Area Buttons
4507#
4508frame .vpane.lower.commarea.buttons
4509label .vpane.lower.commarea.buttons.l -text {} \
4510 -anchor w \
4511 -justify left \
4512 -font font_ui
4513pack .vpane.lower.commarea.buttons.l -side top -fill x
4514pack .vpane.lower.commarea.buttons -side left -fill y
4515button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4517 -command do_rescan \
4518 -font font_ui
4519pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4520lappend disable_on_lock \
4521 {.vpane.lower.commarea.buttons.rescan conf -state}
4522button .vpane.lower.commarea.buttons.incall -text {Add All} \
4524 -command do_add_all \
4525 -font font_ui
4526pack .vpane.lower.commarea.buttons.incall -side top -fill x
4527lappend disable_on_lock \
4528 {.vpane.lower.commarea.buttons.incall conf -state}
4529button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4531 -command do_signoff \
4532 -font font_ui
4533pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4534button .vpane.lower.commarea.buttons.commit -text {Commit} \
4536 -command do_commit \
4537 -font font_ui
4538pack .vpane.lower.commarea.buttons.commit -side top -fill x
4539lappend disable_on_lock \
4540 {.vpane.lower.commarea.buttons.commit conf -state}
4541# -- Commit Message Buffer
4543#
4544frame .vpane.lower.commarea.buffer
4545frame .vpane.lower.commarea.buffer.header
4546set ui_comm .vpane.lower.commarea.buffer.t
4547set ui_coml .vpane.lower.commarea.buffer.header.l
4548radiobutton .vpane.lower.commarea.buffer.header.new \
4549 -text {New Commit} \
4550 -command do_select_commit_type \
4551 -variable selected_commit_type \
4552 -value new \
4553 -font font_ui
4554lappend disable_on_lock \
4555 [list .vpane.lower.commarea.buffer.header.new conf -state]
4556radiobutton .vpane.lower.commarea.buffer.header.amend \
4557 -text {Amend Last Commit} \
4558 -command do_select_commit_type \
4559 -variable selected_commit_type \
4560 -value amend \
4561 -font font_ui
4562lappend disable_on_lock \
4563 [list .vpane.lower.commarea.buffer.header.amend conf -state]
4564label $ui_coml \
4565 -anchor w \
4566 -justify left \
4567 -font font_ui
4568proc trace_commit_type {varname args} {
4569 global ui_coml commit_type
4570 switch -glob -- $commit_type {
4571 initial {set txt {Initial Commit Message:}}
4572 amend {set txt {Amended Commit Message:}}
4573 amend-initial {set txt {Amended Initial Commit Message:}}
4574 amend-merge {set txt {Amended Merge Commit Message:}}
4575 merge {set txt {Merge Commit Message:}}
4576 * {set txt {Commit Message:}}
4577 }
4578 $ui_coml conf -text $txt
4579}
4580trace add variable commit_type write trace_commit_type
4581pack $ui_coml -side left -fill x
4582pack .vpane.lower.commarea.buffer.header.amend -side right
4583pack .vpane.lower.commarea.buffer.header.new -side right
4584text $ui_comm -background white -borderwidth 1 \
4586 -undo true \
4587 -maxundo 20 \
4588 -autoseparators true \
4589 -relief sunken \
4590 -width 75 -height 9 -wrap none \
4591 -font font_diff \
4592 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4593scrollbar .vpane.lower.commarea.buffer.sby \
4594 -command [list $ui_comm yview]
4595pack .vpane.lower.commarea.buffer.header -side top -fill x
4596pack .vpane.lower.commarea.buffer.sby -side right -fill y
4597pack $ui_comm -side left -fill y
4598pack .vpane.lower.commarea.buffer -side left -fill y
4599# -- Commit Message Buffer Context Menu
4601#
4602set ctxm .vpane.lower.commarea.buffer.ctxm
4603menu $ctxm -tearoff 0
4604$ctxm add command \
4605 -label {Cut} \
4606 -font font_ui \
4607 -command {tk_textCut $ui_comm}
4608$ctxm add command \
4609 -label {Copy} \
4610 -font font_ui \
4611 -command {tk_textCopy $ui_comm}
4612$ctxm add command \
4613 -label {Paste} \
4614 -font font_ui \
4615 -command {tk_textPaste $ui_comm}
4616$ctxm add command \
4617 -label {Delete} \
4618 -font font_ui \
4619 -command {$ui_comm delete sel.first sel.last}
4620$ctxm add separator
4621$ctxm add command \
4622 -label {Select All} \
4623 -font font_ui \
4624 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4625$ctxm add command \
4626 -label {Copy All} \
4627 -font font_ui \
4628 -command {
4629 $ui_comm tag add sel 0.0 end
4630 tk_textCopy $ui_comm
4631 $ui_comm tag remove sel 0.0 end
4632 }
4633$ctxm add separator
4634$ctxm add command \
4635 -label {Sign Off} \
4636 -font font_ui \
4637 -command do_signoff
4638bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
4639# -- Diff Header
4641#
4642set current_diff_path {}
4643set current_diff_side {}
4644set diff_actions [list]
4645proc trace_current_diff_path {varname args} {
4646 global current_diff_path diff_actions file_states
4647 if {$current_diff_path eq {}} {
4648 set s {}
4649 set f {}
4650 set p {}
4651 set o disabled
4652 } else {
4653 set p $current_diff_path
4654 set s [mapdesc [lindex $file_states($p) 0] $p]
4655 set f {File:}
4656 set p [escape_path $p]
4657 set o normal
4658 }
4659 .vpane.lower.diff.header.status configure -text $s
4661 .vpane.lower.diff.header.file configure -text $f
4662 .vpane.lower.diff.header.path configure -text $p
4663 foreach w $diff_actions {
4664 uplevel #0 $w $o
4665 }
4666}
4667trace add variable current_diff_path write trace_current_diff_path
4668frame .vpane.lower.diff.header -background orange
4670label .vpane.lower.diff.header.status \
4671 -background orange \
4672 -width $max_status_desc \
4673 -anchor w \
4674 -justify left \
4675 -font font_ui
4676label .vpane.lower.diff.header.file \
4677 -background orange \
4678 -anchor w \
4679 -justify left \
4680 -font font_ui
4681label .vpane.lower.diff.header.path \
4682 -background orange \
4683 -anchor w \
4684 -justify left \
4685 -font font_ui
4686pack .vpane.lower.diff.header.status -side left
4687pack .vpane.lower.diff.header.file -side left
4688pack .vpane.lower.diff.header.path -fill x
4689set ctxm .vpane.lower.diff.header.ctxm
4690menu $ctxm -tearoff 0
4691$ctxm add command \
4692 -label {Copy} \
4693 -font font_ui \
4694 -command {
4695 clipboard clear
4696 clipboard append \
4697 -format STRING \
4698 -type STRING \
4699 -- $current_diff_path
4700 }
4701lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4702bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
4703# -- Diff Body
4705#
4706frame .vpane.lower.diff.body
4707set ui_diff .vpane.lower.diff.body.t
4708text $ui_diff -background white -borderwidth 0 \
4709 -width 80 -height 15 -wrap none \
4710 -font font_diff \
4711 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4712 -yscrollcommand {.vpane.lower.diff.body.sby set} \
4713 -state disabled
4714scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4715 -command [list $ui_diff xview]
4716scrollbar .vpane.lower.diff.body.sby -orient vertical \
4717 -command [list $ui_diff yview]
4718pack .vpane.lower.diff.body.sbx -side bottom -fill x
4719pack .vpane.lower.diff.body.sby -side right -fill y
4720pack $ui_diff -side left -fill both -expand 1
4721pack .vpane.lower.diff.header -side top -fill x
4722pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4723$ui_diff tag conf d_cr -elide true
4725$ui_diff tag conf d_@ -foreground blue -font font_diffbold
4726$ui_diff tag conf d_+ -foreground {#00a000}
4727$ui_diff tag conf d_- -foreground red
4728$ui_diff tag conf d_++ -foreground {#00a000}
4730$ui_diff tag conf d_-- -foreground red
4731$ui_diff tag conf d_+s \
4732 -foreground {#00a000} \
4733 -background {#e2effa}
4734$ui_diff tag conf d_-s \
4735 -foreground red \
4736 -background {#e2effa}
4737$ui_diff tag conf d_s+ \
4738 -foreground {#00a000} \
4739 -background ivory1
4740$ui_diff tag conf d_s- \
4741 -foreground red \
4742 -background ivory1
4743$ui_diff tag conf d<<<<<<< \
4745 -foreground orange \
4746 -font font_diffbold
4747$ui_diff tag conf d======= \
4748 -foreground orange \
4749 -font font_diffbold
4750$ui_diff tag conf d>>>>>>> \
4751 -foreground orange \
4752 -font font_diffbold
4753$ui_diff tag raise sel
4755# -- Diff Body Context Menu
4757#
4758set ctxm .vpane.lower.diff.body.ctxm
4759menu $ctxm -tearoff 0
4760$ctxm add command \
4761 -label {Refresh} \
4762 -font font_ui \
4763 -command reshow_diff
4764lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4765$ctxm add command \
4766 -label {Copy} \
4767 -font font_ui \
4768 -command {tk_textCopy $ui_diff}
4769lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4770$ctxm add command \
4771 -label {Select All} \
4772 -font font_ui \
4773 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4774lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4775$ctxm add command \
4776 -label {Copy All} \
4777 -font font_ui \
4778 -command {
4779 $ui_diff tag add sel 0.0 end
4780 tk_textCopy $ui_diff
4781 $ui_diff tag remove sel 0.0 end
4782 }
4783lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4784$ctxm add separator
4785$ctxm add command \
4786 -label {Apply/Reverse Hunk} \
4787 -font font_ui \
4788 -command {apply_hunk $cursorX $cursorY}
4789set ui_diff_applyhunk [$ctxm index last]
4790lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4791$ctxm add separator
4792$ctxm add command \
4793 -label {Decrease Font Size} \
4794 -font font_ui \
4795 -command {incr_font_size font_diff -1}
4796lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4797$ctxm add command \
4798 -label {Increase Font Size} \
4799 -font font_ui \
4800 -command {incr_font_size font_diff 1}
4801lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4802$ctxm add separator
4803$ctxm add command \
4804 -label {Show Less Context} \
4805 -font font_ui \
4806 -command {if {$repo_config(gui.diffcontext) >= 2} {
4807 incr repo_config(gui.diffcontext) -1
4808 reshow_diff
4809 }}
4810lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4811$ctxm add command \
4812 -label {Show More Context} \
4813 -font font_ui \
4814 -command {
4815 incr repo_config(gui.diffcontext)
4816 reshow_diff
4817 }
4818lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4819$ctxm add separator
4820$ctxm add command -label {Options...} \
4821 -font font_ui \
4822 -command do_options
4823bind_button3 $ui_diff "
4824 set cursorX %x
4825 set cursorY %y
4826 if {\$ui_index eq \$current_diff_side} {
4827 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
4828 } else {
4829 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
4830 }
4831 tk_popup $ctxm %X %Y
4832"
4833unset ui_diff_applyhunk
4834# -- Status Bar
4836#
4837set ui_status_value {Initializing...}
4838label .status -textvariable ui_status_value \
4839 -anchor w \
4840 -justify left \
4841 -borderwidth 1 \
4842 -relief sunken \
4843 -font font_ui
4844pack .status -anchor w -side bottom -fill x
4845# -- Load geometry
4847#
4848catch {
4849set gm $repo_config(gui.geometry)
4850wm geometry . [lindex $gm 0]
4851.vpane sash place 0 \
4852 [lindex [.vpane sash coord 0] 0] \
4853 [lindex $gm 1]
4854.vpane.files sash place 0 \
4855 [lindex $gm 2] \
4856 [lindex [.vpane.files sash coord 0] 1]
4857unset gm
4858}
4859# -- Key Bindings
4861#
4862bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4863bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4864bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4865bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4866bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4867bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4868bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4869bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4870bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4871bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4872bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4873bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4875bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4876bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4877bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4878bind $ui_diff <$M1B-Key-v> {break}
4879bind $ui_diff <$M1B-Key-V> {break}
4880bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4881bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4882bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
4883bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
4884bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
4885bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
4886bind $ui_diff <Button-1> {focus %W}
4887if {!$single_commit} {
4889 bind . <$M1B-Key-n> do_create_branch
4890 bind . <$M1B-Key-N> do_create_branch
4891}
4892bind . <Destroy> do_quit
4894bind all <Key-F5> do_rescan
4895bind all <$M1B-Key-r> do_rescan
4896bind all <$M1B-Key-R> do_rescan
4897bind . <$M1B-Key-s> do_signoff
4898bind . <$M1B-Key-S> do_signoff
4899bind . <$M1B-Key-i> do_add_all
4900bind . <$M1B-Key-I> do_add_all
4901bind . <$M1B-Key-Return> do_commit
4902bind all <$M1B-Key-q> do_quit
4903bind all <$M1B-Key-Q> do_quit
4904bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4905bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4906foreach i [list $ui_index $ui_workdir] {
4907 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
4908 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
4909 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4910}
4911unset i
4912set file_lists($ui_index) [list]
4914set file_lists($ui_workdir) [list]
4915set HEAD {}
4917set PARENT {}
4918set MERGE_HEAD [list]
4919set commit_type {}
4920set empty_tree {}
4921set current_branch {}
4922set current_diff_path {}
4923set selected_commit_type new
4924wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
4926focus -force $ui_comm
4927# -- Warn the user about environmental problems. Cygwin's Tcl
4929# does *not* pass its env array onto any processes it spawns.
4930# This means that git processes get none of our environment.
4931#
4932if {[is_Windows]} {
4933 set ignored_env 0
4934 set suggest_user {}
4935 set msg "Possible environment issues exist.
4936The following environment variables are probably
4938going to be ignored by any Git subprocess run
4939by [appname]:
4940"
4942 foreach name [array names env] {
4943 switch -regexp -- $name {
4944 {^GIT_INDEX_FILE$} -
4945 {^GIT_OBJECT_DIRECTORY$} -
4946 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4947 {^GIT_DIFF_OPTS$} -
4948 {^GIT_EXTERNAL_DIFF$} -
4949 {^GIT_PAGER$} -
4950 {^GIT_TRACE$} -
4951 {^GIT_CONFIG$} -
4952 {^GIT_CONFIG_LOCAL$} -
4953 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4954 append msg " - $name\n"
4955 incr ignored_env
4956 }
4957 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4958 append msg " - $name\n"
4959 incr ignored_env
4960 set suggest_user $name
4961 }
4962 }
4963 }
4964 if {$ignored_env > 0} {
4965 append msg "
4966This is due to a known issue with the
4967Tcl binary distributed by Cygwin."
4968 if {$suggest_user ne {}} {
4970 append msg "
4971A good replacement for $suggest_user
4973is placing values for the user.name and
4974user.email settings into your personal
4975~/.gitconfig file.
4976"
4977 }
4978 warn_popup $msg
4979 }
4980 unset ignored_env msg suggest_user name
4981}
4982# -- Only initialize complex UI if we are going to stay running.
4984#
4985if {!$single_commit} {
4986 load_all_remotes
4987 load_all_heads
4988 populate_branch_menu
4990 populate_fetch_menu
4991 populate_push_menu
4992}
4993# -- Only suggest a gc run if we are going to stay running.
4995#
4996if {!$single_commit} {
4997 set object_limit 2000
4998 if {[is_Windows]} {set object_limit 200}
4999 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5000 if {$objects_current >= $object_limit} {
5001 if {[ask_popup \
5002 "This repository currently has $objects_current loose objects.
5003To maintain optimal performance it is strongly
5005recommended that you compress the database
5006when more than $object_limit loose objects exist.
5007Compress the database now?"] eq yes} {
5009 do_gc
5010 }
5011 }
5012 unset object_limit _junk objects_current
5013}
5014lock_index begin-read
5016after 1 do_rescan