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