git-gui: Update known branches during rescan.
[git.git] / git-gui.sh
blob4116821d8d41d3b357f0acbdcef4a51b94def76b
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 _gitexec {}
30 set _reponame {}
31 set _iscygwin {}
33 proc appname {} {
34 global _appname
35 return $_appname
38 proc gitdir {args} {
39 global _gitdir
40 if {$args eq {}} {
41 return $_gitdir
43 return [eval [concat [list file join $_gitdir] $args]]
46 proc gitexec {args} {
47 global _gitexec
48 if {$_gitexec eq {}} {
49 if {[catch {set _gitexec [exec git --exec-path]} err]} {
50 error "Git not installed?\n\n$err"
53 if {$args eq {}} {
54 return $_gitexec
56 return [eval [concat [list file join $_gitexec] $args]]
59 proc reponame {} {
60 global _reponame
61 return $_reponame
64 proc is_MacOSX {} {
65 global tcl_platform tk_library
66 if {[tk windowingsystem] eq {aqua}} {
67 return 1
69 return 0
72 proc is_Windows {} {
73 global tcl_platform
74 if {$tcl_platform(platform) eq {windows}} {
75 return 1
77 return 0
80 proc is_Cygwin {} {
81 global tcl_platform _iscygwin
82 if {$_iscygwin eq {}} {
83 if {$tcl_platform(platform) eq {windows}} {
84 if {[catch {set p [exec cygpath --windir]} err]} {
85 set _iscygwin 0
86 } else {
87 set _iscygwin 1
89 } else {
90 set _iscygwin 0
93 return $_iscygwin
96 ######################################################################
98 ## config
100 proc is_many_config {name} {
101 switch -glob -- $name {
102 remote.*.fetch -
103 remote.*.push
104 {return 1}
106 {return 0}
110 proc is_config_true {name} {
111 global repo_config
112 if {[catch {set v $repo_config($name)}]} {
113 return 0
114 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
115 return 1
116 } else {
117 return 0
121 proc load_config {include_global} {
122 global repo_config global_config default_config
124 array unset global_config
125 if {$include_global} {
126 catch {
127 set fd_rc [open "| git repo-config --global --list" r]
128 while {[gets $fd_rc line] >= 0} {
129 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
130 if {[is_many_config $name]} {
131 lappend global_config($name) $value
132 } else {
133 set global_config($name) $value
137 close $fd_rc
141 array unset repo_config
142 catch {
143 set fd_rc [open "| git repo-config --list" r]
144 while {[gets $fd_rc line] >= 0} {
145 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
146 if {[is_many_config $name]} {
147 lappend repo_config($name) $value
148 } else {
149 set repo_config($name) $value
153 close $fd_rc
156 foreach name [array names default_config] {
157 if {[catch {set v $global_config($name)}]} {
158 set global_config($name) $default_config($name)
160 if {[catch {set v $repo_config($name)}]} {
161 set repo_config($name) $default_config($name)
166 proc save_config {} {
167 global default_config font_descs
168 global repo_config global_config
169 global repo_config_new global_config_new
171 foreach option $font_descs {
172 set name [lindex $option 0]
173 set font [lindex $option 1]
174 font configure $font \
175 -family $global_config_new(gui.$font^^family) \
176 -size $global_config_new(gui.$font^^size)
177 font configure ${font}bold \
178 -family $global_config_new(gui.$font^^family) \
179 -size $global_config_new(gui.$font^^size)
180 set global_config_new(gui.$name) [font configure $font]
181 unset global_config_new(gui.$font^^family)
182 unset global_config_new(gui.$font^^size)
185 foreach name [array names default_config] {
186 set value $global_config_new($name)
187 if {$value ne $global_config($name)} {
188 if {$value eq $default_config($name)} {
189 catch {exec git repo-config --global --unset $name}
190 } else {
191 regsub -all "\[{}\]" $value {"} value
192 exec git repo-config --global $name $value
194 set global_config($name) $value
195 if {$value eq $repo_config($name)} {
196 catch {exec git repo-config --unset $name}
197 set repo_config($name) $value
202 foreach name [array names default_config] {
203 set value $repo_config_new($name)
204 if {$value ne $repo_config($name)} {
205 if {$value eq $global_config($name)} {
206 catch {exec git repo-config --unset $name}
207 } else {
208 regsub -all "\[{}\]" $value {"} value
209 exec git repo-config $name $value
211 set repo_config($name) $value
216 proc error_popup {msg} {
217 set title [appname]
218 if {[reponame] ne {}} {
219 append title " ([reponame])"
221 set cmd [list tk_messageBox \
222 -icon error \
223 -type ok \
224 -title "$title: error" \
225 -message $msg]
226 if {[winfo ismapped .]} {
227 lappend cmd -parent .
229 eval $cmd
232 proc warn_popup {msg} {
233 set title [appname]
234 if {[reponame] ne {}} {
235 append title " ([reponame])"
237 set cmd [list tk_messageBox \
238 -icon warning \
239 -type ok \
240 -title "$title: warning" \
241 -message $msg]
242 if {[winfo ismapped .]} {
243 lappend cmd -parent .
245 eval $cmd
248 proc info_popup {msg {parent .}} {
249 set title [appname]
250 if {[reponame] ne {}} {
251 append title " ([reponame])"
253 tk_messageBox \
254 -parent $parent \
255 -icon info \
256 -type ok \
257 -title $title \
258 -message $msg
261 proc ask_popup {msg} {
262 set title [appname]
263 if {[reponame] ne {}} {
264 append title " ([reponame])"
266 return [tk_messageBox \
267 -parent . \
268 -icon question \
269 -type yesno \
270 -title $title \
271 -message $msg]
274 ######################################################################
276 ## repository setup
278 if { [catch {set _gitdir $env(GIT_DIR)}]
279 && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
280 catch {wm withdraw .}
281 error_popup "Cannot find the git directory:\n\n$err"
282 exit 1
284 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
285 catch {set _gitdir [exec cygpath --unix $_gitdir]}
287 if {![file isdirectory $_gitdir]} {
288 catch {wm withdraw .}
289 error_popup "Git directory not found:\n\n$_gitdir"
290 exit 1
292 if {[lindex [file split $_gitdir] end] ne {.git}} {
293 catch {wm withdraw .}
294 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
295 exit 1
297 if {[catch {cd [file dirname $_gitdir]} err]} {
298 catch {wm withdraw .}
299 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
300 exit 1
302 set _reponame [lindex [file split \
303 [file normalize [file dirname $_gitdir]]] \
304 end]
306 set single_commit 0
307 if {[appname] eq {git-citool}} {
308 set single_commit 1
311 ######################################################################
313 ## task management
315 set rescan_active 0
316 set diff_active 0
317 set last_clicked {}
319 set disable_on_lock [list]
320 set index_lock_type none
322 proc lock_index {type} {
323 global index_lock_type disable_on_lock
325 if {$index_lock_type eq {none}} {
326 set index_lock_type $type
327 foreach w $disable_on_lock {
328 uplevel #0 $w disabled
330 return 1
331 } elseif {$index_lock_type eq "begin-$type"} {
332 set index_lock_type $type
333 return 1
335 return 0
338 proc unlock_index {} {
339 global index_lock_type disable_on_lock
341 set index_lock_type none
342 foreach w $disable_on_lock {
343 uplevel #0 $w normal
347 ######################################################################
349 ## status
351 proc repository_state {ctvar hdvar mhvar} {
352 global current_branch
353 upvar $ctvar ct $hdvar hd $mhvar mh
355 set mh [list]
357 if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
358 set current_branch {}
359 } else {
360 regsub ^refs/((heads|tags|remotes)/)? \
361 $current_branch \
362 {} \
363 current_branch
366 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
367 set hd {}
368 set ct initial
369 return
372 set merge_head [gitdir MERGE_HEAD]
373 if {[file exists $merge_head]} {
374 set ct merge
375 set fd_mh [open $merge_head r]
376 while {[gets $fd_mh line] >= 0} {
377 lappend mh $line
379 close $fd_mh
380 return
383 set ct normal
386 proc PARENT {} {
387 global PARENT empty_tree
389 set p [lindex $PARENT 0]
390 if {$p ne {}} {
391 return $p
393 if {$empty_tree eq {}} {
394 set empty_tree [exec git mktree << {}]
396 return $empty_tree
399 proc rescan {after {honor_trustmtime 1}} {
400 global HEAD PARENT MERGE_HEAD commit_type
401 global ui_index ui_workdir ui_status_value ui_comm
402 global rescan_active file_states
403 global repo_config single_commit
405 if {$rescan_active > 0 || ![lock_index read]} return
407 repository_state newType newHEAD newMERGE_HEAD
408 if {[string match amend* $commit_type]
409 && $newType eq {normal}
410 && $newHEAD eq $HEAD} {
411 } else {
412 set HEAD $newHEAD
413 set PARENT $newHEAD
414 set MERGE_HEAD $newMERGE_HEAD
415 set commit_type $newType
418 array unset file_states
420 if {![$ui_comm edit modified]
421 || [string trim [$ui_comm get 0.0 end]] eq {}} {
422 if {[load_message GITGUI_MSG]} {
423 } elseif {[load_message MERGE_MSG]} {
424 } elseif {[load_message SQUASH_MSG]} {
426 $ui_comm edit reset
427 $ui_comm edit modified false
430 if {!$single_commit} {
431 load_all_heads
432 populate_branch_menu
435 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
436 rescan_stage2 {} $after
437 } else {
438 set rescan_active 1
439 set ui_status_value {Refreshing file status...}
440 set cmd [list git update-index]
441 lappend cmd -q
442 lappend cmd --unmerged
443 lappend cmd --ignore-missing
444 lappend cmd --refresh
445 set fd_rf [open "| $cmd" r]
446 fconfigure $fd_rf -blocking 0 -translation binary
447 fileevent $fd_rf readable \
448 [list rescan_stage2 $fd_rf $after]
452 proc rescan_stage2 {fd after} {
453 global ui_status_value
454 global rescan_active buf_rdi buf_rdf buf_rlo
456 if {$fd ne {}} {
457 read $fd
458 if {![eof $fd]} return
459 close $fd
462 set ls_others [list | git ls-files --others -z \
463 --exclude-per-directory=.gitignore]
464 set info_exclude [gitdir info exclude]
465 if {[file readable $info_exclude]} {
466 lappend ls_others "--exclude-from=$info_exclude"
469 set buf_rdi {}
470 set buf_rdf {}
471 set buf_rlo {}
473 set rescan_active 3
474 set ui_status_value {Scanning for modified files ...}
475 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
476 set fd_df [open "| git diff-files -z" r]
477 set fd_lo [open $ls_others r]
479 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
480 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
481 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
482 fileevent $fd_di readable [list read_diff_index $fd_di $after]
483 fileevent $fd_df readable [list read_diff_files $fd_df $after]
484 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
487 proc load_message {file} {
488 global ui_comm
490 set f [gitdir $file]
491 if {[file isfile $f]} {
492 if {[catch {set fd [open $f r]}]} {
493 return 0
495 set content [string trim [read $fd]]
496 close $fd
497 regsub -all -line {[ \r\t]+$} $content {} content
498 $ui_comm delete 0.0 end
499 $ui_comm insert end $content
500 return 1
502 return 0
505 proc read_diff_index {fd after} {
506 global buf_rdi
508 append buf_rdi [read $fd]
509 set c 0
510 set n [string length $buf_rdi]
511 while {$c < $n} {
512 set z1 [string first "\0" $buf_rdi $c]
513 if {$z1 == -1} break
514 incr z1
515 set z2 [string first "\0" $buf_rdi $z1]
516 if {$z2 == -1} break
518 incr c
519 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
520 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
521 merge_state \
522 [encoding convertfrom $p] \
523 [lindex $i 4]? \
524 [list [lindex $i 0] [lindex $i 2]] \
525 [list]
526 set c $z2
527 incr c
529 if {$c < $n} {
530 set buf_rdi [string range $buf_rdi $c end]
531 } else {
532 set buf_rdi {}
535 rescan_done $fd buf_rdi $after
538 proc read_diff_files {fd after} {
539 global buf_rdf
541 append buf_rdf [read $fd]
542 set c 0
543 set n [string length $buf_rdf]
544 while {$c < $n} {
545 set z1 [string first "\0" $buf_rdf $c]
546 if {$z1 == -1} break
547 incr z1
548 set z2 [string first "\0" $buf_rdf $z1]
549 if {$z2 == -1} break
551 incr c
552 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
553 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
554 merge_state \
555 [encoding convertfrom $p] \
556 ?[lindex $i 4] \
557 [list] \
558 [list [lindex $i 0] [lindex $i 2]]
559 set c $z2
560 incr c
562 if {$c < $n} {
563 set buf_rdf [string range $buf_rdf $c end]
564 } else {
565 set buf_rdf {}
568 rescan_done $fd buf_rdf $after
571 proc read_ls_others {fd after} {
572 global buf_rlo
574 append buf_rlo [read $fd]
575 set pck [split $buf_rlo "\0"]
576 set buf_rlo [lindex $pck end]
577 foreach p [lrange $pck 0 end-1] {
578 merge_state [encoding convertfrom $p] ?O
580 rescan_done $fd buf_rlo $after
583 proc rescan_done {fd buf after} {
584 global rescan_active
585 global file_states repo_config
586 upvar $buf to_clear
588 if {![eof $fd]} return
589 set to_clear {}
590 close $fd
591 if {[incr rescan_active -1] > 0} return
593 prune_selection
594 unlock_index
595 display_all_files
596 reshow_diff
597 uplevel #0 $after
600 proc prune_selection {} {
601 global file_states selected_paths
603 foreach path [array names selected_paths] {
604 if {[catch {set still_here $file_states($path)}]} {
605 unset selected_paths($path)
610 ######################################################################
612 ## diff
614 proc clear_diff {} {
615 global ui_diff current_diff_path current_diff_header
616 global ui_index ui_workdir
618 $ui_diff conf -state normal
619 $ui_diff delete 0.0 end
620 $ui_diff conf -state disabled
622 set current_diff_path {}
623 set current_diff_header {}
625 $ui_index tag remove in_diff 0.0 end
626 $ui_workdir tag remove in_diff 0.0 end
629 proc reshow_diff {} {
630 global ui_status_value file_states file_lists
631 global current_diff_path current_diff_side
633 set p $current_diff_path
634 if {$p eq {}
635 || $current_diff_side eq {}
636 || [catch {set s $file_states($p)}]
637 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
638 clear_diff
639 } else {
640 show_diff $p $current_diff_side
644 proc handle_empty_diff {} {
645 global current_diff_path file_states file_lists
647 set path $current_diff_path
648 set s $file_states($path)
649 if {[lindex $s 0] ne {_M}} return
651 info_popup "No differences detected.
653 [short_path $path] has no changes.
655 The modification date of this file was updated
656 by another application, but the content within
657 the file was not changed.
659 A rescan will be automatically started to find
660 other files which may have the same state."
662 clear_diff
663 display_file $path __
664 rescan {set ui_status_value {Ready.}} 0
667 proc show_diff {path w {lno {}}} {
668 global file_states file_lists
669 global is_3way_diff diff_active repo_config
670 global ui_diff ui_status_value ui_index ui_workdir
671 global current_diff_path current_diff_side current_diff_header
673 if {$diff_active || ![lock_index read]} return
675 clear_diff
676 if {$lno == {}} {
677 set lno [lsearch -sorted -exact $file_lists($w) $path]
678 if {$lno >= 0} {
679 incr lno
682 if {$lno >= 1} {
683 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
686 set s $file_states($path)
687 set m [lindex $s 0]
688 set is_3way_diff 0
689 set diff_active 1
690 set current_diff_path $path
691 set current_diff_side $w
692 set current_diff_header {}
693 set ui_status_value "Loading diff of [escape_path $path]..."
695 # - Git won't give us the diff, there's nothing to compare to!
697 if {$m eq {_O}} {
698 set max_sz [expr {128 * 1024}]
699 if {[catch {
700 set fd [open $path r]
701 set content [read $fd $max_sz]
702 close $fd
703 set sz [file size $path]
704 } err ]} {
705 set diff_active 0
706 unlock_index
707 set ui_status_value "Unable to display [escape_path $path]"
708 error_popup "Error loading file:\n\n$err"
709 return
711 $ui_diff conf -state normal
712 if {![catch {set type [exec file $path]}]} {
713 set n [string length $path]
714 if {[string equal -length $n $path $type]} {
715 set type [string range $type $n end]
716 regsub {^:?\s*} $type {} type
718 $ui_diff insert end "* $type\n" d_@
720 if {[string first "\0" $content] != -1} {
721 $ui_diff insert end \
722 "* Binary file (not showing content)." \
724 } else {
725 if {$sz > $max_sz} {
726 $ui_diff insert end \
727 "* Untracked file is $sz bytes.
728 * Showing only first $max_sz bytes.
729 " d_@
731 $ui_diff insert end $content
732 if {$sz > $max_sz} {
733 $ui_diff insert end "
734 * Untracked file clipped here by [appname].
735 * To see the entire file, use an external editor.
736 " d_@
739 $ui_diff conf -state disabled
740 set diff_active 0
741 unlock_index
742 set ui_status_value {Ready.}
743 return
746 set cmd [list | git]
747 if {$w eq $ui_index} {
748 lappend cmd diff-index
749 lappend cmd --cached
750 } elseif {$w eq $ui_workdir} {
751 if {[string index $m 0] eq {U}} {
752 lappend cmd diff
753 } else {
754 lappend cmd diff-files
758 lappend cmd -p
759 lappend cmd --no-color
760 if {$repo_config(gui.diffcontext) > 0} {
761 lappend cmd "-U$repo_config(gui.diffcontext)"
763 if {$w eq $ui_index} {
764 lappend cmd [PARENT]
766 lappend cmd --
767 lappend cmd $path
769 if {[catch {set fd [open $cmd r]} err]} {
770 set diff_active 0
771 unlock_index
772 set ui_status_value "Unable to display [escape_path $path]"
773 error_popup "Error loading diff:\n\n$err"
774 return
777 fconfigure $fd \
778 -blocking 0 \
779 -encoding binary \
780 -translation binary
781 fileevent $fd readable [list read_diff $fd]
784 proc read_diff {fd} {
785 global ui_diff ui_status_value diff_active
786 global is_3way_diff current_diff_header
788 $ui_diff conf -state normal
789 while {[gets $fd line] >= 0} {
790 # -- Cleanup uninteresting diff header lines.
792 if { [string match {diff --git *} $line]
793 || [string match {diff --cc *} $line]
794 || [string match {diff --combined *} $line]
795 || [string match {--- *} $line]
796 || [string match {+++ *} $line]} {
797 append current_diff_header $line "\n"
798 continue
800 if {[string match {index *} $line]} continue
801 if {$line eq {deleted file mode 120000}} {
802 set line "deleted symlink"
805 # -- Automatically detect if this is a 3 way diff.
807 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
809 if {[string match {mode *} $line]
810 || [string match {new file *} $line]
811 || [string match {deleted file *} $line]
812 || [string match {Binary files * and * differ} $line]
813 || $line eq {\ No newline at end of file}
814 || [regexp {^\* Unmerged path } $line]} {
815 set tags {}
816 } elseif {$is_3way_diff} {
817 set op [string range $line 0 1]
818 switch -- $op {
819 { } {set tags {}}
820 {@@} {set tags d_@}
821 { +} {set tags d_s+}
822 { -} {set tags d_s-}
823 {+ } {set tags d_+s}
824 {- } {set tags d_-s}
825 {--} {set tags d_--}
826 {++} {
827 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
828 set line [string replace $line 0 1 { }]
829 set tags d$op
830 } else {
831 set tags d_++
834 default {
835 puts "error: Unhandled 3 way diff marker: {$op}"
836 set tags {}
839 } else {
840 set op [string index $line 0]
841 switch -- $op {
842 { } {set tags {}}
843 {@} {set tags d_@}
844 {-} {set tags d_-}
845 {+} {
846 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
847 set line [string replace $line 0 0 { }]
848 set tags d$op
849 } else {
850 set tags d_+
853 default {
854 puts "error: Unhandled 2 way diff marker: {$op}"
855 set tags {}
859 $ui_diff insert end $line $tags
860 if {[string index $line end] eq "\r"} {
861 $ui_diff tag add d_cr {end - 2c}
863 $ui_diff insert end "\n" $tags
865 $ui_diff conf -state disabled
867 if {[eof $fd]} {
868 close $fd
869 set diff_active 0
870 unlock_index
871 set ui_status_value {Ready.}
873 if {[$ui_diff index end] eq {2.0}} {
874 handle_empty_diff
879 proc apply_hunk {x y} {
880 global current_diff_path current_diff_header current_diff_side
881 global ui_diff ui_index file_states
883 if {$current_diff_path eq {} || $current_diff_header eq {}} return
884 if {![lock_index apply_hunk]} return
886 set apply_cmd {git apply --cached --whitespace=nowarn}
887 set mi [lindex $file_states($current_diff_path) 0]
888 if {$current_diff_side eq $ui_index} {
889 set mode unstage
890 lappend apply_cmd --reverse
891 if {[string index $mi 0] ne {M}} {
892 unlock_index
893 return
895 } else {
896 set mode stage
897 if {[string index $mi 1] ne {M}} {
898 unlock_index
899 return
903 set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
904 set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
905 if {$s_lno eq {}} {
906 unlock_index
907 return
910 set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
911 if {$e_lno eq {}} {
912 set e_lno end
915 if {[catch {
916 set p [open "| $apply_cmd" w]
917 fconfigure $p -translation binary -encoding binary
918 puts -nonewline $p $current_diff_header
919 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
920 close $p} err]} {
921 error_popup "Failed to $mode selected hunk.\n\n$err"
922 unlock_index
923 return
926 $ui_diff conf -state normal
927 $ui_diff delete $s_lno $e_lno
928 $ui_diff conf -state disabled
930 if {[$ui_diff get 1.0 end] eq "\n"} {
931 set o _
932 } else {
933 set o ?
936 if {$current_diff_side eq $ui_index} {
937 set mi ${o}M
938 } elseif {[string index $mi 0] eq {_}} {
939 set mi M$o
940 } else {
941 set mi ?$o
943 unlock_index
944 display_file $current_diff_path $mi
945 if {$o eq {_}} {
946 clear_diff
950 ######################################################################
952 ## commit
954 proc load_last_commit {} {
955 global HEAD PARENT MERGE_HEAD commit_type ui_comm
956 global repo_config
958 if {[llength $PARENT] == 0} {
959 error_popup {There is nothing to amend.
961 You are about to create the initial commit.
962 There is no commit before this to amend.
964 return
967 repository_state curType curHEAD curMERGE_HEAD
968 if {$curType eq {merge}} {
969 error_popup {Cannot amend while merging.
971 You are currently in the middle of a merge that
972 has not been fully completed. You cannot amend
973 the prior commit unless you first abort the
974 current merge activity.
976 return
979 set msg {}
980 set parents [list]
981 if {[catch {
982 set fd [open "| git cat-file commit $curHEAD" r]
983 fconfigure $fd -encoding binary -translation lf
984 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
985 set enc utf-8
987 while {[gets $fd line] > 0} {
988 if {[string match {parent *} $line]} {
989 lappend parents [string range $line 7 end]
990 } elseif {[string match {encoding *} $line]} {
991 set enc [string tolower [string range $line 9 end]]
994 fconfigure $fd -encoding $enc
995 set msg [string trim [read $fd]]
996 close $fd
997 } err]} {
998 error_popup "Error loading commit data for amend:\n\n$err"
999 return
1002 set HEAD $curHEAD
1003 set PARENT $parents
1004 set MERGE_HEAD [list]
1005 switch -- [llength $parents] {
1006 0 {set commit_type amend-initial}
1007 1 {set commit_type amend}
1008 default {set commit_type amend-merge}
1011 $ui_comm delete 0.0 end
1012 $ui_comm insert end $msg
1013 $ui_comm edit reset
1014 $ui_comm edit modified false
1015 rescan {set ui_status_value {Ready.}}
1018 proc create_new_commit {} {
1019 global commit_type ui_comm
1021 set commit_type normal
1022 $ui_comm delete 0.0 end
1023 $ui_comm edit reset
1024 $ui_comm edit modified false
1025 rescan {set ui_status_value {Ready.}}
1028 set GIT_COMMITTER_IDENT {}
1030 proc committer_ident {} {
1031 global GIT_COMMITTER_IDENT
1033 if {$GIT_COMMITTER_IDENT eq {}} {
1034 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1035 error_popup "Unable to obtain your identity:\n\n$err"
1036 return {}
1038 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1039 $me me GIT_COMMITTER_IDENT]} {
1040 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1041 return {}
1045 return $GIT_COMMITTER_IDENT
1048 proc commit_tree {} {
1049 global HEAD commit_type file_states ui_comm repo_config
1050 global ui_status_value pch_error
1052 if {[committer_ident] eq {}} return
1053 if {![lock_index update]} return
1055 # -- Our in memory state should match the repository.
1057 repository_state curType curHEAD curMERGE_HEAD
1058 if {[string match amend* $commit_type]
1059 && $curType eq {normal}
1060 && $curHEAD eq $HEAD} {
1061 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1062 info_popup {Last scanned state does not match repository state.
1064 Another Git program has modified this repository
1065 since the last scan. A rescan must be performed
1066 before another commit can be created.
1068 The rescan will be automatically started now.
1070 unlock_index
1071 rescan {set ui_status_value {Ready.}}
1072 return
1075 # -- At least one file should differ in the index.
1077 set files_ready 0
1078 foreach path [array names file_states] {
1079 switch -glob -- [lindex $file_states($path) 0] {
1080 _? {continue}
1081 A? -
1082 D? -
1083 M? {set files_ready 1}
1084 U? {
1085 error_popup "Unmerged files cannot be committed.
1087 File [short_path $path] has merge conflicts.
1088 You must resolve them and add the file before committing.
1090 unlock_index
1091 return
1093 default {
1094 error_popup "Unknown file state [lindex $s 0] detected.
1096 File [short_path $path] cannot be committed by this program.
1101 if {!$files_ready} {
1102 info_popup {No changes to commit.
1104 You must add at least 1 file before you can commit.
1106 unlock_index
1107 return
1110 # -- A message is required.
1112 set msg [string trim [$ui_comm get 1.0 end]]
1113 regsub -all -line {[ \t\r]+$} $msg {} msg
1114 if {$msg eq {}} {
1115 error_popup {Please supply a commit message.
1117 A good commit message has the following format:
1119 - First line: Describe in one sentance what you did.
1120 - Second line: Blank
1121 - Remaining lines: Describe why this change is good.
1123 unlock_index
1124 return
1127 # -- Run the pre-commit hook.
1129 set pchook [gitdir hooks pre-commit]
1131 # On Cygwin [file executable] might lie so we need to ask
1132 # the shell if the hook is executable. Yes that's annoying.
1134 if {[is_Cygwin] && [file isfile $pchook]} {
1135 set pchook [list sh -c [concat \
1136 "if test -x \"$pchook\";" \
1137 "then exec \"$pchook\" 2>&1;" \
1138 "fi"]]
1139 } elseif {[file executable $pchook]} {
1140 set pchook [list $pchook |& cat]
1141 } else {
1142 commit_writetree $curHEAD $msg
1143 return
1146 set ui_status_value {Calling pre-commit hook...}
1147 set pch_error {}
1148 set fd_ph [open "| $pchook" r]
1149 fconfigure $fd_ph -blocking 0 -translation binary
1150 fileevent $fd_ph readable \
1151 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1154 proc commit_prehook_wait {fd_ph curHEAD msg} {
1155 global pch_error ui_status_value
1157 append pch_error [read $fd_ph]
1158 fconfigure $fd_ph -blocking 1
1159 if {[eof $fd_ph]} {
1160 if {[catch {close $fd_ph}]} {
1161 set ui_status_value {Commit declined by pre-commit hook.}
1162 hook_failed_popup pre-commit $pch_error
1163 unlock_index
1164 } else {
1165 commit_writetree $curHEAD $msg
1167 set pch_error {}
1168 return
1170 fconfigure $fd_ph -blocking 0
1173 proc commit_writetree {curHEAD msg} {
1174 global ui_status_value
1176 set ui_status_value {Committing changes...}
1177 set fd_wt [open "| git write-tree" r]
1178 fileevent $fd_wt readable \
1179 [list commit_committree $fd_wt $curHEAD $msg]
1182 proc commit_committree {fd_wt curHEAD msg} {
1183 global HEAD PARENT MERGE_HEAD commit_type
1184 global single_commit all_heads current_branch
1185 global ui_status_value ui_comm selected_commit_type
1186 global file_states selected_paths rescan_active
1187 global repo_config
1189 gets $fd_wt tree_id
1190 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1191 error_popup "write-tree failed:\n\n$err"
1192 set ui_status_value {Commit failed.}
1193 unlock_index
1194 return
1197 # -- Build the message.
1199 set msg_p [gitdir COMMIT_EDITMSG]
1200 set msg_wt [open $msg_p w]
1201 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1202 set enc utf-8
1204 fconfigure $msg_wt -encoding $enc -translation binary
1205 puts -nonewline $msg_wt $msg
1206 close $msg_wt
1208 # -- Create the commit.
1210 set cmd [list git commit-tree $tree_id]
1211 set parents [concat $PARENT $MERGE_HEAD]
1212 if {[llength $parents] > 0} {
1213 foreach p $parents {
1214 lappend cmd -p $p
1216 } else {
1217 # git commit-tree writes to stderr during initial commit.
1218 lappend cmd 2>/dev/null
1220 lappend cmd <$msg_p
1221 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1222 error_popup "commit-tree failed:\n\n$err"
1223 set ui_status_value {Commit failed.}
1224 unlock_index
1225 return
1228 # -- Update the HEAD ref.
1230 set reflogm commit
1231 if {$commit_type ne {normal}} {
1232 append reflogm " ($commit_type)"
1234 set i [string first "\n" $msg]
1235 if {$i >= 0} {
1236 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1237 } else {
1238 append reflogm {: } $msg
1240 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1241 if {[catch {eval exec $cmd} err]} {
1242 error_popup "update-ref failed:\n\n$err"
1243 set ui_status_value {Commit failed.}
1244 unlock_index
1245 return
1248 # -- Make sure our current branch exists.
1250 if {$commit_type eq {initial}} {
1251 lappend all_heads $current_branch
1252 set all_heads [lsort -unique $all_heads]
1253 populate_branch_menu
1256 # -- Cleanup after ourselves.
1258 catch {file delete $msg_p}
1259 catch {file delete [gitdir MERGE_HEAD]}
1260 catch {file delete [gitdir MERGE_MSG]}
1261 catch {file delete [gitdir SQUASH_MSG]}
1262 catch {file delete [gitdir GITGUI_MSG]}
1264 # -- Let rerere do its thing.
1266 if {[file isdirectory [gitdir rr-cache]]} {
1267 catch {exec git rerere}
1270 # -- Run the post-commit hook.
1272 set pchook [gitdir hooks post-commit]
1273 if {[is_Cygwin] && [file isfile $pchook]} {
1274 set pchook [list sh -c [concat \
1275 "if test -x \"$pchook\";" \
1276 "then exec \"$pchook\";" \
1277 "fi"]]
1278 } elseif {![file executable $pchook]} {
1279 set pchook {}
1281 if {$pchook ne {}} {
1282 catch {exec $pchook &}
1285 $ui_comm delete 0.0 end
1286 $ui_comm edit reset
1287 $ui_comm edit modified false
1289 if {$single_commit} do_quit
1291 # -- Update in memory status
1293 set selected_commit_type new
1294 set commit_type normal
1295 set HEAD $cmt_id
1296 set PARENT $cmt_id
1297 set MERGE_HEAD [list]
1299 foreach path [array names file_states] {
1300 set s $file_states($path)
1301 set m [lindex $s 0]
1302 switch -glob -- $m {
1303 _O -
1304 _M -
1305 _D {continue}
1306 __ -
1307 A_ -
1308 M_ -
1309 D_ {
1310 unset file_states($path)
1311 catch {unset selected_paths($path)}
1313 DO {
1314 set file_states($path) [list _O [lindex $s 1] {} {}]
1316 AM -
1317 AD -
1318 MM -
1319 MD {
1320 set file_states($path) [list \
1321 _[string index $m 1] \
1322 [lindex $s 1] \
1323 [lindex $s 3] \
1329 display_all_files
1330 unlock_index
1331 reshow_diff
1332 set ui_status_value \
1333 "Changes committed as [string range $cmt_id 0 7]."
1336 ######################################################################
1338 ## fetch push
1340 proc fetch_from {remote} {
1341 set w [new_console \
1342 "fetch $remote" \
1343 "Fetching new changes from $remote"]
1344 set cmd [list git fetch]
1345 lappend cmd $remote
1346 console_exec $w $cmd console_done
1349 proc push_to {remote} {
1350 set w [new_console \
1351 "push $remote" \
1352 "Pushing changes to $remote"]
1353 set cmd [list git push]
1354 lappend cmd -v
1355 lappend cmd $remote
1356 console_exec $w $cmd console_done
1359 ######################################################################
1361 ## ui helpers
1363 proc mapicon {w state path} {
1364 global all_icons
1366 if {[catch {set r $all_icons($state$w)}]} {
1367 puts "error: no icon for $w state={$state} $path"
1368 return file_plain
1370 return $r
1373 proc mapdesc {state path} {
1374 global all_descs
1376 if {[catch {set r $all_descs($state)}]} {
1377 puts "error: no desc for state={$state} $path"
1378 return $state
1380 return $r
1383 proc escape_path {path} {
1384 regsub -all "\n" $path "\\n" path
1385 return $path
1388 proc short_path {path} {
1389 return [escape_path [lindex [file split $path] end]]
1392 set next_icon_id 0
1393 set null_sha1 [string repeat 0 40]
1395 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1396 global file_states next_icon_id null_sha1
1398 set s0 [string index $new_state 0]
1399 set s1 [string index $new_state 1]
1401 if {[catch {set info $file_states($path)}]} {
1402 set state __
1403 set icon n[incr next_icon_id]
1404 } else {
1405 set state [lindex $info 0]
1406 set icon [lindex $info 1]
1407 if {$head_info eq {}} {set head_info [lindex $info 2]}
1408 if {$index_info eq {}} {set index_info [lindex $info 3]}
1411 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1412 elseif {$s0 eq {_}} {set s0 _}
1414 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1415 elseif {$s1 eq {_}} {set s1 _}
1417 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1418 set head_info [list 0 $null_sha1]
1419 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1420 && $head_info eq {}} {
1421 set head_info $index_info
1424 set file_states($path) [list $s0$s1 $icon \
1425 $head_info $index_info \
1427 return $state
1430 proc display_file_helper {w path icon_name old_m new_m} {
1431 global file_lists
1433 if {$new_m eq {_}} {
1434 set lno [lsearch -sorted -exact $file_lists($w) $path]
1435 if {$lno >= 0} {
1436 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1437 incr lno
1438 $w conf -state normal
1439 $w delete $lno.0 [expr {$lno + 1}].0
1440 $w conf -state disabled
1442 } elseif {$old_m eq {_} && $new_m ne {_}} {
1443 lappend file_lists($w) $path
1444 set file_lists($w) [lsort -unique $file_lists($w)]
1445 set lno [lsearch -sorted -exact $file_lists($w) $path]
1446 incr lno
1447 $w conf -state normal
1448 $w image create $lno.0 \
1449 -align center -padx 5 -pady 1 \
1450 -name $icon_name \
1451 -image [mapicon $w $new_m $path]
1452 $w insert $lno.1 "[escape_path $path]\n"
1453 $w conf -state disabled
1454 } elseif {$old_m ne $new_m} {
1455 $w conf -state normal
1456 $w image conf $icon_name -image [mapicon $w $new_m $path]
1457 $w conf -state disabled
1461 proc display_file {path state} {
1462 global file_states selected_paths
1463 global ui_index ui_workdir
1465 set old_m [merge_state $path $state]
1466 set s $file_states($path)
1467 set new_m [lindex $s 0]
1468 set icon_name [lindex $s 1]
1470 set o [string index $old_m 0]
1471 set n [string index $new_m 0]
1472 if {$o eq {U}} {
1473 set o _
1475 if {$n eq {U}} {
1476 set n _
1478 display_file_helper $ui_index $path $icon_name $o $n
1480 if {[string index $old_m 0] eq {U}} {
1481 set o U
1482 } else {
1483 set o [string index $old_m 1]
1485 if {[string index $new_m 0] eq {U}} {
1486 set n U
1487 } else {
1488 set n [string index $new_m 1]
1490 display_file_helper $ui_workdir $path $icon_name $o $n
1492 if {$new_m eq {__}} {
1493 unset file_states($path)
1494 catch {unset selected_paths($path)}
1498 proc display_all_files_helper {w path icon_name m} {
1499 global file_lists
1501 lappend file_lists($w) $path
1502 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1503 $w image create end \
1504 -align center -padx 5 -pady 1 \
1505 -name $icon_name \
1506 -image [mapicon $w $m $path]
1507 $w insert end "[escape_path $path]\n"
1510 proc display_all_files {} {
1511 global ui_index ui_workdir
1512 global file_states file_lists
1513 global last_clicked
1515 $ui_index conf -state normal
1516 $ui_workdir conf -state normal
1518 $ui_index delete 0.0 end
1519 $ui_workdir delete 0.0 end
1520 set last_clicked {}
1522 set file_lists($ui_index) [list]
1523 set file_lists($ui_workdir) [list]
1525 foreach path [lsort [array names file_states]] {
1526 set s $file_states($path)
1527 set m [lindex $s 0]
1528 set icon_name [lindex $s 1]
1530 set s [string index $m 0]
1531 if {$s ne {U} && $s ne {_}} {
1532 display_all_files_helper $ui_index $path \
1533 $icon_name $s
1536 if {[string index $m 0] eq {U}} {
1537 set s U
1538 } else {
1539 set s [string index $m 1]
1541 if {$s ne {_}} {
1542 display_all_files_helper $ui_workdir $path \
1543 $icon_name $s
1547 $ui_index conf -state disabled
1548 $ui_workdir conf -state disabled
1551 proc update_indexinfo {msg pathList after} {
1552 global update_index_cp ui_status_value
1554 if {![lock_index update]} return
1556 set update_index_cp 0
1557 set pathList [lsort $pathList]
1558 set totalCnt [llength $pathList]
1559 set batch [expr {int($totalCnt * .01) + 1}]
1560 if {$batch > 25} {set batch 25}
1562 set ui_status_value [format \
1563 "$msg... %i/%i files (%.2f%%)" \
1564 $update_index_cp \
1565 $totalCnt \
1566 0.0]
1567 set fd [open "| git update-index -z --index-info" w]
1568 fconfigure $fd \
1569 -blocking 0 \
1570 -buffering full \
1571 -buffersize 512 \
1572 -encoding binary \
1573 -translation binary
1574 fileevent $fd writable [list \
1575 write_update_indexinfo \
1576 $fd \
1577 $pathList \
1578 $totalCnt \
1579 $batch \
1580 $msg \
1581 $after \
1585 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1586 global update_index_cp ui_status_value
1587 global file_states current_diff_path
1589 if {$update_index_cp >= $totalCnt} {
1590 close $fd
1591 unlock_index
1592 uplevel #0 $after
1593 return
1596 for {set i $batch} \
1597 {$update_index_cp < $totalCnt && $i > 0} \
1598 {incr i -1} {
1599 set path [lindex $pathList $update_index_cp]
1600 incr update_index_cp
1602 set s $file_states($path)
1603 switch -glob -- [lindex $s 0] {
1604 A? {set new _O}
1605 M? {set new _M}
1606 D_ {set new _D}
1607 D? {set new _?}
1608 ?? {continue}
1610 set info [lindex $s 2]
1611 if {$info eq {}} continue
1613 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1614 display_file $path $new
1617 set ui_status_value [format \
1618 "$msg... %i/%i files (%.2f%%)" \
1619 $update_index_cp \
1620 $totalCnt \
1621 [expr {100.0 * $update_index_cp / $totalCnt}]]
1624 proc update_index {msg pathList after} {
1625 global update_index_cp ui_status_value
1627 if {![lock_index update]} return
1629 set update_index_cp 0
1630 set pathList [lsort $pathList]
1631 set totalCnt [llength $pathList]
1632 set batch [expr {int($totalCnt * .01) + 1}]
1633 if {$batch > 25} {set batch 25}
1635 set ui_status_value [format \
1636 "$msg... %i/%i files (%.2f%%)" \
1637 $update_index_cp \
1638 $totalCnt \
1639 0.0]
1640 set fd [open "| git update-index --add --remove -z --stdin" w]
1641 fconfigure $fd \
1642 -blocking 0 \
1643 -buffering full \
1644 -buffersize 512 \
1645 -encoding binary \
1646 -translation binary
1647 fileevent $fd writable [list \
1648 write_update_index \
1649 $fd \
1650 $pathList \
1651 $totalCnt \
1652 $batch \
1653 $msg \
1654 $after \
1658 proc write_update_index {fd pathList totalCnt batch msg after} {
1659 global update_index_cp ui_status_value
1660 global file_states current_diff_path
1662 if {$update_index_cp >= $totalCnt} {
1663 close $fd
1664 unlock_index
1665 uplevel #0 $after
1666 return
1669 for {set i $batch} \
1670 {$update_index_cp < $totalCnt && $i > 0} \
1671 {incr i -1} {
1672 set path [lindex $pathList $update_index_cp]
1673 incr update_index_cp
1675 switch -glob -- [lindex $file_states($path) 0] {
1676 AD {set new __}
1677 ?D {set new D_}
1678 _O -
1679 AM {set new A_}
1680 U? {
1681 if {[file exists $path]} {
1682 set new M_
1683 } else {
1684 set new D_
1687 ?M {set new M_}
1688 ?? {continue}
1690 puts -nonewline $fd "[encoding convertto $path]\0"
1691 display_file $path $new
1694 set ui_status_value [format \
1695 "$msg... %i/%i files (%.2f%%)" \
1696 $update_index_cp \
1697 $totalCnt \
1698 [expr {100.0 * $update_index_cp / $totalCnt}]]
1701 proc checkout_index {msg pathList after} {
1702 global update_index_cp ui_status_value
1704 if {![lock_index update]} return
1706 set update_index_cp 0
1707 set pathList [lsort $pathList]
1708 set totalCnt [llength $pathList]
1709 set batch [expr {int($totalCnt * .01) + 1}]
1710 if {$batch > 25} {set batch 25}
1712 set ui_status_value [format \
1713 "$msg... %i/%i files (%.2f%%)" \
1714 $update_index_cp \
1715 $totalCnt \
1716 0.0]
1717 set cmd [list git checkout-index]
1718 lappend cmd --index
1719 lappend cmd --quiet
1720 lappend cmd --force
1721 lappend cmd -z
1722 lappend cmd --stdin
1723 set fd [open "| $cmd " w]
1724 fconfigure $fd \
1725 -blocking 0 \
1726 -buffering full \
1727 -buffersize 512 \
1728 -encoding binary \
1729 -translation binary
1730 fileevent $fd writable [list \
1731 write_checkout_index \
1732 $fd \
1733 $pathList \
1734 $totalCnt \
1735 $batch \
1736 $msg \
1737 $after \
1741 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1742 global update_index_cp ui_status_value
1743 global file_states current_diff_path
1745 if {$update_index_cp >= $totalCnt} {
1746 close $fd
1747 unlock_index
1748 uplevel #0 $after
1749 return
1752 for {set i $batch} \
1753 {$update_index_cp < $totalCnt && $i > 0} \
1754 {incr i -1} {
1755 set path [lindex $pathList $update_index_cp]
1756 incr update_index_cp
1757 switch -glob -- [lindex $file_states($path) 0] {
1758 U? {continue}
1759 ?M -
1760 ?D {
1761 puts -nonewline $fd "[encoding convertto $path]\0"
1762 display_file $path ?_
1767 set ui_status_value [format \
1768 "$msg... %i/%i files (%.2f%%)" \
1769 $update_index_cp \
1770 $totalCnt \
1771 [expr {100.0 * $update_index_cp / $totalCnt}]]
1774 ######################################################################
1776 ## branch management
1778 proc is_tracking_branch {name} {
1779 global tracking_branches
1781 if {![catch {set info $tracking_branches($name)}]} {
1782 return 1
1784 foreach t [array names tracking_branches] {
1785 if {[string match {*/\*} $t] && [string match $t $name]} {
1786 return 1
1789 return 0
1792 proc load_all_heads {} {
1793 global all_heads
1795 set all_heads [list]
1796 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1797 while {[gets $fd line] > 0} {
1798 if {[is_tracking_branch $line]} continue
1799 if {![regsub ^refs/heads/ $line {} name]} continue
1800 lappend all_heads $name
1802 close $fd
1804 set all_heads [lsort $all_heads]
1807 proc populate_branch_menu {} {
1808 global all_heads disable_on_lock
1810 set m .mbar.branch
1811 set last [$m index last]
1812 for {set i 0} {$i <= $last} {incr i} {
1813 if {[$m type $i] eq {separator}} {
1814 $m delete $i last
1815 set new_dol [list]
1816 foreach a $disable_on_lock {
1817 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1818 lappend new_dol $a
1821 set disable_on_lock $new_dol
1822 break
1826 if {$all_heads ne {}} {
1827 $m add separator
1829 foreach b $all_heads {
1830 $m add radiobutton \
1831 -label $b \
1832 -command [list switch_branch $b] \
1833 -variable current_branch \
1834 -value $b \
1835 -font font_ui
1836 lappend disable_on_lock \
1837 [list $m entryconf [$m index last] -state]
1841 proc all_tracking_branches {} {
1842 global tracking_branches
1844 set all_trackings {}
1845 set cmd {}
1846 foreach name [array names tracking_branches] {
1847 if {[regsub {/\*$} $name {} name]} {
1848 lappend cmd $name
1849 } else {
1850 regsub ^refs/(heads|remotes)/ $name {} name
1851 lappend all_trackings $name
1855 if {$cmd ne {}} {
1856 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1857 while {[gets $fd name] > 0} {
1858 regsub ^refs/(heads|remotes)/ $name {} name
1859 lappend all_trackings $name
1861 close $fd
1864 return [lsort -unique $all_trackings]
1867 proc do_create_branch_action {w} {
1868 global all_heads null_sha1 repo_config
1869 global create_branch_checkout create_branch_revtype
1870 global create_branch_head create_branch_trackinghead
1871 global create_branch_name create_branch_revexp
1873 set newbranch $create_branch_name
1874 if {$newbranch eq {}
1875 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1876 tk_messageBox \
1877 -icon error \
1878 -type ok \
1879 -title [wm title $w] \
1880 -parent $w \
1881 -message "Please supply a branch name."
1882 focus $w.desc.name_t
1883 return
1885 if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1886 tk_messageBox \
1887 -icon error \
1888 -type ok \
1889 -title [wm title $w] \
1890 -parent $w \
1891 -message "Branch '$newbranch' already exists."
1892 focus $w.desc.name_t
1893 return
1895 if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1896 tk_messageBox \
1897 -icon error \
1898 -type ok \
1899 -title [wm title $w] \
1900 -parent $w \
1901 -message "We do not like '$newbranch' as a branch name."
1902 focus $w.desc.name_t
1903 return
1906 set rev {}
1907 switch -- $create_branch_revtype {
1908 head {set rev $create_branch_head}
1909 tracking {set rev $create_branch_trackinghead}
1910 expression {set rev $create_branch_revexp}
1912 if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1913 tk_messageBox \
1914 -icon error \
1915 -type ok \
1916 -title [wm title $w] \
1917 -parent $w \
1918 -message "Invalid starting revision: $rev"
1919 return
1921 set cmd [list git update-ref]
1922 lappend cmd -m
1923 lappend cmd "branch: Created from $rev"
1924 lappend cmd "refs/heads/$newbranch"
1925 lappend cmd $cmt
1926 lappend cmd $null_sha1
1927 if {[catch {eval exec $cmd} err]} {
1928 tk_messageBox \
1929 -icon error \
1930 -type ok \
1931 -title [wm title $w] \
1932 -parent $w \
1933 -message "Failed to create '$newbranch'.\n\n$err"
1934 return
1937 lappend all_heads $newbranch
1938 set all_heads [lsort $all_heads]
1939 populate_branch_menu
1940 destroy $w
1941 if {$create_branch_checkout} {
1942 switch_branch $newbranch
1946 proc radio_selector {varname value args} {
1947 upvar #0 $varname var
1948 set var $value
1951 trace add variable create_branch_head write \
1952 [list radio_selector create_branch_revtype head]
1953 trace add variable create_branch_trackinghead write \
1954 [list radio_selector create_branch_revtype tracking]
1956 trace add variable delete_branch_head write \
1957 [list radio_selector delete_branch_checktype head]
1958 trace add variable delete_branch_trackinghead write \
1959 [list radio_selector delete_branch_checktype tracking]
1961 proc do_create_branch {} {
1962 global all_heads current_branch repo_config
1963 global create_branch_checkout create_branch_revtype
1964 global create_branch_head create_branch_trackinghead
1965 global create_branch_name create_branch_revexp
1967 set w .branch_editor
1968 toplevel $w
1969 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1971 label $w.header -text {Create New Branch} \
1972 -font font_uibold
1973 pack $w.header -side top -fill x
1975 frame $w.buttons
1976 button $w.buttons.create -text Create \
1977 -font font_ui \
1978 -default active \
1979 -command [list do_create_branch_action $w]
1980 pack $w.buttons.create -side right
1981 button $w.buttons.cancel -text {Cancel} \
1982 -font font_ui \
1983 -command [list destroy $w]
1984 pack $w.buttons.cancel -side right -padx 5
1985 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1987 labelframe $w.desc \
1988 -text {Branch Description} \
1989 -font font_ui
1990 label $w.desc.name_l -text {Name:} -font font_ui
1991 entry $w.desc.name_t \
1992 -borderwidth 1 \
1993 -relief sunken \
1994 -width 40 \
1995 -textvariable create_branch_name \
1996 -font font_ui \
1997 -validate key \
1998 -validatecommand {
1999 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2000 return 1
2002 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2003 grid columnconfigure $w.desc 1 -weight 1
2004 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2006 labelframe $w.from \
2007 -text {Starting Revision} \
2008 -font font_ui
2009 radiobutton $w.from.head_r \
2010 -text {Local Branch:} \
2011 -value head \
2012 -variable create_branch_revtype \
2013 -font font_ui
2014 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2015 grid $w.from.head_r $w.from.head_m -sticky w
2016 set all_trackings [all_tracking_branches]
2017 if {$all_trackings ne {}} {
2018 set create_branch_trackinghead [lindex $all_trackings 0]
2019 radiobutton $w.from.tracking_r \
2020 -text {Tracking Branch:} \
2021 -value tracking \
2022 -variable create_branch_revtype \
2023 -font font_ui
2024 eval tk_optionMenu $w.from.tracking_m \
2025 create_branch_trackinghead \
2026 $all_trackings
2027 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2029 radiobutton $w.from.exp_r \
2030 -text {Revision Expression:} \
2031 -value expression \
2032 -variable create_branch_revtype \
2033 -font font_ui
2034 entry $w.from.exp_t \
2035 -borderwidth 1 \
2036 -relief sunken \
2037 -width 50 \
2038 -textvariable create_branch_revexp \
2039 -font font_ui \
2040 -validate key \
2041 -validatecommand {
2042 if {%d == 1 && [regexp {\s} %S]} {return 0}
2043 if {%d == 1 && [string length %S] > 0} {
2044 set create_branch_revtype expression
2046 return 1
2048 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2049 grid columnconfigure $w.from 1 -weight 1
2050 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2052 labelframe $w.postActions \
2053 -text {Post Creation Actions} \
2054 -font font_ui
2055 checkbutton $w.postActions.checkout \
2056 -text {Checkout after creation} \
2057 -variable create_branch_checkout \
2058 -font font_ui
2059 pack $w.postActions.checkout -anchor nw
2060 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2062 set create_branch_checkout 1
2063 set create_branch_head $current_branch
2064 set create_branch_revtype head
2065 set create_branch_name $repo_config(gui.newbranchtemplate)
2066 set create_branch_revexp {}
2068 bind $w <Visibility> "
2069 grab $w
2070 $w.desc.name_t icursor end
2071 focus $w.desc.name_t
2073 bind $w <Key-Escape> "destroy $w"
2074 bind $w <Key-Return> "do_create_branch_action $w;break"
2075 wm title $w "[appname] ([reponame]): Create Branch"
2076 tkwait window $w
2079 proc do_delete_branch_action {w} {
2080 global all_heads
2081 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2083 set check_rev {}
2084 switch -- $delete_branch_checktype {
2085 head {set check_rev $delete_branch_head}
2086 tracking {set check_rev $delete_branch_trackinghead}
2087 always {set check_rev {:none}}
2089 if {$check_rev eq {:none}} {
2090 set check_cmt {}
2091 } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2092 tk_messageBox \
2093 -icon error \
2094 -type ok \
2095 -title [wm title $w] \
2096 -parent $w \
2097 -message "Invalid check revision: $check_rev"
2098 return
2101 set to_delete [list]
2102 set not_merged [list]
2103 foreach i [$w.list.l curselection] {
2104 set b [$w.list.l get $i]
2105 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2106 if {$check_cmt ne {}} {
2107 if {$b eq $check_rev} continue
2108 if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2109 if {$o ne $m} {
2110 lappend not_merged $b
2111 continue
2114 lappend to_delete [list $b $o]
2116 if {$not_merged ne {}} {
2117 set msg "The following branches are not completely merged into $check_rev:
2119 - [join $not_merged "\n - "]"
2120 tk_messageBox \
2121 -icon info \
2122 -type ok \
2123 -title [wm title $w] \
2124 -parent $w \
2125 -message $msg
2127 if {$to_delete eq {}} return
2128 if {$delete_branch_checktype eq {always}} {
2129 set msg {Recovering deleted branches is difficult.
2131 Delete the selected branches?}
2132 if {[tk_messageBox \
2133 -icon warning \
2134 -type yesno \
2135 -title [wm title $w] \
2136 -parent $w \
2137 -message $msg] ne yes} {
2138 return
2142 set failed {}
2143 foreach i $to_delete {
2144 set b [lindex $i 0]
2145 set o [lindex $i 1]
2146 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2147 append failed " - $b: $err\n"
2148 } else {
2149 set x [lsearch -sorted -exact $all_heads $b]
2150 if {$x >= 0} {
2151 set all_heads [lreplace $all_heads $x $x]
2156 if {$failed ne {}} {
2157 tk_messageBox \
2158 -icon error \
2159 -type ok \
2160 -title [wm title $w] \
2161 -parent $w \
2162 -message "Failed to delete branches:\n$failed"
2165 set all_heads [lsort $all_heads]
2166 populate_branch_menu
2167 destroy $w
2170 proc do_delete_branch {} {
2171 global all_heads tracking_branches current_branch
2172 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2174 set w .branch_editor
2175 toplevel $w
2176 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2178 label $w.header -text {Delete Local Branch} \
2179 -font font_uibold
2180 pack $w.header -side top -fill x
2182 frame $w.buttons
2183 button $w.buttons.create -text Delete \
2184 -font font_ui \
2185 -command [list do_delete_branch_action $w]
2186 pack $w.buttons.create -side right
2187 button $w.buttons.cancel -text {Cancel} \
2188 -font font_ui \
2189 -command [list destroy $w]
2190 pack $w.buttons.cancel -side right -padx 5
2191 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2193 labelframe $w.list \
2194 -text {Local Branches} \
2195 -font font_ui
2196 listbox $w.list.l \
2197 -height 10 \
2198 -width 70 \
2199 -selectmode extended \
2200 -yscrollcommand [list $w.list.sby set] \
2201 -font font_ui
2202 foreach h $all_heads {
2203 if {$h ne $current_branch} {
2204 $w.list.l insert end $h
2207 scrollbar $w.list.sby -command [list $w.list.l yview]
2208 pack $w.list.sby -side right -fill y
2209 pack $w.list.l -side left -fill both -expand 1
2210 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2212 labelframe $w.validate \
2213 -text {Delete Only If} \
2214 -font font_ui
2215 radiobutton $w.validate.head_r \
2216 -text {Merged Into Local Branch:} \
2217 -value head \
2218 -variable delete_branch_checktype \
2219 -font font_ui
2220 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2221 grid $w.validate.head_r $w.validate.head_m -sticky w
2222 set all_trackings [all_tracking_branches]
2223 if {$all_trackings ne {}} {
2224 set delete_branch_trackinghead [lindex $all_trackings 0]
2225 radiobutton $w.validate.tracking_r \
2226 -text {Merged Into Tracking Branch:} \
2227 -value tracking \
2228 -variable delete_branch_checktype \
2229 -font font_ui
2230 eval tk_optionMenu $w.validate.tracking_m \
2231 delete_branch_trackinghead \
2232 $all_trackings
2233 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2235 radiobutton $w.validate.always_r \
2236 -text {Always (Do not perform merge checks)} \
2237 -value always \
2238 -variable delete_branch_checktype \
2239 -font font_ui
2240 grid $w.validate.always_r -columnspan 2 -sticky w
2241 grid columnconfigure $w.validate 1 -weight 1
2242 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2244 set delete_branch_head $current_branch
2245 set delete_branch_checktype head
2247 bind $w <Visibility> "grab $w; focus $w"
2248 bind $w <Key-Escape> "destroy $w"
2249 wm title $w "[appname] ([reponame]): Delete Branch"
2250 tkwait window $w
2253 proc switch_branch {new_branch} {
2254 global HEAD commit_type current_branch repo_config
2256 if {![lock_index switch]} return
2258 # -- Our in memory state should match the repository.
2260 repository_state curType curHEAD curMERGE_HEAD
2261 if {[string match amend* $commit_type]
2262 && $curType eq {normal}
2263 && $curHEAD eq $HEAD} {
2264 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2265 info_popup {Last scanned state does not match repository state.
2267 Another Git program has modified this repository
2268 since the last scan. A rescan must be performed
2269 before the current branch can be changed.
2271 The rescan will be automatically started now.
2273 unlock_index
2274 rescan {set ui_status_value {Ready.}}
2275 return
2278 # -- Don't do a pointless switch.
2280 if {$current_branch eq $new_branch} {
2281 unlock_index
2282 return
2285 if {$repo_config(gui.trustmtime) eq {true}} {
2286 switch_branch_stage2 {} $new_branch
2287 } else {
2288 set ui_status_value {Refreshing file status...}
2289 set cmd [list git update-index]
2290 lappend cmd -q
2291 lappend cmd --unmerged
2292 lappend cmd --ignore-missing
2293 lappend cmd --refresh
2294 set fd_rf [open "| $cmd" r]
2295 fconfigure $fd_rf -blocking 0 -translation binary
2296 fileevent $fd_rf readable \
2297 [list switch_branch_stage2 $fd_rf $new_branch]
2301 proc switch_branch_stage2 {fd_rf new_branch} {
2302 global ui_status_value HEAD
2304 if {$fd_rf ne {}} {
2305 read $fd_rf
2306 if {![eof $fd_rf]} return
2307 close $fd_rf
2310 set ui_status_value "Updating working directory to '$new_branch'..."
2311 set cmd [list git read-tree]
2312 lappend cmd -m
2313 lappend cmd -u
2314 lappend cmd --exclude-per-directory=.gitignore
2315 lappend cmd $HEAD
2316 lappend cmd $new_branch
2317 set fd_rt [open "| $cmd" r]
2318 fconfigure $fd_rt -blocking 0 -translation binary
2319 fileevent $fd_rt readable \
2320 [list switch_branch_readtree_wait $fd_rt $new_branch]
2323 proc switch_branch_readtree_wait {fd_rt new_branch} {
2324 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2325 global current_branch
2326 global ui_comm ui_status_value
2328 # -- We never get interesting output on stdout; only stderr.
2330 read $fd_rt
2331 fconfigure $fd_rt -blocking 1
2332 if {![eof $fd_rt]} {
2333 fconfigure $fd_rt -blocking 0
2334 return
2337 # -- The working directory wasn't in sync with the index and
2338 # we'd have to overwrite something to make the switch. A
2339 # merge is required.
2341 if {[catch {close $fd_rt} err]} {
2342 regsub {^fatal: } $err {} err
2343 warn_popup "File level merge required.
2345 $err
2347 Staying on branch '$current_branch'."
2348 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2349 unlock_index
2350 return
2353 # -- Update the symbolic ref. Core git doesn't even check for failure
2354 # here, it Just Works(tm). If it doesn't we are in some really ugly
2355 # state that is difficult to recover from within git-gui.
2357 if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2358 error_popup "Failed to set current branch.
2360 This working directory is only partially switched.
2361 We successfully updated your files, but failed to
2362 update an internal Git file.
2364 This should not have occurred. [appname] will now
2365 close and give up.
2367 $err"
2368 do_quit
2369 return
2372 # -- Update our repository state. If we were previously in amend mode
2373 # we need to toss the current buffer and do a full rescan to update
2374 # our file lists. If we weren't in amend mode our file lists are
2375 # accurate and we can avoid the rescan.
2377 unlock_index
2378 set selected_commit_type new
2379 if {[string match amend* $commit_type]} {
2380 $ui_comm delete 0.0 end
2381 $ui_comm edit reset
2382 $ui_comm edit modified false
2383 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2384 } else {
2385 repository_state commit_type HEAD MERGE_HEAD
2386 set PARENT $HEAD
2387 set ui_status_value "Checked out branch '$current_branch'."
2391 ######################################################################
2393 ## remote management
2395 proc load_all_remotes {} {
2396 global repo_config
2397 global all_remotes tracking_branches
2399 set all_remotes [list]
2400 array unset tracking_branches
2402 set rm_dir [gitdir remotes]
2403 if {[file isdirectory $rm_dir]} {
2404 set all_remotes [glob \
2405 -types f \
2406 -tails \
2407 -nocomplain \
2408 -directory $rm_dir *]
2410 foreach name $all_remotes {
2411 catch {
2412 set fd [open [file join $rm_dir $name] r]
2413 while {[gets $fd line] >= 0} {
2414 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2415 $line line src dst]} continue
2416 if {![regexp ^refs/ $dst]} {
2417 set dst "refs/heads/$dst"
2419 set tracking_branches($dst) [list $name $src]
2421 close $fd
2426 foreach line [array names repo_config remote.*.url] {
2427 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2428 lappend all_remotes $name
2430 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2431 set fl {}
2433 foreach line $fl {
2434 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2435 if {![regexp ^refs/ $dst]} {
2436 set dst "refs/heads/$dst"
2438 set tracking_branches($dst) [list $name $src]
2442 set all_remotes [lsort -unique $all_remotes]
2445 proc populate_fetch_menu {} {
2446 global all_remotes repo_config
2448 set m .mbar.fetch
2449 foreach r $all_remotes {
2450 set enable 0
2451 if {![catch {set a $repo_config(remote.$r.url)}]} {
2452 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2453 set enable 1
2455 } else {
2456 catch {
2457 set fd [open [gitdir remotes $r] r]
2458 while {[gets $fd n] >= 0} {
2459 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2460 set enable 1
2461 break
2464 close $fd
2468 if {$enable} {
2469 $m add command \
2470 -label "Fetch from $r..." \
2471 -command [list fetch_from $r] \
2472 -font font_ui
2477 proc populate_push_menu {} {
2478 global all_remotes repo_config
2480 set m .mbar.push
2481 set fast_count 0
2482 foreach r $all_remotes {
2483 set enable 0
2484 if {![catch {set a $repo_config(remote.$r.url)}]} {
2485 if {![catch {set a $repo_config(remote.$r.push)}]} {
2486 set enable 1
2488 } else {
2489 catch {
2490 set fd [open [gitdir remotes $r] r]
2491 while {[gets $fd n] >= 0} {
2492 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2493 set enable 1
2494 break
2497 close $fd
2501 if {$enable} {
2502 if {!$fast_count} {
2503 $m add separator
2505 $m add command \
2506 -label "Push to $r..." \
2507 -command [list push_to $r] \
2508 -font font_ui
2509 incr fast_count
2514 proc start_push_anywhere_action {w} {
2515 global push_urltype push_remote push_url push_thin push_tags
2517 set r_url {}
2518 switch -- $push_urltype {
2519 remote {set r_url $push_remote}
2520 url {set r_url $push_url}
2522 if {$r_url eq {}} return
2524 set cmd [list git push]
2525 lappend cmd -v
2526 if {$push_thin} {
2527 lappend cmd --thin
2529 if {$push_tags} {
2530 lappend cmd --tags
2532 lappend cmd $r_url
2533 set cnt 0
2534 foreach i [$w.source.l curselection] {
2535 set b [$w.source.l get $i]
2536 lappend cmd "refs/heads/$b:refs/heads/$b"
2537 incr cnt
2539 if {$cnt == 0} {
2540 return
2541 } elseif {$cnt == 1} {
2542 set unit branch
2543 } else {
2544 set unit branches
2547 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2548 console_exec $cons $cmd console_done
2549 destroy $w
2552 trace add variable push_remote write \
2553 [list radio_selector push_urltype remote]
2555 proc do_push_anywhere {} {
2556 global all_heads all_remotes current_branch
2557 global push_urltype push_remote push_url push_thin push_tags
2559 set w .push_setup
2560 toplevel $w
2561 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2563 label $w.header -text {Push Branches} -font font_uibold
2564 pack $w.header -side top -fill x
2566 frame $w.buttons
2567 button $w.buttons.create -text Push \
2568 -font font_ui \
2569 -command [list start_push_anywhere_action $w]
2570 pack $w.buttons.create -side right
2571 button $w.buttons.cancel -text {Cancel} \
2572 -font font_ui \
2573 -command [list destroy $w]
2574 pack $w.buttons.cancel -side right -padx 5
2575 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2577 labelframe $w.source \
2578 -text {Source Branches} \
2579 -font font_ui
2580 listbox $w.source.l \
2581 -height 10 \
2582 -width 70 \
2583 -selectmode extended \
2584 -yscrollcommand [list $w.source.sby set] \
2585 -font font_ui
2586 foreach h $all_heads {
2587 $w.source.l insert end $h
2588 if {$h eq $current_branch} {
2589 $w.source.l select set end
2592 scrollbar $w.source.sby -command [list $w.source.l yview]
2593 pack $w.source.sby -side right -fill y
2594 pack $w.source.l -side left -fill both -expand 1
2595 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2597 labelframe $w.dest \
2598 -text {Destination Repository} \
2599 -font font_ui
2600 if {$all_remotes ne {}} {
2601 radiobutton $w.dest.remote_r \
2602 -text {Remote:} \
2603 -value remote \
2604 -variable push_urltype \
2605 -font font_ui
2606 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2607 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2608 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2609 set push_remote origin
2610 } else {
2611 set push_remote [lindex $all_remotes 0]
2613 set push_urltype remote
2614 } else {
2615 set push_urltype url
2617 radiobutton $w.dest.url_r \
2618 -text {Arbitrary URL:} \
2619 -value url \
2620 -variable push_urltype \
2621 -font font_ui
2622 entry $w.dest.url_t \
2623 -borderwidth 1 \
2624 -relief sunken \
2625 -width 50 \
2626 -textvariable push_url \
2627 -font font_ui \
2628 -validate key \
2629 -validatecommand {
2630 if {%d == 1 && [regexp {\s} %S]} {return 0}
2631 if {%d == 1 && [string length %S] > 0} {
2632 set push_urltype url
2634 return 1
2636 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2637 grid columnconfigure $w.dest 1 -weight 1
2638 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2640 labelframe $w.options \
2641 -text {Transfer Options} \
2642 -font font_ui
2643 checkbutton $w.options.thin \
2644 -text {Use thin pack (for slow network connections)} \
2645 -variable push_thin \
2646 -font font_ui
2647 grid $w.options.thin -columnspan 2 -sticky w
2648 checkbutton $w.options.tags \
2649 -text {Include tags} \
2650 -variable push_tags \
2651 -font font_ui
2652 grid $w.options.tags -columnspan 2 -sticky w
2653 grid columnconfigure $w.options 1 -weight 1
2654 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2656 set push_url {}
2657 set push_thin 0
2658 set push_tags 0
2660 bind $w <Visibility> "grab $w"
2661 bind $w <Key-Escape> "destroy $w"
2662 wm title $w "[appname] ([reponame]): Push"
2663 tkwait window $w
2666 ######################################################################
2668 ## merge
2670 proc can_merge {} {
2671 global HEAD commit_type file_states
2673 if {[string match amend* $commit_type]} {
2674 info_popup {Cannot merge while amending.
2676 You must finish amending this commit before
2677 starting any type of merge.
2679 return 0
2682 if {[committer_ident] eq {}} {return 0}
2683 if {![lock_index merge]} {return 0}
2685 # -- Our in memory state should match the repository.
2687 repository_state curType curHEAD curMERGE_HEAD
2688 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2689 info_popup {Last scanned state does not match repository state.
2691 Another Git program has modified this repository
2692 since the last scan. A rescan must be performed
2693 before a merge can be performed.
2695 The rescan will be automatically started now.
2697 unlock_index
2698 rescan {set ui_status_value {Ready.}}
2699 return 0
2702 foreach path [array names file_states] {
2703 switch -glob -- [lindex $file_states($path) 0] {
2704 _O {
2705 continue; # and pray it works!
2707 U? {
2708 error_popup "You are in the middle of a conflicted merge.
2710 File [short_path $path] has merge conflicts.
2712 You must resolve them, add the file, and commit to
2713 complete the current merge. Only then can you
2714 begin another merge.
2716 unlock_index
2717 return 0
2719 ?? {
2720 error_popup "You are in the middle of a change.
2722 File [short_path $path] is modified.
2724 You should complete the current commit before
2725 starting a merge. Doing so will help you abort
2726 a failed merge, should the need arise.
2728 unlock_index
2729 return 0
2734 return 1
2737 proc visualize_local_merge {w} {
2738 set revs {}
2739 foreach i [$w.source.l curselection] {
2740 lappend revs [$w.source.l get $i]
2742 if {$revs eq {}} return
2743 lappend revs --not HEAD
2744 do_gitk $revs
2747 proc start_local_merge_action {w} {
2748 global HEAD ui_status_value current_branch
2750 set cmd [list git merge]
2751 set names {}
2752 set revcnt 0
2753 foreach i [$w.source.l curselection] {
2754 set b [$w.source.l get $i]
2755 lappend cmd $b
2756 lappend names $b
2757 incr revcnt
2760 if {$revcnt == 0} {
2761 return
2762 } elseif {$revcnt == 1} {
2763 set unit branch
2764 } elseif {$revcnt <= 15} {
2765 set unit branches
2766 } else {
2767 tk_messageBox \
2768 -icon error \
2769 -type ok \
2770 -title [wm title $w] \
2771 -parent $w \
2772 -message "Too many branches selected.
2774 You have requested to merge $revcnt branches
2775 in an octopus merge. This exceeds Git's
2776 internal limit of 15 branches per merge.
2778 Please select fewer branches. To merge more
2779 than 15 branches, merge the branches in batches.
2781 return
2784 set msg "Merging $current_branch, [join $names {, }]"
2785 set ui_status_value "$msg..."
2786 set cons [new_console "Merge" $msg]
2787 console_exec $cons $cmd [list finish_merge $revcnt]
2788 bind $w <Destroy> {}
2789 destroy $w
2792 proc finish_merge {revcnt w ok} {
2793 console_done $w $ok
2794 if {$ok} {
2795 set msg {Merge completed successfully.}
2796 } else {
2797 if {$revcnt != 1} {
2798 info_popup "Octopus merge failed.
2800 Your merge of $revcnt branches has failed.
2802 There are file-level conflicts between the
2803 branches which must be resolved manually.
2805 The working directory will now be reset.
2807 You can attempt this merge again
2808 by merging only one branch at a time." $w
2810 set fd [open "| git read-tree --reset -u HEAD" r]
2811 fconfigure $fd -blocking 0 -translation binary
2812 fileevent $fd readable [list reset_hard_wait $fd]
2813 set ui_status_value {Aborting... please wait...}
2814 return
2817 set msg {Merge failed. Conflict resolution is required.}
2819 unlock_index
2820 rescan [list set ui_status_value $msg]
2823 proc do_local_merge {} {
2824 global current_branch
2826 if {![can_merge]} return
2828 set w .merge_setup
2829 toplevel $w
2830 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2832 label $w.header \
2833 -text "Merge Into $current_branch" \
2834 -font font_uibold
2835 pack $w.header -side top -fill x
2837 frame $w.buttons
2838 button $w.buttons.visualize -text Visualize \
2839 -font font_ui \
2840 -command [list visualize_local_merge $w]
2841 pack $w.buttons.visualize -side left
2842 button $w.buttons.create -text Merge \
2843 -font font_ui \
2844 -command [list start_local_merge_action $w]
2845 pack $w.buttons.create -side right
2846 button $w.buttons.cancel -text {Cancel} \
2847 -font font_ui \
2848 -command [list destroy $w]
2849 pack $w.buttons.cancel -side right -padx 5
2850 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2852 labelframe $w.source \
2853 -text {Source Branches} \
2854 -font font_ui
2855 listbox $w.source.l \
2856 -height 10 \
2857 -width 70 \
2858 -selectmode extended \
2859 -yscrollcommand [list $w.source.sby set] \
2860 -font font_ui
2861 scrollbar $w.source.sby -command [list $w.source.l yview]
2862 pack $w.source.sby -side right -fill y
2863 pack $w.source.l -side left -fill both -expand 1
2864 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2866 set cmd [list git for-each-ref]
2867 lappend cmd {--format=%(objectname) %(refname)}
2868 lappend cmd refs/heads
2869 lappend cmd refs/remotes
2870 set fr_fd [open "| $cmd" r]
2871 fconfigure $fr_fd -translation binary
2872 while {[gets $fr_fd line] > 0} {
2873 set line [split $line { }]
2874 set sha1([lindex $line 0]) [lindex $line 1]
2876 close $fr_fd
2878 set to_show {}
2879 set fr_fd [open "| git rev-list --all --not HEAD"]
2880 while {[gets $fr_fd line] > 0} {
2881 if {[catch {set ref $sha1($line)}]} continue
2882 regsub ^refs/(heads|remotes)/ $ref {} ref
2883 lappend to_show $ref
2885 close $fr_fd
2887 foreach ref [lsort -unique $to_show] {
2888 $w.source.l insert end $ref
2891 bind $w <Visibility> "grab $w"
2892 bind $w <Key-Escape> "unlock_index;destroy $w"
2893 bind $w <Destroy> unlock_index
2894 wm title $w "[appname] ([reponame]): Merge"
2895 tkwait window $w
2898 proc do_reset_hard {} {
2899 global HEAD commit_type file_states
2901 if {[string match amend* $commit_type]} {
2902 info_popup {Cannot abort while amending.
2904 You must finish amending this commit.
2906 return
2909 if {![lock_index abort]} return
2911 if {[string match *merge* $commit_type]} {
2912 set op merge
2913 } else {
2914 set op commit
2917 if {[ask_popup "Abort $op?
2919 Aborting the current $op will cause
2920 *ALL* uncommitted changes to be lost.
2922 Continue with aborting the current $op?"] eq {yes}} {
2923 set fd [open "| git read-tree --reset -u HEAD" r]
2924 fconfigure $fd -blocking 0 -translation binary
2925 fileevent $fd readable [list reset_hard_wait $fd]
2926 set ui_status_value {Aborting... please wait...}
2927 } else {
2928 unlock_index
2932 proc reset_hard_wait {fd} {
2933 global ui_comm
2935 read $fd
2936 if {[eof $fd]} {
2937 close $fd
2938 unlock_index
2940 $ui_comm delete 0.0 end
2941 $ui_comm edit modified false
2943 catch {file delete [gitdir MERGE_HEAD]}
2944 catch {file delete [gitdir rr-cache MERGE_RR]}
2945 catch {file delete [gitdir SQUASH_MSG]}
2946 catch {file delete [gitdir MERGE_MSG]}
2947 catch {file delete [gitdir GITGUI_MSG]}
2949 rescan {set ui_status_value {Abort completed. Ready.}}
2953 ######################################################################
2955 ## browser
2957 set next_browser_id 0
2959 proc new_browser {commit} {
2960 global next_browser_id cursor_ptr
2961 global browser_commit browser_status browser_stack browser_path browser_busy
2963 set w .browser[incr next_browser_id]
2964 set w_list $w.list.l
2965 set browser_commit($w_list) $commit
2966 set browser_status($w_list) {Starting...}
2967 set browser_stack($w_list) {}
2968 set browser_path($w_list) $browser_commit($w_list):
2969 set browser_busy($w_list) 1
2971 toplevel $w
2972 label $w.path -textvariable browser_path($w_list) \
2973 -anchor w \
2974 -justify left \
2975 -borderwidth 1 \
2976 -relief sunken \
2977 -font font_uibold
2978 pack $w.path -anchor w -side top -fill x
2980 frame $w.list
2981 text $w_list -background white -borderwidth 0 \
2982 -cursor $cursor_ptr \
2983 -state disabled \
2984 -wrap none \
2985 -height 20 \
2986 -width 70 \
2987 -xscrollcommand [list $w.list.sbx set] \
2988 -yscrollcommand [list $w.list.sby set] \
2989 -font font_ui
2990 $w_list tag conf in_sel \
2991 -background [$w_list cget -foreground] \
2992 -foreground [$w_list cget -background]
2993 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
2994 scrollbar $w.list.sby -orient v -command [list $w_list yview]
2995 pack $w.list.sbx -side bottom -fill x
2996 pack $w.list.sby -side right -fill y
2997 pack $w_list -side left -fill both -expand 1
2998 pack $w.list -side top -fill both -expand 1
3000 label $w.status -textvariable browser_status($w_list) \
3001 -anchor w \
3002 -justify left \
3003 -borderwidth 1 \
3004 -relief sunken \
3005 -font font_ui
3006 pack $w.status -anchor w -side bottom -fill x
3008 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3009 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3011 bind $w <Visibility> "focus $w"
3012 bind $w <Destroy> "
3013 array unset browser_buffer $w_list
3014 array unset browser_files $w_list
3015 array unset browser_status $w_list
3016 array unset browser_stack $w_list
3017 array unset browser_path $w_list
3018 array unset browser_commit $w_list
3019 array unset browser_busy $w_list
3021 wm title $w "[appname] ([reponame]): File Browser"
3022 ls_tree $w_list $browser_commit($w_list) {}
3025 proc browser_click {was_double_click w pos} {
3026 global browser_files browser_status browser_path
3027 global browser_commit browser_stack browser_busy
3029 if {$browser_busy($w)} return
3030 set lno [lindex [split [$w index $pos] .] 0]
3031 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3033 $w conf -state normal
3034 $w tag remove sel 0.0 end
3035 $w tag remove in_sel 0.0 end
3036 if {$info ne {}} {
3037 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3038 if {$was_double_click} {
3039 switch -- [lindex $info 0] {
3040 parent {
3041 set parent [lindex $browser_stack($w) end-1]
3042 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3043 if {$browser_stack($w) eq {}} {
3044 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3045 } else {
3046 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3048 set browser_status($w) "Loading $browser_path($w)..."
3049 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3051 tree {
3052 set name [lindex $info 2]
3053 set escn [escape_path $name]
3054 set browser_status($w) "Loading $escn..."
3055 append browser_path($w) $escn
3056 ls_tree $w [lindex $info 1] $name
3058 blob {
3059 set name [lindex $info 2]
3060 set p {}
3061 foreach n $browser_stack($w) {
3062 append p [lindex $n 1]
3064 append p $name
3065 show_blame $browser_commit($w) $p
3070 $w conf -state disabled
3073 proc ls_tree {w tree_id name} {
3074 global browser_buffer browser_files browser_stack browser_busy
3076 set browser_buffer($w) {}
3077 set browser_files($w) {}
3078 set browser_busy($w) 1
3080 $w conf -state normal
3081 $w tag remove in_sel 0.0 end
3082 $w tag remove sel 0.0 end
3083 $w delete 0.0 end
3084 if {$browser_stack($w) ne {}} {
3085 $w image create end \
3086 -align center -padx 5 -pady 1 \
3087 -name icon0 \
3088 -image file_uplevel
3089 $w insert end {[Up To Parent]}
3090 lappend browser_files($w) parent
3092 lappend browser_stack($w) [list $tree_id $name]
3093 $w conf -state disabled
3095 set cmd [list git ls-tree -z $tree_id]
3096 set fd [open "| $cmd" r]
3097 fconfigure $fd -blocking 0 -translation binary -encoding binary
3098 fileevent $fd readable [list read_ls_tree $fd $w]
3101 proc read_ls_tree {fd w} {
3102 global browser_buffer browser_files browser_status browser_busy
3104 if {![winfo exists $w]} {
3105 catch {close $fd}
3106 return
3109 append browser_buffer($w) [read $fd]
3110 set pck [split $browser_buffer($w) "\0"]
3111 set browser_buffer($w) [lindex $pck end]
3113 set n [llength $browser_files($w)]
3114 $w conf -state normal
3115 foreach p [lrange $pck 0 end-1] {
3116 set info [split $p "\t"]
3117 set path [lindex $info 1]
3118 set info [split [lindex $info 0] { }]
3119 set type [lindex $info 1]
3120 set object [lindex $info 2]
3122 switch -- $type {
3123 blob {
3124 set image file_mod
3126 tree {
3127 set image file_dir
3128 append path /
3130 default {
3131 set image file_question
3135 if {$n > 0} {$w insert end "\n"}
3136 $w image create end \
3137 -align center -padx 5 -pady 1 \
3138 -name icon[incr n] \
3139 -image $image
3140 $w insert end [escape_path $path]
3141 lappend browser_files($w) [list $type $object $path]
3143 $w conf -state disabled
3145 if {[eof $fd]} {
3146 close $fd
3147 set browser_status($w) Ready.
3148 set browser_busy($w) 0
3149 array unset browser_buffer $w
3153 proc show_blame {commit path} {
3154 global next_browser_id blame_status blame_data
3156 set w .browser[incr next_browser_id]
3157 set blame_status($w) {Loading current file content...}
3158 set texts [list]
3160 toplevel $w
3162 label $w.path -text "$commit:$path" \
3163 -anchor w \
3164 -justify left \
3165 -borderwidth 1 \
3166 -relief sunken \
3167 -font font_uibold
3168 pack $w.path -side top -fill x
3170 set hbg #e2effa
3171 frame $w.out
3172 label $w.out.commit_l -text Commit \
3173 -relief solid \
3174 -borderwidth 1 \
3175 -background $hbg \
3176 -font font_uibold
3177 text $w.out.commit_t \
3178 -background white -borderwidth 0 \
3179 -state disabled \
3180 -wrap none \
3181 -height 40 \
3182 -width 9 \
3183 -font font_diff
3184 lappend texts $w.out.commit_t
3186 label $w.out.author_l -text Author \
3187 -relief solid \
3188 -borderwidth 1 \
3189 -background $hbg \
3190 -font font_uibold
3191 text $w.out.author_t \
3192 -background white -borderwidth 0 \
3193 -state disabled \
3194 -wrap none \
3195 -height 40 \
3196 -width 20 \
3197 -font font_diff
3198 lappend texts $w.out.author_t
3200 label $w.out.date_l -text Date \
3201 -relief solid \
3202 -borderwidth 1 \
3203 -background $hbg \
3204 -font font_uibold
3205 text $w.out.date_t \
3206 -background white -borderwidth 0 \
3207 -state disabled \
3208 -wrap none \
3209 -height 40 \
3210 -width [string length "yyyy-mm-dd hh:mm:ss"] \
3211 -font font_diff
3212 lappend texts $w.out.date_t
3214 label $w.out.filename_l -text Filename \
3215 -relief solid \
3216 -borderwidth 1 \
3217 -background $hbg \
3218 -font font_uibold
3219 text $w.out.filename_t \
3220 -background white -borderwidth 0 \
3221 -state disabled \
3222 -wrap none \
3223 -height 40 \
3224 -width 20 \
3225 -font font_diff
3226 lappend texts $w.out.filename_t
3228 label $w.out.origlinenumber_l -text {Orig Line} \
3229 -relief solid \
3230 -borderwidth 1 \
3231 -background $hbg \
3232 -font font_uibold
3233 text $w.out.origlinenumber_t \
3234 -background white -borderwidth 0 \
3235 -state disabled \
3236 -wrap none \
3237 -height 40 \
3238 -width 5 \
3239 -font font_diff
3240 $w.out.origlinenumber_t tag conf linenumber -justify right
3241 lappend texts $w.out.origlinenumber_t
3243 label $w.out.linenumber_l -text {Curr Line} \
3244 -relief solid \
3245 -borderwidth 1 \
3246 -background $hbg \
3247 -font font_uibold
3248 text $w.out.linenumber_t \
3249 -background white -borderwidth 0 \
3250 -state disabled \
3251 -wrap none \
3252 -height 40 \
3253 -width 5 \
3254 -font font_diff
3255 $w.out.linenumber_t tag conf linenumber -justify right
3256 lappend texts $w.out.linenumber_t
3258 label $w.out.file_l -text {File Content} \
3259 -relief solid \
3260 -borderwidth 1 \
3261 -background $hbg \
3262 -font font_uibold
3263 text $w.out.file_t \
3264 -background white -borderwidth 0 \
3265 -state disabled \
3266 -wrap none \
3267 -height 40 \
3268 -width 80 \
3269 -xscrollcommand [list $w.out.sbx set] \
3270 -font font_diff
3271 lappend texts $w.out.file_t
3273 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3274 scrollbar $w.out.sby -orient v \
3275 -command [list scrollbar2many $texts yview]
3276 set labels [list]
3277 foreach i $texts {
3278 regsub {_t$} $i _l l
3279 lappend labels $l
3281 set file_col [expr {[llength $texts] - 1}]
3282 eval grid $labels -sticky we
3283 eval grid $texts $w.out.sby -sticky nsew
3284 grid conf $w.out.sbx -column $file_col -sticky we
3285 grid columnconfigure $w.out $file_col -weight 1
3286 grid rowconfigure $w.out 1 -weight 1
3287 pack $w.out -fill both -expand 1
3289 label $w.status -textvariable blame_status($w) \
3290 -anchor w \
3291 -justify left \
3292 -borderwidth 1 \
3293 -relief sunken \
3294 -font font_ui
3295 pack $w.status -side bottom -fill x
3297 menu $w.ctxm -tearoff 0
3298 $w.ctxm add command -label "Copy Commit" \
3299 -font font_ui \
3300 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3302 foreach i $texts {
3303 $i tag conf in_sel \
3304 -background [$i cget -foreground] \
3305 -foreground [$i cget -background]
3306 $i conf -yscrollcommand \
3307 [list many2scrollbar $texts yview $w.out.sby]
3308 bind $i <Button-1> "blame_highlight $i @%x,%y $texts;break"
3309 bind_button3 $i "
3310 set cursorX %x
3311 set cursorY %y
3312 set cursorW %W
3313 tk_popup $w.ctxm %X %Y
3317 set blame_data($w,colors) {}
3319 bind $w <Visibility> "focus $w"
3320 bind $w <Destroy> "
3321 array unset blame_status $w
3322 array unset blame_data $w,*
3324 wm title $w "[appname] ([reponame]): File Viewer"
3326 set blame_data($w,total_lines) 0
3327 set cmd [list git cat-file blob "$commit:$path"]
3328 set fd [open "| $cmd" r]
3329 fconfigure $fd -blocking 0 -translation lf -encoding binary
3330 fileevent $fd readable [list read_blame_catfile \
3331 $fd $w $commit $path \
3332 $texts $w.out.linenumber_t $w.out.file_t]
3335 proc read_blame_catfile {fd w commit path texts w_lno w_file} {
3336 global blame_status blame_data
3338 if {![winfo exists $w_file]} {
3339 catch {close $fd}
3340 return
3343 set n $blame_data($w,total_lines)
3344 foreach i $texts {$i conf -state normal}
3345 while {[gets $fd line] >= 0} {
3346 regsub "\r\$" $line {} line
3347 incr n
3348 $w_lno insert end $n linenumber
3349 $w_file insert end $line
3350 foreach i $texts {$i insert end "\n"}
3352 foreach i $texts {$i conf -state disabled}
3353 set blame_data($w,total_lines) $n
3355 if {[eof $fd]} {
3356 close $fd
3357 set blame_status($w) {Loading annotations...}
3358 set cmd [list git blame -M -C --incremental]
3359 lappend cmd $commit -- $path
3360 set fd [open "| $cmd" r]
3361 fconfigure $fd -blocking 0 -translation lf -encoding binary
3362 fileevent $fd readable "read_blame_incremental $fd $w $texts"
3366 proc read_blame_incremental {fd w
3367 w_commit w_author w_date w_filename w_olno
3368 w_lno w_file} {
3369 global blame_status blame_data
3371 if {![winfo exists $w_commit]} {
3372 catch {close $fd}
3373 return
3376 set all [list \
3377 $w_commit \
3378 $w_author \
3379 $w_date \
3380 $w_filename \
3381 $w_olno \
3382 $w_lno \
3383 $w_file]
3385 $w_commit conf -state normal
3386 $w_author conf -state normal
3387 $w_date conf -state normal
3388 $w_filename conf -state normal
3389 $w_olno conf -state normal
3391 while {[gets $fd line] >= 0} {
3392 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3393 cmit original_line final_line line_count]} {
3394 set blame_data($w,commit) $cmit
3395 set blame_data($w,original_line) $original_line
3396 set blame_data($w,final_line) $final_line
3397 set blame_data($w,line_count) $line_count
3399 if {[catch {set g $blame_data($w,$cmit,seen)}]} {
3400 if {$blame_data($w,colors) eq {}} {
3401 set blame_data($w,colors) {
3402 yellow
3404 pink
3405 orange
3406 green
3407 grey
3410 set c [lindex $blame_data($w,colors) 0]
3411 set blame_data($w,colors) \
3412 [lrange $blame_data($w,colors) 1 end]
3413 foreach t $all {
3414 $t tag conf g$cmit -background $c
3416 } else {
3417 set blame_data($w,$cmit,seen) 1
3419 } elseif {[string match {filename *} $line]} {
3420 set n $blame_data($w,line_count)
3421 set lno $blame_data($w,final_line)
3422 set ol $blame_data($w,original_line)
3423 set file [string range $line 9 end]
3424 set cmit $blame_data($w,commit)
3425 set abbrev [string range $cmit 0 8]
3427 if {[catch {set author $blame_data($w,$cmit,author)} err]} {
3428 set author {}
3431 if {[catch {set atime $blame_data($w,$cmit,author-time)}]} {
3432 set atime {}
3433 } else {
3434 set atime [clock format $atime -format {%Y-%m-%d %T}]
3437 while {$n > 0} {
3438 if {![catch {set g g$blame_data($w,line$lno,commit)}]} {
3439 foreach t $all {
3440 $t tag remove $g $lno.0 "$lno.0 lineend + 1c"
3444 foreach t [list \
3445 $w_commit \
3446 $w_author \
3447 $w_date \
3448 $w_filename \
3449 $w_olno] {
3450 $t delete $lno.0 "$lno.0 lineend"
3453 $w_commit insert $lno.0 $abbrev
3454 $w_author insert $lno.0 $author
3455 $w_date insert $lno.0 $atime
3456 $w_filename insert $lno.0 $file
3457 $w_olno insert $lno.0 $ol linenumber
3459 set g g$cmit
3460 foreach t $all {
3461 $t tag add $g $lno.0 "$lno.0 lineend + 1c"
3464 set blame_data($w,line$lno,commit) $cmit
3466 incr n -1
3467 incr lno
3468 incr ol
3470 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3471 set blame_data($w,$blame_data($w,commit),$header) $data
3475 $w_commit conf -state disabled
3476 $w_author conf -state disabled
3477 $w_date conf -state disabled
3478 $w_filename conf -state disabled
3479 $w_olno conf -state disabled
3481 if {[eof $fd]} {
3482 close $fd
3483 set blame_status($w) {Annotation complete.}
3487 proc blame_highlight {w pos args} {
3488 set lno [lindex [split [$w index $pos] .] 0]
3489 foreach i $args {
3490 $i tag remove in_sel 0.0 end
3492 if {$lno eq {}} return
3493 foreach i $args {
3494 $i tag add in_sel $lno.0 "$lno.0 + 1 line"
3498 proc blame_copycommit {w i pos} {
3499 global blame_data
3500 set lno [lindex [split [$i index $pos] .] 0]
3501 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3502 clipboard clear
3503 clipboard append \
3504 -format STRING \
3505 -type STRING \
3506 -- $commit
3510 ######################################################################
3512 ## icons
3514 set filemask {
3515 #define mask_width 14
3516 #define mask_height 15
3517 static unsigned char mask_bits[] = {
3518 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3519 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3520 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3523 image create bitmap file_plain -background white -foreground black -data {
3524 #define plain_width 14
3525 #define plain_height 15
3526 static unsigned char plain_bits[] = {
3527 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3528 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3529 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3530 } -maskdata $filemask
3532 image create bitmap file_mod -background white -foreground blue -data {
3533 #define mod_width 14
3534 #define mod_height 15
3535 static unsigned char mod_bits[] = {
3536 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3537 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3538 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3539 } -maskdata $filemask
3541 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3542 #define file_fulltick_width 14
3543 #define file_fulltick_height 15
3544 static unsigned char file_fulltick_bits[] = {
3545 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3546 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3547 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3548 } -maskdata $filemask
3550 image create bitmap file_parttick -background white -foreground "#005050" -data {
3551 #define parttick_width 14
3552 #define parttick_height 15
3553 static unsigned char parttick_bits[] = {
3554 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3555 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3556 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3557 } -maskdata $filemask
3559 image create bitmap file_question -background white -foreground black -data {
3560 #define file_question_width 14
3561 #define file_question_height 15
3562 static unsigned char file_question_bits[] = {
3563 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3564 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3565 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3566 } -maskdata $filemask
3568 image create bitmap file_removed -background white -foreground red -data {
3569 #define file_removed_width 14
3570 #define file_removed_height 15
3571 static unsigned char file_removed_bits[] = {
3572 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3573 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3574 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3575 } -maskdata $filemask
3577 image create bitmap file_merge -background white -foreground blue -data {
3578 #define file_merge_width 14
3579 #define file_merge_height 15
3580 static unsigned char file_merge_bits[] = {
3581 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3582 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3583 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3584 } -maskdata $filemask
3586 set file_dir_data {
3587 #define file_width 18
3588 #define file_height 18
3589 static unsigned char file_bits[] = {
3590 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3591 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3592 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3593 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3594 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3596 image create bitmap file_dir -background white -foreground blue \
3597 -data $file_dir_data -maskdata $file_dir_data
3598 unset file_dir_data
3600 set file_uplevel_data {
3601 #define up_width 15
3602 #define up_height 15
3603 static unsigned char up_bits[] = {
3604 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3605 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3606 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3608 image create bitmap file_uplevel -background white -foreground red \
3609 -data $file_uplevel_data -maskdata $file_uplevel_data
3610 unset file_uplevel_data
3612 set ui_index .vpane.files.index.list
3613 set ui_workdir .vpane.files.workdir.list
3615 set all_icons(_$ui_index) file_plain
3616 set all_icons(A$ui_index) file_fulltick
3617 set all_icons(M$ui_index) file_fulltick
3618 set all_icons(D$ui_index) file_removed
3619 set all_icons(U$ui_index) file_merge
3621 set all_icons(_$ui_workdir) file_plain
3622 set all_icons(M$ui_workdir) file_mod
3623 set all_icons(D$ui_workdir) file_question
3624 set all_icons(U$ui_workdir) file_merge
3625 set all_icons(O$ui_workdir) file_plain
3627 set max_status_desc 0
3628 foreach i {
3629 {__ "Unmodified"}
3631 {_M "Modified, not staged"}
3632 {M_ "Staged for commit"}
3633 {MM "Portions staged for commit"}
3634 {MD "Staged for commit, missing"}
3636 {_O "Untracked, not staged"}
3637 {A_ "Staged for commit"}
3638 {AM "Portions staged for commit"}
3639 {AD "Staged for commit, missing"}
3641 {_D "Missing"}
3642 {D_ "Staged for removal"}
3643 {DO "Staged for removal, still present"}
3645 {U_ "Requires merge resolution"}
3646 {UU "Requires merge resolution"}
3647 {UM "Requires merge resolution"}
3648 {UD "Requires merge resolution"}
3650 if {$max_status_desc < [string length [lindex $i 1]]} {
3651 set max_status_desc [string length [lindex $i 1]]
3653 set all_descs([lindex $i 0]) [lindex $i 1]
3655 unset i
3657 ######################################################################
3659 ## util
3661 proc bind_button3 {w cmd} {
3662 bind $w <Any-Button-3> $cmd
3663 if {[is_MacOSX]} {
3664 bind $w <Control-Button-1> $cmd
3668 proc scrollbar2many {list mode args} {
3669 foreach w $list {eval $w $mode $args}
3672 proc many2scrollbar {list mode sb top bottom} {
3673 $sb set $top $bottom
3674 foreach w $list {$w $mode moveto $top}
3677 proc incr_font_size {font {amt 1}} {
3678 set sz [font configure $font -size]
3679 incr sz $amt
3680 font configure $font -size $sz
3681 font configure ${font}bold -size $sz
3684 proc hook_failed_popup {hook msg} {
3685 set w .hookfail
3686 toplevel $w
3688 frame $w.m
3689 label $w.m.l1 -text "$hook hook failed:" \
3690 -anchor w \
3691 -justify left \
3692 -font font_uibold
3693 text $w.m.t \
3694 -background white -borderwidth 1 \
3695 -relief sunken \
3696 -width 80 -height 10 \
3697 -font font_diff \
3698 -yscrollcommand [list $w.m.sby set]
3699 label $w.m.l2 \
3700 -text {You must correct the above errors before committing.} \
3701 -anchor w \
3702 -justify left \
3703 -font font_uibold
3704 scrollbar $w.m.sby -command [list $w.m.t yview]
3705 pack $w.m.l1 -side top -fill x
3706 pack $w.m.l2 -side bottom -fill x
3707 pack $w.m.sby -side right -fill y
3708 pack $w.m.t -side left -fill both -expand 1
3709 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3711 $w.m.t insert 1.0 $msg
3712 $w.m.t conf -state disabled
3714 button $w.ok -text OK \
3715 -width 15 \
3716 -font font_ui \
3717 -command "destroy $w"
3718 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3720 bind $w <Visibility> "grab $w; focus $w"
3721 bind $w <Key-Return> "destroy $w"
3722 wm title $w "[appname] ([reponame]): error"
3723 tkwait window $w
3726 set next_console_id 0
3728 proc new_console {short_title long_title} {
3729 global next_console_id console_data
3730 set w .console[incr next_console_id]
3731 set console_data($w) [list $short_title $long_title]
3732 return [console_init $w]
3735 proc console_init {w} {
3736 global console_cr console_data M1B
3738 set console_cr($w) 1.0
3739 toplevel $w
3740 frame $w.m
3741 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3742 -anchor w \
3743 -justify left \
3744 -font font_uibold
3745 text $w.m.t \
3746 -background white -borderwidth 1 \
3747 -relief sunken \
3748 -width 80 -height 10 \
3749 -font font_diff \
3750 -state disabled \
3751 -yscrollcommand [list $w.m.sby set]
3752 label $w.m.s -text {Working... please wait...} \
3753 -anchor w \
3754 -justify left \
3755 -font font_uibold
3756 scrollbar $w.m.sby -command [list $w.m.t yview]
3757 pack $w.m.l1 -side top -fill x
3758 pack $w.m.s -side bottom -fill x
3759 pack $w.m.sby -side right -fill y
3760 pack $w.m.t -side left -fill both -expand 1
3761 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3763 menu $w.ctxm -tearoff 0
3764 $w.ctxm add command -label "Copy" \
3765 -font font_ui \
3766 -command "tk_textCopy $w.m.t"
3767 $w.ctxm add command -label "Select All" \
3768 -font font_ui \
3769 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3770 $w.ctxm add command -label "Copy All" \
3771 -font font_ui \
3772 -command "
3773 $w.m.t tag add sel 0.0 end
3774 tk_textCopy $w.m.t
3775 $w.m.t tag remove sel 0.0 end
3778 button $w.ok -text {Close} \
3779 -font font_ui \
3780 -state disabled \
3781 -command "destroy $w"
3782 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3784 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3785 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3786 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3787 bind $w <Visibility> "focus $w"
3788 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3789 return $w
3792 proc console_exec {w cmd after} {
3793 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3794 # But most users need that so we have to relogin. :-(
3796 if {[is_Cygwin]} {
3797 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3800 # -- Tcl won't let us redirect both stdout and stderr to
3801 # the same pipe. So pass it through cat...
3803 set cmd [concat | $cmd |& cat]
3805 set fd_f [open $cmd r]
3806 fconfigure $fd_f -blocking 0 -translation binary
3807 fileevent $fd_f readable [list console_read $w $fd_f $after]
3810 proc console_read {w fd after} {
3811 global console_cr
3813 set buf [read $fd]
3814 if {$buf ne {}} {
3815 if {![winfo exists $w]} {console_init $w}
3816 $w.m.t conf -state normal
3817 set c 0
3818 set n [string length $buf]
3819 while {$c < $n} {
3820 set cr [string first "\r" $buf $c]
3821 set lf [string first "\n" $buf $c]
3822 if {$cr < 0} {set cr [expr {$n + 1}]}
3823 if {$lf < 0} {set lf [expr {$n + 1}]}
3825 if {$lf < $cr} {
3826 $w.m.t insert end [string range $buf $c $lf]
3827 set console_cr($w) [$w.m.t index {end -1c}]
3828 set c $lf
3829 incr c
3830 } else {
3831 $w.m.t delete $console_cr($w) end
3832 $w.m.t insert end "\n"
3833 $w.m.t insert end [string range $buf $c $cr]
3834 set c $cr
3835 incr c
3838 $w.m.t conf -state disabled
3839 $w.m.t see end
3842 fconfigure $fd -blocking 1
3843 if {[eof $fd]} {
3844 if {[catch {close $fd}]} {
3845 set ok 0
3846 } else {
3847 set ok 1
3849 uplevel #0 $after $w $ok
3850 return
3852 fconfigure $fd -blocking 0
3855 proc console_chain {cmdlist w {ok 1}} {
3856 if {$ok} {
3857 if {[llength $cmdlist] == 0} {
3858 console_done $w $ok
3859 return
3862 set cmd [lindex $cmdlist 0]
3863 set cmdlist [lrange $cmdlist 1 end]
3865 if {[lindex $cmd 0] eq {console_exec}} {
3866 console_exec $w \
3867 [lindex $cmd 1] \
3868 [list console_chain $cmdlist]
3869 } else {
3870 uplevel #0 $cmd $cmdlist $w $ok
3872 } else {
3873 console_done $w $ok
3877 proc console_done {args} {
3878 global console_cr console_data
3880 switch -- [llength $args] {
3882 set w [lindex $args 0]
3883 set ok [lindex $args 1]
3886 set w [lindex $args 1]
3887 set ok [lindex $args 2]
3889 default {
3890 error "wrong number of args: console_done ?ignored? w ok"
3894 if {$ok} {
3895 if {[winfo exists $w]} {
3896 $w.m.s conf -background green -text {Success}
3897 $w.ok conf -state normal
3899 } else {
3900 if {![winfo exists $w]} {
3901 console_init $w
3903 $w.m.s conf -background red -text {Error: Command Failed}
3904 $w.ok conf -state normal
3907 array unset console_cr $w
3908 array unset console_data $w
3911 ######################################################################
3913 ## ui commands
3915 set starting_gitk_msg {Starting gitk... please wait...}
3917 proc do_gitk {revs} {
3918 global env ui_status_value starting_gitk_msg
3920 # -- On Windows gitk is severly broken, and right now it seems like
3921 # nobody cares about fixing it. The only known workaround is to
3922 # always delete ~/.gitk before starting the program.
3924 if {[is_Windows]} {
3925 catch {file delete [file join $env(HOME) .gitk]}
3928 # -- Always start gitk through whatever we were loaded with. This
3929 # lets us bypass using shell process on Windows systems.
3931 set cmd [info nameofexecutable]
3932 lappend cmd [gitexec gitk]
3933 if {$revs ne {}} {
3934 append cmd { }
3935 append cmd $revs
3938 if {[catch {eval exec $cmd &} err]} {
3939 error_popup "Failed to start gitk:\n\n$err"
3940 } else {
3941 set ui_status_value $starting_gitk_msg
3942 after 10000 {
3943 if {$ui_status_value eq $starting_gitk_msg} {
3944 set ui_status_value {Ready.}
3950 proc do_stats {} {
3951 set fd [open "| git count-objects -v" r]
3952 while {[gets $fd line] > 0} {
3953 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
3954 set stats($name) $value
3957 close $fd
3959 set packed_sz 0
3960 foreach p [glob -directory [gitdir objects pack] \
3961 -type f \
3962 -nocomplain -- *] {
3963 incr packed_sz [file size $p]
3965 if {$packed_sz > 0} {
3966 set stats(size-pack) [expr {$packed_sz / 1024}]
3969 set w .stats_view
3970 toplevel $w
3971 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3973 label $w.header -text {Database Statistics} \
3974 -font font_uibold
3975 pack $w.header -side top -fill x
3977 frame $w.buttons -border 1
3978 button $w.buttons.close -text Close \
3979 -font font_ui \
3980 -command [list destroy $w]
3981 button $w.buttons.gc -text {Compress Database} \
3982 -font font_ui \
3983 -command "destroy $w;do_gc"
3984 pack $w.buttons.close -side right
3985 pack $w.buttons.gc -side left
3986 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3988 frame $w.stat -borderwidth 1 -relief solid
3989 foreach s {
3990 {count {Number of loose objects}}
3991 {size {Disk space used by loose objects} { KiB}}
3992 {in-pack {Number of packed objects}}
3993 {packs {Number of packs}}
3994 {size-pack {Disk space used by packed objects} { KiB}}
3995 {prune-packable {Packed objects waiting for pruning}}
3996 {garbage {Garbage files}}
3998 set name [lindex $s 0]
3999 set label [lindex $s 1]
4000 if {[catch {set value $stats($name)}]} continue
4001 if {[llength $s] > 2} {
4002 set value "$value[lindex $s 2]"
4005 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4006 label $w.stat.v_$name -text $value -anchor w -font font_ui
4007 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4009 pack $w.stat -pady 10 -padx 10
4011 bind $w <Visibility> "grab $w; focus $w"
4012 bind $w <Key-Escape> [list destroy $w]
4013 bind $w <Key-Return> [list destroy $w]
4014 wm title $w "[appname] ([reponame]): Database Statistics"
4015 tkwait window $w
4018 proc do_gc {} {
4019 set w [new_console {gc} {Compressing the object database}]
4020 console_chain {
4021 {console_exec {git pack-refs --prune}}
4022 {console_exec {git reflog expire --all}}
4023 {console_exec {git repack -a -d -l}}
4024 {console_exec {git rerere gc}}
4025 } $w
4028 proc do_fsck_objects {} {
4029 set w [new_console {fsck-objects} \
4030 {Verifying the object database with fsck-objects}]
4031 set cmd [list git fsck-objects]
4032 lappend cmd --full
4033 lappend cmd --cache
4034 lappend cmd --strict
4035 console_exec $w $cmd console_done
4038 set is_quitting 0
4040 proc do_quit {} {
4041 global ui_comm is_quitting repo_config commit_type
4043 if {$is_quitting} return
4044 set is_quitting 1
4046 # -- Stash our current commit buffer.
4048 set save [gitdir GITGUI_MSG]
4049 set msg [string trim [$ui_comm get 0.0 end]]
4050 regsub -all -line {[ \r\t]+$} $msg {} msg
4051 if {(![string match amend* $commit_type]
4052 || [$ui_comm edit modified])
4053 && $msg ne {}} {
4054 catch {
4055 set fd [open $save w]
4056 puts -nonewline $fd $msg
4057 close $fd
4059 } else {
4060 catch {file delete $save}
4063 # -- Stash our current window geometry into this repository.
4065 set cfg_geometry [list]
4066 lappend cfg_geometry [wm geometry .]
4067 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4068 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4069 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4070 set rc_geometry {}
4072 if {$cfg_geometry ne $rc_geometry} {
4073 catch {exec git repo-config gui.geometry $cfg_geometry}
4076 destroy .
4079 proc do_rescan {} {
4080 rescan {set ui_status_value {Ready.}}
4083 proc unstage_helper {txt paths} {
4084 global file_states current_diff_path
4086 if {![lock_index begin-update]} return
4088 set pathList [list]
4089 set after {}
4090 foreach path $paths {
4091 switch -glob -- [lindex $file_states($path) 0] {
4092 A? -
4093 M? -
4094 D? {
4095 lappend pathList $path
4096 if {$path eq $current_diff_path} {
4097 set after {reshow_diff;}
4102 if {$pathList eq {}} {
4103 unlock_index
4104 } else {
4105 update_indexinfo \
4106 $txt \
4107 $pathList \
4108 [concat $after {set ui_status_value {Ready.}}]
4112 proc do_unstage_selection {} {
4113 global current_diff_path selected_paths
4115 if {[array size selected_paths] > 0} {
4116 unstage_helper \
4117 {Unstaging selected files from commit} \
4118 [array names selected_paths]
4119 } elseif {$current_diff_path ne {}} {
4120 unstage_helper \
4121 "Unstaging [short_path $current_diff_path] from commit" \
4122 [list $current_diff_path]
4126 proc add_helper {txt paths} {
4127 global file_states current_diff_path
4129 if {![lock_index begin-update]} return
4131 set pathList [list]
4132 set after {}
4133 foreach path $paths {
4134 switch -glob -- [lindex $file_states($path) 0] {
4135 _O -
4136 ?M -
4137 ?D -
4138 U? {
4139 lappend pathList $path
4140 if {$path eq $current_diff_path} {
4141 set after {reshow_diff;}
4146 if {$pathList eq {}} {
4147 unlock_index
4148 } else {
4149 update_index \
4150 $txt \
4151 $pathList \
4152 [concat $after {set ui_status_value {Ready to commit.}}]
4156 proc do_add_selection {} {
4157 global current_diff_path selected_paths
4159 if {[array size selected_paths] > 0} {
4160 add_helper \
4161 {Adding selected files} \
4162 [array names selected_paths]
4163 } elseif {$current_diff_path ne {}} {
4164 add_helper \
4165 "Adding [short_path $current_diff_path]" \
4166 [list $current_diff_path]
4170 proc do_add_all {} {
4171 global file_states
4173 set paths [list]
4174 foreach path [array names file_states] {
4175 switch -glob -- [lindex $file_states($path) 0] {
4176 U? {continue}
4177 ?M -
4178 ?D {lappend paths $path}
4181 add_helper {Adding all changed files} $paths
4184 proc revert_helper {txt paths} {
4185 global file_states current_diff_path
4187 if {![lock_index begin-update]} return
4189 set pathList [list]
4190 set after {}
4191 foreach path $paths {
4192 switch -glob -- [lindex $file_states($path) 0] {
4193 U? {continue}
4194 ?M -
4195 ?D {
4196 lappend pathList $path
4197 if {$path eq $current_diff_path} {
4198 set after {reshow_diff;}
4204 set n [llength $pathList]
4205 if {$n == 0} {
4206 unlock_index
4207 return
4208 } elseif {$n == 1} {
4209 set s "[short_path [lindex $pathList]]"
4210 } else {
4211 set s "these $n files"
4214 set reply [tk_dialog \
4215 .confirm_revert \
4216 "[appname] ([reponame])" \
4217 "Revert changes in $s?
4219 Any unadded changes will be permanently lost by the revert." \
4220 question \
4222 {Do Nothing} \
4223 {Revert Changes} \
4225 if {$reply == 1} {
4226 checkout_index \
4227 $txt \
4228 $pathList \
4229 [concat $after {set ui_status_value {Ready.}}]
4230 } else {
4231 unlock_index
4235 proc do_revert_selection {} {
4236 global current_diff_path selected_paths
4238 if {[array size selected_paths] > 0} {
4239 revert_helper \
4240 {Reverting selected files} \
4241 [array names selected_paths]
4242 } elseif {$current_diff_path ne {}} {
4243 revert_helper \
4244 "Reverting [short_path $current_diff_path]" \
4245 [list $current_diff_path]
4249 proc do_signoff {} {
4250 global ui_comm
4252 set me [committer_ident]
4253 if {$me eq {}} return
4255 set sob "Signed-off-by: $me"
4256 set last [$ui_comm get {end -1c linestart} {end -1c}]
4257 if {$last ne $sob} {
4258 $ui_comm edit separator
4259 if {$last ne {}
4260 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4261 $ui_comm insert end "\n"
4263 $ui_comm insert end "\n$sob"
4264 $ui_comm edit separator
4265 $ui_comm see end
4269 proc do_select_commit_type {} {
4270 global commit_type selected_commit_type
4272 if {$selected_commit_type eq {new}
4273 && [string match amend* $commit_type]} {
4274 create_new_commit
4275 } elseif {$selected_commit_type eq {amend}
4276 && ![string match amend* $commit_type]} {
4277 load_last_commit
4279 # The amend request was rejected...
4281 if {![string match amend* $commit_type]} {
4282 set selected_commit_type new
4287 proc do_commit {} {
4288 commit_tree
4291 proc do_about {} {
4292 global appvers copyright
4293 global tcl_patchLevel tk_patchLevel
4295 set w .about_dialog
4296 toplevel $w
4297 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4299 label $w.header -text "About [appname]" \
4300 -font font_uibold
4301 pack $w.header -side top -fill x
4303 frame $w.buttons
4304 button $w.buttons.close -text {Close} \
4305 -font font_ui \
4306 -command [list destroy $w]
4307 pack $w.buttons.close -side right
4308 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4310 label $w.desc \
4311 -text "[appname] - a commit creation tool for Git.
4312 $copyright" \
4313 -padx 5 -pady 5 \
4314 -justify left \
4315 -anchor w \
4316 -borderwidth 1 \
4317 -relief solid \
4318 -font font_ui
4319 pack $w.desc -side top -fill x -padx 5 -pady 5
4321 set v {}
4322 append v "[appname] version $appvers\n"
4323 append v "[exec git version]\n"
4324 append v "\n"
4325 if {$tcl_patchLevel eq $tk_patchLevel} {
4326 append v "Tcl/Tk version $tcl_patchLevel"
4327 } else {
4328 append v "Tcl version $tcl_patchLevel"
4329 append v ", Tk version $tk_patchLevel"
4332 label $w.vers \
4333 -text $v \
4334 -padx 5 -pady 5 \
4335 -justify left \
4336 -anchor w \
4337 -borderwidth 1 \
4338 -relief solid \
4339 -font font_ui
4340 pack $w.vers -side top -fill x -padx 5 -pady 5
4342 menu $w.ctxm -tearoff 0
4343 $w.ctxm add command \
4344 -label {Copy} \
4345 -font font_ui \
4346 -command "
4347 clipboard clear
4348 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4351 bind $w <Visibility> "grab $w; focus $w"
4352 bind $w <Key-Escape> "destroy $w"
4353 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4354 wm title $w "About [appname]"
4355 tkwait window $w
4358 proc do_options {} {
4359 global repo_config global_config font_descs
4360 global repo_config_new global_config_new
4362 array unset repo_config_new
4363 array unset global_config_new
4364 foreach name [array names repo_config] {
4365 set repo_config_new($name) $repo_config($name)
4367 load_config 1
4368 foreach name [array names repo_config] {
4369 switch -- $name {
4370 gui.diffcontext {continue}
4372 set repo_config_new($name) $repo_config($name)
4374 foreach name [array names global_config] {
4375 set global_config_new($name) $global_config($name)
4378 set w .options_editor
4379 toplevel $w
4380 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4382 label $w.header -text "[appname] Options" \
4383 -font font_uibold
4384 pack $w.header -side top -fill x
4386 frame $w.buttons
4387 button $w.buttons.restore -text {Restore Defaults} \
4388 -font font_ui \
4389 -command do_restore_defaults
4390 pack $w.buttons.restore -side left
4391 button $w.buttons.save -text Save \
4392 -font font_ui \
4393 -command [list do_save_config $w]
4394 pack $w.buttons.save -side right
4395 button $w.buttons.cancel -text {Cancel} \
4396 -font font_ui \
4397 -command [list destroy $w]
4398 pack $w.buttons.cancel -side right -padx 5
4399 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4401 labelframe $w.repo -text "[reponame] Repository" \
4402 -font font_ui
4403 labelframe $w.global -text {Global (All Repositories)} \
4404 -font font_ui
4405 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4406 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4408 set optid 0
4409 foreach option {
4410 {t user.name {User Name}}
4411 {t user.email {Email Address}}
4413 {b merge.summary {Summarize Merge Commits}}
4414 {i-1..5 merge.verbosity {Merge Verbosity}}
4416 {b gui.trustmtime {Trust File Modification Timestamps}}
4417 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4418 {t gui.newbranchtemplate {New Branch Name Template}}
4420 set type [lindex $option 0]
4421 set name [lindex $option 1]
4422 set text [lindex $option 2]
4423 incr optid
4424 foreach f {repo global} {
4425 switch -glob -- $type {
4427 checkbutton $w.$f.$optid -text $text \
4428 -variable ${f}_config_new($name) \
4429 -onvalue true \
4430 -offvalue false \
4431 -font font_ui
4432 pack $w.$f.$optid -side top -anchor w
4434 i-* {
4435 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4436 frame $w.$f.$optid
4437 label $w.$f.$optid.l -text "$text:" -font font_ui
4438 pack $w.$f.$optid.l -side left -anchor w -fill x
4439 spinbox $w.$f.$optid.v \
4440 -textvariable ${f}_config_new($name) \
4441 -from $min \
4442 -to $max \
4443 -increment 1 \
4444 -width [expr {1 + [string length $max]}] \
4445 -font font_ui
4446 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4447 pack $w.$f.$optid.v -side right -anchor e -padx 5
4448 pack $w.$f.$optid -side top -anchor w -fill x
4451 frame $w.$f.$optid
4452 label $w.$f.$optid.l -text "$text:" -font font_ui
4453 entry $w.$f.$optid.v \
4454 -borderwidth 1 \
4455 -relief sunken \
4456 -width 20 \
4457 -textvariable ${f}_config_new($name) \
4458 -font font_ui
4459 pack $w.$f.$optid.l -side left -anchor w
4460 pack $w.$f.$optid.v -side left -anchor w \
4461 -fill x -expand 1 \
4462 -padx 5
4463 pack $w.$f.$optid -side top -anchor w -fill x
4469 set all_fonts [lsort [font families]]
4470 foreach option $font_descs {
4471 set name [lindex $option 0]
4472 set font [lindex $option 1]
4473 set text [lindex $option 2]
4475 set global_config_new(gui.$font^^family) \
4476 [font configure $font -family]
4477 set global_config_new(gui.$font^^size) \
4478 [font configure $font -size]
4480 frame $w.global.$name
4481 label $w.global.$name.l -text "$text:" -font font_ui
4482 pack $w.global.$name.l -side left -anchor w -fill x
4483 eval tk_optionMenu $w.global.$name.family \
4484 global_config_new(gui.$font^^family) \
4485 $all_fonts
4486 spinbox $w.global.$name.size \
4487 -textvariable global_config_new(gui.$font^^size) \
4488 -from 2 -to 80 -increment 1 \
4489 -width 3 \
4490 -font font_ui
4491 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4492 pack $w.global.$name.size -side right -anchor e
4493 pack $w.global.$name.family -side right -anchor e
4494 pack $w.global.$name -side top -anchor w -fill x
4497 bind $w <Visibility> "grab $w; focus $w"
4498 bind $w <Key-Escape> "destroy $w"
4499 wm title $w "[appname] ([reponame]): Options"
4500 tkwait window $w
4503 proc do_restore_defaults {} {
4504 global font_descs default_config repo_config
4505 global repo_config_new global_config_new
4507 foreach name [array names default_config] {
4508 set repo_config_new($name) $default_config($name)
4509 set global_config_new($name) $default_config($name)
4512 foreach option $font_descs {
4513 set name [lindex $option 0]
4514 set repo_config(gui.$name) $default_config(gui.$name)
4516 apply_config
4518 foreach option $font_descs {
4519 set name [lindex $option 0]
4520 set font [lindex $option 1]
4521 set global_config_new(gui.$font^^family) \
4522 [font configure $font -family]
4523 set global_config_new(gui.$font^^size) \
4524 [font configure $font -size]
4528 proc do_save_config {w} {
4529 if {[catch {save_config} err]} {
4530 error_popup "Failed to completely save options:\n\n$err"
4532 reshow_diff
4533 destroy $w
4536 proc do_windows_shortcut {} {
4537 global argv0
4539 set fn [tk_getSaveFile \
4540 -parent . \
4541 -title "[appname] ([reponame]): Create Desktop Icon" \
4542 -initialfile "Git [reponame].bat"]
4543 if {$fn != {}} {
4544 if {[catch {
4545 set fd [open $fn w]
4546 puts $fd "@ECHO Entering [reponame]"
4547 puts $fd "@ECHO Starting git-gui... please wait..."
4548 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4549 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4550 puts -nonewline $fd "@\"[info nameofexecutable]\""
4551 puts $fd " \"[file normalize $argv0]\""
4552 close $fd
4553 } err]} {
4554 error_popup "Cannot write script:\n\n$err"
4559 proc do_cygwin_shortcut {} {
4560 global argv0
4562 if {[catch {
4563 set desktop [exec cygpath \
4564 --windows \
4565 --absolute \
4566 --long-name \
4567 --desktop]
4568 }]} {
4569 set desktop .
4571 set fn [tk_getSaveFile \
4572 -parent . \
4573 -title "[appname] ([reponame]): Create Desktop Icon" \
4574 -initialdir $desktop \
4575 -initialfile "Git [reponame].bat"]
4576 if {$fn != {}} {
4577 if {[catch {
4578 set fd [open $fn w]
4579 set sh [exec cygpath \
4580 --windows \
4581 --absolute \
4582 /bin/sh]
4583 set me [exec cygpath \
4584 --unix \
4585 --absolute \
4586 $argv0]
4587 set gd [exec cygpath \
4588 --unix \
4589 --absolute \
4590 [gitdir]]
4591 set gw [exec cygpath \
4592 --windows \
4593 --absolute \
4594 [file dirname [gitdir]]]
4595 regsub -all ' $me "'\\''" me
4596 regsub -all ' $gd "'\\''" gd
4597 puts $fd "@ECHO Entering $gw"
4598 puts $fd "@ECHO Starting git-gui... please wait..."
4599 puts -nonewline $fd "@\"$sh\" --login -c \""
4600 puts -nonewline $fd "GIT_DIR='$gd'"
4601 puts -nonewline $fd " '$me'"
4602 puts $fd "&\""
4603 close $fd
4604 } err]} {
4605 error_popup "Cannot write script:\n\n$err"
4610 proc do_macosx_app {} {
4611 global argv0 env
4613 set fn [tk_getSaveFile \
4614 -parent . \
4615 -title "[appname] ([reponame]): Create Desktop Icon" \
4616 -initialdir [file join $env(HOME) Desktop] \
4617 -initialfile "Git [reponame].app"]
4618 if {$fn != {}} {
4619 if {[catch {
4620 set Contents [file join $fn Contents]
4621 set MacOS [file join $Contents MacOS]
4622 set exe [file join $MacOS git-gui]
4624 file mkdir $MacOS
4626 set fd [open [file join $Contents Info.plist] w]
4627 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4628 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4629 <plist version="1.0">
4630 <dict>
4631 <key>CFBundleDevelopmentRegion</key>
4632 <string>English</string>
4633 <key>CFBundleExecutable</key>
4634 <string>git-gui</string>
4635 <key>CFBundleIdentifier</key>
4636 <string>org.spearce.git-gui</string>
4637 <key>CFBundleInfoDictionaryVersion</key>
4638 <string>6.0</string>
4639 <key>CFBundlePackageType</key>
4640 <string>APPL</string>
4641 <key>CFBundleSignature</key>
4642 <string>????</string>
4643 <key>CFBundleVersion</key>
4644 <string>1.0</string>
4645 <key>NSPrincipalClass</key>
4646 <string>NSApplication</string>
4647 </dict>
4648 </plist>}
4649 close $fd
4651 set fd [open $exe w]
4652 set gd [file normalize [gitdir]]
4653 set ep [file normalize [gitexec]]
4654 regsub -all ' $gd "'\\''" gd
4655 regsub -all ' $ep "'\\''" ep
4656 puts $fd "#!/bin/sh"
4657 foreach name [array names env] {
4658 if {[string match GIT_* $name]} {
4659 regsub -all ' $env($name) "'\\''" v
4660 puts $fd "export $name='$v'"
4663 puts $fd "export PATH='$ep':\$PATH"
4664 puts $fd "export GIT_DIR='$gd'"
4665 puts $fd "exec [file normalize $argv0]"
4666 close $fd
4668 file attributes $exe -permissions u+x,g+x,o+x
4669 } err]} {
4670 error_popup "Cannot write icon:\n\n$err"
4675 proc toggle_or_diff {w x y} {
4676 global file_states file_lists current_diff_path ui_index ui_workdir
4677 global last_clicked selected_paths
4679 set pos [split [$w index @$x,$y] .]
4680 set lno [lindex $pos 0]
4681 set col [lindex $pos 1]
4682 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4683 if {$path eq {}} {
4684 set last_clicked {}
4685 return
4688 set last_clicked [list $w $lno]
4689 array unset selected_paths
4690 $ui_index tag remove in_sel 0.0 end
4691 $ui_workdir tag remove in_sel 0.0 end
4693 if {$col == 0} {
4694 if {$current_diff_path eq $path} {
4695 set after {reshow_diff;}
4696 } else {
4697 set after {}
4699 if {$w eq $ui_index} {
4700 update_indexinfo \
4701 "Unstaging [short_path $path] from commit" \
4702 [list $path] \
4703 [concat $after {set ui_status_value {Ready.}}]
4704 } elseif {$w eq $ui_workdir} {
4705 update_index \
4706 "Adding [short_path $path]" \
4707 [list $path] \
4708 [concat $after {set ui_status_value {Ready.}}]
4710 } else {
4711 show_diff $path $w $lno
4715 proc add_one_to_selection {w x y} {
4716 global file_lists last_clicked selected_paths
4718 set lno [lindex [split [$w index @$x,$y] .] 0]
4719 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4720 if {$path eq {}} {
4721 set last_clicked {}
4722 return
4725 if {$last_clicked ne {}
4726 && [lindex $last_clicked 0] ne $w} {
4727 array unset selected_paths
4728 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4731 set last_clicked [list $w $lno]
4732 if {[catch {set in_sel $selected_paths($path)}]} {
4733 set in_sel 0
4735 if {$in_sel} {
4736 unset selected_paths($path)
4737 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4738 } else {
4739 set selected_paths($path) 1
4740 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4744 proc add_range_to_selection {w x y} {
4745 global file_lists last_clicked selected_paths
4747 if {[lindex $last_clicked 0] ne $w} {
4748 toggle_or_diff $w $x $y
4749 return
4752 set lno [lindex [split [$w index @$x,$y] .] 0]
4753 set lc [lindex $last_clicked 1]
4754 if {$lc < $lno} {
4755 set begin $lc
4756 set end $lno
4757 } else {
4758 set begin $lno
4759 set end $lc
4762 foreach path [lrange $file_lists($w) \
4763 [expr {$begin - 1}] \
4764 [expr {$end - 1}]] {
4765 set selected_paths($path) 1
4767 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4770 ######################################################################
4772 ## config defaults
4774 set cursor_ptr arrow
4775 font create font_diff -family Courier -size 10
4776 font create font_ui
4777 catch {
4778 label .dummy
4779 eval font configure font_ui [font actual [.dummy cget -font]]
4780 destroy .dummy
4783 font create font_uibold
4784 font create font_diffbold
4786 if {[is_Windows]} {
4787 set M1B Control
4788 set M1T Ctrl
4789 } elseif {[is_MacOSX]} {
4790 set M1B M1
4791 set M1T Cmd
4792 } else {
4793 set M1B M1
4794 set M1T M1
4797 proc apply_config {} {
4798 global repo_config font_descs
4800 foreach option $font_descs {
4801 set name [lindex $option 0]
4802 set font [lindex $option 1]
4803 if {[catch {
4804 foreach {cn cv} $repo_config(gui.$name) {
4805 font configure $font $cn $cv
4807 } err]} {
4808 error_popup "Invalid font specified in gui.$name:\n\n$err"
4810 foreach {cn cv} [font configure $font] {
4811 font configure ${font}bold $cn $cv
4813 font configure ${font}bold -weight bold
4817 set default_config(merge.summary) false
4818 set default_config(merge.verbosity) 2
4819 set default_config(user.name) {}
4820 set default_config(user.email) {}
4822 set default_config(gui.trustmtime) false
4823 set default_config(gui.diffcontext) 5
4824 set default_config(gui.newbranchtemplate) {}
4825 set default_config(gui.fontui) [font configure font_ui]
4826 set default_config(gui.fontdiff) [font configure font_diff]
4827 set font_descs {
4828 {fontui font_ui {Main Font}}
4829 {fontdiff font_diff {Diff/Console Font}}
4831 load_config 0
4832 apply_config
4834 ######################################################################
4836 ## ui construction
4838 # -- Menu Bar
4840 menu .mbar -tearoff 0
4841 .mbar add cascade -label Repository -menu .mbar.repository
4842 .mbar add cascade -label Edit -menu .mbar.edit
4843 if {!$single_commit} {
4844 .mbar add cascade -label Branch -menu .mbar.branch
4846 .mbar add cascade -label Commit -menu .mbar.commit
4847 if {!$single_commit} {
4848 .mbar add cascade -label Merge -menu .mbar.merge
4849 .mbar add cascade -label Fetch -menu .mbar.fetch
4850 .mbar add cascade -label Push -menu .mbar.push
4852 . configure -menu .mbar
4854 # -- Repository Menu
4856 menu .mbar.repository
4858 .mbar.repository add command \
4859 -label {Browse Current Branch} \
4860 -command {new_browser $current_branch} \
4861 -font font_ui
4862 .mbar.repository add separator
4864 .mbar.repository add command \
4865 -label {Visualize Current Branch} \
4866 -command {do_gitk {}} \
4867 -font font_ui
4868 .mbar.repository add command \
4869 -label {Visualize All Branches} \
4870 -command {do_gitk {--all}} \
4871 -font font_ui
4872 .mbar.repository add separator
4874 if {!$single_commit} {
4875 .mbar.repository add command -label {Database Statistics} \
4876 -command do_stats \
4877 -font font_ui
4879 .mbar.repository add command -label {Compress Database} \
4880 -command do_gc \
4881 -font font_ui
4883 .mbar.repository add command -label {Verify Database} \
4884 -command do_fsck_objects \
4885 -font font_ui
4887 .mbar.repository add separator
4889 if {[is_Cygwin]} {
4890 .mbar.repository add command \
4891 -label {Create Desktop Icon} \
4892 -command do_cygwin_shortcut \
4893 -font font_ui
4894 } elseif {[is_Windows]} {
4895 .mbar.repository add command \
4896 -label {Create Desktop Icon} \
4897 -command do_windows_shortcut \
4898 -font font_ui
4899 } elseif {[is_MacOSX]} {
4900 .mbar.repository add command \
4901 -label {Create Desktop Icon} \
4902 -command do_macosx_app \
4903 -font font_ui
4907 .mbar.repository add command -label Quit \
4908 -command do_quit \
4909 -accelerator $M1T-Q \
4910 -font font_ui
4912 # -- Edit Menu
4914 menu .mbar.edit
4915 .mbar.edit add command -label Undo \
4916 -command {catch {[focus] edit undo}} \
4917 -accelerator $M1T-Z \
4918 -font font_ui
4919 .mbar.edit add command -label Redo \
4920 -command {catch {[focus] edit redo}} \
4921 -accelerator $M1T-Y \
4922 -font font_ui
4923 .mbar.edit add separator
4924 .mbar.edit add command -label Cut \
4925 -command {catch {tk_textCut [focus]}} \
4926 -accelerator $M1T-X \
4927 -font font_ui
4928 .mbar.edit add command -label Copy \
4929 -command {catch {tk_textCopy [focus]}} \
4930 -accelerator $M1T-C \
4931 -font font_ui
4932 .mbar.edit add command -label Paste \
4933 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4934 -accelerator $M1T-V \
4935 -font font_ui
4936 .mbar.edit add command -label Delete \
4937 -command {catch {[focus] delete sel.first sel.last}} \
4938 -accelerator Del \
4939 -font font_ui
4940 .mbar.edit add separator
4941 .mbar.edit add command -label {Select All} \
4942 -command {catch {[focus] tag add sel 0.0 end}} \
4943 -accelerator $M1T-A \
4944 -font font_ui
4946 # -- Branch Menu
4948 if {!$single_commit} {
4949 menu .mbar.branch
4951 .mbar.branch add command -label {Create...} \
4952 -command do_create_branch \
4953 -accelerator $M1T-N \
4954 -font font_ui
4955 lappend disable_on_lock [list .mbar.branch entryconf \
4956 [.mbar.branch index last] -state]
4958 .mbar.branch add command -label {Delete...} \
4959 -command do_delete_branch \
4960 -font font_ui
4961 lappend disable_on_lock [list .mbar.branch entryconf \
4962 [.mbar.branch index last] -state]
4965 # -- Commit Menu
4967 menu .mbar.commit
4969 .mbar.commit add radiobutton \
4970 -label {New Commit} \
4971 -command do_select_commit_type \
4972 -variable selected_commit_type \
4973 -value new \
4974 -font font_ui
4975 lappend disable_on_lock \
4976 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4978 .mbar.commit add radiobutton \
4979 -label {Amend Last Commit} \
4980 -command do_select_commit_type \
4981 -variable selected_commit_type \
4982 -value amend \
4983 -font font_ui
4984 lappend disable_on_lock \
4985 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4987 .mbar.commit add separator
4989 .mbar.commit add command -label Rescan \
4990 -command do_rescan \
4991 -accelerator F5 \
4992 -font font_ui
4993 lappend disable_on_lock \
4994 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4996 .mbar.commit add command -label {Add To Commit} \
4997 -command do_add_selection \
4998 -font font_ui
4999 lappend disable_on_lock \
5000 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5002 .mbar.commit add command -label {Add All To Commit} \
5003 -command do_add_all \
5004 -accelerator $M1T-I \
5005 -font font_ui
5006 lappend disable_on_lock \
5007 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5009 .mbar.commit add command -label {Unstage From Commit} \
5010 -command do_unstage_selection \
5011 -font font_ui
5012 lappend disable_on_lock \
5013 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5015 .mbar.commit add command -label {Revert Changes} \
5016 -command do_revert_selection \
5017 -font font_ui
5018 lappend disable_on_lock \
5019 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5021 .mbar.commit add separator
5023 .mbar.commit add command -label {Sign Off} \
5024 -command do_signoff \
5025 -accelerator $M1T-S \
5026 -font font_ui
5028 .mbar.commit add command -label Commit \
5029 -command do_commit \
5030 -accelerator $M1T-Return \
5031 -font font_ui
5032 lappend disable_on_lock \
5033 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5035 if {[is_MacOSX]} {
5036 # -- Apple Menu (Mac OS X only)
5038 .mbar add cascade -label Apple -menu .mbar.apple
5039 menu .mbar.apple
5041 .mbar.apple add command -label "About [appname]" \
5042 -command do_about \
5043 -font font_ui
5044 .mbar.apple add command -label "[appname] Options..." \
5045 -command do_options \
5046 -font font_ui
5047 } else {
5048 # -- Edit Menu
5050 .mbar.edit add separator
5051 .mbar.edit add command -label {Options...} \
5052 -command do_options \
5053 -font font_ui
5055 # -- Tools Menu
5057 if {[file exists /usr/local/miga/lib/gui-miga]
5058 && [file exists .pvcsrc]} {
5059 proc do_miga {} {
5060 global ui_status_value
5061 if {![lock_index update]} return
5062 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5063 set miga_fd [open "|$cmd" r]
5064 fconfigure $miga_fd -blocking 0
5065 fileevent $miga_fd readable [list miga_done $miga_fd]
5066 set ui_status_value {Running miga...}
5068 proc miga_done {fd} {
5069 read $fd 512
5070 if {[eof $fd]} {
5071 close $fd
5072 unlock_index
5073 rescan [list set ui_status_value {Ready.}]
5076 .mbar add cascade -label Tools -menu .mbar.tools
5077 menu .mbar.tools
5078 .mbar.tools add command -label "Migrate" \
5079 -command do_miga \
5080 -font font_ui
5081 lappend disable_on_lock \
5082 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5086 # -- Help Menu
5088 .mbar add cascade -label Help -menu .mbar.help
5089 menu .mbar.help
5091 if {![is_MacOSX]} {
5092 .mbar.help add command -label "About [appname]" \
5093 -command do_about \
5094 -font font_ui
5097 set browser {}
5098 catch {set browser $repo_config(instaweb.browser)}
5099 set doc_path [file dirname [gitexec]]
5100 set doc_path [file join $doc_path Documentation index.html]
5102 if {[is_Cygwin]} {
5103 set doc_path [exec cygpath --windows $doc_path]
5106 if {$browser eq {}} {
5107 if {[is_MacOSX]} {
5108 set browser open
5109 } elseif {[is_Cygwin]} {
5110 set program_files [file dirname [exec cygpath --windir]]
5111 set program_files [file join $program_files {Program Files}]
5112 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5113 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5114 if {[file exists $firefox]} {
5115 set browser $firefox
5116 } elseif {[file exists $ie]} {
5117 set browser $ie
5119 unset program_files firefox ie
5123 if {[file isfile $doc_path]} {
5124 set doc_url "file:$doc_path"
5125 } else {
5126 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5129 if {$browser ne {}} {
5130 .mbar.help add command -label {Online Documentation} \
5131 -command [list exec $browser $doc_url &] \
5132 -font font_ui
5134 unset browser doc_path doc_url
5136 # -- Branch Control
5138 frame .branch \
5139 -borderwidth 1 \
5140 -relief sunken
5141 label .branch.l1 \
5142 -text {Current Branch:} \
5143 -anchor w \
5144 -justify left \
5145 -font font_ui
5146 label .branch.cb \
5147 -textvariable current_branch \
5148 -anchor w \
5149 -justify left \
5150 -font font_ui
5151 pack .branch.l1 -side left
5152 pack .branch.cb -side left -fill x
5153 pack .branch -side top -fill x
5155 if {!$single_commit} {
5156 menu .mbar.merge
5157 .mbar.merge add command -label {Local Merge...} \
5158 -command do_local_merge \
5159 -font font_ui
5160 lappend disable_on_lock \
5161 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5162 .mbar.merge add command -label {Abort Merge...} \
5163 -command do_reset_hard \
5164 -font font_ui
5165 lappend disable_on_lock \
5166 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5169 menu .mbar.fetch
5171 menu .mbar.push
5172 .mbar.push add command -label {Push...} \
5173 -command do_push_anywhere \
5174 -font font_ui
5177 # -- Main Window Layout
5179 panedwindow .vpane -orient vertical
5180 panedwindow .vpane.files -orient horizontal
5181 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5182 pack .vpane -anchor n -side top -fill both -expand 1
5184 # -- Index File List
5186 frame .vpane.files.index -height 100 -width 200
5187 label .vpane.files.index.title -text {Changes To Be Committed} \
5188 -background green \
5189 -font font_ui
5190 text $ui_index -background white -borderwidth 0 \
5191 -width 20 -height 10 \
5192 -wrap none \
5193 -font font_ui \
5194 -cursor $cursor_ptr \
5195 -xscrollcommand {.vpane.files.index.sx set} \
5196 -yscrollcommand {.vpane.files.index.sy set} \
5197 -state disabled
5198 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5199 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5200 pack .vpane.files.index.title -side top -fill x
5201 pack .vpane.files.index.sx -side bottom -fill x
5202 pack .vpane.files.index.sy -side right -fill y
5203 pack $ui_index -side left -fill both -expand 1
5204 .vpane.files add .vpane.files.index -sticky nsew
5206 # -- Working Directory File List
5208 frame .vpane.files.workdir -height 100 -width 200
5209 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5210 -background red \
5211 -font font_ui
5212 text $ui_workdir -background white -borderwidth 0 \
5213 -width 20 -height 10 \
5214 -wrap none \
5215 -font font_ui \
5216 -cursor $cursor_ptr \
5217 -xscrollcommand {.vpane.files.workdir.sx set} \
5218 -yscrollcommand {.vpane.files.workdir.sy set} \
5219 -state disabled
5220 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5221 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5222 pack .vpane.files.workdir.title -side top -fill x
5223 pack .vpane.files.workdir.sx -side bottom -fill x
5224 pack .vpane.files.workdir.sy -side right -fill y
5225 pack $ui_workdir -side left -fill both -expand 1
5226 .vpane.files add .vpane.files.workdir -sticky nsew
5228 foreach i [list $ui_index $ui_workdir] {
5229 $i tag conf in_diff -font font_uibold
5230 $i tag conf in_sel \
5231 -background [$i cget -foreground] \
5232 -foreground [$i cget -background]
5234 unset i
5236 # -- Diff and Commit Area
5238 frame .vpane.lower -height 300 -width 400
5239 frame .vpane.lower.commarea
5240 frame .vpane.lower.diff -relief sunken -borderwidth 1
5241 pack .vpane.lower.commarea -side top -fill x
5242 pack .vpane.lower.diff -side bottom -fill both -expand 1
5243 .vpane add .vpane.lower -sticky nsew
5245 # -- Commit Area Buttons
5247 frame .vpane.lower.commarea.buttons
5248 label .vpane.lower.commarea.buttons.l -text {} \
5249 -anchor w \
5250 -justify left \
5251 -font font_ui
5252 pack .vpane.lower.commarea.buttons.l -side top -fill x
5253 pack .vpane.lower.commarea.buttons -side left -fill y
5255 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5256 -command do_rescan \
5257 -font font_ui
5258 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5259 lappend disable_on_lock \
5260 {.vpane.lower.commarea.buttons.rescan conf -state}
5262 button .vpane.lower.commarea.buttons.incall -text {Add All} \
5263 -command do_add_all \
5264 -font font_ui
5265 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5266 lappend disable_on_lock \
5267 {.vpane.lower.commarea.buttons.incall conf -state}
5269 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5270 -command do_signoff \
5271 -font font_ui
5272 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5274 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5275 -command do_commit \
5276 -font font_ui
5277 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5278 lappend disable_on_lock \
5279 {.vpane.lower.commarea.buttons.commit conf -state}
5281 # -- Commit Message Buffer
5283 frame .vpane.lower.commarea.buffer
5284 frame .vpane.lower.commarea.buffer.header
5285 set ui_comm .vpane.lower.commarea.buffer.t
5286 set ui_coml .vpane.lower.commarea.buffer.header.l
5287 radiobutton .vpane.lower.commarea.buffer.header.new \
5288 -text {New Commit} \
5289 -command do_select_commit_type \
5290 -variable selected_commit_type \
5291 -value new \
5292 -font font_ui
5293 lappend disable_on_lock \
5294 [list .vpane.lower.commarea.buffer.header.new conf -state]
5295 radiobutton .vpane.lower.commarea.buffer.header.amend \
5296 -text {Amend Last Commit} \
5297 -command do_select_commit_type \
5298 -variable selected_commit_type \
5299 -value amend \
5300 -font font_ui
5301 lappend disable_on_lock \
5302 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5303 label $ui_coml \
5304 -anchor w \
5305 -justify left \
5306 -font font_ui
5307 proc trace_commit_type {varname args} {
5308 global ui_coml commit_type
5309 switch -glob -- $commit_type {
5310 initial {set txt {Initial Commit Message:}}
5311 amend {set txt {Amended Commit Message:}}
5312 amend-initial {set txt {Amended Initial Commit Message:}}
5313 amend-merge {set txt {Amended Merge Commit Message:}}
5314 merge {set txt {Merge Commit Message:}}
5315 * {set txt {Commit Message:}}
5317 $ui_coml conf -text $txt
5319 trace add variable commit_type write trace_commit_type
5320 pack $ui_coml -side left -fill x
5321 pack .vpane.lower.commarea.buffer.header.amend -side right
5322 pack .vpane.lower.commarea.buffer.header.new -side right
5324 text $ui_comm -background white -borderwidth 1 \
5325 -undo true \
5326 -maxundo 20 \
5327 -autoseparators true \
5328 -relief sunken \
5329 -width 75 -height 9 -wrap none \
5330 -font font_diff \
5331 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5332 scrollbar .vpane.lower.commarea.buffer.sby \
5333 -command [list $ui_comm yview]
5334 pack .vpane.lower.commarea.buffer.header -side top -fill x
5335 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5336 pack $ui_comm -side left -fill y
5337 pack .vpane.lower.commarea.buffer -side left -fill y
5339 # -- Commit Message Buffer Context Menu
5341 set ctxm .vpane.lower.commarea.buffer.ctxm
5342 menu $ctxm -tearoff 0
5343 $ctxm add command \
5344 -label {Cut} \
5345 -font font_ui \
5346 -command {tk_textCut $ui_comm}
5347 $ctxm add command \
5348 -label {Copy} \
5349 -font font_ui \
5350 -command {tk_textCopy $ui_comm}
5351 $ctxm add command \
5352 -label {Paste} \
5353 -font font_ui \
5354 -command {tk_textPaste $ui_comm}
5355 $ctxm add command \
5356 -label {Delete} \
5357 -font font_ui \
5358 -command {$ui_comm delete sel.first sel.last}
5359 $ctxm add separator
5360 $ctxm add command \
5361 -label {Select All} \
5362 -font font_ui \
5363 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5364 $ctxm add command \
5365 -label {Copy All} \
5366 -font font_ui \
5367 -command {
5368 $ui_comm tag add sel 0.0 end
5369 tk_textCopy $ui_comm
5370 $ui_comm tag remove sel 0.0 end
5372 $ctxm add separator
5373 $ctxm add command \
5374 -label {Sign Off} \
5375 -font font_ui \
5376 -command do_signoff
5377 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5379 # -- Diff Header
5381 set current_diff_path {}
5382 set current_diff_side {}
5383 set diff_actions [list]
5384 proc trace_current_diff_path {varname args} {
5385 global current_diff_path diff_actions file_states
5386 if {$current_diff_path eq {}} {
5387 set s {}
5388 set f {}
5389 set p {}
5390 set o disabled
5391 } else {
5392 set p $current_diff_path
5393 set s [mapdesc [lindex $file_states($p) 0] $p]
5394 set f {File:}
5395 set p [escape_path $p]
5396 set o normal
5399 .vpane.lower.diff.header.status configure -text $s
5400 .vpane.lower.diff.header.file configure -text $f
5401 .vpane.lower.diff.header.path configure -text $p
5402 foreach w $diff_actions {
5403 uplevel #0 $w $o
5406 trace add variable current_diff_path write trace_current_diff_path
5408 frame .vpane.lower.diff.header -background orange
5409 label .vpane.lower.diff.header.status \
5410 -background orange \
5411 -width $max_status_desc \
5412 -anchor w \
5413 -justify left \
5414 -font font_ui
5415 label .vpane.lower.diff.header.file \
5416 -background orange \
5417 -anchor w \
5418 -justify left \
5419 -font font_ui
5420 label .vpane.lower.diff.header.path \
5421 -background orange \
5422 -anchor w \
5423 -justify left \
5424 -font font_ui
5425 pack .vpane.lower.diff.header.status -side left
5426 pack .vpane.lower.diff.header.file -side left
5427 pack .vpane.lower.diff.header.path -fill x
5428 set ctxm .vpane.lower.diff.header.ctxm
5429 menu $ctxm -tearoff 0
5430 $ctxm add command \
5431 -label {Copy} \
5432 -font font_ui \
5433 -command {
5434 clipboard clear
5435 clipboard append \
5436 -format STRING \
5437 -type STRING \
5438 -- $current_diff_path
5440 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5441 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5443 # -- Diff Body
5445 frame .vpane.lower.diff.body
5446 set ui_diff .vpane.lower.diff.body.t
5447 text $ui_diff -background white -borderwidth 0 \
5448 -width 80 -height 15 -wrap none \
5449 -font font_diff \
5450 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5451 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5452 -state disabled
5453 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5454 -command [list $ui_diff xview]
5455 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5456 -command [list $ui_diff yview]
5457 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5458 pack .vpane.lower.diff.body.sby -side right -fill y
5459 pack $ui_diff -side left -fill both -expand 1
5460 pack .vpane.lower.diff.header -side top -fill x
5461 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5463 $ui_diff tag conf d_cr -elide true
5464 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5465 $ui_diff tag conf d_+ -foreground {#00a000}
5466 $ui_diff tag conf d_- -foreground red
5468 $ui_diff tag conf d_++ -foreground {#00a000}
5469 $ui_diff tag conf d_-- -foreground red
5470 $ui_diff tag conf d_+s \
5471 -foreground {#00a000} \
5472 -background {#e2effa}
5473 $ui_diff tag conf d_-s \
5474 -foreground red \
5475 -background {#e2effa}
5476 $ui_diff tag conf d_s+ \
5477 -foreground {#00a000} \
5478 -background ivory1
5479 $ui_diff tag conf d_s- \
5480 -foreground red \
5481 -background ivory1
5483 $ui_diff tag conf d<<<<<<< \
5484 -foreground orange \
5485 -font font_diffbold
5486 $ui_diff tag conf d======= \
5487 -foreground orange \
5488 -font font_diffbold
5489 $ui_diff tag conf d>>>>>>> \
5490 -foreground orange \
5491 -font font_diffbold
5493 $ui_diff tag raise sel
5495 # -- Diff Body Context Menu
5497 set ctxm .vpane.lower.diff.body.ctxm
5498 menu $ctxm -tearoff 0
5499 $ctxm add command \
5500 -label {Refresh} \
5501 -font font_ui \
5502 -command reshow_diff
5503 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5504 $ctxm add command \
5505 -label {Copy} \
5506 -font font_ui \
5507 -command {tk_textCopy $ui_diff}
5508 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5509 $ctxm add command \
5510 -label {Select All} \
5511 -font font_ui \
5512 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5513 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5514 $ctxm add command \
5515 -label {Copy All} \
5516 -font font_ui \
5517 -command {
5518 $ui_diff tag add sel 0.0 end
5519 tk_textCopy $ui_diff
5520 $ui_diff tag remove sel 0.0 end
5522 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5523 $ctxm add separator
5524 $ctxm add command \
5525 -label {Apply/Reverse Hunk} \
5526 -font font_ui \
5527 -command {apply_hunk $cursorX $cursorY}
5528 set ui_diff_applyhunk [$ctxm index last]
5529 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5530 $ctxm add separator
5531 $ctxm add command \
5532 -label {Decrease Font Size} \
5533 -font font_ui \
5534 -command {incr_font_size font_diff -1}
5535 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5536 $ctxm add command \
5537 -label {Increase Font Size} \
5538 -font font_ui \
5539 -command {incr_font_size font_diff 1}
5540 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5541 $ctxm add separator
5542 $ctxm add command \
5543 -label {Show Less Context} \
5544 -font font_ui \
5545 -command {if {$repo_config(gui.diffcontext) >= 2} {
5546 incr repo_config(gui.diffcontext) -1
5547 reshow_diff
5549 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5550 $ctxm add command \
5551 -label {Show More Context} \
5552 -font font_ui \
5553 -command {
5554 incr repo_config(gui.diffcontext)
5555 reshow_diff
5557 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5558 $ctxm add separator
5559 $ctxm add command -label {Options...} \
5560 -font font_ui \
5561 -command do_options
5562 bind_button3 $ui_diff "
5563 set cursorX %x
5564 set cursorY %y
5565 if {\$ui_index eq \$current_diff_side} {
5566 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5567 } else {
5568 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5570 tk_popup $ctxm %X %Y
5572 unset ui_diff_applyhunk
5574 # -- Status Bar
5576 set ui_status_value {Initializing...}
5577 label .status -textvariable ui_status_value \
5578 -anchor w \
5579 -justify left \
5580 -borderwidth 1 \
5581 -relief sunken \
5582 -font font_ui
5583 pack .status -anchor w -side bottom -fill x
5585 # -- Load geometry
5587 catch {
5588 set gm $repo_config(gui.geometry)
5589 wm geometry . [lindex $gm 0]
5590 .vpane sash place 0 \
5591 [lindex [.vpane sash coord 0] 0] \
5592 [lindex $gm 1]
5593 .vpane.files sash place 0 \
5594 [lindex $gm 2] \
5595 [lindex [.vpane.files sash coord 0] 1]
5596 unset gm
5599 # -- Key Bindings
5601 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5602 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5603 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5604 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5605 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5606 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5607 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5608 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5609 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5610 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5611 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5613 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5614 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5615 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5616 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5617 bind $ui_diff <$M1B-Key-v> {break}
5618 bind $ui_diff <$M1B-Key-V> {break}
5619 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5620 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5621 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5622 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5623 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5624 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5625 bind $ui_diff <Button-1> {focus %W}
5627 if {!$single_commit} {
5628 bind . <$M1B-Key-n> do_create_branch
5629 bind . <$M1B-Key-N> do_create_branch
5632 bind . <Destroy> do_quit
5633 bind all <Key-F5> do_rescan
5634 bind all <$M1B-Key-r> do_rescan
5635 bind all <$M1B-Key-R> do_rescan
5636 bind . <$M1B-Key-s> do_signoff
5637 bind . <$M1B-Key-S> do_signoff
5638 bind . <$M1B-Key-i> do_add_all
5639 bind . <$M1B-Key-I> do_add_all
5640 bind . <$M1B-Key-Return> do_commit
5641 bind all <$M1B-Key-q> do_quit
5642 bind all <$M1B-Key-Q> do_quit
5643 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5644 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5645 foreach i [list $ui_index $ui_workdir] {
5646 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
5647 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5648 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5650 unset i
5652 set file_lists($ui_index) [list]
5653 set file_lists($ui_workdir) [list]
5655 set HEAD {}
5656 set PARENT {}
5657 set MERGE_HEAD [list]
5658 set commit_type {}
5659 set empty_tree {}
5660 set current_branch {}
5661 set current_diff_path {}
5662 set selected_commit_type new
5664 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5665 focus -force $ui_comm
5667 # -- Warn the user about environmental problems. Cygwin's Tcl
5668 # does *not* pass its env array onto any processes it spawns.
5669 # This means that git processes get none of our environment.
5671 if {[is_Cygwin]} {
5672 set ignored_env 0
5673 set suggest_user {}
5674 set msg "Possible environment issues exist.
5676 The following environment variables are probably
5677 going to be ignored by any Git subprocess run
5678 by [appname]:
5681 foreach name [array names env] {
5682 switch -regexp -- $name {
5683 {^GIT_INDEX_FILE$} -
5684 {^GIT_OBJECT_DIRECTORY$} -
5685 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5686 {^GIT_DIFF_OPTS$} -
5687 {^GIT_EXTERNAL_DIFF$} -
5688 {^GIT_PAGER$} -
5689 {^GIT_TRACE$} -
5690 {^GIT_CONFIG$} -
5691 {^GIT_CONFIG_LOCAL$} -
5692 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5693 append msg " - $name\n"
5694 incr ignored_env
5696 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5697 append msg " - $name\n"
5698 incr ignored_env
5699 set suggest_user $name
5703 if {$ignored_env > 0} {
5704 append msg "
5705 This is due to a known issue with the
5706 Tcl binary distributed by Cygwin."
5708 if {$suggest_user ne {}} {
5709 append msg "
5711 A good replacement for $suggest_user
5712 is placing values for the user.name and
5713 user.email settings into your personal
5714 ~/.gitconfig file.
5717 warn_popup $msg
5719 unset ignored_env msg suggest_user name
5722 # -- Only initialize complex UI if we are going to stay running.
5724 if {!$single_commit} {
5725 load_all_remotes
5726 load_all_heads
5728 populate_branch_menu
5729 populate_fetch_menu
5730 populate_push_menu
5733 # -- Only suggest a gc run if we are going to stay running.
5735 if {!$single_commit} {
5736 set object_limit 2000
5737 if {[is_Windows]} {set object_limit 200}
5738 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5739 if {$objects_current >= $object_limit} {
5740 if {[ask_popup \
5741 "This repository currently has $objects_current loose objects.
5743 To maintain optimal performance it is strongly
5744 recommended that you compress the database
5745 when more than $object_limit loose objects exist.
5747 Compress the database now?"] eq yes} {
5748 do_gc
5751 unset object_limit _junk objects_current
5754 lock_index begin-read
5755 after 1 do_rescan