1f13f7f9b20ae0d1af0ab68ec089660f83473714
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4set appvers {@@GIT_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 [exec 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}
95######################################################################
97##
98## config
99proc is_many_config {name} {
101 switch -glob -- $name {
102 remote.*.fetch -
103 remote.*.push
104 {return 1}
105 *
106 {return 0}
107 }
108}
109proc is_config_true {name} {
111 global repo_config
112 if {[catch {set v $repo_config($name)}]} {
113 return 0
114 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
115 return 1
116 } else {
117 return 0
118 }
119}
120proc load_config {include_global} {
122 global repo_config global_config default_config
123 array unset global_config
125 if {$include_global} {
126 catch {
127 set fd_rc [open "| git repo-config --global --list" r]
128 while {[gets $fd_rc line] >= 0} {
129 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
130 if {[is_many_config $name]} {
131 lappend global_config($name) $value
132 } else {
133 set global_config($name) $value
134 }
135 }
136 }
137 close $fd_rc
138 }
139 }
140 array unset repo_config
142 catch {
143 set fd_rc [open "| git repo-config --list" r]
144 while {[gets $fd_rc line] >= 0} {
145 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
146 if {[is_many_config $name]} {
147 lappend repo_config($name) $value
148 } else {
149 set repo_config($name) $value
150 }
151 }
152 }
153 close $fd_rc
154 }
155 foreach name [array names default_config] {
157 if {[catch {set v $global_config($name)}]} {
158 set global_config($name) $default_config($name)
159 }
160 if {[catch {set v $repo_config($name)}]} {
161 set repo_config($name) $default_config($name)
162 }
163 }
164}
165proc save_config {} {
167 global default_config font_descs
168 global repo_config global_config
169 global repo_config_new global_config_new
170 foreach option $font_descs {
172 set name [lindex $option 0]
173 set font [lindex $option 1]
174 font configure $font \
175 -family $global_config_new(gui.$font^^family) \
176 -size $global_config_new(gui.$font^^size)
177 font configure ${font}bold \
178 -family $global_config_new(gui.$font^^family) \
179 -size $global_config_new(gui.$font^^size)
180 set global_config_new(gui.$name) [font configure $font]
181 unset global_config_new(gui.$font^^family)
182 unset global_config_new(gui.$font^^size)
183 }
184 foreach name [array names default_config] {
186 set value $global_config_new($name)
187 if {$value ne $global_config($name)} {
188 if {$value eq $default_config($name)} {
189 catch {exec git repo-config --global --unset $name}
190 } else {
191 regsub -all "\[{}\]" $value {"} value
192 exec git repo-config --global $name $value
193 }
194 set global_config($name) $value
195 if {$value eq $repo_config($name)} {
196 catch {exec git repo-config --unset $name}
197 set repo_config($name) $value
198 }
199 }
200 }
201 foreach name [array names default_config] {
203 set value $repo_config_new($name)
204 if {$value ne $repo_config($name)} {
205 if {$value eq $global_config($name)} {
206 catch {exec git repo-config --unset $name}
207 } else {
208 regsub -all "\[{}\]" $value {"} value
209 exec git repo-config $name $value
210 }
211 set repo_config($name) $value
212 }
213 }
214}
215proc error_popup {msg} {
217 set title [appname]
218 if {[reponame] ne {}} {
219 append title " ([reponame])"
220 }
221 set cmd [list tk_messageBox \
222 -icon error \
223 -type ok \
224 -title "$title: error" \
225 -message $msg]
226 if {[winfo ismapped .]} {
227 lappend cmd -parent .
228 }
229 eval $cmd
230}
231proc warn_popup {msg} {
233 set title [appname]
234 if {[reponame] ne {}} {
235 append title " ([reponame])"
236 }
237 set cmd [list tk_messageBox \
238 -icon warning \
239 -type ok \
240 -title "$title: warning" \
241 -message $msg]
242 if {[winfo ismapped .]} {
243 lappend cmd -parent .
244 }
245 eval $cmd
246}
247proc info_popup {msg {parent .}} {
249 set title [appname]
250 if {[reponame] ne {}} {
251 append title " ([reponame])"
252 }
253 tk_messageBox \
254 -parent $parent \
255 -icon info \
256 -type ok \
257 -title $title \
258 -message $msg
259}
260proc ask_popup {msg} {
262 set title [appname]
263 if {[reponame] ne {}} {
264 append title " ([reponame])"
265 }
266 return [tk_messageBox \
267 -parent . \
268 -icon question \
269 -type yesno \
270 -title $title \
271 -message $msg]
272}
273######################################################################
275##
276## repository setup
277if { [catch {set _gitdir $env(GIT_DIR)}]
279 && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
280 catch {wm withdraw .}
281 error_popup "Cannot find the git directory:\n\n$err"
282 exit 1
283}
284if {![file isdirectory $_gitdir] && [is_Cygwin]} {
285 catch {set _gitdir [exec cygpath --unix $_gitdir]}
286}
287if {![file isdirectory $_gitdir]} {
288 catch {wm withdraw .}
289 error_popup "Git directory not found:\n\n$_gitdir"
290 exit 1
291}
292if {[lindex [file split $_gitdir] end] ne {.git}} {
293 catch {wm withdraw .}
294 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
295 exit 1
296}
297if {[catch {cd [file dirname $_gitdir]} err]} {
298 catch {wm withdraw .}
299 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
300 exit 1
301}
302set _reponame [lindex [file split \
303 [file normalize [file dirname $_gitdir]]] \
304 end]
305set single_commit 0
307if {[appname] eq {git-citool}} {
308 set single_commit 1
309}
310######################################################################
312##
313## task management
314set rescan_active 0
316set diff_active 0
317set last_clicked {}
318set disable_on_lock [list]
320set index_lock_type none
321proc lock_index {type} {
323 global index_lock_type disable_on_lock
324 if {$index_lock_type eq {none}} {
326 set index_lock_type $type
327 foreach w $disable_on_lock {
328 uplevel #0 $w disabled
329 }
330 return 1
331 } elseif {$index_lock_type eq "begin-$type"} {
332 set index_lock_type $type
333 return 1
334 }
335 return 0
336}
337proc unlock_index {} {
339 global index_lock_type disable_on_lock
340 set index_lock_type none
342 foreach w $disable_on_lock {
343 uplevel #0 $w normal
344 }
345}
346######################################################################
348##
349## status
350proc repository_state {ctvar hdvar mhvar} {
352 global current_branch
353 upvar $ctvar ct $hdvar hd $mhvar mh
354 set mh [list]
356 if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
358 set current_branch {}
359 } else {
360 regsub ^refs/((heads|tags|remotes)/)? \
361 $current_branch \
362 {} \
363 current_branch
364 }
365 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
367 set hd {}
368 set ct initial
369 return
370 }
371 set merge_head [gitdir MERGE_HEAD]
373 if {[file exists $merge_head]} {
374 set ct merge
375 set fd_mh [open $merge_head r]
376 while {[gets $fd_mh line] >= 0} {
377 lappend mh $line
378 }
379 close $fd_mh
380 return
381 }
382 set ct normal
384}
385proc PARENT {} {
387 global PARENT empty_tree
388 set p [lindex $PARENT 0]
390 if {$p ne {}} {
391 return $p
392 }
393 if {$empty_tree eq {}} {
394 set empty_tree [exec git mktree << {}]
395 }
396 return $empty_tree
397}
398proc rescan {after {honor_trustmtime 1}} {
400 global HEAD PARENT MERGE_HEAD commit_type
401 global ui_index ui_workdir ui_status_value ui_comm
402 global rescan_active file_states
403 global repo_config
404 if {$rescan_active > 0 || ![lock_index read]} return
406 repository_state newType newHEAD newMERGE_HEAD
408 if {[string match amend* $commit_type]
409 && $newType eq {normal}
410 && $newHEAD eq $HEAD} {
411 } else {
412 set HEAD $newHEAD
413 set PARENT $newHEAD
414 set MERGE_HEAD $newMERGE_HEAD
415 set commit_type $newType
416 }
417 array unset file_states
419 if {![$ui_comm edit modified]
421 || [string trim [$ui_comm get 0.0 end]] eq {}} {
422 if {[load_message GITGUI_MSG]} {
423 } elseif {[load_message MERGE_MSG]} {
424 } elseif {[load_message SQUASH_MSG]} {
425 }
426 $ui_comm edit reset
427 $ui_comm edit modified false
428 }
429 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
431 rescan_stage2 {} $after
432 } else {
433 set rescan_active 1
434 set ui_status_value {Refreshing file status...}
435 set cmd [list git update-index]
436 lappend cmd -q
437 lappend cmd --unmerged
438 lappend cmd --ignore-missing
439 lappend cmd --refresh
440 set fd_rf [open "| $cmd" r]
441 fconfigure $fd_rf -blocking 0 -translation binary
442 fileevent $fd_rf readable \
443 [list rescan_stage2 $fd_rf $after]
444 }
445}
446proc rescan_stage2 {fd after} {
448 global ui_status_value
449 global rescan_active buf_rdi buf_rdf buf_rlo
450 if {$fd ne {}} {
452 read $fd
453 if {![eof $fd]} return
454 close $fd
455 }
456 set ls_others [list | git ls-files --others -z \
458 --exclude-per-directory=.gitignore]
459 set info_exclude [gitdir info exclude]
460 if {[file readable $info_exclude]} {
461 lappend ls_others "--exclude-from=$info_exclude"
462 }
463 set buf_rdi {}
465 set buf_rdf {}
466 set buf_rlo {}
467 set rescan_active 3
469 set ui_status_value {Scanning for modified files ...}
470 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
471 set fd_df [open "| git diff-files -z" r]
472 set fd_lo [open $ls_others r]
473 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
475 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
476 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
477 fileevent $fd_di readable [list read_diff_index $fd_di $after]
478 fileevent $fd_df readable [list read_diff_files $fd_df $after]
479 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
480}
481proc load_message {file} {
483 global ui_comm
484 set f [gitdir $file]
486 if {[file isfile $f]} {
487 if {[catch {set fd [open $f r]}]} {
488 return 0
489 }
490 set content [string trim [read $fd]]
491 close $fd
492 regsub -all -line {[ \r\t]+$} $content {} content
493 $ui_comm delete 0.0 end
494 $ui_comm insert end $content
495 return 1
496 }
497 return 0
498}
499proc read_diff_index {fd after} {
501 global buf_rdi
502 append buf_rdi [read $fd]
504 set c 0
505 set n [string length $buf_rdi]
506 while {$c < $n} {
507 set z1 [string first "\0" $buf_rdi $c]
508 if {$z1 == -1} break
509 incr z1
510 set z2 [string first "\0" $buf_rdi $z1]
511 if {$z2 == -1} break
512 incr c
514 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
515 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
516 merge_state \
517 [encoding convertfrom $p] \
518 [lindex $i 4]? \
519 [list [lindex $i 0] [lindex $i 2]] \
520 [list]
521 set c $z2
522 incr c
523 }
524 if {$c < $n} {
525 set buf_rdi [string range $buf_rdi $c end]
526 } else {
527 set buf_rdi {}
528 }
529 rescan_done $fd buf_rdi $after
531}
532proc read_diff_files {fd after} {
534 global buf_rdf
535 append buf_rdf [read $fd]
537 set c 0
538 set n [string length $buf_rdf]
539 while {$c < $n} {
540 set z1 [string first "\0" $buf_rdf $c]
541 if {$z1 == -1} break
542 incr z1
543 set z2 [string first "\0" $buf_rdf $z1]
544 if {$z2 == -1} break
545 incr c
547 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
548 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
549 merge_state \
550 [encoding convertfrom $p] \
551 ?[lindex $i 4] \
552 [list] \
553 [list [lindex $i 0] [lindex $i 2]]
554 set c $z2
555 incr c
556 }
557 if {$c < $n} {
558 set buf_rdf [string range $buf_rdf $c end]
559 } else {
560 set buf_rdf {}
561 }
562 rescan_done $fd buf_rdf $after
564}
565proc read_ls_others {fd after} {
567 global buf_rlo
568 append buf_rlo [read $fd]
570 set pck [split $buf_rlo "\0"]
571 set buf_rlo [lindex $pck end]
572 foreach p [lrange $pck 0 end-1] {
573 merge_state [encoding convertfrom $p] ?O
574 }
575 rescan_done $fd buf_rlo $after
576}
577proc rescan_done {fd buf after} {
579 global rescan_active
580 global file_states repo_config
581 upvar $buf to_clear
582 if {![eof $fd]} return
584 set to_clear {}
585 close $fd
586 if {[incr rescan_active -1] > 0} return
587 prune_selection
589 unlock_index
590 display_all_files
591 reshow_diff
592 uplevel #0 $after
593}
594proc prune_selection {} {
596 global file_states selected_paths
597 foreach path [array names selected_paths] {
599 if {[catch {set still_here $file_states($path)}]} {
600 unset selected_paths($path)
601 }
602 }
603}
604######################################################################
606##
607## diff
608proc clear_diff {} {
610 global ui_diff current_diff_path current_diff_header
611 global ui_index ui_workdir
612 $ui_diff conf -state normal
614 $ui_diff delete 0.0 end
615 $ui_diff conf -state disabled
616 set current_diff_path {}
618 set current_diff_header {}
619 $ui_index tag remove in_diff 0.0 end
621 $ui_workdir tag remove in_diff 0.0 end
622}
623proc reshow_diff {} {
625 global ui_status_value file_states file_lists
626 global current_diff_path current_diff_side
627 set p $current_diff_path
629 if {$p eq {}
630 || $current_diff_side eq {}
631 || [catch {set s $file_states($p)}]
632 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
633 clear_diff
634 } else {
635 show_diff $p $current_diff_side
636 }
637}
638proc handle_empty_diff {} {
640 global current_diff_path file_states file_lists
641 set path $current_diff_path
643 set s $file_states($path)
644 if {[lindex $s 0] ne {_M}} return
645 info_popup "No differences detected.
647[short_path $path] has no changes.
649The modification date of this file was updated
651by another application, but the content within
652the file was not changed.
653A rescan will be automatically started to find
655other files which may have the same state."
656 clear_diff
658 display_file $path __
659 rescan {set ui_status_value {Ready.}} 0
660}
661proc show_diff {path w {lno {}}} {
663 global file_states file_lists
664 global is_3way_diff diff_active repo_config
665 global ui_diff ui_status_value ui_index ui_workdir
666 global current_diff_path current_diff_side current_diff_header
667 if {$diff_active || ![lock_index read]} return
669 clear_diff
671 if {$lno == {}} {
672 set lno [lsearch -sorted -exact $file_lists($w) $path]
673 if {$lno >= 0} {
674 incr lno
675 }
676 }
677 if {$lno >= 1} {
678 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
679 }
680 set s $file_states($path)
682 set m [lindex $s 0]
683 set is_3way_diff 0
684 set diff_active 1
685 set current_diff_path $path
686 set current_diff_side $w
687 set current_diff_header {}
688 set ui_status_value "Loading diff of [escape_path $path]..."
689 # - Git won't give us the diff, there's nothing to compare to!
691 #
692 if {$m eq {_O}} {
693 set max_sz [expr {128 * 1024}]
694 if {[catch {
695 set fd [open $path r]
696 set content [read $fd $max_sz]
697 close $fd
698 set sz [file size $path]
699 } err ]} {
700 set diff_active 0
701 unlock_index
702 set ui_status_value "Unable to display [escape_path $path]"
703 error_popup "Error loading file:\n\n$err"
704 return
705 }
706 $ui_diff conf -state normal
707 if {![catch {set type [exec file $path]}]} {
708 set n [string length $path]
709 if {[string equal -length $n $path $type]} {
710 set type [string range $type $n end]
711 regsub {^:?\s*} $type {} type
712 }
713 $ui_diff insert end "* $type\n" d_@
714 }
715 if {[string first "\0" $content] != -1} {
716 $ui_diff insert end \
717 "* Binary file (not showing content)." \
718 d_@
719 } else {
720 if {$sz > $max_sz} {
721 $ui_diff insert end \
722"* Untracked file is $sz bytes.
723* Showing only first $max_sz bytes.
724" d_@
725 }
726 $ui_diff insert end $content
727 if {$sz > $max_sz} {
728 $ui_diff insert end "
729* Untracked file clipped here by [appname].
730* To see the entire file, use an external editor.
731" d_@
732 }
733 }
734 $ui_diff conf -state disabled
735 set diff_active 0
736 unlock_index
737 set ui_status_value {Ready.}
738 return
739 }
740 set cmd [list | git]
742 if {$w eq $ui_index} {
743 lappend cmd diff-index
744 lappend cmd --cached
745 } elseif {$w eq $ui_workdir} {
746 if {[string index $m 0] eq {U}} {
747 lappend cmd diff
748 } else {
749 lappend cmd diff-files
750 }
751 }
752 lappend cmd -p
754 lappend cmd --no-color
755 if {$repo_config(gui.diffcontext) > 0} {
756 lappend cmd "-U$repo_config(gui.diffcontext)"
757 }
758 if {$w eq $ui_index} {
759 lappend cmd [PARENT]
760 }
761 lappend cmd --
762 lappend cmd $path
763 if {[catch {set fd [open $cmd r]} err]} {
765 set diff_active 0
766 unlock_index
767 set ui_status_value "Unable to display [escape_path $path]"
768 error_popup "Error loading diff:\n\n$err"
769 return
770 }
771 fconfigure $fd \
773 -blocking 0 \
774 -encoding binary \
775 -translation binary
776 fileevent $fd readable [list read_diff $fd]
777}
778proc read_diff {fd} {
780 global ui_diff ui_status_value diff_active
781 global is_3way_diff current_diff_header
782 $ui_diff conf -state normal
784 while {[gets $fd line] >= 0} {
785 # -- Cleanup uninteresting diff header lines.
786 #
787 if { [string match {diff --git *} $line]
788 || [string match {diff --cc *} $line]
789 || [string match {diff --combined *} $line]
790 || [string match {--- *} $line]
791 || [string match {+++ *} $line]} {
792 append current_diff_header $line "\n"
793 continue
794 }
795 if {[string match {index *} $line]} continue
796 if {$line eq {deleted file mode 120000}} {
797 set line "deleted symlink"
798 }
799 # -- Automatically detect if this is a 3 way diff.
801 #
802 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
803 if {[string match {mode *} $line]
805 || [string match {new file *} $line]
806 || [string match {deleted file *} $line]
807 || [string match {Binary files * and * differ} $line]
808 || $line eq {\ No newline at end of file}
809 || [regexp {^\* Unmerged path } $line]} {
810 set tags {}
811 } elseif {$is_3way_diff} {
812 set op [string range $line 0 1]
813 switch -- $op {
814 { } {set tags {}}
815 {@@} {set tags d_@}
816 { +} {set tags d_s+}
817 { -} {set tags d_s-}
818 {+ } {set tags d_+s}
819 {- } {set tags d_-s}
820 {--} {set tags d_--}
821 {++} {
822 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
823 set line [string replace $line 0 1 { }]
824 set tags d$op
825 } else {
826 set tags d_++
827 }
828 }
829 default {
830 puts "error: Unhandled 3 way diff marker: {$op}"
831 set tags {}
832 }
833 }
834 } else {
835 set op [string index $line 0]
836 switch -- $op {
837 { } {set tags {}}
838 {@} {set tags d_@}
839 {-} {set tags d_-}
840 {+} {
841 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
842 set line [string replace $line 0 0 { }]
843 set tags d$op
844 } else {
845 set tags d_+
846 }
847 }
848 default {
849 puts "error: Unhandled 2 way diff marker: {$op}"
850 set tags {}
851 }
852 }
853 }
854 $ui_diff insert end $line $tags
855 if {[string index $line end] eq "\r"} {
856 $ui_diff tag add d_cr {end - 2c}
857 }
858 $ui_diff insert end "\n" $tags
859 }
860 $ui_diff conf -state disabled
861 if {[eof $fd]} {
863 close $fd
864 set diff_active 0
865 unlock_index
866 set ui_status_value {Ready.}
867 if {[$ui_diff index end] eq {2.0}} {
869 handle_empty_diff
870 }
871 }
872}
873proc apply_hunk {x y} {
875 global current_diff_path current_diff_header current_diff_side
876 global ui_diff ui_index file_states
877 if {$current_diff_path eq {} || $current_diff_header eq {}} return
879 if {![lock_index apply_hunk]} return
880 set apply_cmd {git apply --cached --whitespace=nowarn}
882 set mi [lindex $file_states($current_diff_path) 0]
883 if {$current_diff_side eq $ui_index} {
884 set mode unstage
885 lappend apply_cmd --reverse
886 if {[string index $mi 0] ne {M}} {
887 unlock_index
888 return
889 }
890 } else {
891 set mode stage
892 if {[string index $mi 1] ne {M}} {
893 unlock_index
894 return
895 }
896 }
897 set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
899 set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
900 if {$s_lno eq {}} {
901 unlock_index
902 return
903 }
904 set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
906 if {$e_lno eq {}} {
907 set e_lno end
908 }
909 if {[catch {
911 set p [open "| $apply_cmd" w]
912 fconfigure $p -translation binary -encoding binary
913 puts -nonewline $p $current_diff_header
914 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
915 close $p} err]} {
916 error_popup "Failed to $mode selected hunk.\n\n$err"
917 unlock_index
918 return
919 }
920 $ui_diff conf -state normal
922 $ui_diff delete $s_lno $e_lno
923 $ui_diff conf -state disabled
924 if {[$ui_diff get 1.0 end] eq "\n"} {
926 set o _
927 } else {
928 set o ?
929 }
930 if {$current_diff_side eq $ui_index} {
932 set mi ${o}M
933 } elseif {[string index $mi 0] eq {_}} {
934 set mi M$o
935 } else {
936 set mi ?$o
937 }
938 unlock_index
939 display_file $current_diff_path $mi
940 if {$o eq {_}} {
941 clear_diff
942 }
943}
944######################################################################
946##
947## commit
948proc load_last_commit {} {
950 global HEAD PARENT MERGE_HEAD commit_type ui_comm
951 global repo_config
952 if {[llength $PARENT] == 0} {
954 error_popup {There is nothing to amend.
955You are about to create the initial commit.
957There is no commit before this to amend.
958}
959 return
960 }
961 repository_state curType curHEAD curMERGE_HEAD
963 if {$curType eq {merge}} {
964 error_popup {Cannot amend while merging.
965You are currently in the middle of a merge that
967has not been fully completed. You cannot amend
968the prior commit unless you first abort the
969current merge activity.
970}
971 return
972 }
973 set msg {}
975 set parents [list]
976 if {[catch {
977 set fd [open "| git cat-file commit $curHEAD" r]
978 fconfigure $fd -encoding binary -translation lf
979 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
980 set enc utf-8
981 }
982 while {[gets $fd line] > 0} {
983 if {[string match {parent *} $line]} {
984 lappend parents [string range $line 7 end]
985 } elseif {[string match {encoding *} $line]} {
986 set enc [string tolower [string range $line 9 end]]
987 }
988 }
989 fconfigure $fd -encoding $enc
990 set msg [string trim [read $fd]]
991 close $fd
992 } err]} {
993 error_popup "Error loading commit data for amend:\n\n$err"
994 return
995 }
996 set HEAD $curHEAD
998 set PARENT $parents
999 set MERGE_HEAD [list]
1000 switch -- [llength $parents] {
1001 0 {set commit_type amend-initial}
1002 1 {set commit_type amend}
1003 default {set commit_type amend-merge}
1004 }
1005 $ui_comm delete 0.0 end
1007 $ui_comm insert end $msg
1008 $ui_comm edit reset
1009 $ui_comm edit modified false
1010 rescan {set ui_status_value {Ready.}}
1011}
1012proc create_new_commit {} {
1014 global commit_type ui_comm
1015 set commit_type normal
1017 $ui_comm delete 0.0 end
1018 $ui_comm edit reset
1019 $ui_comm edit modified false
1020 rescan {set ui_status_value {Ready.}}
1021}
1022set GIT_COMMITTER_IDENT {}
1024proc committer_ident {} {
1026 global GIT_COMMITTER_IDENT
1027 if {$GIT_COMMITTER_IDENT eq {}} {
1029 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1030 error_popup "Unable to obtain your identity:\n\n$err"
1031 return {}
1032 }
1033 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1034 $me me GIT_COMMITTER_IDENT]} {
1035 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1036 return {}
1037 }
1038 }
1039 return $GIT_COMMITTER_IDENT
1041}
1042proc commit_tree {} {
1044 global HEAD commit_type file_states ui_comm repo_config
1045 global ui_status_value pch_error
1046 if {[committer_ident] eq {}} return
1048 if {![lock_index update]} return
1049 # -- Our in memory state should match the repository.
1051 #
1052 repository_state curType curHEAD curMERGE_HEAD
1053 if {[string match amend* $commit_type]
1054 && $curType eq {normal}
1055 && $curHEAD eq $HEAD} {
1056 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1057 info_popup {Last scanned state does not match repository state.
1058Another Git program has modified this repository
1060since the last scan. A rescan must be performed
1061before another commit can be created.
1062The rescan will be automatically started now.
1064}
1065 unlock_index
1066 rescan {set ui_status_value {Ready.}}
1067 return
1068 }
1069 # -- At least one file should differ in the index.
1071 #
1072 set files_ready 0
1073 foreach path [array names file_states] {
1074 switch -glob -- [lindex $file_states($path) 0] {
1075 _? {continue}
1076 A? -
1077 D? -
1078 M? {set files_ready 1}
1079 U? {
1080 error_popup "Unmerged files cannot be committed.
1081File [short_path $path] has merge conflicts.
1083You must resolve them and add the file before committing.
1084"
1085 unlock_index
1086 return
1087 }
1088 default {
1089 error_popup "Unknown file state [lindex $s 0] detected.
1090File [short_path $path] cannot be committed by this program.
1092"
1093 }
1094 }
1095 }
1096 if {!$files_ready} {
1097 info_popup {No changes to commit.
1098You must add at least 1 file before you can commit.
1100}
1101 unlock_index
1102 return
1103 }
1104 # -- A message is required.
1106 #
1107 set msg [string trim [$ui_comm get 1.0 end]]
1108 regsub -all -line {[ \t\r]+$} $msg {} msg
1109 if {$msg eq {}} {
1110 error_popup {Please supply a commit message.
1111A good commit message has the following format:
1113- First line: Describe in one sentance what you did.
1115- Second line: Blank
1116- Remaining lines: Describe why this change is good.
1117}
1118 unlock_index
1119 return
1120 }
1121 # -- Run the pre-commit hook.
1123 #
1124 set pchook [gitdir hooks pre-commit]
1125 # On Cygwin [file executable] might lie so we need to ask
1127 # the shell if the hook is executable. Yes that's annoying.
1128 #
1129 if {[is_Cygwin] && [file isfile $pchook]} {
1130 set pchook [list sh -c [concat \
1131 "if test -x \"$pchook\";" \
1132 "then exec \"$pchook\" 2>&1;" \
1133 "fi"]]
1134 } elseif {[file executable $pchook]} {
1135 set pchook [list $pchook |& cat]
1136 } else {
1137 commit_writetree $curHEAD $msg
1138 return
1139 }
1140 set ui_status_value {Calling pre-commit hook...}
1142 set pch_error {}
1143 set fd_ph [open "| $pchook" r]
1144 fconfigure $fd_ph -blocking 0 -translation binary
1145 fileevent $fd_ph readable \
1146 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1147}
1148proc commit_prehook_wait {fd_ph curHEAD msg} {
1150 global pch_error ui_status_value
1151 append pch_error [read $fd_ph]
1153 fconfigure $fd_ph -blocking 1
1154 if {[eof $fd_ph]} {
1155 if {[catch {close $fd_ph}]} {
1156 set ui_status_value {Commit declined by pre-commit hook.}
1157 hook_failed_popup pre-commit $pch_error
1158 unlock_index
1159 } else {
1160 commit_writetree $curHEAD $msg
1161 }
1162 set pch_error {}
1163 return
1164 }
1165 fconfigure $fd_ph -blocking 0
1166}
1167proc commit_writetree {curHEAD msg} {
1169 global ui_status_value
1170 set ui_status_value {Committing changes...}
1172 set fd_wt [open "| git write-tree" r]
1173 fileevent $fd_wt readable \
1174 [list commit_committree $fd_wt $curHEAD $msg]
1175}
1176proc commit_committree {fd_wt curHEAD msg} {
1178 global HEAD PARENT MERGE_HEAD commit_type
1179 global single_commit all_heads current_branch
1180 global ui_status_value ui_comm selected_commit_type
1181 global file_states selected_paths rescan_active
1182 global repo_config
1183 gets $fd_wt tree_id
1185 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1186 error_popup "write-tree failed:\n\n$err"
1187 set ui_status_value {Commit failed.}
1188 unlock_index
1189 return
1190 }
1191 # -- Build the message.
1193 #
1194 set msg_p [gitdir COMMIT_EDITMSG]
1195 set msg_wt [open $msg_p w]
1196 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1197 set enc utf-8
1198 }
1199 fconfigure $msg_wt -encoding $enc -translation binary
1200 puts -nonewline $msg_wt $msg
1201 close $msg_wt
1202 # -- Create the commit.
1204 #
1205 set cmd [list git commit-tree $tree_id]
1206 set parents [concat $PARENT $MERGE_HEAD]
1207 if {[llength $parents] > 0} {
1208 foreach p $parents {
1209 lappend cmd -p $p
1210 }
1211 } else {
1212 # git commit-tree writes to stderr during initial commit.
1213 lappend cmd 2>/dev/null
1214 }
1215 lappend cmd <$msg_p
1216 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1217 error_popup "commit-tree failed:\n\n$err"
1218 set ui_status_value {Commit failed.}
1219 unlock_index
1220 return
1221 }
1222 # -- Update the HEAD ref.
1224 #
1225 set reflogm commit
1226 if {$commit_type ne {normal}} {
1227 append reflogm " ($commit_type)"
1228 }
1229 set i [string first "\n" $msg]
1230 if {$i >= 0} {
1231 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1232 } else {
1233 append reflogm {: } $msg
1234 }
1235 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1236 if {[catch {eval exec $cmd} err]} {
1237 error_popup "update-ref failed:\n\n$err"
1238 set ui_status_value {Commit failed.}
1239 unlock_index
1240 return
1241 }
1242 # -- Make sure our current branch exists.
1244 #
1245 if {$commit_type eq {initial}} {
1246 lappend all_heads $current_branch
1247 set all_heads [lsort -unique $all_heads]
1248 populate_branch_menu
1249 }
1250 # -- Cleanup after ourselves.
1252 #
1253 catch {file delete $msg_p}
1254 catch {file delete [gitdir MERGE_HEAD]}
1255 catch {file delete [gitdir MERGE_MSG]}
1256 catch {file delete [gitdir SQUASH_MSG]}
1257 catch {file delete [gitdir GITGUI_MSG]}
1258 # -- Let rerere do its thing.
1260 #
1261 if {[file isdirectory [gitdir rr-cache]]} {
1262 catch {exec git rerere}
1263 }
1264 # -- Run the post-commit hook.
1266 #
1267 set pchook [gitdir hooks post-commit]
1268 if {[is_Cygwin] && [file isfile $pchook]} {
1269 set pchook [list sh -c [concat \
1270 "if test -x \"$pchook\";" \
1271 "then exec \"$pchook\";" \
1272 "fi"]]
1273 } elseif {![file executable $pchook]} {
1274 set pchook {}
1275 }
1276 if {$pchook ne {}} {
1277 catch {exec $pchook &}
1278 }
1279 $ui_comm delete 0.0 end
1281 $ui_comm edit reset
1282 $ui_comm edit modified false
1283 if {$single_commit} do_quit
1285 # -- Update in memory status
1287 #
1288 set selected_commit_type new
1289 set commit_type normal
1290 set HEAD $cmt_id
1291 set PARENT $cmt_id
1292 set MERGE_HEAD [list]
1293 foreach path [array names file_states] {
1295 set s $file_states($path)
1296 set m [lindex $s 0]
1297 switch -glob -- $m {
1298 _O -
1299 _M -
1300 _D {continue}
1301 __ -
1302 A_ -
1303 M_ -
1304 D_ {
1305 unset file_states($path)
1306 catch {unset selected_paths($path)}
1307 }
1308 DO {
1309 set file_states($path) [list _O [lindex $s 1] {} {}]
1310 }
1311 AM -
1312 AD -
1313 MM -
1314 MD {
1315 set file_states($path) [list \
1316 _[string index $m 1] \
1317 [lindex $s 1] \
1318 [lindex $s 3] \
1319 {}]
1320 }
1321 }
1322 }
1323 display_all_files
1325 unlock_index
1326 reshow_diff
1327 set ui_status_value \
1328 "Changes committed as [string range $cmt_id 0 7]."
1329}
1330######################################################################
1332##
1333## fetch push
1334proc fetch_from {remote} {
1336 set w [new_console \
1337 "fetch $remote" \
1338 "Fetching new changes from $remote"]
1339 set cmd [list git fetch]
1340 lappend cmd $remote
1341 console_exec $w $cmd console_done
1342}
1343proc push_to {remote} {
1345 set w [new_console \
1346 "push $remote" \
1347 "Pushing changes to $remote"]
1348 set cmd [list git push]
1349 lappend cmd -v
1350 lappend cmd $remote
1351 console_exec $w $cmd console_done
1352}
1353######################################################################
1355##
1356## ui helpers
1357proc mapicon {w state path} {
1359 global all_icons
1360 if {[catch {set r $all_icons($state$w)}]} {
1362 puts "error: no icon for $w state={$state} $path"
1363 return file_plain
1364 }
1365 return $r
1366}
1367proc mapdesc {state path} {
1369 global all_descs
1370 if {[catch {set r $all_descs($state)}]} {
1372 puts "error: no desc for state={$state} $path"
1373 return $state
1374 }
1375 return $r
1376}
1377proc escape_path {path} {
1379 regsub -all "\n" $path "\\n" path
1380 return $path
1381}
1382proc short_path {path} {
1384 return [escape_path [lindex [file split $path] end]]
1385}
1386set next_icon_id 0
1388set null_sha1 [string repeat 0 40]
1389proc merge_state {path new_state {head_info {}} {index_info {}}} {
1391 global file_states next_icon_id null_sha1
1392 set s0 [string index $new_state 0]
1394 set s1 [string index $new_state 1]
1395 if {[catch {set info $file_states($path)}]} {
1397 set state __
1398 set icon n[incr next_icon_id]
1399 } else {
1400 set state [lindex $info 0]
1401 set icon [lindex $info 1]
1402 if {$head_info eq {}} {set head_info [lindex $info 2]}
1403 if {$index_info eq {}} {set index_info [lindex $info 3]}
1404 }
1405 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1407 elseif {$s0 eq {_}} {set s0 _}
1408 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1410 elseif {$s1 eq {_}} {set s1 _}
1411 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1413 set head_info [list 0 $null_sha1]
1414 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1415 && $head_info eq {}} {
1416 set head_info $index_info
1417 }
1418 set file_states($path) [list $s0$s1 $icon \
1420 $head_info $index_info \
1421 ]
1422 return $state
1423}
1424proc display_file_helper {w path icon_name old_m new_m} {
1426 global file_lists
1427 if {$new_m eq {_}} {
1429 set lno [lsearch -sorted -exact $file_lists($w) $path]
1430 if {$lno >= 0} {
1431 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1432 incr lno
1433 $w conf -state normal
1434 $w delete $lno.0 [expr {$lno + 1}].0
1435 $w conf -state disabled
1436 }
1437 } elseif {$old_m eq {_} && $new_m ne {_}} {
1438 lappend file_lists($w) $path
1439 set file_lists($w) [lsort -unique $file_lists($w)]
1440 set lno [lsearch -sorted -exact $file_lists($w) $path]
1441 incr lno
1442 $w conf -state normal
1443 $w image create $lno.0 \
1444 -align center -padx 5 -pady 1 \
1445 -name $icon_name \
1446 -image [mapicon $w $new_m $path]
1447 $w insert $lno.1 "[escape_path $path]\n"
1448 $w conf -state disabled
1449 } elseif {$old_m ne $new_m} {
1450 $w conf -state normal
1451 $w image conf $icon_name -image [mapicon $w $new_m $path]
1452 $w conf -state disabled
1453 }
1454}
1455proc display_file {path state} {
1457 global file_states selected_paths
1458 global ui_index ui_workdir
1459 set old_m [merge_state $path $state]
1461 set s $file_states($path)
1462 set new_m [lindex $s 0]
1463 set icon_name [lindex $s 1]
1464 set o [string index $old_m 0]
1466 set n [string index $new_m 0]
1467 if {$o eq {U}} {
1468 set o _
1469 }
1470 if {$n eq {U}} {
1471 set n _
1472 }
1473 display_file_helper $ui_index $path $icon_name $o $n
1474 if {[string index $old_m 0] eq {U}} {
1476 set o U
1477 } else {
1478 set o [string index $old_m 1]
1479 }
1480 if {[string index $new_m 0] eq {U}} {
1481 set n U
1482 } else {
1483 set n [string index $new_m 1]
1484 }
1485 display_file_helper $ui_workdir $path $icon_name $o $n
1486 if {$new_m eq {__}} {
1488 unset file_states($path)
1489 catch {unset selected_paths($path)}
1490 }
1491}
1492proc display_all_files_helper {w path icon_name m} {
1494 global file_lists
1495 lappend file_lists($w) $path
1497 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1498 $w image create end \
1499 -align center -padx 5 -pady 1 \
1500 -name $icon_name \
1501 -image [mapicon $w $m $path]
1502 $w insert end "[escape_path $path]\n"
1503}
1504proc display_all_files {} {
1506 global ui_index ui_workdir
1507 global file_states file_lists
1508 global last_clicked
1509 $ui_index conf -state normal
1511 $ui_workdir conf -state normal
1512 $ui_index delete 0.0 end
1514 $ui_workdir delete 0.0 end
1515 set last_clicked {}
1516 set file_lists($ui_index) [list]
1518 set file_lists($ui_workdir) [list]
1519 foreach path [lsort [array names file_states]] {
1521 set s $file_states($path)
1522 set m [lindex $s 0]
1523 set icon_name [lindex $s 1]
1524 set s [string index $m 0]
1526 if {$s ne {U} && $s ne {_}} {
1527 display_all_files_helper $ui_index $path \
1528 $icon_name $s
1529 }
1530 if {[string index $m 0] eq {U}} {
1532 set s U
1533 } else {
1534 set s [string index $m 1]
1535 }
1536 if {$s ne {_}} {
1537 display_all_files_helper $ui_workdir $path \
1538 $icon_name $s
1539 }
1540 }
1541 $ui_index conf -state disabled
1543 $ui_workdir conf -state disabled
1544}
1545proc update_indexinfo {msg pathList after} {
1547 global update_index_cp ui_status_value
1548 if {![lock_index update]} return
1550 set update_index_cp 0
1552 set pathList [lsort $pathList]
1553 set totalCnt [llength $pathList]
1554 set batch [expr {int($totalCnt * .01) + 1}]
1555 if {$batch > 25} {set batch 25}
1556 set ui_status_value [format \
1558 "$msg... %i/%i files (%.2f%%)" \
1559 $update_index_cp \
1560 $totalCnt \
1561 0.0]
1562 set fd [open "| git update-index -z --index-info" w]
1563 fconfigure $fd \
1564 -blocking 0 \
1565 -buffering full \
1566 -buffersize 512 \
1567 -encoding binary \
1568 -translation binary
1569 fileevent $fd writable [list \
1570 write_update_indexinfo \
1571 $fd \
1572 $pathList \
1573 $totalCnt \
1574 $batch \
1575 $msg \
1576 $after \
1577 ]
1578}
1579proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1581 global update_index_cp ui_status_value
1582 global file_states current_diff_path
1583 if {$update_index_cp >= $totalCnt} {
1585 close $fd
1586 unlock_index
1587 uplevel #0 $after
1588 return
1589 }
1590 for {set i $batch} \
1592 {$update_index_cp < $totalCnt && $i > 0} \
1593 {incr i -1} {
1594 set path [lindex $pathList $update_index_cp]
1595 incr update_index_cp
1596 set s $file_states($path)
1598 switch -glob -- [lindex $s 0] {
1599 A? {set new _O}
1600 M? {set new _M}
1601 D_ {set new _D}
1602 D? {set new _?}
1603 ?? {continue}
1604 }
1605 set info [lindex $s 2]
1606 if {$info eq {}} continue
1607 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1609 display_file $path $new
1610 }
1611 set ui_status_value [format \
1613 "$msg... %i/%i files (%.2f%%)" \
1614 $update_index_cp \
1615 $totalCnt \
1616 [expr {100.0 * $update_index_cp / $totalCnt}]]
1617}
1618proc update_index {msg pathList after} {
1620 global update_index_cp ui_status_value
1621 if {![lock_index update]} return
1623 set update_index_cp 0
1625 set pathList [lsort $pathList]
1626 set totalCnt [llength $pathList]
1627 set batch [expr {int($totalCnt * .01) + 1}]
1628 if {$batch > 25} {set batch 25}
1629 set ui_status_value [format \
1631 "$msg... %i/%i files (%.2f%%)" \
1632 $update_index_cp \
1633 $totalCnt \
1634 0.0]
1635 set fd [open "| git update-index --add --remove -z --stdin" w]
1636 fconfigure $fd \
1637 -blocking 0 \
1638 -buffering full \
1639 -buffersize 512 \
1640 -encoding binary \
1641 -translation binary
1642 fileevent $fd writable [list \
1643 write_update_index \
1644 $fd \
1645 $pathList \
1646 $totalCnt \
1647 $batch \
1648 $msg \
1649 $after \
1650 ]
1651}
1652proc write_update_index {fd pathList totalCnt batch msg after} {
1654 global update_index_cp ui_status_value
1655 global file_states current_diff_path
1656 if {$update_index_cp >= $totalCnt} {
1658 close $fd
1659 unlock_index
1660 uplevel #0 $after
1661 return
1662 }
1663 for {set i $batch} \
1665 {$update_index_cp < $totalCnt && $i > 0} \
1666 {incr i -1} {
1667 set path [lindex $pathList $update_index_cp]
1668 incr update_index_cp
1669 switch -glob -- [lindex $file_states($path) 0] {
1671 AD {set new __}
1672 ?D {set new D_}
1673 _O -
1674 AM {set new A_}
1675 U? {
1676 if {[file exists $path]} {
1677 set new M_
1678 } else {
1679 set new D_
1680 }
1681 }
1682 ?M {set new M_}
1683 ?? {continue}
1684 }
1685 puts -nonewline $fd "[encoding convertto $path]\0"
1686 display_file $path $new
1687 }
1688 set ui_status_value [format \
1690 "$msg... %i/%i files (%.2f%%)" \
1691 $update_index_cp \
1692 $totalCnt \
1693 [expr {100.0 * $update_index_cp / $totalCnt}]]
1694}
1695proc checkout_index {msg pathList after} {
1697 global update_index_cp ui_status_value
1698 if {![lock_index update]} return
1700 set update_index_cp 0
1702 set pathList [lsort $pathList]
1703 set totalCnt [llength $pathList]
1704 set batch [expr {int($totalCnt * .01) + 1}]
1705 if {$batch > 25} {set batch 25}
1706 set ui_status_value [format \
1708 "$msg... %i/%i files (%.2f%%)" \
1709 $update_index_cp \
1710 $totalCnt \
1711 0.0]
1712 set cmd [list git checkout-index]
1713 lappend cmd --index
1714 lappend cmd --quiet
1715 lappend cmd --force
1716 lappend cmd -z
1717 lappend cmd --stdin
1718 set fd [open "| $cmd " w]
1719 fconfigure $fd \
1720 -blocking 0 \
1721 -buffering full \
1722 -buffersize 512 \
1723 -encoding binary \
1724 -translation binary
1725 fileevent $fd writable [list \
1726 write_checkout_index \
1727 $fd \
1728 $pathList \
1729 $totalCnt \
1730 $batch \
1731 $msg \
1732 $after \
1733 ]
1734}
1735proc write_checkout_index {fd pathList totalCnt batch msg after} {
1737 global update_index_cp ui_status_value
1738 global file_states current_diff_path
1739 if {$update_index_cp >= $totalCnt} {
1741 close $fd
1742 unlock_index
1743 uplevel #0 $after
1744 return
1745 }
1746 for {set i $batch} \
1748 {$update_index_cp < $totalCnt && $i > 0} \
1749 {incr i -1} {
1750 set path [lindex $pathList $update_index_cp]
1751 incr update_index_cp
1752 switch -glob -- [lindex $file_states($path) 0] {
1753 U? {continue}
1754 ?M -
1755 ?D {
1756 puts -nonewline $fd "[encoding convertto $path]\0"
1757 display_file $path ?_
1758 }
1759 }
1760 }
1761 set ui_status_value [format \
1763 "$msg... %i/%i files (%.2f%%)" \
1764 $update_index_cp \
1765 $totalCnt \
1766 [expr {100.0 * $update_index_cp / $totalCnt}]]
1767}
1768######################################################################
1770##
1771## branch management
1772proc is_tracking_branch {name} {
1774 global tracking_branches
1775 if {![catch {set info $tracking_branches($name)}]} {
1777 return 1
1778 }
1779 foreach t [array names tracking_branches] {
1780 if {[string match {*/\*} $t] && [string match $t $name]} {
1781 return 1
1782 }
1783 }
1784 return 0
1785}
1786proc load_all_heads {} {
1788 global all_heads
1789 set all_heads [list]
1791 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1792 while {[gets $fd line] > 0} {
1793 if {[is_tracking_branch $line]} continue
1794 if {![regsub ^refs/heads/ $line {} name]} continue
1795 lappend all_heads $name
1796 }
1797 close $fd
1798 set all_heads [lsort $all_heads]
1800}
1801proc populate_branch_menu {} {
1803 global all_heads disable_on_lock
1804 set m .mbar.branch
1806 set last [$m index last]
1807 for {set i 0} {$i <= $last} {incr i} {
1808 if {[$m type $i] eq {separator}} {
1809 $m delete $i last
1810 set new_dol [list]
1811 foreach a $disable_on_lock {
1812 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1813 lappend new_dol $a
1814 }
1815 }
1816 set disable_on_lock $new_dol
1817 break
1818 }
1819 }
1820 if {$all_heads ne {}} {
1822 $m add separator
1823 }
1824 foreach b $all_heads {
1825 $m add radiobutton \
1826 -label $b \
1827 -command [list switch_branch $b] \
1828 -variable current_branch \
1829 -value $b \
1830 -font font_ui
1831 lappend disable_on_lock \
1832 [list $m entryconf [$m index last] -state]
1833 }
1834}
1835proc all_tracking_branches {} {
1837 global tracking_branches
1838 set all_trackings {}
1840 set cmd {}
1841 foreach name [array names tracking_branches] {
1842 if {[regsub {/\*$} $name {} name]} {
1843 lappend cmd $name
1844 } else {
1845 regsub ^refs/(heads|remotes)/ $name {} name
1846 lappend all_trackings $name
1847 }
1848 }
1849 if {$cmd ne {}} {
1851 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1852 while {[gets $fd name] > 0} {
1853 regsub ^refs/(heads|remotes)/ $name {} name
1854 lappend all_trackings $name
1855 }
1856 close $fd
1857 }
1858 return [lsort -unique $all_trackings]
1860}
1861proc do_create_branch_action {w} {
1863 global all_heads null_sha1 repo_config
1864 global create_branch_checkout create_branch_revtype
1865 global create_branch_head create_branch_trackinghead
1866 global create_branch_name create_branch_revexp
1867 set newbranch $create_branch_name
1869 if {$newbranch eq {}
1870 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1871 tk_messageBox \
1872 -icon error \
1873 -type ok \
1874 -title [wm title $w] \
1875 -parent $w \
1876 -message "Please supply a branch name."
1877 focus $w.desc.name_t
1878 return
1879 }
1880 if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1881 tk_messageBox \
1882 -icon error \
1883 -type ok \
1884 -title [wm title $w] \
1885 -parent $w \
1886 -message "Branch '$newbranch' already exists."
1887 focus $w.desc.name_t
1888 return
1889 }
1890 if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1891 tk_messageBox \
1892 -icon error \
1893 -type ok \
1894 -title [wm title $w] \
1895 -parent $w \
1896 -message "We do not like '$newbranch' as a branch name."
1897 focus $w.desc.name_t
1898 return
1899 }
1900 set rev {}
1902 switch -- $create_branch_revtype {
1903 head {set rev $create_branch_head}
1904 tracking {set rev $create_branch_trackinghead}
1905 expression {set rev $create_branch_revexp}
1906 }
1907 if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1908 tk_messageBox \
1909 -icon error \
1910 -type ok \
1911 -title [wm title $w] \
1912 -parent $w \
1913 -message "Invalid starting revision: $rev"
1914 return
1915 }
1916 set cmd [list git update-ref]
1917 lappend cmd -m
1918 lappend cmd "branch: Created from $rev"
1919 lappend cmd "refs/heads/$newbranch"
1920 lappend cmd $cmt
1921 lappend cmd $null_sha1
1922 if {[catch {eval exec $cmd} err]} {
1923 tk_messageBox \
1924 -icon error \
1925 -type ok \
1926 -title [wm title $w] \
1927 -parent $w \
1928 -message "Failed to create '$newbranch'.\n\n$err"
1929 return
1930 }
1931 lappend all_heads $newbranch
1933 set all_heads [lsort $all_heads]
1934 populate_branch_menu
1935 destroy $w
1936 if {$create_branch_checkout} {
1937 switch_branch $newbranch
1938 }
1939}
1940proc radio_selector {varname value args} {
1942 upvar #0 $varname var
1943 set var $value
1944}
1945trace add variable create_branch_head write \
1947 [list radio_selector create_branch_revtype head]
1948trace add variable create_branch_trackinghead write \
1949 [list radio_selector create_branch_revtype tracking]
1950trace add variable delete_branch_head write \
1952 [list radio_selector delete_branch_checktype head]
1953trace add variable delete_branch_trackinghead write \
1954 [list radio_selector delete_branch_checktype tracking]
1955proc do_create_branch {} {
1957 global all_heads current_branch repo_config
1958 global create_branch_checkout create_branch_revtype
1959 global create_branch_head create_branch_trackinghead
1960 global create_branch_name create_branch_revexp
1961 set w .branch_editor
1963 toplevel $w
1964 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1965 label $w.header -text {Create New Branch} \
1967 -font font_uibold
1968 pack $w.header -side top -fill x
1969 frame $w.buttons
1971 button $w.buttons.create -text Create \
1972 -font font_ui \
1973 -default active \
1974 -command [list do_create_branch_action $w]
1975 pack $w.buttons.create -side right
1976 button $w.buttons.cancel -text {Cancel} \
1977 -font font_ui \
1978 -command [list destroy $w]
1979 pack $w.buttons.cancel -side right -padx 5
1980 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1981 labelframe $w.desc \
1983 -text {Branch Description} \
1984 -font font_ui
1985 label $w.desc.name_l -text {Name:} -font font_ui
1986 entry $w.desc.name_t \
1987 -borderwidth 1 \
1988 -relief sunken \
1989 -width 40 \
1990 -textvariable create_branch_name \
1991 -font font_ui \
1992 -validate key \
1993 -validatecommand {
1994 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
1995 return 1
1996 }
1997 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
1998 grid columnconfigure $w.desc 1 -weight 1
1999 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2000 labelframe $w.from \
2002 -text {Starting Revision} \
2003 -font font_ui
2004 radiobutton $w.from.head_r \
2005 -text {Local Branch:} \
2006 -value head \
2007 -variable create_branch_revtype \
2008 -font font_ui
2009 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2010 grid $w.from.head_r $w.from.head_m -sticky w
2011 set all_trackings [all_tracking_branches]
2012 if {$all_trackings ne {}} {
2013 set create_branch_trackinghead [lindex $all_trackings 0]
2014 radiobutton $w.from.tracking_r \
2015 -text {Tracking Branch:} \
2016 -value tracking \
2017 -variable create_branch_revtype \
2018 -font font_ui
2019 eval tk_optionMenu $w.from.tracking_m \
2020 create_branch_trackinghead \
2021 $all_trackings
2022 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2023 }
2024 radiobutton $w.from.exp_r \
2025 -text {Revision Expression:} \
2026 -value expression \
2027 -variable create_branch_revtype \
2028 -font font_ui
2029 entry $w.from.exp_t \
2030 -borderwidth 1 \
2031 -relief sunken \
2032 -width 50 \
2033 -textvariable create_branch_revexp \
2034 -font font_ui \
2035 -validate key \
2036 -validatecommand {
2037 if {%d == 1 && [regexp {\s} %S]} {return 0}
2038 if {%d == 1 && [string length %S] > 0} {
2039 set create_branch_revtype expression
2040 }
2041 return 1
2042 }
2043 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2044 grid columnconfigure $w.from 1 -weight 1
2045 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2046 labelframe $w.postActions \
2048 -text {Post Creation Actions} \
2049 -font font_ui
2050 checkbutton $w.postActions.checkout \
2051 -text {Checkout after creation} \
2052 -variable create_branch_checkout \
2053 -font font_ui
2054 pack $w.postActions.checkout -anchor nw
2055 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2056 set create_branch_checkout 1
2058 set create_branch_head $current_branch
2059 set create_branch_revtype head
2060 set create_branch_name $repo_config(gui.newbranchtemplate)
2061 set create_branch_revexp {}
2062 bind $w <Visibility> "
2064 grab $w
2065 $w.desc.name_t icursor end
2066 focus $w.desc.name_t
2067 "
2068 bind $w <Key-Escape> "destroy $w"
2069 bind $w <Key-Return> "do_create_branch_action $w;break"
2070 wm title $w "[appname] ([reponame]): Create Branch"
2071 tkwait window $w
2072}
2073proc do_delete_branch_action {w} {
2075 global all_heads
2076 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2077 set check_rev {}
2079 switch -- $delete_branch_checktype {
2080 head {set check_rev $delete_branch_head}
2081 tracking {set check_rev $delete_branch_trackinghead}
2082 always {set check_rev {:none}}
2083 }
2084 if {$check_rev eq {:none}} {
2085 set check_cmt {}
2086 } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2087 tk_messageBox \
2088 -icon error \
2089 -type ok \
2090 -title [wm title $w] \
2091 -parent $w \
2092 -message "Invalid check revision: $check_rev"
2093 return
2094 }
2095 set to_delete [list]
2097 set not_merged [list]
2098 foreach i [$w.list.l curselection] {
2099 set b [$w.list.l get $i]
2100 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2101 if {$check_cmt ne {}} {
2102 if {$b eq $check_rev} continue
2103 if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2104 if {$o ne $m} {
2105 lappend not_merged $b
2106 continue
2107 }
2108 }
2109 lappend to_delete [list $b $o]
2110 }
2111 if {$not_merged ne {}} {
2112 set msg "The following branches are not completely merged into $check_rev:
2113 - [join $not_merged "\n - "]"
2115 tk_messageBox \
2116 -icon info \
2117 -type ok \
2118 -title [wm title $w] \
2119 -parent $w \
2120 -message $msg
2121 }
2122 if {$to_delete eq {}} return
2123 if {$delete_branch_checktype eq {always}} {
2124 set msg {Recovering deleted branches is difficult.
2125Delete the selected branches?}
2127 if {[tk_messageBox \
2128 -icon warning \
2129 -type yesno \
2130 -title [wm title $w] \
2131 -parent $w \
2132 -message $msg] ne yes} {
2133 return
2134 }
2135 }
2136 set failed {}
2138 foreach i $to_delete {
2139 set b [lindex $i 0]
2140 set o [lindex $i 1]
2141 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2142 append failed " - $b: $err\n"
2143 } else {
2144 set x [lsearch -sorted -exact $all_heads $b]
2145 if {$x >= 0} {
2146 set all_heads [lreplace $all_heads $x $x]
2147 }
2148 }
2149 }
2150 if {$failed ne {}} {
2152 tk_messageBox \
2153 -icon error \
2154 -type ok \
2155 -title [wm title $w] \
2156 -parent $w \
2157 -message "Failed to delete branches:\n$failed"
2158 }
2159 set all_heads [lsort $all_heads]
2161 populate_branch_menu
2162 destroy $w
2163}
2164proc do_delete_branch {} {
2166 global all_heads tracking_branches current_branch
2167 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2168 set w .branch_editor
2170 toplevel $w
2171 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2172 label $w.header -text {Delete Local Branch} \
2174 -font font_uibold
2175 pack $w.header -side top -fill x
2176 frame $w.buttons
2178 button $w.buttons.create -text Delete \
2179 -font font_ui \
2180 -command [list do_delete_branch_action $w]
2181 pack $w.buttons.create -side right
2182 button $w.buttons.cancel -text {Cancel} \
2183 -font font_ui \
2184 -command [list destroy $w]
2185 pack $w.buttons.cancel -side right -padx 5
2186 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2187 labelframe $w.list \
2189 -text {Local Branches} \
2190 -font font_ui
2191 listbox $w.list.l \
2192 -height 10 \
2193 -width 70 \
2194 -selectmode extended \
2195 -yscrollcommand [list $w.list.sby set] \
2196 -font font_ui
2197 foreach h $all_heads {
2198 if {$h ne $current_branch} {
2199 $w.list.l insert end $h
2200 }
2201 }
2202 scrollbar $w.list.sby -command [list $w.list.l yview]
2203 pack $w.list.sby -side right -fill y
2204 pack $w.list.l -side left -fill both -expand 1
2205 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2206 labelframe $w.validate \
2208 -text {Delete Only If} \
2209 -font font_ui
2210 radiobutton $w.validate.head_r \
2211 -text {Merged Into Local Branch:} \
2212 -value head \
2213 -variable delete_branch_checktype \
2214 -font font_ui
2215 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2216 grid $w.validate.head_r $w.validate.head_m -sticky w
2217 set all_trackings [all_tracking_branches]
2218 if {$all_trackings ne {}} {
2219 set delete_branch_trackinghead [lindex $all_trackings 0]
2220 radiobutton $w.validate.tracking_r \
2221 -text {Merged Into Tracking Branch:} \
2222 -value tracking \
2223 -variable delete_branch_checktype \
2224 -font font_ui
2225 eval tk_optionMenu $w.validate.tracking_m \
2226 delete_branch_trackinghead \
2227 $all_trackings
2228 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2229 }
2230 radiobutton $w.validate.always_r \
2231 -text {Always (Do not perform merge checks)} \
2232 -value always \
2233 -variable delete_branch_checktype \
2234 -font font_ui
2235 grid $w.validate.always_r -columnspan 2 -sticky w
2236 grid columnconfigure $w.validate 1 -weight 1
2237 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2238 set delete_branch_head $current_branch
2240 set delete_branch_checktype head
2241 bind $w <Visibility> "grab $w; focus $w"
2243 bind $w <Key-Escape> "destroy $w"
2244 wm title $w "[appname] ([reponame]): Delete Branch"
2245 tkwait window $w
2246}
2247proc switch_branch {new_branch} {
2249 global HEAD commit_type current_branch repo_config
2250 if {![lock_index switch]} return
2252 # -- Our in memory state should match the repository.
2254 #
2255 repository_state curType curHEAD curMERGE_HEAD
2256 if {[string match amend* $commit_type]
2257 && $curType eq {normal}
2258 && $curHEAD eq $HEAD} {
2259 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2260 info_popup {Last scanned state does not match repository state.
2261Another Git program has modified this repository
2263since the last scan. A rescan must be performed
2264before the current branch can be changed.
2265The rescan will be automatically started now.
2267}
2268 unlock_index
2269 rescan {set ui_status_value {Ready.}}
2270 return
2271 }
2272 # -- Don't do a pointless switch.
2274 #
2275 if {$current_branch eq $new_branch} {
2276 unlock_index
2277 return
2278 }
2279 if {$repo_config(gui.trustmtime) eq {true}} {
2281 switch_branch_stage2 {} $new_branch
2282 } else {
2283 set ui_status_value {Refreshing file status...}
2284 set cmd [list git update-index]
2285 lappend cmd -q
2286 lappend cmd --unmerged
2287 lappend cmd --ignore-missing
2288 lappend cmd --refresh
2289 set fd_rf [open "| $cmd" r]
2290 fconfigure $fd_rf -blocking 0 -translation binary
2291 fileevent $fd_rf readable \
2292 [list switch_branch_stage2 $fd_rf $new_branch]
2293 }
2294}
2295proc switch_branch_stage2 {fd_rf new_branch} {
2297 global ui_status_value HEAD
2298 if {$fd_rf ne {}} {
2300 read $fd_rf
2301 if {![eof $fd_rf]} return
2302 close $fd_rf
2303 }
2304 set ui_status_value "Updating working directory to '$new_branch'..."
2306 set cmd [list git read-tree]
2307 lappend cmd -m
2308 lappend cmd -u
2309 lappend cmd --exclude-per-directory=.gitignore
2310 lappend cmd $HEAD
2311 lappend cmd $new_branch
2312 set fd_rt [open "| $cmd" r]
2313 fconfigure $fd_rt -blocking 0 -translation binary
2314 fileevent $fd_rt readable \
2315 [list switch_branch_readtree_wait $fd_rt $new_branch]
2316}
2317proc switch_branch_readtree_wait {fd_rt new_branch} {
2319 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2320 global current_branch
2321 global ui_comm ui_status_value
2322 # -- We never get interesting output on stdout; only stderr.
2324 #
2325 read $fd_rt
2326 fconfigure $fd_rt -blocking 1
2327 if {![eof $fd_rt]} {
2328 fconfigure $fd_rt -blocking 0
2329 return
2330 }
2331 # -- The working directory wasn't in sync with the index and
2333 # we'd have to overwrite something to make the switch. A
2334 # merge is required.
2335 #
2336 if {[catch {close $fd_rt} err]} {
2337 regsub {^fatal: } $err {} err
2338 warn_popup "File level merge required.
2339$err
2341Staying on branch '$current_branch'."
2343 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2344 unlock_index
2345 return
2346 }
2347 # -- Update the symbolic ref. Core git doesn't even check for failure
2349 # here, it Just Works(tm). If it doesn't we are in some really ugly
2350 # state that is difficult to recover from within git-gui.
2351 #
2352 if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2353 error_popup "Failed to set current branch.
2354This working directory is only partially switched.
2356We successfully updated your files, but failed to
2357update an internal Git file.
2358This should not have occurred. [appname] will now
2360close and give up.
2361$err"
2363 do_quit
2364 return
2365 }
2366 # -- Update our repository state. If we were previously in amend mode
2368 # we need to toss the current buffer and do a full rescan to update
2369 # our file lists. If we weren't in amend mode our file lists are
2370 # accurate and we can avoid the rescan.
2371 #
2372 unlock_index
2373 set selected_commit_type new
2374 if {[string match amend* $commit_type]} {
2375 $ui_comm delete 0.0 end
2376 $ui_comm edit reset
2377 $ui_comm edit modified false
2378 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2379 } else {
2380 repository_state commit_type HEAD MERGE_HEAD
2381 set PARENT $HEAD
2382 set ui_status_value "Checked out branch '$current_branch'."
2383 }
2384}
2385######################################################################
2387##
2388## remote management
2389proc load_all_remotes {} {
2391 global repo_config
2392 global all_remotes tracking_branches
2393 set all_remotes [list]
2395 array unset tracking_branches
2396 set rm_dir [gitdir remotes]
2398 if {[file isdirectory $rm_dir]} {
2399 set all_remotes [glob \
2400 -types f \
2401 -tails \
2402 -nocomplain \
2403 -directory $rm_dir *]
2404 foreach name $all_remotes {
2406 catch {
2407 set fd [open [file join $rm_dir $name] r]
2408 while {[gets $fd line] >= 0} {
2409 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2410 $line line src dst]} continue
2411 if {![regexp ^refs/ $dst]} {
2412 set dst "refs/heads/$dst"
2413 }
2414 set tracking_branches($dst) [list $name $src]
2415 }
2416 close $fd
2417 }
2418 }
2419 }
2420 foreach line [array names repo_config remote.*.url] {
2422 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2423 lappend all_remotes $name
2424 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2426 set fl {}
2427 }
2428 foreach line $fl {
2429 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2430 if {![regexp ^refs/ $dst]} {
2431 set dst "refs/heads/$dst"
2432 }
2433 set tracking_branches($dst) [list $name $src]
2434 }
2435 }
2436 set all_remotes [lsort -unique $all_remotes]
2438}
2439proc populate_fetch_menu {} {
2441 global all_remotes repo_config
2442 set m .mbar.fetch
2444 foreach r $all_remotes {
2445 set enable 0
2446 if {![catch {set a $repo_config(remote.$r.url)}]} {
2447 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2448 set enable 1
2449 }
2450 } else {
2451 catch {
2452 set fd [open [gitdir remotes $r] r]
2453 while {[gets $fd n] >= 0} {
2454 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2455 set enable 1
2456 break
2457 }
2458 }
2459 close $fd
2460 }
2461 }
2462 if {$enable} {
2464 $m add command \
2465 -label "Fetch from $r..." \
2466 -command [list fetch_from $r] \
2467 -font font_ui
2468 }
2469 }
2470}
2471proc populate_push_menu {} {
2473 global all_remotes repo_config
2474 set m .mbar.push
2476 set fast_count 0
2477 foreach r $all_remotes {
2478 set enable 0
2479 if {![catch {set a $repo_config(remote.$r.url)}]} {
2480 if {![catch {set a $repo_config(remote.$r.push)}]} {
2481 set enable 1
2482 }
2483 } else {
2484 catch {
2485 set fd [open [gitdir remotes $r] r]
2486 while {[gets $fd n] >= 0} {
2487 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2488 set enable 1
2489 break
2490 }
2491 }
2492 close $fd
2493 }
2494 }
2495 if {$enable} {
2497 if {!$fast_count} {
2498 $m add separator
2499 }
2500 $m add command \
2501 -label "Push to $r..." \
2502 -command [list push_to $r] \
2503 -font font_ui
2504 incr fast_count
2505 }
2506 }
2507}
2508proc start_push_anywhere_action {w} {
2510 global push_urltype push_remote push_url push_thin push_tags
2511 set r_url {}
2513 switch -- $push_urltype {
2514 remote {set r_url $push_remote}
2515 url {set r_url $push_url}
2516 }
2517 if {$r_url eq {}} return
2518 set cmd [list git push]
2520 lappend cmd -v
2521 if {$push_thin} {
2522 lappend cmd --thin
2523 }
2524 if {$push_tags} {
2525 lappend cmd --tags
2526 }
2527 lappend cmd $r_url
2528 set cnt 0
2529 foreach i [$w.source.l curselection] {
2530 set b [$w.source.l get $i]
2531 lappend cmd "refs/heads/$b:refs/heads/$b"
2532 incr cnt
2533 }
2534 if {$cnt == 0} {
2535 return
2536 } elseif {$cnt == 1} {
2537 set unit branch
2538 } else {
2539 set unit branches
2540 }
2541 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2543 console_exec $cons $cmd console_done
2544 destroy $w
2545}
2546trace add variable push_remote write \
2548 [list radio_selector push_urltype remote]
2549proc do_push_anywhere {} {
2551 global all_heads all_remotes current_branch
2552 global push_urltype push_remote push_url push_thin push_tags
2553 set w .push_setup
2555 toplevel $w
2556 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2557 label $w.header -text {Push Branches} -font font_uibold
2559 pack $w.header -side top -fill x
2560 frame $w.buttons
2562 button $w.buttons.create -text Push \
2563 -font font_ui \
2564 -command [list start_push_anywhere_action $w]
2565 pack $w.buttons.create -side right
2566 button $w.buttons.cancel -text {Cancel} \
2567 -font font_ui \
2568 -command [list destroy $w]
2569 pack $w.buttons.cancel -side right -padx 5
2570 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2571 labelframe $w.source \
2573 -text {Source Branches} \
2574 -font font_ui
2575 listbox $w.source.l \
2576 -height 10 \
2577 -width 70 \
2578 -selectmode extended \
2579 -yscrollcommand [list $w.source.sby set] \
2580 -font font_ui
2581 foreach h $all_heads {
2582 $w.source.l insert end $h
2583 if {$h eq $current_branch} {
2584 $w.source.l select set end
2585 }
2586 }
2587 scrollbar $w.source.sby -command [list $w.source.l yview]
2588 pack $w.source.sby -side right -fill y
2589 pack $w.source.l -side left -fill both -expand 1
2590 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2591 labelframe $w.dest \
2593 -text {Destination Repository} \
2594 -font font_ui
2595 if {$all_remotes ne {}} {
2596 radiobutton $w.dest.remote_r \
2597 -text {Remote:} \
2598 -value remote \
2599 -variable push_urltype \
2600 -font font_ui
2601 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2602 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2603 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2604 set push_remote origin
2605 } else {
2606 set push_remote [lindex $all_remotes 0]
2607 }
2608 set push_urltype remote
2609 } else {
2610 set push_urltype url
2611 }
2612 radiobutton $w.dest.url_r \
2613 -text {Arbitrary URL:} \
2614 -value url \
2615 -variable push_urltype \
2616 -font font_ui
2617 entry $w.dest.url_t \
2618 -borderwidth 1 \
2619 -relief sunken \
2620 -width 50 \
2621 -textvariable push_url \
2622 -font font_ui \
2623 -validate key \
2624 -validatecommand {
2625 if {%d == 1 && [regexp {\s} %S]} {return 0}
2626 if {%d == 1 && [string length %S] > 0} {
2627 set push_urltype url
2628 }
2629 return 1
2630 }
2631 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2632 grid columnconfigure $w.dest 1 -weight 1
2633 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2634 labelframe $w.options \
2636 -text {Transfer Options} \
2637 -font font_ui
2638 checkbutton $w.options.thin \
2639 -text {Use thin pack (for slow network connections)} \
2640 -variable push_thin \
2641 -font font_ui
2642 grid $w.options.thin -columnspan 2 -sticky w
2643 checkbutton $w.options.tags \
2644 -text {Include tags} \
2645 -variable push_tags \
2646 -font font_ui
2647 grid $w.options.tags -columnspan 2 -sticky w
2648 grid columnconfigure $w.options 1 -weight 1
2649 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2650 set push_url {}
2652 set push_thin 0
2653 set push_tags 0
2654 bind $w <Visibility> "grab $w"
2656 bind $w <Key-Escape> "destroy $w"
2657 wm title $w "[appname] ([reponame]): Push"
2658 tkwait window $w
2659}
2660######################################################################
2662##
2663## merge
2664proc can_merge {} {
2666 global HEAD commit_type file_states
2667 if {[string match amend* $commit_type]} {
2669 info_popup {Cannot merge while amending.
2670You must finish amending this commit before
2672starting any type of merge.
2673}
2674 return 0
2675 }
2676 if {[committer_ident] eq {}} {return 0}
2678 if {![lock_index merge]} {return 0}
2679 # -- Our in memory state should match the repository.
2681 #
2682 repository_state curType curHEAD curMERGE_HEAD
2683 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2684 info_popup {Last scanned state does not match repository state.
2685Another Git program has modified this repository
2687since the last scan. A rescan must be performed
2688before a merge can be performed.
2689The rescan will be automatically started now.
2691}
2692 unlock_index
2693 rescan {set ui_status_value {Ready.}}
2694 return 0
2695 }
2696 foreach path [array names file_states] {
2698 switch -glob -- [lindex $file_states($path) 0] {
2699 _O {
2700 continue; # and pray it works!
2701 }
2702 U? {
2703 error_popup "You are in the middle of a conflicted merge.
2704File [short_path $path] has merge conflicts.
2706You must resolve them, add the file, and commit to
2708complete the current merge. Only then can you
2709begin another merge.
2710"
2711 unlock_index
2712 return 0
2713 }
2714 ?? {
2715 error_popup "You are in the middle of a change.
2716File [short_path $path] is modified.
2718You should complete the current commit before
2720starting a merge. Doing so will help you abort
2721a failed merge, should the need arise.
2722"
2723 unlock_index
2724 return 0
2725 }
2726 }
2727 }
2728 return 1
2730}
2731proc visualize_local_merge {w} {
2733 set revs {}
2734 foreach i [$w.source.l curselection] {
2735 lappend revs [$w.source.l get $i]
2736 }
2737 if {$revs eq {}} return
2738 lappend revs --not HEAD
2739 do_gitk $revs
2740}
2741proc start_local_merge_action {w} {
2743 global HEAD ui_status_value current_branch
2744 set cmd [list git merge]
2746 set names {}
2747 set revcnt 0
2748 foreach i [$w.source.l curselection] {
2749 set b [$w.source.l get $i]
2750 lappend cmd $b
2751 lappend names $b
2752 incr revcnt
2753 }
2754 if {$revcnt == 0} {
2756 return
2757 } elseif {$revcnt == 1} {
2758 set unit branch
2759 } elseif {$revcnt <= 15} {
2760 set unit branches
2761 } else {
2762 tk_messageBox \
2763 -icon error \
2764 -type ok \
2765 -title [wm title $w] \
2766 -parent $w \
2767 -message "Too many branches selected.
2768You have requested to merge $revcnt branches
2770in an octopus merge. This exceeds Git's
2771internal limit of 15 branches per merge.
2772Please select fewer branches. To merge more
2774than 15 branches, merge the branches in batches.
2775"
2776 return
2777 }
2778 set msg "Merging $current_branch, [join $names {, }]"
2780 set ui_status_value "$msg..."
2781 set cons [new_console "Merge" $msg]
2782 console_exec $cons $cmd [list finish_merge $revcnt]
2783 bind $w <Destroy> {}
2784 destroy $w
2785}
2786proc finish_merge {revcnt w ok} {
2788 console_done $w $ok
2789 if {$ok} {
2790 set msg {Merge completed successfully.}
2791 } else {
2792 if {$revcnt != 1} {
2793 info_popup "Octopus merge failed.
2794Your merge of $revcnt branches has failed.
2796There are file-level conflicts between the
2798branches which must be resolved manually.
2799The working directory will now be reset.
2801You can attempt this merge again
2803by merging only one branch at a time." $w
2804 set fd [open "| git read-tree --reset -u HEAD" r]
2806 fconfigure $fd -blocking 0 -translation binary
2807 fileevent $fd readable [list reset_hard_wait $fd]
2808 set ui_status_value {Aborting... please wait...}
2809 return
2810 }
2811 set msg {Merge failed. Conflict resolution is required.}
2813 }
2814 unlock_index
2815 rescan [list set ui_status_value $msg]
2816}
2817proc do_local_merge {} {
2819 global current_branch
2820 if {![can_merge]} return
2822 set w .merge_setup
2824 toplevel $w
2825 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2826 label $w.header \
2828 -text "Merge Into $current_branch" \
2829 -font font_uibold
2830 pack $w.header -side top -fill x
2831 frame $w.buttons
2833 button $w.buttons.visualize -text Visualize \
2834 -font font_ui \
2835 -command [list visualize_local_merge $w]
2836 pack $w.buttons.visualize -side left
2837 button $w.buttons.create -text Merge \
2838 -font font_ui \
2839 -command [list start_local_merge_action $w]
2840 pack $w.buttons.create -side right
2841 button $w.buttons.cancel -text {Cancel} \
2842 -font font_ui \
2843 -command [list destroy $w]
2844 pack $w.buttons.cancel -side right -padx 5
2845 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2846 labelframe $w.source \
2848 -text {Source Branches} \
2849 -font font_ui
2850 listbox $w.source.l \
2851 -height 10 \
2852 -width 70 \
2853 -selectmode extended \
2854 -yscrollcommand [list $w.source.sby set] \
2855 -font font_ui
2856 scrollbar $w.source.sby -command [list $w.source.l yview]
2857 pack $w.source.sby -side right -fill y
2858 pack $w.source.l -side left -fill both -expand 1
2859 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2860 set cmd [list git for-each-ref]
2862 lappend cmd {--format=%(objectname) %(refname)}
2863 lappend cmd refs/heads
2864 lappend cmd refs/remotes
2865 set fr_fd [open "| $cmd" r]
2866 fconfigure $fr_fd -translation binary
2867 while {[gets $fr_fd line] > 0} {
2868 set line [split $line { }]
2869 set sha1([lindex $line 0]) [lindex $line 1]
2870 }
2871 close $fr_fd
2872 set to_show {}
2874 set fr_fd [open "| git rev-list --all --not HEAD"]
2875 while {[gets $fr_fd line] > 0} {
2876 if {[catch {set ref $sha1($line)}]} continue
2877 regsub ^refs/(heads|remotes)/ $ref {} ref
2878 lappend to_show $ref
2879 }
2880 close $fr_fd
2881 foreach ref [lsort -unique $to_show] {
2883 $w.source.l insert end $ref
2884 }
2885 bind $w <Visibility> "grab $w"
2887 bind $w <Key-Escape> "unlock_index;destroy $w"
2888 bind $w <Destroy> unlock_index
2889 wm title $w "[appname] ([reponame]): Merge"
2890 tkwait window $w
2891}
2892proc do_reset_hard {} {
2894 global HEAD commit_type file_states
2895 if {[string match amend* $commit_type]} {
2897 info_popup {Cannot abort while amending.
2898You must finish amending this commit.
2900}
2901 return
2902 }
2903 if {![lock_index abort]} return
2905 if {[string match *merge* $commit_type]} {
2907 set op merge
2908 } else {
2909 set op commit
2910 }
2911 if {[ask_popup "Abort $op?
2913Aborting the current $op will cause
2915*ALL* uncommitted changes to be lost.
2916Continue with aborting the current $op?"] eq {yes}} {
2918 set fd [open "| git read-tree --reset -u HEAD" r]
2919 fconfigure $fd -blocking 0 -translation binary
2920 fileevent $fd readable [list reset_hard_wait $fd]
2921 set ui_status_value {Aborting... please wait...}
2922 } else {
2923 unlock_index
2924 }
2925}
2926proc reset_hard_wait {fd} {
2928 global ui_comm
2929 read $fd
2931 if {[eof $fd]} {
2932 close $fd
2933 unlock_index
2934 $ui_comm delete 0.0 end
2936 $ui_comm edit modified false
2937 catch {file delete [gitdir MERGE_HEAD]}
2939 catch {file delete [gitdir rr-cache MERGE_RR]}
2940 catch {file delete [gitdir SQUASH_MSG]}
2941 catch {file delete [gitdir MERGE_MSG]}
2942 catch {file delete [gitdir GITGUI_MSG]}
2943 rescan {set ui_status_value {Abort completed. Ready.}}
2945 }
2946}
2947######################################################################
2949##
2950## browser
2951set next_browser_id 0
2953proc new_browser {commit} {
2955 global next_browser_id cursor_ptr
2956 global browser_commit browser_status browser_stack browser_path browser_busy
2957 set w .browser[incr next_browser_id]
2959 set w_list $w.list.l
2960 set browser_commit($w_list) $commit
2961 set browser_status($w_list) {Starting...}
2962 set browser_stack($w_list) {}
2963 set browser_path($w_list) $browser_commit($w_list):
2964 set browser_busy($w_list) 1
2965 toplevel $w
2967 label $w.path -textvariable browser_path($w_list) \
2968 -anchor w \
2969 -justify left \
2970 -borderwidth 1 \
2971 -relief sunken \
2972 -font font_uibold
2973 pack $w.path -anchor w -side top -fill x
2974 frame $w.list
2976 text $w_list -background white -borderwidth 0 \
2977 -cursor $cursor_ptr \
2978 -state disabled \
2979 -wrap none \
2980 -height 20 \
2981 -width 70 \
2982 -xscrollcommand [list $w.list.sbx set] \
2983 -yscrollcommand [list $w.list.sby set] \
2984 -font font_ui
2985 $w_list tag conf in_sel \
2986 -background [$w_list cget -foreground] \
2987 -foreground [$w_list cget -background]
2988 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
2989 scrollbar $w.list.sby -orient v -command [list $w_list yview]
2990 pack $w.list.sbx -side bottom -fill x
2991 pack $w.list.sby -side right -fill y
2992 pack $w_list -side left -fill both -expand 1
2993 pack $w.list -side top -fill both -expand 1
2994 label $w.status -textvariable browser_status($w_list) \
2996 -anchor w \
2997 -justify left \
2998 -borderwidth 1 \
2999 -relief sunken \
3000 -font font_ui
3001 pack $w.status -anchor w -side bottom -fill x
3002 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3004 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3005 bind $w <Visibility> "focus $w"
3007 bind $w <Destroy> "
3008 array unset browser_buffer $w_list
3009 array unset browser_files $w_list
3010 array unset browser_status $w_list
3011 array unset browser_stack $w_list
3012 array unset browser_path $w_list
3013 array unset browser_commit $w_list
3014 array unset browser_busy $w_list
3015 "
3016 wm title $w "[appname] ([reponame]): File Browser"
3017 ls_tree $w_list $browser_commit($w_list) {}
3018}
3019proc browser_click {was_double_click w pos} {
3021 global browser_files browser_status browser_path
3022 global browser_commit browser_stack browser_busy
3023 if {$browser_busy($w)} return
3025 set lno [lindex [split [$w index $pos] .] 0]
3026 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3027 $w conf -state normal
3029 $w tag remove sel 0.0 end
3030 $w tag remove in_sel 0.0 end
3031 if {$info ne {}} {
3032 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3033 if {$was_double_click} {
3034 switch -- [lindex $info 0] {
3035 parent {
3036 set parent [lindex $browser_stack($w) end-1]
3037 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3038 if {$browser_stack($w) eq {}} {
3039 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3040 } else {
3041 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3042 }
3043 set browser_status($w) "Loading $browser_path($w)..."
3044 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3045 }
3046 tree {
3047 set name [lindex $info 2]
3048 set escn [escape_path $name]
3049 set browser_status($w) "Loading $escn..."
3050 append browser_path($w) $escn
3051 ls_tree $w [lindex $info 1] $name
3052 }
3053 blob {
3054 set name [lindex $info 2]
3055 set p {}
3056 foreach n $browser_stack($w) {
3057 append p [lindex $n 1]
3058 }
3059 append p $name
3060 show_blame $browser_commit($w) $p
3061 }
3062 }
3063 }
3064 }
3065 $w conf -state disabled
3066}
3067proc ls_tree {w tree_id name} {
3069 global browser_buffer browser_files browser_stack browser_busy
3070 set browser_buffer($w) {}
3072 set browser_files($w) {}
3073 set browser_busy($w) 1
3074 $w conf -state normal
3076 $w tag remove in_sel 0.0 end
3077 $w tag remove sel 0.0 end
3078 $w delete 0.0 end
3079 if {$browser_stack($w) ne {}} {
3080 $w image create end \
3081 -align center -padx 5 -pady 1 \
3082 -name icon0 \
3083 -image file_uplevel
3084 $w insert end {[Up To Parent]}
3085 lappend browser_files($w) parent
3086 }
3087 lappend browser_stack($w) [list $tree_id $name]
3088 $w conf -state disabled
3089 set cmd [list git ls-tree -z $tree_id]
3091 set fd [open "| $cmd" r]
3092 fconfigure $fd -blocking 0 -translation binary -encoding binary
3093 fileevent $fd readable [list read_ls_tree $fd $w]
3094}
3095proc read_ls_tree {fd w} {
3097 global browser_buffer browser_files browser_status browser_busy
3098 if {![winfo exists $w]} {
3100 catch {close $fd}
3101 return
3102 }
3103 append browser_buffer($w) [read $fd]
3105 set pck [split $browser_buffer($w) "\0"]
3106 set browser_buffer($w) [lindex $pck end]
3107 set n [llength $browser_files($w)]
3109 $w conf -state normal
3110 foreach p [lrange $pck 0 end-1] {
3111 set info [split $p "\t"]
3112 set path [lindex $info 1]
3113 set info [split [lindex $info 0] { }]
3114 set type [lindex $info 1]
3115 set object [lindex $info 2]
3116 switch -- $type {
3118 blob {
3119 set image file_mod
3120 }
3121 tree {
3122 set image file_dir
3123 append path /
3124 }
3125 default {
3126 set image file_question
3127 }
3128 }
3129 if {$n > 0} {$w insert end "\n"}
3131 $w image create end \
3132 -align center -padx 5 -pady 1 \
3133 -name icon[incr n] \
3134 -image $image
3135 $w insert end [escape_path $path]
3136 lappend browser_files($w) [list $type $object $path]
3137 }
3138 $w conf -state disabled
3139 if {[eof $fd]} {
3141 close $fd
3142 set browser_status($w) Ready.
3143 set browser_busy($w) 0
3144 array unset browser_buffer $w
3145 }
3146}
3147proc show_blame {commit path} {
3149 global next_browser_id blame_status blame_data
3150 set w .browser[incr next_browser_id]
3152 set blame_status($w) {Loading current file content...}
3153 set texts [list]
3154 toplevel $w
3156 label $w.path -text "$commit:$path" \
3158 -anchor w \
3159 -justify left \
3160 -borderwidth 1 \
3161 -relief sunken \
3162 -font font_uibold
3163 pack $w.path -side top -fill x
3164 set hbg #e2effa
3166 frame $w.out
3167 label $w.out.commit_l -text Commit \
3168 -relief solid \
3169 -borderwidth 1 \
3170 -background $hbg \
3171 -font font_uibold
3172 text $w.out.commit_t \
3173 -background white -borderwidth 0 \
3174 -state disabled \
3175 -wrap none \
3176 -height 40 \
3177 -width 9 \
3178 -font font_diff
3179 lappend texts $w.out.commit_t
3180 label $w.out.author_l -text Author \
3182 -relief solid \
3183 -borderwidth 1 \
3184 -background $hbg \
3185 -font font_uibold
3186 text $w.out.author_t \
3187 -background white -borderwidth 0 \
3188 -state disabled \
3189 -wrap none \
3190 -height 40 \
3191 -width 20 \
3192 -font font_diff
3193 lappend texts $w.out.author_t
3194 label $w.out.date_l -text Date \
3196 -relief solid \
3197 -borderwidth 1 \
3198 -background $hbg \
3199 -font font_uibold
3200 text $w.out.date_t \
3201 -background white -borderwidth 0 \
3202 -state disabled \
3203 -wrap none \
3204 -height 40 \
3205 -width [string length "yyyy-mm-dd hh:mm:ss"] \
3206 -font font_diff
3207 lappend texts $w.out.date_t
3208 label $w.out.filename_l -text Filename \
3210 -relief solid \
3211 -borderwidth 1 \
3212 -background $hbg \
3213 -font font_uibold
3214 text $w.out.filename_t \
3215 -background white -borderwidth 0 \
3216 -state disabled \
3217 -wrap none \
3218 -height 40 \
3219 -width 20 \
3220 -font font_diff
3221 lappend texts $w.out.filename_t
3222 label $w.out.origlinenumber_l -text {Orig Line} \
3224 -relief solid \
3225 -borderwidth 1 \
3226 -background $hbg \
3227 -font font_uibold
3228 text $w.out.origlinenumber_t \
3229 -background white -borderwidth 0 \
3230 -state disabled \
3231 -wrap none \
3232 -height 40 \
3233 -width 5 \
3234 -font font_diff
3235 $w.out.origlinenumber_t tag conf linenumber -justify right
3236 lappend texts $w.out.origlinenumber_t
3237 label $w.out.linenumber_l -text {Curr Line} \
3239 -relief solid \
3240 -borderwidth 1 \
3241 -background $hbg \
3242 -font font_uibold
3243 text $w.out.linenumber_t \
3244 -background white -borderwidth 0 \
3245 -state disabled \
3246 -wrap none \
3247 -height 40 \
3248 -width 5 \
3249 -font font_diff
3250 $w.out.linenumber_t tag conf linenumber -justify right
3251 lappend texts $w.out.linenumber_t
3252 label $w.out.file_l -text {File Content} \
3254 -relief solid \
3255 -borderwidth 1 \
3256 -background $hbg \
3257 -font font_uibold
3258 text $w.out.file_t \
3259 -background white -borderwidth 0 \
3260 -state disabled \
3261 -wrap none \
3262 -height 40 \
3263 -width 80 \
3264 -xscrollcommand [list $w.out.sbx set] \
3265 -font font_diff
3266 lappend texts $w.out.file_t
3267 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3269 scrollbar $w.out.sby -orient v \
3270 -command [list scrollbar2many $texts yview]
3271 set labels [list]
3272 foreach i $texts {
3273 regsub {_t$} $i _l l
3274 lappend labels $l
3275 }
3276 set file_col [expr {[llength $texts] - 1}]
3277 eval grid $labels -sticky we
3278 eval grid $texts $w.out.sby -sticky nsew
3279 grid conf $w.out.sbx -column $file_col -sticky we
3280 grid columnconfigure $w.out $file_col -weight 1
3281 grid rowconfigure $w.out 1 -weight 1
3282 pack $w.out -fill both -expand 1
3283 label $w.status -textvariable blame_status($w) \
3285 -anchor w \
3286 -justify left \
3287 -borderwidth 1 \
3288 -relief sunken \
3289 -font font_ui
3290 pack $w.status -side bottom -fill x
3291 menu $w.ctxm -tearoff 0
3293 $w.ctxm add command -label "Copy Commit" \
3294 -font font_ui \
3295 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3296 foreach i $texts {
3298 $i tag conf in_sel \
3299 -background [$i cget -foreground] \
3300 -foreground [$i cget -background]
3301 $i conf -yscrollcommand \
3302 [list many2scrollbar $texts yview $w.out.sby]
3303 bind $i <Button-1> "blame_highlight $i @%x,%y $texts;break"
3304 bind_button3 $i "
3305 set cursorX %x
3306 set cursorY %y
3307 set cursorW %W
3308 tk_popup $w.ctxm %X %Y
3309 "
3310 }
3311 bind $w <Visibility> "focus $w"
3313 bind $w <Destroy> "
3314 array unset blame_status $w
3315 array unset blame_data $w,*
3316 "
3317 wm title $w "[appname] ([reponame]): File Viewer"
3318 set blame_data($w,total_lines) 0
3320 set cmd [list git cat-file blob "$commit:$path"]
3321 set fd [open "| $cmd" r]
3322 fconfigure $fd -blocking 0 -translation lf -encoding binary
3323 fileevent $fd readable [list read_blame_catfile \
3324 $fd $w $commit $path \
3325 $texts $w.out.linenumber_t $w.out.file_t]
3326}
3327proc read_blame_catfile {fd w commit path texts w_lno w_file} {
3329 global blame_status blame_data
3330 if {![winfo exists $w_file]} {
3332 catch {close $fd}
3333 return
3334 }
3335 set n $blame_data($w,total_lines)
3337 foreach i $texts {$i conf -state normal}
3338 while {[gets $fd line] >= 0} {
3339 regsub "\r\$" $line {} line
3340 incr n
3341 $w_lno insert end $n linenumber
3342 $w_file insert end $line
3343 foreach i $texts {$i insert end "\n"}
3344 }
3345 foreach i $texts {$i conf -state disabled}
3346 set blame_data($w,total_lines) $n
3347 if {[eof $fd]} {
3349 close $fd
3350 set blame_status($w) {Loading annotations...}
3351 set cmd [list git blame -M -C --incremental]
3352 lappend cmd $commit -- $path
3353 set fd [open "| $cmd" r]
3354 fconfigure $fd -blocking 0 -translation lf -encoding binary
3355 fileevent $fd readable "read_blame_incremental $fd $w $texts"
3356 }
3357}
3358proc read_blame_incremental {fd w
3360 w_commit w_author w_date w_filename w_olno
3361 w_lno w_file} {
3362 global blame_status blame_data
3363 if {![winfo exists $w_commit]} {
3365 catch {close $fd}
3366 return
3367 }
3368 $w_commit conf -state normal
3370 $w_author conf -state normal
3371 $w_date conf -state normal
3372 $w_filename conf -state normal
3373 $w_olno conf -state normal
3374 while {[gets $fd line] >= 0} {
3376 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3377 commit original_line final_line line_count]} {
3378 set blame_data($w,commit) $commit
3379 set blame_data($w,original_line) $original_line
3380 set blame_data($w,final_line) $final_line
3381 set blame_data($w,line_count) $line_count
3382 } elseif {[string match {filename *} $line]} {
3383 set n $blame_data($w,line_count)
3384 set lno $blame_data($w,final_line)
3385 set ol $blame_data($w,original_line)
3386 set file [string range $line 9 end]
3387 set commit $blame_data($w,commit)
3388 set abbrev [string range $commit 0 8]
3389 if {[catch {set author $blame_data($w,$commit,author)} err]} {
3391 puts $err
3392 set author {}
3393 }
3394 if {[catch {set atime $blame_data($w,$commit,author-time)}]} {
3396 set atime {}
3397 } else {
3398 set atime [clock format $atime -format {%Y-%m-%d %T}]
3399 }
3400 while {$n > 0} {
3402 $w_commit delete $lno.0 "$lno.0 lineend"
3403 $w_author delete $lno.0 "$lno.0 lineend"
3404 $w_date delete $lno.0 "$lno.0 lineend"
3405 $w_filename delete $lno.0 "$lno.0 lineend"
3406 $w_olno delete $lno.0 "$lno.0 lineend"
3407 $w_commit insert $lno.0 $abbrev
3409 $w_author insert $lno.0 $author
3410 $w_date insert $lno.0 $atime
3411 $w_filename insert $lno.0 $file
3412 $w_olno insert $lno.0 $ol linenumber
3413 set blame_data($w,line$lno,commit) $commit
3415 incr n -1
3417 incr lno
3418 incr ol
3419 }
3420 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3421 set blame_data($w,$blame_data($w,commit),$header) $data
3422 }
3423 }
3424 $w_commit conf -state disabled
3426 $w_author conf -state disabled
3427 $w_date conf -state disabled
3428 $w_filename conf -state disabled
3429 $w_olno conf -state disabled
3430 if {[eof $fd]} {
3432 close $fd
3433 set blame_status($w) {Annotation complete.}
3434 }
3435}
3436proc blame_highlight {w pos args} {
3438 set lno [lindex [split [$w index $pos] .] 0]
3439 foreach i $args {
3440 $i tag remove in_sel 0.0 end
3441 }
3442 if {$lno eq {}} return
3443 foreach i $args {
3444 $i tag add in_sel $lno.0 "$lno.0 + 1 line"
3445 }
3446}
3447proc blame_copycommit {w i pos} {
3449 global blame_data
3450 set lno [lindex [split [$i index $pos] .] 0]
3451 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3452 clipboard clear
3453 clipboard append \
3454 -format STRING \
3455 -type STRING \
3456 -- $commit
3457 }
3458}
3459######################################################################
3461##
3462## icons
3463set filemask {
3465#define mask_width 14
3466#define mask_height 15
3467static unsigned char mask_bits[] = {
3468 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3469 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3470 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3471}
3472image create bitmap file_plain -background white -foreground black -data {
3474#define plain_width 14
3475#define plain_height 15
3476static unsigned char plain_bits[] = {
3477 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3478 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3479 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3480} -maskdata $filemask
3481image create bitmap file_mod -background white -foreground blue -data {
3483#define mod_width 14
3484#define mod_height 15
3485static unsigned char mod_bits[] = {
3486 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3487 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3488 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3489} -maskdata $filemask
3490image create bitmap file_fulltick -background white -foreground "#007000" -data {
3492#define file_fulltick_width 14
3493#define file_fulltick_height 15
3494static unsigned char file_fulltick_bits[] = {
3495 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3496 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3497 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3498} -maskdata $filemask
3499image create bitmap file_parttick -background white -foreground "#005050" -data {
3501#define parttick_width 14
3502#define parttick_height 15
3503static unsigned char parttick_bits[] = {
3504 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3505 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3506 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3507} -maskdata $filemask
3508image create bitmap file_question -background white -foreground black -data {
3510#define file_question_width 14
3511#define file_question_height 15
3512static unsigned char file_question_bits[] = {
3513 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3514 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3515 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3516} -maskdata $filemask
3517image create bitmap file_removed -background white -foreground red -data {
3519#define file_removed_width 14
3520#define file_removed_height 15
3521static unsigned char file_removed_bits[] = {
3522 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3523 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3524 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3525} -maskdata $filemask
3526image create bitmap file_merge -background white -foreground blue -data {
3528#define file_merge_width 14
3529#define file_merge_height 15
3530static unsigned char file_merge_bits[] = {
3531 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3532 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3533 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3534} -maskdata $filemask
3535set file_dir_data {
3537#define file_width 18
3538#define file_height 18
3539static unsigned char file_bits[] = {
3540 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3541 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3542 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3543 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3544 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3545}
3546image create bitmap file_dir -background white -foreground blue \
3547 -data $file_dir_data -maskdata $file_dir_data
3548unset file_dir_data
3549set file_uplevel_data {
3551#define up_width 15
3552#define up_height 15
3553static unsigned char up_bits[] = {
3554 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3555 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3556 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3557}
3558image create bitmap file_uplevel -background white -foreground red \
3559 -data $file_uplevel_data -maskdata $file_uplevel_data
3560unset file_uplevel_data
3561set ui_index .vpane.files.index.list
3563set ui_workdir .vpane.files.workdir.list
3564set all_icons(_$ui_index) file_plain
3566set all_icons(A$ui_index) file_fulltick
3567set all_icons(M$ui_index) file_fulltick
3568set all_icons(D$ui_index) file_removed
3569set all_icons(U$ui_index) file_merge
3570set all_icons(_$ui_workdir) file_plain
3572set all_icons(M$ui_workdir) file_mod
3573set all_icons(D$ui_workdir) file_question
3574set all_icons(U$ui_workdir) file_merge
3575set all_icons(O$ui_workdir) file_plain
3576set max_status_desc 0
3578foreach i {
3579 {__ "Unmodified"}
3580 {_M "Modified, not staged"}
3582 {M_ "Staged for commit"}
3583 {MM "Portions staged for commit"}
3584 {MD "Staged for commit, missing"}
3585 {_O "Untracked, not staged"}
3587 {A_ "Staged for commit"}
3588 {AM "Portions staged for commit"}
3589 {AD "Staged for commit, missing"}
3590 {_D "Missing"}
3592 {D_ "Staged for removal"}
3593 {DO "Staged for removal, still present"}
3594 {U_ "Requires merge resolution"}
3596 {UU "Requires merge resolution"}
3597 {UM "Requires merge resolution"}
3598 {UD "Requires merge resolution"}
3599 } {
3600 if {$max_status_desc < [string length [lindex $i 1]]} {
3601 set max_status_desc [string length [lindex $i 1]]
3602 }
3603 set all_descs([lindex $i 0]) [lindex $i 1]
3604}
3605unset i
3606######################################################################
3608##
3609## util
3610proc bind_button3 {w cmd} {
3612 bind $w <Any-Button-3> $cmd
3613 if {[is_MacOSX]} {
3614 bind $w <Control-Button-1> $cmd
3615 }
3616}
3617proc scrollbar2many {list mode args} {
3619 foreach w $list {eval $w $mode $args}
3620}
3621proc many2scrollbar {list mode sb top bottom} {
3623 $sb set $top $bottom
3624 foreach w $list {$w $mode moveto $top}
3625}
3626proc incr_font_size {font {amt 1}} {
3628 set sz [font configure $font -size]
3629 incr sz $amt
3630 font configure $font -size $sz
3631 font configure ${font}bold -size $sz
3632}
3633proc hook_failed_popup {hook msg} {
3635 set w .hookfail
3636 toplevel $w
3637 frame $w.m
3639 label $w.m.l1 -text "$hook hook failed:" \
3640 -anchor w \
3641 -justify left \
3642 -font font_uibold
3643 text $w.m.t \
3644 -background white -borderwidth 1 \
3645 -relief sunken \
3646 -width 80 -height 10 \
3647 -font font_diff \
3648 -yscrollcommand [list $w.m.sby set]
3649 label $w.m.l2 \
3650 -text {You must correct the above errors before committing.} \
3651 -anchor w \
3652 -justify left \
3653 -font font_uibold
3654 scrollbar $w.m.sby -command [list $w.m.t yview]
3655 pack $w.m.l1 -side top -fill x
3656 pack $w.m.l2 -side bottom -fill x
3657 pack $w.m.sby -side right -fill y
3658 pack $w.m.t -side left -fill both -expand 1
3659 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3660 $w.m.t insert 1.0 $msg
3662 $w.m.t conf -state disabled
3663 button $w.ok -text OK \
3665 -width 15 \
3666 -font font_ui \
3667 -command "destroy $w"
3668 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3669 bind $w <Visibility> "grab $w; focus $w"
3671 bind $w <Key-Return> "destroy $w"
3672 wm title $w "[appname] ([reponame]): error"
3673 tkwait window $w
3674}
3675set next_console_id 0
3677proc new_console {short_title long_title} {
3679 global next_console_id console_data
3680 set w .console[incr next_console_id]
3681 set console_data($w) [list $short_title $long_title]
3682 return [console_init $w]
3683}
3684proc console_init {w} {
3686 global console_cr console_data M1B
3687 set console_cr($w) 1.0
3689 toplevel $w
3690 frame $w.m
3691 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3692 -anchor w \
3693 -justify left \
3694 -font font_uibold
3695 text $w.m.t \
3696 -background white -borderwidth 1 \
3697 -relief sunken \
3698 -width 80 -height 10 \
3699 -font font_diff \
3700 -state disabled \
3701 -yscrollcommand [list $w.m.sby set]
3702 label $w.m.s -text {Working... please wait...} \
3703 -anchor w \
3704 -justify left \
3705 -font font_uibold
3706 scrollbar $w.m.sby -command [list $w.m.t yview]
3707 pack $w.m.l1 -side top -fill x
3708 pack $w.m.s -side bottom -fill x
3709 pack $w.m.sby -side right -fill y
3710 pack $w.m.t -side left -fill both -expand 1
3711 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3712 menu $w.ctxm -tearoff 0
3714 $w.ctxm add command -label "Copy" \
3715 -font font_ui \
3716 -command "tk_textCopy $w.m.t"
3717 $w.ctxm add command -label "Select All" \
3718 -font font_ui \
3719 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3720 $w.ctxm add command -label "Copy All" \
3721 -font font_ui \
3722 -command "
3723 $w.m.t tag add sel 0.0 end
3724 tk_textCopy $w.m.t
3725 $w.m.t tag remove sel 0.0 end
3726 "
3727 button $w.ok -text {Close} \
3729 -font font_ui \
3730 -state disabled \
3731 -command "destroy $w"
3732 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3733 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3735 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3736 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3737 bind $w <Visibility> "focus $w"
3738 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3739 return $w
3740}
3741proc console_exec {w cmd after} {
3743 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3744 # But most users need that so we have to relogin. :-(
3745 #
3746 if {[is_Cygwin]} {
3747 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3748 }
3749 # -- Tcl won't let us redirect both stdout and stderr to
3751 # the same pipe. So pass it through cat...
3752 #
3753 set cmd [concat | $cmd |& cat]
3754 set fd_f [open $cmd r]
3756 fconfigure $fd_f -blocking 0 -translation binary
3757 fileevent $fd_f readable [list console_read $w $fd_f $after]
3758}
3759proc console_read {w fd after} {
3761 global console_cr
3762 set buf [read $fd]
3764 if {$buf ne {}} {
3765 if {![winfo exists $w]} {console_init $w}
3766 $w.m.t conf -state normal
3767 set c 0
3768 set n [string length $buf]
3769 while {$c < $n} {
3770 set cr [string first "\r" $buf $c]
3771 set lf [string first "\n" $buf $c]
3772 if {$cr < 0} {set cr [expr {$n + 1}]}
3773 if {$lf < 0} {set lf [expr {$n + 1}]}
3774 if {$lf < $cr} {
3776 $w.m.t insert end [string range $buf $c $lf]
3777 set console_cr($w) [$w.m.t index {end -1c}]
3778 set c $lf
3779 incr c
3780 } else {
3781 $w.m.t delete $console_cr($w) end
3782 $w.m.t insert end "\n"
3783 $w.m.t insert end [string range $buf $c $cr]
3784 set c $cr
3785 incr c
3786 }
3787 }
3788 $w.m.t conf -state disabled
3789 $w.m.t see end
3790 }
3791 fconfigure $fd -blocking 1
3793 if {[eof $fd]} {
3794 if {[catch {close $fd}]} {
3795 set ok 0
3796 } else {
3797 set ok 1
3798 }
3799 uplevel #0 $after $w $ok
3800 return
3801 }
3802 fconfigure $fd -blocking 0
3803}
3804proc console_chain {cmdlist w {ok 1}} {
3806 if {$ok} {
3807 if {[llength $cmdlist] == 0} {
3808 console_done $w $ok
3809 return
3810 }
3811 set cmd [lindex $cmdlist 0]
3813 set cmdlist [lrange $cmdlist 1 end]
3814 if {[lindex $cmd 0] eq {console_exec}} {
3816 console_exec $w \
3817 [lindex $cmd 1] \
3818 [list console_chain $cmdlist]
3819 } else {
3820 uplevel #0 $cmd $cmdlist $w $ok
3821 }
3822 } else {
3823 console_done $w $ok
3824 }
3825}
3826proc console_done {args} {
3828 global console_cr console_data
3829 switch -- [llength $args] {
3831 2 {
3832 set w [lindex $args 0]
3833 set ok [lindex $args 1]
3834 }
3835 3 {
3836 set w [lindex $args 1]
3837 set ok [lindex $args 2]
3838 }
3839 default {
3840 error "wrong number of args: console_done ?ignored? w ok"
3841 }
3842 }
3843 if {$ok} {
3845 if {[winfo exists $w]} {
3846 $w.m.s conf -background green -text {Success}
3847 $w.ok conf -state normal
3848 }
3849 } else {
3850 if {![winfo exists $w]} {
3851 console_init $w
3852 }
3853 $w.m.s conf -background red -text {Error: Command Failed}
3854 $w.ok conf -state normal
3855 }
3856 array unset console_cr $w
3858 array unset console_data $w
3859}
3860######################################################################
3862##
3863## ui commands
3864set starting_gitk_msg {Starting gitk... please wait...}
3866proc do_gitk {revs} {
3868 global env ui_status_value starting_gitk_msg
3869 # -- On Windows gitk is severly broken, and right now it seems like
3871 # nobody cares about fixing it. The only known workaround is to
3872 # always delete ~/.gitk before starting the program.
3873 #
3874 if {[is_Windows]} {
3875 catch {file delete [file join $env(HOME) .gitk]}
3876 }
3877 # -- Always start gitk through whatever we were loaded with. This
3879 # lets us bypass using shell process on Windows systems.
3880 #
3881 set cmd [info nameofexecutable]
3882 lappend cmd [gitexec gitk]
3883 if {$revs ne {}} {
3884 append cmd { }
3885 append cmd $revs
3886 }
3887 if {[catch {eval exec $cmd &} err]} {
3889 error_popup "Failed to start gitk:\n\n$err"
3890 } else {
3891 set ui_status_value $starting_gitk_msg
3892 after 10000 {
3893 if {$ui_status_value eq $starting_gitk_msg} {
3894 set ui_status_value {Ready.}
3895 }
3896 }
3897 }
3898}
3899proc do_stats {} {
3901 set fd [open "| git count-objects -v" r]
3902 while {[gets $fd line] > 0} {
3903 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
3904 set stats($name) $value
3905 }
3906 }
3907 close $fd
3908 set packed_sz 0
3910 foreach p [glob -directory [gitdir objects pack] \
3911 -type f \
3912 -nocomplain -- *] {
3913 incr packed_sz [file size $p]
3914 }
3915 if {$packed_sz > 0} {
3916 set stats(size-pack) [expr {$packed_sz / 1024}]
3917 }
3918 set w .stats_view
3920 toplevel $w
3921 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3922 label $w.header -text {Database Statistics} \
3924 -font font_uibold
3925 pack $w.header -side top -fill x
3926 frame $w.buttons -border 1
3928 button $w.buttons.close -text Close \
3929 -font font_ui \
3930 -command [list destroy $w]
3931 button $w.buttons.gc -text {Compress Database} \
3932 -font font_ui \
3933 -command "destroy $w;do_gc"
3934 pack $w.buttons.close -side right
3935 pack $w.buttons.gc -side left
3936 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3937 frame $w.stat -borderwidth 1 -relief solid
3939 foreach s {
3940 {count {Number of loose objects}}
3941 {size {Disk space used by loose objects} { KiB}}
3942 {in-pack {Number of packed objects}}
3943 {packs {Number of packs}}
3944 {size-pack {Disk space used by packed objects} { KiB}}
3945 {prune-packable {Packed objects waiting for pruning}}
3946 {garbage {Garbage files}}
3947 } {
3948 set name [lindex $s 0]
3949 set label [lindex $s 1]
3950 if {[catch {set value $stats($name)}]} continue
3951 if {[llength $s] > 2} {
3952 set value "$value[lindex $s 2]"
3953 }
3954 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
3956 label $w.stat.v_$name -text $value -anchor w -font font_ui
3957 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
3958 }
3959 pack $w.stat -pady 10 -padx 10
3960 bind $w <Visibility> "grab $w; focus $w"
3962 bind $w <Key-Escape> [list destroy $w]
3963 bind $w <Key-Return> [list destroy $w]
3964 wm title $w "[appname] ([reponame]): Database Statistics"
3965 tkwait window $w
3966}
3967proc do_gc {} {
3969 set w [new_console {gc} {Compressing the object database}]
3970 console_chain {
3971 {console_exec {git pack-refs --prune}}
3972 {console_exec {git reflog expire --all}}
3973 {console_exec {git repack -a -d -l}}
3974 {console_exec {git rerere gc}}
3975 } $w
3976}
3977proc do_fsck_objects {} {
3979 set w [new_console {fsck-objects} \
3980 {Verifying the object database with fsck-objects}]
3981 set cmd [list git fsck-objects]
3982 lappend cmd --full
3983 lappend cmd --cache
3984 lappend cmd --strict
3985 console_exec $w $cmd console_done
3986}
3987set is_quitting 0
3989proc do_quit {} {
3991 global ui_comm is_quitting repo_config commit_type
3992 if {$is_quitting} return
3994 set is_quitting 1
3995 # -- Stash our current commit buffer.
3997 #
3998 set save [gitdir GITGUI_MSG]
3999 set msg [string trim [$ui_comm get 0.0 end]]
4000 regsub -all -line {[ \r\t]+$} $msg {} msg
4001 if {(![string match amend* $commit_type]
4002 || [$ui_comm edit modified])
4003 && $msg ne {}} {
4004 catch {
4005 set fd [open $save w]
4006 puts -nonewline $fd $msg
4007 close $fd
4008 }
4009 } else {
4010 catch {file delete $save}
4011 }
4012 # -- Stash our current window geometry into this repository.
4014 #
4015 set cfg_geometry [list]
4016 lappend cfg_geometry [wm geometry .]
4017 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4018 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4019 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4020 set rc_geometry {}
4021 }
4022 if {$cfg_geometry ne $rc_geometry} {
4023 catch {exec git repo-config gui.geometry $cfg_geometry}
4024 }
4025 destroy .
4027}
4028proc do_rescan {} {
4030 rescan {set ui_status_value {Ready.}}
4031}
4032proc unstage_helper {txt paths} {
4034 global file_states current_diff_path
4035 if {![lock_index begin-update]} return
4037 set pathList [list]
4039 set after {}
4040 foreach path $paths {
4041 switch -glob -- [lindex $file_states($path) 0] {
4042 A? -
4043 M? -
4044 D? {
4045 lappend pathList $path
4046 if {$path eq $current_diff_path} {
4047 set after {reshow_diff;}
4048 }
4049 }
4050 }
4051 }
4052 if {$pathList eq {}} {
4053 unlock_index
4054 } else {
4055 update_indexinfo \
4056 $txt \
4057 $pathList \
4058 [concat $after {set ui_status_value {Ready.}}]
4059 }
4060}
4061proc do_unstage_selection {} {
4063 global current_diff_path selected_paths
4064 if {[array size selected_paths] > 0} {
4066 unstage_helper \
4067 {Unstaging selected files from commit} \
4068 [array names selected_paths]
4069 } elseif {$current_diff_path ne {}} {
4070 unstage_helper \
4071 "Unstaging [short_path $current_diff_path] from commit" \
4072 [list $current_diff_path]
4073 }
4074}
4075proc add_helper {txt paths} {
4077 global file_states current_diff_path
4078 if {![lock_index begin-update]} return
4080 set pathList [list]
4082 set after {}
4083 foreach path $paths {
4084 switch -glob -- [lindex $file_states($path) 0] {
4085 _O -
4086 ?M -
4087 ?D -
4088 U? {
4089 lappend pathList $path
4090 if {$path eq $current_diff_path} {
4091 set after {reshow_diff;}
4092 }
4093 }
4094 }
4095 }
4096 if {$pathList eq {}} {
4097 unlock_index
4098 } else {
4099 update_index \
4100 $txt \
4101 $pathList \
4102 [concat $after {set ui_status_value {Ready to commit.}}]
4103 }
4104}
4105proc do_add_selection {} {
4107 global current_diff_path selected_paths
4108 if {[array size selected_paths] > 0} {
4110 add_helper \
4111 {Adding selected files} \
4112 [array names selected_paths]
4113 } elseif {$current_diff_path ne {}} {
4114 add_helper \
4115 "Adding [short_path $current_diff_path]" \
4116 [list $current_diff_path]
4117 }
4118}
4119proc do_add_all {} {
4121 global file_states
4122 set paths [list]
4124 foreach path [array names file_states] {
4125 switch -glob -- [lindex $file_states($path) 0] {
4126 U? {continue}
4127 ?M -
4128 ?D {lappend paths $path}
4129 }
4130 }
4131 add_helper {Adding all changed files} $paths
4132}
4133proc revert_helper {txt paths} {
4135 global file_states current_diff_path
4136 if {![lock_index begin-update]} return
4138 set pathList [list]
4140 set after {}
4141 foreach path $paths {
4142 switch -glob -- [lindex $file_states($path) 0] {
4143 U? {continue}
4144 ?M -
4145 ?D {
4146 lappend pathList $path
4147 if {$path eq $current_diff_path} {
4148 set after {reshow_diff;}
4149 }
4150 }
4151 }
4152 }
4153 set n [llength $pathList]
4155 if {$n == 0} {
4156 unlock_index
4157 return
4158 } elseif {$n == 1} {
4159 set s "[short_path [lindex $pathList]]"
4160 } else {
4161 set s "these $n files"
4162 }
4163 set reply [tk_dialog \
4165 .confirm_revert \
4166 "[appname] ([reponame])" \
4167 "Revert changes in $s?
4168Any unadded changes will be permanently lost by the revert." \
4170 question \
4171 1 \
4172 {Do Nothing} \
4173 {Revert Changes} \
4174 ]
4175 if {$reply == 1} {
4176 checkout_index \
4177 $txt \
4178 $pathList \
4179 [concat $after {set ui_status_value {Ready.}}]
4180 } else {
4181 unlock_index
4182 }
4183}
4184proc do_revert_selection {} {
4186 global current_diff_path selected_paths
4187 if {[array size selected_paths] > 0} {
4189 revert_helper \
4190 {Reverting selected files} \
4191 [array names selected_paths]
4192 } elseif {$current_diff_path ne {}} {
4193 revert_helper \
4194 "Reverting [short_path $current_diff_path]" \
4195 [list $current_diff_path]
4196 }
4197}
4198proc do_signoff {} {
4200 global ui_comm
4201 set me [committer_ident]
4203 if {$me eq {}} return
4204 set sob "Signed-off-by: $me"
4206 set last [$ui_comm get {end -1c linestart} {end -1c}]
4207 if {$last ne $sob} {
4208 $ui_comm edit separator
4209 if {$last ne {}
4210 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4211 $ui_comm insert end "\n"
4212 }
4213 $ui_comm insert end "\n$sob"
4214 $ui_comm edit separator
4215 $ui_comm see end
4216 }
4217}
4218proc do_select_commit_type {} {
4220 global commit_type selected_commit_type
4221 if {$selected_commit_type eq {new}
4223 && [string match amend* $commit_type]} {
4224 create_new_commit
4225 } elseif {$selected_commit_type eq {amend}
4226 && ![string match amend* $commit_type]} {
4227 load_last_commit
4228 # The amend request was rejected...
4230 #
4231 if {![string match amend* $commit_type]} {
4232 set selected_commit_type new
4233 }
4234 }
4235}
4236proc do_commit {} {
4238 commit_tree
4239}
4240proc do_about {} {
4242 global appvers copyright
4243 global tcl_patchLevel tk_patchLevel
4244 set w .about_dialog
4246 toplevel $w
4247 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4248 label $w.header -text "About [appname]" \
4250 -font font_uibold
4251 pack $w.header -side top -fill x
4252 frame $w.buttons
4254 button $w.buttons.close -text {Close} \
4255 -font font_ui \
4256 -command [list destroy $w]
4257 pack $w.buttons.close -side right
4258 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4259 label $w.desc \
4261 -text "[appname] - a commit creation tool for Git.
4262$copyright" \
4263 -padx 5 -pady 5 \
4264 -justify left \
4265 -anchor w \
4266 -borderwidth 1 \
4267 -relief solid \
4268 -font font_ui
4269 pack $w.desc -side top -fill x -padx 5 -pady 5
4270 set v {}
4272 append v "[appname] version $appvers\n"
4273 append v "[exec git version]\n"
4274 append v "\n"
4275 if {$tcl_patchLevel eq $tk_patchLevel} {
4276 append v "Tcl/Tk version $tcl_patchLevel"
4277 } else {
4278 append v "Tcl version $tcl_patchLevel"
4279 append v ", Tk version $tk_patchLevel"
4280 }
4281 label $w.vers \
4283 -text $v \
4284 -padx 5 -pady 5 \
4285 -justify left \
4286 -anchor w \
4287 -borderwidth 1 \
4288 -relief solid \
4289 -font font_ui
4290 pack $w.vers -side top -fill x -padx 5 -pady 5
4291 menu $w.ctxm -tearoff 0
4293 $w.ctxm add command \
4294 -label {Copy} \
4295 -font font_ui \
4296 -command "
4297 clipboard clear
4298 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4299 "
4300 bind $w <Visibility> "grab $w; focus $w"
4302 bind $w <Key-Escape> "destroy $w"
4303 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4304 wm title $w "About [appname]"
4305 tkwait window $w
4306}
4307proc do_options {} {
4309 global repo_config global_config font_descs
4310 global repo_config_new global_config_new
4311 array unset repo_config_new
4313 array unset global_config_new
4314 foreach name [array names repo_config] {
4315 set repo_config_new($name) $repo_config($name)
4316 }
4317 load_config 1
4318 foreach name [array names repo_config] {
4319 switch -- $name {
4320 gui.diffcontext {continue}
4321 }
4322 set repo_config_new($name) $repo_config($name)
4323 }
4324 foreach name [array names global_config] {
4325 set global_config_new($name) $global_config($name)
4326 }
4327 set w .options_editor
4329 toplevel $w
4330 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4331 label $w.header -text "[appname] Options" \
4333 -font font_uibold
4334 pack $w.header -side top -fill x
4335 frame $w.buttons
4337 button $w.buttons.restore -text {Restore Defaults} \
4338 -font font_ui \
4339 -command do_restore_defaults
4340 pack $w.buttons.restore -side left
4341 button $w.buttons.save -text Save \
4342 -font font_ui \
4343 -command [list do_save_config $w]
4344 pack $w.buttons.save -side right
4345 button $w.buttons.cancel -text {Cancel} \
4346 -font font_ui \
4347 -command [list destroy $w]
4348 pack $w.buttons.cancel -side right -padx 5
4349 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4350 labelframe $w.repo -text "[reponame] Repository" \
4352 -font font_ui
4353 labelframe $w.global -text {Global (All Repositories)} \
4354 -font font_ui
4355 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4356 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4357 set optid 0
4359 foreach option {
4360 {t user.name {User Name}}
4361 {t user.email {Email Address}}
4362 {b merge.summary {Summarize Merge Commits}}
4364 {i-1..5 merge.verbosity {Merge Verbosity}}
4365 {b gui.trustmtime {Trust File Modification Timestamps}}
4367 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4368 {t gui.newbranchtemplate {New Branch Name Template}}
4369 } {
4370 set type [lindex $option 0]
4371 set name [lindex $option 1]
4372 set text [lindex $option 2]
4373 incr optid
4374 foreach f {repo global} {
4375 switch -glob -- $type {
4376 b {
4377 checkbutton $w.$f.$optid -text $text \
4378 -variable ${f}_config_new($name) \
4379 -onvalue true \
4380 -offvalue false \
4381 -font font_ui
4382 pack $w.$f.$optid -side top -anchor w
4383 }
4384 i-* {
4385 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4386 frame $w.$f.$optid
4387 label $w.$f.$optid.l -text "$text:" -font font_ui
4388 pack $w.$f.$optid.l -side left -anchor w -fill x
4389 spinbox $w.$f.$optid.v \
4390 -textvariable ${f}_config_new($name) \
4391 -from $min \
4392 -to $max \
4393 -increment 1 \
4394 -width [expr {1 + [string length $max]}] \
4395 -font font_ui
4396 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4397 pack $w.$f.$optid.v -side right -anchor e -padx 5
4398 pack $w.$f.$optid -side top -anchor w -fill x
4399 }
4400 t {
4401 frame $w.$f.$optid
4402 label $w.$f.$optid.l -text "$text:" -font font_ui
4403 entry $w.$f.$optid.v \
4404 -borderwidth 1 \
4405 -relief sunken \
4406 -width 20 \
4407 -textvariable ${f}_config_new($name) \
4408 -font font_ui
4409 pack $w.$f.$optid.l -side left -anchor w
4410 pack $w.$f.$optid.v -side left -anchor w \
4411 -fill x -expand 1 \
4412 -padx 5
4413 pack $w.$f.$optid -side top -anchor w -fill x
4414 }
4415 }
4416 }
4417 }
4418 set all_fonts [lsort [font families]]
4420 foreach option $font_descs {
4421 set name [lindex $option 0]
4422 set font [lindex $option 1]
4423 set text [lindex $option 2]
4424 set global_config_new(gui.$font^^family) \
4426 [font configure $font -family]
4427 set global_config_new(gui.$font^^size) \
4428 [font configure $font -size]
4429 frame $w.global.$name
4431 label $w.global.$name.l -text "$text:" -font font_ui
4432 pack $w.global.$name.l -side left -anchor w -fill x
4433 eval tk_optionMenu $w.global.$name.family \
4434 global_config_new(gui.$font^^family) \
4435 $all_fonts
4436 spinbox $w.global.$name.size \
4437 -textvariable global_config_new(gui.$font^^size) \
4438 -from 2 -to 80 -increment 1 \
4439 -width 3 \
4440 -font font_ui
4441 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4442 pack $w.global.$name.size -side right -anchor e
4443 pack $w.global.$name.family -side right -anchor e
4444 pack $w.global.$name -side top -anchor w -fill x
4445 }
4446 bind $w <Visibility> "grab $w; focus $w"
4448 bind $w <Key-Escape> "destroy $w"
4449 wm title $w "[appname] ([reponame]): Options"
4450 tkwait window $w
4451}
4452proc do_restore_defaults {} {
4454 global font_descs default_config repo_config
4455 global repo_config_new global_config_new
4456 foreach name [array names default_config] {
4458 set repo_config_new($name) $default_config($name)
4459 set global_config_new($name) $default_config($name)
4460 }
4461 foreach option $font_descs {
4463 set name [lindex $option 0]
4464 set repo_config(gui.$name) $default_config(gui.$name)
4465 }
4466 apply_config
4467 foreach option $font_descs {
4469 set name [lindex $option 0]
4470 set font [lindex $option 1]
4471 set global_config_new(gui.$font^^family) \
4472 [font configure $font -family]
4473 set global_config_new(gui.$font^^size) \
4474 [font configure $font -size]
4475 }
4476}
4477proc do_save_config {w} {
4479 if {[catch {save_config} err]} {
4480 error_popup "Failed to completely save options:\n\n$err"
4481 }
4482 reshow_diff
4483 destroy $w
4484}
4485proc do_windows_shortcut {} {
4487 global argv0
4488 set fn [tk_getSaveFile \
4490 -parent . \
4491 -title "[appname] ([reponame]): Create Desktop Icon" \
4492 -initialfile "Git [reponame].bat"]
4493 if {$fn != {}} {
4494 if {[catch {
4495 set fd [open $fn w]
4496 puts $fd "@ECHO Entering [reponame]"
4497 puts $fd "@ECHO Starting git-gui... please wait..."
4498 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4499 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4500 puts -nonewline $fd "@\"[info nameofexecutable]\""
4501 puts $fd " \"[file normalize $argv0]\""
4502 close $fd
4503 } err]} {
4504 error_popup "Cannot write script:\n\n$err"
4505 }
4506 }
4507}
4508proc do_cygwin_shortcut {} {
4510 global argv0
4511 if {[catch {
4513 set desktop [exec cygpath \
4514 --windows \
4515 --absolute \
4516 --long-name \
4517 --desktop]
4518 }]} {
4519 set desktop .
4520 }
4521 set fn [tk_getSaveFile \
4522 -parent . \
4523 -title "[appname] ([reponame]): Create Desktop Icon" \
4524 -initialdir $desktop \
4525 -initialfile "Git [reponame].bat"]
4526 if {$fn != {}} {
4527 if {[catch {
4528 set fd [open $fn w]
4529 set sh [exec cygpath \
4530 --windows \
4531 --absolute \
4532 /bin/sh]
4533 set me [exec cygpath \
4534 --unix \
4535 --absolute \
4536 $argv0]
4537 set gd [exec cygpath \
4538 --unix \
4539 --absolute \
4540 [gitdir]]
4541 set gw [exec cygpath \
4542 --windows \
4543 --absolute \
4544 [file dirname [gitdir]]]
4545 regsub -all ' $me "'\\''" me
4546 regsub -all ' $gd "'\\''" gd
4547 puts $fd "@ECHO Entering $gw"
4548 puts $fd "@ECHO Starting git-gui... please wait..."
4549 puts -nonewline $fd "@\"$sh\" --login -c \""
4550 puts -nonewline $fd "GIT_DIR='$gd'"
4551 puts -nonewline $fd " '$me'"
4552 puts $fd "&\""
4553 close $fd
4554 } err]} {
4555 error_popup "Cannot write script:\n\n$err"
4556 }
4557 }
4558}
4559proc do_macosx_app {} {
4561 global argv0 env
4562 set fn [tk_getSaveFile \
4564 -parent . \
4565 -title "[appname] ([reponame]): Create Desktop Icon" \
4566 -initialdir [file join $env(HOME) Desktop] \
4567 -initialfile "Git [reponame].app"]
4568 if {$fn != {}} {
4569 if {[catch {
4570 set Contents [file join $fn Contents]
4571 set MacOS [file join $Contents MacOS]
4572 set exe [file join $MacOS git-gui]
4573 file mkdir $MacOS
4575 set fd [open [file join $Contents Info.plist] w]
4577 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4578<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4579<plist version="1.0">
4580<dict>
4581 <key>CFBundleDevelopmentRegion</key>
4582 <string>English</string>
4583 <key>CFBundleExecutable</key>
4584 <string>git-gui</string>
4585 <key>CFBundleIdentifier</key>
4586 <string>org.spearce.git-gui</string>
4587 <key>CFBundleInfoDictionaryVersion</key>
4588 <string>6.0</string>
4589 <key>CFBundlePackageType</key>
4590 <string>APPL</string>
4591 <key>CFBundleSignature</key>
4592 <string>????</string>
4593 <key>CFBundleVersion</key>
4594 <string>1.0</string>
4595 <key>NSPrincipalClass</key>
4596 <string>NSApplication</string>
4597</dict>
4598</plist>}
4599 close $fd
4600 set fd [open $exe w]
4602 set gd [file normalize [gitdir]]
4603 set ep [file normalize [gitexec]]
4604 regsub -all ' $gd "'\\''" gd
4605 regsub -all ' $ep "'\\''" ep
4606 puts $fd "#!/bin/sh"
4607 foreach name [array names env] {
4608 if {[string match GIT_* $name]} {
4609 regsub -all ' $env($name) "'\\''" v
4610 puts $fd "export $name='$v'"
4611 }
4612 }
4613 puts $fd "export PATH='$ep':\$PATH"
4614 puts $fd "export GIT_DIR='$gd'"
4615 puts $fd "exec [file normalize $argv0]"
4616 close $fd
4617 file attributes $exe -permissions u+x,g+x,o+x
4619 } err]} {
4620 error_popup "Cannot write icon:\n\n$err"
4621 }
4622 }
4623}
4624proc toggle_or_diff {w x y} {
4626 global file_states file_lists current_diff_path ui_index ui_workdir
4627 global last_clicked selected_paths
4628 set pos [split [$w index @$x,$y] .]
4630 set lno [lindex $pos 0]
4631 set col [lindex $pos 1]
4632 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4633 if {$path eq {}} {
4634 set last_clicked {}
4635 return
4636 }
4637 set last_clicked [list $w $lno]
4639 array unset selected_paths
4640 $ui_index tag remove in_sel 0.0 end
4641 $ui_workdir tag remove in_sel 0.0 end
4642 if {$col == 0} {
4644 if {$current_diff_path eq $path} {
4645 set after {reshow_diff;}
4646 } else {
4647 set after {}
4648 }
4649 if {$w eq $ui_index} {
4650 update_indexinfo \
4651 "Unstaging [short_path $path] from commit" \
4652 [list $path] \
4653 [concat $after {set ui_status_value {Ready.}}]
4654 } elseif {$w eq $ui_workdir} {
4655 update_index \
4656 "Adding [short_path $path]" \
4657 [list $path] \
4658 [concat $after {set ui_status_value {Ready.}}]
4659 }
4660 } else {
4661 show_diff $path $w $lno
4662 }
4663}
4664proc add_one_to_selection {w x y} {
4666 global file_lists last_clicked selected_paths
4667 set lno [lindex [split [$w index @$x,$y] .] 0]
4669 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4670 if {$path eq {}} {
4671 set last_clicked {}
4672 return
4673 }
4674 if {$last_clicked ne {}
4676 && [lindex $last_clicked 0] ne $w} {
4677 array unset selected_paths
4678 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4679 }
4680 set last_clicked [list $w $lno]
4682 if {[catch {set in_sel $selected_paths($path)}]} {
4683 set in_sel 0
4684 }
4685 if {$in_sel} {
4686 unset selected_paths($path)
4687 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4688 } else {
4689 set selected_paths($path) 1
4690 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4691 }
4692}
4693proc add_range_to_selection {w x y} {
4695 global file_lists last_clicked selected_paths
4696 if {[lindex $last_clicked 0] ne $w} {
4698 toggle_or_diff $w $x $y
4699 return
4700 }
4701 set lno [lindex [split [$w index @$x,$y] .] 0]
4703 set lc [lindex $last_clicked 1]
4704 if {$lc < $lno} {
4705 set begin $lc
4706 set end $lno
4707 } else {
4708 set begin $lno
4709 set end $lc
4710 }
4711 foreach path [lrange $file_lists($w) \
4713 [expr {$begin - 1}] \
4714 [expr {$end - 1}]] {
4715 set selected_paths($path) 1
4716 }
4717 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4718}
4719######################################################################
4721##
4722## config defaults
4723set cursor_ptr arrow
4725font create font_diff -family Courier -size 10
4726font create font_ui
4727catch {
4728 label .dummy
4729 eval font configure font_ui [font actual [.dummy cget -font]]
4730 destroy .dummy
4731}
4732font create font_uibold
4734font create font_diffbold
4735if {[is_Windows]} {
4737 set M1B Control
4738 set M1T Ctrl
4739} elseif {[is_MacOSX]} {
4740 set M1B M1
4741 set M1T Cmd
4742} else {
4743 set M1B M1
4744 set M1T M1
4745}
4746proc apply_config {} {
4748 global repo_config font_descs
4749 foreach option $font_descs {
4751 set name [lindex $option 0]
4752 set font [lindex $option 1]
4753 if {[catch {
4754 foreach {cn cv} $repo_config(gui.$name) {
4755 font configure $font $cn $cv
4756 }
4757 } err]} {
4758 error_popup "Invalid font specified in gui.$name:\n\n$err"
4759 }
4760 foreach {cn cv} [font configure $font] {
4761 font configure ${font}bold $cn $cv
4762 }
4763 font configure ${font}bold -weight bold
4764 }
4765}
4766set default_config(merge.summary) false
4768set default_config(merge.verbosity) 2
4769set default_config(user.name) {}
4770set default_config(user.email) {}
4771set default_config(gui.trustmtime) false
4773set default_config(gui.diffcontext) 5
4774set default_config(gui.newbranchtemplate) {}
4775set default_config(gui.fontui) [font configure font_ui]
4776set default_config(gui.fontdiff) [font configure font_diff]
4777set font_descs {
4778 {fontui font_ui {Main Font}}
4779 {fontdiff font_diff {Diff/Console Font}}
4780}
4781load_config 0
4782apply_config
4783######################################################################
4785##
4786## ui construction
4787# -- Menu Bar
4789#
4790menu .mbar -tearoff 0
4791.mbar add cascade -label Repository -menu .mbar.repository
4792.mbar add cascade -label Edit -menu .mbar.edit
4793if {!$single_commit} {
4794 .mbar add cascade -label Branch -menu .mbar.branch
4795}
4796.mbar add cascade -label Commit -menu .mbar.commit
4797if {!$single_commit} {
4798 .mbar add cascade -label Merge -menu .mbar.merge
4799 .mbar add cascade -label Fetch -menu .mbar.fetch
4800 .mbar add cascade -label Push -menu .mbar.push
4801}
4802. configure -menu .mbar
4803# -- Repository Menu
4805#
4806menu .mbar.repository
4807.mbar.repository add command \
4809 -label {Browse Current Branch} \
4810 -command {new_browser $current_branch} \
4811 -font font_ui
4812.mbar.repository add separator
4813.mbar.repository add command \
4815 -label {Visualize Current Branch} \
4816 -command {do_gitk {}} \
4817 -font font_ui
4818.mbar.repository add command \
4819 -label {Visualize All Branches} \
4820 -command {do_gitk {--all}} \
4821 -font font_ui
4822.mbar.repository add separator
4823if {!$single_commit} {
4825 .mbar.repository add command -label {Database Statistics} \
4826 -command do_stats \
4827 -font font_ui
4828 .mbar.repository add command -label {Compress Database} \
4830 -command do_gc \
4831 -font font_ui
4832 .mbar.repository add command -label {Verify Database} \
4834 -command do_fsck_objects \
4835 -font font_ui
4836 .mbar.repository add separator
4838 if {[is_Cygwin]} {
4840 .mbar.repository add command \
4841 -label {Create Desktop Icon} \
4842 -command do_cygwin_shortcut \
4843 -font font_ui
4844 } elseif {[is_Windows]} {
4845 .mbar.repository add command \
4846 -label {Create Desktop Icon} \
4847 -command do_windows_shortcut \
4848 -font font_ui
4849 } elseif {[is_MacOSX]} {
4850 .mbar.repository add command \
4851 -label {Create Desktop Icon} \
4852 -command do_macosx_app \
4853 -font font_ui
4854 }
4855}
4856.mbar.repository add command -label Quit \
4858 -command do_quit \
4859 -accelerator $M1T-Q \
4860 -font font_ui
4861# -- Edit Menu
4863#
4864menu .mbar.edit
4865.mbar.edit add command -label Undo \
4866 -command {catch {[focus] edit undo}} \
4867 -accelerator $M1T-Z \
4868 -font font_ui
4869.mbar.edit add command -label Redo \
4870 -command {catch {[focus] edit redo}} \
4871 -accelerator $M1T-Y \
4872 -font font_ui
4873.mbar.edit add separator
4874.mbar.edit add command -label Cut \
4875 -command {catch {tk_textCut [focus]}} \
4876 -accelerator $M1T-X \
4877 -font font_ui
4878.mbar.edit add command -label Copy \
4879 -command {catch {tk_textCopy [focus]}} \
4880 -accelerator $M1T-C \
4881 -font font_ui
4882.mbar.edit add command -label Paste \
4883 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4884 -accelerator $M1T-V \
4885 -font font_ui
4886.mbar.edit add command -label Delete \
4887 -command {catch {[focus] delete sel.first sel.last}} \
4888 -accelerator Del \
4889 -font font_ui
4890.mbar.edit add separator
4891.mbar.edit add command -label {Select All} \
4892 -command {catch {[focus] tag add sel 0.0 end}} \
4893 -accelerator $M1T-A \
4894 -font font_ui
4895# -- Branch Menu
4897#
4898if {!$single_commit} {
4899 menu .mbar.branch
4900 .mbar.branch add command -label {Create...} \
4902 -command do_create_branch \
4903 -accelerator $M1T-N \
4904 -font font_ui
4905 lappend disable_on_lock [list .mbar.branch entryconf \
4906 [.mbar.branch index last] -state]
4907 .mbar.branch add command -label {Delete...} \
4909 -command do_delete_branch \
4910 -font font_ui
4911 lappend disable_on_lock [list .mbar.branch entryconf \
4912 [.mbar.branch index last] -state]
4913}
4914# -- Commit Menu
4916#
4917menu .mbar.commit
4918.mbar.commit add radiobutton \
4920 -label {New Commit} \
4921 -command do_select_commit_type \
4922 -variable selected_commit_type \
4923 -value new \
4924 -font font_ui
4925lappend disable_on_lock \
4926 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4927.mbar.commit add radiobutton \
4929 -label {Amend Last Commit} \
4930 -command do_select_commit_type \
4931 -variable selected_commit_type \
4932 -value amend \
4933 -font font_ui
4934lappend disable_on_lock \
4935 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4936.mbar.commit add separator
4938.mbar.commit add command -label Rescan \
4940 -command do_rescan \
4941 -accelerator F5 \
4942 -font font_ui
4943lappend disable_on_lock \
4944 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4945.mbar.commit add command -label {Add To Commit} \
4947 -command do_add_selection \
4948 -font font_ui
4949lappend disable_on_lock \
4950 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4951.mbar.commit add command -label {Add All To Commit} \
4953 -command do_add_all \
4954 -accelerator $M1T-I \
4955 -font font_ui
4956lappend disable_on_lock \
4957 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4958.mbar.commit add command -label {Unstage From Commit} \
4960 -command do_unstage_selection \
4961 -font font_ui
4962lappend disable_on_lock \
4963 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4964.mbar.commit add command -label {Revert Changes} \
4966 -command do_revert_selection \
4967 -font font_ui
4968lappend disable_on_lock \
4969 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4970.mbar.commit add separator
4972.mbar.commit add command -label {Sign Off} \
4974 -command do_signoff \
4975 -accelerator $M1T-S \
4976 -font font_ui
4977.mbar.commit add command -label Commit \
4979 -command do_commit \
4980 -accelerator $M1T-Return \
4981 -font font_ui
4982lappend disable_on_lock \
4983 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4984if {[is_MacOSX]} {
4986 # -- Apple Menu (Mac OS X only)
4987 #
4988 .mbar add cascade -label Apple -menu .mbar.apple
4989 menu .mbar.apple
4990 .mbar.apple add command -label "About [appname]" \
4992 -command do_about \
4993 -font font_ui
4994 .mbar.apple add command -label "[appname] Options..." \
4995 -command do_options \
4996 -font font_ui
4997} else {
4998 # -- Edit Menu
4999 #
5000 .mbar.edit add separator
5001 .mbar.edit add command -label {Options...} \
5002 -command do_options \
5003 -font font_ui
5004 # -- Tools Menu
5006 #
5007 if {[file exists /usr/local/miga/lib/gui-miga]
5008 && [file exists .pvcsrc]} {
5009 proc do_miga {} {
5010 global ui_status_value
5011 if {![lock_index update]} return
5012 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5013 set miga_fd [open "|$cmd" r]
5014 fconfigure $miga_fd -blocking 0
5015 fileevent $miga_fd readable [list miga_done $miga_fd]
5016 set ui_status_value {Running miga...}
5017 }
5018 proc miga_done {fd} {
5019 read $fd 512
5020 if {[eof $fd]} {
5021 close $fd
5022 unlock_index
5023 rescan [list set ui_status_value {Ready.}]
5024 }
5025 }
5026 .mbar add cascade -label Tools -menu .mbar.tools
5027 menu .mbar.tools
5028 .mbar.tools add command -label "Migrate" \
5029 -command do_miga \
5030 -font font_ui
5031 lappend disable_on_lock \
5032 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5033 }
5034}
5035# -- Help Menu
5037#
5038.mbar add cascade -label Help -menu .mbar.help
5039menu .mbar.help
5040if {![is_MacOSX]} {
5042 .mbar.help add command -label "About [appname]" \
5043 -command do_about \
5044 -font font_ui
5045}
5046set browser {}
5048catch {set browser $repo_config(instaweb.browser)}
5049set doc_path [file dirname [gitexec]]
5050set doc_path [file join $doc_path Documentation index.html]
5051if {[is_Cygwin]} {
5053 set doc_path [exec cygpath --windows $doc_path]
5054}
5055if {$browser eq {}} {
5057 if {[is_MacOSX]} {
5058 set browser open
5059 } elseif {[is_Cygwin]} {
5060 set program_files [file dirname [exec cygpath --windir]]
5061 set program_files [file join $program_files {Program Files}]
5062 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5063 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5064 if {[file exists $firefox]} {
5065 set browser $firefox
5066 } elseif {[file exists $ie]} {
5067 set browser $ie
5068 }
5069 unset program_files firefox ie
5070 }
5071}
5072if {[file isfile $doc_path]} {
5074 set doc_url "file:$doc_path"
5075} else {
5076 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5077}
5078if {$browser ne {}} {
5080 .mbar.help add command -label {Online Documentation} \
5081 -command [list exec $browser $doc_url &] \
5082 -font font_ui
5083}
5084unset browser doc_path doc_url
5085# -- Branch Control
5087#
5088frame .branch \
5089 -borderwidth 1 \
5090 -relief sunken
5091label .branch.l1 \
5092 -text {Current Branch:} \
5093 -anchor w \
5094 -justify left \
5095 -font font_ui
5096label .branch.cb \
5097 -textvariable current_branch \
5098 -anchor w \
5099 -justify left \
5100 -font font_ui
5101pack .branch.l1 -side left
5102pack .branch.cb -side left -fill x
5103pack .branch -side top -fill x
5104if {!$single_commit} {
5106 menu .mbar.merge
5107 .mbar.merge add command -label {Local Merge...} \
5108 -command do_local_merge \
5109 -font font_ui
5110 lappend disable_on_lock \
5111 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5112 .mbar.merge add command -label {Abort Merge...} \
5113 -command do_reset_hard \
5114 -font font_ui
5115 lappend disable_on_lock \
5116 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5117 menu .mbar.fetch
5120 menu .mbar.push
5122 .mbar.push add command -label {Push...} \
5123 -command do_push_anywhere \
5124 -font font_ui
5125}
5126# -- Main Window Layout
5128#
5129panedwindow .vpane -orient vertical
5130panedwindow .vpane.files -orient horizontal
5131.vpane add .vpane.files -sticky nsew -height 100 -width 200
5132pack .vpane -anchor n -side top -fill both -expand 1
5133# -- Index File List
5135#
5136frame .vpane.files.index -height 100 -width 200
5137label .vpane.files.index.title -text {Changes To Be Committed} \
5138 -background green \
5139 -font font_ui
5140text $ui_index -background white -borderwidth 0 \
5141 -width 20 -height 10 \
5142 -wrap none \
5143 -font font_ui \
5144 -cursor $cursor_ptr \
5145 -xscrollcommand {.vpane.files.index.sx set} \
5146 -yscrollcommand {.vpane.files.index.sy set} \
5147 -state disabled
5148scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5149scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5150pack .vpane.files.index.title -side top -fill x
5151pack .vpane.files.index.sx -side bottom -fill x
5152pack .vpane.files.index.sy -side right -fill y
5153pack $ui_index -side left -fill both -expand 1
5154.vpane.files add .vpane.files.index -sticky nsew
5155# -- Working Directory File List
5157#
5158frame .vpane.files.workdir -height 100 -width 200
5159label .vpane.files.workdir.title -text {Changed But Not Updated} \
5160 -background red \
5161 -font font_ui
5162text $ui_workdir -background white -borderwidth 0 \
5163 -width 20 -height 10 \
5164 -wrap none \
5165 -font font_ui \
5166 -cursor $cursor_ptr \
5167 -xscrollcommand {.vpane.files.workdir.sx set} \
5168 -yscrollcommand {.vpane.files.workdir.sy set} \
5169 -state disabled
5170scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5171scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5172pack .vpane.files.workdir.title -side top -fill x
5173pack .vpane.files.workdir.sx -side bottom -fill x
5174pack .vpane.files.workdir.sy -side right -fill y
5175pack $ui_workdir -side left -fill both -expand 1
5176.vpane.files add .vpane.files.workdir -sticky nsew
5177foreach i [list $ui_index $ui_workdir] {
5179 $i tag conf in_diff -font font_uibold
5180 $i tag conf in_sel \
5181 -background [$i cget -foreground] \
5182 -foreground [$i cget -background]
5183}
5184unset i
5185# -- Diff and Commit Area
5187#
5188frame .vpane.lower -height 300 -width 400
5189frame .vpane.lower.commarea
5190frame .vpane.lower.diff -relief sunken -borderwidth 1
5191pack .vpane.lower.commarea -side top -fill x
5192pack .vpane.lower.diff -side bottom -fill both -expand 1
5193.vpane add .vpane.lower -sticky nsew
5194# -- Commit Area Buttons
5196#
5197frame .vpane.lower.commarea.buttons
5198label .vpane.lower.commarea.buttons.l -text {} \
5199 -anchor w \
5200 -justify left \
5201 -font font_ui
5202pack .vpane.lower.commarea.buttons.l -side top -fill x
5203pack .vpane.lower.commarea.buttons -side left -fill y
5204button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5206 -command do_rescan \
5207 -font font_ui
5208pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5209lappend disable_on_lock \
5210 {.vpane.lower.commarea.buttons.rescan conf -state}
5211button .vpane.lower.commarea.buttons.incall -text {Add All} \
5213 -command do_add_all \
5214 -font font_ui
5215pack .vpane.lower.commarea.buttons.incall -side top -fill x
5216lappend disable_on_lock \
5217 {.vpane.lower.commarea.buttons.incall conf -state}
5218button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5220 -command do_signoff \
5221 -font font_ui
5222pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5223button .vpane.lower.commarea.buttons.commit -text {Commit} \
5225 -command do_commit \
5226 -font font_ui
5227pack .vpane.lower.commarea.buttons.commit -side top -fill x
5228lappend disable_on_lock \
5229 {.vpane.lower.commarea.buttons.commit conf -state}
5230# -- Commit Message Buffer
5232#
5233frame .vpane.lower.commarea.buffer
5234frame .vpane.lower.commarea.buffer.header
5235set ui_comm .vpane.lower.commarea.buffer.t
5236set ui_coml .vpane.lower.commarea.buffer.header.l
5237radiobutton .vpane.lower.commarea.buffer.header.new \
5238 -text {New Commit} \
5239 -command do_select_commit_type \
5240 -variable selected_commit_type \
5241 -value new \
5242 -font font_ui
5243lappend disable_on_lock \
5244 [list .vpane.lower.commarea.buffer.header.new conf -state]
5245radiobutton .vpane.lower.commarea.buffer.header.amend \
5246 -text {Amend Last Commit} \
5247 -command do_select_commit_type \
5248 -variable selected_commit_type \
5249 -value amend \
5250 -font font_ui
5251lappend disable_on_lock \
5252 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5253label $ui_coml \
5254 -anchor w \
5255 -justify left \
5256 -font font_ui
5257proc trace_commit_type {varname args} {
5258 global ui_coml commit_type
5259 switch -glob -- $commit_type {
5260 initial {set txt {Initial Commit Message:}}
5261 amend {set txt {Amended Commit Message:}}
5262 amend-initial {set txt {Amended Initial Commit Message:}}
5263 amend-merge {set txt {Amended Merge Commit Message:}}
5264 merge {set txt {Merge Commit Message:}}
5265 * {set txt {Commit Message:}}
5266 }
5267 $ui_coml conf -text $txt
5268}
5269trace add variable commit_type write trace_commit_type
5270pack $ui_coml -side left -fill x
5271pack .vpane.lower.commarea.buffer.header.amend -side right
5272pack .vpane.lower.commarea.buffer.header.new -side right
5273text $ui_comm -background white -borderwidth 1 \
5275 -undo true \
5276 -maxundo 20 \
5277 -autoseparators true \
5278 -relief sunken \
5279 -width 75 -height 9 -wrap none \
5280 -font font_diff \
5281 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5282scrollbar .vpane.lower.commarea.buffer.sby \
5283 -command [list $ui_comm yview]
5284pack .vpane.lower.commarea.buffer.header -side top -fill x
5285pack .vpane.lower.commarea.buffer.sby -side right -fill y
5286pack $ui_comm -side left -fill y
5287pack .vpane.lower.commarea.buffer -side left -fill y
5288# -- Commit Message Buffer Context Menu
5290#
5291set ctxm .vpane.lower.commarea.buffer.ctxm
5292menu $ctxm -tearoff 0
5293$ctxm add command \
5294 -label {Cut} \
5295 -font font_ui \
5296 -command {tk_textCut $ui_comm}
5297$ctxm add command \
5298 -label {Copy} \
5299 -font font_ui \
5300 -command {tk_textCopy $ui_comm}
5301$ctxm add command \
5302 -label {Paste} \
5303 -font font_ui \
5304 -command {tk_textPaste $ui_comm}
5305$ctxm add command \
5306 -label {Delete} \
5307 -font font_ui \
5308 -command {$ui_comm delete sel.first sel.last}
5309$ctxm add separator
5310$ctxm add command \
5311 -label {Select All} \
5312 -font font_ui \
5313 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5314$ctxm add command \
5315 -label {Copy All} \
5316 -font font_ui \
5317 -command {
5318 $ui_comm tag add sel 0.0 end
5319 tk_textCopy $ui_comm
5320 $ui_comm tag remove sel 0.0 end
5321 }
5322$ctxm add separator
5323$ctxm add command \
5324 -label {Sign Off} \
5325 -font font_ui \
5326 -command do_signoff
5327bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5328# -- Diff Header
5330#
5331set current_diff_path {}
5332set current_diff_side {}
5333set diff_actions [list]
5334proc trace_current_diff_path {varname args} {
5335 global current_diff_path diff_actions file_states
5336 if {$current_diff_path eq {}} {
5337 set s {}
5338 set f {}
5339 set p {}
5340 set o disabled
5341 } else {
5342 set p $current_diff_path
5343 set s [mapdesc [lindex $file_states($p) 0] $p]
5344 set f {File:}
5345 set p [escape_path $p]
5346 set o normal
5347 }
5348 .vpane.lower.diff.header.status configure -text $s
5350 .vpane.lower.diff.header.file configure -text $f
5351 .vpane.lower.diff.header.path configure -text $p
5352 foreach w $diff_actions {
5353 uplevel #0 $w $o
5354 }
5355}
5356trace add variable current_diff_path write trace_current_diff_path
5357frame .vpane.lower.diff.header -background orange
5359label .vpane.lower.diff.header.status \
5360 -background orange \
5361 -width $max_status_desc \
5362 -anchor w \
5363 -justify left \
5364 -font font_ui
5365label .vpane.lower.diff.header.file \
5366 -background orange \
5367 -anchor w \
5368 -justify left \
5369 -font font_ui
5370label .vpane.lower.diff.header.path \
5371 -background orange \
5372 -anchor w \
5373 -justify left \
5374 -font font_ui
5375pack .vpane.lower.diff.header.status -side left
5376pack .vpane.lower.diff.header.file -side left
5377pack .vpane.lower.diff.header.path -fill x
5378set ctxm .vpane.lower.diff.header.ctxm
5379menu $ctxm -tearoff 0
5380$ctxm add command \
5381 -label {Copy} \
5382 -font font_ui \
5383 -command {
5384 clipboard clear
5385 clipboard append \
5386 -format STRING \
5387 -type STRING \
5388 -- $current_diff_path
5389 }
5390lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5391bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5392# -- Diff Body
5394#
5395frame .vpane.lower.diff.body
5396set ui_diff .vpane.lower.diff.body.t
5397text $ui_diff -background white -borderwidth 0 \
5398 -width 80 -height 15 -wrap none \
5399 -font font_diff \
5400 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5401 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5402 -state disabled
5403scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5404 -command [list $ui_diff xview]
5405scrollbar .vpane.lower.diff.body.sby -orient vertical \
5406 -command [list $ui_diff yview]
5407pack .vpane.lower.diff.body.sbx -side bottom -fill x
5408pack .vpane.lower.diff.body.sby -side right -fill y
5409pack $ui_diff -side left -fill both -expand 1
5410pack .vpane.lower.diff.header -side top -fill x
5411pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5412$ui_diff tag conf d_cr -elide true
5414$ui_diff tag conf d_@ -foreground blue -font font_diffbold
5415$ui_diff tag conf d_+ -foreground {#00a000}
5416$ui_diff tag conf d_- -foreground red
5417$ui_diff tag conf d_++ -foreground {#00a000}
5419$ui_diff tag conf d_-- -foreground red
5420$ui_diff tag conf d_+s \
5421 -foreground {#00a000} \
5422 -background {#e2effa}
5423$ui_diff tag conf d_-s \
5424 -foreground red \
5425 -background {#e2effa}
5426$ui_diff tag conf d_s+ \
5427 -foreground {#00a000} \
5428 -background ivory1
5429$ui_diff tag conf d_s- \
5430 -foreground red \
5431 -background ivory1
5432$ui_diff tag conf d<<<<<<< \
5434 -foreground orange \
5435 -font font_diffbold
5436$ui_diff tag conf d======= \
5437 -foreground orange \
5438 -font font_diffbold
5439$ui_diff tag conf d>>>>>>> \
5440 -foreground orange \
5441 -font font_diffbold
5442$ui_diff tag raise sel
5444# -- Diff Body Context Menu
5446#
5447set ctxm .vpane.lower.diff.body.ctxm
5448menu $ctxm -tearoff 0
5449$ctxm add command \
5450 -label {Refresh} \
5451 -font font_ui \
5452 -command reshow_diff
5453lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5454$ctxm add command \
5455 -label {Copy} \
5456 -font font_ui \
5457 -command {tk_textCopy $ui_diff}
5458lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5459$ctxm add command \
5460 -label {Select All} \
5461 -font font_ui \
5462 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5463lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5464$ctxm add command \
5465 -label {Copy All} \
5466 -font font_ui \
5467 -command {
5468 $ui_diff tag add sel 0.0 end
5469 tk_textCopy $ui_diff
5470 $ui_diff tag remove sel 0.0 end
5471 }
5472lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5473$ctxm add separator
5474$ctxm add command \
5475 -label {Apply/Reverse Hunk} \
5476 -font font_ui \
5477 -command {apply_hunk $cursorX $cursorY}
5478set ui_diff_applyhunk [$ctxm index last]
5479lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5480$ctxm add separator
5481$ctxm add command \
5482 -label {Decrease Font Size} \
5483 -font font_ui \
5484 -command {incr_font_size font_diff -1}
5485lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5486$ctxm add command \
5487 -label {Increase Font Size} \
5488 -font font_ui \
5489 -command {incr_font_size font_diff 1}
5490lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5491$ctxm add separator
5492$ctxm add command \
5493 -label {Show Less Context} \
5494 -font font_ui \
5495 -command {if {$repo_config(gui.diffcontext) >= 2} {
5496 incr repo_config(gui.diffcontext) -1
5497 reshow_diff
5498 }}
5499lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5500$ctxm add command \
5501 -label {Show More Context} \
5502 -font font_ui \
5503 -command {
5504 incr repo_config(gui.diffcontext)
5505 reshow_diff
5506 }
5507lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5508$ctxm add separator
5509$ctxm add command -label {Options...} \
5510 -font font_ui \
5511 -command do_options
5512bind_button3 $ui_diff "
5513 set cursorX %x
5514 set cursorY %y
5515 if {\$ui_index eq \$current_diff_side} {
5516 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5517 } else {
5518 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5519 }
5520 tk_popup $ctxm %X %Y
5521"
5522unset ui_diff_applyhunk
5523# -- Status Bar
5525#
5526set ui_status_value {Initializing...}
5527label .status -textvariable ui_status_value \
5528 -anchor w \
5529 -justify left \
5530 -borderwidth 1 \
5531 -relief sunken \
5532 -font font_ui
5533pack .status -anchor w -side bottom -fill x
5534# -- Load geometry
5536#
5537catch {
5538set gm $repo_config(gui.geometry)
5539wm geometry . [lindex $gm 0]
5540.vpane sash place 0 \
5541 [lindex [.vpane sash coord 0] 0] \
5542 [lindex $gm 1]
5543.vpane.files sash place 0 \
5544 [lindex $gm 2] \
5545 [lindex [.vpane.files sash coord 0] 1]
5546unset gm
5547}
5548# -- Key Bindings
5550#
5551bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5552bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5553bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5554bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5555bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5556bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5557bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5558bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5559bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5560bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5561bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5562bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5564bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5565bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5566bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5567bind $ui_diff <$M1B-Key-v> {break}
5568bind $ui_diff <$M1B-Key-V> {break}
5569bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5570bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5571bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5572bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5573bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5574bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5575bind $ui_diff <Button-1> {focus %W}
5576if {!$single_commit} {
5578 bind . <$M1B-Key-n> do_create_branch
5579 bind . <$M1B-Key-N> do_create_branch
5580}
5581bind . <Destroy> do_quit
5583bind all <Key-F5> do_rescan
5584bind all <$M1B-Key-r> do_rescan
5585bind all <$M1B-Key-R> do_rescan
5586bind . <$M1B-Key-s> do_signoff
5587bind . <$M1B-Key-S> do_signoff
5588bind . <$M1B-Key-i> do_add_all
5589bind . <$M1B-Key-I> do_add_all
5590bind . <$M1B-Key-Return> do_commit
5591bind all <$M1B-Key-q> do_quit
5592bind all <$M1B-Key-Q> do_quit
5593bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5594bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5595foreach i [list $ui_index $ui_workdir] {
5596 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
5597 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5598 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5599}
5600unset i
5601set file_lists($ui_index) [list]
5603set file_lists($ui_workdir) [list]
5604set HEAD {}
5606set PARENT {}
5607set MERGE_HEAD [list]
5608set commit_type {}
5609set empty_tree {}
5610set current_branch {}
5611set current_diff_path {}
5612set selected_commit_type new
5613wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5615focus -force $ui_comm
5616# -- Warn the user about environmental problems. Cygwin's Tcl
5618# does *not* pass its env array onto any processes it spawns.
5619# This means that git processes get none of our environment.
5620#
5621if {[is_Cygwin]} {
5622 set ignored_env 0
5623 set suggest_user {}
5624 set msg "Possible environment issues exist.
5625The following environment variables are probably
5627going to be ignored by any Git subprocess run
5628by [appname]:
5629"
5631 foreach name [array names env] {
5632 switch -regexp -- $name {
5633 {^GIT_INDEX_FILE$} -
5634 {^GIT_OBJECT_DIRECTORY$} -
5635 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5636 {^GIT_DIFF_OPTS$} -
5637 {^GIT_EXTERNAL_DIFF$} -
5638 {^GIT_PAGER$} -
5639 {^GIT_TRACE$} -
5640 {^GIT_CONFIG$} -
5641 {^GIT_CONFIG_LOCAL$} -
5642 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5643 append msg " - $name\n"
5644 incr ignored_env
5645 }
5646 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5647 append msg " - $name\n"
5648 incr ignored_env
5649 set suggest_user $name
5650 }
5651 }
5652 }
5653 if {$ignored_env > 0} {
5654 append msg "
5655This is due to a known issue with the
5656Tcl binary distributed by Cygwin."
5657 if {$suggest_user ne {}} {
5659 append msg "
5660A good replacement for $suggest_user
5662is placing values for the user.name and
5663user.email settings into your personal
5664~/.gitconfig file.
5665"
5666 }
5667 warn_popup $msg
5668 }
5669 unset ignored_env msg suggest_user name
5670}
5671# -- Only initialize complex UI if we are going to stay running.
5673#
5674if {!$single_commit} {
5675 load_all_remotes
5676 load_all_heads
5677 populate_branch_menu
5679 populate_fetch_menu
5680 populate_push_menu
5681}
5682# -- Only suggest a gc run if we are going to stay running.
5684#
5685if {!$single_commit} {
5686 set object_limit 2000
5687 if {[is_Windows]} {set object_limit 200}
5688 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5689 if {$objects_current >= $object_limit} {
5690 if {[ask_popup \
5691 "This repository currently has $objects_current loose objects.
5692To maintain optimal performance it is strongly
5694recommended that you compress the database
5695when more than $object_limit loose objects exist.
5696Compress the database now?"] eq yes} {
5698 do_gc
5699 }
5700 }
5701 unset object_limit _junk objects_current
5702}
5703lock_index begin-read
5705after 1 do_rescan