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