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