Merge branch 'js/fetch-progress' (early part)
[git/git-svn.git] / git-gui / git-gui.sh
blobf84ba3382b3078ee6de45bddfacd650973068303
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 # -- Build the message.
1272 set msg_p [gitdir COMMIT_EDITMSG]
1273 set msg_wt [open $msg_p w]
1274 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1275 set enc utf-8
1277 fconfigure $msg_wt -encoding $enc -translation binary
1278 puts -nonewline $msg_wt $msg
1279 close $msg_wt
1281 # -- Create the commit.
1283 set cmd [list git commit-tree $tree_id]
1284 set parents [concat $PARENT $MERGE_HEAD]
1285 if {[llength $parents] > 0} {
1286 foreach p $parents {
1287 lappend cmd -p $p
1289 } else {
1290 # git commit-tree writes to stderr during initial commit.
1291 lappend cmd 2>/dev/null
1293 lappend cmd <$msg_p
1294 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1295 error_popup "commit-tree failed:\n\n$err"
1296 set ui_status_value {Commit failed.}
1297 unlock_index
1298 return
1301 # -- Update the HEAD ref.
1303 set reflogm commit
1304 if {$commit_type ne {normal}} {
1305 append reflogm " ($commit_type)"
1307 set i [string first "\n" $msg]
1308 if {$i >= 0} {
1309 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1310 } else {
1311 append reflogm {: } $msg
1313 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1314 if {[catch {eval exec $cmd} err]} {
1315 error_popup "update-ref failed:\n\n$err"
1316 set ui_status_value {Commit failed.}
1317 unlock_index
1318 return
1321 # -- Cleanup after ourselves.
1323 catch {file delete $msg_p}
1324 catch {file delete [gitdir MERGE_HEAD]}
1325 catch {file delete [gitdir MERGE_MSG]}
1326 catch {file delete [gitdir SQUASH_MSG]}
1327 catch {file delete [gitdir GITGUI_MSG]}
1329 # -- Let rerere do its thing.
1331 if {[file isdirectory [gitdir rr-cache]]} {
1332 catch {git rerere}
1335 # -- Run the post-commit hook.
1337 set pchook [gitdir hooks post-commit]
1338 if {[is_Cygwin] && [file isfile $pchook]} {
1339 set pchook [list sh -c [concat \
1340 "if test -x \"$pchook\";" \
1341 "then exec \"$pchook\";" \
1342 "fi"]]
1343 } elseif {![file executable $pchook]} {
1344 set pchook {}
1346 if {$pchook ne {}} {
1347 catch {exec $pchook &}
1350 $ui_comm delete 0.0 end
1351 $ui_comm edit reset
1352 $ui_comm edit modified false
1354 if {[is_enabled singlecommit]} do_quit
1356 # -- Make sure our current branch exists.
1358 if {$commit_type eq {initial}} {
1359 lappend all_heads $current_branch
1360 set all_heads [lsort -unique $all_heads]
1361 populate_branch_menu
1364 # -- Update in memory status
1366 set selected_commit_type new
1367 set commit_type normal
1368 set HEAD $cmt_id
1369 set PARENT $cmt_id
1370 set MERGE_HEAD [list]
1372 foreach path [array names file_states] {
1373 set s $file_states($path)
1374 set m [lindex $s 0]
1375 switch -glob -- $m {
1376 _O -
1377 _M -
1378 _D {continue}
1379 __ -
1380 A_ -
1381 M_ -
1382 D_ {
1383 unset file_states($path)
1384 catch {unset selected_paths($path)}
1386 DO {
1387 set file_states($path) [list _O [lindex $s 1] {} {}]
1389 AM -
1390 AD -
1391 MM -
1392 MD {
1393 set file_states($path) [list \
1394 _[string index $m 1] \
1395 [lindex $s 1] \
1396 [lindex $s 3] \
1402 display_all_files
1403 unlock_index
1404 reshow_diff
1405 set ui_status_value \
1406 "Changes committed as [string range $cmt_id 0 7]."
1409 ######################################################################
1411 ## fetch push
1413 proc fetch_from {remote} {
1414 set w [new_console \
1415 "fetch $remote" \
1416 "Fetching new changes from $remote"]
1417 set cmd [list git fetch]
1418 lappend cmd $remote
1419 console_exec $w $cmd console_done
1422 proc push_to {remote} {
1423 set w [new_console \
1424 "push $remote" \
1425 "Pushing changes to $remote"]
1426 set cmd [list git push]
1427 lappend cmd -v
1428 lappend cmd $remote
1429 console_exec $w $cmd console_done
1432 ######################################################################
1434 ## ui helpers
1436 proc mapicon {w state path} {
1437 global all_icons
1439 if {[catch {set r $all_icons($state$w)}]} {
1440 puts "error: no icon for $w state={$state} $path"
1441 return file_plain
1443 return $r
1446 proc mapdesc {state path} {
1447 global all_descs
1449 if {[catch {set r $all_descs($state)}]} {
1450 puts "error: no desc for state={$state} $path"
1451 return $state
1453 return $r
1456 proc escape_path {path} {
1457 regsub -all {\\} $path "\\\\" path
1458 regsub -all "\n" $path "\\n" path
1459 return $path
1462 proc short_path {path} {
1463 return [escape_path [lindex [file split $path] end]]
1466 set next_icon_id 0
1467 set null_sha1 [string repeat 0 40]
1469 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1470 global file_states next_icon_id null_sha1
1472 set s0 [string index $new_state 0]
1473 set s1 [string index $new_state 1]
1475 if {[catch {set info $file_states($path)}]} {
1476 set state __
1477 set icon n[incr next_icon_id]
1478 } else {
1479 set state [lindex $info 0]
1480 set icon [lindex $info 1]
1481 if {$head_info eq {}} {set head_info [lindex $info 2]}
1482 if {$index_info eq {}} {set index_info [lindex $info 3]}
1485 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1486 elseif {$s0 eq {_}} {set s0 _}
1488 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1489 elseif {$s1 eq {_}} {set s1 _}
1491 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1492 set head_info [list 0 $null_sha1]
1493 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1494 && $head_info eq {}} {
1495 set head_info $index_info
1498 set file_states($path) [list $s0$s1 $icon \
1499 $head_info $index_info \
1501 return $state
1504 proc display_file_helper {w path icon_name old_m new_m} {
1505 global file_lists
1507 if {$new_m eq {_}} {
1508 set lno [lsearch -sorted -exact $file_lists($w) $path]
1509 if {$lno >= 0} {
1510 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1511 incr lno
1512 $w conf -state normal
1513 $w delete $lno.0 [expr {$lno + 1}].0
1514 $w conf -state disabled
1516 } elseif {$old_m eq {_} && $new_m ne {_}} {
1517 lappend file_lists($w) $path
1518 set file_lists($w) [lsort -unique $file_lists($w)]
1519 set lno [lsearch -sorted -exact $file_lists($w) $path]
1520 incr lno
1521 $w conf -state normal
1522 $w image create $lno.0 \
1523 -align center -padx 5 -pady 1 \
1524 -name $icon_name \
1525 -image [mapicon $w $new_m $path]
1526 $w insert $lno.1 "[escape_path $path]\n"
1527 $w conf -state disabled
1528 } elseif {$old_m ne $new_m} {
1529 $w conf -state normal
1530 $w image conf $icon_name -image [mapicon $w $new_m $path]
1531 $w conf -state disabled
1535 proc display_file {path state} {
1536 global file_states selected_paths
1537 global ui_index ui_workdir
1539 set old_m [merge_state $path $state]
1540 set s $file_states($path)
1541 set new_m [lindex $s 0]
1542 set icon_name [lindex $s 1]
1544 set o [string index $old_m 0]
1545 set n [string index $new_m 0]
1546 if {$o eq {U}} {
1547 set o _
1549 if {$n eq {U}} {
1550 set n _
1552 display_file_helper $ui_index $path $icon_name $o $n
1554 if {[string index $old_m 0] eq {U}} {
1555 set o U
1556 } else {
1557 set o [string index $old_m 1]
1559 if {[string index $new_m 0] eq {U}} {
1560 set n U
1561 } else {
1562 set n [string index $new_m 1]
1564 display_file_helper $ui_workdir $path $icon_name $o $n
1566 if {$new_m eq {__}} {
1567 unset file_states($path)
1568 catch {unset selected_paths($path)}
1572 proc display_all_files_helper {w path icon_name m} {
1573 global file_lists
1575 lappend file_lists($w) $path
1576 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1577 $w image create end \
1578 -align center -padx 5 -pady 1 \
1579 -name $icon_name \
1580 -image [mapicon $w $m $path]
1581 $w insert end "[escape_path $path]\n"
1584 proc display_all_files {} {
1585 global ui_index ui_workdir
1586 global file_states file_lists
1587 global last_clicked
1589 $ui_index conf -state normal
1590 $ui_workdir conf -state normal
1592 $ui_index delete 0.0 end
1593 $ui_workdir delete 0.0 end
1594 set last_clicked {}
1596 set file_lists($ui_index) [list]
1597 set file_lists($ui_workdir) [list]
1599 foreach path [lsort [array names file_states]] {
1600 set s $file_states($path)
1601 set m [lindex $s 0]
1602 set icon_name [lindex $s 1]
1604 set s [string index $m 0]
1605 if {$s ne {U} && $s ne {_}} {
1606 display_all_files_helper $ui_index $path \
1607 $icon_name $s
1610 if {[string index $m 0] eq {U}} {
1611 set s U
1612 } else {
1613 set s [string index $m 1]
1615 if {$s ne {_}} {
1616 display_all_files_helper $ui_workdir $path \
1617 $icon_name $s
1621 $ui_index conf -state disabled
1622 $ui_workdir conf -state disabled
1625 proc update_indexinfo {msg pathList after} {
1626 global update_index_cp ui_status_value
1628 if {![lock_index update]} return
1630 set update_index_cp 0
1631 set pathList [lsort $pathList]
1632 set totalCnt [llength $pathList]
1633 set batch [expr {int($totalCnt * .01) + 1}]
1634 if {$batch > 25} {set batch 25}
1636 set ui_status_value [format \
1637 "$msg... %i/%i files (%.2f%%)" \
1638 $update_index_cp \
1639 $totalCnt \
1640 0.0]
1641 set fd [open "| git update-index -z --index-info" w]
1642 fconfigure $fd \
1643 -blocking 0 \
1644 -buffering full \
1645 -buffersize 512 \
1646 -encoding binary \
1647 -translation binary
1648 fileevent $fd writable [list \
1649 write_update_indexinfo \
1650 $fd \
1651 $pathList \
1652 $totalCnt \
1653 $batch \
1654 $msg \
1655 $after \
1659 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1660 global update_index_cp ui_status_value
1661 global file_states current_diff_path
1663 if {$update_index_cp >= $totalCnt} {
1664 close $fd
1665 unlock_index
1666 uplevel #0 $after
1667 return
1670 for {set i $batch} \
1671 {$update_index_cp < $totalCnt && $i > 0} \
1672 {incr i -1} {
1673 set path [lindex $pathList $update_index_cp]
1674 incr update_index_cp
1676 set s $file_states($path)
1677 switch -glob -- [lindex $s 0] {
1678 A? {set new _O}
1679 M? {set new _M}
1680 D_ {set new _D}
1681 D? {set new _?}
1682 ?? {continue}
1684 set info [lindex $s 2]
1685 if {$info eq {}} continue
1687 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1688 display_file $path $new
1691 set ui_status_value [format \
1692 "$msg... %i/%i files (%.2f%%)" \
1693 $update_index_cp \
1694 $totalCnt \
1695 [expr {100.0 * $update_index_cp / $totalCnt}]]
1698 proc update_index {msg pathList after} {
1699 global update_index_cp ui_status_value
1701 if {![lock_index update]} return
1703 set update_index_cp 0
1704 set pathList [lsort $pathList]
1705 set totalCnt [llength $pathList]
1706 set batch [expr {int($totalCnt * .01) + 1}]
1707 if {$batch > 25} {set batch 25}
1709 set ui_status_value [format \
1710 "$msg... %i/%i files (%.2f%%)" \
1711 $update_index_cp \
1712 $totalCnt \
1713 0.0]
1714 set fd [open "| git update-index --add --remove -z --stdin" w]
1715 fconfigure $fd \
1716 -blocking 0 \
1717 -buffering full \
1718 -buffersize 512 \
1719 -encoding binary \
1720 -translation binary
1721 fileevent $fd writable [list \
1722 write_update_index \
1723 $fd \
1724 $pathList \
1725 $totalCnt \
1726 $batch \
1727 $msg \
1728 $after \
1732 proc write_update_index {fd pathList totalCnt batch msg after} {
1733 global update_index_cp ui_status_value
1734 global file_states current_diff_path
1736 if {$update_index_cp >= $totalCnt} {
1737 close $fd
1738 unlock_index
1739 uplevel #0 $after
1740 return
1743 for {set i $batch} \
1744 {$update_index_cp < $totalCnt && $i > 0} \
1745 {incr i -1} {
1746 set path [lindex $pathList $update_index_cp]
1747 incr update_index_cp
1749 switch -glob -- [lindex $file_states($path) 0] {
1750 AD {set new __}
1751 ?D {set new D_}
1752 _O -
1753 AM {set new A_}
1754 U? {
1755 if {[file exists $path]} {
1756 set new M_
1757 } else {
1758 set new D_
1761 ?M {set new M_}
1762 ?? {continue}
1764 puts -nonewline $fd "[encoding convertto $path]\0"
1765 display_file $path $new
1768 set ui_status_value [format \
1769 "$msg... %i/%i files (%.2f%%)" \
1770 $update_index_cp \
1771 $totalCnt \
1772 [expr {100.0 * $update_index_cp / $totalCnt}]]
1775 proc checkout_index {msg pathList after} {
1776 global update_index_cp ui_status_value
1778 if {![lock_index update]} return
1780 set update_index_cp 0
1781 set pathList [lsort $pathList]
1782 set totalCnt [llength $pathList]
1783 set batch [expr {int($totalCnt * .01) + 1}]
1784 if {$batch > 25} {set batch 25}
1786 set ui_status_value [format \
1787 "$msg... %i/%i files (%.2f%%)" \
1788 $update_index_cp \
1789 $totalCnt \
1790 0.0]
1791 set cmd [list git checkout-index]
1792 lappend cmd --index
1793 lappend cmd --quiet
1794 lappend cmd --force
1795 lappend cmd -z
1796 lappend cmd --stdin
1797 set fd [open "| $cmd " w]
1798 fconfigure $fd \
1799 -blocking 0 \
1800 -buffering full \
1801 -buffersize 512 \
1802 -encoding binary \
1803 -translation binary
1804 fileevent $fd writable [list \
1805 write_checkout_index \
1806 $fd \
1807 $pathList \
1808 $totalCnt \
1809 $batch \
1810 $msg \
1811 $after \
1815 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1816 global update_index_cp ui_status_value
1817 global file_states current_diff_path
1819 if {$update_index_cp >= $totalCnt} {
1820 close $fd
1821 unlock_index
1822 uplevel #0 $after
1823 return
1826 for {set i $batch} \
1827 {$update_index_cp < $totalCnt && $i > 0} \
1828 {incr i -1} {
1829 set path [lindex $pathList $update_index_cp]
1830 incr update_index_cp
1831 switch -glob -- [lindex $file_states($path) 0] {
1832 U? {continue}
1833 ?M -
1834 ?D {
1835 puts -nonewline $fd "[encoding convertto $path]\0"
1836 display_file $path ?_
1841 set ui_status_value [format \
1842 "$msg... %i/%i files (%.2f%%)" \
1843 $update_index_cp \
1844 $totalCnt \
1845 [expr {100.0 * $update_index_cp / $totalCnt}]]
1848 ######################################################################
1850 ## branch management
1852 proc is_tracking_branch {name} {
1853 global tracking_branches
1855 if {![catch {set info $tracking_branches($name)}]} {
1856 return 1
1858 foreach t [array names tracking_branches] {
1859 if {[string match {*/\*} $t] && [string match $t $name]} {
1860 return 1
1863 return 0
1866 proc load_all_heads {} {
1867 global all_heads
1869 set all_heads [list]
1870 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1871 while {[gets $fd line] > 0} {
1872 if {[is_tracking_branch $line]} continue
1873 if {![regsub ^refs/heads/ $line {} name]} continue
1874 lappend all_heads $name
1876 close $fd
1878 set all_heads [lsort $all_heads]
1881 proc populate_branch_menu {} {
1882 global all_heads disable_on_lock
1884 set m .mbar.branch
1885 set last [$m index last]
1886 for {set i 0} {$i <= $last} {incr i} {
1887 if {[$m type $i] eq {separator}} {
1888 $m delete $i last
1889 set new_dol [list]
1890 foreach a $disable_on_lock {
1891 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1892 lappend new_dol $a
1895 set disable_on_lock $new_dol
1896 break
1900 if {$all_heads ne {}} {
1901 $m add separator
1903 foreach b $all_heads {
1904 $m add radiobutton \
1905 -label $b \
1906 -command [list switch_branch $b] \
1907 -variable current_branch \
1908 -value $b \
1909 -font font_ui
1910 lappend disable_on_lock \
1911 [list $m entryconf [$m index last] -state]
1915 proc all_tracking_branches {} {
1916 global tracking_branches
1918 set all_trackings {}
1919 set cmd {}
1920 foreach name [array names tracking_branches] {
1921 if {[regsub {/\*$} $name {} name]} {
1922 lappend cmd $name
1923 } else {
1924 regsub ^refs/(heads|remotes)/ $name {} name
1925 lappend all_trackings $name
1929 if {$cmd ne {}} {
1930 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1931 while {[gets $fd name] > 0} {
1932 regsub ^refs/(heads|remotes)/ $name {} name
1933 lappend all_trackings $name
1935 close $fd
1938 return [lsort -unique $all_trackings]
1941 proc load_all_tags {} {
1942 set all_tags [list]
1943 set fd [open "| git for-each-ref --format=%(refname) refs/tags" r]
1944 while {[gets $fd line] > 0} {
1945 if {![regsub ^refs/tags/ $line {} name]} continue
1946 lappend all_tags $name
1948 close $fd
1950 return [lsort $all_tags]
1953 proc do_create_branch_action {w} {
1954 global all_heads null_sha1 repo_config
1955 global create_branch_checkout create_branch_revtype
1956 global create_branch_head create_branch_trackinghead
1957 global create_branch_name create_branch_revexp
1958 global create_branch_tag
1960 set newbranch $create_branch_name
1961 if {$newbranch eq {}
1962 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1963 tk_messageBox \
1964 -icon error \
1965 -type ok \
1966 -title [wm title $w] \
1967 -parent $w \
1968 -message "Please supply a branch name."
1969 focus $w.desc.name_t
1970 return
1972 if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
1973 tk_messageBox \
1974 -icon error \
1975 -type ok \
1976 -title [wm title $w] \
1977 -parent $w \
1978 -message "Branch '$newbranch' already exists."
1979 focus $w.desc.name_t
1980 return
1982 if {[catch {git check-ref-format "heads/$newbranch"}]} {
1983 tk_messageBox \
1984 -icon error \
1985 -type ok \
1986 -title [wm title $w] \
1987 -parent $w \
1988 -message "We do not like '$newbranch' as a branch name."
1989 focus $w.desc.name_t
1990 return
1993 set rev {}
1994 switch -- $create_branch_revtype {
1995 head {set rev $create_branch_head}
1996 tracking {set rev $create_branch_trackinghead}
1997 tag {set rev $create_branch_tag}
1998 expression {set rev $create_branch_revexp}
2000 if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
2001 tk_messageBox \
2002 -icon error \
2003 -type ok \
2004 -title [wm title $w] \
2005 -parent $w \
2006 -message "Invalid starting revision: $rev"
2007 return
2009 set cmd [list git update-ref]
2010 lappend cmd -m
2011 lappend cmd "branch: Created from $rev"
2012 lappend cmd "refs/heads/$newbranch"
2013 lappend cmd $cmt
2014 lappend cmd $null_sha1
2015 if {[catch {eval exec $cmd} err]} {
2016 tk_messageBox \
2017 -icon error \
2018 -type ok \
2019 -title [wm title $w] \
2020 -parent $w \
2021 -message "Failed to create '$newbranch'.\n\n$err"
2022 return
2025 lappend all_heads $newbranch
2026 set all_heads [lsort $all_heads]
2027 populate_branch_menu
2028 destroy $w
2029 if {$create_branch_checkout} {
2030 switch_branch $newbranch
2034 proc radio_selector {varname value args} {
2035 upvar #0 $varname var
2036 set var $value
2039 trace add variable create_branch_head write \
2040 [list radio_selector create_branch_revtype head]
2041 trace add variable create_branch_trackinghead write \
2042 [list radio_selector create_branch_revtype tracking]
2043 trace add variable create_branch_tag write \
2044 [list radio_selector create_branch_revtype tag]
2046 trace add variable delete_branch_head write \
2047 [list radio_selector delete_branch_checktype head]
2048 trace add variable delete_branch_trackinghead write \
2049 [list radio_selector delete_branch_checktype tracking]
2051 proc do_create_branch {} {
2052 global all_heads current_branch repo_config
2053 global create_branch_checkout create_branch_revtype
2054 global create_branch_head create_branch_trackinghead
2055 global create_branch_name create_branch_revexp
2056 global create_branch_tag
2058 set w .branch_editor
2059 toplevel $w
2060 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2062 label $w.header -text {Create New Branch} \
2063 -font font_uibold
2064 pack $w.header -side top -fill x
2066 frame $w.buttons
2067 button $w.buttons.create -text Create \
2068 -font font_ui \
2069 -default active \
2070 -command [list do_create_branch_action $w]
2071 pack $w.buttons.create -side right
2072 button $w.buttons.cancel -text {Cancel} \
2073 -font font_ui \
2074 -command [list destroy $w]
2075 pack $w.buttons.cancel -side right -padx 5
2076 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2078 labelframe $w.desc \
2079 -text {Branch Description} \
2080 -font font_ui
2081 label $w.desc.name_l -text {Name:} -font font_ui
2082 entry $w.desc.name_t \
2083 -borderwidth 1 \
2084 -relief sunken \
2085 -width 40 \
2086 -textvariable create_branch_name \
2087 -font font_ui \
2088 -validate key \
2089 -validatecommand {
2090 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2091 return 1
2093 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2094 grid columnconfigure $w.desc 1 -weight 1
2095 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2097 labelframe $w.from \
2098 -text {Starting Revision} \
2099 -font font_ui
2100 radiobutton $w.from.head_r \
2101 -text {Local Branch:} \
2102 -value head \
2103 -variable create_branch_revtype \
2104 -font font_ui
2105 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2106 grid $w.from.head_r $w.from.head_m -sticky w
2107 set all_trackings [all_tracking_branches]
2108 if {$all_trackings ne {}} {
2109 set create_branch_trackinghead [lindex $all_trackings 0]
2110 radiobutton $w.from.tracking_r \
2111 -text {Tracking Branch:} \
2112 -value tracking \
2113 -variable create_branch_revtype \
2114 -font font_ui
2115 eval tk_optionMenu $w.from.tracking_m \
2116 create_branch_trackinghead \
2117 $all_trackings
2118 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2120 set all_tags [load_all_tags]
2121 if {$all_tags ne {}} {
2122 set create_branch_tag [lindex $all_tags 0]
2123 radiobutton $w.from.tag_r \
2124 -text {Tag:} \
2125 -value tag \
2126 -variable create_branch_revtype \
2127 -font font_ui
2128 eval tk_optionMenu $w.from.tag_m \
2129 create_branch_tag \
2130 $all_tags
2131 grid $w.from.tag_r $w.from.tag_m -sticky w
2133 radiobutton $w.from.exp_r \
2134 -text {Revision Expression:} \
2135 -value expression \
2136 -variable create_branch_revtype \
2137 -font font_ui
2138 entry $w.from.exp_t \
2139 -borderwidth 1 \
2140 -relief sunken \
2141 -width 50 \
2142 -textvariable create_branch_revexp \
2143 -font font_ui \
2144 -validate key \
2145 -validatecommand {
2146 if {%d == 1 && [regexp {\s} %S]} {return 0}
2147 if {%d == 1 && [string length %S] > 0} {
2148 set create_branch_revtype expression
2150 return 1
2152 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2153 grid columnconfigure $w.from 1 -weight 1
2154 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2156 labelframe $w.postActions \
2157 -text {Post Creation Actions} \
2158 -font font_ui
2159 checkbutton $w.postActions.checkout \
2160 -text {Checkout after creation} \
2161 -variable create_branch_checkout \
2162 -font font_ui
2163 pack $w.postActions.checkout -anchor nw
2164 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2166 set create_branch_checkout 1
2167 set create_branch_head $current_branch
2168 set create_branch_revtype head
2169 set create_branch_name $repo_config(gui.newbranchtemplate)
2170 set create_branch_revexp {}
2172 bind $w <Visibility> "
2173 grab $w
2174 $w.desc.name_t icursor end
2175 focus $w.desc.name_t
2177 bind $w <Key-Escape> "destroy $w"
2178 bind $w <Key-Return> "do_create_branch_action $w;break"
2179 wm title $w "[appname] ([reponame]): Create Branch"
2180 tkwait window $w
2183 proc do_delete_branch_action {w} {
2184 global all_heads
2185 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2187 set check_rev {}
2188 switch -- $delete_branch_checktype {
2189 head {set check_rev $delete_branch_head}
2190 tracking {set check_rev $delete_branch_trackinghead}
2191 always {set check_rev {:none}}
2193 if {$check_rev eq {:none}} {
2194 set check_cmt {}
2195 } elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
2196 tk_messageBox \
2197 -icon error \
2198 -type ok \
2199 -title [wm title $w] \
2200 -parent $w \
2201 -message "Invalid check revision: $check_rev"
2202 return
2205 set to_delete [list]
2206 set not_merged [list]
2207 foreach i [$w.list.l curselection] {
2208 set b [$w.list.l get $i]
2209 if {[catch {set o [git rev-parse --verify $b]}]} continue
2210 if {$check_cmt ne {}} {
2211 if {$b eq $check_rev} continue
2212 if {[catch {set m [git merge-base $o $check_cmt]}]} continue
2213 if {$o ne $m} {
2214 lappend not_merged $b
2215 continue
2218 lappend to_delete [list $b $o]
2220 if {$not_merged ne {}} {
2221 set msg "The following branches are not completely merged into $check_rev:
2223 - [join $not_merged "\n - "]"
2224 tk_messageBox \
2225 -icon info \
2226 -type ok \
2227 -title [wm title $w] \
2228 -parent $w \
2229 -message $msg
2231 if {$to_delete eq {}} return
2232 if {$delete_branch_checktype eq {always}} {
2233 set msg {Recovering deleted branches is difficult.
2235 Delete the selected branches?}
2236 if {[tk_messageBox \
2237 -icon warning \
2238 -type yesno \
2239 -title [wm title $w] \
2240 -parent $w \
2241 -message $msg] ne yes} {
2242 return
2246 set failed {}
2247 foreach i $to_delete {
2248 set b [lindex $i 0]
2249 set o [lindex $i 1]
2250 if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
2251 append failed " - $b: $err\n"
2252 } else {
2253 set x [lsearch -sorted -exact $all_heads $b]
2254 if {$x >= 0} {
2255 set all_heads [lreplace $all_heads $x $x]
2260 if {$failed ne {}} {
2261 tk_messageBox \
2262 -icon error \
2263 -type ok \
2264 -title [wm title $w] \
2265 -parent $w \
2266 -message "Failed to delete branches:\n$failed"
2269 set all_heads [lsort $all_heads]
2270 populate_branch_menu
2271 destroy $w
2274 proc do_delete_branch {} {
2275 global all_heads tracking_branches current_branch
2276 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2278 set w .branch_editor
2279 toplevel $w
2280 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2282 label $w.header -text {Delete Local Branch} \
2283 -font font_uibold
2284 pack $w.header -side top -fill x
2286 frame $w.buttons
2287 button $w.buttons.create -text Delete \
2288 -font font_ui \
2289 -command [list do_delete_branch_action $w]
2290 pack $w.buttons.create -side right
2291 button $w.buttons.cancel -text {Cancel} \
2292 -font font_ui \
2293 -command [list destroy $w]
2294 pack $w.buttons.cancel -side right -padx 5
2295 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2297 labelframe $w.list \
2298 -text {Local Branches} \
2299 -font font_ui
2300 listbox $w.list.l \
2301 -height 10 \
2302 -width 70 \
2303 -selectmode extended \
2304 -yscrollcommand [list $w.list.sby set] \
2305 -font font_ui
2306 foreach h $all_heads {
2307 if {$h ne $current_branch} {
2308 $w.list.l insert end $h
2311 scrollbar $w.list.sby -command [list $w.list.l yview]
2312 pack $w.list.sby -side right -fill y
2313 pack $w.list.l -side left -fill both -expand 1
2314 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2316 labelframe $w.validate \
2317 -text {Delete Only If} \
2318 -font font_ui
2319 radiobutton $w.validate.head_r \
2320 -text {Merged Into Local Branch:} \
2321 -value head \
2322 -variable delete_branch_checktype \
2323 -font font_ui
2324 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2325 grid $w.validate.head_r $w.validate.head_m -sticky w
2326 set all_trackings [all_tracking_branches]
2327 if {$all_trackings ne {}} {
2328 set delete_branch_trackinghead [lindex $all_trackings 0]
2329 radiobutton $w.validate.tracking_r \
2330 -text {Merged Into Tracking Branch:} \
2331 -value tracking \
2332 -variable delete_branch_checktype \
2333 -font font_ui
2334 eval tk_optionMenu $w.validate.tracking_m \
2335 delete_branch_trackinghead \
2336 $all_trackings
2337 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2339 radiobutton $w.validate.always_r \
2340 -text {Always (Do not perform merge checks)} \
2341 -value always \
2342 -variable delete_branch_checktype \
2343 -font font_ui
2344 grid $w.validate.always_r -columnspan 2 -sticky w
2345 grid columnconfigure $w.validate 1 -weight 1
2346 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2348 set delete_branch_head $current_branch
2349 set delete_branch_checktype head
2351 bind $w <Visibility> "grab $w; focus $w"
2352 bind $w <Key-Escape> "destroy $w"
2353 wm title $w "[appname] ([reponame]): Delete Branch"
2354 tkwait window $w
2357 proc switch_branch {new_branch} {
2358 global HEAD commit_type current_branch repo_config
2360 if {![lock_index switch]} return
2362 # -- Our in memory state should match the repository.
2364 repository_state curType curHEAD curMERGE_HEAD
2365 if {[string match amend* $commit_type]
2366 && $curType eq {normal}
2367 && $curHEAD eq $HEAD} {
2368 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2369 info_popup {Last scanned state does not match repository state.
2371 Another Git program has modified this repository
2372 since the last scan. A rescan must be performed
2373 before the current branch can be changed.
2375 The rescan will be automatically started now.
2377 unlock_index
2378 rescan {set ui_status_value {Ready.}}
2379 return
2382 # -- Don't do a pointless switch.
2384 if {$current_branch eq $new_branch} {
2385 unlock_index
2386 return
2389 if {$repo_config(gui.trustmtime) eq {true}} {
2390 switch_branch_stage2 {} $new_branch
2391 } else {
2392 set ui_status_value {Refreshing file status...}
2393 set cmd [list git update-index]
2394 lappend cmd -q
2395 lappend cmd --unmerged
2396 lappend cmd --ignore-missing
2397 lappend cmd --refresh
2398 set fd_rf [open "| $cmd" r]
2399 fconfigure $fd_rf -blocking 0 -translation binary
2400 fileevent $fd_rf readable \
2401 [list switch_branch_stage2 $fd_rf $new_branch]
2405 proc switch_branch_stage2 {fd_rf new_branch} {
2406 global ui_status_value HEAD
2408 if {$fd_rf ne {}} {
2409 read $fd_rf
2410 if {![eof $fd_rf]} return
2411 close $fd_rf
2414 set ui_status_value "Updating working directory to '$new_branch'..."
2415 set cmd [list git read-tree]
2416 lappend cmd -m
2417 lappend cmd -u
2418 lappend cmd --exclude-per-directory=.gitignore
2419 lappend cmd $HEAD
2420 lappend cmd $new_branch
2421 set fd_rt [open "| $cmd" r]
2422 fconfigure $fd_rt -blocking 0 -translation binary
2423 fileevent $fd_rt readable \
2424 [list switch_branch_readtree_wait $fd_rt $new_branch]
2427 proc switch_branch_readtree_wait {fd_rt new_branch} {
2428 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2429 global current_branch
2430 global ui_comm ui_status_value
2432 # -- We never get interesting output on stdout; only stderr.
2434 read $fd_rt
2435 fconfigure $fd_rt -blocking 1
2436 if {![eof $fd_rt]} {
2437 fconfigure $fd_rt -blocking 0
2438 return
2441 # -- The working directory wasn't in sync with the index and
2442 # we'd have to overwrite something to make the switch. A
2443 # merge is required.
2445 if {[catch {close $fd_rt} err]} {
2446 regsub {^fatal: } $err {} err
2447 warn_popup "File level merge required.
2449 $err
2451 Staying on branch '$current_branch'."
2452 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2453 unlock_index
2454 return
2457 # -- Update the symbolic ref. Core git doesn't even check for failure
2458 # here, it Just Works(tm). If it doesn't we are in some really ugly
2459 # state that is difficult to recover from within git-gui.
2461 if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2462 error_popup "Failed to set current branch.
2464 This working directory is only partially switched.
2465 We successfully updated your files, but failed to
2466 update an internal Git file.
2468 This should not have occurred. [appname] will now
2469 close and give up.
2471 $err"
2472 do_quit
2473 return
2476 # -- Update our repository state. If we were previously in amend mode
2477 # we need to toss the current buffer and do a full rescan to update
2478 # our file lists. If we weren't in amend mode our file lists are
2479 # accurate and we can avoid the rescan.
2481 unlock_index
2482 set selected_commit_type new
2483 if {[string match amend* $commit_type]} {
2484 $ui_comm delete 0.0 end
2485 $ui_comm edit reset
2486 $ui_comm edit modified false
2487 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2488 } else {
2489 repository_state commit_type HEAD MERGE_HEAD
2490 set PARENT $HEAD
2491 set ui_status_value "Checked out branch '$current_branch'."
2495 ######################################################################
2497 ## remote management
2499 proc load_all_remotes {} {
2500 global repo_config
2501 global all_remotes tracking_branches
2503 set all_remotes [list]
2504 array unset tracking_branches
2506 set rm_dir [gitdir remotes]
2507 if {[file isdirectory $rm_dir]} {
2508 set all_remotes [glob \
2509 -types f \
2510 -tails \
2511 -nocomplain \
2512 -directory $rm_dir *]
2514 foreach name $all_remotes {
2515 catch {
2516 set fd [open [file join $rm_dir $name] r]
2517 while {[gets $fd line] >= 0} {
2518 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2519 $line line src dst]} continue
2520 if {![regexp ^refs/ $dst]} {
2521 set dst "refs/heads/$dst"
2523 set tracking_branches($dst) [list $name $src]
2525 close $fd
2530 foreach line [array names repo_config remote.*.url] {
2531 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2532 lappend all_remotes $name
2534 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2535 set fl {}
2537 foreach line $fl {
2538 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2539 if {![regexp ^refs/ $dst]} {
2540 set dst "refs/heads/$dst"
2542 set tracking_branches($dst) [list $name $src]
2546 set all_remotes [lsort -unique $all_remotes]
2549 proc populate_fetch_menu {} {
2550 global all_remotes repo_config
2552 set m .mbar.fetch
2553 foreach r $all_remotes {
2554 set enable 0
2555 if {![catch {set a $repo_config(remote.$r.url)}]} {
2556 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2557 set enable 1
2559 } else {
2560 catch {
2561 set fd [open [gitdir remotes $r] r]
2562 while {[gets $fd n] >= 0} {
2563 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2564 set enable 1
2565 break
2568 close $fd
2572 if {$enable} {
2573 $m add command \
2574 -label "Fetch from $r..." \
2575 -command [list fetch_from $r] \
2576 -font font_ui
2581 proc populate_push_menu {} {
2582 global all_remotes repo_config
2584 set m .mbar.push
2585 set fast_count 0
2586 foreach r $all_remotes {
2587 set enable 0
2588 if {![catch {set a $repo_config(remote.$r.url)}]} {
2589 if {![catch {set a $repo_config(remote.$r.push)}]} {
2590 set enable 1
2592 } else {
2593 catch {
2594 set fd [open [gitdir remotes $r] r]
2595 while {[gets $fd n] >= 0} {
2596 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2597 set enable 1
2598 break
2601 close $fd
2605 if {$enable} {
2606 if {!$fast_count} {
2607 $m add separator
2609 $m add command \
2610 -label "Push to $r..." \
2611 -command [list push_to $r] \
2612 -font font_ui
2613 incr fast_count
2618 proc start_push_anywhere_action {w} {
2619 global push_urltype push_remote push_url push_thin push_tags
2621 set r_url {}
2622 switch -- $push_urltype {
2623 remote {set r_url $push_remote}
2624 url {set r_url $push_url}
2626 if {$r_url eq {}} return
2628 set cmd [list git push]
2629 lappend cmd -v
2630 if {$push_thin} {
2631 lappend cmd --thin
2633 if {$push_tags} {
2634 lappend cmd --tags
2636 lappend cmd $r_url
2637 set cnt 0
2638 foreach i [$w.source.l curselection] {
2639 set b [$w.source.l get $i]
2640 lappend cmd "refs/heads/$b:refs/heads/$b"
2641 incr cnt
2643 if {$cnt == 0} {
2644 return
2645 } elseif {$cnt == 1} {
2646 set unit branch
2647 } else {
2648 set unit branches
2651 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2652 console_exec $cons $cmd console_done
2653 destroy $w
2656 trace add variable push_remote write \
2657 [list radio_selector push_urltype remote]
2659 proc do_push_anywhere {} {
2660 global all_heads all_remotes current_branch
2661 global push_urltype push_remote push_url push_thin push_tags
2663 set w .push_setup
2664 toplevel $w
2665 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2667 label $w.header -text {Push Branches} -font font_uibold
2668 pack $w.header -side top -fill x
2670 frame $w.buttons
2671 button $w.buttons.create -text Push \
2672 -font font_ui \
2673 -command [list start_push_anywhere_action $w]
2674 pack $w.buttons.create -side right
2675 button $w.buttons.cancel -text {Cancel} \
2676 -font font_ui \
2677 -command [list destroy $w]
2678 pack $w.buttons.cancel -side right -padx 5
2679 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2681 labelframe $w.source \
2682 -text {Source Branches} \
2683 -font font_ui
2684 listbox $w.source.l \
2685 -height 10 \
2686 -width 70 \
2687 -selectmode extended \
2688 -yscrollcommand [list $w.source.sby set] \
2689 -font font_ui
2690 foreach h $all_heads {
2691 $w.source.l insert end $h
2692 if {$h eq $current_branch} {
2693 $w.source.l select set end
2696 scrollbar $w.source.sby -command [list $w.source.l yview]
2697 pack $w.source.sby -side right -fill y
2698 pack $w.source.l -side left -fill both -expand 1
2699 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2701 labelframe $w.dest \
2702 -text {Destination Repository} \
2703 -font font_ui
2704 if {$all_remotes ne {}} {
2705 radiobutton $w.dest.remote_r \
2706 -text {Remote:} \
2707 -value remote \
2708 -variable push_urltype \
2709 -font font_ui
2710 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2711 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2712 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2713 set push_remote origin
2714 } else {
2715 set push_remote [lindex $all_remotes 0]
2717 set push_urltype remote
2718 } else {
2719 set push_urltype url
2721 radiobutton $w.dest.url_r \
2722 -text {Arbitrary URL:} \
2723 -value url \
2724 -variable push_urltype \
2725 -font font_ui
2726 entry $w.dest.url_t \
2727 -borderwidth 1 \
2728 -relief sunken \
2729 -width 50 \
2730 -textvariable push_url \
2731 -font font_ui \
2732 -validate key \
2733 -validatecommand {
2734 if {%d == 1 && [regexp {\s} %S]} {return 0}
2735 if {%d == 1 && [string length %S] > 0} {
2736 set push_urltype url
2738 return 1
2740 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2741 grid columnconfigure $w.dest 1 -weight 1
2742 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2744 labelframe $w.options \
2745 -text {Transfer Options} \
2746 -font font_ui
2747 checkbutton $w.options.thin \
2748 -text {Use thin pack (for slow network connections)} \
2749 -variable push_thin \
2750 -font font_ui
2751 grid $w.options.thin -columnspan 2 -sticky w
2752 checkbutton $w.options.tags \
2753 -text {Include tags} \
2754 -variable push_tags \
2755 -font font_ui
2756 grid $w.options.tags -columnspan 2 -sticky w
2757 grid columnconfigure $w.options 1 -weight 1
2758 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2760 set push_url {}
2761 set push_thin 0
2762 set push_tags 0
2764 bind $w <Visibility> "grab $w"
2765 bind $w <Key-Escape> "destroy $w"
2766 wm title $w "[appname] ([reponame]): Push"
2767 tkwait window $w
2770 ######################################################################
2772 ## merge
2774 proc can_merge {} {
2775 global HEAD commit_type file_states
2777 if {[string match amend* $commit_type]} {
2778 info_popup {Cannot merge while amending.
2780 You must finish amending this commit before
2781 starting any type of merge.
2783 return 0
2786 if {[committer_ident] eq {}} {return 0}
2787 if {![lock_index merge]} {return 0}
2789 # -- Our in memory state should match the repository.
2791 repository_state curType curHEAD curMERGE_HEAD
2792 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2793 info_popup {Last scanned state does not match repository state.
2795 Another Git program has modified this repository
2796 since the last scan. A rescan must be performed
2797 before a merge can be performed.
2799 The rescan will be automatically started now.
2801 unlock_index
2802 rescan {set ui_status_value {Ready.}}
2803 return 0
2806 foreach path [array names file_states] {
2807 switch -glob -- [lindex $file_states($path) 0] {
2808 _O {
2809 continue; # and pray it works!
2811 U? {
2812 error_popup "You are in the middle of a conflicted merge.
2814 File [short_path $path] has merge conflicts.
2816 You must resolve them, add the file, and commit to
2817 complete the current merge. Only then can you
2818 begin another merge.
2820 unlock_index
2821 return 0
2823 ?? {
2824 error_popup "You are in the middle of a change.
2826 File [short_path $path] is modified.
2828 You should complete the current commit before
2829 starting a merge. Doing so will help you abort
2830 a failed merge, should the need arise.
2832 unlock_index
2833 return 0
2838 return 1
2841 proc visualize_local_merge {w} {
2842 set revs {}
2843 foreach i [$w.source.l curselection] {
2844 lappend revs [$w.source.l get $i]
2846 if {$revs eq {}} return
2847 lappend revs --not HEAD
2848 do_gitk $revs
2851 proc start_local_merge_action {w} {
2852 global HEAD ui_status_value current_branch
2854 set cmd [list git merge]
2855 set names {}
2856 set revcnt 0
2857 foreach i [$w.source.l curselection] {
2858 set b [$w.source.l get $i]
2859 lappend cmd $b
2860 lappend names $b
2861 incr revcnt
2864 if {$revcnt == 0} {
2865 return
2866 } elseif {$revcnt == 1} {
2867 set unit branch
2868 } elseif {$revcnt <= 15} {
2869 set unit branches
2870 } else {
2871 tk_messageBox \
2872 -icon error \
2873 -type ok \
2874 -title [wm title $w] \
2875 -parent $w \
2876 -message "Too many branches selected.
2878 You have requested to merge $revcnt branches
2879 in an octopus merge. This exceeds Git's
2880 internal limit of 15 branches per merge.
2882 Please select fewer branches. To merge more
2883 than 15 branches, merge the branches in batches.
2885 return
2888 set msg "Merging $current_branch, [join $names {, }]"
2889 set ui_status_value "$msg..."
2890 set cons [new_console "Merge" $msg]
2891 console_exec $cons $cmd [list finish_merge $revcnt]
2892 bind $w <Destroy> {}
2893 destroy $w
2896 proc finish_merge {revcnt w ok} {
2897 console_done $w $ok
2898 if {$ok} {
2899 set msg {Merge completed successfully.}
2900 } else {
2901 if {$revcnt != 1} {
2902 info_popup "Octopus merge failed.
2904 Your merge of $revcnt branches has failed.
2906 There are file-level conflicts between the
2907 branches which must be resolved manually.
2909 The working directory will now be reset.
2911 You can attempt this merge again
2912 by merging only one branch at a time." $w
2914 set fd [open "| git read-tree --reset -u HEAD" r]
2915 fconfigure $fd -blocking 0 -translation binary
2916 fileevent $fd readable [list reset_hard_wait $fd]
2917 set ui_status_value {Aborting... please wait...}
2918 return
2921 set msg {Merge failed. Conflict resolution is required.}
2923 unlock_index
2924 rescan [list set ui_status_value $msg]
2927 proc do_local_merge {} {
2928 global current_branch
2930 if {![can_merge]} return
2932 set w .merge_setup
2933 toplevel $w
2934 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2936 label $w.header \
2937 -text "Merge Into $current_branch" \
2938 -font font_uibold
2939 pack $w.header -side top -fill x
2941 frame $w.buttons
2942 button $w.buttons.visualize -text Visualize \
2943 -font font_ui \
2944 -command [list visualize_local_merge $w]
2945 pack $w.buttons.visualize -side left
2946 button $w.buttons.create -text Merge \
2947 -font font_ui \
2948 -command [list start_local_merge_action $w]
2949 pack $w.buttons.create -side right
2950 button $w.buttons.cancel -text {Cancel} \
2951 -font font_ui \
2952 -command [list destroy $w]
2953 pack $w.buttons.cancel -side right -padx 5
2954 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2956 labelframe $w.source \
2957 -text {Source Branches} \
2958 -font font_ui
2959 listbox $w.source.l \
2960 -height 10 \
2961 -width 70 \
2962 -selectmode extended \
2963 -yscrollcommand [list $w.source.sby set] \
2964 -font font_ui
2965 scrollbar $w.source.sby -command [list $w.source.l yview]
2966 pack $w.source.sby -side right -fill y
2967 pack $w.source.l -side left -fill both -expand 1
2968 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2970 set cmd [list git for-each-ref]
2971 lappend cmd {--format=%(objectname) %(*objectname) %(refname)}
2972 lappend cmd refs/heads
2973 lappend cmd refs/remotes
2974 lappend cmd refs/tags
2975 set fr_fd [open "| $cmd" r]
2976 fconfigure $fr_fd -translation binary
2977 while {[gets $fr_fd line] > 0} {
2978 set line [split $line { }]
2979 set sha1([lindex $line 0]) [lindex $line 2]
2980 set sha1([lindex $line 1]) [lindex $line 2]
2982 close $fr_fd
2984 set to_show {}
2985 set fr_fd [open "| git rev-list --all --not HEAD"]
2986 while {[gets $fr_fd line] > 0} {
2987 if {[catch {set ref $sha1($line)}]} continue
2988 regsub ^refs/(heads|remotes|tags)/ $ref {} ref
2989 lappend to_show $ref
2991 close $fr_fd
2993 foreach ref [lsort -unique $to_show] {
2994 $w.source.l insert end $ref
2997 bind $w <Visibility> "grab $w"
2998 bind $w <Key-Escape> "unlock_index;destroy $w"
2999 bind $w <Destroy> unlock_index
3000 wm title $w "[appname] ([reponame]): Merge"
3001 tkwait window $w
3004 proc do_reset_hard {} {
3005 global HEAD commit_type file_states
3007 if {[string match amend* $commit_type]} {
3008 info_popup {Cannot abort while amending.
3010 You must finish amending this commit.
3012 return
3015 if {![lock_index abort]} return
3017 if {[string match *merge* $commit_type]} {
3018 set op merge
3019 } else {
3020 set op commit
3023 if {[ask_popup "Abort $op?
3025 Aborting the current $op will cause
3026 *ALL* uncommitted changes to be lost.
3028 Continue with aborting the current $op?"] eq {yes}} {
3029 set fd [open "| git read-tree --reset -u HEAD" r]
3030 fconfigure $fd -blocking 0 -translation binary
3031 fileevent $fd readable [list reset_hard_wait $fd]
3032 set ui_status_value {Aborting... please wait...}
3033 } else {
3034 unlock_index
3038 proc reset_hard_wait {fd} {
3039 global ui_comm
3041 read $fd
3042 if {[eof $fd]} {
3043 close $fd
3044 unlock_index
3046 $ui_comm delete 0.0 end
3047 $ui_comm edit modified false
3049 catch {file delete [gitdir MERGE_HEAD]}
3050 catch {file delete [gitdir rr-cache MERGE_RR]}
3051 catch {file delete [gitdir SQUASH_MSG]}
3052 catch {file delete [gitdir MERGE_MSG]}
3053 catch {file delete [gitdir GITGUI_MSG]}
3055 rescan {set ui_status_value {Abort completed. Ready.}}
3059 ######################################################################
3061 ## browser
3063 set next_browser_id 0
3065 proc new_browser {commit} {
3066 global next_browser_id cursor_ptr M1B
3067 global browser_commit browser_status browser_stack browser_path browser_busy
3069 if {[winfo ismapped .]} {
3070 set w .browser[incr next_browser_id]
3071 set tl $w
3072 toplevel $w
3073 } else {
3074 set w {}
3075 set tl .
3077 set w_list $w.list.l
3078 set browser_commit($w_list) $commit
3079 set browser_status($w_list) {Starting...}
3080 set browser_stack($w_list) {}
3081 set browser_path($w_list) $browser_commit($w_list):
3082 set browser_busy($w_list) 1
3084 label $w.path -textvariable browser_path($w_list) \
3085 -anchor w \
3086 -justify left \
3087 -borderwidth 1 \
3088 -relief sunken \
3089 -font font_uibold
3090 pack $w.path -anchor w -side top -fill x
3092 frame $w.list
3093 text $w_list -background white -borderwidth 0 \
3094 -cursor $cursor_ptr \
3095 -state disabled \
3096 -wrap none \
3097 -height 20 \
3098 -width 70 \
3099 -xscrollcommand [list $w.list.sbx set] \
3100 -yscrollcommand [list $w.list.sby set] \
3101 -font font_ui
3102 $w_list tag conf in_sel \
3103 -background [$w_list cget -foreground] \
3104 -foreground [$w_list cget -background]
3105 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3106 scrollbar $w.list.sby -orient v -command [list $w_list yview]
3107 pack $w.list.sbx -side bottom -fill x
3108 pack $w.list.sby -side right -fill y
3109 pack $w_list -side left -fill both -expand 1
3110 pack $w.list -side top -fill both -expand 1
3112 label $w.status -textvariable browser_status($w_list) \
3113 -anchor w \
3114 -justify left \
3115 -borderwidth 1 \
3116 -relief sunken \
3117 -font font_ui
3118 pack $w.status -anchor w -side bottom -fill x
3120 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3121 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3122 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3123 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3124 bind $w_list <Up> "browser_move -1 $w_list;break"
3125 bind $w_list <Down> "browser_move 1 $w_list;break"
3126 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3127 bind $w_list <Return> "browser_enter $w_list;break"
3128 bind $w_list <Prior> "browser_page -1 $w_list;break"
3129 bind $w_list <Next> "browser_page 1 $w_list;break"
3130 bind $w_list <Left> break
3131 bind $w_list <Right> break
3133 bind $tl <Visibility> "focus $w"
3134 bind $tl <Destroy> "
3135 array unset browser_buffer $w_list
3136 array unset browser_files $w_list
3137 array unset browser_status $w_list
3138 array unset browser_stack $w_list
3139 array unset browser_path $w_list
3140 array unset browser_commit $w_list
3141 array unset browser_busy $w_list
3143 wm title $tl "[appname] ([reponame]): File Browser"
3144 ls_tree $w_list $browser_commit($w_list) {}
3147 proc browser_move {dir w} {
3148 global browser_files browser_busy
3150 if {$browser_busy($w)} return
3151 set lno [lindex [split [$w index in_sel.first] .] 0]
3152 incr lno $dir
3153 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3154 $w tag remove in_sel 0.0 end
3155 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3156 $w see $lno.0
3160 proc browser_page {dir w} {
3161 global browser_files browser_busy
3163 if {$browser_busy($w)} return
3164 $w yview scroll $dir pages
3165 set lno [expr {int(
3166 [lindex [$w yview] 0]
3167 * [llength $browser_files($w)]
3168 + 1)}]
3169 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3170 $w tag remove in_sel 0.0 end
3171 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3172 $w see $lno.0
3176 proc browser_parent {w} {
3177 global browser_files browser_status browser_path
3178 global browser_stack browser_busy
3180 if {$browser_busy($w)} return
3181 set info [lindex $browser_files($w) 0]
3182 if {[lindex $info 0] eq {parent}} {
3183 set parent [lindex $browser_stack($w) end-1]
3184 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3185 if {$browser_stack($w) eq {}} {
3186 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3187 } else {
3188 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3190 set browser_status($w) "Loading $browser_path($w)..."
3191 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3195 proc browser_enter {w} {
3196 global browser_files browser_status browser_path
3197 global browser_commit browser_stack browser_busy
3199 if {$browser_busy($w)} return
3200 set lno [lindex [split [$w index in_sel.first] .] 0]
3201 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3202 if {$info ne {}} {
3203 switch -- [lindex $info 0] {
3204 parent {
3205 browser_parent $w
3207 tree {
3208 set name [lindex $info 2]
3209 set escn [escape_path $name]
3210 set browser_status($w) "Loading $escn..."
3211 append browser_path($w) $escn
3212 ls_tree $w [lindex $info 1] $name
3214 blob {
3215 set name [lindex $info 2]
3216 set p {}
3217 foreach n $browser_stack($w) {
3218 append p [lindex $n 1]
3220 append p $name
3221 show_blame $browser_commit($w) $p
3227 proc browser_click {was_double_click w pos} {
3228 global browser_files browser_busy
3230 if {$browser_busy($w)} return
3231 set lno [lindex [split [$w index $pos] .] 0]
3232 focus $w
3234 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3235 $w tag remove in_sel 0.0 end
3236 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3237 if {$was_double_click} {
3238 browser_enter $w
3243 proc ls_tree {w tree_id name} {
3244 global browser_buffer browser_files browser_stack browser_busy
3246 set browser_buffer($w) {}
3247 set browser_files($w) {}
3248 set browser_busy($w) 1
3250 $w conf -state normal
3251 $w tag remove in_sel 0.0 end
3252 $w delete 0.0 end
3253 if {$browser_stack($w) ne {}} {
3254 $w image create end \
3255 -align center -padx 5 -pady 1 \
3256 -name icon0 \
3257 -image file_uplevel
3258 $w insert end {[Up To Parent]}
3259 lappend browser_files($w) parent
3261 lappend browser_stack($w) [list $tree_id $name]
3262 $w conf -state disabled
3264 set cmd [list git ls-tree -z $tree_id]
3265 set fd [open "| $cmd" r]
3266 fconfigure $fd -blocking 0 -translation binary -encoding binary
3267 fileevent $fd readable [list read_ls_tree $fd $w]
3270 proc read_ls_tree {fd w} {
3271 global browser_buffer browser_files browser_status browser_busy
3273 if {![winfo exists $w]} {
3274 catch {close $fd}
3275 return
3278 append browser_buffer($w) [read $fd]
3279 set pck [split $browser_buffer($w) "\0"]
3280 set browser_buffer($w) [lindex $pck end]
3282 set n [llength $browser_files($w)]
3283 $w conf -state normal
3284 foreach p [lrange $pck 0 end-1] {
3285 set info [split $p "\t"]
3286 set path [lindex $info 1]
3287 set info [split [lindex $info 0] { }]
3288 set type [lindex $info 1]
3289 set object [lindex $info 2]
3291 switch -- $type {
3292 blob {
3293 set image file_mod
3295 tree {
3296 set image file_dir
3297 append path /
3299 default {
3300 set image file_question
3304 if {$n > 0} {$w insert end "\n"}
3305 $w image create end \
3306 -align center -padx 5 -pady 1 \
3307 -name icon[incr n] \
3308 -image $image
3309 $w insert end [escape_path $path]
3310 lappend browser_files($w) [list $type $object $path]
3312 $w conf -state disabled
3314 if {[eof $fd]} {
3315 close $fd
3316 set browser_status($w) Ready.
3317 set browser_busy($w) 0
3318 array unset browser_buffer $w
3319 if {$n > 0} {
3320 $w tag add in_sel 1.0 2.0
3321 focus -force $w
3326 proc show_blame {commit path} {
3327 global next_browser_id blame_status blame_data
3329 if {[winfo ismapped .]} {
3330 set w .browser[incr next_browser_id]
3331 set tl $w
3332 toplevel $w
3333 } else {
3334 set w {}
3335 set tl .
3337 set blame_status($w) {Loading current file content...}
3339 label $w.path -text "$commit:$path" \
3340 -anchor w \
3341 -justify left \
3342 -borderwidth 1 \
3343 -relief sunken \
3344 -font font_uibold
3345 pack $w.path -side top -fill x
3347 frame $w.out
3348 text $w.out.loaded_t \
3349 -background white -borderwidth 0 \
3350 -state disabled \
3351 -wrap none \
3352 -height 40 \
3353 -width 1 \
3354 -font font_diff
3355 $w.out.loaded_t tag conf annotated -background grey
3357 text $w.out.linenumber_t \
3358 -background white -borderwidth 0 \
3359 -state disabled \
3360 -wrap none \
3361 -height 40 \
3362 -width 5 \
3363 -font font_diff
3364 $w.out.linenumber_t tag conf linenumber -justify right
3366 text $w.out.file_t \
3367 -background white -borderwidth 0 \
3368 -state disabled \
3369 -wrap none \
3370 -height 40 \
3371 -width 80 \
3372 -xscrollcommand [list $w.out.sbx set] \
3373 -font font_diff
3375 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3376 scrollbar $w.out.sby -orient v \
3377 -command [list scrollbar2many [list \
3378 $w.out.loaded_t \
3379 $w.out.linenumber_t \
3380 $w.out.file_t \
3381 ] yview]
3382 grid \
3383 $w.out.linenumber_t \
3384 $w.out.loaded_t \
3385 $w.out.file_t \
3386 $w.out.sby \
3387 -sticky nsew
3388 grid conf $w.out.sbx -column 2 -sticky we
3389 grid columnconfigure $w.out 2 -weight 1
3390 grid rowconfigure $w.out 0 -weight 1
3391 pack $w.out -fill both -expand 1
3393 label $w.status -textvariable blame_status($w) \
3394 -anchor w \
3395 -justify left \
3396 -borderwidth 1 \
3397 -relief sunken \
3398 -font font_ui
3399 pack $w.status -side bottom -fill x
3401 frame $w.cm
3402 text $w.cm.t \
3403 -background white -borderwidth 0 \
3404 -state disabled \
3405 -wrap none \
3406 -height 10 \
3407 -width 80 \
3408 -xscrollcommand [list $w.cm.sbx set] \
3409 -yscrollcommand [list $w.cm.sby set] \
3410 -font font_diff
3411 scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3412 scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3413 pack $w.cm.sby -side right -fill y
3414 pack $w.cm.sbx -side bottom -fill x
3415 pack $w.cm.t -expand 1 -fill both
3416 pack $w.cm -side bottom -fill x
3418 menu $w.ctxm -tearoff 0
3419 $w.ctxm add command -label "Copy Commit" \
3420 -font font_ui \
3421 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3423 foreach i [list \
3424 $w.out.loaded_t \
3425 $w.out.linenumber_t \
3426 $w.out.file_t] {
3427 $i tag conf in_sel \
3428 -background [$i cget -foreground] \
3429 -foreground [$i cget -background]
3430 $i conf -yscrollcommand \
3431 [list many2scrollbar [list \
3432 $w.out.loaded_t \
3433 $w.out.linenumber_t \
3434 $w.out.file_t \
3435 ] yview $w.out.sby]
3436 bind $i <Button-1> "
3437 blame_click {$w} \\
3438 $w.cm.t \\
3439 $w.out.linenumber_t \\
3440 $w.out.file_t \\
3441 $i @%x,%y
3442 focus $i
3444 bind_button3 $i "
3445 set cursorX %x
3446 set cursorY %y
3447 set cursorW %W
3448 tk_popup $w.ctxm %X %Y
3452 bind $w.cm.t <Button-1> "focus $w.cm.t"
3453 bind $tl <Visibility> "focus $tl"
3454 bind $tl <Destroy> "
3455 array unset blame_status {$w}
3456 array unset blame_data $w,*
3458 wm title $tl "[appname] ([reponame]): File Viewer"
3460 set blame_data($w,commit_count) 0
3461 set blame_data($w,commit_list) {}
3462 set blame_data($w,total_lines) 0
3463 set blame_data($w,blame_lines) 0
3464 set blame_data($w,highlight_commit) {}
3465 set blame_data($w,highlight_line) -1
3467 set cmd [list git cat-file blob "$commit:$path"]
3468 set fd [open "| $cmd" r]
3469 fconfigure $fd -blocking 0 -translation lf -encoding binary
3470 fileevent $fd readable [list read_blame_catfile \
3471 $fd $w $commit $path \
3472 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3475 proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3476 global blame_status blame_data
3478 if {![winfo exists $w_file]} {
3479 catch {close $fd}
3480 return
3483 set n $blame_data($w,total_lines)
3484 $w_load conf -state normal
3485 $w_line conf -state normal
3486 $w_file conf -state normal
3487 while {[gets $fd line] >= 0} {
3488 regsub "\r\$" $line {} line
3489 incr n
3490 $w_load insert end "\n"
3491 $w_line insert end "$n\n" linenumber
3492 $w_file insert end "$line\n"
3494 $w_load conf -state disabled
3495 $w_line conf -state disabled
3496 $w_file conf -state disabled
3497 set blame_data($w,total_lines) $n
3499 if {[eof $fd]} {
3500 close $fd
3501 blame_incremental_status $w
3502 set cmd [list git blame -M -C --incremental]
3503 lappend cmd $commit -- $path
3504 set fd [open "| $cmd" r]
3505 fconfigure $fd -blocking 0 -translation lf -encoding binary
3506 fileevent $fd readable [list read_blame_incremental $fd $w \
3507 $w_load $w_cmit $w_line $w_file]
3511 proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3512 global blame_status blame_data
3514 if {![winfo exists $w_file]} {
3515 catch {close $fd}
3516 return
3519 while {[gets $fd line] >= 0} {
3520 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3521 cmit original_line final_line line_count]} {
3522 set blame_data($w,commit) $cmit
3523 set blame_data($w,original_line) $original_line
3524 set blame_data($w,final_line) $final_line
3525 set blame_data($w,line_count) $line_count
3527 if {[catch {set g $blame_data($w,$cmit,order)}]} {
3528 $w_line tag conf g$cmit
3529 $w_file tag conf g$cmit
3530 $w_line tag raise in_sel
3531 $w_file tag raise in_sel
3532 $w_file tag raise sel
3533 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3534 incr blame_data($w,commit_count)
3535 lappend blame_data($w,commit_list) $cmit
3537 } elseif {[string match {filename *} $line]} {
3538 set file [string range $line 9 end]
3539 set n $blame_data($w,line_count)
3540 set lno $blame_data($w,final_line)
3541 set cmit $blame_data($w,commit)
3543 while {$n > 0} {
3544 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3545 $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3546 } else {
3547 $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3548 $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3551 set blame_data($w,line$lno,commit) $cmit
3552 set blame_data($w,line$lno,file) $file
3553 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3554 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3556 if {$blame_data($w,highlight_line) == -1} {
3557 if {[lindex [$w_file yview] 0] == 0} {
3558 $w_file see $lno.0
3559 blame_showcommit $w $w_cmit $w_line $w_file $lno
3561 } elseif {$blame_data($w,highlight_line) == $lno} {
3562 blame_showcommit $w $w_cmit $w_line $w_file $lno
3565 incr n -1
3566 incr lno
3567 incr blame_data($w,blame_lines)
3570 set hc $blame_data($w,highlight_commit)
3571 if {$hc ne {}
3572 && [expr {$blame_data($w,$hc,order) + 1}]
3573 == $blame_data($w,$cmit,order)} {
3574 blame_showcommit $w $w_cmit $w_line $w_file \
3575 $blame_data($w,highlight_line)
3577 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3578 set blame_data($w,$blame_data($w,commit),$header) $data
3582 if {[eof $fd]} {
3583 close $fd
3584 set blame_status($w) {Annotation complete.}
3585 } else {
3586 blame_incremental_status $w
3590 proc blame_incremental_status {w} {
3591 global blame_status blame_data
3593 set blame_status($w) [format \
3594 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3595 $blame_data($w,blame_lines) \
3596 $blame_data($w,total_lines) \
3597 [expr {100 * $blame_data($w,blame_lines)
3598 / $blame_data($w,total_lines)}]]
3601 proc blame_click {w w_cmit w_line w_file cur_w pos} {
3602 set lno [lindex [split [$cur_w index $pos] .] 0]
3603 if {$lno eq {}} return
3605 $w_line tag remove in_sel 0.0 end
3606 $w_file tag remove in_sel 0.0 end
3607 $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3608 $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3610 blame_showcommit $w $w_cmit $w_line $w_file $lno
3613 set blame_colors {
3614 #ff4040
3615 #ff40ff
3616 #4040ff
3619 proc blame_showcommit {w w_cmit w_line w_file lno} {
3620 global blame_colors blame_data repo_config
3622 set cmit $blame_data($w,highlight_commit)
3623 if {$cmit ne {}} {
3624 set idx $blame_data($w,$cmit,order)
3625 set i 0
3626 foreach c $blame_colors {
3627 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3628 $w_line tag conf g$h -background white
3629 $w_file tag conf g$h -background white
3630 incr i
3634 $w_cmit conf -state normal
3635 $w_cmit delete 0.0 end
3636 if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3637 set cmit {}
3638 $w_cmit insert end "Loading annotation..."
3639 } else {
3640 set idx $blame_data($w,$cmit,order)
3641 set i 0
3642 foreach c $blame_colors {
3643 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3644 $w_line tag conf g$h -background $c
3645 $w_file tag conf g$h -background $c
3646 incr i
3649 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3650 set msg {}
3651 catch {
3652 set fd [open "| git cat-file commit $cmit" r]
3653 fconfigure $fd -encoding binary -translation lf
3654 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3655 set enc utf-8
3657 while {[gets $fd line] > 0} {
3658 if {[string match {encoding *} $line]} {
3659 set enc [string tolower [string range $line 9 end]]
3662 fconfigure $fd -encoding $enc
3663 set msg [string trim [read $fd]]
3664 close $fd
3666 set blame_data($w,$cmit,message) $msg
3669 set author_name {}
3670 set author_email {}
3671 set author_time {}
3672 catch {set author_name $blame_data($w,$cmit,author)}
3673 catch {set author_email $blame_data($w,$cmit,author-mail)}
3674 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3676 set committer_name {}
3677 set committer_email {}
3678 set committer_time {}
3679 catch {set committer_name $blame_data($w,$cmit,committer)}
3680 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3681 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3683 $w_cmit insert end "commit $cmit\n"
3684 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3685 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3686 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3687 $w_cmit insert end "\n"
3688 $w_cmit insert end $msg
3690 $w_cmit conf -state disabled
3692 set blame_data($w,highlight_line) $lno
3693 set blame_data($w,highlight_commit) $cmit
3696 proc blame_copycommit {w i pos} {
3697 global blame_data
3698 set lno [lindex [split [$i index $pos] .] 0]
3699 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3700 clipboard clear
3701 clipboard append \
3702 -format STRING \
3703 -type STRING \
3704 -- $commit
3708 ######################################################################
3710 ## icons
3712 set filemask {
3713 #define mask_width 14
3714 #define mask_height 15
3715 static unsigned char mask_bits[] = {
3716 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3717 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3718 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3721 image create bitmap file_plain -background white -foreground black -data {
3722 #define plain_width 14
3723 #define plain_height 15
3724 static unsigned char plain_bits[] = {
3725 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3726 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3727 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3728 } -maskdata $filemask
3730 image create bitmap file_mod -background white -foreground blue -data {
3731 #define mod_width 14
3732 #define mod_height 15
3733 static unsigned char mod_bits[] = {
3734 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3735 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3736 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3737 } -maskdata $filemask
3739 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3740 #define file_fulltick_width 14
3741 #define file_fulltick_height 15
3742 static unsigned char file_fulltick_bits[] = {
3743 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3744 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3745 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3746 } -maskdata $filemask
3748 image create bitmap file_parttick -background white -foreground "#005050" -data {
3749 #define parttick_width 14
3750 #define parttick_height 15
3751 static unsigned char parttick_bits[] = {
3752 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3753 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3754 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3755 } -maskdata $filemask
3757 image create bitmap file_question -background white -foreground black -data {
3758 #define file_question_width 14
3759 #define file_question_height 15
3760 static unsigned char file_question_bits[] = {
3761 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3762 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3763 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3764 } -maskdata $filemask
3766 image create bitmap file_removed -background white -foreground red -data {
3767 #define file_removed_width 14
3768 #define file_removed_height 15
3769 static unsigned char file_removed_bits[] = {
3770 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3771 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3772 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3773 } -maskdata $filemask
3775 image create bitmap file_merge -background white -foreground blue -data {
3776 #define file_merge_width 14
3777 #define file_merge_height 15
3778 static unsigned char file_merge_bits[] = {
3779 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3780 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3781 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3782 } -maskdata $filemask
3784 set file_dir_data {
3785 #define file_width 18
3786 #define file_height 18
3787 static unsigned char file_bits[] = {
3788 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3789 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3790 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3791 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3792 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3794 image create bitmap file_dir -background white -foreground blue \
3795 -data $file_dir_data -maskdata $file_dir_data
3796 unset file_dir_data
3798 set file_uplevel_data {
3799 #define up_width 15
3800 #define up_height 15
3801 static unsigned char up_bits[] = {
3802 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3803 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3804 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3806 image create bitmap file_uplevel -background white -foreground red \
3807 -data $file_uplevel_data -maskdata $file_uplevel_data
3808 unset file_uplevel_data
3810 set ui_index .vpane.files.index.list
3811 set ui_workdir .vpane.files.workdir.list
3813 set all_icons(_$ui_index) file_plain
3814 set all_icons(A$ui_index) file_fulltick
3815 set all_icons(M$ui_index) file_fulltick
3816 set all_icons(D$ui_index) file_removed
3817 set all_icons(U$ui_index) file_merge
3819 set all_icons(_$ui_workdir) file_plain
3820 set all_icons(M$ui_workdir) file_mod
3821 set all_icons(D$ui_workdir) file_question
3822 set all_icons(U$ui_workdir) file_merge
3823 set all_icons(O$ui_workdir) file_plain
3825 set max_status_desc 0
3826 foreach i {
3827 {__ "Unmodified"}
3829 {_M "Modified, not staged"}
3830 {M_ "Staged for commit"}
3831 {MM "Portions staged for commit"}
3832 {MD "Staged for commit, missing"}
3834 {_O "Untracked, not staged"}
3835 {A_ "Staged for commit"}
3836 {AM "Portions staged for commit"}
3837 {AD "Staged for commit, missing"}
3839 {_D "Missing"}
3840 {D_ "Staged for removal"}
3841 {DO "Staged for removal, still present"}
3843 {U_ "Requires merge resolution"}
3844 {UU "Requires merge resolution"}
3845 {UM "Requires merge resolution"}
3846 {UD "Requires merge resolution"}
3848 if {$max_status_desc < [string length [lindex $i 1]]} {
3849 set max_status_desc [string length [lindex $i 1]]
3851 set all_descs([lindex $i 0]) [lindex $i 1]
3853 unset i
3855 ######################################################################
3857 ## util
3859 proc bind_button3 {w cmd} {
3860 bind $w <Any-Button-3> $cmd
3861 if {[is_MacOSX]} {
3862 bind $w <Control-Button-1> $cmd
3866 proc scrollbar2many {list mode args} {
3867 foreach w $list {eval $w $mode $args}
3870 proc many2scrollbar {list mode sb top bottom} {
3871 $sb set $top $bottom
3872 foreach w $list {$w $mode moveto $top}
3875 proc incr_font_size {font {amt 1}} {
3876 set sz [font configure $font -size]
3877 incr sz $amt
3878 font configure $font -size $sz
3879 font configure ${font}bold -size $sz
3882 proc hook_failed_popup {hook msg} {
3883 set w .hookfail
3884 toplevel $w
3886 frame $w.m
3887 label $w.m.l1 -text "$hook hook failed:" \
3888 -anchor w \
3889 -justify left \
3890 -font font_uibold
3891 text $w.m.t \
3892 -background white -borderwidth 1 \
3893 -relief sunken \
3894 -width 80 -height 10 \
3895 -font font_diff \
3896 -yscrollcommand [list $w.m.sby set]
3897 label $w.m.l2 \
3898 -text {You must correct the above errors before committing.} \
3899 -anchor w \
3900 -justify left \
3901 -font font_uibold
3902 scrollbar $w.m.sby -command [list $w.m.t yview]
3903 pack $w.m.l1 -side top -fill x
3904 pack $w.m.l2 -side bottom -fill x
3905 pack $w.m.sby -side right -fill y
3906 pack $w.m.t -side left -fill both -expand 1
3907 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3909 $w.m.t insert 1.0 $msg
3910 $w.m.t conf -state disabled
3912 button $w.ok -text OK \
3913 -width 15 \
3914 -font font_ui \
3915 -command "destroy $w"
3916 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3918 bind $w <Visibility> "grab $w; focus $w"
3919 bind $w <Key-Return> "destroy $w"
3920 wm title $w "[appname] ([reponame]): error"
3921 tkwait window $w
3924 set next_console_id 0
3926 proc new_console {short_title long_title} {
3927 global next_console_id console_data
3928 set w .console[incr next_console_id]
3929 set console_data($w) [list $short_title $long_title]
3930 return [console_init $w]
3933 proc console_init {w} {
3934 global console_cr console_data M1B
3936 set console_cr($w) 1.0
3937 toplevel $w
3938 frame $w.m
3939 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3940 -anchor w \
3941 -justify left \
3942 -font font_uibold
3943 text $w.m.t \
3944 -background white -borderwidth 1 \
3945 -relief sunken \
3946 -width 80 -height 10 \
3947 -font font_diff \
3948 -state disabled \
3949 -yscrollcommand [list $w.m.sby set]
3950 label $w.m.s -text {Working... please wait...} \
3951 -anchor w \
3952 -justify left \
3953 -font font_uibold
3954 scrollbar $w.m.sby -command [list $w.m.t yview]
3955 pack $w.m.l1 -side top -fill x
3956 pack $w.m.s -side bottom -fill x
3957 pack $w.m.sby -side right -fill y
3958 pack $w.m.t -side left -fill both -expand 1
3959 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3961 menu $w.ctxm -tearoff 0
3962 $w.ctxm add command -label "Copy" \
3963 -font font_ui \
3964 -command "tk_textCopy $w.m.t"
3965 $w.ctxm add command -label "Select All" \
3966 -font font_ui \
3967 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3968 $w.ctxm add command -label "Copy All" \
3969 -font font_ui \
3970 -command "
3971 $w.m.t tag add sel 0.0 end
3972 tk_textCopy $w.m.t
3973 $w.m.t tag remove sel 0.0 end
3976 button $w.ok -text {Close} \
3977 -font font_ui \
3978 -state disabled \
3979 -command "destroy $w"
3980 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3982 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3983 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3984 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3985 bind $w <Visibility> "focus $w"
3986 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3987 return $w
3990 proc console_exec {w cmd after} {
3991 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3992 # But most users need that so we have to relogin. :-(
3994 if {[is_Cygwin]} {
3995 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3998 # -- Tcl won't let us redirect both stdout and stderr to
3999 # the same pipe. So pass it through cat...
4001 set cmd [concat | $cmd |& cat]
4003 set fd_f [open $cmd r]
4004 fconfigure $fd_f -blocking 0 -translation binary
4005 fileevent $fd_f readable [list console_read $w $fd_f $after]
4008 proc console_read {w fd after} {
4009 global console_cr
4011 set buf [read $fd]
4012 if {$buf ne {}} {
4013 if {![winfo exists $w]} {console_init $w}
4014 $w.m.t conf -state normal
4015 set c 0
4016 set n [string length $buf]
4017 while {$c < $n} {
4018 set cr [string first "\r" $buf $c]
4019 set lf [string first "\n" $buf $c]
4020 if {$cr < 0} {set cr [expr {$n + 1}]}
4021 if {$lf < 0} {set lf [expr {$n + 1}]}
4023 if {$lf < $cr} {
4024 $w.m.t insert end [string range $buf $c $lf]
4025 set console_cr($w) [$w.m.t index {end -1c}]
4026 set c $lf
4027 incr c
4028 } else {
4029 $w.m.t delete $console_cr($w) end
4030 $w.m.t insert end "\n"
4031 $w.m.t insert end [string range $buf $c $cr]
4032 set c $cr
4033 incr c
4036 $w.m.t conf -state disabled
4037 $w.m.t see end
4040 fconfigure $fd -blocking 1
4041 if {[eof $fd]} {
4042 if {[catch {close $fd}]} {
4043 set ok 0
4044 } else {
4045 set ok 1
4047 uplevel #0 $after $w $ok
4048 return
4050 fconfigure $fd -blocking 0
4053 proc console_chain {cmdlist w {ok 1}} {
4054 if {$ok} {
4055 if {[llength $cmdlist] == 0} {
4056 console_done $w $ok
4057 return
4060 set cmd [lindex $cmdlist 0]
4061 set cmdlist [lrange $cmdlist 1 end]
4063 if {[lindex $cmd 0] eq {console_exec}} {
4064 console_exec $w \
4065 [lindex $cmd 1] \
4066 [list console_chain $cmdlist]
4067 } else {
4068 uplevel #0 $cmd $cmdlist $w $ok
4070 } else {
4071 console_done $w $ok
4075 proc console_done {args} {
4076 global console_cr console_data
4078 switch -- [llength $args] {
4080 set w [lindex $args 0]
4081 set ok [lindex $args 1]
4084 set w [lindex $args 1]
4085 set ok [lindex $args 2]
4087 default {
4088 error "wrong number of args: console_done ?ignored? w ok"
4092 if {$ok} {
4093 if {[winfo exists $w]} {
4094 $w.m.s conf -background green -text {Success}
4095 $w.ok conf -state normal
4097 } else {
4098 if {![winfo exists $w]} {
4099 console_init $w
4101 $w.m.s conf -background red -text {Error: Command Failed}
4102 $w.ok conf -state normal
4105 array unset console_cr $w
4106 array unset console_data $w
4109 ######################################################################
4111 ## ui commands
4113 set starting_gitk_msg {Starting gitk... please wait...}
4115 proc do_gitk {revs} {
4116 global env ui_status_value starting_gitk_msg
4118 # -- Always start gitk through whatever we were loaded with. This
4119 # lets us bypass using shell process on Windows systems.
4121 set cmd [info nameofexecutable]
4122 lappend cmd [gitexec gitk]
4123 if {$revs ne {}} {
4124 append cmd { }
4125 append cmd $revs
4128 if {[catch {eval exec $cmd &} err]} {
4129 error_popup "Failed to start gitk:\n\n$err"
4130 } else {
4131 set ui_status_value $starting_gitk_msg
4132 after 10000 {
4133 if {$ui_status_value eq $starting_gitk_msg} {
4134 set ui_status_value {Ready.}
4140 proc do_stats {} {
4141 set fd [open "| git count-objects -v" r]
4142 while {[gets $fd line] > 0} {
4143 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4144 set stats($name) $value
4147 close $fd
4149 set packed_sz 0
4150 foreach p [glob -directory [gitdir objects pack] \
4151 -type f \
4152 -nocomplain -- *] {
4153 incr packed_sz [file size $p]
4155 if {$packed_sz > 0} {
4156 set stats(size-pack) [expr {$packed_sz / 1024}]
4159 set w .stats_view
4160 toplevel $w
4161 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4163 label $w.header -text {Database Statistics} \
4164 -font font_uibold
4165 pack $w.header -side top -fill x
4167 frame $w.buttons -border 1
4168 button $w.buttons.close -text Close \
4169 -font font_ui \
4170 -command [list destroy $w]
4171 button $w.buttons.gc -text {Compress Database} \
4172 -font font_ui \
4173 -command "destroy $w;do_gc"
4174 pack $w.buttons.close -side right
4175 pack $w.buttons.gc -side left
4176 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4178 frame $w.stat -borderwidth 1 -relief solid
4179 foreach s {
4180 {count {Number of loose objects}}
4181 {size {Disk space used by loose objects} { KiB}}
4182 {in-pack {Number of packed objects}}
4183 {packs {Number of packs}}
4184 {size-pack {Disk space used by packed objects} { KiB}}
4185 {prune-packable {Packed objects waiting for pruning}}
4186 {garbage {Garbage files}}
4188 set name [lindex $s 0]
4189 set label [lindex $s 1]
4190 if {[catch {set value $stats($name)}]} continue
4191 if {[llength $s] > 2} {
4192 set value "$value[lindex $s 2]"
4195 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4196 label $w.stat.v_$name -text $value -anchor w -font font_ui
4197 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4199 pack $w.stat -pady 10 -padx 10
4201 bind $w <Visibility> "grab $w; focus $w"
4202 bind $w <Key-Escape> [list destroy $w]
4203 bind $w <Key-Return> [list destroy $w]
4204 wm title $w "[appname] ([reponame]): Database Statistics"
4205 tkwait window $w
4208 proc do_gc {} {
4209 set w [new_console {gc} {Compressing the object database}]
4210 console_chain {
4211 {console_exec {git pack-refs --prune}}
4212 {console_exec {git reflog expire --all}}
4213 {console_exec {git repack -a -d -l}}
4214 {console_exec {git rerere gc}}
4215 } $w
4218 proc do_fsck_objects {} {
4219 set w [new_console {fsck-objects} \
4220 {Verifying the object database with fsck-objects}]
4221 set cmd [list git fsck-objects]
4222 lappend cmd --full
4223 lappend cmd --cache
4224 lappend cmd --strict
4225 console_exec $w $cmd console_done
4228 set is_quitting 0
4230 proc do_quit {} {
4231 global ui_comm is_quitting repo_config commit_type
4233 if {$is_quitting} return
4234 set is_quitting 1
4236 if {[winfo exists $ui_comm]} {
4237 # -- Stash our current commit buffer.
4239 set save [gitdir GITGUI_MSG]
4240 set msg [string trim [$ui_comm get 0.0 end]]
4241 regsub -all -line {[ \r\t]+$} $msg {} msg
4242 if {(![string match amend* $commit_type]
4243 || [$ui_comm edit modified])
4244 && $msg ne {}} {
4245 catch {
4246 set fd [open $save w]
4247 puts -nonewline $fd $msg
4248 close $fd
4250 } else {
4251 catch {file delete $save}
4254 # -- Stash our current window geometry into this repository.
4256 set cfg_geometry [list]
4257 lappend cfg_geometry [wm geometry .]
4258 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4259 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4260 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4261 set rc_geometry {}
4263 if {$cfg_geometry ne $rc_geometry} {
4264 catch {git config gui.geometry $cfg_geometry}
4268 destroy .
4271 proc do_rescan {} {
4272 rescan {set ui_status_value {Ready.}}
4275 proc unstage_helper {txt paths} {
4276 global file_states current_diff_path
4278 if {![lock_index begin-update]} return
4280 set pathList [list]
4281 set after {}
4282 foreach path $paths {
4283 switch -glob -- [lindex $file_states($path) 0] {
4284 A? -
4285 M? -
4286 D? {
4287 lappend pathList $path
4288 if {$path eq $current_diff_path} {
4289 set after {reshow_diff;}
4294 if {$pathList eq {}} {
4295 unlock_index
4296 } else {
4297 update_indexinfo \
4298 $txt \
4299 $pathList \
4300 [concat $after {set ui_status_value {Ready.}}]
4304 proc do_unstage_selection {} {
4305 global current_diff_path selected_paths
4307 if {[array size selected_paths] > 0} {
4308 unstage_helper \
4309 {Unstaging selected files from commit} \
4310 [array names selected_paths]
4311 } elseif {$current_diff_path ne {}} {
4312 unstage_helper \
4313 "Unstaging [short_path $current_diff_path] from commit" \
4314 [list $current_diff_path]
4318 proc add_helper {txt paths} {
4319 global file_states current_diff_path
4321 if {![lock_index begin-update]} return
4323 set pathList [list]
4324 set after {}
4325 foreach path $paths {
4326 switch -glob -- [lindex $file_states($path) 0] {
4327 _O -
4328 ?M -
4329 ?D -
4330 U? {
4331 lappend pathList $path
4332 if {$path eq $current_diff_path} {
4333 set after {reshow_diff;}
4338 if {$pathList eq {}} {
4339 unlock_index
4340 } else {
4341 update_index \
4342 $txt \
4343 $pathList \
4344 [concat $after {set ui_status_value {Ready to commit.}}]
4348 proc do_add_selection {} {
4349 global current_diff_path selected_paths
4351 if {[array size selected_paths] > 0} {
4352 add_helper \
4353 {Adding selected files} \
4354 [array names selected_paths]
4355 } elseif {$current_diff_path ne {}} {
4356 add_helper \
4357 "Adding [short_path $current_diff_path]" \
4358 [list $current_diff_path]
4362 proc do_add_all {} {
4363 global file_states
4365 set paths [list]
4366 foreach path [array names file_states] {
4367 switch -glob -- [lindex $file_states($path) 0] {
4368 U? {continue}
4369 ?M -
4370 ?D {lappend paths $path}
4373 add_helper {Adding all changed files} $paths
4376 proc revert_helper {txt paths} {
4377 global file_states current_diff_path
4379 if {![lock_index begin-update]} return
4381 set pathList [list]
4382 set after {}
4383 foreach path $paths {
4384 switch -glob -- [lindex $file_states($path) 0] {
4385 U? {continue}
4386 ?M -
4387 ?D {
4388 lappend pathList $path
4389 if {$path eq $current_diff_path} {
4390 set after {reshow_diff;}
4396 set n [llength $pathList]
4397 if {$n == 0} {
4398 unlock_index
4399 return
4400 } elseif {$n == 1} {
4401 set s "[short_path [lindex $pathList]]"
4402 } else {
4403 set s "these $n files"
4406 set reply [tk_dialog \
4407 .confirm_revert \
4408 "[appname] ([reponame])" \
4409 "Revert changes in $s?
4411 Any unadded changes will be permanently lost by the revert." \
4412 question \
4414 {Do Nothing} \
4415 {Revert Changes} \
4417 if {$reply == 1} {
4418 checkout_index \
4419 $txt \
4420 $pathList \
4421 [concat $after {set ui_status_value {Ready.}}]
4422 } else {
4423 unlock_index
4427 proc do_revert_selection {} {
4428 global current_diff_path selected_paths
4430 if {[array size selected_paths] > 0} {
4431 revert_helper \
4432 {Reverting selected files} \
4433 [array names selected_paths]
4434 } elseif {$current_diff_path ne {}} {
4435 revert_helper \
4436 "Reverting [short_path $current_diff_path]" \
4437 [list $current_diff_path]
4441 proc do_signoff {} {
4442 global ui_comm
4444 set me [committer_ident]
4445 if {$me eq {}} return
4447 set sob "Signed-off-by: $me"
4448 set last [$ui_comm get {end -1c linestart} {end -1c}]
4449 if {$last ne $sob} {
4450 $ui_comm edit separator
4451 if {$last ne {}
4452 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4453 $ui_comm insert end "\n"
4455 $ui_comm insert end "\n$sob"
4456 $ui_comm edit separator
4457 $ui_comm see end
4461 proc do_select_commit_type {} {
4462 global commit_type selected_commit_type
4464 if {$selected_commit_type eq {new}
4465 && [string match amend* $commit_type]} {
4466 create_new_commit
4467 } elseif {$selected_commit_type eq {amend}
4468 && ![string match amend* $commit_type]} {
4469 load_last_commit
4471 # The amend request was rejected...
4473 if {![string match amend* $commit_type]} {
4474 set selected_commit_type new
4479 proc do_commit {} {
4480 commit_tree
4483 proc do_credits {} {
4484 global gitgui_credits
4486 set w .credits_dialog
4488 toplevel $w
4489 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4491 label $w.header -text {git-gui Contributors} -font font_uibold
4492 pack $w.header -side top -fill x
4494 frame $w.buttons
4495 button $w.buttons.close -text {Close} \
4496 -font font_ui \
4497 -command [list destroy $w]
4498 pack $w.buttons.close -side right
4499 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4501 frame $w.credits
4502 text $w.credits.t \
4503 -background [$w.header cget -background] \
4504 -yscrollcommand [list $w.credits.sby set] \
4505 -width 20 \
4506 -height 10 \
4507 -wrap none \
4508 -borderwidth 1 \
4509 -relief solid \
4510 -padx 5 -pady 5 \
4511 -font font_ui
4512 scrollbar $w.credits.sby -command [list $w.credits.t yview]
4513 pack $w.credits.sby -side right -fill y
4514 pack $w.credits.t -fill both -expand 1
4515 pack $w.credits -side top -fill both -expand 1 -padx 5 -pady 5
4517 label $w.desc \
4518 -text "All portions are copyrighted by their respective authors
4519 and are distributed under the GNU General Public License." \
4520 -padx 5 -pady 5 \
4521 -justify left \
4522 -anchor w \
4523 -borderwidth 1 \
4524 -relief solid \
4525 -font font_ui
4526 pack $w.desc -side top -fill x -padx 5 -pady 5
4528 $w.credits.t insert end "[string trim $gitgui_credits]\n"
4529 $w.credits.t conf -state disabled
4530 $w.credits.t see 1.0
4532 bind $w <Visibility> "grab $w; focus $w"
4533 bind $w <Key-Escape> [list destroy $w]
4534 wm title $w [$w.header cget -text]
4535 tkwait window $w
4538 proc do_about {} {
4539 global appvers copyright
4540 global tcl_patchLevel tk_patchLevel
4542 set w .about_dialog
4543 toplevel $w
4544 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4546 label $w.header -text "About [appname]" \
4547 -font font_uibold
4548 pack $w.header -side top -fill x
4550 frame $w.buttons
4551 button $w.buttons.close -text {Close} \
4552 -font font_ui \
4553 -command [list destroy $w]
4554 button $w.buttons.credits -text {Contributors} \
4555 -font font_ui \
4556 -command do_credits
4557 pack $w.buttons.credits -side left
4558 pack $w.buttons.close -side right
4559 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4561 label $w.desc \
4562 -text "git-gui - a graphical user interface for Git.
4563 $copyright" \
4564 -padx 5 -pady 5 \
4565 -justify left \
4566 -anchor w \
4567 -borderwidth 1 \
4568 -relief solid \
4569 -font font_ui
4570 pack $w.desc -side top -fill x -padx 5 -pady 5
4572 set v {}
4573 append v "git-gui version $appvers\n"
4574 append v "[git version]\n"
4575 append v "\n"
4576 if {$tcl_patchLevel eq $tk_patchLevel} {
4577 append v "Tcl/Tk version $tcl_patchLevel"
4578 } else {
4579 append v "Tcl version $tcl_patchLevel"
4580 append v ", Tk version $tk_patchLevel"
4583 label $w.vers \
4584 -text $v \
4585 -padx 5 -pady 5 \
4586 -justify left \
4587 -anchor w \
4588 -borderwidth 1 \
4589 -relief solid \
4590 -font font_ui
4591 pack $w.vers -side top -fill x -padx 5 -pady 5
4593 menu $w.ctxm -tearoff 0
4594 $w.ctxm add command \
4595 -label {Copy} \
4596 -font font_ui \
4597 -command "
4598 clipboard clear
4599 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4602 bind $w <Visibility> "grab $w; focus $w"
4603 bind $w <Key-Escape> "destroy $w"
4604 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4605 wm title $w "About [appname]"
4606 tkwait window $w
4609 proc do_options {} {
4610 global repo_config global_config font_descs
4611 global repo_config_new global_config_new
4613 array unset repo_config_new
4614 array unset global_config_new
4615 foreach name [array names repo_config] {
4616 set repo_config_new($name) $repo_config($name)
4618 load_config 1
4619 foreach name [array names repo_config] {
4620 switch -- $name {
4621 gui.diffcontext {continue}
4623 set repo_config_new($name) $repo_config($name)
4625 foreach name [array names global_config] {
4626 set global_config_new($name) $global_config($name)
4629 set w .options_editor
4630 toplevel $w
4631 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4633 label $w.header -text "Options" \
4634 -font font_uibold
4635 pack $w.header -side top -fill x
4637 frame $w.buttons
4638 button $w.buttons.restore -text {Restore Defaults} \
4639 -font font_ui \
4640 -command do_restore_defaults
4641 pack $w.buttons.restore -side left
4642 button $w.buttons.save -text Save \
4643 -font font_ui \
4644 -command [list do_save_config $w]
4645 pack $w.buttons.save -side right
4646 button $w.buttons.cancel -text {Cancel} \
4647 -font font_ui \
4648 -command [list destroy $w]
4649 pack $w.buttons.cancel -side right -padx 5
4650 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4652 labelframe $w.repo -text "[reponame] Repository" \
4653 -font font_ui
4654 labelframe $w.global -text {Global (All Repositories)} \
4655 -font font_ui
4656 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4657 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4659 set optid 0
4660 foreach option {
4661 {t user.name {User Name}}
4662 {t user.email {Email Address}}
4664 {b merge.summary {Summarize Merge Commits}}
4665 {i-1..5 merge.verbosity {Merge Verbosity}}
4667 {b gui.trustmtime {Trust File Modification Timestamps}}
4668 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4669 {t gui.newbranchtemplate {New Branch Name Template}}
4671 set type [lindex $option 0]
4672 set name [lindex $option 1]
4673 set text [lindex $option 2]
4674 incr optid
4675 foreach f {repo global} {
4676 switch -glob -- $type {
4678 checkbutton $w.$f.$optid -text $text \
4679 -variable ${f}_config_new($name) \
4680 -onvalue true \
4681 -offvalue false \
4682 -font font_ui
4683 pack $w.$f.$optid -side top -anchor w
4685 i-* {
4686 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4687 frame $w.$f.$optid
4688 label $w.$f.$optid.l -text "$text:" -font font_ui
4689 pack $w.$f.$optid.l -side left -anchor w -fill x
4690 spinbox $w.$f.$optid.v \
4691 -textvariable ${f}_config_new($name) \
4692 -from $min \
4693 -to $max \
4694 -increment 1 \
4695 -width [expr {1 + [string length $max]}] \
4696 -font font_ui
4697 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4698 pack $w.$f.$optid.v -side right -anchor e -padx 5
4699 pack $w.$f.$optid -side top -anchor w -fill x
4702 frame $w.$f.$optid
4703 label $w.$f.$optid.l -text "$text:" -font font_ui
4704 entry $w.$f.$optid.v \
4705 -borderwidth 1 \
4706 -relief sunken \
4707 -width 20 \
4708 -textvariable ${f}_config_new($name) \
4709 -font font_ui
4710 pack $w.$f.$optid.l -side left -anchor w
4711 pack $w.$f.$optid.v -side left -anchor w \
4712 -fill x -expand 1 \
4713 -padx 5
4714 pack $w.$f.$optid -side top -anchor w -fill x
4720 set all_fonts [lsort [font families]]
4721 foreach option $font_descs {
4722 set name [lindex $option 0]
4723 set font [lindex $option 1]
4724 set text [lindex $option 2]
4726 set global_config_new(gui.$font^^family) \
4727 [font configure $font -family]
4728 set global_config_new(gui.$font^^size) \
4729 [font configure $font -size]
4731 frame $w.global.$name
4732 label $w.global.$name.l -text "$text:" -font font_ui
4733 pack $w.global.$name.l -side left -anchor w -fill x
4734 eval tk_optionMenu $w.global.$name.family \
4735 global_config_new(gui.$font^^family) \
4736 $all_fonts
4737 spinbox $w.global.$name.size \
4738 -textvariable global_config_new(gui.$font^^size) \
4739 -from 2 -to 80 -increment 1 \
4740 -width 3 \
4741 -font font_ui
4742 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4743 pack $w.global.$name.size -side right -anchor e
4744 pack $w.global.$name.family -side right -anchor e
4745 pack $w.global.$name -side top -anchor w -fill x
4748 bind $w <Visibility> "grab $w; focus $w"
4749 bind $w <Key-Escape> "destroy $w"
4750 wm title $w "[appname] ([reponame]): Options"
4751 tkwait window $w
4754 proc do_restore_defaults {} {
4755 global font_descs default_config repo_config
4756 global repo_config_new global_config_new
4758 foreach name [array names default_config] {
4759 set repo_config_new($name) $default_config($name)
4760 set global_config_new($name) $default_config($name)
4763 foreach option $font_descs {
4764 set name [lindex $option 0]
4765 set repo_config(gui.$name) $default_config(gui.$name)
4767 apply_config
4769 foreach option $font_descs {
4770 set name [lindex $option 0]
4771 set font [lindex $option 1]
4772 set global_config_new(gui.$font^^family) \
4773 [font configure $font -family]
4774 set global_config_new(gui.$font^^size) \
4775 [font configure $font -size]
4779 proc do_save_config {w} {
4780 if {[catch {save_config} err]} {
4781 error_popup "Failed to completely save options:\n\n$err"
4783 reshow_diff
4784 destroy $w
4787 proc do_windows_shortcut {} {
4788 global argv0
4790 set fn [tk_getSaveFile \
4791 -parent . \
4792 -title "[appname] ([reponame]): Create Desktop Icon" \
4793 -initialfile "Git [reponame].bat"]
4794 if {$fn != {}} {
4795 if {[catch {
4796 set fd [open $fn w]
4797 puts $fd "@ECHO Entering [reponame]"
4798 puts $fd "@ECHO Starting git-gui... please wait..."
4799 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4800 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4801 puts -nonewline $fd "@\"[info nameofexecutable]\""
4802 puts $fd " \"[file normalize $argv0]\""
4803 close $fd
4804 } err]} {
4805 error_popup "Cannot write script:\n\n$err"
4810 proc do_cygwin_shortcut {} {
4811 global argv0
4813 if {[catch {
4814 set desktop [exec cygpath \
4815 --windows \
4816 --absolute \
4817 --long-name \
4818 --desktop]
4819 }]} {
4820 set desktop .
4822 set fn [tk_getSaveFile \
4823 -parent . \
4824 -title "[appname] ([reponame]): Create Desktop Icon" \
4825 -initialdir $desktop \
4826 -initialfile "Git [reponame].bat"]
4827 if {$fn != {}} {
4828 if {[catch {
4829 set fd [open $fn w]
4830 set sh [exec cygpath \
4831 --windows \
4832 --absolute \
4833 /bin/sh]
4834 set me [exec cygpath \
4835 --unix \
4836 --absolute \
4837 $argv0]
4838 set gd [exec cygpath \
4839 --unix \
4840 --absolute \
4841 [gitdir]]
4842 set gw [exec cygpath \
4843 --windows \
4844 --absolute \
4845 [file dirname [gitdir]]]
4846 regsub -all ' $me "'\\''" me
4847 regsub -all ' $gd "'\\''" gd
4848 puts $fd "@ECHO Entering $gw"
4849 puts $fd "@ECHO Starting git-gui... please wait..."
4850 puts -nonewline $fd "@\"$sh\" --login -c \""
4851 puts -nonewline $fd "GIT_DIR='$gd'"
4852 puts -nonewline $fd " '$me'"
4853 puts $fd "&\""
4854 close $fd
4855 } err]} {
4856 error_popup "Cannot write script:\n\n$err"
4861 proc do_macosx_app {} {
4862 global argv0 env
4864 set fn [tk_getSaveFile \
4865 -parent . \
4866 -title "[appname] ([reponame]): Create Desktop Icon" \
4867 -initialdir [file join $env(HOME) Desktop] \
4868 -initialfile "Git [reponame].app"]
4869 if {$fn != {}} {
4870 if {[catch {
4871 set Contents [file join $fn Contents]
4872 set MacOS [file join $Contents MacOS]
4873 set exe [file join $MacOS git-gui]
4875 file mkdir $MacOS
4877 set fd [open [file join $Contents Info.plist] w]
4878 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4879 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4880 <plist version="1.0">
4881 <dict>
4882 <key>CFBundleDevelopmentRegion</key>
4883 <string>English</string>
4884 <key>CFBundleExecutable</key>
4885 <string>git-gui</string>
4886 <key>CFBundleIdentifier</key>
4887 <string>org.spearce.git-gui</string>
4888 <key>CFBundleInfoDictionaryVersion</key>
4889 <string>6.0</string>
4890 <key>CFBundlePackageType</key>
4891 <string>APPL</string>
4892 <key>CFBundleSignature</key>
4893 <string>????</string>
4894 <key>CFBundleVersion</key>
4895 <string>1.0</string>
4896 <key>NSPrincipalClass</key>
4897 <string>NSApplication</string>
4898 </dict>
4899 </plist>}
4900 close $fd
4902 set fd [open $exe w]
4903 set gd [file normalize [gitdir]]
4904 set ep [file normalize [gitexec]]
4905 regsub -all ' $gd "'\\''" gd
4906 regsub -all ' $ep "'\\''" ep
4907 puts $fd "#!/bin/sh"
4908 foreach name [array names env] {
4909 if {[string match GIT_* $name]} {
4910 regsub -all ' $env($name) "'\\''" v
4911 puts $fd "export $name='$v'"
4914 puts $fd "export PATH='$ep':\$PATH"
4915 puts $fd "export GIT_DIR='$gd'"
4916 puts $fd "exec [file normalize $argv0]"
4917 close $fd
4919 file attributes $exe -permissions u+x,g+x,o+x
4920 } err]} {
4921 error_popup "Cannot write icon:\n\n$err"
4926 proc toggle_or_diff {w x y} {
4927 global file_states file_lists current_diff_path ui_index ui_workdir
4928 global last_clicked selected_paths
4930 set pos [split [$w index @$x,$y] .]
4931 set lno [lindex $pos 0]
4932 set col [lindex $pos 1]
4933 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4934 if {$path eq {}} {
4935 set last_clicked {}
4936 return
4939 set last_clicked [list $w $lno]
4940 array unset selected_paths
4941 $ui_index tag remove in_sel 0.0 end
4942 $ui_workdir tag remove in_sel 0.0 end
4944 if {$col == 0} {
4945 if {$current_diff_path eq $path} {
4946 set after {reshow_diff;}
4947 } else {
4948 set after {}
4950 if {$w eq $ui_index} {
4951 update_indexinfo \
4952 "Unstaging [short_path $path] from commit" \
4953 [list $path] \
4954 [concat $after {set ui_status_value {Ready.}}]
4955 } elseif {$w eq $ui_workdir} {
4956 update_index \
4957 "Adding [short_path $path]" \
4958 [list $path] \
4959 [concat $after {set ui_status_value {Ready.}}]
4961 } else {
4962 show_diff $path $w $lno
4966 proc add_one_to_selection {w x y} {
4967 global file_lists last_clicked selected_paths
4969 set lno [lindex [split [$w index @$x,$y] .] 0]
4970 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4971 if {$path eq {}} {
4972 set last_clicked {}
4973 return
4976 if {$last_clicked ne {}
4977 && [lindex $last_clicked 0] ne $w} {
4978 array unset selected_paths
4979 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4982 set last_clicked [list $w $lno]
4983 if {[catch {set in_sel $selected_paths($path)}]} {
4984 set in_sel 0
4986 if {$in_sel} {
4987 unset selected_paths($path)
4988 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4989 } else {
4990 set selected_paths($path) 1
4991 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4995 proc add_range_to_selection {w x y} {
4996 global file_lists last_clicked selected_paths
4998 if {[lindex $last_clicked 0] ne $w} {
4999 toggle_or_diff $w $x $y
5000 return
5003 set lno [lindex [split [$w index @$x,$y] .] 0]
5004 set lc [lindex $last_clicked 1]
5005 if {$lc < $lno} {
5006 set begin $lc
5007 set end $lno
5008 } else {
5009 set begin $lno
5010 set end $lc
5013 foreach path [lrange $file_lists($w) \
5014 [expr {$begin - 1}] \
5015 [expr {$end - 1}]] {
5016 set selected_paths($path) 1
5018 $w tag add in_sel $begin.0 [expr {$end + 1}].0
5021 ######################################################################
5023 ## config defaults
5025 set cursor_ptr arrow
5026 font create font_diff -family Courier -size 10
5027 font create font_ui
5028 catch {
5029 label .dummy
5030 eval font configure font_ui [font actual [.dummy cget -font]]
5031 destroy .dummy
5034 font create font_uibold
5035 font create font_diffbold
5037 if {[is_Windows]} {
5038 set M1B Control
5039 set M1T Ctrl
5040 } elseif {[is_MacOSX]} {
5041 set M1B M1
5042 set M1T Cmd
5043 } else {
5044 set M1B M1
5045 set M1T M1
5048 proc apply_config {} {
5049 global repo_config font_descs
5051 foreach option $font_descs {
5052 set name [lindex $option 0]
5053 set font [lindex $option 1]
5054 if {[catch {
5055 foreach {cn cv} $repo_config(gui.$name) {
5056 font configure $font $cn $cv
5058 } err]} {
5059 error_popup "Invalid font specified in gui.$name:\n\n$err"
5061 foreach {cn cv} [font configure $font] {
5062 font configure ${font}bold $cn $cv
5064 font configure ${font}bold -weight bold
5068 set default_config(merge.summary) false
5069 set default_config(merge.verbosity) 2
5070 set default_config(user.name) {}
5071 set default_config(user.email) {}
5073 set default_config(gui.trustmtime) false
5074 set default_config(gui.diffcontext) 5
5075 set default_config(gui.newbranchtemplate) {}
5076 set default_config(gui.fontui) [font configure font_ui]
5077 set default_config(gui.fontdiff) [font configure font_diff]
5078 set font_descs {
5079 {fontui font_ui {Main Font}}
5080 {fontdiff font_diff {Diff/Console Font}}
5082 load_config 0
5083 apply_config
5085 ######################################################################
5087 ## feature option selection
5089 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5090 unset _junk
5091 } else {
5092 set subcommand gui
5094 if {$subcommand eq {gui.sh}} {
5095 set subcommand gui
5097 if {$subcommand eq {gui} && [llength $argv] > 0} {
5098 set subcommand [lindex $argv 0]
5099 set argv [lrange $argv 1 end]
5102 enable_option multicommit
5103 enable_option branch
5104 enable_option transport
5106 switch -- $subcommand {
5107 --version -
5108 version -
5109 browser -
5110 blame {
5111 disable_option multicommit
5112 disable_option branch
5113 disable_option transport
5115 citool {
5116 enable_option singlecommit
5118 disable_option multicommit
5119 disable_option branch
5120 disable_option transport
5124 ######################################################################
5126 ## ui construction
5128 set ui_comm {}
5130 # -- Menu Bar
5132 menu .mbar -tearoff 0
5133 .mbar add cascade -label Repository -menu .mbar.repository
5134 .mbar add cascade -label Edit -menu .mbar.edit
5135 if {[is_enabled branch]} {
5136 .mbar add cascade -label Branch -menu .mbar.branch
5138 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5139 .mbar add cascade -label Commit -menu .mbar.commit
5141 if {[is_enabled transport]} {
5142 .mbar add cascade -label Merge -menu .mbar.merge
5143 .mbar add cascade -label Fetch -menu .mbar.fetch
5144 .mbar add cascade -label Push -menu .mbar.push
5146 . configure -menu .mbar
5148 # -- Repository Menu
5150 menu .mbar.repository
5152 .mbar.repository add command \
5153 -label {Browse Current Branch} \
5154 -command {new_browser $current_branch} \
5155 -font font_ui
5156 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5157 .mbar.repository add separator
5159 .mbar.repository add command \
5160 -label {Visualize Current Branch} \
5161 -command {do_gitk $current_branch} \
5162 -font font_ui
5163 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5164 .mbar.repository add command \
5165 -label {Visualize All Branches} \
5166 -command {do_gitk --all} \
5167 -font font_ui
5168 .mbar.repository add separator
5170 if {[is_enabled multicommit]} {
5171 .mbar.repository add command -label {Database Statistics} \
5172 -command do_stats \
5173 -font font_ui
5175 .mbar.repository add command -label {Compress Database} \
5176 -command do_gc \
5177 -font font_ui
5179 .mbar.repository add command -label {Verify Database} \
5180 -command do_fsck_objects \
5181 -font font_ui
5183 .mbar.repository add separator
5185 if {[is_Cygwin]} {
5186 .mbar.repository add command \
5187 -label {Create Desktop Icon} \
5188 -command do_cygwin_shortcut \
5189 -font font_ui
5190 } elseif {[is_Windows]} {
5191 .mbar.repository add command \
5192 -label {Create Desktop Icon} \
5193 -command do_windows_shortcut \
5194 -font font_ui
5195 } elseif {[is_MacOSX]} {
5196 .mbar.repository add command \
5197 -label {Create Desktop Icon} \
5198 -command do_macosx_app \
5199 -font font_ui
5203 .mbar.repository add command -label Quit \
5204 -command do_quit \
5205 -accelerator $M1T-Q \
5206 -font font_ui
5208 # -- Edit Menu
5210 menu .mbar.edit
5211 .mbar.edit add command -label Undo \
5212 -command {catch {[focus] edit undo}} \
5213 -accelerator $M1T-Z \
5214 -font font_ui
5215 .mbar.edit add command -label Redo \
5216 -command {catch {[focus] edit redo}} \
5217 -accelerator $M1T-Y \
5218 -font font_ui
5219 .mbar.edit add separator
5220 .mbar.edit add command -label Cut \
5221 -command {catch {tk_textCut [focus]}} \
5222 -accelerator $M1T-X \
5223 -font font_ui
5224 .mbar.edit add command -label Copy \
5225 -command {catch {tk_textCopy [focus]}} \
5226 -accelerator $M1T-C \
5227 -font font_ui
5228 .mbar.edit add command -label Paste \
5229 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5230 -accelerator $M1T-V \
5231 -font font_ui
5232 .mbar.edit add command -label Delete \
5233 -command {catch {[focus] delete sel.first sel.last}} \
5234 -accelerator Del \
5235 -font font_ui
5236 .mbar.edit add separator
5237 .mbar.edit add command -label {Select All} \
5238 -command {catch {[focus] tag add sel 0.0 end}} \
5239 -accelerator $M1T-A \
5240 -font font_ui
5242 # -- Branch Menu
5244 if {[is_enabled branch]} {
5245 menu .mbar.branch
5247 .mbar.branch add command -label {Create...} \
5248 -command do_create_branch \
5249 -accelerator $M1T-N \
5250 -font font_ui
5251 lappend disable_on_lock [list .mbar.branch entryconf \
5252 [.mbar.branch index last] -state]
5254 .mbar.branch add command -label {Delete...} \
5255 -command do_delete_branch \
5256 -font font_ui
5257 lappend disable_on_lock [list .mbar.branch entryconf \
5258 [.mbar.branch index last] -state]
5261 # -- Commit Menu
5263 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5264 menu .mbar.commit
5266 .mbar.commit add radiobutton \
5267 -label {New Commit} \
5268 -command do_select_commit_type \
5269 -variable selected_commit_type \
5270 -value new \
5271 -font font_ui
5272 lappend disable_on_lock \
5273 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5275 .mbar.commit add radiobutton \
5276 -label {Amend Last Commit} \
5277 -command do_select_commit_type \
5278 -variable selected_commit_type \
5279 -value amend \
5280 -font font_ui
5281 lappend disable_on_lock \
5282 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5284 .mbar.commit add separator
5286 .mbar.commit add command -label Rescan \
5287 -command do_rescan \
5288 -accelerator F5 \
5289 -font font_ui
5290 lappend disable_on_lock \
5291 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5293 .mbar.commit add command -label {Add To Commit} \
5294 -command do_add_selection \
5295 -font font_ui
5296 lappend disable_on_lock \
5297 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5299 .mbar.commit add command -label {Add Existing To Commit} \
5300 -command do_add_all \
5301 -accelerator $M1T-I \
5302 -font font_ui
5303 lappend disable_on_lock \
5304 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5306 .mbar.commit add command -label {Unstage From Commit} \
5307 -command do_unstage_selection \
5308 -font font_ui
5309 lappend disable_on_lock \
5310 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5312 .mbar.commit add command -label {Revert Changes} \
5313 -command do_revert_selection \
5314 -font font_ui
5315 lappend disable_on_lock \
5316 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5318 .mbar.commit add separator
5320 .mbar.commit add command -label {Sign Off} \
5321 -command do_signoff \
5322 -accelerator $M1T-S \
5323 -font font_ui
5325 .mbar.commit add command -label Commit \
5326 -command do_commit \
5327 -accelerator $M1T-Return \
5328 -font font_ui
5329 lappend disable_on_lock \
5330 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5333 if {[is_MacOSX]} {
5334 # -- Apple Menu (Mac OS X only)
5336 .mbar add cascade -label Apple -menu .mbar.apple
5337 menu .mbar.apple
5339 .mbar.apple add command -label "About [appname]" \
5340 -command do_about \
5341 -font font_ui
5342 .mbar.apple add command -label "Options..." \
5343 -command do_options \
5344 -font font_ui
5345 } else {
5346 # -- Edit Menu
5348 .mbar.edit add separator
5349 .mbar.edit add command -label {Options...} \
5350 -command do_options \
5351 -font font_ui
5353 # -- Tools Menu
5355 if {[file exists /usr/local/miga/lib/gui-miga]
5356 && [file exists .pvcsrc]} {
5357 proc do_miga {} {
5358 global ui_status_value
5359 if {![lock_index update]} return
5360 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5361 set miga_fd [open "|$cmd" r]
5362 fconfigure $miga_fd -blocking 0
5363 fileevent $miga_fd readable [list miga_done $miga_fd]
5364 set ui_status_value {Running miga...}
5366 proc miga_done {fd} {
5367 read $fd 512
5368 if {[eof $fd]} {
5369 close $fd
5370 unlock_index
5371 rescan [list set ui_status_value {Ready.}]
5374 .mbar add cascade -label Tools -menu .mbar.tools
5375 menu .mbar.tools
5376 .mbar.tools add command -label "Migrate" \
5377 -command do_miga \
5378 -font font_ui
5379 lappend disable_on_lock \
5380 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5384 # -- Help Menu
5386 .mbar add cascade -label Help -menu .mbar.help
5387 menu .mbar.help
5389 if {![is_MacOSX]} {
5390 .mbar.help add command -label "About [appname]" \
5391 -command do_about \
5392 -font font_ui
5395 set browser {}
5396 catch {set browser $repo_config(instaweb.browser)}
5397 set doc_path [file dirname [gitexec]]
5398 set doc_path [file join $doc_path Documentation index.html]
5400 if {[is_Cygwin]} {
5401 set doc_path [exec cygpath --mixed $doc_path]
5404 if {$browser eq {}} {
5405 if {[is_MacOSX]} {
5406 set browser open
5407 } elseif {[is_Cygwin]} {
5408 set program_files [file dirname [exec cygpath --windir]]
5409 set program_files [file join $program_files {Program Files}]
5410 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5411 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5412 if {[file exists $firefox]} {
5413 set browser $firefox
5414 } elseif {[file exists $ie]} {
5415 set browser $ie
5417 unset program_files firefox ie
5421 if {[file isfile $doc_path]} {
5422 set doc_url "file:$doc_path"
5423 } else {
5424 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5427 if {$browser ne {}} {
5428 .mbar.help add command -label {Online Documentation} \
5429 -command [list exec $browser $doc_url &] \
5430 -font font_ui
5432 unset browser doc_path doc_url
5434 # -- Standard bindings
5436 bind . <Destroy> do_quit
5437 bind all <$M1B-Key-q> do_quit
5438 bind all <$M1B-Key-Q> do_quit
5439 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5440 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5442 # -- Not a normal commit type invocation? Do that instead!
5444 switch -- $subcommand {
5445 --version -
5446 version {
5447 puts "git-gui version $appvers"
5448 exit
5450 browser {
5451 if {[llength $argv] != 1} {
5452 puts stderr "usage: $argv0 browser commit"
5453 exit 1
5455 set current_branch [lindex $argv 0]
5456 new_browser $current_branch
5457 return
5459 blame {
5460 if {[llength $argv] != 2} {
5461 puts stderr "usage: $argv0 blame commit path"
5462 exit 1
5464 set current_branch [lindex $argv 0]
5465 show_blame $current_branch [lindex $argv 1]
5466 return
5468 citool -
5469 gui {
5470 if {[llength $argv] != 0} {
5471 puts -nonewline stderr "usage: $argv0"
5472 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5473 puts -nonewline stderr " $subcommand"
5475 puts stderr {}
5476 exit 1
5478 # fall through to setup UI for commits
5480 default {
5481 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
5482 exit 1
5486 # -- Branch Control
5488 frame .branch \
5489 -borderwidth 1 \
5490 -relief sunken
5491 label .branch.l1 \
5492 -text {Current Branch:} \
5493 -anchor w \
5494 -justify left \
5495 -font font_ui
5496 label .branch.cb \
5497 -textvariable current_branch \
5498 -anchor w \
5499 -justify left \
5500 -font font_ui
5501 pack .branch.l1 -side left
5502 pack .branch.cb -side left -fill x
5503 pack .branch -side top -fill x
5505 if {[is_enabled branch]} {
5506 menu .mbar.merge
5507 .mbar.merge add command -label {Local Merge...} \
5508 -command do_local_merge \
5509 -font font_ui
5510 lappend disable_on_lock \
5511 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5512 .mbar.merge add command -label {Abort Merge...} \
5513 -command do_reset_hard \
5514 -font font_ui
5515 lappend disable_on_lock \
5516 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5519 menu .mbar.fetch
5521 menu .mbar.push
5522 .mbar.push add command -label {Push...} \
5523 -command do_push_anywhere \
5524 -font font_ui
5527 # -- Main Window Layout
5529 panedwindow .vpane -orient vertical
5530 panedwindow .vpane.files -orient horizontal
5531 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5532 pack .vpane -anchor n -side top -fill both -expand 1
5534 # -- Index File List
5536 frame .vpane.files.index -height 100 -width 200
5537 label .vpane.files.index.title -text {Changes To Be Committed} \
5538 -background green \
5539 -font font_ui
5540 text $ui_index -background white -borderwidth 0 \
5541 -width 20 -height 10 \
5542 -wrap none \
5543 -font font_ui \
5544 -cursor $cursor_ptr \
5545 -xscrollcommand {.vpane.files.index.sx set} \
5546 -yscrollcommand {.vpane.files.index.sy set} \
5547 -state disabled
5548 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5549 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5550 pack .vpane.files.index.title -side top -fill x
5551 pack .vpane.files.index.sx -side bottom -fill x
5552 pack .vpane.files.index.sy -side right -fill y
5553 pack $ui_index -side left -fill both -expand 1
5554 .vpane.files add .vpane.files.index -sticky nsew
5556 # -- Working Directory File List
5558 frame .vpane.files.workdir -height 100 -width 200
5559 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5560 -background red \
5561 -font font_ui
5562 text $ui_workdir -background white -borderwidth 0 \
5563 -width 20 -height 10 \
5564 -wrap none \
5565 -font font_ui \
5566 -cursor $cursor_ptr \
5567 -xscrollcommand {.vpane.files.workdir.sx set} \
5568 -yscrollcommand {.vpane.files.workdir.sy set} \
5569 -state disabled
5570 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5571 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5572 pack .vpane.files.workdir.title -side top -fill x
5573 pack .vpane.files.workdir.sx -side bottom -fill x
5574 pack .vpane.files.workdir.sy -side right -fill y
5575 pack $ui_workdir -side left -fill both -expand 1
5576 .vpane.files add .vpane.files.workdir -sticky nsew
5578 foreach i [list $ui_index $ui_workdir] {
5579 $i tag conf in_diff -font font_uibold
5580 $i tag conf in_sel \
5581 -background [$i cget -foreground] \
5582 -foreground [$i cget -background]
5584 unset i
5586 # -- Diff and Commit Area
5588 frame .vpane.lower -height 300 -width 400
5589 frame .vpane.lower.commarea
5590 frame .vpane.lower.diff -relief sunken -borderwidth 1
5591 pack .vpane.lower.commarea -side top -fill x
5592 pack .vpane.lower.diff -side bottom -fill both -expand 1
5593 .vpane add .vpane.lower -sticky nsew
5595 # -- Commit Area Buttons
5597 frame .vpane.lower.commarea.buttons
5598 label .vpane.lower.commarea.buttons.l -text {} \
5599 -anchor w \
5600 -justify left \
5601 -font font_ui
5602 pack .vpane.lower.commarea.buttons.l -side top -fill x
5603 pack .vpane.lower.commarea.buttons -side left -fill y
5605 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5606 -command do_rescan \
5607 -font font_ui
5608 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5609 lappend disable_on_lock \
5610 {.vpane.lower.commarea.buttons.rescan conf -state}
5612 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5613 -command do_add_all \
5614 -font font_ui
5615 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5616 lappend disable_on_lock \
5617 {.vpane.lower.commarea.buttons.incall conf -state}
5619 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5620 -command do_signoff \
5621 -font font_ui
5622 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5624 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5625 -command do_commit \
5626 -font font_ui
5627 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5628 lappend disable_on_lock \
5629 {.vpane.lower.commarea.buttons.commit conf -state}
5631 # -- Commit Message Buffer
5633 frame .vpane.lower.commarea.buffer
5634 frame .vpane.lower.commarea.buffer.header
5635 set ui_comm .vpane.lower.commarea.buffer.t
5636 set ui_coml .vpane.lower.commarea.buffer.header.l
5637 radiobutton .vpane.lower.commarea.buffer.header.new \
5638 -text {New Commit} \
5639 -command do_select_commit_type \
5640 -variable selected_commit_type \
5641 -value new \
5642 -font font_ui
5643 lappend disable_on_lock \
5644 [list .vpane.lower.commarea.buffer.header.new conf -state]
5645 radiobutton .vpane.lower.commarea.buffer.header.amend \
5646 -text {Amend Last Commit} \
5647 -command do_select_commit_type \
5648 -variable selected_commit_type \
5649 -value amend \
5650 -font font_ui
5651 lappend disable_on_lock \
5652 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5653 label $ui_coml \
5654 -anchor w \
5655 -justify left \
5656 -font font_ui
5657 proc trace_commit_type {varname args} {
5658 global ui_coml commit_type
5659 switch -glob -- $commit_type {
5660 initial {set txt {Initial Commit Message:}}
5661 amend {set txt {Amended Commit Message:}}
5662 amend-initial {set txt {Amended Initial Commit Message:}}
5663 amend-merge {set txt {Amended Merge Commit Message:}}
5664 merge {set txt {Merge Commit Message:}}
5665 * {set txt {Commit Message:}}
5667 $ui_coml conf -text $txt
5669 trace add variable commit_type write trace_commit_type
5670 pack $ui_coml -side left -fill x
5671 pack .vpane.lower.commarea.buffer.header.amend -side right
5672 pack .vpane.lower.commarea.buffer.header.new -side right
5674 text $ui_comm -background white -borderwidth 1 \
5675 -undo true \
5676 -maxundo 20 \
5677 -autoseparators true \
5678 -relief sunken \
5679 -width 75 -height 9 -wrap none \
5680 -font font_diff \
5681 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5682 scrollbar .vpane.lower.commarea.buffer.sby \
5683 -command [list $ui_comm yview]
5684 pack .vpane.lower.commarea.buffer.header -side top -fill x
5685 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5686 pack $ui_comm -side left -fill y
5687 pack .vpane.lower.commarea.buffer -side left -fill y
5689 # -- Commit Message Buffer Context Menu
5691 set ctxm .vpane.lower.commarea.buffer.ctxm
5692 menu $ctxm -tearoff 0
5693 $ctxm add command \
5694 -label {Cut} \
5695 -font font_ui \
5696 -command {tk_textCut $ui_comm}
5697 $ctxm add command \
5698 -label {Copy} \
5699 -font font_ui \
5700 -command {tk_textCopy $ui_comm}
5701 $ctxm add command \
5702 -label {Paste} \
5703 -font font_ui \
5704 -command {tk_textPaste $ui_comm}
5705 $ctxm add command \
5706 -label {Delete} \
5707 -font font_ui \
5708 -command {$ui_comm delete sel.first sel.last}
5709 $ctxm add separator
5710 $ctxm add command \
5711 -label {Select All} \
5712 -font font_ui \
5713 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5714 $ctxm add command \
5715 -label {Copy All} \
5716 -font font_ui \
5717 -command {
5718 $ui_comm tag add sel 0.0 end
5719 tk_textCopy $ui_comm
5720 $ui_comm tag remove sel 0.0 end
5722 $ctxm add separator
5723 $ctxm add command \
5724 -label {Sign Off} \
5725 -font font_ui \
5726 -command do_signoff
5727 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5729 # -- Diff Header
5731 proc trace_current_diff_path {varname args} {
5732 global current_diff_path diff_actions file_states
5733 if {$current_diff_path eq {}} {
5734 set s {}
5735 set f {}
5736 set p {}
5737 set o disabled
5738 } else {
5739 set p $current_diff_path
5740 set s [mapdesc [lindex $file_states($p) 0] $p]
5741 set f {File:}
5742 set p [escape_path $p]
5743 set o normal
5746 .vpane.lower.diff.header.status configure -text $s
5747 .vpane.lower.diff.header.file configure -text $f
5748 .vpane.lower.diff.header.path configure -text $p
5749 foreach w $diff_actions {
5750 uplevel #0 $w $o
5753 trace add variable current_diff_path write trace_current_diff_path
5755 frame .vpane.lower.diff.header -background orange
5756 label .vpane.lower.diff.header.status \
5757 -background orange \
5758 -width $max_status_desc \
5759 -anchor w \
5760 -justify left \
5761 -font font_ui
5762 label .vpane.lower.diff.header.file \
5763 -background orange \
5764 -anchor w \
5765 -justify left \
5766 -font font_ui
5767 label .vpane.lower.diff.header.path \
5768 -background orange \
5769 -anchor w \
5770 -justify left \
5771 -font font_ui
5772 pack .vpane.lower.diff.header.status -side left
5773 pack .vpane.lower.diff.header.file -side left
5774 pack .vpane.lower.diff.header.path -fill x
5775 set ctxm .vpane.lower.diff.header.ctxm
5776 menu $ctxm -tearoff 0
5777 $ctxm add command \
5778 -label {Copy} \
5779 -font font_ui \
5780 -command {
5781 clipboard clear
5782 clipboard append \
5783 -format STRING \
5784 -type STRING \
5785 -- $current_diff_path
5787 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5788 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5790 # -- Diff Body
5792 frame .vpane.lower.diff.body
5793 set ui_diff .vpane.lower.diff.body.t
5794 text $ui_diff -background white -borderwidth 0 \
5795 -width 80 -height 15 -wrap none \
5796 -font font_diff \
5797 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5798 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5799 -state disabled
5800 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5801 -command [list $ui_diff xview]
5802 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5803 -command [list $ui_diff yview]
5804 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5805 pack .vpane.lower.diff.body.sby -side right -fill y
5806 pack $ui_diff -side left -fill both -expand 1
5807 pack .vpane.lower.diff.header -side top -fill x
5808 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5810 $ui_diff tag conf d_cr -elide true
5811 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5812 $ui_diff tag conf d_+ -foreground {#00a000}
5813 $ui_diff tag conf d_- -foreground red
5815 $ui_diff tag conf d_++ -foreground {#00a000}
5816 $ui_diff tag conf d_-- -foreground red
5817 $ui_diff tag conf d_+s \
5818 -foreground {#00a000} \
5819 -background {#e2effa}
5820 $ui_diff tag conf d_-s \
5821 -foreground red \
5822 -background {#e2effa}
5823 $ui_diff tag conf d_s+ \
5824 -foreground {#00a000} \
5825 -background ivory1
5826 $ui_diff tag conf d_s- \
5827 -foreground red \
5828 -background ivory1
5830 $ui_diff tag conf d<<<<<<< \
5831 -foreground orange \
5832 -font font_diffbold
5833 $ui_diff tag conf d======= \
5834 -foreground orange \
5835 -font font_diffbold
5836 $ui_diff tag conf d>>>>>>> \
5837 -foreground orange \
5838 -font font_diffbold
5840 $ui_diff tag raise sel
5842 # -- Diff Body Context Menu
5844 set ctxm .vpane.lower.diff.body.ctxm
5845 menu $ctxm -tearoff 0
5846 $ctxm add command \
5847 -label {Refresh} \
5848 -font font_ui \
5849 -command reshow_diff
5850 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5851 $ctxm add command \
5852 -label {Copy} \
5853 -font font_ui \
5854 -command {tk_textCopy $ui_diff}
5855 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5856 $ctxm add command \
5857 -label {Select All} \
5858 -font font_ui \
5859 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5860 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5861 $ctxm add command \
5862 -label {Copy All} \
5863 -font font_ui \
5864 -command {
5865 $ui_diff tag add sel 0.0 end
5866 tk_textCopy $ui_diff
5867 $ui_diff tag remove sel 0.0 end
5869 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5870 $ctxm add separator
5871 $ctxm add command \
5872 -label {Apply/Reverse Hunk} \
5873 -font font_ui \
5874 -command {apply_hunk $cursorX $cursorY}
5875 set ui_diff_applyhunk [$ctxm index last]
5876 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5877 $ctxm add separator
5878 $ctxm add command \
5879 -label {Decrease Font Size} \
5880 -font font_ui \
5881 -command {incr_font_size font_diff -1}
5882 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5883 $ctxm add command \
5884 -label {Increase Font Size} \
5885 -font font_ui \
5886 -command {incr_font_size font_diff 1}
5887 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5888 $ctxm add separator
5889 $ctxm add command \
5890 -label {Show Less Context} \
5891 -font font_ui \
5892 -command {if {$repo_config(gui.diffcontext) >= 2} {
5893 incr repo_config(gui.diffcontext) -1
5894 reshow_diff
5896 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5897 $ctxm add command \
5898 -label {Show More Context} \
5899 -font font_ui \
5900 -command {
5901 incr repo_config(gui.diffcontext)
5902 reshow_diff
5904 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5905 $ctxm add separator
5906 $ctxm add command -label {Options...} \
5907 -font font_ui \
5908 -command do_options
5909 bind_button3 $ui_diff "
5910 set cursorX %x
5911 set cursorY %y
5912 if {\$ui_index eq \$current_diff_side} {
5913 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5914 } else {
5915 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5917 tk_popup $ctxm %X %Y
5919 unset ui_diff_applyhunk
5921 # -- Status Bar
5923 label .status -textvariable ui_status_value \
5924 -anchor w \
5925 -justify left \
5926 -borderwidth 1 \
5927 -relief sunken \
5928 -font font_ui
5929 pack .status -anchor w -side bottom -fill x
5931 # -- Load geometry
5933 catch {
5934 set gm $repo_config(gui.geometry)
5935 wm geometry . [lindex $gm 0]
5936 .vpane sash place 0 \
5937 [lindex [.vpane sash coord 0] 0] \
5938 [lindex $gm 1]
5939 .vpane.files sash place 0 \
5940 [lindex $gm 2] \
5941 [lindex [.vpane.files sash coord 0] 1]
5942 unset gm
5945 # -- Key Bindings
5947 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5948 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5949 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5950 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5951 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5952 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5953 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5954 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5955 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5956 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5957 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5959 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5960 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5961 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5962 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5963 bind $ui_diff <$M1B-Key-v> {break}
5964 bind $ui_diff <$M1B-Key-V> {break}
5965 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5966 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5967 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5968 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5969 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5970 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5971 bind $ui_diff <Button-1> {focus %W}
5973 if {[is_enabled branch]} {
5974 bind . <$M1B-Key-n> do_create_branch
5975 bind . <$M1B-Key-N> do_create_branch
5978 bind all <Key-F5> do_rescan
5979 bind all <$M1B-Key-r> do_rescan
5980 bind all <$M1B-Key-R> do_rescan
5981 bind . <$M1B-Key-s> do_signoff
5982 bind . <$M1B-Key-S> do_signoff
5983 bind . <$M1B-Key-i> do_add_all
5984 bind . <$M1B-Key-I> do_add_all
5985 bind . <$M1B-Key-Return> do_commit
5986 foreach i [list $ui_index $ui_workdir] {
5987 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
5988 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5989 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5991 unset i
5993 set file_lists($ui_index) [list]
5994 set file_lists($ui_workdir) [list]
5996 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5997 focus -force $ui_comm
5999 # -- Warn the user about environmental problems. Cygwin's Tcl
6000 # does *not* pass its env array onto any processes it spawns.
6001 # This means that git processes get none of our environment.
6003 if {[is_Cygwin]} {
6004 set ignored_env 0
6005 set suggest_user {}
6006 set msg "Possible environment issues exist.
6008 The following environment variables are probably
6009 going to be ignored by any Git subprocess run
6010 by [appname]:
6013 foreach name [array names env] {
6014 switch -regexp -- $name {
6015 {^GIT_INDEX_FILE$} -
6016 {^GIT_OBJECT_DIRECTORY$} -
6017 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
6018 {^GIT_DIFF_OPTS$} -
6019 {^GIT_EXTERNAL_DIFF$} -
6020 {^GIT_PAGER$} -
6021 {^GIT_TRACE$} -
6022 {^GIT_CONFIG$} -
6023 {^GIT_CONFIG_LOCAL$} -
6024 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
6025 append msg " - $name\n"
6026 incr ignored_env
6028 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
6029 append msg " - $name\n"
6030 incr ignored_env
6031 set suggest_user $name
6035 if {$ignored_env > 0} {
6036 append msg "
6037 This is due to a known issue with the
6038 Tcl binary distributed by Cygwin."
6040 if {$suggest_user ne {}} {
6041 append msg "
6043 A good replacement for $suggest_user
6044 is placing values for the user.name and
6045 user.email settings into your personal
6046 ~/.gitconfig file.
6049 warn_popup $msg
6051 unset ignored_env msg suggest_user name
6054 # -- Only initialize complex UI if we are going to stay running.
6056 if {[is_enabled transport]} {
6057 load_all_remotes
6058 load_all_heads
6060 populate_branch_menu
6061 populate_fetch_menu
6062 populate_push_menu
6065 # -- Only suggest a gc run if we are going to stay running.
6067 if {[is_enabled multicommit]} {
6068 set object_limit 2000
6069 if {[is_Windows]} {set object_limit 200}
6070 regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
6071 if {$objects_current >= $object_limit} {
6072 if {[ask_popup \
6073 "This repository currently has $objects_current loose objects.
6075 To maintain optimal performance it is strongly
6076 recommended that you compress the database
6077 when more than $object_limit loose objects exist.
6079 Compress the database now?"] eq yes} {
6080 do_gc
6083 unset object_limit _junk objects_current
6086 lock_index begin-read
6087 after 1 do_rescan