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