git-gui: Support of "make -s" in: do not output anything of the build itself
[git/gitweb-caching.git] / git-gui.sh
blob1981827a8e8bcc2b2e43598bb06e3e6c87bd4d1d
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 foreach p [concat $PARENT $MERGE_HEAD] {
1303 lappend cmd -p $p
1305 lappend cmd <$msg_p
1306 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1307 error_popup "commit-tree failed:\n\n$err"
1308 set ui_status_value {Commit failed.}
1309 unlock_index
1310 return
1313 # -- Update the HEAD ref.
1315 set reflogm commit
1316 if {$commit_type ne {normal}} {
1317 append reflogm " ($commit_type)"
1319 set i [string first "\n" $msg]
1320 if {$i >= 0} {
1321 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1322 } else {
1323 append reflogm {: } $msg
1325 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1326 if {[catch {eval exec $cmd} err]} {
1327 error_popup "update-ref failed:\n\n$err"
1328 set ui_status_value {Commit failed.}
1329 unlock_index
1330 return
1333 # -- Cleanup after ourselves.
1335 catch {file delete $msg_p}
1336 catch {file delete [gitdir MERGE_HEAD]}
1337 catch {file delete [gitdir MERGE_MSG]}
1338 catch {file delete [gitdir SQUASH_MSG]}
1339 catch {file delete [gitdir GITGUI_MSG]}
1341 # -- Let rerere do its thing.
1343 if {[file isdirectory [gitdir rr-cache]]} {
1344 catch {git rerere}
1347 # -- Run the post-commit hook.
1349 set pchook [gitdir hooks post-commit]
1350 if {[is_Cygwin] && [file isfile $pchook]} {
1351 set pchook [list sh -c [concat \
1352 "if test -x \"$pchook\";" \
1353 "then exec \"$pchook\";" \
1354 "fi"]]
1355 } elseif {![file executable $pchook]} {
1356 set pchook {}
1358 if {$pchook ne {}} {
1359 catch {exec $pchook &}
1362 $ui_comm delete 0.0 end
1363 $ui_comm edit reset
1364 $ui_comm edit modified false
1366 if {[is_enabled singlecommit]} do_quit
1368 # -- Make sure our current branch exists.
1370 if {$commit_type eq {initial}} {
1371 lappend all_heads $current_branch
1372 set all_heads [lsort -unique $all_heads]
1373 populate_branch_menu
1376 # -- Update in memory status
1378 set selected_commit_type new
1379 set commit_type normal
1380 set HEAD $cmt_id
1381 set PARENT $cmt_id
1382 set MERGE_HEAD [list]
1384 foreach path [array names file_states] {
1385 set s $file_states($path)
1386 set m [lindex $s 0]
1387 switch -glob -- $m {
1388 _O -
1389 _M -
1390 _D {continue}
1391 __ -
1392 A_ -
1393 M_ -
1394 D_ {
1395 unset file_states($path)
1396 catch {unset selected_paths($path)}
1398 DO {
1399 set file_states($path) [list _O [lindex $s 1] {} {}]
1401 AM -
1402 AD -
1403 MM -
1404 MD {
1405 set file_states($path) [list \
1406 _[string index $m 1] \
1407 [lindex $s 1] \
1408 [lindex $s 3] \
1414 display_all_files
1415 unlock_index
1416 reshow_diff
1417 set ui_status_value \
1418 "Changes committed as [string range $cmt_id 0 7]."
1421 ######################################################################
1423 ## fetch push
1425 proc fetch_from {remote} {
1426 set w [new_console \
1427 "fetch $remote" \
1428 "Fetching new changes from $remote"]
1429 set cmd [list git fetch]
1430 lappend cmd $remote
1431 console_exec $w $cmd console_done
1434 proc push_to {remote} {
1435 set w [new_console \
1436 "push $remote" \
1437 "Pushing changes to $remote"]
1438 set cmd [list git push]
1439 lappend cmd -v
1440 lappend cmd $remote
1441 console_exec $w $cmd console_done
1444 ######################################################################
1446 ## ui helpers
1448 proc mapicon {w state path} {
1449 global all_icons
1451 if {[catch {set r $all_icons($state$w)}]} {
1452 puts "error: no icon for $w state={$state} $path"
1453 return file_plain
1455 return $r
1458 proc mapdesc {state path} {
1459 global all_descs
1461 if {[catch {set r $all_descs($state)}]} {
1462 puts "error: no desc for state={$state} $path"
1463 return $state
1465 return $r
1468 proc escape_path {path} {
1469 regsub -all {\\} $path "\\\\" path
1470 regsub -all "\n" $path "\\n" path
1471 return $path
1474 proc short_path {path} {
1475 return [escape_path [lindex [file split $path] end]]
1478 set next_icon_id 0
1479 set null_sha1 [string repeat 0 40]
1481 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1482 global file_states next_icon_id null_sha1
1484 set s0 [string index $new_state 0]
1485 set s1 [string index $new_state 1]
1487 if {[catch {set info $file_states($path)}]} {
1488 set state __
1489 set icon n[incr next_icon_id]
1490 } else {
1491 set state [lindex $info 0]
1492 set icon [lindex $info 1]
1493 if {$head_info eq {}} {set head_info [lindex $info 2]}
1494 if {$index_info eq {}} {set index_info [lindex $info 3]}
1497 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1498 elseif {$s0 eq {_}} {set s0 _}
1500 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1501 elseif {$s1 eq {_}} {set s1 _}
1503 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1504 set head_info [list 0 $null_sha1]
1505 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1506 && $head_info eq {}} {
1507 set head_info $index_info
1510 set file_states($path) [list $s0$s1 $icon \
1511 $head_info $index_info \
1513 return $state
1516 proc display_file_helper {w path icon_name old_m new_m} {
1517 global file_lists
1519 if {$new_m eq {_}} {
1520 set lno [lsearch -sorted -exact $file_lists($w) $path]
1521 if {$lno >= 0} {
1522 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1523 incr lno
1524 $w conf -state normal
1525 $w delete $lno.0 [expr {$lno + 1}].0
1526 $w conf -state disabled
1528 } elseif {$old_m eq {_} && $new_m ne {_}} {
1529 lappend file_lists($w) $path
1530 set file_lists($w) [lsort -unique $file_lists($w)]
1531 set lno [lsearch -sorted -exact $file_lists($w) $path]
1532 incr lno
1533 $w conf -state normal
1534 $w image create $lno.0 \
1535 -align center -padx 5 -pady 1 \
1536 -name $icon_name \
1537 -image [mapicon $w $new_m $path]
1538 $w insert $lno.1 "[escape_path $path]\n"
1539 $w conf -state disabled
1540 } elseif {$old_m ne $new_m} {
1541 $w conf -state normal
1542 $w image conf $icon_name -image [mapicon $w $new_m $path]
1543 $w conf -state disabled
1547 proc display_file {path state} {
1548 global file_states selected_paths
1549 global ui_index ui_workdir
1551 set old_m [merge_state $path $state]
1552 set s $file_states($path)
1553 set new_m [lindex $s 0]
1554 set icon_name [lindex $s 1]
1556 set o [string index $old_m 0]
1557 set n [string index $new_m 0]
1558 if {$o eq {U}} {
1559 set o _
1561 if {$n eq {U}} {
1562 set n _
1564 display_file_helper $ui_index $path $icon_name $o $n
1566 if {[string index $old_m 0] eq {U}} {
1567 set o U
1568 } else {
1569 set o [string index $old_m 1]
1571 if {[string index $new_m 0] eq {U}} {
1572 set n U
1573 } else {
1574 set n [string index $new_m 1]
1576 display_file_helper $ui_workdir $path $icon_name $o $n
1578 if {$new_m eq {__}} {
1579 unset file_states($path)
1580 catch {unset selected_paths($path)}
1584 proc display_all_files_helper {w path icon_name m} {
1585 global file_lists
1587 lappend file_lists($w) $path
1588 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1589 $w image create end \
1590 -align center -padx 5 -pady 1 \
1591 -name $icon_name \
1592 -image [mapicon $w $m $path]
1593 $w insert end "[escape_path $path]\n"
1596 proc display_all_files {} {
1597 global ui_index ui_workdir
1598 global file_states file_lists
1599 global last_clicked
1601 $ui_index conf -state normal
1602 $ui_workdir conf -state normal
1604 $ui_index delete 0.0 end
1605 $ui_workdir delete 0.0 end
1606 set last_clicked {}
1608 set file_lists($ui_index) [list]
1609 set file_lists($ui_workdir) [list]
1611 foreach path [lsort [array names file_states]] {
1612 set s $file_states($path)
1613 set m [lindex $s 0]
1614 set icon_name [lindex $s 1]
1616 set s [string index $m 0]
1617 if {$s ne {U} && $s ne {_}} {
1618 display_all_files_helper $ui_index $path \
1619 $icon_name $s
1622 if {[string index $m 0] eq {U}} {
1623 set s U
1624 } else {
1625 set s [string index $m 1]
1627 if {$s ne {_}} {
1628 display_all_files_helper $ui_workdir $path \
1629 $icon_name $s
1633 $ui_index conf -state disabled
1634 $ui_workdir conf -state disabled
1637 proc update_indexinfo {msg pathList after} {
1638 global update_index_cp ui_status_value
1640 if {![lock_index update]} return
1642 set update_index_cp 0
1643 set pathList [lsort $pathList]
1644 set totalCnt [llength $pathList]
1645 set batch [expr {int($totalCnt * .01) + 1}]
1646 if {$batch > 25} {set batch 25}
1648 set ui_status_value [format \
1649 "$msg... %i/%i files (%.2f%%)" \
1650 $update_index_cp \
1651 $totalCnt \
1652 0.0]
1653 set fd [open "| git update-index -z --index-info" w]
1654 fconfigure $fd \
1655 -blocking 0 \
1656 -buffering full \
1657 -buffersize 512 \
1658 -encoding binary \
1659 -translation binary
1660 fileevent $fd writable [list \
1661 write_update_indexinfo \
1662 $fd \
1663 $pathList \
1664 $totalCnt \
1665 $batch \
1666 $msg \
1667 $after \
1671 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1672 global update_index_cp ui_status_value
1673 global file_states current_diff_path
1675 if {$update_index_cp >= $totalCnt} {
1676 close $fd
1677 unlock_index
1678 uplevel #0 $after
1679 return
1682 for {set i $batch} \
1683 {$update_index_cp < $totalCnt && $i > 0} \
1684 {incr i -1} {
1685 set path [lindex $pathList $update_index_cp]
1686 incr update_index_cp
1688 set s $file_states($path)
1689 switch -glob -- [lindex $s 0] {
1690 A? {set new _O}
1691 M? {set new _M}
1692 D_ {set new _D}
1693 D? {set new _?}
1694 ?? {continue}
1696 set info [lindex $s 2]
1697 if {$info eq {}} continue
1699 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1700 display_file $path $new
1703 set ui_status_value [format \
1704 "$msg... %i/%i files (%.2f%%)" \
1705 $update_index_cp \
1706 $totalCnt \
1707 [expr {100.0 * $update_index_cp / $totalCnt}]]
1710 proc update_index {msg pathList after} {
1711 global update_index_cp ui_status_value
1713 if {![lock_index update]} return
1715 set update_index_cp 0
1716 set pathList [lsort $pathList]
1717 set totalCnt [llength $pathList]
1718 set batch [expr {int($totalCnt * .01) + 1}]
1719 if {$batch > 25} {set batch 25}
1721 set ui_status_value [format \
1722 "$msg... %i/%i files (%.2f%%)" \
1723 $update_index_cp \
1724 $totalCnt \
1725 0.0]
1726 set fd [open "| git update-index --add --remove -z --stdin" w]
1727 fconfigure $fd \
1728 -blocking 0 \
1729 -buffering full \
1730 -buffersize 512 \
1731 -encoding binary \
1732 -translation binary
1733 fileevent $fd writable [list \
1734 write_update_index \
1735 $fd \
1736 $pathList \
1737 $totalCnt \
1738 $batch \
1739 $msg \
1740 $after \
1744 proc write_update_index {fd pathList totalCnt batch msg after} {
1745 global update_index_cp ui_status_value
1746 global file_states current_diff_path
1748 if {$update_index_cp >= $totalCnt} {
1749 close $fd
1750 unlock_index
1751 uplevel #0 $after
1752 return
1755 for {set i $batch} \
1756 {$update_index_cp < $totalCnt && $i > 0} \
1757 {incr i -1} {
1758 set path [lindex $pathList $update_index_cp]
1759 incr update_index_cp
1761 switch -glob -- [lindex $file_states($path) 0] {
1762 AD {set new __}
1763 ?D {set new D_}
1764 _O -
1765 AM {set new A_}
1766 U? {
1767 if {[file exists $path]} {
1768 set new M_
1769 } else {
1770 set new D_
1773 ?M {set new M_}
1774 ?? {continue}
1776 puts -nonewline $fd "[encoding convertto $path]\0"
1777 display_file $path $new
1780 set ui_status_value [format \
1781 "$msg... %i/%i files (%.2f%%)" \
1782 $update_index_cp \
1783 $totalCnt \
1784 [expr {100.0 * $update_index_cp / $totalCnt}]]
1787 proc checkout_index {msg pathList after} {
1788 global update_index_cp ui_status_value
1790 if {![lock_index update]} return
1792 set update_index_cp 0
1793 set pathList [lsort $pathList]
1794 set totalCnt [llength $pathList]
1795 set batch [expr {int($totalCnt * .01) + 1}]
1796 if {$batch > 25} {set batch 25}
1798 set ui_status_value [format \
1799 "$msg... %i/%i files (%.2f%%)" \
1800 $update_index_cp \
1801 $totalCnt \
1802 0.0]
1803 set cmd [list git checkout-index]
1804 lappend cmd --index
1805 lappend cmd --quiet
1806 lappend cmd --force
1807 lappend cmd -z
1808 lappend cmd --stdin
1809 set fd [open "| $cmd " w]
1810 fconfigure $fd \
1811 -blocking 0 \
1812 -buffering full \
1813 -buffersize 512 \
1814 -encoding binary \
1815 -translation binary
1816 fileevent $fd writable [list \
1817 write_checkout_index \
1818 $fd \
1819 $pathList \
1820 $totalCnt \
1821 $batch \
1822 $msg \
1823 $after \
1827 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1828 global update_index_cp ui_status_value
1829 global file_states current_diff_path
1831 if {$update_index_cp >= $totalCnt} {
1832 close $fd
1833 unlock_index
1834 uplevel #0 $after
1835 return
1838 for {set i $batch} \
1839 {$update_index_cp < $totalCnt && $i > 0} \
1840 {incr i -1} {
1841 set path [lindex $pathList $update_index_cp]
1842 incr update_index_cp
1843 switch -glob -- [lindex $file_states($path) 0] {
1844 U? {continue}
1845 ?M -
1846 ?D {
1847 puts -nonewline $fd "[encoding convertto $path]\0"
1848 display_file $path ?_
1853 set ui_status_value [format \
1854 "$msg... %i/%i files (%.2f%%)" \
1855 $update_index_cp \
1856 $totalCnt \
1857 [expr {100.0 * $update_index_cp / $totalCnt}]]
1860 ######################################################################
1862 ## branch management
1864 proc is_tracking_branch {name} {
1865 global tracking_branches
1867 if {![catch {set info $tracking_branches($name)}]} {
1868 return 1
1870 foreach t [array names tracking_branches] {
1871 if {[string match {*/\*} $t] && [string match $t $name]} {
1872 return 1
1875 return 0
1878 proc load_all_heads {} {
1879 global all_heads
1881 set all_heads [list]
1882 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1883 while {[gets $fd line] > 0} {
1884 if {[is_tracking_branch $line]} continue
1885 if {![regsub ^refs/heads/ $line {} name]} continue
1886 lappend all_heads $name
1888 close $fd
1890 set all_heads [lsort $all_heads]
1893 proc populate_branch_menu {} {
1894 global all_heads disable_on_lock
1896 set m .mbar.branch
1897 set last [$m index last]
1898 for {set i 0} {$i <= $last} {incr i} {
1899 if {[$m type $i] eq {separator}} {
1900 $m delete $i last
1901 set new_dol [list]
1902 foreach a $disable_on_lock {
1903 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1904 lappend new_dol $a
1907 set disable_on_lock $new_dol
1908 break
1912 if {$all_heads ne {}} {
1913 $m add separator
1915 foreach b $all_heads {
1916 $m add radiobutton \
1917 -label $b \
1918 -command [list switch_branch $b] \
1919 -variable current_branch \
1920 -value $b \
1921 -font font_ui
1922 lappend disable_on_lock \
1923 [list $m entryconf [$m index last] -state]
1927 proc all_tracking_branches {} {
1928 global tracking_branches
1930 set all_trackings {}
1931 set cmd {}
1932 foreach name [array names tracking_branches] {
1933 if {[regsub {/\*$} $name {} name]} {
1934 lappend cmd $name
1935 } else {
1936 regsub ^refs/(heads|remotes)/ $name {} name
1937 lappend all_trackings $name
1941 if {$cmd ne {}} {
1942 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1943 while {[gets $fd name] > 0} {
1944 regsub ^refs/(heads|remotes)/ $name {} name
1945 lappend all_trackings $name
1947 close $fd
1950 return [lsort -unique $all_trackings]
1953 proc load_all_tags {} {
1954 set all_tags [list]
1955 set fd [open "| git for-each-ref --format=%(refname) refs/tags" r]
1956 while {[gets $fd line] > 0} {
1957 if {![regsub ^refs/tags/ $line {} name]} continue
1958 lappend all_tags $name
1960 close $fd
1962 return [lsort $all_tags]
1965 proc do_create_branch_action {w} {
1966 global all_heads null_sha1 repo_config
1967 global create_branch_checkout create_branch_revtype
1968 global create_branch_head create_branch_trackinghead
1969 global create_branch_name create_branch_revexp
1970 global create_branch_tag
1972 set newbranch $create_branch_name
1973 if {$newbranch eq {}
1974 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1975 tk_messageBox \
1976 -icon error \
1977 -type ok \
1978 -title [wm title $w] \
1979 -parent $w \
1980 -message "Please supply a branch name."
1981 focus $w.desc.name_t
1982 return
1984 if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
1985 tk_messageBox \
1986 -icon error \
1987 -type ok \
1988 -title [wm title $w] \
1989 -parent $w \
1990 -message "Branch '$newbranch' already exists."
1991 focus $w.desc.name_t
1992 return
1994 if {[catch {git check-ref-format "heads/$newbranch"}]} {
1995 tk_messageBox \
1996 -icon error \
1997 -type ok \
1998 -title [wm title $w] \
1999 -parent $w \
2000 -message "We do not like '$newbranch' as a branch name."
2001 focus $w.desc.name_t
2002 return
2005 set rev {}
2006 switch -- $create_branch_revtype {
2007 head {set rev $create_branch_head}
2008 tracking {set rev $create_branch_trackinghead}
2009 tag {set rev $create_branch_tag}
2010 expression {set rev $create_branch_revexp}
2012 if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
2013 tk_messageBox \
2014 -icon error \
2015 -type ok \
2016 -title [wm title $w] \
2017 -parent $w \
2018 -message "Invalid starting revision: $rev"
2019 return
2021 set cmd [list git update-ref]
2022 lappend cmd -m
2023 lappend cmd "branch: Created from $rev"
2024 lappend cmd "refs/heads/$newbranch"
2025 lappend cmd $cmt
2026 lappend cmd $null_sha1
2027 if {[catch {eval exec $cmd} err]} {
2028 tk_messageBox \
2029 -icon error \
2030 -type ok \
2031 -title [wm title $w] \
2032 -parent $w \
2033 -message "Failed to create '$newbranch'.\n\n$err"
2034 return
2037 lappend all_heads $newbranch
2038 set all_heads [lsort $all_heads]
2039 populate_branch_menu
2040 destroy $w
2041 if {$create_branch_checkout} {
2042 switch_branch $newbranch
2046 proc radio_selector {varname value args} {
2047 upvar #0 $varname var
2048 set var $value
2051 trace add variable create_branch_head write \
2052 [list radio_selector create_branch_revtype head]
2053 trace add variable create_branch_trackinghead write \
2054 [list radio_selector create_branch_revtype tracking]
2055 trace add variable create_branch_tag write \
2056 [list radio_selector create_branch_revtype tag]
2058 trace add variable delete_branch_head write \
2059 [list radio_selector delete_branch_checktype head]
2060 trace add variable delete_branch_trackinghead write \
2061 [list radio_selector delete_branch_checktype tracking]
2063 proc do_create_branch {} {
2064 global all_heads current_branch repo_config
2065 global create_branch_checkout create_branch_revtype
2066 global create_branch_head create_branch_trackinghead
2067 global create_branch_name create_branch_revexp
2068 global create_branch_tag
2070 set w .branch_editor
2071 toplevel $w
2072 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2074 label $w.header -text {Create New Branch} \
2075 -font font_uibold
2076 pack $w.header -side top -fill x
2078 frame $w.buttons
2079 button $w.buttons.create -text Create \
2080 -font font_ui \
2081 -default active \
2082 -command [list do_create_branch_action $w]
2083 pack $w.buttons.create -side right
2084 button $w.buttons.cancel -text {Cancel} \
2085 -font font_ui \
2086 -command [list destroy $w]
2087 pack $w.buttons.cancel -side right -padx 5
2088 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2090 labelframe $w.desc \
2091 -text {Branch Description} \
2092 -font font_ui
2093 label $w.desc.name_l -text {Name:} -font font_ui
2094 entry $w.desc.name_t \
2095 -borderwidth 1 \
2096 -relief sunken \
2097 -width 40 \
2098 -textvariable create_branch_name \
2099 -font font_ui \
2100 -validate key \
2101 -validatecommand {
2102 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2103 return 1
2105 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2106 grid columnconfigure $w.desc 1 -weight 1
2107 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2109 labelframe $w.from \
2110 -text {Starting Revision} \
2111 -font font_ui
2112 radiobutton $w.from.head_r \
2113 -text {Local Branch:} \
2114 -value head \
2115 -variable create_branch_revtype \
2116 -font font_ui
2117 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2118 grid $w.from.head_r $w.from.head_m -sticky w
2119 set all_trackings [all_tracking_branches]
2120 if {$all_trackings ne {}} {
2121 set create_branch_trackinghead [lindex $all_trackings 0]
2122 radiobutton $w.from.tracking_r \
2123 -text {Tracking Branch:} \
2124 -value tracking \
2125 -variable create_branch_revtype \
2126 -font font_ui
2127 eval tk_optionMenu $w.from.tracking_m \
2128 create_branch_trackinghead \
2129 $all_trackings
2130 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2132 set all_tags [load_all_tags]
2133 if {$all_tags ne {}} {
2134 set create_branch_tag [lindex $all_tags 0]
2135 radiobutton $w.from.tag_r \
2136 -text {Tag:} \
2137 -value tag \
2138 -variable create_branch_revtype \
2139 -font font_ui
2140 eval tk_optionMenu $w.from.tag_m \
2141 create_branch_tag \
2142 $all_tags
2143 grid $w.from.tag_r $w.from.tag_m -sticky w
2145 radiobutton $w.from.exp_r \
2146 -text {Revision Expression:} \
2147 -value expression \
2148 -variable create_branch_revtype \
2149 -font font_ui
2150 entry $w.from.exp_t \
2151 -borderwidth 1 \
2152 -relief sunken \
2153 -width 50 \
2154 -textvariable create_branch_revexp \
2155 -font font_ui \
2156 -validate key \
2157 -validatecommand {
2158 if {%d == 1 && [regexp {\s} %S]} {return 0}
2159 if {%d == 1 && [string length %S] > 0} {
2160 set create_branch_revtype expression
2162 return 1
2164 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2165 grid columnconfigure $w.from 1 -weight 1
2166 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2168 labelframe $w.postActions \
2169 -text {Post Creation Actions} \
2170 -font font_ui
2171 checkbutton $w.postActions.checkout \
2172 -text {Checkout after creation} \
2173 -variable create_branch_checkout \
2174 -font font_ui
2175 pack $w.postActions.checkout -anchor nw
2176 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2178 set create_branch_checkout 1
2179 set create_branch_head $current_branch
2180 set create_branch_revtype head
2181 set create_branch_name $repo_config(gui.newbranchtemplate)
2182 set create_branch_revexp {}
2184 bind $w <Visibility> "
2185 grab $w
2186 $w.desc.name_t icursor end
2187 focus $w.desc.name_t
2189 bind $w <Key-Escape> "destroy $w"
2190 bind $w <Key-Return> "do_create_branch_action $w;break"
2191 wm title $w "[appname] ([reponame]): Create Branch"
2192 tkwait window $w
2195 proc do_delete_branch_action {w} {
2196 global all_heads
2197 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2199 set check_rev {}
2200 switch -- $delete_branch_checktype {
2201 head {set check_rev $delete_branch_head}
2202 tracking {set check_rev $delete_branch_trackinghead}
2203 always {set check_rev {:none}}
2205 if {$check_rev eq {:none}} {
2206 set check_cmt {}
2207 } elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
2208 tk_messageBox \
2209 -icon error \
2210 -type ok \
2211 -title [wm title $w] \
2212 -parent $w \
2213 -message "Invalid check revision: $check_rev"
2214 return
2217 set to_delete [list]
2218 set not_merged [list]
2219 foreach i [$w.list.l curselection] {
2220 set b [$w.list.l get $i]
2221 if {[catch {set o [git rev-parse --verify $b]}]} continue
2222 if {$check_cmt ne {}} {
2223 if {$b eq $check_rev} continue
2224 if {[catch {set m [git merge-base $o $check_cmt]}]} continue
2225 if {$o ne $m} {
2226 lappend not_merged $b
2227 continue
2230 lappend to_delete [list $b $o]
2232 if {$not_merged ne {}} {
2233 set msg "The following branches are not completely merged into $check_rev:
2235 - [join $not_merged "\n - "]"
2236 tk_messageBox \
2237 -icon info \
2238 -type ok \
2239 -title [wm title $w] \
2240 -parent $w \
2241 -message $msg
2243 if {$to_delete eq {}} return
2244 if {$delete_branch_checktype eq {always}} {
2245 set msg {Recovering deleted branches is difficult.
2247 Delete the selected branches?}
2248 if {[tk_messageBox \
2249 -icon warning \
2250 -type yesno \
2251 -title [wm title $w] \
2252 -parent $w \
2253 -message $msg] ne yes} {
2254 return
2258 set failed {}
2259 foreach i $to_delete {
2260 set b [lindex $i 0]
2261 set o [lindex $i 1]
2262 if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
2263 append failed " - $b: $err\n"
2264 } else {
2265 set x [lsearch -sorted -exact $all_heads $b]
2266 if {$x >= 0} {
2267 set all_heads [lreplace $all_heads $x $x]
2272 if {$failed ne {}} {
2273 tk_messageBox \
2274 -icon error \
2275 -type ok \
2276 -title [wm title $w] \
2277 -parent $w \
2278 -message "Failed to delete branches:\n$failed"
2281 set all_heads [lsort $all_heads]
2282 populate_branch_menu
2283 destroy $w
2286 proc do_delete_branch {} {
2287 global all_heads tracking_branches current_branch
2288 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2290 set w .branch_editor
2291 toplevel $w
2292 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2294 label $w.header -text {Delete Local Branch} \
2295 -font font_uibold
2296 pack $w.header -side top -fill x
2298 frame $w.buttons
2299 button $w.buttons.create -text Delete \
2300 -font font_ui \
2301 -command [list do_delete_branch_action $w]
2302 pack $w.buttons.create -side right
2303 button $w.buttons.cancel -text {Cancel} \
2304 -font font_ui \
2305 -command [list destroy $w]
2306 pack $w.buttons.cancel -side right -padx 5
2307 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2309 labelframe $w.list \
2310 -text {Local Branches} \
2311 -font font_ui
2312 listbox $w.list.l \
2313 -height 10 \
2314 -width 70 \
2315 -selectmode extended \
2316 -yscrollcommand [list $w.list.sby set] \
2317 -font font_ui
2318 foreach h $all_heads {
2319 if {$h ne $current_branch} {
2320 $w.list.l insert end $h
2323 scrollbar $w.list.sby -command [list $w.list.l yview]
2324 pack $w.list.sby -side right -fill y
2325 pack $w.list.l -side left -fill both -expand 1
2326 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2328 labelframe $w.validate \
2329 -text {Delete Only If} \
2330 -font font_ui
2331 radiobutton $w.validate.head_r \
2332 -text {Merged Into Local Branch:} \
2333 -value head \
2334 -variable delete_branch_checktype \
2335 -font font_ui
2336 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2337 grid $w.validate.head_r $w.validate.head_m -sticky w
2338 set all_trackings [all_tracking_branches]
2339 if {$all_trackings ne {}} {
2340 set delete_branch_trackinghead [lindex $all_trackings 0]
2341 radiobutton $w.validate.tracking_r \
2342 -text {Merged Into Tracking Branch:} \
2343 -value tracking \
2344 -variable delete_branch_checktype \
2345 -font font_ui
2346 eval tk_optionMenu $w.validate.tracking_m \
2347 delete_branch_trackinghead \
2348 $all_trackings
2349 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2351 radiobutton $w.validate.always_r \
2352 -text {Always (Do not perform merge checks)} \
2353 -value always \
2354 -variable delete_branch_checktype \
2355 -font font_ui
2356 grid $w.validate.always_r -columnspan 2 -sticky w
2357 grid columnconfigure $w.validate 1 -weight 1
2358 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2360 set delete_branch_head $current_branch
2361 set delete_branch_checktype head
2363 bind $w <Visibility> "grab $w; focus $w"
2364 bind $w <Key-Escape> "destroy $w"
2365 wm title $w "[appname] ([reponame]): Delete Branch"
2366 tkwait window $w
2369 proc switch_branch {new_branch} {
2370 global HEAD commit_type current_branch repo_config
2372 if {![lock_index switch]} return
2374 # -- Our in memory state should match the repository.
2376 repository_state curType curHEAD curMERGE_HEAD
2377 if {[string match amend* $commit_type]
2378 && $curType eq {normal}
2379 && $curHEAD eq $HEAD} {
2380 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2381 info_popup {Last scanned state does not match repository state.
2383 Another Git program has modified this repository
2384 since the last scan. A rescan must be performed
2385 before the current branch can be changed.
2387 The rescan will be automatically started now.
2389 unlock_index
2390 rescan {set ui_status_value {Ready.}}
2391 return
2394 # -- Don't do a pointless switch.
2396 if {$current_branch eq $new_branch} {
2397 unlock_index
2398 return
2401 if {$repo_config(gui.trustmtime) eq {true}} {
2402 switch_branch_stage2 {} $new_branch
2403 } else {
2404 set ui_status_value {Refreshing file status...}
2405 set cmd [list git update-index]
2406 lappend cmd -q
2407 lappend cmd --unmerged
2408 lappend cmd --ignore-missing
2409 lappend cmd --refresh
2410 set fd_rf [open "| $cmd" r]
2411 fconfigure $fd_rf -blocking 0 -translation binary
2412 fileevent $fd_rf readable \
2413 [list switch_branch_stage2 $fd_rf $new_branch]
2417 proc switch_branch_stage2 {fd_rf new_branch} {
2418 global ui_status_value HEAD
2420 if {$fd_rf ne {}} {
2421 read $fd_rf
2422 if {![eof $fd_rf]} return
2423 close $fd_rf
2426 set ui_status_value "Updating working directory to '$new_branch'..."
2427 set cmd [list git read-tree]
2428 lappend cmd -m
2429 lappend cmd -u
2430 lappend cmd --exclude-per-directory=.gitignore
2431 lappend cmd $HEAD
2432 lappend cmd $new_branch
2433 set fd_rt [open "| $cmd" r]
2434 fconfigure $fd_rt -blocking 0 -translation binary
2435 fileevent $fd_rt readable \
2436 [list switch_branch_readtree_wait $fd_rt $new_branch]
2439 proc switch_branch_readtree_wait {fd_rt new_branch} {
2440 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2441 global current_branch
2442 global ui_comm ui_status_value
2444 # -- We never get interesting output on stdout; only stderr.
2446 read $fd_rt
2447 fconfigure $fd_rt -blocking 1
2448 if {![eof $fd_rt]} {
2449 fconfigure $fd_rt -blocking 0
2450 return
2453 # -- The working directory wasn't in sync with the index and
2454 # we'd have to overwrite something to make the switch. A
2455 # merge is required.
2457 if {[catch {close $fd_rt} err]} {
2458 regsub {^fatal: } $err {} err
2459 warn_popup "File level merge required.
2461 $err
2463 Staying on branch '$current_branch'."
2464 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2465 unlock_index
2466 return
2469 # -- Update the symbolic ref. Core git doesn't even check for failure
2470 # here, it Just Works(tm). If it doesn't we are in some really ugly
2471 # state that is difficult to recover from within git-gui.
2473 if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2474 error_popup "Failed to set current branch.
2476 This working directory is only partially switched.
2477 We successfully updated your files, but failed to
2478 update an internal Git file.
2480 This should not have occurred. [appname] will now
2481 close and give up.
2483 $err"
2484 do_quit
2485 return
2488 # -- Update our repository state. If we were previously in amend mode
2489 # we need to toss the current buffer and do a full rescan to update
2490 # our file lists. If we weren't in amend mode our file lists are
2491 # accurate and we can avoid the rescan.
2493 unlock_index
2494 set selected_commit_type new
2495 if {[string match amend* $commit_type]} {
2496 $ui_comm delete 0.0 end
2497 $ui_comm edit reset
2498 $ui_comm edit modified false
2499 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2500 } else {
2501 repository_state commit_type HEAD MERGE_HEAD
2502 set PARENT $HEAD
2503 set ui_status_value "Checked out branch '$current_branch'."
2507 ######################################################################
2509 ## remote management
2511 proc load_all_remotes {} {
2512 global repo_config
2513 global all_remotes tracking_branches
2515 set all_remotes [list]
2516 array unset tracking_branches
2518 set rm_dir [gitdir remotes]
2519 if {[file isdirectory $rm_dir]} {
2520 set all_remotes [glob \
2521 -types f \
2522 -tails \
2523 -nocomplain \
2524 -directory $rm_dir *]
2526 foreach name $all_remotes {
2527 catch {
2528 set fd [open [file join $rm_dir $name] r]
2529 while {[gets $fd line] >= 0} {
2530 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2531 $line line src dst]} continue
2532 if {![regexp ^refs/ $dst]} {
2533 set dst "refs/heads/$dst"
2535 set tracking_branches($dst) [list $name $src]
2537 close $fd
2542 foreach line [array names repo_config remote.*.url] {
2543 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2544 lappend all_remotes $name
2546 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2547 set fl {}
2549 foreach line $fl {
2550 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2551 if {![regexp ^refs/ $dst]} {
2552 set dst "refs/heads/$dst"
2554 set tracking_branches($dst) [list $name $src]
2558 set all_remotes [lsort -unique $all_remotes]
2561 proc populate_fetch_menu {} {
2562 global all_remotes repo_config
2564 set m .mbar.fetch
2565 foreach r $all_remotes {
2566 set enable 0
2567 if {![catch {set a $repo_config(remote.$r.url)}]} {
2568 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2569 set enable 1
2571 } else {
2572 catch {
2573 set fd [open [gitdir remotes $r] r]
2574 while {[gets $fd n] >= 0} {
2575 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2576 set enable 1
2577 break
2580 close $fd
2584 if {$enable} {
2585 $m add command \
2586 -label "Fetch from $r..." \
2587 -command [list fetch_from $r] \
2588 -font font_ui
2593 proc populate_push_menu {} {
2594 global all_remotes repo_config
2596 set m .mbar.push
2597 set fast_count 0
2598 foreach r $all_remotes {
2599 set enable 0
2600 if {![catch {set a $repo_config(remote.$r.url)}]} {
2601 if {![catch {set a $repo_config(remote.$r.push)}]} {
2602 set enable 1
2604 } else {
2605 catch {
2606 set fd [open [gitdir remotes $r] r]
2607 while {[gets $fd n] >= 0} {
2608 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2609 set enable 1
2610 break
2613 close $fd
2617 if {$enable} {
2618 if {!$fast_count} {
2619 $m add separator
2621 $m add command \
2622 -label "Push to $r..." \
2623 -command [list push_to $r] \
2624 -font font_ui
2625 incr fast_count
2630 proc start_push_anywhere_action {w} {
2631 global push_urltype push_remote push_url push_thin push_tags
2633 set r_url {}
2634 switch -- $push_urltype {
2635 remote {set r_url $push_remote}
2636 url {set r_url $push_url}
2638 if {$r_url eq {}} return
2640 set cmd [list git push]
2641 lappend cmd -v
2642 if {$push_thin} {
2643 lappend cmd --thin
2645 if {$push_tags} {
2646 lappend cmd --tags
2648 lappend cmd $r_url
2649 set cnt 0
2650 foreach i [$w.source.l curselection] {
2651 set b [$w.source.l get $i]
2652 lappend cmd "refs/heads/$b:refs/heads/$b"
2653 incr cnt
2655 if {$cnt == 0} {
2656 return
2657 } elseif {$cnt == 1} {
2658 set unit branch
2659 } else {
2660 set unit branches
2663 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2664 console_exec $cons $cmd console_done
2665 destroy $w
2668 trace add variable push_remote write \
2669 [list radio_selector push_urltype remote]
2671 proc do_push_anywhere {} {
2672 global all_heads all_remotes current_branch
2673 global push_urltype push_remote push_url push_thin push_tags
2675 set w .push_setup
2676 toplevel $w
2677 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2679 label $w.header -text {Push Branches} -font font_uibold
2680 pack $w.header -side top -fill x
2682 frame $w.buttons
2683 button $w.buttons.create -text Push \
2684 -font font_ui \
2685 -command [list start_push_anywhere_action $w]
2686 pack $w.buttons.create -side right
2687 button $w.buttons.cancel -text {Cancel} \
2688 -font font_ui \
2689 -command [list destroy $w]
2690 pack $w.buttons.cancel -side right -padx 5
2691 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2693 labelframe $w.source \
2694 -text {Source Branches} \
2695 -font font_ui
2696 listbox $w.source.l \
2697 -height 10 \
2698 -width 70 \
2699 -selectmode extended \
2700 -yscrollcommand [list $w.source.sby set] \
2701 -font font_ui
2702 foreach h $all_heads {
2703 $w.source.l insert end $h
2704 if {$h eq $current_branch} {
2705 $w.source.l select set end
2708 scrollbar $w.source.sby -command [list $w.source.l yview]
2709 pack $w.source.sby -side right -fill y
2710 pack $w.source.l -side left -fill both -expand 1
2711 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2713 labelframe $w.dest \
2714 -text {Destination Repository} \
2715 -font font_ui
2716 if {$all_remotes ne {}} {
2717 radiobutton $w.dest.remote_r \
2718 -text {Remote:} \
2719 -value remote \
2720 -variable push_urltype \
2721 -font font_ui
2722 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2723 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2724 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2725 set push_remote origin
2726 } else {
2727 set push_remote [lindex $all_remotes 0]
2729 set push_urltype remote
2730 } else {
2731 set push_urltype url
2733 radiobutton $w.dest.url_r \
2734 -text {Arbitrary URL:} \
2735 -value url \
2736 -variable push_urltype \
2737 -font font_ui
2738 entry $w.dest.url_t \
2739 -borderwidth 1 \
2740 -relief sunken \
2741 -width 50 \
2742 -textvariable push_url \
2743 -font font_ui \
2744 -validate key \
2745 -validatecommand {
2746 if {%d == 1 && [regexp {\s} %S]} {return 0}
2747 if {%d == 1 && [string length %S] > 0} {
2748 set push_urltype url
2750 return 1
2752 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2753 grid columnconfigure $w.dest 1 -weight 1
2754 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2756 labelframe $w.options \
2757 -text {Transfer Options} \
2758 -font font_ui
2759 checkbutton $w.options.thin \
2760 -text {Use thin pack (for slow network connections)} \
2761 -variable push_thin \
2762 -font font_ui
2763 grid $w.options.thin -columnspan 2 -sticky w
2764 checkbutton $w.options.tags \
2765 -text {Include tags} \
2766 -variable push_tags \
2767 -font font_ui
2768 grid $w.options.tags -columnspan 2 -sticky w
2769 grid columnconfigure $w.options 1 -weight 1
2770 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2772 set push_url {}
2773 set push_thin 0
2774 set push_tags 0
2776 bind $w <Visibility> "grab $w"
2777 bind $w <Key-Escape> "destroy $w"
2778 wm title $w "[appname] ([reponame]): Push"
2779 tkwait window $w
2782 ######################################################################
2784 ## merge
2786 proc can_merge {} {
2787 global HEAD commit_type file_states
2789 if {[string match amend* $commit_type]} {
2790 info_popup {Cannot merge while amending.
2792 You must finish amending this commit before
2793 starting any type of merge.
2795 return 0
2798 if {[committer_ident] eq {}} {return 0}
2799 if {![lock_index merge]} {return 0}
2801 # -- Our in memory state should match the repository.
2803 repository_state curType curHEAD curMERGE_HEAD
2804 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2805 info_popup {Last scanned state does not match repository state.
2807 Another Git program has modified this repository
2808 since the last scan. A rescan must be performed
2809 before a merge can be performed.
2811 The rescan will be automatically started now.
2813 unlock_index
2814 rescan {set ui_status_value {Ready.}}
2815 return 0
2818 foreach path [array names file_states] {
2819 switch -glob -- [lindex $file_states($path) 0] {
2820 _O {
2821 continue; # and pray it works!
2823 U? {
2824 error_popup "You are in the middle of a conflicted merge.
2826 File [short_path $path] has merge conflicts.
2828 You must resolve them, add the file, and commit to
2829 complete the current merge. Only then can you
2830 begin another merge.
2832 unlock_index
2833 return 0
2835 ?? {
2836 error_popup "You are in the middle of a change.
2838 File [short_path $path] is modified.
2840 You should complete the current commit before
2841 starting a merge. Doing so will help you abort
2842 a failed merge, should the need arise.
2844 unlock_index
2845 return 0
2850 return 1
2853 proc visualize_local_merge {w} {
2854 set revs {}
2855 foreach i [$w.source.l curselection] {
2856 lappend revs [$w.source.l get $i]
2858 if {$revs eq {}} return
2859 lappend revs --not HEAD
2860 do_gitk $revs
2863 proc start_local_merge_action {w} {
2864 global HEAD ui_status_value current_branch
2866 set cmd [list git merge]
2867 set names {}
2868 set revcnt 0
2869 foreach i [$w.source.l curselection] {
2870 set b [$w.source.l get $i]
2871 lappend cmd $b
2872 lappend names $b
2873 incr revcnt
2876 if {$revcnt == 0} {
2877 return
2878 } elseif {$revcnt == 1} {
2879 set unit branch
2880 } elseif {$revcnt <= 15} {
2881 set unit branches
2882 } else {
2883 tk_messageBox \
2884 -icon error \
2885 -type ok \
2886 -title [wm title $w] \
2887 -parent $w \
2888 -message "Too many branches selected.
2890 You have requested to merge $revcnt branches
2891 in an octopus merge. This exceeds Git's
2892 internal limit of 15 branches per merge.
2894 Please select fewer branches. To merge more
2895 than 15 branches, merge the branches in batches.
2897 return
2900 set msg "Merging $current_branch, [join $names {, }]"
2901 set ui_status_value "$msg..."
2902 set cons [new_console "Merge" $msg]
2903 console_exec $cons $cmd [list finish_merge $revcnt]
2904 bind $w <Destroy> {}
2905 destroy $w
2908 proc finish_merge {revcnt w ok} {
2909 console_done $w $ok
2910 if {$ok} {
2911 set msg {Merge completed successfully.}
2912 } else {
2913 if {$revcnt != 1} {
2914 info_popup "Octopus merge failed.
2916 Your merge of $revcnt branches has failed.
2918 There are file-level conflicts between the
2919 branches which must be resolved manually.
2921 The working directory will now be reset.
2923 You can attempt this merge again
2924 by merging only one branch at a time." $w
2926 set fd [open "| git read-tree --reset -u HEAD" r]
2927 fconfigure $fd -blocking 0 -translation binary
2928 fileevent $fd readable [list reset_hard_wait $fd]
2929 set ui_status_value {Aborting... please wait...}
2930 return
2933 set msg {Merge failed. Conflict resolution is required.}
2935 unlock_index
2936 rescan [list set ui_status_value $msg]
2939 proc do_local_merge {} {
2940 global current_branch
2942 if {![can_merge]} return
2944 set w .merge_setup
2945 toplevel $w
2946 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2948 label $w.header \
2949 -text "Merge Into $current_branch" \
2950 -font font_uibold
2951 pack $w.header -side top -fill x
2953 frame $w.buttons
2954 button $w.buttons.visualize -text Visualize \
2955 -font font_ui \
2956 -command [list visualize_local_merge $w]
2957 pack $w.buttons.visualize -side left
2958 button $w.buttons.create -text Merge \
2959 -font font_ui \
2960 -command [list start_local_merge_action $w]
2961 pack $w.buttons.create -side right
2962 button $w.buttons.cancel -text {Cancel} \
2963 -font font_ui \
2964 -command [list destroy $w]
2965 pack $w.buttons.cancel -side right -padx 5
2966 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2968 labelframe $w.source \
2969 -text {Source Branches} \
2970 -font font_ui
2971 listbox $w.source.l \
2972 -height 10 \
2973 -width 70 \
2974 -selectmode extended \
2975 -yscrollcommand [list $w.source.sby set] \
2976 -font font_ui
2977 scrollbar $w.source.sby -command [list $w.source.l yview]
2978 pack $w.source.sby -side right -fill y
2979 pack $w.source.l -side left -fill both -expand 1
2980 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2982 set cmd [list git for-each-ref]
2983 lappend cmd {--format=%(objectname) %(*objectname) %(refname)}
2984 lappend cmd refs/heads
2985 lappend cmd refs/remotes
2986 lappend cmd refs/tags
2987 set fr_fd [open "| $cmd" r]
2988 fconfigure $fr_fd -translation binary
2989 while {[gets $fr_fd line] > 0} {
2990 set line [split $line { }]
2991 set sha1([lindex $line 0]) [lindex $line 2]
2992 set sha1([lindex $line 1]) [lindex $line 2]
2994 close $fr_fd
2996 set to_show {}
2997 set fr_fd [open "| git rev-list --all --not HEAD"]
2998 while {[gets $fr_fd line] > 0} {
2999 if {[catch {set ref $sha1($line)}]} continue
3000 regsub ^refs/(heads|remotes|tags)/ $ref {} ref
3001 lappend to_show $ref
3003 close $fr_fd
3005 foreach ref [lsort -unique $to_show] {
3006 $w.source.l insert end $ref
3009 bind $w <Visibility> "grab $w"
3010 bind $w <Key-Escape> "unlock_index;destroy $w"
3011 bind $w <Destroy> unlock_index
3012 wm title $w "[appname] ([reponame]): Merge"
3013 tkwait window $w
3016 proc do_reset_hard {} {
3017 global HEAD commit_type file_states
3019 if {[string match amend* $commit_type]} {
3020 info_popup {Cannot abort while amending.
3022 You must finish amending this commit.
3024 return
3027 if {![lock_index abort]} return
3029 if {[string match *merge* $commit_type]} {
3030 set op merge
3031 } else {
3032 set op commit
3035 if {[ask_popup "Abort $op?
3037 Aborting the current $op will cause
3038 *ALL* uncommitted changes to be lost.
3040 Continue with aborting the current $op?"] eq {yes}} {
3041 set fd [open "| git read-tree --reset -u HEAD" r]
3042 fconfigure $fd -blocking 0 -translation binary
3043 fileevent $fd readable [list reset_hard_wait $fd]
3044 set ui_status_value {Aborting... please wait...}
3045 } else {
3046 unlock_index
3050 proc reset_hard_wait {fd} {
3051 global ui_comm
3053 read $fd
3054 if {[eof $fd]} {
3055 close $fd
3056 unlock_index
3058 $ui_comm delete 0.0 end
3059 $ui_comm edit modified false
3061 catch {file delete [gitdir MERGE_HEAD]}
3062 catch {file delete [gitdir rr-cache MERGE_RR]}
3063 catch {file delete [gitdir SQUASH_MSG]}
3064 catch {file delete [gitdir MERGE_MSG]}
3065 catch {file delete [gitdir GITGUI_MSG]}
3067 rescan {set ui_status_value {Abort completed. Ready.}}
3071 ######################################################################
3073 ## browser
3075 set next_browser_id 0
3077 proc new_browser {commit} {
3078 global next_browser_id cursor_ptr M1B
3079 global browser_commit browser_status browser_stack browser_path browser_busy
3081 if {[winfo ismapped .]} {
3082 set w .browser[incr next_browser_id]
3083 set tl $w
3084 toplevel $w
3085 } else {
3086 set w {}
3087 set tl .
3089 set w_list $w.list.l
3090 set browser_commit($w_list) $commit
3091 set browser_status($w_list) {Starting...}
3092 set browser_stack($w_list) {}
3093 set browser_path($w_list) $browser_commit($w_list):
3094 set browser_busy($w_list) 1
3096 label $w.path -textvariable browser_path($w_list) \
3097 -anchor w \
3098 -justify left \
3099 -borderwidth 1 \
3100 -relief sunken \
3101 -font font_uibold
3102 pack $w.path -anchor w -side top -fill x
3104 frame $w.list
3105 text $w_list -background white -borderwidth 0 \
3106 -cursor $cursor_ptr \
3107 -state disabled \
3108 -wrap none \
3109 -height 20 \
3110 -width 70 \
3111 -xscrollcommand [list $w.list.sbx set] \
3112 -yscrollcommand [list $w.list.sby set] \
3113 -font font_ui
3114 $w_list tag conf in_sel \
3115 -background [$w_list cget -foreground] \
3116 -foreground [$w_list cget -background]
3117 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3118 scrollbar $w.list.sby -orient v -command [list $w_list yview]
3119 pack $w.list.sbx -side bottom -fill x
3120 pack $w.list.sby -side right -fill y
3121 pack $w_list -side left -fill both -expand 1
3122 pack $w.list -side top -fill both -expand 1
3124 label $w.status -textvariable browser_status($w_list) \
3125 -anchor w \
3126 -justify left \
3127 -borderwidth 1 \
3128 -relief sunken \
3129 -font font_ui
3130 pack $w.status -anchor w -side bottom -fill x
3132 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3133 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3134 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3135 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3136 bind $w_list <Up> "browser_move -1 $w_list;break"
3137 bind $w_list <Down> "browser_move 1 $w_list;break"
3138 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3139 bind $w_list <Return> "browser_enter $w_list;break"
3140 bind $w_list <Prior> "browser_page -1 $w_list;break"
3141 bind $w_list <Next> "browser_page 1 $w_list;break"
3142 bind $w_list <Left> break
3143 bind $w_list <Right> break
3145 bind $tl <Visibility> "focus $w"
3146 bind $tl <Destroy> "
3147 array unset browser_buffer $w_list
3148 array unset browser_files $w_list
3149 array unset browser_status $w_list
3150 array unset browser_stack $w_list
3151 array unset browser_path $w_list
3152 array unset browser_commit $w_list
3153 array unset browser_busy $w_list
3155 wm title $tl "[appname] ([reponame]): File Browser"
3156 ls_tree $w_list $browser_commit($w_list) {}
3159 proc browser_move {dir w} {
3160 global browser_files browser_busy
3162 if {$browser_busy($w)} return
3163 set lno [lindex [split [$w index in_sel.first] .] 0]
3164 incr lno $dir
3165 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3166 $w tag remove in_sel 0.0 end
3167 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3168 $w see $lno.0
3172 proc browser_page {dir w} {
3173 global browser_files browser_busy
3175 if {$browser_busy($w)} return
3176 $w yview scroll $dir pages
3177 set lno [expr {int(
3178 [lindex [$w yview] 0]
3179 * [llength $browser_files($w)]
3180 + 1)}]
3181 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3182 $w tag remove in_sel 0.0 end
3183 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3184 $w see $lno.0
3188 proc browser_parent {w} {
3189 global browser_files browser_status browser_path
3190 global browser_stack browser_busy
3192 if {$browser_busy($w)} return
3193 set info [lindex $browser_files($w) 0]
3194 if {[lindex $info 0] eq {parent}} {
3195 set parent [lindex $browser_stack($w) end-1]
3196 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3197 if {$browser_stack($w) eq {}} {
3198 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3199 } else {
3200 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3202 set browser_status($w) "Loading $browser_path($w)..."
3203 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3207 proc browser_enter {w} {
3208 global browser_files browser_status browser_path
3209 global browser_commit browser_stack browser_busy
3211 if {$browser_busy($w)} return
3212 set lno [lindex [split [$w index in_sel.first] .] 0]
3213 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3214 if {$info ne {}} {
3215 switch -- [lindex $info 0] {
3216 parent {
3217 browser_parent $w
3219 tree {
3220 set name [lindex $info 2]
3221 set escn [escape_path $name]
3222 set browser_status($w) "Loading $escn..."
3223 append browser_path($w) $escn
3224 ls_tree $w [lindex $info 1] $name
3226 blob {
3227 set name [lindex $info 2]
3228 set p {}
3229 foreach n $browser_stack($w) {
3230 append p [lindex $n 1]
3232 append p $name
3233 show_blame $browser_commit($w) $p
3239 proc browser_click {was_double_click w pos} {
3240 global browser_files browser_busy
3242 if {$browser_busy($w)} return
3243 set lno [lindex [split [$w index $pos] .] 0]
3244 focus $w
3246 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3247 $w tag remove in_sel 0.0 end
3248 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3249 if {$was_double_click} {
3250 browser_enter $w
3255 proc ls_tree {w tree_id name} {
3256 global browser_buffer browser_files browser_stack browser_busy
3258 set browser_buffer($w) {}
3259 set browser_files($w) {}
3260 set browser_busy($w) 1
3262 $w conf -state normal
3263 $w tag remove in_sel 0.0 end
3264 $w delete 0.0 end
3265 if {$browser_stack($w) ne {}} {
3266 $w image create end \
3267 -align center -padx 5 -pady 1 \
3268 -name icon0 \
3269 -image file_uplevel
3270 $w insert end {[Up To Parent]}
3271 lappend browser_files($w) parent
3273 lappend browser_stack($w) [list $tree_id $name]
3274 $w conf -state disabled
3276 set cmd [list git ls-tree -z $tree_id]
3277 set fd [open "| $cmd" r]
3278 fconfigure $fd -blocking 0 -translation binary -encoding binary
3279 fileevent $fd readable [list read_ls_tree $fd $w]
3282 proc read_ls_tree {fd w} {
3283 global browser_buffer browser_files browser_status browser_busy
3285 if {![winfo exists $w]} {
3286 catch {close $fd}
3287 return
3290 append browser_buffer($w) [read $fd]
3291 set pck [split $browser_buffer($w) "\0"]
3292 set browser_buffer($w) [lindex $pck end]
3294 set n [llength $browser_files($w)]
3295 $w conf -state normal
3296 foreach p [lrange $pck 0 end-1] {
3297 set info [split $p "\t"]
3298 set path [lindex $info 1]
3299 set info [split [lindex $info 0] { }]
3300 set type [lindex $info 1]
3301 set object [lindex $info 2]
3303 switch -- $type {
3304 blob {
3305 set image file_mod
3307 tree {
3308 set image file_dir
3309 append path /
3311 default {
3312 set image file_question
3316 if {$n > 0} {$w insert end "\n"}
3317 $w image create end \
3318 -align center -padx 5 -pady 1 \
3319 -name icon[incr n] \
3320 -image $image
3321 $w insert end [escape_path $path]
3322 lappend browser_files($w) [list $type $object $path]
3324 $w conf -state disabled
3326 if {[eof $fd]} {
3327 close $fd
3328 set browser_status($w) Ready.
3329 set browser_busy($w) 0
3330 array unset browser_buffer $w
3331 if {$n > 0} {
3332 $w tag add in_sel 1.0 2.0
3333 focus -force $w
3338 proc show_blame {commit path} {
3339 global next_browser_id blame_status blame_data
3341 if {[winfo ismapped .]} {
3342 set w .browser[incr next_browser_id]
3343 set tl $w
3344 toplevel $w
3345 } else {
3346 set w {}
3347 set tl .
3349 set blame_status($w) {Loading current file content...}
3351 label $w.path -text "$commit:$path" \
3352 -anchor w \
3353 -justify left \
3354 -borderwidth 1 \
3355 -relief sunken \
3356 -font font_uibold
3357 pack $w.path -side top -fill x
3359 frame $w.out
3360 text $w.out.loaded_t \
3361 -background white -borderwidth 0 \
3362 -state disabled \
3363 -wrap none \
3364 -height 40 \
3365 -width 1 \
3366 -font font_diff
3367 $w.out.loaded_t tag conf annotated -background grey
3369 text $w.out.linenumber_t \
3370 -background white -borderwidth 0 \
3371 -state disabled \
3372 -wrap none \
3373 -height 40 \
3374 -width 5 \
3375 -font font_diff
3376 $w.out.linenumber_t tag conf linenumber -justify right
3378 text $w.out.file_t \
3379 -background white -borderwidth 0 \
3380 -state disabled \
3381 -wrap none \
3382 -height 40 \
3383 -width 80 \
3384 -xscrollcommand [list $w.out.sbx set] \
3385 -font font_diff
3387 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3388 scrollbar $w.out.sby -orient v \
3389 -command [list scrollbar2many [list \
3390 $w.out.loaded_t \
3391 $w.out.linenumber_t \
3392 $w.out.file_t \
3393 ] yview]
3394 grid \
3395 $w.out.linenumber_t \
3396 $w.out.loaded_t \
3397 $w.out.file_t \
3398 $w.out.sby \
3399 -sticky nsew
3400 grid conf $w.out.sbx -column 2 -sticky we
3401 grid columnconfigure $w.out 2 -weight 1
3402 grid rowconfigure $w.out 0 -weight 1
3403 pack $w.out -fill both -expand 1
3405 label $w.status -textvariable blame_status($w) \
3406 -anchor w \
3407 -justify left \
3408 -borderwidth 1 \
3409 -relief sunken \
3410 -font font_ui
3411 pack $w.status -side bottom -fill x
3413 frame $w.cm
3414 text $w.cm.t \
3415 -background white -borderwidth 0 \
3416 -state disabled \
3417 -wrap none \
3418 -height 10 \
3419 -width 80 \
3420 -xscrollcommand [list $w.cm.sbx set] \
3421 -yscrollcommand [list $w.cm.sby set] \
3422 -font font_diff
3423 scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3424 scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3425 pack $w.cm.sby -side right -fill y
3426 pack $w.cm.sbx -side bottom -fill x
3427 pack $w.cm.t -expand 1 -fill both
3428 pack $w.cm -side bottom -fill x
3430 menu $w.ctxm -tearoff 0
3431 $w.ctxm add command -label "Copy Commit" \
3432 -font font_ui \
3433 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3435 foreach i [list \
3436 $w.out.loaded_t \
3437 $w.out.linenumber_t \
3438 $w.out.file_t] {
3439 $i tag conf in_sel \
3440 -background [$i cget -foreground] \
3441 -foreground [$i cget -background]
3442 $i conf -yscrollcommand \
3443 [list many2scrollbar [list \
3444 $w.out.loaded_t \
3445 $w.out.linenumber_t \
3446 $w.out.file_t \
3447 ] yview $w.out.sby]
3448 bind $i <Button-1> "
3449 blame_click {$w} \\
3450 $w.cm.t \\
3451 $w.out.linenumber_t \\
3452 $w.out.file_t \\
3453 $i @%x,%y
3454 focus $i
3456 bind_button3 $i "
3457 set cursorX %x
3458 set cursorY %y
3459 set cursorW %W
3460 tk_popup $w.ctxm %X %Y
3464 bind $w.cm.t <Button-1> "focus $w.cm.t"
3465 bind $tl <Visibility> "focus $tl"
3466 bind $tl <Destroy> "
3467 array unset blame_status {$w}
3468 array unset blame_data $w,*
3470 wm title $tl "[appname] ([reponame]): File Viewer"
3472 set blame_data($w,commit_count) 0
3473 set blame_data($w,commit_list) {}
3474 set blame_data($w,total_lines) 0
3475 set blame_data($w,blame_lines) 0
3476 set blame_data($w,highlight_commit) {}
3477 set blame_data($w,highlight_line) -1
3479 set cmd [list git cat-file blob "$commit:$path"]
3480 set fd [open "| $cmd" r]
3481 fconfigure $fd -blocking 0 -translation lf -encoding binary
3482 fileevent $fd readable [list read_blame_catfile \
3483 $fd $w $commit $path \
3484 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3487 proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3488 global blame_status blame_data
3490 if {![winfo exists $w_file]} {
3491 catch {close $fd}
3492 return
3495 set n $blame_data($w,total_lines)
3496 $w_load conf -state normal
3497 $w_line conf -state normal
3498 $w_file conf -state normal
3499 while {[gets $fd line] >= 0} {
3500 regsub "\r\$" $line {} line
3501 incr n
3502 $w_load insert end "\n"
3503 $w_line insert end "$n\n" linenumber
3504 $w_file insert end "$line\n"
3506 $w_load conf -state disabled
3507 $w_line conf -state disabled
3508 $w_file conf -state disabled
3509 set blame_data($w,total_lines) $n
3511 if {[eof $fd]} {
3512 close $fd
3513 blame_incremental_status $w
3514 set cmd [list git blame -M -C --incremental]
3515 lappend cmd $commit -- $path
3516 set fd [open "| $cmd" r]
3517 fconfigure $fd -blocking 0 -translation lf -encoding binary
3518 fileevent $fd readable [list read_blame_incremental $fd $w \
3519 $w_load $w_cmit $w_line $w_file]
3523 proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3524 global blame_status blame_data
3526 if {![winfo exists $w_file]} {
3527 catch {close $fd}
3528 return
3531 while {[gets $fd line] >= 0} {
3532 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3533 cmit original_line final_line line_count]} {
3534 set blame_data($w,commit) $cmit
3535 set blame_data($w,original_line) $original_line
3536 set blame_data($w,final_line) $final_line
3537 set blame_data($w,line_count) $line_count
3539 if {[catch {set g $blame_data($w,$cmit,order)}]} {
3540 $w_line tag conf g$cmit
3541 $w_file tag conf g$cmit
3542 $w_line tag raise in_sel
3543 $w_file tag raise in_sel
3544 $w_file tag raise sel
3545 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3546 incr blame_data($w,commit_count)
3547 lappend blame_data($w,commit_list) $cmit
3549 } elseif {[string match {filename *} $line]} {
3550 set file [string range $line 9 end]
3551 set n $blame_data($w,line_count)
3552 set lno $blame_data($w,final_line)
3553 set cmit $blame_data($w,commit)
3555 while {$n > 0} {
3556 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3557 $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3558 } else {
3559 $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3560 $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3563 set blame_data($w,line$lno,commit) $cmit
3564 set blame_data($w,line$lno,file) $file
3565 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3566 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3568 if {$blame_data($w,highlight_line) == -1} {
3569 if {[lindex [$w_file yview] 0] == 0} {
3570 $w_file see $lno.0
3571 blame_showcommit $w $w_cmit $w_line $w_file $lno
3573 } elseif {$blame_data($w,highlight_line) == $lno} {
3574 blame_showcommit $w $w_cmit $w_line $w_file $lno
3577 incr n -1
3578 incr lno
3579 incr blame_data($w,blame_lines)
3582 set hc $blame_data($w,highlight_commit)
3583 if {$hc ne {}
3584 && [expr {$blame_data($w,$hc,order) + 1}]
3585 == $blame_data($w,$cmit,order)} {
3586 blame_showcommit $w $w_cmit $w_line $w_file \
3587 $blame_data($w,highlight_line)
3589 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3590 set blame_data($w,$blame_data($w,commit),$header) $data
3594 if {[eof $fd]} {
3595 close $fd
3596 set blame_status($w) {Annotation complete.}
3597 } else {
3598 blame_incremental_status $w
3602 proc blame_incremental_status {w} {
3603 global blame_status blame_data
3605 set blame_status($w) [format \
3606 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3607 $blame_data($w,blame_lines) \
3608 $blame_data($w,total_lines) \
3609 [expr {100 * $blame_data($w,blame_lines)
3610 / $blame_data($w,total_lines)}]]
3613 proc blame_click {w w_cmit w_line w_file cur_w pos} {
3614 set lno [lindex [split [$cur_w index $pos] .] 0]
3615 if {$lno eq {}} return
3617 $w_line tag remove in_sel 0.0 end
3618 $w_file tag remove in_sel 0.0 end
3619 $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3620 $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3622 blame_showcommit $w $w_cmit $w_line $w_file $lno
3625 set blame_colors {
3626 #ff4040
3627 #ff40ff
3628 #4040ff
3631 proc blame_showcommit {w w_cmit w_line w_file lno} {
3632 global blame_colors blame_data repo_config
3634 set cmit $blame_data($w,highlight_commit)
3635 if {$cmit ne {}} {
3636 set idx $blame_data($w,$cmit,order)
3637 set i 0
3638 foreach c $blame_colors {
3639 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3640 $w_line tag conf g$h -background white
3641 $w_file tag conf g$h -background white
3642 incr i
3646 $w_cmit conf -state normal
3647 $w_cmit delete 0.0 end
3648 if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3649 set cmit {}
3650 $w_cmit insert end "Loading annotation..."
3651 } else {
3652 set idx $blame_data($w,$cmit,order)
3653 set i 0
3654 foreach c $blame_colors {
3655 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3656 $w_line tag conf g$h -background $c
3657 $w_file tag conf g$h -background $c
3658 incr i
3661 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3662 set msg {}
3663 catch {
3664 set fd [open "| git cat-file commit $cmit" r]
3665 fconfigure $fd -encoding binary -translation lf
3666 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3667 set enc utf-8
3669 while {[gets $fd line] > 0} {
3670 if {[string match {encoding *} $line]} {
3671 set enc [string tolower [string range $line 9 end]]
3674 fconfigure $fd -encoding $enc
3675 set msg [string trim [read $fd]]
3676 close $fd
3678 set blame_data($w,$cmit,message) $msg
3681 set author_name {}
3682 set author_email {}
3683 set author_time {}
3684 catch {set author_name $blame_data($w,$cmit,author)}
3685 catch {set author_email $blame_data($w,$cmit,author-mail)}
3686 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3688 set committer_name {}
3689 set committer_email {}
3690 set committer_time {}
3691 catch {set committer_name $blame_data($w,$cmit,committer)}
3692 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3693 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3695 $w_cmit insert end "commit $cmit\n"
3696 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3697 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3698 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3699 $w_cmit insert end "\n"
3700 $w_cmit insert end $msg
3702 $w_cmit conf -state disabled
3704 set blame_data($w,highlight_line) $lno
3705 set blame_data($w,highlight_commit) $cmit
3708 proc blame_copycommit {w i pos} {
3709 global blame_data
3710 set lno [lindex [split [$i index $pos] .] 0]
3711 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3712 clipboard clear
3713 clipboard append \
3714 -format STRING \
3715 -type STRING \
3716 -- $commit
3720 ######################################################################
3722 ## icons
3724 set filemask {
3725 #define mask_width 14
3726 #define mask_height 15
3727 static unsigned char mask_bits[] = {
3728 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3729 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3730 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3733 image create bitmap file_plain -background white -foreground black -data {
3734 #define plain_width 14
3735 #define plain_height 15
3736 static unsigned char plain_bits[] = {
3737 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3738 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3739 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3740 } -maskdata $filemask
3742 image create bitmap file_mod -background white -foreground blue -data {
3743 #define mod_width 14
3744 #define mod_height 15
3745 static unsigned char mod_bits[] = {
3746 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3747 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3748 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3749 } -maskdata $filemask
3751 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3752 #define file_fulltick_width 14
3753 #define file_fulltick_height 15
3754 static unsigned char file_fulltick_bits[] = {
3755 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3756 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3757 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3758 } -maskdata $filemask
3760 image create bitmap file_parttick -background white -foreground "#005050" -data {
3761 #define parttick_width 14
3762 #define parttick_height 15
3763 static unsigned char parttick_bits[] = {
3764 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3765 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3766 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3767 } -maskdata $filemask
3769 image create bitmap file_question -background white -foreground black -data {
3770 #define file_question_width 14
3771 #define file_question_height 15
3772 static unsigned char file_question_bits[] = {
3773 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3774 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3775 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3776 } -maskdata $filemask
3778 image create bitmap file_removed -background white -foreground red -data {
3779 #define file_removed_width 14
3780 #define file_removed_height 15
3781 static unsigned char file_removed_bits[] = {
3782 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3783 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3784 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3785 } -maskdata $filemask
3787 image create bitmap file_merge -background white -foreground blue -data {
3788 #define file_merge_width 14
3789 #define file_merge_height 15
3790 static unsigned char file_merge_bits[] = {
3791 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3792 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3793 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3794 } -maskdata $filemask
3796 set file_dir_data {
3797 #define file_width 18
3798 #define file_height 18
3799 static unsigned char file_bits[] = {
3800 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3801 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3802 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3803 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3804 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3806 image create bitmap file_dir -background white -foreground blue \
3807 -data $file_dir_data -maskdata $file_dir_data
3808 unset file_dir_data
3810 set file_uplevel_data {
3811 #define up_width 15
3812 #define up_height 15
3813 static unsigned char up_bits[] = {
3814 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3815 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3816 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3818 image create bitmap file_uplevel -background white -foreground red \
3819 -data $file_uplevel_data -maskdata $file_uplevel_data
3820 unset file_uplevel_data
3822 set ui_index .vpane.files.index.list
3823 set ui_workdir .vpane.files.workdir.list
3825 set all_icons(_$ui_index) file_plain
3826 set all_icons(A$ui_index) file_fulltick
3827 set all_icons(M$ui_index) file_fulltick
3828 set all_icons(D$ui_index) file_removed
3829 set all_icons(U$ui_index) file_merge
3831 set all_icons(_$ui_workdir) file_plain
3832 set all_icons(M$ui_workdir) file_mod
3833 set all_icons(D$ui_workdir) file_question
3834 set all_icons(U$ui_workdir) file_merge
3835 set all_icons(O$ui_workdir) file_plain
3837 set max_status_desc 0
3838 foreach i {
3839 {__ "Unmodified"}
3841 {_M "Modified, not staged"}
3842 {M_ "Staged for commit"}
3843 {MM "Portions staged for commit"}
3844 {MD "Staged for commit, missing"}
3846 {_O "Untracked, not staged"}
3847 {A_ "Staged for commit"}
3848 {AM "Portions staged for commit"}
3849 {AD "Staged for commit, missing"}
3851 {_D "Missing"}
3852 {D_ "Staged for removal"}
3853 {DO "Staged for removal, still present"}
3855 {U_ "Requires merge resolution"}
3856 {UU "Requires merge resolution"}
3857 {UM "Requires merge resolution"}
3858 {UD "Requires merge resolution"}
3860 if {$max_status_desc < [string length [lindex $i 1]]} {
3861 set max_status_desc [string length [lindex $i 1]]
3863 set all_descs([lindex $i 0]) [lindex $i 1]
3865 unset i
3867 ######################################################################
3869 ## util
3871 proc bind_button3 {w cmd} {
3872 bind $w <Any-Button-3> $cmd
3873 if {[is_MacOSX]} {
3874 bind $w <Control-Button-1> $cmd
3878 proc scrollbar2many {list mode args} {
3879 foreach w $list {eval $w $mode $args}
3882 proc many2scrollbar {list mode sb top bottom} {
3883 $sb set $top $bottom
3884 foreach w $list {$w $mode moveto $top}
3887 proc incr_font_size {font {amt 1}} {
3888 set sz [font configure $font -size]
3889 incr sz $amt
3890 font configure $font -size $sz
3891 font configure ${font}bold -size $sz
3894 proc hook_failed_popup {hook msg} {
3895 set w .hookfail
3896 toplevel $w
3898 frame $w.m
3899 label $w.m.l1 -text "$hook hook failed:" \
3900 -anchor w \
3901 -justify left \
3902 -font font_uibold
3903 text $w.m.t \
3904 -background white -borderwidth 1 \
3905 -relief sunken \
3906 -width 80 -height 10 \
3907 -font font_diff \
3908 -yscrollcommand [list $w.m.sby set]
3909 label $w.m.l2 \
3910 -text {You must correct the above errors before committing.} \
3911 -anchor w \
3912 -justify left \
3913 -font font_uibold
3914 scrollbar $w.m.sby -command [list $w.m.t yview]
3915 pack $w.m.l1 -side top -fill x
3916 pack $w.m.l2 -side bottom -fill x
3917 pack $w.m.sby -side right -fill y
3918 pack $w.m.t -side left -fill both -expand 1
3919 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3921 $w.m.t insert 1.0 $msg
3922 $w.m.t conf -state disabled
3924 button $w.ok -text OK \
3925 -width 15 \
3926 -font font_ui \
3927 -command "destroy $w"
3928 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3930 bind $w <Visibility> "grab $w; focus $w"
3931 bind $w <Key-Return> "destroy $w"
3932 wm title $w "[appname] ([reponame]): error"
3933 tkwait window $w
3936 set next_console_id 0
3938 proc new_console {short_title long_title} {
3939 global next_console_id console_data
3940 set w .console[incr next_console_id]
3941 set console_data($w) [list $short_title $long_title]
3942 return [console_init $w]
3945 proc console_init {w} {
3946 global console_cr console_data M1B
3948 set console_cr($w) 1.0
3949 toplevel $w
3950 frame $w.m
3951 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3952 -anchor w \
3953 -justify left \
3954 -font font_uibold
3955 text $w.m.t \
3956 -background white -borderwidth 1 \
3957 -relief sunken \
3958 -width 80 -height 10 \
3959 -font font_diff \
3960 -state disabled \
3961 -yscrollcommand [list $w.m.sby set]
3962 label $w.m.s -text {Working... please wait...} \
3963 -anchor w \
3964 -justify left \
3965 -font font_uibold
3966 scrollbar $w.m.sby -command [list $w.m.t yview]
3967 pack $w.m.l1 -side top -fill x
3968 pack $w.m.s -side bottom -fill x
3969 pack $w.m.sby -side right -fill y
3970 pack $w.m.t -side left -fill both -expand 1
3971 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3973 menu $w.ctxm -tearoff 0
3974 $w.ctxm add command -label "Copy" \
3975 -font font_ui \
3976 -command "tk_textCopy $w.m.t"
3977 $w.ctxm add command -label "Select All" \
3978 -font font_ui \
3979 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3980 $w.ctxm add command -label "Copy All" \
3981 -font font_ui \
3982 -command "
3983 $w.m.t tag add sel 0.0 end
3984 tk_textCopy $w.m.t
3985 $w.m.t tag remove sel 0.0 end
3988 button $w.ok -text {Close} \
3989 -font font_ui \
3990 -state disabled \
3991 -command "destroy $w"
3992 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3994 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3995 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3996 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3997 bind $w <Visibility> "focus $w"
3998 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3999 return $w
4002 proc console_exec {w cmd after} {
4003 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
4004 # But most users need that so we have to relogin. :-(
4006 if {[is_Cygwin]} {
4007 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
4010 # -- Tcl won't let us redirect both stdout and stderr to
4011 # the same pipe. So pass it through cat...
4013 set cmd [concat | $cmd |& cat]
4015 set fd_f [open $cmd r]
4016 fconfigure $fd_f -blocking 0 -translation binary
4017 fileevent $fd_f readable [list console_read $w $fd_f $after]
4020 proc console_read {w fd after} {
4021 global console_cr
4023 set buf [read $fd]
4024 if {$buf ne {}} {
4025 if {![winfo exists $w]} {console_init $w}
4026 $w.m.t conf -state normal
4027 set c 0
4028 set n [string length $buf]
4029 while {$c < $n} {
4030 set cr [string first "\r" $buf $c]
4031 set lf [string first "\n" $buf $c]
4032 if {$cr < 0} {set cr [expr {$n + 1}]}
4033 if {$lf < 0} {set lf [expr {$n + 1}]}
4035 if {$lf < $cr} {
4036 $w.m.t insert end [string range $buf $c $lf]
4037 set console_cr($w) [$w.m.t index {end -1c}]
4038 set c $lf
4039 incr c
4040 } else {
4041 $w.m.t delete $console_cr($w) end
4042 $w.m.t insert end "\n"
4043 $w.m.t insert end [string range $buf $c $cr]
4044 set c $cr
4045 incr c
4048 $w.m.t conf -state disabled
4049 $w.m.t see end
4052 fconfigure $fd -blocking 1
4053 if {[eof $fd]} {
4054 if {[catch {close $fd}]} {
4055 set ok 0
4056 } else {
4057 set ok 1
4059 uplevel #0 $after $w $ok
4060 return
4062 fconfigure $fd -blocking 0
4065 proc console_chain {cmdlist w {ok 1}} {
4066 if {$ok} {
4067 if {[llength $cmdlist] == 0} {
4068 console_done $w $ok
4069 return
4072 set cmd [lindex $cmdlist 0]
4073 set cmdlist [lrange $cmdlist 1 end]
4075 if {[lindex $cmd 0] eq {console_exec}} {
4076 console_exec $w \
4077 [lindex $cmd 1] \
4078 [list console_chain $cmdlist]
4079 } else {
4080 uplevel #0 $cmd $cmdlist $w $ok
4082 } else {
4083 console_done $w $ok
4087 proc console_done {args} {
4088 global console_cr console_data
4090 switch -- [llength $args] {
4092 set w [lindex $args 0]
4093 set ok [lindex $args 1]
4096 set w [lindex $args 1]
4097 set ok [lindex $args 2]
4099 default {
4100 error "wrong number of args: console_done ?ignored? w ok"
4104 if {$ok} {
4105 if {[winfo exists $w]} {
4106 $w.m.s conf -background green -text {Success}
4107 $w.ok conf -state normal
4109 } else {
4110 if {![winfo exists $w]} {
4111 console_init $w
4113 $w.m.s conf -background red -text {Error: Command Failed}
4114 $w.ok conf -state normal
4117 array unset console_cr $w
4118 array unset console_data $w
4121 ######################################################################
4123 ## ui commands
4125 set starting_gitk_msg {Starting gitk... please wait...}
4127 proc do_gitk {revs} {
4128 global env ui_status_value starting_gitk_msg
4130 # -- Always start gitk through whatever we were loaded with. This
4131 # lets us bypass using shell process on Windows systems.
4133 set cmd [info nameofexecutable]
4134 lappend cmd [gitexec gitk]
4135 if {$revs ne {}} {
4136 append cmd { }
4137 append cmd $revs
4140 if {[catch {eval exec $cmd &} err]} {
4141 error_popup "Failed to start gitk:\n\n$err"
4142 } else {
4143 set ui_status_value $starting_gitk_msg
4144 after 10000 {
4145 if {$ui_status_value eq $starting_gitk_msg} {
4146 set ui_status_value {Ready.}
4152 proc do_stats {} {
4153 set fd [open "| git count-objects -v" r]
4154 while {[gets $fd line] > 0} {
4155 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4156 set stats($name) $value
4159 close $fd
4161 set packed_sz 0
4162 foreach p [glob -directory [gitdir objects pack] \
4163 -type f \
4164 -nocomplain -- *] {
4165 incr packed_sz [file size $p]
4167 if {$packed_sz > 0} {
4168 set stats(size-pack) [expr {$packed_sz / 1024}]
4171 set w .stats_view
4172 toplevel $w
4173 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4175 label $w.header -text {Database Statistics} \
4176 -font font_uibold
4177 pack $w.header -side top -fill x
4179 frame $w.buttons -border 1
4180 button $w.buttons.close -text Close \
4181 -font font_ui \
4182 -command [list destroy $w]
4183 button $w.buttons.gc -text {Compress Database} \
4184 -font font_ui \
4185 -command "destroy $w;do_gc"
4186 pack $w.buttons.close -side right
4187 pack $w.buttons.gc -side left
4188 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4190 frame $w.stat -borderwidth 1 -relief solid
4191 foreach s {
4192 {count {Number of loose objects}}
4193 {size {Disk space used by loose objects} { KiB}}
4194 {in-pack {Number of packed objects}}
4195 {packs {Number of packs}}
4196 {size-pack {Disk space used by packed objects} { KiB}}
4197 {prune-packable {Packed objects waiting for pruning}}
4198 {garbage {Garbage files}}
4200 set name [lindex $s 0]
4201 set label [lindex $s 1]
4202 if {[catch {set value $stats($name)}]} continue
4203 if {[llength $s] > 2} {
4204 set value "$value[lindex $s 2]"
4207 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4208 label $w.stat.v_$name -text $value -anchor w -font font_ui
4209 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4211 pack $w.stat -pady 10 -padx 10
4213 bind $w <Visibility> "grab $w; focus $w"
4214 bind $w <Key-Escape> [list destroy $w]
4215 bind $w <Key-Return> [list destroy $w]
4216 wm title $w "[appname] ([reponame]): Database Statistics"
4217 tkwait window $w
4220 proc do_gc {} {
4221 set w [new_console {gc} {Compressing the object database}]
4222 console_chain {
4223 {console_exec {git pack-refs --prune}}
4224 {console_exec {git reflog expire --all}}
4225 {console_exec {git repack -a -d -l}}
4226 {console_exec {git rerere gc}}
4227 } $w
4230 proc do_fsck_objects {} {
4231 set w [new_console {fsck-objects} \
4232 {Verifying the object database with fsck-objects}]
4233 set cmd [list git fsck-objects]
4234 lappend cmd --full
4235 lappend cmd --cache
4236 lappend cmd --strict
4237 console_exec $w $cmd console_done
4240 set is_quitting 0
4242 proc do_quit {} {
4243 global ui_comm is_quitting repo_config commit_type
4245 if {$is_quitting} return
4246 set is_quitting 1
4248 if {[winfo exists $ui_comm]} {
4249 # -- Stash our current commit buffer.
4251 set save [gitdir GITGUI_MSG]
4252 set msg [string trim [$ui_comm get 0.0 end]]
4253 regsub -all -line {[ \r\t]+$} $msg {} msg
4254 if {(![string match amend* $commit_type]
4255 || [$ui_comm edit modified])
4256 && $msg ne {}} {
4257 catch {
4258 set fd [open $save w]
4259 puts -nonewline $fd $msg
4260 close $fd
4262 } else {
4263 catch {file delete $save}
4266 # -- Stash our current window geometry into this repository.
4268 set cfg_geometry [list]
4269 lappend cfg_geometry [wm geometry .]
4270 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4271 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4272 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4273 set rc_geometry {}
4275 if {$cfg_geometry ne $rc_geometry} {
4276 catch {git config gui.geometry $cfg_geometry}
4280 destroy .
4283 proc do_rescan {} {
4284 rescan {set ui_status_value {Ready.}}
4287 proc unstage_helper {txt paths} {
4288 global file_states current_diff_path
4290 if {![lock_index begin-update]} return
4292 set pathList [list]
4293 set after {}
4294 foreach path $paths {
4295 switch -glob -- [lindex $file_states($path) 0] {
4296 A? -
4297 M? -
4298 D? {
4299 lappend pathList $path
4300 if {$path eq $current_diff_path} {
4301 set after {reshow_diff;}
4306 if {$pathList eq {}} {
4307 unlock_index
4308 } else {
4309 update_indexinfo \
4310 $txt \
4311 $pathList \
4312 [concat $after {set ui_status_value {Ready.}}]
4316 proc do_unstage_selection {} {
4317 global current_diff_path selected_paths
4319 if {[array size selected_paths] > 0} {
4320 unstage_helper \
4321 {Unstaging selected files from commit} \
4322 [array names selected_paths]
4323 } elseif {$current_diff_path ne {}} {
4324 unstage_helper \
4325 "Unstaging [short_path $current_diff_path] from commit" \
4326 [list $current_diff_path]
4330 proc add_helper {txt paths} {
4331 global file_states current_diff_path
4333 if {![lock_index begin-update]} return
4335 set pathList [list]
4336 set after {}
4337 foreach path $paths {
4338 switch -glob -- [lindex $file_states($path) 0] {
4339 _O -
4340 ?M -
4341 ?D -
4342 U? {
4343 lappend pathList $path
4344 if {$path eq $current_diff_path} {
4345 set after {reshow_diff;}
4350 if {$pathList eq {}} {
4351 unlock_index
4352 } else {
4353 update_index \
4354 $txt \
4355 $pathList \
4356 [concat $after {set ui_status_value {Ready to commit.}}]
4360 proc do_add_selection {} {
4361 global current_diff_path selected_paths
4363 if {[array size selected_paths] > 0} {
4364 add_helper \
4365 {Adding selected files} \
4366 [array names selected_paths]
4367 } elseif {$current_diff_path ne {}} {
4368 add_helper \
4369 "Adding [short_path $current_diff_path]" \
4370 [list $current_diff_path]
4374 proc do_add_all {} {
4375 global file_states
4377 set paths [list]
4378 foreach path [array names file_states] {
4379 switch -glob -- [lindex $file_states($path) 0] {
4380 U? {continue}
4381 ?M -
4382 ?D {lappend paths $path}
4385 add_helper {Adding all changed files} $paths
4388 proc revert_helper {txt paths} {
4389 global file_states current_diff_path
4391 if {![lock_index begin-update]} return
4393 set pathList [list]
4394 set after {}
4395 foreach path $paths {
4396 switch -glob -- [lindex $file_states($path) 0] {
4397 U? {continue}
4398 ?M -
4399 ?D {
4400 lappend pathList $path
4401 if {$path eq $current_diff_path} {
4402 set after {reshow_diff;}
4408 set n [llength $pathList]
4409 if {$n == 0} {
4410 unlock_index
4411 return
4412 } elseif {$n == 1} {
4413 set s "[short_path [lindex $pathList]]"
4414 } else {
4415 set s "these $n files"
4418 set reply [tk_dialog \
4419 .confirm_revert \
4420 "[appname] ([reponame])" \
4421 "Revert changes in $s?
4423 Any unadded changes will be permanently lost by the revert." \
4424 question \
4426 {Do Nothing} \
4427 {Revert Changes} \
4429 if {$reply == 1} {
4430 checkout_index \
4431 $txt \
4432 $pathList \
4433 [concat $after {set ui_status_value {Ready.}}]
4434 } else {
4435 unlock_index
4439 proc do_revert_selection {} {
4440 global current_diff_path selected_paths
4442 if {[array size selected_paths] > 0} {
4443 revert_helper \
4444 {Reverting selected files} \
4445 [array names selected_paths]
4446 } elseif {$current_diff_path ne {}} {
4447 revert_helper \
4448 "Reverting [short_path $current_diff_path]" \
4449 [list $current_diff_path]
4453 proc do_signoff {} {
4454 global ui_comm
4456 set me [committer_ident]
4457 if {$me eq {}} return
4459 set sob "Signed-off-by: $me"
4460 set last [$ui_comm get {end -1c linestart} {end -1c}]
4461 if {$last ne $sob} {
4462 $ui_comm edit separator
4463 if {$last ne {}
4464 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4465 $ui_comm insert end "\n"
4467 $ui_comm insert end "\n$sob"
4468 $ui_comm edit separator
4469 $ui_comm see end
4473 proc do_select_commit_type {} {
4474 global commit_type selected_commit_type
4476 if {$selected_commit_type eq {new}
4477 && [string match amend* $commit_type]} {
4478 create_new_commit
4479 } elseif {$selected_commit_type eq {amend}
4480 && ![string match amend* $commit_type]} {
4481 load_last_commit
4483 # The amend request was rejected...
4485 if {![string match amend* $commit_type]} {
4486 set selected_commit_type new
4491 proc do_commit {} {
4492 commit_tree
4495 proc do_credits {} {
4496 global gitgui_credits
4498 set w .credits_dialog
4500 toplevel $w
4501 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4503 label $w.header -text {git-gui Contributors} -font font_uibold
4504 pack $w.header -side top -fill x
4506 frame $w.buttons
4507 button $w.buttons.close -text {Close} \
4508 -font font_ui \
4509 -command [list destroy $w]
4510 pack $w.buttons.close -side right
4511 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4513 frame $w.credits
4514 text $w.credits.t \
4515 -background [$w.header cget -background] \
4516 -yscrollcommand [list $w.credits.sby set] \
4517 -width 20 \
4518 -height 10 \
4519 -wrap none \
4520 -borderwidth 1 \
4521 -relief solid \
4522 -padx 5 -pady 5 \
4523 -font font_ui
4524 scrollbar $w.credits.sby -command [list $w.credits.t yview]
4525 pack $w.credits.sby -side right -fill y
4526 pack $w.credits.t -fill both -expand 1
4527 pack $w.credits -side top -fill both -expand 1 -padx 5 -pady 5
4529 label $w.desc \
4530 -text "All portions are copyrighted by their respective authors
4531 and are distributed under the GNU General Public License." \
4532 -padx 5 -pady 5 \
4533 -justify left \
4534 -anchor w \
4535 -borderwidth 1 \
4536 -relief solid \
4537 -font font_ui
4538 pack $w.desc -side top -fill x -padx 5 -pady 5
4540 $w.credits.t insert end "[string trim $gitgui_credits]\n"
4541 $w.credits.t conf -state disabled
4542 $w.credits.t see 1.0
4544 bind $w <Visibility> "grab $w; focus $w"
4545 bind $w <Key-Escape> [list destroy $w]
4546 wm title $w [$w.header cget -text]
4547 tkwait window $w
4550 proc do_about {} {
4551 global appvers copyright
4552 global tcl_patchLevel tk_patchLevel
4554 set w .about_dialog
4555 toplevel $w
4556 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4558 label $w.header -text "About [appname]" \
4559 -font font_uibold
4560 pack $w.header -side top -fill x
4562 frame $w.buttons
4563 button $w.buttons.close -text {Close} \
4564 -font font_ui \
4565 -command [list destroy $w]
4566 button $w.buttons.credits -text {Contributors} \
4567 -font font_ui \
4568 -command do_credits
4569 pack $w.buttons.credits -side left
4570 pack $w.buttons.close -side right
4571 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4573 label $w.desc \
4574 -text "git-gui - a graphical user interface for Git.
4575 $copyright" \
4576 -padx 5 -pady 5 \
4577 -justify left \
4578 -anchor w \
4579 -borderwidth 1 \
4580 -relief solid \
4581 -font font_ui
4582 pack $w.desc -side top -fill x -padx 5 -pady 5
4584 set v {}
4585 append v "git-gui version $appvers\n"
4586 append v "[git version]\n"
4587 append v "\n"
4588 if {$tcl_patchLevel eq $tk_patchLevel} {
4589 append v "Tcl/Tk version $tcl_patchLevel"
4590 } else {
4591 append v "Tcl version $tcl_patchLevel"
4592 append v ", Tk version $tk_patchLevel"
4595 label $w.vers \
4596 -text $v \
4597 -padx 5 -pady 5 \
4598 -justify left \
4599 -anchor w \
4600 -borderwidth 1 \
4601 -relief solid \
4602 -font font_ui
4603 pack $w.vers -side top -fill x -padx 5 -pady 5
4605 menu $w.ctxm -tearoff 0
4606 $w.ctxm add command \
4607 -label {Copy} \
4608 -font font_ui \
4609 -command "
4610 clipboard clear
4611 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4614 bind $w <Visibility> "grab $w; focus $w"
4615 bind $w <Key-Escape> "destroy $w"
4616 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4617 wm title $w "About [appname]"
4618 tkwait window $w
4621 proc do_options {} {
4622 global repo_config global_config font_descs
4623 global repo_config_new global_config_new
4625 array unset repo_config_new
4626 array unset global_config_new
4627 foreach name [array names repo_config] {
4628 set repo_config_new($name) $repo_config($name)
4630 load_config 1
4631 foreach name [array names repo_config] {
4632 switch -- $name {
4633 gui.diffcontext {continue}
4635 set repo_config_new($name) $repo_config($name)
4637 foreach name [array names global_config] {
4638 set global_config_new($name) $global_config($name)
4641 set w .options_editor
4642 toplevel $w
4643 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4645 label $w.header -text "Options" \
4646 -font font_uibold
4647 pack $w.header -side top -fill x
4649 frame $w.buttons
4650 button $w.buttons.restore -text {Restore Defaults} \
4651 -font font_ui \
4652 -command do_restore_defaults
4653 pack $w.buttons.restore -side left
4654 button $w.buttons.save -text Save \
4655 -font font_ui \
4656 -command [list do_save_config $w]
4657 pack $w.buttons.save -side right
4658 button $w.buttons.cancel -text {Cancel} \
4659 -font font_ui \
4660 -command [list destroy $w]
4661 pack $w.buttons.cancel -side right -padx 5
4662 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4664 labelframe $w.repo -text "[reponame] Repository" \
4665 -font font_ui
4666 labelframe $w.global -text {Global (All Repositories)} \
4667 -font font_ui
4668 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4669 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4671 set optid 0
4672 foreach option {
4673 {t user.name {User Name}}
4674 {t user.email {Email Address}}
4676 {b merge.summary {Summarize Merge Commits}}
4677 {i-1..5 merge.verbosity {Merge Verbosity}}
4679 {b gui.trustmtime {Trust File Modification Timestamps}}
4680 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4681 {t gui.newbranchtemplate {New Branch Name Template}}
4683 set type [lindex $option 0]
4684 set name [lindex $option 1]
4685 set text [lindex $option 2]
4686 incr optid
4687 foreach f {repo global} {
4688 switch -glob -- $type {
4690 checkbutton $w.$f.$optid -text $text \
4691 -variable ${f}_config_new($name) \
4692 -onvalue true \
4693 -offvalue false \
4694 -font font_ui
4695 pack $w.$f.$optid -side top -anchor w
4697 i-* {
4698 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4699 frame $w.$f.$optid
4700 label $w.$f.$optid.l -text "$text:" -font font_ui
4701 pack $w.$f.$optid.l -side left -anchor w -fill x
4702 spinbox $w.$f.$optid.v \
4703 -textvariable ${f}_config_new($name) \
4704 -from $min \
4705 -to $max \
4706 -increment 1 \
4707 -width [expr {1 + [string length $max]}] \
4708 -font font_ui
4709 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4710 pack $w.$f.$optid.v -side right -anchor e -padx 5
4711 pack $w.$f.$optid -side top -anchor w -fill x
4714 frame $w.$f.$optid
4715 label $w.$f.$optid.l -text "$text:" -font font_ui
4716 entry $w.$f.$optid.v \
4717 -borderwidth 1 \
4718 -relief sunken \
4719 -width 20 \
4720 -textvariable ${f}_config_new($name) \
4721 -font font_ui
4722 pack $w.$f.$optid.l -side left -anchor w
4723 pack $w.$f.$optid.v -side left -anchor w \
4724 -fill x -expand 1 \
4725 -padx 5
4726 pack $w.$f.$optid -side top -anchor w -fill x
4732 set all_fonts [lsort [font families]]
4733 foreach option $font_descs {
4734 set name [lindex $option 0]
4735 set font [lindex $option 1]
4736 set text [lindex $option 2]
4738 set global_config_new(gui.$font^^family) \
4739 [font configure $font -family]
4740 set global_config_new(gui.$font^^size) \
4741 [font configure $font -size]
4743 frame $w.global.$name
4744 label $w.global.$name.l -text "$text:" -font font_ui
4745 pack $w.global.$name.l -side left -anchor w -fill x
4746 eval tk_optionMenu $w.global.$name.family \
4747 global_config_new(gui.$font^^family) \
4748 $all_fonts
4749 spinbox $w.global.$name.size \
4750 -textvariable global_config_new(gui.$font^^size) \
4751 -from 2 -to 80 -increment 1 \
4752 -width 3 \
4753 -font font_ui
4754 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4755 pack $w.global.$name.size -side right -anchor e
4756 pack $w.global.$name.family -side right -anchor e
4757 pack $w.global.$name -side top -anchor w -fill x
4760 bind $w <Visibility> "grab $w; focus $w"
4761 bind $w <Key-Escape> "destroy $w"
4762 wm title $w "[appname] ([reponame]): Options"
4763 tkwait window $w
4766 proc do_restore_defaults {} {
4767 global font_descs default_config repo_config
4768 global repo_config_new global_config_new
4770 foreach name [array names default_config] {
4771 set repo_config_new($name) $default_config($name)
4772 set global_config_new($name) $default_config($name)
4775 foreach option $font_descs {
4776 set name [lindex $option 0]
4777 set repo_config(gui.$name) $default_config(gui.$name)
4779 apply_config
4781 foreach option $font_descs {
4782 set name [lindex $option 0]
4783 set font [lindex $option 1]
4784 set global_config_new(gui.$font^^family) \
4785 [font configure $font -family]
4786 set global_config_new(gui.$font^^size) \
4787 [font configure $font -size]
4791 proc do_save_config {w} {
4792 if {[catch {save_config} err]} {
4793 error_popup "Failed to completely save options:\n\n$err"
4795 reshow_diff
4796 destroy $w
4799 proc do_windows_shortcut {} {
4800 global argv0
4802 set fn [tk_getSaveFile \
4803 -parent . \
4804 -title "[appname] ([reponame]): Create Desktop Icon" \
4805 -initialfile "Git [reponame].bat"]
4806 if {$fn != {}} {
4807 if {[catch {
4808 set fd [open $fn w]
4809 puts $fd "@ECHO Entering [reponame]"
4810 puts $fd "@ECHO Starting git-gui... please wait..."
4811 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4812 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4813 puts -nonewline $fd "@\"[info nameofexecutable]\""
4814 puts $fd " \"[file normalize $argv0]\""
4815 close $fd
4816 } err]} {
4817 error_popup "Cannot write script:\n\n$err"
4822 proc do_cygwin_shortcut {} {
4823 global argv0
4825 if {[catch {
4826 set desktop [exec cygpath \
4827 --windows \
4828 --absolute \
4829 --long-name \
4830 --desktop]
4831 }]} {
4832 set desktop .
4834 set fn [tk_getSaveFile \
4835 -parent . \
4836 -title "[appname] ([reponame]): Create Desktop Icon" \
4837 -initialdir $desktop \
4838 -initialfile "Git [reponame].bat"]
4839 if {$fn != {}} {
4840 if {[catch {
4841 set fd [open $fn w]
4842 set sh [exec cygpath \
4843 --windows \
4844 --absolute \
4845 /bin/sh]
4846 set me [exec cygpath \
4847 --unix \
4848 --absolute \
4849 $argv0]
4850 set gd [exec cygpath \
4851 --unix \
4852 --absolute \
4853 [gitdir]]
4854 set gw [exec cygpath \
4855 --windows \
4856 --absolute \
4857 [file dirname [gitdir]]]
4858 regsub -all ' $me "'\\''" me
4859 regsub -all ' $gd "'\\''" gd
4860 puts $fd "@ECHO Entering $gw"
4861 puts $fd "@ECHO Starting git-gui... please wait..."
4862 puts -nonewline $fd "@\"$sh\" --login -c \""
4863 puts -nonewline $fd "GIT_DIR='$gd'"
4864 puts -nonewline $fd " '$me'"
4865 puts $fd "&\""
4866 close $fd
4867 } err]} {
4868 error_popup "Cannot write script:\n\n$err"
4873 proc do_macosx_app {} {
4874 global argv0 env
4876 set fn [tk_getSaveFile \
4877 -parent . \
4878 -title "[appname] ([reponame]): Create Desktop Icon" \
4879 -initialdir [file join $env(HOME) Desktop] \
4880 -initialfile "Git [reponame].app"]
4881 if {$fn != {}} {
4882 if {[catch {
4883 set Contents [file join $fn Contents]
4884 set MacOS [file join $Contents MacOS]
4885 set exe [file join $MacOS git-gui]
4887 file mkdir $MacOS
4889 set fd [open [file join $Contents Info.plist] w]
4890 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4891 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4892 <plist version="1.0">
4893 <dict>
4894 <key>CFBundleDevelopmentRegion</key>
4895 <string>English</string>
4896 <key>CFBundleExecutable</key>
4897 <string>git-gui</string>
4898 <key>CFBundleIdentifier</key>
4899 <string>org.spearce.git-gui</string>
4900 <key>CFBundleInfoDictionaryVersion</key>
4901 <string>6.0</string>
4902 <key>CFBundlePackageType</key>
4903 <string>APPL</string>
4904 <key>CFBundleSignature</key>
4905 <string>????</string>
4906 <key>CFBundleVersion</key>
4907 <string>1.0</string>
4908 <key>NSPrincipalClass</key>
4909 <string>NSApplication</string>
4910 </dict>
4911 </plist>}
4912 close $fd
4914 set fd [open $exe w]
4915 set gd [file normalize [gitdir]]
4916 set ep [file normalize [gitexec]]
4917 regsub -all ' $gd "'\\''" gd
4918 regsub -all ' $ep "'\\''" ep
4919 puts $fd "#!/bin/sh"
4920 foreach name [array names env] {
4921 if {[string match GIT_* $name]} {
4922 regsub -all ' $env($name) "'\\''" v
4923 puts $fd "export $name='$v'"
4926 puts $fd "export PATH='$ep':\$PATH"
4927 puts $fd "export GIT_DIR='$gd'"
4928 puts $fd "exec [file normalize $argv0]"
4929 close $fd
4931 file attributes $exe -permissions u+x,g+x,o+x
4932 } err]} {
4933 error_popup "Cannot write icon:\n\n$err"
4938 proc toggle_or_diff {w x y} {
4939 global file_states file_lists current_diff_path ui_index ui_workdir
4940 global last_clicked selected_paths
4942 set pos [split [$w index @$x,$y] .]
4943 set lno [lindex $pos 0]
4944 set col [lindex $pos 1]
4945 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4946 if {$path eq {}} {
4947 set last_clicked {}
4948 return
4951 set last_clicked [list $w $lno]
4952 array unset selected_paths
4953 $ui_index tag remove in_sel 0.0 end
4954 $ui_workdir tag remove in_sel 0.0 end
4956 if {$col == 0} {
4957 if {$current_diff_path eq $path} {
4958 set after {reshow_diff;}
4959 } else {
4960 set after {}
4962 if {$w eq $ui_index} {
4963 update_indexinfo \
4964 "Unstaging [short_path $path] from commit" \
4965 [list $path] \
4966 [concat $after {set ui_status_value {Ready.}}]
4967 } elseif {$w eq $ui_workdir} {
4968 update_index \
4969 "Adding [short_path $path]" \
4970 [list $path] \
4971 [concat $after {set ui_status_value {Ready.}}]
4973 } else {
4974 show_diff $path $w $lno
4978 proc add_one_to_selection {w x y} {
4979 global file_lists last_clicked selected_paths
4981 set lno [lindex [split [$w index @$x,$y] .] 0]
4982 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4983 if {$path eq {}} {
4984 set last_clicked {}
4985 return
4988 if {$last_clicked ne {}
4989 && [lindex $last_clicked 0] ne $w} {
4990 array unset selected_paths
4991 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4994 set last_clicked [list $w $lno]
4995 if {[catch {set in_sel $selected_paths($path)}]} {
4996 set in_sel 0
4998 if {$in_sel} {
4999 unset selected_paths($path)
5000 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
5001 } else {
5002 set selected_paths($path) 1
5003 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
5007 proc add_range_to_selection {w x y} {
5008 global file_lists last_clicked selected_paths
5010 if {[lindex $last_clicked 0] ne $w} {
5011 toggle_or_diff $w $x $y
5012 return
5015 set lno [lindex [split [$w index @$x,$y] .] 0]
5016 set lc [lindex $last_clicked 1]
5017 if {$lc < $lno} {
5018 set begin $lc
5019 set end $lno
5020 } else {
5021 set begin $lno
5022 set end $lc
5025 foreach path [lrange $file_lists($w) \
5026 [expr {$begin - 1}] \
5027 [expr {$end - 1}]] {
5028 set selected_paths($path) 1
5030 $w tag add in_sel $begin.0 [expr {$end + 1}].0
5033 ######################################################################
5035 ## config defaults
5037 set cursor_ptr arrow
5038 font create font_diff -family Courier -size 10
5039 font create font_ui
5040 catch {
5041 label .dummy
5042 eval font configure font_ui [font actual [.dummy cget -font]]
5043 destroy .dummy
5046 font create font_uibold
5047 font create font_diffbold
5049 if {[is_Windows]} {
5050 set M1B Control
5051 set M1T Ctrl
5052 } elseif {[is_MacOSX]} {
5053 set M1B M1
5054 set M1T Cmd
5055 } else {
5056 set M1B M1
5057 set M1T M1
5060 proc apply_config {} {
5061 global repo_config font_descs
5063 foreach option $font_descs {
5064 set name [lindex $option 0]
5065 set font [lindex $option 1]
5066 if {[catch {
5067 foreach {cn cv} $repo_config(gui.$name) {
5068 font configure $font $cn $cv
5070 } err]} {
5071 error_popup "Invalid font specified in gui.$name:\n\n$err"
5073 foreach {cn cv} [font configure $font] {
5074 font configure ${font}bold $cn $cv
5076 font configure ${font}bold -weight bold
5080 set default_config(merge.summary) false
5081 set default_config(merge.verbosity) 2
5082 set default_config(user.name) {}
5083 set default_config(user.email) {}
5085 set default_config(gui.trustmtime) false
5086 set default_config(gui.diffcontext) 5
5087 set default_config(gui.newbranchtemplate) {}
5088 set default_config(gui.fontui) [font configure font_ui]
5089 set default_config(gui.fontdiff) [font configure font_diff]
5090 set font_descs {
5091 {fontui font_ui {Main Font}}
5092 {fontdiff font_diff {Diff/Console Font}}
5094 load_config 0
5095 apply_config
5097 ######################################################################
5099 ## feature option selection
5101 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5102 unset _junk
5103 } else {
5104 set subcommand gui
5106 if {$subcommand eq {gui.sh}} {
5107 set subcommand gui
5109 if {$subcommand eq {gui} && [llength $argv] > 0} {
5110 set subcommand [lindex $argv 0]
5111 set argv [lrange $argv 1 end]
5114 enable_option multicommit
5115 enable_option branch
5116 enable_option transport
5118 switch -- $subcommand {
5119 --version -
5120 version -
5121 browser -
5122 blame {
5123 disable_option multicommit
5124 disable_option branch
5125 disable_option transport
5127 citool {
5128 enable_option singlecommit
5130 disable_option multicommit
5131 disable_option branch
5132 disable_option transport
5136 ######################################################################
5138 ## ui construction
5140 set ui_comm {}
5142 # -- Menu Bar
5144 menu .mbar -tearoff 0
5145 .mbar add cascade -label Repository -menu .mbar.repository
5146 .mbar add cascade -label Edit -menu .mbar.edit
5147 if {[is_enabled branch]} {
5148 .mbar add cascade -label Branch -menu .mbar.branch
5150 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5151 .mbar add cascade -label Commit -menu .mbar.commit
5153 if {[is_enabled transport]} {
5154 .mbar add cascade -label Merge -menu .mbar.merge
5155 .mbar add cascade -label Fetch -menu .mbar.fetch
5156 .mbar add cascade -label Push -menu .mbar.push
5158 . configure -menu .mbar
5160 # -- Repository Menu
5162 menu .mbar.repository
5164 .mbar.repository add command \
5165 -label {Browse Current Branch} \
5166 -command {new_browser $current_branch} \
5167 -font font_ui
5168 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5169 .mbar.repository add separator
5171 .mbar.repository add command \
5172 -label {Visualize Current Branch} \
5173 -command {do_gitk $current_branch} \
5174 -font font_ui
5175 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5176 .mbar.repository add command \
5177 -label {Visualize All Branches} \
5178 -command {do_gitk --all} \
5179 -font font_ui
5180 .mbar.repository add separator
5182 if {[is_enabled multicommit]} {
5183 .mbar.repository add command -label {Database Statistics} \
5184 -command do_stats \
5185 -font font_ui
5187 .mbar.repository add command -label {Compress Database} \
5188 -command do_gc \
5189 -font font_ui
5191 .mbar.repository add command -label {Verify Database} \
5192 -command do_fsck_objects \
5193 -font font_ui
5195 .mbar.repository add separator
5197 if {[is_Cygwin]} {
5198 .mbar.repository add command \
5199 -label {Create Desktop Icon} \
5200 -command do_cygwin_shortcut \
5201 -font font_ui
5202 } elseif {[is_Windows]} {
5203 .mbar.repository add command \
5204 -label {Create Desktop Icon} \
5205 -command do_windows_shortcut \
5206 -font font_ui
5207 } elseif {[is_MacOSX]} {
5208 .mbar.repository add command \
5209 -label {Create Desktop Icon} \
5210 -command do_macosx_app \
5211 -font font_ui
5215 .mbar.repository add command -label Quit \
5216 -command do_quit \
5217 -accelerator $M1T-Q \
5218 -font font_ui
5220 # -- Edit Menu
5222 menu .mbar.edit
5223 .mbar.edit add command -label Undo \
5224 -command {catch {[focus] edit undo}} \
5225 -accelerator $M1T-Z \
5226 -font font_ui
5227 .mbar.edit add command -label Redo \
5228 -command {catch {[focus] edit redo}} \
5229 -accelerator $M1T-Y \
5230 -font font_ui
5231 .mbar.edit add separator
5232 .mbar.edit add command -label Cut \
5233 -command {catch {tk_textCut [focus]}} \
5234 -accelerator $M1T-X \
5235 -font font_ui
5236 .mbar.edit add command -label Copy \
5237 -command {catch {tk_textCopy [focus]}} \
5238 -accelerator $M1T-C \
5239 -font font_ui
5240 .mbar.edit add command -label Paste \
5241 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5242 -accelerator $M1T-V \
5243 -font font_ui
5244 .mbar.edit add command -label Delete \
5245 -command {catch {[focus] delete sel.first sel.last}} \
5246 -accelerator Del \
5247 -font font_ui
5248 .mbar.edit add separator
5249 .mbar.edit add command -label {Select All} \
5250 -command {catch {[focus] tag add sel 0.0 end}} \
5251 -accelerator $M1T-A \
5252 -font font_ui
5254 # -- Branch Menu
5256 if {[is_enabled branch]} {
5257 menu .mbar.branch
5259 .mbar.branch add command -label {Create...} \
5260 -command do_create_branch \
5261 -accelerator $M1T-N \
5262 -font font_ui
5263 lappend disable_on_lock [list .mbar.branch entryconf \
5264 [.mbar.branch index last] -state]
5266 .mbar.branch add command -label {Delete...} \
5267 -command do_delete_branch \
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 {Reset...} \
5273 -command do_reset_hard \
5274 -font font_ui
5275 lappend disable_on_lock [list .mbar.branch entryconf \
5276 [.mbar.branch index last] -state]
5279 # -- Commit Menu
5281 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5282 menu .mbar.commit
5284 .mbar.commit add radiobutton \
5285 -label {New Commit} \
5286 -command do_select_commit_type \
5287 -variable selected_commit_type \
5288 -value new \
5289 -font font_ui
5290 lappend disable_on_lock \
5291 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5293 .mbar.commit add radiobutton \
5294 -label {Amend Last Commit} \
5295 -command do_select_commit_type \
5296 -variable selected_commit_type \
5297 -value amend \
5298 -font font_ui
5299 lappend disable_on_lock \
5300 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5302 .mbar.commit add separator
5304 .mbar.commit add command -label Rescan \
5305 -command do_rescan \
5306 -accelerator F5 \
5307 -font font_ui
5308 lappend disable_on_lock \
5309 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5311 .mbar.commit add command -label {Add To Commit} \
5312 -command do_add_selection \
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 Existing To Commit} \
5318 -command do_add_all \
5319 -accelerator $M1T-I \
5320 -font font_ui
5321 lappend disable_on_lock \
5322 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5324 .mbar.commit add command -label {Unstage From Commit} \
5325 -command do_unstage_selection \
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 {Revert Changes} \
5331 -command do_revert_selection \
5332 -font font_ui
5333 lappend disable_on_lock \
5334 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5336 .mbar.commit add separator
5338 .mbar.commit add command -label {Sign Off} \
5339 -command do_signoff \
5340 -accelerator $M1T-S \
5341 -font font_ui
5343 .mbar.commit add command -label Commit \
5344 -command do_commit \
5345 -accelerator $M1T-Return \
5346 -font font_ui
5347 lappend disable_on_lock \
5348 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5351 # -- Merge Menu
5353 if {[is_enabled branch]} {
5354 menu .mbar.merge
5355 .mbar.merge add command -label {Local Merge...} \
5356 -command do_local_merge \
5357 -font font_ui
5358 lappend disable_on_lock \
5359 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5360 .mbar.merge add command -label {Abort Merge...} \
5361 -command do_reset_hard \
5362 -font font_ui
5363 lappend disable_on_lock \
5364 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5368 # -- Transport Menu
5370 if {[is_enabled transport]} {
5371 menu .mbar.fetch
5373 menu .mbar.push
5374 .mbar.push add command -label {Push...} \
5375 -command do_push_anywhere \
5376 -font font_ui
5379 if {[is_MacOSX]} {
5380 # -- Apple Menu (Mac OS X only)
5382 .mbar add cascade -label Apple -menu .mbar.apple
5383 menu .mbar.apple
5385 .mbar.apple add command -label "About [appname]" \
5386 -command do_about \
5387 -font font_ui
5388 .mbar.apple add command -label "Options..." \
5389 -command do_options \
5390 -font font_ui
5391 } else {
5392 # -- Edit Menu
5394 .mbar.edit add separator
5395 .mbar.edit add command -label {Options...} \
5396 -command do_options \
5397 -font font_ui
5399 # -- Tools Menu
5401 if {[file exists /usr/local/miga/lib/gui-miga]
5402 && [file exists .pvcsrc]} {
5403 proc do_miga {} {
5404 global ui_status_value
5405 if {![lock_index update]} return
5406 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5407 set miga_fd [open "|$cmd" r]
5408 fconfigure $miga_fd -blocking 0
5409 fileevent $miga_fd readable [list miga_done $miga_fd]
5410 set ui_status_value {Running miga...}
5412 proc miga_done {fd} {
5413 read $fd 512
5414 if {[eof $fd]} {
5415 close $fd
5416 unlock_index
5417 rescan [list set ui_status_value {Ready.}]
5420 .mbar add cascade -label Tools -menu .mbar.tools
5421 menu .mbar.tools
5422 .mbar.tools add command -label "Migrate" \
5423 -command do_miga \
5424 -font font_ui
5425 lappend disable_on_lock \
5426 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5430 # -- Help Menu
5432 .mbar add cascade -label Help -menu .mbar.help
5433 menu .mbar.help
5435 if {![is_MacOSX]} {
5436 .mbar.help add command -label "About [appname]" \
5437 -command do_about \
5438 -font font_ui
5441 set browser {}
5442 catch {set browser $repo_config(instaweb.browser)}
5443 set doc_path [file dirname [gitexec]]
5444 set doc_path [file join $doc_path Documentation index.html]
5446 if {[is_Cygwin]} {
5447 set doc_path [exec cygpath --mixed $doc_path]
5450 if {$browser eq {}} {
5451 if {[is_MacOSX]} {
5452 set browser open
5453 } elseif {[is_Cygwin]} {
5454 set program_files [file dirname [exec cygpath --windir]]
5455 set program_files [file join $program_files {Program Files}]
5456 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5457 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5458 if {[file exists $firefox]} {
5459 set browser $firefox
5460 } elseif {[file exists $ie]} {
5461 set browser $ie
5463 unset program_files firefox ie
5467 if {[file isfile $doc_path]} {
5468 set doc_url "file:$doc_path"
5469 } else {
5470 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5473 if {$browser ne {}} {
5474 .mbar.help add command -label {Online Documentation} \
5475 -command [list exec $browser $doc_url &] \
5476 -font font_ui
5478 unset browser doc_path doc_url
5480 # -- Standard bindings
5482 bind . <Destroy> do_quit
5483 bind all <$M1B-Key-q> do_quit
5484 bind all <$M1B-Key-Q> do_quit
5485 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5486 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5488 # -- Not a normal commit type invocation? Do that instead!
5490 switch -- $subcommand {
5491 --version -
5492 version {
5493 puts "git-gui version $appvers"
5494 exit
5496 browser {
5497 if {[llength $argv] != 1} {
5498 puts stderr "usage: $argv0 browser commit"
5499 exit 1
5501 set current_branch [lindex $argv 0]
5502 new_browser $current_branch
5503 return
5505 blame {
5506 if {[llength $argv] != 2} {
5507 puts stderr "usage: $argv0 blame commit path"
5508 exit 1
5510 set current_branch [lindex $argv 0]
5511 show_blame $current_branch [lindex $argv 1]
5512 return
5514 citool -
5515 gui {
5516 if {[llength $argv] != 0} {
5517 puts -nonewline stderr "usage: $argv0"
5518 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5519 puts -nonewline stderr " $subcommand"
5521 puts stderr {}
5522 exit 1
5524 # fall through to setup UI for commits
5526 default {
5527 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
5528 exit 1
5532 # -- Branch Control
5534 frame .branch \
5535 -borderwidth 1 \
5536 -relief sunken
5537 label .branch.l1 \
5538 -text {Current Branch:} \
5539 -anchor w \
5540 -justify left \
5541 -font font_ui
5542 label .branch.cb \
5543 -textvariable current_branch \
5544 -anchor w \
5545 -justify left \
5546 -font font_ui
5547 pack .branch.l1 -side left
5548 pack .branch.cb -side left -fill x
5549 pack .branch -side top -fill x
5551 # -- Main Window Layout
5553 panedwindow .vpane -orient vertical
5554 panedwindow .vpane.files -orient horizontal
5555 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5556 pack .vpane -anchor n -side top -fill both -expand 1
5558 # -- Index File List
5560 frame .vpane.files.index -height 100 -width 200
5561 label .vpane.files.index.title -text {Changes To Be Committed} \
5562 -background green \
5563 -font font_ui
5564 text $ui_index -background white -borderwidth 0 \
5565 -width 20 -height 10 \
5566 -wrap none \
5567 -font font_ui \
5568 -cursor $cursor_ptr \
5569 -xscrollcommand {.vpane.files.index.sx set} \
5570 -yscrollcommand {.vpane.files.index.sy set} \
5571 -state disabled
5572 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5573 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5574 pack .vpane.files.index.title -side top -fill x
5575 pack .vpane.files.index.sx -side bottom -fill x
5576 pack .vpane.files.index.sy -side right -fill y
5577 pack $ui_index -side left -fill both -expand 1
5578 .vpane.files add .vpane.files.index -sticky nsew
5580 # -- Working Directory File List
5582 frame .vpane.files.workdir -height 100 -width 200
5583 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5584 -background red \
5585 -font font_ui
5586 text $ui_workdir -background white -borderwidth 0 \
5587 -width 20 -height 10 \
5588 -wrap none \
5589 -font font_ui \
5590 -cursor $cursor_ptr \
5591 -xscrollcommand {.vpane.files.workdir.sx set} \
5592 -yscrollcommand {.vpane.files.workdir.sy set} \
5593 -state disabled
5594 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5595 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5596 pack .vpane.files.workdir.title -side top -fill x
5597 pack .vpane.files.workdir.sx -side bottom -fill x
5598 pack .vpane.files.workdir.sy -side right -fill y
5599 pack $ui_workdir -side left -fill both -expand 1
5600 .vpane.files add .vpane.files.workdir -sticky nsew
5602 foreach i [list $ui_index $ui_workdir] {
5603 $i tag conf in_diff -font font_uibold
5604 $i tag conf in_sel \
5605 -background [$i cget -foreground] \
5606 -foreground [$i cget -background]
5608 unset i
5610 # -- Diff and Commit Area
5612 frame .vpane.lower -height 300 -width 400
5613 frame .vpane.lower.commarea
5614 frame .vpane.lower.diff -relief sunken -borderwidth 1
5615 pack .vpane.lower.commarea -side top -fill x
5616 pack .vpane.lower.diff -side bottom -fill both -expand 1
5617 .vpane add .vpane.lower -sticky nsew
5619 # -- Commit Area Buttons
5621 frame .vpane.lower.commarea.buttons
5622 label .vpane.lower.commarea.buttons.l -text {} \
5623 -anchor w \
5624 -justify left \
5625 -font font_ui
5626 pack .vpane.lower.commarea.buttons.l -side top -fill x
5627 pack .vpane.lower.commarea.buttons -side left -fill y
5629 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5630 -command do_rescan \
5631 -font font_ui
5632 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5633 lappend disable_on_lock \
5634 {.vpane.lower.commarea.buttons.rescan conf -state}
5636 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5637 -command do_add_all \
5638 -font font_ui
5639 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5640 lappend disable_on_lock \
5641 {.vpane.lower.commarea.buttons.incall conf -state}
5643 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5644 -command do_signoff \
5645 -font font_ui
5646 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5648 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5649 -command do_commit \
5650 -font font_ui
5651 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5652 lappend disable_on_lock \
5653 {.vpane.lower.commarea.buttons.commit conf -state}
5655 # -- Commit Message Buffer
5657 frame .vpane.lower.commarea.buffer
5658 frame .vpane.lower.commarea.buffer.header
5659 set ui_comm .vpane.lower.commarea.buffer.t
5660 set ui_coml .vpane.lower.commarea.buffer.header.l
5661 radiobutton .vpane.lower.commarea.buffer.header.new \
5662 -text {New Commit} \
5663 -command do_select_commit_type \
5664 -variable selected_commit_type \
5665 -value new \
5666 -font font_ui
5667 lappend disable_on_lock \
5668 [list .vpane.lower.commarea.buffer.header.new conf -state]
5669 radiobutton .vpane.lower.commarea.buffer.header.amend \
5670 -text {Amend Last Commit} \
5671 -command do_select_commit_type \
5672 -variable selected_commit_type \
5673 -value amend \
5674 -font font_ui
5675 lappend disable_on_lock \
5676 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5677 label $ui_coml \
5678 -anchor w \
5679 -justify left \
5680 -font font_ui
5681 proc trace_commit_type {varname args} {
5682 global ui_coml commit_type
5683 switch -glob -- $commit_type {
5684 initial {set txt {Initial Commit Message:}}
5685 amend {set txt {Amended Commit Message:}}
5686 amend-initial {set txt {Amended Initial Commit Message:}}
5687 amend-merge {set txt {Amended Merge Commit Message:}}
5688 merge {set txt {Merge Commit Message:}}
5689 * {set txt {Commit Message:}}
5691 $ui_coml conf -text $txt
5693 trace add variable commit_type write trace_commit_type
5694 pack $ui_coml -side left -fill x
5695 pack .vpane.lower.commarea.buffer.header.amend -side right
5696 pack .vpane.lower.commarea.buffer.header.new -side right
5698 text $ui_comm -background white -borderwidth 1 \
5699 -undo true \
5700 -maxundo 20 \
5701 -autoseparators true \
5702 -relief sunken \
5703 -width 75 -height 9 -wrap none \
5704 -font font_diff \
5705 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5706 scrollbar .vpane.lower.commarea.buffer.sby \
5707 -command [list $ui_comm yview]
5708 pack .vpane.lower.commarea.buffer.header -side top -fill x
5709 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5710 pack $ui_comm -side left -fill y
5711 pack .vpane.lower.commarea.buffer -side left -fill y
5713 # -- Commit Message Buffer Context Menu
5715 set ctxm .vpane.lower.commarea.buffer.ctxm
5716 menu $ctxm -tearoff 0
5717 $ctxm add command \
5718 -label {Cut} \
5719 -font font_ui \
5720 -command {tk_textCut $ui_comm}
5721 $ctxm add command \
5722 -label {Copy} \
5723 -font font_ui \
5724 -command {tk_textCopy $ui_comm}
5725 $ctxm add command \
5726 -label {Paste} \
5727 -font font_ui \
5728 -command {tk_textPaste $ui_comm}
5729 $ctxm add command \
5730 -label {Delete} \
5731 -font font_ui \
5732 -command {$ui_comm delete sel.first sel.last}
5733 $ctxm add separator
5734 $ctxm add command \
5735 -label {Select All} \
5736 -font font_ui \
5737 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5738 $ctxm add command \
5739 -label {Copy All} \
5740 -font font_ui \
5741 -command {
5742 $ui_comm tag add sel 0.0 end
5743 tk_textCopy $ui_comm
5744 $ui_comm tag remove sel 0.0 end
5746 $ctxm add separator
5747 $ctxm add command \
5748 -label {Sign Off} \
5749 -font font_ui \
5750 -command do_signoff
5751 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5753 # -- Diff Header
5755 proc trace_current_diff_path {varname args} {
5756 global current_diff_path diff_actions file_states
5757 if {$current_diff_path eq {}} {
5758 set s {}
5759 set f {}
5760 set p {}
5761 set o disabled
5762 } else {
5763 set p $current_diff_path
5764 set s [mapdesc [lindex $file_states($p) 0] $p]
5765 set f {File:}
5766 set p [escape_path $p]
5767 set o normal
5770 .vpane.lower.diff.header.status configure -text $s
5771 .vpane.lower.diff.header.file configure -text $f
5772 .vpane.lower.diff.header.path configure -text $p
5773 foreach w $diff_actions {
5774 uplevel #0 $w $o
5777 trace add variable current_diff_path write trace_current_diff_path
5779 frame .vpane.lower.diff.header -background orange
5780 label .vpane.lower.diff.header.status \
5781 -background orange \
5782 -width $max_status_desc \
5783 -anchor w \
5784 -justify left \
5785 -font font_ui
5786 label .vpane.lower.diff.header.file \
5787 -background orange \
5788 -anchor w \
5789 -justify left \
5790 -font font_ui
5791 label .vpane.lower.diff.header.path \
5792 -background orange \
5793 -anchor w \
5794 -justify left \
5795 -font font_ui
5796 pack .vpane.lower.diff.header.status -side left
5797 pack .vpane.lower.diff.header.file -side left
5798 pack .vpane.lower.diff.header.path -fill x
5799 set ctxm .vpane.lower.diff.header.ctxm
5800 menu $ctxm -tearoff 0
5801 $ctxm add command \
5802 -label {Copy} \
5803 -font font_ui \
5804 -command {
5805 clipboard clear
5806 clipboard append \
5807 -format STRING \
5808 -type STRING \
5809 -- $current_diff_path
5811 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5812 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5814 # -- Diff Body
5816 frame .vpane.lower.diff.body
5817 set ui_diff .vpane.lower.diff.body.t
5818 text $ui_diff -background white -borderwidth 0 \
5819 -width 80 -height 15 -wrap none \
5820 -font font_diff \
5821 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5822 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5823 -state disabled
5824 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5825 -command [list $ui_diff xview]
5826 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5827 -command [list $ui_diff yview]
5828 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5829 pack .vpane.lower.diff.body.sby -side right -fill y
5830 pack $ui_diff -side left -fill both -expand 1
5831 pack .vpane.lower.diff.header -side top -fill x
5832 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5834 $ui_diff tag conf d_cr -elide true
5835 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5836 $ui_diff tag conf d_+ -foreground {#00a000}
5837 $ui_diff tag conf d_- -foreground red
5839 $ui_diff tag conf d_++ -foreground {#00a000}
5840 $ui_diff tag conf d_-- -foreground red
5841 $ui_diff tag conf d_+s \
5842 -foreground {#00a000} \
5843 -background {#e2effa}
5844 $ui_diff tag conf d_-s \
5845 -foreground red \
5846 -background {#e2effa}
5847 $ui_diff tag conf d_s+ \
5848 -foreground {#00a000} \
5849 -background ivory1
5850 $ui_diff tag conf d_s- \
5851 -foreground red \
5852 -background ivory1
5854 $ui_diff tag conf d<<<<<<< \
5855 -foreground orange \
5856 -font font_diffbold
5857 $ui_diff tag conf d======= \
5858 -foreground orange \
5859 -font font_diffbold
5860 $ui_diff tag conf d>>>>>>> \
5861 -foreground orange \
5862 -font font_diffbold
5864 $ui_diff tag raise sel
5866 # -- Diff Body Context Menu
5868 set ctxm .vpane.lower.diff.body.ctxm
5869 menu $ctxm -tearoff 0
5870 $ctxm add command \
5871 -label {Refresh} \
5872 -font font_ui \
5873 -command reshow_diff
5874 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5875 $ctxm add command \
5876 -label {Copy} \
5877 -font font_ui \
5878 -command {tk_textCopy $ui_diff}
5879 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5880 $ctxm add command \
5881 -label {Select All} \
5882 -font font_ui \
5883 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5884 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5885 $ctxm add command \
5886 -label {Copy All} \
5887 -font font_ui \
5888 -command {
5889 $ui_diff tag add sel 0.0 end
5890 tk_textCopy $ui_diff
5891 $ui_diff tag remove sel 0.0 end
5893 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5894 $ctxm add separator
5895 $ctxm add command \
5896 -label {Apply/Reverse Hunk} \
5897 -font font_ui \
5898 -command {apply_hunk $cursorX $cursorY}
5899 set ui_diff_applyhunk [$ctxm index last]
5900 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5901 $ctxm add separator
5902 $ctxm add command \
5903 -label {Decrease Font Size} \
5904 -font font_ui \
5905 -command {incr_font_size font_diff -1}
5906 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5907 $ctxm add command \
5908 -label {Increase Font Size} \
5909 -font font_ui \
5910 -command {incr_font_size font_diff 1}
5911 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5912 $ctxm add separator
5913 $ctxm add command \
5914 -label {Show Less Context} \
5915 -font font_ui \
5916 -command {if {$repo_config(gui.diffcontext) >= 2} {
5917 incr repo_config(gui.diffcontext) -1
5918 reshow_diff
5920 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5921 $ctxm add command \
5922 -label {Show More Context} \
5923 -font font_ui \
5924 -command {
5925 incr repo_config(gui.diffcontext)
5926 reshow_diff
5928 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5929 $ctxm add separator
5930 $ctxm add command -label {Options...} \
5931 -font font_ui \
5932 -command do_options
5933 bind_button3 $ui_diff "
5934 set cursorX %x
5935 set cursorY %y
5936 if {\$ui_index eq \$current_diff_side} {
5937 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5938 } else {
5939 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5941 tk_popup $ctxm %X %Y
5943 unset ui_diff_applyhunk
5945 # -- Status Bar
5947 label .status -textvariable ui_status_value \
5948 -anchor w \
5949 -justify left \
5950 -borderwidth 1 \
5951 -relief sunken \
5952 -font font_ui
5953 pack .status -anchor w -side bottom -fill x
5955 # -- Load geometry
5957 catch {
5958 set gm $repo_config(gui.geometry)
5959 wm geometry . [lindex $gm 0]
5960 .vpane sash place 0 \
5961 [lindex [.vpane sash coord 0] 0] \
5962 [lindex $gm 1]
5963 .vpane.files sash place 0 \
5964 [lindex $gm 2] \
5965 [lindex [.vpane.files sash coord 0] 1]
5966 unset gm
5969 # -- Key Bindings
5971 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5972 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5973 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5974 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5975 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5976 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5977 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5978 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5979 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5980 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5981 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5983 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5984 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5985 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5986 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5987 bind $ui_diff <$M1B-Key-v> {break}
5988 bind $ui_diff <$M1B-Key-V> {break}
5989 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5990 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5991 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5992 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5993 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5994 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5995 bind $ui_diff <Button-1> {focus %W}
5997 if {[is_enabled branch]} {
5998 bind . <$M1B-Key-n> do_create_branch
5999 bind . <$M1B-Key-N> do_create_branch
6002 bind all <Key-F5> do_rescan
6003 bind all <$M1B-Key-r> do_rescan
6004 bind all <$M1B-Key-R> do_rescan
6005 bind . <$M1B-Key-s> do_signoff
6006 bind . <$M1B-Key-S> do_signoff
6007 bind . <$M1B-Key-i> do_add_all
6008 bind . <$M1B-Key-I> do_add_all
6009 bind . <$M1B-Key-Return> do_commit
6010 foreach i [list $ui_index $ui_workdir] {
6011 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
6012 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
6013 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
6015 unset i
6017 set file_lists($ui_index) [list]
6018 set file_lists($ui_workdir) [list]
6020 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
6021 focus -force $ui_comm
6023 # -- Warn the user about environmental problems. Cygwin's Tcl
6024 # does *not* pass its env array onto any processes it spawns.
6025 # This means that git processes get none of our environment.
6027 if {[is_Cygwin]} {
6028 set ignored_env 0
6029 set suggest_user {}
6030 set msg "Possible environment issues exist.
6032 The following environment variables are probably
6033 going to be ignored by any Git subprocess run
6034 by [appname]:
6037 foreach name [array names env] {
6038 switch -regexp -- $name {
6039 {^GIT_INDEX_FILE$} -
6040 {^GIT_OBJECT_DIRECTORY$} -
6041 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
6042 {^GIT_DIFF_OPTS$} -
6043 {^GIT_EXTERNAL_DIFF$} -
6044 {^GIT_PAGER$} -
6045 {^GIT_TRACE$} -
6046 {^GIT_CONFIG$} -
6047 {^GIT_CONFIG_LOCAL$} -
6048 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
6049 append msg " - $name\n"
6050 incr ignored_env
6052 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
6053 append msg " - $name\n"
6054 incr ignored_env
6055 set suggest_user $name
6059 if {$ignored_env > 0} {
6060 append msg "
6061 This is due to a known issue with the
6062 Tcl binary distributed by Cygwin."
6064 if {$suggest_user ne {}} {
6065 append msg "
6067 A good replacement for $suggest_user
6068 is placing values for the user.name and
6069 user.email settings into your personal
6070 ~/.gitconfig file.
6073 warn_popup $msg
6075 unset ignored_env msg suggest_user name
6078 # -- Only initialize complex UI if we are going to stay running.
6080 if {[is_enabled transport]} {
6081 load_all_remotes
6082 load_all_heads
6084 populate_branch_menu
6085 populate_fetch_menu
6086 populate_push_menu
6089 # -- Only suggest a gc run if we are going to stay running.
6091 if {[is_enabled multicommit]} {
6092 set object_limit 2000
6093 if {[is_Windows]} {set object_limit 200}
6094 regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
6095 if {$objects_current >= $object_limit} {
6096 if {[ask_popup \
6097 "This repository currently has $objects_current loose objects.
6099 To maintain optimal performance it is strongly
6100 recommended that you compress the database
6101 when more than $object_limit loose objects exist.
6103 Compress the database now?"] eq yes} {
6104 do_gc
6107 unset object_limit _junk objects_current
6110 lock_index begin-read
6111 after 1 do_rescan