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