1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4set appvers {@@GITGUI_VERSION@@}
6set copyright {
7Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
8This program is free software; you can redistribute it and/or modify
10it under the terms of the GNU General Public License as published by
11the Free Software Foundation; either version 2 of the License, or
12(at your option) any later version.
13This program is distributed in the hope that it will be useful,
15but WITHOUT ANY WARRANTY; without even the implied warranty of
16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17GNU General Public License for more details.
18You should have received a copy of the GNU General Public License
20along with this program; if not, write to the Free Software
21Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
22######################################################################
24##
25## read only globals
26set _appname [lindex [file split $argv0] end]
28set _gitdir {}
29set _gitexec {}
30set _reponame {}
31set _iscygwin {}
32proc appname {} {
34 global _appname
35 return $_appname
36}
37proc gitdir {args} {
39 global _gitdir
40 if {$args eq {}} {
41 return $_gitdir
42 }
43 return [eval [concat [list file join $_gitdir] $args]]
44}
45proc 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"
51 }
52 }
53 if {$args eq {}} {
54 return $_gitexec
55 }
56 return [eval [concat [list file join $_gitexec] $args]]
57}
58proc reponame {} {
60 global _reponame
61 return $_reponame
62}
63proc is_MacOSX {} {
65 global tcl_platform tk_library
66 if {[tk windowingsystem] eq {aqua}} {
67 return 1
68 }
69 return 0
70}
71proc is_Windows {} {
73 global tcl_platform
74 if {$tcl_platform(platform) eq {windows}} {
75 return 1
76 }
77 return 0
78}
79proc 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
88 }
89 } else {
90 set _iscygwin 0
91 }
92 }
93 return $_iscygwin
94}
95proc is_enabled {option} {
97 global enabled_options
98 if {[catch {set on $enabled_options($option)}]} {return 0}
99 return $on
100}
101proc enable_option {option} {
103 global enabled_options
104 set enabled_options($option) 1
105}
106proc disable_option {option} {
108 global enabled_options
109 set enabled_options($option) 0
110}
111######################################################################
113##
114## config
115proc is_many_config {name} {
117 switch -glob -- $name {
118 remote.*.fetch -
119 remote.*.push
120 {return 1}
121 *
122 {return 0}
123 }
124}
125proc 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
134 }
135}
136proc load_config {include_global} {
138 global repo_config global_config default_config
139 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
150 }
151 }
152 }
153 close $fd_rc
154 }
155 }
156 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
166 }
167 }
168 }
169 close $fd_rc
170 }
171 foreach name [array names default_config] {
173 if {[catch {set v $global_config($name)}]} {
174 set global_config($name) $default_config($name)
175 }
176 if {[catch {set v $repo_config($name)}]} {
177 set repo_config($name) $default_config($name)
178 }
179 }
180}
181proc save_config {} {
183 global default_config font_descs
184 global repo_config global_config
185 global repo_config_new global_config_new
186 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)
199 }
200 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
209 }
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
214 }
215 }
216 }
217 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
226 }
227 set repo_config($name) $value
228 }
229 }
230}
231######################################################################
233##
234## handy utils
235proc git {args} {
237 return [eval exec git $args]
238}
239proc error_popup {msg} {
241 set title [appname]
242 if {[reponame] ne {}} {
243 append title " ([reponame])"
244 }
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 .
252 }
253 eval $cmd
254}
255proc warn_popup {msg} {
257 set title [appname]
258 if {[reponame] ne {}} {
259 append title " ([reponame])"
260 }
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 .
268 }
269 eval $cmd
270}
271proc info_popup {msg {parent .}} {
273 set title [appname]
274 if {[reponame] ne {}} {
275 append title " ([reponame])"
276 }
277 tk_messageBox \
278 -parent $parent \
279 -icon info \
280 -type ok \
281 -title $title \
282 -message $msg
283}
284proc ask_popup {msg} {
286 set title [appname]
287 if {[reponame] ne {}} {
288 append title " ([reponame])"
289 }
290 return [tk_messageBox \
291 -parent . \
292 -icon question \
293 -type yesno \
294 -title $title \
295 -message $msg]
296}
297######################################################################
299##
300## repository setup
301if { [catch {set _gitdir $env(GIT_DIR)}]
303 && [catch {set _gitdir [git rev-parse --git-dir]} err]} {
304 catch {wm withdraw .}
305 error_popup "Cannot find the git directory:\n\n$err"
306 exit 1
307}
308if {![file isdirectory $_gitdir] && [is_Cygwin]} {
309 catch {set _gitdir [exec cygpath --unix $_gitdir]}
310}
311if {![file isdirectory $_gitdir]} {
312 catch {wm withdraw .}
313 error_popup "Git directory not found:\n\n$_gitdir"
314 exit 1
315}
316if {[lindex [file split $_gitdir] end] ne {.git}} {
317 catch {wm withdraw .}
318 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
319 exit 1
320}
321if {[catch {cd [file dirname $_gitdir]} err]} {
322 catch {wm withdraw .}
323 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
324 exit 1
325}
326set _reponame [lindex [file split \
327 [file normalize [file dirname $_gitdir]]] \
328 end]
329######################################################################
331##
332## task management
333set rescan_active 0
335set diff_active 0
336set last_clicked {}
337set disable_on_lock [list]
339set index_lock_type none
340proc lock_index {type} {
342 global index_lock_type disable_on_lock
343 if {$index_lock_type eq {none}} {
345 set index_lock_type $type
346 foreach w $disable_on_lock {
347 uplevel #0 $w disabled
348 }
349 return 1
350 } elseif {$index_lock_type eq "begin-$type"} {
351 set index_lock_type $type
352 return 1
353 }
354 return 0
355}
356proc unlock_index {} {
358 global index_lock_type disable_on_lock
359 set index_lock_type none
361 foreach w $disable_on_lock {
362 uplevel #0 $w normal
363 }
364}
365######################################################################
367##
368## status
369proc repository_state {ctvar hdvar mhvar} {
371 global current_branch
372 upvar $ctvar ct $hdvar hd $mhvar mh
373 set mh [list]
375 if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
377 set current_branch {}
378 } else {
379 regsub ^refs/((heads|tags|remotes)/)? \
380 $current_branch \
381 {} \
382 current_branch
383 }
384 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
386 set hd {}
387 set ct initial
388 return
389 }
390 set merge_head [gitdir MERGE_HEAD]
392 if {[file exists $merge_head]} {
393 set ct merge
394 set fd_mh [open $merge_head r]
395 while {[gets $fd_mh line] >= 0} {
396 lappend mh $line
397 }
398 close $fd_mh
399 return
400 }
401 set ct normal
403}
404proc PARENT {} {
406 global PARENT empty_tree
407 set p [lindex $PARENT 0]
409 if {$p ne {}} {
410 return $p
411 }
412 if {$empty_tree eq {}} {
413 set empty_tree [git mktree << {}]
414 }
415 return $empty_tree
416}
417proc rescan {after {honor_trustmtime 1}} {
419 global HEAD PARENT MERGE_HEAD commit_type
420 global ui_index ui_workdir ui_status_value ui_comm
421 global rescan_active file_states
422 global repo_config
423 if {$rescan_active > 0 || ![lock_index read]} return
425 repository_state newType newHEAD newMERGE_HEAD
427 if {[string match amend* $commit_type]
428 && $newType eq {normal}
429 && $newHEAD eq $HEAD} {
430 } else {
431 set HEAD $newHEAD
432 set PARENT $newHEAD
433 set MERGE_HEAD $newMERGE_HEAD
434 set commit_type $newType
435 }
436 array unset file_states
438 if {![$ui_comm edit modified]
440 || [string trim [$ui_comm get 0.0 end]] eq {}} {
441 if {[load_message GITGUI_MSG]} {
442 } elseif {[load_message MERGE_MSG]} {
443 } elseif {[load_message SQUASH_MSG]} {
444 }
445 $ui_comm edit reset
446 $ui_comm edit modified false
447 }
448 if {[is_enabled branch]} {
450 load_all_heads
451 populate_branch_menu
452 }
453 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
455 rescan_stage2 {} $after
456 } else {
457 set rescan_active 1
458 set ui_status_value {Refreshing file status...}
459 set cmd [list git update-index]
460 lappend cmd -q
461 lappend cmd --unmerged
462 lappend cmd --ignore-missing
463 lappend cmd --refresh
464 set fd_rf [open "| $cmd" r]
465 fconfigure $fd_rf -blocking 0 -translation binary
466 fileevent $fd_rf readable \
467 [list rescan_stage2 $fd_rf $after]
468 }
469}
470proc rescan_stage2 {fd after} {
472 global ui_status_value
473 global rescan_active buf_rdi buf_rdf buf_rlo
474 if {$fd ne {}} {
476 read $fd
477 if {![eof $fd]} return
478 close $fd
479 }
480 set ls_others [list | git ls-files --others -z \
482 --exclude-per-directory=.gitignore]
483 set info_exclude [gitdir info exclude]
484 if {[file readable $info_exclude]} {
485 lappend ls_others "--exclude-from=$info_exclude"
486 }
487 set buf_rdi {}
489 set buf_rdf {}
490 set buf_rlo {}
491 set rescan_active 3
493 set ui_status_value {Scanning for modified files ...}
494 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
495 set fd_df [open "| git diff-files -z" r]
496 set fd_lo [open $ls_others r]
497 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
499 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
500 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
501 fileevent $fd_di readable [list read_diff_index $fd_di $after]
502 fileevent $fd_df readable [list read_diff_files $fd_df $after]
503 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
504}
505proc load_message {file} {
507 global ui_comm
508 set f [gitdir $file]
510 if {[file isfile $f]} {
511 if {[catch {set fd [open $f r]}]} {
512 return 0
513 }
514 set content [string trim [read $fd]]
515 close $fd
516 regsub -all -line {[ \r\t]+$} $content {} content
517 $ui_comm delete 0.0 end
518 $ui_comm insert end $content
519 return 1
520 }
521 return 0
522}
523proc read_diff_index {fd after} {
525 global buf_rdi
526 append buf_rdi [read $fd]
528 set c 0
529 set n [string length $buf_rdi]
530 while {$c < $n} {
531 set z1 [string first "\0" $buf_rdi $c]
532 if {$z1 == -1} break
533 incr z1
534 set z2 [string first "\0" $buf_rdi $z1]
535 if {$z2 == -1} break
536 incr c
538 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
539 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
540 merge_state \
541 [encoding convertfrom $p] \
542 [lindex $i 4]? \
543 [list [lindex $i 0] [lindex $i 2]] \
544 [list]
545 set c $z2
546 incr c
547 }
548 if {$c < $n} {
549 set buf_rdi [string range $buf_rdi $c end]
550 } else {
551 set buf_rdi {}
552 }
553 rescan_done $fd buf_rdi $after
555}
556proc read_diff_files {fd after} {
558 global buf_rdf
559 append buf_rdf [read $fd]
561 set c 0
562 set n [string length $buf_rdf]
563 while {$c < $n} {
564 set z1 [string first "\0" $buf_rdf $c]
565 if {$z1 == -1} break
566 incr z1
567 set z2 [string first "\0" $buf_rdf $z1]
568 if {$z2 == -1} break
569 incr c
571 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
572 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
573 merge_state \
574 [encoding convertfrom $p] \
575 ?[lindex $i 4] \
576 [list] \
577 [list [lindex $i 0] [lindex $i 2]]
578 set c $z2
579 incr c
580 }
581 if {$c < $n} {
582 set buf_rdf [string range $buf_rdf $c end]
583 } else {
584 set buf_rdf {}
585 }
586 rescan_done $fd buf_rdf $after
588}
589proc read_ls_others {fd after} {
591 global buf_rlo
592 append buf_rlo [read $fd]
594 set pck [split $buf_rlo "\0"]
595 set buf_rlo [lindex $pck end]
596 foreach p [lrange $pck 0 end-1] {
597 merge_state [encoding convertfrom $p] ?O
598 }
599 rescan_done $fd buf_rlo $after
600}
601proc rescan_done {fd buf after} {
603 global rescan_active
604 global file_states repo_config
605 upvar $buf to_clear
606 if {![eof $fd]} return
608 set to_clear {}
609 close $fd
610 if {[incr rescan_active -1] > 0} return
611 prune_selection
613 unlock_index
614 display_all_files
615 reshow_diff
616 uplevel #0 $after
617}
618proc prune_selection {} {
620 global file_states selected_paths
621 foreach path [array names selected_paths] {
623 if {[catch {set still_here $file_states($path)}]} {
624 unset selected_paths($path)
625 }
626 }
627}
628######################################################################
630##
631## diff
632proc clear_diff {} {
634 global ui_diff current_diff_path current_diff_header
635 global ui_index ui_workdir
636 $ui_diff conf -state normal
638 $ui_diff delete 0.0 end
639 $ui_diff conf -state disabled
640 set current_diff_path {}
642 set current_diff_header {}
643 $ui_index tag remove in_diff 0.0 end
645 $ui_workdir tag remove in_diff 0.0 end
646}
647proc reshow_diff {} {
649 global ui_status_value file_states file_lists
650 global current_diff_path current_diff_side
651 set p $current_diff_path
653 if {$p eq {}
654 || $current_diff_side eq {}
655 || [catch {set s $file_states($p)}]
656 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
657 clear_diff
658 } else {
659 show_diff $p $current_diff_side
660 }
661}
662proc handle_empty_diff {} {
664 global current_diff_path file_states file_lists
665 set path $current_diff_path
667 set s $file_states($path)
668 if {[lindex $s 0] ne {_M}} return
669 info_popup "No differences detected.
671[short_path $path] has no changes.
673The modification date of this file was updated
675by another application, but the content within
676the file was not changed.
677A rescan will be automatically started to find
679other files which may have the same state."
680 clear_diff
682 display_file $path __
683 rescan {set ui_status_value {Ready.}} 0
684}
685proc show_diff {path w {lno {}}} {
687 global file_states file_lists
688 global is_3way_diff diff_active repo_config
689 global ui_diff ui_status_value ui_index ui_workdir
690 global current_diff_path current_diff_side current_diff_header
691 if {$diff_active || ![lock_index read]} return
693 clear_diff
695 if {$lno == {}} {
696 set lno [lsearch -sorted -exact $file_lists($w) $path]
697 if {$lno >= 0} {
698 incr lno
699 }
700 }
701 if {$lno >= 1} {
702 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
703 }
704 set s $file_states($path)
706 set m [lindex $s 0]
707 set is_3way_diff 0
708 set diff_active 1
709 set current_diff_path $path
710 set current_diff_side $w
711 set current_diff_header {}
712 set ui_status_value "Loading diff of [escape_path $path]..."
713 # - Git won't give us the diff, there's nothing to compare to!
715 #
716 if {$m eq {_O}} {
717 set max_sz [expr {128 * 1024}]
718 if {[catch {
719 set fd [open $path r]
720 set content [read $fd $max_sz]
721 close $fd
722 set sz [file size $path]
723 } err ]} {
724 set diff_active 0
725 unlock_index
726 set ui_status_value "Unable to display [escape_path $path]"
727 error_popup "Error loading file:\n\n$err"
728 return
729 }
730 $ui_diff conf -state normal
731 if {![catch {set type [exec file $path]}]} {
732 set n [string length $path]
733 if {[string equal -length $n $path $type]} {
734 set type [string range $type $n end]
735 regsub {^:?\s*} $type {} type
736 }
737 $ui_diff insert end "* $type\n" d_@
738 }
739 if {[string first "\0" $content] != -1} {
740 $ui_diff insert end \
741 "* Binary file (not showing content)." \
742 d_@
743 } else {
744 if {$sz > $max_sz} {
745 $ui_diff insert end \
746"* Untracked file is $sz bytes.
747* Showing only first $max_sz bytes.
748" d_@
749 }
750 $ui_diff insert end $content
751 if {$sz > $max_sz} {
752 $ui_diff insert end "
753* Untracked file clipped here by [appname].
754* To see the entire file, use an external editor.
755" d_@
756 }
757 }
758 $ui_diff conf -state disabled
759 set diff_active 0
760 unlock_index
761 set ui_status_value {Ready.}
762 return
763 }
764 set cmd [list | git]
766 if {$w eq $ui_index} {
767 lappend cmd diff-index
768 lappend cmd --cached
769 } elseif {$w eq $ui_workdir} {
770 if {[string index $m 0] eq {U}} {
771 lappend cmd diff
772 } else {
773 lappend cmd diff-files
774 }
775 }
776 lappend cmd -p
778 lappend cmd --no-color
779 if {$repo_config(gui.diffcontext) > 0} {
780 lappend cmd "-U$repo_config(gui.diffcontext)"
781 }
782 if {$w eq $ui_index} {
783 lappend cmd [PARENT]
784 }
785 lappend cmd --
786 lappend cmd $path
787 if {[catch {set fd [open $cmd r]} err]} {
789 set diff_active 0
790 unlock_index
791 set ui_status_value "Unable to display [escape_path $path]"
792 error_popup "Error loading diff:\n\n$err"
793 return
794 }
795 fconfigure $fd \
797 -blocking 0 \
798 -encoding binary \
799 -translation binary
800 fileevent $fd readable [list read_diff $fd]
801}
802proc read_diff {fd} {
804 global ui_diff ui_status_value diff_active
805 global is_3way_diff current_diff_header
806 $ui_diff conf -state normal
808 while {[gets $fd line] >= 0} {
809 # -- Cleanup uninteresting diff header lines.
810 #
811 if { [string match {diff --git *} $line]
812 || [string match {diff --cc *} $line]
813 || [string match {diff --combined *} $line]
814 || [string match {--- *} $line]
815 || [string match {+++ *} $line]} {
816 append current_diff_header $line "\n"
817 continue
818 }
819 if {[string match {index *} $line]} continue
820 if {$line eq {deleted file mode 120000}} {
821 set line "deleted symlink"
822 }
823 # -- Automatically detect if this is a 3 way diff.
825 #
826 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
827 if {[string match {mode *} $line]
829 || [string match {new file *} $line]
830 || [string match {deleted file *} $line]
831 || [string match {Binary files * and * differ} $line]
832 || $line eq {\ No newline at end of file}
833 || [regexp {^\* Unmerged path } $line]} {
834 set tags {}
835 } elseif {$is_3way_diff} {
836 set op [string range $line 0 1]
837 switch -- $op {
838 { } {set tags {}}
839 {@@} {set tags d_@}
840 { +} {set tags d_s+}
841 { -} {set tags d_s-}
842 {+ } {set tags d_+s}
843 {- } {set tags d_-s}
844 {--} {set tags d_--}
845 {++} {
846 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
847 set line [string replace $line 0 1 { }]
848 set tags d$op
849 } else {
850 set tags d_++
851 }
852 }
853 default {
854 puts "error: Unhandled 3 way diff marker: {$op}"
855 set tags {}
856 }
857 }
858 } else {
859 set op [string index $line 0]
860 switch -- $op {
861 { } {set tags {}}
862 {@} {set tags d_@}
863 {-} {set tags d_-}
864 {+} {
865 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
866 set line [string replace $line 0 0 { }]
867 set tags d$op
868 } else {
869 set tags d_+
870 }
871 }
872 default {
873 puts "error: Unhandled 2 way diff marker: {$op}"
874 set tags {}
875 }
876 }
877 }
878 $ui_diff insert end $line $tags
879 if {[string index $line end] eq "\r"} {
880 $ui_diff tag add d_cr {end - 2c}
881 }
882 $ui_diff insert end "\n" $tags
883 }
884 $ui_diff conf -state disabled
885 if {[eof $fd]} {
887 close $fd
888 set diff_active 0
889 unlock_index
890 set ui_status_value {Ready.}
891 if {[$ui_diff index end] eq {2.0}} {
893 handle_empty_diff
894 }
895 }
896}
897proc apply_hunk {x y} {
899 global current_diff_path current_diff_header current_diff_side
900 global ui_diff ui_index file_states
901 if {$current_diff_path eq {} || $current_diff_header eq {}} return
903 if {![lock_index apply_hunk]} return
904 set apply_cmd {git apply --cached --whitespace=nowarn}
906 set mi [lindex $file_states($current_diff_path) 0]
907 if {$current_diff_side eq $ui_index} {
908 set mode unstage
909 lappend apply_cmd --reverse
910 if {[string index $mi 0] ne {M}} {
911 unlock_index
912 return
913 }
914 } else {
915 set mode stage
916 if {[string index $mi 1] ne {M}} {
917 unlock_index
918 return
919 }
920 }
921 set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
923 set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
924 if {$s_lno eq {}} {
925 unlock_index
926 return
927 }
928 set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
930 if {$e_lno eq {}} {
931 set e_lno end
932 }
933 if {[catch {
935 set p [open "| $apply_cmd" w]
936 fconfigure $p -translation binary -encoding binary
937 puts -nonewline $p $current_diff_header
938 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
939 close $p} err]} {
940 error_popup "Failed to $mode selected hunk.\n\n$err"
941 unlock_index
942 return
943 }
944 $ui_diff conf -state normal
946 $ui_diff delete $s_lno $e_lno
947 $ui_diff conf -state disabled
948 if {[$ui_diff get 1.0 end] eq "\n"} {
950 set o _
951 } else {
952 set o ?
953 }
954 if {$current_diff_side eq $ui_index} {
956 set mi ${o}M
957 } elseif {[string index $mi 0] eq {_}} {
958 set mi M$o
959 } else {
960 set mi ?$o
961 }
962 unlock_index
963 display_file $current_diff_path $mi
964 if {$o eq {_}} {
965 clear_diff
966 }
967}
968######################################################################
970##
971## commit
972proc load_last_commit {} {
974 global HEAD PARENT MERGE_HEAD commit_type ui_comm
975 global repo_config
976 if {[llength $PARENT] == 0} {
978 error_popup {There is nothing to amend.
979You are about to create the initial commit.
981There is no commit before this to amend.
982}
983 return
984 }
985 repository_state curType curHEAD curMERGE_HEAD
987 if {$curType eq {merge}} {
988 error_popup {Cannot amend while merging.
989You are currently in the middle of a merge that
991has not been fully completed. You cannot amend
992the prior commit unless you first abort the
993current merge activity.
994}
995 return
996 }
997 set msg {}
999 set parents [list]
1000 if {[catch {
1001 set fd [open "| git cat-file commit $curHEAD" r]
1002 fconfigure $fd -encoding binary -translation lf
1003 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1004 set enc utf-8
1005 }
1006 while {[gets $fd line] > 0} {
1007 if {[string match {parent *} $line]} {
1008 lappend parents [string range $line 7 end]
1009 } elseif {[string match {encoding *} $line]} {
1010 set enc [string tolower [string range $line 9 end]]
1011 }
1012 }
1013 fconfigure $fd -encoding $enc
1014 set msg [string trim [read $fd]]
1015 close $fd
1016 } err]} {
1017 error_popup "Error loading commit data for amend:\n\n$err"
1018 return
1019 }
1020 set HEAD $curHEAD
1022 set PARENT $parents
1023 set MERGE_HEAD [list]
1024 switch -- [llength $parents] {
1025 0 {set commit_type amend-initial}
1026 1 {set commit_type amend}
1027 default {set commit_type amend-merge}
1028 }
1029 $ui_comm delete 0.0 end
1031 $ui_comm insert end $msg
1032 $ui_comm edit reset
1033 $ui_comm edit modified false
1034 rescan {set ui_status_value {Ready.}}
1035}
1036proc create_new_commit {} {
1038 global commit_type ui_comm
1039 set commit_type normal
1041 $ui_comm delete 0.0 end
1042 $ui_comm edit reset
1043 $ui_comm edit modified false
1044 rescan {set ui_status_value {Ready.}}
1045}
1046set GIT_COMMITTER_IDENT {}
1048proc committer_ident {} {
1050 global GIT_COMMITTER_IDENT
1051 if {$GIT_COMMITTER_IDENT eq {}} {
1053 if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
1054 error_popup "Unable to obtain your identity:\n\n$err"
1055 return {}
1056 }
1057 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1058 $me me GIT_COMMITTER_IDENT]} {
1059 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1060 return {}
1061 }
1062 }
1063 return $GIT_COMMITTER_IDENT
1065}
1066proc commit_tree {} {
1068 global HEAD commit_type file_states ui_comm repo_config
1069 global ui_status_value pch_error
1070 if {[committer_ident] eq {}} return
1072 if {![lock_index update]} return
1073 # -- Our in memory state should match the repository.
1075 #
1076 repository_state curType curHEAD curMERGE_HEAD
1077 if {[string match amend* $commit_type]
1078 && $curType eq {normal}
1079 && $curHEAD eq $HEAD} {
1080 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1081 info_popup {Last scanned state does not match repository state.
1082Another Git program has modified this repository
1084since the last scan. A rescan must be performed
1085before another commit can be created.
1086The rescan will be automatically started now.
1088}
1089 unlock_index
1090 rescan {set ui_status_value {Ready.}}
1091 return
1092 }
1093 # -- At least one file should differ in the index.
1095 #
1096 set files_ready 0
1097 foreach path [array names file_states] {
1098 switch -glob -- [lindex $file_states($path) 0] {
1099 _? {continue}
1100 A? -
1101 D? -
1102 M? {set files_ready 1}
1103 U? {
1104 error_popup "Unmerged files cannot be committed.
1105File [short_path $path] has merge conflicts.
1107You must resolve them and add the file before committing.
1108"
1109 unlock_index
1110 return
1111 }
1112 default {
1113 error_popup "Unknown file state [lindex $s 0] detected.
1114File [short_path $path] cannot be committed by this program.
1116"
1117 }
1118 }
1119 }
1120 if {!$files_ready} {
1121 info_popup {No changes to commit.
1122You must add at least 1 file before you can commit.
1124}
1125 unlock_index
1126 return
1127 }
1128 # -- A message is required.
1130 #
1131 set msg [string trim [$ui_comm get 1.0 end]]
1132 regsub -all -line {[ \t\r]+$} $msg {} msg
1133 if {$msg eq {}} {
1134 error_popup {Please supply a commit message.
1135A good commit message has the following format:
1137- First line: Describe in one sentance what you did.
1139- Second line: Blank
1140- Remaining lines: Describe why this change is good.
1141}
1142 unlock_index
1143 return
1144 }
1145 # -- Run the pre-commit hook.
1147 #
1148 set pchook [gitdir hooks pre-commit]
1149 # On Cygwin [file executable] might lie so we need to ask
1151 # the shell if the hook is executable. Yes that's annoying.
1152 #
1153 if {[is_Cygwin] && [file isfile $pchook]} {
1154 set pchook [list sh -c [concat \
1155 "if test -x \"$pchook\";" \
1156 "then exec \"$pchook\" 2>&1;" \
1157 "fi"]]
1158 } elseif {[file executable $pchook]} {
1159 set pchook [list $pchook |& cat]
1160 } else {
1161 commit_writetree $curHEAD $msg
1162 return
1163 }
1164 set ui_status_value {Calling pre-commit hook...}
1166 set pch_error {}
1167 set fd_ph [open "| $pchook" r]
1168 fconfigure $fd_ph -blocking 0 -translation binary
1169 fileevent $fd_ph readable \
1170 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1171}
1172proc commit_prehook_wait {fd_ph curHEAD msg} {
1174 global pch_error ui_status_value
1175 append pch_error [read $fd_ph]
1177 fconfigure $fd_ph -blocking 1
1178 if {[eof $fd_ph]} {
1179 if {[catch {close $fd_ph}]} {
1180 set ui_status_value {Commit declined by pre-commit hook.}
1181 hook_failed_popup pre-commit $pch_error
1182 unlock_index
1183 } else {
1184 commit_writetree $curHEAD $msg
1185 }
1186 set pch_error {}
1187 return
1188 }
1189 fconfigure $fd_ph -blocking 0
1190}
1191proc commit_writetree {curHEAD msg} {
1193 global ui_status_value
1194 set ui_status_value {Committing changes...}
1196 set fd_wt [open "| git write-tree" r]
1197 fileevent $fd_wt readable \
1198 [list commit_committree $fd_wt $curHEAD $msg]
1199}
1200proc commit_committree {fd_wt curHEAD msg} {
1202 global HEAD PARENT MERGE_HEAD commit_type
1203 global all_heads current_branch
1204 global ui_status_value ui_comm selected_commit_type
1205 global file_states selected_paths rescan_active
1206 global repo_config
1207 gets $fd_wt tree_id
1209 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1210 error_popup "write-tree failed:\n\n$err"
1211 set ui_status_value {Commit failed.}
1212 unlock_index
1213 return
1214 }
1215 # -- Build the message.
1217 #
1218 set msg_p [gitdir COMMIT_EDITMSG]
1219 set msg_wt [open $msg_p w]
1220 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1221 set enc utf-8
1222 }
1223 fconfigure $msg_wt -encoding $enc -translation binary
1224 puts -nonewline $msg_wt $msg
1225 close $msg_wt
1226 # -- Create the commit.
1228 #
1229 set cmd [list git commit-tree $tree_id]
1230 set parents [concat $PARENT $MERGE_HEAD]
1231 if {[llength $parents] > 0} {
1232 foreach p $parents {
1233 lappend cmd -p $p
1234 }
1235 } else {
1236 # git commit-tree writes to stderr during initial commit.
1237 lappend cmd 2>/dev/null
1238 }
1239 lappend cmd <$msg_p
1240 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1241 error_popup "commit-tree failed:\n\n$err"
1242 set ui_status_value {Commit failed.}
1243 unlock_index
1244 return
1245 }
1246 # -- Update the HEAD ref.
1248 #
1249 set reflogm commit
1250 if {$commit_type ne {normal}} {
1251 append reflogm " ($commit_type)"
1252 }
1253 set i [string first "\n" $msg]
1254 if {$i >= 0} {
1255 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1256 } else {
1257 append reflogm {: } $msg
1258 }
1259 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1260 if {[catch {eval exec $cmd} err]} {
1261 error_popup "update-ref failed:\n\n$err"
1262 set ui_status_value {Commit failed.}
1263 unlock_index
1264 return
1265 }
1266 # -- Make sure our current branch exists.
1268 #
1269 if {$commit_type eq {initial}} {
1270 lappend all_heads $current_branch
1271 set all_heads [lsort -unique $all_heads]
1272 populate_branch_menu
1273 }
1274 # -- Cleanup after ourselves.
1276 #
1277 catch {file delete $msg_p}
1278 catch {file delete [gitdir MERGE_HEAD]}
1279 catch {file delete [gitdir MERGE_MSG]}
1280 catch {file delete [gitdir SQUASH_MSG]}
1281 catch {file delete [gitdir GITGUI_MSG]}
1282 # -- Let rerere do its thing.
1284 #
1285 if {[file isdirectory [gitdir rr-cache]]} {
1286 catch {git rerere}
1287 }
1288 # -- Run the post-commit hook.
1290 #
1291 set pchook [gitdir hooks post-commit]
1292 if {[is_Cygwin] && [file isfile $pchook]} {
1293 set pchook [list sh -c [concat \
1294 "if test -x \"$pchook\";" \
1295 "then exec \"$pchook\";" \
1296 "fi"]]
1297 } elseif {![file executable $pchook]} {
1298 set pchook {}
1299 }
1300 if {$pchook ne {}} {
1301 catch {exec $pchook &}
1302 }
1303 $ui_comm delete 0.0 end
1305 $ui_comm edit reset
1306 $ui_comm edit modified false
1307 if {[is_enabled singlecommit]} do_quit
1309 # -- Update in memory status
1311 #
1312 set selected_commit_type new
1313 set commit_type normal
1314 set HEAD $cmt_id
1315 set PARENT $cmt_id
1316 set MERGE_HEAD [list]
1317 foreach path [array names file_states] {
1319 set s $file_states($path)
1320 set m [lindex $s 0]
1321 switch -glob -- $m {
1322 _O -
1323 _M -
1324 _D {continue}
1325 __ -
1326 A_ -
1327 M_ -
1328 D_ {
1329 unset file_states($path)
1330 catch {unset selected_paths($path)}
1331 }
1332 DO {
1333 set file_states($path) [list _O [lindex $s 1] {} {}]
1334 }
1335 AM -
1336 AD -
1337 MM -
1338 MD {
1339 set file_states($path) [list \
1340 _[string index $m 1] \
1341 [lindex $s 1] \
1342 [lindex $s 3] \
1343 {}]
1344 }
1345 }
1346 }
1347 display_all_files
1349 unlock_index
1350 reshow_diff
1351 set ui_status_value \
1352 "Changes committed as [string range $cmt_id 0 7]."
1353}
1354######################################################################
1356##
1357## fetch push
1358proc fetch_from {remote} {
1360 set w [new_console \
1361 "fetch $remote" \
1362 "Fetching new changes from $remote"]
1363 set cmd [list git fetch]
1364 lappend cmd $remote
1365 console_exec $w $cmd console_done
1366}
1367proc push_to {remote} {
1369 set w [new_console \
1370 "push $remote" \
1371 "Pushing changes to $remote"]
1372 set cmd [list git push]
1373 lappend cmd -v
1374 lappend cmd $remote
1375 console_exec $w $cmd console_done
1376}
1377######################################################################
1379##
1380## ui helpers
1381proc mapicon {w state path} {
1383 global all_icons
1384 if {[catch {set r $all_icons($state$w)}]} {
1386 puts "error: no icon for $w state={$state} $path"
1387 return file_plain
1388 }
1389 return $r
1390}
1391proc mapdesc {state path} {
1393 global all_descs
1394 if {[catch {set r $all_descs($state)}]} {
1396 puts "error: no desc for state={$state} $path"
1397 return $state
1398 }
1399 return $r
1400}
1401proc escape_path {path} {
1403 regsub -all {\\} $path "\\\\" path
1404 regsub -all "\n" $path "\\n" path
1405 return $path
1406}
1407proc short_path {path} {
1409 return [escape_path [lindex [file split $path] end]]
1410}
1411set next_icon_id 0
1413set null_sha1 [string repeat 0 40]
1414proc merge_state {path new_state {head_info {}} {index_info {}}} {
1416 global file_states next_icon_id null_sha1
1417 set s0 [string index $new_state 0]
1419 set s1 [string index $new_state 1]
1420 if {[catch {set info $file_states($path)}]} {
1422 set state __
1423 set icon n[incr next_icon_id]
1424 } else {
1425 set state [lindex $info 0]
1426 set icon [lindex $info 1]
1427 if {$head_info eq {}} {set head_info [lindex $info 2]}
1428 if {$index_info eq {}} {set index_info [lindex $info 3]}
1429 }
1430 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1432 elseif {$s0 eq {_}} {set s0 _}
1433 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1435 elseif {$s1 eq {_}} {set s1 _}
1436 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1438 set head_info [list 0 $null_sha1]
1439 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1440 && $head_info eq {}} {
1441 set head_info $index_info
1442 }
1443 set file_states($path) [list $s0$s1 $icon \
1445 $head_info $index_info \
1446 ]
1447 return $state
1448}
1449proc display_file_helper {w path icon_name old_m new_m} {
1451 global file_lists
1452 if {$new_m eq {_}} {
1454 set lno [lsearch -sorted -exact $file_lists($w) $path]
1455 if {$lno >= 0} {
1456 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1457 incr lno
1458 $w conf -state normal
1459 $w delete $lno.0 [expr {$lno + 1}].0
1460 $w conf -state disabled
1461 }
1462 } elseif {$old_m eq {_} && $new_m ne {_}} {
1463 lappend file_lists($w) $path
1464 set file_lists($w) [lsort -unique $file_lists($w)]
1465 set lno [lsearch -sorted -exact $file_lists($w) $path]
1466 incr lno
1467 $w conf -state normal
1468 $w image create $lno.0 \
1469 -align center -padx 5 -pady 1 \
1470 -name $icon_name \
1471 -image [mapicon $w $new_m $path]
1472 $w insert $lno.1 "[escape_path $path]\n"
1473 $w conf -state disabled
1474 } elseif {$old_m ne $new_m} {
1475 $w conf -state normal
1476 $w image conf $icon_name -image [mapicon $w $new_m $path]
1477 $w conf -state disabled
1478 }
1479}
1480proc display_file {path state} {
1482 global file_states selected_paths
1483 global ui_index ui_workdir
1484 set old_m [merge_state $path $state]
1486 set s $file_states($path)
1487 set new_m [lindex $s 0]
1488 set icon_name [lindex $s 1]
1489 set o [string index $old_m 0]
1491 set n [string index $new_m 0]
1492 if {$o eq {U}} {
1493 set o _
1494 }
1495 if {$n eq {U}} {
1496 set n _
1497 }
1498 display_file_helper $ui_index $path $icon_name $o $n
1499 if {[string index $old_m 0] eq {U}} {
1501 set o U
1502 } else {
1503 set o [string index $old_m 1]
1504 }
1505 if {[string index $new_m 0] eq {U}} {
1506 set n U
1507 } else {
1508 set n [string index $new_m 1]
1509 }
1510 display_file_helper $ui_workdir $path $icon_name $o $n
1511 if {$new_m eq {__}} {
1513 unset file_states($path)
1514 catch {unset selected_paths($path)}
1515 }
1516}
1517proc display_all_files_helper {w path icon_name m} {
1519 global file_lists
1520 lappend file_lists($w) $path
1522 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1523 $w image create end \
1524 -align center -padx 5 -pady 1 \
1525 -name $icon_name \
1526 -image [mapicon $w $m $path]
1527 $w insert end "[escape_path $path]\n"
1528}
1529proc display_all_files {} {
1531 global ui_index ui_workdir
1532 global file_states file_lists
1533 global last_clicked
1534 $ui_index conf -state normal
1536 $ui_workdir conf -state normal
1537 $ui_index delete 0.0 end
1539 $ui_workdir delete 0.0 end
1540 set last_clicked {}
1541 set file_lists($ui_index) [list]
1543 set file_lists($ui_workdir) [list]
1544 foreach path [lsort [array names file_states]] {
1546 set s $file_states($path)
1547 set m [lindex $s 0]
1548 set icon_name [lindex $s 1]
1549 set s [string index $m 0]
1551 if {$s ne {U} && $s ne {_}} {
1552 display_all_files_helper $ui_index $path \
1553 $icon_name $s
1554 }
1555 if {[string index $m 0] eq {U}} {
1557 set s U
1558 } else {
1559 set s [string index $m 1]
1560 }
1561 if {$s ne {_}} {
1562 display_all_files_helper $ui_workdir $path \
1563 $icon_name $s
1564 }
1565 }
1566 $ui_index conf -state disabled
1568 $ui_workdir conf -state disabled
1569}
1570proc update_indexinfo {msg pathList after} {
1572 global update_index_cp ui_status_value
1573 if {![lock_index update]} return
1575 set update_index_cp 0
1577 set pathList [lsort $pathList]
1578 set totalCnt [llength $pathList]
1579 set batch [expr {int($totalCnt * .01) + 1}]
1580 if {$batch > 25} {set batch 25}
1581 set ui_status_value [format \
1583 "$msg... %i/%i files (%.2f%%)" \
1584 $update_index_cp \
1585 $totalCnt \
1586 0.0]
1587 set fd [open "| git update-index -z --index-info" w]
1588 fconfigure $fd \
1589 -blocking 0 \
1590 -buffering full \
1591 -buffersize 512 \
1592 -encoding binary \
1593 -translation binary
1594 fileevent $fd writable [list \
1595 write_update_indexinfo \
1596 $fd \
1597 $pathList \
1598 $totalCnt \
1599 $batch \
1600 $msg \
1601 $after \
1602 ]
1603}
1604proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1606 global update_index_cp ui_status_value
1607 global file_states current_diff_path
1608 if {$update_index_cp >= $totalCnt} {
1610 close $fd
1611 unlock_index
1612 uplevel #0 $after
1613 return
1614 }
1615 for {set i $batch} \
1617 {$update_index_cp < $totalCnt && $i > 0} \
1618 {incr i -1} {
1619 set path [lindex $pathList $update_index_cp]
1620 incr update_index_cp
1621 set s $file_states($path)
1623 switch -glob -- [lindex $s 0] {
1624 A? {set new _O}
1625 M? {set new _M}
1626 D_ {set new _D}
1627 D? {set new _?}
1628 ?? {continue}
1629 }
1630 set info [lindex $s 2]
1631 if {$info eq {}} continue
1632 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1634 display_file $path $new
1635 }
1636 set ui_status_value [format \
1638 "$msg... %i/%i files (%.2f%%)" \
1639 $update_index_cp \
1640 $totalCnt \
1641 [expr {100.0 * $update_index_cp / $totalCnt}]]
1642}
1643proc update_index {msg pathList after} {
1645 global update_index_cp ui_status_value
1646 if {![lock_index update]} return
1648 set update_index_cp 0
1650 set pathList [lsort $pathList]
1651 set totalCnt [llength $pathList]
1652 set batch [expr {int($totalCnt * .01) + 1}]
1653 if {$batch > 25} {set batch 25}
1654 set ui_status_value [format \
1656 "$msg... %i/%i files (%.2f%%)" \
1657 $update_index_cp \
1658 $totalCnt \
1659 0.0]
1660 set fd [open "| git update-index --add --remove -z --stdin" w]
1661 fconfigure $fd \
1662 -blocking 0 \
1663 -buffering full \
1664 -buffersize 512 \
1665 -encoding binary \
1666 -translation binary
1667 fileevent $fd writable [list \
1668 write_update_index \
1669 $fd \
1670 $pathList \
1671 $totalCnt \
1672 $batch \
1673 $msg \
1674 $after \
1675 ]
1676}
1677proc write_update_index {fd pathList totalCnt batch msg after} {
1679 global update_index_cp ui_status_value
1680 global file_states current_diff_path
1681 if {$update_index_cp >= $totalCnt} {
1683 close $fd
1684 unlock_index
1685 uplevel #0 $after
1686 return
1687 }
1688 for {set i $batch} \
1690 {$update_index_cp < $totalCnt && $i > 0} \
1691 {incr i -1} {
1692 set path [lindex $pathList $update_index_cp]
1693 incr update_index_cp
1694 switch -glob -- [lindex $file_states($path) 0] {
1696 AD {set new __}
1697 ?D {set new D_}
1698 _O -
1699 AM {set new A_}
1700 U? {
1701 if {[file exists $path]} {
1702 set new M_
1703 } else {
1704 set new D_
1705 }
1706 }
1707 ?M {set new M_}
1708 ?? {continue}
1709 }
1710 puts -nonewline $fd "[encoding convertto $path]\0"
1711 display_file $path $new
1712 }
1713 set ui_status_value [format \
1715 "$msg... %i/%i files (%.2f%%)" \
1716 $update_index_cp \
1717 $totalCnt \
1718 [expr {100.0 * $update_index_cp / $totalCnt}]]
1719}
1720proc checkout_index {msg pathList after} {
1722 global update_index_cp ui_status_value
1723 if {![lock_index update]} return
1725 set update_index_cp 0
1727 set pathList [lsort $pathList]
1728 set totalCnt [llength $pathList]
1729 set batch [expr {int($totalCnt * .01) + 1}]
1730 if {$batch > 25} {set batch 25}
1731 set ui_status_value [format \
1733 "$msg... %i/%i files (%.2f%%)" \
1734 $update_index_cp \
1735 $totalCnt \
1736 0.0]
1737 set cmd [list git checkout-index]
1738 lappend cmd --index
1739 lappend cmd --quiet
1740 lappend cmd --force
1741 lappend cmd -z
1742 lappend cmd --stdin
1743 set fd [open "| $cmd " w]
1744 fconfigure $fd \
1745 -blocking 0 \
1746 -buffering full \
1747 -buffersize 512 \
1748 -encoding binary \
1749 -translation binary
1750 fileevent $fd writable [list \
1751 write_checkout_index \
1752 $fd \
1753 $pathList \
1754 $totalCnt \
1755 $batch \
1756 $msg \
1757 $after \
1758 ]
1759}
1760proc write_checkout_index {fd pathList totalCnt batch msg after} {
1762 global update_index_cp ui_status_value
1763 global file_states current_diff_path
1764 if {$update_index_cp >= $totalCnt} {
1766 close $fd
1767 unlock_index
1768 uplevel #0 $after
1769 return
1770 }
1771 for {set i $batch} \
1773 {$update_index_cp < $totalCnt && $i > 0} \
1774 {incr i -1} {
1775 set path [lindex $pathList $update_index_cp]
1776 incr update_index_cp
1777 switch -glob -- [lindex $file_states($path) 0] {
1778 U? {continue}
1779 ?M -
1780 ?D {
1781 puts -nonewline $fd "[encoding convertto $path]\0"
1782 display_file $path ?_
1783 }
1784 }
1785 }
1786 set ui_status_value [format \
1788 "$msg... %i/%i files (%.2f%%)" \
1789 $update_index_cp \
1790 $totalCnt \
1791 [expr {100.0 * $update_index_cp / $totalCnt}]]
1792}
1793######################################################################
1795##
1796## branch management
1797proc is_tracking_branch {name} {
1799 global tracking_branches
1800 if {![catch {set info $tracking_branches($name)}]} {
1802 return 1
1803 }
1804 foreach t [array names tracking_branches] {
1805 if {[string match {*/\*} $t] && [string match $t $name]} {
1806 return 1
1807 }
1808 }
1809 return 0
1810}
1811proc load_all_heads {} {
1813 global all_heads
1814 set all_heads [list]
1816 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1817 while {[gets $fd line] > 0} {
1818 if {[is_tracking_branch $line]} continue
1819 if {![regsub ^refs/heads/ $line {} name]} continue
1820 lappend all_heads $name
1821 }
1822 close $fd
1823 set all_heads [lsort $all_heads]
1825}
1826proc populate_branch_menu {} {
1828 global all_heads disable_on_lock
1829 set m .mbar.branch
1831 set last [$m index last]
1832 for {set i 0} {$i <= $last} {incr i} {
1833 if {[$m type $i] eq {separator}} {
1834 $m delete $i last
1835 set new_dol [list]
1836 foreach a $disable_on_lock {
1837 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1838 lappend new_dol $a
1839 }
1840 }
1841 set disable_on_lock $new_dol
1842 break
1843 }
1844 }
1845 if {$all_heads ne {}} {
1847 $m add separator
1848 }
1849 foreach b $all_heads {
1850 $m add radiobutton \
1851 -label $b \
1852 -command [list switch_branch $b] \
1853 -variable current_branch \
1854 -value $b \
1855 -font font_ui
1856 lappend disable_on_lock \
1857 [list $m entryconf [$m index last] -state]
1858 }
1859}
1860proc all_tracking_branches {} {
1862 global tracking_branches
1863 set all_trackings {}
1865 set cmd {}
1866 foreach name [array names tracking_branches] {
1867 if {[regsub {/\*$} $name {} name]} {
1868 lappend cmd $name
1869 } else {
1870 regsub ^refs/(heads|remotes)/ $name {} name
1871 lappend all_trackings $name
1872 }
1873 }
1874 if {$cmd ne {}} {
1876 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1877 while {[gets $fd name] > 0} {
1878 regsub ^refs/(heads|remotes)/ $name {} name
1879 lappend all_trackings $name
1880 }
1881 close $fd
1882 }
1883 return [lsort -unique $all_trackings]
1885}
1886proc do_create_branch_action {w} {
1888 global all_heads null_sha1 repo_config
1889 global create_branch_checkout create_branch_revtype
1890 global create_branch_head create_branch_trackinghead
1891 global create_branch_name create_branch_revexp
1892 set newbranch $create_branch_name
1894 if {$newbranch eq {}
1895 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1896 tk_messageBox \
1897 -icon error \
1898 -type ok \
1899 -title [wm title $w] \
1900 -parent $w \
1901 -message "Please supply a branch name."
1902 focus $w.desc.name_t
1903 return
1904 }
1905 if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
1906 tk_messageBox \
1907 -icon error \
1908 -type ok \
1909 -title [wm title $w] \
1910 -parent $w \
1911 -message "Branch '$newbranch' already exists."
1912 focus $w.desc.name_t
1913 return
1914 }
1915 if {[catch {git check-ref-format "heads/$newbranch"}]} {
1916 tk_messageBox \
1917 -icon error \
1918 -type ok \
1919 -title [wm title $w] \
1920 -parent $w \
1921 -message "We do not like '$newbranch' as a branch name."
1922 focus $w.desc.name_t
1923 return
1924 }
1925 set rev {}
1927 switch -- $create_branch_revtype {
1928 head {set rev $create_branch_head}
1929 tracking {set rev $create_branch_trackinghead}
1930 expression {set rev $create_branch_revexp}
1931 }
1932 if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
1933 tk_messageBox \
1934 -icon error \
1935 -type ok \
1936 -title [wm title $w] \
1937 -parent $w \
1938 -message "Invalid starting revision: $rev"
1939 return
1940 }
1941 set cmd [list git update-ref]
1942 lappend cmd -m
1943 lappend cmd "branch: Created from $rev"
1944 lappend cmd "refs/heads/$newbranch"
1945 lappend cmd $cmt
1946 lappend cmd $null_sha1
1947 if {[catch {eval exec $cmd} err]} {
1948 tk_messageBox \
1949 -icon error \
1950 -type ok \
1951 -title [wm title $w] \
1952 -parent $w \
1953 -message "Failed to create '$newbranch'.\n\n$err"
1954 return
1955 }
1956 lappend all_heads $newbranch
1958 set all_heads [lsort $all_heads]
1959 populate_branch_menu
1960 destroy $w
1961 if {$create_branch_checkout} {
1962 switch_branch $newbranch
1963 }
1964}
1965proc radio_selector {varname value args} {
1967 upvar #0 $varname var
1968 set var $value
1969}
1970trace add variable create_branch_head write \
1972 [list radio_selector create_branch_revtype head]
1973trace add variable create_branch_trackinghead write \
1974 [list radio_selector create_branch_revtype tracking]
1975trace add variable delete_branch_head write \
1977 [list radio_selector delete_branch_checktype head]
1978trace add variable delete_branch_trackinghead write \
1979 [list radio_selector delete_branch_checktype tracking]
1980proc do_create_branch {} {
1982 global all_heads current_branch repo_config
1983 global create_branch_checkout create_branch_revtype
1984 global create_branch_head create_branch_trackinghead
1985 global create_branch_name create_branch_revexp
1986 set w .branch_editor
1988 toplevel $w
1989 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1990 label $w.header -text {Create New Branch} \
1992 -font font_uibold
1993 pack $w.header -side top -fill x
1994 frame $w.buttons
1996 button $w.buttons.create -text Create \
1997 -font font_ui \
1998 -default active \
1999 -command [list do_create_branch_action $w]
2000 pack $w.buttons.create -side right
2001 button $w.buttons.cancel -text {Cancel} \
2002 -font font_ui \
2003 -command [list destroy $w]
2004 pack $w.buttons.cancel -side right -padx 5
2005 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2006 labelframe $w.desc \
2008 -text {Branch Description} \
2009 -font font_ui
2010 label $w.desc.name_l -text {Name:} -font font_ui
2011 entry $w.desc.name_t \
2012 -borderwidth 1 \
2013 -relief sunken \
2014 -width 40 \
2015 -textvariable create_branch_name \
2016 -font font_ui \
2017 -validate key \
2018 -validatecommand {
2019 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2020 return 1
2021 }
2022 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2023 grid columnconfigure $w.desc 1 -weight 1
2024 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2025 labelframe $w.from \
2027 -text {Starting Revision} \
2028 -font font_ui
2029 radiobutton $w.from.head_r \
2030 -text {Local Branch:} \
2031 -value head \
2032 -variable create_branch_revtype \
2033 -font font_ui
2034 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2035 grid $w.from.head_r $w.from.head_m -sticky w
2036 set all_trackings [all_tracking_branches]
2037 if {$all_trackings ne {}} {
2038 set create_branch_trackinghead [lindex $all_trackings 0]
2039 radiobutton $w.from.tracking_r \
2040 -text {Tracking Branch:} \
2041 -value tracking \
2042 -variable create_branch_revtype \
2043 -font font_ui
2044 eval tk_optionMenu $w.from.tracking_m \
2045 create_branch_trackinghead \
2046 $all_trackings
2047 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2048 }
2049 radiobutton $w.from.exp_r \
2050 -text {Revision Expression:} \
2051 -value expression \
2052 -variable create_branch_revtype \
2053 -font font_ui
2054 entry $w.from.exp_t \
2055 -borderwidth 1 \
2056 -relief sunken \
2057 -width 50 \
2058 -textvariable create_branch_revexp \
2059 -font font_ui \
2060 -validate key \
2061 -validatecommand {
2062 if {%d == 1 && [regexp {\s} %S]} {return 0}
2063 if {%d == 1 && [string length %S] > 0} {
2064 set create_branch_revtype expression
2065 }
2066 return 1
2067 }
2068 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2069 grid columnconfigure $w.from 1 -weight 1
2070 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2071 labelframe $w.postActions \
2073 -text {Post Creation Actions} \
2074 -font font_ui
2075 checkbutton $w.postActions.checkout \
2076 -text {Checkout after creation} \
2077 -variable create_branch_checkout \
2078 -font font_ui
2079 pack $w.postActions.checkout -anchor nw
2080 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2081 set create_branch_checkout 1
2083 set create_branch_head $current_branch
2084 set create_branch_revtype head
2085 set create_branch_name $repo_config(gui.newbranchtemplate)
2086 set create_branch_revexp {}
2087 bind $w <Visibility> "
2089 grab $w
2090 $w.desc.name_t icursor end
2091 focus $w.desc.name_t
2092 "
2093 bind $w <Key-Escape> "destroy $w"
2094 bind $w <Key-Return> "do_create_branch_action $w;break"
2095 wm title $w "[appname] ([reponame]): Create Branch"
2096 tkwait window $w
2097}
2098proc do_delete_branch_action {w} {
2100 global all_heads
2101 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2102 set check_rev {}
2104 switch -- $delete_branch_checktype {
2105 head {set check_rev $delete_branch_head}
2106 tracking {set check_rev $delete_branch_trackinghead}
2107 always {set check_rev {:none}}
2108 }
2109 if {$check_rev eq {:none}} {
2110 set check_cmt {}
2111 } elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
2112 tk_messageBox \
2113 -icon error \
2114 -type ok \
2115 -title [wm title $w] \
2116 -parent $w \
2117 -message "Invalid check revision: $check_rev"
2118 return
2119 }
2120 set to_delete [list]
2122 set not_merged [list]
2123 foreach i [$w.list.l curselection] {
2124 set b [$w.list.l get $i]
2125 if {[catch {set o [git rev-parse --verify $b]}]} continue
2126 if {$check_cmt ne {}} {
2127 if {$b eq $check_rev} continue
2128 if {[catch {set m [git merge-base $o $check_cmt]}]} continue
2129 if {$o ne $m} {
2130 lappend not_merged $b
2131 continue
2132 }
2133 }
2134 lappend to_delete [list $b $o]
2135 }
2136 if {$not_merged ne {}} {
2137 set msg "The following branches are not completely merged into $check_rev:
2138 - [join $not_merged "\n - "]"
2140 tk_messageBox \
2141 -icon info \
2142 -type ok \
2143 -title [wm title $w] \
2144 -parent $w \
2145 -message $msg
2146 }
2147 if {$to_delete eq {}} return
2148 if {$delete_branch_checktype eq {always}} {
2149 set msg {Recovering deleted branches is difficult.
2150Delete the selected branches?}
2152 if {[tk_messageBox \
2153 -icon warning \
2154 -type yesno \
2155 -title [wm title $w] \
2156 -parent $w \
2157 -message $msg] ne yes} {
2158 return
2159 }
2160 }
2161 set failed {}
2163 foreach i $to_delete {
2164 set b [lindex $i 0]
2165 set o [lindex $i 1]
2166 if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
2167 append failed " - $b: $err\n"
2168 } else {
2169 set x [lsearch -sorted -exact $all_heads $b]
2170 if {$x >= 0} {
2171 set all_heads [lreplace $all_heads $x $x]
2172 }
2173 }
2174 }
2175 if {$failed ne {}} {
2177 tk_messageBox \
2178 -icon error \
2179 -type ok \
2180 -title [wm title $w] \
2181 -parent $w \
2182 -message "Failed to delete branches:\n$failed"
2183 }
2184 set all_heads [lsort $all_heads]
2186 populate_branch_menu
2187 destroy $w
2188}
2189proc do_delete_branch {} {
2191 global all_heads tracking_branches current_branch
2192 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2193 set w .branch_editor
2195 toplevel $w
2196 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2197 label $w.header -text {Delete Local Branch} \
2199 -font font_uibold
2200 pack $w.header -side top -fill x
2201 frame $w.buttons
2203 button $w.buttons.create -text Delete \
2204 -font font_ui \
2205 -command [list do_delete_branch_action $w]
2206 pack $w.buttons.create -side right
2207 button $w.buttons.cancel -text {Cancel} \
2208 -font font_ui \
2209 -command [list destroy $w]
2210 pack $w.buttons.cancel -side right -padx 5
2211 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2212 labelframe $w.list \
2214 -text {Local Branches} \
2215 -font font_ui
2216 listbox $w.list.l \
2217 -height 10 \
2218 -width 70 \
2219 -selectmode extended \
2220 -yscrollcommand [list $w.list.sby set] \
2221 -font font_ui
2222 foreach h $all_heads {
2223 if {$h ne $current_branch} {
2224 $w.list.l insert end $h
2225 }
2226 }
2227 scrollbar $w.list.sby -command [list $w.list.l yview]
2228 pack $w.list.sby -side right -fill y
2229 pack $w.list.l -side left -fill both -expand 1
2230 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2231 labelframe $w.validate \
2233 -text {Delete Only If} \
2234 -font font_ui
2235 radiobutton $w.validate.head_r \
2236 -text {Merged Into Local Branch:} \
2237 -value head \
2238 -variable delete_branch_checktype \
2239 -font font_ui
2240 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2241 grid $w.validate.head_r $w.validate.head_m -sticky w
2242 set all_trackings [all_tracking_branches]
2243 if {$all_trackings ne {}} {
2244 set delete_branch_trackinghead [lindex $all_trackings 0]
2245 radiobutton $w.validate.tracking_r \
2246 -text {Merged Into Tracking Branch:} \
2247 -value tracking \
2248 -variable delete_branch_checktype \
2249 -font font_ui
2250 eval tk_optionMenu $w.validate.tracking_m \
2251 delete_branch_trackinghead \
2252 $all_trackings
2253 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2254 }
2255 radiobutton $w.validate.always_r \
2256 -text {Always (Do not perform merge checks)} \
2257 -value always \
2258 -variable delete_branch_checktype \
2259 -font font_ui
2260 grid $w.validate.always_r -columnspan 2 -sticky w
2261 grid columnconfigure $w.validate 1 -weight 1
2262 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2263 set delete_branch_head $current_branch
2265 set delete_branch_checktype head
2266 bind $w <Visibility> "grab $w; focus $w"
2268 bind $w <Key-Escape> "destroy $w"
2269 wm title $w "[appname] ([reponame]): Delete Branch"
2270 tkwait window $w
2271}
2272proc switch_branch {new_branch} {
2274 global HEAD commit_type current_branch repo_config
2275 if {![lock_index switch]} return
2277 # -- Our in memory state should match the repository.
2279 #
2280 repository_state curType curHEAD curMERGE_HEAD
2281 if {[string match amend* $commit_type]
2282 && $curType eq {normal}
2283 && $curHEAD eq $HEAD} {
2284 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2285 info_popup {Last scanned state does not match repository state.
2286Another Git program has modified this repository
2288since the last scan. A rescan must be performed
2289before the current branch can be changed.
2290The rescan will be automatically started now.
2292}
2293 unlock_index
2294 rescan {set ui_status_value {Ready.}}
2295 return
2296 }
2297 # -- Don't do a pointless switch.
2299 #
2300 if {$current_branch eq $new_branch} {
2301 unlock_index
2302 return
2303 }
2304 if {$repo_config(gui.trustmtime) eq {true}} {
2306 switch_branch_stage2 {} $new_branch
2307 } else {
2308 set ui_status_value {Refreshing file status...}
2309 set cmd [list git update-index]
2310 lappend cmd -q
2311 lappend cmd --unmerged
2312 lappend cmd --ignore-missing
2313 lappend cmd --refresh
2314 set fd_rf [open "| $cmd" r]
2315 fconfigure $fd_rf -blocking 0 -translation binary
2316 fileevent $fd_rf readable \
2317 [list switch_branch_stage2 $fd_rf $new_branch]
2318 }
2319}
2320proc switch_branch_stage2 {fd_rf new_branch} {
2322 global ui_status_value HEAD
2323 if {$fd_rf ne {}} {
2325 read $fd_rf
2326 if {![eof $fd_rf]} return
2327 close $fd_rf
2328 }
2329 set ui_status_value "Updating working directory to '$new_branch'..."
2331 set cmd [list git read-tree]
2332 lappend cmd -m
2333 lappend cmd -u
2334 lappend cmd --exclude-per-directory=.gitignore
2335 lappend cmd $HEAD
2336 lappend cmd $new_branch
2337 set fd_rt [open "| $cmd" r]
2338 fconfigure $fd_rt -blocking 0 -translation binary
2339 fileevent $fd_rt readable \
2340 [list switch_branch_readtree_wait $fd_rt $new_branch]
2341}
2342proc switch_branch_readtree_wait {fd_rt new_branch} {
2344 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2345 global current_branch
2346 global ui_comm ui_status_value
2347 # -- We never get interesting output on stdout; only stderr.
2349 #
2350 read $fd_rt
2351 fconfigure $fd_rt -blocking 1
2352 if {![eof $fd_rt]} {
2353 fconfigure $fd_rt -blocking 0
2354 return
2355 }
2356 # -- The working directory wasn't in sync with the index and
2358 # we'd have to overwrite something to make the switch. A
2359 # merge is required.
2360 #
2361 if {[catch {close $fd_rt} err]} {
2362 regsub {^fatal: } $err {} err
2363 warn_popup "File level merge required.
2364$err
2366Staying on branch '$current_branch'."
2368 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2369 unlock_index
2370 return
2371 }
2372 # -- Update the symbolic ref. Core git doesn't even check for failure
2374 # here, it Just Works(tm). If it doesn't we are in some really ugly
2375 # state that is difficult to recover from within git-gui.
2376 #
2377 if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2378 error_popup "Failed to set current branch.
2379This working directory is only partially switched.
2381We successfully updated your files, but failed to
2382update an internal Git file.
2383This should not have occurred. [appname] will now
2385close and give up.
2386$err"
2388 do_quit
2389 return
2390 }
2391 # -- Update our repository state. If we were previously in amend mode
2393 # we need to toss the current buffer and do a full rescan to update
2394 # our file lists. If we weren't in amend mode our file lists are
2395 # accurate and we can avoid the rescan.
2396 #
2397 unlock_index
2398 set selected_commit_type new
2399 if {[string match amend* $commit_type]} {
2400 $ui_comm delete 0.0 end
2401 $ui_comm edit reset
2402 $ui_comm edit modified false
2403 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2404 } else {
2405 repository_state commit_type HEAD MERGE_HEAD
2406 set PARENT $HEAD
2407 set ui_status_value "Checked out branch '$current_branch'."
2408 }
2409}
2410######################################################################
2412##
2413## remote management
2414proc load_all_remotes {} {
2416 global repo_config
2417 global all_remotes tracking_branches
2418 set all_remotes [list]
2420 array unset tracking_branches
2421 set rm_dir [gitdir remotes]
2423 if {[file isdirectory $rm_dir]} {
2424 set all_remotes [glob \
2425 -types f \
2426 -tails \
2427 -nocomplain \
2428 -directory $rm_dir *]
2429 foreach name $all_remotes {
2431 catch {
2432 set fd [open [file join $rm_dir $name] r]
2433 while {[gets $fd line] >= 0} {
2434 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2435 $line line src dst]} continue
2436 if {![regexp ^refs/ $dst]} {
2437 set dst "refs/heads/$dst"
2438 }
2439 set tracking_branches($dst) [list $name $src]
2440 }
2441 close $fd
2442 }
2443 }
2444 }
2445 foreach line [array names repo_config remote.*.url] {
2447 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2448 lappend all_remotes $name
2449 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2451 set fl {}
2452 }
2453 foreach line $fl {
2454 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2455 if {![regexp ^refs/ $dst]} {
2456 set dst "refs/heads/$dst"
2457 }
2458 set tracking_branches($dst) [list $name $src]
2459 }
2460 }
2461 set all_remotes [lsort -unique $all_remotes]
2463}
2464proc populate_fetch_menu {} {
2466 global all_remotes repo_config
2467 set m .mbar.fetch
2469 foreach r $all_remotes {
2470 set enable 0
2471 if {![catch {set a $repo_config(remote.$r.url)}]} {
2472 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2473 set enable 1
2474 }
2475 } else {
2476 catch {
2477 set fd [open [gitdir remotes $r] r]
2478 while {[gets $fd n] >= 0} {
2479 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2480 set enable 1
2481 break
2482 }
2483 }
2484 close $fd
2485 }
2486 }
2487 if {$enable} {
2489 $m add command \
2490 -label "Fetch from $r..." \
2491 -command [list fetch_from $r] \
2492 -font font_ui
2493 }
2494 }
2495}
2496proc populate_push_menu {} {
2498 global all_remotes repo_config
2499 set m .mbar.push
2501 set fast_count 0
2502 foreach r $all_remotes {
2503 set enable 0
2504 if {![catch {set a $repo_config(remote.$r.url)}]} {
2505 if {![catch {set a $repo_config(remote.$r.push)}]} {
2506 set enable 1
2507 }
2508 } else {
2509 catch {
2510 set fd [open [gitdir remotes $r] r]
2511 while {[gets $fd n] >= 0} {
2512 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2513 set enable 1
2514 break
2515 }
2516 }
2517 close $fd
2518 }
2519 }
2520 if {$enable} {
2522 if {!$fast_count} {
2523 $m add separator
2524 }
2525 $m add command \
2526 -label "Push to $r..." \
2527 -command [list push_to $r] \
2528 -font font_ui
2529 incr fast_count
2530 }
2531 }
2532}
2533proc start_push_anywhere_action {w} {
2535 global push_urltype push_remote push_url push_thin push_tags
2536 set r_url {}
2538 switch -- $push_urltype {
2539 remote {set r_url $push_remote}
2540 url {set r_url $push_url}
2541 }
2542 if {$r_url eq {}} return
2543 set cmd [list git push]
2545 lappend cmd -v
2546 if {$push_thin} {
2547 lappend cmd --thin
2548 }
2549 if {$push_tags} {
2550 lappend cmd --tags
2551 }
2552 lappend cmd $r_url
2553 set cnt 0
2554 foreach i [$w.source.l curselection] {
2555 set b [$w.source.l get $i]
2556 lappend cmd "refs/heads/$b:refs/heads/$b"
2557 incr cnt
2558 }
2559 if {$cnt == 0} {
2560 return
2561 } elseif {$cnt == 1} {
2562 set unit branch
2563 } else {
2564 set unit branches
2565 }
2566 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2568 console_exec $cons $cmd console_done
2569 destroy $w
2570}
2571trace add variable push_remote write \
2573 [list radio_selector push_urltype remote]
2574proc do_push_anywhere {} {
2576 global all_heads all_remotes current_branch
2577 global push_urltype push_remote push_url push_thin push_tags
2578 set w .push_setup
2580 toplevel $w
2581 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2582 label $w.header -text {Push Branches} -font font_uibold
2584 pack $w.header -side top -fill x
2585 frame $w.buttons
2587 button $w.buttons.create -text Push \
2588 -font font_ui \
2589 -command [list start_push_anywhere_action $w]
2590 pack $w.buttons.create -side right
2591 button $w.buttons.cancel -text {Cancel} \
2592 -font font_ui \
2593 -command [list destroy $w]
2594 pack $w.buttons.cancel -side right -padx 5
2595 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2596 labelframe $w.source \
2598 -text {Source Branches} \
2599 -font font_ui
2600 listbox $w.source.l \
2601 -height 10 \
2602 -width 70 \
2603 -selectmode extended \
2604 -yscrollcommand [list $w.source.sby set] \
2605 -font font_ui
2606 foreach h $all_heads {
2607 $w.source.l insert end $h
2608 if {$h eq $current_branch} {
2609 $w.source.l select set end
2610 }
2611 }
2612 scrollbar $w.source.sby -command [list $w.source.l yview]
2613 pack $w.source.sby -side right -fill y
2614 pack $w.source.l -side left -fill both -expand 1
2615 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2616 labelframe $w.dest \
2618 -text {Destination Repository} \
2619 -font font_ui
2620 if {$all_remotes ne {}} {
2621 radiobutton $w.dest.remote_r \
2622 -text {Remote:} \
2623 -value remote \
2624 -variable push_urltype \
2625 -font font_ui
2626 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2627 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2628 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2629 set push_remote origin
2630 } else {
2631 set push_remote [lindex $all_remotes 0]
2632 }
2633 set push_urltype remote
2634 } else {
2635 set push_urltype url
2636 }
2637 radiobutton $w.dest.url_r \
2638 -text {Arbitrary URL:} \
2639 -value url \
2640 -variable push_urltype \
2641 -font font_ui
2642 entry $w.dest.url_t \
2643 -borderwidth 1 \
2644 -relief sunken \
2645 -width 50 \
2646 -textvariable push_url \
2647 -font font_ui \
2648 -validate key \
2649 -validatecommand {
2650 if {%d == 1 && [regexp {\s} %S]} {return 0}
2651 if {%d == 1 && [string length %S] > 0} {
2652 set push_urltype url
2653 }
2654 return 1
2655 }
2656 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2657 grid columnconfigure $w.dest 1 -weight 1
2658 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2659 labelframe $w.options \
2661 -text {Transfer Options} \
2662 -font font_ui
2663 checkbutton $w.options.thin \
2664 -text {Use thin pack (for slow network connections)} \
2665 -variable push_thin \
2666 -font font_ui
2667 grid $w.options.thin -columnspan 2 -sticky w
2668 checkbutton $w.options.tags \
2669 -text {Include tags} \
2670 -variable push_tags \
2671 -font font_ui
2672 grid $w.options.tags -columnspan 2 -sticky w
2673 grid columnconfigure $w.options 1 -weight 1
2674 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2675 set push_url {}
2677 set push_thin 0
2678 set push_tags 0
2679 bind $w <Visibility> "grab $w"
2681 bind $w <Key-Escape> "destroy $w"
2682 wm title $w "[appname] ([reponame]): Push"
2683 tkwait window $w
2684}
2685######################################################################
2687##
2688## merge
2689proc can_merge {} {
2691 global HEAD commit_type file_states
2692 if {[string match amend* $commit_type]} {
2694 info_popup {Cannot merge while amending.
2695You must finish amending this commit before
2697starting any type of merge.
2698}
2699 return 0
2700 }
2701 if {[committer_ident] eq {}} {return 0}
2703 if {![lock_index merge]} {return 0}
2704 # -- Our in memory state should match the repository.
2706 #
2707 repository_state curType curHEAD curMERGE_HEAD
2708 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2709 info_popup {Last scanned state does not match repository state.
2710Another Git program has modified this repository
2712since the last scan. A rescan must be performed
2713before a merge can be performed.
2714The rescan will be automatically started now.
2716}
2717 unlock_index
2718 rescan {set ui_status_value {Ready.}}
2719 return 0
2720 }
2721 foreach path [array names file_states] {
2723 switch -glob -- [lindex $file_states($path) 0] {
2724 _O {
2725 continue; # and pray it works!
2726 }
2727 U? {
2728 error_popup "You are in the middle of a conflicted merge.
2729File [short_path $path] has merge conflicts.
2731You must resolve them, add the file, and commit to
2733complete the current merge. Only then can you
2734begin another merge.
2735"
2736 unlock_index
2737 return 0
2738 }
2739 ?? {
2740 error_popup "You are in the middle of a change.
2741File [short_path $path] is modified.
2743You should complete the current commit before
2745starting a merge. Doing so will help you abort
2746a failed merge, should the need arise.
2747"
2748 unlock_index
2749 return 0
2750 }
2751 }
2752 }
2753 return 1
2755}
2756proc visualize_local_merge {w} {
2758 set revs {}
2759 foreach i [$w.source.l curselection] {
2760 lappend revs [$w.source.l get $i]
2761 }
2762 if {$revs eq {}} return
2763 lappend revs --not HEAD
2764 do_gitk $revs
2765}
2766proc start_local_merge_action {w} {
2768 global HEAD ui_status_value current_branch
2769 set cmd [list git merge]
2771 set names {}
2772 set revcnt 0
2773 foreach i [$w.source.l curselection] {
2774 set b [$w.source.l get $i]
2775 lappend cmd $b
2776 lappend names $b
2777 incr revcnt
2778 }
2779 if {$revcnt == 0} {
2781 return
2782 } elseif {$revcnt == 1} {
2783 set unit branch
2784 } elseif {$revcnt <= 15} {
2785 set unit branches
2786 } else {
2787 tk_messageBox \
2788 -icon error \
2789 -type ok \
2790 -title [wm title $w] \
2791 -parent $w \
2792 -message "Too many branches selected.
2793You have requested to merge $revcnt branches
2795in an octopus merge. This exceeds Git's
2796internal limit of 15 branches per merge.
2797Please select fewer branches. To merge more
2799than 15 branches, merge the branches in batches.
2800"
2801 return
2802 }
2803 set msg "Merging $current_branch, [join $names {, }]"
2805 set ui_status_value "$msg..."
2806 set cons [new_console "Merge" $msg]
2807 console_exec $cons $cmd [list finish_merge $revcnt]
2808 bind $w <Destroy> {}
2809 destroy $w
2810}
2811proc finish_merge {revcnt w ok} {
2813 console_done $w $ok
2814 if {$ok} {
2815 set msg {Merge completed successfully.}
2816 } else {
2817 if {$revcnt != 1} {
2818 info_popup "Octopus merge failed.
2819Your merge of $revcnt branches has failed.
2821There are file-level conflicts between the
2823branches which must be resolved manually.
2824The working directory will now be reset.
2826You can attempt this merge again
2828by merging only one branch at a time." $w
2829 set fd [open "| git read-tree --reset -u HEAD" r]
2831 fconfigure $fd -blocking 0 -translation binary
2832 fileevent $fd readable [list reset_hard_wait $fd]
2833 set ui_status_value {Aborting... please wait...}
2834 return
2835 }
2836 set msg {Merge failed. Conflict resolution is required.}
2838 }
2839 unlock_index
2840 rescan [list set ui_status_value $msg]
2841}
2842proc do_local_merge {} {
2844 global current_branch
2845 if {![can_merge]} return
2847 set w .merge_setup
2849 toplevel $w
2850 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2851 label $w.header \
2853 -text "Merge Into $current_branch" \
2854 -font font_uibold
2855 pack $w.header -side top -fill x
2856 frame $w.buttons
2858 button $w.buttons.visualize -text Visualize \
2859 -font font_ui \
2860 -command [list visualize_local_merge $w]
2861 pack $w.buttons.visualize -side left
2862 button $w.buttons.create -text Merge \
2863 -font font_ui \
2864 -command [list start_local_merge_action $w]
2865 pack $w.buttons.create -side right
2866 button $w.buttons.cancel -text {Cancel} \
2867 -font font_ui \
2868 -command [list destroy $w]
2869 pack $w.buttons.cancel -side right -padx 5
2870 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2871 labelframe $w.source \
2873 -text {Source Branches} \
2874 -font font_ui
2875 listbox $w.source.l \
2876 -height 10 \
2877 -width 70 \
2878 -selectmode extended \
2879 -yscrollcommand [list $w.source.sby set] \
2880 -font font_ui
2881 scrollbar $w.source.sby -command [list $w.source.l yview]
2882 pack $w.source.sby -side right -fill y
2883 pack $w.source.l -side left -fill both -expand 1
2884 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2885 set cmd [list git for-each-ref]
2887 lappend cmd {--format=%(objectname) %(refname)}
2888 lappend cmd refs/heads
2889 lappend cmd refs/remotes
2890 set fr_fd [open "| $cmd" r]
2891 fconfigure $fr_fd -translation binary
2892 while {[gets $fr_fd line] > 0} {
2893 set line [split $line { }]
2894 set sha1([lindex $line 0]) [lindex $line 1]
2895 }
2896 close $fr_fd
2897 set to_show {}
2899 set fr_fd [open "| git rev-list --all --not HEAD"]
2900 while {[gets $fr_fd line] > 0} {
2901 if {[catch {set ref $sha1($line)}]} continue
2902 regsub ^refs/(heads|remotes)/ $ref {} ref
2903 lappend to_show $ref
2904 }
2905 close $fr_fd
2906 foreach ref [lsort -unique $to_show] {
2908 $w.source.l insert end $ref
2909 }
2910 bind $w <Visibility> "grab $w"
2912 bind $w <Key-Escape> "unlock_index;destroy $w"
2913 bind $w <Destroy> unlock_index
2914 wm title $w "[appname] ([reponame]): Merge"
2915 tkwait window $w
2916}
2917proc do_reset_hard {} {
2919 global HEAD commit_type file_states
2920 if {[string match amend* $commit_type]} {
2922 info_popup {Cannot abort while amending.
2923You must finish amending this commit.
2925}
2926 return
2927 }
2928 if {![lock_index abort]} return
2930 if {[string match *merge* $commit_type]} {
2932 set op merge
2933 } else {
2934 set op commit
2935 }
2936 if {[ask_popup "Abort $op?
2938Aborting the current $op will cause
2940*ALL* uncommitted changes to be lost.
2941Continue with aborting the current $op?"] eq {yes}} {
2943 set fd [open "| git read-tree --reset -u HEAD" r]
2944 fconfigure $fd -blocking 0 -translation binary
2945 fileevent $fd readable [list reset_hard_wait $fd]
2946 set ui_status_value {Aborting... please wait...}
2947 } else {
2948 unlock_index
2949 }
2950}
2951proc reset_hard_wait {fd} {
2953 global ui_comm
2954 read $fd
2956 if {[eof $fd]} {
2957 close $fd
2958 unlock_index
2959 $ui_comm delete 0.0 end
2961 $ui_comm edit modified false
2962 catch {file delete [gitdir MERGE_HEAD]}
2964 catch {file delete [gitdir rr-cache MERGE_RR]}
2965 catch {file delete [gitdir SQUASH_MSG]}
2966 catch {file delete [gitdir MERGE_MSG]}
2967 catch {file delete [gitdir GITGUI_MSG]}
2968 rescan {set ui_status_value {Abort completed. Ready.}}
2970 }
2971}
2972######################################################################
2974##
2975## browser
2976set next_browser_id 0
2978proc new_browser {commit} {
2980 global next_browser_id cursor_ptr M1B
2981 global browser_commit browser_status browser_stack browser_path browser_busy
2982 set w .browser[incr next_browser_id]
2984 set w_list $w.list.l
2985 set browser_commit($w_list) $commit
2986 set browser_status($w_list) {Starting...}
2987 set browser_stack($w_list) {}
2988 set browser_path($w_list) $browser_commit($w_list):
2989 set browser_busy($w_list) 1
2990 toplevel $w
2992 label $w.path -textvariable browser_path($w_list) \
2993 -anchor w \
2994 -justify left \
2995 -borderwidth 1 \
2996 -relief sunken \
2997 -font font_uibold
2998 pack $w.path -anchor w -side top -fill x
2999 frame $w.list
3001 text $w_list -background white -borderwidth 0 \
3002 -cursor $cursor_ptr \
3003 -state disabled \
3004 -wrap none \
3005 -height 20 \
3006 -width 70 \
3007 -xscrollcommand [list $w.list.sbx set] \
3008 -yscrollcommand [list $w.list.sby set] \
3009 -font font_ui
3010 $w_list tag conf in_sel \
3011 -background [$w_list cget -foreground] \
3012 -foreground [$w_list cget -background]
3013 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3014 scrollbar $w.list.sby -orient v -command [list $w_list yview]
3015 pack $w.list.sbx -side bottom -fill x
3016 pack $w.list.sby -side right -fill y
3017 pack $w_list -side left -fill both -expand 1
3018 pack $w.list -side top -fill both -expand 1
3019 label $w.status -textvariable browser_status($w_list) \
3021 -anchor w \
3022 -justify left \
3023 -borderwidth 1 \
3024 -relief sunken \
3025 -font font_ui
3026 pack $w.status -anchor w -side bottom -fill x
3027 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3029 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3030 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3031 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3032 bind $w_list <Up> "browser_move -1 $w_list;break"
3033 bind $w_list <Down> "browser_move 1 $w_list;break"
3034 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3035 bind $w_list <Return> "browser_enter $w_list;break"
3036 bind $w_list <Prior> "browser_page -1 $w_list;break"
3037 bind $w_list <Next> "browser_page 1 $w_list;break"
3038 bind $w_list <Left> break
3039 bind $w_list <Right> break
3040 bind $w <Visibility> "focus $w"
3042 bind $w <Destroy> "
3043 array unset browser_buffer $w_list
3044 array unset browser_files $w_list
3045 array unset browser_status $w_list
3046 array unset browser_stack $w_list
3047 array unset browser_path $w_list
3048 array unset browser_commit $w_list
3049 array unset browser_busy $w_list
3050 "
3051 wm title $w "[appname] ([reponame]): File Browser"
3052 ls_tree $w_list $browser_commit($w_list) {}
3053}
3054proc browser_move {dir w} {
3056 global browser_files browser_busy
3057 if {$browser_busy($w)} return
3059 set lno [lindex [split [$w index in_sel.first] .] 0]
3060 incr lno $dir
3061 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3062 $w tag remove in_sel 0.0 end
3063 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3064 $w see $lno.0
3065 }
3066}
3067proc browser_page {dir w} {
3069 global browser_files browser_busy
3070 if {$browser_busy($w)} return
3072 $w yview scroll $dir pages
3073 set lno [expr {int(
3074 [lindex [$w yview] 0]
3075 * [llength $browser_files($w)]
3076 + 1)}]
3077 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3078 $w tag remove in_sel 0.0 end
3079 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3080 $w see $lno.0
3081 }
3082}
3083proc browser_parent {w} {
3085 global browser_files browser_status browser_path
3086 global browser_stack browser_busy
3087 if {$browser_busy($w)} return
3089 set info [lindex $browser_files($w) 0]
3090 if {[lindex $info 0] eq {parent}} {
3091 set parent [lindex $browser_stack($w) end-1]
3092 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3093 if {$browser_stack($w) eq {}} {
3094 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3095 } else {
3096 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3097 }
3098 set browser_status($w) "Loading $browser_path($w)..."
3099 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3100 }
3101}
3102proc browser_enter {w} {
3104 global browser_files browser_status browser_path
3105 global browser_commit browser_stack browser_busy
3106 if {$browser_busy($w)} return
3108 set lno [lindex [split [$w index in_sel.first] .] 0]
3109 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3110 if {$info ne {}} {
3111 switch -- [lindex $info 0] {
3112 parent {
3113 browser_parent $w
3114 }
3115 tree {
3116 set name [lindex $info 2]
3117 set escn [escape_path $name]
3118 set browser_status($w) "Loading $escn..."
3119 append browser_path($w) $escn
3120 ls_tree $w [lindex $info 1] $name
3121 }
3122 blob {
3123 set name [lindex $info 2]
3124 set p {}
3125 foreach n $browser_stack($w) {
3126 append p [lindex $n 1]
3127 }
3128 append p $name
3129 show_blame $browser_commit($w) $p
3130 }
3131 }
3132 }
3133}
3134proc browser_click {was_double_click w pos} {
3136 global browser_files browser_busy
3137 if {$browser_busy($w)} return
3139 set lno [lindex [split [$w index $pos] .] 0]
3140 focus $w
3141 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3143 $w tag remove in_sel 0.0 end
3144 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3145 if {$was_double_click} {
3146 browser_enter $w
3147 }
3148 }
3149}
3150proc ls_tree {w tree_id name} {
3152 global browser_buffer browser_files browser_stack browser_busy
3153 set browser_buffer($w) {}
3155 set browser_files($w) {}
3156 set browser_busy($w) 1
3157 $w conf -state normal
3159 $w tag remove in_sel 0.0 end
3160 $w delete 0.0 end
3161 if {$browser_stack($w) ne {}} {
3162 $w image create end \
3163 -align center -padx 5 -pady 1 \
3164 -name icon0 \
3165 -image file_uplevel
3166 $w insert end {[Up To Parent]}
3167 lappend browser_files($w) parent
3168 }
3169 lappend browser_stack($w) [list $tree_id $name]
3170 $w conf -state disabled
3171 set cmd [list git ls-tree -z $tree_id]
3173 set fd [open "| $cmd" r]
3174 fconfigure $fd -blocking 0 -translation binary -encoding binary
3175 fileevent $fd readable [list read_ls_tree $fd $w]
3176}
3177proc read_ls_tree {fd w} {
3179 global browser_buffer browser_files browser_status browser_busy
3180 if {![winfo exists $w]} {
3182 catch {close $fd}
3183 return
3184 }
3185 append browser_buffer($w) [read $fd]
3187 set pck [split $browser_buffer($w) "\0"]
3188 set browser_buffer($w) [lindex $pck end]
3189 set n [llength $browser_files($w)]
3191 $w conf -state normal
3192 foreach p [lrange $pck 0 end-1] {
3193 set info [split $p "\t"]
3194 set path [lindex $info 1]
3195 set info [split [lindex $info 0] { }]
3196 set type [lindex $info 1]
3197 set object [lindex $info 2]
3198 switch -- $type {
3200 blob {
3201 set image file_mod
3202 }
3203 tree {
3204 set image file_dir
3205 append path /
3206 }
3207 default {
3208 set image file_question
3209 }
3210 }
3211 if {$n > 0} {$w insert end "\n"}
3213 $w image create end \
3214 -align center -padx 5 -pady 1 \
3215 -name icon[incr n] \
3216 -image $image
3217 $w insert end [escape_path $path]
3218 lappend browser_files($w) [list $type $object $path]
3219 }
3220 $w conf -state disabled
3221 if {[eof $fd]} {
3223 close $fd
3224 set browser_status($w) Ready.
3225 set browser_busy($w) 0
3226 array unset browser_buffer $w
3227 if {$n > 0} {
3228 $w tag add in_sel 1.0 2.0
3229 focus -force $w
3230 }
3231 }
3232}
3233proc show_blame {commit path} {
3235 global next_browser_id blame_status blame_data
3236 if {[winfo ismapped .]} {
3238 set w .browser[incr next_browser_id]
3239 set tl $w
3240 toplevel $w
3241 } else {
3242 set w {}
3243 set tl .
3244 }
3245 set blame_status($w) {Loading current file content...}
3246 label $w.path -text "$commit:$path" \
3248 -anchor w \
3249 -justify left \
3250 -borderwidth 1 \
3251 -relief sunken \
3252 -font font_uibold
3253 pack $w.path -side top -fill x
3254 frame $w.out
3256 text $w.out.loaded_t \
3257 -background white -borderwidth 0 \
3258 -state disabled \
3259 -wrap none \
3260 -height 40 \
3261 -width 1 \
3262 -font font_diff
3263 $w.out.loaded_t tag conf annotated -background grey
3264 text $w.out.linenumber_t \
3266 -background white -borderwidth 0 \
3267 -state disabled \
3268 -wrap none \
3269 -height 40 \
3270 -width 5 \
3271 -font font_diff
3272 $w.out.linenumber_t tag conf linenumber -justify right
3273 text $w.out.file_t \
3275 -background white -borderwidth 0 \
3276 -state disabled \
3277 -wrap none \
3278 -height 40 \
3279 -width 80 \
3280 -xscrollcommand [list $w.out.sbx set] \
3281 -font font_diff
3282 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3284 scrollbar $w.out.sby -orient v \
3285 -command [list scrollbar2many [list \
3286 $w.out.loaded_t \
3287 $w.out.linenumber_t \
3288 $w.out.file_t \
3289 ] yview]
3290 grid \
3291 $w.out.linenumber_t \
3292 $w.out.loaded_t \
3293 $w.out.file_t \
3294 $w.out.sby \
3295 -sticky nsew
3296 grid conf $w.out.sbx -column 2 -sticky we
3297 grid columnconfigure $w.out 2 -weight 1
3298 grid rowconfigure $w.out 0 -weight 1
3299 pack $w.out -fill both -expand 1
3300 label $w.status -textvariable blame_status($w) \
3302 -anchor w \
3303 -justify left \
3304 -borderwidth 1 \
3305 -relief sunken \
3306 -font font_ui
3307 pack $w.status -side bottom -fill x
3308 frame $w.cm
3310 text $w.cm.t \
3311 -background white -borderwidth 0 \
3312 -state disabled \
3313 -wrap none \
3314 -height 10 \
3315 -width 80 \
3316 -xscrollcommand [list $w.cm.sbx set] \
3317 -yscrollcommand [list $w.cm.sby set] \
3318 -font font_diff
3319 scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3320 scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3321 pack $w.cm.sby -side right -fill y
3322 pack $w.cm.sbx -side bottom -fill x
3323 pack $w.cm.t -expand 1 -fill both
3324 pack $w.cm -side bottom -fill x
3325 menu $w.ctxm -tearoff 0
3327 $w.ctxm add command -label "Copy Commit" \
3328 -font font_ui \
3329 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3330 foreach i [list \
3332 $w.out.loaded_t \
3333 $w.out.linenumber_t \
3334 $w.out.file_t] {
3335 $i tag conf in_sel \
3336 -background [$i cget -foreground] \
3337 -foreground [$i cget -background]
3338 $i conf -yscrollcommand \
3339 [list many2scrollbar [list \
3340 $w.out.loaded_t \
3341 $w.out.linenumber_t \
3342 $w.out.file_t \
3343 ] yview $w.out.sby]
3344 bind $i <Button-1> "
3345 blame_click {$w} \\
3346 $w.cm.t \\
3347 $w.out.linenumber_t \\
3348 $w.out.file_t \\
3349 $i @%x,%y
3350 focus $i
3351 "
3352 bind_button3 $i "
3353 set cursorX %x
3354 set cursorY %y
3355 set cursorW %W
3356 tk_popup $w.ctxm %X %Y
3357 "
3358 }
3359 bind $w.cm.t <Button-1> "focus $w.cm.t"
3361 bind $tl <Visibility> "focus $tl"
3362 bind $tl <Destroy> "
3363 array unset blame_status {$w}
3364 array unset blame_data $w,*
3365 "
3366 wm title $tl "[appname] ([reponame]): File Viewer"
3367 set blame_data($w,commit_count) 0
3369 set blame_data($w,commit_list) {}
3370 set blame_data($w,total_lines) 0
3371 set blame_data($w,blame_lines) 0
3372 set blame_data($w,highlight_commit) {}
3373 set blame_data($w,highlight_line) -1
3374 set cmd [list git cat-file blob "$commit:$path"]
3376 set fd [open "| $cmd" r]
3377 fconfigure $fd -blocking 0 -translation lf -encoding binary
3378 fileevent $fd readable [list read_blame_catfile \
3379 $fd $w $commit $path \
3380 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3381}
3382proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3384 global blame_status blame_data
3385 if {![winfo exists $w_file]} {
3387 catch {close $fd}
3388 return
3389 }
3390 set n $blame_data($w,total_lines)
3392 $w_load conf -state normal
3393 $w_line conf -state normal
3394 $w_file conf -state normal
3395 while {[gets $fd line] >= 0} {
3396 regsub "\r\$" $line {} line
3397 incr n
3398 $w_load insert end "\n"
3399 $w_line insert end "$n\n" linenumber
3400 $w_file insert end "$line\n"
3401 }
3402 $w_load conf -state disabled
3403 $w_line conf -state disabled
3404 $w_file conf -state disabled
3405 set blame_data($w,total_lines) $n
3406 if {[eof $fd]} {
3408 close $fd
3409 blame_incremental_status $w
3410 set cmd [list git blame -M -C --incremental]
3411 lappend cmd $commit -- $path
3412 set fd [open "| $cmd" r]
3413 fconfigure $fd -blocking 0 -translation lf -encoding binary
3414 fileevent $fd readable [list read_blame_incremental $fd $w \
3415 $w_load $w_cmit $w_line $w_file]
3416 }
3417}
3418proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3420 global blame_status blame_data
3421 if {![winfo exists $w_file]} {
3423 catch {close $fd}
3424 return
3425 }
3426 while {[gets $fd line] >= 0} {
3428 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3429 cmit original_line final_line line_count]} {
3430 set blame_data($w,commit) $cmit
3431 set blame_data($w,original_line) $original_line
3432 set blame_data($w,final_line) $final_line
3433 set blame_data($w,line_count) $line_count
3434 if {[catch {set g $blame_data($w,$cmit,order)}]} {
3436 $w_line tag conf g$cmit
3437 $w_file tag conf g$cmit
3438 $w_line tag raise in_sel
3439 $w_file tag raise in_sel
3440 $w_file tag raise sel
3441 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3442 incr blame_data($w,commit_count)
3443 lappend blame_data($w,commit_list) $cmit
3444 }
3445 } elseif {[string match {filename *} $line]} {
3446 set file [string range $line 9 end]
3447 set n $blame_data($w,line_count)
3448 set lno $blame_data($w,final_line)
3449 set cmit $blame_data($w,commit)
3450 while {$n > 0} {
3452 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3453 $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3454 } else {
3455 $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3456 $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3457 }
3458 set blame_data($w,line$lno,commit) $cmit
3460 set blame_data($w,line$lno,file) $file
3461 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3462 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3463 if {$blame_data($w,highlight_line) == -1} {
3465 if {[lindex [$w_file yview] 0] == 0} {
3466 $w_file see $lno.0
3467 blame_showcommit $w $w_cmit $w_line $w_file $lno
3468 }
3469 } elseif {$blame_data($w,highlight_line) == $lno} {
3470 blame_showcommit $w $w_cmit $w_line $w_file $lno
3471 }
3472 incr n -1
3474 incr lno
3475 incr blame_data($w,blame_lines)
3476 }
3477 set hc $blame_data($w,highlight_commit)
3479 if {$hc ne {}
3480 && [expr {$blame_data($w,$hc,order) + 1}]
3481 == $blame_data($w,$cmit,order)} {
3482 blame_showcommit $w $w_cmit $w_line $w_file \
3483 $blame_data($w,highlight_line)
3484 }
3485 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3486 set blame_data($w,$blame_data($w,commit),$header) $data
3487 }
3488 }
3489 if {[eof $fd]} {
3491 close $fd
3492 set blame_status($w) {Annotation complete.}
3493 } else {
3494 blame_incremental_status $w
3495 }
3496}
3497proc blame_incremental_status {w} {
3499 global blame_status blame_data
3500 set blame_status($w) [format \
3502 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3503 $blame_data($w,blame_lines) \
3504 $blame_data($w,total_lines) \
3505 [expr {100 * $blame_data($w,blame_lines)
3506 / $blame_data($w,total_lines)}]]
3507}
3508proc blame_click {w w_cmit w_line w_file cur_w pos} {
3510 set lno [lindex [split [$cur_w index $pos] .] 0]
3511 if {$lno eq {}} return
3512 $w_line tag remove in_sel 0.0 end
3514 $w_file tag remove in_sel 0.0 end
3515 $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3516 $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3517 blame_showcommit $w $w_cmit $w_line $w_file $lno
3519}
3520set blame_colors {
3522 #ff4040
3523 #ff40ff
3524 #4040ff
3525}
3526proc blame_showcommit {w w_cmit w_line w_file lno} {
3528 global blame_colors blame_data repo_config
3529 set cmit $blame_data($w,highlight_commit)
3531 if {$cmit ne {}} {
3532 set idx $blame_data($w,$cmit,order)
3533 set i 0
3534 foreach c $blame_colors {
3535 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3536 $w_line tag conf g$h -background white
3537 $w_file tag conf g$h -background white
3538 incr i
3539 }
3540 }
3541 $w_cmit conf -state normal
3543 $w_cmit delete 0.0 end
3544 if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3545 set cmit {}
3546 $w_cmit insert end "Loading annotation..."
3547 } else {
3548 set idx $blame_data($w,$cmit,order)
3549 set i 0
3550 foreach c $blame_colors {
3551 set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3552 $w_line tag conf g$h -background $c
3553 $w_file tag conf g$h -background $c
3554 incr i
3555 }
3556 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3558 set msg {}
3559 catch {
3560 set fd [open "| git cat-file commit $cmit" r]
3561 fconfigure $fd -encoding binary -translation lf
3562 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3563 set enc utf-8
3564 }
3565 while {[gets $fd line] > 0} {
3566 if {[string match {encoding *} $line]} {
3567 set enc [string tolower [string range $line 9 end]]
3568 }
3569 }
3570 fconfigure $fd -encoding $enc
3571 set msg [string trim [read $fd]]
3572 close $fd
3573 }
3574 set blame_data($w,$cmit,message) $msg
3575 }
3576 set author_name {}
3578 set author_email {}
3579 set author_time {}
3580 catch {set author_name $blame_data($w,$cmit,author)}
3581 catch {set author_email $blame_data($w,$cmit,author-mail)}
3582 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3583 set committer_name {}
3585 set committer_email {}
3586 set committer_time {}
3587 catch {set committer_name $blame_data($w,$cmit,committer)}
3588 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3589 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3590 $w_cmit insert end "commit $cmit\n"
3592 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3593 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3594 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3595 $w_cmit insert end "\n"
3596 $w_cmit insert end $msg
3597 }
3598 $w_cmit conf -state disabled
3599 set blame_data($w,highlight_line) $lno
3601 set blame_data($w,highlight_commit) $cmit
3602}
3603proc blame_copycommit {w i pos} {
3605 global blame_data
3606 set lno [lindex [split [$i index $pos] .] 0]
3607 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3608 clipboard clear
3609 clipboard append \
3610 -format STRING \
3611 -type STRING \
3612 -- $commit
3613 }
3614}
3615######################################################################
3617##
3618## icons
3619set filemask {
3621#define mask_width 14
3622#define mask_height 15
3623static unsigned char mask_bits[] = {
3624 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3625 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3626 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3627}
3628image create bitmap file_plain -background white -foreground black -data {
3630#define plain_width 14
3631#define plain_height 15
3632static unsigned char plain_bits[] = {
3633 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3634 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3635 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3636} -maskdata $filemask
3637image create bitmap file_mod -background white -foreground blue -data {
3639#define mod_width 14
3640#define mod_height 15
3641static unsigned char mod_bits[] = {
3642 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3643 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3644 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3645} -maskdata $filemask
3646image create bitmap file_fulltick -background white -foreground "#007000" -data {
3648#define file_fulltick_width 14
3649#define file_fulltick_height 15
3650static unsigned char file_fulltick_bits[] = {
3651 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3652 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3653 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3654} -maskdata $filemask
3655image create bitmap file_parttick -background white -foreground "#005050" -data {
3657#define parttick_width 14
3658#define parttick_height 15
3659static unsigned char parttick_bits[] = {
3660 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3661 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3662 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3663} -maskdata $filemask
3664image create bitmap file_question -background white -foreground black -data {
3666#define file_question_width 14
3667#define file_question_height 15
3668static unsigned char file_question_bits[] = {
3669 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3670 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3671 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3672} -maskdata $filemask
3673image create bitmap file_removed -background white -foreground red -data {
3675#define file_removed_width 14
3676#define file_removed_height 15
3677static unsigned char file_removed_bits[] = {
3678 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3679 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3680 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3681} -maskdata $filemask
3682image create bitmap file_merge -background white -foreground blue -data {
3684#define file_merge_width 14
3685#define file_merge_height 15
3686static unsigned char file_merge_bits[] = {
3687 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3688 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3689 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3690} -maskdata $filemask
3691set file_dir_data {
3693#define file_width 18
3694#define file_height 18
3695static unsigned char file_bits[] = {
3696 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3697 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3698 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3699 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3700 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3701}
3702image create bitmap file_dir -background white -foreground blue \
3703 -data $file_dir_data -maskdata $file_dir_data
3704unset file_dir_data
3705set file_uplevel_data {
3707#define up_width 15
3708#define up_height 15
3709static unsigned char up_bits[] = {
3710 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3711 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3712 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3713}
3714image create bitmap file_uplevel -background white -foreground red \
3715 -data $file_uplevel_data -maskdata $file_uplevel_data
3716unset file_uplevel_data
3717set ui_index .vpane.files.index.list
3719set ui_workdir .vpane.files.workdir.list
3720set all_icons(_$ui_index) file_plain
3722set all_icons(A$ui_index) file_fulltick
3723set all_icons(M$ui_index) file_fulltick
3724set all_icons(D$ui_index) file_removed
3725set all_icons(U$ui_index) file_merge
3726set all_icons(_$ui_workdir) file_plain
3728set all_icons(M$ui_workdir) file_mod
3729set all_icons(D$ui_workdir) file_question
3730set all_icons(U$ui_workdir) file_merge
3731set all_icons(O$ui_workdir) file_plain
3732set max_status_desc 0
3734foreach i {
3735 {__ "Unmodified"}
3736 {_M "Modified, not staged"}
3738 {M_ "Staged for commit"}
3739 {MM "Portions staged for commit"}
3740 {MD "Staged for commit, missing"}
3741 {_O "Untracked, not staged"}
3743 {A_ "Staged for commit"}
3744 {AM "Portions staged for commit"}
3745 {AD "Staged for commit, missing"}
3746 {_D "Missing"}
3748 {D_ "Staged for removal"}
3749 {DO "Staged for removal, still present"}
3750 {U_ "Requires merge resolution"}
3752 {UU "Requires merge resolution"}
3753 {UM "Requires merge resolution"}
3754 {UD "Requires merge resolution"}
3755 } {
3756 if {$max_status_desc < [string length [lindex $i 1]]} {
3757 set max_status_desc [string length [lindex $i 1]]
3758 }
3759 set all_descs([lindex $i 0]) [lindex $i 1]
3760}
3761unset i
3762######################################################################
3764##
3765## util
3766proc bind_button3 {w cmd} {
3768 bind $w <Any-Button-3> $cmd
3769 if {[is_MacOSX]} {
3770 bind $w <Control-Button-1> $cmd
3771 }
3772}
3773proc scrollbar2many {list mode args} {
3775 foreach w $list {eval $w $mode $args}
3776}
3777proc many2scrollbar {list mode sb top bottom} {
3779 $sb set $top $bottom
3780 foreach w $list {$w $mode moveto $top}
3781}
3782proc incr_font_size {font {amt 1}} {
3784 set sz [font configure $font -size]
3785 incr sz $amt
3786 font configure $font -size $sz
3787 font configure ${font}bold -size $sz
3788}
3789proc hook_failed_popup {hook msg} {
3791 set w .hookfail
3792 toplevel $w
3793 frame $w.m
3795 label $w.m.l1 -text "$hook hook failed:" \
3796 -anchor w \
3797 -justify left \
3798 -font font_uibold
3799 text $w.m.t \
3800 -background white -borderwidth 1 \
3801 -relief sunken \
3802 -width 80 -height 10 \
3803 -font font_diff \
3804 -yscrollcommand [list $w.m.sby set]
3805 label $w.m.l2 \
3806 -text {You must correct the above errors before committing.} \
3807 -anchor w \
3808 -justify left \
3809 -font font_uibold
3810 scrollbar $w.m.sby -command [list $w.m.t yview]
3811 pack $w.m.l1 -side top -fill x
3812 pack $w.m.l2 -side bottom -fill x
3813 pack $w.m.sby -side right -fill y
3814 pack $w.m.t -side left -fill both -expand 1
3815 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3816 $w.m.t insert 1.0 $msg
3818 $w.m.t conf -state disabled
3819 button $w.ok -text OK \
3821 -width 15 \
3822 -font font_ui \
3823 -command "destroy $w"
3824 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3825 bind $w <Visibility> "grab $w; focus $w"
3827 bind $w <Key-Return> "destroy $w"
3828 wm title $w "[appname] ([reponame]): error"
3829 tkwait window $w
3830}
3831set next_console_id 0
3833proc new_console {short_title long_title} {
3835 global next_console_id console_data
3836 set w .console[incr next_console_id]
3837 set console_data($w) [list $short_title $long_title]
3838 return [console_init $w]
3839}
3840proc console_init {w} {
3842 global console_cr console_data M1B
3843 set console_cr($w) 1.0
3845 toplevel $w
3846 frame $w.m
3847 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3848 -anchor w \
3849 -justify left \
3850 -font font_uibold
3851 text $w.m.t \
3852 -background white -borderwidth 1 \
3853 -relief sunken \
3854 -width 80 -height 10 \
3855 -font font_diff \
3856 -state disabled \
3857 -yscrollcommand [list $w.m.sby set]
3858 label $w.m.s -text {Working... please wait...} \
3859 -anchor w \
3860 -justify left \
3861 -font font_uibold
3862 scrollbar $w.m.sby -command [list $w.m.t yview]
3863 pack $w.m.l1 -side top -fill x
3864 pack $w.m.s -side bottom -fill x
3865 pack $w.m.sby -side right -fill y
3866 pack $w.m.t -side left -fill both -expand 1
3867 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3868 menu $w.ctxm -tearoff 0
3870 $w.ctxm add command -label "Copy" \
3871 -font font_ui \
3872 -command "tk_textCopy $w.m.t"
3873 $w.ctxm add command -label "Select All" \
3874 -font font_ui \
3875 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3876 $w.ctxm add command -label "Copy All" \
3877 -font font_ui \
3878 -command "
3879 $w.m.t tag add sel 0.0 end
3880 tk_textCopy $w.m.t
3881 $w.m.t tag remove sel 0.0 end
3882 "
3883 button $w.ok -text {Close} \
3885 -font font_ui \
3886 -state disabled \
3887 -command "destroy $w"
3888 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3889 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3891 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3892 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3893 bind $w <Visibility> "focus $w"
3894 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3895 return $w
3896}
3897proc console_exec {w cmd after} {
3899 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3900 # But most users need that so we have to relogin. :-(
3901 #
3902 if {[is_Cygwin]} {
3903 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3904 }
3905 # -- Tcl won't let us redirect both stdout and stderr to
3907 # the same pipe. So pass it through cat...
3908 #
3909 set cmd [concat | $cmd |& cat]
3910 set fd_f [open $cmd r]
3912 fconfigure $fd_f -blocking 0 -translation binary
3913 fileevent $fd_f readable [list console_read $w $fd_f $after]
3914}
3915proc console_read {w fd after} {
3917 global console_cr
3918 set buf [read $fd]
3920 if {$buf ne {}} {
3921 if {![winfo exists $w]} {console_init $w}
3922 $w.m.t conf -state normal
3923 set c 0
3924 set n [string length $buf]
3925 while {$c < $n} {
3926 set cr [string first "\r" $buf $c]
3927 set lf [string first "\n" $buf $c]
3928 if {$cr < 0} {set cr [expr {$n + 1}]}
3929 if {$lf < 0} {set lf [expr {$n + 1}]}
3930 if {$lf < $cr} {
3932 $w.m.t insert end [string range $buf $c $lf]
3933 set console_cr($w) [$w.m.t index {end -1c}]
3934 set c $lf
3935 incr c
3936 } else {
3937 $w.m.t delete $console_cr($w) end
3938 $w.m.t insert end "\n"
3939 $w.m.t insert end [string range $buf $c $cr]
3940 set c $cr
3941 incr c
3942 }
3943 }
3944 $w.m.t conf -state disabled
3945 $w.m.t see end
3946 }
3947 fconfigure $fd -blocking 1
3949 if {[eof $fd]} {
3950 if {[catch {close $fd}]} {
3951 set ok 0
3952 } else {
3953 set ok 1
3954 }
3955 uplevel #0 $after $w $ok
3956 return
3957 }
3958 fconfigure $fd -blocking 0
3959}
3960proc console_chain {cmdlist w {ok 1}} {
3962 if {$ok} {
3963 if {[llength $cmdlist] == 0} {
3964 console_done $w $ok
3965 return
3966 }
3967 set cmd [lindex $cmdlist 0]
3969 set cmdlist [lrange $cmdlist 1 end]
3970 if {[lindex $cmd 0] eq {console_exec}} {
3972 console_exec $w \
3973 [lindex $cmd 1] \
3974 [list console_chain $cmdlist]
3975 } else {
3976 uplevel #0 $cmd $cmdlist $w $ok
3977 }
3978 } else {
3979 console_done $w $ok
3980 }
3981}
3982proc console_done {args} {
3984 global console_cr console_data
3985 switch -- [llength $args] {
3987 2 {
3988 set w [lindex $args 0]
3989 set ok [lindex $args 1]
3990 }
3991 3 {
3992 set w [lindex $args 1]
3993 set ok [lindex $args 2]
3994 }
3995 default {
3996 error "wrong number of args: console_done ?ignored? w ok"
3997 }
3998 }
3999 if {$ok} {
4001 if {[winfo exists $w]} {
4002 $w.m.s conf -background green -text {Success}
4003 $w.ok conf -state normal
4004 }
4005 } else {
4006 if {![winfo exists $w]} {
4007 console_init $w
4008 }
4009 $w.m.s conf -background red -text {Error: Command Failed}
4010 $w.ok conf -state normal
4011 }
4012 array unset console_cr $w
4014 array unset console_data $w
4015}
4016######################################################################
4018##
4019## ui commands
4020set starting_gitk_msg {Starting gitk... please wait...}
4022proc do_gitk {revs} {
4024 global env ui_status_value starting_gitk_msg
4025 # -- Always start gitk through whatever we were loaded with. This
4027 # lets us bypass using shell process on Windows systems.
4028 #
4029 set cmd [info nameofexecutable]
4030 lappend cmd [gitexec gitk]
4031 if {$revs ne {}} {
4032 append cmd { }
4033 append cmd $revs
4034 }
4035 if {[catch {eval exec $cmd &} err]} {
4037 error_popup "Failed to start gitk:\n\n$err"
4038 } else {
4039 set ui_status_value $starting_gitk_msg
4040 after 10000 {
4041 if {$ui_status_value eq $starting_gitk_msg} {
4042 set ui_status_value {Ready.}
4043 }
4044 }
4045 }
4046}
4047proc do_stats {} {
4049 set fd [open "| git count-objects -v" r]
4050 while {[gets $fd line] > 0} {
4051 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4052 set stats($name) $value
4053 }
4054 }
4055 close $fd
4056 set packed_sz 0
4058 foreach p [glob -directory [gitdir objects pack] \
4059 -type f \
4060 -nocomplain -- *] {
4061 incr packed_sz [file size $p]
4062 }
4063 if {$packed_sz > 0} {
4064 set stats(size-pack) [expr {$packed_sz / 1024}]
4065 }
4066 set w .stats_view
4068 toplevel $w
4069 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4070 label $w.header -text {Database Statistics} \
4072 -font font_uibold
4073 pack $w.header -side top -fill x
4074 frame $w.buttons -border 1
4076 button $w.buttons.close -text Close \
4077 -font font_ui \
4078 -command [list destroy $w]
4079 button $w.buttons.gc -text {Compress Database} \
4080 -font font_ui \
4081 -command "destroy $w;do_gc"
4082 pack $w.buttons.close -side right
4083 pack $w.buttons.gc -side left
4084 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4085 frame $w.stat -borderwidth 1 -relief solid
4087 foreach s {
4088 {count {Number of loose objects}}
4089 {size {Disk space used by loose objects} { KiB}}
4090 {in-pack {Number of packed objects}}
4091 {packs {Number of packs}}
4092 {size-pack {Disk space used by packed objects} { KiB}}
4093 {prune-packable {Packed objects waiting for pruning}}
4094 {garbage {Garbage files}}
4095 } {
4096 set name [lindex $s 0]
4097 set label [lindex $s 1]
4098 if {[catch {set value $stats($name)}]} continue
4099 if {[llength $s] > 2} {
4100 set value "$value[lindex $s 2]"
4101 }
4102 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4104 label $w.stat.v_$name -text $value -anchor w -font font_ui
4105 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4106 }
4107 pack $w.stat -pady 10 -padx 10
4108 bind $w <Visibility> "grab $w; focus $w"
4110 bind $w <Key-Escape> [list destroy $w]
4111 bind $w <Key-Return> [list destroy $w]
4112 wm title $w "[appname] ([reponame]): Database Statistics"
4113 tkwait window $w
4114}
4115proc do_gc {} {
4117 set w [new_console {gc} {Compressing the object database}]
4118 console_chain {
4119 {console_exec {git pack-refs --prune}}
4120 {console_exec {git reflog expire --all}}
4121 {console_exec {git repack -a -d -l}}
4122 {console_exec {git rerere gc}}
4123 } $w
4124}
4125proc do_fsck_objects {} {
4127 set w [new_console {fsck-objects} \
4128 {Verifying the object database with fsck-objects}]
4129 set cmd [list git fsck-objects]
4130 lappend cmd --full
4131 lappend cmd --cache
4132 lappend cmd --strict
4133 console_exec $w $cmd console_done
4134}
4135set is_quitting 0
4137proc do_quit {} {
4139 global ui_comm is_quitting repo_config commit_type
4140 if {$is_quitting} return
4142 set is_quitting 1
4143 if {[winfo exists $ui_comm]} {
4145 # -- Stash our current commit buffer.
4146 #
4147 set save [gitdir GITGUI_MSG]
4148 set msg [string trim [$ui_comm get 0.0 end]]
4149 regsub -all -line {[ \r\t]+$} $msg {} msg
4150 if {(![string match amend* $commit_type]
4151 || [$ui_comm edit modified])
4152 && $msg ne {}} {
4153 catch {
4154 set fd [open $save w]
4155 puts -nonewline $fd $msg
4156 close $fd
4157 }
4158 } else {
4159 catch {file delete $save}
4160 }
4161 # -- Stash our current window geometry into this repository.
4163 #
4164 set cfg_geometry [list]
4165 lappend cfg_geometry [wm geometry .]
4166 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4167 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4168 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4169 set rc_geometry {}
4170 }
4171 if {$cfg_geometry ne $rc_geometry} {
4172 catch {git config gui.geometry $cfg_geometry}
4173 }
4174 }
4175 destroy .
4177}
4178proc do_rescan {} {
4180 rescan {set ui_status_value {Ready.}}
4181}
4182proc unstage_helper {txt paths} {
4184 global file_states current_diff_path
4185 if {![lock_index begin-update]} return
4187 set pathList [list]
4189 set after {}
4190 foreach path $paths {
4191 switch -glob -- [lindex $file_states($path) 0] {
4192 A? -
4193 M? -
4194 D? {
4195 lappend pathList $path
4196 if {$path eq $current_diff_path} {
4197 set after {reshow_diff;}
4198 }
4199 }
4200 }
4201 }
4202 if {$pathList eq {}} {
4203 unlock_index
4204 } else {
4205 update_indexinfo \
4206 $txt \
4207 $pathList \
4208 [concat $after {set ui_status_value {Ready.}}]
4209 }
4210}
4211proc do_unstage_selection {} {
4213 global current_diff_path selected_paths
4214 if {[array size selected_paths] > 0} {
4216 unstage_helper \
4217 {Unstaging selected files from commit} \
4218 [array names selected_paths]
4219 } elseif {$current_diff_path ne {}} {
4220 unstage_helper \
4221 "Unstaging [short_path $current_diff_path] from commit" \
4222 [list $current_diff_path]
4223 }
4224}
4225proc add_helper {txt paths} {
4227 global file_states current_diff_path
4228 if {![lock_index begin-update]} return
4230 set pathList [list]
4232 set after {}
4233 foreach path $paths {
4234 switch -glob -- [lindex $file_states($path) 0] {
4235 _O -
4236 ?M -
4237 ?D -
4238 U? {
4239 lappend pathList $path
4240 if {$path eq $current_diff_path} {
4241 set after {reshow_diff;}
4242 }
4243 }
4244 }
4245 }
4246 if {$pathList eq {}} {
4247 unlock_index
4248 } else {
4249 update_index \
4250 $txt \
4251 $pathList \
4252 [concat $after {set ui_status_value {Ready to commit.}}]
4253 }
4254}
4255proc do_add_selection {} {
4257 global current_diff_path selected_paths
4258 if {[array size selected_paths] > 0} {
4260 add_helper \
4261 {Adding selected files} \
4262 [array names selected_paths]
4263 } elseif {$current_diff_path ne {}} {
4264 add_helper \
4265 "Adding [short_path $current_diff_path]" \
4266 [list $current_diff_path]
4267 }
4268}
4269proc do_add_all {} {
4271 global file_states
4272 set paths [list]
4274 foreach path [array names file_states] {
4275 switch -glob -- [lindex $file_states($path) 0] {
4276 U? {continue}
4277 ?M -
4278 ?D {lappend paths $path}
4279 }
4280 }
4281 add_helper {Adding all changed files} $paths
4282}
4283proc revert_helper {txt paths} {
4285 global file_states current_diff_path
4286 if {![lock_index begin-update]} return
4288 set pathList [list]
4290 set after {}
4291 foreach path $paths {
4292 switch -glob -- [lindex $file_states($path) 0] {
4293 U? {continue}
4294 ?M -
4295 ?D {
4296 lappend pathList $path
4297 if {$path eq $current_diff_path} {
4298 set after {reshow_diff;}
4299 }
4300 }
4301 }
4302 }
4303 set n [llength $pathList]
4305 if {$n == 0} {
4306 unlock_index
4307 return
4308 } elseif {$n == 1} {
4309 set s "[short_path [lindex $pathList]]"
4310 } else {
4311 set s "these $n files"
4312 }
4313 set reply [tk_dialog \
4315 .confirm_revert \
4316 "[appname] ([reponame])" \
4317 "Revert changes in $s?
4318Any unadded changes will be permanently lost by the revert." \
4320 question \
4321 1 \
4322 {Do Nothing} \
4323 {Revert Changes} \
4324 ]
4325 if {$reply == 1} {
4326 checkout_index \
4327 $txt \
4328 $pathList \
4329 [concat $after {set ui_status_value {Ready.}}]
4330 } else {
4331 unlock_index
4332 }
4333}
4334proc do_revert_selection {} {
4336 global current_diff_path selected_paths
4337 if {[array size selected_paths] > 0} {
4339 revert_helper \
4340 {Reverting selected files} \
4341 [array names selected_paths]
4342 } elseif {$current_diff_path ne {}} {
4343 revert_helper \
4344 "Reverting [short_path $current_diff_path]" \
4345 [list $current_diff_path]
4346 }
4347}
4348proc do_signoff {} {
4350 global ui_comm
4351 set me [committer_ident]
4353 if {$me eq {}} return
4354 set sob "Signed-off-by: $me"
4356 set last [$ui_comm get {end -1c linestart} {end -1c}]
4357 if {$last ne $sob} {
4358 $ui_comm edit separator
4359 if {$last ne {}
4360 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4361 $ui_comm insert end "\n"
4362 }
4363 $ui_comm insert end "\n$sob"
4364 $ui_comm edit separator
4365 $ui_comm see end
4366 }
4367}
4368proc do_select_commit_type {} {
4370 global commit_type selected_commit_type
4371 if {$selected_commit_type eq {new}
4373 && [string match amend* $commit_type]} {
4374 create_new_commit
4375 } elseif {$selected_commit_type eq {amend}
4376 && ![string match amend* $commit_type]} {
4377 load_last_commit
4378 # The amend request was rejected...
4380 #
4381 if {![string match amend* $commit_type]} {
4382 set selected_commit_type new
4383 }
4384 }
4385}
4386proc do_commit {} {
4388 commit_tree
4389}
4390proc do_about {} {
4392 global appvers copyright
4393 global tcl_patchLevel tk_patchLevel
4394 set w .about_dialog
4396 toplevel $w
4397 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4398 label $w.header -text "About [appname]" \
4400 -font font_uibold
4401 pack $w.header -side top -fill x
4402 frame $w.buttons
4404 button $w.buttons.close -text {Close} \
4405 -font font_ui \
4406 -command [list destroy $w]
4407 pack $w.buttons.close -side right
4408 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4409 label $w.desc \
4411 -text "[appname] - a commit creation tool for Git.
4412$copyright" \
4413 -padx 5 -pady 5 \
4414 -justify left \
4415 -anchor w \
4416 -borderwidth 1 \
4417 -relief solid \
4418 -font font_ui
4419 pack $w.desc -side top -fill x -padx 5 -pady 5
4420 set v {}
4422 append v "[appname] version $appvers\n"
4423 append v "[git version]\n"
4424 append v "\n"
4425 if {$tcl_patchLevel eq $tk_patchLevel} {
4426 append v "Tcl/Tk version $tcl_patchLevel"
4427 } else {
4428 append v "Tcl version $tcl_patchLevel"
4429 append v ", Tk version $tk_patchLevel"
4430 }
4431 label $w.vers \
4433 -text $v \
4434 -padx 5 -pady 5 \
4435 -justify left \
4436 -anchor w \
4437 -borderwidth 1 \
4438 -relief solid \
4439 -font font_ui
4440 pack $w.vers -side top -fill x -padx 5 -pady 5
4441 menu $w.ctxm -tearoff 0
4443 $w.ctxm add command \
4444 -label {Copy} \
4445 -font font_ui \
4446 -command "
4447 clipboard clear
4448 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4449 "
4450 bind $w <Visibility> "grab $w; focus $w"
4452 bind $w <Key-Escape> "destroy $w"
4453 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4454 wm title $w "About [appname]"
4455 tkwait window $w
4456}
4457proc do_options {} {
4459 global repo_config global_config font_descs
4460 global repo_config_new global_config_new
4461 array unset repo_config_new
4463 array unset global_config_new
4464 foreach name [array names repo_config] {
4465 set repo_config_new($name) $repo_config($name)
4466 }
4467 load_config 1
4468 foreach name [array names repo_config] {
4469 switch -- $name {
4470 gui.diffcontext {continue}
4471 }
4472 set repo_config_new($name) $repo_config($name)
4473 }
4474 foreach name [array names global_config] {
4475 set global_config_new($name) $global_config($name)
4476 }
4477 set w .options_editor
4479 toplevel $w
4480 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4481 label $w.header -text "[appname] Options" \
4483 -font font_uibold
4484 pack $w.header -side top -fill x
4485 frame $w.buttons
4487 button $w.buttons.restore -text {Restore Defaults} \
4488 -font font_ui \
4489 -command do_restore_defaults
4490 pack $w.buttons.restore -side left
4491 button $w.buttons.save -text Save \
4492 -font font_ui \
4493 -command [list do_save_config $w]
4494 pack $w.buttons.save -side right
4495 button $w.buttons.cancel -text {Cancel} \
4496 -font font_ui \
4497 -command [list destroy $w]
4498 pack $w.buttons.cancel -side right -padx 5
4499 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4500 labelframe $w.repo -text "[reponame] Repository" \
4502 -font font_ui
4503 labelframe $w.global -text {Global (All Repositories)} \
4504 -font font_ui
4505 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4506 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4507 set optid 0
4509 foreach option {
4510 {t user.name {User Name}}
4511 {t user.email {Email Address}}
4512 {b merge.summary {Summarize Merge Commits}}
4514 {i-1..5 merge.verbosity {Merge Verbosity}}
4515 {b gui.trustmtime {Trust File Modification Timestamps}}
4517 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4518 {t gui.newbranchtemplate {New Branch Name Template}}
4519 } {
4520 set type [lindex $option 0]
4521 set name [lindex $option 1]
4522 set text [lindex $option 2]
4523 incr optid
4524 foreach f {repo global} {
4525 switch -glob -- $type {
4526 b {
4527 checkbutton $w.$f.$optid -text $text \
4528 -variable ${f}_config_new($name) \
4529 -onvalue true \
4530 -offvalue false \
4531 -font font_ui
4532 pack $w.$f.$optid -side top -anchor w
4533 }
4534 i-* {
4535 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4536 frame $w.$f.$optid
4537 label $w.$f.$optid.l -text "$text:" -font font_ui
4538 pack $w.$f.$optid.l -side left -anchor w -fill x
4539 spinbox $w.$f.$optid.v \
4540 -textvariable ${f}_config_new($name) \
4541 -from $min \
4542 -to $max \
4543 -increment 1 \
4544 -width [expr {1 + [string length $max]}] \
4545 -font font_ui
4546 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4547 pack $w.$f.$optid.v -side right -anchor e -padx 5
4548 pack $w.$f.$optid -side top -anchor w -fill x
4549 }
4550 t {
4551 frame $w.$f.$optid
4552 label $w.$f.$optid.l -text "$text:" -font font_ui
4553 entry $w.$f.$optid.v \
4554 -borderwidth 1 \
4555 -relief sunken \
4556 -width 20 \
4557 -textvariable ${f}_config_new($name) \
4558 -font font_ui
4559 pack $w.$f.$optid.l -side left -anchor w
4560 pack $w.$f.$optid.v -side left -anchor w \
4561 -fill x -expand 1 \
4562 -padx 5
4563 pack $w.$f.$optid -side top -anchor w -fill x
4564 }
4565 }
4566 }
4567 }
4568 set all_fonts [lsort [font families]]
4570 foreach option $font_descs {
4571 set name [lindex $option 0]
4572 set font [lindex $option 1]
4573 set text [lindex $option 2]
4574 set global_config_new(gui.$font^^family) \
4576 [font configure $font -family]
4577 set global_config_new(gui.$font^^size) \
4578 [font configure $font -size]
4579 frame $w.global.$name
4581 label $w.global.$name.l -text "$text:" -font font_ui
4582 pack $w.global.$name.l -side left -anchor w -fill x
4583 eval tk_optionMenu $w.global.$name.family \
4584 global_config_new(gui.$font^^family) \
4585 $all_fonts
4586 spinbox $w.global.$name.size \
4587 -textvariable global_config_new(gui.$font^^size) \
4588 -from 2 -to 80 -increment 1 \
4589 -width 3 \
4590 -font font_ui
4591 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4592 pack $w.global.$name.size -side right -anchor e
4593 pack $w.global.$name.family -side right -anchor e
4594 pack $w.global.$name -side top -anchor w -fill x
4595 }
4596 bind $w <Visibility> "grab $w; focus $w"
4598 bind $w <Key-Escape> "destroy $w"
4599 wm title $w "[appname] ([reponame]): Options"
4600 tkwait window $w
4601}
4602proc do_restore_defaults {} {
4604 global font_descs default_config repo_config
4605 global repo_config_new global_config_new
4606 foreach name [array names default_config] {
4608 set repo_config_new($name) $default_config($name)
4609 set global_config_new($name) $default_config($name)
4610 }
4611 foreach option $font_descs {
4613 set name [lindex $option 0]
4614 set repo_config(gui.$name) $default_config(gui.$name)
4615 }
4616 apply_config
4617 foreach option $font_descs {
4619 set name [lindex $option 0]
4620 set font [lindex $option 1]
4621 set global_config_new(gui.$font^^family) \
4622 [font configure $font -family]
4623 set global_config_new(gui.$font^^size) \
4624 [font configure $font -size]
4625 }
4626}
4627proc do_save_config {w} {
4629 if {[catch {save_config} err]} {
4630 error_popup "Failed to completely save options:\n\n$err"
4631 }
4632 reshow_diff
4633 destroy $w
4634}
4635proc do_windows_shortcut {} {
4637 global argv0
4638 set fn [tk_getSaveFile \
4640 -parent . \
4641 -title "[appname] ([reponame]): Create Desktop Icon" \
4642 -initialfile "Git [reponame].bat"]
4643 if {$fn != {}} {
4644 if {[catch {
4645 set fd [open $fn w]
4646 puts $fd "@ECHO Entering [reponame]"
4647 puts $fd "@ECHO Starting git-gui... please wait..."
4648 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4649 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4650 puts -nonewline $fd "@\"[info nameofexecutable]\""
4651 puts $fd " \"[file normalize $argv0]\""
4652 close $fd
4653 } err]} {
4654 error_popup "Cannot write script:\n\n$err"
4655 }
4656 }
4657}
4658proc do_cygwin_shortcut {} {
4660 global argv0
4661 if {[catch {
4663 set desktop [exec cygpath \
4664 --windows \
4665 --absolute \
4666 --long-name \
4667 --desktop]
4668 }]} {
4669 set desktop .
4670 }
4671 set fn [tk_getSaveFile \
4672 -parent . \
4673 -title "[appname] ([reponame]): Create Desktop Icon" \
4674 -initialdir $desktop \
4675 -initialfile "Git [reponame].bat"]
4676 if {$fn != {}} {
4677 if {[catch {
4678 set fd [open $fn w]
4679 set sh [exec cygpath \
4680 --windows \
4681 --absolute \
4682 /bin/sh]
4683 set me [exec cygpath \
4684 --unix \
4685 --absolute \
4686 $argv0]
4687 set gd [exec cygpath \
4688 --unix \
4689 --absolute \
4690 [gitdir]]
4691 set gw [exec cygpath \
4692 --windows \
4693 --absolute \
4694 [file dirname [gitdir]]]
4695 regsub -all ' $me "'\\''" me
4696 regsub -all ' $gd "'\\''" gd
4697 puts $fd "@ECHO Entering $gw"
4698 puts $fd "@ECHO Starting git-gui... please wait..."
4699 puts -nonewline $fd "@\"$sh\" --login -c \""
4700 puts -nonewline $fd "GIT_DIR='$gd'"
4701 puts -nonewline $fd " '$me'"
4702 puts $fd "&\""
4703 close $fd
4704 } err]} {
4705 error_popup "Cannot write script:\n\n$err"
4706 }
4707 }
4708}
4709proc do_macosx_app {} {
4711 global argv0 env
4712 set fn [tk_getSaveFile \
4714 -parent . \
4715 -title "[appname] ([reponame]): Create Desktop Icon" \
4716 -initialdir [file join $env(HOME) Desktop] \
4717 -initialfile "Git [reponame].app"]
4718 if {$fn != {}} {
4719 if {[catch {
4720 set Contents [file join $fn Contents]
4721 set MacOS [file join $Contents MacOS]
4722 set exe [file join $MacOS git-gui]
4723 file mkdir $MacOS
4725 set fd [open [file join $Contents Info.plist] w]
4727 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4728<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4729<plist version="1.0">
4730<dict>
4731 <key>CFBundleDevelopmentRegion</key>
4732 <string>English</string>
4733 <key>CFBundleExecutable</key>
4734 <string>git-gui</string>
4735 <key>CFBundleIdentifier</key>
4736 <string>org.spearce.git-gui</string>
4737 <key>CFBundleInfoDictionaryVersion</key>
4738 <string>6.0</string>
4739 <key>CFBundlePackageType</key>
4740 <string>APPL</string>
4741 <key>CFBundleSignature</key>
4742 <string>????</string>
4743 <key>CFBundleVersion</key>
4744 <string>1.0</string>
4745 <key>NSPrincipalClass</key>
4746 <string>NSApplication</string>
4747</dict>
4748</plist>}
4749 close $fd
4750 set fd [open $exe w]
4752 set gd [file normalize [gitdir]]
4753 set ep [file normalize [gitexec]]
4754 regsub -all ' $gd "'\\''" gd
4755 regsub -all ' $ep "'\\''" ep
4756 puts $fd "#!/bin/sh"
4757 foreach name [array names env] {
4758 if {[string match GIT_* $name]} {
4759 regsub -all ' $env($name) "'\\''" v
4760 puts $fd "export $name='$v'"
4761 }
4762 }
4763 puts $fd "export PATH='$ep':\$PATH"
4764 puts $fd "export GIT_DIR='$gd'"
4765 puts $fd "exec [file normalize $argv0]"
4766 close $fd
4767 file attributes $exe -permissions u+x,g+x,o+x
4769 } err]} {
4770 error_popup "Cannot write icon:\n\n$err"
4771 }
4772 }
4773}
4774proc toggle_or_diff {w x y} {
4776 global file_states file_lists current_diff_path ui_index ui_workdir
4777 global last_clicked selected_paths
4778 set pos [split [$w index @$x,$y] .]
4780 set lno [lindex $pos 0]
4781 set col [lindex $pos 1]
4782 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4783 if {$path eq {}} {
4784 set last_clicked {}
4785 return
4786 }
4787 set last_clicked [list $w $lno]
4789 array unset selected_paths
4790 $ui_index tag remove in_sel 0.0 end
4791 $ui_workdir tag remove in_sel 0.0 end
4792 if {$col == 0} {
4794 if {$current_diff_path eq $path} {
4795 set after {reshow_diff;}
4796 } else {
4797 set after {}
4798 }
4799 if {$w eq $ui_index} {
4800 update_indexinfo \
4801 "Unstaging [short_path $path] from commit" \
4802 [list $path] \
4803 [concat $after {set ui_status_value {Ready.}}]
4804 } elseif {$w eq $ui_workdir} {
4805 update_index \
4806 "Adding [short_path $path]" \
4807 [list $path] \
4808 [concat $after {set ui_status_value {Ready.}}]
4809 }
4810 } else {
4811 show_diff $path $w $lno
4812 }
4813}
4814proc add_one_to_selection {w x y} {
4816 global file_lists last_clicked selected_paths
4817 set lno [lindex [split [$w index @$x,$y] .] 0]
4819 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4820 if {$path eq {}} {
4821 set last_clicked {}
4822 return
4823 }
4824 if {$last_clicked ne {}
4826 && [lindex $last_clicked 0] ne $w} {
4827 array unset selected_paths
4828 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4829 }
4830 set last_clicked [list $w $lno]
4832 if {[catch {set in_sel $selected_paths($path)}]} {
4833 set in_sel 0
4834 }
4835 if {$in_sel} {
4836 unset selected_paths($path)
4837 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4838 } else {
4839 set selected_paths($path) 1
4840 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4841 }
4842}
4843proc add_range_to_selection {w x y} {
4845 global file_lists last_clicked selected_paths
4846 if {[lindex $last_clicked 0] ne $w} {
4848 toggle_or_diff $w $x $y
4849 return
4850 }
4851 set lno [lindex [split [$w index @$x,$y] .] 0]
4853 set lc [lindex $last_clicked 1]
4854 if {$lc < $lno} {
4855 set begin $lc
4856 set end $lno
4857 } else {
4858 set begin $lno
4859 set end $lc
4860 }
4861 foreach path [lrange $file_lists($w) \
4863 [expr {$begin - 1}] \
4864 [expr {$end - 1}]] {
4865 set selected_paths($path) 1
4866 }
4867 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4868}
4869######################################################################
4871##
4872## config defaults
4873set cursor_ptr arrow
4875font create font_diff -family Courier -size 10
4876font create font_ui
4877catch {
4878 label .dummy
4879 eval font configure font_ui [font actual [.dummy cget -font]]
4880 destroy .dummy
4881}
4882font create font_uibold
4884font create font_diffbold
4885if {[is_Windows]} {
4887 set M1B Control
4888 set M1T Ctrl
4889} elseif {[is_MacOSX]} {
4890 set M1B M1
4891 set M1T Cmd
4892} else {
4893 set M1B M1
4894 set M1T M1
4895}
4896proc apply_config {} {
4898 global repo_config font_descs
4899 foreach option $font_descs {
4901 set name [lindex $option 0]
4902 set font [lindex $option 1]
4903 if {[catch {
4904 foreach {cn cv} $repo_config(gui.$name) {
4905 font configure $font $cn $cv
4906 }
4907 } err]} {
4908 error_popup "Invalid font specified in gui.$name:\n\n$err"
4909 }
4910 foreach {cn cv} [font configure $font] {
4911 font configure ${font}bold $cn $cv
4912 }
4913 font configure ${font}bold -weight bold
4914 }
4915}
4916set default_config(merge.summary) false
4918set default_config(merge.verbosity) 2
4919set default_config(user.name) {}
4920set default_config(user.email) {}
4921set default_config(gui.trustmtime) false
4923set default_config(gui.diffcontext) 5
4924set default_config(gui.newbranchtemplate) {}
4925set default_config(gui.fontui) [font configure font_ui]
4926set default_config(gui.fontdiff) [font configure font_diff]
4927set font_descs {
4928 {fontui font_ui {Main Font}}
4929 {fontdiff font_diff {Diff/Console Font}}
4930}
4931load_config 0
4932apply_config
4933######################################################################
4935##
4936## feature option selection
4937if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
4939 unset _junk
4940} else {
4941 set subcommand gui
4942}
4943if {$subcommand eq {gui.sh}} {
4944 set subcommand gui
4945}
4946if {$subcommand eq {gui} && [llength $argv] > 0} {
4947 set subcommand [lindex $argv 0]
4948 set argv [lrange $argv 1 end]
4949}
4950enable_option multicommit
4952enable_option branch
4953enable_option transport
4954switch -- $subcommand {
4956blame {
4957 disable_option multicommit
4958 disable_option branch
4959 disable_option transport
4960}
4961citool {
4962 enable_option singlecommit
4963 disable_option multicommit
4965 disable_option branch
4966 disable_option transport
4967}
4968}
4969######################################################################
4971##
4972## ui construction
4973set ui_comm {}
4975# -- Menu Bar
4977#
4978menu .mbar -tearoff 0
4979.mbar add cascade -label Repository -menu .mbar.repository
4980.mbar add cascade -label Edit -menu .mbar.edit
4981if {[is_enabled branch]} {
4982 .mbar add cascade -label Branch -menu .mbar.branch
4983}
4984if {[is_enabled multicommit] || [is_enabled singlecommit]} {
4985 .mbar add cascade -label Commit -menu .mbar.commit
4986}
4987if {[is_enabled transport]} {
4988 .mbar add cascade -label Merge -menu .mbar.merge
4989 .mbar add cascade -label Fetch -menu .mbar.fetch
4990 .mbar add cascade -label Push -menu .mbar.push
4991}
4992. configure -menu .mbar
4993# -- Repository Menu
4995#
4996menu .mbar.repository
4997.mbar.repository add command \
4999 -label {Browse Current Branch} \
5000 -command {new_browser $current_branch} \
5001 -font font_ui
5002trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5003.mbar.repository add separator
5004.mbar.repository add command \
5006 -label {Visualize Current Branch} \
5007 -command {do_gitk $current_branch} \
5008 -font font_ui
5009trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5010.mbar.repository add command \
5011 -label {Visualize All Branches} \
5012 -command {do_gitk --all} \
5013 -font font_ui
5014.mbar.repository add separator
5015if {[is_enabled multicommit]} {
5017 .mbar.repository add command -label {Database Statistics} \
5018 -command do_stats \
5019 -font font_ui
5020 .mbar.repository add command -label {Compress Database} \
5022 -command do_gc \
5023 -font font_ui
5024 .mbar.repository add command -label {Verify Database} \
5026 -command do_fsck_objects \
5027 -font font_ui
5028 .mbar.repository add separator
5030 if {[is_Cygwin]} {
5032 .mbar.repository add command \
5033 -label {Create Desktop Icon} \
5034 -command do_cygwin_shortcut \
5035 -font font_ui
5036 } elseif {[is_Windows]} {
5037 .mbar.repository add command \
5038 -label {Create Desktop Icon} \
5039 -command do_windows_shortcut \
5040 -font font_ui
5041 } elseif {[is_MacOSX]} {
5042 .mbar.repository add command \
5043 -label {Create Desktop Icon} \
5044 -command do_macosx_app \
5045 -font font_ui
5046 }
5047}
5048.mbar.repository add command -label Quit \
5050 -command do_quit \
5051 -accelerator $M1T-Q \
5052 -font font_ui
5053# -- Edit Menu
5055#
5056menu .mbar.edit
5057.mbar.edit add command -label Undo \
5058 -command {catch {[focus] edit undo}} \
5059 -accelerator $M1T-Z \
5060 -font font_ui
5061.mbar.edit add command -label Redo \
5062 -command {catch {[focus] edit redo}} \
5063 -accelerator $M1T-Y \
5064 -font font_ui
5065.mbar.edit add separator
5066.mbar.edit add command -label Cut \
5067 -command {catch {tk_textCut [focus]}} \
5068 -accelerator $M1T-X \
5069 -font font_ui
5070.mbar.edit add command -label Copy \
5071 -command {catch {tk_textCopy [focus]}} \
5072 -accelerator $M1T-C \
5073 -font font_ui
5074.mbar.edit add command -label Paste \
5075 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5076 -accelerator $M1T-V \
5077 -font font_ui
5078.mbar.edit add command -label Delete \
5079 -command {catch {[focus] delete sel.first sel.last}} \
5080 -accelerator Del \
5081 -font font_ui
5082.mbar.edit add separator
5083.mbar.edit add command -label {Select All} \
5084 -command {catch {[focus] tag add sel 0.0 end}} \
5085 -accelerator $M1T-A \
5086 -font font_ui
5087# -- Branch Menu
5089#
5090if {[is_enabled branch]} {
5091 menu .mbar.branch
5092 .mbar.branch add command -label {Create...} \
5094 -command do_create_branch \
5095 -accelerator $M1T-N \
5096 -font font_ui
5097 lappend disable_on_lock [list .mbar.branch entryconf \
5098 [.mbar.branch index last] -state]
5099 .mbar.branch add command -label {Delete...} \
5101 -command do_delete_branch \
5102 -font font_ui
5103 lappend disable_on_lock [list .mbar.branch entryconf \
5104 [.mbar.branch index last] -state]
5105}
5106# -- Commit Menu
5108#
5109if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5110 menu .mbar.commit
5111 .mbar.commit add radiobutton \
5113 -label {New Commit} \
5114 -command do_select_commit_type \
5115 -variable selected_commit_type \
5116 -value new \
5117 -font font_ui
5118 lappend disable_on_lock \
5119 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5120 .mbar.commit add radiobutton \
5122 -label {Amend Last Commit} \
5123 -command do_select_commit_type \
5124 -variable selected_commit_type \
5125 -value amend \
5126 -font font_ui
5127 lappend disable_on_lock \
5128 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5129 .mbar.commit add separator
5131 .mbar.commit add command -label Rescan \
5133 -command do_rescan \
5134 -accelerator F5 \
5135 -font font_ui
5136 lappend disable_on_lock \
5137 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5138 .mbar.commit add command -label {Add To Commit} \
5140 -command do_add_selection \
5141 -font font_ui
5142 lappend disable_on_lock \
5143 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5144 .mbar.commit add command -label {Add Existing To Commit} \
5146 -command do_add_all \
5147 -accelerator $M1T-I \
5148 -font font_ui
5149 lappend disable_on_lock \
5150 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5151 .mbar.commit add command -label {Unstage From Commit} \
5153 -command do_unstage_selection \
5154 -font font_ui
5155 lappend disable_on_lock \
5156 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5157 .mbar.commit add command -label {Revert Changes} \
5159 -command do_revert_selection \
5160 -font font_ui
5161 lappend disable_on_lock \
5162 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5163 .mbar.commit add separator
5165 .mbar.commit add command -label {Sign Off} \
5167 -command do_signoff \
5168 -accelerator $M1T-S \
5169 -font font_ui
5170 .mbar.commit add command -label Commit \
5172 -command do_commit \
5173 -accelerator $M1T-Return \
5174 -font font_ui
5175 lappend disable_on_lock \
5176 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5177}
5178if {[is_MacOSX]} {
5180 # -- Apple Menu (Mac OS X only)
5181 #
5182 .mbar add cascade -label Apple -menu .mbar.apple
5183 menu .mbar.apple
5184 .mbar.apple add command -label "About [appname]" \
5186 -command do_about \
5187 -font font_ui
5188 .mbar.apple add command -label "[appname] Options..." \
5189 -command do_options \
5190 -font font_ui
5191} else {
5192 # -- Edit Menu
5193 #
5194 .mbar.edit add separator
5195 .mbar.edit add command -label {Options...} \
5196 -command do_options \
5197 -font font_ui
5198 # -- Tools Menu
5200 #
5201 if {[file exists /usr/local/miga/lib/gui-miga]
5202 && [file exists .pvcsrc]} {
5203 proc do_miga {} {
5204 global ui_status_value
5205 if {![lock_index update]} return
5206 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5207 set miga_fd [open "|$cmd" r]
5208 fconfigure $miga_fd -blocking 0
5209 fileevent $miga_fd readable [list miga_done $miga_fd]
5210 set ui_status_value {Running miga...}
5211 }
5212 proc miga_done {fd} {
5213 read $fd 512
5214 if {[eof $fd]} {
5215 close $fd
5216 unlock_index
5217 rescan [list set ui_status_value {Ready.}]
5218 }
5219 }
5220 .mbar add cascade -label Tools -menu .mbar.tools
5221 menu .mbar.tools
5222 .mbar.tools add command -label "Migrate" \
5223 -command do_miga \
5224 -font font_ui
5225 lappend disable_on_lock \
5226 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5227 }
5228}
5229# -- Help Menu
5231#
5232.mbar add cascade -label Help -menu .mbar.help
5233menu .mbar.help
5234if {![is_MacOSX]} {
5236 .mbar.help add command -label "About [appname]" \
5237 -command do_about \
5238 -font font_ui
5239}
5240set browser {}
5242catch {set browser $repo_config(instaweb.browser)}
5243set doc_path [file dirname [gitexec]]
5244set doc_path [file join $doc_path Documentation index.html]
5245if {[is_Cygwin]} {
5247 set doc_path [exec cygpath --windows $doc_path]
5248}
5249if {$browser eq {}} {
5251 if {[is_MacOSX]} {
5252 set browser open
5253 } elseif {[is_Cygwin]} {
5254 set program_files [file dirname [exec cygpath --windir]]
5255 set program_files [file join $program_files {Program Files}]
5256 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5257 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5258 if {[file exists $firefox]} {
5259 set browser $firefox
5260 } elseif {[file exists $ie]} {
5261 set browser $ie
5262 }
5263 unset program_files firefox ie
5264 }
5265}
5266if {[file isfile $doc_path]} {
5268 set doc_url "file:$doc_path"
5269} else {
5270 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5271}
5272if {$browser ne {}} {
5274 .mbar.help add command -label {Online Documentation} \
5275 -command [list exec $browser $doc_url &] \
5276 -font font_ui
5277}
5278unset browser doc_path doc_url
5279# -- Standard bindings
5281#
5282bind . <Destroy> do_quit
5283bind all <$M1B-Key-q> do_quit
5284bind all <$M1B-Key-Q> do_quit
5285bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5286bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5287# -- Not a normal commit type invocation? Do that instead!
5289#
5290switch -- $subcommand {
5291blame {
5292 if {[llength $argv] != 2} {
5293 puts stderr "usage: $argv0 blame commit path"
5294 exit 1
5295 }
5296 set current_branch [lindex $argv 0]
5297 show_blame $current_branch [lindex $argv 1]
5298 return
5299}
5300citool -
5301gui {
5302 if {[llength $argv] != 0} {
5303 puts -nonewline stderr "usage: $argv0"
5304 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5305 puts -nonewline stderr " $subcommand"
5306 }
5307 puts stderr {}
5308 exit 1
5309 }
5310 # fall through to setup UI for commits
5311}
5312default {
5313 puts stderr "usage: $argv0 \[{blame|citool}\]"
5314 exit 1
5315}
5316}
5317# -- Branch Control
5319#
5320frame .branch \
5321 -borderwidth 1 \
5322 -relief sunken
5323label .branch.l1 \
5324 -text {Current Branch:} \
5325 -anchor w \
5326 -justify left \
5327 -font font_ui
5328label .branch.cb \
5329 -textvariable current_branch \
5330 -anchor w \
5331 -justify left \
5332 -font font_ui
5333pack .branch.l1 -side left
5334pack .branch.cb -side left -fill x
5335pack .branch -side top -fill x
5336if {[is_enabled branch]} {
5338 menu .mbar.merge
5339 .mbar.merge add command -label {Local Merge...} \
5340 -command do_local_merge \
5341 -font font_ui
5342 lappend disable_on_lock \
5343 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5344 .mbar.merge add command -label {Abort Merge...} \
5345 -command do_reset_hard \
5346 -font font_ui
5347 lappend disable_on_lock \
5348 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5349 menu .mbar.fetch
5352 menu .mbar.push
5354 .mbar.push add command -label {Push...} \
5355 -command do_push_anywhere \
5356 -font font_ui
5357}
5358# -- Main Window Layout
5360#
5361panedwindow .vpane -orient vertical
5362panedwindow .vpane.files -orient horizontal
5363.vpane add .vpane.files -sticky nsew -height 100 -width 200
5364pack .vpane -anchor n -side top -fill both -expand 1
5365# -- Index File List
5367#
5368frame .vpane.files.index -height 100 -width 200
5369label .vpane.files.index.title -text {Changes To Be Committed} \
5370 -background green \
5371 -font font_ui
5372text $ui_index -background white -borderwidth 0 \
5373 -width 20 -height 10 \
5374 -wrap none \
5375 -font font_ui \
5376 -cursor $cursor_ptr \
5377 -xscrollcommand {.vpane.files.index.sx set} \
5378 -yscrollcommand {.vpane.files.index.sy set} \
5379 -state disabled
5380scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5381scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5382pack .vpane.files.index.title -side top -fill x
5383pack .vpane.files.index.sx -side bottom -fill x
5384pack .vpane.files.index.sy -side right -fill y
5385pack $ui_index -side left -fill both -expand 1
5386.vpane.files add .vpane.files.index -sticky nsew
5387# -- Working Directory File List
5389#
5390frame .vpane.files.workdir -height 100 -width 200
5391label .vpane.files.workdir.title -text {Changed But Not Updated} \
5392 -background red \
5393 -font font_ui
5394text $ui_workdir -background white -borderwidth 0 \
5395 -width 20 -height 10 \
5396 -wrap none \
5397 -font font_ui \
5398 -cursor $cursor_ptr \
5399 -xscrollcommand {.vpane.files.workdir.sx set} \
5400 -yscrollcommand {.vpane.files.workdir.sy set} \
5401 -state disabled
5402scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5403scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5404pack .vpane.files.workdir.title -side top -fill x
5405pack .vpane.files.workdir.sx -side bottom -fill x
5406pack .vpane.files.workdir.sy -side right -fill y
5407pack $ui_workdir -side left -fill both -expand 1
5408.vpane.files add .vpane.files.workdir -sticky nsew
5409foreach i [list $ui_index $ui_workdir] {
5411 $i tag conf in_diff -font font_uibold
5412 $i tag conf in_sel \
5413 -background [$i cget -foreground] \
5414 -foreground [$i cget -background]
5415}
5416unset i
5417# -- Diff and Commit Area
5419#
5420frame .vpane.lower -height 300 -width 400
5421frame .vpane.lower.commarea
5422frame .vpane.lower.diff -relief sunken -borderwidth 1
5423pack .vpane.lower.commarea -side top -fill x
5424pack .vpane.lower.diff -side bottom -fill both -expand 1
5425.vpane add .vpane.lower -sticky nsew
5426# -- Commit Area Buttons
5428#
5429frame .vpane.lower.commarea.buttons
5430label .vpane.lower.commarea.buttons.l -text {} \
5431 -anchor w \
5432 -justify left \
5433 -font font_ui
5434pack .vpane.lower.commarea.buttons.l -side top -fill x
5435pack .vpane.lower.commarea.buttons -side left -fill y
5436button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5438 -command do_rescan \
5439 -font font_ui
5440pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5441lappend disable_on_lock \
5442 {.vpane.lower.commarea.buttons.rescan conf -state}
5443button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5445 -command do_add_all \
5446 -font font_ui
5447pack .vpane.lower.commarea.buttons.incall -side top -fill x
5448lappend disable_on_lock \
5449 {.vpane.lower.commarea.buttons.incall conf -state}
5450button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5452 -command do_signoff \
5453 -font font_ui
5454pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5455button .vpane.lower.commarea.buttons.commit -text {Commit} \
5457 -command do_commit \
5458 -font font_ui
5459pack .vpane.lower.commarea.buttons.commit -side top -fill x
5460lappend disable_on_lock \
5461 {.vpane.lower.commarea.buttons.commit conf -state}
5462# -- Commit Message Buffer
5464#
5465frame .vpane.lower.commarea.buffer
5466frame .vpane.lower.commarea.buffer.header
5467set ui_comm .vpane.lower.commarea.buffer.t
5468set ui_coml .vpane.lower.commarea.buffer.header.l
5469radiobutton .vpane.lower.commarea.buffer.header.new \
5470 -text {New Commit} \
5471 -command do_select_commit_type \
5472 -variable selected_commit_type \
5473 -value new \
5474 -font font_ui
5475lappend disable_on_lock \
5476 [list .vpane.lower.commarea.buffer.header.new conf -state]
5477radiobutton .vpane.lower.commarea.buffer.header.amend \
5478 -text {Amend Last Commit} \
5479 -command do_select_commit_type \
5480 -variable selected_commit_type \
5481 -value amend \
5482 -font font_ui
5483lappend disable_on_lock \
5484 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5485label $ui_coml \
5486 -anchor w \
5487 -justify left \
5488 -font font_ui
5489proc trace_commit_type {varname args} {
5490 global ui_coml commit_type
5491 switch -glob -- $commit_type {
5492 initial {set txt {Initial Commit Message:}}
5493 amend {set txt {Amended Commit Message:}}
5494 amend-initial {set txt {Amended Initial Commit Message:}}
5495 amend-merge {set txt {Amended Merge Commit Message:}}
5496 merge {set txt {Merge Commit Message:}}
5497 * {set txt {Commit Message:}}
5498 }
5499 $ui_coml conf -text $txt
5500}
5501trace add variable commit_type write trace_commit_type
5502pack $ui_coml -side left -fill x
5503pack .vpane.lower.commarea.buffer.header.amend -side right
5504pack .vpane.lower.commarea.buffer.header.new -side right
5505text $ui_comm -background white -borderwidth 1 \
5507 -undo true \
5508 -maxundo 20 \
5509 -autoseparators true \
5510 -relief sunken \
5511 -width 75 -height 9 -wrap none \
5512 -font font_diff \
5513 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5514scrollbar .vpane.lower.commarea.buffer.sby \
5515 -command [list $ui_comm yview]
5516pack .vpane.lower.commarea.buffer.header -side top -fill x
5517pack .vpane.lower.commarea.buffer.sby -side right -fill y
5518pack $ui_comm -side left -fill y
5519pack .vpane.lower.commarea.buffer -side left -fill y
5520# -- Commit Message Buffer Context Menu
5522#
5523set ctxm .vpane.lower.commarea.buffer.ctxm
5524menu $ctxm -tearoff 0
5525$ctxm add command \
5526 -label {Cut} \
5527 -font font_ui \
5528 -command {tk_textCut $ui_comm}
5529$ctxm add command \
5530 -label {Copy} \
5531 -font font_ui \
5532 -command {tk_textCopy $ui_comm}
5533$ctxm add command \
5534 -label {Paste} \
5535 -font font_ui \
5536 -command {tk_textPaste $ui_comm}
5537$ctxm add command \
5538 -label {Delete} \
5539 -font font_ui \
5540 -command {$ui_comm delete sel.first sel.last}
5541$ctxm add separator
5542$ctxm add command \
5543 -label {Select All} \
5544 -font font_ui \
5545 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5546$ctxm add command \
5547 -label {Copy All} \
5548 -font font_ui \
5549 -command {
5550 $ui_comm tag add sel 0.0 end
5551 tk_textCopy $ui_comm
5552 $ui_comm tag remove sel 0.0 end
5553 }
5554$ctxm add separator
5555$ctxm add command \
5556 -label {Sign Off} \
5557 -font font_ui \
5558 -command do_signoff
5559bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5560# -- Diff Header
5562#
5563set current_diff_path {}
5564set current_diff_side {}
5565set diff_actions [list]
5566proc trace_current_diff_path {varname args} {
5567 global current_diff_path diff_actions file_states
5568 if {$current_diff_path eq {}} {
5569 set s {}
5570 set f {}
5571 set p {}
5572 set o disabled
5573 } else {
5574 set p $current_diff_path
5575 set s [mapdesc [lindex $file_states($p) 0] $p]
5576 set f {File:}
5577 set p [escape_path $p]
5578 set o normal
5579 }
5580 .vpane.lower.diff.header.status configure -text $s
5582 .vpane.lower.diff.header.file configure -text $f
5583 .vpane.lower.diff.header.path configure -text $p
5584 foreach w $diff_actions {
5585 uplevel #0 $w $o
5586 }
5587}
5588trace add variable current_diff_path write trace_current_diff_path
5589frame .vpane.lower.diff.header -background orange
5591label .vpane.lower.diff.header.status \
5592 -background orange \
5593 -width $max_status_desc \
5594 -anchor w \
5595 -justify left \
5596 -font font_ui
5597label .vpane.lower.diff.header.file \
5598 -background orange \
5599 -anchor w \
5600 -justify left \
5601 -font font_ui
5602label .vpane.lower.diff.header.path \
5603 -background orange \
5604 -anchor w \
5605 -justify left \
5606 -font font_ui
5607pack .vpane.lower.diff.header.status -side left
5608pack .vpane.lower.diff.header.file -side left
5609pack .vpane.lower.diff.header.path -fill x
5610set ctxm .vpane.lower.diff.header.ctxm
5611menu $ctxm -tearoff 0
5612$ctxm add command \
5613 -label {Copy} \
5614 -font font_ui \
5615 -command {
5616 clipboard clear
5617 clipboard append \
5618 -format STRING \
5619 -type STRING \
5620 -- $current_diff_path
5621 }
5622lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5623bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5624# -- Diff Body
5626#
5627frame .vpane.lower.diff.body
5628set ui_diff .vpane.lower.diff.body.t
5629text $ui_diff -background white -borderwidth 0 \
5630 -width 80 -height 15 -wrap none \
5631 -font font_diff \
5632 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5633 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5634 -state disabled
5635scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5636 -command [list $ui_diff xview]
5637scrollbar .vpane.lower.diff.body.sby -orient vertical \
5638 -command [list $ui_diff yview]
5639pack .vpane.lower.diff.body.sbx -side bottom -fill x
5640pack .vpane.lower.diff.body.sby -side right -fill y
5641pack $ui_diff -side left -fill both -expand 1
5642pack .vpane.lower.diff.header -side top -fill x
5643pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5644$ui_diff tag conf d_cr -elide true
5646$ui_diff tag conf d_@ -foreground blue -font font_diffbold
5647$ui_diff tag conf d_+ -foreground {#00a000}
5648$ui_diff tag conf d_- -foreground red
5649$ui_diff tag conf d_++ -foreground {#00a000}
5651$ui_diff tag conf d_-- -foreground red
5652$ui_diff tag conf d_+s \
5653 -foreground {#00a000} \
5654 -background {#e2effa}
5655$ui_diff tag conf d_-s \
5656 -foreground red \
5657 -background {#e2effa}
5658$ui_diff tag conf d_s+ \
5659 -foreground {#00a000} \
5660 -background ivory1
5661$ui_diff tag conf d_s- \
5662 -foreground red \
5663 -background ivory1
5664$ui_diff tag conf d<<<<<<< \
5666 -foreground orange \
5667 -font font_diffbold
5668$ui_diff tag conf d======= \
5669 -foreground orange \
5670 -font font_diffbold
5671$ui_diff tag conf d>>>>>>> \
5672 -foreground orange \
5673 -font font_diffbold
5674$ui_diff tag raise sel
5676# -- Diff Body Context Menu
5678#
5679set ctxm .vpane.lower.diff.body.ctxm
5680menu $ctxm -tearoff 0
5681$ctxm add command \
5682 -label {Refresh} \
5683 -font font_ui \
5684 -command reshow_diff
5685lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5686$ctxm add command \
5687 -label {Copy} \
5688 -font font_ui \
5689 -command {tk_textCopy $ui_diff}
5690lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5691$ctxm add command \
5692 -label {Select All} \
5693 -font font_ui \
5694 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5695lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5696$ctxm add command \
5697 -label {Copy All} \
5698 -font font_ui \
5699 -command {
5700 $ui_diff tag add sel 0.0 end
5701 tk_textCopy $ui_diff
5702 $ui_diff tag remove sel 0.0 end
5703 }
5704lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5705$ctxm add separator
5706$ctxm add command \
5707 -label {Apply/Reverse Hunk} \
5708 -font font_ui \
5709 -command {apply_hunk $cursorX $cursorY}
5710set ui_diff_applyhunk [$ctxm index last]
5711lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5712$ctxm add separator
5713$ctxm add command \
5714 -label {Decrease Font Size} \
5715 -font font_ui \
5716 -command {incr_font_size font_diff -1}
5717lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5718$ctxm add command \
5719 -label {Increase Font Size} \
5720 -font font_ui \
5721 -command {incr_font_size font_diff 1}
5722lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5723$ctxm add separator
5724$ctxm add command \
5725 -label {Show Less Context} \
5726 -font font_ui \
5727 -command {if {$repo_config(gui.diffcontext) >= 2} {
5728 incr repo_config(gui.diffcontext) -1
5729 reshow_diff
5730 }}
5731lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5732$ctxm add command \
5733 -label {Show More Context} \
5734 -font font_ui \
5735 -command {
5736 incr repo_config(gui.diffcontext)
5737 reshow_diff
5738 }
5739lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5740$ctxm add separator
5741$ctxm add command -label {Options...} \
5742 -font font_ui \
5743 -command do_options
5744bind_button3 $ui_diff "
5745 set cursorX %x
5746 set cursorY %y
5747 if {\$ui_index eq \$current_diff_side} {
5748 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5749 } else {
5750 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5751 }
5752 tk_popup $ctxm %X %Y
5753"
5754unset ui_diff_applyhunk
5755# -- Status Bar
5757#
5758set ui_status_value {Initializing...}
5759label .status -textvariable ui_status_value \
5760 -anchor w \
5761 -justify left \
5762 -borderwidth 1 \
5763 -relief sunken \
5764 -font font_ui
5765pack .status -anchor w -side bottom -fill x
5766# -- Load geometry
5768#
5769catch {
5770set gm $repo_config(gui.geometry)
5771wm geometry . [lindex $gm 0]
5772.vpane sash place 0 \
5773 [lindex [.vpane sash coord 0] 0] \
5774 [lindex $gm 1]
5775.vpane.files sash place 0 \
5776 [lindex $gm 2] \
5777 [lindex [.vpane.files sash coord 0] 1]
5778unset gm
5779}
5780# -- Key Bindings
5782#
5783bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5784bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5785bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5786bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5787bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5788bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5789bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5790bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5791bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5792bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5793bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5794bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5796bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5797bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5798bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5799bind $ui_diff <$M1B-Key-v> {break}
5800bind $ui_diff <$M1B-Key-V> {break}
5801bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5802bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5803bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5804bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5805bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5806bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5807bind $ui_diff <Button-1> {focus %W}
5808if {[is_enabled branch]} {
5810 bind . <$M1B-Key-n> do_create_branch
5811 bind . <$M1B-Key-N> do_create_branch
5812}
5813bind all <Key-F5> do_rescan
5815bind all <$M1B-Key-r> do_rescan
5816bind all <$M1B-Key-R> do_rescan
5817bind . <$M1B-Key-s> do_signoff
5818bind . <$M1B-Key-S> do_signoff
5819bind . <$M1B-Key-i> do_add_all
5820bind . <$M1B-Key-I> do_add_all
5821bind . <$M1B-Key-Return> do_commit
5822foreach i [list $ui_index $ui_workdir] {
5823 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
5824 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5825 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5826}
5827unset i
5828set file_lists($ui_index) [list]
5830set file_lists($ui_workdir) [list]
5831set HEAD {}
5833set PARENT {}
5834set MERGE_HEAD [list]
5835set commit_type {}
5836set empty_tree {}
5837set current_branch {}
5838set current_diff_path {}
5839set selected_commit_type new
5840wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5842focus -force $ui_comm
5843# -- Warn the user about environmental problems. Cygwin's Tcl
5845# does *not* pass its env array onto any processes it spawns.
5846# This means that git processes get none of our environment.
5847#
5848if {[is_Cygwin]} {
5849 set ignored_env 0
5850 set suggest_user {}
5851 set msg "Possible environment issues exist.
5852The following environment variables are probably
5854going to be ignored by any Git subprocess run
5855by [appname]:
5856"
5858 foreach name [array names env] {
5859 switch -regexp -- $name {
5860 {^GIT_INDEX_FILE$} -
5861 {^GIT_OBJECT_DIRECTORY$} -
5862 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5863 {^GIT_DIFF_OPTS$} -
5864 {^GIT_EXTERNAL_DIFF$} -
5865 {^GIT_PAGER$} -
5866 {^GIT_TRACE$} -
5867 {^GIT_CONFIG$} -
5868 {^GIT_CONFIG_LOCAL$} -
5869 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5870 append msg " - $name\n"
5871 incr ignored_env
5872 }
5873 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5874 append msg " - $name\n"
5875 incr ignored_env
5876 set suggest_user $name
5877 }
5878 }
5879 }
5880 if {$ignored_env > 0} {
5881 append msg "
5882This is due to a known issue with the
5883Tcl binary distributed by Cygwin."
5884 if {$suggest_user ne {}} {
5886 append msg "
5887A good replacement for $suggest_user
5889is placing values for the user.name and
5890user.email settings into your personal
5891~/.gitconfig file.
5892"
5893 }
5894 warn_popup $msg
5895 }
5896 unset ignored_env msg suggest_user name
5897}
5898# -- Only initialize complex UI if we are going to stay running.
5900#
5901if {[is_enabled transport]} {
5902 load_all_remotes
5903 load_all_heads
5904 populate_branch_menu
5906 populate_fetch_menu
5907 populate_push_menu
5908}
5909# -- Only suggest a gc run if we are going to stay running.
5911#
5912if {[is_enabled multicommit]} {
5913 set object_limit 2000
5914 if {[is_Windows]} {set object_limit 200}
5915 regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
5916 if {$objects_current >= $object_limit} {
5917 if {[ask_popup \
5918 "This repository currently has $objects_current loose objects.
5919To maintain optimal performance it is strongly
5921recommended that you compress the database
5922when more than $object_limit loose objects exist.
5923Compress the database now?"] eq yes} {
5925 do_gc
5926 }
5927 }
5928 unset object_limit _junk objects_current
5929}
5930lock_index begin-read
5932after 1 do_rescan