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 single_commit
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 {!$single_commit} {
431 load_all_heads
432 populate_branch_menu
433 }
434 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
436 rescan_stage2 {} $after
437 } else {
438 set rescan_active 1
439 set ui_status_value {Refreshing file status...}
440 set cmd [list git update-index]
441 lappend cmd -q
442 lappend cmd --unmerged
443 lappend cmd --ignore-missing
444 lappend cmd --refresh
445 set fd_rf [open "| $cmd" r]
446 fconfigure $fd_rf -blocking 0 -translation binary
447 fileevent $fd_rf readable \
448 [list rescan_stage2 $fd_rf $after]
449 }
450}
451proc rescan_stage2 {fd after} {
453 global ui_status_value
454 global rescan_active buf_rdi buf_rdf buf_rlo
455 if {$fd ne {}} {
457 read $fd
458 if {![eof $fd]} return
459 close $fd
460 }
461 set ls_others [list | git ls-files --others -z \
463 --exclude-per-directory=.gitignore]
464 set info_exclude [gitdir info exclude]
465 if {[file readable $info_exclude]} {
466 lappend ls_others "--exclude-from=$info_exclude"
467 }
468 set buf_rdi {}
470 set buf_rdf {}
471 set buf_rlo {}
472 set rescan_active 3
474 set ui_status_value {Scanning for modified files ...}
475 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
476 set fd_df [open "| git diff-files -z" r]
477 set fd_lo [open $ls_others r]
478 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
480 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
481 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
482 fileevent $fd_di readable [list read_diff_index $fd_di $after]
483 fileevent $fd_df readable [list read_diff_files $fd_df $after]
484 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
485}
486proc load_message {file} {
488 global ui_comm
489 set f [gitdir $file]
491 if {[file isfile $f]} {
492 if {[catch {set fd [open $f r]}]} {
493 return 0
494 }
495 set content [string trim [read $fd]]
496 close $fd
497 regsub -all -line {[ \r\t]+$} $content {} content
498 $ui_comm delete 0.0 end
499 $ui_comm insert end $content
500 return 1
501 }
502 return 0
503}
504proc read_diff_index {fd after} {
506 global buf_rdi
507 append buf_rdi [read $fd]
509 set c 0
510 set n [string length $buf_rdi]
511 while {$c < $n} {
512 set z1 [string first "\0" $buf_rdi $c]
513 if {$z1 == -1} break
514 incr z1
515 set z2 [string first "\0" $buf_rdi $z1]
516 if {$z2 == -1} break
517 incr c
519 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
520 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
521 merge_state \
522 [encoding convertfrom $p] \
523 [lindex $i 4]? \
524 [list [lindex $i 0] [lindex $i 2]] \
525 [list]
526 set c $z2
527 incr c
528 }
529 if {$c < $n} {
530 set buf_rdi [string range $buf_rdi $c end]
531 } else {
532 set buf_rdi {}
533 }
534 rescan_done $fd buf_rdi $after
536}
537proc read_diff_files {fd after} {
539 global buf_rdf
540 append buf_rdf [read $fd]
542 set c 0
543 set n [string length $buf_rdf]
544 while {$c < $n} {
545 set z1 [string first "\0" $buf_rdf $c]
546 if {$z1 == -1} break
547 incr z1
548 set z2 [string first "\0" $buf_rdf $z1]
549 if {$z2 == -1} break
550 incr c
552 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
553 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
554 merge_state \
555 [encoding convertfrom $p] \
556 ?[lindex $i 4] \
557 [list] \
558 [list [lindex $i 0] [lindex $i 2]]
559 set c $z2
560 incr c
561 }
562 if {$c < $n} {
563 set buf_rdf [string range $buf_rdf $c end]
564 } else {
565 set buf_rdf {}
566 }
567 rescan_done $fd buf_rdf $after
569}
570proc read_ls_others {fd after} {
572 global buf_rlo
573 append buf_rlo [read $fd]
575 set pck [split $buf_rlo "\0"]
576 set buf_rlo [lindex $pck end]
577 foreach p [lrange $pck 0 end-1] {
578 merge_state [encoding convertfrom $p] ?O
579 }
580 rescan_done $fd buf_rlo $after
581}
582proc rescan_done {fd buf after} {
584 global rescan_active
585 global file_states repo_config
586 upvar $buf to_clear
587 if {![eof $fd]} return
589 set to_clear {}
590 close $fd
591 if {[incr rescan_active -1] > 0} return
592 prune_selection
594 unlock_index
595 display_all_files
596 reshow_diff
597 uplevel #0 $after
598}
599proc prune_selection {} {
601 global file_states selected_paths
602 foreach path [array names selected_paths] {
604 if {[catch {set still_here $file_states($path)}]} {
605 unset selected_paths($path)
606 }
607 }
608}
609######################################################################
611##
612## diff
613proc clear_diff {} {
615 global ui_diff current_diff_path current_diff_header
616 global ui_index ui_workdir
617 $ui_diff conf -state normal
619 $ui_diff delete 0.0 end
620 $ui_diff conf -state disabled
621 set current_diff_path {}
623 set current_diff_header {}
624 $ui_index tag remove in_diff 0.0 end
626 $ui_workdir tag remove in_diff 0.0 end
627}
628proc reshow_diff {} {
630 global ui_status_value file_states file_lists
631 global current_diff_path current_diff_side
632 set p $current_diff_path
634 if {$p eq {}
635 || $current_diff_side eq {}
636 || [catch {set s $file_states($p)}]
637 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
638 clear_diff
639 } else {
640 show_diff $p $current_diff_side
641 }
642}
643proc handle_empty_diff {} {
645 global current_diff_path file_states file_lists
646 set path $current_diff_path
648 set s $file_states($path)
649 if {[lindex $s 0] ne {_M}} return
650 info_popup "No differences detected.
652[short_path $path] has no changes.
654The modification date of this file was updated
656by another application, but the content within
657the file was not changed.
658A rescan will be automatically started to find
660other files which may have the same state."
661 clear_diff
663 display_file $path __
664 rescan {set ui_status_value {Ready.}} 0
665}
666proc show_diff {path w {lno {}}} {
668 global file_states file_lists
669 global is_3way_diff diff_active repo_config
670 global ui_diff ui_status_value ui_index ui_workdir
671 global current_diff_path current_diff_side current_diff_header
672 if {$diff_active || ![lock_index read]} return
674 clear_diff
676 if {$lno == {}} {
677 set lno [lsearch -sorted -exact $file_lists($w) $path]
678 if {$lno >= 0} {
679 incr lno
680 }
681 }
682 if {$lno >= 1} {
683 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
684 }
685 set s $file_states($path)
687 set m [lindex $s 0]
688 set is_3way_diff 0
689 set diff_active 1
690 set current_diff_path $path
691 set current_diff_side $w
692 set current_diff_header {}
693 set ui_status_value "Loading diff of [escape_path $path]..."
694 # - Git won't give us the diff, there's nothing to compare to!
696 #
697 if {$m eq {_O}} {
698 set max_sz [expr {128 * 1024}]
699 if {[catch {
700 set fd [open $path r]
701 set content [read $fd $max_sz]
702 close $fd
703 set sz [file size $path]
704 } err ]} {
705 set diff_active 0
706 unlock_index
707 set ui_status_value "Unable to display [escape_path $path]"
708 error_popup "Error loading file:\n\n$err"
709 return
710 }
711 $ui_diff conf -state normal
712 if {![catch {set type [exec file $path]}]} {
713 set n [string length $path]
714 if {[string equal -length $n $path $type]} {
715 set type [string range $type $n end]
716 regsub {^:?\s*} $type {} type
717 }
718 $ui_diff insert end "* $type\n" d_@
719 }
720 if {[string first "\0" $content] != -1} {
721 $ui_diff insert end \
722 "* Binary file (not showing content)." \
723 d_@
724 } else {
725 if {$sz > $max_sz} {
726 $ui_diff insert end \
727"* Untracked file is $sz bytes.
728* Showing only first $max_sz bytes.
729" d_@
730 }
731 $ui_diff insert end $content
732 if {$sz > $max_sz} {
733 $ui_diff insert end "
734* Untracked file clipped here by [appname].
735* To see the entire file, use an external editor.
736" d_@
737 }
738 }
739 $ui_diff conf -state disabled
740 set diff_active 0
741 unlock_index
742 set ui_status_value {Ready.}
743 return
744 }
745 set cmd [list | git]
747 if {$w eq $ui_index} {
748 lappend cmd diff-index
749 lappend cmd --cached
750 } elseif {$w eq $ui_workdir} {
751 if {[string index $m 0] eq {U}} {
752 lappend cmd diff
753 } else {
754 lappend cmd diff-files
755 }
756 }
757 lappend cmd -p
759 lappend cmd --no-color
760 if {$repo_config(gui.diffcontext) > 0} {
761 lappend cmd "-U$repo_config(gui.diffcontext)"
762 }
763 if {$w eq $ui_index} {
764 lappend cmd [PARENT]
765 }
766 lappend cmd --
767 lappend cmd $path
768 if {[catch {set fd [open $cmd r]} err]} {
770 set diff_active 0
771 unlock_index
772 set ui_status_value "Unable to display [escape_path $path]"
773 error_popup "Error loading diff:\n\n$err"
774 return
775 }
776 fconfigure $fd \
778 -blocking 0 \
779 -encoding binary \
780 -translation binary
781 fileevent $fd readable [list read_diff $fd]
782}
783proc read_diff {fd} {
785 global ui_diff ui_status_value diff_active
786 global is_3way_diff current_diff_header
787 $ui_diff conf -state normal
789 while {[gets $fd line] >= 0} {
790 # -- Cleanup uninteresting diff header lines.
791 #
792 if { [string match {diff --git *} $line]
793 || [string match {diff --cc *} $line]
794 || [string match {diff --combined *} $line]
795 || [string match {--- *} $line]
796 || [string match {+++ *} $line]} {
797 append current_diff_header $line "\n"
798 continue
799 }
800 if {[string match {index *} $line]} continue
801 if {$line eq {deleted file mode 120000}} {
802 set line "deleted symlink"
803 }
804 # -- Automatically detect if this is a 3 way diff.
806 #
807 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
808 if {[string match {mode *} $line]
810 || [string match {new file *} $line]
811 || [string match {deleted file *} $line]
812 || [string match {Binary files * and * differ} $line]
813 || $line eq {\ No newline at end of file}
814 || [regexp {^\* Unmerged path } $line]} {
815 set tags {}
816 } elseif {$is_3way_diff} {
817 set op [string range $line 0 1]
818 switch -- $op {
819 { } {set tags {}}
820 {@@} {set tags d_@}
821 { +} {set tags d_s+}
822 { -} {set tags d_s-}
823 {+ } {set tags d_+s}
824 {- } {set tags d_-s}
825 {--} {set tags d_--}
826 {++} {
827 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
828 set line [string replace $line 0 1 { }]
829 set tags d$op
830 } else {
831 set tags d_++
832 }
833 }
834 default {
835 puts "error: Unhandled 3 way diff marker: {$op}"
836 set tags {}
837 }
838 }
839 } else {
840 set op [string index $line 0]
841 switch -- $op {
842 { } {set tags {}}
843 {@} {set tags d_@}
844 {-} {set tags d_-}
845 {+} {
846 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
847 set line [string replace $line 0 0 { }]
848 set tags d$op
849 } else {
850 set tags d_+
851 }
852 }
853 default {
854 puts "error: Unhandled 2 way diff marker: {$op}"
855 set tags {}
856 }
857 }
858 }
859 $ui_diff insert end $line $tags
860 if {[string index $line end] eq "\r"} {
861 $ui_diff tag add d_cr {end - 2c}
862 }
863 $ui_diff insert end "\n" $tags
864 }
865 $ui_diff conf -state disabled
866 if {[eof $fd]} {
868 close $fd
869 set diff_active 0
870 unlock_index
871 set ui_status_value {Ready.}
872 if {[$ui_diff index end] eq {2.0}} {
874 handle_empty_diff
875 }
876 }
877}
878proc apply_hunk {x y} {
880 global current_diff_path current_diff_header current_diff_side
881 global ui_diff ui_index file_states
882 if {$current_diff_path eq {} || $current_diff_header eq {}} return
884 if {![lock_index apply_hunk]} return
885 set apply_cmd {git apply --cached --whitespace=nowarn}
887 set mi [lindex $file_states($current_diff_path) 0]
888 if {$current_diff_side eq $ui_index} {
889 set mode unstage
890 lappend apply_cmd --reverse
891 if {[string index $mi 0] ne {M}} {
892 unlock_index
893 return
894 }
895 } else {
896 set mode stage
897 if {[string index $mi 1] ne {M}} {
898 unlock_index
899 return
900 }
901 }
902 set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
904 set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
905 if {$s_lno eq {}} {
906 unlock_index
907 return
908 }
909 set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
911 if {$e_lno eq {}} {
912 set e_lno end
913 }
914 if {[catch {
916 set p [open "| $apply_cmd" w]
917 fconfigure $p -translation binary -encoding binary
918 puts -nonewline $p $current_diff_header
919 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
920 close $p} err]} {
921 error_popup "Failed to $mode selected hunk.\n\n$err"
922 unlock_index
923 return
924 }
925 $ui_diff conf -state normal
927 $ui_diff delete $s_lno $e_lno
928 $ui_diff conf -state disabled
929 if {[$ui_diff get 1.0 end] eq "\n"} {
931 set o _
932 } else {
933 set o ?
934 }
935 if {$current_diff_side eq $ui_index} {
937 set mi ${o}M
938 } elseif {[string index $mi 0] eq {_}} {
939 set mi M$o
940 } else {
941 set mi ?$o
942 }
943 unlock_index
944 display_file $current_diff_path $mi
945 if {$o eq {_}} {
946 clear_diff
947 }
948}
949######################################################################
951##
952## commit
953proc load_last_commit {} {
955 global HEAD PARENT MERGE_HEAD commit_type ui_comm
956 global repo_config
957 if {[llength $PARENT] == 0} {
959 error_popup {There is nothing to amend.
960You are about to create the initial commit.
962There is no commit before this to amend.
963}
964 return
965 }
966 repository_state curType curHEAD curMERGE_HEAD
968 if {$curType eq {merge}} {
969 error_popup {Cannot amend while merging.
970You are currently in the middle of a merge that
972has not been fully completed. You cannot amend
973the prior commit unless you first abort the
974current merge activity.
975}
976 return
977 }
978 set msg {}
980 set parents [list]
981 if {[catch {
982 set fd [open "| git cat-file commit $curHEAD" r]
983 fconfigure $fd -encoding binary -translation lf
984 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
985 set enc utf-8
986 }
987 while {[gets $fd line] > 0} {
988 if {[string match {parent *} $line]} {
989 lappend parents [string range $line 7 end]
990 } elseif {[string match {encoding *} $line]} {
991 set enc [string tolower [string range $line 9 end]]
992 }
993 }
994 fconfigure $fd -encoding $enc
995 set msg [string trim [read $fd]]
996 close $fd
997 } err]} {
998 error_popup "Error loading commit data for amend:\n\n$err"
999 return
1000 }
1001 set HEAD $curHEAD
1003 set PARENT $parents
1004 set MERGE_HEAD [list]
1005 switch -- [llength $parents] {
1006 0 {set commit_type amend-initial}
1007 1 {set commit_type amend}
1008 default {set commit_type amend-merge}
1009 }
1010 $ui_comm delete 0.0 end
1012 $ui_comm insert end $msg
1013 $ui_comm edit reset
1014 $ui_comm edit modified false
1015 rescan {set ui_status_value {Ready.}}
1016}
1017proc create_new_commit {} {
1019 global commit_type ui_comm
1020 set commit_type normal
1022 $ui_comm delete 0.0 end
1023 $ui_comm edit reset
1024 $ui_comm edit modified false
1025 rescan {set ui_status_value {Ready.}}
1026}
1027set GIT_COMMITTER_IDENT {}
1029proc committer_ident {} {
1031 global GIT_COMMITTER_IDENT
1032 if {$GIT_COMMITTER_IDENT eq {}} {
1034 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1035 error_popup "Unable to obtain your identity:\n\n$err"
1036 return {}
1037 }
1038 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1039 $me me GIT_COMMITTER_IDENT]} {
1040 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1041 return {}
1042 }
1043 }
1044 return $GIT_COMMITTER_IDENT
1046}
1047proc commit_tree {} {
1049 global HEAD commit_type file_states ui_comm repo_config
1050 global ui_status_value pch_error
1051 if {[committer_ident] eq {}} return
1053 if {![lock_index update]} return
1054 # -- Our in memory state should match the repository.
1056 #
1057 repository_state curType curHEAD curMERGE_HEAD
1058 if {[string match amend* $commit_type]
1059 && $curType eq {normal}
1060 && $curHEAD eq $HEAD} {
1061 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1062 info_popup {Last scanned state does not match repository state.
1063Another Git program has modified this repository
1065since the last scan. A rescan must be performed
1066before another commit can be created.
1067The rescan will be automatically started now.
1069}
1070 unlock_index
1071 rescan {set ui_status_value {Ready.}}
1072 return
1073 }
1074 # -- At least one file should differ in the index.
1076 #
1077 set files_ready 0
1078 foreach path [array names file_states] {
1079 switch -glob -- [lindex $file_states($path) 0] {
1080 _? {continue}
1081 A? -
1082 D? -
1083 M? {set files_ready 1}
1084 U? {
1085 error_popup "Unmerged files cannot be committed.
1086File [short_path $path] has merge conflicts.
1088You must resolve them and add the file before committing.
1089"
1090 unlock_index
1091 return
1092 }
1093 default {
1094 error_popup "Unknown file state [lindex $s 0] detected.
1095File [short_path $path] cannot be committed by this program.
1097"
1098 }
1099 }
1100 }
1101 if {!$files_ready} {
1102 info_popup {No changes to commit.
1103You must add at least 1 file before you can commit.
1105}
1106 unlock_index
1107 return
1108 }
1109 # -- A message is required.
1111 #
1112 set msg [string trim [$ui_comm get 1.0 end]]
1113 regsub -all -line {[ \t\r]+$} $msg {} msg
1114 if {$msg eq {}} {
1115 error_popup {Please supply a commit message.
1116A good commit message has the following format:
1118- First line: Describe in one sentance what you did.
1120- Second line: Blank
1121- Remaining lines: Describe why this change is good.
1122}
1123 unlock_index
1124 return
1125 }
1126 # -- Run the pre-commit hook.
1128 #
1129 set pchook [gitdir hooks pre-commit]
1130 # On Cygwin [file executable] might lie so we need to ask
1132 # the shell if the hook is executable. Yes that's annoying.
1133 #
1134 if {[is_Cygwin] && [file isfile $pchook]} {
1135 set pchook [list sh -c [concat \
1136 "if test -x \"$pchook\";" \
1137 "then exec \"$pchook\" 2>&1;" \
1138 "fi"]]
1139 } elseif {[file executable $pchook]} {
1140 set pchook [list $pchook |& cat]
1141 } else {
1142 commit_writetree $curHEAD $msg
1143 return
1144 }
1145 set ui_status_value {Calling pre-commit hook...}
1147 set pch_error {}
1148 set fd_ph [open "| $pchook" r]
1149 fconfigure $fd_ph -blocking 0 -translation binary
1150 fileevent $fd_ph readable \
1151 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1152}
1153proc commit_prehook_wait {fd_ph curHEAD msg} {
1155 global pch_error ui_status_value
1156 append pch_error [read $fd_ph]
1158 fconfigure $fd_ph -blocking 1
1159 if {[eof $fd_ph]} {
1160 if {[catch {close $fd_ph}]} {
1161 set ui_status_value {Commit declined by pre-commit hook.}
1162 hook_failed_popup pre-commit $pch_error
1163 unlock_index
1164 } else {
1165 commit_writetree $curHEAD $msg
1166 }
1167 set pch_error {}
1168 return
1169 }
1170 fconfigure $fd_ph -blocking 0
1171}
1172proc commit_writetree {curHEAD msg} {
1174 global ui_status_value
1175 set ui_status_value {Committing changes...}
1177 set fd_wt [open "| git write-tree" r]
1178 fileevent $fd_wt readable \
1179 [list commit_committree $fd_wt $curHEAD $msg]
1180}
1181proc commit_committree {fd_wt curHEAD msg} {
1183 global HEAD PARENT MERGE_HEAD commit_type
1184 global single_commit all_heads current_branch
1185 global ui_status_value ui_comm selected_commit_type
1186 global file_states selected_paths rescan_active
1187 global repo_config
1188 gets $fd_wt tree_id
1190 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1191 error_popup "write-tree failed:\n\n$err"
1192 set ui_status_value {Commit failed.}
1193 unlock_index
1194 return
1195 }
1196 # -- Build the message.
1198 #
1199 set msg_p [gitdir COMMIT_EDITMSG]
1200 set msg_wt [open $msg_p w]
1201 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1202 set enc utf-8
1203 }
1204 fconfigure $msg_wt -encoding $enc -translation binary
1205 puts -nonewline $msg_wt $msg
1206 close $msg_wt
1207 # -- Create the commit.
1209 #
1210 set cmd [list git commit-tree $tree_id]
1211 set parents [concat $PARENT $MERGE_HEAD]
1212 if {[llength $parents] > 0} {
1213 foreach p $parents {
1214 lappend cmd -p $p
1215 }
1216 } else {
1217 # git commit-tree writes to stderr during initial commit.
1218 lappend cmd 2>/dev/null
1219 }
1220 lappend cmd <$msg_p
1221 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1222 error_popup "commit-tree failed:\n\n$err"
1223 set ui_status_value {Commit failed.}
1224 unlock_index
1225 return
1226 }
1227 # -- Update the HEAD ref.
1229 #
1230 set reflogm commit
1231 if {$commit_type ne {normal}} {
1232 append reflogm " ($commit_type)"
1233 }
1234 set i [string first "\n" $msg]
1235 if {$i >= 0} {
1236 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1237 } else {
1238 append reflogm {: } $msg
1239 }
1240 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1241 if {[catch {eval exec $cmd} err]} {
1242 error_popup "update-ref failed:\n\n$err"
1243 set ui_status_value {Commit failed.}
1244 unlock_index
1245 return
1246 }
1247 # -- Make sure our current branch exists.
1249 #
1250 if {$commit_type eq {initial}} {
1251 lappend all_heads $current_branch
1252 set all_heads [lsort -unique $all_heads]
1253 populate_branch_menu
1254 }
1255 # -- Cleanup after ourselves.
1257 #
1258 catch {file delete $msg_p}
1259 catch {file delete [gitdir MERGE_HEAD]}
1260 catch {file delete [gitdir MERGE_MSG]}
1261 catch {file delete [gitdir SQUASH_MSG]}
1262 catch {file delete [gitdir GITGUI_MSG]}
1263 # -- Let rerere do its thing.
1265 #
1266 if {[file isdirectory [gitdir rr-cache]]} {
1267 catch {exec git rerere}
1268 }
1269 # -- Run the post-commit hook.
1271 #
1272 set pchook [gitdir hooks post-commit]
1273 if {[is_Cygwin] && [file isfile $pchook]} {
1274 set pchook [list sh -c [concat \
1275 "if test -x \"$pchook\";" \
1276 "then exec \"$pchook\";" \
1277 "fi"]]
1278 } elseif {![file executable $pchook]} {
1279 set pchook {}
1280 }
1281 if {$pchook ne {}} {
1282 catch {exec $pchook &}
1283 }
1284 $ui_comm delete 0.0 end
1286 $ui_comm edit reset
1287 $ui_comm edit modified false
1288 if {$single_commit} do_quit
1290 # -- Update in memory status
1292 #
1293 set selected_commit_type new
1294 set commit_type normal
1295 set HEAD $cmt_id
1296 set PARENT $cmt_id
1297 set MERGE_HEAD [list]
1298 foreach path [array names file_states] {
1300 set s $file_states($path)
1301 set m [lindex $s 0]
1302 switch -glob -- $m {
1303 _O -
1304 _M -
1305 _D {continue}
1306 __ -
1307 A_ -
1308 M_ -
1309 D_ {
1310 unset file_states($path)
1311 catch {unset selected_paths($path)}
1312 }
1313 DO {
1314 set file_states($path) [list _O [lindex $s 1] {} {}]
1315 }
1316 AM -
1317 AD -
1318 MM -
1319 MD {
1320 set file_states($path) [list \
1321 _[string index $m 1] \
1322 [lindex $s 1] \
1323 [lindex $s 3] \
1324 {}]
1325 }
1326 }
1327 }
1328 display_all_files
1330 unlock_index
1331 reshow_diff
1332 set ui_status_value \
1333 "Changes committed as [string range $cmt_id 0 7]."
1334}
1335######################################################################
1337##
1338## fetch push
1339proc fetch_from {remote} {
1341 set w [new_console \
1342 "fetch $remote" \
1343 "Fetching new changes from $remote"]
1344 set cmd [list git fetch]
1345 lappend cmd $remote
1346 console_exec $w $cmd console_done
1347}
1348proc push_to {remote} {
1350 set w [new_console \
1351 "push $remote" \
1352 "Pushing changes to $remote"]
1353 set cmd [list git push]
1354 lappend cmd -v
1355 lappend cmd $remote
1356 console_exec $w $cmd console_done
1357}
1358######################################################################
1360##
1361## ui helpers
1362proc mapicon {w state path} {
1364 global all_icons
1365 if {[catch {set r $all_icons($state$w)}]} {
1367 puts "error: no icon for $w state={$state} $path"
1368 return file_plain
1369 }
1370 return $r
1371}
1372proc mapdesc {state path} {
1374 global all_descs
1375 if {[catch {set r $all_descs($state)}]} {
1377 puts "error: no desc for state={$state} $path"
1378 return $state
1379 }
1380 return $r
1381}
1382proc escape_path {path} {
1384 regsub -all "\n" $path "\\n" path
1385 return $path
1386}
1387proc short_path {path} {
1389 return [escape_path [lindex [file split $path] end]]
1390}
1391set next_icon_id 0
1393set null_sha1 [string repeat 0 40]
1394proc merge_state {path new_state {head_info {}} {index_info {}}} {
1396 global file_states next_icon_id null_sha1
1397 set s0 [string index $new_state 0]
1399 set s1 [string index $new_state 1]
1400 if {[catch {set info $file_states($path)}]} {
1402 set state __
1403 set icon n[incr next_icon_id]
1404 } else {
1405 set state [lindex $info 0]
1406 set icon [lindex $info 1]
1407 if {$head_info eq {}} {set head_info [lindex $info 2]}
1408 if {$index_info eq {}} {set index_info [lindex $info 3]}
1409 }
1410 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1412 elseif {$s0 eq {_}} {set s0 _}
1413 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1415 elseif {$s1 eq {_}} {set s1 _}
1416 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1418 set head_info [list 0 $null_sha1]
1419 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1420 && $head_info eq {}} {
1421 set head_info $index_info
1422 }
1423 set file_states($path) [list $s0$s1 $icon \
1425 $head_info $index_info \
1426 ]
1427 return $state
1428}
1429proc display_file_helper {w path icon_name old_m new_m} {
1431 global file_lists
1432 if {$new_m eq {_}} {
1434 set lno [lsearch -sorted -exact $file_lists($w) $path]
1435 if {$lno >= 0} {
1436 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1437 incr lno
1438 $w conf -state normal
1439 $w delete $lno.0 [expr {$lno + 1}].0
1440 $w conf -state disabled
1441 }
1442 } elseif {$old_m eq {_} && $new_m ne {_}} {
1443 lappend file_lists($w) $path
1444 set file_lists($w) [lsort -unique $file_lists($w)]
1445 set lno [lsearch -sorted -exact $file_lists($w) $path]
1446 incr lno
1447 $w conf -state normal
1448 $w image create $lno.0 \
1449 -align center -padx 5 -pady 1 \
1450 -name $icon_name \
1451 -image [mapicon $w $new_m $path]
1452 $w insert $lno.1 "[escape_path $path]\n"
1453 $w conf -state disabled
1454 } elseif {$old_m ne $new_m} {
1455 $w conf -state normal
1456 $w image conf $icon_name -image [mapicon $w $new_m $path]
1457 $w conf -state disabled
1458 }
1459}
1460proc display_file {path state} {
1462 global file_states selected_paths
1463 global ui_index ui_workdir
1464 set old_m [merge_state $path $state]
1466 set s $file_states($path)
1467 set new_m [lindex $s 0]
1468 set icon_name [lindex $s 1]
1469 set o [string index $old_m 0]
1471 set n [string index $new_m 0]
1472 if {$o eq {U}} {
1473 set o _
1474 }
1475 if {$n eq {U}} {
1476 set n _
1477 }
1478 display_file_helper $ui_index $path $icon_name $o $n
1479 if {[string index $old_m 0] eq {U}} {
1481 set o U
1482 } else {
1483 set o [string index $old_m 1]
1484 }
1485 if {[string index $new_m 0] eq {U}} {
1486 set n U
1487 } else {
1488 set n [string index $new_m 1]
1489 }
1490 display_file_helper $ui_workdir $path $icon_name $o $n
1491 if {$new_m eq {__}} {
1493 unset file_states($path)
1494 catch {unset selected_paths($path)}
1495 }
1496}
1497proc display_all_files_helper {w path icon_name m} {
1499 global file_lists
1500 lappend file_lists($w) $path
1502 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1503 $w image create end \
1504 -align center -padx 5 -pady 1 \
1505 -name $icon_name \
1506 -image [mapicon $w $m $path]
1507 $w insert end "[escape_path $path]\n"
1508}
1509proc display_all_files {} {
1511 global ui_index ui_workdir
1512 global file_states file_lists
1513 global last_clicked
1514 $ui_index conf -state normal
1516 $ui_workdir conf -state normal
1517 $ui_index delete 0.0 end
1519 $ui_workdir delete 0.0 end
1520 set last_clicked {}
1521 set file_lists($ui_index) [list]
1523 set file_lists($ui_workdir) [list]
1524 foreach path [lsort [array names file_states]] {
1526 set s $file_states($path)
1527 set m [lindex $s 0]
1528 set icon_name [lindex $s 1]
1529 set s [string index $m 0]
1531 if {$s ne {U} && $s ne {_}} {
1532 display_all_files_helper $ui_index $path \
1533 $icon_name $s
1534 }
1535 if {[string index $m 0] eq {U}} {
1537 set s U
1538 } else {
1539 set s [string index $m 1]
1540 }
1541 if {$s ne {_}} {
1542 display_all_files_helper $ui_workdir $path \
1543 $icon_name $s
1544 }
1545 }
1546 $ui_index conf -state disabled
1548 $ui_workdir conf -state disabled
1549}
1550proc update_indexinfo {msg pathList after} {
1552 global update_index_cp ui_status_value
1553 if {![lock_index update]} return
1555 set update_index_cp 0
1557 set pathList [lsort $pathList]
1558 set totalCnt [llength $pathList]
1559 set batch [expr {int($totalCnt * .01) + 1}]
1560 if {$batch > 25} {set batch 25}
1561 set ui_status_value [format \
1563 "$msg... %i/%i files (%.2f%%)" \
1564 $update_index_cp \
1565 $totalCnt \
1566 0.0]
1567 set fd [open "| git update-index -z --index-info" w]
1568 fconfigure $fd \
1569 -blocking 0 \
1570 -buffering full \
1571 -buffersize 512 \
1572 -encoding binary \
1573 -translation binary
1574 fileevent $fd writable [list \
1575 write_update_indexinfo \
1576 $fd \
1577 $pathList \
1578 $totalCnt \
1579 $batch \
1580 $msg \
1581 $after \
1582 ]
1583}
1584proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1586 global update_index_cp ui_status_value
1587 global file_states current_diff_path
1588 if {$update_index_cp >= $totalCnt} {
1590 close $fd
1591 unlock_index
1592 uplevel #0 $after
1593 return
1594 }
1595 for {set i $batch} \
1597 {$update_index_cp < $totalCnt && $i > 0} \
1598 {incr i -1} {
1599 set path [lindex $pathList $update_index_cp]
1600 incr update_index_cp
1601 set s $file_states($path)
1603 switch -glob -- [lindex $s 0] {
1604 A? {set new _O}
1605 M? {set new _M}
1606 D_ {set new _D}
1607 D? {set new _?}
1608 ?? {continue}
1609 }
1610 set info [lindex $s 2]
1611 if {$info eq {}} continue
1612 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1614 display_file $path $new
1615 }
1616 set ui_status_value [format \
1618 "$msg... %i/%i files (%.2f%%)" \
1619 $update_index_cp \
1620 $totalCnt \
1621 [expr {100.0 * $update_index_cp / $totalCnt}]]
1622}
1623proc update_index {msg pathList after} {
1625 global update_index_cp ui_status_value
1626 if {![lock_index update]} return
1628 set update_index_cp 0
1630 set pathList [lsort $pathList]
1631 set totalCnt [llength $pathList]
1632 set batch [expr {int($totalCnt * .01) + 1}]
1633 if {$batch > 25} {set batch 25}
1634 set ui_status_value [format \
1636 "$msg... %i/%i files (%.2f%%)" \
1637 $update_index_cp \
1638 $totalCnt \
1639 0.0]
1640 set fd [open "| git update-index --add --remove -z --stdin" w]
1641 fconfigure $fd \
1642 -blocking 0 \
1643 -buffering full \
1644 -buffersize 512 \
1645 -encoding binary \
1646 -translation binary
1647 fileevent $fd writable [list \
1648 write_update_index \
1649 $fd \
1650 $pathList \
1651 $totalCnt \
1652 $batch \
1653 $msg \
1654 $after \
1655 ]
1656}
1657proc write_update_index {fd pathList totalCnt batch msg after} {
1659 global update_index_cp ui_status_value
1660 global file_states current_diff_path
1661 if {$update_index_cp >= $totalCnt} {
1663 close $fd
1664 unlock_index
1665 uplevel #0 $after
1666 return
1667 }
1668 for {set i $batch} \
1670 {$update_index_cp < $totalCnt && $i > 0} \
1671 {incr i -1} {
1672 set path [lindex $pathList $update_index_cp]
1673 incr update_index_cp
1674 switch -glob -- [lindex $file_states($path) 0] {
1676 AD {set new __}
1677 ?D {set new D_}
1678 _O -
1679 AM {set new A_}
1680 U? {
1681 if {[file exists $path]} {
1682 set new M_
1683 } else {
1684 set new D_
1685 }
1686 }
1687 ?M {set new M_}
1688 ?? {continue}
1689 }
1690 puts -nonewline $fd "[encoding convertto $path]\0"
1691 display_file $path $new
1692 }
1693 set ui_status_value [format \
1695 "$msg... %i/%i files (%.2f%%)" \
1696 $update_index_cp \
1697 $totalCnt \
1698 [expr {100.0 * $update_index_cp / $totalCnt}]]
1699}
1700proc checkout_index {msg pathList after} {
1702 global update_index_cp ui_status_value
1703 if {![lock_index update]} return
1705 set update_index_cp 0
1707 set pathList [lsort $pathList]
1708 set totalCnt [llength $pathList]
1709 set batch [expr {int($totalCnt * .01) + 1}]
1710 if {$batch > 25} {set batch 25}
1711 set ui_status_value [format \
1713 "$msg... %i/%i files (%.2f%%)" \
1714 $update_index_cp \
1715 $totalCnt \
1716 0.0]
1717 set cmd [list git checkout-index]
1718 lappend cmd --index
1719 lappend cmd --quiet
1720 lappend cmd --force
1721 lappend cmd -z
1722 lappend cmd --stdin
1723 set fd [open "| $cmd " w]
1724 fconfigure $fd \
1725 -blocking 0 \
1726 -buffering full \
1727 -buffersize 512 \
1728 -encoding binary \
1729 -translation binary
1730 fileevent $fd writable [list \
1731 write_checkout_index \
1732 $fd \
1733 $pathList \
1734 $totalCnt \
1735 $batch \
1736 $msg \
1737 $after \
1738 ]
1739}
1740proc write_checkout_index {fd pathList totalCnt batch msg after} {
1742 global update_index_cp ui_status_value
1743 global file_states current_diff_path
1744 if {$update_index_cp >= $totalCnt} {
1746 close $fd
1747 unlock_index
1748 uplevel #0 $after
1749 return
1750 }
1751 for {set i $batch} \
1753 {$update_index_cp < $totalCnt && $i > 0} \
1754 {incr i -1} {
1755 set path [lindex $pathList $update_index_cp]
1756 incr update_index_cp
1757 switch -glob -- [lindex $file_states($path) 0] {
1758 U? {continue}
1759 ?M -
1760 ?D {
1761 puts -nonewline $fd "[encoding convertto $path]\0"
1762 display_file $path ?_
1763 }
1764 }
1765 }
1766 set ui_status_value [format \
1768 "$msg... %i/%i files (%.2f%%)" \
1769 $update_index_cp \
1770 $totalCnt \
1771 [expr {100.0 * $update_index_cp / $totalCnt}]]
1772}
1773######################################################################
1775##
1776## branch management
1777proc is_tracking_branch {name} {
1779 global tracking_branches
1780 if {![catch {set info $tracking_branches($name)}]} {
1782 return 1
1783 }
1784 foreach t [array names tracking_branches] {
1785 if {[string match {*/\*} $t] && [string match $t $name]} {
1786 return 1
1787 }
1788 }
1789 return 0
1790}
1791proc load_all_heads {} {
1793 global all_heads
1794 set all_heads [list]
1796 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1797 while {[gets $fd line] > 0} {
1798 if {[is_tracking_branch $line]} continue
1799 if {![regsub ^refs/heads/ $line {} name]} continue
1800 lappend all_heads $name
1801 }
1802 close $fd
1803 set all_heads [lsort $all_heads]
1805}
1806proc populate_branch_menu {} {
1808 global all_heads disable_on_lock
1809 set m .mbar.branch
1811 set last [$m index last]
1812 for {set i 0} {$i <= $last} {incr i} {
1813 if {[$m type $i] eq {separator}} {
1814 $m delete $i last
1815 set new_dol [list]
1816 foreach a $disable_on_lock {
1817 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1818 lappend new_dol $a
1819 }
1820 }
1821 set disable_on_lock $new_dol
1822 break
1823 }
1824 }
1825 if {$all_heads ne {}} {
1827 $m add separator
1828 }
1829 foreach b $all_heads {
1830 $m add radiobutton \
1831 -label $b \
1832 -command [list switch_branch $b] \
1833 -variable current_branch \
1834 -value $b \
1835 -font font_ui
1836 lappend disable_on_lock \
1837 [list $m entryconf [$m index last] -state]
1838 }
1839}
1840proc all_tracking_branches {} {
1842 global tracking_branches
1843 set all_trackings {}
1845 set cmd {}
1846 foreach name [array names tracking_branches] {
1847 if {[regsub {/\*$} $name {} name]} {
1848 lappend cmd $name
1849 } else {
1850 regsub ^refs/(heads|remotes)/ $name {} name
1851 lappend all_trackings $name
1852 }
1853 }
1854 if {$cmd ne {}} {
1856 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1857 while {[gets $fd name] > 0} {
1858 regsub ^refs/(heads|remotes)/ $name {} name
1859 lappend all_trackings $name
1860 }
1861 close $fd
1862 }
1863 return [lsort -unique $all_trackings]
1865}
1866proc do_create_branch_action {w} {
1868 global all_heads null_sha1 repo_config
1869 global create_branch_checkout create_branch_revtype
1870 global create_branch_head create_branch_trackinghead
1871 global create_branch_name create_branch_revexp
1872 set newbranch $create_branch_name
1874 if {$newbranch eq {}
1875 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1876 tk_messageBox \
1877 -icon error \
1878 -type ok \
1879 -title [wm title $w] \
1880 -parent $w \
1881 -message "Please supply a branch name."
1882 focus $w.desc.name_t
1883 return
1884 }
1885 if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1886 tk_messageBox \
1887 -icon error \
1888 -type ok \
1889 -title [wm title $w] \
1890 -parent $w \
1891 -message "Branch '$newbranch' already exists."
1892 focus $w.desc.name_t
1893 return
1894 }
1895 if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1896 tk_messageBox \
1897 -icon error \
1898 -type ok \
1899 -title [wm title $w] \
1900 -parent $w \
1901 -message "We do not like '$newbranch' as a branch name."
1902 focus $w.desc.name_t
1903 return
1904 }
1905 set rev {}
1907 switch -- $create_branch_revtype {
1908 head {set rev $create_branch_head}
1909 tracking {set rev $create_branch_trackinghead}
1910 expression {set rev $create_branch_revexp}
1911 }
1912 if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1913 tk_messageBox \
1914 -icon error \
1915 -type ok \
1916 -title [wm title $w] \
1917 -parent $w \
1918 -message "Invalid starting revision: $rev"
1919 return
1920 }
1921 set cmd [list git update-ref]
1922 lappend cmd -m
1923 lappend cmd "branch: Created from $rev"
1924 lappend cmd "refs/heads/$newbranch"
1925 lappend cmd $cmt
1926 lappend cmd $null_sha1
1927 if {[catch {eval exec $cmd} err]} {
1928 tk_messageBox \
1929 -icon error \
1930 -type ok \
1931 -title [wm title $w] \
1932 -parent $w \
1933 -message "Failed to create '$newbranch'.\n\n$err"
1934 return
1935 }
1936 lappend all_heads $newbranch
1938 set all_heads [lsort $all_heads]
1939 populate_branch_menu
1940 destroy $w
1941 if {$create_branch_checkout} {
1942 switch_branch $newbranch
1943 }
1944}
1945proc radio_selector {varname value args} {
1947 upvar #0 $varname var
1948 set var $value
1949}
1950trace add variable create_branch_head write \
1952 [list radio_selector create_branch_revtype head]
1953trace add variable create_branch_trackinghead write \
1954 [list radio_selector create_branch_revtype tracking]
1955trace add variable delete_branch_head write \
1957 [list radio_selector delete_branch_checktype head]
1958trace add variable delete_branch_trackinghead write \
1959 [list radio_selector delete_branch_checktype tracking]
1960proc do_create_branch {} {
1962 global all_heads current_branch repo_config
1963 global create_branch_checkout create_branch_revtype
1964 global create_branch_head create_branch_trackinghead
1965 global create_branch_name create_branch_revexp
1966 set w .branch_editor
1968 toplevel $w
1969 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1970 label $w.header -text {Create New Branch} \
1972 -font font_uibold
1973 pack $w.header -side top -fill x
1974 frame $w.buttons
1976 button $w.buttons.create -text Create \
1977 -font font_ui \
1978 -default active \
1979 -command [list do_create_branch_action $w]
1980 pack $w.buttons.create -side right
1981 button $w.buttons.cancel -text {Cancel} \
1982 -font font_ui \
1983 -command [list destroy $w]
1984 pack $w.buttons.cancel -side right -padx 5
1985 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1986 labelframe $w.desc \
1988 -text {Branch Description} \
1989 -font font_ui
1990 label $w.desc.name_l -text {Name:} -font font_ui
1991 entry $w.desc.name_t \
1992 -borderwidth 1 \
1993 -relief sunken \
1994 -width 40 \
1995 -textvariable create_branch_name \
1996 -font font_ui \
1997 -validate key \
1998 -validatecommand {
1999 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2000 return 1
2001 }
2002 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2003 grid columnconfigure $w.desc 1 -weight 1
2004 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2005 labelframe $w.from \
2007 -text {Starting Revision} \
2008 -font font_ui
2009 radiobutton $w.from.head_r \
2010 -text {Local Branch:} \
2011 -value head \
2012 -variable create_branch_revtype \
2013 -font font_ui
2014 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2015 grid $w.from.head_r $w.from.head_m -sticky w
2016 set all_trackings [all_tracking_branches]
2017 if {$all_trackings ne {}} {
2018 set create_branch_trackinghead [lindex $all_trackings 0]
2019 radiobutton $w.from.tracking_r \
2020 -text {Tracking Branch:} \
2021 -value tracking \
2022 -variable create_branch_revtype \
2023 -font font_ui
2024 eval tk_optionMenu $w.from.tracking_m \
2025 create_branch_trackinghead \
2026 $all_trackings
2027 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2028 }
2029 radiobutton $w.from.exp_r \
2030 -text {Revision Expression:} \
2031 -value expression \
2032 -variable create_branch_revtype \
2033 -font font_ui
2034 entry $w.from.exp_t \
2035 -borderwidth 1 \
2036 -relief sunken \
2037 -width 50 \
2038 -textvariable create_branch_revexp \
2039 -font font_ui \
2040 -validate key \
2041 -validatecommand {
2042 if {%d == 1 && [regexp {\s} %S]} {return 0}
2043 if {%d == 1 && [string length %S] > 0} {
2044 set create_branch_revtype expression
2045 }
2046 return 1
2047 }
2048 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2049 grid columnconfigure $w.from 1 -weight 1
2050 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2051 labelframe $w.postActions \
2053 -text {Post Creation Actions} \
2054 -font font_ui
2055 checkbutton $w.postActions.checkout \
2056 -text {Checkout after creation} \
2057 -variable create_branch_checkout \
2058 -font font_ui
2059 pack $w.postActions.checkout -anchor nw
2060 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2061 set create_branch_checkout 1
2063 set create_branch_head $current_branch
2064 set create_branch_revtype head
2065 set create_branch_name $repo_config(gui.newbranchtemplate)
2066 set create_branch_revexp {}
2067 bind $w <Visibility> "
2069 grab $w
2070 $w.desc.name_t icursor end
2071 focus $w.desc.name_t
2072 "
2073 bind $w <Key-Escape> "destroy $w"
2074 bind $w <Key-Return> "do_create_branch_action $w;break"
2075 wm title $w "[appname] ([reponame]): Create Branch"
2076 tkwait window $w
2077}
2078proc do_delete_branch_action {w} {
2080 global all_heads
2081 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2082 set check_rev {}
2084 switch -- $delete_branch_checktype {
2085 head {set check_rev $delete_branch_head}
2086 tracking {set check_rev $delete_branch_trackinghead}
2087 always {set check_rev {:none}}
2088 }
2089 if {$check_rev eq {:none}} {
2090 set check_cmt {}
2091 } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2092 tk_messageBox \
2093 -icon error \
2094 -type ok \
2095 -title [wm title $w] \
2096 -parent $w \
2097 -message "Invalid check revision: $check_rev"
2098 return
2099 }
2100 set to_delete [list]
2102 set not_merged [list]
2103 foreach i [$w.list.l curselection] {
2104 set b [$w.list.l get $i]
2105 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2106 if {$check_cmt ne {}} {
2107 if {$b eq $check_rev} continue
2108 if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2109 if {$o ne $m} {
2110 lappend not_merged $b
2111 continue
2112 }
2113 }
2114 lappend to_delete [list $b $o]
2115 }
2116 if {$not_merged ne {}} {
2117 set msg "The following branches are not completely merged into $check_rev:
2118 - [join $not_merged "\n - "]"
2120 tk_messageBox \
2121 -icon info \
2122 -type ok \
2123 -title [wm title $w] \
2124 -parent $w \
2125 -message $msg
2126 }
2127 if {$to_delete eq {}} return
2128 if {$delete_branch_checktype eq {always}} {
2129 set msg {Recovering deleted branches is difficult.
2130Delete the selected branches?}
2132 if {[tk_messageBox \
2133 -icon warning \
2134 -type yesno \
2135 -title [wm title $w] \
2136 -parent $w \
2137 -message $msg] ne yes} {
2138 return
2139 }
2140 }
2141 set failed {}
2143 foreach i $to_delete {
2144 set b [lindex $i 0]
2145 set o [lindex $i 1]
2146 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2147 append failed " - $b: $err\n"
2148 } else {
2149 set x [lsearch -sorted -exact $all_heads $b]
2150 if {$x >= 0} {
2151 set all_heads [lreplace $all_heads $x $x]
2152 }
2153 }
2154 }
2155 if {$failed ne {}} {
2157 tk_messageBox \
2158 -icon error \
2159 -type ok \
2160 -title [wm title $w] \
2161 -parent $w \
2162 -message "Failed to delete branches:\n$failed"
2163 }
2164 set all_heads [lsort $all_heads]
2166 populate_branch_menu
2167 destroy $w
2168}
2169proc do_delete_branch {} {
2171 global all_heads tracking_branches current_branch
2172 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2173 set w .branch_editor
2175 toplevel $w
2176 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2177 label $w.header -text {Delete Local Branch} \
2179 -font font_uibold
2180 pack $w.header -side top -fill x
2181 frame $w.buttons
2183 button $w.buttons.create -text Delete \
2184 -font font_ui \
2185 -command [list do_delete_branch_action $w]
2186 pack $w.buttons.create -side right
2187 button $w.buttons.cancel -text {Cancel} \
2188 -font font_ui \
2189 -command [list destroy $w]
2190 pack $w.buttons.cancel -side right -padx 5
2191 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2192 labelframe $w.list \
2194 -text {Local Branches} \
2195 -font font_ui
2196 listbox $w.list.l \
2197 -height 10 \
2198 -width 70 \
2199 -selectmode extended \
2200 -yscrollcommand [list $w.list.sby set] \
2201 -font font_ui
2202 foreach h $all_heads {
2203 if {$h ne $current_branch} {
2204 $w.list.l insert end $h
2205 }
2206 }
2207 scrollbar $w.list.sby -command [list $w.list.l yview]
2208 pack $w.list.sby -side right -fill y
2209 pack $w.list.l -side left -fill both -expand 1
2210 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2211 labelframe $w.validate \
2213 -text {Delete Only If} \
2214 -font font_ui
2215 radiobutton $w.validate.head_r \
2216 -text {Merged Into Local Branch:} \
2217 -value head \
2218 -variable delete_branch_checktype \
2219 -font font_ui
2220 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2221 grid $w.validate.head_r $w.validate.head_m -sticky w
2222 set all_trackings [all_tracking_branches]
2223 if {$all_trackings ne {}} {
2224 set delete_branch_trackinghead [lindex $all_trackings 0]
2225 radiobutton $w.validate.tracking_r \
2226 -text {Merged Into Tracking Branch:} \
2227 -value tracking \
2228 -variable delete_branch_checktype \
2229 -font font_ui
2230 eval tk_optionMenu $w.validate.tracking_m \
2231 delete_branch_trackinghead \
2232 $all_trackings
2233 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2234 }
2235 radiobutton $w.validate.always_r \
2236 -text {Always (Do not perform merge checks)} \
2237 -value always \
2238 -variable delete_branch_checktype \
2239 -font font_ui
2240 grid $w.validate.always_r -columnspan 2 -sticky w
2241 grid columnconfigure $w.validate 1 -weight 1
2242 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2243 set delete_branch_head $current_branch
2245 set delete_branch_checktype head
2246 bind $w <Visibility> "grab $w; focus $w"
2248 bind $w <Key-Escape> "destroy $w"
2249 wm title $w "[appname] ([reponame]): Delete Branch"
2250 tkwait window $w
2251}
2252proc switch_branch {new_branch} {
2254 global HEAD commit_type current_branch repo_config
2255 if {![lock_index switch]} return
2257 # -- Our in memory state should match the repository.
2259 #
2260 repository_state curType curHEAD curMERGE_HEAD
2261 if {[string match amend* $commit_type]
2262 && $curType eq {normal}
2263 && $curHEAD eq $HEAD} {
2264 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2265 info_popup {Last scanned state does not match repository state.
2266Another Git program has modified this repository
2268since the last scan. A rescan must be performed
2269before the current branch can be changed.
2270The rescan will be automatically started now.
2272}
2273 unlock_index
2274 rescan {set ui_status_value {Ready.}}
2275 return
2276 }
2277 # -- Don't do a pointless switch.
2279 #
2280 if {$current_branch eq $new_branch} {
2281 unlock_index
2282 return
2283 }
2284 if {$repo_config(gui.trustmtime) eq {true}} {
2286 switch_branch_stage2 {} $new_branch
2287 } else {
2288 set ui_status_value {Refreshing file status...}
2289 set cmd [list git update-index]
2290 lappend cmd -q
2291 lappend cmd --unmerged
2292 lappend cmd --ignore-missing
2293 lappend cmd --refresh
2294 set fd_rf [open "| $cmd" r]
2295 fconfigure $fd_rf -blocking 0 -translation binary
2296 fileevent $fd_rf readable \
2297 [list switch_branch_stage2 $fd_rf $new_branch]
2298 }
2299}
2300proc switch_branch_stage2 {fd_rf new_branch} {
2302 global ui_status_value HEAD
2303 if {$fd_rf ne {}} {
2305 read $fd_rf
2306 if {![eof $fd_rf]} return
2307 close $fd_rf
2308 }
2309 set ui_status_value "Updating working directory to '$new_branch'..."
2311 set cmd [list git read-tree]
2312 lappend cmd -m
2313 lappend cmd -u
2314 lappend cmd --exclude-per-directory=.gitignore
2315 lappend cmd $HEAD
2316 lappend cmd $new_branch
2317 set fd_rt [open "| $cmd" r]
2318 fconfigure $fd_rt -blocking 0 -translation binary
2319 fileevent $fd_rt readable \
2320 [list switch_branch_readtree_wait $fd_rt $new_branch]
2321}
2322proc switch_branch_readtree_wait {fd_rt new_branch} {
2324 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2325 global current_branch
2326 global ui_comm ui_status_value
2327 # -- We never get interesting output on stdout; only stderr.
2329 #
2330 read $fd_rt
2331 fconfigure $fd_rt -blocking 1
2332 if {![eof $fd_rt]} {
2333 fconfigure $fd_rt -blocking 0
2334 return
2335 }
2336 # -- The working directory wasn't in sync with the index and
2338 # we'd have to overwrite something to make the switch. A
2339 # merge is required.
2340 #
2341 if {[catch {close $fd_rt} err]} {
2342 regsub {^fatal: } $err {} err
2343 warn_popup "File level merge required.
2344$err
2346Staying on branch '$current_branch'."
2348 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2349 unlock_index
2350 return
2351 }
2352 # -- Update the symbolic ref. Core git doesn't even check for failure
2354 # here, it Just Works(tm). If it doesn't we are in some really ugly
2355 # state that is difficult to recover from within git-gui.
2356 #
2357 if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2358 error_popup "Failed to set current branch.
2359This working directory is only partially switched.
2361We successfully updated your files, but failed to
2362update an internal Git file.
2363This should not have occurred. [appname] will now
2365close and give up.
2366$err"
2368 do_quit
2369 return
2370 }
2371 # -- Update our repository state. If we were previously in amend mode
2373 # we need to toss the current buffer and do a full rescan to update
2374 # our file lists. If we weren't in amend mode our file lists are
2375 # accurate and we can avoid the rescan.
2376 #
2377 unlock_index
2378 set selected_commit_type new
2379 if {[string match amend* $commit_type]} {
2380 $ui_comm delete 0.0 end
2381 $ui_comm edit reset
2382 $ui_comm edit modified false
2383 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2384 } else {
2385 repository_state commit_type HEAD MERGE_HEAD
2386 set PARENT $HEAD
2387 set ui_status_value "Checked out branch '$current_branch'."
2388 }
2389}
2390######################################################################
2392##
2393## remote management
2394proc load_all_remotes {} {
2396 global repo_config
2397 global all_remotes tracking_branches
2398 set all_remotes [list]
2400 array unset tracking_branches
2401 set rm_dir [gitdir remotes]
2403 if {[file isdirectory $rm_dir]} {
2404 set all_remotes [glob \
2405 -types f \
2406 -tails \
2407 -nocomplain \
2408 -directory $rm_dir *]
2409 foreach name $all_remotes {
2411 catch {
2412 set fd [open [file join $rm_dir $name] r]
2413 while {[gets $fd line] >= 0} {
2414 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2415 $line line src dst]} continue
2416 if {![regexp ^refs/ $dst]} {
2417 set dst "refs/heads/$dst"
2418 }
2419 set tracking_branches($dst) [list $name $src]
2420 }
2421 close $fd
2422 }
2423 }
2424 }
2425 foreach line [array names repo_config remote.*.url] {
2427 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2428 lappend all_remotes $name
2429 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2431 set fl {}
2432 }
2433 foreach line $fl {
2434 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2435 if {![regexp ^refs/ $dst]} {
2436 set dst "refs/heads/$dst"
2437 }
2438 set tracking_branches($dst) [list $name $src]
2439 }
2440 }
2441 set all_remotes [lsort -unique $all_remotes]
2443}
2444proc populate_fetch_menu {} {
2446 global all_remotes repo_config
2447 set m .mbar.fetch
2449 foreach r $all_remotes {
2450 set enable 0
2451 if {![catch {set a $repo_config(remote.$r.url)}]} {
2452 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2453 set enable 1
2454 }
2455 } else {
2456 catch {
2457 set fd [open [gitdir remotes $r] r]
2458 while {[gets $fd n] >= 0} {
2459 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2460 set enable 1
2461 break
2462 }
2463 }
2464 close $fd
2465 }
2466 }
2467 if {$enable} {
2469 $m add command \
2470 -label "Fetch from $r..." \
2471 -command [list fetch_from $r] \
2472 -font font_ui
2473 }
2474 }
2475}
2476proc populate_push_menu {} {
2478 global all_remotes repo_config
2479 set m .mbar.push
2481 set fast_count 0
2482 foreach r $all_remotes {
2483 set enable 0
2484 if {![catch {set a $repo_config(remote.$r.url)}]} {
2485 if {![catch {set a $repo_config(remote.$r.push)}]} {
2486 set enable 1
2487 }
2488 } else {
2489 catch {
2490 set fd [open [gitdir remotes $r] r]
2491 while {[gets $fd n] >= 0} {
2492 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2493 set enable 1
2494 break
2495 }
2496 }
2497 close $fd
2498 }
2499 }
2500 if {$enable} {
2502 if {!$fast_count} {
2503 $m add separator
2504 }
2505 $m add command \
2506 -label "Push to $r..." \
2507 -command [list push_to $r] \
2508 -font font_ui
2509 incr fast_count
2510 }
2511 }
2512}
2513proc start_push_anywhere_action {w} {
2515 global push_urltype push_remote push_url push_thin push_tags
2516 set r_url {}
2518 switch -- $push_urltype {
2519 remote {set r_url $push_remote}
2520 url {set r_url $push_url}
2521 }
2522 if {$r_url eq {}} return
2523 set cmd [list git push]
2525 lappend cmd -v
2526 if {$push_thin} {
2527 lappend cmd --thin
2528 }
2529 if {$push_tags} {
2530 lappend cmd --tags
2531 }
2532 lappend cmd $r_url
2533 set cnt 0
2534 foreach i [$w.source.l curselection] {
2535 set b [$w.source.l get $i]
2536 lappend cmd "refs/heads/$b:refs/heads/$b"
2537 incr cnt
2538 }
2539 if {$cnt == 0} {
2540 return
2541 } elseif {$cnt == 1} {
2542 set unit branch
2543 } else {
2544 set unit branches
2545 }
2546 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2548 console_exec $cons $cmd console_done
2549 destroy $w
2550}
2551trace add variable push_remote write \
2553 [list radio_selector push_urltype remote]
2554proc do_push_anywhere {} {
2556 global all_heads all_remotes current_branch
2557 global push_urltype push_remote push_url push_thin push_tags
2558 set w .push_setup
2560 toplevel $w
2561 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2562 label $w.header -text {Push Branches} -font font_uibold
2564 pack $w.header -side top -fill x
2565 frame $w.buttons
2567 button $w.buttons.create -text Push \
2568 -font font_ui \
2569 -command [list start_push_anywhere_action $w]
2570 pack $w.buttons.create -side right
2571 button $w.buttons.cancel -text {Cancel} \
2572 -font font_ui \
2573 -command [list destroy $w]
2574 pack $w.buttons.cancel -side right -padx 5
2575 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2576 labelframe $w.source \
2578 -text {Source Branches} \
2579 -font font_ui
2580 listbox $w.source.l \
2581 -height 10 \
2582 -width 70 \
2583 -selectmode extended \
2584 -yscrollcommand [list $w.source.sby set] \
2585 -font font_ui
2586 foreach h $all_heads {
2587 $w.source.l insert end $h
2588 if {$h eq $current_branch} {
2589 $w.source.l select set end
2590 }
2591 }
2592 scrollbar $w.source.sby -command [list $w.source.l yview]
2593 pack $w.source.sby -side right -fill y
2594 pack $w.source.l -side left -fill both -expand 1
2595 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2596 labelframe $w.dest \
2598 -text {Destination Repository} \
2599 -font font_ui
2600 if {$all_remotes ne {}} {
2601 radiobutton $w.dest.remote_r \
2602 -text {Remote:} \
2603 -value remote \
2604 -variable push_urltype \
2605 -font font_ui
2606 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2607 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2608 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2609 set push_remote origin
2610 } else {
2611 set push_remote [lindex $all_remotes 0]
2612 }
2613 set push_urltype remote
2614 } else {
2615 set push_urltype url
2616 }
2617 radiobutton $w.dest.url_r \
2618 -text {Arbitrary URL:} \
2619 -value url \
2620 -variable push_urltype \
2621 -font font_ui
2622 entry $w.dest.url_t \
2623 -borderwidth 1 \
2624 -relief sunken \
2625 -width 50 \
2626 -textvariable push_url \
2627 -font font_ui \
2628 -validate key \
2629 -validatecommand {
2630 if {%d == 1 && [regexp {\s} %S]} {return 0}
2631 if {%d == 1 && [string length %S] > 0} {
2632 set push_urltype url
2633 }
2634 return 1
2635 }
2636 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2637 grid columnconfigure $w.dest 1 -weight 1
2638 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2639 labelframe $w.options \
2641 -text {Transfer Options} \
2642 -font font_ui
2643 checkbutton $w.options.thin \
2644 -text {Use thin pack (for slow network connections)} \
2645 -variable push_thin \
2646 -font font_ui
2647 grid $w.options.thin -columnspan 2 -sticky w
2648 checkbutton $w.options.tags \
2649 -text {Include tags} \
2650 -variable push_tags \
2651 -font font_ui
2652 grid $w.options.tags -columnspan 2 -sticky w
2653 grid columnconfigure $w.options 1 -weight 1
2654 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2655 set push_url {}
2657 set push_thin 0
2658 set push_tags 0
2659 bind $w <Visibility> "grab $w"
2661 bind $w <Key-Escape> "destroy $w"
2662 wm title $w "[appname] ([reponame]): Push"
2663 tkwait window $w
2664}
2665######################################################################
2667##
2668## merge
2669proc can_merge {} {
2671 global HEAD commit_type file_states
2672 if {[string match amend* $commit_type]} {
2674 info_popup {Cannot merge while amending.
2675You must finish amending this commit before
2677starting any type of merge.
2678}
2679 return 0
2680 }
2681 if {[committer_ident] eq {}} {return 0}
2683 if {![lock_index merge]} {return 0}
2684 # -- Our in memory state should match the repository.
2686 #
2687 repository_state curType curHEAD curMERGE_HEAD
2688 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2689 info_popup {Last scanned state does not match repository state.
2690Another Git program has modified this repository
2692since the last scan. A rescan must be performed
2693before a merge can be performed.
2694The rescan will be automatically started now.
2696}
2697 unlock_index
2698 rescan {set ui_status_value {Ready.}}
2699 return 0
2700 }
2701 foreach path [array names file_states] {
2703 switch -glob -- [lindex $file_states($path) 0] {
2704 _O {
2705 continue; # and pray it works!
2706 }
2707 U? {
2708 error_popup "You are in the middle of a conflicted merge.
2709File [short_path $path] has merge conflicts.
2711You must resolve them, add the file, and commit to
2713complete the current merge. Only then can you
2714begin another merge.
2715"
2716 unlock_index
2717 return 0
2718 }
2719 ?? {
2720 error_popup "You are in the middle of a change.
2721File [short_path $path] is modified.
2723You should complete the current commit before
2725starting a merge. Doing so will help you abort
2726a failed merge, should the need arise.
2727"
2728 unlock_index
2729 return 0
2730 }
2731 }
2732 }
2733 return 1
2735}
2736proc visualize_local_merge {w} {
2738 set revs {}
2739 foreach i [$w.source.l curselection] {
2740 lappend revs [$w.source.l get $i]
2741 }
2742 if {$revs eq {}} return
2743 lappend revs --not HEAD
2744 do_gitk $revs
2745}
2746proc start_local_merge_action {w} {
2748 global HEAD ui_status_value current_branch
2749 set cmd [list git merge]
2751 set names {}
2752 set revcnt 0
2753 foreach i [$w.source.l curselection] {
2754 set b [$w.source.l get $i]
2755 lappend cmd $b
2756 lappend names $b
2757 incr revcnt
2758 }
2759 if {$revcnt == 0} {
2761 return
2762 } elseif {$revcnt == 1} {
2763 set unit branch
2764 } elseif {$revcnt <= 15} {
2765 set unit branches
2766 } else {
2767 tk_messageBox \
2768 -icon error \
2769 -type ok \
2770 -title [wm title $w] \
2771 -parent $w \
2772 -message "Too many branches selected.
2773You have requested to merge $revcnt branches
2775in an octopus merge. This exceeds Git's
2776internal limit of 15 branches per merge.
2777Please select fewer branches. To merge more
2779than 15 branches, merge the branches in batches.
2780"
2781 return
2782 }
2783 set msg "Merging $current_branch, [join $names {, }]"
2785 set ui_status_value "$msg..."
2786 set cons [new_console "Merge" $msg]
2787 console_exec $cons $cmd [list finish_merge $revcnt]
2788 bind $w <Destroy> {}
2789 destroy $w
2790}
2791proc finish_merge {revcnt w ok} {
2793 console_done $w $ok
2794 if {$ok} {
2795 set msg {Merge completed successfully.}
2796 } else {
2797 if {$revcnt != 1} {
2798 info_popup "Octopus merge failed.
2799Your merge of $revcnt branches has failed.
2801There are file-level conflicts between the
2803branches which must be resolved manually.
2804The working directory will now be reset.
2806You can attempt this merge again
2808by merging only one branch at a time." $w
2809 set fd [open "| git read-tree --reset -u HEAD" r]
2811 fconfigure $fd -blocking 0 -translation binary
2812 fileevent $fd readable [list reset_hard_wait $fd]
2813 set ui_status_value {Aborting... please wait...}
2814 return
2815 }
2816 set msg {Merge failed. Conflict resolution is required.}
2818 }
2819 unlock_index
2820 rescan [list set ui_status_value $msg]
2821}
2822proc do_local_merge {} {
2824 global current_branch
2825 if {![can_merge]} return
2827 set w .merge_setup
2829 toplevel $w
2830 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2831 label $w.header \
2833 -text "Merge Into $current_branch" \
2834 -font font_uibold
2835 pack $w.header -side top -fill x
2836 frame $w.buttons
2838 button $w.buttons.visualize -text Visualize \
2839 -font font_ui \
2840 -command [list visualize_local_merge $w]
2841 pack $w.buttons.visualize -side left
2842 button $w.buttons.create -text Merge \
2843 -font font_ui \
2844 -command [list start_local_merge_action $w]
2845 pack $w.buttons.create -side right
2846 button $w.buttons.cancel -text {Cancel} \
2847 -font font_ui \
2848 -command [list destroy $w]
2849 pack $w.buttons.cancel -side right -padx 5
2850 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2851 labelframe $w.source \
2853 -text {Source Branches} \
2854 -font font_ui
2855 listbox $w.source.l \
2856 -height 10 \
2857 -width 70 \
2858 -selectmode extended \
2859 -yscrollcommand [list $w.source.sby set] \
2860 -font font_ui
2861 scrollbar $w.source.sby -command [list $w.source.l yview]
2862 pack $w.source.sby -side right -fill y
2863 pack $w.source.l -side left -fill both -expand 1
2864 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2865 set cmd [list git for-each-ref]
2867 lappend cmd {--format=%(objectname) %(refname)}
2868 lappend cmd refs/heads
2869 lappend cmd refs/remotes
2870 set fr_fd [open "| $cmd" r]
2871 fconfigure $fr_fd -translation binary
2872 while {[gets $fr_fd line] > 0} {
2873 set line [split $line { }]
2874 set sha1([lindex $line 0]) [lindex $line 1]
2875 }
2876 close $fr_fd
2877 set to_show {}
2879 set fr_fd [open "| git rev-list --all --not HEAD"]
2880 while {[gets $fr_fd line] > 0} {
2881 if {[catch {set ref $sha1($line)}]} continue
2882 regsub ^refs/(heads|remotes)/ $ref {} ref
2883 lappend to_show $ref
2884 }
2885 close $fr_fd
2886 foreach ref [lsort -unique $to_show] {
2888 $w.source.l insert end $ref
2889 }
2890 bind $w <Visibility> "grab $w"
2892 bind $w <Key-Escape> "unlock_index;destroy $w"
2893 bind $w <Destroy> unlock_index
2894 wm title $w "[appname] ([reponame]): Merge"
2895 tkwait window $w
2896}
2897proc do_reset_hard {} {
2899 global HEAD commit_type file_states
2900 if {[string match amend* $commit_type]} {
2902 info_popup {Cannot abort while amending.
2903You must finish amending this commit.
2905}
2906 return
2907 }
2908 if {![lock_index abort]} return
2910 if {[string match *merge* $commit_type]} {
2912 set op merge
2913 } else {
2914 set op commit
2915 }
2916 if {[ask_popup "Abort $op?
2918Aborting the current $op will cause
2920*ALL* uncommitted changes to be lost.
2921Continue with aborting the current $op?"] eq {yes}} {
2923 set fd [open "| git read-tree --reset -u HEAD" r]
2924 fconfigure $fd -blocking 0 -translation binary
2925 fileevent $fd readable [list reset_hard_wait $fd]
2926 set ui_status_value {Aborting... please wait...}
2927 } else {
2928 unlock_index
2929 }
2930}
2931proc reset_hard_wait {fd} {
2933 global ui_comm
2934 read $fd
2936 if {[eof $fd]} {
2937 close $fd
2938 unlock_index
2939 $ui_comm delete 0.0 end
2941 $ui_comm edit modified false
2942 catch {file delete [gitdir MERGE_HEAD]}
2944 catch {file delete [gitdir rr-cache MERGE_RR]}
2945 catch {file delete [gitdir SQUASH_MSG]}
2946 catch {file delete [gitdir MERGE_MSG]}
2947 catch {file delete [gitdir GITGUI_MSG]}
2948 rescan {set ui_status_value {Abort completed. Ready.}}
2950 }
2951}
2952######################################################################
2954##
2955## browser
2956set next_browser_id 0
2958proc new_browser {commit} {
2960 global next_browser_id cursor_ptr M1B
2961 global browser_commit browser_status browser_stack browser_path browser_busy
2962 set w .browser[incr next_browser_id]
2964 set w_list $w.list.l
2965 set browser_commit($w_list) $commit
2966 set browser_status($w_list) {Starting...}
2967 set browser_stack($w_list) {}
2968 set browser_path($w_list) $browser_commit($w_list):
2969 set browser_busy($w_list) 1
2970 toplevel $w
2972 label $w.path -textvariable browser_path($w_list) \
2973 -anchor w \
2974 -justify left \
2975 -borderwidth 1 \
2976 -relief sunken \
2977 -font font_uibold
2978 pack $w.path -anchor w -side top -fill x
2979 frame $w.list
2981 text $w_list -background white -borderwidth 0 \
2982 -cursor $cursor_ptr \
2983 -state disabled \
2984 -wrap none \
2985 -height 20 \
2986 -width 70 \
2987 -xscrollcommand [list $w.list.sbx set] \
2988 -yscrollcommand [list $w.list.sby set] \
2989 -font font_ui
2990 $w_list tag conf in_sel \
2991 -background [$w_list cget -foreground] \
2992 -foreground [$w_list cget -background]
2993 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
2994 scrollbar $w.list.sby -orient v -command [list $w_list yview]
2995 pack $w.list.sbx -side bottom -fill x
2996 pack $w.list.sby -side right -fill y
2997 pack $w_list -side left -fill both -expand 1
2998 pack $w.list -side top -fill both -expand 1
2999 label $w.status -textvariable browser_status($w_list) \
3001 -anchor w \
3002 -justify left \
3003 -borderwidth 1 \
3004 -relief sunken \
3005 -font font_ui
3006 pack $w.status -anchor w -side bottom -fill x
3007 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3009 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3010 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3011 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3012 bind $w_list <Up> "browser_move -1 $w_list;break"
3013 bind $w_list <Down> "browser_move 1 $w_list;break"
3014 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3015 bind $w_list <Return> "browser_enter $w_list;break"
3016 bind $w_list <Prior> "browser_page -1 $w_list;break"
3017 bind $w_list <Next> "browser_page 1 $w_list;break"
3018 bind $w_list <Left> break
3019 bind $w_list <Right> break
3020 bind $w <Visibility> "focus $w"
3022 bind $w <Destroy> "
3023 array unset browser_buffer $w_list
3024 array unset browser_files $w_list
3025 array unset browser_status $w_list
3026 array unset browser_stack $w_list
3027 array unset browser_path $w_list
3028 array unset browser_commit $w_list
3029 array unset browser_busy $w_list
3030 "
3031 wm title $w "[appname] ([reponame]): File Browser"
3032 ls_tree $w_list $browser_commit($w_list) {}
3033}
3034proc browser_move {dir w} {
3036 global browser_files browser_busy
3037 if {$browser_busy($w)} return
3039 set lno [lindex [split [$w index in_sel.first] .] 0]
3040 incr lno $dir
3041 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3042 $w tag remove in_sel 0.0 end
3043 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3044 $w see $lno.0
3045 }
3046}
3047proc browser_page {dir w} {
3049 global browser_files browser_busy
3050 if {$browser_busy($w)} return
3052 $w yview scroll $dir pages
3053 set lno [expr {int(
3054 [lindex [$w yview] 0]
3055 * [llength $browser_files($w)]
3056 + 1)}]
3057 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3058 $w tag remove in_sel 0.0 end
3059 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3060 $w see $lno.0
3061 }
3062}
3063proc browser_parent {w} {
3065 global browser_files browser_status browser_path
3066 global browser_stack browser_busy
3067 if {$browser_busy($w)} return
3069 set info [lindex $browser_files($w) 0]
3070 if {[lindex $info 0] eq {parent}} {
3071 set parent [lindex $browser_stack($w) end-1]
3072 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3073 if {$browser_stack($w) eq {}} {
3074 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3075 } else {
3076 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3077 }
3078 set browser_status($w) "Loading $browser_path($w)..."
3079 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3080 }
3081}
3082proc browser_enter {w} {
3084 global browser_files browser_status browser_path
3085 global browser_commit browser_stack browser_busy
3086 if {$browser_busy($w)} return
3088 set lno [lindex [split [$w index in_sel.first] .] 0]
3089 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3090 if {$info ne {}} {
3091 switch -- [lindex $info 0] {
3092 parent {
3093 browser_parent $w
3094 }
3095 tree {
3096 set name [lindex $info 2]
3097 set escn [escape_path $name]
3098 set browser_status($w) "Loading $escn..."
3099 append browser_path($w) $escn
3100 ls_tree $w [lindex $info 1] $name
3101 }
3102 blob {
3103 set name [lindex $info 2]
3104 set p {}
3105 foreach n $browser_stack($w) {
3106 append p [lindex $n 1]
3107 }
3108 append p $name
3109 show_blame $browser_commit($w) $p
3110 }
3111 }
3112 }
3113}
3114proc browser_click {was_double_click w pos} {
3116 global browser_files browser_busy
3117 if {$browser_busy($w)} return
3119 set lno [lindex [split [$w index $pos] .] 0]
3120 focus $w
3121 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3123 $w tag remove in_sel 0.0 end
3124 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3125 if {$was_double_click} {
3126 browser_enter $w
3127 }
3128 }
3129}
3130proc ls_tree {w tree_id name} {
3132 global browser_buffer browser_files browser_stack browser_busy
3133 set browser_buffer($w) {}
3135 set browser_files($w) {}
3136 set browser_busy($w) 1
3137 $w conf -state normal
3139 $w tag remove in_sel 0.0 end
3140 $w delete 0.0 end
3141 if {$browser_stack($w) ne {}} {
3142 $w image create end \
3143 -align center -padx 5 -pady 1 \
3144 -name icon0 \
3145 -image file_uplevel
3146 $w insert end {[Up To Parent]}
3147 lappend browser_files($w) parent
3148 }
3149 lappend browser_stack($w) [list $tree_id $name]
3150 $w conf -state disabled
3151 set cmd [list git ls-tree -z $tree_id]
3153 set fd [open "| $cmd" r]
3154 fconfigure $fd -blocking 0 -translation binary -encoding binary
3155 fileevent $fd readable [list read_ls_tree $fd $w]
3156}
3157proc read_ls_tree {fd w} {
3159 global browser_buffer browser_files browser_status browser_busy
3160 if {![winfo exists $w]} {
3162 catch {close $fd}
3163 return
3164 }
3165 append browser_buffer($w) [read $fd]
3167 set pck [split $browser_buffer($w) "\0"]
3168 set browser_buffer($w) [lindex $pck end]
3169 set n [llength $browser_files($w)]
3171 $w conf -state normal
3172 foreach p [lrange $pck 0 end-1] {
3173 set info [split $p "\t"]
3174 set path [lindex $info 1]
3175 set info [split [lindex $info 0] { }]
3176 set type [lindex $info 1]
3177 set object [lindex $info 2]
3178 switch -- $type {
3180 blob {
3181 set image file_mod
3182 }
3183 tree {
3184 set image file_dir
3185 append path /
3186 }
3187 default {
3188 set image file_question
3189 }
3190 }
3191 if {$n > 0} {$w insert end "\n"}
3193 $w image create end \
3194 -align center -padx 5 -pady 1 \
3195 -name icon[incr n] \
3196 -image $image
3197 $w insert end [escape_path $path]
3198 lappend browser_files($w) [list $type $object $path]
3199 }
3200 $w conf -state disabled
3201 if {[eof $fd]} {
3203 close $fd
3204 set browser_status($w) Ready.
3205 set browser_busy($w) 0
3206 array unset browser_buffer $w
3207 if {$n > 0} {
3208 $w tag add in_sel 1.0 2.0
3209 focus -force $w
3210 }
3211 }
3212}
3213proc show_blame {commit path} {
3215 global next_browser_id blame_status blame_data
3216 set w .browser[incr next_browser_id]
3218 set blame_status($w) {Loading current file content...}
3219 set texts [list]
3220 toplevel $w
3222 label $w.path -text "$commit:$path" \
3224 -anchor w \
3225 -justify left \
3226 -borderwidth 1 \
3227 -relief sunken \
3228 -font font_uibold
3229 pack $w.path -side top -fill x
3230 set hbg #e2effa
3232 frame $w.out
3233 label $w.out.commit_l -text Commit \
3234 -relief solid \
3235 -borderwidth 1 \
3236 -background $hbg \
3237 -font font_uibold
3238 text $w.out.commit_t \
3239 -background white -borderwidth 0 \
3240 -state disabled \
3241 -wrap none \
3242 -height 40 \
3243 -width 9 \
3244 -font font_diff
3245 lappend texts $w.out.commit_t
3246 label $w.out.author_l -text Author \
3248 -relief solid \
3249 -borderwidth 1 \
3250 -background $hbg \
3251 -font font_uibold
3252 text $w.out.author_t \
3253 -background white -borderwidth 0 \
3254 -state disabled \
3255 -wrap none \
3256 -height 40 \
3257 -width 20 \
3258 -font font_diff
3259 lappend texts $w.out.author_t
3260 label $w.out.date_l -text Date \
3262 -relief solid \
3263 -borderwidth 1 \
3264 -background $hbg \
3265 -font font_uibold
3266 text $w.out.date_t \
3267 -background white -borderwidth 0 \
3268 -state disabled \
3269 -wrap none \
3270 -height 40 \
3271 -width [string length "yyyy-mm-dd hh:mm:ss"] \
3272 -font font_diff
3273 lappend texts $w.out.date_t
3274 label $w.out.filename_l -text Filename \
3276 -relief solid \
3277 -borderwidth 1 \
3278 -background $hbg \
3279 -font font_uibold
3280 text $w.out.filename_t \
3281 -background white -borderwidth 0 \
3282 -state disabled \
3283 -wrap none \
3284 -height 40 \
3285 -width 20 \
3286 -font font_diff
3287 lappend texts $w.out.filename_t
3288 label $w.out.origlinenumber_l -text {Orig Line} \
3290 -relief solid \
3291 -borderwidth 1 \
3292 -background $hbg \
3293 -font font_uibold
3294 text $w.out.origlinenumber_t \
3295 -background white -borderwidth 0 \
3296 -state disabled \
3297 -wrap none \
3298 -height 40 \
3299 -width 5 \
3300 -font font_diff
3301 $w.out.origlinenumber_t tag conf linenumber -justify right
3302 lappend texts $w.out.origlinenumber_t
3303 label $w.out.linenumber_l -text {Curr Line} \
3305 -relief solid \
3306 -borderwidth 1 \
3307 -background $hbg \
3308 -font font_uibold
3309 text $w.out.linenumber_t \
3310 -background white -borderwidth 0 \
3311 -state disabled \
3312 -wrap none \
3313 -height 40 \
3314 -width 5 \
3315 -font font_diff
3316 $w.out.linenumber_t tag conf linenumber -justify right
3317 lappend texts $w.out.linenumber_t
3318 label $w.out.file_l -text {File Content} \
3320 -relief solid \
3321 -borderwidth 1 \
3322 -background $hbg \
3323 -font font_uibold
3324 text $w.out.file_t \
3325 -background white -borderwidth 0 \
3326 -state disabled \
3327 -wrap none \
3328 -height 40 \
3329 -width 80 \
3330 -xscrollcommand [list $w.out.sbx set] \
3331 -font font_diff
3332 lappend texts $w.out.file_t
3333 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3335 scrollbar $w.out.sby -orient v \
3336 -command [list scrollbar2many $texts yview]
3337 set labels [list]
3338 foreach i $texts {
3339 regsub {_t$} $i _l l
3340 lappend labels $l
3341 }
3342 set file_col [expr {[llength $texts] - 1}]
3343 eval grid $labels -sticky we
3344 eval grid $texts $w.out.sby -sticky nsew
3345 grid conf $w.out.sbx -column $file_col -sticky we
3346 grid columnconfigure $w.out $file_col -weight 1
3347 grid rowconfigure $w.out 1 -weight 1
3348 pack $w.out -fill both -expand 1
3349 label $w.status -textvariable blame_status($w) \
3351 -anchor w \
3352 -justify left \
3353 -borderwidth 1 \
3354 -relief sunken \
3355 -font font_ui
3356 pack $w.status -side bottom -fill x
3357 menu $w.ctxm -tearoff 0
3359 $w.ctxm add command -label "Copy Commit" \
3360 -font font_ui \
3361 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3362 foreach i $texts {
3364 $i tag conf in_sel \
3365 -background [$i cget -foreground] \
3366 -foreground [$i cget -background]
3367 $i conf -yscrollcommand \
3368 [list many2scrollbar $texts yview $w.out.sby]
3369 bind $i <Button-1> "blame_highlight $i @%x,%y $texts;break"
3370 bind_button3 $i "
3371 set cursorX %x
3372 set cursorY %y
3373 set cursorW %W
3374 tk_popup $w.ctxm %X %Y
3375 "
3376 }
3377 set blame_data($w,colors) {}
3379 bind $w <Visibility> "focus $w"
3381 bind $w <Destroy> "
3382 array unset blame_status $w
3383 array unset blame_data $w,*
3384 "
3385 wm title $w "[appname] ([reponame]): File Viewer"
3386 set blame_data($w,total_lines) 0
3388 set cmd [list git cat-file blob "$commit:$path"]
3389 set fd [open "| $cmd" r]
3390 fconfigure $fd -blocking 0 -translation lf -encoding binary
3391 fileevent $fd readable [list read_blame_catfile \
3392 $fd $w $commit $path \
3393 $texts $w.out.linenumber_t $w.out.file_t]
3394}
3395proc read_blame_catfile {fd w commit path texts w_lno w_file} {
3397 global blame_status blame_data
3398 if {![winfo exists $w_file]} {
3400 catch {close $fd}
3401 return
3402 }
3403 set n $blame_data($w,total_lines)
3405 foreach i $texts {$i conf -state normal}
3406 while {[gets $fd line] >= 0} {
3407 regsub "\r\$" $line {} line
3408 incr n
3409 $w_lno insert end $n linenumber
3410 $w_file insert end $line
3411 foreach i $texts {$i insert end "\n"}
3412 }
3413 foreach i $texts {$i conf -state disabled}
3414 set blame_data($w,total_lines) $n
3415 if {[eof $fd]} {
3417 close $fd
3418 set blame_status($w) {Loading annotations...}
3419 set cmd [list git blame -M -C --incremental]
3420 lappend cmd $commit -- $path
3421 set fd [open "| $cmd" r]
3422 fconfigure $fd -blocking 0 -translation lf -encoding binary
3423 fileevent $fd readable "read_blame_incremental $fd $w $texts"
3424 }
3425}
3426proc read_blame_incremental {fd w
3428 w_commit w_author w_date w_filename w_olno
3429 w_lno w_file} {
3430 global blame_status blame_data
3431 if {![winfo exists $w_commit]} {
3433 catch {close $fd}
3434 return
3435 }
3436 set all [list \
3438 $w_commit \
3439 $w_author \
3440 $w_date \
3441 $w_filename \
3442 $w_olno \
3443 $w_lno \
3444 $w_file]
3445 $w_commit conf -state normal
3447 $w_author conf -state normal
3448 $w_date conf -state normal
3449 $w_filename conf -state normal
3450 $w_olno conf -state normal
3451 while {[gets $fd line] >= 0} {
3453 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3454 cmit original_line final_line line_count]} {
3455 set blame_data($w,commit) $cmit
3456 set blame_data($w,original_line) $original_line
3457 set blame_data($w,final_line) $final_line
3458 set blame_data($w,line_count) $line_count
3459 if {[catch {set g $blame_data($w,$cmit,seen)}]} {
3461 if {$blame_data($w,colors) eq {}} {
3462 set blame_data($w,colors) {
3463 yellow
3464 red
3465 pink
3466 orange
3467 green
3468 grey
3469 }
3470 }
3471 set c [lindex $blame_data($w,colors) 0]
3472 set blame_data($w,colors) \
3473 [lrange $blame_data($w,colors) 1 end]
3474 foreach t $all {
3475 $t tag conf g$cmit -background $c
3476 }
3477 } else {
3478 set blame_data($w,$cmit,seen) 1
3479 }
3480 } elseif {[string match {filename *} $line]} {
3481 set n $blame_data($w,line_count)
3482 set lno $blame_data($w,final_line)
3483 set ol $blame_data($w,original_line)
3484 set file [string range $line 9 end]
3485 set cmit $blame_data($w,commit)
3486 set abbrev [string range $cmit 0 8]
3487 if {[catch {set author $blame_data($w,$cmit,author)} err]} {
3489 set author {}
3490 }
3491 if {[catch {set atime $blame_data($w,$cmit,author-time)}]} {
3493 set atime {}
3494 } else {
3495 set atime [clock format $atime -format {%Y-%m-%d %T}]
3496 }
3497 while {$n > 0} {
3499 if {![catch {set g g$blame_data($w,line$lno,commit)}]} {
3500 foreach t $all {
3501 $t tag remove $g $lno.0 "$lno.0 lineend + 1c"
3502 }
3503 }
3504 foreach t [list \
3506 $w_commit \
3507 $w_author \
3508 $w_date \
3509 $w_filename \
3510 $w_olno] {
3511 $t delete $lno.0 "$lno.0 lineend"
3512 }
3513 $w_commit insert $lno.0 $abbrev
3515 $w_author insert $lno.0 $author
3516 $w_date insert $lno.0 $atime
3517 $w_filename insert $lno.0 $file
3518 $w_olno insert $lno.0 $ol linenumber
3519 set g g$cmit
3521 foreach t $all {
3522 $t tag add $g $lno.0 "$lno.0 lineend + 1c"
3523 }
3524 set blame_data($w,line$lno,commit) $cmit
3526 incr n -1
3528 incr lno
3529 incr ol
3530 }
3531 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3532 set blame_data($w,$blame_data($w,commit),$header) $data
3533 }
3534 }
3535 $w_commit conf -state disabled
3537 $w_author conf -state disabled
3538 $w_date conf -state disabled
3539 $w_filename conf -state disabled
3540 $w_olno conf -state disabled
3541 if {[eof $fd]} {
3543 close $fd
3544 set blame_status($w) {Annotation complete.}
3545 }
3546}
3547proc blame_highlight {w pos args} {
3549 set lno [lindex [split [$w index $pos] .] 0]
3550 foreach i $args {
3551 $i tag remove in_sel 0.0 end
3552 }
3553 if {$lno eq {}} return
3554 foreach i $args {
3555 $i tag add in_sel $lno.0 "$lno.0 + 1 line"
3556 }
3557}
3558proc blame_copycommit {w i pos} {
3560 global blame_data
3561 set lno [lindex [split [$i index $pos] .] 0]
3562 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3563 clipboard clear
3564 clipboard append \
3565 -format STRING \
3566 -type STRING \
3567 -- $commit
3568 }
3569}
3570######################################################################
3572##
3573## icons
3574set filemask {
3576#define mask_width 14
3577#define mask_height 15
3578static unsigned char mask_bits[] = {
3579 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3580 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3581 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3582}
3583image create bitmap file_plain -background white -foreground black -data {
3585#define plain_width 14
3586#define plain_height 15
3587static unsigned char plain_bits[] = {
3588 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3589 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3590 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3591} -maskdata $filemask
3592image create bitmap file_mod -background white -foreground blue -data {
3594#define mod_width 14
3595#define mod_height 15
3596static unsigned char mod_bits[] = {
3597 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3598 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3599 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3600} -maskdata $filemask
3601image create bitmap file_fulltick -background white -foreground "#007000" -data {
3603#define file_fulltick_width 14
3604#define file_fulltick_height 15
3605static unsigned char file_fulltick_bits[] = {
3606 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3607 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3608 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3609} -maskdata $filemask
3610image create bitmap file_parttick -background white -foreground "#005050" -data {
3612#define parttick_width 14
3613#define parttick_height 15
3614static unsigned char parttick_bits[] = {
3615 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3616 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3617 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3618} -maskdata $filemask
3619image create bitmap file_question -background white -foreground black -data {
3621#define file_question_width 14
3622#define file_question_height 15
3623static unsigned char file_question_bits[] = {
3624 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3625 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3626 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3627} -maskdata $filemask
3628image create bitmap file_removed -background white -foreground red -data {
3630#define file_removed_width 14
3631#define file_removed_height 15
3632static unsigned char file_removed_bits[] = {
3633 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3634 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3635 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3636} -maskdata $filemask
3637image create bitmap file_merge -background white -foreground blue -data {
3639#define file_merge_width 14
3640#define file_merge_height 15
3641static unsigned char file_merge_bits[] = {
3642 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3643 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3644 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3645} -maskdata $filemask
3646set file_dir_data {
3648#define file_width 18
3649#define file_height 18
3650static unsigned char file_bits[] = {
3651 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3652 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3653 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3654 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3655 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3656}
3657image create bitmap file_dir -background white -foreground blue \
3658 -data $file_dir_data -maskdata $file_dir_data
3659unset file_dir_data
3660set file_uplevel_data {
3662#define up_width 15
3663#define up_height 15
3664static unsigned char up_bits[] = {
3665 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3666 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3667 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3668}
3669image create bitmap file_uplevel -background white -foreground red \
3670 -data $file_uplevel_data -maskdata $file_uplevel_data
3671unset file_uplevel_data
3672set ui_index .vpane.files.index.list
3674set ui_workdir .vpane.files.workdir.list
3675set all_icons(_$ui_index) file_plain
3677set all_icons(A$ui_index) file_fulltick
3678set all_icons(M$ui_index) file_fulltick
3679set all_icons(D$ui_index) file_removed
3680set all_icons(U$ui_index) file_merge
3681set all_icons(_$ui_workdir) file_plain
3683set all_icons(M$ui_workdir) file_mod
3684set all_icons(D$ui_workdir) file_question
3685set all_icons(U$ui_workdir) file_merge
3686set all_icons(O$ui_workdir) file_plain
3687set max_status_desc 0
3689foreach i {
3690 {__ "Unmodified"}
3691 {_M "Modified, not staged"}
3693 {M_ "Staged for commit"}
3694 {MM "Portions staged for commit"}
3695 {MD "Staged for commit, missing"}
3696 {_O "Untracked, not staged"}
3698 {A_ "Staged for commit"}
3699 {AM "Portions staged for commit"}
3700 {AD "Staged for commit, missing"}
3701 {_D "Missing"}
3703 {D_ "Staged for removal"}
3704 {DO "Staged for removal, still present"}
3705 {U_ "Requires merge resolution"}
3707 {UU "Requires merge resolution"}
3708 {UM "Requires merge resolution"}
3709 {UD "Requires merge resolution"}
3710 } {
3711 if {$max_status_desc < [string length [lindex $i 1]]} {
3712 set max_status_desc [string length [lindex $i 1]]
3713 }
3714 set all_descs([lindex $i 0]) [lindex $i 1]
3715}
3716unset i
3717######################################################################
3719##
3720## util
3721proc bind_button3 {w cmd} {
3723 bind $w <Any-Button-3> $cmd
3724 if {[is_MacOSX]} {
3725 bind $w <Control-Button-1> $cmd
3726 }
3727}
3728proc scrollbar2many {list mode args} {
3730 foreach w $list {eval $w $mode $args}
3731}
3732proc many2scrollbar {list mode sb top bottom} {
3734 $sb set $top $bottom
3735 foreach w $list {$w $mode moveto $top}
3736}
3737proc incr_font_size {font {amt 1}} {
3739 set sz [font configure $font -size]
3740 incr sz $amt
3741 font configure $font -size $sz
3742 font configure ${font}bold -size $sz
3743}
3744proc hook_failed_popup {hook msg} {
3746 set w .hookfail
3747 toplevel $w
3748 frame $w.m
3750 label $w.m.l1 -text "$hook hook failed:" \
3751 -anchor w \
3752 -justify left \
3753 -font font_uibold
3754 text $w.m.t \
3755 -background white -borderwidth 1 \
3756 -relief sunken \
3757 -width 80 -height 10 \
3758 -font font_diff \
3759 -yscrollcommand [list $w.m.sby set]
3760 label $w.m.l2 \
3761 -text {You must correct the above errors before committing.} \
3762 -anchor w \
3763 -justify left \
3764 -font font_uibold
3765 scrollbar $w.m.sby -command [list $w.m.t yview]
3766 pack $w.m.l1 -side top -fill x
3767 pack $w.m.l2 -side bottom -fill x
3768 pack $w.m.sby -side right -fill y
3769 pack $w.m.t -side left -fill both -expand 1
3770 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3771 $w.m.t insert 1.0 $msg
3773 $w.m.t conf -state disabled
3774 button $w.ok -text OK \
3776 -width 15 \
3777 -font font_ui \
3778 -command "destroy $w"
3779 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3780 bind $w <Visibility> "grab $w; focus $w"
3782 bind $w <Key-Return> "destroy $w"
3783 wm title $w "[appname] ([reponame]): error"
3784 tkwait window $w
3785}
3786set next_console_id 0
3788proc new_console {short_title long_title} {
3790 global next_console_id console_data
3791 set w .console[incr next_console_id]
3792 set console_data($w) [list $short_title $long_title]
3793 return [console_init $w]
3794}
3795proc console_init {w} {
3797 global console_cr console_data M1B
3798 set console_cr($w) 1.0
3800 toplevel $w
3801 frame $w.m
3802 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3803 -anchor w \
3804 -justify left \
3805 -font font_uibold
3806 text $w.m.t \
3807 -background white -borderwidth 1 \
3808 -relief sunken \
3809 -width 80 -height 10 \
3810 -font font_diff \
3811 -state disabled \
3812 -yscrollcommand [list $w.m.sby set]
3813 label $w.m.s -text {Working... please wait...} \
3814 -anchor w \
3815 -justify left \
3816 -font font_uibold
3817 scrollbar $w.m.sby -command [list $w.m.t yview]
3818 pack $w.m.l1 -side top -fill x
3819 pack $w.m.s -side bottom -fill x
3820 pack $w.m.sby -side right -fill y
3821 pack $w.m.t -side left -fill both -expand 1
3822 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3823 menu $w.ctxm -tearoff 0
3825 $w.ctxm add command -label "Copy" \
3826 -font font_ui \
3827 -command "tk_textCopy $w.m.t"
3828 $w.ctxm add command -label "Select All" \
3829 -font font_ui \
3830 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3831 $w.ctxm add command -label "Copy All" \
3832 -font font_ui \
3833 -command "
3834 $w.m.t tag add sel 0.0 end
3835 tk_textCopy $w.m.t
3836 $w.m.t tag remove sel 0.0 end
3837 "
3838 button $w.ok -text {Close} \
3840 -font font_ui \
3841 -state disabled \
3842 -command "destroy $w"
3843 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3844 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3846 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3847 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3848 bind $w <Visibility> "focus $w"
3849 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3850 return $w
3851}
3852proc console_exec {w cmd after} {
3854 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3855 # But most users need that so we have to relogin. :-(
3856 #
3857 if {[is_Cygwin]} {
3858 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3859 }
3860 # -- Tcl won't let us redirect both stdout and stderr to
3862 # the same pipe. So pass it through cat...
3863 #
3864 set cmd [concat | $cmd |& cat]
3865 set fd_f [open $cmd r]
3867 fconfigure $fd_f -blocking 0 -translation binary
3868 fileevent $fd_f readable [list console_read $w $fd_f $after]
3869}
3870proc console_read {w fd after} {
3872 global console_cr
3873 set buf [read $fd]
3875 if {$buf ne {}} {
3876 if {![winfo exists $w]} {console_init $w}
3877 $w.m.t conf -state normal
3878 set c 0
3879 set n [string length $buf]
3880 while {$c < $n} {
3881 set cr [string first "\r" $buf $c]
3882 set lf [string first "\n" $buf $c]
3883 if {$cr < 0} {set cr [expr {$n + 1}]}
3884 if {$lf < 0} {set lf [expr {$n + 1}]}
3885 if {$lf < $cr} {
3887 $w.m.t insert end [string range $buf $c $lf]
3888 set console_cr($w) [$w.m.t index {end -1c}]
3889 set c $lf
3890 incr c
3891 } else {
3892 $w.m.t delete $console_cr($w) end
3893 $w.m.t insert end "\n"
3894 $w.m.t insert end [string range $buf $c $cr]
3895 set c $cr
3896 incr c
3897 }
3898 }
3899 $w.m.t conf -state disabled
3900 $w.m.t see end
3901 }
3902 fconfigure $fd -blocking 1
3904 if {[eof $fd]} {
3905 if {[catch {close $fd}]} {
3906 set ok 0
3907 } else {
3908 set ok 1
3909 }
3910 uplevel #0 $after $w $ok
3911 return
3912 }
3913 fconfigure $fd -blocking 0
3914}
3915proc console_chain {cmdlist w {ok 1}} {
3917 if {$ok} {
3918 if {[llength $cmdlist] == 0} {
3919 console_done $w $ok
3920 return
3921 }
3922 set cmd [lindex $cmdlist 0]
3924 set cmdlist [lrange $cmdlist 1 end]
3925 if {[lindex $cmd 0] eq {console_exec}} {
3927 console_exec $w \
3928 [lindex $cmd 1] \
3929 [list console_chain $cmdlist]
3930 } else {
3931 uplevel #0 $cmd $cmdlist $w $ok
3932 }
3933 } else {
3934 console_done $w $ok
3935 }
3936}
3937proc console_done {args} {
3939 global console_cr console_data
3940 switch -- [llength $args] {
3942 2 {
3943 set w [lindex $args 0]
3944 set ok [lindex $args 1]
3945 }
3946 3 {
3947 set w [lindex $args 1]
3948 set ok [lindex $args 2]
3949 }
3950 default {
3951 error "wrong number of args: console_done ?ignored? w ok"
3952 }
3953 }
3954 if {$ok} {
3956 if {[winfo exists $w]} {
3957 $w.m.s conf -background green -text {Success}
3958 $w.ok conf -state normal
3959 }
3960 } else {
3961 if {![winfo exists $w]} {
3962 console_init $w
3963 }
3964 $w.m.s conf -background red -text {Error: Command Failed}
3965 $w.ok conf -state normal
3966 }
3967 array unset console_cr $w
3969 array unset console_data $w
3970}
3971######################################################################
3973##
3974## ui commands
3975set starting_gitk_msg {Starting gitk... please wait...}
3977proc do_gitk {revs} {
3979 global env ui_status_value starting_gitk_msg
3980 # -- On Windows gitk is severly broken, and right now it seems like
3982 # nobody cares about fixing it. The only known workaround is to
3983 # always delete ~/.gitk before starting the program.
3984 #
3985 if {[is_Windows]} {
3986 catch {file delete [file join $env(HOME) .gitk]}
3987 }
3988 # -- Always start gitk through whatever we were loaded with. This
3990 # lets us bypass using shell process on Windows systems.
3991 #
3992 set cmd [info nameofexecutable]
3993 lappend cmd [gitexec gitk]
3994 if {$revs ne {}} {
3995 append cmd { }
3996 append cmd $revs
3997 }
3998 if {[catch {eval exec $cmd &} err]} {
4000 error_popup "Failed to start gitk:\n\n$err"
4001 } else {
4002 set ui_status_value $starting_gitk_msg
4003 after 10000 {
4004 if {$ui_status_value eq $starting_gitk_msg} {
4005 set ui_status_value {Ready.}
4006 }
4007 }
4008 }
4009}
4010proc do_stats {} {
4012 set fd [open "| git count-objects -v" r]
4013 while {[gets $fd line] > 0} {
4014 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4015 set stats($name) $value
4016 }
4017 }
4018 close $fd
4019 set packed_sz 0
4021 foreach p [glob -directory [gitdir objects pack] \
4022 -type f \
4023 -nocomplain -- *] {
4024 incr packed_sz [file size $p]
4025 }
4026 if {$packed_sz > 0} {
4027 set stats(size-pack) [expr {$packed_sz / 1024}]
4028 }
4029 set w .stats_view
4031 toplevel $w
4032 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4033 label $w.header -text {Database Statistics} \
4035 -font font_uibold
4036 pack $w.header -side top -fill x
4037 frame $w.buttons -border 1
4039 button $w.buttons.close -text Close \
4040 -font font_ui \
4041 -command [list destroy $w]
4042 button $w.buttons.gc -text {Compress Database} \
4043 -font font_ui \
4044 -command "destroy $w;do_gc"
4045 pack $w.buttons.close -side right
4046 pack $w.buttons.gc -side left
4047 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4048 frame $w.stat -borderwidth 1 -relief solid
4050 foreach s {
4051 {count {Number of loose objects}}
4052 {size {Disk space used by loose objects} { KiB}}
4053 {in-pack {Number of packed objects}}
4054 {packs {Number of packs}}
4055 {size-pack {Disk space used by packed objects} { KiB}}
4056 {prune-packable {Packed objects waiting for pruning}}
4057 {garbage {Garbage files}}
4058 } {
4059 set name [lindex $s 0]
4060 set label [lindex $s 1]
4061 if {[catch {set value $stats($name)}]} continue
4062 if {[llength $s] > 2} {
4063 set value "$value[lindex $s 2]"
4064 }
4065 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4067 label $w.stat.v_$name -text $value -anchor w -font font_ui
4068 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4069 }
4070 pack $w.stat -pady 10 -padx 10
4071 bind $w <Visibility> "grab $w; focus $w"
4073 bind $w <Key-Escape> [list destroy $w]
4074 bind $w <Key-Return> [list destroy $w]
4075 wm title $w "[appname] ([reponame]): Database Statistics"
4076 tkwait window $w
4077}
4078proc do_gc {} {
4080 set w [new_console {gc} {Compressing the object database}]
4081 console_chain {
4082 {console_exec {git pack-refs --prune}}
4083 {console_exec {git reflog expire --all}}
4084 {console_exec {git repack -a -d -l}}
4085 {console_exec {git rerere gc}}
4086 } $w
4087}
4088proc do_fsck_objects {} {
4090 set w [new_console {fsck-objects} \
4091 {Verifying the object database with fsck-objects}]
4092 set cmd [list git fsck-objects]
4093 lappend cmd --full
4094 lappend cmd --cache
4095 lappend cmd --strict
4096 console_exec $w $cmd console_done
4097}
4098set is_quitting 0
4100proc do_quit {} {
4102 global ui_comm is_quitting repo_config commit_type
4103 if {$is_quitting} return
4105 set is_quitting 1
4106 # -- Stash our current commit buffer.
4108 #
4109 set save [gitdir GITGUI_MSG]
4110 set msg [string trim [$ui_comm get 0.0 end]]
4111 regsub -all -line {[ \r\t]+$} $msg {} msg
4112 if {(![string match amend* $commit_type]
4113 || [$ui_comm edit modified])
4114 && $msg ne {}} {
4115 catch {
4116 set fd [open $save w]
4117 puts -nonewline $fd $msg
4118 close $fd
4119 }
4120 } else {
4121 catch {file delete $save}
4122 }
4123 # -- Stash our current window geometry into this repository.
4125 #
4126 set cfg_geometry [list]
4127 lappend cfg_geometry [wm geometry .]
4128 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4129 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4130 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4131 set rc_geometry {}
4132 }
4133 if {$cfg_geometry ne $rc_geometry} {
4134 catch {exec git repo-config gui.geometry $cfg_geometry}
4135 }
4136 destroy .
4138}
4139proc do_rescan {} {
4141 rescan {set ui_status_value {Ready.}}
4142}
4143proc unstage_helper {txt paths} {
4145 global file_states current_diff_path
4146 if {![lock_index begin-update]} return
4148 set pathList [list]
4150 set after {}
4151 foreach path $paths {
4152 switch -glob -- [lindex $file_states($path) 0] {
4153 A? -
4154 M? -
4155 D? {
4156 lappend pathList $path
4157 if {$path eq $current_diff_path} {
4158 set after {reshow_diff;}
4159 }
4160 }
4161 }
4162 }
4163 if {$pathList eq {}} {
4164 unlock_index
4165 } else {
4166 update_indexinfo \
4167 $txt \
4168 $pathList \
4169 [concat $after {set ui_status_value {Ready.}}]
4170 }
4171}
4172proc do_unstage_selection {} {
4174 global current_diff_path selected_paths
4175 if {[array size selected_paths] > 0} {
4177 unstage_helper \
4178 {Unstaging selected files from commit} \
4179 [array names selected_paths]
4180 } elseif {$current_diff_path ne {}} {
4181 unstage_helper \
4182 "Unstaging [short_path $current_diff_path] from commit" \
4183 [list $current_diff_path]
4184 }
4185}
4186proc add_helper {txt paths} {
4188 global file_states current_diff_path
4189 if {![lock_index begin-update]} return
4191 set pathList [list]
4193 set after {}
4194 foreach path $paths {
4195 switch -glob -- [lindex $file_states($path) 0] {
4196 _O -
4197 ?M -
4198 ?D -
4199 U? {
4200 lappend pathList $path
4201 if {$path eq $current_diff_path} {
4202 set after {reshow_diff;}
4203 }
4204 }
4205 }
4206 }
4207 if {$pathList eq {}} {
4208 unlock_index
4209 } else {
4210 update_index \
4211 $txt \
4212 $pathList \
4213 [concat $after {set ui_status_value {Ready to commit.}}]
4214 }
4215}
4216proc do_add_selection {} {
4218 global current_diff_path selected_paths
4219 if {[array size selected_paths] > 0} {
4221 add_helper \
4222 {Adding selected files} \
4223 [array names selected_paths]
4224 } elseif {$current_diff_path ne {}} {
4225 add_helper \
4226 "Adding [short_path $current_diff_path]" \
4227 [list $current_diff_path]
4228 }
4229}
4230proc do_add_all {} {
4232 global file_states
4233 set paths [list]
4235 foreach path [array names file_states] {
4236 switch -glob -- [lindex $file_states($path) 0] {
4237 U? {continue}
4238 ?M -
4239 ?D {lappend paths $path}
4240 }
4241 }
4242 add_helper {Adding all changed files} $paths
4243}
4244proc revert_helper {txt paths} {
4246 global file_states current_diff_path
4247 if {![lock_index begin-update]} return
4249 set pathList [list]
4251 set after {}
4252 foreach path $paths {
4253 switch -glob -- [lindex $file_states($path) 0] {
4254 U? {continue}
4255 ?M -
4256 ?D {
4257 lappend pathList $path
4258 if {$path eq $current_diff_path} {
4259 set after {reshow_diff;}
4260 }
4261 }
4262 }
4263 }
4264 set n [llength $pathList]
4266 if {$n == 0} {
4267 unlock_index
4268 return
4269 } elseif {$n == 1} {
4270 set s "[short_path [lindex $pathList]]"
4271 } else {
4272 set s "these $n files"
4273 }
4274 set reply [tk_dialog \
4276 .confirm_revert \
4277 "[appname] ([reponame])" \
4278 "Revert changes in $s?
4279Any unadded changes will be permanently lost by the revert." \
4281 question \
4282 1 \
4283 {Do Nothing} \
4284 {Revert Changes} \
4285 ]
4286 if {$reply == 1} {
4287 checkout_index \
4288 $txt \
4289 $pathList \
4290 [concat $after {set ui_status_value {Ready.}}]
4291 } else {
4292 unlock_index
4293 }
4294}
4295proc do_revert_selection {} {
4297 global current_diff_path selected_paths
4298 if {[array size selected_paths] > 0} {
4300 revert_helper \
4301 {Reverting selected files} \
4302 [array names selected_paths]
4303 } elseif {$current_diff_path ne {}} {
4304 revert_helper \
4305 "Reverting [short_path $current_diff_path]" \
4306 [list $current_diff_path]
4307 }
4308}
4309proc do_signoff {} {
4311 global ui_comm
4312 set me [committer_ident]
4314 if {$me eq {}} return
4315 set sob "Signed-off-by: $me"
4317 set last [$ui_comm get {end -1c linestart} {end -1c}]
4318 if {$last ne $sob} {
4319 $ui_comm edit separator
4320 if {$last ne {}
4321 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4322 $ui_comm insert end "\n"
4323 }
4324 $ui_comm insert end "\n$sob"
4325 $ui_comm edit separator
4326 $ui_comm see end
4327 }
4328}
4329proc do_select_commit_type {} {
4331 global commit_type selected_commit_type
4332 if {$selected_commit_type eq {new}
4334 && [string match amend* $commit_type]} {
4335 create_new_commit
4336 } elseif {$selected_commit_type eq {amend}
4337 && ![string match amend* $commit_type]} {
4338 load_last_commit
4339 # The amend request was rejected...
4341 #
4342 if {![string match amend* $commit_type]} {
4343 set selected_commit_type new
4344 }
4345 }
4346}
4347proc do_commit {} {
4349 commit_tree
4350}
4351proc do_about {} {
4353 global appvers copyright
4354 global tcl_patchLevel tk_patchLevel
4355 set w .about_dialog
4357 toplevel $w
4358 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4359 label $w.header -text "About [appname]" \
4361 -font font_uibold
4362 pack $w.header -side top -fill x
4363 frame $w.buttons
4365 button $w.buttons.close -text {Close} \
4366 -font font_ui \
4367 -command [list destroy $w]
4368 pack $w.buttons.close -side right
4369 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4370 label $w.desc \
4372 -text "[appname] - a commit creation tool for Git.
4373$copyright" \
4374 -padx 5 -pady 5 \
4375 -justify left \
4376 -anchor w \
4377 -borderwidth 1 \
4378 -relief solid \
4379 -font font_ui
4380 pack $w.desc -side top -fill x -padx 5 -pady 5
4381 set v {}
4383 append v "[appname] version $appvers\n"
4384 append v "[exec git version]\n"
4385 append v "\n"
4386 if {$tcl_patchLevel eq $tk_patchLevel} {
4387 append v "Tcl/Tk version $tcl_patchLevel"
4388 } else {
4389 append v "Tcl version $tcl_patchLevel"
4390 append v ", Tk version $tk_patchLevel"
4391 }
4392 label $w.vers \
4394 -text $v \
4395 -padx 5 -pady 5 \
4396 -justify left \
4397 -anchor w \
4398 -borderwidth 1 \
4399 -relief solid \
4400 -font font_ui
4401 pack $w.vers -side top -fill x -padx 5 -pady 5
4402 menu $w.ctxm -tearoff 0
4404 $w.ctxm add command \
4405 -label {Copy} \
4406 -font font_ui \
4407 -command "
4408 clipboard clear
4409 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4410 "
4411 bind $w <Visibility> "grab $w; focus $w"
4413 bind $w <Key-Escape> "destroy $w"
4414 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4415 wm title $w "About [appname]"
4416 tkwait window $w
4417}
4418proc do_options {} {
4420 global repo_config global_config font_descs
4421 global repo_config_new global_config_new
4422 array unset repo_config_new
4424 array unset global_config_new
4425 foreach name [array names repo_config] {
4426 set repo_config_new($name) $repo_config($name)
4427 }
4428 load_config 1
4429 foreach name [array names repo_config] {
4430 switch -- $name {
4431 gui.diffcontext {continue}
4432 }
4433 set repo_config_new($name) $repo_config($name)
4434 }
4435 foreach name [array names global_config] {
4436 set global_config_new($name) $global_config($name)
4437 }
4438 set w .options_editor
4440 toplevel $w
4441 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4442 label $w.header -text "[appname] Options" \
4444 -font font_uibold
4445 pack $w.header -side top -fill x
4446 frame $w.buttons
4448 button $w.buttons.restore -text {Restore Defaults} \
4449 -font font_ui \
4450 -command do_restore_defaults
4451 pack $w.buttons.restore -side left
4452 button $w.buttons.save -text Save \
4453 -font font_ui \
4454 -command [list do_save_config $w]
4455 pack $w.buttons.save -side right
4456 button $w.buttons.cancel -text {Cancel} \
4457 -font font_ui \
4458 -command [list destroy $w]
4459 pack $w.buttons.cancel -side right -padx 5
4460 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4461 labelframe $w.repo -text "[reponame] Repository" \
4463 -font font_ui
4464 labelframe $w.global -text {Global (All Repositories)} \
4465 -font font_ui
4466 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4467 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4468 set optid 0
4470 foreach option {
4471 {t user.name {User Name}}
4472 {t user.email {Email Address}}
4473 {b merge.summary {Summarize Merge Commits}}
4475 {i-1..5 merge.verbosity {Merge Verbosity}}
4476 {b gui.trustmtime {Trust File Modification Timestamps}}
4478 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4479 {t gui.newbranchtemplate {New Branch Name Template}}
4480 } {
4481 set type [lindex $option 0]
4482 set name [lindex $option 1]
4483 set text [lindex $option 2]
4484 incr optid
4485 foreach f {repo global} {
4486 switch -glob -- $type {
4487 b {
4488 checkbutton $w.$f.$optid -text $text \
4489 -variable ${f}_config_new($name) \
4490 -onvalue true \
4491 -offvalue false \
4492 -font font_ui
4493 pack $w.$f.$optid -side top -anchor w
4494 }
4495 i-* {
4496 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4497 frame $w.$f.$optid
4498 label $w.$f.$optid.l -text "$text:" -font font_ui
4499 pack $w.$f.$optid.l -side left -anchor w -fill x
4500 spinbox $w.$f.$optid.v \
4501 -textvariable ${f}_config_new($name) \
4502 -from $min \
4503 -to $max \
4504 -increment 1 \
4505 -width [expr {1 + [string length $max]}] \
4506 -font font_ui
4507 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4508 pack $w.$f.$optid.v -side right -anchor e -padx 5
4509 pack $w.$f.$optid -side top -anchor w -fill x
4510 }
4511 t {
4512 frame $w.$f.$optid
4513 label $w.$f.$optid.l -text "$text:" -font font_ui
4514 entry $w.$f.$optid.v \
4515 -borderwidth 1 \
4516 -relief sunken \
4517 -width 20 \
4518 -textvariable ${f}_config_new($name) \
4519 -font font_ui
4520 pack $w.$f.$optid.l -side left -anchor w
4521 pack $w.$f.$optid.v -side left -anchor w \
4522 -fill x -expand 1 \
4523 -padx 5
4524 pack $w.$f.$optid -side top -anchor w -fill x
4525 }
4526 }
4527 }
4528 }
4529 set all_fonts [lsort [font families]]
4531 foreach option $font_descs {
4532 set name [lindex $option 0]
4533 set font [lindex $option 1]
4534 set text [lindex $option 2]
4535 set global_config_new(gui.$font^^family) \
4537 [font configure $font -family]
4538 set global_config_new(gui.$font^^size) \
4539 [font configure $font -size]
4540 frame $w.global.$name
4542 label $w.global.$name.l -text "$text:" -font font_ui
4543 pack $w.global.$name.l -side left -anchor w -fill x
4544 eval tk_optionMenu $w.global.$name.family \
4545 global_config_new(gui.$font^^family) \
4546 $all_fonts
4547 spinbox $w.global.$name.size \
4548 -textvariable global_config_new(gui.$font^^size) \
4549 -from 2 -to 80 -increment 1 \
4550 -width 3 \
4551 -font font_ui
4552 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4553 pack $w.global.$name.size -side right -anchor e
4554 pack $w.global.$name.family -side right -anchor e
4555 pack $w.global.$name -side top -anchor w -fill x
4556 }
4557 bind $w <Visibility> "grab $w; focus $w"
4559 bind $w <Key-Escape> "destroy $w"
4560 wm title $w "[appname] ([reponame]): Options"
4561 tkwait window $w
4562}
4563proc do_restore_defaults {} {
4565 global font_descs default_config repo_config
4566 global repo_config_new global_config_new
4567 foreach name [array names default_config] {
4569 set repo_config_new($name) $default_config($name)
4570 set global_config_new($name) $default_config($name)
4571 }
4572 foreach option $font_descs {
4574 set name [lindex $option 0]
4575 set repo_config(gui.$name) $default_config(gui.$name)
4576 }
4577 apply_config
4578 foreach option $font_descs {
4580 set name [lindex $option 0]
4581 set font [lindex $option 1]
4582 set global_config_new(gui.$font^^family) \
4583 [font configure $font -family]
4584 set global_config_new(gui.$font^^size) \
4585 [font configure $font -size]
4586 }
4587}
4588proc do_save_config {w} {
4590 if {[catch {save_config} err]} {
4591 error_popup "Failed to completely save options:\n\n$err"
4592 }
4593 reshow_diff
4594 destroy $w
4595}
4596proc do_windows_shortcut {} {
4598 global argv0
4599 set fn [tk_getSaveFile \
4601 -parent . \
4602 -title "[appname] ([reponame]): Create Desktop Icon" \
4603 -initialfile "Git [reponame].bat"]
4604 if {$fn != {}} {
4605 if {[catch {
4606 set fd [open $fn w]
4607 puts $fd "@ECHO Entering [reponame]"
4608 puts $fd "@ECHO Starting git-gui... please wait..."
4609 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4610 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4611 puts -nonewline $fd "@\"[info nameofexecutable]\""
4612 puts $fd " \"[file normalize $argv0]\""
4613 close $fd
4614 } err]} {
4615 error_popup "Cannot write script:\n\n$err"
4616 }
4617 }
4618}
4619proc do_cygwin_shortcut {} {
4621 global argv0
4622 if {[catch {
4624 set desktop [exec cygpath \
4625 --windows \
4626 --absolute \
4627 --long-name \
4628 --desktop]
4629 }]} {
4630 set desktop .
4631 }
4632 set fn [tk_getSaveFile \
4633 -parent . \
4634 -title "[appname] ([reponame]): Create Desktop Icon" \
4635 -initialdir $desktop \
4636 -initialfile "Git [reponame].bat"]
4637 if {$fn != {}} {
4638 if {[catch {
4639 set fd [open $fn w]
4640 set sh [exec cygpath \
4641 --windows \
4642 --absolute \
4643 /bin/sh]
4644 set me [exec cygpath \
4645 --unix \
4646 --absolute \
4647 $argv0]
4648 set gd [exec cygpath \
4649 --unix \
4650 --absolute \
4651 [gitdir]]
4652 set gw [exec cygpath \
4653 --windows \
4654 --absolute \
4655 [file dirname [gitdir]]]
4656 regsub -all ' $me "'\\''" me
4657 regsub -all ' $gd "'\\''" gd
4658 puts $fd "@ECHO Entering $gw"
4659 puts $fd "@ECHO Starting git-gui... please wait..."
4660 puts -nonewline $fd "@\"$sh\" --login -c \""
4661 puts -nonewline $fd "GIT_DIR='$gd'"
4662 puts -nonewline $fd " '$me'"
4663 puts $fd "&\""
4664 close $fd
4665 } err]} {
4666 error_popup "Cannot write script:\n\n$err"
4667 }
4668 }
4669}
4670proc do_macosx_app {} {
4672 global argv0 env
4673 set fn [tk_getSaveFile \
4675 -parent . \
4676 -title "[appname] ([reponame]): Create Desktop Icon" \
4677 -initialdir [file join $env(HOME) Desktop] \
4678 -initialfile "Git [reponame].app"]
4679 if {$fn != {}} {
4680 if {[catch {
4681 set Contents [file join $fn Contents]
4682 set MacOS [file join $Contents MacOS]
4683 set exe [file join $MacOS git-gui]
4684 file mkdir $MacOS
4686 set fd [open [file join $Contents Info.plist] w]
4688 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4689<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4690<plist version="1.0">
4691<dict>
4692 <key>CFBundleDevelopmentRegion</key>
4693 <string>English</string>
4694 <key>CFBundleExecutable</key>
4695 <string>git-gui</string>
4696 <key>CFBundleIdentifier</key>
4697 <string>org.spearce.git-gui</string>
4698 <key>CFBundleInfoDictionaryVersion</key>
4699 <string>6.0</string>
4700 <key>CFBundlePackageType</key>
4701 <string>APPL</string>
4702 <key>CFBundleSignature</key>
4703 <string>????</string>
4704 <key>CFBundleVersion</key>
4705 <string>1.0</string>
4706 <key>NSPrincipalClass</key>
4707 <string>NSApplication</string>
4708</dict>
4709</plist>}
4710 close $fd
4711 set fd [open $exe w]
4713 set gd [file normalize [gitdir]]
4714 set ep [file normalize [gitexec]]
4715 regsub -all ' $gd "'\\''" gd
4716 regsub -all ' $ep "'\\''" ep
4717 puts $fd "#!/bin/sh"
4718 foreach name [array names env] {
4719 if {[string match GIT_* $name]} {
4720 regsub -all ' $env($name) "'\\''" v
4721 puts $fd "export $name='$v'"
4722 }
4723 }
4724 puts $fd "export PATH='$ep':\$PATH"
4725 puts $fd "export GIT_DIR='$gd'"
4726 puts $fd "exec [file normalize $argv0]"
4727 close $fd
4728 file attributes $exe -permissions u+x,g+x,o+x
4730 } err]} {
4731 error_popup "Cannot write icon:\n\n$err"
4732 }
4733 }
4734}
4735proc toggle_or_diff {w x y} {
4737 global file_states file_lists current_diff_path ui_index ui_workdir
4738 global last_clicked selected_paths
4739 set pos [split [$w index @$x,$y] .]
4741 set lno [lindex $pos 0]
4742 set col [lindex $pos 1]
4743 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4744 if {$path eq {}} {
4745 set last_clicked {}
4746 return
4747 }
4748 set last_clicked [list $w $lno]
4750 array unset selected_paths
4751 $ui_index tag remove in_sel 0.0 end
4752 $ui_workdir tag remove in_sel 0.0 end
4753 if {$col == 0} {
4755 if {$current_diff_path eq $path} {
4756 set after {reshow_diff;}
4757 } else {
4758 set after {}
4759 }
4760 if {$w eq $ui_index} {
4761 update_indexinfo \
4762 "Unstaging [short_path $path] from commit" \
4763 [list $path] \
4764 [concat $after {set ui_status_value {Ready.}}]
4765 } elseif {$w eq $ui_workdir} {
4766 update_index \
4767 "Adding [short_path $path]" \
4768 [list $path] \
4769 [concat $after {set ui_status_value {Ready.}}]
4770 }
4771 } else {
4772 show_diff $path $w $lno
4773 }
4774}
4775proc add_one_to_selection {w x y} {
4777 global file_lists last_clicked selected_paths
4778 set lno [lindex [split [$w index @$x,$y] .] 0]
4780 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4781 if {$path eq {}} {
4782 set last_clicked {}
4783 return
4784 }
4785 if {$last_clicked ne {}
4787 && [lindex $last_clicked 0] ne $w} {
4788 array unset selected_paths
4789 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4790 }
4791 set last_clicked [list $w $lno]
4793 if {[catch {set in_sel $selected_paths($path)}]} {
4794 set in_sel 0
4795 }
4796 if {$in_sel} {
4797 unset selected_paths($path)
4798 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4799 } else {
4800 set selected_paths($path) 1
4801 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4802 }
4803}
4804proc add_range_to_selection {w x y} {
4806 global file_lists last_clicked selected_paths
4807 if {[lindex $last_clicked 0] ne $w} {
4809 toggle_or_diff $w $x $y
4810 return
4811 }
4812 set lno [lindex [split [$w index @$x,$y] .] 0]
4814 set lc [lindex $last_clicked 1]
4815 if {$lc < $lno} {
4816 set begin $lc
4817 set end $lno
4818 } else {
4819 set begin $lno
4820 set end $lc
4821 }
4822 foreach path [lrange $file_lists($w) \
4824 [expr {$begin - 1}] \
4825 [expr {$end - 1}]] {
4826 set selected_paths($path) 1
4827 }
4828 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4829}
4830######################################################################
4832##
4833## config defaults
4834set cursor_ptr arrow
4836font create font_diff -family Courier -size 10
4837font create font_ui
4838catch {
4839 label .dummy
4840 eval font configure font_ui [font actual [.dummy cget -font]]
4841 destroy .dummy
4842}
4843font create font_uibold
4845font create font_diffbold
4846if {[is_Windows]} {
4848 set M1B Control
4849 set M1T Ctrl
4850} elseif {[is_MacOSX]} {
4851 set M1B M1
4852 set M1T Cmd
4853} else {
4854 set M1B M1
4855 set M1T M1
4856}
4857proc apply_config {} {
4859 global repo_config font_descs
4860 foreach option $font_descs {
4862 set name [lindex $option 0]
4863 set font [lindex $option 1]
4864 if {[catch {
4865 foreach {cn cv} $repo_config(gui.$name) {
4866 font configure $font $cn $cv
4867 }
4868 } err]} {
4869 error_popup "Invalid font specified in gui.$name:\n\n$err"
4870 }
4871 foreach {cn cv} [font configure $font] {
4872 font configure ${font}bold $cn $cv
4873 }
4874 font configure ${font}bold -weight bold
4875 }
4876}
4877set default_config(merge.summary) false
4879set default_config(merge.verbosity) 2
4880set default_config(user.name) {}
4881set default_config(user.email) {}
4882set default_config(gui.trustmtime) false
4884set default_config(gui.diffcontext) 5
4885set default_config(gui.newbranchtemplate) {}
4886set default_config(gui.fontui) [font configure font_ui]
4887set default_config(gui.fontdiff) [font configure font_diff]
4888set font_descs {
4889 {fontui font_ui {Main Font}}
4890 {fontdiff font_diff {Diff/Console Font}}
4891}
4892load_config 0
4893apply_config
4894######################################################################
4896##
4897## ui construction
4898# -- Menu Bar
4900#
4901menu .mbar -tearoff 0
4902.mbar add cascade -label Repository -menu .mbar.repository
4903.mbar add cascade -label Edit -menu .mbar.edit
4904if {!$single_commit} {
4905 .mbar add cascade -label Branch -menu .mbar.branch
4906}
4907.mbar add cascade -label Commit -menu .mbar.commit
4908if {!$single_commit} {
4909 .mbar add cascade -label Merge -menu .mbar.merge
4910 .mbar add cascade -label Fetch -menu .mbar.fetch
4911 .mbar add cascade -label Push -menu .mbar.push
4912}
4913. configure -menu .mbar
4914# -- Repository Menu
4916#
4917menu .mbar.repository
4918.mbar.repository add command \
4920 -label {Browse Current Branch} \
4921 -command {new_browser $current_branch} \
4922 -font font_ui
4923.mbar.repository add separator
4924.mbar.repository add command \
4926 -label {Visualize Current Branch} \
4927 -command {do_gitk {}} \
4928 -font font_ui
4929.mbar.repository add command \
4930 -label {Visualize All Branches} \
4931 -command {do_gitk {--all}} \
4932 -font font_ui
4933.mbar.repository add separator
4934if {!$single_commit} {
4936 .mbar.repository add command -label {Database Statistics} \
4937 -command do_stats \
4938 -font font_ui
4939 .mbar.repository add command -label {Compress Database} \
4941 -command do_gc \
4942 -font font_ui
4943 .mbar.repository add command -label {Verify Database} \
4945 -command do_fsck_objects \
4946 -font font_ui
4947 .mbar.repository add separator
4949 if {[is_Cygwin]} {
4951 .mbar.repository add command \
4952 -label {Create Desktop Icon} \
4953 -command do_cygwin_shortcut \
4954 -font font_ui
4955 } elseif {[is_Windows]} {
4956 .mbar.repository add command \
4957 -label {Create Desktop Icon} \
4958 -command do_windows_shortcut \
4959 -font font_ui
4960 } elseif {[is_MacOSX]} {
4961 .mbar.repository add command \
4962 -label {Create Desktop Icon} \
4963 -command do_macosx_app \
4964 -font font_ui
4965 }
4966}
4967.mbar.repository add command -label Quit \
4969 -command do_quit \
4970 -accelerator $M1T-Q \
4971 -font font_ui
4972# -- Edit Menu
4974#
4975menu .mbar.edit
4976.mbar.edit add command -label Undo \
4977 -command {catch {[focus] edit undo}} \
4978 -accelerator $M1T-Z \
4979 -font font_ui
4980.mbar.edit add command -label Redo \
4981 -command {catch {[focus] edit redo}} \
4982 -accelerator $M1T-Y \
4983 -font font_ui
4984.mbar.edit add separator
4985.mbar.edit add command -label Cut \
4986 -command {catch {tk_textCut [focus]}} \
4987 -accelerator $M1T-X \
4988 -font font_ui
4989.mbar.edit add command -label Copy \
4990 -command {catch {tk_textCopy [focus]}} \
4991 -accelerator $M1T-C \
4992 -font font_ui
4993.mbar.edit add command -label Paste \
4994 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4995 -accelerator $M1T-V \
4996 -font font_ui
4997.mbar.edit add command -label Delete \
4998 -command {catch {[focus] delete sel.first sel.last}} \
4999 -accelerator Del \
5000 -font font_ui
5001.mbar.edit add separator
5002.mbar.edit add command -label {Select All} \
5003 -command {catch {[focus] tag add sel 0.0 end}} \
5004 -accelerator $M1T-A \
5005 -font font_ui
5006# -- Branch Menu
5008#
5009if {!$single_commit} {
5010 menu .mbar.branch
5011 .mbar.branch add command -label {Create...} \
5013 -command do_create_branch \
5014 -accelerator $M1T-N \
5015 -font font_ui
5016 lappend disable_on_lock [list .mbar.branch entryconf \
5017 [.mbar.branch index last] -state]
5018 .mbar.branch add command -label {Delete...} \
5020 -command do_delete_branch \
5021 -font font_ui
5022 lappend disable_on_lock [list .mbar.branch entryconf \
5023 [.mbar.branch index last] -state]
5024}
5025# -- Commit Menu
5027#
5028menu .mbar.commit
5029.mbar.commit add radiobutton \
5031 -label {New Commit} \
5032 -command do_select_commit_type \
5033 -variable selected_commit_type \
5034 -value new \
5035 -font font_ui
5036lappend disable_on_lock \
5037 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5038.mbar.commit add radiobutton \
5040 -label {Amend Last Commit} \
5041 -command do_select_commit_type \
5042 -variable selected_commit_type \
5043 -value amend \
5044 -font font_ui
5045lappend disable_on_lock \
5046 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5047.mbar.commit add separator
5049.mbar.commit add command -label Rescan \
5051 -command do_rescan \
5052 -accelerator F5 \
5053 -font font_ui
5054lappend disable_on_lock \
5055 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5056.mbar.commit add command -label {Add To Commit} \
5058 -command do_add_selection \
5059 -font font_ui
5060lappend disable_on_lock \
5061 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5062.mbar.commit add command -label {Add All To Commit} \
5064 -command do_add_all \
5065 -accelerator $M1T-I \
5066 -font font_ui
5067lappend disable_on_lock \
5068 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5069.mbar.commit add command -label {Unstage From Commit} \
5071 -command do_unstage_selection \
5072 -font font_ui
5073lappend disable_on_lock \
5074 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5075.mbar.commit add command -label {Revert Changes} \
5077 -command do_revert_selection \
5078 -font font_ui
5079lappend disable_on_lock \
5080 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5081.mbar.commit add separator
5083.mbar.commit add command -label {Sign Off} \
5085 -command do_signoff \
5086 -accelerator $M1T-S \
5087 -font font_ui
5088.mbar.commit add command -label Commit \
5090 -command do_commit \
5091 -accelerator $M1T-Return \
5092 -font font_ui
5093lappend disable_on_lock \
5094 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5095if {[is_MacOSX]} {
5097 # -- Apple Menu (Mac OS X only)
5098 #
5099 .mbar add cascade -label Apple -menu .mbar.apple
5100 menu .mbar.apple
5101 .mbar.apple add command -label "About [appname]" \
5103 -command do_about \
5104 -font font_ui
5105 .mbar.apple add command -label "[appname] Options..." \
5106 -command do_options \
5107 -font font_ui
5108} else {
5109 # -- Edit Menu
5110 #
5111 .mbar.edit add separator
5112 .mbar.edit add command -label {Options...} \
5113 -command do_options \
5114 -font font_ui
5115 # -- Tools Menu
5117 #
5118 if {[file exists /usr/local/miga/lib/gui-miga]
5119 && [file exists .pvcsrc]} {
5120 proc do_miga {} {
5121 global ui_status_value
5122 if {![lock_index update]} return
5123 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5124 set miga_fd [open "|$cmd" r]
5125 fconfigure $miga_fd -blocking 0
5126 fileevent $miga_fd readable [list miga_done $miga_fd]
5127 set ui_status_value {Running miga...}
5128 }
5129 proc miga_done {fd} {
5130 read $fd 512
5131 if {[eof $fd]} {
5132 close $fd
5133 unlock_index
5134 rescan [list set ui_status_value {Ready.}]
5135 }
5136 }
5137 .mbar add cascade -label Tools -menu .mbar.tools
5138 menu .mbar.tools
5139 .mbar.tools add command -label "Migrate" \
5140 -command do_miga \
5141 -font font_ui
5142 lappend disable_on_lock \
5143 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5144 }
5145}
5146# -- Help Menu
5148#
5149.mbar add cascade -label Help -menu .mbar.help
5150menu .mbar.help
5151if {![is_MacOSX]} {
5153 .mbar.help add command -label "About [appname]" \
5154 -command do_about \
5155 -font font_ui
5156}
5157set browser {}
5159catch {set browser $repo_config(instaweb.browser)}
5160set doc_path [file dirname [gitexec]]
5161set doc_path [file join $doc_path Documentation index.html]
5162if {[is_Cygwin]} {
5164 set doc_path [exec cygpath --windows $doc_path]
5165}
5166if {$browser eq {}} {
5168 if {[is_MacOSX]} {
5169 set browser open
5170 } elseif {[is_Cygwin]} {
5171 set program_files [file dirname [exec cygpath --windir]]
5172 set program_files [file join $program_files {Program Files}]
5173 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5174 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5175 if {[file exists $firefox]} {
5176 set browser $firefox
5177 } elseif {[file exists $ie]} {
5178 set browser $ie
5179 }
5180 unset program_files firefox ie
5181 }
5182}
5183if {[file isfile $doc_path]} {
5185 set doc_url "file:$doc_path"
5186} else {
5187 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5188}
5189if {$browser ne {}} {
5191 .mbar.help add command -label {Online Documentation} \
5192 -command [list exec $browser $doc_url &] \
5193 -font font_ui
5194}
5195unset browser doc_path doc_url
5196# -- Branch Control
5198#
5199frame .branch \
5200 -borderwidth 1 \
5201 -relief sunken
5202label .branch.l1 \
5203 -text {Current Branch:} \
5204 -anchor w \
5205 -justify left \
5206 -font font_ui
5207label .branch.cb \
5208 -textvariable current_branch \
5209 -anchor w \
5210 -justify left \
5211 -font font_ui
5212pack .branch.l1 -side left
5213pack .branch.cb -side left -fill x
5214pack .branch -side top -fill x
5215if {!$single_commit} {
5217 menu .mbar.merge
5218 .mbar.merge add command -label {Local Merge...} \
5219 -command do_local_merge \
5220 -font font_ui
5221 lappend disable_on_lock \
5222 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5223 .mbar.merge add command -label {Abort Merge...} \
5224 -command do_reset_hard \
5225 -font font_ui
5226 lappend disable_on_lock \
5227 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5228 menu .mbar.fetch
5231 menu .mbar.push
5233 .mbar.push add command -label {Push...} \
5234 -command do_push_anywhere \
5235 -font font_ui
5236}
5237# -- Main Window Layout
5239#
5240panedwindow .vpane -orient vertical
5241panedwindow .vpane.files -orient horizontal
5242.vpane add .vpane.files -sticky nsew -height 100 -width 200
5243pack .vpane -anchor n -side top -fill both -expand 1
5244# -- Index File List
5246#
5247frame .vpane.files.index -height 100 -width 200
5248label .vpane.files.index.title -text {Changes To Be Committed} \
5249 -background green \
5250 -font font_ui
5251text $ui_index -background white -borderwidth 0 \
5252 -width 20 -height 10 \
5253 -wrap none \
5254 -font font_ui \
5255 -cursor $cursor_ptr \
5256 -xscrollcommand {.vpane.files.index.sx set} \
5257 -yscrollcommand {.vpane.files.index.sy set} \
5258 -state disabled
5259scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5260scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5261pack .vpane.files.index.title -side top -fill x
5262pack .vpane.files.index.sx -side bottom -fill x
5263pack .vpane.files.index.sy -side right -fill y
5264pack $ui_index -side left -fill both -expand 1
5265.vpane.files add .vpane.files.index -sticky nsew
5266# -- Working Directory File List
5268#
5269frame .vpane.files.workdir -height 100 -width 200
5270label .vpane.files.workdir.title -text {Changed But Not Updated} \
5271 -background red \
5272 -font font_ui
5273text $ui_workdir -background white -borderwidth 0 \
5274 -width 20 -height 10 \
5275 -wrap none \
5276 -font font_ui \
5277 -cursor $cursor_ptr \
5278 -xscrollcommand {.vpane.files.workdir.sx set} \
5279 -yscrollcommand {.vpane.files.workdir.sy set} \
5280 -state disabled
5281scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5282scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5283pack .vpane.files.workdir.title -side top -fill x
5284pack .vpane.files.workdir.sx -side bottom -fill x
5285pack .vpane.files.workdir.sy -side right -fill y
5286pack $ui_workdir -side left -fill both -expand 1
5287.vpane.files add .vpane.files.workdir -sticky nsew
5288foreach i [list $ui_index $ui_workdir] {
5290 $i tag conf in_diff -font font_uibold
5291 $i tag conf in_sel \
5292 -background [$i cget -foreground] \
5293 -foreground [$i cget -background]
5294}
5295unset i
5296# -- Diff and Commit Area
5298#
5299frame .vpane.lower -height 300 -width 400
5300frame .vpane.lower.commarea
5301frame .vpane.lower.diff -relief sunken -borderwidth 1
5302pack .vpane.lower.commarea -side top -fill x
5303pack .vpane.lower.diff -side bottom -fill both -expand 1
5304.vpane add .vpane.lower -sticky nsew
5305# -- Commit Area Buttons
5307#
5308frame .vpane.lower.commarea.buttons
5309label .vpane.lower.commarea.buttons.l -text {} \
5310 -anchor w \
5311 -justify left \
5312 -font font_ui
5313pack .vpane.lower.commarea.buttons.l -side top -fill x
5314pack .vpane.lower.commarea.buttons -side left -fill y
5315button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5317 -command do_rescan \
5318 -font font_ui
5319pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5320lappend disable_on_lock \
5321 {.vpane.lower.commarea.buttons.rescan conf -state}
5322button .vpane.lower.commarea.buttons.incall -text {Add All} \
5324 -command do_add_all \
5325 -font font_ui
5326pack .vpane.lower.commarea.buttons.incall -side top -fill x
5327lappend disable_on_lock \
5328 {.vpane.lower.commarea.buttons.incall conf -state}
5329button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5331 -command do_signoff \
5332 -font font_ui
5333pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5334button .vpane.lower.commarea.buttons.commit -text {Commit} \
5336 -command do_commit \
5337 -font font_ui
5338pack .vpane.lower.commarea.buttons.commit -side top -fill x
5339lappend disable_on_lock \
5340 {.vpane.lower.commarea.buttons.commit conf -state}
5341# -- Commit Message Buffer
5343#
5344frame .vpane.lower.commarea.buffer
5345frame .vpane.lower.commarea.buffer.header
5346set ui_comm .vpane.lower.commarea.buffer.t
5347set ui_coml .vpane.lower.commarea.buffer.header.l
5348radiobutton .vpane.lower.commarea.buffer.header.new \
5349 -text {New Commit} \
5350 -command do_select_commit_type \
5351 -variable selected_commit_type \
5352 -value new \
5353 -font font_ui
5354lappend disable_on_lock \
5355 [list .vpane.lower.commarea.buffer.header.new conf -state]
5356radiobutton .vpane.lower.commarea.buffer.header.amend \
5357 -text {Amend Last Commit} \
5358 -command do_select_commit_type \
5359 -variable selected_commit_type \
5360 -value amend \
5361 -font font_ui
5362lappend disable_on_lock \
5363 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5364label $ui_coml \
5365 -anchor w \
5366 -justify left \
5367 -font font_ui
5368proc trace_commit_type {varname args} {
5369 global ui_coml commit_type
5370 switch -glob -- $commit_type {
5371 initial {set txt {Initial Commit Message:}}
5372 amend {set txt {Amended Commit Message:}}
5373 amend-initial {set txt {Amended Initial Commit Message:}}
5374 amend-merge {set txt {Amended Merge Commit Message:}}
5375 merge {set txt {Merge Commit Message:}}
5376 * {set txt {Commit Message:}}
5377 }
5378 $ui_coml conf -text $txt
5379}
5380trace add variable commit_type write trace_commit_type
5381pack $ui_coml -side left -fill x
5382pack .vpane.lower.commarea.buffer.header.amend -side right
5383pack .vpane.lower.commarea.buffer.header.new -side right
5384text $ui_comm -background white -borderwidth 1 \
5386 -undo true \
5387 -maxundo 20 \
5388 -autoseparators true \
5389 -relief sunken \
5390 -width 75 -height 9 -wrap none \
5391 -font font_diff \
5392 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5393scrollbar .vpane.lower.commarea.buffer.sby \
5394 -command [list $ui_comm yview]
5395pack .vpane.lower.commarea.buffer.header -side top -fill x
5396pack .vpane.lower.commarea.buffer.sby -side right -fill y
5397pack $ui_comm -side left -fill y
5398pack .vpane.lower.commarea.buffer -side left -fill y
5399# -- Commit Message Buffer Context Menu
5401#
5402set ctxm .vpane.lower.commarea.buffer.ctxm
5403menu $ctxm -tearoff 0
5404$ctxm add command \
5405 -label {Cut} \
5406 -font font_ui \
5407 -command {tk_textCut $ui_comm}
5408$ctxm add command \
5409 -label {Copy} \
5410 -font font_ui \
5411 -command {tk_textCopy $ui_comm}
5412$ctxm add command \
5413 -label {Paste} \
5414 -font font_ui \
5415 -command {tk_textPaste $ui_comm}
5416$ctxm add command \
5417 -label {Delete} \
5418 -font font_ui \
5419 -command {$ui_comm delete sel.first sel.last}
5420$ctxm add separator
5421$ctxm add command \
5422 -label {Select All} \
5423 -font font_ui \
5424 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5425$ctxm add command \
5426 -label {Copy All} \
5427 -font font_ui \
5428 -command {
5429 $ui_comm tag add sel 0.0 end
5430 tk_textCopy $ui_comm
5431 $ui_comm tag remove sel 0.0 end
5432 }
5433$ctxm add separator
5434$ctxm add command \
5435 -label {Sign Off} \
5436 -font font_ui \
5437 -command do_signoff
5438bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5439# -- Diff Header
5441#
5442set current_diff_path {}
5443set current_diff_side {}
5444set diff_actions [list]
5445proc trace_current_diff_path {varname args} {
5446 global current_diff_path diff_actions file_states
5447 if {$current_diff_path eq {}} {
5448 set s {}
5449 set f {}
5450 set p {}
5451 set o disabled
5452 } else {
5453 set p $current_diff_path
5454 set s [mapdesc [lindex $file_states($p) 0] $p]
5455 set f {File:}
5456 set p [escape_path $p]
5457 set o normal
5458 }
5459 .vpane.lower.diff.header.status configure -text $s
5461 .vpane.lower.diff.header.file configure -text $f
5462 .vpane.lower.diff.header.path configure -text $p
5463 foreach w $diff_actions {
5464 uplevel #0 $w $o
5465 }
5466}
5467trace add variable current_diff_path write trace_current_diff_path
5468frame .vpane.lower.diff.header -background orange
5470label .vpane.lower.diff.header.status \
5471 -background orange \
5472 -width $max_status_desc \
5473 -anchor w \
5474 -justify left \
5475 -font font_ui
5476label .vpane.lower.diff.header.file \
5477 -background orange \
5478 -anchor w \
5479 -justify left \
5480 -font font_ui
5481label .vpane.lower.diff.header.path \
5482 -background orange \
5483 -anchor w \
5484 -justify left \
5485 -font font_ui
5486pack .vpane.lower.diff.header.status -side left
5487pack .vpane.lower.diff.header.file -side left
5488pack .vpane.lower.diff.header.path -fill x
5489set ctxm .vpane.lower.diff.header.ctxm
5490menu $ctxm -tearoff 0
5491$ctxm add command \
5492 -label {Copy} \
5493 -font font_ui \
5494 -command {
5495 clipboard clear
5496 clipboard append \
5497 -format STRING \
5498 -type STRING \
5499 -- $current_diff_path
5500 }
5501lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5502bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5503# -- Diff Body
5505#
5506frame .vpane.lower.diff.body
5507set ui_diff .vpane.lower.diff.body.t
5508text $ui_diff -background white -borderwidth 0 \
5509 -width 80 -height 15 -wrap none \
5510 -font font_diff \
5511 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5512 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5513 -state disabled
5514scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5515 -command [list $ui_diff xview]
5516scrollbar .vpane.lower.diff.body.sby -orient vertical \
5517 -command [list $ui_diff yview]
5518pack .vpane.lower.diff.body.sbx -side bottom -fill x
5519pack .vpane.lower.diff.body.sby -side right -fill y
5520pack $ui_diff -side left -fill both -expand 1
5521pack .vpane.lower.diff.header -side top -fill x
5522pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5523$ui_diff tag conf d_cr -elide true
5525$ui_diff tag conf d_@ -foreground blue -font font_diffbold
5526$ui_diff tag conf d_+ -foreground {#00a000}
5527$ui_diff tag conf d_- -foreground red
5528$ui_diff tag conf d_++ -foreground {#00a000}
5530$ui_diff tag conf d_-- -foreground red
5531$ui_diff tag conf d_+s \
5532 -foreground {#00a000} \
5533 -background {#e2effa}
5534$ui_diff tag conf d_-s \
5535 -foreground red \
5536 -background {#e2effa}
5537$ui_diff tag conf d_s+ \
5538 -foreground {#00a000} \
5539 -background ivory1
5540$ui_diff tag conf d_s- \
5541 -foreground red \
5542 -background ivory1
5543$ui_diff tag conf d<<<<<<< \
5545 -foreground orange \
5546 -font font_diffbold
5547$ui_diff tag conf d======= \
5548 -foreground orange \
5549 -font font_diffbold
5550$ui_diff tag conf d>>>>>>> \
5551 -foreground orange \
5552 -font font_diffbold
5553$ui_diff tag raise sel
5555# -- Diff Body Context Menu
5557#
5558set ctxm .vpane.lower.diff.body.ctxm
5559menu $ctxm -tearoff 0
5560$ctxm add command \
5561 -label {Refresh} \
5562 -font font_ui \
5563 -command reshow_diff
5564lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5565$ctxm add command \
5566 -label {Copy} \
5567 -font font_ui \
5568 -command {tk_textCopy $ui_diff}
5569lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5570$ctxm add command \
5571 -label {Select All} \
5572 -font font_ui \
5573 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5574lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5575$ctxm add command \
5576 -label {Copy All} \
5577 -font font_ui \
5578 -command {
5579 $ui_diff tag add sel 0.0 end
5580 tk_textCopy $ui_diff
5581 $ui_diff tag remove sel 0.0 end
5582 }
5583lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5584$ctxm add separator
5585$ctxm add command \
5586 -label {Apply/Reverse Hunk} \
5587 -font font_ui \
5588 -command {apply_hunk $cursorX $cursorY}
5589set ui_diff_applyhunk [$ctxm index last]
5590lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5591$ctxm add separator
5592$ctxm add command \
5593 -label {Decrease Font Size} \
5594 -font font_ui \
5595 -command {incr_font_size font_diff -1}
5596lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5597$ctxm add command \
5598 -label {Increase Font Size} \
5599 -font font_ui \
5600 -command {incr_font_size font_diff 1}
5601lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5602$ctxm add separator
5603$ctxm add command \
5604 -label {Show Less Context} \
5605 -font font_ui \
5606 -command {if {$repo_config(gui.diffcontext) >= 2} {
5607 incr repo_config(gui.diffcontext) -1
5608 reshow_diff
5609 }}
5610lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5611$ctxm add command \
5612 -label {Show More Context} \
5613 -font font_ui \
5614 -command {
5615 incr repo_config(gui.diffcontext)
5616 reshow_diff
5617 }
5618lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5619$ctxm add separator
5620$ctxm add command -label {Options...} \
5621 -font font_ui \
5622 -command do_options
5623bind_button3 $ui_diff "
5624 set cursorX %x
5625 set cursorY %y
5626 if {\$ui_index eq \$current_diff_side} {
5627 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5628 } else {
5629 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5630 }
5631 tk_popup $ctxm %X %Y
5632"
5633unset ui_diff_applyhunk
5634# -- Status Bar
5636#
5637set ui_status_value {Initializing...}
5638label .status -textvariable ui_status_value \
5639 -anchor w \
5640 -justify left \
5641 -borderwidth 1 \
5642 -relief sunken \
5643 -font font_ui
5644pack .status -anchor w -side bottom -fill x
5645# -- Load geometry
5647#
5648catch {
5649set gm $repo_config(gui.geometry)
5650wm geometry . [lindex $gm 0]
5651.vpane sash place 0 \
5652 [lindex [.vpane sash coord 0] 0] \
5653 [lindex $gm 1]
5654.vpane.files sash place 0 \
5655 [lindex $gm 2] \
5656 [lindex [.vpane.files sash coord 0] 1]
5657unset gm
5658}
5659# -- Key Bindings
5661#
5662bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5663bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5664bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5665bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5666bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5667bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5668bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5669bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5670bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5671bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5672bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5673bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5675bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5676bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5677bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5678bind $ui_diff <$M1B-Key-v> {break}
5679bind $ui_diff <$M1B-Key-V> {break}
5680bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5681bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5682bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5683bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5684bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5685bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5686bind $ui_diff <Button-1> {focus %W}
5687if {!$single_commit} {
5689 bind . <$M1B-Key-n> do_create_branch
5690 bind . <$M1B-Key-N> do_create_branch
5691}
5692bind . <Destroy> do_quit
5694bind all <Key-F5> do_rescan
5695bind all <$M1B-Key-r> do_rescan
5696bind all <$M1B-Key-R> do_rescan
5697bind . <$M1B-Key-s> do_signoff
5698bind . <$M1B-Key-S> do_signoff
5699bind . <$M1B-Key-i> do_add_all
5700bind . <$M1B-Key-I> do_add_all
5701bind . <$M1B-Key-Return> do_commit
5702bind all <$M1B-Key-q> do_quit
5703bind all <$M1B-Key-Q> do_quit
5704bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5705bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5706foreach i [list $ui_index $ui_workdir] {
5707 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
5708 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5709 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5710}
5711unset i
5712set file_lists($ui_index) [list]
5714set file_lists($ui_workdir) [list]
5715set HEAD {}
5717set PARENT {}
5718set MERGE_HEAD [list]
5719set commit_type {}
5720set empty_tree {}
5721set current_branch {}
5722set current_diff_path {}
5723set selected_commit_type new
5724wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5726focus -force $ui_comm
5727# -- Warn the user about environmental problems. Cygwin's Tcl
5729# does *not* pass its env array onto any processes it spawns.
5730# This means that git processes get none of our environment.
5731#
5732if {[is_Cygwin]} {
5733 set ignored_env 0
5734 set suggest_user {}
5735 set msg "Possible environment issues exist.
5736The following environment variables are probably
5738going to be ignored by any Git subprocess run
5739by [appname]:
5740"
5742 foreach name [array names env] {
5743 switch -regexp -- $name {
5744 {^GIT_INDEX_FILE$} -
5745 {^GIT_OBJECT_DIRECTORY$} -
5746 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5747 {^GIT_DIFF_OPTS$} -
5748 {^GIT_EXTERNAL_DIFF$} -
5749 {^GIT_PAGER$} -
5750 {^GIT_TRACE$} -
5751 {^GIT_CONFIG$} -
5752 {^GIT_CONFIG_LOCAL$} -
5753 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5754 append msg " - $name\n"
5755 incr ignored_env
5756 }
5757 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5758 append msg " - $name\n"
5759 incr ignored_env
5760 set suggest_user $name
5761 }
5762 }
5763 }
5764 if {$ignored_env > 0} {
5765 append msg "
5766This is due to a known issue with the
5767Tcl binary distributed by Cygwin."
5768 if {$suggest_user ne {}} {
5770 append msg "
5771A good replacement for $suggest_user
5773is placing values for the user.name and
5774user.email settings into your personal
5775~/.gitconfig file.
5776"
5777 }
5778 warn_popup $msg
5779 }
5780 unset ignored_env msg suggest_user name
5781}
5782# -- Only initialize complex UI if we are going to stay running.
5784#
5785if {!$single_commit} {
5786 load_all_remotes
5787 load_all_heads
5788 populate_branch_menu
5790 populate_fetch_menu
5791 populate_push_menu
5792}
5793# -- Only suggest a gc run if we are going to stay running.
5795#
5796if {!$single_commit} {
5797 set object_limit 2000
5798 if {[is_Windows]} {set object_limit 200}
5799 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5800 if {$objects_current >= $object_limit} {
5801 if {[ask_popup \
5802 "This repository currently has $objects_current loose objects.
5803To maintain optimal performance it is strongly
5805recommended that you compress the database
5806when more than $object_limit loose objects exist.
5807Compress the database now?"] eq yes} {
5809 do_gc
5810 }
5811 }
5812 unset object_limit _junk objects_current
5813}
5814lock_index begin-read
5816after 1 do_rescan