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 {\\} $path "\\\\" path
1385 regsub -all "\n" $path "\\n" path
1386 return $path
1387}
1388proc short_path {path} {
1390 return [escape_path [lindex [file split $path] end]]
1391}
1392set next_icon_id 0
1394set null_sha1 [string repeat 0 40]
1395proc merge_state {path new_state {head_info {}} {index_info {}}} {
1397 global file_states next_icon_id null_sha1
1398 set s0 [string index $new_state 0]
1400 set s1 [string index $new_state 1]
1401 if {[catch {set info $file_states($path)}]} {
1403 set state __
1404 set icon n[incr next_icon_id]
1405 } else {
1406 set state [lindex $info 0]
1407 set icon [lindex $info 1]
1408 if {$head_info eq {}} {set head_info [lindex $info 2]}
1409 if {$index_info eq {}} {set index_info [lindex $info 3]}
1410 }
1411 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1413 elseif {$s0 eq {_}} {set s0 _}
1414 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1416 elseif {$s1 eq {_}} {set s1 _}
1417 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1419 set head_info [list 0 $null_sha1]
1420 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1421 && $head_info eq {}} {
1422 set head_info $index_info
1423 }
1424 set file_states($path) [list $s0$s1 $icon \
1426 $head_info $index_info \
1427 ]
1428 return $state
1429}
1430proc display_file_helper {w path icon_name old_m new_m} {
1432 global file_lists
1433 if {$new_m eq {_}} {
1435 set lno [lsearch -sorted -exact $file_lists($w) $path]
1436 if {$lno >= 0} {
1437 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1438 incr lno
1439 $w conf -state normal
1440 $w delete $lno.0 [expr {$lno + 1}].0
1441 $w conf -state disabled
1442 }
1443 } elseif {$old_m eq {_} && $new_m ne {_}} {
1444 lappend file_lists($w) $path
1445 set file_lists($w) [lsort -unique $file_lists($w)]
1446 set lno [lsearch -sorted -exact $file_lists($w) $path]
1447 incr lno
1448 $w conf -state normal
1449 $w image create $lno.0 \
1450 -align center -padx 5 -pady 1 \
1451 -name $icon_name \
1452 -image [mapicon $w $new_m $path]
1453 $w insert $lno.1 "[escape_path $path]\n"
1454 $w conf -state disabled
1455 } elseif {$old_m ne $new_m} {
1456 $w conf -state normal
1457 $w image conf $icon_name -image [mapicon $w $new_m $path]
1458 $w conf -state disabled
1459 }
1460}
1461proc display_file {path state} {
1463 global file_states selected_paths
1464 global ui_index ui_workdir
1465 set old_m [merge_state $path $state]
1467 set s $file_states($path)
1468 set new_m [lindex $s 0]
1469 set icon_name [lindex $s 1]
1470 set o [string index $old_m 0]
1472 set n [string index $new_m 0]
1473 if {$o eq {U}} {
1474 set o _
1475 }
1476 if {$n eq {U}} {
1477 set n _
1478 }
1479 display_file_helper $ui_index $path $icon_name $o $n
1480 if {[string index $old_m 0] eq {U}} {
1482 set o U
1483 } else {
1484 set o [string index $old_m 1]
1485 }
1486 if {[string index $new_m 0] eq {U}} {
1487 set n U
1488 } else {
1489 set n [string index $new_m 1]
1490 }
1491 display_file_helper $ui_workdir $path $icon_name $o $n
1492 if {$new_m eq {__}} {
1494 unset file_states($path)
1495 catch {unset selected_paths($path)}
1496 }
1497}
1498proc display_all_files_helper {w path icon_name m} {
1500 global file_lists
1501 lappend file_lists($w) $path
1503 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1504 $w image create end \
1505 -align center -padx 5 -pady 1 \
1506 -name $icon_name \
1507 -image [mapicon $w $m $path]
1508 $w insert end "[escape_path $path]\n"
1509}
1510proc display_all_files {} {
1512 global ui_index ui_workdir
1513 global file_states file_lists
1514 global last_clicked
1515 $ui_index conf -state normal
1517 $ui_workdir conf -state normal
1518 $ui_index delete 0.0 end
1520 $ui_workdir delete 0.0 end
1521 set last_clicked {}
1522 set file_lists($ui_index) [list]
1524 set file_lists($ui_workdir) [list]
1525 foreach path [lsort [array names file_states]] {
1527 set s $file_states($path)
1528 set m [lindex $s 0]
1529 set icon_name [lindex $s 1]
1530 set s [string index $m 0]
1532 if {$s ne {U} && $s ne {_}} {
1533 display_all_files_helper $ui_index $path \
1534 $icon_name $s
1535 }
1536 if {[string index $m 0] eq {U}} {
1538 set s U
1539 } else {
1540 set s [string index $m 1]
1541 }
1542 if {$s ne {_}} {
1543 display_all_files_helper $ui_workdir $path \
1544 $icon_name $s
1545 }
1546 }
1547 $ui_index conf -state disabled
1549 $ui_workdir conf -state disabled
1550}
1551proc update_indexinfo {msg pathList after} {
1553 global update_index_cp ui_status_value
1554 if {![lock_index update]} return
1556 set update_index_cp 0
1558 set pathList [lsort $pathList]
1559 set totalCnt [llength $pathList]
1560 set batch [expr {int($totalCnt * .01) + 1}]
1561 if {$batch > 25} {set batch 25}
1562 set ui_status_value [format \
1564 "$msg... %i/%i files (%.2f%%)" \
1565 $update_index_cp \
1566 $totalCnt \
1567 0.0]
1568 set fd [open "| git update-index -z --index-info" w]
1569 fconfigure $fd \
1570 -blocking 0 \
1571 -buffering full \
1572 -buffersize 512 \
1573 -encoding binary \
1574 -translation binary
1575 fileevent $fd writable [list \
1576 write_update_indexinfo \
1577 $fd \
1578 $pathList \
1579 $totalCnt \
1580 $batch \
1581 $msg \
1582 $after \
1583 ]
1584}
1585proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1587 global update_index_cp ui_status_value
1588 global file_states current_diff_path
1589 if {$update_index_cp >= $totalCnt} {
1591 close $fd
1592 unlock_index
1593 uplevel #0 $after
1594 return
1595 }
1596 for {set i $batch} \
1598 {$update_index_cp < $totalCnt && $i > 0} \
1599 {incr i -1} {
1600 set path [lindex $pathList $update_index_cp]
1601 incr update_index_cp
1602 set s $file_states($path)
1604 switch -glob -- [lindex $s 0] {
1605 A? {set new _O}
1606 M? {set new _M}
1607 D_ {set new _D}
1608 D? {set new _?}
1609 ?? {continue}
1610 }
1611 set info [lindex $s 2]
1612 if {$info eq {}} continue
1613 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1615 display_file $path $new
1616 }
1617 set ui_status_value [format \
1619 "$msg... %i/%i files (%.2f%%)" \
1620 $update_index_cp \
1621 $totalCnt \
1622 [expr {100.0 * $update_index_cp / $totalCnt}]]
1623}
1624proc update_index {msg pathList after} {
1626 global update_index_cp ui_status_value
1627 if {![lock_index update]} return
1629 set update_index_cp 0
1631 set pathList [lsort $pathList]
1632 set totalCnt [llength $pathList]
1633 set batch [expr {int($totalCnt * .01) + 1}]
1634 if {$batch > 25} {set batch 25}
1635 set ui_status_value [format \
1637 "$msg... %i/%i files (%.2f%%)" \
1638 $update_index_cp \
1639 $totalCnt \
1640 0.0]
1641 set fd [open "| git update-index --add --remove -z --stdin" w]
1642 fconfigure $fd \
1643 -blocking 0 \
1644 -buffering full \
1645 -buffersize 512 \
1646 -encoding binary \
1647 -translation binary
1648 fileevent $fd writable [list \
1649 write_update_index \
1650 $fd \
1651 $pathList \
1652 $totalCnt \
1653 $batch \
1654 $msg \
1655 $after \
1656 ]
1657}
1658proc write_update_index {fd pathList totalCnt batch msg after} {
1660 global update_index_cp ui_status_value
1661 global file_states current_diff_path
1662 if {$update_index_cp >= $totalCnt} {
1664 close $fd
1665 unlock_index
1666 uplevel #0 $after
1667 return
1668 }
1669 for {set i $batch} \
1671 {$update_index_cp < $totalCnt && $i > 0} \
1672 {incr i -1} {
1673 set path [lindex $pathList $update_index_cp]
1674 incr update_index_cp
1675 switch -glob -- [lindex $file_states($path) 0] {
1677 AD {set new __}
1678 ?D {set new D_}
1679 _O -
1680 AM {set new A_}
1681 U? {
1682 if {[file exists $path]} {
1683 set new M_
1684 } else {
1685 set new D_
1686 }
1687 }
1688 ?M {set new M_}
1689 ?? {continue}
1690 }
1691 puts -nonewline $fd "[encoding convertto $path]\0"
1692 display_file $path $new
1693 }
1694 set ui_status_value [format \
1696 "$msg... %i/%i files (%.2f%%)" \
1697 $update_index_cp \
1698 $totalCnt \
1699 [expr {100.0 * $update_index_cp / $totalCnt}]]
1700}
1701proc checkout_index {msg pathList after} {
1703 global update_index_cp ui_status_value
1704 if {![lock_index update]} return
1706 set update_index_cp 0
1708 set pathList [lsort $pathList]
1709 set totalCnt [llength $pathList]
1710 set batch [expr {int($totalCnt * .01) + 1}]
1711 if {$batch > 25} {set batch 25}
1712 set ui_status_value [format \
1714 "$msg... %i/%i files (%.2f%%)" \
1715 $update_index_cp \
1716 $totalCnt \
1717 0.0]
1718 set cmd [list git checkout-index]
1719 lappend cmd --index
1720 lappend cmd --quiet
1721 lappend cmd --force
1722 lappend cmd -z
1723 lappend cmd --stdin
1724 set fd [open "| $cmd " w]
1725 fconfigure $fd \
1726 -blocking 0 \
1727 -buffering full \
1728 -buffersize 512 \
1729 -encoding binary \
1730 -translation binary
1731 fileevent $fd writable [list \
1732 write_checkout_index \
1733 $fd \
1734 $pathList \
1735 $totalCnt \
1736 $batch \
1737 $msg \
1738 $after \
1739 ]
1740}
1741proc write_checkout_index {fd pathList totalCnt batch msg after} {
1743 global update_index_cp ui_status_value
1744 global file_states current_diff_path
1745 if {$update_index_cp >= $totalCnt} {
1747 close $fd
1748 unlock_index
1749 uplevel #0 $after
1750 return
1751 }
1752 for {set i $batch} \
1754 {$update_index_cp < $totalCnt && $i > 0} \
1755 {incr i -1} {
1756 set path [lindex $pathList $update_index_cp]
1757 incr update_index_cp
1758 switch -glob -- [lindex $file_states($path) 0] {
1759 U? {continue}
1760 ?M -
1761 ?D {
1762 puts -nonewline $fd "[encoding convertto $path]\0"
1763 display_file $path ?_
1764 }
1765 }
1766 }
1767 set ui_status_value [format \
1769 "$msg... %i/%i files (%.2f%%)" \
1770 $update_index_cp \
1771 $totalCnt \
1772 [expr {100.0 * $update_index_cp / $totalCnt}]]
1773}
1774######################################################################
1776##
1777## branch management
1778proc is_tracking_branch {name} {
1780 global tracking_branches
1781 if {![catch {set info $tracking_branches($name)}]} {
1783 return 1
1784 }
1785 foreach t [array names tracking_branches] {
1786 if {[string match {*/\*} $t] && [string match $t $name]} {
1787 return 1
1788 }
1789 }
1790 return 0
1791}
1792proc load_all_heads {} {
1794 global all_heads
1795 set all_heads [list]
1797 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1798 while {[gets $fd line] > 0} {
1799 if {[is_tracking_branch $line]} continue
1800 if {![regsub ^refs/heads/ $line {} name]} continue
1801 lappend all_heads $name
1802 }
1803 close $fd
1804 set all_heads [lsort $all_heads]
1806}
1807proc populate_branch_menu {} {
1809 global all_heads disable_on_lock
1810 set m .mbar.branch
1812 set last [$m index last]
1813 for {set i 0} {$i <= $last} {incr i} {
1814 if {[$m type $i] eq {separator}} {
1815 $m delete $i last
1816 set new_dol [list]
1817 foreach a $disable_on_lock {
1818 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1819 lappend new_dol $a
1820 }
1821 }
1822 set disable_on_lock $new_dol
1823 break
1824 }
1825 }
1826 if {$all_heads ne {}} {
1828 $m add separator
1829 }
1830 foreach b $all_heads {
1831 $m add radiobutton \
1832 -label $b \
1833 -command [list switch_branch $b] \
1834 -variable current_branch \
1835 -value $b \
1836 -font font_ui
1837 lappend disable_on_lock \
1838 [list $m entryconf [$m index last] -state]
1839 }
1840}
1841proc all_tracking_branches {} {
1843 global tracking_branches
1844 set all_trackings {}
1846 set cmd {}
1847 foreach name [array names tracking_branches] {
1848 if {[regsub {/\*$} $name {} name]} {
1849 lappend cmd $name
1850 } else {
1851 regsub ^refs/(heads|remotes)/ $name {} name
1852 lappend all_trackings $name
1853 }
1854 }
1855 if {$cmd ne {}} {
1857 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1858 while {[gets $fd name] > 0} {
1859 regsub ^refs/(heads|remotes)/ $name {} name
1860 lappend all_trackings $name
1861 }
1862 close $fd
1863 }
1864 return [lsort -unique $all_trackings]
1866}
1867proc do_create_branch_action {w} {
1869 global all_heads null_sha1 repo_config
1870 global create_branch_checkout create_branch_revtype
1871 global create_branch_head create_branch_trackinghead
1872 global create_branch_name create_branch_revexp
1873 set newbranch $create_branch_name
1875 if {$newbranch eq {}
1876 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1877 tk_messageBox \
1878 -icon error \
1879 -type ok \
1880 -title [wm title $w] \
1881 -parent $w \
1882 -message "Please supply a branch name."
1883 focus $w.desc.name_t
1884 return
1885 }
1886 if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1887 tk_messageBox \
1888 -icon error \
1889 -type ok \
1890 -title [wm title $w] \
1891 -parent $w \
1892 -message "Branch '$newbranch' already exists."
1893 focus $w.desc.name_t
1894 return
1895 }
1896 if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1897 tk_messageBox \
1898 -icon error \
1899 -type ok \
1900 -title [wm title $w] \
1901 -parent $w \
1902 -message "We do not like '$newbranch' as a branch name."
1903 focus $w.desc.name_t
1904 return
1905 }
1906 set rev {}
1908 switch -- $create_branch_revtype {
1909 head {set rev $create_branch_head}
1910 tracking {set rev $create_branch_trackinghead}
1911 expression {set rev $create_branch_revexp}
1912 }
1913 if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1914 tk_messageBox \
1915 -icon error \
1916 -type ok \
1917 -title [wm title $w] \
1918 -parent $w \
1919 -message "Invalid starting revision: $rev"
1920 return
1921 }
1922 set cmd [list git update-ref]
1923 lappend cmd -m
1924 lappend cmd "branch: Created from $rev"
1925 lappend cmd "refs/heads/$newbranch"
1926 lappend cmd $cmt
1927 lappend cmd $null_sha1
1928 if {[catch {eval exec $cmd} err]} {
1929 tk_messageBox \
1930 -icon error \
1931 -type ok \
1932 -title [wm title $w] \
1933 -parent $w \
1934 -message "Failed to create '$newbranch'.\n\n$err"
1935 return
1936 }
1937 lappend all_heads $newbranch
1939 set all_heads [lsort $all_heads]
1940 populate_branch_menu
1941 destroy $w
1942 if {$create_branch_checkout} {
1943 switch_branch $newbranch
1944 }
1945}
1946proc radio_selector {varname value args} {
1948 upvar #0 $varname var
1949 set var $value
1950}
1951trace add variable create_branch_head write \
1953 [list radio_selector create_branch_revtype head]
1954trace add variable create_branch_trackinghead write \
1955 [list radio_selector create_branch_revtype tracking]
1956trace add variable delete_branch_head write \
1958 [list radio_selector delete_branch_checktype head]
1959trace add variable delete_branch_trackinghead write \
1960 [list radio_selector delete_branch_checktype tracking]
1961proc do_create_branch {} {
1963 global all_heads current_branch repo_config
1964 global create_branch_checkout create_branch_revtype
1965 global create_branch_head create_branch_trackinghead
1966 global create_branch_name create_branch_revexp
1967 set w .branch_editor
1969 toplevel $w
1970 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1971 label $w.header -text {Create New Branch} \
1973 -font font_uibold
1974 pack $w.header -side top -fill x
1975 frame $w.buttons
1977 button $w.buttons.create -text Create \
1978 -font font_ui \
1979 -default active \
1980 -command [list do_create_branch_action $w]
1981 pack $w.buttons.create -side right
1982 button $w.buttons.cancel -text {Cancel} \
1983 -font font_ui \
1984 -command [list destroy $w]
1985 pack $w.buttons.cancel -side right -padx 5
1986 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1987 labelframe $w.desc \
1989 -text {Branch Description} \
1990 -font font_ui
1991 label $w.desc.name_l -text {Name:} -font font_ui
1992 entry $w.desc.name_t \
1993 -borderwidth 1 \
1994 -relief sunken \
1995 -width 40 \
1996 -textvariable create_branch_name \
1997 -font font_ui \
1998 -validate key \
1999 -validatecommand {
2000 if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2001 return 1
2002 }
2003 grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2004 grid columnconfigure $w.desc 1 -weight 1
2005 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2006 labelframe $w.from \
2008 -text {Starting Revision} \
2009 -font font_ui
2010 radiobutton $w.from.head_r \
2011 -text {Local Branch:} \
2012 -value head \
2013 -variable create_branch_revtype \
2014 -font font_ui
2015 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2016 grid $w.from.head_r $w.from.head_m -sticky w
2017 set all_trackings [all_tracking_branches]
2018 if {$all_trackings ne {}} {
2019 set create_branch_trackinghead [lindex $all_trackings 0]
2020 radiobutton $w.from.tracking_r \
2021 -text {Tracking Branch:} \
2022 -value tracking \
2023 -variable create_branch_revtype \
2024 -font font_ui
2025 eval tk_optionMenu $w.from.tracking_m \
2026 create_branch_trackinghead \
2027 $all_trackings
2028 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2029 }
2030 radiobutton $w.from.exp_r \
2031 -text {Revision Expression:} \
2032 -value expression \
2033 -variable create_branch_revtype \
2034 -font font_ui
2035 entry $w.from.exp_t \
2036 -borderwidth 1 \
2037 -relief sunken \
2038 -width 50 \
2039 -textvariable create_branch_revexp \
2040 -font font_ui \
2041 -validate key \
2042 -validatecommand {
2043 if {%d == 1 && [regexp {\s} %S]} {return 0}
2044 if {%d == 1 && [string length %S] > 0} {
2045 set create_branch_revtype expression
2046 }
2047 return 1
2048 }
2049 grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2050 grid columnconfigure $w.from 1 -weight 1
2051 pack $w.from -anchor nw -fill x -pady 5 -padx 5
2052 labelframe $w.postActions \
2054 -text {Post Creation Actions} \
2055 -font font_ui
2056 checkbutton $w.postActions.checkout \
2057 -text {Checkout after creation} \
2058 -variable create_branch_checkout \
2059 -font font_ui
2060 pack $w.postActions.checkout -anchor nw
2061 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2062 set create_branch_checkout 1
2064 set create_branch_head $current_branch
2065 set create_branch_revtype head
2066 set create_branch_name $repo_config(gui.newbranchtemplate)
2067 set create_branch_revexp {}
2068 bind $w <Visibility> "
2070 grab $w
2071 $w.desc.name_t icursor end
2072 focus $w.desc.name_t
2073 "
2074 bind $w <Key-Escape> "destroy $w"
2075 bind $w <Key-Return> "do_create_branch_action $w;break"
2076 wm title $w "[appname] ([reponame]): Create Branch"
2077 tkwait window $w
2078}
2079proc do_delete_branch_action {w} {
2081 global all_heads
2082 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2083 set check_rev {}
2085 switch -- $delete_branch_checktype {
2086 head {set check_rev $delete_branch_head}
2087 tracking {set check_rev $delete_branch_trackinghead}
2088 always {set check_rev {:none}}
2089 }
2090 if {$check_rev eq {:none}} {
2091 set check_cmt {}
2092 } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2093 tk_messageBox \
2094 -icon error \
2095 -type ok \
2096 -title [wm title $w] \
2097 -parent $w \
2098 -message "Invalid check revision: $check_rev"
2099 return
2100 }
2101 set to_delete [list]
2103 set not_merged [list]
2104 foreach i [$w.list.l curselection] {
2105 set b [$w.list.l get $i]
2106 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2107 if {$check_cmt ne {}} {
2108 if {$b eq $check_rev} continue
2109 if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2110 if {$o ne $m} {
2111 lappend not_merged $b
2112 continue
2113 }
2114 }
2115 lappend to_delete [list $b $o]
2116 }
2117 if {$not_merged ne {}} {
2118 set msg "The following branches are not completely merged into $check_rev:
2119 - [join $not_merged "\n - "]"
2121 tk_messageBox \
2122 -icon info \
2123 -type ok \
2124 -title [wm title $w] \
2125 -parent $w \
2126 -message $msg
2127 }
2128 if {$to_delete eq {}} return
2129 if {$delete_branch_checktype eq {always}} {
2130 set msg {Recovering deleted branches is difficult.
2131Delete the selected branches?}
2133 if {[tk_messageBox \
2134 -icon warning \
2135 -type yesno \
2136 -title [wm title $w] \
2137 -parent $w \
2138 -message $msg] ne yes} {
2139 return
2140 }
2141 }
2142 set failed {}
2144 foreach i $to_delete {
2145 set b [lindex $i 0]
2146 set o [lindex $i 1]
2147 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2148 append failed " - $b: $err\n"
2149 } else {
2150 set x [lsearch -sorted -exact $all_heads $b]
2151 if {$x >= 0} {
2152 set all_heads [lreplace $all_heads $x $x]
2153 }
2154 }
2155 }
2156 if {$failed ne {}} {
2158 tk_messageBox \
2159 -icon error \
2160 -type ok \
2161 -title [wm title $w] \
2162 -parent $w \
2163 -message "Failed to delete branches:\n$failed"
2164 }
2165 set all_heads [lsort $all_heads]
2167 populate_branch_menu
2168 destroy $w
2169}
2170proc do_delete_branch {} {
2172 global all_heads tracking_branches current_branch
2173 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2174 set w .branch_editor
2176 toplevel $w
2177 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2178 label $w.header -text {Delete Local Branch} \
2180 -font font_uibold
2181 pack $w.header -side top -fill x
2182 frame $w.buttons
2184 button $w.buttons.create -text Delete \
2185 -font font_ui \
2186 -command [list do_delete_branch_action $w]
2187 pack $w.buttons.create -side right
2188 button $w.buttons.cancel -text {Cancel} \
2189 -font font_ui \
2190 -command [list destroy $w]
2191 pack $w.buttons.cancel -side right -padx 5
2192 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2193 labelframe $w.list \
2195 -text {Local Branches} \
2196 -font font_ui
2197 listbox $w.list.l \
2198 -height 10 \
2199 -width 70 \
2200 -selectmode extended \
2201 -yscrollcommand [list $w.list.sby set] \
2202 -font font_ui
2203 foreach h $all_heads {
2204 if {$h ne $current_branch} {
2205 $w.list.l insert end $h
2206 }
2207 }
2208 scrollbar $w.list.sby -command [list $w.list.l yview]
2209 pack $w.list.sby -side right -fill y
2210 pack $w.list.l -side left -fill both -expand 1
2211 pack $w.list -fill both -expand 1 -pady 5 -padx 5
2212 labelframe $w.validate \
2214 -text {Delete Only If} \
2215 -font font_ui
2216 radiobutton $w.validate.head_r \
2217 -text {Merged Into Local Branch:} \
2218 -value head \
2219 -variable delete_branch_checktype \
2220 -font font_ui
2221 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2222 grid $w.validate.head_r $w.validate.head_m -sticky w
2223 set all_trackings [all_tracking_branches]
2224 if {$all_trackings ne {}} {
2225 set delete_branch_trackinghead [lindex $all_trackings 0]
2226 radiobutton $w.validate.tracking_r \
2227 -text {Merged Into Tracking Branch:} \
2228 -value tracking \
2229 -variable delete_branch_checktype \
2230 -font font_ui
2231 eval tk_optionMenu $w.validate.tracking_m \
2232 delete_branch_trackinghead \
2233 $all_trackings
2234 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2235 }
2236 radiobutton $w.validate.always_r \
2237 -text {Always (Do not perform merge checks)} \
2238 -value always \
2239 -variable delete_branch_checktype \
2240 -font font_ui
2241 grid $w.validate.always_r -columnspan 2 -sticky w
2242 grid columnconfigure $w.validate 1 -weight 1
2243 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2244 set delete_branch_head $current_branch
2246 set delete_branch_checktype head
2247 bind $w <Visibility> "grab $w; focus $w"
2249 bind $w <Key-Escape> "destroy $w"
2250 wm title $w "[appname] ([reponame]): Delete Branch"
2251 tkwait window $w
2252}
2253proc switch_branch {new_branch} {
2255 global HEAD commit_type current_branch repo_config
2256 if {![lock_index switch]} return
2258 # -- Our in memory state should match the repository.
2260 #
2261 repository_state curType curHEAD curMERGE_HEAD
2262 if {[string match amend* $commit_type]
2263 && $curType eq {normal}
2264 && $curHEAD eq $HEAD} {
2265 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2266 info_popup {Last scanned state does not match repository state.
2267Another Git program has modified this repository
2269since the last scan. A rescan must be performed
2270before the current branch can be changed.
2271The rescan will be automatically started now.
2273}
2274 unlock_index
2275 rescan {set ui_status_value {Ready.}}
2276 return
2277 }
2278 # -- Don't do a pointless switch.
2280 #
2281 if {$current_branch eq $new_branch} {
2282 unlock_index
2283 return
2284 }
2285 if {$repo_config(gui.trustmtime) eq {true}} {
2287 switch_branch_stage2 {} $new_branch
2288 } else {
2289 set ui_status_value {Refreshing file status...}
2290 set cmd [list git update-index]
2291 lappend cmd -q
2292 lappend cmd --unmerged
2293 lappend cmd --ignore-missing
2294 lappend cmd --refresh
2295 set fd_rf [open "| $cmd" r]
2296 fconfigure $fd_rf -blocking 0 -translation binary
2297 fileevent $fd_rf readable \
2298 [list switch_branch_stage2 $fd_rf $new_branch]
2299 }
2300}
2301proc switch_branch_stage2 {fd_rf new_branch} {
2303 global ui_status_value HEAD
2304 if {$fd_rf ne {}} {
2306 read $fd_rf
2307 if {![eof $fd_rf]} return
2308 close $fd_rf
2309 }
2310 set ui_status_value "Updating working directory to '$new_branch'..."
2312 set cmd [list git read-tree]
2313 lappend cmd -m
2314 lappend cmd -u
2315 lappend cmd --exclude-per-directory=.gitignore
2316 lappend cmd $HEAD
2317 lappend cmd $new_branch
2318 set fd_rt [open "| $cmd" r]
2319 fconfigure $fd_rt -blocking 0 -translation binary
2320 fileevent $fd_rt readable \
2321 [list switch_branch_readtree_wait $fd_rt $new_branch]
2322}
2323proc switch_branch_readtree_wait {fd_rt new_branch} {
2325 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2326 global current_branch
2327 global ui_comm ui_status_value
2328 # -- We never get interesting output on stdout; only stderr.
2330 #
2331 read $fd_rt
2332 fconfigure $fd_rt -blocking 1
2333 if {![eof $fd_rt]} {
2334 fconfigure $fd_rt -blocking 0
2335 return
2336 }
2337 # -- The working directory wasn't in sync with the index and
2339 # we'd have to overwrite something to make the switch. A
2340 # merge is required.
2341 #
2342 if {[catch {close $fd_rt} err]} {
2343 regsub {^fatal: } $err {} err
2344 warn_popup "File level merge required.
2345$err
2347Staying on branch '$current_branch'."
2349 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2350 unlock_index
2351 return
2352 }
2353 # -- Update the symbolic ref. Core git doesn't even check for failure
2355 # here, it Just Works(tm). If it doesn't we are in some really ugly
2356 # state that is difficult to recover from within git-gui.
2357 #
2358 if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2359 error_popup "Failed to set current branch.
2360This working directory is only partially switched.
2362We successfully updated your files, but failed to
2363update an internal Git file.
2364This should not have occurred. [appname] will now
2366close and give up.
2367$err"
2369 do_quit
2370 return
2371 }
2372 # -- Update our repository state. If we were previously in amend mode
2374 # we need to toss the current buffer and do a full rescan to update
2375 # our file lists. If we weren't in amend mode our file lists are
2376 # accurate and we can avoid the rescan.
2377 #
2378 unlock_index
2379 set selected_commit_type new
2380 if {[string match amend* $commit_type]} {
2381 $ui_comm delete 0.0 end
2382 $ui_comm edit reset
2383 $ui_comm edit modified false
2384 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2385 } else {
2386 repository_state commit_type HEAD MERGE_HEAD
2387 set PARENT $HEAD
2388 set ui_status_value "Checked out branch '$current_branch'."
2389 }
2390}
2391######################################################################
2393##
2394## remote management
2395proc load_all_remotes {} {
2397 global repo_config
2398 global all_remotes tracking_branches
2399 set all_remotes [list]
2401 array unset tracking_branches
2402 set rm_dir [gitdir remotes]
2404 if {[file isdirectory $rm_dir]} {
2405 set all_remotes [glob \
2406 -types f \
2407 -tails \
2408 -nocomplain \
2409 -directory $rm_dir *]
2410 foreach name $all_remotes {
2412 catch {
2413 set fd [open [file join $rm_dir $name] r]
2414 while {[gets $fd line] >= 0} {
2415 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2416 $line line src dst]} continue
2417 if {![regexp ^refs/ $dst]} {
2418 set dst "refs/heads/$dst"
2419 }
2420 set tracking_branches($dst) [list $name $src]
2421 }
2422 close $fd
2423 }
2424 }
2425 }
2426 foreach line [array names repo_config remote.*.url] {
2428 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2429 lappend all_remotes $name
2430 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2432 set fl {}
2433 }
2434 foreach line $fl {
2435 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2436 if {![regexp ^refs/ $dst]} {
2437 set dst "refs/heads/$dst"
2438 }
2439 set tracking_branches($dst) [list $name $src]
2440 }
2441 }
2442 set all_remotes [lsort -unique $all_remotes]
2444}
2445proc populate_fetch_menu {} {
2447 global all_remotes repo_config
2448 set m .mbar.fetch
2450 foreach r $all_remotes {
2451 set enable 0
2452 if {![catch {set a $repo_config(remote.$r.url)}]} {
2453 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2454 set enable 1
2455 }
2456 } else {
2457 catch {
2458 set fd [open [gitdir remotes $r] r]
2459 while {[gets $fd n] >= 0} {
2460 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2461 set enable 1
2462 break
2463 }
2464 }
2465 close $fd
2466 }
2467 }
2468 if {$enable} {
2470 $m add command \
2471 -label "Fetch from $r..." \
2472 -command [list fetch_from $r] \
2473 -font font_ui
2474 }
2475 }
2476}
2477proc populate_push_menu {} {
2479 global all_remotes repo_config
2480 set m .mbar.push
2482 set fast_count 0
2483 foreach r $all_remotes {
2484 set enable 0
2485 if {![catch {set a $repo_config(remote.$r.url)}]} {
2486 if {![catch {set a $repo_config(remote.$r.push)}]} {
2487 set enable 1
2488 }
2489 } else {
2490 catch {
2491 set fd [open [gitdir remotes $r] r]
2492 while {[gets $fd n] >= 0} {
2493 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2494 set enable 1
2495 break
2496 }
2497 }
2498 close $fd
2499 }
2500 }
2501 if {$enable} {
2503 if {!$fast_count} {
2504 $m add separator
2505 }
2506 $m add command \
2507 -label "Push to $r..." \
2508 -command [list push_to $r] \
2509 -font font_ui
2510 incr fast_count
2511 }
2512 }
2513}
2514proc start_push_anywhere_action {w} {
2516 global push_urltype push_remote push_url push_thin push_tags
2517 set r_url {}
2519 switch -- $push_urltype {
2520 remote {set r_url $push_remote}
2521 url {set r_url $push_url}
2522 }
2523 if {$r_url eq {}} return
2524 set cmd [list git push]
2526 lappend cmd -v
2527 if {$push_thin} {
2528 lappend cmd --thin
2529 }
2530 if {$push_tags} {
2531 lappend cmd --tags
2532 }
2533 lappend cmd $r_url
2534 set cnt 0
2535 foreach i [$w.source.l curselection] {
2536 set b [$w.source.l get $i]
2537 lappend cmd "refs/heads/$b:refs/heads/$b"
2538 incr cnt
2539 }
2540 if {$cnt == 0} {
2541 return
2542 } elseif {$cnt == 1} {
2543 set unit branch
2544 } else {
2545 set unit branches
2546 }
2547 set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2549 console_exec $cons $cmd console_done
2550 destroy $w
2551}
2552trace add variable push_remote write \
2554 [list radio_selector push_urltype remote]
2555proc do_push_anywhere {} {
2557 global all_heads all_remotes current_branch
2558 global push_urltype push_remote push_url push_thin push_tags
2559 set w .push_setup
2561 toplevel $w
2562 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2563 label $w.header -text {Push Branches} -font font_uibold
2565 pack $w.header -side top -fill x
2566 frame $w.buttons
2568 button $w.buttons.create -text Push \
2569 -font font_ui \
2570 -command [list start_push_anywhere_action $w]
2571 pack $w.buttons.create -side right
2572 button $w.buttons.cancel -text {Cancel} \
2573 -font font_ui \
2574 -command [list destroy $w]
2575 pack $w.buttons.cancel -side right -padx 5
2576 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2577 labelframe $w.source \
2579 -text {Source Branches} \
2580 -font font_ui
2581 listbox $w.source.l \
2582 -height 10 \
2583 -width 70 \
2584 -selectmode extended \
2585 -yscrollcommand [list $w.source.sby set] \
2586 -font font_ui
2587 foreach h $all_heads {
2588 $w.source.l insert end $h
2589 if {$h eq $current_branch} {
2590 $w.source.l select set end
2591 }
2592 }
2593 scrollbar $w.source.sby -command [list $w.source.l yview]
2594 pack $w.source.sby -side right -fill y
2595 pack $w.source.l -side left -fill both -expand 1
2596 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2597 labelframe $w.dest \
2599 -text {Destination Repository} \
2600 -font font_ui
2601 if {$all_remotes ne {}} {
2602 radiobutton $w.dest.remote_r \
2603 -text {Remote:} \
2604 -value remote \
2605 -variable push_urltype \
2606 -font font_ui
2607 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2608 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2609 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2610 set push_remote origin
2611 } else {
2612 set push_remote [lindex $all_remotes 0]
2613 }
2614 set push_urltype remote
2615 } else {
2616 set push_urltype url
2617 }
2618 radiobutton $w.dest.url_r \
2619 -text {Arbitrary URL:} \
2620 -value url \
2621 -variable push_urltype \
2622 -font font_ui
2623 entry $w.dest.url_t \
2624 -borderwidth 1 \
2625 -relief sunken \
2626 -width 50 \
2627 -textvariable push_url \
2628 -font font_ui \
2629 -validate key \
2630 -validatecommand {
2631 if {%d == 1 && [regexp {\s} %S]} {return 0}
2632 if {%d == 1 && [string length %S] > 0} {
2633 set push_urltype url
2634 }
2635 return 1
2636 }
2637 grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2638 grid columnconfigure $w.dest 1 -weight 1
2639 pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2640 labelframe $w.options \
2642 -text {Transfer Options} \
2643 -font font_ui
2644 checkbutton $w.options.thin \
2645 -text {Use thin pack (for slow network connections)} \
2646 -variable push_thin \
2647 -font font_ui
2648 grid $w.options.thin -columnspan 2 -sticky w
2649 checkbutton $w.options.tags \
2650 -text {Include tags} \
2651 -variable push_tags \
2652 -font font_ui
2653 grid $w.options.tags -columnspan 2 -sticky w
2654 grid columnconfigure $w.options 1 -weight 1
2655 pack $w.options -anchor nw -fill x -pady 5 -padx 5
2656 set push_url {}
2658 set push_thin 0
2659 set push_tags 0
2660 bind $w <Visibility> "grab $w"
2662 bind $w <Key-Escape> "destroy $w"
2663 wm title $w "[appname] ([reponame]): Push"
2664 tkwait window $w
2665}
2666######################################################################
2668##
2669## merge
2670proc can_merge {} {
2672 global HEAD commit_type file_states
2673 if {[string match amend* $commit_type]} {
2675 info_popup {Cannot merge while amending.
2676You must finish amending this commit before
2678starting any type of merge.
2679}
2680 return 0
2681 }
2682 if {[committer_ident] eq {}} {return 0}
2684 if {![lock_index merge]} {return 0}
2685 # -- Our in memory state should match the repository.
2687 #
2688 repository_state curType curHEAD curMERGE_HEAD
2689 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2690 info_popup {Last scanned state does not match repository state.
2691Another Git program has modified this repository
2693since the last scan. A rescan must be performed
2694before a merge can be performed.
2695The rescan will be automatically started now.
2697}
2698 unlock_index
2699 rescan {set ui_status_value {Ready.}}
2700 return 0
2701 }
2702 foreach path [array names file_states] {
2704 switch -glob -- [lindex $file_states($path) 0] {
2705 _O {
2706 continue; # and pray it works!
2707 }
2708 U? {
2709 error_popup "You are in the middle of a conflicted merge.
2710File [short_path $path] has merge conflicts.
2712You must resolve them, add the file, and commit to
2714complete the current merge. Only then can you
2715begin another merge.
2716"
2717 unlock_index
2718 return 0
2719 }
2720 ?? {
2721 error_popup "You are in the middle of a change.
2722File [short_path $path] is modified.
2724You should complete the current commit before
2726starting a merge. Doing so will help you abort
2727a failed merge, should the need arise.
2728"
2729 unlock_index
2730 return 0
2731 }
2732 }
2733 }
2734 return 1
2736}
2737proc visualize_local_merge {w} {
2739 set revs {}
2740 foreach i [$w.source.l curselection] {
2741 lappend revs [$w.source.l get $i]
2742 }
2743 if {$revs eq {}} return
2744 lappend revs --not HEAD
2745 do_gitk $revs
2746}
2747proc start_local_merge_action {w} {
2749 global HEAD ui_status_value current_branch
2750 set cmd [list git merge]
2752 set names {}
2753 set revcnt 0
2754 foreach i [$w.source.l curselection] {
2755 set b [$w.source.l get $i]
2756 lappend cmd $b
2757 lappend names $b
2758 incr revcnt
2759 }
2760 if {$revcnt == 0} {
2762 return
2763 } elseif {$revcnt == 1} {
2764 set unit branch
2765 } elseif {$revcnt <= 15} {
2766 set unit branches
2767 } else {
2768 tk_messageBox \
2769 -icon error \
2770 -type ok \
2771 -title [wm title $w] \
2772 -parent $w \
2773 -message "Too many branches selected.
2774You have requested to merge $revcnt branches
2776in an octopus merge. This exceeds Git's
2777internal limit of 15 branches per merge.
2778Please select fewer branches. To merge more
2780than 15 branches, merge the branches in batches.
2781"
2782 return
2783 }
2784 set msg "Merging $current_branch, [join $names {, }]"
2786 set ui_status_value "$msg..."
2787 set cons [new_console "Merge" $msg]
2788 console_exec $cons $cmd [list finish_merge $revcnt]
2789 bind $w <Destroy> {}
2790 destroy $w
2791}
2792proc finish_merge {revcnt w ok} {
2794 console_done $w $ok
2795 if {$ok} {
2796 set msg {Merge completed successfully.}
2797 } else {
2798 if {$revcnt != 1} {
2799 info_popup "Octopus merge failed.
2800Your merge of $revcnt branches has failed.
2802There are file-level conflicts between the
2804branches which must be resolved manually.
2805The working directory will now be reset.
2807You can attempt this merge again
2809by merging only one branch at a time." $w
2810 set fd [open "| git read-tree --reset -u HEAD" r]
2812 fconfigure $fd -blocking 0 -translation binary
2813 fileevent $fd readable [list reset_hard_wait $fd]
2814 set ui_status_value {Aborting... please wait...}
2815 return
2816 }
2817 set msg {Merge failed. Conflict resolution is required.}
2819 }
2820 unlock_index
2821 rescan [list set ui_status_value $msg]
2822}
2823proc do_local_merge {} {
2825 global current_branch
2826 if {![can_merge]} return
2828 set w .merge_setup
2830 toplevel $w
2831 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2832 label $w.header \
2834 -text "Merge Into $current_branch" \
2835 -font font_uibold
2836 pack $w.header -side top -fill x
2837 frame $w.buttons
2839 button $w.buttons.visualize -text Visualize \
2840 -font font_ui \
2841 -command [list visualize_local_merge $w]
2842 pack $w.buttons.visualize -side left
2843 button $w.buttons.create -text Merge \
2844 -font font_ui \
2845 -command [list start_local_merge_action $w]
2846 pack $w.buttons.create -side right
2847 button $w.buttons.cancel -text {Cancel} \
2848 -font font_ui \
2849 -command [list destroy $w]
2850 pack $w.buttons.cancel -side right -padx 5
2851 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2852 labelframe $w.source \
2854 -text {Source Branches} \
2855 -font font_ui
2856 listbox $w.source.l \
2857 -height 10 \
2858 -width 70 \
2859 -selectmode extended \
2860 -yscrollcommand [list $w.source.sby set] \
2861 -font font_ui
2862 scrollbar $w.source.sby -command [list $w.source.l yview]
2863 pack $w.source.sby -side right -fill y
2864 pack $w.source.l -side left -fill both -expand 1
2865 pack $w.source -fill both -expand 1 -pady 5 -padx 5
2866 set cmd [list git for-each-ref]
2868 lappend cmd {--format=%(objectname) %(refname)}
2869 lappend cmd refs/heads
2870 lappend cmd refs/remotes
2871 set fr_fd [open "| $cmd" r]
2872 fconfigure $fr_fd -translation binary
2873 while {[gets $fr_fd line] > 0} {
2874 set line [split $line { }]
2875 set sha1([lindex $line 0]) [lindex $line 1]
2876 }
2877 close $fr_fd
2878 set to_show {}
2880 set fr_fd [open "| git rev-list --all --not HEAD"]
2881 while {[gets $fr_fd line] > 0} {
2882 if {[catch {set ref $sha1($line)}]} continue
2883 regsub ^refs/(heads|remotes)/ $ref {} ref
2884 lappend to_show $ref
2885 }
2886 close $fr_fd
2887 foreach ref [lsort -unique $to_show] {
2889 $w.source.l insert end $ref
2890 }
2891 bind $w <Visibility> "grab $w"
2893 bind $w <Key-Escape> "unlock_index;destroy $w"
2894 bind $w <Destroy> unlock_index
2895 wm title $w "[appname] ([reponame]): Merge"
2896 tkwait window $w
2897}
2898proc do_reset_hard {} {
2900 global HEAD commit_type file_states
2901 if {[string match amend* $commit_type]} {
2903 info_popup {Cannot abort while amending.
2904You must finish amending this commit.
2906}
2907 return
2908 }
2909 if {![lock_index abort]} return
2911 if {[string match *merge* $commit_type]} {
2913 set op merge
2914 } else {
2915 set op commit
2916 }
2917 if {[ask_popup "Abort $op?
2919Aborting the current $op will cause
2921*ALL* uncommitted changes to be lost.
2922Continue with aborting the current $op?"] eq {yes}} {
2924 set fd [open "| git read-tree --reset -u HEAD" r]
2925 fconfigure $fd -blocking 0 -translation binary
2926 fileevent $fd readable [list reset_hard_wait $fd]
2927 set ui_status_value {Aborting... please wait...}
2928 } else {
2929 unlock_index
2930 }
2931}
2932proc reset_hard_wait {fd} {
2934 global ui_comm
2935 read $fd
2937 if {[eof $fd]} {
2938 close $fd
2939 unlock_index
2940 $ui_comm delete 0.0 end
2942 $ui_comm edit modified false
2943 catch {file delete [gitdir MERGE_HEAD]}
2945 catch {file delete [gitdir rr-cache MERGE_RR]}
2946 catch {file delete [gitdir SQUASH_MSG]}
2947 catch {file delete [gitdir MERGE_MSG]}
2948 catch {file delete [gitdir GITGUI_MSG]}
2949 rescan {set ui_status_value {Abort completed. Ready.}}
2951 }
2952}
2953######################################################################
2955##
2956## browser
2957set next_browser_id 0
2959proc new_browser {commit} {
2961 global next_browser_id cursor_ptr M1B
2962 global browser_commit browser_status browser_stack browser_path browser_busy
2963 set w .browser[incr next_browser_id]
2965 set w_list $w.list.l
2966 set browser_commit($w_list) $commit
2967 set browser_status($w_list) {Starting...}
2968 set browser_stack($w_list) {}
2969 set browser_path($w_list) $browser_commit($w_list):
2970 set browser_busy($w_list) 1
2971 toplevel $w
2973 label $w.path -textvariable browser_path($w_list) \
2974 -anchor w \
2975 -justify left \
2976 -borderwidth 1 \
2977 -relief sunken \
2978 -font font_uibold
2979 pack $w.path -anchor w -side top -fill x
2980 frame $w.list
2982 text $w_list -background white -borderwidth 0 \
2983 -cursor $cursor_ptr \
2984 -state disabled \
2985 -wrap none \
2986 -height 20 \
2987 -width 70 \
2988 -xscrollcommand [list $w.list.sbx set] \
2989 -yscrollcommand [list $w.list.sby set] \
2990 -font font_ui
2991 $w_list tag conf in_sel \
2992 -background [$w_list cget -foreground] \
2993 -foreground [$w_list cget -background]
2994 scrollbar $w.list.sbx -orient h -command [list $w_list xview]
2995 scrollbar $w.list.sby -orient v -command [list $w_list yview]
2996 pack $w.list.sbx -side bottom -fill x
2997 pack $w.list.sby -side right -fill y
2998 pack $w_list -side left -fill both -expand 1
2999 pack $w.list -side top -fill both -expand 1
3000 label $w.status -textvariable browser_status($w_list) \
3002 -anchor w \
3003 -justify left \
3004 -borderwidth 1 \
3005 -relief sunken \
3006 -font font_ui
3007 pack $w.status -anchor w -side bottom -fill x
3008 bind $w_list <Button-1> "browser_click 0 $w_list @%x,%y;break"
3010 bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3011 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3012 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3013 bind $w_list <Up> "browser_move -1 $w_list;break"
3014 bind $w_list <Down> "browser_move 1 $w_list;break"
3015 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3016 bind $w_list <Return> "browser_enter $w_list;break"
3017 bind $w_list <Prior> "browser_page -1 $w_list;break"
3018 bind $w_list <Next> "browser_page 1 $w_list;break"
3019 bind $w_list <Left> break
3020 bind $w_list <Right> break
3021 bind $w <Visibility> "focus $w"
3023 bind $w <Destroy> "
3024 array unset browser_buffer $w_list
3025 array unset browser_files $w_list
3026 array unset browser_status $w_list
3027 array unset browser_stack $w_list
3028 array unset browser_path $w_list
3029 array unset browser_commit $w_list
3030 array unset browser_busy $w_list
3031 "
3032 wm title $w "[appname] ([reponame]): File Browser"
3033 ls_tree $w_list $browser_commit($w_list) {}
3034}
3035proc browser_move {dir w} {
3037 global browser_files browser_busy
3038 if {$browser_busy($w)} return
3040 set lno [lindex [split [$w index in_sel.first] .] 0]
3041 incr lno $dir
3042 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3043 $w tag remove in_sel 0.0 end
3044 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3045 $w see $lno.0
3046 }
3047}
3048proc browser_page {dir w} {
3050 global browser_files browser_busy
3051 if {$browser_busy($w)} return
3053 $w yview scroll $dir pages
3054 set lno [expr {int(
3055 [lindex [$w yview] 0]
3056 * [llength $browser_files($w)]
3057 + 1)}]
3058 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3059 $w tag remove in_sel 0.0 end
3060 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3061 $w see $lno.0
3062 }
3063}
3064proc browser_parent {w} {
3066 global browser_files browser_status browser_path
3067 global browser_stack browser_busy
3068 if {$browser_busy($w)} return
3070 set info [lindex $browser_files($w) 0]
3071 if {[lindex $info 0] eq {parent}} {
3072 set parent [lindex $browser_stack($w) end-1]
3073 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3074 if {$browser_stack($w) eq {}} {
3075 regsub {:.*$} $browser_path($w) {:} browser_path($w)
3076 } else {
3077 regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3078 }
3079 set browser_status($w) "Loading $browser_path($w)..."
3080 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3081 }
3082}
3083proc browser_enter {w} {
3085 global browser_files browser_status browser_path
3086 global browser_commit browser_stack browser_busy
3087 if {$browser_busy($w)} return
3089 set lno [lindex [split [$w index in_sel.first] .] 0]
3090 set info [lindex $browser_files($w) [expr {$lno - 1}]]
3091 if {$info ne {}} {
3092 switch -- [lindex $info 0] {
3093 parent {
3094 browser_parent $w
3095 }
3096 tree {
3097 set name [lindex $info 2]
3098 set escn [escape_path $name]
3099 set browser_status($w) "Loading $escn..."
3100 append browser_path($w) $escn
3101 ls_tree $w [lindex $info 1] $name
3102 }
3103 blob {
3104 set name [lindex $info 2]
3105 set p {}
3106 foreach n $browser_stack($w) {
3107 append p [lindex $n 1]
3108 }
3109 append p $name
3110 show_blame $browser_commit($w) $p
3111 }
3112 }
3113 }
3114}
3115proc browser_click {was_double_click w pos} {
3117 global browser_files browser_busy
3118 if {$browser_busy($w)} return
3120 set lno [lindex [split [$w index $pos] .] 0]
3121 focus $w
3122 if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3124 $w tag remove in_sel 0.0 end
3125 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3126 if {$was_double_click} {
3127 browser_enter $w
3128 }
3129 }
3130}
3131proc ls_tree {w tree_id name} {
3133 global browser_buffer browser_files browser_stack browser_busy
3134 set browser_buffer($w) {}
3136 set browser_files($w) {}
3137 set browser_busy($w) 1
3138 $w conf -state normal
3140 $w tag remove in_sel 0.0 end
3141 $w delete 0.0 end
3142 if {$browser_stack($w) ne {}} {
3143 $w image create end \
3144 -align center -padx 5 -pady 1 \
3145 -name icon0 \
3146 -image file_uplevel
3147 $w insert end {[Up To Parent]}
3148 lappend browser_files($w) parent
3149 }
3150 lappend browser_stack($w) [list $tree_id $name]
3151 $w conf -state disabled
3152 set cmd [list git ls-tree -z $tree_id]
3154 set fd [open "| $cmd" r]
3155 fconfigure $fd -blocking 0 -translation binary -encoding binary
3156 fileevent $fd readable [list read_ls_tree $fd $w]
3157}
3158proc read_ls_tree {fd w} {
3160 global browser_buffer browser_files browser_status browser_busy
3161 if {![winfo exists $w]} {
3163 catch {close $fd}
3164 return
3165 }
3166 append browser_buffer($w) [read $fd]
3168 set pck [split $browser_buffer($w) "\0"]
3169 set browser_buffer($w) [lindex $pck end]
3170 set n [llength $browser_files($w)]
3172 $w conf -state normal
3173 foreach p [lrange $pck 0 end-1] {
3174 set info [split $p "\t"]
3175 set path [lindex $info 1]
3176 set info [split [lindex $info 0] { }]
3177 set type [lindex $info 1]
3178 set object [lindex $info 2]
3179 switch -- $type {
3181 blob {
3182 set image file_mod
3183 }
3184 tree {
3185 set image file_dir
3186 append path /
3187 }
3188 default {
3189 set image file_question
3190 }
3191 }
3192 if {$n > 0} {$w insert end "\n"}
3194 $w image create end \
3195 -align center -padx 5 -pady 1 \
3196 -name icon[incr n] \
3197 -image $image
3198 $w insert end [escape_path $path]
3199 lappend browser_files($w) [list $type $object $path]
3200 }
3201 $w conf -state disabled
3202 if {[eof $fd]} {
3204 close $fd
3205 set browser_status($w) Ready.
3206 set browser_busy($w) 0
3207 array unset browser_buffer $w
3208 if {$n > 0} {
3209 $w tag add in_sel 1.0 2.0
3210 focus -force $w
3211 }
3212 }
3213}
3214proc show_blame {commit path} {
3216 global next_browser_id blame_status blame_data
3217 set w .browser[incr next_browser_id]
3219 set blame_status($w) {Loading current file content...}
3220 set texts [list]
3221 toplevel $w
3223 label $w.path -text "$commit:$path" \
3225 -anchor w \
3226 -justify left \
3227 -borderwidth 1 \
3228 -relief sunken \
3229 -font font_uibold
3230 pack $w.path -side top -fill x
3231 set hbg #e2effa
3233 frame $w.out
3234 label $w.out.commit_l -text Commit \
3235 -relief solid \
3236 -borderwidth 1 \
3237 -background $hbg \
3238 -font font_uibold
3239 text $w.out.commit_t \
3240 -background white -borderwidth 0 \
3241 -state disabled \
3242 -wrap none \
3243 -height 40 \
3244 -width 9 \
3245 -font font_diff
3246 lappend texts $w.out.commit_t
3247 label $w.out.author_l -text Author \
3249 -relief solid \
3250 -borderwidth 1 \
3251 -background $hbg \
3252 -font font_uibold
3253 text $w.out.author_t \
3254 -background white -borderwidth 0 \
3255 -state disabled \
3256 -wrap none \
3257 -height 40 \
3258 -width 20 \
3259 -font font_diff
3260 lappend texts $w.out.author_t
3261 label $w.out.date_l -text Date \
3263 -relief solid \
3264 -borderwidth 1 \
3265 -background $hbg \
3266 -font font_uibold
3267 text $w.out.date_t \
3268 -background white -borderwidth 0 \
3269 -state disabled \
3270 -wrap none \
3271 -height 40 \
3272 -width [string length "yyyy-mm-dd hh:mm:ss"] \
3273 -font font_diff
3274 lappend texts $w.out.date_t
3275 label $w.out.filename_l -text Filename \
3277 -relief solid \
3278 -borderwidth 1 \
3279 -background $hbg \
3280 -font font_uibold
3281 text $w.out.filename_t \
3282 -background white -borderwidth 0 \
3283 -state disabled \
3284 -wrap none \
3285 -height 40 \
3286 -width 20 \
3287 -font font_diff
3288 lappend texts $w.out.filename_t
3289 label $w.out.origlinenumber_l -text {Orig Line} \
3291 -relief solid \
3292 -borderwidth 1 \
3293 -background $hbg \
3294 -font font_uibold
3295 text $w.out.origlinenumber_t \
3296 -background white -borderwidth 0 \
3297 -state disabled \
3298 -wrap none \
3299 -height 40 \
3300 -width 5 \
3301 -font font_diff
3302 $w.out.origlinenumber_t tag conf linenumber -justify right
3303 lappend texts $w.out.origlinenumber_t
3304 label $w.out.linenumber_l -text {Curr Line} \
3306 -relief solid \
3307 -borderwidth 1 \
3308 -background $hbg \
3309 -font font_uibold
3310 text $w.out.linenumber_t \
3311 -background white -borderwidth 0 \
3312 -state disabled \
3313 -wrap none \
3314 -height 40 \
3315 -width 5 \
3316 -font font_diff
3317 $w.out.linenumber_t tag conf linenumber -justify right
3318 lappend texts $w.out.linenumber_t
3319 label $w.out.file_l -text {File Content} \
3321 -relief solid \
3322 -borderwidth 1 \
3323 -background $hbg \
3324 -font font_uibold
3325 text $w.out.file_t \
3326 -background white -borderwidth 0 \
3327 -state disabled \
3328 -wrap none \
3329 -height 40 \
3330 -width 80 \
3331 -xscrollcommand [list $w.out.sbx set] \
3332 -font font_diff
3333 lappend texts $w.out.file_t
3334 scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3336 scrollbar $w.out.sby -orient v \
3337 -command [list scrollbar2many $texts yview]
3338 set labels [list]
3339 foreach i $texts {
3340 regsub {_t$} $i _l l
3341 lappend labels $l
3342 }
3343 set file_col [expr {[llength $texts] - 1}]
3344 eval grid $labels -sticky we
3345 eval grid $texts $w.out.sby -sticky nsew
3346 grid conf $w.out.sbx -column $file_col -sticky we
3347 grid columnconfigure $w.out $file_col -weight 1
3348 grid rowconfigure $w.out 1 -weight 1
3349 pack $w.out -fill both -expand 1
3350 label $w.status -textvariable blame_status($w) \
3352 -anchor w \
3353 -justify left \
3354 -borderwidth 1 \
3355 -relief sunken \
3356 -font font_ui
3357 pack $w.status -side bottom -fill x
3358 menu $w.ctxm -tearoff 0
3360 $w.ctxm add command -label "Copy Commit" \
3361 -font font_ui \
3362 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3363 foreach i $texts {
3365 $i tag conf in_sel \
3366 -background [$i cget -foreground] \
3367 -foreground [$i cget -background]
3368 $i conf -yscrollcommand \
3369 [list many2scrollbar $texts yview $w.out.sby]
3370 bind $i <Button-1> "blame_highlight $i @%x,%y $texts;break"
3371 bind_button3 $i "
3372 set cursorX %x
3373 set cursorY %y
3374 set cursorW %W
3375 tk_popup $w.ctxm %X %Y
3376 "
3377 }
3378 set blame_data($w,colors) {}
3380 bind $w <Visibility> "focus $w"
3382 bind $w <Destroy> "
3383 array unset blame_status $w
3384 array unset blame_data $w,*
3385 "
3386 wm title $w "[appname] ([reponame]): File Viewer"
3387 set blame_data($w,total_lines) 0
3389 set cmd [list git cat-file blob "$commit:$path"]
3390 set fd [open "| $cmd" r]
3391 fconfigure $fd -blocking 0 -translation lf -encoding binary
3392 fileevent $fd readable [list read_blame_catfile \
3393 $fd $w $commit $path \
3394 $texts $w.out.linenumber_t $w.out.file_t]
3395}
3396proc read_blame_catfile {fd w commit path texts w_lno w_file} {
3398 global blame_status blame_data
3399 if {![winfo exists $w_file]} {
3401 catch {close $fd}
3402 return
3403 }
3404 set n $blame_data($w,total_lines)
3406 foreach i $texts {$i conf -state normal}
3407 while {[gets $fd line] >= 0} {
3408 regsub "\r\$" $line {} line
3409 incr n
3410 $w_lno insert end $n linenumber
3411 $w_file insert end $line
3412 foreach i $texts {$i insert end "\n"}
3413 }
3414 foreach i $texts {$i conf -state disabled}
3415 set blame_data($w,total_lines) $n
3416 if {[eof $fd]} {
3418 close $fd
3419 set blame_status($w) {Loading annotations...}
3420 set cmd [list git blame -M -C --incremental]
3421 lappend cmd $commit -- $path
3422 set fd [open "| $cmd" r]
3423 fconfigure $fd -blocking 0 -translation lf -encoding binary
3424 fileevent $fd readable "read_blame_incremental $fd $w $texts"
3425 }
3426}
3427proc read_blame_incremental {fd w
3429 w_commit w_author w_date w_filename w_olno
3430 w_lno w_file} {
3431 global blame_status blame_data
3432 if {![winfo exists $w_commit]} {
3434 catch {close $fd}
3435 return
3436 }
3437 set all [list \
3439 $w_commit \
3440 $w_author \
3441 $w_date \
3442 $w_filename \
3443 $w_olno \
3444 $w_lno \
3445 $w_file]
3446 $w_commit conf -state normal
3448 $w_author conf -state normal
3449 $w_date conf -state normal
3450 $w_filename conf -state normal
3451 $w_olno conf -state normal
3452 while {[gets $fd line] >= 0} {
3454 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3455 cmit original_line final_line line_count]} {
3456 set blame_data($w,commit) $cmit
3457 set blame_data($w,original_line) $original_line
3458 set blame_data($w,final_line) $final_line
3459 set blame_data($w,line_count) $line_count
3460 if {[catch {set g $blame_data($w,$cmit,seen)}]} {
3462 if {$blame_data($w,colors) eq {}} {
3463 set blame_data($w,colors) {
3464 yellow
3465 red
3466 pink
3467 orange
3468 green
3469 grey
3470 }
3471 }
3472 set c [lindex $blame_data($w,colors) 0]
3473 set blame_data($w,colors) \
3474 [lrange $blame_data($w,colors) 1 end]
3475 foreach t $all {
3476 $t tag conf g$cmit -background $c
3477 }
3478 } else {
3479 set blame_data($w,$cmit,seen) 1
3480 }
3481 } elseif {[string match {filename *} $line]} {
3482 set n $blame_data($w,line_count)
3483 set lno $blame_data($w,final_line)
3484 set ol $blame_data($w,original_line)
3485 set file [string range $line 9 end]
3486 set cmit $blame_data($w,commit)
3487 set abbrev [string range $cmit 0 8]
3488 if {[catch {set author $blame_data($w,$cmit,author)} err]} {
3490 set author {}
3491 }
3492 if {[catch {set atime $blame_data($w,$cmit,author-time)}]} {
3494 set atime {}
3495 } else {
3496 set atime [clock format $atime -format {%Y-%m-%d %T}]
3497 }
3498 while {$n > 0} {
3500 if {![catch {set g g$blame_data($w,line$lno,commit)}]} {
3501 foreach t $all {
3502 $t tag remove $g $lno.0 "$lno.0 lineend + 1c"
3503 }
3504 }
3505 foreach t [list \
3507 $w_commit \
3508 $w_author \
3509 $w_date \
3510 $w_filename \
3511 $w_olno] {
3512 $t delete $lno.0 "$lno.0 lineend"
3513 }
3514 $w_commit insert $lno.0 $abbrev
3516 $w_author insert $lno.0 $author
3517 $w_date insert $lno.0 $atime
3518 $w_filename insert $lno.0 $file
3519 $w_olno insert $lno.0 $ol linenumber
3520 set g g$cmit
3522 foreach t $all {
3523 $t tag add $g $lno.0 "$lno.0 lineend + 1c"
3524 }
3525 set blame_data($w,line$lno,commit) $cmit
3527 incr n -1
3529 incr lno
3530 incr ol
3531 }
3532 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3533 set blame_data($w,$blame_data($w,commit),$header) $data
3534 }
3535 }
3536 $w_commit conf -state disabled
3538 $w_author conf -state disabled
3539 $w_date conf -state disabled
3540 $w_filename conf -state disabled
3541 $w_olno conf -state disabled
3542 if {[eof $fd]} {
3544 close $fd
3545 set blame_status($w) {Annotation complete.}
3546 }
3547}
3548proc blame_highlight {w pos args} {
3550 set lno [lindex [split [$w index $pos] .] 0]
3551 foreach i $args {
3552 $i tag remove in_sel 0.0 end
3553 }
3554 if {$lno eq {}} return
3555 foreach i $args {
3556 $i tag add in_sel $lno.0 "$lno.0 + 1 line"
3557 }
3558}
3559proc blame_copycommit {w i pos} {
3561 global blame_data
3562 set lno [lindex [split [$i index $pos] .] 0]
3563 if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3564 clipboard clear
3565 clipboard append \
3566 -format STRING \
3567 -type STRING \
3568 -- $commit
3569 }
3570}
3571######################################################################
3573##
3574## icons
3575set filemask {
3577#define mask_width 14
3578#define mask_height 15
3579static unsigned char mask_bits[] = {
3580 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3581 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3582 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3583}
3584image create bitmap file_plain -background white -foreground black -data {
3586#define plain_width 14
3587#define plain_height 15
3588static unsigned char plain_bits[] = {
3589 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3590 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3591 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3592} -maskdata $filemask
3593image create bitmap file_mod -background white -foreground blue -data {
3595#define mod_width 14
3596#define mod_height 15
3597static unsigned char mod_bits[] = {
3598 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3599 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3600 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3601} -maskdata $filemask
3602image create bitmap file_fulltick -background white -foreground "#007000" -data {
3604#define file_fulltick_width 14
3605#define file_fulltick_height 15
3606static unsigned char file_fulltick_bits[] = {
3607 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3608 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3609 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3610} -maskdata $filemask
3611image create bitmap file_parttick -background white -foreground "#005050" -data {
3613#define parttick_width 14
3614#define parttick_height 15
3615static unsigned char parttick_bits[] = {
3616 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3617 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3618 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3619} -maskdata $filemask
3620image create bitmap file_question -background white -foreground black -data {
3622#define file_question_width 14
3623#define file_question_height 15
3624static unsigned char file_question_bits[] = {
3625 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3626 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3627 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3628} -maskdata $filemask
3629image create bitmap file_removed -background white -foreground red -data {
3631#define file_removed_width 14
3632#define file_removed_height 15
3633static unsigned char file_removed_bits[] = {
3634 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3635 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3636 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3637} -maskdata $filemask
3638image create bitmap file_merge -background white -foreground blue -data {
3640#define file_merge_width 14
3641#define file_merge_height 15
3642static unsigned char file_merge_bits[] = {
3643 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3644 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3645 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3646} -maskdata $filemask
3647set file_dir_data {
3649#define file_width 18
3650#define file_height 18
3651static unsigned char file_bits[] = {
3652 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3653 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3654 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3655 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3656 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3657}
3658image create bitmap file_dir -background white -foreground blue \
3659 -data $file_dir_data -maskdata $file_dir_data
3660unset file_dir_data
3661set file_uplevel_data {
3663#define up_width 15
3664#define up_height 15
3665static unsigned char up_bits[] = {
3666 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3667 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3668 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3669}
3670image create bitmap file_uplevel -background white -foreground red \
3671 -data $file_uplevel_data -maskdata $file_uplevel_data
3672unset file_uplevel_data
3673set ui_index .vpane.files.index.list
3675set ui_workdir .vpane.files.workdir.list
3676set all_icons(_$ui_index) file_plain
3678set all_icons(A$ui_index) file_fulltick
3679set all_icons(M$ui_index) file_fulltick
3680set all_icons(D$ui_index) file_removed
3681set all_icons(U$ui_index) file_merge
3682set all_icons(_$ui_workdir) file_plain
3684set all_icons(M$ui_workdir) file_mod
3685set all_icons(D$ui_workdir) file_question
3686set all_icons(U$ui_workdir) file_merge
3687set all_icons(O$ui_workdir) file_plain
3688set max_status_desc 0
3690foreach i {
3691 {__ "Unmodified"}
3692 {_M "Modified, not staged"}
3694 {M_ "Staged for commit"}
3695 {MM "Portions staged for commit"}
3696 {MD "Staged for commit, missing"}
3697 {_O "Untracked, not staged"}
3699 {A_ "Staged for commit"}
3700 {AM "Portions staged for commit"}
3701 {AD "Staged for commit, missing"}
3702 {_D "Missing"}
3704 {D_ "Staged for removal"}
3705 {DO "Staged for removal, still present"}
3706 {U_ "Requires merge resolution"}
3708 {UU "Requires merge resolution"}
3709 {UM "Requires merge resolution"}
3710 {UD "Requires merge resolution"}
3711 } {
3712 if {$max_status_desc < [string length [lindex $i 1]]} {
3713 set max_status_desc [string length [lindex $i 1]]
3714 }
3715 set all_descs([lindex $i 0]) [lindex $i 1]
3716}
3717unset i
3718######################################################################
3720##
3721## util
3722proc bind_button3 {w cmd} {
3724 bind $w <Any-Button-3> $cmd
3725 if {[is_MacOSX]} {
3726 bind $w <Control-Button-1> $cmd
3727 }
3728}
3729proc scrollbar2many {list mode args} {
3731 foreach w $list {eval $w $mode $args}
3732}
3733proc many2scrollbar {list mode sb top bottom} {
3735 $sb set $top $bottom
3736 foreach w $list {$w $mode moveto $top}
3737}
3738proc incr_font_size {font {amt 1}} {
3740 set sz [font configure $font -size]
3741 incr sz $amt
3742 font configure $font -size $sz
3743 font configure ${font}bold -size $sz
3744}
3745proc hook_failed_popup {hook msg} {
3747 set w .hookfail
3748 toplevel $w
3749 frame $w.m
3751 label $w.m.l1 -text "$hook hook failed:" \
3752 -anchor w \
3753 -justify left \
3754 -font font_uibold
3755 text $w.m.t \
3756 -background white -borderwidth 1 \
3757 -relief sunken \
3758 -width 80 -height 10 \
3759 -font font_diff \
3760 -yscrollcommand [list $w.m.sby set]
3761 label $w.m.l2 \
3762 -text {You must correct the above errors before committing.} \
3763 -anchor w \
3764 -justify left \
3765 -font font_uibold
3766 scrollbar $w.m.sby -command [list $w.m.t yview]
3767 pack $w.m.l1 -side top -fill x
3768 pack $w.m.l2 -side bottom -fill x
3769 pack $w.m.sby -side right -fill y
3770 pack $w.m.t -side left -fill both -expand 1
3771 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3772 $w.m.t insert 1.0 $msg
3774 $w.m.t conf -state disabled
3775 button $w.ok -text OK \
3777 -width 15 \
3778 -font font_ui \
3779 -command "destroy $w"
3780 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3781 bind $w <Visibility> "grab $w; focus $w"
3783 bind $w <Key-Return> "destroy $w"
3784 wm title $w "[appname] ([reponame]): error"
3785 tkwait window $w
3786}
3787set next_console_id 0
3789proc new_console {short_title long_title} {
3791 global next_console_id console_data
3792 set w .console[incr next_console_id]
3793 set console_data($w) [list $short_title $long_title]
3794 return [console_init $w]
3795}
3796proc console_init {w} {
3798 global console_cr console_data M1B
3799 set console_cr($w) 1.0
3801 toplevel $w
3802 frame $w.m
3803 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3804 -anchor w \
3805 -justify left \
3806 -font font_uibold
3807 text $w.m.t \
3808 -background white -borderwidth 1 \
3809 -relief sunken \
3810 -width 80 -height 10 \
3811 -font font_diff \
3812 -state disabled \
3813 -yscrollcommand [list $w.m.sby set]
3814 label $w.m.s -text {Working... please wait...} \
3815 -anchor w \
3816 -justify left \
3817 -font font_uibold
3818 scrollbar $w.m.sby -command [list $w.m.t yview]
3819 pack $w.m.l1 -side top -fill x
3820 pack $w.m.s -side bottom -fill x
3821 pack $w.m.sby -side right -fill y
3822 pack $w.m.t -side left -fill both -expand 1
3823 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3824 menu $w.ctxm -tearoff 0
3826 $w.ctxm add command -label "Copy" \
3827 -font font_ui \
3828 -command "tk_textCopy $w.m.t"
3829 $w.ctxm add command -label "Select All" \
3830 -font font_ui \
3831 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3832 $w.ctxm add command -label "Copy All" \
3833 -font font_ui \
3834 -command "
3835 $w.m.t tag add sel 0.0 end
3836 tk_textCopy $w.m.t
3837 $w.m.t tag remove sel 0.0 end
3838 "
3839 button $w.ok -text {Close} \
3841 -font font_ui \
3842 -state disabled \
3843 -command "destroy $w"
3844 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3845 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3847 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3848 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3849 bind $w <Visibility> "focus $w"
3850 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3851 return $w
3852}
3853proc console_exec {w cmd after} {
3855 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3856 # But most users need that so we have to relogin. :-(
3857 #
3858 if {[is_Cygwin]} {
3859 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3860 }
3861 # -- Tcl won't let us redirect both stdout and stderr to
3863 # the same pipe. So pass it through cat...
3864 #
3865 set cmd [concat | $cmd |& cat]
3866 set fd_f [open $cmd r]
3868 fconfigure $fd_f -blocking 0 -translation binary
3869 fileevent $fd_f readable [list console_read $w $fd_f $after]
3870}
3871proc console_read {w fd after} {
3873 global console_cr
3874 set buf [read $fd]
3876 if {$buf ne {}} {
3877 if {![winfo exists $w]} {console_init $w}
3878 $w.m.t conf -state normal
3879 set c 0
3880 set n [string length $buf]
3881 while {$c < $n} {
3882 set cr [string first "\r" $buf $c]
3883 set lf [string first "\n" $buf $c]
3884 if {$cr < 0} {set cr [expr {$n + 1}]}
3885 if {$lf < 0} {set lf [expr {$n + 1}]}
3886 if {$lf < $cr} {
3888 $w.m.t insert end [string range $buf $c $lf]
3889 set console_cr($w) [$w.m.t index {end -1c}]
3890 set c $lf
3891 incr c
3892 } else {
3893 $w.m.t delete $console_cr($w) end
3894 $w.m.t insert end "\n"
3895 $w.m.t insert end [string range $buf $c $cr]
3896 set c $cr
3897 incr c
3898 }
3899 }
3900 $w.m.t conf -state disabled
3901 $w.m.t see end
3902 }
3903 fconfigure $fd -blocking 1
3905 if {[eof $fd]} {
3906 if {[catch {close $fd}]} {
3907 set ok 0
3908 } else {
3909 set ok 1
3910 }
3911 uplevel #0 $after $w $ok
3912 return
3913 }
3914 fconfigure $fd -blocking 0
3915}
3916proc console_chain {cmdlist w {ok 1}} {
3918 if {$ok} {
3919 if {[llength $cmdlist] == 0} {
3920 console_done $w $ok
3921 return
3922 }
3923 set cmd [lindex $cmdlist 0]
3925 set cmdlist [lrange $cmdlist 1 end]
3926 if {[lindex $cmd 0] eq {console_exec}} {
3928 console_exec $w \
3929 [lindex $cmd 1] \
3930 [list console_chain $cmdlist]
3931 } else {
3932 uplevel #0 $cmd $cmdlist $w $ok
3933 }
3934 } else {
3935 console_done $w $ok
3936 }
3937}
3938proc console_done {args} {
3940 global console_cr console_data
3941 switch -- [llength $args] {
3943 2 {
3944 set w [lindex $args 0]
3945 set ok [lindex $args 1]
3946 }
3947 3 {
3948 set w [lindex $args 1]
3949 set ok [lindex $args 2]
3950 }
3951 default {
3952 error "wrong number of args: console_done ?ignored? w ok"
3953 }
3954 }
3955 if {$ok} {
3957 if {[winfo exists $w]} {
3958 $w.m.s conf -background green -text {Success}
3959 $w.ok conf -state normal
3960 }
3961 } else {
3962 if {![winfo exists $w]} {
3963 console_init $w
3964 }
3965 $w.m.s conf -background red -text {Error: Command Failed}
3966 $w.ok conf -state normal
3967 }
3968 array unset console_cr $w
3970 array unset console_data $w
3971}
3972######################################################################
3974##
3975## ui commands
3976set starting_gitk_msg {Starting gitk... please wait...}
3978proc do_gitk {revs} {
3980 global env ui_status_value starting_gitk_msg
3981 # -- On Windows gitk is severly broken, and right now it seems like
3983 # nobody cares about fixing it. The only known workaround is to
3984 # always delete ~/.gitk before starting the program.
3985 #
3986 if {[is_Windows]} {
3987 catch {file delete [file join $env(HOME) .gitk]}
3988 }
3989 # -- Always start gitk through whatever we were loaded with. This
3991 # lets us bypass using shell process on Windows systems.
3992 #
3993 set cmd [info nameofexecutable]
3994 lappend cmd [gitexec gitk]
3995 if {$revs ne {}} {
3996 append cmd { }
3997 append cmd $revs
3998 }
3999 if {[catch {eval exec $cmd &} err]} {
4001 error_popup "Failed to start gitk:\n\n$err"
4002 } else {
4003 set ui_status_value $starting_gitk_msg
4004 after 10000 {
4005 if {$ui_status_value eq $starting_gitk_msg} {
4006 set ui_status_value {Ready.}
4007 }
4008 }
4009 }
4010}
4011proc do_stats {} {
4013 set fd [open "| git count-objects -v" r]
4014 while {[gets $fd line] > 0} {
4015 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4016 set stats($name) $value
4017 }
4018 }
4019 close $fd
4020 set packed_sz 0
4022 foreach p [glob -directory [gitdir objects pack] \
4023 -type f \
4024 -nocomplain -- *] {
4025 incr packed_sz [file size $p]
4026 }
4027 if {$packed_sz > 0} {
4028 set stats(size-pack) [expr {$packed_sz / 1024}]
4029 }
4030 set w .stats_view
4032 toplevel $w
4033 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4034 label $w.header -text {Database Statistics} \
4036 -font font_uibold
4037 pack $w.header -side top -fill x
4038 frame $w.buttons -border 1
4040 button $w.buttons.close -text Close \
4041 -font font_ui \
4042 -command [list destroy $w]
4043 button $w.buttons.gc -text {Compress Database} \
4044 -font font_ui \
4045 -command "destroy $w;do_gc"
4046 pack $w.buttons.close -side right
4047 pack $w.buttons.gc -side left
4048 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4049 frame $w.stat -borderwidth 1 -relief solid
4051 foreach s {
4052 {count {Number of loose objects}}
4053 {size {Disk space used by loose objects} { KiB}}
4054 {in-pack {Number of packed objects}}
4055 {packs {Number of packs}}
4056 {size-pack {Disk space used by packed objects} { KiB}}
4057 {prune-packable {Packed objects waiting for pruning}}
4058 {garbage {Garbage files}}
4059 } {
4060 set name [lindex $s 0]
4061 set label [lindex $s 1]
4062 if {[catch {set value $stats($name)}]} continue
4063 if {[llength $s] > 2} {
4064 set value "$value[lindex $s 2]"
4065 }
4066 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4068 label $w.stat.v_$name -text $value -anchor w -font font_ui
4069 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4070 }
4071 pack $w.stat -pady 10 -padx 10
4072 bind $w <Visibility> "grab $w; focus $w"
4074 bind $w <Key-Escape> [list destroy $w]
4075 bind $w <Key-Return> [list destroy $w]
4076 wm title $w "[appname] ([reponame]): Database Statistics"
4077 tkwait window $w
4078}
4079proc do_gc {} {
4081 set w [new_console {gc} {Compressing the object database}]
4082 console_chain {
4083 {console_exec {git pack-refs --prune}}
4084 {console_exec {git reflog expire --all}}
4085 {console_exec {git repack -a -d -l}}
4086 {console_exec {git rerere gc}}
4087 } $w
4088}
4089proc do_fsck_objects {} {
4091 set w [new_console {fsck-objects} \
4092 {Verifying the object database with fsck-objects}]
4093 set cmd [list git fsck-objects]
4094 lappend cmd --full
4095 lappend cmd --cache
4096 lappend cmd --strict
4097 console_exec $w $cmd console_done
4098}
4099set is_quitting 0
4101proc do_quit {} {
4103 global ui_comm is_quitting repo_config commit_type
4104 if {$is_quitting} return
4106 set is_quitting 1
4107 # -- Stash our current commit buffer.
4109 #
4110 set save [gitdir GITGUI_MSG]
4111 set msg [string trim [$ui_comm get 0.0 end]]
4112 regsub -all -line {[ \r\t]+$} $msg {} msg
4113 if {(![string match amend* $commit_type]
4114 || [$ui_comm edit modified])
4115 && $msg ne {}} {
4116 catch {
4117 set fd [open $save w]
4118 puts -nonewline $fd $msg
4119 close $fd
4120 }
4121 } else {
4122 catch {file delete $save}
4123 }
4124 # -- Stash our current window geometry into this repository.
4126 #
4127 set cfg_geometry [list]
4128 lappend cfg_geometry [wm geometry .]
4129 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4130 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4131 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4132 set rc_geometry {}
4133 }
4134 if {$cfg_geometry ne $rc_geometry} {
4135 catch {exec git repo-config gui.geometry $cfg_geometry}
4136 }
4137 destroy .
4139}
4140proc do_rescan {} {
4142 rescan {set ui_status_value {Ready.}}
4143}
4144proc unstage_helper {txt paths} {
4146 global file_states current_diff_path
4147 if {![lock_index begin-update]} return
4149 set pathList [list]
4151 set after {}
4152 foreach path $paths {
4153 switch -glob -- [lindex $file_states($path) 0] {
4154 A? -
4155 M? -
4156 D? {
4157 lappend pathList $path
4158 if {$path eq $current_diff_path} {
4159 set after {reshow_diff;}
4160 }
4161 }
4162 }
4163 }
4164 if {$pathList eq {}} {
4165 unlock_index
4166 } else {
4167 update_indexinfo \
4168 $txt \
4169 $pathList \
4170 [concat $after {set ui_status_value {Ready.}}]
4171 }
4172}
4173proc do_unstage_selection {} {
4175 global current_diff_path selected_paths
4176 if {[array size selected_paths] > 0} {
4178 unstage_helper \
4179 {Unstaging selected files from commit} \
4180 [array names selected_paths]
4181 } elseif {$current_diff_path ne {}} {
4182 unstage_helper \
4183 "Unstaging [short_path $current_diff_path] from commit" \
4184 [list $current_diff_path]
4185 }
4186}
4187proc add_helper {txt paths} {
4189 global file_states current_diff_path
4190 if {![lock_index begin-update]} return
4192 set pathList [list]
4194 set after {}
4195 foreach path $paths {
4196 switch -glob -- [lindex $file_states($path) 0] {
4197 _O -
4198 ?M -
4199 ?D -
4200 U? {
4201 lappend pathList $path
4202 if {$path eq $current_diff_path} {
4203 set after {reshow_diff;}
4204 }
4205 }
4206 }
4207 }
4208 if {$pathList eq {}} {
4209 unlock_index
4210 } else {
4211 update_index \
4212 $txt \
4213 $pathList \
4214 [concat $after {set ui_status_value {Ready to commit.}}]
4215 }
4216}
4217proc do_add_selection {} {
4219 global current_diff_path selected_paths
4220 if {[array size selected_paths] > 0} {
4222 add_helper \
4223 {Adding selected files} \
4224 [array names selected_paths]
4225 } elseif {$current_diff_path ne {}} {
4226 add_helper \
4227 "Adding [short_path $current_diff_path]" \
4228 [list $current_diff_path]
4229 }
4230}
4231proc do_add_all {} {
4233 global file_states
4234 set paths [list]
4236 foreach path [array names file_states] {
4237 switch -glob -- [lindex $file_states($path) 0] {
4238 U? {continue}
4239 ?M -
4240 ?D {lappend paths $path}
4241 }
4242 }
4243 add_helper {Adding all changed files} $paths
4244}
4245proc revert_helper {txt paths} {
4247 global file_states current_diff_path
4248 if {![lock_index begin-update]} return
4250 set pathList [list]
4252 set after {}
4253 foreach path $paths {
4254 switch -glob -- [lindex $file_states($path) 0] {
4255 U? {continue}
4256 ?M -
4257 ?D {
4258 lappend pathList $path
4259 if {$path eq $current_diff_path} {
4260 set after {reshow_diff;}
4261 }
4262 }
4263 }
4264 }
4265 set n [llength $pathList]
4267 if {$n == 0} {
4268 unlock_index
4269 return
4270 } elseif {$n == 1} {
4271 set s "[short_path [lindex $pathList]]"
4272 } else {
4273 set s "these $n files"
4274 }
4275 set reply [tk_dialog \
4277 .confirm_revert \
4278 "[appname] ([reponame])" \
4279 "Revert changes in $s?
4280Any unadded changes will be permanently lost by the revert." \
4282 question \
4283 1 \
4284 {Do Nothing} \
4285 {Revert Changes} \
4286 ]
4287 if {$reply == 1} {
4288 checkout_index \
4289 $txt \
4290 $pathList \
4291 [concat $after {set ui_status_value {Ready.}}]
4292 } else {
4293 unlock_index
4294 }
4295}
4296proc do_revert_selection {} {
4298 global current_diff_path selected_paths
4299 if {[array size selected_paths] > 0} {
4301 revert_helper \
4302 {Reverting selected files} \
4303 [array names selected_paths]
4304 } elseif {$current_diff_path ne {}} {
4305 revert_helper \
4306 "Reverting [short_path $current_diff_path]" \
4307 [list $current_diff_path]
4308 }
4309}
4310proc do_signoff {} {
4312 global ui_comm
4313 set me [committer_ident]
4315 if {$me eq {}} return
4316 set sob "Signed-off-by: $me"
4318 set last [$ui_comm get {end -1c linestart} {end -1c}]
4319 if {$last ne $sob} {
4320 $ui_comm edit separator
4321 if {$last ne {}
4322 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4323 $ui_comm insert end "\n"
4324 }
4325 $ui_comm insert end "\n$sob"
4326 $ui_comm edit separator
4327 $ui_comm see end
4328 }
4329}
4330proc do_select_commit_type {} {
4332 global commit_type selected_commit_type
4333 if {$selected_commit_type eq {new}
4335 && [string match amend* $commit_type]} {
4336 create_new_commit
4337 } elseif {$selected_commit_type eq {amend}
4338 && ![string match amend* $commit_type]} {
4339 load_last_commit
4340 # The amend request was rejected...
4342 #
4343 if {![string match amend* $commit_type]} {
4344 set selected_commit_type new
4345 }
4346 }
4347}
4348proc do_commit {} {
4350 commit_tree
4351}
4352proc do_about {} {
4354 global appvers copyright
4355 global tcl_patchLevel tk_patchLevel
4356 set w .about_dialog
4358 toplevel $w
4359 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4360 label $w.header -text "About [appname]" \
4362 -font font_uibold
4363 pack $w.header -side top -fill x
4364 frame $w.buttons
4366 button $w.buttons.close -text {Close} \
4367 -font font_ui \
4368 -command [list destroy $w]
4369 pack $w.buttons.close -side right
4370 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4371 label $w.desc \
4373 -text "[appname] - a commit creation tool for Git.
4374$copyright" \
4375 -padx 5 -pady 5 \
4376 -justify left \
4377 -anchor w \
4378 -borderwidth 1 \
4379 -relief solid \
4380 -font font_ui
4381 pack $w.desc -side top -fill x -padx 5 -pady 5
4382 set v {}
4384 append v "[appname] version $appvers\n"
4385 append v "[exec git version]\n"
4386 append v "\n"
4387 if {$tcl_patchLevel eq $tk_patchLevel} {
4388 append v "Tcl/Tk version $tcl_patchLevel"
4389 } else {
4390 append v "Tcl version $tcl_patchLevel"
4391 append v ", Tk version $tk_patchLevel"
4392 }
4393 label $w.vers \
4395 -text $v \
4396 -padx 5 -pady 5 \
4397 -justify left \
4398 -anchor w \
4399 -borderwidth 1 \
4400 -relief solid \
4401 -font font_ui
4402 pack $w.vers -side top -fill x -padx 5 -pady 5
4403 menu $w.ctxm -tearoff 0
4405 $w.ctxm add command \
4406 -label {Copy} \
4407 -font font_ui \
4408 -command "
4409 clipboard clear
4410 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4411 "
4412 bind $w <Visibility> "grab $w; focus $w"
4414 bind $w <Key-Escape> "destroy $w"
4415 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4416 wm title $w "About [appname]"
4417 tkwait window $w
4418}
4419proc do_options {} {
4421 global repo_config global_config font_descs
4422 global repo_config_new global_config_new
4423 array unset repo_config_new
4425 array unset global_config_new
4426 foreach name [array names repo_config] {
4427 set repo_config_new($name) $repo_config($name)
4428 }
4429 load_config 1
4430 foreach name [array names repo_config] {
4431 switch -- $name {
4432 gui.diffcontext {continue}
4433 }
4434 set repo_config_new($name) $repo_config($name)
4435 }
4436 foreach name [array names global_config] {
4437 set global_config_new($name) $global_config($name)
4438 }
4439 set w .options_editor
4441 toplevel $w
4442 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4443 label $w.header -text "[appname] Options" \
4445 -font font_uibold
4446 pack $w.header -side top -fill x
4447 frame $w.buttons
4449 button $w.buttons.restore -text {Restore Defaults} \
4450 -font font_ui \
4451 -command do_restore_defaults
4452 pack $w.buttons.restore -side left
4453 button $w.buttons.save -text Save \
4454 -font font_ui \
4455 -command [list do_save_config $w]
4456 pack $w.buttons.save -side right
4457 button $w.buttons.cancel -text {Cancel} \
4458 -font font_ui \
4459 -command [list destroy $w]
4460 pack $w.buttons.cancel -side right -padx 5
4461 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4462 labelframe $w.repo -text "[reponame] Repository" \
4464 -font font_ui
4465 labelframe $w.global -text {Global (All Repositories)} \
4466 -font font_ui
4467 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4468 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4469 set optid 0
4471 foreach option {
4472 {t user.name {User Name}}
4473 {t user.email {Email Address}}
4474 {b merge.summary {Summarize Merge Commits}}
4476 {i-1..5 merge.verbosity {Merge Verbosity}}
4477 {b gui.trustmtime {Trust File Modification Timestamps}}
4479 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4480 {t gui.newbranchtemplate {New Branch Name Template}}
4481 } {
4482 set type [lindex $option 0]
4483 set name [lindex $option 1]
4484 set text [lindex $option 2]
4485 incr optid
4486 foreach f {repo global} {
4487 switch -glob -- $type {
4488 b {
4489 checkbutton $w.$f.$optid -text $text \
4490 -variable ${f}_config_new($name) \
4491 -onvalue true \
4492 -offvalue false \
4493 -font font_ui
4494 pack $w.$f.$optid -side top -anchor w
4495 }
4496 i-* {
4497 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4498 frame $w.$f.$optid
4499 label $w.$f.$optid.l -text "$text:" -font font_ui
4500 pack $w.$f.$optid.l -side left -anchor w -fill x
4501 spinbox $w.$f.$optid.v \
4502 -textvariable ${f}_config_new($name) \
4503 -from $min \
4504 -to $max \
4505 -increment 1 \
4506 -width [expr {1 + [string length $max]}] \
4507 -font font_ui
4508 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4509 pack $w.$f.$optid.v -side right -anchor e -padx 5
4510 pack $w.$f.$optid -side top -anchor w -fill x
4511 }
4512 t {
4513 frame $w.$f.$optid
4514 label $w.$f.$optid.l -text "$text:" -font font_ui
4515 entry $w.$f.$optid.v \
4516 -borderwidth 1 \
4517 -relief sunken \
4518 -width 20 \
4519 -textvariable ${f}_config_new($name) \
4520 -font font_ui
4521 pack $w.$f.$optid.l -side left -anchor w
4522 pack $w.$f.$optid.v -side left -anchor w \
4523 -fill x -expand 1 \
4524 -padx 5
4525 pack $w.$f.$optid -side top -anchor w -fill x
4526 }
4527 }
4528 }
4529 }
4530 set all_fonts [lsort [font families]]
4532 foreach option $font_descs {
4533 set name [lindex $option 0]
4534 set font [lindex $option 1]
4535 set text [lindex $option 2]
4536 set global_config_new(gui.$font^^family) \
4538 [font configure $font -family]
4539 set global_config_new(gui.$font^^size) \
4540 [font configure $font -size]
4541 frame $w.global.$name
4543 label $w.global.$name.l -text "$text:" -font font_ui
4544 pack $w.global.$name.l -side left -anchor w -fill x
4545 eval tk_optionMenu $w.global.$name.family \
4546 global_config_new(gui.$font^^family) \
4547 $all_fonts
4548 spinbox $w.global.$name.size \
4549 -textvariable global_config_new(gui.$font^^size) \
4550 -from 2 -to 80 -increment 1 \
4551 -width 3 \
4552 -font font_ui
4553 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4554 pack $w.global.$name.size -side right -anchor e
4555 pack $w.global.$name.family -side right -anchor e
4556 pack $w.global.$name -side top -anchor w -fill x
4557 }
4558 bind $w <Visibility> "grab $w; focus $w"
4560 bind $w <Key-Escape> "destroy $w"
4561 wm title $w "[appname] ([reponame]): Options"
4562 tkwait window $w
4563}
4564proc do_restore_defaults {} {
4566 global font_descs default_config repo_config
4567 global repo_config_new global_config_new
4568 foreach name [array names default_config] {
4570 set repo_config_new($name) $default_config($name)
4571 set global_config_new($name) $default_config($name)
4572 }
4573 foreach option $font_descs {
4575 set name [lindex $option 0]
4576 set repo_config(gui.$name) $default_config(gui.$name)
4577 }
4578 apply_config
4579 foreach option $font_descs {
4581 set name [lindex $option 0]
4582 set font [lindex $option 1]
4583 set global_config_new(gui.$font^^family) \
4584 [font configure $font -family]
4585 set global_config_new(gui.$font^^size) \
4586 [font configure $font -size]
4587 }
4588}
4589proc do_save_config {w} {
4591 if {[catch {save_config} err]} {
4592 error_popup "Failed to completely save options:\n\n$err"
4593 }
4594 reshow_diff
4595 destroy $w
4596}
4597proc do_windows_shortcut {} {
4599 global argv0
4600 set fn [tk_getSaveFile \
4602 -parent . \
4603 -title "[appname] ([reponame]): Create Desktop Icon" \
4604 -initialfile "Git [reponame].bat"]
4605 if {$fn != {}} {
4606 if {[catch {
4607 set fd [open $fn w]
4608 puts $fd "@ECHO Entering [reponame]"
4609 puts $fd "@ECHO Starting git-gui... please wait..."
4610 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4611 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4612 puts -nonewline $fd "@\"[info nameofexecutable]\""
4613 puts $fd " \"[file normalize $argv0]\""
4614 close $fd
4615 } err]} {
4616 error_popup "Cannot write script:\n\n$err"
4617 }
4618 }
4619}
4620proc do_cygwin_shortcut {} {
4622 global argv0
4623 if {[catch {
4625 set desktop [exec cygpath \
4626 --windows \
4627 --absolute \
4628 --long-name \
4629 --desktop]
4630 }]} {
4631 set desktop .
4632 }
4633 set fn [tk_getSaveFile \
4634 -parent . \
4635 -title "[appname] ([reponame]): Create Desktop Icon" \
4636 -initialdir $desktop \
4637 -initialfile "Git [reponame].bat"]
4638 if {$fn != {}} {
4639 if {[catch {
4640 set fd [open $fn w]
4641 set sh [exec cygpath \
4642 --windows \
4643 --absolute \
4644 /bin/sh]
4645 set me [exec cygpath \
4646 --unix \
4647 --absolute \
4648 $argv0]
4649 set gd [exec cygpath \
4650 --unix \
4651 --absolute \
4652 [gitdir]]
4653 set gw [exec cygpath \
4654 --windows \
4655 --absolute \
4656 [file dirname [gitdir]]]
4657 regsub -all ' $me "'\\''" me
4658 regsub -all ' $gd "'\\''" gd
4659 puts $fd "@ECHO Entering $gw"
4660 puts $fd "@ECHO Starting git-gui... please wait..."
4661 puts -nonewline $fd "@\"$sh\" --login -c \""
4662 puts -nonewline $fd "GIT_DIR='$gd'"
4663 puts -nonewline $fd " '$me'"
4664 puts $fd "&\""
4665 close $fd
4666 } err]} {
4667 error_popup "Cannot write script:\n\n$err"
4668 }
4669 }
4670}
4671proc do_macosx_app {} {
4673 global argv0 env
4674 set fn [tk_getSaveFile \
4676 -parent . \
4677 -title "[appname] ([reponame]): Create Desktop Icon" \
4678 -initialdir [file join $env(HOME) Desktop] \
4679 -initialfile "Git [reponame].app"]
4680 if {$fn != {}} {
4681 if {[catch {
4682 set Contents [file join $fn Contents]
4683 set MacOS [file join $Contents MacOS]
4684 set exe [file join $MacOS git-gui]
4685 file mkdir $MacOS
4687 set fd [open [file join $Contents Info.plist] w]
4689 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4690<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4691<plist version="1.0">
4692<dict>
4693 <key>CFBundleDevelopmentRegion</key>
4694 <string>English</string>
4695 <key>CFBundleExecutable</key>
4696 <string>git-gui</string>
4697 <key>CFBundleIdentifier</key>
4698 <string>org.spearce.git-gui</string>
4699 <key>CFBundleInfoDictionaryVersion</key>
4700 <string>6.0</string>
4701 <key>CFBundlePackageType</key>
4702 <string>APPL</string>
4703 <key>CFBundleSignature</key>
4704 <string>????</string>
4705 <key>CFBundleVersion</key>
4706 <string>1.0</string>
4707 <key>NSPrincipalClass</key>
4708 <string>NSApplication</string>
4709</dict>
4710</plist>}
4711 close $fd
4712 set fd [open $exe w]
4714 set gd [file normalize [gitdir]]
4715 set ep [file normalize [gitexec]]
4716 regsub -all ' $gd "'\\''" gd
4717 regsub -all ' $ep "'\\''" ep
4718 puts $fd "#!/bin/sh"
4719 foreach name [array names env] {
4720 if {[string match GIT_* $name]} {
4721 regsub -all ' $env($name) "'\\''" v
4722 puts $fd "export $name='$v'"
4723 }
4724 }
4725 puts $fd "export PATH='$ep':\$PATH"
4726 puts $fd "export GIT_DIR='$gd'"
4727 puts $fd "exec [file normalize $argv0]"
4728 close $fd
4729 file attributes $exe -permissions u+x,g+x,o+x
4731 } err]} {
4732 error_popup "Cannot write icon:\n\n$err"
4733 }
4734 }
4735}
4736proc toggle_or_diff {w x y} {
4738 global file_states file_lists current_diff_path ui_index ui_workdir
4739 global last_clicked selected_paths
4740 set pos [split [$w index @$x,$y] .]
4742 set lno [lindex $pos 0]
4743 set col [lindex $pos 1]
4744 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4745 if {$path eq {}} {
4746 set last_clicked {}
4747 return
4748 }
4749 set last_clicked [list $w $lno]
4751 array unset selected_paths
4752 $ui_index tag remove in_sel 0.0 end
4753 $ui_workdir tag remove in_sel 0.0 end
4754 if {$col == 0} {
4756 if {$current_diff_path eq $path} {
4757 set after {reshow_diff;}
4758 } else {
4759 set after {}
4760 }
4761 if {$w eq $ui_index} {
4762 update_indexinfo \
4763 "Unstaging [short_path $path] from commit" \
4764 [list $path] \
4765 [concat $after {set ui_status_value {Ready.}}]
4766 } elseif {$w eq $ui_workdir} {
4767 update_index \
4768 "Adding [short_path $path]" \
4769 [list $path] \
4770 [concat $after {set ui_status_value {Ready.}}]
4771 }
4772 } else {
4773 show_diff $path $w $lno
4774 }
4775}
4776proc add_one_to_selection {w x y} {
4778 global file_lists last_clicked selected_paths
4779 set lno [lindex [split [$w index @$x,$y] .] 0]
4781 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4782 if {$path eq {}} {
4783 set last_clicked {}
4784 return
4785 }
4786 if {$last_clicked ne {}
4788 && [lindex $last_clicked 0] ne $w} {
4789 array unset selected_paths
4790 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4791 }
4792 set last_clicked [list $w $lno]
4794 if {[catch {set in_sel $selected_paths($path)}]} {
4795 set in_sel 0
4796 }
4797 if {$in_sel} {
4798 unset selected_paths($path)
4799 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4800 } else {
4801 set selected_paths($path) 1
4802 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4803 }
4804}
4805proc add_range_to_selection {w x y} {
4807 global file_lists last_clicked selected_paths
4808 if {[lindex $last_clicked 0] ne $w} {
4810 toggle_or_diff $w $x $y
4811 return
4812 }
4813 set lno [lindex [split [$w index @$x,$y] .] 0]
4815 set lc [lindex $last_clicked 1]
4816 if {$lc < $lno} {
4817 set begin $lc
4818 set end $lno
4819 } else {
4820 set begin $lno
4821 set end $lc
4822 }
4823 foreach path [lrange $file_lists($w) \
4825 [expr {$begin - 1}] \
4826 [expr {$end - 1}]] {
4827 set selected_paths($path) 1
4828 }
4829 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4830}
4831######################################################################
4833##
4834## config defaults
4835set cursor_ptr arrow
4837font create font_diff -family Courier -size 10
4838font create font_ui
4839catch {
4840 label .dummy
4841 eval font configure font_ui [font actual [.dummy cget -font]]
4842 destroy .dummy
4843}
4844font create font_uibold
4846font create font_diffbold
4847if {[is_Windows]} {
4849 set M1B Control
4850 set M1T Ctrl
4851} elseif {[is_MacOSX]} {
4852 set M1B M1
4853 set M1T Cmd
4854} else {
4855 set M1B M1
4856 set M1T M1
4857}
4858proc apply_config {} {
4860 global repo_config font_descs
4861 foreach option $font_descs {
4863 set name [lindex $option 0]
4864 set font [lindex $option 1]
4865 if {[catch {
4866 foreach {cn cv} $repo_config(gui.$name) {
4867 font configure $font $cn $cv
4868 }
4869 } err]} {
4870 error_popup "Invalid font specified in gui.$name:\n\n$err"
4871 }
4872 foreach {cn cv} [font configure $font] {
4873 font configure ${font}bold $cn $cv
4874 }
4875 font configure ${font}bold -weight bold
4876 }
4877}
4878set default_config(merge.summary) false
4880set default_config(merge.verbosity) 2
4881set default_config(user.name) {}
4882set default_config(user.email) {}
4883set default_config(gui.trustmtime) false
4885set default_config(gui.diffcontext) 5
4886set default_config(gui.newbranchtemplate) {}
4887set default_config(gui.fontui) [font configure font_ui]
4888set default_config(gui.fontdiff) [font configure font_diff]
4889set font_descs {
4890 {fontui font_ui {Main Font}}
4891 {fontdiff font_diff {Diff/Console Font}}
4892}
4893load_config 0
4894apply_config
4895######################################################################
4897##
4898## ui construction
4899# -- Menu Bar
4901#
4902menu .mbar -tearoff 0
4903.mbar add cascade -label Repository -menu .mbar.repository
4904.mbar add cascade -label Edit -menu .mbar.edit
4905if {!$single_commit} {
4906 .mbar add cascade -label Branch -menu .mbar.branch
4907}
4908.mbar add cascade -label Commit -menu .mbar.commit
4909if {!$single_commit} {
4910 .mbar add cascade -label Merge -menu .mbar.merge
4911 .mbar add cascade -label Fetch -menu .mbar.fetch
4912 .mbar add cascade -label Push -menu .mbar.push
4913}
4914. configure -menu .mbar
4915# -- Repository Menu
4917#
4918menu .mbar.repository
4919.mbar.repository add command \
4921 -label {Browse Current Branch} \
4922 -command {new_browser $current_branch} \
4923 -font font_ui
4924.mbar.repository add separator
4925.mbar.repository add command \
4927 -label {Visualize Current Branch} \
4928 -command {do_gitk {}} \
4929 -font font_ui
4930.mbar.repository add command \
4931 -label {Visualize All Branches} \
4932 -command {do_gitk {--all}} \
4933 -font font_ui
4934.mbar.repository add separator
4935if {!$single_commit} {
4937 .mbar.repository add command -label {Database Statistics} \
4938 -command do_stats \
4939 -font font_ui
4940 .mbar.repository add command -label {Compress Database} \
4942 -command do_gc \
4943 -font font_ui
4944 .mbar.repository add command -label {Verify Database} \
4946 -command do_fsck_objects \
4947 -font font_ui
4948 .mbar.repository add separator
4950 if {[is_Cygwin]} {
4952 .mbar.repository add command \
4953 -label {Create Desktop Icon} \
4954 -command do_cygwin_shortcut \
4955 -font font_ui
4956 } elseif {[is_Windows]} {
4957 .mbar.repository add command \
4958 -label {Create Desktop Icon} \
4959 -command do_windows_shortcut \
4960 -font font_ui
4961 } elseif {[is_MacOSX]} {
4962 .mbar.repository add command \
4963 -label {Create Desktop Icon} \
4964 -command do_macosx_app \
4965 -font font_ui
4966 }
4967}
4968.mbar.repository add command -label Quit \
4970 -command do_quit \
4971 -accelerator $M1T-Q \
4972 -font font_ui
4973# -- Edit Menu
4975#
4976menu .mbar.edit
4977.mbar.edit add command -label Undo \
4978 -command {catch {[focus] edit undo}} \
4979 -accelerator $M1T-Z \
4980 -font font_ui
4981.mbar.edit add command -label Redo \
4982 -command {catch {[focus] edit redo}} \
4983 -accelerator $M1T-Y \
4984 -font font_ui
4985.mbar.edit add separator
4986.mbar.edit add command -label Cut \
4987 -command {catch {tk_textCut [focus]}} \
4988 -accelerator $M1T-X \
4989 -font font_ui
4990.mbar.edit add command -label Copy \
4991 -command {catch {tk_textCopy [focus]}} \
4992 -accelerator $M1T-C \
4993 -font font_ui
4994.mbar.edit add command -label Paste \
4995 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4996 -accelerator $M1T-V \
4997 -font font_ui
4998.mbar.edit add command -label Delete \
4999 -command {catch {[focus] delete sel.first sel.last}} \
5000 -accelerator Del \
5001 -font font_ui
5002.mbar.edit add separator
5003.mbar.edit add command -label {Select All} \
5004 -command {catch {[focus] tag add sel 0.0 end}} \
5005 -accelerator $M1T-A \
5006 -font font_ui
5007# -- Branch Menu
5009#
5010if {!$single_commit} {
5011 menu .mbar.branch
5012 .mbar.branch add command -label {Create...} \
5014 -command do_create_branch \
5015 -accelerator $M1T-N \
5016 -font font_ui
5017 lappend disable_on_lock [list .mbar.branch entryconf \
5018 [.mbar.branch index last] -state]
5019 .mbar.branch add command -label {Delete...} \
5021 -command do_delete_branch \
5022 -font font_ui
5023 lappend disable_on_lock [list .mbar.branch entryconf \
5024 [.mbar.branch index last] -state]
5025}
5026# -- Commit Menu
5028#
5029menu .mbar.commit
5030.mbar.commit add radiobutton \
5032 -label {New Commit} \
5033 -command do_select_commit_type \
5034 -variable selected_commit_type \
5035 -value new \
5036 -font font_ui
5037lappend disable_on_lock \
5038 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5039.mbar.commit add radiobutton \
5041 -label {Amend Last Commit} \
5042 -command do_select_commit_type \
5043 -variable selected_commit_type \
5044 -value amend \
5045 -font font_ui
5046lappend disable_on_lock \
5047 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5048.mbar.commit add separator
5050.mbar.commit add command -label Rescan \
5052 -command do_rescan \
5053 -accelerator F5 \
5054 -font font_ui
5055lappend disable_on_lock \
5056 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5057.mbar.commit add command -label {Add To Commit} \
5059 -command do_add_selection \
5060 -font font_ui
5061lappend disable_on_lock \
5062 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5063.mbar.commit add command -label {Add All To Commit} \
5065 -command do_add_all \
5066 -accelerator $M1T-I \
5067 -font font_ui
5068lappend disable_on_lock \
5069 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5070.mbar.commit add command -label {Unstage From Commit} \
5072 -command do_unstage_selection \
5073 -font font_ui
5074lappend disable_on_lock \
5075 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5076.mbar.commit add command -label {Revert Changes} \
5078 -command do_revert_selection \
5079 -font font_ui
5080lappend disable_on_lock \
5081 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5082.mbar.commit add separator
5084.mbar.commit add command -label {Sign Off} \
5086 -command do_signoff \
5087 -accelerator $M1T-S \
5088 -font font_ui
5089.mbar.commit add command -label Commit \
5091 -command do_commit \
5092 -accelerator $M1T-Return \
5093 -font font_ui
5094lappend disable_on_lock \
5095 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5096if {[is_MacOSX]} {
5098 # -- Apple Menu (Mac OS X only)
5099 #
5100 .mbar add cascade -label Apple -menu .mbar.apple
5101 menu .mbar.apple
5102 .mbar.apple add command -label "About [appname]" \
5104 -command do_about \
5105 -font font_ui
5106 .mbar.apple add command -label "[appname] Options..." \
5107 -command do_options \
5108 -font font_ui
5109} else {
5110 # -- Edit Menu
5111 #
5112 .mbar.edit add separator
5113 .mbar.edit add command -label {Options...} \
5114 -command do_options \
5115 -font font_ui
5116 # -- Tools Menu
5118 #
5119 if {[file exists /usr/local/miga/lib/gui-miga]
5120 && [file exists .pvcsrc]} {
5121 proc do_miga {} {
5122 global ui_status_value
5123 if {![lock_index update]} return
5124 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5125 set miga_fd [open "|$cmd" r]
5126 fconfigure $miga_fd -blocking 0
5127 fileevent $miga_fd readable [list miga_done $miga_fd]
5128 set ui_status_value {Running miga...}
5129 }
5130 proc miga_done {fd} {
5131 read $fd 512
5132 if {[eof $fd]} {
5133 close $fd
5134 unlock_index
5135 rescan [list set ui_status_value {Ready.}]
5136 }
5137 }
5138 .mbar add cascade -label Tools -menu .mbar.tools
5139 menu .mbar.tools
5140 .mbar.tools add command -label "Migrate" \
5141 -command do_miga \
5142 -font font_ui
5143 lappend disable_on_lock \
5144 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5145 }
5146}
5147# -- Help Menu
5149#
5150.mbar add cascade -label Help -menu .mbar.help
5151menu .mbar.help
5152if {![is_MacOSX]} {
5154 .mbar.help add command -label "About [appname]" \
5155 -command do_about \
5156 -font font_ui
5157}
5158set browser {}
5160catch {set browser $repo_config(instaweb.browser)}
5161set doc_path [file dirname [gitexec]]
5162set doc_path [file join $doc_path Documentation index.html]
5163if {[is_Cygwin]} {
5165 set doc_path [exec cygpath --windows $doc_path]
5166}
5167if {$browser eq {}} {
5169 if {[is_MacOSX]} {
5170 set browser open
5171 } elseif {[is_Cygwin]} {
5172 set program_files [file dirname [exec cygpath --windir]]
5173 set program_files [file join $program_files {Program Files}]
5174 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5175 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5176 if {[file exists $firefox]} {
5177 set browser $firefox
5178 } elseif {[file exists $ie]} {
5179 set browser $ie
5180 }
5181 unset program_files firefox ie
5182 }
5183}
5184if {[file isfile $doc_path]} {
5186 set doc_url "file:$doc_path"
5187} else {
5188 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5189}
5190if {$browser ne {}} {
5192 .mbar.help add command -label {Online Documentation} \
5193 -command [list exec $browser $doc_url &] \
5194 -font font_ui
5195}
5196unset browser doc_path doc_url
5197# -- Branch Control
5199#
5200frame .branch \
5201 -borderwidth 1 \
5202 -relief sunken
5203label .branch.l1 \
5204 -text {Current Branch:} \
5205 -anchor w \
5206 -justify left \
5207 -font font_ui
5208label .branch.cb \
5209 -textvariable current_branch \
5210 -anchor w \
5211 -justify left \
5212 -font font_ui
5213pack .branch.l1 -side left
5214pack .branch.cb -side left -fill x
5215pack .branch -side top -fill x
5216if {!$single_commit} {
5218 menu .mbar.merge
5219 .mbar.merge add command -label {Local Merge...} \
5220 -command do_local_merge \
5221 -font font_ui
5222 lappend disable_on_lock \
5223 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5224 .mbar.merge add command -label {Abort Merge...} \
5225 -command do_reset_hard \
5226 -font font_ui
5227 lappend disable_on_lock \
5228 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5229 menu .mbar.fetch
5232 menu .mbar.push
5234 .mbar.push add command -label {Push...} \
5235 -command do_push_anywhere \
5236 -font font_ui
5237}
5238# -- Main Window Layout
5240#
5241panedwindow .vpane -orient vertical
5242panedwindow .vpane.files -orient horizontal
5243.vpane add .vpane.files -sticky nsew -height 100 -width 200
5244pack .vpane -anchor n -side top -fill both -expand 1
5245# -- Index File List
5247#
5248frame .vpane.files.index -height 100 -width 200
5249label .vpane.files.index.title -text {Changes To Be Committed} \
5250 -background green \
5251 -font font_ui
5252text $ui_index -background white -borderwidth 0 \
5253 -width 20 -height 10 \
5254 -wrap none \
5255 -font font_ui \
5256 -cursor $cursor_ptr \
5257 -xscrollcommand {.vpane.files.index.sx set} \
5258 -yscrollcommand {.vpane.files.index.sy set} \
5259 -state disabled
5260scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5261scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5262pack .vpane.files.index.title -side top -fill x
5263pack .vpane.files.index.sx -side bottom -fill x
5264pack .vpane.files.index.sy -side right -fill y
5265pack $ui_index -side left -fill both -expand 1
5266.vpane.files add .vpane.files.index -sticky nsew
5267# -- Working Directory File List
5269#
5270frame .vpane.files.workdir -height 100 -width 200
5271label .vpane.files.workdir.title -text {Changed But Not Updated} \
5272 -background red \
5273 -font font_ui
5274text $ui_workdir -background white -borderwidth 0 \
5275 -width 20 -height 10 \
5276 -wrap none \
5277 -font font_ui \
5278 -cursor $cursor_ptr \
5279 -xscrollcommand {.vpane.files.workdir.sx set} \
5280 -yscrollcommand {.vpane.files.workdir.sy set} \
5281 -state disabled
5282scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5283scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5284pack .vpane.files.workdir.title -side top -fill x
5285pack .vpane.files.workdir.sx -side bottom -fill x
5286pack .vpane.files.workdir.sy -side right -fill y
5287pack $ui_workdir -side left -fill both -expand 1
5288.vpane.files add .vpane.files.workdir -sticky nsew
5289foreach i [list $ui_index $ui_workdir] {
5291 $i tag conf in_diff -font font_uibold
5292 $i tag conf in_sel \
5293 -background [$i cget -foreground] \
5294 -foreground [$i cget -background]
5295}
5296unset i
5297# -- Diff and Commit Area
5299#
5300frame .vpane.lower -height 300 -width 400
5301frame .vpane.lower.commarea
5302frame .vpane.lower.diff -relief sunken -borderwidth 1
5303pack .vpane.lower.commarea -side top -fill x
5304pack .vpane.lower.diff -side bottom -fill both -expand 1
5305.vpane add .vpane.lower -sticky nsew
5306# -- Commit Area Buttons
5308#
5309frame .vpane.lower.commarea.buttons
5310label .vpane.lower.commarea.buttons.l -text {} \
5311 -anchor w \
5312 -justify left \
5313 -font font_ui
5314pack .vpane.lower.commarea.buttons.l -side top -fill x
5315pack .vpane.lower.commarea.buttons -side left -fill y
5316button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5318 -command do_rescan \
5319 -font font_ui
5320pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5321lappend disable_on_lock \
5322 {.vpane.lower.commarea.buttons.rescan conf -state}
5323button .vpane.lower.commarea.buttons.incall -text {Add All} \
5325 -command do_add_all \
5326 -font font_ui
5327pack .vpane.lower.commarea.buttons.incall -side top -fill x
5328lappend disable_on_lock \
5329 {.vpane.lower.commarea.buttons.incall conf -state}
5330button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5332 -command do_signoff \
5333 -font font_ui
5334pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5335button .vpane.lower.commarea.buttons.commit -text {Commit} \
5337 -command do_commit \
5338 -font font_ui
5339pack .vpane.lower.commarea.buttons.commit -side top -fill x
5340lappend disable_on_lock \
5341 {.vpane.lower.commarea.buttons.commit conf -state}
5342# -- Commit Message Buffer
5344#
5345frame .vpane.lower.commarea.buffer
5346frame .vpane.lower.commarea.buffer.header
5347set ui_comm .vpane.lower.commarea.buffer.t
5348set ui_coml .vpane.lower.commarea.buffer.header.l
5349radiobutton .vpane.lower.commarea.buffer.header.new \
5350 -text {New Commit} \
5351 -command do_select_commit_type \
5352 -variable selected_commit_type \
5353 -value new \
5354 -font font_ui
5355lappend disable_on_lock \
5356 [list .vpane.lower.commarea.buffer.header.new conf -state]
5357radiobutton .vpane.lower.commarea.buffer.header.amend \
5358 -text {Amend Last Commit} \
5359 -command do_select_commit_type \
5360 -variable selected_commit_type \
5361 -value amend \
5362 -font font_ui
5363lappend disable_on_lock \
5364 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5365label $ui_coml \
5366 -anchor w \
5367 -justify left \
5368 -font font_ui
5369proc trace_commit_type {varname args} {
5370 global ui_coml commit_type
5371 switch -glob -- $commit_type {
5372 initial {set txt {Initial Commit Message:}}
5373 amend {set txt {Amended Commit Message:}}
5374 amend-initial {set txt {Amended Initial Commit Message:}}
5375 amend-merge {set txt {Amended Merge Commit Message:}}
5376 merge {set txt {Merge Commit Message:}}
5377 * {set txt {Commit Message:}}
5378 }
5379 $ui_coml conf -text $txt
5380}
5381trace add variable commit_type write trace_commit_type
5382pack $ui_coml -side left -fill x
5383pack .vpane.lower.commarea.buffer.header.amend -side right
5384pack .vpane.lower.commarea.buffer.header.new -side right
5385text $ui_comm -background white -borderwidth 1 \
5387 -undo true \
5388 -maxundo 20 \
5389 -autoseparators true \
5390 -relief sunken \
5391 -width 75 -height 9 -wrap none \
5392 -font font_diff \
5393 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5394scrollbar .vpane.lower.commarea.buffer.sby \
5395 -command [list $ui_comm yview]
5396pack .vpane.lower.commarea.buffer.header -side top -fill x
5397pack .vpane.lower.commarea.buffer.sby -side right -fill y
5398pack $ui_comm -side left -fill y
5399pack .vpane.lower.commarea.buffer -side left -fill y
5400# -- Commit Message Buffer Context Menu
5402#
5403set ctxm .vpane.lower.commarea.buffer.ctxm
5404menu $ctxm -tearoff 0
5405$ctxm add command \
5406 -label {Cut} \
5407 -font font_ui \
5408 -command {tk_textCut $ui_comm}
5409$ctxm add command \
5410 -label {Copy} \
5411 -font font_ui \
5412 -command {tk_textCopy $ui_comm}
5413$ctxm add command \
5414 -label {Paste} \
5415 -font font_ui \
5416 -command {tk_textPaste $ui_comm}
5417$ctxm add command \
5418 -label {Delete} \
5419 -font font_ui \
5420 -command {$ui_comm delete sel.first sel.last}
5421$ctxm add separator
5422$ctxm add command \
5423 -label {Select All} \
5424 -font font_ui \
5425 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5426$ctxm add command \
5427 -label {Copy All} \
5428 -font font_ui \
5429 -command {
5430 $ui_comm tag add sel 0.0 end
5431 tk_textCopy $ui_comm
5432 $ui_comm tag remove sel 0.0 end
5433 }
5434$ctxm add separator
5435$ctxm add command \
5436 -label {Sign Off} \
5437 -font font_ui \
5438 -command do_signoff
5439bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5440# -- Diff Header
5442#
5443set current_diff_path {}
5444set current_diff_side {}
5445set diff_actions [list]
5446proc trace_current_diff_path {varname args} {
5447 global current_diff_path diff_actions file_states
5448 if {$current_diff_path eq {}} {
5449 set s {}
5450 set f {}
5451 set p {}
5452 set o disabled
5453 } else {
5454 set p $current_diff_path
5455 set s [mapdesc [lindex $file_states($p) 0] $p]
5456 set f {File:}
5457 set p [escape_path $p]
5458 set o normal
5459 }
5460 .vpane.lower.diff.header.status configure -text $s
5462 .vpane.lower.diff.header.file configure -text $f
5463 .vpane.lower.diff.header.path configure -text $p
5464 foreach w $diff_actions {
5465 uplevel #0 $w $o
5466 }
5467}
5468trace add variable current_diff_path write trace_current_diff_path
5469frame .vpane.lower.diff.header -background orange
5471label .vpane.lower.diff.header.status \
5472 -background orange \
5473 -width $max_status_desc \
5474 -anchor w \
5475 -justify left \
5476 -font font_ui
5477label .vpane.lower.diff.header.file \
5478 -background orange \
5479 -anchor w \
5480 -justify left \
5481 -font font_ui
5482label .vpane.lower.diff.header.path \
5483 -background orange \
5484 -anchor w \
5485 -justify left \
5486 -font font_ui
5487pack .vpane.lower.diff.header.status -side left
5488pack .vpane.lower.diff.header.file -side left
5489pack .vpane.lower.diff.header.path -fill x
5490set ctxm .vpane.lower.diff.header.ctxm
5491menu $ctxm -tearoff 0
5492$ctxm add command \
5493 -label {Copy} \
5494 -font font_ui \
5495 -command {
5496 clipboard clear
5497 clipboard append \
5498 -format STRING \
5499 -type STRING \
5500 -- $current_diff_path
5501 }
5502lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5503bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5504# -- Diff Body
5506#
5507frame .vpane.lower.diff.body
5508set ui_diff .vpane.lower.diff.body.t
5509text $ui_diff -background white -borderwidth 0 \
5510 -width 80 -height 15 -wrap none \
5511 -font font_diff \
5512 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5513 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5514 -state disabled
5515scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5516 -command [list $ui_diff xview]
5517scrollbar .vpane.lower.diff.body.sby -orient vertical \
5518 -command [list $ui_diff yview]
5519pack .vpane.lower.diff.body.sbx -side bottom -fill x
5520pack .vpane.lower.diff.body.sby -side right -fill y
5521pack $ui_diff -side left -fill both -expand 1
5522pack .vpane.lower.diff.header -side top -fill x
5523pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5524$ui_diff tag conf d_cr -elide true
5526$ui_diff tag conf d_@ -foreground blue -font font_diffbold
5527$ui_diff tag conf d_+ -foreground {#00a000}
5528$ui_diff tag conf d_- -foreground red
5529$ui_diff tag conf d_++ -foreground {#00a000}
5531$ui_diff tag conf d_-- -foreground red
5532$ui_diff tag conf d_+s \
5533 -foreground {#00a000} \
5534 -background {#e2effa}
5535$ui_diff tag conf d_-s \
5536 -foreground red \
5537 -background {#e2effa}
5538$ui_diff tag conf d_s+ \
5539 -foreground {#00a000} \
5540 -background ivory1
5541$ui_diff tag conf d_s- \
5542 -foreground red \
5543 -background ivory1
5544$ui_diff tag conf d<<<<<<< \
5546 -foreground orange \
5547 -font font_diffbold
5548$ui_diff tag conf d======= \
5549 -foreground orange \
5550 -font font_diffbold
5551$ui_diff tag conf d>>>>>>> \
5552 -foreground orange \
5553 -font font_diffbold
5554$ui_diff tag raise sel
5556# -- Diff Body Context Menu
5558#
5559set ctxm .vpane.lower.diff.body.ctxm
5560menu $ctxm -tearoff 0
5561$ctxm add command \
5562 -label {Refresh} \
5563 -font font_ui \
5564 -command reshow_diff
5565lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5566$ctxm add command \
5567 -label {Copy} \
5568 -font font_ui \
5569 -command {tk_textCopy $ui_diff}
5570lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5571$ctxm add command \
5572 -label {Select All} \
5573 -font font_ui \
5574 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5575lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5576$ctxm add command \
5577 -label {Copy All} \
5578 -font font_ui \
5579 -command {
5580 $ui_diff tag add sel 0.0 end
5581 tk_textCopy $ui_diff
5582 $ui_diff tag remove sel 0.0 end
5583 }
5584lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5585$ctxm add separator
5586$ctxm add command \
5587 -label {Apply/Reverse Hunk} \
5588 -font font_ui \
5589 -command {apply_hunk $cursorX $cursorY}
5590set ui_diff_applyhunk [$ctxm index last]
5591lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5592$ctxm add separator
5593$ctxm add command \
5594 -label {Decrease Font Size} \
5595 -font font_ui \
5596 -command {incr_font_size font_diff -1}
5597lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5598$ctxm add command \
5599 -label {Increase Font Size} \
5600 -font font_ui \
5601 -command {incr_font_size font_diff 1}
5602lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5603$ctxm add separator
5604$ctxm add command \
5605 -label {Show Less Context} \
5606 -font font_ui \
5607 -command {if {$repo_config(gui.diffcontext) >= 2} {
5608 incr repo_config(gui.diffcontext) -1
5609 reshow_diff
5610 }}
5611lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5612$ctxm add command \
5613 -label {Show More Context} \
5614 -font font_ui \
5615 -command {
5616 incr repo_config(gui.diffcontext)
5617 reshow_diff
5618 }
5619lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5620$ctxm add separator
5621$ctxm add command -label {Options...} \
5622 -font font_ui \
5623 -command do_options
5624bind_button3 $ui_diff "
5625 set cursorX %x
5626 set cursorY %y
5627 if {\$ui_index eq \$current_diff_side} {
5628 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5629 } else {
5630 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5631 }
5632 tk_popup $ctxm %X %Y
5633"
5634unset ui_diff_applyhunk
5635# -- Status Bar
5637#
5638set ui_status_value {Initializing...}
5639label .status -textvariable ui_status_value \
5640 -anchor w \
5641 -justify left \
5642 -borderwidth 1 \
5643 -relief sunken \
5644 -font font_ui
5645pack .status -anchor w -side bottom -fill x
5646# -- Load geometry
5648#
5649catch {
5650set gm $repo_config(gui.geometry)
5651wm geometry . [lindex $gm 0]
5652.vpane sash place 0 \
5653 [lindex [.vpane sash coord 0] 0] \
5654 [lindex $gm 1]
5655.vpane.files sash place 0 \
5656 [lindex $gm 2] \
5657 [lindex [.vpane.files sash coord 0] 1]
5658unset gm
5659}
5660# -- Key Bindings
5662#
5663bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5664bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5665bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5666bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5667bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5668bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5669bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5670bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5671bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5672bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5673bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5674bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5676bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5677bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5678bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5679bind $ui_diff <$M1B-Key-v> {break}
5680bind $ui_diff <$M1B-Key-V> {break}
5681bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5682bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5683bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5684bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5685bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5686bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5687bind $ui_diff <Button-1> {focus %W}
5688if {!$single_commit} {
5690 bind . <$M1B-Key-n> do_create_branch
5691 bind . <$M1B-Key-N> do_create_branch
5692}
5693bind . <Destroy> do_quit
5695bind all <Key-F5> do_rescan
5696bind all <$M1B-Key-r> do_rescan
5697bind all <$M1B-Key-R> do_rescan
5698bind . <$M1B-Key-s> do_signoff
5699bind . <$M1B-Key-S> do_signoff
5700bind . <$M1B-Key-i> do_add_all
5701bind . <$M1B-Key-I> do_add_all
5702bind . <$M1B-Key-Return> do_commit
5703bind all <$M1B-Key-q> do_quit
5704bind all <$M1B-Key-Q> do_quit
5705bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5706bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5707foreach i [list $ui_index $ui_workdir] {
5708 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
5709 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
5710 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5711}
5712unset i
5713set file_lists($ui_index) [list]
5715set file_lists($ui_workdir) [list]
5716set HEAD {}
5718set PARENT {}
5719set MERGE_HEAD [list]
5720set commit_type {}
5721set empty_tree {}
5722set current_branch {}
5723set current_diff_path {}
5724set selected_commit_type new
5725wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5727focus -force $ui_comm
5728# -- Warn the user about environmental problems. Cygwin's Tcl
5730# does *not* pass its env array onto any processes it spawns.
5731# This means that git processes get none of our environment.
5732#
5733if {[is_Cygwin]} {
5734 set ignored_env 0
5735 set suggest_user {}
5736 set msg "Possible environment issues exist.
5737The following environment variables are probably
5739going to be ignored by any Git subprocess run
5740by [appname]:
5741"
5743 foreach name [array names env] {
5744 switch -regexp -- $name {
5745 {^GIT_INDEX_FILE$} -
5746 {^GIT_OBJECT_DIRECTORY$} -
5747 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5748 {^GIT_DIFF_OPTS$} -
5749 {^GIT_EXTERNAL_DIFF$} -
5750 {^GIT_PAGER$} -
5751 {^GIT_TRACE$} -
5752 {^GIT_CONFIG$} -
5753 {^GIT_CONFIG_LOCAL$} -
5754 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5755 append msg " - $name\n"
5756 incr ignored_env
5757 }
5758 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5759 append msg " - $name\n"
5760 incr ignored_env
5761 set suggest_user $name
5762 }
5763 }
5764 }
5765 if {$ignored_env > 0} {
5766 append msg "
5767This is due to a known issue with the
5768Tcl binary distributed by Cygwin."
5769 if {$suggest_user ne {}} {
5771 append msg "
5772A good replacement for $suggest_user
5774is placing values for the user.name and
5775user.email settings into your personal
5776~/.gitconfig file.
5777"
5778 }
5779 warn_popup $msg
5780 }
5781 unset ignored_env msg suggest_user name
5782}
5783# -- Only initialize complex UI if we are going to stay running.
5785#
5786if {!$single_commit} {
5787 load_all_remotes
5788 load_all_heads
5789 populate_branch_menu
5791 populate_fetch_menu
5792 populate_push_menu
5793}
5794# -- Only suggest a gc run if we are going to stay running.
5796#
5797if {!$single_commit} {
5798 set object_limit 2000
5799 if {[is_Windows]} {set object_limit 200}
5800 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5801 if {$objects_current >= $object_limit} {
5802 if {[ask_popup \
5803 "This repository currently has $objects_current loose objects.
5804To maintain optimal performance it is strongly
5806recommended that you compress the database
5807when more than $object_limit loose objects exist.
5808Compress the database now?"] eq yes} {
5810 do_gc
5811 }
5812 }
5813 unset object_limit _junk objects_current
5814}
5815lock_index begin-read
5817after 1 do_rescan