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