git-gui: Revert "git-gui: Display all authors of git-gui."
[git-gui.git] / git-gui.sh
blob2888864e49d3feb4ac9d0f156163a26944a2fc81
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 set appvers {@@GITGUI_VERSION@@}
6 set copyright {
7 Copyright © 2006, 2007 Shawn Pearce, et. al.
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
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 ## version check
302 set req_maj 1
303 set req_min 5
305 if {[catch {set v [git --version]} err]} {
306 catch {wm withdraw .}
307 error_popup "Cannot determine Git version:
309 $err
311 [appname] requires Git $req_maj.$req_min or later."
312 exit 1
314 if {[regexp {^git version (\d+)\.(\d+)} $v _junk act_maj act_min]} {
315 if {$act_maj < $req_maj
316 || ($act_maj == $req_maj && $act_min < $req_min)} {
317 catch {wm withdraw .}
318 error_popup "[appname] requires Git $req_maj.$req_min or later.
320 You are using $v."
321 exit 1
323 } else {
324 catch {wm withdraw .}
325 error_popup "Cannot parse Git version string:\n\n$v"
326 exit 1
328 unset -nocomplain v _junk act_maj act_min req_maj req_min
330 ######################################################################
332 ## repository setup
334 if { [catch {set _gitdir $env(GIT_DIR)}]
335 && [catch {set _gitdir [git rev-parse --git-dir]} err]} {
336 catch {wm withdraw .}
337 error_popup "Cannot find the git directory:\n\n$err"
338 exit 1
340 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
341 catch {set _gitdir [exec cygpath --unix $_gitdir]}
343 if {![file isdirectory $_gitdir]} {
344 catch {wm withdraw .}
345 error_popup "Git directory not found:\n\n$_gitdir"
346 exit 1
348 if {[lindex [file split $_gitdir] end] ne {.git}} {
349 catch {wm withdraw .}
350 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
351 exit 1
353 if {[catch {cd [file dirname $_gitdir]} err]} {
354 catch {wm withdraw .}
355 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
356 exit 1
358 set _reponame [lindex [file split \
359 [file normalize [file dirname $_gitdir]]] \
360 end]
362 ######################################################################
364 ## global init
366 set current_diff_path {}
367 set current_diff_side {}
368 set diff_actions [list]
369 set ui_status_value {Initializing...}
371 set HEAD {}
372 set PARENT {}
373 set MERGE_HEAD [list]
374 set commit_type {}
375 set empty_tree {}
376 set current_branch {}
377 set current_diff_path {}
378 set selected_commit_type new
380 ######################################################################
382 ## task management
384 set rescan_active 0
385 set diff_active 0
386 set last_clicked {}
388 set disable_on_lock [list]
389 set index_lock_type none
391 proc lock_index {type} {
392 global index_lock_type disable_on_lock
394 if {$index_lock_type eq {none}} {
395 set index_lock_type $type
396 foreach w $disable_on_lock {
397 uplevel #0 $w disabled
399 return 1
400 } elseif {$index_lock_type eq "begin-$type"} {
401 set index_lock_type $type
402 return 1
404 return 0
407 proc unlock_index {} {
408 global index_lock_type disable_on_lock
410 set index_lock_type none
411 foreach w $disable_on_lock {
412 uplevel #0 $w normal
416 ######################################################################
418 ## status
420 proc repository_state {ctvar hdvar mhvar} {
421 global current_branch
422 upvar $ctvar ct $hdvar hd $mhvar mh
424 set mh [list]
426 if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
427 set current_branch {}
428 } else {
429 regsub ^refs/((heads|tags|remotes)/)? \
430 $current_branch \
431 {} \
432 current_branch
435 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
436 set hd {}
437 set ct initial
438 return
441 set merge_head [gitdir MERGE_HEAD]
442 if {[file exists $merge_head]} {
443 set ct merge
444 set fd_mh [open $merge_head r]
445 while {[gets $fd_mh line] >= 0} {
446 lappend mh $line
448 close $fd_mh
449 return
452 set ct normal
455 proc PARENT {} {
456 global PARENT empty_tree
458 set p [lindex $PARENT 0]
459 if {$p ne {}} {
460 return $p
462 if {$empty_tree eq {}} {
463 set empty_tree [git mktree << {}]
465 return $empty_tree
468 proc rescan {after {honor_trustmtime 1}} {
469 global HEAD PARENT MERGE_HEAD commit_type
470 global ui_index ui_workdir ui_status_value ui_comm
471 global rescan_active file_states
472 global repo_config
474 if {$rescan_active > 0 || ![lock_index read]} return
476 repository_state newType newHEAD newMERGE_HEAD
477 if {[string match amend* $commit_type]
478 && $newType eq {normal}
479 && $newHEAD eq $HEAD} {
480 } else {
481 set HEAD $newHEAD
482 set PARENT $newHEAD
483 set MERGE_HEAD $newMERGE_HEAD
484 set commit_type $newType
487 array unset file_states
489 if {![$ui_comm edit modified]
490 || [string trim [$ui_comm get 0.0 end]] eq {}} {
491 if {[load_message GITGUI_MSG]} {
492 } elseif {[load_message MERGE_MSG]} {
493 } elseif {[load_message SQUASH_MSG]} {
495 $ui_comm edit reset
496 $ui_comm edit modified false
499 if {[is_enabled branch]} {
500 load_all_heads
501 populate_branch_menu
504 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
505 rescan_stage2 {} $after
506 } else {
507 set rescan_active 1
508 set ui_status_value {Refreshing file status...}
509 set cmd [list git update-index]
510 lappend cmd -q
511 lappend cmd --unmerged
512 lappend cmd --ignore-missing
513 lappend cmd --refresh
514 set fd_rf [open "| $cmd" r]
515 fconfigure $fd_rf -blocking 0 -translation binary
516 fileevent $fd_rf readable \
517 [list rescan_stage2 $fd_rf $after]
521 proc rescan_stage2 {fd after} {
522 global ui_status_value
523 global rescan_active buf_rdi buf_rdf buf_rlo
525 if {$fd ne {}} {
526 read $fd
527 if {![eof $fd]} return
528 close $fd
531 set ls_others [list | git ls-files --others -z \
532 --exclude-per-directory=.gitignore]
533 set info_exclude [gitdir info exclude]
534 if {[file readable $info_exclude]} {
535 lappend ls_others "--exclude-from=$info_exclude"
538 set buf_rdi {}
539 set buf_rdf {}
540 set buf_rlo {}
542 set rescan_active 3
543 set ui_status_value {Scanning for modified files ...}
544 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
545 set fd_df [open "| git diff-files -z" r]
546 set fd_lo [open $ls_others r]
548 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
549 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
550 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
551 fileevent $fd_di readable [list read_diff_index $fd_di $after]
552 fileevent $fd_df readable [list read_diff_files $fd_df $after]
553 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
556 proc load_message {file} {
557 global ui_comm
559 set f [gitdir $file]
560 if {[file isfile $f]} {
561 if {[catch {set fd [open $f r]}]} {
562 return 0
564 set content [string trim [read $fd]]
565 close $fd
566 regsub -all -line {[ \r\t]+$} $content {} content
567 $ui_comm delete 0.0 end
568 $ui_comm insert end $content
569 return 1
571 return 0
574 proc read_diff_index {fd after} {
575 global buf_rdi
577 append buf_rdi [read $fd]
578 set c 0
579 set n [string length $buf_rdi]
580 while {$c < $n} {
581 set z1 [string first "\0" $buf_rdi $c]
582 if {$z1 == -1} break
583 incr z1
584 set z2 [string first "\0" $buf_rdi $z1]
585 if {$z2 == -1} break
587 incr c
588 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
589 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
590 merge_state \
591 [encoding convertfrom $p] \
592 [lindex $i 4]? \
593 [list [lindex $i 0] [lindex $i 2]] \
594 [list]
595 set c $z2
596 incr c
598 if {$c < $n} {
599 set buf_rdi [string range $buf_rdi $c end]
600 } else {
601 set buf_rdi {}
604 rescan_done $fd buf_rdi $after
607 proc read_diff_files {fd after} {
608 global buf_rdf
610 append buf_rdf [read $fd]
611 set c 0
612 set n [string length $buf_rdf]
613 while {$c < $n} {
614 set z1 [string first "\0" $buf_rdf $c]
615 if {$z1 == -1} break
616 incr z1
617 set z2 [string first "\0" $buf_rdf $z1]
618 if {$z2 == -1} break
620 incr c
621 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
622 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
623 merge_state \
624 [encoding convertfrom $p] \
625 ?[lindex $i 4] \
626 [list] \
627 [list [lindex $i 0] [lindex $i 2]]
628 set c $z2
629 incr c
631 if {$c < $n} {
632 set buf_rdf [string range $buf_rdf $c end]
633 } else {
634 set buf_rdf {}
637 rescan_done $fd buf_rdf $after
640 proc read_ls_others {fd after} {
641 global buf_rlo
643 append buf_rlo [read $fd]
644 set pck [split $buf_rlo "\0"]
645 set buf_rlo [lindex $pck end]
646 foreach p [lrange $pck 0 end-1] {
647 merge_state [encoding convertfrom $p] ?O
649 rescan_done $fd buf_rlo $after
652 proc rescan_done {fd buf after} {
653 global rescan_active
654 global file_states repo_config
655 upvar $buf to_clear
657 if {![eof $fd]} return
658 set to_clear {}
659 close $fd
660 if {[incr rescan_active -1] > 0} return
662 prune_selection
663 unlock_index
664 display_all_files
665 reshow_diff
666 uplevel #0 $after
669 proc prune_selection {} {
670 global file_states selected_paths
672 foreach path [array names selected_paths] {
673 if {[catch {set still_here $file_states($path)}]} {
674 unset selected_paths($path)
679 ######################################################################
681 ## diff
683 proc clear_diff {} {
684 global ui_diff current_diff_path current_diff_header
685 global ui_index ui_workdir
687 $ui_diff conf -state normal
688 $ui_diff delete 0.0 end
689 $ui_diff conf -state disabled
691 set current_diff_path {}
692 set current_diff_header {}
694 $ui_index tag remove in_diff 0.0 end
695 $ui_workdir tag remove in_diff 0.0 end
698 proc reshow_diff {} {
699 global ui_status_value file_states file_lists
700 global current_diff_path current_diff_side
702 set p $current_diff_path
703 if {$p eq {}} {
704 # No diff is being shown.
705 } elseif {$current_diff_side eq {}
706 || [catch {set s $file_states($p)}]
707 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
708 clear_diff
709 } else {
710 show_diff $p $current_diff_side
714 proc handle_empty_diff {} {
715 global current_diff_path file_states file_lists
717 set path $current_diff_path
718 set s $file_states($path)
719 if {[lindex $s 0] ne {_M}} return
721 info_popup "No differences detected.
723 [short_path $path] has no changes.
725 The modification date of this file was updated
726 by another application, but the content within
727 the file was not changed.
729 A rescan will be automatically started to find
730 other files which may have the same state."
732 clear_diff
733 display_file $path __
734 rescan {set ui_status_value {Ready.}} 0
737 proc show_diff {path w {lno {}}} {
738 global file_states file_lists
739 global is_3way_diff diff_active repo_config
740 global ui_diff ui_status_value ui_index ui_workdir
741 global current_diff_path current_diff_side current_diff_header
743 if {$diff_active || ![lock_index read]} return
745 clear_diff
746 if {$lno == {}} {
747 set lno [lsearch -sorted -exact $file_lists($w) $path]
748 if {$lno >= 0} {
749 incr lno
752 if {$lno >= 1} {
753 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
756 set s $file_states($path)
757 set m [lindex $s 0]
758 set is_3way_diff 0
759 set diff_active 1
760 set current_diff_path $path
761 set current_diff_side $w
762 set current_diff_header {}
763 set ui_status_value "Loading diff of [escape_path $path]..."
765 # - Git won't give us the diff, there's nothing to compare to!
767 if {$m eq {_O}} {
768 set max_sz [expr {128 * 1024}]
769 if {[catch {
770 set fd [open $path r]
771 set content [read $fd $max_sz]
772 close $fd
773 set sz [file size $path]
774 } err ]} {
775 set diff_active 0
776 unlock_index
777 set ui_status_value "Unable to display [escape_path $path]"
778 error_popup "Error loading file:\n\n$err"
779 return
781 $ui_diff conf -state normal
782 if {![catch {set type [exec file $path]}]} {
783 set n [string length $path]
784 if {[string equal -length $n $path $type]} {
785 set type [string range $type $n end]
786 regsub {^:?\s*} $type {} type
788 $ui_diff insert end "* $type\n" d_@
790 if {[string first "\0" $content] != -1} {
791 $ui_diff insert end \
792 "* Binary file (not showing content)." \
794 } else {
795 if {$sz > $max_sz} {
796 $ui_diff insert end \
797 "* Untracked file is $sz bytes.
798 * Showing only first $max_sz bytes.
799 " d_@
801 $ui_diff insert end $content
802 if {$sz > $max_sz} {
803 $ui_diff insert end "
804 * Untracked file clipped here by [appname].
805 * To see the entire file, use an external editor.
806 " d_@
809 $ui_diff conf -state disabled
810 set diff_active 0
811 unlock_index
812 set ui_status_value {Ready.}
813 return
816 set cmd [list | git]
817 if {$w eq $ui_index} {
818 lappend cmd diff-index
819 lappend cmd --cached
820 } elseif {$w eq $ui_workdir} {
821 if {[string index $m 0] eq {U}} {
822 lappend cmd diff
823 } else {
824 lappend cmd diff-files
828 lappend cmd -p
829 lappend cmd --no-color
830 if {$repo_config(gui.diffcontext) > 0} {
831 lappend cmd "-U$repo_config(gui.diffcontext)"
833 if {$w eq $ui_index} {
834 lappend cmd [PARENT]
836 lappend cmd --
837 lappend cmd $path
839 if {[catch {set fd [open $cmd r]} err]} {
840 set diff_active 0
841 unlock_index
842 set ui_status_value "Unable to display [escape_path $path]"
843 error_popup "Error loading diff:\n\n$err"
844 return
847 fconfigure $fd \
848 -blocking 0 \
849 -encoding binary \
850 -translation binary
851 fileevent $fd readable [list read_diff $fd]
854 proc read_diff {fd} {
855 global ui_diff ui_status_value diff_active
856 global is_3way_diff current_diff_header
858 $ui_diff conf -state normal
859 while {[gets $fd line] >= 0} {
860 # -- Cleanup uninteresting diff header lines.
862 if { [string match {diff --git *} $line]
863 || [string match {diff --cc *} $line]
864 || [string match {diff --combined *} $line]
865 || [string match {--- *} $line]
866 || [string match {+++ *} $line]} {
867 append current_diff_header $line "\n"
868 continue
870 if {[string match {index *} $line]} continue
871 if {$line eq {deleted file mode 120000}} {
872 set line "deleted symlink"
875 # -- Automatically detect if this is a 3 way diff.
877 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
879 if {[string match {mode *} $line]
880 || [string match {new file *} $line]
881 || [string match {deleted file *} $line]
882 || [string match {Binary files * and * differ} $line]
883 || $line eq {\ No newline at end of file}
884 || [regexp {^\* Unmerged path } $line]} {
885 set tags {}
886 } elseif {$is_3way_diff} {
887 set op [string range $line 0 1]
888 switch -- $op {
889 { } {set tags {}}
890 {@@} {set tags d_@}
891 { +} {set tags d_s+}
892 { -} {set tags d_s-}
893 {+ } {set tags d_+s}
894 {- } {set tags d_-s}
895 {--} {set tags d_--}
896 {++} {
897 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
898 set line [string replace $line 0 1 { }]
899 set tags d$op
900 } else {
901 set tags d_++
904 default {
905 puts "error: Unhandled 3 way diff marker: {$op}"
906 set tags {}
909 } else {
910 set op [string index $line 0]
911 switch -- $op {
912 { } {set tags {}}
913 {@} {set tags d_@}
914 {-} {set tags d_-}
915 {+} {
916 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
917 set line [string replace $line 0 0 { }]
918 set tags d$op
919 } else {
920 set tags d_+
923 default {
924 puts "error: Unhandled 2 way diff marker: {$op}"
925 set tags {}
929 $ui_diff insert end $line $tags
930 if {[string index $line end] eq "\r"} {
931 $ui_diff tag add d_cr {end - 2c}
933 $ui_diff insert end "\n" $tags
935 $ui_diff conf -state disabled
937 if {[eof $fd]} {
938 close $fd
939 set diff_active 0
940 unlock_index
941 set ui_status_value {Ready.}
943 if {[$ui_diff index end] eq {2.0}} {
944 handle_empty_diff
949 proc apply_hunk {x y} {
950 global current_diff_path current_diff_header current_diff_side
951 global ui_diff ui_index file_states
953 if {$current_diff_path eq {} || $current_diff_header eq {}} return
954 if {![lock_index apply_hunk]} return
956 set apply_cmd {git apply --cached --whitespace=nowarn}
957 set mi [lindex $file_states($current_diff_path) 0]
958 if {$current_diff_side eq $ui_index} {
959 set mode unstage
960 lappend apply_cmd --reverse
961 if {[string index $mi 0] ne {M}} {
962 unlock_index
963 return
965 } else {
966 set mode stage
967 if {[string index $mi 1] ne {M}} {
968 unlock_index
969 return
973 set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
974 set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
975 if {$s_lno eq {}} {
976 unlock_index
977 return
980 set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
981 if {$e_lno eq {}} {
982 set e_lno end
985 if {[catch {
986 set p [open "| $apply_cmd" w]
987 fconfigure $p -translation binary -encoding binary
988 puts -nonewline $p $current_diff_header
989 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
990 close $p} err]} {
991 error_popup "Failed to $mode selected hunk.\n\n$err"
992 unlock_index
993 return
996 $ui_diff conf -state normal
997 $ui_diff delete $s_lno $e_lno
998 $ui_diff conf -state disabled
1000 if {[$ui_diff get 1.0 end] eq "\n"} {
1001 set o _
1002 } else {
1003 set o ?
1006 if {$current_diff_side eq $ui_index} {
1007 set mi ${o}M
1008 } elseif {[string index $mi 0] eq {_}} {
1009 set mi M$o
1010 } else {
1011 set mi ?$o
1013 unlock_index
1014 display_file $current_diff_path $mi
1015 if {$o eq {_}} {
1016 clear_diff
1020 ######################################################################
1022 ## commit
1024 proc load_last_commit {} {
1025 global HEAD PARENT MERGE_HEAD commit_type ui_comm
1026 global repo_config
1028 if {[llength $PARENT] == 0} {
1029 error_popup {There is nothing to amend.
1031 You are about to create the initial commit.
1032 There is no commit before this to amend.
1034 return
1037 repository_state curType curHEAD curMERGE_HEAD
1038 if {$curType eq {merge}} {
1039 error_popup {Cannot amend while merging.
1041 You are currently in the middle of a merge that
1042 has not been fully completed. You cannot amend
1043 the prior commit unless you first abort the
1044 current merge activity.
1046 return
1049 set msg {}
1050 set parents [list]
1051 if {[catch {
1052 set fd [open "| git cat-file commit $curHEAD" r]
1053 fconfigure $fd -encoding binary -translation lf
1054 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1055 set enc utf-8
1057 while {[gets $fd line] > 0} {
1058 if {[string match {parent *} $line]} {
1059 lappend parents [string range $line 7 end]
1060 } elseif {[string match {encoding *} $line]} {
1061 set enc [string tolower [string range $line 9 end]]
1064 fconfigure $fd -encoding $enc
1065 set msg [string trim [read $fd]]
1066 close $fd
1067 } err]} {
1068 error_popup "Error loading commit data for amend:\n\n$err"
1069 return
1072 set HEAD $curHEAD
1073 set PARENT $parents
1074 set MERGE_HEAD [list]
1075 switch -- [llength $parents] {
1076 0 {set commit_type amend-initial}
1077 1 {set commit_type amend}
1078 default {set commit_type amend-merge}
1081 $ui_comm delete 0.0 end
1082 $ui_comm insert end $msg
1083 $ui_comm edit reset
1084 $ui_comm edit modified false
1085 rescan {set ui_status_value {Ready.}}
1088 proc create_new_commit {} {
1089 global commit_type ui_comm
1091 set commit_type normal
1092 $ui_comm delete 0.0 end
1093 $ui_comm edit reset
1094 $ui_comm edit modified false
1095 rescan {set ui_status_value {Ready.}}
1098 set GIT_COMMITTER_IDENT {}
1100 proc committer_ident {} {
1101 global GIT_COMMITTER_IDENT
1103 if {$GIT_COMMITTER_IDENT eq {}} {
1104 if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
1105 error_popup "Unable to obtain your identity:\n\n$err"
1106 return {}
1108 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1109 $me me GIT_COMMITTER_IDENT]} {
1110 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1111 return {}
1115 return $GIT_COMMITTER_IDENT
1118 proc commit_tree {} {
1119 global HEAD commit_type file_states ui_comm repo_config
1120 global ui_status_value pch_error
1122 if {[committer_ident] eq {}} return
1123 if {![lock_index update]} return
1125 # -- Our in memory state should match the repository.
1127 repository_state curType curHEAD curMERGE_HEAD
1128 if {[string match amend* $commit_type]
1129 && $curType eq {normal}
1130 && $curHEAD eq $HEAD} {
1131 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1132 info_popup {Last scanned state does not match repository state.
1134 Another Git program has modified this repository
1135 since the last scan. A rescan must be performed
1136 before another commit can be created.
1138 The rescan will be automatically started now.
1140 unlock_index
1141 rescan {set ui_status_value {Ready.}}
1142 return
1145 # -- At least one file should differ in the index.
1147 set files_ready 0
1148 foreach path [array names file_states] {
1149 switch -glob -- [lindex $file_states($path) 0] {
1150 _? {continue}
1151 A? -
1152 D? -
1153 M? {set files_ready 1}
1154 U? {
1155 error_popup "Unmerged files cannot be committed.
1157 File [short_path $path] has merge conflicts.
1158 You must resolve them and add the file before committing.
1160 unlock_index
1161 return
1163 default {
1164 error_popup "Unknown file state [lindex $s 0] detected.
1166 File [short_path $path] cannot be committed by this program.
1171 if {!$files_ready && ![string match *merge $curType]} {
1172 info_popup {No changes to commit.
1174 You must add at least 1 file before you can commit.
1176 unlock_index
1177 return
1180 # -- A message is required.
1182 set msg [string trim [$ui_comm get 1.0 end]]
1183 regsub -all -line {[ \t\r]+$} $msg {} msg
1184 if {$msg eq {}} {
1185 error_popup {Please supply a commit message.
1187 A good commit message has the following format:
1189 - First line: Describe in one sentance what you did.
1190 - Second line: Blank
1191 - Remaining lines: Describe why this change is good.
1193 unlock_index
1194 return
1197 # -- Run the pre-commit hook.
1199 set pchook [gitdir hooks pre-commit]
1201 # On Cygwin [file executable] might lie so we need to ask
1202 # the shell if the hook is executable. Yes that's annoying.
1204 if {[is_Cygwin] && [file isfile $pchook]} {
1205 set pchook [list sh -c [concat \
1206 "if test -x \"$pchook\";" \
1207 "then exec \"$pchook\" 2>&1;" \
1208 "fi"]]
1209 } elseif {[file executable $pchook]} {
1210 set pchook [list $pchook |& cat]
1211 } else {
1212 commit_writetree $curHEAD $msg
1213 return
1216 set ui_status_value {Calling pre-commit hook...}
1217 set pch_error {}
1218 set fd_ph [open "| $pchook" r]
1219 fconfigure $fd_ph -blocking 0 -translation binary
1220 fileevent $fd_ph readable \
1221 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1224 proc commit_prehook_wait {fd_ph curHEAD msg} {
1225 global pch_error ui_status_value
1227 append pch_error [read $fd_ph]
1228 fconfigure $fd_ph -blocking 1
1229 if {[eof $fd_ph]} {
1230 if {[catch {close $fd_ph}]} {
1231 set ui_status_value {Commit declined by pre-commit hook.}
1232 hook_failed_popup pre-commit $pch_error
1233 unlock_index
1234 } else {
1235 commit_writetree $curHEAD $msg
1237 set pch_error {}
1238 return
1240 fconfigure $fd_ph -blocking 0
1243 proc commit_writetree {curHEAD msg} {
1244 global ui_status_value
1246 set ui_status_value {Committing changes...}
1247 set fd_wt [open "| git write-tree" r]
1248 fileevent $fd_wt readable \
1249 [list commit_committree $fd_wt $curHEAD $msg]
1252 proc commit_committree {fd_wt curHEAD msg} {
1253 global HEAD PARENT MERGE_HEAD commit_type
1254 global all_heads current_branch
1255 global ui_status_value ui_comm selected_commit_type
1256 global file_states selected_paths rescan_active
1257 global repo_config
1259 gets $fd_wt tree_id
1260 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1261 error_popup "write-tree failed:\n\n$err"
1262 set ui_status_value {Commit failed.}
1263 unlock_index
1264 return
1267 # -- Verify this wasn't an empty change.
1269 if {$commit_type eq {normal}} {
1270 set old_tree [git rev-parse "$PARENT^{tree}"]
1271 if {$tree_id eq $old_tree} {
1272 info_popup {No changes to commit.
1274 No files were modified by this commit and it
1275 was not a merge commit.
1277 A rescan will be automatically started now.
1279 unlock_index
1280 rescan {set ui_status_value {No changes to commit.}}
1281 return
1285 # -- Build the message.
1287 set msg_p [gitdir COMMIT_EDITMSG]
1288 set msg_wt [open $msg_p w]
1289 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1290 set enc utf-8
1292 fconfigure $msg_wt -encoding $enc -translation binary
1293 puts -nonewline $msg_wt $msg
1294 close $msg_wt
1296 # -- Create the commit.
1298 set cmd [list git commit-tree $tree_id]
1299 foreach p [concat $PARENT $MERGE_HEAD] {
1300 lappend cmd -p $p
1302 lappend cmd <$msg_p
1303 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1304 error_popup "commit-tree failed:\n\n$err"
1305 set ui_status_value {Commit failed.}
1306 unlock_index
1307 return
1310 # -- Update the HEAD ref.
1312 set reflogm commit
1313 if {$commit_type ne {normal}} {
1314 append reflogm " ($commit_type)"
1316 set i [string first "\n" $msg]
1317 if {$i >= 0} {
1318 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1319 } else {
1320 append reflogm {: } $msg
1322 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1323 if {[catch {eval exec $cmd} err]} {
1324 error_popup "update-ref failed:\n\n$err"
1325 set ui_status_value {Commit failed.}
1326 unlock_index
1327 return
1330 # -- Cleanup after ourselves.
1332 catch {file delete $msg_p}
1333 catch {file delete [gitdir MERGE_HEAD]}
1334 catch {file delete [gitdir MERGE_MSG]}
1335 catch {file delete [gitdir SQUASH_MSG]}
1336 catch {file delete [gitdir GITGUI_MSG]}
1338 # -- Let rerere do its thing.
1340 if {[file isdirectory [gitdir rr-cache]]} {
1341 catch {git rerere}
1344 # -- Run the post-commit hook.
1346 set pchook [gitdir hooks post-commit]
1347 if {[is_Cygwin] && [file isfile $pchook]} {
1348 set pchook [list sh -c [concat \
1349 "if test -x \"$pchook\";" \
1350 "then exec \"$pchook\";" \
1351 "fi"]]
1352 } elseif {![file executable $pchook]} {
1353 set pchook {}
1355 if {$pchook ne {}} {
1356 catch {exec $pchook &}
1359 $ui_comm delete 0.0 end
1360 $ui_comm edit reset
1361 $ui_comm edit modified false
1363 if {[is_enabled singlecommit]} do_quit
1365 # -- Make sure our current branch exists.
1367 if {$commit_type eq {initial}} {
1368 lappend all_heads $current_branch
1369 set all_heads [lsort -unique $all_heads]
1370 populate_branch_menu
1373 # -- Update in memory status
1375 set selected_commit_type new
1376 set commit_type normal
1377 set HEAD $cmt_id
1378 set PARENT $cmt_id
1379 set MERGE_HEAD [list]
1381 foreach path [array names file_states] {
1382 set s $file_states($path)
1383 set m [lindex $s 0]
1384 switch -glob -- $m {
1385 _O -
1386 _M -
1387 _D {continue}
1388 __ -
1389 A_ -
1390 M_ -
1391 D_ {
1392 unset file_states($path)
1393 catch {unset selected_paths($path)}
1395 DO {
1396 set file_states($path) [list _O [lindex $s 1] {} {}]
1398 AM -
1399 AD -
1400 MM -
1401 MD {
1402 set file_states($path) [list \
1403 _[string index $m 1] \
1404 [lindex $s 1] \
1405 [lindex $s 3] \
1411 display_all_files
1412 unlock_index
1413 reshow_diff
1414 set ui_status_value \
1415 "Changes committed as [string range $cmt_id 0 7]."
1418 ######################################################################
1420 ## fetch push
1422 proc fetch_from {remote} {
1423 set w [new_console \
1424 "fetch $remote" \
1425 "Fetching new changes from $remote"]
1426 set cmd [list git fetch]
1427 lappend cmd $remote
1428 console_exec $w $cmd console_done
1431 proc push_to {remote} {
1432 set w [new_console \
1433 "push $remote" \
1434 "Pushing changes to $remote"]
1435 set cmd [list git push]
1436 lappend cmd -v
1437 lappend cmd $remote
1438 console_exec $w $cmd console_done
1441 ######################################################################
1443 ## ui helpers
1445 proc mapicon {w state path} {
1446 global all_icons
1448 if {[catch {set r $all_icons($state$w)}]} {
1449 puts "error: no icon for $w state={$state} $path"
1450 return file_plain
1452 return $r
1455 proc mapdesc {state path} {
1456 global all_descs
1458 if {[catch {set r $all_descs($state)}]} {
1459 puts "error: no desc for state={$state} $path"
1460 return $state
1462 return $r
1465 proc escape_path {path} {
1466 regsub -all {\\} $path "\\\\" path
1467 regsub -all "\n" $path "\\n" path
1468 return $path
1471 proc short_path {path} {
1472 return [escape_path [lindex [file split $path] end]]
1475 set next_icon_id 0
1476 set null_sha1 [string repeat 0 40]
1478 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1479 global file_states next_icon_id null_sha1
1481 set s0 [string index $new_state 0]
1482 set s1 [string index $new_state 1]
1484 if {[catch {set info $file_states($path)}]} {
1485 set state __
1486 set icon n[incr next_icon_id]
1487 } else {
1488 set state [lindex $info 0]
1489 set icon [lindex $info 1]
1490 if {$head_info eq {}} {set head_info [lindex $info 2]}
1491 if {$index_info eq {}} {set index_info [lindex $info 3]}
1494 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1495 elseif {$s0 eq {_}} {set s0 _}
1497 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1498 elseif {$s1 eq {_}} {set s1 _}
1500 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1501 set head_info [list 0 $null_sha1]
1502 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1503 && $head_info eq {}} {
1504 set head_info $index_info
1507 set file_states($path) [list $s0$s1 $icon \
1508 $head_info $index_info \
1510 return $state
1513 proc display_file_helper {w path icon_name old_m new_m} {
1514 global file_lists
1516 if {$new_m eq {_}} {
1517 set lno [lsearch -sorted -exact $file_lists($w) $path]
1518 if {$lno >= 0} {
1519 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1520 incr lno
1521 $w conf -state normal
1522 $w delete $lno.0 [expr {$lno + 1}].0
1523 $w conf -state disabled
1525 } elseif {$old_m eq {_} && $new_m ne {_}} {
1526 lappend file_lists($w) $path
1527 set file_lists($w) [lsort -unique $file_lists($w)]
1528 set lno [lsearch -sorted -exact $file_lists($w) $path]
1529 incr lno
1530 $w conf -state normal
1531 $w image create $lno.0 \
1532 -align center -padx 5 -pady 1 \
1533 -name $icon_name \
1534 -image [mapicon $w $new_m $path]
1535 $w insert $lno.1 "[escape_path $path]\n"
1536 $w conf -state disabled
1537 } elseif {$old_m ne $new_m} {
1538 $w conf -state normal
1539 $w image conf $icon_name -image [mapicon $w $new_m $path]
1540 $w conf -state disabled
1544 proc display_file {path state} {
1545 global file_states selected_paths
1546 global ui_index ui_workdir
1548 set old_m [merge_state $path $state]
1549 set s $file_states($path)
1550 set new_m [lindex $s 0]
1551 set icon_name [lindex $s 1]
1553 set o [string index $old_m 0]
1554 set n [string index $new_m 0]
1555 if {$o eq {U}} {
1556 set o _
1558 if {$n eq {U}} {
1559 set n _
1561 display_file_helper $ui_index $path $icon_name $o $n
1563 if {[string index $old_m 0] eq {U}} {
1564 set o U
1565 } else {
1566 set o [string index $old_m 1]
1568 if {[string index $new_m 0] eq {U}} {
1569 set n U
1570 } else {
1571 set n [string index $new_m 1]
1573 display_file_helper $ui_workdir $path $icon_name $o $n
1575 if {$new_m eq {__}} {
1576 unset file_states($path)
1577 catch {unset selected_paths($path)}
1581 proc display_all_files_helper {w path icon_name m} {
1582 global file_lists
1584 lappend file_lists($w) $path
1585 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1586 $w image create end \
1587 -align center -padx 5 -pady 1 \
1588 -name $icon_name \
1589 -image [mapicon $w $m $path]
1590 $w insert end "[escape_path $path]\n"
1593 proc display_all_files {} {
1594 global ui_index ui_workdir
1595 global file_states file_lists
1596 global last_clicked
1598 $ui_index conf -state normal
1599 $ui_workdir conf -state normal
1601 $ui_index delete 0.0 end
1602 $ui_workdir delete 0.0 end
1603 set last_clicked {}
1605 set file_lists($ui_index) [list]
1606 set file_lists($ui_workdir) [list]
1608 foreach path [lsort [array names file_states]] {
1609 set s $file_states($path)
1610 set m [lindex $s 0]
1611 set icon_name [lindex $s 1]
1613 set s [string index $m 0]
1614 if {$s ne {U} && $s ne {_}} {
1615 display_all_files_helper $ui_index $path \
1616 $icon_name $s
1619 if {[string index $m 0] eq {U}} {
1620 set s U
1621 } else {
1622 set s [string index $m 1]
1624 if {$s ne {_}} {
1625 display_all_files_helper $ui_workdir $path \
1626 $icon_name $s
1630 $ui_index conf -state disabled
1631 $ui_workdir conf -state disabled
1634 proc update_indexinfo {msg pathList after} {
1635 global update_index_cp ui_status_value
1637 if {![lock_index update]} return
1639 set update_index_cp 0
1640 set pathList [lsort $pathList]
1641 set totalCnt [llength $pathList]
1642 set batch [expr {int($totalCnt * .01) + 1}]
1643 if {$batch > 25} {set batch 25}
1645 set ui_status_value [format \
1646 "$msg... %i/%i files (%.2f%%)" \
1647 $update_index_cp \
1648 $totalCnt \
1649 0.0]
1650 set fd [open "| git update-index -z --index-info" w]
1651 fconfigure $fd \
1652 -blocking 0 \
1653 -buffering full \
1654 -buffersize 512 \
1655 -encoding binary \
1656 -translation binary
1657 fileevent $fd writable [list \
1658 write_update_indexinfo \
1659 $fd \
1660 $pathList \
1661 $totalCnt \
1662 $batch \
1663 $msg \
1664 $after \
1668 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1669 global update_index_cp ui_status_value
1670 global file_states current_diff_path
1672 if {$update_index_cp >= $totalCnt} {
1673 close $fd
1674 unlock_index
1675 uplevel #0 $after
1676 return
1679 for {set i $batch} \
1680 {$update_index_cp < $totalCnt && $i > 0} \
1681 {incr i -1} {
1682 set path [lindex $pathList $update_index_cp]
1683 incr update_index_cp
1685 set s $file_states($path)
1686 switch -glob -- [lindex $s 0] {
1687 A? {set new _O}
1688 M? {set new _M}
1689 D_ {set new _D}
1690 D? {set new _?}
1691 ?? {continue}
1693 set info [lindex $s 2]
1694 if {$info eq {}} continue
1696 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1697 display_file $path $new
1700 set ui_status_value [format \
1701 "$msg... %i/%i files (%.2f%%)" \
1702 $update_index_cp \
1703 $totalCnt \
1704 [expr {100.0 * $update_index_cp / $totalCnt}]]
1707 proc update_index {msg pathList after} {
1708 global update_index_cp ui_status_value
1710 if {![lock_index update]} return
1712 set update_index_cp 0
1713 set pathList [lsort $pathList]
1714 set totalCnt [llength $pathList]
1715 set batch [expr {int($totalCnt * .01) + 1}]
1716 if {$batch > 25} {set batch 25}
1718 set ui_status_value [format \
1719 "$msg... %i/%i files (%.2f%%)" \
1720 $update_index_cp \
1721 $totalCnt \
1722 0.0]
1723 set fd [open "| git update-index --add --remove -z --stdin" w]
1724 fconfigure $fd \
1725 -blocking 0 \
1726 -buffering full \
1727 -buffersize 512 \
1728 -encoding binary \
1729 -translation binary
1730 fileevent $fd writable [list \
1731 write_update_index \
1732 $fd \
1733 $pathList \
1734 $totalCnt \
1735 $batch \
1736 $msg \
1737 $after \
1741 proc write_update_index {fd pathList totalCnt batch msg after} {
1742 global update_index_cp ui_status_value
1743 global file_states current_diff_path
1745 if {$update_index_cp >= $totalCnt} {
1746 close $fd
1747 unlock_index
1748 uplevel #0 $after
1749 return
1752 for {set i $batch} \
1753 {$update_index_cp < $totalCnt && $i > 0} \
1754 {incr i -1} {
1755 set path [lindex $pathList $update_index_cp]
1756 incr update_index_cp
1758 switch -glob -- [lindex $file_states($path) 0] {
1759 AD {set new __}
1760 ?D {set new D_}
1761 _O -
1762 AM {set new A_}
1763 U? {
1764 if {[file exists $path]} {
1765 set new M_
1766 } else {
1767 set new D_
1770 ?M {set new M_}
1771 ?? {continue}
1773 puts -nonewline $fd "[encoding convertto $path]\0"
1774 display_file $path $new
1777 set ui_status_value [format \
1778 "$msg... %i/%i files (%.2f%%)" \
1779 $update_index_cp \
1780 $totalCnt \
1781 [expr {100.0 * $update_index_cp / $totalCnt}]]
1784 proc checkout_index {msg pathList after} {
1785 global update_index_cp ui_status_value
1787 if {![lock_index update]} return
1789 set update_index_cp 0
1790 set pathList [lsort $pathList]
1791 set totalCnt [llength $pathList]
1792 set batch [expr {int($totalCnt * .01) + 1}]
1793 if {$batch > 25} {set batch 25}
1795 set ui_status_value [format \
1796 "$msg... %i/%i files (%.2f%%)" \
1797 $update_index_cp \
1798 $totalCnt \
1799 0.0]
1800 set cmd [list git checkout-index]
1801 lappend cmd --index
1802 lappend cmd --quiet
1803 lappend cmd --force
1804 lappend cmd -z
1805 lappend cmd --stdin
1806 set fd [open "| $cmd " w]
1807 fconfigure $fd \
1808 -blocking 0 \
1809 -buffering full \
1810 -buffersize 512 \
1811 -encoding binary \
1812 -translation binary
1813 fileevent $fd writable [list \
1814 write_checkout_index \
1815 $fd \
1816 $pathList \
1817 $totalCnt \
1818 $batch \
1819 $msg \
1820 $after \
1824 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1825 global update_index_cp ui_status_value
1826 global file_states current_diff_path
1828 if {$update_index_cp >= $totalCnt} {
1829 close $fd
1830 unlock_index
1831 uplevel #0 $after
1832 return
1835 for {set i $batch} \
1836 {$update_index_cp < $totalCnt && $i > 0} \
1837 {incr i -1} {
1838 set path [lindex $pathList $update_index_cp]
1839 incr update_index_cp
1840 switch -glob -- [lindex $file_states($path) 0] {
1841 U? {continue}
1842 ?M -
1843 ?D {
1844 puts -nonewline $fd "[encoding convertto $path]\0"
1845 display_file $path ?_
1850 set ui_status_value [format \
1851 "$msg... %i/%i files (%.2f%%)" \
1852 $update_index_cp \
1853 $totalCnt \
1854 [expr {100.0 * $update_index_cp / $totalCnt}]]
1857 ######################################################################
1859 ## branch management
1861 proc is_tracking_branch {name} {
1862 global tracking_branches
1864 if {![catch {set info $tracking_branches($name)}]} {
1865 return 1
1867 foreach t [array names tracking_branches] {
1868 if {[string match {*/\*} $t] && [string match $t $name]} {
1869 return 1
1872 return 0
1875 proc load_all_heads {} {
1876 global all_heads
1878 set all_heads [list]
1879 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1880 while {[gets $fd line] > 0} {
1881 if {[is_tracking_branch $line]} continue
1882 if {![regsub ^refs/heads/ $line {} name]} continue
1883 lappend all_heads $name
1885 close $fd
1887 set all_heads [lsort $all_heads]
1890 proc populate_branch_menu {} {
1891 global all_heads disable_on_lock
1893 set m .mbar.branch
1894 set last [$m index last]
1895 for {set i 0} {$i <= $last} {incr i} {
1896 if {[$m type $i] eq {separator}} {
1897 $m delete $i last
1898 set new_dol [list]
1899 foreach a $disable_on_lock {
1900 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1901 lappend new_dol $a
1904 set disable_on_lock $new_dol
1905 break
1909 if {$all_heads ne {}} {
1910 $m add separator
1912 foreach b $all_heads {
1913 $m add radiobutton \
1914 -label $b \
1915 -command [list switch_branch $b] \
1916 -variable current_branch \
1917 -value $b \
1918 -font font_ui
1919 lappend disable_on_lock \
1920 [list $m entryconf [$m index last] -state]
1924 proc all_tracking_branches {} {
1925 global tracking_branches
1927 set all_trackings {}
1928 set cmd {}
1929 foreach name [array names tracking_branches] {
1930 if {[regsub {/\*$} $name {} name]} {
1931 lappend cmd $name
1932 } else {
1933 regsub ^refs/(heads|remotes)/ $name {} name
1934 lappend all_trackings $name
1938 if {$cmd ne {}} {
1939 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1940 while {[gets $fd name] > 0} {
1941 regsub ^refs/(heads|remotes)/ $name {} name
1942 lappend all_trackings $name
1944 close $fd
1947 return [lsort -unique $all_trackings]
1950 proc load_all_tags {} {
1951 set all_tags [list]
1952 set fd [open "| git for-each-ref --format=%(refname) refs/tags" r]
1953 while {[gets $fd line] > 0} {
1954 if {![regsub ^refs/tags/ $line {} name]} continue
1955 lappend all_tags $name
1957 close $fd
1959 return [lsort $all_tags]
1962 proc do_create_branch_action {w} {
1963 global all_heads null_sha1 repo_config
1964 global create_branch_checkout create_branch_revtype
1965 global create_branch_head create_branch_trackinghead
1966 global create_branch_name create_branch_revexp
1967 global create_branch_tag
1969 set newbranch $create_branch_name
1970 if {$newbranch eq {}
1971 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1972 tk_messageBox \
1973 -icon error \
1974 -type ok \
1975 -title [wm title $w] \
1976 -parent $w \
1977 -message "Please supply a branch name."
1978 focus $w.desc.name_t
1979 return
1981 if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
1982 tk_messageBox \
1983 -icon error \
1984 -type ok \
1985 -title [wm title $w] \
1986 -parent $w \
1987 -message "Branch '$newbranch' already exists."
1988 focus $w.desc.name_t
1989 return
1991 if {[catch {git check-ref-format "heads/$newbranch"}]} {
1992 tk_messageBox \
1993 -icon error \
1994 -type ok \
1995 -title [wm title $w] \
1996 -parent $w \
1997 -message "We do not like '$newbranch' as a branch name."
1998 focus $w.desc.name_t
1999 return
2002 set rev {}
2003 switch -- $create_branch_revtype {
2004 head {set rev $create_branch_head}
2005 tracking {set rev $create_branch_trackinghead}
2006 tag {set rev $create_branch_tag}
2007 expression {set rev $create_branch_revexp}
2009 if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
2010 tk_messageBox \
2011 -icon error \
2012 -type ok \
2013 -title [wm title $w] \
2014 -parent $w \
2015 -message "Invalid starting revision: $rev"
2016 return
2018 set cmd [list git update-ref]
2019 lappend cmd -m
2020 lappend cmd "branch: Created from $rev"
2021 lappend cmd "refs/heads/$newbranch"
2022 lappend cmd $cmt
2023 lappend cmd $null_sha1
2024 if {[catch {eval exec $cmd} err]} {
2025 tk_messageBox \
2026 -icon error \
2027 -type ok \
2028 -title [wm title $w] \
2029 -parent $w \
2030 -message "Failed to create '$newbranch'.\n\n$err"
2031 return
2034 lappend all_heads $newbranch
2035 set all_heads [lsort $all_heads]
2036 populate_branch_menu
2037 destroy $w
2038 if {$create_branch_checkout} {
2039 switch_branch $newbranch
2043 proc radio_selector {varname value args} {
2044 upvar #0 $varname var
2045 set var $value
2048 trace add variable create_branch_head write \
2049 [list radio_selector create_branch_revtype head]
2050 trace add variable create_branch_trackinghead write \
2051 [list radio_selector create_branch_revtype tracking]
2052 trace add variable create_branch_tag write \
2053 [list radio_selector create_branch_revtype tag]
2055 trace add variable delete_branch_head write \
2056 [list radio_selector delete_branch_checktype head]
2057 trace add variable delete_branch_trackinghead write \
2058 [list radio_selector delete_branch_checktype tracking]
2060 proc do_create_branch {} {
2061 global all_heads current_branch repo_config
2062 global create_branch_checkout create_branch_revtype
2063 global create_branch_head create_branch_trackinghead
2064 global create_branch_name create_branch_revexp
2065 global create_branch_tag
2067 set w .branch_editor
2068 toplevel $w
2069 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2071 label $w.header -text {Create New Branch} \
2072 -font font_uibold
2073 pack $w.header -side top -fill x
2075 frame $w.buttons
2076 button $w.buttons.create -text Create \
2077 -font font_ui \
2078 -default active \
2079 -command [list do_create_branch_action $w]
2080 pack $w.buttons.create -side right
2081 button $w.buttons.cancel -text {Cancel} \
2082 -font font_ui \
2083 -command [list destroy $w]
2084 pack $w.buttons.cancel -side right -padx 5
2085 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2087 labelframe $w.desc \
2088 -text {Branch Description} \
2089 -font font_ui
2090 label $w.desc.name_l -text {Name:} -font font_ui
2091 entry $w.desc.name_t \
2092 -borderwidth 1 \
2093 -relief sunken \
2094 -width 40 \
2095 -textvariable create_branch_name \
2096 -font font_ui \
2097 -validate key \
2098 -validatecommand {
2099 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2100 return 1
2102 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2103 grid columnconfigure $w.desc 1 -weight 1
2104 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2106 labelframe $w.from \
2107 -text {Starting Revision} \
2108 -font font_ui
2109 radiobutton $w.from.head_r \
2110 -text {Local Branch:} \
2111 -value head \
2112 -variable create_branch_revtype \
2113 -font font_ui
2114 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2115 grid $w.from.head_r $w.from.head_m -sticky w
2116 set all_trackings [all_tracking_branches]
2117 if {$all_trackings ne {}} {
2118 set create_branch_trackinghead [lindex $all_trackings 0]
2119 radiobutton $w.from.tracking_r \
2120 -text {Tracking Branch:} \
2121 -value tracking \
2122 -variable create_branch_revtype \
2123 -font font_ui
2124 eval tk_optionMenu $w.from.tracking_m \
2125 create_branch_trackinghead \
2126 $all_trackings
2127 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2129 set all_tags [load_all_tags]
2130 if {$all_tags ne {}} {
2131 set create_branch_tag [lindex $all_tags 0]
2132 radiobutton $w.from.tag_r \
2133 -text {Tag:} \
2134 -value tag \
2135 -variable create_branch_revtype \
2136 -font font_ui
2137 eval tk_optionMenu $w.from.tag_m \
2138 create_branch_tag \
2139 $all_tags
2140 grid $w.from.tag_r $w.from.tag_m -sticky w
2142 radiobutton $w.from.exp_r \
2143 -text {Revision Expression:} \
2144 -value expression \
2145 -variable create_branch_revtype \
2146 -font font_ui
2147 entry $w.from.exp_t \
2148 -borderwidth 1 \
2149 -relief sunken \
2150 -width 50 \
2151 -textvariable create_branch_revexp \
2152 -font font_ui \
2153 -validate key \
2154 -validatecommand {
2155 if {%d == 1 && [regexp {\s} %S]} {return 0}
2156 if {%d == 1 && [string length %S] > 0} {
2157 set create_branch_revtype expression
2159 return 1
2161 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2162 grid columnconfigure $w.from 1 -weight 1
2163 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2165 labelframe $w.postActions \
2166 -text {Post Creation Actions} \
2167 -font font_ui
2168 checkbutton $w.postActions.checkout \
2169 -text {Checkout after creation} \
2170 -variable create_branch_checkout \
2171 -font font_ui
2172 pack $w.postActions.checkout -anchor nw
2173 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2175 set create_branch_checkout 1
2176 set create_branch_head $current_branch
2177 set create_branch_revtype head
2178 set create_branch_name $repo_config(gui.newbranchtemplate)
2179 set create_branch_revexp {}
2181 bind $w <Visibility> "
2182 grab $w
2183 $w.desc.name_t icursor end
2184 focus $w.desc.name_t
2186 bind $w <Key-Escape> "destroy $w"
2187 bind $w <Key-Return> "do_create_branch_action $w;break"
2188 wm title $w "[appname] ([reponame]): Create Branch"
2189 tkwait window $w
2192 proc do_delete_branch_action {w} {
2193 global all_heads
2194 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2196 set check_rev {}
2197 switch -- $delete_branch_checktype {
2198 head {set check_rev $delete_branch_head}
2199 tracking {set check_rev $delete_branch_trackinghead}
2200 always {set check_rev {:none}}
2202 if {$check_rev eq {:none}} {
2203 set check_cmt {}
2204 } elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
2205 tk_messageBox \
2206 -icon error \
2207 -type ok \
2208 -title [wm title $w] \
2209 -parent $w \
2210 -message "Invalid check revision: $check_rev"
2211 return
2214 set to_delete [list]
2215 set not_merged [list]
2216 foreach i [$w.list.l curselection] {
2217 set b [$w.list.l get $i]
2218 if {[catch {set o [git rev-parse --verify $b]}]} continue
2219 if {$check_cmt ne {}} {
2220 if {$b eq $check_rev} continue
2221 if {[catch {set m [git merge-base $o $check_cmt]}]} continue
2222 if {$o ne $m} {
2223 lappend not_merged $b
2224 continue
2227 lappend to_delete [list $b $o]
2229 if {$not_merged ne {}} {
2230 set msg "The following branches are not completely merged into $check_rev:
2232 - [join $not_merged "\n - "]"
2233 tk_messageBox \
2234 -icon info \
2235 -type ok \
2236 -title [wm title $w] \
2237 -parent $w \
2238 -message $msg
2240 if {$to_delete eq {}} return
2241 if {$delete_branch_checktype eq {always}} {
2242 set msg {Recovering deleted branches is difficult.
2244 Delete the selected branches?}
2245 if {[tk_messageBox \
2246 -icon warning \
2247 -type yesno \
2248 -title [wm title $w] \
2249 -parent $w \
2250 -message $msg] ne yes} {
2251 return
2255 set failed {}
2256 foreach i $to_delete {
2257 set b [lindex $i 0]
2258 set o [lindex $i 1]
2259 if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
2260 append failed " - $b: $err\n"
2261 } else {
2262 set x [lsearch -sorted -exact $all_heads $b]
2263 if {$x >= 0} {
2264 set all_heads [lreplace $all_heads $x $x]
2269 if {$failed ne {}} {
2270 tk_messageBox \
2271 -icon error \
2272 -type ok \
2273 -title [wm title $w] \
2274 -parent $w \
2275 -message "Failed to delete branches:\n$failed"
2278 set all_heads [lsort $all_heads]
2279 populate_branch_menu
2280 destroy $w
2283 proc do_delete_branch {} {
2284 global all_heads tracking_branches current_branch
2285 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2287 set w .branch_editor
2288 toplevel $w
2289 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2291 label $w.header -text {Delete Local Branch} \
2292 -font font_uibold
2293 pack $w.header -side top -fill x
2295 frame $w.buttons
2296 button $w.buttons.create -text Delete \
2297 -font font_ui \
2298 -command [list do_delete_branch_action $w]
2299 pack $w.buttons.create -side right
2300 button $w.buttons.cancel -text {Cancel} \
2301 -font font_ui \
2302 -command [list destroy $w]
2303 pack $w.buttons.cancel -side right -padx 5
2304 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2306 labelframe $w.list \
2307 -text {Local Branches} \
2308 -font font_ui
2309 listbox $w.list.l \
2310 -height 10 \
2311 -width 70 \
2312 -selectmode extended \
2313 -yscrollcommand [list $w.list.sby set] \
2314 -font font_ui
2315 foreach h $all_heads {
2316 if {$h ne $current_branch} {
2317 $w.list.l insert end $h
2320 scrollbar $w.list.sby -command [list $w.list.l yview]
2321 pack $w.list.sby -side right -fill y
2322 pack $w.list.l -side left -fill both -expand 1
2323 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2325 labelframe $w.validate \
2326 -text {Delete Only If} \
2327 -font font_ui
2328 radiobutton $w.validate.head_r \
2329 -text {Merged Into Local Branch:} \
2330 -value head \
2331 -variable delete_branch_checktype \
2332 -font font_ui
2333 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2334 grid $w.validate.head_r $w.validate.head_m -sticky w
2335 set all_trackings [all_tracking_branches]
2336 if {$all_trackings ne {}} {
2337 set delete_branch_trackinghead [lindex $all_trackings 0]
2338 radiobutton $w.validate.tracking_r \
2339 -text {Merged Into Tracking Branch:} \
2340 -value tracking \
2341 -variable delete_branch_checktype \
2342 -font font_ui
2343 eval tk_optionMenu $w.validate.tracking_m \
2344 delete_branch_trackinghead \
2345 $all_trackings
2346 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2348 radiobutton $w.validate.always_r \
2349 -text {Always (Do not perform merge checks)} \
2350 -value always \
2351 -variable delete_branch_checktype \
2352 -font font_ui
2353 grid $w.validate.always_r -columnspan 2 -sticky w
2354 grid columnconfigure $w.validate 1 -weight 1
2355 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2357 set delete_branch_head $current_branch
2358 set delete_branch_checktype head
2360 bind $w <Visibility> "grab $w; focus $w"
2361 bind $w <Key-Escape> "destroy $w"
2362 wm title $w "[appname] ([reponame]): Delete Branch"
2363 tkwait window $w
2366 proc switch_branch {new_branch} {
2367 global HEAD commit_type current_branch repo_config
2369 if {![lock_index switch]} return
2371 # -- Our in memory state should match the repository.
2373 repository_state curType curHEAD curMERGE_HEAD
2374 if {[string match amend* $commit_type]
2375 && $curType eq {normal}
2376 && $curHEAD eq $HEAD} {
2377 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2378 info_popup {Last scanned state does not match repository state.
2380 Another Git program has modified this repository
2381 since the last scan. A rescan must be performed
2382 before the current branch can be changed.
2384 The rescan will be automatically started now.
2386 unlock_index
2387 rescan {set ui_status_value {Ready.}}
2388 return
2391 # -- Don't do a pointless switch.
2393 if {$current_branch eq $new_branch} {
2394 unlock_index
2395 return
2398 if {$repo_config(gui.trustmtime) eq {true}} {
2399 switch_branch_stage2 {} $new_branch
2400 } else {
2401 set ui_status_value {Refreshing file status...}
2402 set cmd [list git update-index]
2403 lappend cmd -q
2404 lappend cmd --unmerged
2405 lappend cmd --ignore-missing
2406 lappend cmd --refresh
2407 set fd_rf [open "| $cmd" r]
2408 fconfigure $fd_rf -blocking 0 -translation binary
2409 fileevent $fd_rf readable \
2410 [list switch_branch_stage2 $fd_rf $new_branch]
2414 proc switch_branch_stage2 {fd_rf new_branch} {
2415 global ui_status_value HEAD
2417 if {$fd_rf ne {}} {
2418 read $fd_rf
2419 if {![eof $fd_rf]} return
2420 close $fd_rf
2423 set ui_status_value "Updating working directory to '$new_branch'..."
2424 set cmd [list git read-tree]
2425 lappend cmd -m
2426 lappend cmd -u
2427 lappend cmd --exclude-per-directory=.gitignore
2428 lappend cmd $HEAD
2429 lappend cmd $new_branch
2430 set fd_rt [open "| $cmd" r]
2431 fconfigure $fd_rt -blocking 0 -translation binary
2432 fileevent $fd_rt readable \
2433 [list switch_branch_readtree_wait $fd_rt $new_branch]
2436 proc switch_branch_readtree_wait {fd_rt new_branch} {
2437 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2438 global current_branch
2439 global ui_comm ui_status_value
2441 # -- We never get interesting output on stdout; only stderr.
2443 read $fd_rt
2444 fconfigure $fd_rt -blocking 1
2445 if {![eof $fd_rt]} {
2446 fconfigure $fd_rt -blocking 0
2447 return
2450 # -- The working directory wasn't in sync with the index and
2451 # we'd have to overwrite something to make the switch. A
2452 # merge is required.
2454 if {[catch {close $fd_rt} err]} {
2455 regsub {^fatal: } $err {} err
2456 warn_popup "File level merge required.
2458 $err
2460 Staying on branch '$current_branch'."
2461 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2462 unlock_index
2463 return
2466 # -- Update the symbolic ref. Core git doesn't even check for failure
2467 # here, it Just Works(tm). If it doesn't we are in some really ugly
2468 # state that is difficult to recover from within git-gui.
2470 if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2471 error_popup "Failed to set current branch.
2473 This working directory is only partially switched.
2474 We successfully updated your files, but failed to
2475 update an internal Git file.
2477 This should not have occurred. [appname] will now
2478 close and give up.
2480 $err"
2481 do_quit
2482 return
2485 # -- Update our repository state. If we were previously in amend mode
2486 # we need to toss the current buffer and do a full rescan to update
2487 # our file lists. If we weren't in amend mode our file lists are
2488 # accurate and we can avoid the rescan.
2490 unlock_index
2491 set selected_commit_type new
2492 if {[string match amend* $commit_type]} {
2493 $ui_comm delete 0.0 end
2494 $ui_comm edit reset
2495 $ui_comm edit modified false
2496 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2497 } else {
2498 repository_state commit_type HEAD MERGE_HEAD
2499 set PARENT $HEAD
2500 set ui_status_value "Checked out branch '$current_branch'."
2504 ######################################################################
2506 ## remote management
2508 proc load_all_remotes {} {
2509 global repo_config
2510 global all_remotes tracking_branches
2512 set all_remotes [list]
2513 array unset tracking_branches
2515 set rm_dir [gitdir remotes]
2516 if {[file isdirectory $rm_dir]} {
2517 set all_remotes [glob \
2518 -types f \
2519 -tails \
2520 -nocomplain \
2521 -directory $rm_dir *]
2523 foreach name $all_remotes {
2524 catch {
2525 set fd [open [file join $rm_dir $name] r]
2526 while {[gets $fd line] >= 0} {
2527 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2528 $line line src dst]} continue
2529 if {![regexp ^refs/ $dst]} {
2530 set dst "refs/heads/$dst"
2532 set tracking_branches($dst) [list $name $src]
2534 close $fd
2539 foreach line [array names repo_config remote.*.url] {
2540 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2541 lappend all_remotes $name
2543 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2544 set fl {}
2546 foreach line $fl {
2547 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2548 if {![regexp ^refs/ $dst]} {
2549 set dst "refs/heads/$dst"
2551 set tracking_branches($dst) [list $name $src]
2555 set all_remotes [lsort -unique $all_remotes]
2558 proc populate_fetch_menu {} {
2559 global all_remotes repo_config
2561 set m .mbar.fetch
2562 foreach r $all_remotes {
2563 set enable 0
2564 if {![catch {set a $repo_config(remote.$r.url)}]} {
2565 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2566 set enable 1
2568 } else {
2569 catch {
2570 set fd [open [gitdir remotes $r] r]
2571 while {[gets $fd n] >= 0} {
2572 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2573 set enable 1
2574 break
2577 close $fd
2581 if {$enable} {
2582 $m add command \
2583 -label "Fetch from $r..." \
2584 -command [list fetch_from $r] \
2585 -font font_ui
2590 proc populate_push_menu {} {
2591 global all_remotes repo_config
2593 set m .mbar.push
2594 set fast_count 0
2595 foreach r $all_remotes {
2596 set enable 0
2597 if {![catch {set a $repo_config(remote.$r.url)}]} {
2598 if {![catch {set a $repo_config(remote.$r.push)}]} {
2599 set enable 1
2601 } else {
2602 catch {
2603 set fd [open [gitdir remotes $r] r]
2604 while {[gets $fd n] >= 0} {
2605 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2606 set enable 1
2607 break
2610 close $fd
2614 if {$enable} {
2615 if {!$fast_count} {
2616 $m add separator
2618 $m add command \
2619 -label "Push to $r..." \
2620 -command [list push_to $r] \
2621 -font font_ui
2622 incr fast_count
2627 proc start_push_anywhere_action {w} {
2628 global push_urltype push_remote push_url push_thin push_tags
2630 set r_url {}
2631 switch -- $push_urltype {
2632 remote {set r_url $push_remote}
2633 url {set r_url $push_url}
2635 if {$r_url eq {}} return
2637 set cmd [list git push]
2638 lappend cmd -v
2639 if {$push_thin} {
2640 lappend cmd --thin
2642 if {$push_tags} {
2643 lappend cmd --tags
2645 lappend cmd $r_url
2646 set cnt 0
2647 foreach i [$w.source.l curselection] {
2648 set b [$w.source.l get $i]
2649 lappend cmd "refs/heads/$b:refs/heads/$b"
2650 incr cnt
2652 if {$cnt == 0} {
2653 return
2654 } elseif {$cnt == 1} {
2655 set unit branch
2656 } else {
2657 set unit branches
2660 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2661 console_exec $cons $cmd console_done
2662 destroy $w
2665 trace add variable push_remote write \
2666 [list radio_selector push_urltype remote]
2668 proc do_push_anywhere {} {
2669 global all_heads all_remotes current_branch
2670 global push_urltype push_remote push_url push_thin push_tags
2672 set w .push_setup
2673 toplevel $w
2674 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2676 label $w.header -text {Push Branches} -font font_uibold
2677 pack $w.header -side top -fill x
2679 frame $w.buttons
2680 button $w.buttons.create -text Push \
2681 -font font_ui \
2682 -command [list start_push_anywhere_action $w]
2683 pack $w.buttons.create -side right
2684 button $w.buttons.cancel -text {Cancel} \
2685 -font font_ui \
2686 -command [list destroy $w]
2687 pack $w.buttons.cancel -side right -padx 5
2688 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2690 labelframe $w.source \
2691 -text {Source Branches} \
2692 -font font_ui
2693 listbox $w.source.l \
2694 -height 10 \
2695 -width 70 \
2696 -selectmode extended \
2697 -yscrollcommand [list $w.source.sby set] \
2698 -font font_ui
2699 foreach h $all_heads {
2700 $w.source.l insert end $h
2701 if {$h eq $current_branch} {
2702 $w.source.l select set end
2705 scrollbar $w.source.sby -command [list $w.source.l yview]
2706 pack $w.source.sby -side right -fill y
2707 pack $w.source.l -side left -fill both -expand 1
2708 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2710 labelframe $w.dest \
2711 -text {Destination Repository} \
2712 -font font_ui
2713 if {$all_remotes ne {}} {
2714 radiobutton $w.dest.remote_r \
2715 -text {Remote:} \
2716 -value remote \
2717 -variable push_urltype \
2718 -font font_ui
2719 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2720 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2721 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2722 set push_remote origin
2723 } else {
2724 set push_remote [lindex $all_remotes 0]
2726 set push_urltype remote
2727 } else {
2728 set push_urltype url
2730 radiobutton $w.dest.url_r \
2731 -text {Arbitrary URL:} \
2732 -value url \
2733 -variable push_urltype \
2734 -font font_ui
2735 entry $w.dest.url_t \
2736 -borderwidth 1 \
2737 -relief sunken \
2738 -width 50 \
2739 -textvariable push_url \
2740 -font font_ui \
2741 -validate key \
2742 -validatecommand {
2743 if {%d == 1 && [regexp {\s} %S]} {return 0}
2744 if {%d == 1 && [string length %S] > 0} {
2745 set push_urltype url
2747 return 1
2749 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2750 grid columnconfigure $w.dest 1 -weight 1
2751 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2753 labelframe $w.options \
2754 -text {Transfer Options} \
2755 -font font_ui
2756 checkbutton $w.options.thin \
2757 -text {Use thin pack (for slow network connections)} \
2758 -variable push_thin \
2759 -font font_ui
2760 grid $w.options.thin -columnspan 2 -sticky w
2761 checkbutton $w.options.tags \
2762 -text {Include tags} \
2763 -variable push_tags \
2764 -font font_ui
2765 grid $w.options.tags -columnspan 2 -sticky w
2766 grid columnconfigure $w.options 1 -weight 1
2767 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2769 set push_url {}
2770 set push_thin 0
2771 set push_tags 0
2773 bind $w <Visibility> "grab $w"
2774 bind $w <Key-Escape> "destroy $w"
2775 wm title $w "[appname] ([reponame]): Push"
2776 tkwait window $w
2779 ######################################################################
2781 ## merge
2783 proc can_merge {} {
2784 global HEAD commit_type file_states
2786 if {[string match amend* $commit_type]} {
2787 info_popup {Cannot merge while amending.
2789 You must finish amending this commit before
2790 starting any type of merge.
2792 return 0
2795 if {[committer_ident] eq {}} {return 0}
2796 if {![lock_index merge]} {return 0}
2798 # -- Our in memory state should match the repository.
2800 repository_state curType curHEAD curMERGE_HEAD
2801 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2802 info_popup {Last scanned state does not match repository state.
2804 Another Git program has modified this repository
2805 since the last scan. A rescan must be performed
2806 before a merge can be performed.
2808 The rescan will be automatically started now.
2810 unlock_index
2811 rescan {set ui_status_value {Ready.}}
2812 return 0
2815 foreach path [array names file_states] {
2816 switch -glob -- [lindex $file_states($path) 0] {
2817 _O {
2818 continue; # and pray it works!
2820 U? {
2821 error_popup "You are in the middle of a conflicted merge.
2823 File [short_path $path] has merge conflicts.
2825 You must resolve them, add the file, and commit to
2826 complete the current merge. Only then can you
2827 begin another merge.
2829 unlock_index
2830 return 0
2832 ?? {
2833 error_popup "You are in the middle of a change.
2835 File [short_path $path] is modified.
2837 You should complete the current commit before
2838 starting a merge. Doing so will help you abort
2839 a failed merge, should the need arise.
2841 unlock_index
2842 return 0
2847 return 1
2850 proc visualize_local_merge {w} {
2851 set revs {}
2852 foreach i [$w.source.l curselection] {
2853 lappend revs [$w.source.l get $i]
2855 if {$revs eq {}} return
2856 lappend revs --not HEAD
2857 do_gitk $revs
2860 proc start_local_merge_action {w} {
2861 global HEAD ui_status_value current_branch
2863 set cmd [list git merge]
2864 set names {}
2865 set revcnt 0
2866 foreach i [$w.source.l curselection] {
2867 set b [$w.source.l get $i]
2868 lappend cmd $b
2869 lappend names $b
2870 incr revcnt
2873 if {$revcnt == 0} {
2874 return
2875 } elseif {$revcnt == 1} {
2876 set unit branch
2877 } elseif {$revcnt <= 15} {
2878 set unit branches
2879 } else {
2880 tk_messageBox \
2881 -icon error \
2882 -type ok \
2883 -title [wm title $w] \
2884 -parent $w \
2885 -message "Too many branches selected.
2887 You have requested to merge $revcnt branches
2888 in an octopus merge. This exceeds Git's
2889 internal limit of 15 branches per merge.
2891 Please select fewer branches. To merge more
2892 than 15 branches, merge the branches in batches.
2894 return
2897 set msg "Merging $current_branch, [join $names {, }]"
2898 set ui_status_value "$msg..."
2899 set cons [new_console "Merge" $msg]
2900 console_exec $cons $cmd [list finish_merge $revcnt]
2901 bind $w <Destroy> {}
2902 destroy $w
2905 proc finish_merge {revcnt w ok} {
2906 console_done $w $ok
2907 if {$ok} {
2908 set msg {Merge completed successfully.}
2909 } else {
2910 if {$revcnt != 1} {
2911 info_popup "Octopus merge failed.
2913 Your merge of $revcnt branches has failed.
2915 There are file-level conflicts between the
2916 branches which must be resolved manually.
2918 The working directory will now be reset.
2920 You can attempt this merge again
2921 by merging only one branch at a time." $w
2923 set fd [open "| git read-tree --reset -u HEAD" r]
2924 fconfigure $fd -blocking 0 -translation binary
2925 fileevent $fd readable [list reset_hard_wait $fd]
2926 set ui_status_value {Aborting... please wait...}
2927 return
2930 set msg {Merge failed. Conflict resolution is required.}
2932 unlock_index
2933 rescan [list set ui_status_value $msg]
2936 proc do_local_merge {} {
2937 global current_branch
2939 if {![can_merge]} return
2941 set w .merge_setup
2942 toplevel $w
2943 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2945 label $w.header \
2946 -text "Merge Into $current_branch" \
2947 -font font_uibold
2948 pack $w.header -side top -fill x
2950 frame $w.buttons
2951 button $w.buttons.visualize -text Visualize \
2952 -font font_ui \
2953 -command [list visualize_local_merge $w]
2954 pack $w.buttons.visualize -side left
2955 button $w.buttons.create -text Merge \
2956 -font font_ui \
2957 -command [list start_local_merge_action $w]
2958 pack $w.buttons.create -side right
2959 button $w.buttons.cancel -text {Cancel} \
2960 -font font_ui \
2961 -command [list destroy $w]
2962 pack $w.buttons.cancel -side right -padx 5
2963 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2965 labelframe $w.source \
2966 -text {Source Branches} \
2967 -font font_ui
2968 listbox $w.source.l \
2969 -height 10 \
2970 -width 70 \
2971 -selectmode extended \
2972 -yscrollcommand [list $w.source.sby set] \
2973 -font font_ui
2974 scrollbar $w.source.sby -command [list $w.source.l yview]
2975 pack $w.source.sby -side right -fill y
2976 pack $w.source.l -side left -fill both -expand 1
2977 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2979 set cmd [list git for-each-ref]
2980 lappend cmd {--format=%(objectname) %(*objectname) %(refname)}
2981 lappend cmd refs/heads
2982 lappend cmd refs/remotes
2983 lappend cmd refs/tags
2984 set fr_fd [open "| $cmd" r]
2985 fconfigure $fr_fd -translation binary
2986 while {[gets $fr_fd line] > 0} {
2987 set line [split $line { }]
2988 set sha1([lindex $line 0]) [lindex $line 2]
2989 set sha1([lindex $line 1]) [lindex $line 2]
2991 close $fr_fd
2993 set to_show {}
2994 set fr_fd [open "| git rev-list --all --not HEAD"]
2995 while {[gets $fr_fd line] > 0} {
2996 if {[catch {set ref $sha1($line)}]} continue
2997 regsub ^refs/(heads|remotes|tags)/ $ref {} ref
2998 lappend to_show $ref
3000 close $fr_fd
3002 foreach ref [lsort -unique $to_show] {
3003 $w.source.l insert end $ref
3006 bind $w <Visibility> "grab $w"
3007 bind $w <Key-Escape> "unlock_index;destroy $w"
3008 bind $w <Destroy> unlock_index
3009 wm title $w "[appname] ([reponame]): Merge"
3010 tkwait window $w
3013 proc do_reset_hard {} {
3014 global HEAD commit_type file_states
3016 if {[string match amend* $commit_type]} {
3017 info_popup {Cannot abort while amending.
3019 You must finish amending this commit.
3021 return
3024 if {![lock_index abort]} return
3026 if {[string match *merge* $commit_type]} {
3027 set op merge
3028 } else {
3029 set op commit
3032 if {[ask_popup "Abort $op?
3034 Aborting the current $op will cause
3035 *ALL* uncommitted changes to be lost.
3037 Continue with aborting the current $op?"] eq {yes}} {
3038 set fd [open "| git read-tree --reset -u HEAD" r]
3039 fconfigure $fd -blocking 0 -translation binary
3040 fileevent $fd readable [list reset_hard_wait $fd]
3041 set ui_status_value {Aborting... please wait...}
3042 } else {
3043 unlock_index
3047 proc reset_hard_wait {fd} {
3048 global ui_comm
3050 read $fd
3051 if {[eof $fd]} {
3052 close $fd
3053 unlock_index
3055 $ui_comm delete 0.0 end
3056 $ui_comm edit modified false
3058 catch {file delete [gitdir MERGE_HEAD]}
3059 catch {file delete [gitdir rr-cache MERGE_RR]}
3060 catch {file delete [gitdir SQUASH_MSG]}
3061 catch {file delete [gitdir MERGE_MSG]}
3062 catch {file delete [gitdir GITGUI_MSG]}
3064 rescan {set ui_status_value {Abort completed. Ready.}}
3068 ######################################################################
3070 ## browser
3072 set next_browser_id 0
3074 proc new_browser {commit} {
3075 global next_browser_id cursor_ptr M1B
3076 global browser_commit browser_status browser_stack browser_path browser_busy
3078 if {[winfo ismapped .]} {
3079 set w .browser[incr next_browser_id]
3080 set tl $w
3081 toplevel $w
3082 } else {
3083 set w {}
3084 set tl .
3086 set w_list $w.list.l
3087 set browser_commit($w_list) $commit
3088 set browser_status($w_list) {Starting...}
3089 set browser_stack($w_list) {}
3090 set browser_path($w_list) $browser_commit($w_list):
3091 set browser_busy($w_list) 1
3093 label $w.path -textvariable browser_path($w_list) \
3094 -anchor w \
3095 -justify left \
3096 -borderwidth 1 \
3097 -relief sunken \
3098 -font font_uibold
3099 pack $w.path -anchor w -side top -fill x
3101 frame $w.list
3102 text $w_list -background white -borderwidth 0 \
3103 -cursor $cursor_ptr \
3104 -state disabled \
3105 -wrap none \
3106 -height 20 \
3107 -width 70 \
3108 -xscrollcommand [list $w.list.sbx set] \
3109 -yscrollcommand [list $w.list.sby set] \
3110 -font font_ui
3111 $w_list tag conf in_sel \
3112 -background [$w_list cget -foreground] \
3113 -foreground [$w_list cget -background]
3114 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3115 scrollbar $w.list.sby -orient v -command [list $w_list yview]
3116 pack $w.list.sbx -side bottom -fill x
3117 pack $w.list.sby -side right -fill y
3118 pack $w_list -side left -fill both -expand 1
3119 pack $w.list -side top -fill both -expand 1
3121 label $w.status -textvariable browser_status($w_list) \
3122 -anchor w \
3123 -justify left \
3124 -borderwidth 1 \
3125 -relief sunken \
3126 -font font_ui
3127 pack $w.status -anchor w -side bottom -fill x
3129 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3130 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3131 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3132 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3133 bind $w_list <Up> "browser_move -1 $w_list;break"
3134 bind $w_list <Down> "browser_move 1 $w_list;break"
3135 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3136 bind $w_list <Return> "browser_enter $w_list;break"
3137 bind $w_list <Prior> "browser_page -1 $w_list;break"
3138 bind $w_list <Next> "browser_page 1 $w_list;break"
3139 bind $w_list <Left> break
3140 bind $w_list <Right> break
3142 bind $tl <Visibility> "focus $w"
3143 bind $tl <Destroy> "
3144 array unset browser_buffer $w_list
3145 array unset browser_files $w_list
3146 array unset browser_status $w_list
3147 array unset browser_stack $w_list
3148 array unset browser_path $w_list
3149 array unset browser_commit $w_list
3150 array unset browser_busy $w_list
3152 wm title $tl "[appname] ([reponame]): File Browser"
3153 ls_tree $w_list $browser_commit($w_list) {}
3156 proc browser_move {dir w} {
3157 global browser_files browser_busy
3159 if {$browser_busy($w)} return
3160 set lno [lindex [split [$w index in_sel.first] .] 0]
3161 incr lno $dir
3162 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3163 $w tag remove in_sel 0.0 end
3164 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3165 $w see $lno.0
3169 proc browser_page {dir w} {
3170 global browser_files browser_busy
3172 if {$browser_busy($w)} return
3173 $w yview scroll $dir pages
3174 set lno [expr {int(
3175 [lindex [$w yview] 0]
3176 * [llength $browser_files($w)]
3177 + 1)}]
3178 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3179 $w tag remove in_sel 0.0 end
3180 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3181 $w see $lno.0
3185 proc browser_parent {w} {
3186 global browser_files browser_status browser_path
3187 global browser_stack browser_busy
3189 if {$browser_busy($w)} return
3190 set info [lindex $browser_files($w) 0]
3191 if {[lindex $info 0] eq {parent}} {
3192 set parent [lindex $browser_stack($w) end-1]
3193 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3194 if {$browser_stack($w) eq {}} {
3195 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3196 } else {
3197 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3199 set browser_status($w) "Loading $browser_path($w)..."
3200 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3204 proc browser_enter {w} {
3205 global browser_files browser_status browser_path
3206 global browser_commit browser_stack browser_busy
3208 if {$browser_busy($w)} return
3209 set lno [lindex [split [$w index in_sel.first] .] 0]
3210 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3211 if {$info ne {}} {
3212 switch -- [lindex $info 0] {
3213 parent {
3214 browser_parent $w
3216 tree {
3217 set name [lindex $info 2]
3218 set escn [escape_path $name]
3219 set browser_status($w) "Loading $escn..."
3220 append browser_path($w) $escn
3221 ls_tree $w [lindex $info 1] $name
3223 blob {
3224 set name [lindex $info 2]
3225 set p {}
3226 foreach n $browser_stack($w) {
3227 append p [lindex $n 1]
3229 append p $name
3230 show_blame $browser_commit($w) $p
3236 proc browser_click {was_double_click w pos} {
3237 global browser_files browser_busy
3239 if {$browser_busy($w)} return
3240 set lno [lindex [split [$w index $pos] .] 0]
3241 focus $w
3243 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3244 $w tag remove in_sel 0.0 end
3245 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3246 if {$was_double_click} {
3247 browser_enter $w
3252 proc ls_tree {w tree_id name} {
3253 global browser_buffer browser_files browser_stack browser_busy
3255 set browser_buffer($w) {}
3256 set browser_files($w) {}
3257 set browser_busy($w) 1
3259 $w conf -state normal
3260 $w tag remove in_sel 0.0 end
3261 $w delete 0.0 end
3262 if {$browser_stack($w) ne {}} {
3263 $w image create end \
3264 -align center -padx 5 -pady 1 \
3265 -name icon0 \
3266 -image file_uplevel
3267 $w insert end {[Up To Parent]}
3268 lappend browser_files($w) parent
3270 lappend browser_stack($w) [list $tree_id $name]
3271 $w conf -state disabled
3273 set cmd [list git ls-tree -z $tree_id]
3274 set fd [open "| $cmd" r]
3275 fconfigure $fd -blocking 0 -translation binary -encoding binary
3276 fileevent $fd readable [list read_ls_tree $fd $w]
3279 proc read_ls_tree {fd w} {
3280 global browser_buffer browser_files browser_status browser_busy
3282 if {![winfo exists $w]} {
3283 catch {close $fd}
3284 return
3287 append browser_buffer($w) [read $fd]
3288 set pck [split $browser_buffer($w) "\0"]
3289 set browser_buffer($w) [lindex $pck end]
3291 set n [llength $browser_files($w)]
3292 $w conf -state normal
3293 foreach p [lrange $pck 0 end-1] {
3294 set info [split $p "\t"]
3295 set path [lindex $info 1]
3296 set info [split [lindex $info 0] { }]
3297 set type [lindex $info 1]
3298 set object [lindex $info 2]
3300 switch -- $type {
3301 blob {
3302 set image file_mod
3304 tree {
3305 set image file_dir
3306 append path /
3308 default {
3309 set image file_question
3313 if {$n > 0} {$w insert end "\n"}
3314 $w image create end \
3315 -align center -padx 5 -pady 1 \
3316 -name icon[incr n] \
3317 -image $image
3318 $w insert end [escape_path $path]
3319 lappend browser_files($w) [list $type $object $path]
3321 $w conf -state disabled
3323 if {[eof $fd]} {
3324 close $fd
3325 set browser_status($w) Ready.
3326 set browser_busy($w) 0
3327 array unset browser_buffer $w
3328 if {$n > 0} {
3329 $w tag add in_sel 1.0 2.0
3330 focus -force $w
3335 proc show_blame {commit path} {
3336 global next_browser_id blame_status blame_data
3338 if {[winfo ismapped .]} {
3339 set w .browser[incr next_browser_id]
3340 set tl $w
3341 toplevel $w
3342 } else {
3343 set w {}
3344 set tl .
3346 set blame_status($w) {Loading current file content...}
3348 label $w.path -text "$commit:$path" \
3349 -anchor w \
3350 -justify left \
3351 -borderwidth 1 \
3352 -relief sunken \
3353 -font font_uibold
3354 pack $w.path -side top -fill x
3356 frame $w.out
3357 text $w.out.loaded_t \
3358 -background white -borderwidth 0 \
3359 -state disabled \
3360 -wrap none \
3361 -height 40 \
3362 -width 1 \
3363 -font font_diff
3364 $w.out.loaded_t tag conf annotated -background grey
3366 text $w.out.linenumber_t \
3367 -background white -borderwidth 0 \
3368 -state disabled \
3369 -wrap none \
3370 -height 40 \
3371 -width 5 \
3372 -font font_diff
3373 $w.out.linenumber_t tag conf linenumber -justify right
3375 text $w.out.file_t \
3376 -background white -borderwidth 0 \
3377 -state disabled \
3378 -wrap none \
3379 -height 40 \
3380 -width 80 \
3381 -xscrollcommand [list $w.out.sbx set] \
3382 -font font_diff
3384 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3385 scrollbar $w.out.sby -orient v \
3386 -command [list scrollbar2many [list \
3387 $w.out.loaded_t \
3388 $w.out.linenumber_t \
3389 $w.out.file_t \
3390 ] yview]
3391 grid \
3392 $w.out.linenumber_t \
3393 $w.out.loaded_t \
3394 $w.out.file_t \
3395 $w.out.sby \
3396 -sticky nsew
3397 grid conf $w.out.sbx -column 2 -sticky we
3398 grid columnconfigure $w.out 2 -weight 1
3399 grid rowconfigure $w.out 0 -weight 1
3400 pack $w.out -fill both -expand 1
3402 label $w.status -textvariable blame_status($w) \
3403 -anchor w \
3404 -justify left \
3405 -borderwidth 1 \
3406 -relief sunken \
3407 -font font_ui
3408 pack $w.status -side bottom -fill x
3410 frame $w.cm
3411 text $w.cm.t \
3412 -background white -borderwidth 0 \
3413 -state disabled \
3414 -wrap none \
3415 -height 10 \
3416 -width 80 \
3417 -xscrollcommand [list $w.cm.sbx set] \
3418 -yscrollcommand [list $w.cm.sby set] \
3419 -font font_diff
3420 scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3421 scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3422 pack $w.cm.sby -side right -fill y
3423 pack $w.cm.sbx -side bottom -fill x
3424 pack $w.cm.t -expand 1 -fill both
3425 pack $w.cm -side bottom -fill x
3427 menu $w.ctxm -tearoff 0
3428 $w.ctxm add command -label "Copy Commit" \
3429 -font font_ui \
3430 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3432 foreach i [list \
3433 $w.out.loaded_t \
3434 $w.out.linenumber_t \
3435 $w.out.file_t] {
3436 $i tag conf in_sel \
3437 -background [$i cget -foreground] \
3438 -foreground [$i cget -background]
3439 $i conf -yscrollcommand \
3440 [list many2scrollbar [list \
3441 $w.out.loaded_t \
3442 $w.out.linenumber_t \
3443 $w.out.file_t \
3444 ] yview $w.out.sby]
3445 bind $i <Button-1> "
3446 blame_click {$w} \\
3447 $w.cm.t \\
3448 $w.out.linenumber_t \\
3449 $w.out.file_t \\
3450 $i @%x,%y
3451 focus $i
3453 bind_button3 $i "
3454 set cursorX %x
3455 set cursorY %y
3456 set cursorW %W
3457 tk_popup $w.ctxm %X %Y
3461 bind $w.cm.t <Button-1> "focus $w.cm.t"
3462 bind $tl <Visibility> "focus $tl"
3463 bind $tl <Destroy> "
3464 array unset blame_status {$w}
3465 array unset blame_data $w,*
3467 wm title $tl "[appname] ([reponame]): File Viewer"
3469 set blame_data($w,commit_count) 0
3470 set blame_data($w,commit_list) {}
3471 set blame_data($w,total_lines) 0
3472 set blame_data($w,blame_lines) 0
3473 set blame_data($w,highlight_commit) {}
3474 set blame_data($w,highlight_line) -1
3476 set cmd [list git cat-file blob "$commit:$path"]
3477 set fd [open "| $cmd" r]
3478 fconfigure $fd -blocking 0 -translation lf -encoding binary
3479 fileevent $fd readable [list read_blame_catfile \
3480 $fd $w $commit $path \
3481 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3484 proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3485 global blame_status blame_data
3487 if {![winfo exists $w_file]} {
3488 catch {close $fd}
3489 return
3492 set n $blame_data($w,total_lines)
3493 $w_load conf -state normal
3494 $w_line conf -state normal
3495 $w_file conf -state normal
3496 while {[gets $fd line] >= 0} {
3497 regsub "\r\$" $line {} line
3498 incr n
3499 $w_load insert end "\n"
3500 $w_line insert end "$n\n" linenumber
3501 $w_file insert end "$line\n"
3503 $w_load conf -state disabled
3504 $w_line conf -state disabled
3505 $w_file conf -state disabled
3506 set blame_data($w,total_lines) $n
3508 if {[eof $fd]} {
3509 close $fd
3510 blame_incremental_status $w
3511 set cmd [list git blame -M -C --incremental]
3512 lappend cmd $commit -- $path
3513 set fd [open "| $cmd" r]
3514 fconfigure $fd -blocking 0 -translation lf -encoding binary
3515 fileevent $fd readable [list read_blame_incremental $fd $w \
3516 $w_load $w_cmit $w_line $w_file]
3520 proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3521 global blame_status blame_data
3523 if {![winfo exists $w_file]} {
3524 catch {close $fd}
3525 return
3528 while {[gets $fd line] >= 0} {
3529 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3530 cmit original_line final_line line_count]} {
3531 set blame_data($w,commit) $cmit
3532 set blame_data($w,original_line) $original_line
3533 set blame_data($w,final_line) $final_line
3534 set blame_data($w,line_count) $line_count
3536 if {[catch {set g $blame_data($w,$cmit,order)}]} {
3537 $w_line tag conf g$cmit
3538 $w_file tag conf g$cmit
3539 $w_line tag raise in_sel
3540 $w_file tag raise in_sel
3541 $w_file tag raise sel
3542 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3543 incr blame_data($w,commit_count)
3544 lappend blame_data($w,commit_list) $cmit
3546 } elseif {[string match {filename *} $line]} {
3547 set file [string range $line 9 end]
3548 set n $blame_data($w,line_count)
3549 set lno $blame_data($w,final_line)
3550 set cmit $blame_data($w,commit)
3552 while {$n > 0} {
3553 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3554 $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3555 } else {
3556 $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3557 $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3560 set blame_data($w,line$lno,commit) $cmit
3561 set blame_data($w,line$lno,file) $file
3562 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3563 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3565 if {$blame_data($w,highlight_line) == -1} {
3566 if {[lindex [$w_file yview] 0] == 0} {
3567 $w_file see $lno.0
3568 blame_showcommit $w $w_cmit $w_line $w_file $lno
3570 } elseif {$blame_data($w,highlight_line) == $lno} {
3571 blame_showcommit $w $w_cmit $w_line $w_file $lno
3574 incr n -1
3575 incr lno
3576 incr blame_data($w,blame_lines)
3579 set hc $blame_data($w,highlight_commit)
3580 if {$hc ne {}
3581 && [expr {$blame_data($w,$hc,order) + 1}]
3582 == $blame_data($w,$cmit,order)} {
3583 blame_showcommit $w $w_cmit $w_line $w_file \
3584 $blame_data($w,highlight_line)
3586 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3587 set blame_data($w,$blame_data($w,commit),$header) $data
3591 if {[eof $fd]} {
3592 close $fd
3593 set blame_status($w) {Annotation complete.}
3594 } else {
3595 blame_incremental_status $w
3599 proc blame_incremental_status {w} {
3600 global blame_status blame_data
3602 set blame_status($w) [format \
3603 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3604 $blame_data($w,blame_lines) \
3605 $blame_data($w,total_lines) \
3606 [expr {100 * $blame_data($w,blame_lines)
3607 / $blame_data($w,total_lines)}]]
3610 proc blame_click {w w_cmit w_line w_file cur_w pos} {
3611 set lno [lindex [split [$cur_w index $pos] .] 0]
3612 if {$lno eq {}} return
3614 $w_line tag remove in_sel 0.0 end
3615 $w_file tag remove in_sel 0.0 end
3616 $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3617 $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3619 blame_showcommit $w $w_cmit $w_line $w_file $lno
3622 set blame_colors {
3623 #ff4040
3624 #ff40ff
3625 #4040ff
3628 proc blame_showcommit {w w_cmit w_line w_file lno} {
3629 global blame_colors blame_data repo_config
3631 set cmit $blame_data($w,highlight_commit)
3632 if {$cmit ne {}} {
3633 set idx $blame_data($w,$cmit,order)
3634 set i 0
3635 foreach c $blame_colors {
3636 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3637 $w_line tag conf g$h -background white
3638 $w_file tag conf g$h -background white
3639 incr i
3643 $w_cmit conf -state normal
3644 $w_cmit delete 0.0 end
3645 if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3646 set cmit {}
3647 $w_cmit insert end "Loading annotation..."
3648 } else {
3649 set idx $blame_data($w,$cmit,order)
3650 set i 0
3651 foreach c $blame_colors {
3652 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3653 $w_line tag conf g$h -background $c
3654 $w_file tag conf g$h -background $c
3655 incr i
3658 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3659 set msg {}
3660 catch {
3661 set fd [open "| git cat-file commit $cmit" r]
3662 fconfigure $fd -encoding binary -translation lf
3663 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3664 set enc utf-8
3666 while {[gets $fd line] > 0} {
3667 if {[string match {encoding *} $line]} {
3668 set enc [string tolower [string range $line 9 end]]
3671 fconfigure $fd -encoding $enc
3672 set msg [string trim [read $fd]]
3673 close $fd
3675 set blame_data($w,$cmit,message) $msg
3678 set author_name {}
3679 set author_email {}
3680 set author_time {}
3681 catch {set author_name $blame_data($w,$cmit,author)}
3682 catch {set author_email $blame_data($w,$cmit,author-mail)}
3683 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3685 set committer_name {}
3686 set committer_email {}
3687 set committer_time {}
3688 catch {set committer_name $blame_data($w,$cmit,committer)}
3689 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3690 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3692 $w_cmit insert end "commit $cmit\n"
3693 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3694 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3695 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3696 $w_cmit insert end "\n"
3697 $w_cmit insert end $msg
3699 $w_cmit conf -state disabled
3701 set blame_data($w,highlight_line) $lno
3702 set blame_data($w,highlight_commit) $cmit
3705 proc blame_copycommit {w i pos} {
3706 global blame_data
3707 set lno [lindex [split [$i index $pos] .] 0]
3708 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3709 clipboard clear
3710 clipboard append \
3711 -format STRING \
3712 -type STRING \
3713 -- $commit
3717 ######################################################################
3719 ## icons
3721 set filemask {
3722 #define mask_width 14
3723 #define mask_height 15
3724 static unsigned char mask_bits[] = {
3725 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3726 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3727 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3730 image create bitmap file_plain -background white -foreground black -data {
3731 #define plain_width 14
3732 #define plain_height 15
3733 static unsigned char plain_bits[] = {
3734 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3735 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3736 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3737 } -maskdata $filemask
3739 image create bitmap file_mod -background white -foreground blue -data {
3740 #define mod_width 14
3741 #define mod_height 15
3742 static unsigned char mod_bits[] = {
3743 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3744 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3745 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3746 } -maskdata $filemask
3748 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3749 #define file_fulltick_width 14
3750 #define file_fulltick_height 15
3751 static unsigned char file_fulltick_bits[] = {
3752 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3753 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3754 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3755 } -maskdata $filemask
3757 image create bitmap file_parttick -background white -foreground "#005050" -data {
3758 #define parttick_width 14
3759 #define parttick_height 15
3760 static unsigned char parttick_bits[] = {
3761 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3762 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3763 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3764 } -maskdata $filemask
3766 image create bitmap file_question -background white -foreground black -data {
3767 #define file_question_width 14
3768 #define file_question_height 15
3769 static unsigned char file_question_bits[] = {
3770 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3771 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3772 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3773 } -maskdata $filemask
3775 image create bitmap file_removed -background white -foreground red -data {
3776 #define file_removed_width 14
3777 #define file_removed_height 15
3778 static unsigned char file_removed_bits[] = {
3779 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3780 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3781 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3782 } -maskdata $filemask
3784 image create bitmap file_merge -background white -foreground blue -data {
3785 #define file_merge_width 14
3786 #define file_merge_height 15
3787 static unsigned char file_merge_bits[] = {
3788 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3789 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3790 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3791 } -maskdata $filemask
3793 set file_dir_data {
3794 #define file_width 18
3795 #define file_height 18
3796 static unsigned char file_bits[] = {
3797 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3798 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3799 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3800 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3801 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3803 image create bitmap file_dir -background white -foreground blue \
3804 -data $file_dir_data -maskdata $file_dir_data
3805 unset file_dir_data
3807 set file_uplevel_data {
3808 #define up_width 15
3809 #define up_height 15
3810 static unsigned char up_bits[] = {
3811 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3812 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3813 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3815 image create bitmap file_uplevel -background white -foreground red \
3816 -data $file_uplevel_data -maskdata $file_uplevel_data
3817 unset file_uplevel_data
3819 set ui_index .vpane.files.index.list
3820 set ui_workdir .vpane.files.workdir.list
3822 set all_icons(_$ui_index) file_plain
3823 set all_icons(A$ui_index) file_fulltick
3824 set all_icons(M$ui_index) file_fulltick
3825 set all_icons(D$ui_index) file_removed
3826 set all_icons(U$ui_index) file_merge
3828 set all_icons(_$ui_workdir) file_plain
3829 set all_icons(M$ui_workdir) file_mod
3830 set all_icons(D$ui_workdir) file_question
3831 set all_icons(U$ui_workdir) file_merge
3832 set all_icons(O$ui_workdir) file_plain
3834 set max_status_desc 0
3835 foreach i {
3836 {__ "Unmodified"}
3838 {_M "Modified, not staged"}
3839 {M_ "Staged for commit"}
3840 {MM "Portions staged for commit"}
3841 {MD "Staged for commit, missing"}
3843 {_O "Untracked, not staged"}
3844 {A_ "Staged for commit"}
3845 {AM "Portions staged for commit"}
3846 {AD "Staged for commit, missing"}
3848 {_D "Missing"}
3849 {D_ "Staged for removal"}
3850 {DO "Staged for removal, still present"}
3852 {U_ "Requires merge resolution"}
3853 {UU "Requires merge resolution"}
3854 {UM "Requires merge resolution"}
3855 {UD "Requires merge resolution"}
3857 if {$max_status_desc < [string length [lindex $i 1]]} {
3858 set max_status_desc [string length [lindex $i 1]]
3860 set all_descs([lindex $i 0]) [lindex $i 1]
3862 unset i
3864 ######################################################################
3866 ## util
3868 proc bind_button3 {w cmd} {
3869 bind $w <Any-Button-3> $cmd
3870 if {[is_MacOSX]} {
3871 bind $w <Control-Button-1> $cmd
3875 proc scrollbar2many {list mode args} {
3876 foreach w $list {eval $w $mode $args}
3879 proc many2scrollbar {list mode sb top bottom} {
3880 $sb set $top $bottom
3881 foreach w $list {$w $mode moveto $top}
3884 proc incr_font_size {font {amt 1}} {
3885 set sz [font configure $font -size]
3886 incr sz $amt
3887 font configure $font -size $sz
3888 font configure ${font}bold -size $sz
3891 proc hook_failed_popup {hook msg} {
3892 set w .hookfail
3893 toplevel $w
3895 frame $w.m
3896 label $w.m.l1 -text "$hook hook failed:" \
3897 -anchor w \
3898 -justify left \
3899 -font font_uibold
3900 text $w.m.t \
3901 -background white -borderwidth 1 \
3902 -relief sunken \
3903 -width 80 -height 10 \
3904 -font font_diff \
3905 -yscrollcommand [list $w.m.sby set]
3906 label $w.m.l2 \
3907 -text {You must correct the above errors before committing.} \
3908 -anchor w \
3909 -justify left \
3910 -font font_uibold
3911 scrollbar $w.m.sby -command [list $w.m.t yview]
3912 pack $w.m.l1 -side top -fill x
3913 pack $w.m.l2 -side bottom -fill x
3914 pack $w.m.sby -side right -fill y
3915 pack $w.m.t -side left -fill both -expand 1
3916 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3918 $w.m.t insert 1.0 $msg
3919 $w.m.t conf -state disabled
3921 button $w.ok -text OK \
3922 -width 15 \
3923 -font font_ui \
3924 -command "destroy $w"
3925 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3927 bind $w <Visibility> "grab $w; focus $w"
3928 bind $w <Key-Return> "destroy $w"
3929 wm title $w "[appname] ([reponame]): error"
3930 tkwait window $w
3933 set next_console_id 0
3935 proc new_console {short_title long_title} {
3936 global next_console_id console_data
3937 set w .console[incr next_console_id]
3938 set console_data($w) [list $short_title $long_title]
3939 return [console_init $w]
3942 proc console_init {w} {
3943 global console_cr console_data M1B
3945 set console_cr($w) 1.0
3946 toplevel $w
3947 frame $w.m
3948 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3949 -anchor w \
3950 -justify left \
3951 -font font_uibold
3952 text $w.m.t \
3953 -background white -borderwidth 1 \
3954 -relief sunken \
3955 -width 80 -height 10 \
3956 -font font_diff \
3957 -state disabled \
3958 -yscrollcommand [list $w.m.sby set]
3959 label $w.m.s -text {Working... please wait...} \
3960 -anchor w \
3961 -justify left \
3962 -font font_uibold
3963 scrollbar $w.m.sby -command [list $w.m.t yview]
3964 pack $w.m.l1 -side top -fill x
3965 pack $w.m.s -side bottom -fill x
3966 pack $w.m.sby -side right -fill y
3967 pack $w.m.t -side left -fill both -expand 1
3968 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3970 menu $w.ctxm -tearoff 0
3971 $w.ctxm add command -label "Copy" \
3972 -font font_ui \
3973 -command "tk_textCopy $w.m.t"
3974 $w.ctxm add command -label "Select All" \
3975 -font font_ui \
3976 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3977 $w.ctxm add command -label "Copy All" \
3978 -font font_ui \
3979 -command "
3980 $w.m.t tag add sel 0.0 end
3981 tk_textCopy $w.m.t
3982 $w.m.t tag remove sel 0.0 end
3985 button $w.ok -text {Close} \
3986 -font font_ui \
3987 -state disabled \
3988 -command "destroy $w"
3989 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3991 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3992 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3993 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3994 bind $w <Visibility> "focus $w"
3995 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3996 return $w
3999 proc console_exec {w cmd after} {
4000 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
4001 # But most users need that so we have to relogin. :-(
4003 if {[is_Cygwin]} {
4004 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
4007 # -- Tcl won't let us redirect both stdout and stderr to
4008 # the same pipe. So pass it through cat...
4010 set cmd [concat | $cmd |& cat]
4012 set fd_f [open $cmd r]
4013 fconfigure $fd_f -blocking 0 -translation binary
4014 fileevent $fd_f readable [list console_read $w $fd_f $after]
4017 proc console_read {w fd after} {
4018 global console_cr
4020 set buf [read $fd]
4021 if {$buf ne {}} {
4022 if {![winfo exists $w]} {console_init $w}
4023 $w.m.t conf -state normal
4024 set c 0
4025 set n [string length $buf]
4026 while {$c < $n} {
4027 set cr [string first "\r" $buf $c]
4028 set lf [string first "\n" $buf $c]
4029 if {$cr < 0} {set cr [expr {$n + 1}]}
4030 if {$lf < 0} {set lf [expr {$n + 1}]}
4032 if {$lf < $cr} {
4033 $w.m.t insert end [string range $buf $c $lf]
4034 set console_cr($w) [$w.m.t index {end -1c}]
4035 set c $lf
4036 incr c
4037 } else {
4038 $w.m.t delete $console_cr($w) end
4039 $w.m.t insert end "\n"
4040 $w.m.t insert end [string range $buf $c $cr]
4041 set c $cr
4042 incr c
4045 $w.m.t conf -state disabled
4046 $w.m.t see end
4049 fconfigure $fd -blocking 1
4050 if {[eof $fd]} {
4051 if {[catch {close $fd}]} {
4052 set ok 0
4053 } else {
4054 set ok 1
4056 uplevel #0 $after $w $ok
4057 return
4059 fconfigure $fd -blocking 0
4062 proc console_chain {cmdlist w {ok 1}} {
4063 if {$ok} {
4064 if {[llength $cmdlist] == 0} {
4065 console_done $w $ok
4066 return
4069 set cmd [lindex $cmdlist 0]
4070 set cmdlist [lrange $cmdlist 1 end]
4072 if {[lindex $cmd 0] eq {console_exec}} {
4073 console_exec $w \
4074 [lindex $cmd 1] \
4075 [list console_chain $cmdlist]
4076 } else {
4077 uplevel #0 $cmd $cmdlist $w $ok
4079 } else {
4080 console_done $w $ok
4084 proc console_done {args} {
4085 global console_cr console_data
4087 switch -- [llength $args] {
4089 set w [lindex $args 0]
4090 set ok [lindex $args 1]
4093 set w [lindex $args 1]
4094 set ok [lindex $args 2]
4096 default {
4097 error "wrong number of args: console_done ?ignored? w ok"
4101 if {$ok} {
4102 if {[winfo exists $w]} {
4103 $w.m.s conf -background green -text {Success}
4104 $w.ok conf -state normal
4106 } else {
4107 if {![winfo exists $w]} {
4108 console_init $w
4110 $w.m.s conf -background red -text {Error: Command Failed}
4111 $w.ok conf -state normal
4114 array unset console_cr $w
4115 array unset console_data $w
4118 ######################################################################
4120 ## ui commands
4122 set starting_gitk_msg {Starting gitk... please wait...}
4124 proc do_gitk {revs} {
4125 global env ui_status_value starting_gitk_msg
4127 # -- Always start gitk through whatever we were loaded with. This
4128 # lets us bypass using shell process on Windows systems.
4130 set cmd [info nameofexecutable]
4131 lappend cmd [gitexec gitk]
4132 if {$revs ne {}} {
4133 append cmd { }
4134 append cmd $revs
4137 if {[catch {eval exec $cmd &} err]} {
4138 error_popup "Failed to start gitk:\n\n$err"
4139 } else {
4140 set ui_status_value $starting_gitk_msg
4141 after 10000 {
4142 if {$ui_status_value eq $starting_gitk_msg} {
4143 set ui_status_value {Ready.}
4149 proc do_stats {} {
4150 set fd [open "| git count-objects -v" r]
4151 while {[gets $fd line] > 0} {
4152 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4153 set stats($name) $value
4156 close $fd
4158 set packed_sz 0
4159 foreach p [glob -directory [gitdir objects pack] \
4160 -type f \
4161 -nocomplain -- *] {
4162 incr packed_sz [file size $p]
4164 if {$packed_sz > 0} {
4165 set stats(size-pack) [expr {$packed_sz / 1024}]
4168 set w .stats_view
4169 toplevel $w
4170 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4172 label $w.header -text {Database Statistics} \
4173 -font font_uibold
4174 pack $w.header -side top -fill x
4176 frame $w.buttons -border 1
4177 button $w.buttons.close -text Close \
4178 -font font_ui \
4179 -command [list destroy $w]
4180 button $w.buttons.gc -text {Compress Database} \
4181 -font font_ui \
4182 -command "destroy $w;do_gc"
4183 pack $w.buttons.close -side right
4184 pack $w.buttons.gc -side left
4185 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4187 frame $w.stat -borderwidth 1 -relief solid
4188 foreach s {
4189 {count {Number of loose objects}}
4190 {size {Disk space used by loose objects} { KiB}}
4191 {in-pack {Number of packed objects}}
4192 {packs {Number of packs}}
4193 {size-pack {Disk space used by packed objects} { KiB}}
4194 {prune-packable {Packed objects waiting for pruning}}
4195 {garbage {Garbage files}}
4197 set name [lindex $s 0]
4198 set label [lindex $s 1]
4199 if {[catch {set value $stats($name)}]} continue
4200 if {[llength $s] > 2} {
4201 set value "$value[lindex $s 2]"
4204 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4205 label $w.stat.v_$name -text $value -anchor w -font font_ui
4206 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4208 pack $w.stat -pady 10 -padx 10
4210 bind $w <Visibility> "grab $w; focus $w"
4211 bind $w <Key-Escape> [list destroy $w]
4212 bind $w <Key-Return> [list destroy $w]
4213 wm title $w "[appname] ([reponame]): Database Statistics"
4214 tkwait window $w
4217 proc do_gc {} {
4218 set w [new_console {gc} {Compressing the object database}]
4219 console_chain {
4220 {console_exec {git pack-refs --prune}}
4221 {console_exec {git reflog expire --all}}
4222 {console_exec {git repack -a -d -l}}
4223 {console_exec {git rerere gc}}
4224 } $w
4227 proc do_fsck_objects {} {
4228 set w [new_console {fsck-objects} \
4229 {Verifying the object database with fsck-objects}]
4230 set cmd [list git fsck-objects]
4231 lappend cmd --full
4232 lappend cmd --cache
4233 lappend cmd --strict
4234 console_exec $w $cmd console_done
4237 set is_quitting 0
4239 proc do_quit {} {
4240 global ui_comm is_quitting repo_config commit_type
4242 if {$is_quitting} return
4243 set is_quitting 1
4245 if {[winfo exists $ui_comm]} {
4246 # -- Stash our current commit buffer.
4248 set save [gitdir GITGUI_MSG]
4249 set msg [string trim [$ui_comm get 0.0 end]]
4250 regsub -all -line {[ \r\t]+$} $msg {} msg
4251 if {(![string match amend* $commit_type]
4252 || [$ui_comm edit modified])
4253 && $msg ne {}} {
4254 catch {
4255 set fd [open $save w]
4256 puts -nonewline $fd $msg
4257 close $fd
4259 } else {
4260 catch {file delete $save}
4263 # -- Stash our current window geometry into this repository.
4265 set cfg_geometry [list]
4266 lappend cfg_geometry [wm geometry .]
4267 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4268 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4269 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4270 set rc_geometry {}
4272 if {$cfg_geometry ne $rc_geometry} {
4273 catch {git config gui.geometry $cfg_geometry}
4277 destroy .
4280 proc do_rescan {} {
4281 rescan {set ui_status_value {Ready.}}
4284 proc unstage_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 A? -
4294 M? -
4295 D? {
4296 lappend pathList $path
4297 if {$path eq $current_diff_path} {
4298 set after {reshow_diff;}
4303 if {$pathList eq {}} {
4304 unlock_index
4305 } else {
4306 update_indexinfo \
4307 $txt \
4308 $pathList \
4309 [concat $after {set ui_status_value {Ready.}}]
4313 proc do_unstage_selection {} {
4314 global current_diff_path selected_paths
4316 if {[array size selected_paths] > 0} {
4317 unstage_helper \
4318 {Unstaging selected files from commit} \
4319 [array names selected_paths]
4320 } elseif {$current_diff_path ne {}} {
4321 unstage_helper \
4322 "Unstaging [short_path $current_diff_path] from commit" \
4323 [list $current_diff_path]
4327 proc add_helper {txt paths} {
4328 global file_states current_diff_path
4330 if {![lock_index begin-update]} return
4332 set pathList [list]
4333 set after {}
4334 foreach path $paths {
4335 switch -glob -- [lindex $file_states($path) 0] {
4336 _O -
4337 ?M -
4338 ?D -
4339 U? {
4340 lappend pathList $path
4341 if {$path eq $current_diff_path} {
4342 set after {reshow_diff;}
4347 if {$pathList eq {}} {
4348 unlock_index
4349 } else {
4350 update_index \
4351 $txt \
4352 $pathList \
4353 [concat $after {set ui_status_value {Ready to commit.}}]
4357 proc do_add_selection {} {
4358 global current_diff_path selected_paths
4360 if {[array size selected_paths] > 0} {
4361 add_helper \
4362 {Adding selected files} \
4363 [array names selected_paths]
4364 } elseif {$current_diff_path ne {}} {
4365 add_helper \
4366 "Adding [short_path $current_diff_path]" \
4367 [list $current_diff_path]
4371 proc do_add_all {} {
4372 global file_states
4374 set paths [list]
4375 foreach path [array names file_states] {
4376 switch -glob -- [lindex $file_states($path) 0] {
4377 U? {continue}
4378 ?M -
4379 ?D {lappend paths $path}
4382 add_helper {Adding all changed files} $paths
4385 proc revert_helper {txt paths} {
4386 global file_states current_diff_path
4388 if {![lock_index begin-update]} return
4390 set pathList [list]
4391 set after {}
4392 foreach path $paths {
4393 switch -glob -- [lindex $file_states($path) 0] {
4394 U? {continue}
4395 ?M -
4396 ?D {
4397 lappend pathList $path
4398 if {$path eq $current_diff_path} {
4399 set after {reshow_diff;}
4405 set n [llength $pathList]
4406 if {$n == 0} {
4407 unlock_index
4408 return
4409 } elseif {$n == 1} {
4410 set s "[short_path [lindex $pathList]]"
4411 } else {
4412 set s "these $n files"
4415 set reply [tk_dialog \
4416 .confirm_revert \
4417 "[appname] ([reponame])" \
4418 "Revert changes in $s?
4420 Any unadded changes will be permanently lost by the revert." \
4421 question \
4423 {Do Nothing} \
4424 {Revert Changes} \
4426 if {$reply == 1} {
4427 checkout_index \
4428 $txt \
4429 $pathList \
4430 [concat $after {set ui_status_value {Ready.}}]
4431 } else {
4432 unlock_index
4436 proc do_revert_selection {} {
4437 global current_diff_path selected_paths
4439 if {[array size selected_paths] > 0} {
4440 revert_helper \
4441 {Reverting selected files} \
4442 [array names selected_paths]
4443 } elseif {$current_diff_path ne {}} {
4444 revert_helper \
4445 "Reverting [short_path $current_diff_path]" \
4446 [list $current_diff_path]
4450 proc do_signoff {} {
4451 global ui_comm
4453 set me [committer_ident]
4454 if {$me eq {}} return
4456 set sob "Signed-off-by: $me"
4457 set last [$ui_comm get {end -1c linestart} {end -1c}]
4458 if {$last ne $sob} {
4459 $ui_comm edit separator
4460 if {$last ne {}
4461 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4462 $ui_comm insert end "\n"
4464 $ui_comm insert end "\n$sob"
4465 $ui_comm edit separator
4466 $ui_comm see end
4470 proc do_select_commit_type {} {
4471 global commit_type selected_commit_type
4473 if {$selected_commit_type eq {new}
4474 && [string match amend* $commit_type]} {
4475 create_new_commit
4476 } elseif {$selected_commit_type eq {amend}
4477 && ![string match amend* $commit_type]} {
4478 load_last_commit
4480 # The amend request was rejected...
4482 if {![string match amend* $commit_type]} {
4483 set selected_commit_type new
4488 proc do_commit {} {
4489 commit_tree
4492 proc do_about {} {
4493 global appvers copyright
4494 global tcl_patchLevel tk_patchLevel
4496 set w .about_dialog
4497 toplevel $w
4498 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4500 label $w.header -text "About [appname]" \
4501 -font font_uibold
4502 pack $w.header -side top -fill x
4504 frame $w.buttons
4505 button $w.buttons.close -text {Close} \
4506 -font font_ui \
4507 -command [list destroy $w]
4508 pack $w.buttons.close -side right
4509 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4511 label $w.desc \
4512 -text "git-gui - a graphical user interface for Git.
4513 $copyright" \
4514 -padx 5 -pady 5 \
4515 -justify left \
4516 -anchor w \
4517 -borderwidth 1 \
4518 -relief solid \
4519 -font font_ui
4520 pack $w.desc -side top -fill x -padx 5 -pady 5
4522 set v {}
4523 append v "git-gui version $appvers\n"
4524 append v "[git version]\n"
4525 append v "\n"
4526 if {$tcl_patchLevel eq $tk_patchLevel} {
4527 append v "Tcl/Tk version $tcl_patchLevel"
4528 } else {
4529 append v "Tcl version $tcl_patchLevel"
4530 append v ", Tk version $tk_patchLevel"
4533 label $w.vers \
4534 -text $v \
4535 -padx 5 -pady 5 \
4536 -justify left \
4537 -anchor w \
4538 -borderwidth 1 \
4539 -relief solid \
4540 -font font_ui
4541 pack $w.vers -side top -fill x -padx 5 -pady 5
4543 menu $w.ctxm -tearoff 0
4544 $w.ctxm add command \
4545 -label {Copy} \
4546 -font font_ui \
4547 -command "
4548 clipboard clear
4549 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4552 bind $w <Visibility> "grab $w; focus $w"
4553 bind $w <Key-Escape> "destroy $w"
4554 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4555 wm title $w "About [appname]"
4556 tkwait window $w
4559 proc do_options {} {
4560 global repo_config global_config font_descs
4561 global repo_config_new global_config_new
4563 array unset repo_config_new
4564 array unset global_config_new
4565 foreach name [array names repo_config] {
4566 set repo_config_new($name) $repo_config($name)
4568 load_config 1
4569 foreach name [array names repo_config] {
4570 switch -- $name {
4571 gui.diffcontext {continue}
4573 set repo_config_new($name) $repo_config($name)
4575 foreach name [array names global_config] {
4576 set global_config_new($name) $global_config($name)
4579 set w .options_editor
4580 toplevel $w
4581 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4583 label $w.header -text "Options" \
4584 -font font_uibold
4585 pack $w.header -side top -fill x
4587 frame $w.buttons
4588 button $w.buttons.restore -text {Restore Defaults} \
4589 -font font_ui \
4590 -command do_restore_defaults
4591 pack $w.buttons.restore -side left
4592 button $w.buttons.save -text Save \
4593 -font font_ui \
4594 -command [list do_save_config $w]
4595 pack $w.buttons.save -side right
4596 button $w.buttons.cancel -text {Cancel} \
4597 -font font_ui \
4598 -command [list destroy $w]
4599 pack $w.buttons.cancel -side right -padx 5
4600 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4602 labelframe $w.repo -text "[reponame] Repository" \
4603 -font font_ui
4604 labelframe $w.global -text {Global (All Repositories)} \
4605 -font font_ui
4606 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4607 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4609 set optid 0
4610 foreach option {
4611 {t user.name {User Name}}
4612 {t user.email {Email Address}}
4614 {b merge.summary {Summarize Merge Commits}}
4615 {i-1..5 merge.verbosity {Merge Verbosity}}
4617 {b gui.trustmtime {Trust File Modification Timestamps}}
4618 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4619 {t gui.newbranchtemplate {New Branch Name Template}}
4621 set type [lindex $option 0]
4622 set name [lindex $option 1]
4623 set text [lindex $option 2]
4624 incr optid
4625 foreach f {repo global} {
4626 switch -glob -- $type {
4628 checkbutton $w.$f.$optid -text $text \
4629 -variable ${f}_config_new($name) \
4630 -onvalue true \
4631 -offvalue false \
4632 -font font_ui
4633 pack $w.$f.$optid -side top -anchor w
4635 i-* {
4636 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4637 frame $w.$f.$optid
4638 label $w.$f.$optid.l -text "$text:" -font font_ui
4639 pack $w.$f.$optid.l -side left -anchor w -fill x
4640 spinbox $w.$f.$optid.v \
4641 -textvariable ${f}_config_new($name) \
4642 -from $min \
4643 -to $max \
4644 -increment 1 \
4645 -width [expr {1 + [string length $max]}] \
4646 -font font_ui
4647 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4648 pack $w.$f.$optid.v -side right -anchor e -padx 5
4649 pack $w.$f.$optid -side top -anchor w -fill x
4652 frame $w.$f.$optid
4653 label $w.$f.$optid.l -text "$text:" -font font_ui
4654 entry $w.$f.$optid.v \
4655 -borderwidth 1 \
4656 -relief sunken \
4657 -width 20 \
4658 -textvariable ${f}_config_new($name) \
4659 -font font_ui
4660 pack $w.$f.$optid.l -side left -anchor w
4661 pack $w.$f.$optid.v -side left -anchor w \
4662 -fill x -expand 1 \
4663 -padx 5
4664 pack $w.$f.$optid -side top -anchor w -fill x
4670 set all_fonts [lsort [font families]]
4671 foreach option $font_descs {
4672 set name [lindex $option 0]
4673 set font [lindex $option 1]
4674 set text [lindex $option 2]
4676 set global_config_new(gui.$font^^family) \
4677 [font configure $font -family]
4678 set global_config_new(gui.$font^^size) \
4679 [font configure $font -size]
4681 frame $w.global.$name
4682 label $w.global.$name.l -text "$text:" -font font_ui
4683 pack $w.global.$name.l -side left -anchor w -fill x
4684 eval tk_optionMenu $w.global.$name.family \
4685 global_config_new(gui.$font^^family) \
4686 $all_fonts
4687 spinbox $w.global.$name.size \
4688 -textvariable global_config_new(gui.$font^^size) \
4689 -from 2 -to 80 -increment 1 \
4690 -width 3 \
4691 -font font_ui
4692 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4693 pack $w.global.$name.size -side right -anchor e
4694 pack $w.global.$name.family -side right -anchor e
4695 pack $w.global.$name -side top -anchor w -fill x
4698 bind $w <Visibility> "grab $w; focus $w"
4699 bind $w <Key-Escape> "destroy $w"
4700 wm title $w "[appname] ([reponame]): Options"
4701 tkwait window $w
4704 proc do_restore_defaults {} {
4705 global font_descs default_config repo_config
4706 global repo_config_new global_config_new
4708 foreach name [array names default_config] {
4709 set repo_config_new($name) $default_config($name)
4710 set global_config_new($name) $default_config($name)
4713 foreach option $font_descs {
4714 set name [lindex $option 0]
4715 set repo_config(gui.$name) $default_config(gui.$name)
4717 apply_config
4719 foreach option $font_descs {
4720 set name [lindex $option 0]
4721 set font [lindex $option 1]
4722 set global_config_new(gui.$font^^family) \
4723 [font configure $font -family]
4724 set global_config_new(gui.$font^^size) \
4725 [font configure $font -size]
4729 proc do_save_config {w} {
4730 if {[catch {save_config} err]} {
4731 error_popup "Failed to completely save options:\n\n$err"
4733 reshow_diff
4734 destroy $w
4737 proc do_windows_shortcut {} {
4738 global argv0
4740 set fn [tk_getSaveFile \
4741 -parent . \
4742 -title "[appname] ([reponame]): Create Desktop Icon" \
4743 -initialfile "Git [reponame].bat"]
4744 if {$fn != {}} {
4745 if {[catch {
4746 set fd [open $fn w]
4747 puts $fd "@ECHO Entering [reponame]"
4748 puts $fd "@ECHO Starting git-gui... please wait..."
4749 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4750 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4751 puts -nonewline $fd "@\"[info nameofexecutable]\""
4752 puts $fd " \"[file normalize $argv0]\""
4753 close $fd
4754 } err]} {
4755 error_popup "Cannot write script:\n\n$err"
4760 proc do_cygwin_shortcut {} {
4761 global argv0
4763 if {[catch {
4764 set desktop [exec cygpath \
4765 --windows \
4766 --absolute \
4767 --long-name \
4768 --desktop]
4769 }]} {
4770 set desktop .
4772 set fn [tk_getSaveFile \
4773 -parent . \
4774 -title "[appname] ([reponame]): Create Desktop Icon" \
4775 -initialdir $desktop \
4776 -initialfile "Git [reponame].bat"]
4777 if {$fn != {}} {
4778 if {[catch {
4779 set fd [open $fn w]
4780 set sh [exec cygpath \
4781 --windows \
4782 --absolute \
4783 /bin/sh]
4784 set me [exec cygpath \
4785 --unix \
4786 --absolute \
4787 $argv0]
4788 set gd [exec cygpath \
4789 --unix \
4790 --absolute \
4791 [gitdir]]
4792 set gw [exec cygpath \
4793 --windows \
4794 --absolute \
4795 [file dirname [gitdir]]]
4796 regsub -all ' $me "'\\''" me
4797 regsub -all ' $gd "'\\''" gd
4798 puts $fd "@ECHO Entering $gw"
4799 puts $fd "@ECHO Starting git-gui... please wait..."
4800 puts -nonewline $fd "@\"$sh\" --login -c \""
4801 puts -nonewline $fd "GIT_DIR='$gd'"
4802 puts -nonewline $fd " '$me'"
4803 puts $fd "&\""
4804 close $fd
4805 } err]} {
4806 error_popup "Cannot write script:\n\n$err"
4811 proc do_macosx_app {} {
4812 global argv0 env
4814 set fn [tk_getSaveFile \
4815 -parent . \
4816 -title "[appname] ([reponame]): Create Desktop Icon" \
4817 -initialdir [file join $env(HOME) Desktop] \
4818 -initialfile "Git [reponame].app"]
4819 if {$fn != {}} {
4820 if {[catch {
4821 set Contents [file join $fn Contents]
4822 set MacOS [file join $Contents MacOS]
4823 set exe [file join $MacOS git-gui]
4825 file mkdir $MacOS
4827 set fd [open [file join $Contents Info.plist] w]
4828 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4829 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4830 <plist version="1.0">
4831 <dict>
4832 <key>CFBundleDevelopmentRegion</key>
4833 <string>English</string>
4834 <key>CFBundleExecutable</key>
4835 <string>git-gui</string>
4836 <key>CFBundleIdentifier</key>
4837 <string>org.spearce.git-gui</string>
4838 <key>CFBundleInfoDictionaryVersion</key>
4839 <string>6.0</string>
4840 <key>CFBundlePackageType</key>
4841 <string>APPL</string>
4842 <key>CFBundleSignature</key>
4843 <string>????</string>
4844 <key>CFBundleVersion</key>
4845 <string>1.0</string>
4846 <key>NSPrincipalClass</key>
4847 <string>NSApplication</string>
4848 </dict>
4849 </plist>}
4850 close $fd
4852 set fd [open $exe w]
4853 set gd [file normalize [gitdir]]
4854 set ep [file normalize [gitexec]]
4855 regsub -all ' $gd "'\\''" gd
4856 regsub -all ' $ep "'\\''" ep
4857 puts $fd "#!/bin/sh"
4858 foreach name [array names env] {
4859 if {[string match GIT_* $name]} {
4860 regsub -all ' $env($name) "'\\''" v
4861 puts $fd "export $name='$v'"
4864 puts $fd "export PATH='$ep':\$PATH"
4865 puts $fd "export GIT_DIR='$gd'"
4866 puts $fd "exec [file normalize $argv0]"
4867 close $fd
4869 file attributes $exe -permissions u+x,g+x,o+x
4870 } err]} {
4871 error_popup "Cannot write icon:\n\n$err"
4876 proc toggle_or_diff {w x y} {
4877 global file_states file_lists current_diff_path ui_index ui_workdir
4878 global last_clicked selected_paths
4880 set pos [split [$w index @$x,$y] .]
4881 set lno [lindex $pos 0]
4882 set col [lindex $pos 1]
4883 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4884 if {$path eq {}} {
4885 set last_clicked {}
4886 return
4889 set last_clicked [list $w $lno]
4890 array unset selected_paths
4891 $ui_index tag remove in_sel 0.0 end
4892 $ui_workdir tag remove in_sel 0.0 end
4894 if {$col == 0} {
4895 if {$current_diff_path eq $path} {
4896 set after {reshow_diff;}
4897 } else {
4898 set after {}
4900 if {$w eq $ui_index} {
4901 update_indexinfo \
4902 "Unstaging [short_path $path] from commit" \
4903 [list $path] \
4904 [concat $after {set ui_status_value {Ready.}}]
4905 } elseif {$w eq $ui_workdir} {
4906 update_index \
4907 "Adding [short_path $path]" \
4908 [list $path] \
4909 [concat $after {set ui_status_value {Ready.}}]
4911 } else {
4912 show_diff $path $w $lno
4916 proc add_one_to_selection {w x y} {
4917 global file_lists last_clicked selected_paths
4919 set lno [lindex [split [$w index @$x,$y] .] 0]
4920 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4921 if {$path eq {}} {
4922 set last_clicked {}
4923 return
4926 if {$last_clicked ne {}
4927 && [lindex $last_clicked 0] ne $w} {
4928 array unset selected_paths
4929 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4932 set last_clicked [list $w $lno]
4933 if {[catch {set in_sel $selected_paths($path)}]} {
4934 set in_sel 0
4936 if {$in_sel} {
4937 unset selected_paths($path)
4938 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4939 } else {
4940 set selected_paths($path) 1
4941 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4945 proc add_range_to_selection {w x y} {
4946 global file_lists last_clicked selected_paths
4948 if {[lindex $last_clicked 0] ne $w} {
4949 toggle_or_diff $w $x $y
4950 return
4953 set lno [lindex [split [$w index @$x,$y] .] 0]
4954 set lc [lindex $last_clicked 1]
4955 if {$lc < $lno} {
4956 set begin $lc
4957 set end $lno
4958 } else {
4959 set begin $lno
4960 set end $lc
4963 foreach path [lrange $file_lists($w) \
4964 [expr {$begin - 1}] \
4965 [expr {$end - 1}]] {
4966 set selected_paths($path) 1
4968 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4971 ######################################################################
4973 ## config defaults
4975 set cursor_ptr arrow
4976 font create font_diff -family Courier -size 10
4977 font create font_ui
4978 catch {
4979 label .dummy
4980 eval font configure font_ui [font actual [.dummy cget -font]]
4981 destroy .dummy
4984 font create font_uibold
4985 font create font_diffbold
4987 if {[is_Windows]} {
4988 set M1B Control
4989 set M1T Ctrl
4990 } elseif {[is_MacOSX]} {
4991 set M1B M1
4992 set M1T Cmd
4993 } else {
4994 set M1B M1
4995 set M1T M1
4998 proc apply_config {} {
4999 global repo_config font_descs
5001 foreach option $font_descs {
5002 set name [lindex $option 0]
5003 set font [lindex $option 1]
5004 if {[catch {
5005 foreach {cn cv} $repo_config(gui.$name) {
5006 font configure $font $cn $cv
5008 } err]} {
5009 error_popup "Invalid font specified in gui.$name:\n\n$err"
5011 foreach {cn cv} [font configure $font] {
5012 font configure ${font}bold $cn $cv
5014 font configure ${font}bold -weight bold
5018 set default_config(merge.summary) false
5019 set default_config(merge.verbosity) 2
5020 set default_config(user.name) {}
5021 set default_config(user.email) {}
5023 set default_config(gui.trustmtime) false
5024 set default_config(gui.diffcontext) 5
5025 set default_config(gui.newbranchtemplate) {}
5026 set default_config(gui.fontui) [font configure font_ui]
5027 set default_config(gui.fontdiff) [font configure font_diff]
5028 set font_descs {
5029 {fontui font_ui {Main Font}}
5030 {fontdiff font_diff {Diff/Console Font}}
5032 load_config 0
5033 apply_config
5035 ######################################################################
5037 ## feature option selection
5039 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5040 unset _junk
5041 } else {
5042 set subcommand gui
5044 if {$subcommand eq {gui.sh}} {
5045 set subcommand gui
5047 if {$subcommand eq {gui} && [llength $argv] > 0} {
5048 set subcommand [lindex $argv 0]
5049 set argv [lrange $argv 1 end]
5052 enable_option multicommit
5053 enable_option branch
5054 enable_option transport
5056 switch -- $subcommand {
5057 --version -
5058 version -
5059 browser -
5060 blame {
5061 disable_option multicommit
5062 disable_option branch
5063 disable_option transport
5065 citool {
5066 enable_option singlecommit
5068 disable_option multicommit
5069 disable_option branch
5070 disable_option transport
5074 ######################################################################
5076 ## ui construction
5078 set ui_comm {}
5080 # -- Menu Bar
5082 menu .mbar -tearoff 0
5083 .mbar add cascade -label Repository -menu .mbar.repository
5084 .mbar add cascade -label Edit -menu .mbar.edit
5085 if {[is_enabled branch]} {
5086 .mbar add cascade -label Branch -menu .mbar.branch
5088 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5089 .mbar add cascade -label Commit -menu .mbar.commit
5091 if {[is_enabled transport]} {
5092 .mbar add cascade -label Merge -menu .mbar.merge
5093 .mbar add cascade -label Fetch -menu .mbar.fetch
5094 .mbar add cascade -label Push -menu .mbar.push
5096 . configure -menu .mbar
5098 # -- Repository Menu
5100 menu .mbar.repository
5102 .mbar.repository add command \
5103 -label {Browse Current Branch} \
5104 -command {new_browser $current_branch} \
5105 -font font_ui
5106 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5107 .mbar.repository add separator
5109 .mbar.repository add command \
5110 -label {Visualize Current Branch} \
5111 -command {do_gitk $current_branch} \
5112 -font font_ui
5113 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5114 .mbar.repository add command \
5115 -label {Visualize All Branches} \
5116 -command {do_gitk --all} \
5117 -font font_ui
5118 .mbar.repository add separator
5120 if {[is_enabled multicommit]} {
5121 .mbar.repository add command -label {Database Statistics} \
5122 -command do_stats \
5123 -font font_ui
5125 .mbar.repository add command -label {Compress Database} \
5126 -command do_gc \
5127 -font font_ui
5129 .mbar.repository add command -label {Verify Database} \
5130 -command do_fsck_objects \
5131 -font font_ui
5133 .mbar.repository add separator
5135 if {[is_Cygwin]} {
5136 .mbar.repository add command \
5137 -label {Create Desktop Icon} \
5138 -command do_cygwin_shortcut \
5139 -font font_ui
5140 } elseif {[is_Windows]} {
5141 .mbar.repository add command \
5142 -label {Create Desktop Icon} \
5143 -command do_windows_shortcut \
5144 -font font_ui
5145 } elseif {[is_MacOSX]} {
5146 .mbar.repository add command \
5147 -label {Create Desktop Icon} \
5148 -command do_macosx_app \
5149 -font font_ui
5153 .mbar.repository add command -label Quit \
5154 -command do_quit \
5155 -accelerator $M1T-Q \
5156 -font font_ui
5158 # -- Edit Menu
5160 menu .mbar.edit
5161 .mbar.edit add command -label Undo \
5162 -command {catch {[focus] edit undo}} \
5163 -accelerator $M1T-Z \
5164 -font font_ui
5165 .mbar.edit add command -label Redo \
5166 -command {catch {[focus] edit redo}} \
5167 -accelerator $M1T-Y \
5168 -font font_ui
5169 .mbar.edit add separator
5170 .mbar.edit add command -label Cut \
5171 -command {catch {tk_textCut [focus]}} \
5172 -accelerator $M1T-X \
5173 -font font_ui
5174 .mbar.edit add command -label Copy \
5175 -command {catch {tk_textCopy [focus]}} \
5176 -accelerator $M1T-C \
5177 -font font_ui
5178 .mbar.edit add command -label Paste \
5179 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5180 -accelerator $M1T-V \
5181 -font font_ui
5182 .mbar.edit add command -label Delete \
5183 -command {catch {[focus] delete sel.first sel.last}} \
5184 -accelerator Del \
5185 -font font_ui
5186 .mbar.edit add separator
5187 .mbar.edit add command -label {Select All} \
5188 -command {catch {[focus] tag add sel 0.0 end}} \
5189 -accelerator $M1T-A \
5190 -font font_ui
5192 # -- Branch Menu
5194 if {[is_enabled branch]} {
5195 menu .mbar.branch
5197 .mbar.branch add command -label {Create...} \
5198 -command do_create_branch \
5199 -accelerator $M1T-N \
5200 -font font_ui
5201 lappend disable_on_lock [list .mbar.branch entryconf \
5202 [.mbar.branch index last] -state]
5204 .mbar.branch add command -label {Delete...} \
5205 -command do_delete_branch \
5206 -font font_ui
5207 lappend disable_on_lock [list .mbar.branch entryconf \
5208 [.mbar.branch index last] -state]
5210 .mbar.branch add command -label {Reset...} \
5211 -command do_reset_hard \
5212 -font font_ui
5213 lappend disable_on_lock [list .mbar.branch entryconf \
5214 [.mbar.branch index last] -state]
5217 # -- Commit Menu
5219 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5220 menu .mbar.commit
5222 .mbar.commit add radiobutton \
5223 -label {New Commit} \
5224 -command do_select_commit_type \
5225 -variable selected_commit_type \
5226 -value new \
5227 -font font_ui
5228 lappend disable_on_lock \
5229 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5231 .mbar.commit add radiobutton \
5232 -label {Amend Last Commit} \
5233 -command do_select_commit_type \
5234 -variable selected_commit_type \
5235 -value amend \
5236 -font font_ui
5237 lappend disable_on_lock \
5238 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5240 .mbar.commit add separator
5242 .mbar.commit add command -label Rescan \
5243 -command do_rescan \
5244 -accelerator F5 \
5245 -font font_ui
5246 lappend disable_on_lock \
5247 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5249 .mbar.commit add command -label {Add To Commit} \
5250 -command do_add_selection \
5251 -font font_ui
5252 lappend disable_on_lock \
5253 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5255 .mbar.commit add command -label {Add Existing To Commit} \
5256 -command do_add_all \
5257 -accelerator $M1T-I \
5258 -font font_ui
5259 lappend disable_on_lock \
5260 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5262 .mbar.commit add command -label {Unstage From Commit} \
5263 -command do_unstage_selection \
5264 -font font_ui
5265 lappend disable_on_lock \
5266 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5268 .mbar.commit add command -label {Revert Changes} \
5269 -command do_revert_selection \
5270 -font font_ui
5271 lappend disable_on_lock \
5272 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5274 .mbar.commit add separator
5276 .mbar.commit add command -label {Sign Off} \
5277 -command do_signoff \
5278 -accelerator $M1T-S \
5279 -font font_ui
5281 .mbar.commit add command -label Commit \
5282 -command do_commit \
5283 -accelerator $M1T-Return \
5284 -font font_ui
5285 lappend disable_on_lock \
5286 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5289 # -- Merge Menu
5291 if {[is_enabled branch]} {
5292 menu .mbar.merge
5293 .mbar.merge add command -label {Local Merge...} \
5294 -command do_local_merge \
5295 -font font_ui
5296 lappend disable_on_lock \
5297 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5298 .mbar.merge add command -label {Abort Merge...} \
5299 -command do_reset_hard \
5300 -font font_ui
5301 lappend disable_on_lock \
5302 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5306 # -- Transport Menu
5308 if {[is_enabled transport]} {
5309 menu .mbar.fetch
5311 menu .mbar.push
5312 .mbar.push add command -label {Push...} \
5313 -command do_push_anywhere \
5314 -font font_ui
5317 if {[is_MacOSX]} {
5318 # -- Apple Menu (Mac OS X only)
5320 .mbar add cascade -label Apple -menu .mbar.apple
5321 menu .mbar.apple
5323 .mbar.apple add command -label "About [appname]" \
5324 -command do_about \
5325 -font font_ui
5326 .mbar.apple add command -label "Options..." \
5327 -command do_options \
5328 -font font_ui
5329 } else {
5330 # -- Edit Menu
5332 .mbar.edit add separator
5333 .mbar.edit add command -label {Options...} \
5334 -command do_options \
5335 -font font_ui
5337 # -- Tools Menu
5339 if {[file exists /usr/local/miga/lib/gui-miga]
5340 && [file exists .pvcsrc]} {
5341 proc do_miga {} {
5342 global ui_status_value
5343 if {![lock_index update]} return
5344 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5345 set miga_fd [open "|$cmd" r]
5346 fconfigure $miga_fd -blocking 0
5347 fileevent $miga_fd readable [list miga_done $miga_fd]
5348 set ui_status_value {Running miga...}
5350 proc miga_done {fd} {
5351 read $fd 512
5352 if {[eof $fd]} {
5353 close $fd
5354 unlock_index
5355 rescan [list set ui_status_value {Ready.}]
5358 .mbar add cascade -label Tools -menu .mbar.tools
5359 menu .mbar.tools
5360 .mbar.tools add command -label "Migrate" \
5361 -command do_miga \
5362 -font font_ui
5363 lappend disable_on_lock \
5364 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5368 # -- Help Menu
5370 .mbar add cascade -label Help -menu .mbar.help
5371 menu .mbar.help
5373 if {![is_MacOSX]} {
5374 .mbar.help add command -label "About [appname]" \
5375 -command do_about \
5376 -font font_ui
5379 set browser {}
5380 catch {set browser $repo_config(instaweb.browser)}
5381 set doc_path [file dirname [gitexec]]
5382 set doc_path [file join $doc_path Documentation index.html]
5384 if {[is_Cygwin]} {
5385 set doc_path [exec cygpath --mixed $doc_path]
5388 if {$browser eq {}} {
5389 if {[is_MacOSX]} {
5390 set browser open
5391 } elseif {[is_Cygwin]} {
5392 set program_files [file dirname [exec cygpath --windir]]
5393 set program_files [file join $program_files {Program Files}]
5394 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5395 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5396 if {[file exists $firefox]} {
5397 set browser $firefox
5398 } elseif {[file exists $ie]} {
5399 set browser $ie
5401 unset program_files firefox ie
5405 if {[file isfile $doc_path]} {
5406 set doc_url "file:$doc_path"
5407 } else {
5408 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5411 if {$browser ne {}} {
5412 .mbar.help add command -label {Online Documentation} \
5413 -command [list exec $browser $doc_url &] \
5414 -font font_ui
5416 unset browser doc_path doc_url
5418 # -- Standard bindings
5420 bind . <Destroy> do_quit
5421 bind all <$M1B-Key-q> do_quit
5422 bind all <$M1B-Key-Q> do_quit
5423 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5424 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5426 # -- Not a normal commit type invocation? Do that instead!
5428 switch -- $subcommand {
5429 --version -
5430 version {
5431 puts "git-gui version $appvers"
5432 exit
5434 browser {
5435 if {[llength $argv] != 1} {
5436 puts stderr "usage: $argv0 browser commit"
5437 exit 1
5439 set current_branch [lindex $argv 0]
5440 new_browser $current_branch
5441 return
5443 blame {
5444 if {[llength $argv] != 2} {
5445 puts stderr "usage: $argv0 blame commit path"
5446 exit 1
5448 set current_branch [lindex $argv 0]
5449 show_blame $current_branch [lindex $argv 1]
5450 return
5452 citool -
5453 gui {
5454 if {[llength $argv] != 0} {
5455 puts -nonewline stderr "usage: $argv0"
5456 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5457 puts -nonewline stderr " $subcommand"
5459 puts stderr {}
5460 exit 1
5462 # fall through to setup UI for commits
5464 default {
5465 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
5466 exit 1
5470 # -- Branch Control
5472 frame .branch \
5473 -borderwidth 1 \
5474 -relief sunken
5475 label .branch.l1 \
5476 -text {Current Branch:} \
5477 -anchor w \
5478 -justify left \
5479 -font font_ui
5480 label .branch.cb \
5481 -textvariable current_branch \
5482 -anchor w \
5483 -justify left \
5484 -font font_ui
5485 pack .branch.l1 -side left
5486 pack .branch.cb -side left -fill x
5487 pack .branch -side top -fill x
5489 # -- Main Window Layout
5491 panedwindow .vpane -orient vertical
5492 panedwindow .vpane.files -orient horizontal
5493 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5494 pack .vpane -anchor n -side top -fill both -expand 1
5496 # -- Index File List
5498 frame .vpane.files.index -height 100 -width 200
5499 label .vpane.files.index.title -text {Changes To Be Committed} \
5500 -background green \
5501 -font font_ui
5502 text $ui_index -background white -borderwidth 0 \
5503 -width 20 -height 10 \
5504 -wrap none \
5505 -font font_ui \
5506 -cursor $cursor_ptr \
5507 -xscrollcommand {.vpane.files.index.sx set} \
5508 -yscrollcommand {.vpane.files.index.sy set} \
5509 -state disabled
5510 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5511 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5512 pack .vpane.files.index.title -side top -fill x
5513 pack .vpane.files.index.sx -side bottom -fill x
5514 pack .vpane.files.index.sy -side right -fill y
5515 pack $ui_index -side left -fill both -expand 1
5516 .vpane.files add .vpane.files.index -sticky nsew
5518 # -- Working Directory File List
5520 frame .vpane.files.workdir -height 100 -width 200
5521 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5522 -background red \
5523 -font font_ui
5524 text $ui_workdir -background white -borderwidth 0 \
5525 -width 20 -height 10 \
5526 -wrap none \
5527 -font font_ui \
5528 -cursor $cursor_ptr \
5529 -xscrollcommand {.vpane.files.workdir.sx set} \
5530 -yscrollcommand {.vpane.files.workdir.sy set} \
5531 -state disabled
5532 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5533 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5534 pack .vpane.files.workdir.title -side top -fill x
5535 pack .vpane.files.workdir.sx -side bottom -fill x
5536 pack .vpane.files.workdir.sy -side right -fill y
5537 pack $ui_workdir -side left -fill both -expand 1
5538 .vpane.files add .vpane.files.workdir -sticky nsew
5540 foreach i [list $ui_index $ui_workdir] {
5541 $i tag conf in_diff -font font_uibold
5542 $i tag conf in_sel \
5543 -background [$i cget -foreground] \
5544 -foreground [$i cget -background]
5546 unset i
5548 # -- Diff and Commit Area
5550 frame .vpane.lower -height 300 -width 400
5551 frame .vpane.lower.commarea
5552 frame .vpane.lower.diff -relief sunken -borderwidth 1
5553 pack .vpane.lower.commarea -side top -fill x
5554 pack .vpane.lower.diff -side bottom -fill both -expand 1
5555 .vpane add .vpane.lower -sticky nsew
5557 # -- Commit Area Buttons
5559 frame .vpane.lower.commarea.buttons
5560 label .vpane.lower.commarea.buttons.l -text {} \
5561 -anchor w \
5562 -justify left \
5563 -font font_ui
5564 pack .vpane.lower.commarea.buttons.l -side top -fill x
5565 pack .vpane.lower.commarea.buttons -side left -fill y
5567 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5568 -command do_rescan \
5569 -font font_ui
5570 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5571 lappend disable_on_lock \
5572 {.vpane.lower.commarea.buttons.rescan conf -state}
5574 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5575 -command do_add_all \
5576 -font font_ui
5577 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5578 lappend disable_on_lock \
5579 {.vpane.lower.commarea.buttons.incall conf -state}
5581 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5582 -command do_signoff \
5583 -font font_ui
5584 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5586 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5587 -command do_commit \
5588 -font font_ui
5589 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5590 lappend disable_on_lock \
5591 {.vpane.lower.commarea.buttons.commit conf -state}
5593 # -- Commit Message Buffer
5595 frame .vpane.lower.commarea.buffer
5596 frame .vpane.lower.commarea.buffer.header
5597 set ui_comm .vpane.lower.commarea.buffer.t
5598 set ui_coml .vpane.lower.commarea.buffer.header.l
5599 radiobutton .vpane.lower.commarea.buffer.header.new \
5600 -text {New Commit} \
5601 -command do_select_commit_type \
5602 -variable selected_commit_type \
5603 -value new \
5604 -font font_ui
5605 lappend disable_on_lock \
5606 [list .vpane.lower.commarea.buffer.header.new conf -state]
5607 radiobutton .vpane.lower.commarea.buffer.header.amend \
5608 -text {Amend Last Commit} \
5609 -command do_select_commit_type \
5610 -variable selected_commit_type \
5611 -value amend \
5612 -font font_ui
5613 lappend disable_on_lock \
5614 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5615 label $ui_coml \
5616 -anchor w \
5617 -justify left \
5618 -font font_ui
5619 proc trace_commit_type {varname args} {
5620 global ui_coml commit_type
5621 switch -glob -- $commit_type {
5622 initial {set txt {Initial Commit Message:}}
5623 amend {set txt {Amended Commit Message:}}
5624 amend-initial {set txt {Amended Initial Commit Message:}}
5625 amend-merge {set txt {Amended Merge Commit Message:}}
5626 merge {set txt {Merge Commit Message:}}
5627 * {set txt {Commit Message:}}
5629 $ui_coml conf -text $txt
5631 trace add variable commit_type write trace_commit_type
5632 pack $ui_coml -side left -fill x
5633 pack .vpane.lower.commarea.buffer.header.amend -side right
5634 pack .vpane.lower.commarea.buffer.header.new -side right
5636 text $ui_comm -background white -borderwidth 1 \
5637 -undo true \
5638 -maxundo 20 \
5639 -autoseparators true \
5640 -relief sunken \
5641 -width 75 -height 9 -wrap none \
5642 -font font_diff \
5643 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5644 scrollbar .vpane.lower.commarea.buffer.sby \
5645 -command [list $ui_comm yview]
5646 pack .vpane.lower.commarea.buffer.header -side top -fill x
5647 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5648 pack $ui_comm -side left -fill y
5649 pack .vpane.lower.commarea.buffer -side left -fill y
5651 # -- Commit Message Buffer Context Menu
5653 set ctxm .vpane.lower.commarea.buffer.ctxm
5654 menu $ctxm -tearoff 0
5655 $ctxm add command \
5656 -label {Cut} \
5657 -font font_ui \
5658 -command {tk_textCut $ui_comm}
5659 $ctxm add command \
5660 -label {Copy} \
5661 -font font_ui \
5662 -command {tk_textCopy $ui_comm}
5663 $ctxm add command \
5664 -label {Paste} \
5665 -font font_ui \
5666 -command {tk_textPaste $ui_comm}
5667 $ctxm add command \
5668 -label {Delete} \
5669 -font font_ui \
5670 -command {$ui_comm delete sel.first sel.last}
5671 $ctxm add separator
5672 $ctxm add command \
5673 -label {Select All} \
5674 -font font_ui \
5675 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5676 $ctxm add command \
5677 -label {Copy All} \
5678 -font font_ui \
5679 -command {
5680 $ui_comm tag add sel 0.0 end
5681 tk_textCopy $ui_comm
5682 $ui_comm tag remove sel 0.0 end
5684 $ctxm add separator
5685 $ctxm add command \
5686 -label {Sign Off} \
5687 -font font_ui \
5688 -command do_signoff
5689 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5691 # -- Diff Header
5693 proc trace_current_diff_path {varname args} {
5694 global current_diff_path diff_actions file_states
5695 if {$current_diff_path eq {}} {
5696 set s {}
5697 set f {}
5698 set p {}
5699 set o disabled
5700 } else {
5701 set p $current_diff_path
5702 set s [mapdesc [lindex $file_states($p) 0] $p]
5703 set f {File:}
5704 set p [escape_path $p]
5705 set o normal
5708 .vpane.lower.diff.header.status configure -text $s
5709 .vpane.lower.diff.header.file configure -text $f
5710 .vpane.lower.diff.header.path configure -text $p
5711 foreach w $diff_actions {
5712 uplevel #0 $w $o
5715 trace add variable current_diff_path write trace_current_diff_path
5717 frame .vpane.lower.diff.header -background orange
5718 label .vpane.lower.diff.header.status \
5719 -background orange \
5720 -width $max_status_desc \
5721 -anchor w \
5722 -justify left \
5723 -font font_ui
5724 label .vpane.lower.diff.header.file \
5725 -background orange \
5726 -anchor w \
5727 -justify left \
5728 -font font_ui
5729 label .vpane.lower.diff.header.path \
5730 -background orange \
5731 -anchor w \
5732 -justify left \
5733 -font font_ui
5734 pack .vpane.lower.diff.header.status -side left
5735 pack .vpane.lower.diff.header.file -side left
5736 pack .vpane.lower.diff.header.path -fill x
5737 set ctxm .vpane.lower.diff.header.ctxm
5738 menu $ctxm -tearoff 0
5739 $ctxm add command \
5740 -label {Copy} \
5741 -font font_ui \
5742 -command {
5743 clipboard clear
5744 clipboard append \
5745 -format STRING \
5746 -type STRING \
5747 -- $current_diff_path
5749 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5750 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5752 # -- Diff Body
5754 frame .vpane.lower.diff.body
5755 set ui_diff .vpane.lower.diff.body.t
5756 text $ui_diff -background white -borderwidth 0 \
5757 -width 80 -height 15 -wrap none \
5758 -font font_diff \
5759 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5760 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5761 -state disabled
5762 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5763 -command [list $ui_diff xview]
5764 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5765 -command [list $ui_diff yview]
5766 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5767 pack .vpane.lower.diff.body.sby -side right -fill y
5768 pack $ui_diff -side left -fill both -expand 1
5769 pack .vpane.lower.diff.header -side top -fill x
5770 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5772 $ui_diff tag conf d_cr -elide true
5773 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5774 $ui_diff tag conf d_+ -foreground {#00a000}
5775 $ui_diff tag conf d_- -foreground red
5777 $ui_diff tag conf d_++ -foreground {#00a000}
5778 $ui_diff tag conf d_-- -foreground red
5779 $ui_diff tag conf d_+s \
5780 -foreground {#00a000} \
5781 -background {#e2effa}
5782 $ui_diff tag conf d_-s \
5783 -foreground red \
5784 -background {#e2effa}
5785 $ui_diff tag conf d_s+ \
5786 -foreground {#00a000} \
5787 -background ivory1
5788 $ui_diff tag conf d_s- \
5789 -foreground red \
5790 -background ivory1
5792 $ui_diff tag conf d<<<<<<< \
5793 -foreground orange \
5794 -font font_diffbold
5795 $ui_diff tag conf d======= \
5796 -foreground orange \
5797 -font font_diffbold
5798 $ui_diff tag conf d>>>>>>> \
5799 -foreground orange \
5800 -font font_diffbold
5802 $ui_diff tag raise sel
5804 # -- Diff Body Context Menu
5806 set ctxm .vpane.lower.diff.body.ctxm
5807 menu $ctxm -tearoff 0
5808 $ctxm add command \
5809 -label {Refresh} \
5810 -font font_ui \
5811 -command reshow_diff
5812 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5813 $ctxm add command \
5814 -label {Copy} \
5815 -font font_ui \
5816 -command {tk_textCopy $ui_diff}
5817 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5818 $ctxm add command \
5819 -label {Select All} \
5820 -font font_ui \
5821 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5822 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5823 $ctxm add command \
5824 -label {Copy All} \
5825 -font font_ui \
5826 -command {
5827 $ui_diff tag add sel 0.0 end
5828 tk_textCopy $ui_diff
5829 $ui_diff tag remove sel 0.0 end
5831 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5832 $ctxm add separator
5833 $ctxm add command \
5834 -label {Apply/Reverse Hunk} \
5835 -font font_ui \
5836 -command {apply_hunk $cursorX $cursorY}
5837 set ui_diff_applyhunk [$ctxm index last]
5838 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5839 $ctxm add separator
5840 $ctxm add command \
5841 -label {Decrease Font Size} \
5842 -font font_ui \
5843 -command {incr_font_size font_diff -1}
5844 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5845 $ctxm add command \
5846 -label {Increase Font Size} \
5847 -font font_ui \
5848 -command {incr_font_size font_diff 1}
5849 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5850 $ctxm add separator
5851 $ctxm add command \
5852 -label {Show Less Context} \
5853 -font font_ui \
5854 -command {if {$repo_config(gui.diffcontext) >= 2} {
5855 incr repo_config(gui.diffcontext) -1
5856 reshow_diff
5858 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5859 $ctxm add command \
5860 -label {Show More Context} \
5861 -font font_ui \
5862 -command {
5863 incr repo_config(gui.diffcontext)
5864 reshow_diff
5866 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5867 $ctxm add separator
5868 $ctxm add command -label {Options...} \
5869 -font font_ui \
5870 -command do_options
5871 bind_button3 $ui_diff "
5872 set cursorX %x
5873 set cursorY %y
5874 if {\$ui_index eq \$current_diff_side} {
5875 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5876 } else {
5877 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5879 tk_popup $ctxm %X %Y
5881 unset ui_diff_applyhunk
5883 # -- Status Bar
5885 label .status -textvariable ui_status_value \
5886 -anchor w \
5887 -justify left \
5888 -borderwidth 1 \
5889 -relief sunken \
5890 -font font_ui
5891 pack .status -anchor w -side bottom -fill x
5893 # -- Load geometry
5895 catch {
5896 set gm $repo_config(gui.geometry)
5897 wm geometry . [lindex $gm 0]
5898 .vpane sash place 0 \
5899 [lindex [.vpane sash coord 0] 0] \
5900 [lindex $gm 1]
5901 .vpane.files sash place 0 \
5902 [lindex $gm 2] \
5903 [lindex [.vpane.files sash coord 0] 1]
5904 unset gm
5907 # -- Key Bindings
5909 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5910 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5911 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5912 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5913 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5914 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5915 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5916 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5917 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5918 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5919 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5921 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5922 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5923 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5924 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5925 bind $ui_diff <$M1B-Key-v> {break}
5926 bind $ui_diff <$M1B-Key-V> {break}
5927 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5928 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5929 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5930 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5931 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5932 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5933 bind $ui_diff <Button-1> {focus %W}
5935 if {[is_enabled branch]} {
5936 bind . <$M1B-Key-n> do_create_branch
5937 bind . <$M1B-Key-N> do_create_branch
5940 bind all <Key-F5> do_rescan
5941 bind all <$M1B-Key-r> do_rescan
5942 bind all <$M1B-Key-R> do_rescan
5943 bind . <$M1B-Key-s> do_signoff
5944 bind . <$M1B-Key-S> do_signoff
5945 bind . <$M1B-Key-i> do_add_all
5946 bind . <$M1B-Key-I> do_add_all
5947 bind . <$M1B-Key-Return> do_commit
5948 foreach i [list $ui_index $ui_workdir] {
5949 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
5950 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5951 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5953 unset i
5955 set file_lists($ui_index) [list]
5956 set file_lists($ui_workdir) [list]
5958 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5959 focus -force $ui_comm
5961 # -- Warn the user about environmental problems. Cygwin's Tcl
5962 # does *not* pass its env array onto any processes it spawns.
5963 # This means that git processes get none of our environment.
5965 if {[is_Cygwin]} {
5966 set ignored_env 0
5967 set suggest_user {}
5968 set msg "Possible environment issues exist.
5970 The following environment variables are probably
5971 going to be ignored by any Git subprocess run
5972 by [appname]:
5975 foreach name [array names env] {
5976 switch -regexp -- $name {
5977 {^GIT_INDEX_FILE$} -
5978 {^GIT_OBJECT_DIRECTORY$} -
5979 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5980 {^GIT_DIFF_OPTS$} -
5981 {^GIT_EXTERNAL_DIFF$} -
5982 {^GIT_PAGER$} -
5983 {^GIT_TRACE$} -
5984 {^GIT_CONFIG$} -
5985 {^GIT_CONFIG_LOCAL$} -
5986 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5987 append msg " - $name\n"
5988 incr ignored_env
5990 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5991 append msg " - $name\n"
5992 incr ignored_env
5993 set suggest_user $name
5997 if {$ignored_env > 0} {
5998 append msg "
5999 This is due to a known issue with the
6000 Tcl binary distributed by Cygwin."
6002 if {$suggest_user ne {}} {
6003 append msg "
6005 A good replacement for $suggest_user
6006 is placing values for the user.name and
6007 user.email settings into your personal
6008 ~/.gitconfig file.
6011 warn_popup $msg
6013 unset ignored_env msg suggest_user name
6016 # -- Only initialize complex UI if we are going to stay running.
6018 if {[is_enabled transport]} {
6019 load_all_remotes
6020 load_all_heads
6022 populate_branch_menu
6023 populate_fetch_menu
6024 populate_push_menu
6027 # -- Only suggest a gc run if we are going to stay running.
6029 if {[is_enabled multicommit]} {
6030 set object_limit 2000
6031 if {[is_Windows]} {set object_limit 200}
6032 regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
6033 if {$objects_current >= $object_limit} {
6034 if {[ask_popup \
6035 "This repository currently has $objects_current loose objects.
6037 To maintain optimal performance it is strongly
6038 recommended that you compress the database
6039 when more than $object_limit loose objects exist.
6041 Compress the database now?"] eq yes} {
6042 do_gc
6045 unset object_limit _junk objects_current
6048 lock_index begin-read
6049 after 1 do_rescan