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