git-gui: Refactor 'exec git subcmd' idiom.
[git/gitweb.git] / git-gui.sh
blob7ecb98b900576ed6abc8b4e4af4333a209769ba6
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, Paul Mackerras.
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
23 ######################################################################
25 ## read only globals
27 set _appname [lindex [file split $argv0] end]
28 set _gitdir {}
29 set _gitexec {}
30 set _reponame {}
31 set _iscygwin {}
33 proc appname {} {
34 global _appname
35 return $_appname
38 proc gitdir {args} {
39 global _gitdir
40 if {$args eq {}} {
41 return $_gitdir
43 return [eval [concat [list file join $_gitdir] $args]]
46 proc gitexec {args} {
47 global _gitexec
48 if {$_gitexec eq {}} {
49 if {[catch {set _gitexec [git --exec-path]} err]} {
50 error "Git not installed?\n\n$err"
53 if {$args eq {}} {
54 return $_gitexec
56 return [eval [concat [list file join $_gitexec] $args]]
59 proc reponame {} {
60 global _reponame
61 return $_reponame
64 proc is_MacOSX {} {
65 global tcl_platform tk_library
66 if {[tk windowingsystem] eq {aqua}} {
67 return 1
69 return 0
72 proc is_Windows {} {
73 global tcl_platform
74 if {$tcl_platform(platform) eq {windows}} {
75 return 1
77 return 0
80 proc is_Cygwin {} {
81 global tcl_platform _iscygwin
82 if {$_iscygwin eq {}} {
83 if {$tcl_platform(platform) eq {windows}} {
84 if {[catch {set p [exec cygpath --windir]} err]} {
85 set _iscygwin 0
86 } else {
87 set _iscygwin 1
89 } else {
90 set _iscygwin 0
93 return $_iscygwin
96 proc is_enabled {option} {
97 global enabled_options
98 if {[catch {set on $enabled_options($option)}]} {return 0}
99 return $on
102 proc enable_option {option} {
103 global enabled_options
104 set enabled_options($option) 1
107 proc disable_option {option} {
108 global enabled_options
109 set enabled_options($option) 0
112 ######################################################################
114 ## config
116 proc is_many_config {name} {
117 switch -glob -- $name {
118 remote.*.fetch -
119 remote.*.push
120 {return 1}
122 {return 0}
126 proc is_config_true {name} {
127 global repo_config
128 if {[catch {set v $repo_config($name)}]} {
129 return 0
130 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
131 return 1
132 } else {
133 return 0
137 proc load_config {include_global} {
138 global repo_config global_config default_config
140 array unset global_config
141 if {$include_global} {
142 catch {
143 set fd_rc [open "| git config --global --list" r]
144 while {[gets $fd_rc line] >= 0} {
145 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
146 if {[is_many_config $name]} {
147 lappend global_config($name) $value
148 } else {
149 set global_config($name) $value
153 close $fd_rc
157 array unset repo_config
158 catch {
159 set fd_rc [open "| git config --list" r]
160 while {[gets $fd_rc line] >= 0} {
161 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
162 if {[is_many_config $name]} {
163 lappend repo_config($name) $value
164 } else {
165 set repo_config($name) $value
169 close $fd_rc
172 foreach name [array names default_config] {
173 if {[catch {set v $global_config($name)}]} {
174 set global_config($name) $default_config($name)
176 if {[catch {set v $repo_config($name)}]} {
177 set repo_config($name) $default_config($name)
182 proc save_config {} {
183 global default_config font_descs
184 global repo_config global_config
185 global repo_config_new global_config_new
187 foreach option $font_descs {
188 set name [lindex $option 0]
189 set font [lindex $option 1]
190 font configure $font \
191 -family $global_config_new(gui.$font^^family) \
192 -size $global_config_new(gui.$font^^size)
193 font configure ${font}bold \
194 -family $global_config_new(gui.$font^^family) \
195 -size $global_config_new(gui.$font^^size)
196 set global_config_new(gui.$name) [font configure $font]
197 unset global_config_new(gui.$font^^family)
198 unset global_config_new(gui.$font^^size)
201 foreach name [array names default_config] {
202 set value $global_config_new($name)
203 if {$value ne $global_config($name)} {
204 if {$value eq $default_config($name)} {
205 catch {git config --global --unset $name}
206 } else {
207 regsub -all "\[{}\]" $value {"} value
208 git config --global $name $value
210 set global_config($name) $value
211 if {$value eq $repo_config($name)} {
212 catch {git config --unset $name}
213 set repo_config($name) $value
218 foreach name [array names default_config] {
219 set value $repo_config_new($name)
220 if {$value ne $repo_config($name)} {
221 if {$value eq $global_config($name)} {
222 catch {git config --unset $name}
223 } else {
224 regsub -all "\[{}\]" $value {"} value
225 git config $name $value
227 set repo_config($name) $value
232 ######################################################################
234 ## handy utils
236 proc git {args} {
237 return [eval exec git $args]
240 proc error_popup {msg} {
241 set title [appname]
242 if {[reponame] ne {}} {
243 append title " ([reponame])"
245 set cmd [list tk_messageBox \
246 -icon error \
247 -type ok \
248 -title "$title: error" \
249 -message $msg]
250 if {[winfo ismapped .]} {
251 lappend cmd -parent .
253 eval $cmd
256 proc warn_popup {msg} {
257 set title [appname]
258 if {[reponame] ne {}} {
259 append title " ([reponame])"
261 set cmd [list tk_messageBox \
262 -icon warning \
263 -type ok \
264 -title "$title: warning" \
265 -message $msg]
266 if {[winfo ismapped .]} {
267 lappend cmd -parent .
269 eval $cmd
272 proc info_popup {msg {parent .}} {
273 set title [appname]
274 if {[reponame] ne {}} {
275 append title " ([reponame])"
277 tk_messageBox \
278 -parent $parent \
279 -icon info \
280 -type ok \
281 -title $title \
282 -message $msg
285 proc ask_popup {msg} {
286 set title [appname]
287 if {[reponame] ne {}} {
288 append title " ([reponame])"
290 return [tk_messageBox \
291 -parent . \
292 -icon question \
293 -type yesno \
294 -title $title \
295 -message $msg]
298 ######################################################################
300 ## repository setup
302 if { [catch {set _gitdir $env(GIT_DIR)}]
303 && [catch {set _gitdir [git rev-parse --git-dir]} err]} {
304 catch {wm withdraw .}
305 error_popup "Cannot find the git directory:\n\n$err"
306 exit 1
308 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
309 catch {set _gitdir [exec cygpath --unix $_gitdir]}
311 if {![file isdirectory $_gitdir]} {
312 catch {wm withdraw .}
313 error_popup "Git directory not found:\n\n$_gitdir"
314 exit 1
316 if {[lindex [file split $_gitdir] end] ne {.git}} {
317 catch {wm withdraw .}
318 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
319 exit 1
321 if {[catch {cd [file dirname $_gitdir]} err]} {
322 catch {wm withdraw .}
323 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
324 exit 1
326 set _reponame [lindex [file split \
327 [file normalize [file dirname $_gitdir]]] \
328 end]
330 ######################################################################
332 ## task management
334 set rescan_active 0
335 set diff_active 0
336 set last_clicked {}
338 set disable_on_lock [list]
339 set index_lock_type none
341 proc lock_index {type} {
342 global index_lock_type disable_on_lock
344 if {$index_lock_type eq {none}} {
345 set index_lock_type $type
346 foreach w $disable_on_lock {
347 uplevel #0 $w disabled
349 return 1
350 } elseif {$index_lock_type eq "begin-$type"} {
351 set index_lock_type $type
352 return 1
354 return 0
357 proc unlock_index {} {
358 global index_lock_type disable_on_lock
360 set index_lock_type none
361 foreach w $disable_on_lock {
362 uplevel #0 $w normal
366 ######################################################################
368 ## status
370 proc repository_state {ctvar hdvar mhvar} {
371 global current_branch
372 upvar $ctvar ct $hdvar hd $mhvar mh
374 set mh [list]
376 if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
377 set current_branch {}
378 } else {
379 regsub ^refs/((heads|tags|remotes)/)? \
380 $current_branch \
381 {} \
382 current_branch
385 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
386 set hd {}
387 set ct initial
388 return
391 set merge_head [gitdir MERGE_HEAD]
392 if {[file exists $merge_head]} {
393 set ct merge
394 set fd_mh [open $merge_head r]
395 while {[gets $fd_mh line] >= 0} {
396 lappend mh $line
398 close $fd_mh
399 return
402 set ct normal
405 proc PARENT {} {
406 global PARENT empty_tree
408 set p [lindex $PARENT 0]
409 if {$p ne {}} {
410 return $p
412 if {$empty_tree eq {}} {
413 set empty_tree [git mktree << {}]
415 return $empty_tree
418 proc rescan {after {honor_trustmtime 1}} {
419 global HEAD PARENT MERGE_HEAD commit_type
420 global ui_index ui_workdir ui_status_value ui_comm
421 global rescan_active file_states
422 global repo_config
424 if {$rescan_active > 0 || ![lock_index read]} return
426 repository_state newType newHEAD newMERGE_HEAD
427 if {[string match amend* $commit_type]
428 && $newType eq {normal}
429 && $newHEAD eq $HEAD} {
430 } else {
431 set HEAD $newHEAD
432 set PARENT $newHEAD
433 set MERGE_HEAD $newMERGE_HEAD
434 set commit_type $newType
437 array unset file_states
439 if {![$ui_comm edit modified]
440 || [string trim [$ui_comm get 0.0 end]] eq {}} {
441 if {[load_message GITGUI_MSG]} {
442 } elseif {[load_message MERGE_MSG]} {
443 } elseif {[load_message SQUASH_MSG]} {
445 $ui_comm edit reset
446 $ui_comm edit modified false
449 if {[is_enabled branch]} {
450 load_all_heads
451 populate_branch_menu
454 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
455 rescan_stage2 {} $after
456 } else {
457 set rescan_active 1
458 set ui_status_value {Refreshing file status...}
459 set cmd [list git update-index]
460 lappend cmd -q
461 lappend cmd --unmerged
462 lappend cmd --ignore-missing
463 lappend cmd --refresh
464 set fd_rf [open "| $cmd" r]
465 fconfigure $fd_rf -blocking 0 -translation binary
466 fileevent $fd_rf readable \
467 [list rescan_stage2 $fd_rf $after]
471 proc rescan_stage2 {fd after} {
472 global ui_status_value
473 global rescan_active buf_rdi buf_rdf buf_rlo
475 if {$fd ne {}} {
476 read $fd
477 if {![eof $fd]} return
478 close $fd
481 set ls_others [list | git ls-files --others -z \
482 --exclude-per-directory=.gitignore]
483 set info_exclude [gitdir info exclude]
484 if {[file readable $info_exclude]} {
485 lappend ls_others "--exclude-from=$info_exclude"
488 set buf_rdi {}
489 set buf_rdf {}
490 set buf_rlo {}
492 set rescan_active 3
493 set ui_status_value {Scanning for modified files ...}
494 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
495 set fd_df [open "| git diff-files -z" r]
496 set fd_lo [open $ls_others r]
498 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
499 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
500 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
501 fileevent $fd_di readable [list read_diff_index $fd_di $after]
502 fileevent $fd_df readable [list read_diff_files $fd_df $after]
503 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
506 proc load_message {file} {
507 global ui_comm
509 set f [gitdir $file]
510 if {[file isfile $f]} {
511 if {[catch {set fd [open $f r]}]} {
512 return 0
514 set content [string trim [read $fd]]
515 close $fd
516 regsub -all -line {[ \r\t]+$} $content {} content
517 $ui_comm delete 0.0 end
518 $ui_comm insert end $content
519 return 1
521 return 0
524 proc read_diff_index {fd after} {
525 global buf_rdi
527 append buf_rdi [read $fd]
528 set c 0
529 set n [string length $buf_rdi]
530 while {$c < $n} {
531 set z1 [string first "\0" $buf_rdi $c]
532 if {$z1 == -1} break
533 incr z1
534 set z2 [string first "\0" $buf_rdi $z1]
535 if {$z2 == -1} break
537 incr c
538 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
539 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
540 merge_state \
541 [encoding convertfrom $p] \
542 [lindex $i 4]? \
543 [list [lindex $i 0] [lindex $i 2]] \
544 [list]
545 set c $z2
546 incr c
548 if {$c < $n} {
549 set buf_rdi [string range $buf_rdi $c end]
550 } else {
551 set buf_rdi {}
554 rescan_done $fd buf_rdi $after
557 proc read_diff_files {fd after} {
558 global buf_rdf
560 append buf_rdf [read $fd]
561 set c 0
562 set n [string length $buf_rdf]
563 while {$c < $n} {
564 set z1 [string first "\0" $buf_rdf $c]
565 if {$z1 == -1} break
566 incr z1
567 set z2 [string first "\0" $buf_rdf $z1]
568 if {$z2 == -1} break
570 incr c
571 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
572 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
573 merge_state \
574 [encoding convertfrom $p] \
575 ?[lindex $i 4] \
576 [list] \
577 [list [lindex $i 0] [lindex $i 2]]
578 set c $z2
579 incr c
581 if {$c < $n} {
582 set buf_rdf [string range $buf_rdf $c end]
583 } else {
584 set buf_rdf {}
587 rescan_done $fd buf_rdf $after
590 proc read_ls_others {fd after} {
591 global buf_rlo
593 append buf_rlo [read $fd]
594 set pck [split $buf_rlo "\0"]
595 set buf_rlo [lindex $pck end]
596 foreach p [lrange $pck 0 end-1] {
597 merge_state [encoding convertfrom $p] ?O
599 rescan_done $fd buf_rlo $after
602 proc rescan_done {fd buf after} {
603 global rescan_active
604 global file_states repo_config
605 upvar $buf to_clear
607 if {![eof $fd]} return
608 set to_clear {}
609 close $fd
610 if {[incr rescan_active -1] > 0} return
612 prune_selection
613 unlock_index
614 display_all_files
615 reshow_diff
616 uplevel #0 $after
619 proc prune_selection {} {
620 global file_states selected_paths
622 foreach path [array names selected_paths] {
623 if {[catch {set still_here $file_states($path)}]} {
624 unset selected_paths($path)
629 ######################################################################
631 ## diff
633 proc clear_diff {} {
634 global ui_diff current_diff_path current_diff_header
635 global ui_index ui_workdir
637 $ui_diff conf -state normal
638 $ui_diff delete 0.0 end
639 $ui_diff conf -state disabled
641 set current_diff_path {}
642 set current_diff_header {}
644 $ui_index tag remove in_diff 0.0 end
645 $ui_workdir tag remove in_diff 0.0 end
648 proc reshow_diff {} {
649 global ui_status_value file_states file_lists
650 global current_diff_path current_diff_side
652 set p $current_diff_path
653 if {$p eq {}
654 || $current_diff_side eq {}
655 || [catch {set s $file_states($p)}]
656 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
657 clear_diff
658 } else {
659 show_diff $p $current_diff_side
663 proc handle_empty_diff {} {
664 global current_diff_path file_states file_lists
666 set path $current_diff_path
667 set s $file_states($path)
668 if {[lindex $s 0] ne {_M}} return
670 info_popup "No differences detected.
672 [short_path $path] has no changes.
674 The modification date of this file was updated
675 by another application, but the content within
676 the file was not changed.
678 A rescan will be automatically started to find
679 other files which may have the same state."
681 clear_diff
682 display_file $path __
683 rescan {set ui_status_value {Ready.}} 0
686 proc show_diff {path w {lno {}}} {
687 global file_states file_lists
688 global is_3way_diff diff_active repo_config
689 global ui_diff ui_status_value ui_index ui_workdir
690 global current_diff_path current_diff_side current_diff_header
692 if {$diff_active || ![lock_index read]} return
694 clear_diff
695 if {$lno == {}} {
696 set lno [lsearch -sorted -exact $file_lists($w) $path]
697 if {$lno >= 0} {
698 incr lno
701 if {$lno >= 1} {
702 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
705 set s $file_states($path)
706 set m [lindex $s 0]
707 set is_3way_diff 0
708 set diff_active 1
709 set current_diff_path $path
710 set current_diff_side $w
711 set current_diff_header {}
712 set ui_status_value "Loading diff of [escape_path $path]..."
714 # - Git won't give us the diff, there's nothing to compare to!
716 if {$m eq {_O}} {
717 set max_sz [expr {128 * 1024}]
718 if {[catch {
719 set fd [open $path r]
720 set content [read $fd $max_sz]
721 close $fd
722 set sz [file size $path]
723 } err ]} {
724 set diff_active 0
725 unlock_index
726 set ui_status_value "Unable to display [escape_path $path]"
727 error_popup "Error loading file:\n\n$err"
728 return
730 $ui_diff conf -state normal
731 if {![catch {set type [exec file $path]}]} {
732 set n [string length $path]
733 if {[string equal -length $n $path $type]} {
734 set type [string range $type $n end]
735 regsub {^:?\s*} $type {} type
737 $ui_diff insert end "* $type\n" d_@
739 if {[string first "\0" $content] != -1} {
740 $ui_diff insert end \
741 "* Binary file (not showing content)." \
743 } else {
744 if {$sz > $max_sz} {
745 $ui_diff insert end \
746 "* Untracked file is $sz bytes.
747 * Showing only first $max_sz bytes.
748 " d_@
750 $ui_diff insert end $content
751 if {$sz > $max_sz} {
752 $ui_diff insert end "
753 * Untracked file clipped here by [appname].
754 * To see the entire file, use an external editor.
755 " d_@
758 $ui_diff conf -state disabled
759 set diff_active 0
760 unlock_index
761 set ui_status_value {Ready.}
762 return
765 set cmd [list | git]
766 if {$w eq $ui_index} {
767 lappend cmd diff-index
768 lappend cmd --cached
769 } elseif {$w eq $ui_workdir} {
770 if {[string index $m 0] eq {U}} {
771 lappend cmd diff
772 } else {
773 lappend cmd diff-files
777 lappend cmd -p
778 lappend cmd --no-color
779 if {$repo_config(gui.diffcontext) > 0} {
780 lappend cmd "-U$repo_config(gui.diffcontext)"
782 if {$w eq $ui_index} {
783 lappend cmd [PARENT]
785 lappend cmd --
786 lappend cmd $path
788 if {[catch {set fd [open $cmd r]} err]} {
789 set diff_active 0
790 unlock_index
791 set ui_status_value "Unable to display [escape_path $path]"
792 error_popup "Error loading diff:\n\n$err"
793 return
796 fconfigure $fd \
797 -blocking 0 \
798 -encoding binary \
799 -translation binary
800 fileevent $fd readable [list read_diff $fd]
803 proc read_diff {fd} {
804 global ui_diff ui_status_value diff_active
805 global is_3way_diff current_diff_header
807 $ui_diff conf -state normal
808 while {[gets $fd line] >= 0} {
809 # -- Cleanup uninteresting diff header lines.
811 if { [string match {diff --git *} $line]
812 || [string match {diff --cc *} $line]
813 || [string match {diff --combined *} $line]
814 || [string match {--- *} $line]
815 || [string match {+++ *} $line]} {
816 append current_diff_header $line "\n"
817 continue
819 if {[string match {index *} $line]} continue
820 if {$line eq {deleted file mode 120000}} {
821 set line "deleted symlink"
824 # -- Automatically detect if this is a 3 way diff.
826 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
828 if {[string match {mode *} $line]
829 || [string match {new file *} $line]
830 || [string match {deleted file *} $line]
831 || [string match {Binary files * and * differ} $line]
832 || $line eq {\ No newline at end of file}
833 || [regexp {^\* Unmerged path } $line]} {
834 set tags {}
835 } elseif {$is_3way_diff} {
836 set op [string range $line 0 1]
837 switch -- $op {
838 { } {set tags {}}
839 {@@} {set tags d_@}
840 { +} {set tags d_s+}
841 { -} {set tags d_s-}
842 {+ } {set tags d_+s}
843 {- } {set tags d_-s}
844 {--} {set tags d_--}
845 {++} {
846 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
847 set line [string replace $line 0 1 { }]
848 set tags d$op
849 } else {
850 set tags d_++
853 default {
854 puts "error: Unhandled 3 way diff marker: {$op}"
855 set tags {}
858 } else {
859 set op [string index $line 0]
860 switch -- $op {
861 { } {set tags {}}
862 {@} {set tags d_@}
863 {-} {set tags d_-}
864 {+} {
865 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
866 set line [string replace $line 0 0 { }]
867 set tags d$op
868 } else {
869 set tags d_+
872 default {
873 puts "error: Unhandled 2 way diff marker: {$op}"
874 set tags {}
878 $ui_diff insert end $line $tags
879 if {[string index $line end] eq "\r"} {
880 $ui_diff tag add d_cr {end - 2c}
882 $ui_diff insert end "\n" $tags
884 $ui_diff conf -state disabled
886 if {[eof $fd]} {
887 close $fd
888 set diff_active 0
889 unlock_index
890 set ui_status_value {Ready.}
892 if {[$ui_diff index end] eq {2.0}} {
893 handle_empty_diff
898 proc apply_hunk {x y} {
899 global current_diff_path current_diff_header current_diff_side
900 global ui_diff ui_index file_states
902 if {$current_diff_path eq {} || $current_diff_header eq {}} return
903 if {![lock_index apply_hunk]} return
905 set apply_cmd {git apply --cached --whitespace=nowarn}
906 set mi [lindex $file_states($current_diff_path) 0]
907 if {$current_diff_side eq $ui_index} {
908 set mode unstage
909 lappend apply_cmd --reverse
910 if {[string index $mi 0] ne {M}} {
911 unlock_index
912 return
914 } else {
915 set mode stage
916 if {[string index $mi 1] ne {M}} {
917 unlock_index
918 return
922 set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
923 set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
924 if {$s_lno eq {}} {
925 unlock_index
926 return
929 set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
930 if {$e_lno eq {}} {
931 set e_lno end
934 if {[catch {
935 set p [open "| $apply_cmd" w]
936 fconfigure $p -translation binary -encoding binary
937 puts -nonewline $p $current_diff_header
938 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
939 close $p} err]} {
940 error_popup "Failed to $mode selected hunk.\n\n$err"
941 unlock_index
942 return
945 $ui_diff conf -state normal
946 $ui_diff delete $s_lno $e_lno
947 $ui_diff conf -state disabled
949 if {[$ui_diff get 1.0 end] eq "\n"} {
950 set o _
951 } else {
952 set o ?
955 if {$current_diff_side eq $ui_index} {
956 set mi ${o}M
957 } elseif {[string index $mi 0] eq {_}} {
958 set mi M$o
959 } else {
960 set mi ?$o
962 unlock_index
963 display_file $current_diff_path $mi
964 if {$o eq {_}} {
965 clear_diff
969 ######################################################################
971 ## commit
973 proc load_last_commit {} {
974 global HEAD PARENT MERGE_HEAD commit_type ui_comm
975 global repo_config
977 if {[llength $PARENT] == 0} {
978 error_popup {There is nothing to amend.
980 You are about to create the initial commit.
981 There is no commit before this to amend.
983 return
986 repository_state curType curHEAD curMERGE_HEAD
987 if {$curType eq {merge}} {
988 error_popup {Cannot amend while merging.
990 You are currently in the middle of a merge that
991 has not been fully completed. You cannot amend
992 the prior commit unless you first abort the
993 current merge activity.
995 return
998 set msg {}
999 set parents [list]
1000 if {[catch {
1001 set fd [open "| git cat-file commit $curHEAD" r]
1002 fconfigure $fd -encoding binary -translation lf
1003 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1004 set enc utf-8
1006 while {[gets $fd line] > 0} {
1007 if {[string match {parent *} $line]} {
1008 lappend parents [string range $line 7 end]
1009 } elseif {[string match {encoding *} $line]} {
1010 set enc [string tolower [string range $line 9 end]]
1013 fconfigure $fd -encoding $enc
1014 set msg [string trim [read $fd]]
1015 close $fd
1016 } err]} {
1017 error_popup "Error loading commit data for amend:\n\n$err"
1018 return
1021 set HEAD $curHEAD
1022 set PARENT $parents
1023 set MERGE_HEAD [list]
1024 switch -- [llength $parents] {
1025 0 {set commit_type amend-initial}
1026 1 {set commit_type amend}
1027 default {set commit_type amend-merge}
1030 $ui_comm delete 0.0 end
1031 $ui_comm insert end $msg
1032 $ui_comm edit reset
1033 $ui_comm edit modified false
1034 rescan {set ui_status_value {Ready.}}
1037 proc create_new_commit {} {
1038 global commit_type ui_comm
1040 set commit_type normal
1041 $ui_comm delete 0.0 end
1042 $ui_comm edit reset
1043 $ui_comm edit modified false
1044 rescan {set ui_status_value {Ready.}}
1047 set GIT_COMMITTER_IDENT {}
1049 proc committer_ident {} {
1050 global GIT_COMMITTER_IDENT
1052 if {$GIT_COMMITTER_IDENT eq {}} {
1053 if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
1054 error_popup "Unable to obtain your identity:\n\n$err"
1055 return {}
1057 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1058 $me me GIT_COMMITTER_IDENT]} {
1059 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1060 return {}
1064 return $GIT_COMMITTER_IDENT
1067 proc commit_tree {} {
1068 global HEAD commit_type file_states ui_comm repo_config
1069 global ui_status_value pch_error
1071 if {[committer_ident] eq {}} return
1072 if {![lock_index update]} return
1074 # -- Our in memory state should match the repository.
1076 repository_state curType curHEAD curMERGE_HEAD
1077 if {[string match amend* $commit_type]
1078 && $curType eq {normal}
1079 && $curHEAD eq $HEAD} {
1080 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1081 info_popup {Last scanned state does not match repository state.
1083 Another Git program has modified this repository
1084 since the last scan. A rescan must be performed
1085 before another commit can be created.
1087 The rescan will be automatically started now.
1089 unlock_index
1090 rescan {set ui_status_value {Ready.}}
1091 return
1094 # -- At least one file should differ in the index.
1096 set files_ready 0
1097 foreach path [array names file_states] {
1098 switch -glob -- [lindex $file_states($path) 0] {
1099 _? {continue}
1100 A? -
1101 D? -
1102 M? {set files_ready 1}
1103 U? {
1104 error_popup "Unmerged files cannot be committed.
1106 File [short_path $path] has merge conflicts.
1107 You must resolve them and add the file before committing.
1109 unlock_index
1110 return
1112 default {
1113 error_popup "Unknown file state [lindex $s 0] detected.
1115 File [short_path $path] cannot be committed by this program.
1120 if {!$files_ready} {
1121 info_popup {No changes to commit.
1123 You must add at least 1 file before you can commit.
1125 unlock_index
1126 return
1129 # -- A message is required.
1131 set msg [string trim [$ui_comm get 1.0 end]]
1132 regsub -all -line {[ \t\r]+$} $msg {} msg
1133 if {$msg eq {}} {
1134 error_popup {Please supply a commit message.
1136 A good commit message has the following format:
1138 - First line: Describe in one sentance what you did.
1139 - Second line: Blank
1140 - Remaining lines: Describe why this change is good.
1142 unlock_index
1143 return
1146 # -- Run the pre-commit hook.
1148 set pchook [gitdir hooks pre-commit]
1150 # On Cygwin [file executable] might lie so we need to ask
1151 # the shell if the hook is executable. Yes that's annoying.
1153 if {[is_Cygwin] && [file isfile $pchook]} {
1154 set pchook [list sh -c [concat \
1155 "if test -x \"$pchook\";" \
1156 "then exec \"$pchook\" 2>&1;" \
1157 "fi"]]
1158 } elseif {[file executable $pchook]} {
1159 set pchook [list $pchook |& cat]
1160 } else {
1161 commit_writetree $curHEAD $msg
1162 return
1165 set ui_status_value {Calling pre-commit hook...}
1166 set pch_error {}
1167 set fd_ph [open "| $pchook" r]
1168 fconfigure $fd_ph -blocking 0 -translation binary
1169 fileevent $fd_ph readable \
1170 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1173 proc commit_prehook_wait {fd_ph curHEAD msg} {
1174 global pch_error ui_status_value
1176 append pch_error [read $fd_ph]
1177 fconfigure $fd_ph -blocking 1
1178 if {[eof $fd_ph]} {
1179 if {[catch {close $fd_ph}]} {
1180 set ui_status_value {Commit declined by pre-commit hook.}
1181 hook_failed_popup pre-commit $pch_error
1182 unlock_index
1183 } else {
1184 commit_writetree $curHEAD $msg
1186 set pch_error {}
1187 return
1189 fconfigure $fd_ph -blocking 0
1192 proc commit_writetree {curHEAD msg} {
1193 global ui_status_value
1195 set ui_status_value {Committing changes...}
1196 set fd_wt [open "| git write-tree" r]
1197 fileevent $fd_wt readable \
1198 [list commit_committree $fd_wt $curHEAD $msg]
1201 proc commit_committree {fd_wt curHEAD msg} {
1202 global HEAD PARENT MERGE_HEAD commit_type
1203 global all_heads current_branch
1204 global ui_status_value ui_comm selected_commit_type
1205 global file_states selected_paths rescan_active
1206 global repo_config
1208 gets $fd_wt tree_id
1209 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1210 error_popup "write-tree failed:\n\n$err"
1211 set ui_status_value {Commit failed.}
1212 unlock_index
1213 return
1216 # -- Build the message.
1218 set msg_p [gitdir COMMIT_EDITMSG]
1219 set msg_wt [open $msg_p w]
1220 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1221 set enc utf-8
1223 fconfigure $msg_wt -encoding $enc -translation binary
1224 puts -nonewline $msg_wt $msg
1225 close $msg_wt
1227 # -- Create the commit.
1229 set cmd [list git commit-tree $tree_id]
1230 set parents [concat $PARENT $MERGE_HEAD]
1231 if {[llength $parents] > 0} {
1232 foreach p $parents {
1233 lappend cmd -p $p
1235 } else {
1236 # git commit-tree writes to stderr during initial commit.
1237 lappend cmd 2>/dev/null
1239 lappend cmd <$msg_p
1240 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1241 error_popup "commit-tree failed:\n\n$err"
1242 set ui_status_value {Commit failed.}
1243 unlock_index
1244 return
1247 # -- Update the HEAD ref.
1249 set reflogm commit
1250 if {$commit_type ne {normal}} {
1251 append reflogm " ($commit_type)"
1253 set i [string first "\n" $msg]
1254 if {$i >= 0} {
1255 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1256 } else {
1257 append reflogm {: } $msg
1259 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1260 if {[catch {eval exec $cmd} err]} {
1261 error_popup "update-ref failed:\n\n$err"
1262 set ui_status_value {Commit failed.}
1263 unlock_index
1264 return
1267 # -- Make sure our current branch exists.
1269 if {$commit_type eq {initial}} {
1270 lappend all_heads $current_branch
1271 set all_heads [lsort -unique $all_heads]
1272 populate_branch_menu
1275 # -- Cleanup after ourselves.
1277 catch {file delete $msg_p}
1278 catch {file delete [gitdir MERGE_HEAD]}
1279 catch {file delete [gitdir MERGE_MSG]}
1280 catch {file delete [gitdir SQUASH_MSG]}
1281 catch {file delete [gitdir GITGUI_MSG]}
1283 # -- Let rerere do its thing.
1285 if {[file isdirectory [gitdir rr-cache]]} {
1286 catch {git rerere}
1289 # -- Run the post-commit hook.
1291 set pchook [gitdir hooks post-commit]
1292 if {[is_Cygwin] && [file isfile $pchook]} {
1293 set pchook [list sh -c [concat \
1294 "if test -x \"$pchook\";" \
1295 "then exec \"$pchook\";" \
1296 "fi"]]
1297 } elseif {![file executable $pchook]} {
1298 set pchook {}
1300 if {$pchook ne {}} {
1301 catch {exec $pchook &}
1304 $ui_comm delete 0.0 end
1305 $ui_comm edit reset
1306 $ui_comm edit modified false
1308 if {[is_enabled singlecommit]} do_quit
1310 # -- Update in memory status
1312 set selected_commit_type new
1313 set commit_type normal
1314 set HEAD $cmt_id
1315 set PARENT $cmt_id
1316 set MERGE_HEAD [list]
1318 foreach path [array names file_states] {
1319 set s $file_states($path)
1320 set m [lindex $s 0]
1321 switch -glob -- $m {
1322 _O -
1323 _M -
1324 _D {continue}
1325 __ -
1326 A_ -
1327 M_ -
1328 D_ {
1329 unset file_states($path)
1330 catch {unset selected_paths($path)}
1332 DO {
1333 set file_states($path) [list _O [lindex $s 1] {} {}]
1335 AM -
1336 AD -
1337 MM -
1338 MD {
1339 set file_states($path) [list \
1340 _[string index $m 1] \
1341 [lindex $s 1] \
1342 [lindex $s 3] \
1348 display_all_files
1349 unlock_index
1350 reshow_diff
1351 set ui_status_value \
1352 "Changes committed as [string range $cmt_id 0 7]."
1355 ######################################################################
1357 ## fetch push
1359 proc fetch_from {remote} {
1360 set w [new_console \
1361 "fetch $remote" \
1362 "Fetching new changes from $remote"]
1363 set cmd [list git fetch]
1364 lappend cmd $remote
1365 console_exec $w $cmd console_done
1368 proc push_to {remote} {
1369 set w [new_console \
1370 "push $remote" \
1371 "Pushing changes to $remote"]
1372 set cmd [list git push]
1373 lappend cmd -v
1374 lappend cmd $remote
1375 console_exec $w $cmd console_done
1378 ######################################################################
1380 ## ui helpers
1382 proc mapicon {w state path} {
1383 global all_icons
1385 if {[catch {set r $all_icons($state$w)}]} {
1386 puts "error: no icon for $w state={$state} $path"
1387 return file_plain
1389 return $r
1392 proc mapdesc {state path} {
1393 global all_descs
1395 if {[catch {set r $all_descs($state)}]} {
1396 puts "error: no desc for state={$state} $path"
1397 return $state
1399 return $r
1402 proc escape_path {path} {
1403 regsub -all {\\} $path "\\\\" path
1404 regsub -all "\n" $path "\\n" path
1405 return $path
1408 proc short_path {path} {
1409 return [escape_path [lindex [file split $path] end]]
1412 set next_icon_id 0
1413 set null_sha1 [string repeat 0 40]
1415 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1416 global file_states next_icon_id null_sha1
1418 set s0 [string index $new_state 0]
1419 set s1 [string index $new_state 1]
1421 if {[catch {set info $file_states($path)}]} {
1422 set state __
1423 set icon n[incr next_icon_id]
1424 } else {
1425 set state [lindex $info 0]
1426 set icon [lindex $info 1]
1427 if {$head_info eq {}} {set head_info [lindex $info 2]}
1428 if {$index_info eq {}} {set index_info [lindex $info 3]}
1431 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1432 elseif {$s0 eq {_}} {set s0 _}
1434 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1435 elseif {$s1 eq {_}} {set s1 _}
1437 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1438 set head_info [list 0 $null_sha1]
1439 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1440 && $head_info eq {}} {
1441 set head_info $index_info
1444 set file_states($path) [list $s0$s1 $icon \
1445 $head_info $index_info \
1447 return $state
1450 proc display_file_helper {w path icon_name old_m new_m} {
1451 global file_lists
1453 if {$new_m eq {_}} {
1454 set lno [lsearch -sorted -exact $file_lists($w) $path]
1455 if {$lno >= 0} {
1456 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1457 incr lno
1458 $w conf -state normal
1459 $w delete $lno.0 [expr {$lno + 1}].0
1460 $w conf -state disabled
1462 } elseif {$old_m eq {_} && $new_m ne {_}} {
1463 lappend file_lists($w) $path
1464 set file_lists($w) [lsort -unique $file_lists($w)]
1465 set lno [lsearch -sorted -exact $file_lists($w) $path]
1466 incr lno
1467 $w conf -state normal
1468 $w image create $lno.0 \
1469 -align center -padx 5 -pady 1 \
1470 -name $icon_name \
1471 -image [mapicon $w $new_m $path]
1472 $w insert $lno.1 "[escape_path $path]\n"
1473 $w conf -state disabled
1474 } elseif {$old_m ne $new_m} {
1475 $w conf -state normal
1476 $w image conf $icon_name -image [mapicon $w $new_m $path]
1477 $w conf -state disabled
1481 proc display_file {path state} {
1482 global file_states selected_paths
1483 global ui_index ui_workdir
1485 set old_m [merge_state $path $state]
1486 set s $file_states($path)
1487 set new_m [lindex $s 0]
1488 set icon_name [lindex $s 1]
1490 set o [string index $old_m 0]
1491 set n [string index $new_m 0]
1492 if {$o eq {U}} {
1493 set o _
1495 if {$n eq {U}} {
1496 set n _
1498 display_file_helper $ui_index $path $icon_name $o $n
1500 if {[string index $old_m 0] eq {U}} {
1501 set o U
1502 } else {
1503 set o [string index $old_m 1]
1505 if {[string index $new_m 0] eq {U}} {
1506 set n U
1507 } else {
1508 set n [string index $new_m 1]
1510 display_file_helper $ui_workdir $path $icon_name $o $n
1512 if {$new_m eq {__}} {
1513 unset file_states($path)
1514 catch {unset selected_paths($path)}
1518 proc display_all_files_helper {w path icon_name m} {
1519 global file_lists
1521 lappend file_lists($w) $path
1522 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1523 $w image create end \
1524 -align center -padx 5 -pady 1 \
1525 -name $icon_name \
1526 -image [mapicon $w $m $path]
1527 $w insert end "[escape_path $path]\n"
1530 proc display_all_files {} {
1531 global ui_index ui_workdir
1532 global file_states file_lists
1533 global last_clicked
1535 $ui_index conf -state normal
1536 $ui_workdir conf -state normal
1538 $ui_index delete 0.0 end
1539 $ui_workdir delete 0.0 end
1540 set last_clicked {}
1542 set file_lists($ui_index) [list]
1543 set file_lists($ui_workdir) [list]
1545 foreach path [lsort [array names file_states]] {
1546 set s $file_states($path)
1547 set m [lindex $s 0]
1548 set icon_name [lindex $s 1]
1550 set s [string index $m 0]
1551 if {$s ne {U} && $s ne {_}} {
1552 display_all_files_helper $ui_index $path \
1553 $icon_name $s
1556 if {[string index $m 0] eq {U}} {
1557 set s U
1558 } else {
1559 set s [string index $m 1]
1561 if {$s ne {_}} {
1562 display_all_files_helper $ui_workdir $path \
1563 $icon_name $s
1567 $ui_index conf -state disabled
1568 $ui_workdir conf -state disabled
1571 proc update_indexinfo {msg pathList after} {
1572 global update_index_cp ui_status_value
1574 if {![lock_index update]} return
1576 set update_index_cp 0
1577 set pathList [lsort $pathList]
1578 set totalCnt [llength $pathList]
1579 set batch [expr {int($totalCnt * .01) + 1}]
1580 if {$batch > 25} {set batch 25}
1582 set ui_status_value [format \
1583 "$msg... %i/%i files (%.2f%%)" \
1584 $update_index_cp \
1585 $totalCnt \
1586 0.0]
1587 set fd [open "| git update-index -z --index-info" w]
1588 fconfigure $fd \
1589 -blocking 0 \
1590 -buffering full \
1591 -buffersize 512 \
1592 -encoding binary \
1593 -translation binary
1594 fileevent $fd writable [list \
1595 write_update_indexinfo \
1596 $fd \
1597 $pathList \
1598 $totalCnt \
1599 $batch \
1600 $msg \
1601 $after \
1605 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1606 global update_index_cp ui_status_value
1607 global file_states current_diff_path
1609 if {$update_index_cp >= $totalCnt} {
1610 close $fd
1611 unlock_index
1612 uplevel #0 $after
1613 return
1616 for {set i $batch} \
1617 {$update_index_cp < $totalCnt && $i > 0} \
1618 {incr i -1} {
1619 set path [lindex $pathList $update_index_cp]
1620 incr update_index_cp
1622 set s $file_states($path)
1623 switch -glob -- [lindex $s 0] {
1624 A? {set new _O}
1625 M? {set new _M}
1626 D_ {set new _D}
1627 D? {set new _?}
1628 ?? {continue}
1630 set info [lindex $s 2]
1631 if {$info eq {}} continue
1633 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1634 display_file $path $new
1637 set ui_status_value [format \
1638 "$msg... %i/%i files (%.2f%%)" \
1639 $update_index_cp \
1640 $totalCnt \
1641 [expr {100.0 * $update_index_cp / $totalCnt}]]
1644 proc update_index {msg pathList after} {
1645 global update_index_cp ui_status_value
1647 if {![lock_index update]} return
1649 set update_index_cp 0
1650 set pathList [lsort $pathList]
1651 set totalCnt [llength $pathList]
1652 set batch [expr {int($totalCnt * .01) + 1}]
1653 if {$batch > 25} {set batch 25}
1655 set ui_status_value [format \
1656 "$msg... %i/%i files (%.2f%%)" \
1657 $update_index_cp \
1658 $totalCnt \
1659 0.0]
1660 set fd [open "| git update-index --add --remove -z --stdin" w]
1661 fconfigure $fd \
1662 -blocking 0 \
1663 -buffering full \
1664 -buffersize 512 \
1665 -encoding binary \
1666 -translation binary
1667 fileevent $fd writable [list \
1668 write_update_index \
1669 $fd \
1670 $pathList \
1671 $totalCnt \
1672 $batch \
1673 $msg \
1674 $after \
1678 proc write_update_index {fd pathList totalCnt batch msg after} {
1679 global update_index_cp ui_status_value
1680 global file_states current_diff_path
1682 if {$update_index_cp >= $totalCnt} {
1683 close $fd
1684 unlock_index
1685 uplevel #0 $after
1686 return
1689 for {set i $batch} \
1690 {$update_index_cp < $totalCnt && $i > 0} \
1691 {incr i -1} {
1692 set path [lindex $pathList $update_index_cp]
1693 incr update_index_cp
1695 switch -glob -- [lindex $file_states($path) 0] {
1696 AD {set new __}
1697 ?D {set new D_}
1698 _O -
1699 AM {set new A_}
1700 U? {
1701 if {[file exists $path]} {
1702 set new M_
1703 } else {
1704 set new D_
1707 ?M {set new M_}
1708 ?? {continue}
1710 puts -nonewline $fd "[encoding convertto $path]\0"
1711 display_file $path $new
1714 set ui_status_value [format \
1715 "$msg... %i/%i files (%.2f%%)" \
1716 $update_index_cp \
1717 $totalCnt \
1718 [expr {100.0 * $update_index_cp / $totalCnt}]]
1721 proc checkout_index {msg pathList after} {
1722 global update_index_cp ui_status_value
1724 if {![lock_index update]} return
1726 set update_index_cp 0
1727 set pathList [lsort $pathList]
1728 set totalCnt [llength $pathList]
1729 set batch [expr {int($totalCnt * .01) + 1}]
1730 if {$batch > 25} {set batch 25}
1732 set ui_status_value [format \
1733 "$msg... %i/%i files (%.2f%%)" \
1734 $update_index_cp \
1735 $totalCnt \
1736 0.0]
1737 set cmd [list git checkout-index]
1738 lappend cmd --index
1739 lappend cmd --quiet
1740 lappend cmd --force
1741 lappend cmd -z
1742 lappend cmd --stdin
1743 set fd [open "| $cmd " w]
1744 fconfigure $fd \
1745 -blocking 0 \
1746 -buffering full \
1747 -buffersize 512 \
1748 -encoding binary \
1749 -translation binary
1750 fileevent $fd writable [list \
1751 write_checkout_index \
1752 $fd \
1753 $pathList \
1754 $totalCnt \
1755 $batch \
1756 $msg \
1757 $after \
1761 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1762 global update_index_cp ui_status_value
1763 global file_states current_diff_path
1765 if {$update_index_cp >= $totalCnt} {
1766 close $fd
1767 unlock_index
1768 uplevel #0 $after
1769 return
1772 for {set i $batch} \
1773 {$update_index_cp < $totalCnt && $i > 0} \
1774 {incr i -1} {
1775 set path [lindex $pathList $update_index_cp]
1776 incr update_index_cp
1777 switch -glob -- [lindex $file_states($path) 0] {
1778 U? {continue}
1779 ?M -
1780 ?D {
1781 puts -nonewline $fd "[encoding convertto $path]\0"
1782 display_file $path ?_
1787 set ui_status_value [format \
1788 "$msg... %i/%i files (%.2f%%)" \
1789 $update_index_cp \
1790 $totalCnt \
1791 [expr {100.0 * $update_index_cp / $totalCnt}]]
1794 ######################################################################
1796 ## branch management
1798 proc is_tracking_branch {name} {
1799 global tracking_branches
1801 if {![catch {set info $tracking_branches($name)}]} {
1802 return 1
1804 foreach t [array names tracking_branches] {
1805 if {[string match {*/\*} $t] && [string match $t $name]} {
1806 return 1
1809 return 0
1812 proc load_all_heads {} {
1813 global all_heads
1815 set all_heads [list]
1816 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1817 while {[gets $fd line] > 0} {
1818 if {[is_tracking_branch $line]} continue
1819 if {![regsub ^refs/heads/ $line {} name]} continue
1820 lappend all_heads $name
1822 close $fd
1824 set all_heads [lsort $all_heads]
1827 proc populate_branch_menu {} {
1828 global all_heads disable_on_lock
1830 set m .mbar.branch
1831 set last [$m index last]
1832 for {set i 0} {$i <= $last} {incr i} {
1833 if {[$m type $i] eq {separator}} {
1834 $m delete $i last
1835 set new_dol [list]
1836 foreach a $disable_on_lock {
1837 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1838 lappend new_dol $a
1841 set disable_on_lock $new_dol
1842 break
1846 if {$all_heads ne {}} {
1847 $m add separator
1849 foreach b $all_heads {
1850 $m add radiobutton \
1851 -label $b \
1852 -command [list switch_branch $b] \
1853 -variable current_branch \
1854 -value $b \
1855 -font font_ui
1856 lappend disable_on_lock \
1857 [list $m entryconf [$m index last] -state]
1861 proc all_tracking_branches {} {
1862 global tracking_branches
1864 set all_trackings {}
1865 set cmd {}
1866 foreach name [array names tracking_branches] {
1867 if {[regsub {/\*$} $name {} name]} {
1868 lappend cmd $name
1869 } else {
1870 regsub ^refs/(heads|remotes)/ $name {} name
1871 lappend all_trackings $name
1875 if {$cmd ne {}} {
1876 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1877 while {[gets $fd name] > 0} {
1878 regsub ^refs/(heads|remotes)/ $name {} name
1879 lappend all_trackings $name
1881 close $fd
1884 return [lsort -unique $all_trackings]
1887 proc do_create_branch_action {w} {
1888 global all_heads null_sha1 repo_config
1889 global create_branch_checkout create_branch_revtype
1890 global create_branch_head create_branch_trackinghead
1891 global create_branch_name create_branch_revexp
1893 set newbranch $create_branch_name
1894 if {$newbranch eq {}
1895 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1896 tk_messageBox \
1897 -icon error \
1898 -type ok \
1899 -title [wm title $w] \
1900 -parent $w \
1901 -message "Please supply a branch name."
1902 focus $w.desc.name_t
1903 return
1905 if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
1906 tk_messageBox \
1907 -icon error \
1908 -type ok \
1909 -title [wm title $w] \
1910 -parent $w \
1911 -message "Branch '$newbranch' already exists."
1912 focus $w.desc.name_t
1913 return
1915 if {[catch {git check-ref-format "heads/$newbranch"}]} {
1916 tk_messageBox \
1917 -icon error \
1918 -type ok \
1919 -title [wm title $w] \
1920 -parent $w \
1921 -message "We do not like '$newbranch' as a branch name."
1922 focus $w.desc.name_t
1923 return
1926 set rev {}
1927 switch -- $create_branch_revtype {
1928 head {set rev $create_branch_head}
1929 tracking {set rev $create_branch_trackinghead}
1930 expression {set rev $create_branch_revexp}
1932 if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
1933 tk_messageBox \
1934 -icon error \
1935 -type ok \
1936 -title [wm title $w] \
1937 -parent $w \
1938 -message "Invalid starting revision: $rev"
1939 return
1941 set cmd [list git update-ref]
1942 lappend cmd -m
1943 lappend cmd "branch: Created from $rev"
1944 lappend cmd "refs/heads/$newbranch"
1945 lappend cmd $cmt
1946 lappend cmd $null_sha1
1947 if {[catch {eval exec $cmd} err]} {
1948 tk_messageBox \
1949 -icon error \
1950 -type ok \
1951 -title [wm title $w] \
1952 -parent $w \
1953 -message "Failed to create '$newbranch'.\n\n$err"
1954 return
1957 lappend all_heads $newbranch
1958 set all_heads [lsort $all_heads]
1959 populate_branch_menu
1960 destroy $w
1961 if {$create_branch_checkout} {
1962 switch_branch $newbranch
1966 proc radio_selector {varname value args} {
1967 upvar #0 $varname var
1968 set var $value
1971 trace add variable create_branch_head write \
1972 [list radio_selector create_branch_revtype head]
1973 trace add variable create_branch_trackinghead write \
1974 [list radio_selector create_branch_revtype tracking]
1976 trace add variable delete_branch_head write \
1977 [list radio_selector delete_branch_checktype head]
1978 trace add variable delete_branch_trackinghead write \
1979 [list radio_selector delete_branch_checktype tracking]
1981 proc do_create_branch {} {
1982 global all_heads current_branch repo_config
1983 global create_branch_checkout create_branch_revtype
1984 global create_branch_head create_branch_trackinghead
1985 global create_branch_name create_branch_revexp
1987 set w .branch_editor
1988 toplevel $w
1989 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1991 label $w.header -text {Create New Branch} \
1992 -font font_uibold
1993 pack $w.header -side top -fill x
1995 frame $w.buttons
1996 button $w.buttons.create -text Create \
1997 -font font_ui \
1998 -default active \
1999 -command [list do_create_branch_action $w]
2000 pack $w.buttons.create -side right
2001 button $w.buttons.cancel -text {Cancel} \
2002 -font font_ui \
2003 -command [list destroy $w]
2004 pack $w.buttons.cancel -side right -padx 5
2005 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2007 labelframe $w.desc \
2008 -text {Branch Description} \
2009 -font font_ui
2010 label $w.desc.name_l -text {Name:} -font font_ui
2011 entry $w.desc.name_t \
2012 -borderwidth 1 \
2013 -relief sunken \
2014 -width 40 \
2015 -textvariable create_branch_name \
2016 -font font_ui \
2017 -validate key \
2018 -validatecommand {
2019 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2020 return 1
2022 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2023 grid columnconfigure $w.desc 1 -weight 1
2024 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2026 labelframe $w.from \
2027 -text {Starting Revision} \
2028 -font font_ui
2029 radiobutton $w.from.head_r \
2030 -text {Local Branch:} \
2031 -value head \
2032 -variable create_branch_revtype \
2033 -font font_ui
2034 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2035 grid $w.from.head_r $w.from.head_m -sticky w
2036 set all_trackings [all_tracking_branches]
2037 if {$all_trackings ne {}} {
2038 set create_branch_trackinghead [lindex $all_trackings 0]
2039 radiobutton $w.from.tracking_r \
2040 -text {Tracking Branch:} \
2041 -value tracking \
2042 -variable create_branch_revtype \
2043 -font font_ui
2044 eval tk_optionMenu $w.from.tracking_m \
2045 create_branch_trackinghead \
2046 $all_trackings
2047 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2049 radiobutton $w.from.exp_r \
2050 -text {Revision Expression:} \
2051 -value expression \
2052 -variable create_branch_revtype \
2053 -font font_ui
2054 entry $w.from.exp_t \
2055 -borderwidth 1 \
2056 -relief sunken \
2057 -width 50 \
2058 -textvariable create_branch_revexp \
2059 -font font_ui \
2060 -validate key \
2061 -validatecommand {
2062 if {%d == 1 && [regexp {\s} %S]} {return 0}
2063 if {%d == 1 && [string length %S] > 0} {
2064 set create_branch_revtype expression
2066 return 1
2068 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2069 grid columnconfigure $w.from 1 -weight 1
2070 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2072 labelframe $w.postActions \
2073 -text {Post Creation Actions} \
2074 -font font_ui
2075 checkbutton $w.postActions.checkout \
2076 -text {Checkout after creation} \
2077 -variable create_branch_checkout \
2078 -font font_ui
2079 pack $w.postActions.checkout -anchor nw
2080 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2082 set create_branch_checkout 1
2083 set create_branch_head $current_branch
2084 set create_branch_revtype head
2085 set create_branch_name $repo_config(gui.newbranchtemplate)
2086 set create_branch_revexp {}
2088 bind $w <Visibility> "
2089 grab $w
2090 $w.desc.name_t icursor end
2091 focus $w.desc.name_t
2093 bind $w <Key-Escape> "destroy $w"
2094 bind $w <Key-Return> "do_create_branch_action $w;break"
2095 wm title $w "[appname] ([reponame]): Create Branch"
2096 tkwait window $w
2099 proc do_delete_branch_action {w} {
2100 global all_heads
2101 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2103 set check_rev {}
2104 switch -- $delete_branch_checktype {
2105 head {set check_rev $delete_branch_head}
2106 tracking {set check_rev $delete_branch_trackinghead}
2107 always {set check_rev {:none}}
2109 if {$check_rev eq {:none}} {
2110 set check_cmt {}
2111 } elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
2112 tk_messageBox \
2113 -icon error \
2114 -type ok \
2115 -title [wm title $w] \
2116 -parent $w \
2117 -message "Invalid check revision: $check_rev"
2118 return
2121 set to_delete [list]
2122 set not_merged [list]
2123 foreach i [$w.list.l curselection] {
2124 set b [$w.list.l get $i]
2125 if {[catch {set o [git rev-parse --verify $b]}]} continue
2126 if {$check_cmt ne {}} {
2127 if {$b eq $check_rev} continue
2128 if {[catch {set m [git merge-base $o $check_cmt]}]} continue
2129 if {$o ne $m} {
2130 lappend not_merged $b
2131 continue
2134 lappend to_delete [list $b $o]
2136 if {$not_merged ne {}} {
2137 set msg "The following branches are not completely merged into $check_rev:
2139 - [join $not_merged "\n - "]"
2140 tk_messageBox \
2141 -icon info \
2142 -type ok \
2143 -title [wm title $w] \
2144 -parent $w \
2145 -message $msg
2147 if {$to_delete eq {}} return
2148 if {$delete_branch_checktype eq {always}} {
2149 set msg {Recovering deleted branches is difficult.
2151 Delete the selected branches?}
2152 if {[tk_messageBox \
2153 -icon warning \
2154 -type yesno \
2155 -title [wm title $w] \
2156 -parent $w \
2157 -message $msg] ne yes} {
2158 return
2162 set failed {}
2163 foreach i $to_delete {
2164 set b [lindex $i 0]
2165 set o [lindex $i 1]
2166 if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
2167 append failed " - $b: $err\n"
2168 } else {
2169 set x [lsearch -sorted -exact $all_heads $b]
2170 if {$x >= 0} {
2171 set all_heads [lreplace $all_heads $x $x]
2176 if {$failed ne {}} {
2177 tk_messageBox \
2178 -icon error \
2179 -type ok \
2180 -title [wm title $w] \
2181 -parent $w \
2182 -message "Failed to delete branches:\n$failed"
2185 set all_heads [lsort $all_heads]
2186 populate_branch_menu
2187 destroy $w
2190 proc do_delete_branch {} {
2191 global all_heads tracking_branches current_branch
2192 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2194 set w .branch_editor
2195 toplevel $w
2196 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2198 label $w.header -text {Delete Local Branch} \
2199 -font font_uibold
2200 pack $w.header -side top -fill x
2202 frame $w.buttons
2203 button $w.buttons.create -text Delete \
2204 -font font_ui \
2205 -command [list do_delete_branch_action $w]
2206 pack $w.buttons.create -side right
2207 button $w.buttons.cancel -text {Cancel} \
2208 -font font_ui \
2209 -command [list destroy $w]
2210 pack $w.buttons.cancel -side right -padx 5
2211 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2213 labelframe $w.list \
2214 -text {Local Branches} \
2215 -font font_ui
2216 listbox $w.list.l \
2217 -height 10 \
2218 -width 70 \
2219 -selectmode extended \
2220 -yscrollcommand [list $w.list.sby set] \
2221 -font font_ui
2222 foreach h $all_heads {
2223 if {$h ne $current_branch} {
2224 $w.list.l insert end $h
2227 scrollbar $w.list.sby -command [list $w.list.l yview]
2228 pack $w.list.sby -side right -fill y
2229 pack $w.list.l -side left -fill both -expand 1
2230 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2232 labelframe $w.validate \
2233 -text {Delete Only If} \
2234 -font font_ui
2235 radiobutton $w.validate.head_r \
2236 -text {Merged Into Local Branch:} \
2237 -value head \
2238 -variable delete_branch_checktype \
2239 -font font_ui
2240 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2241 grid $w.validate.head_r $w.validate.head_m -sticky w
2242 set all_trackings [all_tracking_branches]
2243 if {$all_trackings ne {}} {
2244 set delete_branch_trackinghead [lindex $all_trackings 0]
2245 radiobutton $w.validate.tracking_r \
2246 -text {Merged Into Tracking Branch:} \
2247 -value tracking \
2248 -variable delete_branch_checktype \
2249 -font font_ui
2250 eval tk_optionMenu $w.validate.tracking_m \
2251 delete_branch_trackinghead \
2252 $all_trackings
2253 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2255 radiobutton $w.validate.always_r \
2256 -text {Always (Do not perform merge checks)} \
2257 -value always \
2258 -variable delete_branch_checktype \
2259 -font font_ui
2260 grid $w.validate.always_r -columnspan 2 -sticky w
2261 grid columnconfigure $w.validate 1 -weight 1
2262 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2264 set delete_branch_head $current_branch
2265 set delete_branch_checktype head
2267 bind $w <Visibility> "grab $w; focus $w"
2268 bind $w <Key-Escape> "destroy $w"
2269 wm title $w "[appname] ([reponame]): Delete Branch"
2270 tkwait window $w
2273 proc switch_branch {new_branch} {
2274 global HEAD commit_type current_branch repo_config
2276 if {![lock_index switch]} return
2278 # -- Our in memory state should match the repository.
2280 repository_state curType curHEAD curMERGE_HEAD
2281 if {[string match amend* $commit_type]
2282 && $curType eq {normal}
2283 && $curHEAD eq $HEAD} {
2284 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2285 info_popup {Last scanned state does not match repository state.
2287 Another Git program has modified this repository
2288 since the last scan. A rescan must be performed
2289 before the current branch can be changed.
2291 The rescan will be automatically started now.
2293 unlock_index
2294 rescan {set ui_status_value {Ready.}}
2295 return
2298 # -- Don't do a pointless switch.
2300 if {$current_branch eq $new_branch} {
2301 unlock_index
2302 return
2305 if {$repo_config(gui.trustmtime) eq {true}} {
2306 switch_branch_stage2 {} $new_branch
2307 } else {
2308 set ui_status_value {Refreshing file status...}
2309 set cmd [list git update-index]
2310 lappend cmd -q
2311 lappend cmd --unmerged
2312 lappend cmd --ignore-missing
2313 lappend cmd --refresh
2314 set fd_rf [open "| $cmd" r]
2315 fconfigure $fd_rf -blocking 0 -translation binary
2316 fileevent $fd_rf readable \
2317 [list switch_branch_stage2 $fd_rf $new_branch]
2321 proc switch_branch_stage2 {fd_rf new_branch} {
2322 global ui_status_value HEAD
2324 if {$fd_rf ne {}} {
2325 read $fd_rf
2326 if {![eof $fd_rf]} return
2327 close $fd_rf
2330 set ui_status_value "Updating working directory to '$new_branch'..."
2331 set cmd [list git read-tree]
2332 lappend cmd -m
2333 lappend cmd -u
2334 lappend cmd --exclude-per-directory=.gitignore
2335 lappend cmd $HEAD
2336 lappend cmd $new_branch
2337 set fd_rt [open "| $cmd" r]
2338 fconfigure $fd_rt -blocking 0 -translation binary
2339 fileevent $fd_rt readable \
2340 [list switch_branch_readtree_wait $fd_rt $new_branch]
2343 proc switch_branch_readtree_wait {fd_rt new_branch} {
2344 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2345 global current_branch
2346 global ui_comm ui_status_value
2348 # -- We never get interesting output on stdout; only stderr.
2350 read $fd_rt
2351 fconfigure $fd_rt -blocking 1
2352 if {![eof $fd_rt]} {
2353 fconfigure $fd_rt -blocking 0
2354 return
2357 # -- The working directory wasn't in sync with the index and
2358 # we'd have to overwrite something to make the switch. A
2359 # merge is required.
2361 if {[catch {close $fd_rt} err]} {
2362 regsub {^fatal: } $err {} err
2363 warn_popup "File level merge required.
2365 $err
2367 Staying on branch '$current_branch'."
2368 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2369 unlock_index
2370 return
2373 # -- Update the symbolic ref. Core git doesn't even check for failure
2374 # here, it Just Works(tm). If it doesn't we are in some really ugly
2375 # state that is difficult to recover from within git-gui.
2377 if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2378 error_popup "Failed to set current branch.
2380 This working directory is only partially switched.
2381 We successfully updated your files, but failed to
2382 update an internal Git file.
2384 This should not have occurred. [appname] will now
2385 close and give up.
2387 $err"
2388 do_quit
2389 return
2392 # -- Update our repository state. If we were previously in amend mode
2393 # we need to toss the current buffer and do a full rescan to update
2394 # our file lists. If we weren't in amend mode our file lists are
2395 # accurate and we can avoid the rescan.
2397 unlock_index
2398 set selected_commit_type new
2399 if {[string match amend* $commit_type]} {
2400 $ui_comm delete 0.0 end
2401 $ui_comm edit reset
2402 $ui_comm edit modified false
2403 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2404 } else {
2405 repository_state commit_type HEAD MERGE_HEAD
2406 set PARENT $HEAD
2407 set ui_status_value "Checked out branch '$current_branch'."
2411 ######################################################################
2413 ## remote management
2415 proc load_all_remotes {} {
2416 global repo_config
2417 global all_remotes tracking_branches
2419 set all_remotes [list]
2420 array unset tracking_branches
2422 set rm_dir [gitdir remotes]
2423 if {[file isdirectory $rm_dir]} {
2424 set all_remotes [glob \
2425 -types f \
2426 -tails \
2427 -nocomplain \
2428 -directory $rm_dir *]
2430 foreach name $all_remotes {
2431 catch {
2432 set fd [open [file join $rm_dir $name] r]
2433 while {[gets $fd line] >= 0} {
2434 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2435 $line line src dst]} continue
2436 if {![regexp ^refs/ $dst]} {
2437 set dst "refs/heads/$dst"
2439 set tracking_branches($dst) [list $name $src]
2441 close $fd
2446 foreach line [array names repo_config remote.*.url] {
2447 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2448 lappend all_remotes $name
2450 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2451 set fl {}
2453 foreach line $fl {
2454 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2455 if {![regexp ^refs/ $dst]} {
2456 set dst "refs/heads/$dst"
2458 set tracking_branches($dst) [list $name $src]
2462 set all_remotes [lsort -unique $all_remotes]
2465 proc populate_fetch_menu {} {
2466 global all_remotes repo_config
2468 set m .mbar.fetch
2469 foreach r $all_remotes {
2470 set enable 0
2471 if {![catch {set a $repo_config(remote.$r.url)}]} {
2472 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2473 set enable 1
2475 } else {
2476 catch {
2477 set fd [open [gitdir remotes $r] r]
2478 while {[gets $fd n] >= 0} {
2479 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2480 set enable 1
2481 break
2484 close $fd
2488 if {$enable} {
2489 $m add command \
2490 -label "Fetch from $r..." \
2491 -command [list fetch_from $r] \
2492 -font font_ui
2497 proc populate_push_menu {} {
2498 global all_remotes repo_config
2500 set m .mbar.push
2501 set fast_count 0
2502 foreach r $all_remotes {
2503 set enable 0
2504 if {![catch {set a $repo_config(remote.$r.url)}]} {
2505 if {![catch {set a $repo_config(remote.$r.push)}]} {
2506 set enable 1
2508 } else {
2509 catch {
2510 set fd [open [gitdir remotes $r] r]
2511 while {[gets $fd n] >= 0} {
2512 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2513 set enable 1
2514 break
2517 close $fd
2521 if {$enable} {
2522 if {!$fast_count} {
2523 $m add separator
2525 $m add command \
2526 -label "Push to $r..." \
2527 -command [list push_to $r] \
2528 -font font_ui
2529 incr fast_count
2534 proc start_push_anywhere_action {w} {
2535 global push_urltype push_remote push_url push_thin push_tags
2537 set r_url {}
2538 switch -- $push_urltype {
2539 remote {set r_url $push_remote}
2540 url {set r_url $push_url}
2542 if {$r_url eq {}} return
2544 set cmd [list git push]
2545 lappend cmd -v
2546 if {$push_thin} {
2547 lappend cmd --thin
2549 if {$push_tags} {
2550 lappend cmd --tags
2552 lappend cmd $r_url
2553 set cnt 0
2554 foreach i [$w.source.l curselection] {
2555 set b [$w.source.l get $i]
2556 lappend cmd "refs/heads/$b:refs/heads/$b"
2557 incr cnt
2559 if {$cnt == 0} {
2560 return
2561 } elseif {$cnt == 1} {
2562 set unit branch
2563 } else {
2564 set unit branches
2567 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2568 console_exec $cons $cmd console_done
2569 destroy $w
2572 trace add variable push_remote write \
2573 [list radio_selector push_urltype remote]
2575 proc do_push_anywhere {} {
2576 global all_heads all_remotes current_branch
2577 global push_urltype push_remote push_url push_thin push_tags
2579 set w .push_setup
2580 toplevel $w
2581 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2583 label $w.header -text {Push Branches} -font font_uibold
2584 pack $w.header -side top -fill x
2586 frame $w.buttons
2587 button $w.buttons.create -text Push \
2588 -font font_ui \
2589 -command [list start_push_anywhere_action $w]
2590 pack $w.buttons.create -side right
2591 button $w.buttons.cancel -text {Cancel} \
2592 -font font_ui \
2593 -command [list destroy $w]
2594 pack $w.buttons.cancel -side right -padx 5
2595 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2597 labelframe $w.source \
2598 -text {Source Branches} \
2599 -font font_ui
2600 listbox $w.source.l \
2601 -height 10 \
2602 -width 70 \
2603 -selectmode extended \
2604 -yscrollcommand [list $w.source.sby set] \
2605 -font font_ui
2606 foreach h $all_heads {
2607 $w.source.l insert end $h
2608 if {$h eq $current_branch} {
2609 $w.source.l select set end
2612 scrollbar $w.source.sby -command [list $w.source.l yview]
2613 pack $w.source.sby -side right -fill y
2614 pack $w.source.l -side left -fill both -expand 1
2615 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2617 labelframe $w.dest \
2618 -text {Destination Repository} \
2619 -font font_ui
2620 if {$all_remotes ne {}} {
2621 radiobutton $w.dest.remote_r \
2622 -text {Remote:} \
2623 -value remote \
2624 -variable push_urltype \
2625 -font font_ui
2626 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2627 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2628 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2629 set push_remote origin
2630 } else {
2631 set push_remote [lindex $all_remotes 0]
2633 set push_urltype remote
2634 } else {
2635 set push_urltype url
2637 radiobutton $w.dest.url_r \
2638 -text {Arbitrary URL:} \
2639 -value url \
2640 -variable push_urltype \
2641 -font font_ui
2642 entry $w.dest.url_t \
2643 -borderwidth 1 \
2644 -relief sunken \
2645 -width 50 \
2646 -textvariable push_url \
2647 -font font_ui \
2648 -validate key \
2649 -validatecommand {
2650 if {%d == 1 && [regexp {\s} %S]} {return 0}
2651 if {%d == 1 && [string length %S] > 0} {
2652 set push_urltype url
2654 return 1
2656 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2657 grid columnconfigure $w.dest 1 -weight 1
2658 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2660 labelframe $w.options \
2661 -text {Transfer Options} \
2662 -font font_ui
2663 checkbutton $w.options.thin \
2664 -text {Use thin pack (for slow network connections)} \
2665 -variable push_thin \
2666 -font font_ui
2667 grid $w.options.thin -columnspan 2 -sticky w
2668 checkbutton $w.options.tags \
2669 -text {Include tags} \
2670 -variable push_tags \
2671 -font font_ui
2672 grid $w.options.tags -columnspan 2 -sticky w
2673 grid columnconfigure $w.options 1 -weight 1
2674 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2676 set push_url {}
2677 set push_thin 0
2678 set push_tags 0
2680 bind $w <Visibility> "grab $w"
2681 bind $w <Key-Escape> "destroy $w"
2682 wm title $w "[appname] ([reponame]): Push"
2683 tkwait window $w
2686 ######################################################################
2688 ## merge
2690 proc can_merge {} {
2691 global HEAD commit_type file_states
2693 if {[string match amend* $commit_type]} {
2694 info_popup {Cannot merge while amending.
2696 You must finish amending this commit before
2697 starting any type of merge.
2699 return 0
2702 if {[committer_ident] eq {}} {return 0}
2703 if {![lock_index merge]} {return 0}
2705 # -- Our in memory state should match the repository.
2707 repository_state curType curHEAD curMERGE_HEAD
2708 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2709 info_popup {Last scanned state does not match repository state.
2711 Another Git program has modified this repository
2712 since the last scan. A rescan must be performed
2713 before a merge can be performed.
2715 The rescan will be automatically started now.
2717 unlock_index
2718 rescan {set ui_status_value {Ready.}}
2719 return 0
2722 foreach path [array names file_states] {
2723 switch -glob -- [lindex $file_states($path) 0] {
2724 _O {
2725 continue; # and pray it works!
2727 U? {
2728 error_popup "You are in the middle of a conflicted merge.
2730 File [short_path $path] has merge conflicts.
2732 You must resolve them, add the file, and commit to
2733 complete the current merge. Only then can you
2734 begin another merge.
2736 unlock_index
2737 return 0
2739 ?? {
2740 error_popup "You are in the middle of a change.
2742 File [short_path $path] is modified.
2744 You should complete the current commit before
2745 starting a merge. Doing so will help you abort
2746 a failed merge, should the need arise.
2748 unlock_index
2749 return 0
2754 return 1
2757 proc visualize_local_merge {w} {
2758 set revs {}
2759 foreach i [$w.source.l curselection] {
2760 lappend revs [$w.source.l get $i]
2762 if {$revs eq {}} return
2763 lappend revs --not HEAD
2764 do_gitk $revs
2767 proc start_local_merge_action {w} {
2768 global HEAD ui_status_value current_branch
2770 set cmd [list git merge]
2771 set names {}
2772 set revcnt 0
2773 foreach i [$w.source.l curselection] {
2774 set b [$w.source.l get $i]
2775 lappend cmd $b
2776 lappend names $b
2777 incr revcnt
2780 if {$revcnt == 0} {
2781 return
2782 } elseif {$revcnt == 1} {
2783 set unit branch
2784 } elseif {$revcnt <= 15} {
2785 set unit branches
2786 } else {
2787 tk_messageBox \
2788 -icon error \
2789 -type ok \
2790 -title [wm title $w] \
2791 -parent $w \
2792 -message "Too many branches selected.
2794 You have requested to merge $revcnt branches
2795 in an octopus merge. This exceeds Git's
2796 internal limit of 15 branches per merge.
2798 Please select fewer branches. To merge more
2799 than 15 branches, merge the branches in batches.
2801 return
2804 set msg "Merging $current_branch, [join $names {, }]"
2805 set ui_status_value "$msg..."
2806 set cons [new_console "Merge" $msg]
2807 console_exec $cons $cmd [list finish_merge $revcnt]
2808 bind $w <Destroy> {}
2809 destroy $w
2812 proc finish_merge {revcnt w ok} {
2813 console_done $w $ok
2814 if {$ok} {
2815 set msg {Merge completed successfully.}
2816 } else {
2817 if {$revcnt != 1} {
2818 info_popup "Octopus merge failed.
2820 Your merge of $revcnt branches has failed.
2822 There are file-level conflicts between the
2823 branches which must be resolved manually.
2825 The working directory will now be reset.
2827 You can attempt this merge again
2828 by merging only one branch at a time." $w
2830 set fd [open "| git read-tree --reset -u HEAD" r]
2831 fconfigure $fd -blocking 0 -translation binary
2832 fileevent $fd readable [list reset_hard_wait $fd]
2833 set ui_status_value {Aborting... please wait...}
2834 return
2837 set msg {Merge failed. Conflict resolution is required.}
2839 unlock_index
2840 rescan [list set ui_status_value $msg]
2843 proc do_local_merge {} {
2844 global current_branch
2846 if {![can_merge]} return
2848 set w .merge_setup
2849 toplevel $w
2850 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2852 label $w.header \
2853 -text "Merge Into $current_branch" \
2854 -font font_uibold
2855 pack $w.header -side top -fill x
2857 frame $w.buttons
2858 button $w.buttons.visualize -text Visualize \
2859 -font font_ui \
2860 -command [list visualize_local_merge $w]
2861 pack $w.buttons.visualize -side left
2862 button $w.buttons.create -text Merge \
2863 -font font_ui \
2864 -command [list start_local_merge_action $w]
2865 pack $w.buttons.create -side right
2866 button $w.buttons.cancel -text {Cancel} \
2867 -font font_ui \
2868 -command [list destroy $w]
2869 pack $w.buttons.cancel -side right -padx 5
2870 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2872 labelframe $w.source \
2873 -text {Source Branches} \
2874 -font font_ui
2875 listbox $w.source.l \
2876 -height 10 \
2877 -width 70 \
2878 -selectmode extended \
2879 -yscrollcommand [list $w.source.sby set] \
2880 -font font_ui
2881 scrollbar $w.source.sby -command [list $w.source.l yview]
2882 pack $w.source.sby -side right -fill y
2883 pack $w.source.l -side left -fill both -expand 1
2884 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2886 set cmd [list git for-each-ref]
2887 lappend cmd {--format=%(objectname) %(refname)}
2888 lappend cmd refs/heads
2889 lappend cmd refs/remotes
2890 set fr_fd [open "| $cmd" r]
2891 fconfigure $fr_fd -translation binary
2892 while {[gets $fr_fd line] > 0} {
2893 set line [split $line { }]
2894 set sha1([lindex $line 0]) [lindex $line 1]
2896 close $fr_fd
2898 set to_show {}
2899 set fr_fd [open "| git rev-list --all --not HEAD"]
2900 while {[gets $fr_fd line] > 0} {
2901 if {[catch {set ref $sha1($line)}]} continue
2902 regsub ^refs/(heads|remotes)/ $ref {} ref
2903 lappend to_show $ref
2905 close $fr_fd
2907 foreach ref [lsort -unique $to_show] {
2908 $w.source.l insert end $ref
2911 bind $w <Visibility> "grab $w"
2912 bind $w <Key-Escape> "unlock_index;destroy $w"
2913 bind $w <Destroy> unlock_index
2914 wm title $w "[appname] ([reponame]): Merge"
2915 tkwait window $w
2918 proc do_reset_hard {} {
2919 global HEAD commit_type file_states
2921 if {[string match amend* $commit_type]} {
2922 info_popup {Cannot abort while amending.
2924 You must finish amending this commit.
2926 return
2929 if {![lock_index abort]} return
2931 if {[string match *merge* $commit_type]} {
2932 set op merge
2933 } else {
2934 set op commit
2937 if {[ask_popup "Abort $op?
2939 Aborting the current $op will cause
2940 *ALL* uncommitted changes to be lost.
2942 Continue with aborting the current $op?"] eq {yes}} {
2943 set fd [open "| git read-tree --reset -u HEAD" r]
2944 fconfigure $fd -blocking 0 -translation binary
2945 fileevent $fd readable [list reset_hard_wait $fd]
2946 set ui_status_value {Aborting... please wait...}
2947 } else {
2948 unlock_index
2952 proc reset_hard_wait {fd} {
2953 global ui_comm
2955 read $fd
2956 if {[eof $fd]} {
2957 close $fd
2958 unlock_index
2960 $ui_comm delete 0.0 end
2961 $ui_comm edit modified false
2963 catch {file delete [gitdir MERGE_HEAD]}
2964 catch {file delete [gitdir rr-cache MERGE_RR]}
2965 catch {file delete [gitdir SQUASH_MSG]}
2966 catch {file delete [gitdir MERGE_MSG]}
2967 catch {file delete [gitdir GITGUI_MSG]}
2969 rescan {set ui_status_value {Abort completed. Ready.}}
2973 ######################################################################
2975 ## browser
2977 set next_browser_id 0
2979 proc new_browser {commit} {
2980 global next_browser_id cursor_ptr M1B
2981 global browser_commit browser_status browser_stack browser_path browser_busy
2983 set w .browser[incr next_browser_id]
2984 set w_list $w.list.l
2985 set browser_commit($w_list) $commit
2986 set browser_status($w_list) {Starting...}
2987 set browser_stack($w_list) {}
2988 set browser_path($w_list) $browser_commit($w_list):
2989 set browser_busy($w_list) 1
2991 toplevel $w
2992 label $w.path -textvariable browser_path($w_list) \
2993 -anchor w \
2994 -justify left \
2995 -borderwidth 1 \
2996 -relief sunken \
2997 -font font_uibold
2998 pack $w.path -anchor w -side top -fill x
3000 frame $w.list
3001 text $w_list -background white -borderwidth 0 \
3002 -cursor $cursor_ptr \
3003 -state disabled \
3004 -wrap none \
3005 -height 20 \
3006 -width 70 \
3007 -xscrollcommand [list $w.list.sbx set] \
3008 -yscrollcommand [list $w.list.sby set] \
3009 -font font_ui
3010 $w_list tag conf in_sel \
3011 -background [$w_list cget -foreground] \
3012 -foreground [$w_list cget -background]
3013 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3014 scrollbar $w.list.sby -orient v -command [list $w_list yview]
3015 pack $w.list.sbx -side bottom -fill x
3016 pack $w.list.sby -side right -fill y
3017 pack $w_list -side left -fill both -expand 1
3018 pack $w.list -side top -fill both -expand 1
3020 label $w.status -textvariable browser_status($w_list) \
3021 -anchor w \
3022 -justify left \
3023 -borderwidth 1 \
3024 -relief sunken \
3025 -font font_ui
3026 pack $w.status -anchor w -side bottom -fill x
3028 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3029 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3030 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3031 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3032 bind $w_list <Up> "browser_move -1 $w_list;break"
3033 bind $w_list <Down> "browser_move 1 $w_list;break"
3034 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3035 bind $w_list <Return> "browser_enter $w_list;break"
3036 bind $w_list <Prior> "browser_page -1 $w_list;break"
3037 bind $w_list <Next> "browser_page 1 $w_list;break"
3038 bind $w_list <Left> break
3039 bind $w_list <Right> break
3041 bind $w <Visibility> "focus $w"
3042 bind $w <Destroy> "
3043 array unset browser_buffer $w_list
3044 array unset browser_files $w_list
3045 array unset browser_status $w_list
3046 array unset browser_stack $w_list
3047 array unset browser_path $w_list
3048 array unset browser_commit $w_list
3049 array unset browser_busy $w_list
3051 wm title $w "[appname] ([reponame]): File Browser"
3052 ls_tree $w_list $browser_commit($w_list) {}
3055 proc browser_move {dir w} {
3056 global browser_files browser_busy
3058 if {$browser_busy($w)} return
3059 set lno [lindex [split [$w index in_sel.first] .] 0]
3060 incr lno $dir
3061 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3062 $w tag remove in_sel 0.0 end
3063 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3064 $w see $lno.0
3068 proc browser_page {dir w} {
3069 global browser_files browser_busy
3071 if {$browser_busy($w)} return
3072 $w yview scroll $dir pages
3073 set lno [expr {int(
3074 [lindex [$w yview] 0]
3075 * [llength $browser_files($w)]
3076 + 1)}]
3077 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3078 $w tag remove in_sel 0.0 end
3079 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3080 $w see $lno.0
3084 proc browser_parent {w} {
3085 global browser_files browser_status browser_path
3086 global browser_stack browser_busy
3088 if {$browser_busy($w)} return
3089 set info [lindex $browser_files($w) 0]
3090 if {[lindex $info 0] eq {parent}} {
3091 set parent [lindex $browser_stack($w) end-1]
3092 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3093 if {$browser_stack($w) eq {}} {
3094 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3095 } else {
3096 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3098 set browser_status($w) "Loading $browser_path($w)..."
3099 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3103 proc browser_enter {w} {
3104 global browser_files browser_status browser_path
3105 global browser_commit browser_stack browser_busy
3107 if {$browser_busy($w)} return
3108 set lno [lindex [split [$w index in_sel.first] .] 0]
3109 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3110 if {$info ne {}} {
3111 switch -- [lindex $info 0] {
3112 parent {
3113 browser_parent $w
3115 tree {
3116 set name [lindex $info 2]
3117 set escn [escape_path $name]
3118 set browser_status($w) "Loading $escn..."
3119 append browser_path($w) $escn
3120 ls_tree $w [lindex $info 1] $name
3122 blob {
3123 set name [lindex $info 2]
3124 set p {}
3125 foreach n $browser_stack($w) {
3126 append p [lindex $n 1]
3128 append p $name
3129 show_blame $browser_commit($w) $p
3135 proc browser_click {was_double_click w pos} {
3136 global browser_files browser_busy
3138 if {$browser_busy($w)} return
3139 set lno [lindex [split [$w index $pos] .] 0]
3140 focus $w
3142 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3143 $w tag remove in_sel 0.0 end
3144 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3145 if {$was_double_click} {
3146 browser_enter $w
3151 proc ls_tree {w tree_id name} {
3152 global browser_buffer browser_files browser_stack browser_busy
3154 set browser_buffer($w) {}
3155 set browser_files($w) {}
3156 set browser_busy($w) 1
3158 $w conf -state normal
3159 $w tag remove in_sel 0.0 end
3160 $w delete 0.0 end
3161 if {$browser_stack($w) ne {}} {
3162 $w image create end \
3163 -align center -padx 5 -pady 1 \
3164 -name icon0 \
3165 -image file_uplevel
3166 $w insert end {[Up To Parent]}
3167 lappend browser_files($w) parent
3169 lappend browser_stack($w) [list $tree_id $name]
3170 $w conf -state disabled
3172 set cmd [list git ls-tree -z $tree_id]
3173 set fd [open "| $cmd" r]
3174 fconfigure $fd -blocking 0 -translation binary -encoding binary
3175 fileevent $fd readable [list read_ls_tree $fd $w]
3178 proc read_ls_tree {fd w} {
3179 global browser_buffer browser_files browser_status browser_busy
3181 if {![winfo exists $w]} {
3182 catch {close $fd}
3183 return
3186 append browser_buffer($w) [read $fd]
3187 set pck [split $browser_buffer($w) "\0"]
3188 set browser_buffer($w) [lindex $pck end]
3190 set n [llength $browser_files($w)]
3191 $w conf -state normal
3192 foreach p [lrange $pck 0 end-1] {
3193 set info [split $p "\t"]
3194 set path [lindex $info 1]
3195 set info [split [lindex $info 0] { }]
3196 set type [lindex $info 1]
3197 set object [lindex $info 2]
3199 switch -- $type {
3200 blob {
3201 set image file_mod
3203 tree {
3204 set image file_dir
3205 append path /
3207 default {
3208 set image file_question
3212 if {$n > 0} {$w insert end "\n"}
3213 $w image create end \
3214 -align center -padx 5 -pady 1 \
3215 -name icon[incr n] \
3216 -image $image
3217 $w insert end [escape_path $path]
3218 lappend browser_files($w) [list $type $object $path]
3220 $w conf -state disabled
3222 if {[eof $fd]} {
3223 close $fd
3224 set browser_status($w) Ready.
3225 set browser_busy($w) 0
3226 array unset browser_buffer $w
3227 if {$n > 0} {
3228 $w tag add in_sel 1.0 2.0
3229 focus -force $w
3234 proc show_blame {commit path} {
3235 global next_browser_id blame_status blame_data
3237 if {[winfo ismapped .]} {
3238 set w .browser[incr next_browser_id]
3239 set tl $w
3240 toplevel $w
3241 } else {
3242 set w {}
3243 set tl .
3245 set blame_status($w) {Loading current file content...}
3247 label $w.path -text "$commit:$path" \
3248 -anchor w \
3249 -justify left \
3250 -borderwidth 1 \
3251 -relief sunken \
3252 -font font_uibold
3253 pack $w.path -side top -fill x
3255 frame $w.out
3256 text $w.out.loaded_t \
3257 -background white -borderwidth 0 \
3258 -state disabled \
3259 -wrap none \
3260 -height 40 \
3261 -width 1 \
3262 -font font_diff
3263 $w.out.loaded_t tag conf annotated -background grey
3265 text $w.out.linenumber_t \
3266 -background white -borderwidth 0 \
3267 -state disabled \
3268 -wrap none \
3269 -height 40 \
3270 -width 5 \
3271 -font font_diff
3272 $w.out.linenumber_t tag conf linenumber -justify right
3274 text $w.out.file_t \
3275 -background white -borderwidth 0 \
3276 -state disabled \
3277 -wrap none \
3278 -height 40 \
3279 -width 80 \
3280 -xscrollcommand [list $w.out.sbx set] \
3281 -font font_diff
3283 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3284 scrollbar $w.out.sby -orient v \
3285 -command [list scrollbar2many [list \
3286 $w.out.loaded_t \
3287 $w.out.linenumber_t \
3288 $w.out.file_t \
3289 ] yview]
3290 grid \
3291 $w.out.linenumber_t \
3292 $w.out.loaded_t \
3293 $w.out.file_t \
3294 $w.out.sby \
3295 -sticky nsew
3296 grid conf $w.out.sbx -column 2 -sticky we
3297 grid columnconfigure $w.out 2 -weight 1
3298 grid rowconfigure $w.out 0 -weight 1
3299 pack $w.out -fill both -expand 1
3301 label $w.status -textvariable blame_status($w) \
3302 -anchor w \
3303 -justify left \
3304 -borderwidth 1 \
3305 -relief sunken \
3306 -font font_ui
3307 pack $w.status -side bottom -fill x
3309 frame $w.cm
3310 text $w.cm.t \
3311 -background white -borderwidth 0 \
3312 -state disabled \
3313 -wrap none \
3314 -height 10 \
3315 -width 80 \
3316 -xscrollcommand [list $w.cm.sbx set] \
3317 -yscrollcommand [list $w.cm.sby set] \
3318 -font font_diff
3319 scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3320 scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3321 pack $w.cm.sby -side right -fill y
3322 pack $w.cm.sbx -side bottom -fill x
3323 pack $w.cm.t -expand 1 -fill both
3324 pack $w.cm -side bottom -fill x
3326 menu $w.ctxm -tearoff 0
3327 $w.ctxm add command -label "Copy Commit" \
3328 -font font_ui \
3329 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3331 foreach i [list \
3332 $w.out.loaded_t \
3333 $w.out.linenumber_t \
3334 $w.out.file_t] {
3335 $i tag conf in_sel \
3336 -background [$i cget -foreground] \
3337 -foreground [$i cget -background]
3338 $i conf -yscrollcommand \
3339 [list many2scrollbar [list \
3340 $w.out.loaded_t \
3341 $w.out.linenumber_t \
3342 $w.out.file_t \
3343 ] yview $w.out.sby]
3344 bind $i <Button-1> "
3345 blame_click {$w} \\
3346 $w.cm.t \\
3347 $w.out.linenumber_t \\
3348 $w.out.file_t \\
3349 $i @%x,%y
3350 focus $i
3352 bind_button3 $i "
3353 set cursorX %x
3354 set cursorY %y
3355 set cursorW %W
3356 tk_popup $w.ctxm %X %Y
3360 bind $w.cm.t <Button-1> "focus $w.cm.t"
3361 bind $tl <Visibility> "focus $tl"
3362 bind $tl <Destroy> "
3363 array unset blame_status {$w}
3364 array unset blame_data $w,*
3366 wm title $tl "[appname] ([reponame]): File Viewer"
3368 set blame_data($w,commit_count) 0
3369 set blame_data($w,commit_list) {}
3370 set blame_data($w,total_lines) 0
3371 set blame_data($w,blame_lines) 0
3372 set blame_data($w,highlight_commit) {}
3373 set blame_data($w,highlight_line) -1
3375 set cmd [list git cat-file blob "$commit:$path"]
3376 set fd [open "| $cmd" r]
3377 fconfigure $fd -blocking 0 -translation lf -encoding binary
3378 fileevent $fd readable [list read_blame_catfile \
3379 $fd $w $commit $path \
3380 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3383 proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3384 global blame_status blame_data
3386 if {![winfo exists $w_file]} {
3387 catch {close $fd}
3388 return
3391 set n $blame_data($w,total_lines)
3392 $w_load conf -state normal
3393 $w_line conf -state normal
3394 $w_file conf -state normal
3395 while {[gets $fd line] >= 0} {
3396 regsub "\r\$" $line {} line
3397 incr n
3398 $w_load insert end "\n"
3399 $w_line insert end "$n\n" linenumber
3400 $w_file insert end "$line\n"
3402 $w_load conf -state disabled
3403 $w_line conf -state disabled
3404 $w_file conf -state disabled
3405 set blame_data($w,total_lines) $n
3407 if {[eof $fd]} {
3408 close $fd
3409 blame_incremental_status $w
3410 set cmd [list git blame -M -C --incremental]
3411 lappend cmd $commit -- $path
3412 set fd [open "| $cmd" r]
3413 fconfigure $fd -blocking 0 -translation lf -encoding binary
3414 fileevent $fd readable [list read_blame_incremental $fd $w \
3415 $w_load $w_cmit $w_line $w_file]
3419 proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3420 global blame_status blame_data
3422 if {![winfo exists $w_file]} {
3423 catch {close $fd}
3424 return
3427 while {[gets $fd line] >= 0} {
3428 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3429 cmit original_line final_line line_count]} {
3430 set blame_data($w,commit) $cmit
3431 set blame_data($w,original_line) $original_line
3432 set blame_data($w,final_line) $final_line
3433 set blame_data($w,line_count) $line_count
3435 if {[catch {set g $blame_data($w,$cmit,order)}]} {
3436 $w_line tag conf g$cmit
3437 $w_file tag conf g$cmit
3438 $w_line tag raise in_sel
3439 $w_file tag raise in_sel
3440 $w_file tag raise sel
3441 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3442 incr blame_data($w,commit_count)
3443 lappend blame_data($w,commit_list) $cmit
3445 } elseif {[string match {filename *} $line]} {
3446 set file [string range $line 9 end]
3447 set n $blame_data($w,line_count)
3448 set lno $blame_data($w,final_line)
3449 set cmit $blame_data($w,commit)
3451 while {$n > 0} {
3452 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3453 $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3454 } else {
3455 $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3456 $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3459 set blame_data($w,line$lno,commit) $cmit
3460 set blame_data($w,line$lno,file) $file
3461 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3462 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3464 if {$blame_data($w,highlight_line) == -1} {
3465 if {[lindex [$w_file yview] 0] == 0} {
3466 $w_file see $lno.0
3467 blame_showcommit $w $w_cmit $w_line $w_file $lno
3469 } elseif {$blame_data($w,highlight_line) == $lno} {
3470 blame_showcommit $w $w_cmit $w_line $w_file $lno
3473 incr n -1
3474 incr lno
3475 incr blame_data($w,blame_lines)
3478 set hc $blame_data($w,highlight_commit)
3479 if {$hc ne {}
3480 && [expr {$blame_data($w,$hc,order) + 1}]
3481 == $blame_data($w,$cmit,order)} {
3482 blame_showcommit $w $w_cmit $w_line $w_file \
3483 $blame_data($w,highlight_line)
3485 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3486 set blame_data($w,$blame_data($w,commit),$header) $data
3490 if {[eof $fd]} {
3491 close $fd
3492 set blame_status($w) {Annotation complete.}
3493 } else {
3494 blame_incremental_status $w
3498 proc blame_incremental_status {w} {
3499 global blame_status blame_data
3501 set blame_status($w) [format \
3502 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3503 $blame_data($w,blame_lines) \
3504 $blame_data($w,total_lines) \
3505 [expr {100 * $blame_data($w,blame_lines)
3506 / $blame_data($w,total_lines)}]]
3509 proc blame_click {w w_cmit w_line w_file cur_w pos} {
3510 set lno [lindex [split [$cur_w index $pos] .] 0]
3511 if {$lno eq {}} return
3513 $w_line tag remove in_sel 0.0 end
3514 $w_file tag remove in_sel 0.0 end
3515 $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3516 $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3518 blame_showcommit $w $w_cmit $w_line $w_file $lno
3521 set blame_colors {
3522 #ff4040
3523 #ff40ff
3524 #4040ff
3527 proc blame_showcommit {w w_cmit w_line w_file lno} {
3528 global blame_colors blame_data repo_config
3530 set cmit $blame_data($w,highlight_commit)
3531 if {$cmit ne {}} {
3532 set idx $blame_data($w,$cmit,order)
3533 set i 0
3534 foreach c $blame_colors {
3535 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3536 $w_line tag conf g$h -background white
3537 $w_file tag conf g$h -background white
3538 incr i
3542 $w_cmit conf -state normal
3543 $w_cmit delete 0.0 end
3544 if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3545 set cmit {}
3546 $w_cmit insert end "Loading annotation..."
3547 } else {
3548 set idx $blame_data($w,$cmit,order)
3549 set i 0
3550 foreach c $blame_colors {
3551 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3552 $w_line tag conf g$h -background $c
3553 $w_file tag conf g$h -background $c
3554 incr i
3557 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3558 set msg {}
3559 catch {
3560 set fd [open "| git cat-file commit $cmit" r]
3561 fconfigure $fd -encoding binary -translation lf
3562 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3563 set enc utf-8
3565 while {[gets $fd line] > 0} {
3566 if {[string match {encoding *} $line]} {
3567 set enc [string tolower [string range $line 9 end]]
3570 fconfigure $fd -encoding $enc
3571 set msg [string trim [read $fd]]
3572 close $fd
3574 set blame_data($w,$cmit,message) $msg
3577 set author_name {}
3578 set author_email {}
3579 set author_time {}
3580 catch {set author_name $blame_data($w,$cmit,author)}
3581 catch {set author_email $blame_data($w,$cmit,author-mail)}
3582 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3584 set committer_name {}
3585 set committer_email {}
3586 set committer_time {}
3587 catch {set committer_name $blame_data($w,$cmit,committer)}
3588 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3589 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3591 $w_cmit insert end "commit $cmit\n"
3592 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3593 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3594 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3595 $w_cmit insert end "\n"
3596 $w_cmit insert end $msg
3598 $w_cmit conf -state disabled
3600 set blame_data($w,highlight_line) $lno
3601 set blame_data($w,highlight_commit) $cmit
3604 proc blame_copycommit {w i pos} {
3605 global blame_data
3606 set lno [lindex [split [$i index $pos] .] 0]
3607 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3608 clipboard clear
3609 clipboard append \
3610 -format STRING \
3611 -type STRING \
3612 -- $commit
3616 ######################################################################
3618 ## icons
3620 set filemask {
3621 #define mask_width 14
3622 #define mask_height 15
3623 static unsigned char mask_bits[] = {
3624 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3625 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3626 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3629 image create bitmap file_plain -background white -foreground black -data {
3630 #define plain_width 14
3631 #define plain_height 15
3632 static unsigned char plain_bits[] = {
3633 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3634 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3635 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3636 } -maskdata $filemask
3638 image create bitmap file_mod -background white -foreground blue -data {
3639 #define mod_width 14
3640 #define mod_height 15
3641 static unsigned char mod_bits[] = {
3642 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3643 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3644 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3645 } -maskdata $filemask
3647 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3648 #define file_fulltick_width 14
3649 #define file_fulltick_height 15
3650 static unsigned char file_fulltick_bits[] = {
3651 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3652 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3653 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3654 } -maskdata $filemask
3656 image create bitmap file_parttick -background white -foreground "#005050" -data {
3657 #define parttick_width 14
3658 #define parttick_height 15
3659 static unsigned char parttick_bits[] = {
3660 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3661 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3662 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3663 } -maskdata $filemask
3665 image create bitmap file_question -background white -foreground black -data {
3666 #define file_question_width 14
3667 #define file_question_height 15
3668 static unsigned char file_question_bits[] = {
3669 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3670 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3671 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3672 } -maskdata $filemask
3674 image create bitmap file_removed -background white -foreground red -data {
3675 #define file_removed_width 14
3676 #define file_removed_height 15
3677 static unsigned char file_removed_bits[] = {
3678 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3679 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3680 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3681 } -maskdata $filemask
3683 image create bitmap file_merge -background white -foreground blue -data {
3684 #define file_merge_width 14
3685 #define file_merge_height 15
3686 static unsigned char file_merge_bits[] = {
3687 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3688 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3689 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3690 } -maskdata $filemask
3692 set file_dir_data {
3693 #define file_width 18
3694 #define file_height 18
3695 static unsigned char file_bits[] = {
3696 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3697 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3698 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3699 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3700 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3702 image create bitmap file_dir -background white -foreground blue \
3703 -data $file_dir_data -maskdata $file_dir_data
3704 unset file_dir_data
3706 set file_uplevel_data {
3707 #define up_width 15
3708 #define up_height 15
3709 static unsigned char up_bits[] = {
3710 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3711 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3712 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3714 image create bitmap file_uplevel -background white -foreground red \
3715 -data $file_uplevel_data -maskdata $file_uplevel_data
3716 unset file_uplevel_data
3718 set ui_index .vpane.files.index.list
3719 set ui_workdir .vpane.files.workdir.list
3721 set all_icons(_$ui_index) file_plain
3722 set all_icons(A$ui_index) file_fulltick
3723 set all_icons(M$ui_index) file_fulltick
3724 set all_icons(D$ui_index) file_removed
3725 set all_icons(U$ui_index) file_merge
3727 set all_icons(_$ui_workdir) file_plain
3728 set all_icons(M$ui_workdir) file_mod
3729 set all_icons(D$ui_workdir) file_question
3730 set all_icons(U$ui_workdir) file_merge
3731 set all_icons(O$ui_workdir) file_plain
3733 set max_status_desc 0
3734 foreach i {
3735 {__ "Unmodified"}
3737 {_M "Modified, not staged"}
3738 {M_ "Staged for commit"}
3739 {MM "Portions staged for commit"}
3740 {MD "Staged for commit, missing"}
3742 {_O "Untracked, not staged"}
3743 {A_ "Staged for commit"}
3744 {AM "Portions staged for commit"}
3745 {AD "Staged for commit, missing"}
3747 {_D "Missing"}
3748 {D_ "Staged for removal"}
3749 {DO "Staged for removal, still present"}
3751 {U_ "Requires merge resolution"}
3752 {UU "Requires merge resolution"}
3753 {UM "Requires merge resolution"}
3754 {UD "Requires merge resolution"}
3756 if {$max_status_desc < [string length [lindex $i 1]]} {
3757 set max_status_desc [string length [lindex $i 1]]
3759 set all_descs([lindex $i 0]) [lindex $i 1]
3761 unset i
3763 ######################################################################
3765 ## util
3767 proc bind_button3 {w cmd} {
3768 bind $w <Any-Button-3> $cmd
3769 if {[is_MacOSX]} {
3770 bind $w <Control-Button-1> $cmd
3774 proc scrollbar2many {list mode args} {
3775 foreach w $list {eval $w $mode $args}
3778 proc many2scrollbar {list mode sb top bottom} {
3779 $sb set $top $bottom
3780 foreach w $list {$w $mode moveto $top}
3783 proc incr_font_size {font {amt 1}} {
3784 set sz [font configure $font -size]
3785 incr sz $amt
3786 font configure $font -size $sz
3787 font configure ${font}bold -size $sz
3790 proc hook_failed_popup {hook msg} {
3791 set w .hookfail
3792 toplevel $w
3794 frame $w.m
3795 label $w.m.l1 -text "$hook hook failed:" \
3796 -anchor w \
3797 -justify left \
3798 -font font_uibold
3799 text $w.m.t \
3800 -background white -borderwidth 1 \
3801 -relief sunken \
3802 -width 80 -height 10 \
3803 -font font_diff \
3804 -yscrollcommand [list $w.m.sby set]
3805 label $w.m.l2 \
3806 -text {You must correct the above errors before committing.} \
3807 -anchor w \
3808 -justify left \
3809 -font font_uibold
3810 scrollbar $w.m.sby -command [list $w.m.t yview]
3811 pack $w.m.l1 -side top -fill x
3812 pack $w.m.l2 -side bottom -fill x
3813 pack $w.m.sby -side right -fill y
3814 pack $w.m.t -side left -fill both -expand 1
3815 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3817 $w.m.t insert 1.0 $msg
3818 $w.m.t conf -state disabled
3820 button $w.ok -text OK \
3821 -width 15 \
3822 -font font_ui \
3823 -command "destroy $w"
3824 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3826 bind $w <Visibility> "grab $w; focus $w"
3827 bind $w <Key-Return> "destroy $w"
3828 wm title $w "[appname] ([reponame]): error"
3829 tkwait window $w
3832 set next_console_id 0
3834 proc new_console {short_title long_title} {
3835 global next_console_id console_data
3836 set w .console[incr next_console_id]
3837 set console_data($w) [list $short_title $long_title]
3838 return [console_init $w]
3841 proc console_init {w} {
3842 global console_cr console_data M1B
3844 set console_cr($w) 1.0
3845 toplevel $w
3846 frame $w.m
3847 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3848 -anchor w \
3849 -justify left \
3850 -font font_uibold
3851 text $w.m.t \
3852 -background white -borderwidth 1 \
3853 -relief sunken \
3854 -width 80 -height 10 \
3855 -font font_diff \
3856 -state disabled \
3857 -yscrollcommand [list $w.m.sby set]
3858 label $w.m.s -text {Working... please wait...} \
3859 -anchor w \
3860 -justify left \
3861 -font font_uibold
3862 scrollbar $w.m.sby -command [list $w.m.t yview]
3863 pack $w.m.l1 -side top -fill x
3864 pack $w.m.s -side bottom -fill x
3865 pack $w.m.sby -side right -fill y
3866 pack $w.m.t -side left -fill both -expand 1
3867 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3869 menu $w.ctxm -tearoff 0
3870 $w.ctxm add command -label "Copy" \
3871 -font font_ui \
3872 -command "tk_textCopy $w.m.t"
3873 $w.ctxm add command -label "Select All" \
3874 -font font_ui \
3875 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3876 $w.ctxm add command -label "Copy All" \
3877 -font font_ui \
3878 -command "
3879 $w.m.t tag add sel 0.0 end
3880 tk_textCopy $w.m.t
3881 $w.m.t tag remove sel 0.0 end
3884 button $w.ok -text {Close} \
3885 -font font_ui \
3886 -state disabled \
3887 -command "destroy $w"
3888 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3890 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3891 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3892 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3893 bind $w <Visibility> "focus $w"
3894 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3895 return $w
3898 proc console_exec {w cmd after} {
3899 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3900 # But most users need that so we have to relogin. :-(
3902 if {[is_Cygwin]} {
3903 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3906 # -- Tcl won't let us redirect both stdout and stderr to
3907 # the same pipe. So pass it through cat...
3909 set cmd [concat | $cmd |& cat]
3911 set fd_f [open $cmd r]
3912 fconfigure $fd_f -blocking 0 -translation binary
3913 fileevent $fd_f readable [list console_read $w $fd_f $after]
3916 proc console_read {w fd after} {
3917 global console_cr
3919 set buf [read $fd]
3920 if {$buf ne {}} {
3921 if {![winfo exists $w]} {console_init $w}
3922 $w.m.t conf -state normal
3923 set c 0
3924 set n [string length $buf]
3925 while {$c < $n} {
3926 set cr [string first "\r" $buf $c]
3927 set lf [string first "\n" $buf $c]
3928 if {$cr < 0} {set cr [expr {$n + 1}]}
3929 if {$lf < 0} {set lf [expr {$n + 1}]}
3931 if {$lf < $cr} {
3932 $w.m.t insert end [string range $buf $c $lf]
3933 set console_cr($w) [$w.m.t index {end -1c}]
3934 set c $lf
3935 incr c
3936 } else {
3937 $w.m.t delete $console_cr($w) end
3938 $w.m.t insert end "\n"
3939 $w.m.t insert end [string range $buf $c $cr]
3940 set c $cr
3941 incr c
3944 $w.m.t conf -state disabled
3945 $w.m.t see end
3948 fconfigure $fd -blocking 1
3949 if {[eof $fd]} {
3950 if {[catch {close $fd}]} {
3951 set ok 0
3952 } else {
3953 set ok 1
3955 uplevel #0 $after $w $ok
3956 return
3958 fconfigure $fd -blocking 0
3961 proc console_chain {cmdlist w {ok 1}} {
3962 if {$ok} {
3963 if {[llength $cmdlist] == 0} {
3964 console_done $w $ok
3965 return
3968 set cmd [lindex $cmdlist 0]
3969 set cmdlist [lrange $cmdlist 1 end]
3971 if {[lindex $cmd 0] eq {console_exec}} {
3972 console_exec $w \
3973 [lindex $cmd 1] \
3974 [list console_chain $cmdlist]
3975 } else {
3976 uplevel #0 $cmd $cmdlist $w $ok
3978 } else {
3979 console_done $w $ok
3983 proc console_done {args} {
3984 global console_cr console_data
3986 switch -- [llength $args] {
3988 set w [lindex $args 0]
3989 set ok [lindex $args 1]
3992 set w [lindex $args 1]
3993 set ok [lindex $args 2]
3995 default {
3996 error "wrong number of args: console_done ?ignored? w ok"
4000 if {$ok} {
4001 if {[winfo exists $w]} {
4002 $w.m.s conf -background green -text {Success}
4003 $w.ok conf -state normal
4005 } else {
4006 if {![winfo exists $w]} {
4007 console_init $w
4009 $w.m.s conf -background red -text {Error: Command Failed}
4010 $w.ok conf -state normal
4013 array unset console_cr $w
4014 array unset console_data $w
4017 ######################################################################
4019 ## ui commands
4021 set starting_gitk_msg {Starting gitk... please wait...}
4023 proc do_gitk {revs} {
4024 global env ui_status_value starting_gitk_msg
4026 # -- Always start gitk through whatever we were loaded with. This
4027 # lets us bypass using shell process on Windows systems.
4029 set cmd [info nameofexecutable]
4030 lappend cmd [gitexec gitk]
4031 if {$revs ne {}} {
4032 append cmd { }
4033 append cmd $revs
4036 if {[catch {eval exec $cmd &} err]} {
4037 error_popup "Failed to start gitk:\n\n$err"
4038 } else {
4039 set ui_status_value $starting_gitk_msg
4040 after 10000 {
4041 if {$ui_status_value eq $starting_gitk_msg} {
4042 set ui_status_value {Ready.}
4048 proc do_stats {} {
4049 set fd [open "| git count-objects -v" r]
4050 while {[gets $fd line] > 0} {
4051 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4052 set stats($name) $value
4055 close $fd
4057 set packed_sz 0
4058 foreach p [glob -directory [gitdir objects pack] \
4059 -type f \
4060 -nocomplain -- *] {
4061 incr packed_sz [file size $p]
4063 if {$packed_sz > 0} {
4064 set stats(size-pack) [expr {$packed_sz / 1024}]
4067 set w .stats_view
4068 toplevel $w
4069 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4071 label $w.header -text {Database Statistics} \
4072 -font font_uibold
4073 pack $w.header -side top -fill x
4075 frame $w.buttons -border 1
4076 button $w.buttons.close -text Close \
4077 -font font_ui \
4078 -command [list destroy $w]
4079 button $w.buttons.gc -text {Compress Database} \
4080 -font font_ui \
4081 -command "destroy $w;do_gc"
4082 pack $w.buttons.close -side right
4083 pack $w.buttons.gc -side left
4084 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4086 frame $w.stat -borderwidth 1 -relief solid
4087 foreach s {
4088 {count {Number of loose objects}}
4089 {size {Disk space used by loose objects} { KiB}}
4090 {in-pack {Number of packed objects}}
4091 {packs {Number of packs}}
4092 {size-pack {Disk space used by packed objects} { KiB}}
4093 {prune-packable {Packed objects waiting for pruning}}
4094 {garbage {Garbage files}}
4096 set name [lindex $s 0]
4097 set label [lindex $s 1]
4098 if {[catch {set value $stats($name)}]} continue
4099 if {[llength $s] > 2} {
4100 set value "$value[lindex $s 2]"
4103 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4104 label $w.stat.v_$name -text $value -anchor w -font font_ui
4105 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4107 pack $w.stat -pady 10 -padx 10
4109 bind $w <Visibility> "grab $w; focus $w"
4110 bind $w <Key-Escape> [list destroy $w]
4111 bind $w <Key-Return> [list destroy $w]
4112 wm title $w "[appname] ([reponame]): Database Statistics"
4113 tkwait window $w
4116 proc do_gc {} {
4117 set w [new_console {gc} {Compressing the object database}]
4118 console_chain {
4119 {console_exec {git pack-refs --prune}}
4120 {console_exec {git reflog expire --all}}
4121 {console_exec {git repack -a -d -l}}
4122 {console_exec {git rerere gc}}
4123 } $w
4126 proc do_fsck_objects {} {
4127 set w [new_console {fsck-objects} \
4128 {Verifying the object database with fsck-objects}]
4129 set cmd [list git fsck-objects]
4130 lappend cmd --full
4131 lappend cmd --cache
4132 lappend cmd --strict
4133 console_exec $w $cmd console_done
4136 set is_quitting 0
4138 proc do_quit {} {
4139 global ui_comm is_quitting repo_config commit_type
4141 if {$is_quitting} return
4142 set is_quitting 1
4144 if {[winfo exists $ui_comm]} {
4145 # -- Stash our current commit buffer.
4147 set save [gitdir GITGUI_MSG]
4148 set msg [string trim [$ui_comm get 0.0 end]]
4149 regsub -all -line {[ \r\t]+$} $msg {} msg
4150 if {(![string match amend* $commit_type]
4151 || [$ui_comm edit modified])
4152 && $msg ne {}} {
4153 catch {
4154 set fd [open $save w]
4155 puts -nonewline $fd $msg
4156 close $fd
4158 } else {
4159 catch {file delete $save}
4162 # -- Stash our current window geometry into this repository.
4164 set cfg_geometry [list]
4165 lappend cfg_geometry [wm geometry .]
4166 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4167 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4168 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4169 set rc_geometry {}
4171 if {$cfg_geometry ne $rc_geometry} {
4172 catch {git config gui.geometry $cfg_geometry}
4176 destroy .
4179 proc do_rescan {} {
4180 rescan {set ui_status_value {Ready.}}
4183 proc unstage_helper {txt paths} {
4184 global file_states current_diff_path
4186 if {![lock_index begin-update]} return
4188 set pathList [list]
4189 set after {}
4190 foreach path $paths {
4191 switch -glob -- [lindex $file_states($path) 0] {
4192 A? -
4193 M? -
4194 D? {
4195 lappend pathList $path
4196 if {$path eq $current_diff_path} {
4197 set after {reshow_diff;}
4202 if {$pathList eq {}} {
4203 unlock_index
4204 } else {
4205 update_indexinfo \
4206 $txt \
4207 $pathList \
4208 [concat $after {set ui_status_value {Ready.}}]
4212 proc do_unstage_selection {} {
4213 global current_diff_path selected_paths
4215 if {[array size selected_paths] > 0} {
4216 unstage_helper \
4217 {Unstaging selected files from commit} \
4218 [array names selected_paths]
4219 } elseif {$current_diff_path ne {}} {
4220 unstage_helper \
4221 "Unstaging [short_path $current_diff_path] from commit" \
4222 [list $current_diff_path]
4226 proc add_helper {txt paths} {
4227 global file_states current_diff_path
4229 if {![lock_index begin-update]} return
4231 set pathList [list]
4232 set after {}
4233 foreach path $paths {
4234 switch -glob -- [lindex $file_states($path) 0] {
4235 _O -
4236 ?M -
4237 ?D -
4238 U? {
4239 lappend pathList $path
4240 if {$path eq $current_diff_path} {
4241 set after {reshow_diff;}
4246 if {$pathList eq {}} {
4247 unlock_index
4248 } else {
4249 update_index \
4250 $txt \
4251 $pathList \
4252 [concat $after {set ui_status_value {Ready to commit.}}]
4256 proc do_add_selection {} {
4257 global current_diff_path selected_paths
4259 if {[array size selected_paths] > 0} {
4260 add_helper \
4261 {Adding selected files} \
4262 [array names selected_paths]
4263 } elseif {$current_diff_path ne {}} {
4264 add_helper \
4265 "Adding [short_path $current_diff_path]" \
4266 [list $current_diff_path]
4270 proc do_add_all {} {
4271 global file_states
4273 set paths [list]
4274 foreach path [array names file_states] {
4275 switch -glob -- [lindex $file_states($path) 0] {
4276 U? {continue}
4277 ?M -
4278 ?D {lappend paths $path}
4281 add_helper {Adding all changed files} $paths
4284 proc revert_helper {txt paths} {
4285 global file_states current_diff_path
4287 if {![lock_index begin-update]} return
4289 set pathList [list]
4290 set after {}
4291 foreach path $paths {
4292 switch -glob -- [lindex $file_states($path) 0] {
4293 U? {continue}
4294 ?M -
4295 ?D {
4296 lappend pathList $path
4297 if {$path eq $current_diff_path} {
4298 set after {reshow_diff;}
4304 set n [llength $pathList]
4305 if {$n == 0} {
4306 unlock_index
4307 return
4308 } elseif {$n == 1} {
4309 set s "[short_path [lindex $pathList]]"
4310 } else {
4311 set s "these $n files"
4314 set reply [tk_dialog \
4315 .confirm_revert \
4316 "[appname] ([reponame])" \
4317 "Revert changes in $s?
4319 Any unadded changes will be permanently lost by the revert." \
4320 question \
4322 {Do Nothing} \
4323 {Revert Changes} \
4325 if {$reply == 1} {
4326 checkout_index \
4327 $txt \
4328 $pathList \
4329 [concat $after {set ui_status_value {Ready.}}]
4330 } else {
4331 unlock_index
4335 proc do_revert_selection {} {
4336 global current_diff_path selected_paths
4338 if {[array size selected_paths] > 0} {
4339 revert_helper \
4340 {Reverting selected files} \
4341 [array names selected_paths]
4342 } elseif {$current_diff_path ne {}} {
4343 revert_helper \
4344 "Reverting [short_path $current_diff_path]" \
4345 [list $current_diff_path]
4349 proc do_signoff {} {
4350 global ui_comm
4352 set me [committer_ident]
4353 if {$me eq {}} return
4355 set sob "Signed-off-by: $me"
4356 set last [$ui_comm get {end -1c linestart} {end -1c}]
4357 if {$last ne $sob} {
4358 $ui_comm edit separator
4359 if {$last ne {}
4360 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4361 $ui_comm insert end "\n"
4363 $ui_comm insert end "\n$sob"
4364 $ui_comm edit separator
4365 $ui_comm see end
4369 proc do_select_commit_type {} {
4370 global commit_type selected_commit_type
4372 if {$selected_commit_type eq {new}
4373 && [string match amend* $commit_type]} {
4374 create_new_commit
4375 } elseif {$selected_commit_type eq {amend}
4376 && ![string match amend* $commit_type]} {
4377 load_last_commit
4379 # The amend request was rejected...
4381 if {![string match amend* $commit_type]} {
4382 set selected_commit_type new
4387 proc do_commit {} {
4388 commit_tree
4391 proc do_about {} {
4392 global appvers copyright
4393 global tcl_patchLevel tk_patchLevel
4395 set w .about_dialog
4396 toplevel $w
4397 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4399 label $w.header -text "About [appname]" \
4400 -font font_uibold
4401 pack $w.header -side top -fill x
4403 frame $w.buttons
4404 button $w.buttons.close -text {Close} \
4405 -font font_ui \
4406 -command [list destroy $w]
4407 pack $w.buttons.close -side right
4408 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4410 label $w.desc \
4411 -text "[appname] - a commit creation tool for Git.
4412 $copyright" \
4413 -padx 5 -pady 5 \
4414 -justify left \
4415 -anchor w \
4416 -borderwidth 1 \
4417 -relief solid \
4418 -font font_ui
4419 pack $w.desc -side top -fill x -padx 5 -pady 5
4421 set v {}
4422 append v "[appname] version $appvers\n"
4423 append v "[git version]\n"
4424 append v "\n"
4425 if {$tcl_patchLevel eq $tk_patchLevel} {
4426 append v "Tcl/Tk version $tcl_patchLevel"
4427 } else {
4428 append v "Tcl version $tcl_patchLevel"
4429 append v ", Tk version $tk_patchLevel"
4432 label $w.vers \
4433 -text $v \
4434 -padx 5 -pady 5 \
4435 -justify left \
4436 -anchor w \
4437 -borderwidth 1 \
4438 -relief solid \
4439 -font font_ui
4440 pack $w.vers -side top -fill x -padx 5 -pady 5
4442 menu $w.ctxm -tearoff 0
4443 $w.ctxm add command \
4444 -label {Copy} \
4445 -font font_ui \
4446 -command "
4447 clipboard clear
4448 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4451 bind $w <Visibility> "grab $w; focus $w"
4452 bind $w <Key-Escape> "destroy $w"
4453 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4454 wm title $w "About [appname]"
4455 tkwait window $w
4458 proc do_options {} {
4459 global repo_config global_config font_descs
4460 global repo_config_new global_config_new
4462 array unset repo_config_new
4463 array unset global_config_new
4464 foreach name [array names repo_config] {
4465 set repo_config_new($name) $repo_config($name)
4467 load_config 1
4468 foreach name [array names repo_config] {
4469 switch -- $name {
4470 gui.diffcontext {continue}
4472 set repo_config_new($name) $repo_config($name)
4474 foreach name [array names global_config] {
4475 set global_config_new($name) $global_config($name)
4478 set w .options_editor
4479 toplevel $w
4480 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4482 label $w.header -text "[appname] Options" \
4483 -font font_uibold
4484 pack $w.header -side top -fill x
4486 frame $w.buttons
4487 button $w.buttons.restore -text {Restore Defaults} \
4488 -font font_ui \
4489 -command do_restore_defaults
4490 pack $w.buttons.restore -side left
4491 button $w.buttons.save -text Save \
4492 -font font_ui \
4493 -command [list do_save_config $w]
4494 pack $w.buttons.save -side right
4495 button $w.buttons.cancel -text {Cancel} \
4496 -font font_ui \
4497 -command [list destroy $w]
4498 pack $w.buttons.cancel -side right -padx 5
4499 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4501 labelframe $w.repo -text "[reponame] Repository" \
4502 -font font_ui
4503 labelframe $w.global -text {Global (All Repositories)} \
4504 -font font_ui
4505 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4506 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4508 set optid 0
4509 foreach option {
4510 {t user.name {User Name}}
4511 {t user.email {Email Address}}
4513 {b merge.summary {Summarize Merge Commits}}
4514 {i-1..5 merge.verbosity {Merge Verbosity}}
4516 {b gui.trustmtime {Trust File Modification Timestamps}}
4517 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4518 {t gui.newbranchtemplate {New Branch Name Template}}
4520 set type [lindex $option 0]
4521 set name [lindex $option 1]
4522 set text [lindex $option 2]
4523 incr optid
4524 foreach f {repo global} {
4525 switch -glob -- $type {
4527 checkbutton $w.$f.$optid -text $text \
4528 -variable ${f}_config_new($name) \
4529 -onvalue true \
4530 -offvalue false \
4531 -font font_ui
4532 pack $w.$f.$optid -side top -anchor w
4534 i-* {
4535 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4536 frame $w.$f.$optid
4537 label $w.$f.$optid.l -text "$text:" -font font_ui
4538 pack $w.$f.$optid.l -side left -anchor w -fill x
4539 spinbox $w.$f.$optid.v \
4540 -textvariable ${f}_config_new($name) \
4541 -from $min \
4542 -to $max \
4543 -increment 1 \
4544 -width [expr {1 + [string length $max]}] \
4545 -font font_ui
4546 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4547 pack $w.$f.$optid.v -side right -anchor e -padx 5
4548 pack $w.$f.$optid -side top -anchor w -fill x
4551 frame $w.$f.$optid
4552 label $w.$f.$optid.l -text "$text:" -font font_ui
4553 entry $w.$f.$optid.v \
4554 -borderwidth 1 \
4555 -relief sunken \
4556 -width 20 \
4557 -textvariable ${f}_config_new($name) \
4558 -font font_ui
4559 pack $w.$f.$optid.l -side left -anchor w
4560 pack $w.$f.$optid.v -side left -anchor w \
4561 -fill x -expand 1 \
4562 -padx 5
4563 pack $w.$f.$optid -side top -anchor w -fill x
4569 set all_fonts [lsort [font families]]
4570 foreach option $font_descs {
4571 set name [lindex $option 0]
4572 set font [lindex $option 1]
4573 set text [lindex $option 2]
4575 set global_config_new(gui.$font^^family) \
4576 [font configure $font -family]
4577 set global_config_new(gui.$font^^size) \
4578 [font configure $font -size]
4580 frame $w.global.$name
4581 label $w.global.$name.l -text "$text:" -font font_ui
4582 pack $w.global.$name.l -side left -anchor w -fill x
4583 eval tk_optionMenu $w.global.$name.family \
4584 global_config_new(gui.$font^^family) \
4585 $all_fonts
4586 spinbox $w.global.$name.size \
4587 -textvariable global_config_new(gui.$font^^size) \
4588 -from 2 -to 80 -increment 1 \
4589 -width 3 \
4590 -font font_ui
4591 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4592 pack $w.global.$name.size -side right -anchor e
4593 pack $w.global.$name.family -side right -anchor e
4594 pack $w.global.$name -side top -anchor w -fill x
4597 bind $w <Visibility> "grab $w; focus $w"
4598 bind $w <Key-Escape> "destroy $w"
4599 wm title $w "[appname] ([reponame]): Options"
4600 tkwait window $w
4603 proc do_restore_defaults {} {
4604 global font_descs default_config repo_config
4605 global repo_config_new global_config_new
4607 foreach name [array names default_config] {
4608 set repo_config_new($name) $default_config($name)
4609 set global_config_new($name) $default_config($name)
4612 foreach option $font_descs {
4613 set name [lindex $option 0]
4614 set repo_config(gui.$name) $default_config(gui.$name)
4616 apply_config
4618 foreach option $font_descs {
4619 set name [lindex $option 0]
4620 set font [lindex $option 1]
4621 set global_config_new(gui.$font^^family) \
4622 [font configure $font -family]
4623 set global_config_new(gui.$font^^size) \
4624 [font configure $font -size]
4628 proc do_save_config {w} {
4629 if {[catch {save_config} err]} {
4630 error_popup "Failed to completely save options:\n\n$err"
4632 reshow_diff
4633 destroy $w
4636 proc do_windows_shortcut {} {
4637 global argv0
4639 set fn [tk_getSaveFile \
4640 -parent . \
4641 -title "[appname] ([reponame]): Create Desktop Icon" \
4642 -initialfile "Git [reponame].bat"]
4643 if {$fn != {}} {
4644 if {[catch {
4645 set fd [open $fn w]
4646 puts $fd "@ECHO Entering [reponame]"
4647 puts $fd "@ECHO Starting git-gui... please wait..."
4648 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4649 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4650 puts -nonewline $fd "@\"[info nameofexecutable]\""
4651 puts $fd " \"[file normalize $argv0]\""
4652 close $fd
4653 } err]} {
4654 error_popup "Cannot write script:\n\n$err"
4659 proc do_cygwin_shortcut {} {
4660 global argv0
4662 if {[catch {
4663 set desktop [exec cygpath \
4664 --windows \
4665 --absolute \
4666 --long-name \
4667 --desktop]
4668 }]} {
4669 set desktop .
4671 set fn [tk_getSaveFile \
4672 -parent . \
4673 -title "[appname] ([reponame]): Create Desktop Icon" \
4674 -initialdir $desktop \
4675 -initialfile "Git [reponame].bat"]
4676 if {$fn != {}} {
4677 if {[catch {
4678 set fd [open $fn w]
4679 set sh [exec cygpath \
4680 --windows \
4681 --absolute \
4682 /bin/sh]
4683 set me [exec cygpath \
4684 --unix \
4685 --absolute \
4686 $argv0]
4687 set gd [exec cygpath \
4688 --unix \
4689 --absolute \
4690 [gitdir]]
4691 set gw [exec cygpath \
4692 --windows \
4693 --absolute \
4694 [file dirname [gitdir]]]
4695 regsub -all ' $me "'\\''" me
4696 regsub -all ' $gd "'\\''" gd
4697 puts $fd "@ECHO Entering $gw"
4698 puts $fd "@ECHO Starting git-gui... please wait..."
4699 puts -nonewline $fd "@\"$sh\" --login -c \""
4700 puts -nonewline $fd "GIT_DIR='$gd'"
4701 puts -nonewline $fd " '$me'"
4702 puts $fd "&\""
4703 close $fd
4704 } err]} {
4705 error_popup "Cannot write script:\n\n$err"
4710 proc do_macosx_app {} {
4711 global argv0 env
4713 set fn [tk_getSaveFile \
4714 -parent . \
4715 -title "[appname] ([reponame]): Create Desktop Icon" \
4716 -initialdir [file join $env(HOME) Desktop] \
4717 -initialfile "Git [reponame].app"]
4718 if {$fn != {}} {
4719 if {[catch {
4720 set Contents [file join $fn Contents]
4721 set MacOS [file join $Contents MacOS]
4722 set exe [file join $MacOS git-gui]
4724 file mkdir $MacOS
4726 set fd [open [file join $Contents Info.plist] w]
4727 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4728 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4729 <plist version="1.0">
4730 <dict>
4731 <key>CFBundleDevelopmentRegion</key>
4732 <string>English</string>
4733 <key>CFBundleExecutable</key>
4734 <string>git-gui</string>
4735 <key>CFBundleIdentifier</key>
4736 <string>org.spearce.git-gui</string>
4737 <key>CFBundleInfoDictionaryVersion</key>
4738 <string>6.0</string>
4739 <key>CFBundlePackageType</key>
4740 <string>APPL</string>
4741 <key>CFBundleSignature</key>
4742 <string>????</string>
4743 <key>CFBundleVersion</key>
4744 <string>1.0</string>
4745 <key>NSPrincipalClass</key>
4746 <string>NSApplication</string>
4747 </dict>
4748 </plist>}
4749 close $fd
4751 set fd [open $exe w]
4752 set gd [file normalize [gitdir]]
4753 set ep [file normalize [gitexec]]
4754 regsub -all ' $gd "'\\''" gd
4755 regsub -all ' $ep "'\\''" ep
4756 puts $fd "#!/bin/sh"
4757 foreach name [array names env] {
4758 if {[string match GIT_* $name]} {
4759 regsub -all ' $env($name) "'\\''" v
4760 puts $fd "export $name='$v'"
4763 puts $fd "export PATH='$ep':\$PATH"
4764 puts $fd "export GIT_DIR='$gd'"
4765 puts $fd "exec [file normalize $argv0]"
4766 close $fd
4768 file attributes $exe -permissions u+x,g+x,o+x
4769 } err]} {
4770 error_popup "Cannot write icon:\n\n$err"
4775 proc toggle_or_diff {w x y} {
4776 global file_states file_lists current_diff_path ui_index ui_workdir
4777 global last_clicked selected_paths
4779 set pos [split [$w index @$x,$y] .]
4780 set lno [lindex $pos 0]
4781 set col [lindex $pos 1]
4782 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4783 if {$path eq {}} {
4784 set last_clicked {}
4785 return
4788 set last_clicked [list $w $lno]
4789 array unset selected_paths
4790 $ui_index tag remove in_sel 0.0 end
4791 $ui_workdir tag remove in_sel 0.0 end
4793 if {$col == 0} {
4794 if {$current_diff_path eq $path} {
4795 set after {reshow_diff;}
4796 } else {
4797 set after {}
4799 if {$w eq $ui_index} {
4800 update_indexinfo \
4801 "Unstaging [short_path $path] from commit" \
4802 [list $path] \
4803 [concat $after {set ui_status_value {Ready.}}]
4804 } elseif {$w eq $ui_workdir} {
4805 update_index \
4806 "Adding [short_path $path]" \
4807 [list $path] \
4808 [concat $after {set ui_status_value {Ready.}}]
4810 } else {
4811 show_diff $path $w $lno
4815 proc add_one_to_selection {w x y} {
4816 global file_lists last_clicked selected_paths
4818 set lno [lindex [split [$w index @$x,$y] .] 0]
4819 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4820 if {$path eq {}} {
4821 set last_clicked {}
4822 return
4825 if {$last_clicked ne {}
4826 && [lindex $last_clicked 0] ne $w} {
4827 array unset selected_paths
4828 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4831 set last_clicked [list $w $lno]
4832 if {[catch {set in_sel $selected_paths($path)}]} {
4833 set in_sel 0
4835 if {$in_sel} {
4836 unset selected_paths($path)
4837 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4838 } else {
4839 set selected_paths($path) 1
4840 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4844 proc add_range_to_selection {w x y} {
4845 global file_lists last_clicked selected_paths
4847 if {[lindex $last_clicked 0] ne $w} {
4848 toggle_or_diff $w $x $y
4849 return
4852 set lno [lindex [split [$w index @$x,$y] .] 0]
4853 set lc [lindex $last_clicked 1]
4854 if {$lc < $lno} {
4855 set begin $lc
4856 set end $lno
4857 } else {
4858 set begin $lno
4859 set end $lc
4862 foreach path [lrange $file_lists($w) \
4863 [expr {$begin - 1}] \
4864 [expr {$end - 1}]] {
4865 set selected_paths($path) 1
4867 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4870 ######################################################################
4872 ## config defaults
4874 set cursor_ptr arrow
4875 font create font_diff -family Courier -size 10
4876 font create font_ui
4877 catch {
4878 label .dummy
4879 eval font configure font_ui [font actual [.dummy cget -font]]
4880 destroy .dummy
4883 font create font_uibold
4884 font create font_diffbold
4886 if {[is_Windows]} {
4887 set M1B Control
4888 set M1T Ctrl
4889 } elseif {[is_MacOSX]} {
4890 set M1B M1
4891 set M1T Cmd
4892 } else {
4893 set M1B M1
4894 set M1T M1
4897 proc apply_config {} {
4898 global repo_config font_descs
4900 foreach option $font_descs {
4901 set name [lindex $option 0]
4902 set font [lindex $option 1]
4903 if {[catch {
4904 foreach {cn cv} $repo_config(gui.$name) {
4905 font configure $font $cn $cv
4907 } err]} {
4908 error_popup "Invalid font specified in gui.$name:\n\n$err"
4910 foreach {cn cv} [font configure $font] {
4911 font configure ${font}bold $cn $cv
4913 font configure ${font}bold -weight bold
4917 set default_config(merge.summary) false
4918 set default_config(merge.verbosity) 2
4919 set default_config(user.name) {}
4920 set default_config(user.email) {}
4922 set default_config(gui.trustmtime) false
4923 set default_config(gui.diffcontext) 5
4924 set default_config(gui.newbranchtemplate) {}
4925 set default_config(gui.fontui) [font configure font_ui]
4926 set default_config(gui.fontdiff) [font configure font_diff]
4927 set font_descs {
4928 {fontui font_ui {Main Font}}
4929 {fontdiff font_diff {Diff/Console Font}}
4931 load_config 0
4932 apply_config
4934 ######################################################################
4936 ## feature option selection
4938 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
4939 unset _junk
4940 } else {
4941 set subcommand gui
4943 if {$subcommand eq {gui.sh}} {
4944 set subcommand gui
4946 if {$subcommand eq {gui} && [llength $argv] > 0} {
4947 set subcommand [lindex $argv 0]
4948 set argv [lrange $argv 1 end]
4951 enable_option multicommit
4952 enable_option branch
4953 enable_option transport
4955 switch -- $subcommand {
4956 blame {
4957 disable_option multicommit
4958 disable_option branch
4959 disable_option transport
4961 citool {
4962 enable_option singlecommit
4964 disable_option multicommit
4965 disable_option branch
4966 disable_option transport
4970 ######################################################################
4972 ## ui construction
4974 set ui_comm {}
4976 # -- Menu Bar
4978 menu .mbar -tearoff 0
4979 .mbar add cascade -label Repository -menu .mbar.repository
4980 .mbar add cascade -label Edit -menu .mbar.edit
4981 if {[is_enabled branch]} {
4982 .mbar add cascade -label Branch -menu .mbar.branch
4984 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
4985 .mbar add cascade -label Commit -menu .mbar.commit
4987 if {[is_enabled transport]} {
4988 .mbar add cascade -label Merge -menu .mbar.merge
4989 .mbar add cascade -label Fetch -menu .mbar.fetch
4990 .mbar add cascade -label Push -menu .mbar.push
4992 . configure -menu .mbar
4994 # -- Repository Menu
4996 menu .mbar.repository
4998 .mbar.repository add command \
4999 -label {Browse Current Branch} \
5000 -command {new_browser $current_branch} \
5001 -font font_ui
5002 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5003 .mbar.repository add separator
5005 .mbar.repository add command \
5006 -label {Visualize Current Branch} \
5007 -command {do_gitk $current_branch} \
5008 -font font_ui
5009 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5010 .mbar.repository add command \
5011 -label {Visualize All Branches} \
5012 -command {do_gitk --all} \
5013 -font font_ui
5014 .mbar.repository add separator
5016 if {[is_enabled multicommit]} {
5017 .mbar.repository add command -label {Database Statistics} \
5018 -command do_stats \
5019 -font font_ui
5021 .mbar.repository add command -label {Compress Database} \
5022 -command do_gc \
5023 -font font_ui
5025 .mbar.repository add command -label {Verify Database} \
5026 -command do_fsck_objects \
5027 -font font_ui
5029 .mbar.repository add separator
5031 if {[is_Cygwin]} {
5032 .mbar.repository add command \
5033 -label {Create Desktop Icon} \
5034 -command do_cygwin_shortcut \
5035 -font font_ui
5036 } elseif {[is_Windows]} {
5037 .mbar.repository add command \
5038 -label {Create Desktop Icon} \
5039 -command do_windows_shortcut \
5040 -font font_ui
5041 } elseif {[is_MacOSX]} {
5042 .mbar.repository add command \
5043 -label {Create Desktop Icon} \
5044 -command do_macosx_app \
5045 -font font_ui
5049 .mbar.repository add command -label Quit \
5050 -command do_quit \
5051 -accelerator $M1T-Q \
5052 -font font_ui
5054 # -- Edit Menu
5056 menu .mbar.edit
5057 .mbar.edit add command -label Undo \
5058 -command {catch {[focus] edit undo}} \
5059 -accelerator $M1T-Z \
5060 -font font_ui
5061 .mbar.edit add command -label Redo \
5062 -command {catch {[focus] edit redo}} \
5063 -accelerator $M1T-Y \
5064 -font font_ui
5065 .mbar.edit add separator
5066 .mbar.edit add command -label Cut \
5067 -command {catch {tk_textCut [focus]}} \
5068 -accelerator $M1T-X \
5069 -font font_ui
5070 .mbar.edit add command -label Copy \
5071 -command {catch {tk_textCopy [focus]}} \
5072 -accelerator $M1T-C \
5073 -font font_ui
5074 .mbar.edit add command -label Paste \
5075 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5076 -accelerator $M1T-V \
5077 -font font_ui
5078 .mbar.edit add command -label Delete \
5079 -command {catch {[focus] delete sel.first sel.last}} \
5080 -accelerator Del \
5081 -font font_ui
5082 .mbar.edit add separator
5083 .mbar.edit add command -label {Select All} \
5084 -command {catch {[focus] tag add sel 0.0 end}} \
5085 -accelerator $M1T-A \
5086 -font font_ui
5088 # -- Branch Menu
5090 if {[is_enabled branch]} {
5091 menu .mbar.branch
5093 .mbar.branch add command -label {Create...} \
5094 -command do_create_branch \
5095 -accelerator $M1T-N \
5096 -font font_ui
5097 lappend disable_on_lock [list .mbar.branch entryconf \
5098 [.mbar.branch index last] -state]
5100 .mbar.branch add command -label {Delete...} \
5101 -command do_delete_branch \
5102 -font font_ui
5103 lappend disable_on_lock [list .mbar.branch entryconf \
5104 [.mbar.branch index last] -state]
5107 # -- Commit Menu
5109 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5110 menu .mbar.commit
5112 .mbar.commit add radiobutton \
5113 -label {New Commit} \
5114 -command do_select_commit_type \
5115 -variable selected_commit_type \
5116 -value new \
5117 -font font_ui
5118 lappend disable_on_lock \
5119 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5121 .mbar.commit add radiobutton \
5122 -label {Amend Last Commit} \
5123 -command do_select_commit_type \
5124 -variable selected_commit_type \
5125 -value amend \
5126 -font font_ui
5127 lappend disable_on_lock \
5128 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5130 .mbar.commit add separator
5132 .mbar.commit add command -label Rescan \
5133 -command do_rescan \
5134 -accelerator F5 \
5135 -font font_ui
5136 lappend disable_on_lock \
5137 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5139 .mbar.commit add command -label {Add To Commit} \
5140 -command do_add_selection \
5141 -font font_ui
5142 lappend disable_on_lock \
5143 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5145 .mbar.commit add command -label {Add Existing To Commit} \
5146 -command do_add_all \
5147 -accelerator $M1T-I \
5148 -font font_ui
5149 lappend disable_on_lock \
5150 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5152 .mbar.commit add command -label {Unstage From Commit} \
5153 -command do_unstage_selection \
5154 -font font_ui
5155 lappend disable_on_lock \
5156 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5158 .mbar.commit add command -label {Revert Changes} \
5159 -command do_revert_selection \
5160 -font font_ui
5161 lappend disable_on_lock \
5162 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5164 .mbar.commit add separator
5166 .mbar.commit add command -label {Sign Off} \
5167 -command do_signoff \
5168 -accelerator $M1T-S \
5169 -font font_ui
5171 .mbar.commit add command -label Commit \
5172 -command do_commit \
5173 -accelerator $M1T-Return \
5174 -font font_ui
5175 lappend disable_on_lock \
5176 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5179 if {[is_MacOSX]} {
5180 # -- Apple Menu (Mac OS X only)
5182 .mbar add cascade -label Apple -menu .mbar.apple
5183 menu .mbar.apple
5185 .mbar.apple add command -label "About [appname]" \
5186 -command do_about \
5187 -font font_ui
5188 .mbar.apple add command -label "[appname] Options..." \
5189 -command do_options \
5190 -font font_ui
5191 } else {
5192 # -- Edit Menu
5194 .mbar.edit add separator
5195 .mbar.edit add command -label {Options...} \
5196 -command do_options \
5197 -font font_ui
5199 # -- Tools Menu
5201 if {[file exists /usr/local/miga/lib/gui-miga]
5202 && [file exists .pvcsrc]} {
5203 proc do_miga {} {
5204 global ui_status_value
5205 if {![lock_index update]} return
5206 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5207 set miga_fd [open "|$cmd" r]
5208 fconfigure $miga_fd -blocking 0
5209 fileevent $miga_fd readable [list miga_done $miga_fd]
5210 set ui_status_value {Running miga...}
5212 proc miga_done {fd} {
5213 read $fd 512
5214 if {[eof $fd]} {
5215 close $fd
5216 unlock_index
5217 rescan [list set ui_status_value {Ready.}]
5220 .mbar add cascade -label Tools -menu .mbar.tools
5221 menu .mbar.tools
5222 .mbar.tools add command -label "Migrate" \
5223 -command do_miga \
5224 -font font_ui
5225 lappend disable_on_lock \
5226 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5230 # -- Help Menu
5232 .mbar add cascade -label Help -menu .mbar.help
5233 menu .mbar.help
5235 if {![is_MacOSX]} {
5236 .mbar.help add command -label "About [appname]" \
5237 -command do_about \
5238 -font font_ui
5241 set browser {}
5242 catch {set browser $repo_config(instaweb.browser)}
5243 set doc_path [file dirname [gitexec]]
5244 set doc_path [file join $doc_path Documentation index.html]
5246 if {[is_Cygwin]} {
5247 set doc_path [exec cygpath --windows $doc_path]
5250 if {$browser eq {}} {
5251 if {[is_MacOSX]} {
5252 set browser open
5253 } elseif {[is_Cygwin]} {
5254 set program_files [file dirname [exec cygpath --windir]]
5255 set program_files [file join $program_files {Program Files}]
5256 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5257 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5258 if {[file exists $firefox]} {
5259 set browser $firefox
5260 } elseif {[file exists $ie]} {
5261 set browser $ie
5263 unset program_files firefox ie
5267 if {[file isfile $doc_path]} {
5268 set doc_url "file:$doc_path"
5269 } else {
5270 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5273 if {$browser ne {}} {
5274 .mbar.help add command -label {Online Documentation} \
5275 -command [list exec $browser $doc_url &] \
5276 -font font_ui
5278 unset browser doc_path doc_url
5280 # -- Standard bindings
5282 bind . <Destroy> do_quit
5283 bind all <$M1B-Key-q> do_quit
5284 bind all <$M1B-Key-Q> do_quit
5285 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5286 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5288 # -- Not a normal commit type invocation? Do that instead!
5290 switch -- $subcommand {
5291 blame {
5292 if {[llength $argv] != 2} {
5293 puts stderr "usage: $argv0 blame commit path"
5294 exit 1
5296 set current_branch [lindex $argv 0]
5297 show_blame $current_branch [lindex $argv 1]
5298 return
5300 citool -
5301 gui {
5302 if {[llength $argv] != 0} {
5303 puts -nonewline stderr "usage: $argv0"
5304 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5305 puts -nonewline stderr " $subcommand"
5307 puts stderr {}
5308 exit 1
5310 # fall through to setup UI for commits
5312 default {
5313 puts stderr "usage: $argv0 \[{blame|citool}\]"
5314 exit 1
5318 # -- Branch Control
5320 frame .branch \
5321 -borderwidth 1 \
5322 -relief sunken
5323 label .branch.l1 \
5324 -text {Current Branch:} \
5325 -anchor w \
5326 -justify left \
5327 -font font_ui
5328 label .branch.cb \
5329 -textvariable current_branch \
5330 -anchor w \
5331 -justify left \
5332 -font font_ui
5333 pack .branch.l1 -side left
5334 pack .branch.cb -side left -fill x
5335 pack .branch -side top -fill x
5337 if {[is_enabled branch]} {
5338 menu .mbar.merge
5339 .mbar.merge add command -label {Local Merge...} \
5340 -command do_local_merge \
5341 -font font_ui
5342 lappend disable_on_lock \
5343 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5344 .mbar.merge add command -label {Abort Merge...} \
5345 -command do_reset_hard \
5346 -font font_ui
5347 lappend disable_on_lock \
5348 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5351 menu .mbar.fetch
5353 menu .mbar.push
5354 .mbar.push add command -label {Push...} \
5355 -command do_push_anywhere \
5356 -font font_ui
5359 # -- Main Window Layout
5361 panedwindow .vpane -orient vertical
5362 panedwindow .vpane.files -orient horizontal
5363 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5364 pack .vpane -anchor n -side top -fill both -expand 1
5366 # -- Index File List
5368 frame .vpane.files.index -height 100 -width 200
5369 label .vpane.files.index.title -text {Changes To Be Committed} \
5370 -background green \
5371 -font font_ui
5372 text $ui_index -background white -borderwidth 0 \
5373 -width 20 -height 10 \
5374 -wrap none \
5375 -font font_ui \
5376 -cursor $cursor_ptr \
5377 -xscrollcommand {.vpane.files.index.sx set} \
5378 -yscrollcommand {.vpane.files.index.sy set} \
5379 -state disabled
5380 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5381 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5382 pack .vpane.files.index.title -side top -fill x
5383 pack .vpane.files.index.sx -side bottom -fill x
5384 pack .vpane.files.index.sy -side right -fill y
5385 pack $ui_index -side left -fill both -expand 1
5386 .vpane.files add .vpane.files.index -sticky nsew
5388 # -- Working Directory File List
5390 frame .vpane.files.workdir -height 100 -width 200
5391 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5392 -background red \
5393 -font font_ui
5394 text $ui_workdir -background white -borderwidth 0 \
5395 -width 20 -height 10 \
5396 -wrap none \
5397 -font font_ui \
5398 -cursor $cursor_ptr \
5399 -xscrollcommand {.vpane.files.workdir.sx set} \
5400 -yscrollcommand {.vpane.files.workdir.sy set} \
5401 -state disabled
5402 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5403 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5404 pack .vpane.files.workdir.title -side top -fill x
5405 pack .vpane.files.workdir.sx -side bottom -fill x
5406 pack .vpane.files.workdir.sy -side right -fill y
5407 pack $ui_workdir -side left -fill both -expand 1
5408 .vpane.files add .vpane.files.workdir -sticky nsew
5410 foreach i [list $ui_index $ui_workdir] {
5411 $i tag conf in_diff -font font_uibold
5412 $i tag conf in_sel \
5413 -background [$i cget -foreground] \
5414 -foreground [$i cget -background]
5416 unset i
5418 # -- Diff and Commit Area
5420 frame .vpane.lower -height 300 -width 400
5421 frame .vpane.lower.commarea
5422 frame .vpane.lower.diff -relief sunken -borderwidth 1
5423 pack .vpane.lower.commarea -side top -fill x
5424 pack .vpane.lower.diff -side bottom -fill both -expand 1
5425 .vpane add .vpane.lower -sticky nsew
5427 # -- Commit Area Buttons
5429 frame .vpane.lower.commarea.buttons
5430 label .vpane.lower.commarea.buttons.l -text {} \
5431 -anchor w \
5432 -justify left \
5433 -font font_ui
5434 pack .vpane.lower.commarea.buttons.l -side top -fill x
5435 pack .vpane.lower.commarea.buttons -side left -fill y
5437 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5438 -command do_rescan \
5439 -font font_ui
5440 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5441 lappend disable_on_lock \
5442 {.vpane.lower.commarea.buttons.rescan conf -state}
5444 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5445 -command do_add_all \
5446 -font font_ui
5447 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5448 lappend disable_on_lock \
5449 {.vpane.lower.commarea.buttons.incall conf -state}
5451 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5452 -command do_signoff \
5453 -font font_ui
5454 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5456 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5457 -command do_commit \
5458 -font font_ui
5459 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5460 lappend disable_on_lock \
5461 {.vpane.lower.commarea.buttons.commit conf -state}
5463 # -- Commit Message Buffer
5465 frame .vpane.lower.commarea.buffer
5466 frame .vpane.lower.commarea.buffer.header
5467 set ui_comm .vpane.lower.commarea.buffer.t
5468 set ui_coml .vpane.lower.commarea.buffer.header.l
5469 radiobutton .vpane.lower.commarea.buffer.header.new \
5470 -text {New Commit} \
5471 -command do_select_commit_type \
5472 -variable selected_commit_type \
5473 -value new \
5474 -font font_ui
5475 lappend disable_on_lock \
5476 [list .vpane.lower.commarea.buffer.header.new conf -state]
5477 radiobutton .vpane.lower.commarea.buffer.header.amend \
5478 -text {Amend Last Commit} \
5479 -command do_select_commit_type \
5480 -variable selected_commit_type \
5481 -value amend \
5482 -font font_ui
5483 lappend disable_on_lock \
5484 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5485 label $ui_coml \
5486 -anchor w \
5487 -justify left \
5488 -font font_ui
5489 proc trace_commit_type {varname args} {
5490 global ui_coml commit_type
5491 switch -glob -- $commit_type {
5492 initial {set txt {Initial Commit Message:}}
5493 amend {set txt {Amended Commit Message:}}
5494 amend-initial {set txt {Amended Initial Commit Message:}}
5495 amend-merge {set txt {Amended Merge Commit Message:}}
5496 merge {set txt {Merge Commit Message:}}
5497 * {set txt {Commit Message:}}
5499 $ui_coml conf -text $txt
5501 trace add variable commit_type write trace_commit_type
5502 pack $ui_coml -side left -fill x
5503 pack .vpane.lower.commarea.buffer.header.amend -side right
5504 pack .vpane.lower.commarea.buffer.header.new -side right
5506 text $ui_comm -background white -borderwidth 1 \
5507 -undo true \
5508 -maxundo 20 \
5509 -autoseparators true \
5510 -relief sunken \
5511 -width 75 -height 9 -wrap none \
5512 -font font_diff \
5513 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5514 scrollbar .vpane.lower.commarea.buffer.sby \
5515 -command [list $ui_comm yview]
5516 pack .vpane.lower.commarea.buffer.header -side top -fill x
5517 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5518 pack $ui_comm -side left -fill y
5519 pack .vpane.lower.commarea.buffer -side left -fill y
5521 # -- Commit Message Buffer Context Menu
5523 set ctxm .vpane.lower.commarea.buffer.ctxm
5524 menu $ctxm -tearoff 0
5525 $ctxm add command \
5526 -label {Cut} \
5527 -font font_ui \
5528 -command {tk_textCut $ui_comm}
5529 $ctxm add command \
5530 -label {Copy} \
5531 -font font_ui \
5532 -command {tk_textCopy $ui_comm}
5533 $ctxm add command \
5534 -label {Paste} \
5535 -font font_ui \
5536 -command {tk_textPaste $ui_comm}
5537 $ctxm add command \
5538 -label {Delete} \
5539 -font font_ui \
5540 -command {$ui_comm delete sel.first sel.last}
5541 $ctxm add separator
5542 $ctxm add command \
5543 -label {Select All} \
5544 -font font_ui \
5545 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5546 $ctxm add command \
5547 -label {Copy All} \
5548 -font font_ui \
5549 -command {
5550 $ui_comm tag add sel 0.0 end
5551 tk_textCopy $ui_comm
5552 $ui_comm tag remove sel 0.0 end
5554 $ctxm add separator
5555 $ctxm add command \
5556 -label {Sign Off} \
5557 -font font_ui \
5558 -command do_signoff
5559 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5561 # -- Diff Header
5563 set current_diff_path {}
5564 set current_diff_side {}
5565 set diff_actions [list]
5566 proc trace_current_diff_path {varname args} {
5567 global current_diff_path diff_actions file_states
5568 if {$current_diff_path eq {}} {
5569 set s {}
5570 set f {}
5571 set p {}
5572 set o disabled
5573 } else {
5574 set p $current_diff_path
5575 set s [mapdesc [lindex $file_states($p) 0] $p]
5576 set f {File:}
5577 set p [escape_path $p]
5578 set o normal
5581 .vpane.lower.diff.header.status configure -text $s
5582 .vpane.lower.diff.header.file configure -text $f
5583 .vpane.lower.diff.header.path configure -text $p
5584 foreach w $diff_actions {
5585 uplevel #0 $w $o
5588 trace add variable current_diff_path write trace_current_diff_path
5590 frame .vpane.lower.diff.header -background orange
5591 label .vpane.lower.diff.header.status \
5592 -background orange \
5593 -width $max_status_desc \
5594 -anchor w \
5595 -justify left \
5596 -font font_ui
5597 label .vpane.lower.diff.header.file \
5598 -background orange \
5599 -anchor w \
5600 -justify left \
5601 -font font_ui
5602 label .vpane.lower.diff.header.path \
5603 -background orange \
5604 -anchor w \
5605 -justify left \
5606 -font font_ui
5607 pack .vpane.lower.diff.header.status -side left
5608 pack .vpane.lower.diff.header.file -side left
5609 pack .vpane.lower.diff.header.path -fill x
5610 set ctxm .vpane.lower.diff.header.ctxm
5611 menu $ctxm -tearoff 0
5612 $ctxm add command \
5613 -label {Copy} \
5614 -font font_ui \
5615 -command {
5616 clipboard clear
5617 clipboard append \
5618 -format STRING \
5619 -type STRING \
5620 -- $current_diff_path
5622 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5623 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5625 # -- Diff Body
5627 frame .vpane.lower.diff.body
5628 set ui_diff .vpane.lower.diff.body.t
5629 text $ui_diff -background white -borderwidth 0 \
5630 -width 80 -height 15 -wrap none \
5631 -font font_diff \
5632 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5633 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5634 -state disabled
5635 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5636 -command [list $ui_diff xview]
5637 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5638 -command [list $ui_diff yview]
5639 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5640 pack .vpane.lower.diff.body.sby -side right -fill y
5641 pack $ui_diff -side left -fill both -expand 1
5642 pack .vpane.lower.diff.header -side top -fill x
5643 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5645 $ui_diff tag conf d_cr -elide true
5646 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5647 $ui_diff tag conf d_+ -foreground {#00a000}
5648 $ui_diff tag conf d_- -foreground red
5650 $ui_diff tag conf d_++ -foreground {#00a000}
5651 $ui_diff tag conf d_-- -foreground red
5652 $ui_diff tag conf d_+s \
5653 -foreground {#00a000} \
5654 -background {#e2effa}
5655 $ui_diff tag conf d_-s \
5656 -foreground red \
5657 -background {#e2effa}
5658 $ui_diff tag conf d_s+ \
5659 -foreground {#00a000} \
5660 -background ivory1
5661 $ui_diff tag conf d_s- \
5662 -foreground red \
5663 -background ivory1
5665 $ui_diff tag conf d<<<<<<< \
5666 -foreground orange \
5667 -font font_diffbold
5668 $ui_diff tag conf d======= \
5669 -foreground orange \
5670 -font font_diffbold
5671 $ui_diff tag conf d>>>>>>> \
5672 -foreground orange \
5673 -font font_diffbold
5675 $ui_diff tag raise sel
5677 # -- Diff Body Context Menu
5679 set ctxm .vpane.lower.diff.body.ctxm
5680 menu $ctxm -tearoff 0
5681 $ctxm add command \
5682 -label {Refresh} \
5683 -font font_ui \
5684 -command reshow_diff
5685 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5686 $ctxm add command \
5687 -label {Copy} \
5688 -font font_ui \
5689 -command {tk_textCopy $ui_diff}
5690 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5691 $ctxm add command \
5692 -label {Select All} \
5693 -font font_ui \
5694 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5695 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5696 $ctxm add command \
5697 -label {Copy All} \
5698 -font font_ui \
5699 -command {
5700 $ui_diff tag add sel 0.0 end
5701 tk_textCopy $ui_diff
5702 $ui_diff tag remove sel 0.0 end
5704 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5705 $ctxm add separator
5706 $ctxm add command \
5707 -label {Apply/Reverse Hunk} \
5708 -font font_ui \
5709 -command {apply_hunk $cursorX $cursorY}
5710 set ui_diff_applyhunk [$ctxm index last]
5711 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5712 $ctxm add separator
5713 $ctxm add command \
5714 -label {Decrease Font Size} \
5715 -font font_ui \
5716 -command {incr_font_size font_diff -1}
5717 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5718 $ctxm add command \
5719 -label {Increase Font Size} \
5720 -font font_ui \
5721 -command {incr_font_size font_diff 1}
5722 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5723 $ctxm add separator
5724 $ctxm add command \
5725 -label {Show Less Context} \
5726 -font font_ui \
5727 -command {if {$repo_config(gui.diffcontext) >= 2} {
5728 incr repo_config(gui.diffcontext) -1
5729 reshow_diff
5731 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5732 $ctxm add command \
5733 -label {Show More Context} \
5734 -font font_ui \
5735 -command {
5736 incr repo_config(gui.diffcontext)
5737 reshow_diff
5739 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5740 $ctxm add separator
5741 $ctxm add command -label {Options...} \
5742 -font font_ui \
5743 -command do_options
5744 bind_button3 $ui_diff "
5745 set cursorX %x
5746 set cursorY %y
5747 if {\$ui_index eq \$current_diff_side} {
5748 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5749 } else {
5750 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5752 tk_popup $ctxm %X %Y
5754 unset ui_diff_applyhunk
5756 # -- Status Bar
5758 set ui_status_value {Initializing...}
5759 label .status -textvariable ui_status_value \
5760 -anchor w \
5761 -justify left \
5762 -borderwidth 1 \
5763 -relief sunken \
5764 -font font_ui
5765 pack .status -anchor w -side bottom -fill x
5767 # -- Load geometry
5769 catch {
5770 set gm $repo_config(gui.geometry)
5771 wm geometry . [lindex $gm 0]
5772 .vpane sash place 0 \
5773 [lindex [.vpane sash coord 0] 0] \
5774 [lindex $gm 1]
5775 .vpane.files sash place 0 \
5776 [lindex $gm 2] \
5777 [lindex [.vpane.files sash coord 0] 1]
5778 unset gm
5781 # -- Key Bindings
5783 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5784 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5785 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5786 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5787 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5788 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5789 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5790 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5791 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5792 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5793 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5795 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5796 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5797 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5798 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5799 bind $ui_diff <$M1B-Key-v> {break}
5800 bind $ui_diff <$M1B-Key-V> {break}
5801 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5802 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5803 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5804 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5805 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5806 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5807 bind $ui_diff <Button-1> {focus %W}
5809 if {[is_enabled branch]} {
5810 bind . <$M1B-Key-n> do_create_branch
5811 bind . <$M1B-Key-N> do_create_branch
5814 bind all <Key-F5> do_rescan
5815 bind all <$M1B-Key-r> do_rescan
5816 bind all <$M1B-Key-R> do_rescan
5817 bind . <$M1B-Key-s> do_signoff
5818 bind . <$M1B-Key-S> do_signoff
5819 bind . <$M1B-Key-i> do_add_all
5820 bind . <$M1B-Key-I> do_add_all
5821 bind . <$M1B-Key-Return> do_commit
5822 foreach i [list $ui_index $ui_workdir] {
5823 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
5824 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5825 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5827 unset i
5829 set file_lists($ui_index) [list]
5830 set file_lists($ui_workdir) [list]
5832 set HEAD {}
5833 set PARENT {}
5834 set MERGE_HEAD [list]
5835 set commit_type {}
5836 set empty_tree {}
5837 set current_branch {}
5838 set current_diff_path {}
5839 set selected_commit_type new
5841 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5842 focus -force $ui_comm
5844 # -- Warn the user about environmental problems. Cygwin's Tcl
5845 # does *not* pass its env array onto any processes it spawns.
5846 # This means that git processes get none of our environment.
5848 if {[is_Cygwin]} {
5849 set ignored_env 0
5850 set suggest_user {}
5851 set msg "Possible environment issues exist.
5853 The following environment variables are probably
5854 going to be ignored by any Git subprocess run
5855 by [appname]:
5858 foreach name [array names env] {
5859 switch -regexp -- $name {
5860 {^GIT_INDEX_FILE$} -
5861 {^GIT_OBJECT_DIRECTORY$} -
5862 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5863 {^GIT_DIFF_OPTS$} -
5864 {^GIT_EXTERNAL_DIFF$} -
5865 {^GIT_PAGER$} -
5866 {^GIT_TRACE$} -
5867 {^GIT_CONFIG$} -
5868 {^GIT_CONFIG_LOCAL$} -
5869 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5870 append msg " - $name\n"
5871 incr ignored_env
5873 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5874 append msg " - $name\n"
5875 incr ignored_env
5876 set suggest_user $name
5880 if {$ignored_env > 0} {
5881 append msg "
5882 This is due to a known issue with the
5883 Tcl binary distributed by Cygwin."
5885 if {$suggest_user ne {}} {
5886 append msg "
5888 A good replacement for $suggest_user
5889 is placing values for the user.name and
5890 user.email settings into your personal
5891 ~/.gitconfig file.
5894 warn_popup $msg
5896 unset ignored_env msg suggest_user name
5899 # -- Only initialize complex UI if we are going to stay running.
5901 if {[is_enabled transport]} {
5902 load_all_remotes
5903 load_all_heads
5905 populate_branch_menu
5906 populate_fetch_menu
5907 populate_push_menu
5910 # -- Only suggest a gc run if we are going to stay running.
5912 if {[is_enabled multicommit]} {
5913 set object_limit 2000
5914 if {[is_Windows]} {set object_limit 200}
5915 regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
5916 if {$objects_current >= $object_limit} {
5917 if {[ask_popup \
5918 "This repository currently has $objects_current loose objects.
5920 To maintain optimal performance it is strongly
5921 recommended that you compress the database
5922 when more than $object_limit loose objects exist.
5924 Compress the database now?"] eq yes} {
5925 do_gc
5928 unset object_limit _junk objects_current
5931 lock_index begin-read
5932 after 1 do_rescan