git-gui: Don't create empty (same tree as parent) commits.
[git/gitweb.git] / git-gui.sh
blob743099c57301bc4af103162e0279559a6e211638
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 set appvers {@@GITGUI_VERSION@@}
6 set copyright {
7 Copyright © 2006, 2007 Shawn Pearce, et. al.
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}
22 set gitgui_credits {
23 Paul Mackerras
26 ######################################################################
28 ## read only globals
30 set _appname [lindex [file split $argv0] end]
31 set _gitdir {}
32 set _gitexec {}
33 set _reponame {}
34 set _iscygwin {}
36 proc appname {} {
37 global _appname
38 return $_appname
41 proc gitdir {args} {
42 global _gitdir
43 if {$args eq {}} {
44 return $_gitdir
46 return [eval [concat [list file join $_gitdir] $args]]
49 proc gitexec {args} {
50 global _gitexec
51 if {$_gitexec eq {}} {
52 if {[catch {set _gitexec [git --exec-path]} err]} {
53 error "Git not installed?\n\n$err"
56 if {$args eq {}} {
57 return $_gitexec
59 return [eval [concat [list file join $_gitexec] $args]]
62 proc reponame {} {
63 global _reponame
64 return $_reponame
67 proc is_MacOSX {} {
68 global tcl_platform tk_library
69 if {[tk windowingsystem] eq {aqua}} {
70 return 1
72 return 0
75 proc is_Windows {} {
76 global tcl_platform
77 if {$tcl_platform(platform) eq {windows}} {
78 return 1
80 return 0
83 proc is_Cygwin {} {
84 global tcl_platform _iscygwin
85 if {$_iscygwin eq {}} {
86 if {$tcl_platform(platform) eq {windows}} {
87 if {[catch {set p [exec cygpath --windir]} err]} {
88 set _iscygwin 0
89 } else {
90 set _iscygwin 1
92 } else {
93 set _iscygwin 0
96 return $_iscygwin
99 proc is_enabled {option} {
100 global enabled_options
101 if {[catch {set on $enabled_options($option)}]} {return 0}
102 return $on
105 proc enable_option {option} {
106 global enabled_options
107 set enabled_options($option) 1
110 proc disable_option {option} {
111 global enabled_options
112 set enabled_options($option) 0
115 ######################################################################
117 ## config
119 proc is_many_config {name} {
120 switch -glob -- $name {
121 remote.*.fetch -
122 remote.*.push
123 {return 1}
125 {return 0}
129 proc is_config_true {name} {
130 global repo_config
131 if {[catch {set v $repo_config($name)}]} {
132 return 0
133 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
134 return 1
135 } else {
136 return 0
140 proc load_config {include_global} {
141 global repo_config global_config default_config
143 array unset global_config
144 if {$include_global} {
145 catch {
146 set fd_rc [open "| git config --global --list" r]
147 while {[gets $fd_rc line] >= 0} {
148 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
149 if {[is_many_config $name]} {
150 lappend global_config($name) $value
151 } else {
152 set global_config($name) $value
156 close $fd_rc
160 array unset repo_config
161 catch {
162 set fd_rc [open "| git config --list" r]
163 while {[gets $fd_rc line] >= 0} {
164 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
165 if {[is_many_config $name]} {
166 lappend repo_config($name) $value
167 } else {
168 set repo_config($name) $value
172 close $fd_rc
175 foreach name [array names default_config] {
176 if {[catch {set v $global_config($name)}]} {
177 set global_config($name) $default_config($name)
179 if {[catch {set v $repo_config($name)}]} {
180 set repo_config($name) $default_config($name)
185 proc save_config {} {
186 global default_config font_descs
187 global repo_config global_config
188 global repo_config_new global_config_new
190 foreach option $font_descs {
191 set name [lindex $option 0]
192 set font [lindex $option 1]
193 font configure $font \
194 -family $global_config_new(gui.$font^^family) \
195 -size $global_config_new(gui.$font^^size)
196 font configure ${font}bold \
197 -family $global_config_new(gui.$font^^family) \
198 -size $global_config_new(gui.$font^^size)
199 set global_config_new(gui.$name) [font configure $font]
200 unset global_config_new(gui.$font^^family)
201 unset global_config_new(gui.$font^^size)
204 foreach name [array names default_config] {
205 set value $global_config_new($name)
206 if {$value ne $global_config($name)} {
207 if {$value eq $default_config($name)} {
208 catch {git config --global --unset $name}
209 } else {
210 regsub -all "\[{}\]" $value {"} value
211 git config --global $name $value
213 set global_config($name) $value
214 if {$value eq $repo_config($name)} {
215 catch {git config --unset $name}
216 set repo_config($name) $value
221 foreach name [array names default_config] {
222 set value $repo_config_new($name)
223 if {$value ne $repo_config($name)} {
224 if {$value eq $global_config($name)} {
225 catch {git config --unset $name}
226 } else {
227 regsub -all "\[{}\]" $value {"} value
228 git config $name $value
230 set repo_config($name) $value
235 ######################################################################
237 ## handy utils
239 proc git {args} {
240 return [eval exec git $args]
243 proc error_popup {msg} {
244 set title [appname]
245 if {[reponame] ne {}} {
246 append title " ([reponame])"
248 set cmd [list tk_messageBox \
249 -icon error \
250 -type ok \
251 -title "$title: error" \
252 -message $msg]
253 if {[winfo ismapped .]} {
254 lappend cmd -parent .
256 eval $cmd
259 proc warn_popup {msg} {
260 set title [appname]
261 if {[reponame] ne {}} {
262 append title " ([reponame])"
264 set cmd [list tk_messageBox \
265 -icon warning \
266 -type ok \
267 -title "$title: warning" \
268 -message $msg]
269 if {[winfo ismapped .]} {
270 lappend cmd -parent .
272 eval $cmd
275 proc info_popup {msg {parent .}} {
276 set title [appname]
277 if {[reponame] ne {}} {
278 append title " ([reponame])"
280 tk_messageBox \
281 -parent $parent \
282 -icon info \
283 -type ok \
284 -title $title \
285 -message $msg
288 proc ask_popup {msg} {
289 set title [appname]
290 if {[reponame] ne {}} {
291 append title " ([reponame])"
293 return [tk_messageBox \
294 -parent . \
295 -icon question \
296 -type yesno \
297 -title $title \
298 -message $msg]
301 ######################################################################
303 ## version check
305 set req_maj 1
306 set req_min 5
308 if {[catch {set v [git --version]} err]} {
309 catch {wm withdraw .}
310 error_popup "Cannot determine Git version:
312 $err
314 [appname] requires Git $req_maj.$req_min or later."
315 exit 1
317 if {[regexp {^git version (\d+)\.(\d+)} $v _junk act_maj act_min]} {
318 if {$act_maj < $req_maj
319 || ($act_maj == $req_maj && $act_min < $req_min)} {
320 catch {wm withdraw .}
321 error_popup "[appname] requires Git $req_maj.$req_min or later.
323 You are using $v."
324 exit 1
326 } else {
327 catch {wm withdraw .}
328 error_popup "Cannot parse Git version string:\n\n$v"
329 exit 1
331 unset -nocomplain v _junk act_maj act_min req_maj req_min
333 ######################################################################
335 ## repository setup
337 if { [catch {set _gitdir $env(GIT_DIR)}]
338 && [catch {set _gitdir [git rev-parse --git-dir]} err]} {
339 catch {wm withdraw .}
340 error_popup "Cannot find the git directory:\n\n$err"
341 exit 1
343 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
344 catch {set _gitdir [exec cygpath --unix $_gitdir]}
346 if {![file isdirectory $_gitdir]} {
347 catch {wm withdraw .}
348 error_popup "Git directory not found:\n\n$_gitdir"
349 exit 1
351 if {[lindex [file split $_gitdir] end] ne {.git}} {
352 catch {wm withdraw .}
353 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
354 exit 1
356 if {[catch {cd [file dirname $_gitdir]} err]} {
357 catch {wm withdraw .}
358 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
359 exit 1
361 set _reponame [lindex [file split \
362 [file normalize [file dirname $_gitdir]]] \
363 end]
365 ######################################################################
367 ## global init
369 set current_diff_path {}
370 set current_diff_side {}
371 set diff_actions [list]
372 set ui_status_value {Initializing...}
374 set HEAD {}
375 set PARENT {}
376 set MERGE_HEAD [list]
377 set commit_type {}
378 set empty_tree {}
379 set current_branch {}
380 set current_diff_path {}
381 set selected_commit_type new
383 ######################################################################
385 ## task management
387 set rescan_active 0
388 set diff_active 0
389 set last_clicked {}
391 set disable_on_lock [list]
392 set index_lock_type none
394 proc lock_index {type} {
395 global index_lock_type disable_on_lock
397 if {$index_lock_type eq {none}} {
398 set index_lock_type $type
399 foreach w $disable_on_lock {
400 uplevel #0 $w disabled
402 return 1
403 } elseif {$index_lock_type eq "begin-$type"} {
404 set index_lock_type $type
405 return 1
407 return 0
410 proc unlock_index {} {
411 global index_lock_type disable_on_lock
413 set index_lock_type none
414 foreach w $disable_on_lock {
415 uplevel #0 $w normal
419 ######################################################################
421 ## status
423 proc repository_state {ctvar hdvar mhvar} {
424 global current_branch
425 upvar $ctvar ct $hdvar hd $mhvar mh
427 set mh [list]
429 if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
430 set current_branch {}
431 } else {
432 regsub ^refs/((heads|tags|remotes)/)? \
433 $current_branch \
434 {} \
435 current_branch
438 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
439 set hd {}
440 set ct initial
441 return
444 set merge_head [gitdir MERGE_HEAD]
445 if {[file exists $merge_head]} {
446 set ct merge
447 set fd_mh [open $merge_head r]
448 while {[gets $fd_mh line] >= 0} {
449 lappend mh $line
451 close $fd_mh
452 return
455 set ct normal
458 proc PARENT {} {
459 global PARENT empty_tree
461 set p [lindex $PARENT 0]
462 if {$p ne {}} {
463 return $p
465 if {$empty_tree eq {}} {
466 set empty_tree [git mktree << {}]
468 return $empty_tree
471 proc rescan {after {honor_trustmtime 1}} {
472 global HEAD PARENT MERGE_HEAD commit_type
473 global ui_index ui_workdir ui_status_value ui_comm
474 global rescan_active file_states
475 global repo_config
477 if {$rescan_active > 0 || ![lock_index read]} return
479 repository_state newType newHEAD newMERGE_HEAD
480 if {[string match amend* $commit_type]
481 && $newType eq {normal}
482 && $newHEAD eq $HEAD} {
483 } else {
484 set HEAD $newHEAD
485 set PARENT $newHEAD
486 set MERGE_HEAD $newMERGE_HEAD
487 set commit_type $newType
490 array unset file_states
492 if {![$ui_comm edit modified]
493 || [string trim [$ui_comm get 0.0 end]] eq {}} {
494 if {[load_message GITGUI_MSG]} {
495 } elseif {[load_message MERGE_MSG]} {
496 } elseif {[load_message SQUASH_MSG]} {
498 $ui_comm edit reset
499 $ui_comm edit modified false
502 if {[is_enabled branch]} {
503 load_all_heads
504 populate_branch_menu
507 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
508 rescan_stage2 {} $after
509 } else {
510 set rescan_active 1
511 set ui_status_value {Refreshing file status...}
512 set cmd [list git update-index]
513 lappend cmd -q
514 lappend cmd --unmerged
515 lappend cmd --ignore-missing
516 lappend cmd --refresh
517 set fd_rf [open "| $cmd" r]
518 fconfigure $fd_rf -blocking 0 -translation binary
519 fileevent $fd_rf readable \
520 [list rescan_stage2 $fd_rf $after]
524 proc rescan_stage2 {fd after} {
525 global ui_status_value
526 global rescan_active buf_rdi buf_rdf buf_rlo
528 if {$fd ne {}} {
529 read $fd
530 if {![eof $fd]} return
531 close $fd
534 set ls_others [list | git ls-files --others -z \
535 --exclude-per-directory=.gitignore]
536 set info_exclude [gitdir info exclude]
537 if {[file readable $info_exclude]} {
538 lappend ls_others "--exclude-from=$info_exclude"
541 set buf_rdi {}
542 set buf_rdf {}
543 set buf_rlo {}
545 set rescan_active 3
546 set ui_status_value {Scanning for modified files ...}
547 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
548 set fd_df [open "| git diff-files -z" r]
549 set fd_lo [open $ls_others r]
551 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
552 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
553 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
554 fileevent $fd_di readable [list read_diff_index $fd_di $after]
555 fileevent $fd_df readable [list read_diff_files $fd_df $after]
556 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
559 proc load_message {file} {
560 global ui_comm
562 set f [gitdir $file]
563 if {[file isfile $f]} {
564 if {[catch {set fd [open $f r]}]} {
565 return 0
567 set content [string trim [read $fd]]
568 close $fd
569 regsub -all -line {[ \r\t]+$} $content {} content
570 $ui_comm delete 0.0 end
571 $ui_comm insert end $content
572 return 1
574 return 0
577 proc read_diff_index {fd after} {
578 global buf_rdi
580 append buf_rdi [read $fd]
581 set c 0
582 set n [string length $buf_rdi]
583 while {$c < $n} {
584 set z1 [string first "\0" $buf_rdi $c]
585 if {$z1 == -1} break
586 incr z1
587 set z2 [string first "\0" $buf_rdi $z1]
588 if {$z2 == -1} break
590 incr c
591 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
592 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
593 merge_state \
594 [encoding convertfrom $p] \
595 [lindex $i 4]? \
596 [list [lindex $i 0] [lindex $i 2]] \
597 [list]
598 set c $z2
599 incr c
601 if {$c < $n} {
602 set buf_rdi [string range $buf_rdi $c end]
603 } else {
604 set buf_rdi {}
607 rescan_done $fd buf_rdi $after
610 proc read_diff_files {fd after} {
611 global buf_rdf
613 append buf_rdf [read $fd]
614 set c 0
615 set n [string length $buf_rdf]
616 while {$c < $n} {
617 set z1 [string first "\0" $buf_rdf $c]
618 if {$z1 == -1} break
619 incr z1
620 set z2 [string first "\0" $buf_rdf $z1]
621 if {$z2 == -1} break
623 incr c
624 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
625 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
626 merge_state \
627 [encoding convertfrom $p] \
628 ?[lindex $i 4] \
629 [list] \
630 [list [lindex $i 0] [lindex $i 2]]
631 set c $z2
632 incr c
634 if {$c < $n} {
635 set buf_rdf [string range $buf_rdf $c end]
636 } else {
637 set buf_rdf {}
640 rescan_done $fd buf_rdf $after
643 proc read_ls_others {fd after} {
644 global buf_rlo
646 append buf_rlo [read $fd]
647 set pck [split $buf_rlo "\0"]
648 set buf_rlo [lindex $pck end]
649 foreach p [lrange $pck 0 end-1] {
650 merge_state [encoding convertfrom $p] ?O
652 rescan_done $fd buf_rlo $after
655 proc rescan_done {fd buf after} {
656 global rescan_active
657 global file_states repo_config
658 upvar $buf to_clear
660 if {![eof $fd]} return
661 set to_clear {}
662 close $fd
663 if {[incr rescan_active -1] > 0} return
665 prune_selection
666 unlock_index
667 display_all_files
668 reshow_diff
669 uplevel #0 $after
672 proc prune_selection {} {
673 global file_states selected_paths
675 foreach path [array names selected_paths] {
676 if {[catch {set still_here $file_states($path)}]} {
677 unset selected_paths($path)
682 ######################################################################
684 ## diff
686 proc clear_diff {} {
687 global ui_diff current_diff_path current_diff_header
688 global ui_index ui_workdir
690 $ui_diff conf -state normal
691 $ui_diff delete 0.0 end
692 $ui_diff conf -state disabled
694 set current_diff_path {}
695 set current_diff_header {}
697 $ui_index tag remove in_diff 0.0 end
698 $ui_workdir tag remove in_diff 0.0 end
701 proc reshow_diff {} {
702 global ui_status_value file_states file_lists
703 global current_diff_path current_diff_side
705 set p $current_diff_path
706 if {$p eq {}} {
707 # No diff is being shown.
708 } elseif {$current_diff_side eq {}
709 || [catch {set s $file_states($p)}]
710 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
711 clear_diff
712 } else {
713 show_diff $p $current_diff_side
717 proc handle_empty_diff {} {
718 global current_diff_path file_states file_lists
720 set path $current_diff_path
721 set s $file_states($path)
722 if {[lindex $s 0] ne {_M}} return
724 info_popup "No differences detected.
726 [short_path $path] has no changes.
728 The modification date of this file was updated
729 by another application, but the content within
730 the file was not changed.
732 A rescan will be automatically started to find
733 other files which may have the same state."
735 clear_diff
736 display_file $path __
737 rescan {set ui_status_value {Ready.}} 0
740 proc show_diff {path w {lno {}}} {
741 global file_states file_lists
742 global is_3way_diff diff_active repo_config
743 global ui_diff ui_status_value ui_index ui_workdir
744 global current_diff_path current_diff_side current_diff_header
746 if {$diff_active || ![lock_index read]} return
748 clear_diff
749 if {$lno == {}} {
750 set lno [lsearch -sorted -exact $file_lists($w) $path]
751 if {$lno >= 0} {
752 incr lno
755 if {$lno >= 1} {
756 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
759 set s $file_states($path)
760 set m [lindex $s 0]
761 set is_3way_diff 0
762 set diff_active 1
763 set current_diff_path $path
764 set current_diff_side $w
765 set current_diff_header {}
766 set ui_status_value "Loading diff of [escape_path $path]..."
768 # - Git won't give us the diff, there's nothing to compare to!
770 if {$m eq {_O}} {
771 set max_sz [expr {128 * 1024}]
772 if {[catch {
773 set fd [open $path r]
774 set content [read $fd $max_sz]
775 close $fd
776 set sz [file size $path]
777 } err ]} {
778 set diff_active 0
779 unlock_index
780 set ui_status_value "Unable to display [escape_path $path]"
781 error_popup "Error loading file:\n\n$err"
782 return
784 $ui_diff conf -state normal
785 if {![catch {set type [exec file $path]}]} {
786 set n [string length $path]
787 if {[string equal -length $n $path $type]} {
788 set type [string range $type $n end]
789 regsub {^:?\s*} $type {} type
791 $ui_diff insert end "* $type\n" d_@
793 if {[string first "\0" $content] != -1} {
794 $ui_diff insert end \
795 "* Binary file (not showing content)." \
797 } else {
798 if {$sz > $max_sz} {
799 $ui_diff insert end \
800 "* Untracked file is $sz bytes.
801 * Showing only first $max_sz bytes.
802 " d_@
804 $ui_diff insert end $content
805 if {$sz > $max_sz} {
806 $ui_diff insert end "
807 * Untracked file clipped here by [appname].
808 * To see the entire file, use an external editor.
809 " d_@
812 $ui_diff conf -state disabled
813 set diff_active 0
814 unlock_index
815 set ui_status_value {Ready.}
816 return
819 set cmd [list | git]
820 if {$w eq $ui_index} {
821 lappend cmd diff-index
822 lappend cmd --cached
823 } elseif {$w eq $ui_workdir} {
824 if {[string index $m 0] eq {U}} {
825 lappend cmd diff
826 } else {
827 lappend cmd diff-files
831 lappend cmd -p
832 lappend cmd --no-color
833 if {$repo_config(gui.diffcontext) > 0} {
834 lappend cmd "-U$repo_config(gui.diffcontext)"
836 if {$w eq $ui_index} {
837 lappend cmd [PARENT]
839 lappend cmd --
840 lappend cmd $path
842 if {[catch {set fd [open $cmd r]} err]} {
843 set diff_active 0
844 unlock_index
845 set ui_status_value "Unable to display [escape_path $path]"
846 error_popup "Error loading diff:\n\n$err"
847 return
850 fconfigure $fd \
851 -blocking 0 \
852 -encoding binary \
853 -translation binary
854 fileevent $fd readable [list read_diff $fd]
857 proc read_diff {fd} {
858 global ui_diff ui_status_value diff_active
859 global is_3way_diff current_diff_header
861 $ui_diff conf -state normal
862 while {[gets $fd line] >= 0} {
863 # -- Cleanup uninteresting diff header lines.
865 if { [string match {diff --git *} $line]
866 || [string match {diff --cc *} $line]
867 || [string match {diff --combined *} $line]
868 || [string match {--- *} $line]
869 || [string match {+++ *} $line]} {
870 append current_diff_header $line "\n"
871 continue
873 if {[string match {index *} $line]} continue
874 if {$line eq {deleted file mode 120000}} {
875 set line "deleted symlink"
878 # -- Automatically detect if this is a 3 way diff.
880 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
882 if {[string match {mode *} $line]
883 || [string match {new file *} $line]
884 || [string match {deleted file *} $line]
885 || [string match {Binary files * and * differ} $line]
886 || $line eq {\ No newline at end of file}
887 || [regexp {^\* Unmerged path } $line]} {
888 set tags {}
889 } elseif {$is_3way_diff} {
890 set op [string range $line 0 1]
891 switch -- $op {
892 { } {set tags {}}
893 {@@} {set tags d_@}
894 { +} {set tags d_s+}
895 { -} {set tags d_s-}
896 {+ } {set tags d_+s}
897 {- } {set tags d_-s}
898 {--} {set tags d_--}
899 {++} {
900 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
901 set line [string replace $line 0 1 { }]
902 set tags d$op
903 } else {
904 set tags d_++
907 default {
908 puts "error: Unhandled 3 way diff marker: {$op}"
909 set tags {}
912 } else {
913 set op [string index $line 0]
914 switch -- $op {
915 { } {set tags {}}
916 {@} {set tags d_@}
917 {-} {set tags d_-}
918 {+} {
919 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
920 set line [string replace $line 0 0 { }]
921 set tags d$op
922 } else {
923 set tags d_+
926 default {
927 puts "error: Unhandled 2 way diff marker: {$op}"
928 set tags {}
932 $ui_diff insert end $line $tags
933 if {[string index $line end] eq "\r"} {
934 $ui_diff tag add d_cr {end - 2c}
936 $ui_diff insert end "\n" $tags
938 $ui_diff conf -state disabled
940 if {[eof $fd]} {
941 close $fd
942 set diff_active 0
943 unlock_index
944 set ui_status_value {Ready.}
946 if {[$ui_diff index end] eq {2.0}} {
947 handle_empty_diff
952 proc apply_hunk {x y} {
953 global current_diff_path current_diff_header current_diff_side
954 global ui_diff ui_index file_states
956 if {$current_diff_path eq {} || $current_diff_header eq {}} return
957 if {![lock_index apply_hunk]} return
959 set apply_cmd {git apply --cached --whitespace=nowarn}
960 set mi [lindex $file_states($current_diff_path) 0]
961 if {$current_diff_side eq $ui_index} {
962 set mode unstage
963 lappend apply_cmd --reverse
964 if {[string index $mi 0] ne {M}} {
965 unlock_index
966 return
968 } else {
969 set mode stage
970 if {[string index $mi 1] ne {M}} {
971 unlock_index
972 return
976 set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
977 set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
978 if {$s_lno eq {}} {
979 unlock_index
980 return
983 set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
984 if {$e_lno eq {}} {
985 set e_lno end
988 if {[catch {
989 set p [open "| $apply_cmd" w]
990 fconfigure $p -translation binary -encoding binary
991 puts -nonewline $p $current_diff_header
992 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
993 close $p} err]} {
994 error_popup "Failed to $mode selected hunk.\n\n$err"
995 unlock_index
996 return
999 $ui_diff conf -state normal
1000 $ui_diff delete $s_lno $e_lno
1001 $ui_diff conf -state disabled
1003 if {[$ui_diff get 1.0 end] eq "\n"} {
1004 set o _
1005 } else {
1006 set o ?
1009 if {$current_diff_side eq $ui_index} {
1010 set mi ${o}M
1011 } elseif {[string index $mi 0] eq {_}} {
1012 set mi M$o
1013 } else {
1014 set mi ?$o
1016 unlock_index
1017 display_file $current_diff_path $mi
1018 if {$o eq {_}} {
1019 clear_diff
1023 ######################################################################
1025 ## commit
1027 proc load_last_commit {} {
1028 global HEAD PARENT MERGE_HEAD commit_type ui_comm
1029 global repo_config
1031 if {[llength $PARENT] == 0} {
1032 error_popup {There is nothing to amend.
1034 You are about to create the initial commit.
1035 There is no commit before this to amend.
1037 return
1040 repository_state curType curHEAD curMERGE_HEAD
1041 if {$curType eq {merge}} {
1042 error_popup {Cannot amend while merging.
1044 You are currently in the middle of a merge that
1045 has not been fully completed. You cannot amend
1046 the prior commit unless you first abort the
1047 current merge activity.
1049 return
1052 set msg {}
1053 set parents [list]
1054 if {[catch {
1055 set fd [open "| git cat-file commit $curHEAD" r]
1056 fconfigure $fd -encoding binary -translation lf
1057 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1058 set enc utf-8
1060 while {[gets $fd line] > 0} {
1061 if {[string match {parent *} $line]} {
1062 lappend parents [string range $line 7 end]
1063 } elseif {[string match {encoding *} $line]} {
1064 set enc [string tolower [string range $line 9 end]]
1067 fconfigure $fd -encoding $enc
1068 set msg [string trim [read $fd]]
1069 close $fd
1070 } err]} {
1071 error_popup "Error loading commit data for amend:\n\n$err"
1072 return
1075 set HEAD $curHEAD
1076 set PARENT $parents
1077 set MERGE_HEAD [list]
1078 switch -- [llength $parents] {
1079 0 {set commit_type amend-initial}
1080 1 {set commit_type amend}
1081 default {set commit_type amend-merge}
1084 $ui_comm delete 0.0 end
1085 $ui_comm insert end $msg
1086 $ui_comm edit reset
1087 $ui_comm edit modified false
1088 rescan {set ui_status_value {Ready.}}
1091 proc create_new_commit {} {
1092 global commit_type ui_comm
1094 set commit_type normal
1095 $ui_comm delete 0.0 end
1096 $ui_comm edit reset
1097 $ui_comm edit modified false
1098 rescan {set ui_status_value {Ready.}}
1101 set GIT_COMMITTER_IDENT {}
1103 proc committer_ident {} {
1104 global GIT_COMMITTER_IDENT
1106 if {$GIT_COMMITTER_IDENT eq {}} {
1107 if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
1108 error_popup "Unable to obtain your identity:\n\n$err"
1109 return {}
1111 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1112 $me me GIT_COMMITTER_IDENT]} {
1113 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1114 return {}
1118 return $GIT_COMMITTER_IDENT
1121 proc commit_tree {} {
1122 global HEAD commit_type file_states ui_comm repo_config
1123 global ui_status_value pch_error
1125 if {[committer_ident] eq {}} return
1126 if {![lock_index update]} return
1128 # -- Our in memory state should match the repository.
1130 repository_state curType curHEAD curMERGE_HEAD
1131 if {[string match amend* $commit_type]
1132 && $curType eq {normal}
1133 && $curHEAD eq $HEAD} {
1134 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1135 info_popup {Last scanned state does not match repository state.
1137 Another Git program has modified this repository
1138 since the last scan. A rescan must be performed
1139 before another commit can be created.
1141 The rescan will be automatically started now.
1143 unlock_index
1144 rescan {set ui_status_value {Ready.}}
1145 return
1148 # -- At least one file should differ in the index.
1150 set files_ready 0
1151 foreach path [array names file_states] {
1152 switch -glob -- [lindex $file_states($path) 0] {
1153 _? {continue}
1154 A? -
1155 D? -
1156 M? {set files_ready 1}
1157 U? {
1158 error_popup "Unmerged files cannot be committed.
1160 File [short_path $path] has merge conflicts.
1161 You must resolve them and add the file before committing.
1163 unlock_index
1164 return
1166 default {
1167 error_popup "Unknown file state [lindex $s 0] detected.
1169 File [short_path $path] cannot be committed by this program.
1174 if {!$files_ready} {
1175 info_popup {No changes to commit.
1177 You must add at least 1 file before you can commit.
1179 unlock_index
1180 return
1183 # -- A message is required.
1185 set msg [string trim [$ui_comm get 1.0 end]]
1186 regsub -all -line {[ \t\r]+$} $msg {} msg
1187 if {$msg eq {}} {
1188 error_popup {Please supply a commit message.
1190 A good commit message has the following format:
1192 - First line: Describe in one sentance what you did.
1193 - Second line: Blank
1194 - Remaining lines: Describe why this change is good.
1196 unlock_index
1197 return
1200 # -- Run the pre-commit hook.
1202 set pchook [gitdir hooks pre-commit]
1204 # On Cygwin [file executable] might lie so we need to ask
1205 # the shell if the hook is executable. Yes that's annoying.
1207 if {[is_Cygwin] && [file isfile $pchook]} {
1208 set pchook [list sh -c [concat \
1209 "if test -x \"$pchook\";" \
1210 "then exec \"$pchook\" 2>&1;" \
1211 "fi"]]
1212 } elseif {[file executable $pchook]} {
1213 set pchook [list $pchook |& cat]
1214 } else {
1215 commit_writetree $curHEAD $msg
1216 return
1219 set ui_status_value {Calling pre-commit hook...}
1220 set pch_error {}
1221 set fd_ph [open "| $pchook" r]
1222 fconfigure $fd_ph -blocking 0 -translation binary
1223 fileevent $fd_ph readable \
1224 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1227 proc commit_prehook_wait {fd_ph curHEAD msg} {
1228 global pch_error ui_status_value
1230 append pch_error [read $fd_ph]
1231 fconfigure $fd_ph -blocking 1
1232 if {[eof $fd_ph]} {
1233 if {[catch {close $fd_ph}]} {
1234 set ui_status_value {Commit declined by pre-commit hook.}
1235 hook_failed_popup pre-commit $pch_error
1236 unlock_index
1237 } else {
1238 commit_writetree $curHEAD $msg
1240 set pch_error {}
1241 return
1243 fconfigure $fd_ph -blocking 0
1246 proc commit_writetree {curHEAD msg} {
1247 global ui_status_value
1249 set ui_status_value {Committing changes...}
1250 set fd_wt [open "| git write-tree" r]
1251 fileevent $fd_wt readable \
1252 [list commit_committree $fd_wt $curHEAD $msg]
1255 proc commit_committree {fd_wt curHEAD msg} {
1256 global HEAD PARENT MERGE_HEAD commit_type
1257 global all_heads current_branch
1258 global ui_status_value ui_comm selected_commit_type
1259 global file_states selected_paths rescan_active
1260 global repo_config
1262 gets $fd_wt tree_id
1263 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1264 error_popup "write-tree failed:\n\n$err"
1265 set ui_status_value {Commit failed.}
1266 unlock_index
1267 return
1270 # -- Verify this wasn't an empty change.
1272 if {$commit_type eq {normal}} {
1273 set old_tree [git rev-parse "$PARENT^{tree}"]
1274 if {$tree_id eq $old_tree} {
1275 info_popup {No changes to commit.
1277 No files were modified by this commit and it
1278 was not a merge commit.
1280 A rescan will be automatically started now.
1282 unlock_index
1283 rescan {set ui_status_value {No changes to commit.}}
1284 return
1288 # -- Build the message.
1290 set msg_p [gitdir COMMIT_EDITMSG]
1291 set msg_wt [open $msg_p w]
1292 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1293 set enc utf-8
1295 fconfigure $msg_wt -encoding $enc -translation binary
1296 puts -nonewline $msg_wt $msg
1297 close $msg_wt
1299 # -- Create the commit.
1301 set cmd [list git commit-tree $tree_id]
1302 set parents [concat $PARENT $MERGE_HEAD]
1303 if {[llength $parents] > 0} {
1304 foreach p $parents {
1305 lappend cmd -p $p
1307 } else {
1308 # git commit-tree writes to stderr during initial commit.
1309 lappend cmd 2>/dev/null
1311 lappend cmd <$msg_p
1312 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1313 error_popup "commit-tree failed:\n\n$err"
1314 set ui_status_value {Commit failed.}
1315 unlock_index
1316 return
1319 # -- Update the HEAD ref.
1321 set reflogm commit
1322 if {$commit_type ne {normal}} {
1323 append reflogm " ($commit_type)"
1325 set i [string first "\n" $msg]
1326 if {$i >= 0} {
1327 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1328 } else {
1329 append reflogm {: } $msg
1331 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1332 if {[catch {eval exec $cmd} err]} {
1333 error_popup "update-ref failed:\n\n$err"
1334 set ui_status_value {Commit failed.}
1335 unlock_index
1336 return
1339 # -- Cleanup after ourselves.
1341 catch {file delete $msg_p}
1342 catch {file delete [gitdir MERGE_HEAD]}
1343 catch {file delete [gitdir MERGE_MSG]}
1344 catch {file delete [gitdir SQUASH_MSG]}
1345 catch {file delete [gitdir GITGUI_MSG]}
1347 # -- Let rerere do its thing.
1349 if {[file isdirectory [gitdir rr-cache]]} {
1350 catch {git rerere}
1353 # -- Run the post-commit hook.
1355 set pchook [gitdir hooks post-commit]
1356 if {[is_Cygwin] && [file isfile $pchook]} {
1357 set pchook [list sh -c [concat \
1358 "if test -x \"$pchook\";" \
1359 "then exec \"$pchook\";" \
1360 "fi"]]
1361 } elseif {![file executable $pchook]} {
1362 set pchook {}
1364 if {$pchook ne {}} {
1365 catch {exec $pchook &}
1368 $ui_comm delete 0.0 end
1369 $ui_comm edit reset
1370 $ui_comm edit modified false
1372 if {[is_enabled singlecommit]} do_quit
1374 # -- Make sure our current branch exists.
1376 if {$commit_type eq {initial}} {
1377 lappend all_heads $current_branch
1378 set all_heads [lsort -unique $all_heads]
1379 populate_branch_menu
1382 # -- Update in memory status
1384 set selected_commit_type new
1385 set commit_type normal
1386 set HEAD $cmt_id
1387 set PARENT $cmt_id
1388 set MERGE_HEAD [list]
1390 foreach path [array names file_states] {
1391 set s $file_states($path)
1392 set m [lindex $s 0]
1393 switch -glob -- $m {
1394 _O -
1395 _M -
1396 _D {continue}
1397 __ -
1398 A_ -
1399 M_ -
1400 D_ {
1401 unset file_states($path)
1402 catch {unset selected_paths($path)}
1404 DO {
1405 set file_states($path) [list _O [lindex $s 1] {} {}]
1407 AM -
1408 AD -
1409 MM -
1410 MD {
1411 set file_states($path) [list \
1412 _[string index $m 1] \
1413 [lindex $s 1] \
1414 [lindex $s 3] \
1420 display_all_files
1421 unlock_index
1422 reshow_diff
1423 set ui_status_value \
1424 "Changes committed as [string range $cmt_id 0 7]."
1427 ######################################################################
1429 ## fetch push
1431 proc fetch_from {remote} {
1432 set w [new_console \
1433 "fetch $remote" \
1434 "Fetching new changes from $remote"]
1435 set cmd [list git fetch]
1436 lappend cmd $remote
1437 console_exec $w $cmd console_done
1440 proc push_to {remote} {
1441 set w [new_console \
1442 "push $remote" \
1443 "Pushing changes to $remote"]
1444 set cmd [list git push]
1445 lappend cmd -v
1446 lappend cmd $remote
1447 console_exec $w $cmd console_done
1450 ######################################################################
1452 ## ui helpers
1454 proc mapicon {w state path} {
1455 global all_icons
1457 if {[catch {set r $all_icons($state$w)}]} {
1458 puts "error: no icon for $w state={$state} $path"
1459 return file_plain
1461 return $r
1464 proc mapdesc {state path} {
1465 global all_descs
1467 if {[catch {set r $all_descs($state)}]} {
1468 puts "error: no desc for state={$state} $path"
1469 return $state
1471 return $r
1474 proc escape_path {path} {
1475 regsub -all {\\} $path "\\\\" path
1476 regsub -all "\n" $path "\\n" path
1477 return $path
1480 proc short_path {path} {
1481 return [escape_path [lindex [file split $path] end]]
1484 set next_icon_id 0
1485 set null_sha1 [string repeat 0 40]
1487 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1488 global file_states next_icon_id null_sha1
1490 set s0 [string index $new_state 0]
1491 set s1 [string index $new_state 1]
1493 if {[catch {set info $file_states($path)}]} {
1494 set state __
1495 set icon n[incr next_icon_id]
1496 } else {
1497 set state [lindex $info 0]
1498 set icon [lindex $info 1]
1499 if {$head_info eq {}} {set head_info [lindex $info 2]}
1500 if {$index_info eq {}} {set index_info [lindex $info 3]}
1503 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1504 elseif {$s0 eq {_}} {set s0 _}
1506 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1507 elseif {$s1 eq {_}} {set s1 _}
1509 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1510 set head_info [list 0 $null_sha1]
1511 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1512 && $head_info eq {}} {
1513 set head_info $index_info
1516 set file_states($path) [list $s0$s1 $icon \
1517 $head_info $index_info \
1519 return $state
1522 proc display_file_helper {w path icon_name old_m new_m} {
1523 global file_lists
1525 if {$new_m eq {_}} {
1526 set lno [lsearch -sorted -exact $file_lists($w) $path]
1527 if {$lno >= 0} {
1528 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1529 incr lno
1530 $w conf -state normal
1531 $w delete $lno.0 [expr {$lno + 1}].0
1532 $w conf -state disabled
1534 } elseif {$old_m eq {_} && $new_m ne {_}} {
1535 lappend file_lists($w) $path
1536 set file_lists($w) [lsort -unique $file_lists($w)]
1537 set lno [lsearch -sorted -exact $file_lists($w) $path]
1538 incr lno
1539 $w conf -state normal
1540 $w image create $lno.0 \
1541 -align center -padx 5 -pady 1 \
1542 -name $icon_name \
1543 -image [mapicon $w $new_m $path]
1544 $w insert $lno.1 "[escape_path $path]\n"
1545 $w conf -state disabled
1546 } elseif {$old_m ne $new_m} {
1547 $w conf -state normal
1548 $w image conf $icon_name -image [mapicon $w $new_m $path]
1549 $w conf -state disabled
1553 proc display_file {path state} {
1554 global file_states selected_paths
1555 global ui_index ui_workdir
1557 set old_m [merge_state $path $state]
1558 set s $file_states($path)
1559 set new_m [lindex $s 0]
1560 set icon_name [lindex $s 1]
1562 set o [string index $old_m 0]
1563 set n [string index $new_m 0]
1564 if {$o eq {U}} {
1565 set o _
1567 if {$n eq {U}} {
1568 set n _
1570 display_file_helper $ui_index $path $icon_name $o $n
1572 if {[string index $old_m 0] eq {U}} {
1573 set o U
1574 } else {
1575 set o [string index $old_m 1]
1577 if {[string index $new_m 0] eq {U}} {
1578 set n U
1579 } else {
1580 set n [string index $new_m 1]
1582 display_file_helper $ui_workdir $path $icon_name $o $n
1584 if {$new_m eq {__}} {
1585 unset file_states($path)
1586 catch {unset selected_paths($path)}
1590 proc display_all_files_helper {w path icon_name m} {
1591 global file_lists
1593 lappend file_lists($w) $path
1594 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1595 $w image create end \
1596 -align center -padx 5 -pady 1 \
1597 -name $icon_name \
1598 -image [mapicon $w $m $path]
1599 $w insert end "[escape_path $path]\n"
1602 proc display_all_files {} {
1603 global ui_index ui_workdir
1604 global file_states file_lists
1605 global last_clicked
1607 $ui_index conf -state normal
1608 $ui_workdir conf -state normal
1610 $ui_index delete 0.0 end
1611 $ui_workdir delete 0.0 end
1612 set last_clicked {}
1614 set file_lists($ui_index) [list]
1615 set file_lists($ui_workdir) [list]
1617 foreach path [lsort [array names file_states]] {
1618 set s $file_states($path)
1619 set m [lindex $s 0]
1620 set icon_name [lindex $s 1]
1622 set s [string index $m 0]
1623 if {$s ne {U} && $s ne {_}} {
1624 display_all_files_helper $ui_index $path \
1625 $icon_name $s
1628 if {[string index $m 0] eq {U}} {
1629 set s U
1630 } else {
1631 set s [string index $m 1]
1633 if {$s ne {_}} {
1634 display_all_files_helper $ui_workdir $path \
1635 $icon_name $s
1639 $ui_index conf -state disabled
1640 $ui_workdir conf -state disabled
1643 proc update_indexinfo {msg pathList after} {
1644 global update_index_cp ui_status_value
1646 if {![lock_index update]} return
1648 set update_index_cp 0
1649 set pathList [lsort $pathList]
1650 set totalCnt [llength $pathList]
1651 set batch [expr {int($totalCnt * .01) + 1}]
1652 if {$batch > 25} {set batch 25}
1654 set ui_status_value [format \
1655 "$msg... %i/%i files (%.2f%%)" \
1656 $update_index_cp \
1657 $totalCnt \
1658 0.0]
1659 set fd [open "| git update-index -z --index-info" w]
1660 fconfigure $fd \
1661 -blocking 0 \
1662 -buffering full \
1663 -buffersize 512 \
1664 -encoding binary \
1665 -translation binary
1666 fileevent $fd writable [list \
1667 write_update_indexinfo \
1668 $fd \
1669 $pathList \
1670 $totalCnt \
1671 $batch \
1672 $msg \
1673 $after \
1677 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1678 global update_index_cp ui_status_value
1679 global file_states current_diff_path
1681 if {$update_index_cp >= $totalCnt} {
1682 close $fd
1683 unlock_index
1684 uplevel #0 $after
1685 return
1688 for {set i $batch} \
1689 {$update_index_cp < $totalCnt && $i > 0} \
1690 {incr i -1} {
1691 set path [lindex $pathList $update_index_cp]
1692 incr update_index_cp
1694 set s $file_states($path)
1695 switch -glob -- [lindex $s 0] {
1696 A? {set new _O}
1697 M? {set new _M}
1698 D_ {set new _D}
1699 D? {set new _?}
1700 ?? {continue}
1702 set info [lindex $s 2]
1703 if {$info eq {}} continue
1705 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1706 display_file $path $new
1709 set ui_status_value [format \
1710 "$msg... %i/%i files (%.2f%%)" \
1711 $update_index_cp \
1712 $totalCnt \
1713 [expr {100.0 * $update_index_cp / $totalCnt}]]
1716 proc update_index {msg pathList after} {
1717 global update_index_cp ui_status_value
1719 if {![lock_index update]} return
1721 set update_index_cp 0
1722 set pathList [lsort $pathList]
1723 set totalCnt [llength $pathList]
1724 set batch [expr {int($totalCnt * .01) + 1}]
1725 if {$batch > 25} {set batch 25}
1727 set ui_status_value [format \
1728 "$msg... %i/%i files (%.2f%%)" \
1729 $update_index_cp \
1730 $totalCnt \
1731 0.0]
1732 set fd [open "| git update-index --add --remove -z --stdin" w]
1733 fconfigure $fd \
1734 -blocking 0 \
1735 -buffering full \
1736 -buffersize 512 \
1737 -encoding binary \
1738 -translation binary
1739 fileevent $fd writable [list \
1740 write_update_index \
1741 $fd \
1742 $pathList \
1743 $totalCnt \
1744 $batch \
1745 $msg \
1746 $after \
1750 proc write_update_index {fd pathList totalCnt batch msg after} {
1751 global update_index_cp ui_status_value
1752 global file_states current_diff_path
1754 if {$update_index_cp >= $totalCnt} {
1755 close $fd
1756 unlock_index
1757 uplevel #0 $after
1758 return
1761 for {set i $batch} \
1762 {$update_index_cp < $totalCnt && $i > 0} \
1763 {incr i -1} {
1764 set path [lindex $pathList $update_index_cp]
1765 incr update_index_cp
1767 switch -glob -- [lindex $file_states($path) 0] {
1768 AD {set new __}
1769 ?D {set new D_}
1770 _O -
1771 AM {set new A_}
1772 U? {
1773 if {[file exists $path]} {
1774 set new M_
1775 } else {
1776 set new D_
1779 ?M {set new M_}
1780 ?? {continue}
1782 puts -nonewline $fd "[encoding convertto $path]\0"
1783 display_file $path $new
1786 set ui_status_value [format \
1787 "$msg... %i/%i files (%.2f%%)" \
1788 $update_index_cp \
1789 $totalCnt \
1790 [expr {100.0 * $update_index_cp / $totalCnt}]]
1793 proc checkout_index {msg pathList after} {
1794 global update_index_cp ui_status_value
1796 if {![lock_index update]} return
1798 set update_index_cp 0
1799 set pathList [lsort $pathList]
1800 set totalCnt [llength $pathList]
1801 set batch [expr {int($totalCnt * .01) + 1}]
1802 if {$batch > 25} {set batch 25}
1804 set ui_status_value [format \
1805 "$msg... %i/%i files (%.2f%%)" \
1806 $update_index_cp \
1807 $totalCnt \
1808 0.0]
1809 set cmd [list git checkout-index]
1810 lappend cmd --index
1811 lappend cmd --quiet
1812 lappend cmd --force
1813 lappend cmd -z
1814 lappend cmd --stdin
1815 set fd [open "| $cmd " w]
1816 fconfigure $fd \
1817 -blocking 0 \
1818 -buffering full \
1819 -buffersize 512 \
1820 -encoding binary \
1821 -translation binary
1822 fileevent $fd writable [list \
1823 write_checkout_index \
1824 $fd \
1825 $pathList \
1826 $totalCnt \
1827 $batch \
1828 $msg \
1829 $after \
1833 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1834 global update_index_cp ui_status_value
1835 global file_states current_diff_path
1837 if {$update_index_cp >= $totalCnt} {
1838 close $fd
1839 unlock_index
1840 uplevel #0 $after
1841 return
1844 for {set i $batch} \
1845 {$update_index_cp < $totalCnt && $i > 0} \
1846 {incr i -1} {
1847 set path [lindex $pathList $update_index_cp]
1848 incr update_index_cp
1849 switch -glob -- [lindex $file_states($path) 0] {
1850 U? {continue}
1851 ?M -
1852 ?D {
1853 puts -nonewline $fd "[encoding convertto $path]\0"
1854 display_file $path ?_
1859 set ui_status_value [format \
1860 "$msg... %i/%i files (%.2f%%)" \
1861 $update_index_cp \
1862 $totalCnt \
1863 [expr {100.0 * $update_index_cp / $totalCnt}]]
1866 ######################################################################
1868 ## branch management
1870 proc is_tracking_branch {name} {
1871 global tracking_branches
1873 if {![catch {set info $tracking_branches($name)}]} {
1874 return 1
1876 foreach t [array names tracking_branches] {
1877 if {[string match {*/\*} $t] && [string match $t $name]} {
1878 return 1
1881 return 0
1884 proc load_all_heads {} {
1885 global all_heads
1887 set all_heads [list]
1888 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1889 while {[gets $fd line] > 0} {
1890 if {[is_tracking_branch $line]} continue
1891 if {![regsub ^refs/heads/ $line {} name]} continue
1892 lappend all_heads $name
1894 close $fd
1896 set all_heads [lsort $all_heads]
1899 proc populate_branch_menu {} {
1900 global all_heads disable_on_lock
1902 set m .mbar.branch
1903 set last [$m index last]
1904 for {set i 0} {$i <= $last} {incr i} {
1905 if {[$m type $i] eq {separator}} {
1906 $m delete $i last
1907 set new_dol [list]
1908 foreach a $disable_on_lock {
1909 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1910 lappend new_dol $a
1913 set disable_on_lock $new_dol
1914 break
1918 if {$all_heads ne {}} {
1919 $m add separator
1921 foreach b $all_heads {
1922 $m add radiobutton \
1923 -label $b \
1924 -command [list switch_branch $b] \
1925 -variable current_branch \
1926 -value $b \
1927 -font font_ui
1928 lappend disable_on_lock \
1929 [list $m entryconf [$m index last] -state]
1933 proc all_tracking_branches {} {
1934 global tracking_branches
1936 set all_trackings {}
1937 set cmd {}
1938 foreach name [array names tracking_branches] {
1939 if {[regsub {/\*$} $name {} name]} {
1940 lappend cmd $name
1941 } else {
1942 regsub ^refs/(heads|remotes)/ $name {} name
1943 lappend all_trackings $name
1947 if {$cmd ne {}} {
1948 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1949 while {[gets $fd name] > 0} {
1950 regsub ^refs/(heads|remotes)/ $name {} name
1951 lappend all_trackings $name
1953 close $fd
1956 return [lsort -unique $all_trackings]
1959 proc load_all_tags {} {
1960 set all_tags [list]
1961 set fd [open "| git for-each-ref --format=%(refname) refs/tags" r]
1962 while {[gets $fd line] > 0} {
1963 if {![regsub ^refs/tags/ $line {} name]} continue
1964 lappend all_tags $name
1966 close $fd
1968 return [lsort $all_tags]
1971 proc do_create_branch_action {w} {
1972 global all_heads null_sha1 repo_config
1973 global create_branch_checkout create_branch_revtype
1974 global create_branch_head create_branch_trackinghead
1975 global create_branch_name create_branch_revexp
1976 global create_branch_tag
1978 set newbranch $create_branch_name
1979 if {$newbranch eq {}
1980 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1981 tk_messageBox \
1982 -icon error \
1983 -type ok \
1984 -title [wm title $w] \
1985 -parent $w \
1986 -message "Please supply a branch name."
1987 focus $w.desc.name_t
1988 return
1990 if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
1991 tk_messageBox \
1992 -icon error \
1993 -type ok \
1994 -title [wm title $w] \
1995 -parent $w \
1996 -message "Branch '$newbranch' already exists."
1997 focus $w.desc.name_t
1998 return
2000 if {[catch {git check-ref-format "heads/$newbranch"}]} {
2001 tk_messageBox \
2002 -icon error \
2003 -type ok \
2004 -title [wm title $w] \
2005 -parent $w \
2006 -message "We do not like '$newbranch' as a branch name."
2007 focus $w.desc.name_t
2008 return
2011 set rev {}
2012 switch -- $create_branch_revtype {
2013 head {set rev $create_branch_head}
2014 tracking {set rev $create_branch_trackinghead}
2015 tag {set rev $create_branch_tag}
2016 expression {set rev $create_branch_revexp}
2018 if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
2019 tk_messageBox \
2020 -icon error \
2021 -type ok \
2022 -title [wm title $w] \
2023 -parent $w \
2024 -message "Invalid starting revision: $rev"
2025 return
2027 set cmd [list git update-ref]
2028 lappend cmd -m
2029 lappend cmd "branch: Created from $rev"
2030 lappend cmd "refs/heads/$newbranch"
2031 lappend cmd $cmt
2032 lappend cmd $null_sha1
2033 if {[catch {eval exec $cmd} err]} {
2034 tk_messageBox \
2035 -icon error \
2036 -type ok \
2037 -title [wm title $w] \
2038 -parent $w \
2039 -message "Failed to create '$newbranch'.\n\n$err"
2040 return
2043 lappend all_heads $newbranch
2044 set all_heads [lsort $all_heads]
2045 populate_branch_menu
2046 destroy $w
2047 if {$create_branch_checkout} {
2048 switch_branch $newbranch
2052 proc radio_selector {varname value args} {
2053 upvar #0 $varname var
2054 set var $value
2057 trace add variable create_branch_head write \
2058 [list radio_selector create_branch_revtype head]
2059 trace add variable create_branch_trackinghead write \
2060 [list radio_selector create_branch_revtype tracking]
2061 trace add variable create_branch_tag write \
2062 [list radio_selector create_branch_revtype tag]
2064 trace add variable delete_branch_head write \
2065 [list radio_selector delete_branch_checktype head]
2066 trace add variable delete_branch_trackinghead write \
2067 [list radio_selector delete_branch_checktype tracking]
2069 proc do_create_branch {} {
2070 global all_heads current_branch repo_config
2071 global create_branch_checkout create_branch_revtype
2072 global create_branch_head create_branch_trackinghead
2073 global create_branch_name create_branch_revexp
2074 global create_branch_tag
2076 set w .branch_editor
2077 toplevel $w
2078 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2080 label $w.header -text {Create New Branch} \
2081 -font font_uibold
2082 pack $w.header -side top -fill x
2084 frame $w.buttons
2085 button $w.buttons.create -text Create \
2086 -font font_ui \
2087 -default active \
2088 -command [list do_create_branch_action $w]
2089 pack $w.buttons.create -side right
2090 button $w.buttons.cancel -text {Cancel} \
2091 -font font_ui \
2092 -command [list destroy $w]
2093 pack $w.buttons.cancel -side right -padx 5
2094 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2096 labelframe $w.desc \
2097 -text {Branch Description} \
2098 -font font_ui
2099 label $w.desc.name_l -text {Name:} -font font_ui
2100 entry $w.desc.name_t \
2101 -borderwidth 1 \
2102 -relief sunken \
2103 -width 40 \
2104 -textvariable create_branch_name \
2105 -font font_ui \
2106 -validate key \
2107 -validatecommand {
2108 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2109 return 1
2111 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2112 grid columnconfigure $w.desc 1 -weight 1
2113 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2115 labelframe $w.from \
2116 -text {Starting Revision} \
2117 -font font_ui
2118 radiobutton $w.from.head_r \
2119 -text {Local Branch:} \
2120 -value head \
2121 -variable create_branch_revtype \
2122 -font font_ui
2123 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2124 grid $w.from.head_r $w.from.head_m -sticky w
2125 set all_trackings [all_tracking_branches]
2126 if {$all_trackings ne {}} {
2127 set create_branch_trackinghead [lindex $all_trackings 0]
2128 radiobutton $w.from.tracking_r \
2129 -text {Tracking Branch:} \
2130 -value tracking \
2131 -variable create_branch_revtype \
2132 -font font_ui
2133 eval tk_optionMenu $w.from.tracking_m \
2134 create_branch_trackinghead \
2135 $all_trackings
2136 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2138 set all_tags [load_all_tags]
2139 if {$all_tags ne {}} {
2140 set create_branch_tag [lindex $all_tags 0]
2141 radiobutton $w.from.tag_r \
2142 -text {Tag:} \
2143 -value tag \
2144 -variable create_branch_revtype \
2145 -font font_ui
2146 eval tk_optionMenu $w.from.tag_m \
2147 create_branch_tag \
2148 $all_tags
2149 grid $w.from.tag_r $w.from.tag_m -sticky w
2151 radiobutton $w.from.exp_r \
2152 -text {Revision Expression:} \
2153 -value expression \
2154 -variable create_branch_revtype \
2155 -font font_ui
2156 entry $w.from.exp_t \
2157 -borderwidth 1 \
2158 -relief sunken \
2159 -width 50 \
2160 -textvariable create_branch_revexp \
2161 -font font_ui \
2162 -validate key \
2163 -validatecommand {
2164 if {%d == 1 && [regexp {\s} %S]} {return 0}
2165 if {%d == 1 && [string length %S] > 0} {
2166 set create_branch_revtype expression
2168 return 1
2170 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2171 grid columnconfigure $w.from 1 -weight 1
2172 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2174 labelframe $w.postActions \
2175 -text {Post Creation Actions} \
2176 -font font_ui
2177 checkbutton $w.postActions.checkout \
2178 -text {Checkout after creation} \
2179 -variable create_branch_checkout \
2180 -font font_ui
2181 pack $w.postActions.checkout -anchor nw
2182 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2184 set create_branch_checkout 1
2185 set create_branch_head $current_branch
2186 set create_branch_revtype head
2187 set create_branch_name $repo_config(gui.newbranchtemplate)
2188 set create_branch_revexp {}
2190 bind $w <Visibility> "
2191 grab $w
2192 $w.desc.name_t icursor end
2193 focus $w.desc.name_t
2195 bind $w <Key-Escape> "destroy $w"
2196 bind $w <Key-Return> "do_create_branch_action $w;break"
2197 wm title $w "[appname] ([reponame]): Create Branch"
2198 tkwait window $w
2201 proc do_delete_branch_action {w} {
2202 global all_heads
2203 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2205 set check_rev {}
2206 switch -- $delete_branch_checktype {
2207 head {set check_rev $delete_branch_head}
2208 tracking {set check_rev $delete_branch_trackinghead}
2209 always {set check_rev {:none}}
2211 if {$check_rev eq {:none}} {
2212 set check_cmt {}
2213 } elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
2214 tk_messageBox \
2215 -icon error \
2216 -type ok \
2217 -title [wm title $w] \
2218 -parent $w \
2219 -message "Invalid check revision: $check_rev"
2220 return
2223 set to_delete [list]
2224 set not_merged [list]
2225 foreach i [$w.list.l curselection] {
2226 set b [$w.list.l get $i]
2227 if {[catch {set o [git rev-parse --verify $b]}]} continue
2228 if {$check_cmt ne {}} {
2229 if {$b eq $check_rev} continue
2230 if {[catch {set m [git merge-base $o $check_cmt]}]} continue
2231 if {$o ne $m} {
2232 lappend not_merged $b
2233 continue
2236 lappend to_delete [list $b $o]
2238 if {$not_merged ne {}} {
2239 set msg "The following branches are not completely merged into $check_rev:
2241 - [join $not_merged "\n - "]"
2242 tk_messageBox \
2243 -icon info \
2244 -type ok \
2245 -title [wm title $w] \
2246 -parent $w \
2247 -message $msg
2249 if {$to_delete eq {}} return
2250 if {$delete_branch_checktype eq {always}} {
2251 set msg {Recovering deleted branches is difficult.
2253 Delete the selected branches?}
2254 if {[tk_messageBox \
2255 -icon warning \
2256 -type yesno \
2257 -title [wm title $w] \
2258 -parent $w \
2259 -message $msg] ne yes} {
2260 return
2264 set failed {}
2265 foreach i $to_delete {
2266 set b [lindex $i 0]
2267 set o [lindex $i 1]
2268 if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
2269 append failed " - $b: $err\n"
2270 } else {
2271 set x [lsearch -sorted -exact $all_heads $b]
2272 if {$x >= 0} {
2273 set all_heads [lreplace $all_heads $x $x]
2278 if {$failed ne {}} {
2279 tk_messageBox \
2280 -icon error \
2281 -type ok \
2282 -title [wm title $w] \
2283 -parent $w \
2284 -message "Failed to delete branches:\n$failed"
2287 set all_heads [lsort $all_heads]
2288 populate_branch_menu
2289 destroy $w
2292 proc do_delete_branch {} {
2293 global all_heads tracking_branches current_branch
2294 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2296 set w .branch_editor
2297 toplevel $w
2298 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2300 label $w.header -text {Delete Local Branch} \
2301 -font font_uibold
2302 pack $w.header -side top -fill x
2304 frame $w.buttons
2305 button $w.buttons.create -text Delete \
2306 -font font_ui \
2307 -command [list do_delete_branch_action $w]
2308 pack $w.buttons.create -side right
2309 button $w.buttons.cancel -text {Cancel} \
2310 -font font_ui \
2311 -command [list destroy $w]
2312 pack $w.buttons.cancel -side right -padx 5
2313 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2315 labelframe $w.list \
2316 -text {Local Branches} \
2317 -font font_ui
2318 listbox $w.list.l \
2319 -height 10 \
2320 -width 70 \
2321 -selectmode extended \
2322 -yscrollcommand [list $w.list.sby set] \
2323 -font font_ui
2324 foreach h $all_heads {
2325 if {$h ne $current_branch} {
2326 $w.list.l insert end $h
2329 scrollbar $w.list.sby -command [list $w.list.l yview]
2330 pack $w.list.sby -side right -fill y
2331 pack $w.list.l -side left -fill both -expand 1
2332 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2334 labelframe $w.validate \
2335 -text {Delete Only If} \
2336 -font font_ui
2337 radiobutton $w.validate.head_r \
2338 -text {Merged Into Local Branch:} \
2339 -value head \
2340 -variable delete_branch_checktype \
2341 -font font_ui
2342 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2343 grid $w.validate.head_r $w.validate.head_m -sticky w
2344 set all_trackings [all_tracking_branches]
2345 if {$all_trackings ne {}} {
2346 set delete_branch_trackinghead [lindex $all_trackings 0]
2347 radiobutton $w.validate.tracking_r \
2348 -text {Merged Into Tracking Branch:} \
2349 -value tracking \
2350 -variable delete_branch_checktype \
2351 -font font_ui
2352 eval tk_optionMenu $w.validate.tracking_m \
2353 delete_branch_trackinghead \
2354 $all_trackings
2355 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2357 radiobutton $w.validate.always_r \
2358 -text {Always (Do not perform merge checks)} \
2359 -value always \
2360 -variable delete_branch_checktype \
2361 -font font_ui
2362 grid $w.validate.always_r -columnspan 2 -sticky w
2363 grid columnconfigure $w.validate 1 -weight 1
2364 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2366 set delete_branch_head $current_branch
2367 set delete_branch_checktype head
2369 bind $w <Visibility> "grab $w; focus $w"
2370 bind $w <Key-Escape> "destroy $w"
2371 wm title $w "[appname] ([reponame]): Delete Branch"
2372 tkwait window $w
2375 proc switch_branch {new_branch} {
2376 global HEAD commit_type current_branch repo_config
2378 if {![lock_index switch]} return
2380 # -- Our in memory state should match the repository.
2382 repository_state curType curHEAD curMERGE_HEAD
2383 if {[string match amend* $commit_type]
2384 && $curType eq {normal}
2385 && $curHEAD eq $HEAD} {
2386 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2387 info_popup {Last scanned state does not match repository state.
2389 Another Git program has modified this repository
2390 since the last scan. A rescan must be performed
2391 before the current branch can be changed.
2393 The rescan will be automatically started now.
2395 unlock_index
2396 rescan {set ui_status_value {Ready.}}
2397 return
2400 # -- Don't do a pointless switch.
2402 if {$current_branch eq $new_branch} {
2403 unlock_index
2404 return
2407 if {$repo_config(gui.trustmtime) eq {true}} {
2408 switch_branch_stage2 {} $new_branch
2409 } else {
2410 set ui_status_value {Refreshing file status...}
2411 set cmd [list git update-index]
2412 lappend cmd -q
2413 lappend cmd --unmerged
2414 lappend cmd --ignore-missing
2415 lappend cmd --refresh
2416 set fd_rf [open "| $cmd" r]
2417 fconfigure $fd_rf -blocking 0 -translation binary
2418 fileevent $fd_rf readable \
2419 [list switch_branch_stage2 $fd_rf $new_branch]
2423 proc switch_branch_stage2 {fd_rf new_branch} {
2424 global ui_status_value HEAD
2426 if {$fd_rf ne {}} {
2427 read $fd_rf
2428 if {![eof $fd_rf]} return
2429 close $fd_rf
2432 set ui_status_value "Updating working directory to '$new_branch'..."
2433 set cmd [list git read-tree]
2434 lappend cmd -m
2435 lappend cmd -u
2436 lappend cmd --exclude-per-directory=.gitignore
2437 lappend cmd $HEAD
2438 lappend cmd $new_branch
2439 set fd_rt [open "| $cmd" r]
2440 fconfigure $fd_rt -blocking 0 -translation binary
2441 fileevent $fd_rt readable \
2442 [list switch_branch_readtree_wait $fd_rt $new_branch]
2445 proc switch_branch_readtree_wait {fd_rt new_branch} {
2446 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2447 global current_branch
2448 global ui_comm ui_status_value
2450 # -- We never get interesting output on stdout; only stderr.
2452 read $fd_rt
2453 fconfigure $fd_rt -blocking 1
2454 if {![eof $fd_rt]} {
2455 fconfigure $fd_rt -blocking 0
2456 return
2459 # -- The working directory wasn't in sync with the index and
2460 # we'd have to overwrite something to make the switch. A
2461 # merge is required.
2463 if {[catch {close $fd_rt} err]} {
2464 regsub {^fatal: } $err {} err
2465 warn_popup "File level merge required.
2467 $err
2469 Staying on branch '$current_branch'."
2470 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2471 unlock_index
2472 return
2475 # -- Update the symbolic ref. Core git doesn't even check for failure
2476 # here, it Just Works(tm). If it doesn't we are in some really ugly
2477 # state that is difficult to recover from within git-gui.
2479 if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2480 error_popup "Failed to set current branch.
2482 This working directory is only partially switched.
2483 We successfully updated your files, but failed to
2484 update an internal Git file.
2486 This should not have occurred. [appname] will now
2487 close and give up.
2489 $err"
2490 do_quit
2491 return
2494 # -- Update our repository state. If we were previously in amend mode
2495 # we need to toss the current buffer and do a full rescan to update
2496 # our file lists. If we weren't in amend mode our file lists are
2497 # accurate and we can avoid the rescan.
2499 unlock_index
2500 set selected_commit_type new
2501 if {[string match amend* $commit_type]} {
2502 $ui_comm delete 0.0 end
2503 $ui_comm edit reset
2504 $ui_comm edit modified false
2505 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2506 } else {
2507 repository_state commit_type HEAD MERGE_HEAD
2508 set PARENT $HEAD
2509 set ui_status_value "Checked out branch '$current_branch'."
2513 ######################################################################
2515 ## remote management
2517 proc load_all_remotes {} {
2518 global repo_config
2519 global all_remotes tracking_branches
2521 set all_remotes [list]
2522 array unset tracking_branches
2524 set rm_dir [gitdir remotes]
2525 if {[file isdirectory $rm_dir]} {
2526 set all_remotes [glob \
2527 -types f \
2528 -tails \
2529 -nocomplain \
2530 -directory $rm_dir *]
2532 foreach name $all_remotes {
2533 catch {
2534 set fd [open [file join $rm_dir $name] r]
2535 while {[gets $fd line] >= 0} {
2536 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2537 $line line src dst]} continue
2538 if {![regexp ^refs/ $dst]} {
2539 set dst "refs/heads/$dst"
2541 set tracking_branches($dst) [list $name $src]
2543 close $fd
2548 foreach line [array names repo_config remote.*.url] {
2549 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2550 lappend all_remotes $name
2552 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2553 set fl {}
2555 foreach line $fl {
2556 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2557 if {![regexp ^refs/ $dst]} {
2558 set dst "refs/heads/$dst"
2560 set tracking_branches($dst) [list $name $src]
2564 set all_remotes [lsort -unique $all_remotes]
2567 proc populate_fetch_menu {} {
2568 global all_remotes repo_config
2570 set m .mbar.fetch
2571 foreach r $all_remotes {
2572 set enable 0
2573 if {![catch {set a $repo_config(remote.$r.url)}]} {
2574 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2575 set enable 1
2577 } else {
2578 catch {
2579 set fd [open [gitdir remotes $r] r]
2580 while {[gets $fd n] >= 0} {
2581 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2582 set enable 1
2583 break
2586 close $fd
2590 if {$enable} {
2591 $m add command \
2592 -label "Fetch from $r..." \
2593 -command [list fetch_from $r] \
2594 -font font_ui
2599 proc populate_push_menu {} {
2600 global all_remotes repo_config
2602 set m .mbar.push
2603 set fast_count 0
2604 foreach r $all_remotes {
2605 set enable 0
2606 if {![catch {set a $repo_config(remote.$r.url)}]} {
2607 if {![catch {set a $repo_config(remote.$r.push)}]} {
2608 set enable 1
2610 } else {
2611 catch {
2612 set fd [open [gitdir remotes $r] r]
2613 while {[gets $fd n] >= 0} {
2614 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2615 set enable 1
2616 break
2619 close $fd
2623 if {$enable} {
2624 if {!$fast_count} {
2625 $m add separator
2627 $m add command \
2628 -label "Push to $r..." \
2629 -command [list push_to $r] \
2630 -font font_ui
2631 incr fast_count
2636 proc start_push_anywhere_action {w} {
2637 global push_urltype push_remote push_url push_thin push_tags
2639 set r_url {}
2640 switch -- $push_urltype {
2641 remote {set r_url $push_remote}
2642 url {set r_url $push_url}
2644 if {$r_url eq {}} return
2646 set cmd [list git push]
2647 lappend cmd -v
2648 if {$push_thin} {
2649 lappend cmd --thin
2651 if {$push_tags} {
2652 lappend cmd --tags
2654 lappend cmd $r_url
2655 set cnt 0
2656 foreach i [$w.source.l curselection] {
2657 set b [$w.source.l get $i]
2658 lappend cmd "refs/heads/$b:refs/heads/$b"
2659 incr cnt
2661 if {$cnt == 0} {
2662 return
2663 } elseif {$cnt == 1} {
2664 set unit branch
2665 } else {
2666 set unit branches
2669 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2670 console_exec $cons $cmd console_done
2671 destroy $w
2674 trace add variable push_remote write \
2675 [list radio_selector push_urltype remote]
2677 proc do_push_anywhere {} {
2678 global all_heads all_remotes current_branch
2679 global push_urltype push_remote push_url push_thin push_tags
2681 set w .push_setup
2682 toplevel $w
2683 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2685 label $w.header -text {Push Branches} -font font_uibold
2686 pack $w.header -side top -fill x
2688 frame $w.buttons
2689 button $w.buttons.create -text Push \
2690 -font font_ui \
2691 -command [list start_push_anywhere_action $w]
2692 pack $w.buttons.create -side right
2693 button $w.buttons.cancel -text {Cancel} \
2694 -font font_ui \
2695 -command [list destroy $w]
2696 pack $w.buttons.cancel -side right -padx 5
2697 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2699 labelframe $w.source \
2700 -text {Source Branches} \
2701 -font font_ui
2702 listbox $w.source.l \
2703 -height 10 \
2704 -width 70 \
2705 -selectmode extended \
2706 -yscrollcommand [list $w.source.sby set] \
2707 -font font_ui
2708 foreach h $all_heads {
2709 $w.source.l insert end $h
2710 if {$h eq $current_branch} {
2711 $w.source.l select set end
2714 scrollbar $w.source.sby -command [list $w.source.l yview]
2715 pack $w.source.sby -side right -fill y
2716 pack $w.source.l -side left -fill both -expand 1
2717 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2719 labelframe $w.dest \
2720 -text {Destination Repository} \
2721 -font font_ui
2722 if {$all_remotes ne {}} {
2723 radiobutton $w.dest.remote_r \
2724 -text {Remote:} \
2725 -value remote \
2726 -variable push_urltype \
2727 -font font_ui
2728 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2729 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2730 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2731 set push_remote origin
2732 } else {
2733 set push_remote [lindex $all_remotes 0]
2735 set push_urltype remote
2736 } else {
2737 set push_urltype url
2739 radiobutton $w.dest.url_r \
2740 -text {Arbitrary URL:} \
2741 -value url \
2742 -variable push_urltype \
2743 -font font_ui
2744 entry $w.dest.url_t \
2745 -borderwidth 1 \
2746 -relief sunken \
2747 -width 50 \
2748 -textvariable push_url \
2749 -font font_ui \
2750 -validate key \
2751 -validatecommand {
2752 if {%d == 1 && [regexp {\s} %S]} {return 0}
2753 if {%d == 1 && [string length %S] > 0} {
2754 set push_urltype url
2756 return 1
2758 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2759 grid columnconfigure $w.dest 1 -weight 1
2760 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2762 labelframe $w.options \
2763 -text {Transfer Options} \
2764 -font font_ui
2765 checkbutton $w.options.thin \
2766 -text {Use thin pack (for slow network connections)} \
2767 -variable push_thin \
2768 -font font_ui
2769 grid $w.options.thin -columnspan 2 -sticky w
2770 checkbutton $w.options.tags \
2771 -text {Include tags} \
2772 -variable push_tags \
2773 -font font_ui
2774 grid $w.options.tags -columnspan 2 -sticky w
2775 grid columnconfigure $w.options 1 -weight 1
2776 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2778 set push_url {}
2779 set push_thin 0
2780 set push_tags 0
2782 bind $w <Visibility> "grab $w"
2783 bind $w <Key-Escape> "destroy $w"
2784 wm title $w "[appname] ([reponame]): Push"
2785 tkwait window $w
2788 ######################################################################
2790 ## merge
2792 proc can_merge {} {
2793 global HEAD commit_type file_states
2795 if {[string match amend* $commit_type]} {
2796 info_popup {Cannot merge while amending.
2798 You must finish amending this commit before
2799 starting any type of merge.
2801 return 0
2804 if {[committer_ident] eq {}} {return 0}
2805 if {![lock_index merge]} {return 0}
2807 # -- Our in memory state should match the repository.
2809 repository_state curType curHEAD curMERGE_HEAD
2810 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2811 info_popup {Last scanned state does not match repository state.
2813 Another Git program has modified this repository
2814 since the last scan. A rescan must be performed
2815 before a merge can be performed.
2817 The rescan will be automatically started now.
2819 unlock_index
2820 rescan {set ui_status_value {Ready.}}
2821 return 0
2824 foreach path [array names file_states] {
2825 switch -glob -- [lindex $file_states($path) 0] {
2826 _O {
2827 continue; # and pray it works!
2829 U? {
2830 error_popup "You are in the middle of a conflicted merge.
2832 File [short_path $path] has merge conflicts.
2834 You must resolve them, add the file, and commit to
2835 complete the current merge. Only then can you
2836 begin another merge.
2838 unlock_index
2839 return 0
2841 ?? {
2842 error_popup "You are in the middle of a change.
2844 File [short_path $path] is modified.
2846 You should complete the current commit before
2847 starting a merge. Doing so will help you abort
2848 a failed merge, should the need arise.
2850 unlock_index
2851 return 0
2856 return 1
2859 proc visualize_local_merge {w} {
2860 set revs {}
2861 foreach i [$w.source.l curselection] {
2862 lappend revs [$w.source.l get $i]
2864 if {$revs eq {}} return
2865 lappend revs --not HEAD
2866 do_gitk $revs
2869 proc start_local_merge_action {w} {
2870 global HEAD ui_status_value current_branch
2872 set cmd [list git merge]
2873 set names {}
2874 set revcnt 0
2875 foreach i [$w.source.l curselection] {
2876 set b [$w.source.l get $i]
2877 lappend cmd $b
2878 lappend names $b
2879 incr revcnt
2882 if {$revcnt == 0} {
2883 return
2884 } elseif {$revcnt == 1} {
2885 set unit branch
2886 } elseif {$revcnt <= 15} {
2887 set unit branches
2888 } else {
2889 tk_messageBox \
2890 -icon error \
2891 -type ok \
2892 -title [wm title $w] \
2893 -parent $w \
2894 -message "Too many branches selected.
2896 You have requested to merge $revcnt branches
2897 in an octopus merge. This exceeds Git's
2898 internal limit of 15 branches per merge.
2900 Please select fewer branches. To merge more
2901 than 15 branches, merge the branches in batches.
2903 return
2906 set msg "Merging $current_branch, [join $names {, }]"
2907 set ui_status_value "$msg..."
2908 set cons [new_console "Merge" $msg]
2909 console_exec $cons $cmd [list finish_merge $revcnt]
2910 bind $w <Destroy> {}
2911 destroy $w
2914 proc finish_merge {revcnt w ok} {
2915 console_done $w $ok
2916 if {$ok} {
2917 set msg {Merge completed successfully.}
2918 } else {
2919 if {$revcnt != 1} {
2920 info_popup "Octopus merge failed.
2922 Your merge of $revcnt branches has failed.
2924 There are file-level conflicts between the
2925 branches which must be resolved manually.
2927 The working directory will now be reset.
2929 You can attempt this merge again
2930 by merging only one branch at a time." $w
2932 set fd [open "| git read-tree --reset -u HEAD" r]
2933 fconfigure $fd -blocking 0 -translation binary
2934 fileevent $fd readable [list reset_hard_wait $fd]
2935 set ui_status_value {Aborting... please wait...}
2936 return
2939 set msg {Merge failed. Conflict resolution is required.}
2941 unlock_index
2942 rescan [list set ui_status_value $msg]
2945 proc do_local_merge {} {
2946 global current_branch
2948 if {![can_merge]} return
2950 set w .merge_setup
2951 toplevel $w
2952 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2954 label $w.header \
2955 -text "Merge Into $current_branch" \
2956 -font font_uibold
2957 pack $w.header -side top -fill x
2959 frame $w.buttons
2960 button $w.buttons.visualize -text Visualize \
2961 -font font_ui \
2962 -command [list visualize_local_merge $w]
2963 pack $w.buttons.visualize -side left
2964 button $w.buttons.create -text Merge \
2965 -font font_ui \
2966 -command [list start_local_merge_action $w]
2967 pack $w.buttons.create -side right
2968 button $w.buttons.cancel -text {Cancel} \
2969 -font font_ui \
2970 -command [list destroy $w]
2971 pack $w.buttons.cancel -side right -padx 5
2972 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2974 labelframe $w.source \
2975 -text {Source Branches} \
2976 -font font_ui
2977 listbox $w.source.l \
2978 -height 10 \
2979 -width 70 \
2980 -selectmode extended \
2981 -yscrollcommand [list $w.source.sby set] \
2982 -font font_ui
2983 scrollbar $w.source.sby -command [list $w.source.l yview]
2984 pack $w.source.sby -side right -fill y
2985 pack $w.source.l -side left -fill both -expand 1
2986 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2988 set cmd [list git for-each-ref]
2989 lappend cmd {--format=%(objectname) %(*objectname) %(refname)}
2990 lappend cmd refs/heads
2991 lappend cmd refs/remotes
2992 lappend cmd refs/tags
2993 set fr_fd [open "| $cmd" r]
2994 fconfigure $fr_fd -translation binary
2995 while {[gets $fr_fd line] > 0} {
2996 set line [split $line { }]
2997 set sha1([lindex $line 0]) [lindex $line 2]
2998 set sha1([lindex $line 1]) [lindex $line 2]
3000 close $fr_fd
3002 set to_show {}
3003 set fr_fd [open "| git rev-list --all --not HEAD"]
3004 while {[gets $fr_fd line] > 0} {
3005 if {[catch {set ref $sha1($line)}]} continue
3006 regsub ^refs/(heads|remotes|tags)/ $ref {} ref
3007 lappend to_show $ref
3009 close $fr_fd
3011 foreach ref [lsort -unique $to_show] {
3012 $w.source.l insert end $ref
3015 bind $w <Visibility> "grab $w"
3016 bind $w <Key-Escape> "unlock_index;destroy $w"
3017 bind $w <Destroy> unlock_index
3018 wm title $w "[appname] ([reponame]): Merge"
3019 tkwait window $w
3022 proc do_reset_hard {} {
3023 global HEAD commit_type file_states
3025 if {[string match amend* $commit_type]} {
3026 info_popup {Cannot abort while amending.
3028 You must finish amending this commit.
3030 return
3033 if {![lock_index abort]} return
3035 if {[string match *merge* $commit_type]} {
3036 set op merge
3037 } else {
3038 set op commit
3041 if {[ask_popup "Abort $op?
3043 Aborting the current $op will cause
3044 *ALL* uncommitted changes to be lost.
3046 Continue with aborting the current $op?"] eq {yes}} {
3047 set fd [open "| git read-tree --reset -u HEAD" r]
3048 fconfigure $fd -blocking 0 -translation binary
3049 fileevent $fd readable [list reset_hard_wait $fd]
3050 set ui_status_value {Aborting... please wait...}
3051 } else {
3052 unlock_index
3056 proc reset_hard_wait {fd} {
3057 global ui_comm
3059 read $fd
3060 if {[eof $fd]} {
3061 close $fd
3062 unlock_index
3064 $ui_comm delete 0.0 end
3065 $ui_comm edit modified false
3067 catch {file delete [gitdir MERGE_HEAD]}
3068 catch {file delete [gitdir rr-cache MERGE_RR]}
3069 catch {file delete [gitdir SQUASH_MSG]}
3070 catch {file delete [gitdir MERGE_MSG]}
3071 catch {file delete [gitdir GITGUI_MSG]}
3073 rescan {set ui_status_value {Abort completed. Ready.}}
3077 ######################################################################
3079 ## browser
3081 set next_browser_id 0
3083 proc new_browser {commit} {
3084 global next_browser_id cursor_ptr M1B
3085 global browser_commit browser_status browser_stack browser_path browser_busy
3087 if {[winfo ismapped .]} {
3088 set w .browser[incr next_browser_id]
3089 set tl $w
3090 toplevel $w
3091 } else {
3092 set w {}
3093 set tl .
3095 set w_list $w.list.l
3096 set browser_commit($w_list) $commit
3097 set browser_status($w_list) {Starting...}
3098 set browser_stack($w_list) {}
3099 set browser_path($w_list) $browser_commit($w_list):
3100 set browser_busy($w_list) 1
3102 label $w.path -textvariable browser_path($w_list) \
3103 -anchor w \
3104 -justify left \
3105 -borderwidth 1 \
3106 -relief sunken \
3107 -font font_uibold
3108 pack $w.path -anchor w -side top -fill x
3110 frame $w.list
3111 text $w_list -background white -borderwidth 0 \
3112 -cursor $cursor_ptr \
3113 -state disabled \
3114 -wrap none \
3115 -height 20 \
3116 -width 70 \
3117 -xscrollcommand [list $w.list.sbx set] \
3118 -yscrollcommand [list $w.list.sby set] \
3119 -font font_ui
3120 $w_list tag conf in_sel \
3121 -background [$w_list cget -foreground] \
3122 -foreground [$w_list cget -background]
3123 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3124 scrollbar $w.list.sby -orient v -command [list $w_list yview]
3125 pack $w.list.sbx -side bottom -fill x
3126 pack $w.list.sby -side right -fill y
3127 pack $w_list -side left -fill both -expand 1
3128 pack $w.list -side top -fill both -expand 1
3130 label $w.status -textvariable browser_status($w_list) \
3131 -anchor w \
3132 -justify left \
3133 -borderwidth 1 \
3134 -relief sunken \
3135 -font font_ui
3136 pack $w.status -anchor w -side bottom -fill x
3138 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3139 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3140 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3141 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3142 bind $w_list <Up> "browser_move -1 $w_list;break"
3143 bind $w_list <Down> "browser_move 1 $w_list;break"
3144 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3145 bind $w_list <Return> "browser_enter $w_list;break"
3146 bind $w_list <Prior> "browser_page -1 $w_list;break"
3147 bind $w_list <Next> "browser_page 1 $w_list;break"
3148 bind $w_list <Left> break
3149 bind $w_list <Right> break
3151 bind $tl <Visibility> "focus $w"
3152 bind $tl <Destroy> "
3153 array unset browser_buffer $w_list
3154 array unset browser_files $w_list
3155 array unset browser_status $w_list
3156 array unset browser_stack $w_list
3157 array unset browser_path $w_list
3158 array unset browser_commit $w_list
3159 array unset browser_busy $w_list
3161 wm title $tl "[appname] ([reponame]): File Browser"
3162 ls_tree $w_list $browser_commit($w_list) {}
3165 proc browser_move {dir w} {
3166 global browser_files browser_busy
3168 if {$browser_busy($w)} return
3169 set lno [lindex [split [$w index in_sel.first] .] 0]
3170 incr lno $dir
3171 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3172 $w tag remove in_sel 0.0 end
3173 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3174 $w see $lno.0
3178 proc browser_page {dir w} {
3179 global browser_files browser_busy
3181 if {$browser_busy($w)} return
3182 $w yview scroll $dir pages
3183 set lno [expr {int(
3184 [lindex [$w yview] 0]
3185 * [llength $browser_files($w)]
3186 + 1)}]
3187 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3188 $w tag remove in_sel 0.0 end
3189 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3190 $w see $lno.0
3194 proc browser_parent {w} {
3195 global browser_files browser_status browser_path
3196 global browser_stack browser_busy
3198 if {$browser_busy($w)} return
3199 set info [lindex $browser_files($w) 0]
3200 if {[lindex $info 0] eq {parent}} {
3201 set parent [lindex $browser_stack($w) end-1]
3202 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3203 if {$browser_stack($w) eq {}} {
3204 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3205 } else {
3206 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3208 set browser_status($w) "Loading $browser_path($w)..."
3209 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3213 proc browser_enter {w} {
3214 global browser_files browser_status browser_path
3215 global browser_commit browser_stack browser_busy
3217 if {$browser_busy($w)} return
3218 set lno [lindex [split [$w index in_sel.first] .] 0]
3219 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3220 if {$info ne {}} {
3221 switch -- [lindex $info 0] {
3222 parent {
3223 browser_parent $w
3225 tree {
3226 set name [lindex $info 2]
3227 set escn [escape_path $name]
3228 set browser_status($w) "Loading $escn..."
3229 append browser_path($w) $escn
3230 ls_tree $w [lindex $info 1] $name
3232 blob {
3233 set name [lindex $info 2]
3234 set p {}
3235 foreach n $browser_stack($w) {
3236 append p [lindex $n 1]
3238 append p $name
3239 show_blame $browser_commit($w) $p
3245 proc browser_click {was_double_click w pos} {
3246 global browser_files browser_busy
3248 if {$browser_busy($w)} return
3249 set lno [lindex [split [$w index $pos] .] 0]
3250 focus $w
3252 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3253 $w tag remove in_sel 0.0 end
3254 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3255 if {$was_double_click} {
3256 browser_enter $w
3261 proc ls_tree {w tree_id name} {
3262 global browser_buffer browser_files browser_stack browser_busy
3264 set browser_buffer($w) {}
3265 set browser_files($w) {}
3266 set browser_busy($w) 1
3268 $w conf -state normal
3269 $w tag remove in_sel 0.0 end
3270 $w delete 0.0 end
3271 if {$browser_stack($w) ne {}} {
3272 $w image create end \
3273 -align center -padx 5 -pady 1 \
3274 -name icon0 \
3275 -image file_uplevel
3276 $w insert end {[Up To Parent]}
3277 lappend browser_files($w) parent
3279 lappend browser_stack($w) [list $tree_id $name]
3280 $w conf -state disabled
3282 set cmd [list git ls-tree -z $tree_id]
3283 set fd [open "| $cmd" r]
3284 fconfigure $fd -blocking 0 -translation binary -encoding binary
3285 fileevent $fd readable [list read_ls_tree $fd $w]
3288 proc read_ls_tree {fd w} {
3289 global browser_buffer browser_files browser_status browser_busy
3291 if {![winfo exists $w]} {
3292 catch {close $fd}
3293 return
3296 append browser_buffer($w) [read $fd]
3297 set pck [split $browser_buffer($w) "\0"]
3298 set browser_buffer($w) [lindex $pck end]
3300 set n [llength $browser_files($w)]
3301 $w conf -state normal
3302 foreach p [lrange $pck 0 end-1] {
3303 set info [split $p "\t"]
3304 set path [lindex $info 1]
3305 set info [split [lindex $info 0] { }]
3306 set type [lindex $info 1]
3307 set object [lindex $info 2]
3309 switch -- $type {
3310 blob {
3311 set image file_mod
3313 tree {
3314 set image file_dir
3315 append path /
3317 default {
3318 set image file_question
3322 if {$n > 0} {$w insert end "\n"}
3323 $w image create end \
3324 -align center -padx 5 -pady 1 \
3325 -name icon[incr n] \
3326 -image $image
3327 $w insert end [escape_path $path]
3328 lappend browser_files($w) [list $type $object $path]
3330 $w conf -state disabled
3332 if {[eof $fd]} {
3333 close $fd
3334 set browser_status($w) Ready.
3335 set browser_busy($w) 0
3336 array unset browser_buffer $w
3337 if {$n > 0} {
3338 $w tag add in_sel 1.0 2.0
3339 focus -force $w
3344 proc show_blame {commit path} {
3345 global next_browser_id blame_status blame_data
3347 if {[winfo ismapped .]} {
3348 set w .browser[incr next_browser_id]
3349 set tl $w
3350 toplevel $w
3351 } else {
3352 set w {}
3353 set tl .
3355 set blame_status($w) {Loading current file content...}
3357 label $w.path -text "$commit:$path" \
3358 -anchor w \
3359 -justify left \
3360 -borderwidth 1 \
3361 -relief sunken \
3362 -font font_uibold
3363 pack $w.path -side top -fill x
3365 frame $w.out
3366 text $w.out.loaded_t \
3367 -background white -borderwidth 0 \
3368 -state disabled \
3369 -wrap none \
3370 -height 40 \
3371 -width 1 \
3372 -font font_diff
3373 $w.out.loaded_t tag conf annotated -background grey
3375 text $w.out.linenumber_t \
3376 -background white -borderwidth 0 \
3377 -state disabled \
3378 -wrap none \
3379 -height 40 \
3380 -width 5 \
3381 -font font_diff
3382 $w.out.linenumber_t tag conf linenumber -justify right
3384 text $w.out.file_t \
3385 -background white -borderwidth 0 \
3386 -state disabled \
3387 -wrap none \
3388 -height 40 \
3389 -width 80 \
3390 -xscrollcommand [list $w.out.sbx set] \
3391 -font font_diff
3393 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3394 scrollbar $w.out.sby -orient v \
3395 -command [list scrollbar2many [list \
3396 $w.out.loaded_t \
3397 $w.out.linenumber_t \
3398 $w.out.file_t \
3399 ] yview]
3400 grid \
3401 $w.out.linenumber_t \
3402 $w.out.loaded_t \
3403 $w.out.file_t \
3404 $w.out.sby \
3405 -sticky nsew
3406 grid conf $w.out.sbx -column 2 -sticky we
3407 grid columnconfigure $w.out 2 -weight 1
3408 grid rowconfigure $w.out 0 -weight 1
3409 pack $w.out -fill both -expand 1
3411 label $w.status -textvariable blame_status($w) \
3412 -anchor w \
3413 -justify left \
3414 -borderwidth 1 \
3415 -relief sunken \
3416 -font font_ui
3417 pack $w.status -side bottom -fill x
3419 frame $w.cm
3420 text $w.cm.t \
3421 -background white -borderwidth 0 \
3422 -state disabled \
3423 -wrap none \
3424 -height 10 \
3425 -width 80 \
3426 -xscrollcommand [list $w.cm.sbx set] \
3427 -yscrollcommand [list $w.cm.sby set] \
3428 -font font_diff
3429 scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3430 scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3431 pack $w.cm.sby -side right -fill y
3432 pack $w.cm.sbx -side bottom -fill x
3433 pack $w.cm.t -expand 1 -fill both
3434 pack $w.cm -side bottom -fill x
3436 menu $w.ctxm -tearoff 0
3437 $w.ctxm add command -label "Copy Commit" \
3438 -font font_ui \
3439 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3441 foreach i [list \
3442 $w.out.loaded_t \
3443 $w.out.linenumber_t \
3444 $w.out.file_t] {
3445 $i tag conf in_sel \
3446 -background [$i cget -foreground] \
3447 -foreground [$i cget -background]
3448 $i conf -yscrollcommand \
3449 [list many2scrollbar [list \
3450 $w.out.loaded_t \
3451 $w.out.linenumber_t \
3452 $w.out.file_t \
3453 ] yview $w.out.sby]
3454 bind $i <Button-1> "
3455 blame_click {$w} \\
3456 $w.cm.t \\
3457 $w.out.linenumber_t \\
3458 $w.out.file_t \\
3459 $i @%x,%y
3460 focus $i
3462 bind_button3 $i "
3463 set cursorX %x
3464 set cursorY %y
3465 set cursorW %W
3466 tk_popup $w.ctxm %X %Y
3470 bind $w.cm.t <Button-1> "focus $w.cm.t"
3471 bind $tl <Visibility> "focus $tl"
3472 bind $tl <Destroy> "
3473 array unset blame_status {$w}
3474 array unset blame_data $w,*
3476 wm title $tl "[appname] ([reponame]): File Viewer"
3478 set blame_data($w,commit_count) 0
3479 set blame_data($w,commit_list) {}
3480 set blame_data($w,total_lines) 0
3481 set blame_data($w,blame_lines) 0
3482 set blame_data($w,highlight_commit) {}
3483 set blame_data($w,highlight_line) -1
3485 set cmd [list git cat-file blob "$commit:$path"]
3486 set fd [open "| $cmd" r]
3487 fconfigure $fd -blocking 0 -translation lf -encoding binary
3488 fileevent $fd readable [list read_blame_catfile \
3489 $fd $w $commit $path \
3490 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3493 proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3494 global blame_status blame_data
3496 if {![winfo exists $w_file]} {
3497 catch {close $fd}
3498 return
3501 set n $blame_data($w,total_lines)
3502 $w_load conf -state normal
3503 $w_line conf -state normal
3504 $w_file conf -state normal
3505 while {[gets $fd line] >= 0} {
3506 regsub "\r\$" $line {} line
3507 incr n
3508 $w_load insert end "\n"
3509 $w_line insert end "$n\n" linenumber
3510 $w_file insert end "$line\n"
3512 $w_load conf -state disabled
3513 $w_line conf -state disabled
3514 $w_file conf -state disabled
3515 set blame_data($w,total_lines) $n
3517 if {[eof $fd]} {
3518 close $fd
3519 blame_incremental_status $w
3520 set cmd [list git blame -M -C --incremental]
3521 lappend cmd $commit -- $path
3522 set fd [open "| $cmd" r]
3523 fconfigure $fd -blocking 0 -translation lf -encoding binary
3524 fileevent $fd readable [list read_blame_incremental $fd $w \
3525 $w_load $w_cmit $w_line $w_file]
3529 proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3530 global blame_status blame_data
3532 if {![winfo exists $w_file]} {
3533 catch {close $fd}
3534 return
3537 while {[gets $fd line] >= 0} {
3538 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3539 cmit original_line final_line line_count]} {
3540 set blame_data($w,commit) $cmit
3541 set blame_data($w,original_line) $original_line
3542 set blame_data($w,final_line) $final_line
3543 set blame_data($w,line_count) $line_count
3545 if {[catch {set g $blame_data($w,$cmit,order)}]} {
3546 $w_line tag conf g$cmit
3547 $w_file tag conf g$cmit
3548 $w_line tag raise in_sel
3549 $w_file tag raise in_sel
3550 $w_file tag raise sel
3551 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3552 incr blame_data($w,commit_count)
3553 lappend blame_data($w,commit_list) $cmit
3555 } elseif {[string match {filename *} $line]} {
3556 set file [string range $line 9 end]
3557 set n $blame_data($w,line_count)
3558 set lno $blame_data($w,final_line)
3559 set cmit $blame_data($w,commit)
3561 while {$n > 0} {
3562 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3563 $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3564 } else {
3565 $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3566 $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3569 set blame_data($w,line$lno,commit) $cmit
3570 set blame_data($w,line$lno,file) $file
3571 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3572 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3574 if {$blame_data($w,highlight_line) == -1} {
3575 if {[lindex [$w_file yview] 0] == 0} {
3576 $w_file see $lno.0
3577 blame_showcommit $w $w_cmit $w_line $w_file $lno
3579 } elseif {$blame_data($w,highlight_line) == $lno} {
3580 blame_showcommit $w $w_cmit $w_line $w_file $lno
3583 incr n -1
3584 incr lno
3585 incr blame_data($w,blame_lines)
3588 set hc $blame_data($w,highlight_commit)
3589 if {$hc ne {}
3590 && [expr {$blame_data($w,$hc,order) + 1}]
3591 == $blame_data($w,$cmit,order)} {
3592 blame_showcommit $w $w_cmit $w_line $w_file \
3593 $blame_data($w,highlight_line)
3595 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3596 set blame_data($w,$blame_data($w,commit),$header) $data
3600 if {[eof $fd]} {
3601 close $fd
3602 set blame_status($w) {Annotation complete.}
3603 } else {
3604 blame_incremental_status $w
3608 proc blame_incremental_status {w} {
3609 global blame_status blame_data
3611 set blame_status($w) [format \
3612 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3613 $blame_data($w,blame_lines) \
3614 $blame_data($w,total_lines) \
3615 [expr {100 * $blame_data($w,blame_lines)
3616 / $blame_data($w,total_lines)}]]
3619 proc blame_click {w w_cmit w_line w_file cur_w pos} {
3620 set lno [lindex [split [$cur_w index $pos] .] 0]
3621 if {$lno eq {}} return
3623 $w_line tag remove in_sel 0.0 end
3624 $w_file tag remove in_sel 0.0 end
3625 $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3626 $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3628 blame_showcommit $w $w_cmit $w_line $w_file $lno
3631 set blame_colors {
3632 #ff4040
3633 #ff40ff
3634 #4040ff
3637 proc blame_showcommit {w w_cmit w_line w_file lno} {
3638 global blame_colors blame_data repo_config
3640 set cmit $blame_data($w,highlight_commit)
3641 if {$cmit ne {}} {
3642 set idx $blame_data($w,$cmit,order)
3643 set i 0
3644 foreach c $blame_colors {
3645 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3646 $w_line tag conf g$h -background white
3647 $w_file tag conf g$h -background white
3648 incr i
3652 $w_cmit conf -state normal
3653 $w_cmit delete 0.0 end
3654 if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3655 set cmit {}
3656 $w_cmit insert end "Loading annotation..."
3657 } else {
3658 set idx $blame_data($w,$cmit,order)
3659 set i 0
3660 foreach c $blame_colors {
3661 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3662 $w_line tag conf g$h -background $c
3663 $w_file tag conf g$h -background $c
3664 incr i
3667 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3668 set msg {}
3669 catch {
3670 set fd [open "| git cat-file commit $cmit" r]
3671 fconfigure $fd -encoding binary -translation lf
3672 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3673 set enc utf-8
3675 while {[gets $fd line] > 0} {
3676 if {[string match {encoding *} $line]} {
3677 set enc [string tolower [string range $line 9 end]]
3680 fconfigure $fd -encoding $enc
3681 set msg [string trim [read $fd]]
3682 close $fd
3684 set blame_data($w,$cmit,message) $msg
3687 set author_name {}
3688 set author_email {}
3689 set author_time {}
3690 catch {set author_name $blame_data($w,$cmit,author)}
3691 catch {set author_email $blame_data($w,$cmit,author-mail)}
3692 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3694 set committer_name {}
3695 set committer_email {}
3696 set committer_time {}
3697 catch {set committer_name $blame_data($w,$cmit,committer)}
3698 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3699 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3701 $w_cmit insert end "commit $cmit\n"
3702 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3703 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3704 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3705 $w_cmit insert end "\n"
3706 $w_cmit insert end $msg
3708 $w_cmit conf -state disabled
3710 set blame_data($w,highlight_line) $lno
3711 set blame_data($w,highlight_commit) $cmit
3714 proc blame_copycommit {w i pos} {
3715 global blame_data
3716 set lno [lindex [split [$i index $pos] .] 0]
3717 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3718 clipboard clear
3719 clipboard append \
3720 -format STRING \
3721 -type STRING \
3722 -- $commit
3726 ######################################################################
3728 ## icons
3730 set filemask {
3731 #define mask_width 14
3732 #define mask_height 15
3733 static unsigned char mask_bits[] = {
3734 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3735 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3736 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3739 image create bitmap file_plain -background white -foreground black -data {
3740 #define plain_width 14
3741 #define plain_height 15
3742 static unsigned char plain_bits[] = {
3743 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3744 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3745 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3746 } -maskdata $filemask
3748 image create bitmap file_mod -background white -foreground blue -data {
3749 #define mod_width 14
3750 #define mod_height 15
3751 static unsigned char mod_bits[] = {
3752 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3753 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3754 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3755 } -maskdata $filemask
3757 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3758 #define file_fulltick_width 14
3759 #define file_fulltick_height 15
3760 static unsigned char file_fulltick_bits[] = {
3761 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3762 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3763 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3764 } -maskdata $filemask
3766 image create bitmap file_parttick -background white -foreground "#005050" -data {
3767 #define parttick_width 14
3768 #define parttick_height 15
3769 static unsigned char parttick_bits[] = {
3770 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3771 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3772 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3773 } -maskdata $filemask
3775 image create bitmap file_question -background white -foreground black -data {
3776 #define file_question_width 14
3777 #define file_question_height 15
3778 static unsigned char file_question_bits[] = {
3779 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3780 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3781 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3782 } -maskdata $filemask
3784 image create bitmap file_removed -background white -foreground red -data {
3785 #define file_removed_width 14
3786 #define file_removed_height 15
3787 static unsigned char file_removed_bits[] = {
3788 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3789 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3790 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3791 } -maskdata $filemask
3793 image create bitmap file_merge -background white -foreground blue -data {
3794 #define file_merge_width 14
3795 #define file_merge_height 15
3796 static unsigned char file_merge_bits[] = {
3797 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3798 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3799 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3800 } -maskdata $filemask
3802 set file_dir_data {
3803 #define file_width 18
3804 #define file_height 18
3805 static unsigned char file_bits[] = {
3806 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3807 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3808 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3809 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3810 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3812 image create bitmap file_dir -background white -foreground blue \
3813 -data $file_dir_data -maskdata $file_dir_data
3814 unset file_dir_data
3816 set file_uplevel_data {
3817 #define up_width 15
3818 #define up_height 15
3819 static unsigned char up_bits[] = {
3820 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3821 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3822 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3824 image create bitmap file_uplevel -background white -foreground red \
3825 -data $file_uplevel_data -maskdata $file_uplevel_data
3826 unset file_uplevel_data
3828 set ui_index .vpane.files.index.list
3829 set ui_workdir .vpane.files.workdir.list
3831 set all_icons(_$ui_index) file_plain
3832 set all_icons(A$ui_index) file_fulltick
3833 set all_icons(M$ui_index) file_fulltick
3834 set all_icons(D$ui_index) file_removed
3835 set all_icons(U$ui_index) file_merge
3837 set all_icons(_$ui_workdir) file_plain
3838 set all_icons(M$ui_workdir) file_mod
3839 set all_icons(D$ui_workdir) file_question
3840 set all_icons(U$ui_workdir) file_merge
3841 set all_icons(O$ui_workdir) file_plain
3843 set max_status_desc 0
3844 foreach i {
3845 {__ "Unmodified"}
3847 {_M "Modified, not staged"}
3848 {M_ "Staged for commit"}
3849 {MM "Portions staged for commit"}
3850 {MD "Staged for commit, missing"}
3852 {_O "Untracked, not staged"}
3853 {A_ "Staged for commit"}
3854 {AM "Portions staged for commit"}
3855 {AD "Staged for commit, missing"}
3857 {_D "Missing"}
3858 {D_ "Staged for removal"}
3859 {DO "Staged for removal, still present"}
3861 {U_ "Requires merge resolution"}
3862 {UU "Requires merge resolution"}
3863 {UM "Requires merge resolution"}
3864 {UD "Requires merge resolution"}
3866 if {$max_status_desc < [string length [lindex $i 1]]} {
3867 set max_status_desc [string length [lindex $i 1]]
3869 set all_descs([lindex $i 0]) [lindex $i 1]
3871 unset i
3873 ######################################################################
3875 ## util
3877 proc bind_button3 {w cmd} {
3878 bind $w <Any-Button-3> $cmd
3879 if {[is_MacOSX]} {
3880 bind $w <Control-Button-1> $cmd
3884 proc scrollbar2many {list mode args} {
3885 foreach w $list {eval $w $mode $args}
3888 proc many2scrollbar {list mode sb top bottom} {
3889 $sb set $top $bottom
3890 foreach w $list {$w $mode moveto $top}
3893 proc incr_font_size {font {amt 1}} {
3894 set sz [font configure $font -size]
3895 incr sz $amt
3896 font configure $font -size $sz
3897 font configure ${font}bold -size $sz
3900 proc hook_failed_popup {hook msg} {
3901 set w .hookfail
3902 toplevel $w
3904 frame $w.m
3905 label $w.m.l1 -text "$hook hook failed:" \
3906 -anchor w \
3907 -justify left \
3908 -font font_uibold
3909 text $w.m.t \
3910 -background white -borderwidth 1 \
3911 -relief sunken \
3912 -width 80 -height 10 \
3913 -font font_diff \
3914 -yscrollcommand [list $w.m.sby set]
3915 label $w.m.l2 \
3916 -text {You must correct the above errors before committing.} \
3917 -anchor w \
3918 -justify left \
3919 -font font_uibold
3920 scrollbar $w.m.sby -command [list $w.m.t yview]
3921 pack $w.m.l1 -side top -fill x
3922 pack $w.m.l2 -side bottom -fill x
3923 pack $w.m.sby -side right -fill y
3924 pack $w.m.t -side left -fill both -expand 1
3925 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3927 $w.m.t insert 1.0 $msg
3928 $w.m.t conf -state disabled
3930 button $w.ok -text OK \
3931 -width 15 \
3932 -font font_ui \
3933 -command "destroy $w"
3934 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3936 bind $w <Visibility> "grab $w; focus $w"
3937 bind $w <Key-Return> "destroy $w"
3938 wm title $w "[appname] ([reponame]): error"
3939 tkwait window $w
3942 set next_console_id 0
3944 proc new_console {short_title long_title} {
3945 global next_console_id console_data
3946 set w .console[incr next_console_id]
3947 set console_data($w) [list $short_title $long_title]
3948 return [console_init $w]
3951 proc console_init {w} {
3952 global console_cr console_data M1B
3954 set console_cr($w) 1.0
3955 toplevel $w
3956 frame $w.m
3957 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3958 -anchor w \
3959 -justify left \
3960 -font font_uibold
3961 text $w.m.t \
3962 -background white -borderwidth 1 \
3963 -relief sunken \
3964 -width 80 -height 10 \
3965 -font font_diff \
3966 -state disabled \
3967 -yscrollcommand [list $w.m.sby set]
3968 label $w.m.s -text {Working... please wait...} \
3969 -anchor w \
3970 -justify left \
3971 -font font_uibold
3972 scrollbar $w.m.sby -command [list $w.m.t yview]
3973 pack $w.m.l1 -side top -fill x
3974 pack $w.m.s -side bottom -fill x
3975 pack $w.m.sby -side right -fill y
3976 pack $w.m.t -side left -fill both -expand 1
3977 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3979 menu $w.ctxm -tearoff 0
3980 $w.ctxm add command -label "Copy" \
3981 -font font_ui \
3982 -command "tk_textCopy $w.m.t"
3983 $w.ctxm add command -label "Select All" \
3984 -font font_ui \
3985 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3986 $w.ctxm add command -label "Copy All" \
3987 -font font_ui \
3988 -command "
3989 $w.m.t tag add sel 0.0 end
3990 tk_textCopy $w.m.t
3991 $w.m.t tag remove sel 0.0 end
3994 button $w.ok -text {Close} \
3995 -font font_ui \
3996 -state disabled \
3997 -command "destroy $w"
3998 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
4000 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
4001 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
4002 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
4003 bind $w <Visibility> "focus $w"
4004 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
4005 return $w
4008 proc console_exec {w cmd after} {
4009 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
4010 # But most users need that so we have to relogin. :-(
4012 if {[is_Cygwin]} {
4013 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
4016 # -- Tcl won't let us redirect both stdout and stderr to
4017 # the same pipe. So pass it through cat...
4019 set cmd [concat | $cmd |& cat]
4021 set fd_f [open $cmd r]
4022 fconfigure $fd_f -blocking 0 -translation binary
4023 fileevent $fd_f readable [list console_read $w $fd_f $after]
4026 proc console_read {w fd after} {
4027 global console_cr
4029 set buf [read $fd]
4030 if {$buf ne {}} {
4031 if {![winfo exists $w]} {console_init $w}
4032 $w.m.t conf -state normal
4033 set c 0
4034 set n [string length $buf]
4035 while {$c < $n} {
4036 set cr [string first "\r" $buf $c]
4037 set lf [string first "\n" $buf $c]
4038 if {$cr < 0} {set cr [expr {$n + 1}]}
4039 if {$lf < 0} {set lf [expr {$n + 1}]}
4041 if {$lf < $cr} {
4042 $w.m.t insert end [string range $buf $c $lf]
4043 set console_cr($w) [$w.m.t index {end -1c}]
4044 set c $lf
4045 incr c
4046 } else {
4047 $w.m.t delete $console_cr($w) end
4048 $w.m.t insert end "\n"
4049 $w.m.t insert end [string range $buf $c $cr]
4050 set c $cr
4051 incr c
4054 $w.m.t conf -state disabled
4055 $w.m.t see end
4058 fconfigure $fd -blocking 1
4059 if {[eof $fd]} {
4060 if {[catch {close $fd}]} {
4061 set ok 0
4062 } else {
4063 set ok 1
4065 uplevel #0 $after $w $ok
4066 return
4068 fconfigure $fd -blocking 0
4071 proc console_chain {cmdlist w {ok 1}} {
4072 if {$ok} {
4073 if {[llength $cmdlist] == 0} {
4074 console_done $w $ok
4075 return
4078 set cmd [lindex $cmdlist 0]
4079 set cmdlist [lrange $cmdlist 1 end]
4081 if {[lindex $cmd 0] eq {console_exec}} {
4082 console_exec $w \
4083 [lindex $cmd 1] \
4084 [list console_chain $cmdlist]
4085 } else {
4086 uplevel #0 $cmd $cmdlist $w $ok
4088 } else {
4089 console_done $w $ok
4093 proc console_done {args} {
4094 global console_cr console_data
4096 switch -- [llength $args] {
4098 set w [lindex $args 0]
4099 set ok [lindex $args 1]
4102 set w [lindex $args 1]
4103 set ok [lindex $args 2]
4105 default {
4106 error "wrong number of args: console_done ?ignored? w ok"
4110 if {$ok} {
4111 if {[winfo exists $w]} {
4112 $w.m.s conf -background green -text {Success}
4113 $w.ok conf -state normal
4115 } else {
4116 if {![winfo exists $w]} {
4117 console_init $w
4119 $w.m.s conf -background red -text {Error: Command Failed}
4120 $w.ok conf -state normal
4123 array unset console_cr $w
4124 array unset console_data $w
4127 ######################################################################
4129 ## ui commands
4131 set starting_gitk_msg {Starting gitk... please wait...}
4133 proc do_gitk {revs} {
4134 global env ui_status_value starting_gitk_msg
4136 # -- Always start gitk through whatever we were loaded with. This
4137 # lets us bypass using shell process on Windows systems.
4139 set cmd [info nameofexecutable]
4140 lappend cmd [gitexec gitk]
4141 if {$revs ne {}} {
4142 append cmd { }
4143 append cmd $revs
4146 if {[catch {eval exec $cmd &} err]} {
4147 error_popup "Failed to start gitk:\n\n$err"
4148 } else {
4149 set ui_status_value $starting_gitk_msg
4150 after 10000 {
4151 if {$ui_status_value eq $starting_gitk_msg} {
4152 set ui_status_value {Ready.}
4158 proc do_stats {} {
4159 set fd [open "| git count-objects -v" r]
4160 while {[gets $fd line] > 0} {
4161 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4162 set stats($name) $value
4165 close $fd
4167 set packed_sz 0
4168 foreach p [glob -directory [gitdir objects pack] \
4169 -type f \
4170 -nocomplain -- *] {
4171 incr packed_sz [file size $p]
4173 if {$packed_sz > 0} {
4174 set stats(size-pack) [expr {$packed_sz / 1024}]
4177 set w .stats_view
4178 toplevel $w
4179 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4181 label $w.header -text {Database Statistics} \
4182 -font font_uibold
4183 pack $w.header -side top -fill x
4185 frame $w.buttons -border 1
4186 button $w.buttons.close -text Close \
4187 -font font_ui \
4188 -command [list destroy $w]
4189 button $w.buttons.gc -text {Compress Database} \
4190 -font font_ui \
4191 -command "destroy $w;do_gc"
4192 pack $w.buttons.close -side right
4193 pack $w.buttons.gc -side left
4194 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4196 frame $w.stat -borderwidth 1 -relief solid
4197 foreach s {
4198 {count {Number of loose objects}}
4199 {size {Disk space used by loose objects} { KiB}}
4200 {in-pack {Number of packed objects}}
4201 {packs {Number of packs}}
4202 {size-pack {Disk space used by packed objects} { KiB}}
4203 {prune-packable {Packed objects waiting for pruning}}
4204 {garbage {Garbage files}}
4206 set name [lindex $s 0]
4207 set label [lindex $s 1]
4208 if {[catch {set value $stats($name)}]} continue
4209 if {[llength $s] > 2} {
4210 set value "$value[lindex $s 2]"
4213 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4214 label $w.stat.v_$name -text $value -anchor w -font font_ui
4215 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4217 pack $w.stat -pady 10 -padx 10
4219 bind $w <Visibility> "grab $w; focus $w"
4220 bind $w <Key-Escape> [list destroy $w]
4221 bind $w <Key-Return> [list destroy $w]
4222 wm title $w "[appname] ([reponame]): Database Statistics"
4223 tkwait window $w
4226 proc do_gc {} {
4227 set w [new_console {gc} {Compressing the object database}]
4228 console_chain {
4229 {console_exec {git pack-refs --prune}}
4230 {console_exec {git reflog expire --all}}
4231 {console_exec {git repack -a -d -l}}
4232 {console_exec {git rerere gc}}
4233 } $w
4236 proc do_fsck_objects {} {
4237 set w [new_console {fsck-objects} \
4238 {Verifying the object database with fsck-objects}]
4239 set cmd [list git fsck-objects]
4240 lappend cmd --full
4241 lappend cmd --cache
4242 lappend cmd --strict
4243 console_exec $w $cmd console_done
4246 set is_quitting 0
4248 proc do_quit {} {
4249 global ui_comm is_quitting repo_config commit_type
4251 if {$is_quitting} return
4252 set is_quitting 1
4254 if {[winfo exists $ui_comm]} {
4255 # -- Stash our current commit buffer.
4257 set save [gitdir GITGUI_MSG]
4258 set msg [string trim [$ui_comm get 0.0 end]]
4259 regsub -all -line {[ \r\t]+$} $msg {} msg
4260 if {(![string match amend* $commit_type]
4261 || [$ui_comm edit modified])
4262 && $msg ne {}} {
4263 catch {
4264 set fd [open $save w]
4265 puts -nonewline $fd $msg
4266 close $fd
4268 } else {
4269 catch {file delete $save}
4272 # -- Stash our current window geometry into this repository.
4274 set cfg_geometry [list]
4275 lappend cfg_geometry [wm geometry .]
4276 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4277 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4278 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4279 set rc_geometry {}
4281 if {$cfg_geometry ne $rc_geometry} {
4282 catch {git config gui.geometry $cfg_geometry}
4286 destroy .
4289 proc do_rescan {} {
4290 rescan {set ui_status_value {Ready.}}
4293 proc unstage_helper {txt paths} {
4294 global file_states current_diff_path
4296 if {![lock_index begin-update]} return
4298 set pathList [list]
4299 set after {}
4300 foreach path $paths {
4301 switch -glob -- [lindex $file_states($path) 0] {
4302 A? -
4303 M? -
4304 D? {
4305 lappend pathList $path
4306 if {$path eq $current_diff_path} {
4307 set after {reshow_diff;}
4312 if {$pathList eq {}} {
4313 unlock_index
4314 } else {
4315 update_indexinfo \
4316 $txt \
4317 $pathList \
4318 [concat $after {set ui_status_value {Ready.}}]
4322 proc do_unstage_selection {} {
4323 global current_diff_path selected_paths
4325 if {[array size selected_paths] > 0} {
4326 unstage_helper \
4327 {Unstaging selected files from commit} \
4328 [array names selected_paths]
4329 } elseif {$current_diff_path ne {}} {
4330 unstage_helper \
4331 "Unstaging [short_path $current_diff_path] from commit" \
4332 [list $current_diff_path]
4336 proc add_helper {txt paths} {
4337 global file_states current_diff_path
4339 if {![lock_index begin-update]} return
4341 set pathList [list]
4342 set after {}
4343 foreach path $paths {
4344 switch -glob -- [lindex $file_states($path) 0] {
4345 _O -
4346 ?M -
4347 ?D -
4348 U? {
4349 lappend pathList $path
4350 if {$path eq $current_diff_path} {
4351 set after {reshow_diff;}
4356 if {$pathList eq {}} {
4357 unlock_index
4358 } else {
4359 update_index \
4360 $txt \
4361 $pathList \
4362 [concat $after {set ui_status_value {Ready to commit.}}]
4366 proc do_add_selection {} {
4367 global current_diff_path selected_paths
4369 if {[array size selected_paths] > 0} {
4370 add_helper \
4371 {Adding selected files} \
4372 [array names selected_paths]
4373 } elseif {$current_diff_path ne {}} {
4374 add_helper \
4375 "Adding [short_path $current_diff_path]" \
4376 [list $current_diff_path]
4380 proc do_add_all {} {
4381 global file_states
4383 set paths [list]
4384 foreach path [array names file_states] {
4385 switch -glob -- [lindex $file_states($path) 0] {
4386 U? {continue}
4387 ?M -
4388 ?D {lappend paths $path}
4391 add_helper {Adding all changed files} $paths
4394 proc revert_helper {txt paths} {
4395 global file_states current_diff_path
4397 if {![lock_index begin-update]} return
4399 set pathList [list]
4400 set after {}
4401 foreach path $paths {
4402 switch -glob -- [lindex $file_states($path) 0] {
4403 U? {continue}
4404 ?M -
4405 ?D {
4406 lappend pathList $path
4407 if {$path eq $current_diff_path} {
4408 set after {reshow_diff;}
4414 set n [llength $pathList]
4415 if {$n == 0} {
4416 unlock_index
4417 return
4418 } elseif {$n == 1} {
4419 set s "[short_path [lindex $pathList]]"
4420 } else {
4421 set s "these $n files"
4424 set reply [tk_dialog \
4425 .confirm_revert \
4426 "[appname] ([reponame])" \
4427 "Revert changes in $s?
4429 Any unadded changes will be permanently lost by the revert." \
4430 question \
4432 {Do Nothing} \
4433 {Revert Changes} \
4435 if {$reply == 1} {
4436 checkout_index \
4437 $txt \
4438 $pathList \
4439 [concat $after {set ui_status_value {Ready.}}]
4440 } else {
4441 unlock_index
4445 proc do_revert_selection {} {
4446 global current_diff_path selected_paths
4448 if {[array size selected_paths] > 0} {
4449 revert_helper \
4450 {Reverting selected files} \
4451 [array names selected_paths]
4452 } elseif {$current_diff_path ne {}} {
4453 revert_helper \
4454 "Reverting [short_path $current_diff_path]" \
4455 [list $current_diff_path]
4459 proc do_signoff {} {
4460 global ui_comm
4462 set me [committer_ident]
4463 if {$me eq {}} return
4465 set sob "Signed-off-by: $me"
4466 set last [$ui_comm get {end -1c linestart} {end -1c}]
4467 if {$last ne $sob} {
4468 $ui_comm edit separator
4469 if {$last ne {}
4470 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4471 $ui_comm insert end "\n"
4473 $ui_comm insert end "\n$sob"
4474 $ui_comm edit separator
4475 $ui_comm see end
4479 proc do_select_commit_type {} {
4480 global commit_type selected_commit_type
4482 if {$selected_commit_type eq {new}
4483 && [string match amend* $commit_type]} {
4484 create_new_commit
4485 } elseif {$selected_commit_type eq {amend}
4486 && ![string match amend* $commit_type]} {
4487 load_last_commit
4489 # The amend request was rejected...
4491 if {![string match amend* $commit_type]} {
4492 set selected_commit_type new
4497 proc do_commit {} {
4498 commit_tree
4501 proc do_credits {} {
4502 global gitgui_credits
4504 set w .credits_dialog
4506 toplevel $w
4507 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4509 label $w.header -text {git-gui Contributors} -font font_uibold
4510 pack $w.header -side top -fill x
4512 frame $w.buttons
4513 button $w.buttons.close -text {Close} \
4514 -font font_ui \
4515 -command [list destroy $w]
4516 pack $w.buttons.close -side right
4517 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4519 frame $w.credits
4520 text $w.credits.t \
4521 -background [$w.header cget -background] \
4522 -yscrollcommand [list $w.credits.sby set] \
4523 -width 20 \
4524 -height 10 \
4525 -wrap none \
4526 -borderwidth 1 \
4527 -relief solid \
4528 -padx 5 -pady 5 \
4529 -font font_ui
4530 scrollbar $w.credits.sby -command [list $w.credits.t yview]
4531 pack $w.credits.sby -side right -fill y
4532 pack $w.credits.t -fill both -expand 1
4533 pack $w.credits -side top -fill both -expand 1 -padx 5 -pady 5
4535 label $w.desc \
4536 -text "All portions are copyrighted by their respective authors
4537 and are distributed under the GNU General Public License." \
4538 -padx 5 -pady 5 \
4539 -justify left \
4540 -anchor w \
4541 -borderwidth 1 \
4542 -relief solid \
4543 -font font_ui
4544 pack $w.desc -side top -fill x -padx 5 -pady 5
4546 $w.credits.t insert end "[string trim $gitgui_credits]\n"
4547 $w.credits.t conf -state disabled
4548 $w.credits.t see 1.0
4550 bind $w <Visibility> "grab $w; focus $w"
4551 bind $w <Key-Escape> [list destroy $w]
4552 wm title $w [$w.header cget -text]
4553 tkwait window $w
4556 proc do_about {} {
4557 global appvers copyright
4558 global tcl_patchLevel tk_patchLevel
4560 set w .about_dialog
4561 toplevel $w
4562 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4564 label $w.header -text "About [appname]" \
4565 -font font_uibold
4566 pack $w.header -side top -fill x
4568 frame $w.buttons
4569 button $w.buttons.close -text {Close} \
4570 -font font_ui \
4571 -command [list destroy $w]
4572 button $w.buttons.credits -text {Contributors} \
4573 -font font_ui \
4574 -command do_credits
4575 pack $w.buttons.credits -side left
4576 pack $w.buttons.close -side right
4577 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4579 label $w.desc \
4580 -text "git-gui - a graphical user interface for Git.
4581 $copyright" \
4582 -padx 5 -pady 5 \
4583 -justify left \
4584 -anchor w \
4585 -borderwidth 1 \
4586 -relief solid \
4587 -font font_ui
4588 pack $w.desc -side top -fill x -padx 5 -pady 5
4590 set v {}
4591 append v "git-gui version $appvers\n"
4592 append v "[git version]\n"
4593 append v "\n"
4594 if {$tcl_patchLevel eq $tk_patchLevel} {
4595 append v "Tcl/Tk version $tcl_patchLevel"
4596 } else {
4597 append v "Tcl version $tcl_patchLevel"
4598 append v ", Tk version $tk_patchLevel"
4601 label $w.vers \
4602 -text $v \
4603 -padx 5 -pady 5 \
4604 -justify left \
4605 -anchor w \
4606 -borderwidth 1 \
4607 -relief solid \
4608 -font font_ui
4609 pack $w.vers -side top -fill x -padx 5 -pady 5
4611 menu $w.ctxm -tearoff 0
4612 $w.ctxm add command \
4613 -label {Copy} \
4614 -font font_ui \
4615 -command "
4616 clipboard clear
4617 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4620 bind $w <Visibility> "grab $w; focus $w"
4621 bind $w <Key-Escape> "destroy $w"
4622 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4623 wm title $w "About [appname]"
4624 tkwait window $w
4627 proc do_options {} {
4628 global repo_config global_config font_descs
4629 global repo_config_new global_config_new
4631 array unset repo_config_new
4632 array unset global_config_new
4633 foreach name [array names repo_config] {
4634 set repo_config_new($name) $repo_config($name)
4636 load_config 1
4637 foreach name [array names repo_config] {
4638 switch -- $name {
4639 gui.diffcontext {continue}
4641 set repo_config_new($name) $repo_config($name)
4643 foreach name [array names global_config] {
4644 set global_config_new($name) $global_config($name)
4647 set w .options_editor
4648 toplevel $w
4649 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4651 label $w.header -text "Options" \
4652 -font font_uibold
4653 pack $w.header -side top -fill x
4655 frame $w.buttons
4656 button $w.buttons.restore -text {Restore Defaults} \
4657 -font font_ui \
4658 -command do_restore_defaults
4659 pack $w.buttons.restore -side left
4660 button $w.buttons.save -text Save \
4661 -font font_ui \
4662 -command [list do_save_config $w]
4663 pack $w.buttons.save -side right
4664 button $w.buttons.cancel -text {Cancel} \
4665 -font font_ui \
4666 -command [list destroy $w]
4667 pack $w.buttons.cancel -side right -padx 5
4668 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4670 labelframe $w.repo -text "[reponame] Repository" \
4671 -font font_ui
4672 labelframe $w.global -text {Global (All Repositories)} \
4673 -font font_ui
4674 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4675 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4677 set optid 0
4678 foreach option {
4679 {t user.name {User Name}}
4680 {t user.email {Email Address}}
4682 {b merge.summary {Summarize Merge Commits}}
4683 {i-1..5 merge.verbosity {Merge Verbosity}}
4685 {b gui.trustmtime {Trust File Modification Timestamps}}
4686 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4687 {t gui.newbranchtemplate {New Branch Name Template}}
4689 set type [lindex $option 0]
4690 set name [lindex $option 1]
4691 set text [lindex $option 2]
4692 incr optid
4693 foreach f {repo global} {
4694 switch -glob -- $type {
4696 checkbutton $w.$f.$optid -text $text \
4697 -variable ${f}_config_new($name) \
4698 -onvalue true \
4699 -offvalue false \
4700 -font font_ui
4701 pack $w.$f.$optid -side top -anchor w
4703 i-* {
4704 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4705 frame $w.$f.$optid
4706 label $w.$f.$optid.l -text "$text:" -font font_ui
4707 pack $w.$f.$optid.l -side left -anchor w -fill x
4708 spinbox $w.$f.$optid.v \
4709 -textvariable ${f}_config_new($name) \
4710 -from $min \
4711 -to $max \
4712 -increment 1 \
4713 -width [expr {1 + [string length $max]}] \
4714 -font font_ui
4715 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4716 pack $w.$f.$optid.v -side right -anchor e -padx 5
4717 pack $w.$f.$optid -side top -anchor w -fill x
4720 frame $w.$f.$optid
4721 label $w.$f.$optid.l -text "$text:" -font font_ui
4722 entry $w.$f.$optid.v \
4723 -borderwidth 1 \
4724 -relief sunken \
4725 -width 20 \
4726 -textvariable ${f}_config_new($name) \
4727 -font font_ui
4728 pack $w.$f.$optid.l -side left -anchor w
4729 pack $w.$f.$optid.v -side left -anchor w \
4730 -fill x -expand 1 \
4731 -padx 5
4732 pack $w.$f.$optid -side top -anchor w -fill x
4738 set all_fonts [lsort [font families]]
4739 foreach option $font_descs {
4740 set name [lindex $option 0]
4741 set font [lindex $option 1]
4742 set text [lindex $option 2]
4744 set global_config_new(gui.$font^^family) \
4745 [font configure $font -family]
4746 set global_config_new(gui.$font^^size) \
4747 [font configure $font -size]
4749 frame $w.global.$name
4750 label $w.global.$name.l -text "$text:" -font font_ui
4751 pack $w.global.$name.l -side left -anchor w -fill x
4752 eval tk_optionMenu $w.global.$name.family \
4753 global_config_new(gui.$font^^family) \
4754 $all_fonts
4755 spinbox $w.global.$name.size \
4756 -textvariable global_config_new(gui.$font^^size) \
4757 -from 2 -to 80 -increment 1 \
4758 -width 3 \
4759 -font font_ui
4760 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4761 pack $w.global.$name.size -side right -anchor e
4762 pack $w.global.$name.family -side right -anchor e
4763 pack $w.global.$name -side top -anchor w -fill x
4766 bind $w <Visibility> "grab $w; focus $w"
4767 bind $w <Key-Escape> "destroy $w"
4768 wm title $w "[appname] ([reponame]): Options"
4769 tkwait window $w
4772 proc do_restore_defaults {} {
4773 global font_descs default_config repo_config
4774 global repo_config_new global_config_new
4776 foreach name [array names default_config] {
4777 set repo_config_new($name) $default_config($name)
4778 set global_config_new($name) $default_config($name)
4781 foreach option $font_descs {
4782 set name [lindex $option 0]
4783 set repo_config(gui.$name) $default_config(gui.$name)
4785 apply_config
4787 foreach option $font_descs {
4788 set name [lindex $option 0]
4789 set font [lindex $option 1]
4790 set global_config_new(gui.$font^^family) \
4791 [font configure $font -family]
4792 set global_config_new(gui.$font^^size) \
4793 [font configure $font -size]
4797 proc do_save_config {w} {
4798 if {[catch {save_config} err]} {
4799 error_popup "Failed to completely save options:\n\n$err"
4801 reshow_diff
4802 destroy $w
4805 proc do_windows_shortcut {} {
4806 global argv0
4808 set fn [tk_getSaveFile \
4809 -parent . \
4810 -title "[appname] ([reponame]): Create Desktop Icon" \
4811 -initialfile "Git [reponame].bat"]
4812 if {$fn != {}} {
4813 if {[catch {
4814 set fd [open $fn w]
4815 puts $fd "@ECHO Entering [reponame]"
4816 puts $fd "@ECHO Starting git-gui... please wait..."
4817 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4818 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4819 puts -nonewline $fd "@\"[info nameofexecutable]\""
4820 puts $fd " \"[file normalize $argv0]\""
4821 close $fd
4822 } err]} {
4823 error_popup "Cannot write script:\n\n$err"
4828 proc do_cygwin_shortcut {} {
4829 global argv0
4831 if {[catch {
4832 set desktop [exec cygpath \
4833 --windows \
4834 --absolute \
4835 --long-name \
4836 --desktop]
4837 }]} {
4838 set desktop .
4840 set fn [tk_getSaveFile \
4841 -parent . \
4842 -title "[appname] ([reponame]): Create Desktop Icon" \
4843 -initialdir $desktop \
4844 -initialfile "Git [reponame].bat"]
4845 if {$fn != {}} {
4846 if {[catch {
4847 set fd [open $fn w]
4848 set sh [exec cygpath \
4849 --windows \
4850 --absolute \
4851 /bin/sh]
4852 set me [exec cygpath \
4853 --unix \
4854 --absolute \
4855 $argv0]
4856 set gd [exec cygpath \
4857 --unix \
4858 --absolute \
4859 [gitdir]]
4860 set gw [exec cygpath \
4861 --windows \
4862 --absolute \
4863 [file dirname [gitdir]]]
4864 regsub -all ' $me "'\\''" me
4865 regsub -all ' $gd "'\\''" gd
4866 puts $fd "@ECHO Entering $gw"
4867 puts $fd "@ECHO Starting git-gui... please wait..."
4868 puts -nonewline $fd "@\"$sh\" --login -c \""
4869 puts -nonewline $fd "GIT_DIR='$gd'"
4870 puts -nonewline $fd " '$me'"
4871 puts $fd "&\""
4872 close $fd
4873 } err]} {
4874 error_popup "Cannot write script:\n\n$err"
4879 proc do_macosx_app {} {
4880 global argv0 env
4882 set fn [tk_getSaveFile \
4883 -parent . \
4884 -title "[appname] ([reponame]): Create Desktop Icon" \
4885 -initialdir [file join $env(HOME) Desktop] \
4886 -initialfile "Git [reponame].app"]
4887 if {$fn != {}} {
4888 if {[catch {
4889 set Contents [file join $fn Contents]
4890 set MacOS [file join $Contents MacOS]
4891 set exe [file join $MacOS git-gui]
4893 file mkdir $MacOS
4895 set fd [open [file join $Contents Info.plist] w]
4896 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4897 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4898 <plist version="1.0">
4899 <dict>
4900 <key>CFBundleDevelopmentRegion</key>
4901 <string>English</string>
4902 <key>CFBundleExecutable</key>
4903 <string>git-gui</string>
4904 <key>CFBundleIdentifier</key>
4905 <string>org.spearce.git-gui</string>
4906 <key>CFBundleInfoDictionaryVersion</key>
4907 <string>6.0</string>
4908 <key>CFBundlePackageType</key>
4909 <string>APPL</string>
4910 <key>CFBundleSignature</key>
4911 <string>????</string>
4912 <key>CFBundleVersion</key>
4913 <string>1.0</string>
4914 <key>NSPrincipalClass</key>
4915 <string>NSApplication</string>
4916 </dict>
4917 </plist>}
4918 close $fd
4920 set fd [open $exe w]
4921 set gd [file normalize [gitdir]]
4922 set ep [file normalize [gitexec]]
4923 regsub -all ' $gd "'\\''" gd
4924 regsub -all ' $ep "'\\''" ep
4925 puts $fd "#!/bin/sh"
4926 foreach name [array names env] {
4927 if {[string match GIT_* $name]} {
4928 regsub -all ' $env($name) "'\\''" v
4929 puts $fd "export $name='$v'"
4932 puts $fd "export PATH='$ep':\$PATH"
4933 puts $fd "export GIT_DIR='$gd'"
4934 puts $fd "exec [file normalize $argv0]"
4935 close $fd
4937 file attributes $exe -permissions u+x,g+x,o+x
4938 } err]} {
4939 error_popup "Cannot write icon:\n\n$err"
4944 proc toggle_or_diff {w x y} {
4945 global file_states file_lists current_diff_path ui_index ui_workdir
4946 global last_clicked selected_paths
4948 set pos [split [$w index @$x,$y] .]
4949 set lno [lindex $pos 0]
4950 set col [lindex $pos 1]
4951 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4952 if {$path eq {}} {
4953 set last_clicked {}
4954 return
4957 set last_clicked [list $w $lno]
4958 array unset selected_paths
4959 $ui_index tag remove in_sel 0.0 end
4960 $ui_workdir tag remove in_sel 0.0 end
4962 if {$col == 0} {
4963 if {$current_diff_path eq $path} {
4964 set after {reshow_diff;}
4965 } else {
4966 set after {}
4968 if {$w eq $ui_index} {
4969 update_indexinfo \
4970 "Unstaging [short_path $path] from commit" \
4971 [list $path] \
4972 [concat $after {set ui_status_value {Ready.}}]
4973 } elseif {$w eq $ui_workdir} {
4974 update_index \
4975 "Adding [short_path $path]" \
4976 [list $path] \
4977 [concat $after {set ui_status_value {Ready.}}]
4979 } else {
4980 show_diff $path $w $lno
4984 proc add_one_to_selection {w x y} {
4985 global file_lists last_clicked selected_paths
4987 set lno [lindex [split [$w index @$x,$y] .] 0]
4988 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4989 if {$path eq {}} {
4990 set last_clicked {}
4991 return
4994 if {$last_clicked ne {}
4995 && [lindex $last_clicked 0] ne $w} {
4996 array unset selected_paths
4997 [lindex $last_clicked 0] tag remove in_sel 0.0 end
5000 set last_clicked [list $w $lno]
5001 if {[catch {set in_sel $selected_paths($path)}]} {
5002 set in_sel 0
5004 if {$in_sel} {
5005 unset selected_paths($path)
5006 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
5007 } else {
5008 set selected_paths($path) 1
5009 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
5013 proc add_range_to_selection {w x y} {
5014 global file_lists last_clicked selected_paths
5016 if {[lindex $last_clicked 0] ne $w} {
5017 toggle_or_diff $w $x $y
5018 return
5021 set lno [lindex [split [$w index @$x,$y] .] 0]
5022 set lc [lindex $last_clicked 1]
5023 if {$lc < $lno} {
5024 set begin $lc
5025 set end $lno
5026 } else {
5027 set begin $lno
5028 set end $lc
5031 foreach path [lrange $file_lists($w) \
5032 [expr {$begin - 1}] \
5033 [expr {$end - 1}]] {
5034 set selected_paths($path) 1
5036 $w tag add in_sel $begin.0 [expr {$end + 1}].0
5039 ######################################################################
5041 ## config defaults
5043 set cursor_ptr arrow
5044 font create font_diff -family Courier -size 10
5045 font create font_ui
5046 catch {
5047 label .dummy
5048 eval font configure font_ui [font actual [.dummy cget -font]]
5049 destroy .dummy
5052 font create font_uibold
5053 font create font_diffbold
5055 if {[is_Windows]} {
5056 set M1B Control
5057 set M1T Ctrl
5058 } elseif {[is_MacOSX]} {
5059 set M1B M1
5060 set M1T Cmd
5061 } else {
5062 set M1B M1
5063 set M1T M1
5066 proc apply_config {} {
5067 global repo_config font_descs
5069 foreach option $font_descs {
5070 set name [lindex $option 0]
5071 set font [lindex $option 1]
5072 if {[catch {
5073 foreach {cn cv} $repo_config(gui.$name) {
5074 font configure $font $cn $cv
5076 } err]} {
5077 error_popup "Invalid font specified in gui.$name:\n\n$err"
5079 foreach {cn cv} [font configure $font] {
5080 font configure ${font}bold $cn $cv
5082 font configure ${font}bold -weight bold
5086 set default_config(merge.summary) false
5087 set default_config(merge.verbosity) 2
5088 set default_config(user.name) {}
5089 set default_config(user.email) {}
5091 set default_config(gui.trustmtime) false
5092 set default_config(gui.diffcontext) 5
5093 set default_config(gui.newbranchtemplate) {}
5094 set default_config(gui.fontui) [font configure font_ui]
5095 set default_config(gui.fontdiff) [font configure font_diff]
5096 set font_descs {
5097 {fontui font_ui {Main Font}}
5098 {fontdiff font_diff {Diff/Console Font}}
5100 load_config 0
5101 apply_config
5103 ######################################################################
5105 ## feature option selection
5107 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5108 unset _junk
5109 } else {
5110 set subcommand gui
5112 if {$subcommand eq {gui.sh}} {
5113 set subcommand gui
5115 if {$subcommand eq {gui} && [llength $argv] > 0} {
5116 set subcommand [lindex $argv 0]
5117 set argv [lrange $argv 1 end]
5120 enable_option multicommit
5121 enable_option branch
5122 enable_option transport
5124 switch -- $subcommand {
5125 --version -
5126 version -
5127 browser -
5128 blame {
5129 disable_option multicommit
5130 disable_option branch
5131 disable_option transport
5133 citool {
5134 enable_option singlecommit
5136 disable_option multicommit
5137 disable_option branch
5138 disable_option transport
5142 ######################################################################
5144 ## ui construction
5146 set ui_comm {}
5148 # -- Menu Bar
5150 menu .mbar -tearoff 0
5151 .mbar add cascade -label Repository -menu .mbar.repository
5152 .mbar add cascade -label Edit -menu .mbar.edit
5153 if {[is_enabled branch]} {
5154 .mbar add cascade -label Branch -menu .mbar.branch
5156 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5157 .mbar add cascade -label Commit -menu .mbar.commit
5159 if {[is_enabled transport]} {
5160 .mbar add cascade -label Merge -menu .mbar.merge
5161 .mbar add cascade -label Fetch -menu .mbar.fetch
5162 .mbar add cascade -label Push -menu .mbar.push
5164 . configure -menu .mbar
5166 # -- Repository Menu
5168 menu .mbar.repository
5170 .mbar.repository add command \
5171 -label {Browse Current Branch} \
5172 -command {new_browser $current_branch} \
5173 -font font_ui
5174 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5175 .mbar.repository add separator
5177 .mbar.repository add command \
5178 -label {Visualize Current Branch} \
5179 -command {do_gitk $current_branch} \
5180 -font font_ui
5181 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5182 .mbar.repository add command \
5183 -label {Visualize All Branches} \
5184 -command {do_gitk --all} \
5185 -font font_ui
5186 .mbar.repository add separator
5188 if {[is_enabled multicommit]} {
5189 .mbar.repository add command -label {Database Statistics} \
5190 -command do_stats \
5191 -font font_ui
5193 .mbar.repository add command -label {Compress Database} \
5194 -command do_gc \
5195 -font font_ui
5197 .mbar.repository add command -label {Verify Database} \
5198 -command do_fsck_objects \
5199 -font font_ui
5201 .mbar.repository add separator
5203 if {[is_Cygwin]} {
5204 .mbar.repository add command \
5205 -label {Create Desktop Icon} \
5206 -command do_cygwin_shortcut \
5207 -font font_ui
5208 } elseif {[is_Windows]} {
5209 .mbar.repository add command \
5210 -label {Create Desktop Icon} \
5211 -command do_windows_shortcut \
5212 -font font_ui
5213 } elseif {[is_MacOSX]} {
5214 .mbar.repository add command \
5215 -label {Create Desktop Icon} \
5216 -command do_macosx_app \
5217 -font font_ui
5221 .mbar.repository add command -label Quit \
5222 -command do_quit \
5223 -accelerator $M1T-Q \
5224 -font font_ui
5226 # -- Edit Menu
5228 menu .mbar.edit
5229 .mbar.edit add command -label Undo \
5230 -command {catch {[focus] edit undo}} \
5231 -accelerator $M1T-Z \
5232 -font font_ui
5233 .mbar.edit add command -label Redo \
5234 -command {catch {[focus] edit redo}} \
5235 -accelerator $M1T-Y \
5236 -font font_ui
5237 .mbar.edit add separator
5238 .mbar.edit add command -label Cut \
5239 -command {catch {tk_textCut [focus]}} \
5240 -accelerator $M1T-X \
5241 -font font_ui
5242 .mbar.edit add command -label Copy \
5243 -command {catch {tk_textCopy [focus]}} \
5244 -accelerator $M1T-C \
5245 -font font_ui
5246 .mbar.edit add command -label Paste \
5247 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5248 -accelerator $M1T-V \
5249 -font font_ui
5250 .mbar.edit add command -label Delete \
5251 -command {catch {[focus] delete sel.first sel.last}} \
5252 -accelerator Del \
5253 -font font_ui
5254 .mbar.edit add separator
5255 .mbar.edit add command -label {Select All} \
5256 -command {catch {[focus] tag add sel 0.0 end}} \
5257 -accelerator $M1T-A \
5258 -font font_ui
5260 # -- Branch Menu
5262 if {[is_enabled branch]} {
5263 menu .mbar.branch
5265 .mbar.branch add command -label {Create...} \
5266 -command do_create_branch \
5267 -accelerator $M1T-N \
5268 -font font_ui
5269 lappend disable_on_lock [list .mbar.branch entryconf \
5270 [.mbar.branch index last] -state]
5272 .mbar.branch add command -label {Delete...} \
5273 -command do_delete_branch \
5274 -font font_ui
5275 lappend disable_on_lock [list .mbar.branch entryconf \
5276 [.mbar.branch index last] -state]
5278 .mbar.branch add command -label {Reset...} \
5279 -command do_reset_hard \
5280 -font font_ui
5281 lappend disable_on_lock [list .mbar.branch entryconf \
5282 [.mbar.branch index last] -state]
5285 # -- Commit Menu
5287 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5288 menu .mbar.commit
5290 .mbar.commit add radiobutton \
5291 -label {New Commit} \
5292 -command do_select_commit_type \
5293 -variable selected_commit_type \
5294 -value new \
5295 -font font_ui
5296 lappend disable_on_lock \
5297 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5299 .mbar.commit add radiobutton \
5300 -label {Amend Last Commit} \
5301 -command do_select_commit_type \
5302 -variable selected_commit_type \
5303 -value amend \
5304 -font font_ui
5305 lappend disable_on_lock \
5306 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5308 .mbar.commit add separator
5310 .mbar.commit add command -label Rescan \
5311 -command do_rescan \
5312 -accelerator F5 \
5313 -font font_ui
5314 lappend disable_on_lock \
5315 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5317 .mbar.commit add command -label {Add To Commit} \
5318 -command do_add_selection \
5319 -font font_ui
5320 lappend disable_on_lock \
5321 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5323 .mbar.commit add command -label {Add Existing To Commit} \
5324 -command do_add_all \
5325 -accelerator $M1T-I \
5326 -font font_ui
5327 lappend disable_on_lock \
5328 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5330 .mbar.commit add command -label {Unstage From Commit} \
5331 -command do_unstage_selection \
5332 -font font_ui
5333 lappend disable_on_lock \
5334 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5336 .mbar.commit add command -label {Revert Changes} \
5337 -command do_revert_selection \
5338 -font font_ui
5339 lappend disable_on_lock \
5340 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5342 .mbar.commit add separator
5344 .mbar.commit add command -label {Sign Off} \
5345 -command do_signoff \
5346 -accelerator $M1T-S \
5347 -font font_ui
5349 .mbar.commit add command -label Commit \
5350 -command do_commit \
5351 -accelerator $M1T-Return \
5352 -font font_ui
5353 lappend disable_on_lock \
5354 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5357 # -- Merge Menu
5359 if {[is_enabled branch]} {
5360 menu .mbar.merge
5361 .mbar.merge add command -label {Local Merge...} \
5362 -command do_local_merge \
5363 -font font_ui
5364 lappend disable_on_lock \
5365 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5366 .mbar.merge add command -label {Abort Merge...} \
5367 -command do_reset_hard \
5368 -font font_ui
5369 lappend disable_on_lock \
5370 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5374 # -- Transport Menu
5376 if {[is_enabled transport]} {
5377 menu .mbar.fetch
5379 menu .mbar.push
5380 .mbar.push add command -label {Push...} \
5381 -command do_push_anywhere \
5382 -font font_ui
5385 if {[is_MacOSX]} {
5386 # -- Apple Menu (Mac OS X only)
5388 .mbar add cascade -label Apple -menu .mbar.apple
5389 menu .mbar.apple
5391 .mbar.apple add command -label "About [appname]" \
5392 -command do_about \
5393 -font font_ui
5394 .mbar.apple add command -label "Options..." \
5395 -command do_options \
5396 -font font_ui
5397 } else {
5398 # -- Edit Menu
5400 .mbar.edit add separator
5401 .mbar.edit add command -label {Options...} \
5402 -command do_options \
5403 -font font_ui
5405 # -- Tools Menu
5407 if {[file exists /usr/local/miga/lib/gui-miga]
5408 && [file exists .pvcsrc]} {
5409 proc do_miga {} {
5410 global ui_status_value
5411 if {![lock_index update]} return
5412 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5413 set miga_fd [open "|$cmd" r]
5414 fconfigure $miga_fd -blocking 0
5415 fileevent $miga_fd readable [list miga_done $miga_fd]
5416 set ui_status_value {Running miga...}
5418 proc miga_done {fd} {
5419 read $fd 512
5420 if {[eof $fd]} {
5421 close $fd
5422 unlock_index
5423 rescan [list set ui_status_value {Ready.}]
5426 .mbar add cascade -label Tools -menu .mbar.tools
5427 menu .mbar.tools
5428 .mbar.tools add command -label "Migrate" \
5429 -command do_miga \
5430 -font font_ui
5431 lappend disable_on_lock \
5432 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5436 # -- Help Menu
5438 .mbar add cascade -label Help -menu .mbar.help
5439 menu .mbar.help
5441 if {![is_MacOSX]} {
5442 .mbar.help add command -label "About [appname]" \
5443 -command do_about \
5444 -font font_ui
5447 set browser {}
5448 catch {set browser $repo_config(instaweb.browser)}
5449 set doc_path [file dirname [gitexec]]
5450 set doc_path [file join $doc_path Documentation index.html]
5452 if {[is_Cygwin]} {
5453 set doc_path [exec cygpath --mixed $doc_path]
5456 if {$browser eq {}} {
5457 if {[is_MacOSX]} {
5458 set browser open
5459 } elseif {[is_Cygwin]} {
5460 set program_files [file dirname [exec cygpath --windir]]
5461 set program_files [file join $program_files {Program Files}]
5462 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5463 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5464 if {[file exists $firefox]} {
5465 set browser $firefox
5466 } elseif {[file exists $ie]} {
5467 set browser $ie
5469 unset program_files firefox ie
5473 if {[file isfile $doc_path]} {
5474 set doc_url "file:$doc_path"
5475 } else {
5476 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5479 if {$browser ne {}} {
5480 .mbar.help add command -label {Online Documentation} \
5481 -command [list exec $browser $doc_url &] \
5482 -font font_ui
5484 unset browser doc_path doc_url
5486 # -- Standard bindings
5488 bind . <Destroy> do_quit
5489 bind all <$M1B-Key-q> do_quit
5490 bind all <$M1B-Key-Q> do_quit
5491 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5492 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5494 # -- Not a normal commit type invocation? Do that instead!
5496 switch -- $subcommand {
5497 --version -
5498 version {
5499 puts "git-gui version $appvers"
5500 exit
5502 browser {
5503 if {[llength $argv] != 1} {
5504 puts stderr "usage: $argv0 browser commit"
5505 exit 1
5507 set current_branch [lindex $argv 0]
5508 new_browser $current_branch
5509 return
5511 blame {
5512 if {[llength $argv] != 2} {
5513 puts stderr "usage: $argv0 blame commit path"
5514 exit 1
5516 set current_branch [lindex $argv 0]
5517 show_blame $current_branch [lindex $argv 1]
5518 return
5520 citool -
5521 gui {
5522 if {[llength $argv] != 0} {
5523 puts -nonewline stderr "usage: $argv0"
5524 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5525 puts -nonewline stderr " $subcommand"
5527 puts stderr {}
5528 exit 1
5530 # fall through to setup UI for commits
5532 default {
5533 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
5534 exit 1
5538 # -- Branch Control
5540 frame .branch \
5541 -borderwidth 1 \
5542 -relief sunken
5543 label .branch.l1 \
5544 -text {Current Branch:} \
5545 -anchor w \
5546 -justify left \
5547 -font font_ui
5548 label .branch.cb \
5549 -textvariable current_branch \
5550 -anchor w \
5551 -justify left \
5552 -font font_ui
5553 pack .branch.l1 -side left
5554 pack .branch.cb -side left -fill x
5555 pack .branch -side top -fill x
5557 # -- Main Window Layout
5559 panedwindow .vpane -orient vertical
5560 panedwindow .vpane.files -orient horizontal
5561 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5562 pack .vpane -anchor n -side top -fill both -expand 1
5564 # -- Index File List
5566 frame .vpane.files.index -height 100 -width 200
5567 label .vpane.files.index.title -text {Changes To Be Committed} \
5568 -background green \
5569 -font font_ui
5570 text $ui_index -background white -borderwidth 0 \
5571 -width 20 -height 10 \
5572 -wrap none \
5573 -font font_ui \
5574 -cursor $cursor_ptr \
5575 -xscrollcommand {.vpane.files.index.sx set} \
5576 -yscrollcommand {.vpane.files.index.sy set} \
5577 -state disabled
5578 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5579 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5580 pack .vpane.files.index.title -side top -fill x
5581 pack .vpane.files.index.sx -side bottom -fill x
5582 pack .vpane.files.index.sy -side right -fill y
5583 pack $ui_index -side left -fill both -expand 1
5584 .vpane.files add .vpane.files.index -sticky nsew
5586 # -- Working Directory File List
5588 frame .vpane.files.workdir -height 100 -width 200
5589 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5590 -background red \
5591 -font font_ui
5592 text $ui_workdir -background white -borderwidth 0 \
5593 -width 20 -height 10 \
5594 -wrap none \
5595 -font font_ui \
5596 -cursor $cursor_ptr \
5597 -xscrollcommand {.vpane.files.workdir.sx set} \
5598 -yscrollcommand {.vpane.files.workdir.sy set} \
5599 -state disabled
5600 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5601 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5602 pack .vpane.files.workdir.title -side top -fill x
5603 pack .vpane.files.workdir.sx -side bottom -fill x
5604 pack .vpane.files.workdir.sy -side right -fill y
5605 pack $ui_workdir -side left -fill both -expand 1
5606 .vpane.files add .vpane.files.workdir -sticky nsew
5608 foreach i [list $ui_index $ui_workdir] {
5609 $i tag conf in_diff -font font_uibold
5610 $i tag conf in_sel \
5611 -background [$i cget -foreground] \
5612 -foreground [$i cget -background]
5614 unset i
5616 # -- Diff and Commit Area
5618 frame .vpane.lower -height 300 -width 400
5619 frame .vpane.lower.commarea
5620 frame .vpane.lower.diff -relief sunken -borderwidth 1
5621 pack .vpane.lower.commarea -side top -fill x
5622 pack .vpane.lower.diff -side bottom -fill both -expand 1
5623 .vpane add .vpane.lower -sticky nsew
5625 # -- Commit Area Buttons
5627 frame .vpane.lower.commarea.buttons
5628 label .vpane.lower.commarea.buttons.l -text {} \
5629 -anchor w \
5630 -justify left \
5631 -font font_ui
5632 pack .vpane.lower.commarea.buttons.l -side top -fill x
5633 pack .vpane.lower.commarea.buttons -side left -fill y
5635 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5636 -command do_rescan \
5637 -font font_ui
5638 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5639 lappend disable_on_lock \
5640 {.vpane.lower.commarea.buttons.rescan conf -state}
5642 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5643 -command do_add_all \
5644 -font font_ui
5645 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5646 lappend disable_on_lock \
5647 {.vpane.lower.commarea.buttons.incall conf -state}
5649 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5650 -command do_signoff \
5651 -font font_ui
5652 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5654 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5655 -command do_commit \
5656 -font font_ui
5657 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5658 lappend disable_on_lock \
5659 {.vpane.lower.commarea.buttons.commit conf -state}
5661 # -- Commit Message Buffer
5663 frame .vpane.lower.commarea.buffer
5664 frame .vpane.lower.commarea.buffer.header
5665 set ui_comm .vpane.lower.commarea.buffer.t
5666 set ui_coml .vpane.lower.commarea.buffer.header.l
5667 radiobutton .vpane.lower.commarea.buffer.header.new \
5668 -text {New Commit} \
5669 -command do_select_commit_type \
5670 -variable selected_commit_type \
5671 -value new \
5672 -font font_ui
5673 lappend disable_on_lock \
5674 [list .vpane.lower.commarea.buffer.header.new conf -state]
5675 radiobutton .vpane.lower.commarea.buffer.header.amend \
5676 -text {Amend Last Commit} \
5677 -command do_select_commit_type \
5678 -variable selected_commit_type \
5679 -value amend \
5680 -font font_ui
5681 lappend disable_on_lock \
5682 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5683 label $ui_coml \
5684 -anchor w \
5685 -justify left \
5686 -font font_ui
5687 proc trace_commit_type {varname args} {
5688 global ui_coml commit_type
5689 switch -glob -- $commit_type {
5690 initial {set txt {Initial Commit Message:}}
5691 amend {set txt {Amended Commit Message:}}
5692 amend-initial {set txt {Amended Initial Commit Message:}}
5693 amend-merge {set txt {Amended Merge Commit Message:}}
5694 merge {set txt {Merge Commit Message:}}
5695 * {set txt {Commit Message:}}
5697 $ui_coml conf -text $txt
5699 trace add variable commit_type write trace_commit_type
5700 pack $ui_coml -side left -fill x
5701 pack .vpane.lower.commarea.buffer.header.amend -side right
5702 pack .vpane.lower.commarea.buffer.header.new -side right
5704 text $ui_comm -background white -borderwidth 1 \
5705 -undo true \
5706 -maxundo 20 \
5707 -autoseparators true \
5708 -relief sunken \
5709 -width 75 -height 9 -wrap none \
5710 -font font_diff \
5711 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5712 scrollbar .vpane.lower.commarea.buffer.sby \
5713 -command [list $ui_comm yview]
5714 pack .vpane.lower.commarea.buffer.header -side top -fill x
5715 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5716 pack $ui_comm -side left -fill y
5717 pack .vpane.lower.commarea.buffer -side left -fill y
5719 # -- Commit Message Buffer Context Menu
5721 set ctxm .vpane.lower.commarea.buffer.ctxm
5722 menu $ctxm -tearoff 0
5723 $ctxm add command \
5724 -label {Cut} \
5725 -font font_ui \
5726 -command {tk_textCut $ui_comm}
5727 $ctxm add command \
5728 -label {Copy} \
5729 -font font_ui \
5730 -command {tk_textCopy $ui_comm}
5731 $ctxm add command \
5732 -label {Paste} \
5733 -font font_ui \
5734 -command {tk_textPaste $ui_comm}
5735 $ctxm add command \
5736 -label {Delete} \
5737 -font font_ui \
5738 -command {$ui_comm delete sel.first sel.last}
5739 $ctxm add separator
5740 $ctxm add command \
5741 -label {Select All} \
5742 -font font_ui \
5743 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5744 $ctxm add command \
5745 -label {Copy All} \
5746 -font font_ui \
5747 -command {
5748 $ui_comm tag add sel 0.0 end
5749 tk_textCopy $ui_comm
5750 $ui_comm tag remove sel 0.0 end
5752 $ctxm add separator
5753 $ctxm add command \
5754 -label {Sign Off} \
5755 -font font_ui \
5756 -command do_signoff
5757 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5759 # -- Diff Header
5761 proc trace_current_diff_path {varname args} {
5762 global current_diff_path diff_actions file_states
5763 if {$current_diff_path eq {}} {
5764 set s {}
5765 set f {}
5766 set p {}
5767 set o disabled
5768 } else {
5769 set p $current_diff_path
5770 set s [mapdesc [lindex $file_states($p) 0] $p]
5771 set f {File:}
5772 set p [escape_path $p]
5773 set o normal
5776 .vpane.lower.diff.header.status configure -text $s
5777 .vpane.lower.diff.header.file configure -text $f
5778 .vpane.lower.diff.header.path configure -text $p
5779 foreach w $diff_actions {
5780 uplevel #0 $w $o
5783 trace add variable current_diff_path write trace_current_diff_path
5785 frame .vpane.lower.diff.header -background orange
5786 label .vpane.lower.diff.header.status \
5787 -background orange \
5788 -width $max_status_desc \
5789 -anchor w \
5790 -justify left \
5791 -font font_ui
5792 label .vpane.lower.diff.header.file \
5793 -background orange \
5794 -anchor w \
5795 -justify left \
5796 -font font_ui
5797 label .vpane.lower.diff.header.path \
5798 -background orange \
5799 -anchor w \
5800 -justify left \
5801 -font font_ui
5802 pack .vpane.lower.diff.header.status -side left
5803 pack .vpane.lower.diff.header.file -side left
5804 pack .vpane.lower.diff.header.path -fill x
5805 set ctxm .vpane.lower.diff.header.ctxm
5806 menu $ctxm -tearoff 0
5807 $ctxm add command \
5808 -label {Copy} \
5809 -font font_ui \
5810 -command {
5811 clipboard clear
5812 clipboard append \
5813 -format STRING \
5814 -type STRING \
5815 -- $current_diff_path
5817 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5818 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5820 # -- Diff Body
5822 frame .vpane.lower.diff.body
5823 set ui_diff .vpane.lower.diff.body.t
5824 text $ui_diff -background white -borderwidth 0 \
5825 -width 80 -height 15 -wrap none \
5826 -font font_diff \
5827 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5828 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5829 -state disabled
5830 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5831 -command [list $ui_diff xview]
5832 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5833 -command [list $ui_diff yview]
5834 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5835 pack .vpane.lower.diff.body.sby -side right -fill y
5836 pack $ui_diff -side left -fill both -expand 1
5837 pack .vpane.lower.diff.header -side top -fill x
5838 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5840 $ui_diff tag conf d_cr -elide true
5841 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5842 $ui_diff tag conf d_+ -foreground {#00a000}
5843 $ui_diff tag conf d_- -foreground red
5845 $ui_diff tag conf d_++ -foreground {#00a000}
5846 $ui_diff tag conf d_-- -foreground red
5847 $ui_diff tag conf d_+s \
5848 -foreground {#00a000} \
5849 -background {#e2effa}
5850 $ui_diff tag conf d_-s \
5851 -foreground red \
5852 -background {#e2effa}
5853 $ui_diff tag conf d_s+ \
5854 -foreground {#00a000} \
5855 -background ivory1
5856 $ui_diff tag conf d_s- \
5857 -foreground red \
5858 -background ivory1
5860 $ui_diff tag conf d<<<<<<< \
5861 -foreground orange \
5862 -font font_diffbold
5863 $ui_diff tag conf d======= \
5864 -foreground orange \
5865 -font font_diffbold
5866 $ui_diff tag conf d>>>>>>> \
5867 -foreground orange \
5868 -font font_diffbold
5870 $ui_diff tag raise sel
5872 # -- Diff Body Context Menu
5874 set ctxm .vpane.lower.diff.body.ctxm
5875 menu $ctxm -tearoff 0
5876 $ctxm add command \
5877 -label {Refresh} \
5878 -font font_ui \
5879 -command reshow_diff
5880 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5881 $ctxm add command \
5882 -label {Copy} \
5883 -font font_ui \
5884 -command {tk_textCopy $ui_diff}
5885 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5886 $ctxm add command \
5887 -label {Select All} \
5888 -font font_ui \
5889 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5890 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5891 $ctxm add command \
5892 -label {Copy All} \
5893 -font font_ui \
5894 -command {
5895 $ui_diff tag add sel 0.0 end
5896 tk_textCopy $ui_diff
5897 $ui_diff tag remove sel 0.0 end
5899 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5900 $ctxm add separator
5901 $ctxm add command \
5902 -label {Apply/Reverse Hunk} \
5903 -font font_ui \
5904 -command {apply_hunk $cursorX $cursorY}
5905 set ui_diff_applyhunk [$ctxm index last]
5906 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5907 $ctxm add separator
5908 $ctxm add command \
5909 -label {Decrease Font Size} \
5910 -font font_ui \
5911 -command {incr_font_size font_diff -1}
5912 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5913 $ctxm add command \
5914 -label {Increase Font Size} \
5915 -font font_ui \
5916 -command {incr_font_size font_diff 1}
5917 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5918 $ctxm add separator
5919 $ctxm add command \
5920 -label {Show Less Context} \
5921 -font font_ui \
5922 -command {if {$repo_config(gui.diffcontext) >= 2} {
5923 incr repo_config(gui.diffcontext) -1
5924 reshow_diff
5926 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5927 $ctxm add command \
5928 -label {Show More Context} \
5929 -font font_ui \
5930 -command {
5931 incr repo_config(gui.diffcontext)
5932 reshow_diff
5934 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5935 $ctxm add separator
5936 $ctxm add command -label {Options...} \
5937 -font font_ui \
5938 -command do_options
5939 bind_button3 $ui_diff "
5940 set cursorX %x
5941 set cursorY %y
5942 if {\$ui_index eq \$current_diff_side} {
5943 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5944 } else {
5945 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5947 tk_popup $ctxm %X %Y
5949 unset ui_diff_applyhunk
5951 # -- Status Bar
5953 label .status -textvariable ui_status_value \
5954 -anchor w \
5955 -justify left \
5956 -borderwidth 1 \
5957 -relief sunken \
5958 -font font_ui
5959 pack .status -anchor w -side bottom -fill x
5961 # -- Load geometry
5963 catch {
5964 set gm $repo_config(gui.geometry)
5965 wm geometry . [lindex $gm 0]
5966 .vpane sash place 0 \
5967 [lindex [.vpane sash coord 0] 0] \
5968 [lindex $gm 1]
5969 .vpane.files sash place 0 \
5970 [lindex $gm 2] \
5971 [lindex [.vpane.files sash coord 0] 1]
5972 unset gm
5975 # -- Key Bindings
5977 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5978 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5979 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5980 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5981 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5982 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5983 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5984 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5985 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5986 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5987 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5989 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5990 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5991 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5992 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5993 bind $ui_diff <$M1B-Key-v> {break}
5994 bind $ui_diff <$M1B-Key-V> {break}
5995 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5996 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5997 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5998 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5999 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
6000 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
6001 bind $ui_diff <Button-1> {focus %W}
6003 if {[is_enabled branch]} {
6004 bind . <$M1B-Key-n> do_create_branch
6005 bind . <$M1B-Key-N> do_create_branch
6008 bind all <Key-F5> do_rescan
6009 bind all <$M1B-Key-r> do_rescan
6010 bind all <$M1B-Key-R> do_rescan
6011 bind . <$M1B-Key-s> do_signoff
6012 bind . <$M1B-Key-S> do_signoff
6013 bind . <$M1B-Key-i> do_add_all
6014 bind . <$M1B-Key-I> do_add_all
6015 bind . <$M1B-Key-Return> do_commit
6016 foreach i [list $ui_index $ui_workdir] {
6017 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
6018 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
6019 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
6021 unset i
6023 set file_lists($ui_index) [list]
6024 set file_lists($ui_workdir) [list]
6026 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
6027 focus -force $ui_comm
6029 # -- Warn the user about environmental problems. Cygwin's Tcl
6030 # does *not* pass its env array onto any processes it spawns.
6031 # This means that git processes get none of our environment.
6033 if {[is_Cygwin]} {
6034 set ignored_env 0
6035 set suggest_user {}
6036 set msg "Possible environment issues exist.
6038 The following environment variables are probably
6039 going to be ignored by any Git subprocess run
6040 by [appname]:
6043 foreach name [array names env] {
6044 switch -regexp -- $name {
6045 {^GIT_INDEX_FILE$} -
6046 {^GIT_OBJECT_DIRECTORY$} -
6047 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
6048 {^GIT_DIFF_OPTS$} -
6049 {^GIT_EXTERNAL_DIFF$} -
6050 {^GIT_PAGER$} -
6051 {^GIT_TRACE$} -
6052 {^GIT_CONFIG$} -
6053 {^GIT_CONFIG_LOCAL$} -
6054 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
6055 append msg " - $name\n"
6056 incr ignored_env
6058 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
6059 append msg " - $name\n"
6060 incr ignored_env
6061 set suggest_user $name
6065 if {$ignored_env > 0} {
6066 append msg "
6067 This is due to a known issue with the
6068 Tcl binary distributed by Cygwin."
6070 if {$suggest_user ne {}} {
6071 append msg "
6073 A good replacement for $suggest_user
6074 is placing values for the user.name and
6075 user.email settings into your personal
6076 ~/.gitconfig file.
6079 warn_popup $msg
6081 unset ignored_env msg suggest_user name
6084 # -- Only initialize complex UI if we are going to stay running.
6086 if {[is_enabled transport]} {
6087 load_all_remotes
6088 load_all_heads
6090 populate_branch_menu
6091 populate_fetch_menu
6092 populate_push_menu
6095 # -- Only suggest a gc run if we are going to stay running.
6097 if {[is_enabled multicommit]} {
6098 set object_limit 2000
6099 if {[is_Windows]} {set object_limit 200}
6100 regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
6101 if {$objects_current >= $object_limit} {
6102 if {[ask_popup \
6103 "This repository currently has $objects_current loose objects.
6105 To maintain optimal performance it is strongly
6106 recommended that you compress the database
6107 when more than $object_limit loose objects exist.
6109 Compress the database now?"] eq yes} {
6110 do_gc
6113 unset object_limit _junk objects_current
6116 lock_index begin-read
6117 after 1 do_rescan