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