?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
git-gui: Minor options dialog UI cleanups.
[git/mingw.git] / git-gui
blob580110e629ec5f372c91ee2cecd8e749dbf88a18
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
4
5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
9
10 set appname [lindex [file split $argv0] end]
11 set gitdir {}
12
13 ######################################################################
14 ##
15 ## config
16
17 proc is_many_config {name} {
18 switch -glob -- $name {
19 remote.*.fetch -
20 remote.*.push
21 {return 1}
22 *
23 {return 0}
24 }
25 }
26
27 proc load_config {} {
28 global repo_config global_config default_config
29
30 array unset global_config
31 array unset repo_config
32 catch {
33 set fd_rc [open "| git repo-config --global --list" r]
34 while {[gets $fd_rc line] >= 0} {
35 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
36 if {[is_many_config $name]} {
37 lappend global_config($name) $value
38 } else {
39 set global_config($name) $value
40 }
41 }
42 }
43 close $fd_rc
44 }
45 catch {
46 set fd_rc [open "| git repo-config --list" r]
47 while {[gets $fd_rc line] >= 0} {
48 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
49 if {[is_many_config $name]} {
50 lappend repo_config($name) $value
51 } else {
52 set repo_config($name) $value
53 }
54 }
55 }
56 close $fd_rc
57 }
58
59 foreach name [array names default_config] {
60 if {[catch {set v $global_config($name)}]} {
61 set global_config($name) $default_config($name)
62 }
63 if {[catch {set v $repo_config($name)}]} {
64 set repo_config($name) $default_config($name)
65 }
66 }
67 }
68
69 proc save_config {} {
70 global default_config font_descs
71 global repo_config global_config
72 global repo_config_new global_config_new
73
74 foreach option $font_descs {
75 set name [lindex $option 0]
76 set font [lindex $option 1]
77 font configure $font \
78 -family $global_config_new(gui.$font^^family) \
79 -size $global_config_new(gui.$font^^size)
80 font configure ${font}bold \
81 -family $global_config_new(gui.$font^^family) \
82 -size $global_config_new(gui.$font^^size)
83 set global_config_new(gui.$name) [font configure $font]
84 unset global_config_new(gui.$font^^family)
85 unset global_config_new(gui.$font^^size)
86 }
87
88 foreach name [array names default_config] {
89 set value $global_config_new($name)
90 if {$value != $global_config($name)} {
91 if {$value == $default_config($name)} {
92 catch {exec git repo-config --global --unset $name}
93 } else {
94 catch {exec git repo-config --global $name $value}
95 }
96 set global_config($name) $value
97 if {$value == $repo_config($name)} {
98 catch {exec git repo-config --unset $name}
99 set repo_config($name) $value
100 }
101 }
102 }
103
104 foreach name [array names default_config] {
105 set value $repo_config_new($name)
106 if {$value != $repo_config($name)} {
107 if {$value == $global_config($name)} {
108 catch {exec git repo-config --unset $name}
109 } else {
110 catch {exec git repo-config $name $value}
111 }
112 set repo_config($name) $value
113 }
114 }
115 }
116
117 proc error_popup {msg} {
118 global gitdir appname
119
120 set title $appname
121 if {$gitdir != {}} {
122 append title { (}
123 append title [lindex \
124 [file split [file normalize [file dirname $gitdir]]] \
125 end]
126 append title {)}
127 }
128 tk_messageBox \
129 -parent . \
130 -icon error \
131 -type ok \
132 -title "$title: error" \
133 -message $msg
134 }
135
136 proc info_popup {msg} {
137 global gitdir appname
138
139 set title $appname
140 if {$gitdir != {}} {
141 append title { (}
142 append title [lindex \
143 [file split [file normalize [file dirname $gitdir]]] \
144 end]
145 append title {)}
146 }
147 tk_messageBox \
148 -parent . \
149 -icon error \
150 -type ok \
151 -title $title \
152 -message $msg
153 }
154
155 ######################################################################
156 ##
157 ## repository setup
158
159 if { [catch {set cdup [exec git rev-parse --show-cdup]} err]
160 || [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
161 catch {wm withdraw .}
162 error_popup "Cannot find the git directory:\n\n$err"
163 exit 1
164 }
165 if {$cdup != ""} {
166 cd $cdup
167 }
168 unset cdup
169
170 if {$appname == {git-citool}} {
171 set single_commit 1
172 }
173
174 ######################################################################
175 ##
176 ## task management
177
178 set single_commit 0
179 set status_active 0
180 set diff_active 0
181 set commit_active 0
182
183 set disable_on_lock [list]
184 set index_lock_type none
185
186 set HEAD {}
187 set PARENT {}
188 set commit_type {}
189
190 proc lock_index {type} {
191 global index_lock_type disable_on_lock
192
193 if {$index_lock_type == {none}} {
194 set index_lock_type $type
195 foreach w $disable_on_lock {
196 uplevel #0 $w disabled
197 }
198 return 1
199 } elseif {$index_lock_type == {begin-update} && $type == {update}} {
200 set index_lock_type $type
201 return 1
202 }
203 return 0
204 }
205
206 proc unlock_index {} {
207 global index_lock_type disable_on_lock
208
209 set index_lock_type none
210 foreach w $disable_on_lock {
211 uplevel #0 $w normal
212 }
213 }
214
215 ######################################################################
216 ##
217 ## status
218
219 proc repository_state {hdvar ctvar} {
220 global gitdir
221 upvar $hdvar hd $ctvar ct
222
223 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
224 set ct initial
225 } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
226 set ct merge
227 } else {
228 set ct normal
229 }
230 }
231
232 proc update_status {{final Ready.}} {
233 global HEAD PARENT commit_type
234 global ui_index ui_other ui_status_value ui_comm
235 global status_active file_states
236 global repo_config
237
238 if {$status_active || ![lock_index read]} return
239
240 repository_state new_HEAD new_type
241 if {$commit_type == {amend}
242 && $new_type == {normal}
243 && $new_HEAD == $HEAD} {
244 } else {
245 set HEAD $new_HEAD
246 set PARENT $new_HEAD
247 set commit_type $new_type
248 }
249
250 array unset file_states
251
252 if {![$ui_comm edit modified]
253 || [string trim [$ui_comm get 0.0 end]] == {}} {
254 if {[load_message GITGUI_MSG]} {
255 } elseif {[load_message MERGE_MSG]} {
256 } elseif {[load_message SQUASH_MSG]} {
257 }
258 $ui_comm edit modified false
259 $ui_comm edit reset
260 }
261
262 if {$repo_config(gui.trustmtime) == {true}} {
263 update_status_stage2 {} $final
264 } else {
265 set status_active 1
266 set ui_status_value {Refreshing file status...}
267 set cmd [list git update-index]
268 lappend cmd -q
269 lappend cmd --unmerged
270 lappend cmd --ignore-missing
271 lappend cmd --refresh
272 set fd_rf [open "| $cmd" r]
273 fconfigure $fd_rf -blocking 0 -translation binary
274 fileevent $fd_rf readable \
275 [list update_status_stage2 $fd_rf $final]
276 }
277 }
278
279 proc update_status_stage2 {fd final} {
280 global gitdir PARENT commit_type
281 global ui_index ui_other ui_status_value ui_comm
282 global status_active
283 global buf_rdi buf_rdf buf_rlo
284
285 if {$fd != {}} {
286 read $fd
287 if {![eof $fd]} return
288 close $fd
289 }
290
291 set ls_others [list | git ls-files --others -z \
292 --exclude-per-directory=.gitignore]
293 set info_exclude [file join $gitdir info exclude]
294 if {[file readable $info_exclude]} {
295 lappend ls_others "--exclude-from=$info_exclude"
296 }
297
298 set buf_rdi {}
299 set buf_rdf {}
300 set buf_rlo {}
301
302 set status_active 3
303 set ui_status_value {Scanning for modified files ...}
304 set fd_di [open "| git diff-index --cached -z $PARENT" r]
305 set fd_df [open "| git diff-files -z" r]
306 set fd_lo [open $ls_others r]
307
308 fconfigure $fd_di -blocking 0 -translation binary
309 fconfigure $fd_df -blocking 0 -translation binary
310 fconfigure $fd_lo -blocking 0 -translation binary
311 fileevent $fd_di readable [list read_diff_index $fd_di $final]
312 fileevent $fd_df readable [list read_diff_files $fd_df $final]
313 fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
314 }
315
316 proc load_message {file} {
317 global gitdir ui_comm
318
319 set f [file join $gitdir $file]
320 if {[file isfile $f]} {
321 if {[catch {set fd [open $f r]}]} {
322 return 0
323 }
324 set content [string trim [read $fd]]
325 close $fd
326 $ui_comm delete 0.0 end
327 $ui_comm insert end $content
328 return 1
329 }
330 return 0
331 }
332
333 proc read_diff_index {fd final} {
334 global buf_rdi
335
336 append buf_rdi [read $fd]
337 set c 0
338 set n [string length $buf_rdi]
339 while {$c < $n} {
340 set z1 [string first "\0" $buf_rdi $c]
341 if {$z1 == -1} break
342 incr z1
343 set z2 [string first "\0" $buf_rdi $z1]
344 if {$z2 == -1} break
345
346 set c $z2
347 incr z2 -1
348 display_file \
349 [string range $buf_rdi $z1 $z2] \
350 [string index $buf_rdi [expr $z1 - 2]]_
351 incr c
352 }
353 if {$c < $n} {
354 set buf_rdi [string range $buf_rdi $c end]
355 } else {
356 set buf_rdi {}
357 }
358
359 status_eof $fd buf_rdi $final
360 }
361
362 proc read_diff_files {fd final} {
363 global buf_rdf
364
365 append buf_rdf [read $fd]
366 set c 0
367 set n [string length $buf_rdf]
368 while {$c < $n} {
369 set z1 [string first "\0" $buf_rdf $c]
370 if {$z1 == -1} break
371 incr z1
372 set z2 [string first "\0" $buf_rdf $z1]
373 if {$z2 == -1} break
374
375 set c $z2
376 incr z2 -1
377 display_file \
378 [string range $buf_rdf $z1 $z2] \
379 _[string index $buf_rdf [expr $z1 - 2]]
380 incr c
381 }
382 if {$c < $n} {
383 set buf_rdf [string range $buf_rdf $c end]
384 } else {
385 set buf_rdf {}
386 }
387
388 status_eof $fd buf_rdf $final
389 }
390
391 proc read_ls_others {fd final} {
392 global buf_rlo
393
394 append buf_rlo [read $fd]
395 set pck [split $buf_rlo "\0"]
396 set buf_rlo [lindex $pck end]
397 foreach p [lrange $pck 0 end-1] {
398 display_file $p _O
399 }
400 status_eof $fd buf_rlo $final
401 }
402
403 proc status_eof {fd buf final} {
404 global status_active ui_status_value
405 upvar $buf to_clear
406
407 if {[eof $fd]} {
408 set to_clear {}
409 close $fd
410
411 if {[incr status_active -1] == 0} {
412 display_all_files
413 unlock_index
414 reshow_diff
415 set ui_status_value $final
416 }
417 }
418 }
419
420 ######################################################################
421 ##
422 ## diff
423
424 proc clear_diff {} {
425 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
426
427 $ui_diff conf -state normal
428 $ui_diff delete 0.0 end
429 $ui_diff conf -state disabled
430
431 set ui_fname_value {}
432 set ui_fstatus_value {}
433
434 $ui_index tag remove in_diff 0.0 end
435 $ui_other tag remove in_diff 0.0 end
436 }
437
438 proc reshow_diff {} {
439 global ui_fname_value ui_status_value file_states
440
441 if {$ui_fname_value == {}
442 || [catch {set s $file_states($ui_fname_value)}]} {
443 clear_diff
444 } else {
445 show_diff $ui_fname_value
446 }
447 }
448
449 proc handle_empty_diff {} {
450 global ui_fname_value file_states file_lists
451
452 set path $ui_fname_value
453 set s $file_states($path)
454 if {[lindex $s 0] != {_M}} return
455
456 info_popup "No differences detected.
457
458 [short_path $path] has no changes.
459
460 The modification date of this file was updated by another
461 application and you currently have the Trust File Modification
462 Timestamps option enabled, so Git did not automatically detect
463 that there are no content differences in this file.
464
465 This file will now be removed from the modified files list, to
466 prevent possible confusion.
467 "
468 if {[catch {exec git update-index -- $path} err]} {
469 error_popup "Failed to refresh index:\n\n$err"
470 }
471
472 clear_diff
473 set old_w [mapcol [lindex $file_states($path) 0] $path]
474 set lno [lsearch -sorted $file_lists($old_w) $path]
475 if {$lno >= 0} {
476 set file_lists($old_w) \
477 [lreplace $file_lists($old_w) $lno $lno]
478 incr lno
479 $old_w conf -state normal
480 $old_w delete $lno.0 [expr $lno + 1].0
481 $old_w conf -state disabled
482 }
483 }
484
485 proc show_diff {path {w {}} {lno {}}} {
486 global file_states file_lists
487 global PARENT diff_3way diff_active
488 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
489
490 if {$diff_active || ![lock_index read]} return
491
492 clear_diff
493 if {$w == {} || $lno == {}} {
494 foreach w [array names file_lists] {
495 set lno [lsearch -sorted $file_lists($w) $path]
496 if {$lno >= 0} {
497 incr lno
498 break
499 }
500 }
501 }
502 if {$w != {} && $lno >= 1} {
503 $w tag add in_diff $lno.0 [expr $lno + 1].0
504 }
505
506 set s $file_states($path)
507 set m [lindex $s 0]
508 set diff_3way 0
509 set diff_active 1
510 set ui_fname_value [escape_path $path]
511 set ui_fstatus_value [mapdesc $m $path]
512 set ui_status_value "Loading diff of [escape_path $path]..."
513
514 set cmd [list | git diff-index -p $PARENT -- $path]
515 switch $m {
516 MM {
517 set cmd [list | git diff-index -p -c $PARENT $path]
518 }
519 _O {
520 if {[catch {
521 set fd [open $path r]
522 set content [read $fd]
523 close $fd
524 } err ]} {
525 set diff_active 0
526 unlock_index
527 set ui_status_value "Unable to display [escape_path $path]"
528 error_popup "Error loading file:\n\n$err"
529 return
530 }
531 $ui_diff conf -state normal
532 $ui_diff insert end $content
533 $ui_diff conf -state disabled
534 set diff_active 0
535 unlock_index
536 set ui_status_value {Ready.}
537 return
538 }
539 }
540
541 if {[catch {set fd [open $cmd r]} err]} {
542 set diff_active 0
543 unlock_index
544 set ui_status_value "Unable to display [escape_path $path]"
545 error_popup "Error loading diff:\n\n$err"
546 return
547 }
548
549 fconfigure $fd -blocking 0 -translation auto
550 fileevent $fd readable [list read_diff $fd]
551 }
552
553 proc read_diff {fd} {
554 global ui_diff ui_status_value diff_3way diff_active
555 global repo_config
556
557 while {[gets $fd line] >= 0} {
558 if {[string match {diff --git *} $line]} continue
559 if {[string match {diff --combined *} $line]} continue
560 if {[string match {--- *} $line]} continue
561 if {[string match {+++ *} $line]} continue
562 if {[string match index* $line]} {
563 if {[string first , $line] >= 0} {
564 set diff_3way 1
565 }
566 }
567
568 $ui_diff conf -state normal
569 if {!$diff_3way} {
570 set x [string index $line 0]
571 switch -- $x {
572 "@" {set tags da}
573 "+" {set tags dp}
574 "-" {set tags dm}
575 default {set tags {}}
576 }
577 } else {
578 set x [string range $line 0 1]
579 switch -- $x {
580 default {set tags {}}
581 "@@" {set tags da}
582 "++" {set tags dp; set x " +"}
583 " +" {set tags {di bold}; set x "++"}
584 "+ " {set tags dni; set x "-+"}
585 "--" {set tags dm; set x " -"}
586 " -" {set tags {dm bold}; set x "--"}
587 "- " {set tags di; set x "+-"}
588 default {set tags {}}
589 }
590 set line [string replace $line 0 1 $x]
591 }
592 $ui_diff insert end $line $tags
593 $ui_diff insert end "\n"
594 $ui_diff conf -state disabled
595 }
596
597 if {[eof $fd]} {
598 close $fd
599 set diff_active 0
600 unlock_index
601 set ui_status_value {Ready.}
602
603 if {$repo_config(gui.trustmtime) == {true}
604 && [$ui_diff index end] == {2.0}} {
605 handle_empty_diff
606 }
607 }
608 }
609
610 ######################################################################
611 ##
612 ## commit
613
614 proc load_last_commit {} {
615 global HEAD PARENT commit_type ui_comm
616
617 if {$commit_type == {amend}} return
618 if {$commit_type != {normal}} {
619 error_popup "Can't amend a $commit_type commit."
620 return
621 }
622
623 set msg {}
624 set parent {}
625 set parent_count 0
626 if {[catch {
627 set fd [open "| git cat-file commit $HEAD" r]
628 while {[gets $fd line] > 0} {
629 if {[string match {parent *} $line]} {
630 set parent [string range $line 7 end]
631 incr parent_count
632 }
633 }
634 set msg [string trim [read $fd]]
635 close $fd
636 } err]} {
637 error_popup "Error loading commit data for amend:\n\n$err"
638 return
639 }
640
641 if {$parent_count == 0} {
642 set commit_type amend
643 set HEAD {}
644 set PARENT {}
645 update_status
646 } elseif {$parent_count == 1} {
647 set commit_type amend
648 set PARENT $parent
649 $ui_comm delete 0.0 end
650 $ui_comm insert end $msg
651 $ui_comm edit modified false
652 $ui_comm edit reset
653 update_status
654 } else {
655 error_popup {You can't amend a merge commit.}
656 return
657 }
658 }
659
660 proc commit_tree {} {
661 global tcl_platform HEAD gitdir commit_type file_states
662 global commit_active ui_status_value
663 global ui_comm
664
665 if {$commit_active || ![lock_index update]} return
666
667 # -- Our in memory state should match the repository.
668 #
669 repository_state curHEAD cur_type
670 if {$commit_type == {amend}
671 && $cur_type == {normal}
672 && $curHEAD == $HEAD} {
673 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
674 error_popup {Last scanned state does not match repository state.
675
676 Its highly likely that another Git program modified the
677 repository since our last scan. A rescan is required
678 before committing.
679 }
680 unlock_index
681 update_status
682 return
683 }
684
685 # -- At least one file should differ in the index.
686 #
687 set files_ready 0
688 foreach path [array names file_states] {
689 set s $file_states($path)
690 switch -glob -- [lindex $s 0] {
691 _? {continue}
692 A? -
693 D? -
694 M? {set files_ready 1; break}
695 U? {
696 error_popup "Unmerged files cannot be committed.
697
698 File [short_path $path] has merge conflicts.
699 You must resolve them and include the file before committing.
700 "
701 unlock_index
702 return
703 }
704 default {
705 error_popup "Unknown file state [lindex $s 0] detected.
706
707 File [short_path $path] cannot be committed by this program.
708 "
709 }
710 }
711 }
712 if {!$files_ready} {
713 error_popup {No included files to commit.
714
715 You must include at least 1 file before you can commit.
716 }
717 unlock_index
718 return
719 }
720
721 # -- A message is required.
722 #
723 set msg [string trim [$ui_comm get 1.0 end]]
724 if {$msg == {}} {
725 error_popup {Please supply a commit message.
726
727 A good commit message has the following format:
728
729 - First line: Describe in one sentance what you did.
730 - Second line: Blank
731 - Remaining lines: Describe why this change is good.
732 }
733 unlock_index
734 return
735 }
736
737 # -- Ask the pre-commit hook for the go-ahead.
738 #
739 set pchook [file join $gitdir hooks pre-commit]
740 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
741 set pchook [list sh -c \
742 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
743 } elseif {[file executable $pchook]} {
744 set pchook [list $pchook]
745 } else {
746 set pchook {}
747 }
748 if {$pchook != {} && [catch {eval exec $pchook} err]} {
749 hook_failed_popup pre-commit $err
750 unlock_index
751 return
752 }
753
754 # -- Write the tree in the background.
755 #
756 set commit_active 1
757 set ui_status_value {Committing changes...}
758
759 set fd_wt [open "| git write-tree" r]
760 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
761 }
762
763 proc commit_stage2 {fd_wt curHEAD msg} {
764 global single_commit gitdir HEAD PARENT commit_type
765 global commit_active ui_status_value ui_comm
766 global file_states
767
768 gets $fd_wt tree_id
769 if {$tree_id == {} || [catch {close $fd_wt} err]} {
770 error_popup "write-tree failed:\n\n$err"
771 set commit_active 0
772 set ui_status_value {Commit failed.}
773 unlock_index
774 return
775 }
776
777 # -- Create the commit.
778 #
779 set cmd [list git commit-tree $tree_id]
780 if {$PARENT != {}} {
781 lappend cmd -p $PARENT
782 }
783 if {$commit_type == {merge}} {
784 if {[catch {
785 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
786 while {[gets $fd_mh merge_head] >= 0} {
787 lappend cmd -p $merge_head
788 }
789 close $fd_mh
790 } err]} {
791 error_popup "Loading MERGE_HEAD failed:\n\n$err"
792 set commit_active 0
793 set ui_status_value {Commit failed.}
794 unlock_index
795 return
796 }
797 }
798 if {$PARENT == {}} {
799 # git commit-tree writes to stderr during initial commit.
800 lappend cmd 2>/dev/null
801 }
802 lappend cmd << $msg
803 if {[catch {set cmt_id [eval exec $cmd]} err]} {
804 error_popup "commit-tree failed:\n\n$err"
805 set commit_active 0
806 set ui_status_value {Commit failed.}
807 unlock_index
808 return
809 }
810
811 # -- Update the HEAD ref.
812 #
813 set reflogm commit
814 if {$commit_type != {normal}} {
815 append reflogm " ($commit_type)"
816 }
817 set i [string first "\n" $msg]
818 if {$i >= 0} {
819 append reflogm {: } [string range $msg 0 [expr $i - 1]]
820 } else {
821 append reflogm {: } $msg
822 }
823 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
824 if {[catch {eval exec $cmd} err]} {
825 error_popup "update-ref failed:\n\n$err"
826 set commit_active 0
827 set ui_status_value {Commit failed.}
828 unlock_index
829 return
830 }
831
832 # -- Cleanup after ourselves.
833 #
834 catch {file delete [file join $gitdir MERGE_HEAD]}
835 catch {file delete [file join $gitdir MERGE_MSG]}
836 catch {file delete [file join $gitdir SQUASH_MSG]}
837 catch {file delete [file join $gitdir GITGUI_MSG]}
838
839 # -- Let rerere do its thing.
840 #
841 if {[file isdirectory [file join $gitdir rr-cache]]} {
842 catch {exec git rerere}
843 }
844
845 $ui_comm delete 0.0 end
846 $ui_comm edit modified false
847 $ui_comm edit reset
848
849 if {$single_commit} do_quit
850
851 # -- Update status without invoking any git commands.
852 #
853 set commit_active 0
854 set commit_type normal
855 set HEAD $cmt_id
856 set PARENT $cmt_id
857
858 foreach path [array names file_states] {
859 set s $file_states($path)
860 set m [lindex $s 0]
861 switch -glob -- $m {
862 A? -
863 M? -
864 D? {set m _[string index $m 1]}
865 }
866
867 if {$m == {__}} {
868 unset file_states($path)
869 } else {
870 lset file_states($path) 0 $m
871 }
872 }
873
874 display_all_files
875 unlock_index
876 reshow_diff
877 set ui_status_value \
878 "Changes committed as [string range $cmt_id 0 7]."
879 }
880
881 ######################################################################
882 ##
883 ## fetch pull push
884
885 proc fetch_from {remote} {
886 set w [new_console "fetch $remote" \
887 "Fetching new changes from $remote"]
888 set cmd [list git fetch]
889 lappend cmd $remote
890 console_exec $w $cmd
891 }
892
893 proc pull_remote {remote branch} {
894 global HEAD commit_type
895 global file_states
896
897 if {![lock_index update]} return
898
899 # -- Our in memory state should match the repository.
900 #
901 repository_state curHEAD cur_type
902 if {$commit_type != $cur_type || $HEAD != $curHEAD} {
903 error_popup {Last scanned state does not match repository state.
904
905 Its highly likely that another Git program modified the
906 repository since our last scan. A rescan is required
907 before a pull can be started.
908 }
909 unlock_index
910 update_status
911 return
912 }
913
914 # -- No differences should exist before a pull.
915 #
916 if {[array size file_states] != 0} {
917 error_popup {Uncommitted but modified files are present.
918
919 You should not perform a pull with unmodified files in your working
920 directory as Git would be unable to recover from an incorrect merge.
921
922 Commit or throw away all changes before starting a pull operation.
923 }
924 unlock_index
925 return
926 }
927
928 set w [new_console "pull $remote $branch" \
929 "Pulling new changes from branch $branch in $remote"]
930 set cmd [list git pull]
931 lappend cmd $remote
932 lappend cmd $branch
933 console_exec $w $cmd [list post_pull_remote $remote $branch]
934 }
935
936 proc post_pull_remote {remote branch success} {
937 global HEAD PARENT commit_type
938 global ui_status_value
939
940 unlock_index
941 if {$success} {
942 repository_state HEAD commit_type
943 set PARENT $HEAD
944 set $ui_status_value {Ready.}
945 } else {
946 update_status \
947 "Conflicts detected while pulling $branch from $remote."
948 }
949 }
950
951 proc push_to {remote} {
952 set w [new_console "push $remote" \
953 "Pushing changes to $remote"]
954 set cmd [list git push]
955 lappend cmd $remote
956 console_exec $w $cmd
957 }
958
959 ######################################################################
960 ##
961 ## ui helpers
962
963 proc mapcol {state path} {
964 global all_cols ui_other
965
966 if {[catch {set r $all_cols($state)}]} {
967 puts "error: no column for state={$state} $path"
968 return $ui_other
969 }
970 return $r
971 }
972
973 proc mapicon {state path} {
974 global all_icons
975
976 if {[catch {set r $all_icons($state)}]} {
977 puts "error: no icon for state={$state} $path"
978 return file_plain
979 }
980 return $r
981 }
982
983 proc mapdesc {state path} {
984 global all_descs
985
986 if {[catch {set r $all_descs($state)}]} {
987 puts "error: no desc for state={$state} $path"
988 return $state
989 }
990 return $r
991 }
992
993 proc escape_path {path} {
994 regsub -all "\n" $path "\\n" path
995 return $path
996 }
997
998 proc short_path {path} {
999 return [escape_path [lindex [file split $path] end]]
1000 }
1001
1002 set next_icon_id 0
1003
1004 proc merge_state {path new_state} {
1005 global file_states next_icon_id
1006
1007 set s0 [string index $new_state 0]
1008 set s1 [string index $new_state 1]
1009
1010 if {[catch {set info $file_states($path)}]} {
1011 set state __
1012 set icon n[incr next_icon_id]
1013 } else {
1014 set state [lindex $info 0]
1015 set icon [lindex $info 1]
1016 }
1017
1018 if {$s0 == {_}} {
1019 set s0 [string index $state 0]
1020 } elseif {$s0 == {*}} {
1021 set s0 _
1022 }
1023
1024 if {$s1 == {_}} {
1025 set s1 [string index $state 1]
1026 } elseif {$s1 == {*}} {
1027 set s1 _
1028 }
1029
1030 set file_states($path) [list $s0$s1 $icon]
1031 return $state
1032 }
1033
1034 proc display_file {path state} {
1035 global file_states file_lists status_active
1036
1037 set old_m [merge_state $path $state]
1038 if {$status_active} return
1039
1040 set s $file_states($path)
1041 set new_m [lindex $s 0]
1042 set new_w [mapcol $new_m $path]
1043 set old_w [mapcol $old_m $path]
1044 set new_icon [mapicon $new_m $path]
1045
1046 if {$new_w != $old_w} {
1047 set lno [lsearch -sorted $file_lists($old_w) $path]
1048 if {$lno >= 0} {
1049 incr lno
1050 $old_w conf -state normal
1051 $old_w delete $lno.0 [expr $lno + 1].0
1052 $old_w conf -state disabled
1053 }
1054
1055 lappend file_lists($new_w) $path
1056 set file_lists($new_w) [lsort $file_lists($new_w)]
1057 set lno [lsearch -sorted $file_lists($new_w) $path]
1058 incr lno
1059 $new_w conf -state normal
1060 $new_w image create $lno.0 \
1061 -align center -padx 5 -pady 1 \
1062 -name [lindex $s 1] \
1063 -image $new_icon
1064 $new_w insert $lno.1 "[escape_path $path]\n"
1065 $new_w conf -state disabled
1066 } elseif {$new_icon != [mapicon $old_m $path]} {
1067 $new_w conf -state normal
1068 $new_w image conf [lindex $s 1] -image $new_icon
1069 $new_w conf -state disabled
1070 }
1071 }
1072
1073 proc display_all_files {} {
1074 global ui_index ui_other file_states file_lists
1075
1076 $ui_index conf -state normal
1077 $ui_other conf -state normal
1078
1079 $ui_index delete 0.0 end
1080 $ui_other delete 0.0 end
1081
1082 set file_lists($ui_index) [list]
1083 set file_lists($ui_other) [list]
1084
1085 foreach path [lsort [array names file_states]] {
1086 set s $file_states($path)
1087 set m [lindex $s 0]
1088 set w [mapcol $m $path]
1089 lappend file_lists($w) $path
1090 $w image create end \
1091 -align center -padx 5 -pady 1 \
1092 -name [lindex $s 1] \
1093 -image [mapicon $m $path]
1094 $w insert end "[escape_path $path]\n"
1095 }
1096
1097 $ui_index conf -state disabled
1098 $ui_other conf -state disabled
1099 }
1100
1101 proc update_index {pathList} {
1102 global update_index_cp ui_status_value
1103
1104 if {![lock_index update]} return
1105
1106 set update_index_cp 0
1107 set totalCnt [llength $pathList]
1108 set batch [expr {int($totalCnt * .01) + 1}]
1109 if {$batch > 25} {set batch 25}
1110
1111 set ui_status_value "Including files ... 0/$totalCnt 0%"
1112 set ui_status_value [format \
1113 "Including files ... %i/%i files (%.2f%%)" \
1114 $update_index_cp \
1115 $totalCnt \
1116 0.0]
1117 set fd [open "| git update-index --add --remove -z --stdin" w]
1118 fconfigure $fd -blocking 0 -translation binary
1119 fileevent $fd writable [list \
1120 write_update_index \
1121 $fd \
1122 $pathList \
1123 $totalCnt \
1124 $batch \
1125 ]
1126 }
1127
1128 proc write_update_index {fd pathList totalCnt batch} {
1129 global update_index_cp ui_status_value
1130 global file_states ui_fname_value
1131
1132 if {$update_index_cp >= $totalCnt} {
1133 close $fd
1134 unlock_index
1135 set ui_status_value {Ready.}
1136 return
1137 }
1138
1139 for {set i $batch} \
1140 {$update_index_cp < $totalCnt && $i > 0} \
1141 {incr i -1} {
1142 set path [lindex $pathList $update_index_cp]
1143 incr update_index_cp
1144
1145 switch -- [lindex $file_states($path) 0] {
1146 AM -
1147 _O {set new A*}
1148 _M -
1149 MM {set new M*}
1150 AD -
1151 _D {set new D*}
1152 default {continue}
1153 }
1154
1155 puts -nonewline $fd $path
1156 puts -nonewline $fd "\0"
1157 display_file $path $new
1158 if {$ui_fname_value == $path} {
1159 show_diff $path
1160 }
1161 }
1162
1163 set ui_status_value [format \
1164 "Including files ... %i/%i files (%.2f%%)" \
1165 $update_index_cp \
1166 $totalCnt \
1167 [expr {100.0 * $update_index_cp / $totalCnt}]]
1168 }
1169
1170 ######################################################################
1171 ##
1172 ## remote management
1173
1174 proc load_all_remotes {} {
1175 global gitdir all_remotes repo_config
1176
1177 set all_remotes [list]
1178 set rm_dir [file join $gitdir remotes]
1179 if {[file isdirectory $rm_dir]} {
1180 set all_remotes [concat $all_remotes [glob \
1181 -types f \
1182 -tails \
1183 -nocomplain \
1184 -directory $rm_dir *]]
1185 }
1186
1187 foreach line [array names repo_config remote.*.url] {
1188 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1189 lappend all_remotes $name
1190 }
1191 }
1192
1193 set all_remotes [lsort -unique $all_remotes]
1194 }
1195
1196 proc populate_remote_menu {m pfx op} {
1197 global all_remotes
1198
1199 foreach remote $all_remotes {
1200 $m add command -label "$pfx $remote..." \
1201 -command [list $op $remote] \
1202 -font font_ui
1203 }
1204 }
1205
1206 proc populate_pull_menu {m} {
1207 global gitdir repo_config all_remotes disable_on_lock
1208
1209 foreach remote $all_remotes {
1210 set rb {}
1211 if {[array get repo_config remote.$remote.url] != {}} {
1212 if {[array get repo_config remote.$remote.fetch] != {}} {
1213 regexp {^([^:]+):} \
1214 [lindex $repo_config(remote.$remote.fetch) 0] \
1215 line rb
1216 }
1217 } else {
1218 catch {
1219 set fd [open [file join $gitdir remotes $remote] r]
1220 while {[gets $fd line] >= 0} {
1221 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1222 break
1223 }
1224 }
1225 close $fd
1226 }
1227 }
1228
1229 set rb_short $rb
1230 regsub ^refs/heads/ $rb {} rb_short
1231 if {$rb_short != {}} {
1232 $m add command \
1233 -label "Branch $rb_short from $remote..." \
1234 -command [list pull_remote $remote $rb] \
1235 -font font_ui
1236 lappend disable_on_lock \
1237 [list $m entryconf [$m index last] -state]
1238 }
1239 }
1240 }
1241
1242 ######################################################################
1243 ##
1244 ## icons
1245
1246 set filemask {
1247 #define mask_width 14
1248 #define mask_height 15
1249 static unsigned char mask_bits[] = {
1250 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1251 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1252 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1253 }
1254
1255 image create bitmap file_plain -background white -foreground black -data {
1256 #define plain_width 14
1257 #define plain_height 15
1258 static unsigned char plain_bits[] = {
1259 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1260 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1261 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1262 } -maskdata $filemask
1263
1264 image create bitmap file_mod -background white -foreground blue -data {
1265 #define mod_width 14
1266 #define mod_height 15
1267 static unsigned char mod_bits[] = {
1268 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1269 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1270 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1271 } -maskdata $filemask
1272
1273 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1274 #define file_fulltick_width 14
1275 #define file_fulltick_height 15
1276 static unsigned char file_fulltick_bits[] = {
1277 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1278 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1279 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1280 } -maskdata $filemask
1281
1282 image create bitmap file_parttick -background white -foreground "#005050" -data {
1283 #define parttick_width 14
1284 #define parttick_height 15
1285 static unsigned char parttick_bits[] = {
1286 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1287 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1288 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1289 } -maskdata $filemask
1290
1291 image create bitmap file_question -background white -foreground black -data {
1292 #define file_question_width 14
1293 #define file_question_height 15
1294 static unsigned char file_question_bits[] = {
1295 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1296 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1297 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1298 } -maskdata $filemask
1299
1300 image create bitmap file_removed -background white -foreground red -data {
1301 #define file_removed_width 14
1302 #define file_removed_height 15
1303 static unsigned char file_removed_bits[] = {
1304 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1305 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1306 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1307 } -maskdata $filemask
1308
1309 image create bitmap file_merge -background white -foreground blue -data {
1310 #define file_merge_width 14
1311 #define file_merge_height 15
1312 static unsigned char file_merge_bits[] = {
1313 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1314 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1315 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1316 } -maskdata $filemask
1317
1318 set ui_index .vpane.files.index.list
1319 set ui_other .vpane.files.other.list
1320 set max_status_desc 0
1321 foreach i {
1322 {__ i plain "Unmodified"}
1323 {_M i mod "Modified"}
1324 {M_ i fulltick "Checked in"}
1325 {MM i parttick "Partially included"}
1326
1327 {_O o plain "Untracked"}
1328 {A_ o fulltick "Added"}
1329 {AM o parttick "Partially added"}
1330 {AD o question "Added (but now gone)"}
1331
1332 {_D i question "Missing"}
1333 {D_ i removed "Removed"}
1334 {DD i removed "Removed"}
1335 {DO i removed "Removed (still exists)"}
1336
1337 {UM i merge "Merge conflicts"}
1338 {U_ i merge "Merge conflicts"}
1339 } {
1340 if {$max_status_desc < [string length [lindex $i 3]]} {
1341 set max_status_desc [string length [lindex $i 3]]
1342 }
1343 if {[lindex $i 1] == {i}} {
1344 set all_cols([lindex $i 0]) $ui_index
1345 } else {
1346 set all_cols([lindex $i 0]) $ui_other
1347 }
1348 set all_icons([lindex $i 0]) file_[lindex $i 2]
1349 set all_descs([lindex $i 0]) [lindex $i 3]
1350 }
1351 unset filemask i
1352
1353 ######################################################################
1354 ##
1355 ## util
1356
1357 proc is_MacOSX {} {
1358 global tcl_platform tk_library
1359 if {$tcl_platform(platform) == {unix}
1360 && $tcl_platform(os) == {Darwin}
1361 && [string match /Library/Frameworks/* $tk_library]} {
1362 return 1
1363 }
1364 return 0
1365 }
1366
1367 proc bind_button3 {w cmd} {
1368 bind $w <Any-Button-3> $cmd
1369 if {[is_MacOSX]} {
1370 bind $w <Control-Button-1> $cmd
1371 }
1372 }
1373
1374 proc incr_font_size {font {amt 1}} {
1375 set sz [font configure $font -size]
1376 incr sz $amt
1377 font configure $font -size $sz
1378 font configure ${font}bold -size $sz
1379 }
1380
1381 proc hook_failed_popup {hook msg} {
1382 global gitdir appname
1383
1384 set w .hookfail
1385 toplevel $w
1386
1387 frame $w.m
1388 label $w.m.l1 -text "$hook hook failed:" \
1389 -anchor w \
1390 -justify left \
1391 -font font_uibold
1392 text $w.m.t \
1393 -background white -borderwidth 1 \
1394 -relief sunken \
1395 -width 80 -height 10 \
1396 -font font_diff \
1397 -yscrollcommand [list $w.m.sby set]
1398 label $w.m.l2 \
1399 -text {You must correct the above errors before committing.} \
1400 -anchor w \
1401 -justify left \
1402 -font font_uibold
1403 scrollbar $w.m.sby -command [list $w.m.t yview]
1404 pack $w.m.l1 -side top -fill x
1405 pack $w.m.l2 -side bottom -fill x
1406 pack $w.m.sby -side right -fill y
1407 pack $w.m.t -side left -fill both -expand 1
1408 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1409
1410 $w.m.t insert 1.0 $msg
1411 $w.m.t conf -state disabled
1412
1413 button $w.ok -text OK \
1414 -width 15 \
1415 -font font_ui \
1416 -command "destroy $w"
1417 pack $w.ok -side bottom
1418
1419 bind $w <Visibility> "grab $w; focus $w"
1420 bind $w <Key-Return> "destroy $w"
1421 wm title $w "$appname ([lindex [file split \
1422 [file normalize [file dirname $gitdir]]] \
1423 end]): error"
1424 tkwait window $w
1425 }
1426
1427 set next_console_id 0
1428
1429 proc new_console {short_title long_title} {
1430 global next_console_id console_data
1431 set w .console[incr next_console_id]
1432 set console_data($w) [list $short_title $long_title]
1433 return [console_init $w]
1434 }
1435
1436 proc console_init {w} {
1437 global console_cr console_data
1438 global gitdir appname M1B
1439
1440 set console_cr($w) 1.0
1441 toplevel $w
1442 frame $w.m
1443 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1444 -anchor w \
1445 -justify left \
1446 -font font_uibold
1447 text $w.m.t \
1448 -background white -borderwidth 1 \
1449 -relief sunken \
1450 -width 80 -height 10 \
1451 -font font_diff \
1452 -state disabled \
1453 -yscrollcommand [list $w.m.sby set]
1454 label $w.m.s -anchor w \
1455 -justify left \
1456 -font font_uibold
1457 scrollbar $w.m.sby -command [list $w.m.t yview]
1458 pack $w.m.l1 -side top -fill x
1459 pack $w.m.s -side bottom -fill x
1460 pack $w.m.sby -side right -fill y
1461 pack $w.m.t -side left -fill both -expand 1
1462 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1463
1464 menu $w.ctxm -tearoff 0
1465 $w.ctxm add command -label "Copy" \
1466 -font font_ui \
1467 -command "tk_textCopy $w.m.t"
1468 $w.ctxm add command -label "Select All" \
1469 -font font_ui \
1470 -command "$w.m.t tag add sel 0.0 end"
1471 $w.ctxm add command -label "Copy All" \
1472 -font font_ui \
1473 -command "
1474 $w.m.t tag add sel 0.0 end
1475 tk_textCopy $w.m.t
1476 $w.m.t tag remove sel 0.0 end
1477 "
1478
1479 button $w.ok -text {Running...} \
1480 -width 15 \
1481 -font font_ui \
1482 -state disabled \
1483 -command "destroy $w"
1484 pack $w.ok -side bottom
1485
1486 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1487 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1488 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1489 bind $w <Visibility> "focus $w"
1490 wm title $w "$appname ([lindex [file split \
1491 [file normalize [file dirname $gitdir]]] \
1492 end]): [lindex $console_data($w) 0]"
1493 return $w
1494 }
1495
1496 proc console_exec {w cmd {after {}}} {
1497 global tcl_platform
1498
1499 # -- Windows tosses the enviroment when we exec our child.
1500 # But most users need that so we have to relogin. :-(
1501 #
1502 if {$tcl_platform(platform) == {windows}} {
1503 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1504 }
1505
1506 # -- Tcl won't let us redirect both stdout and stderr to
1507 # the same pipe. So pass it through cat...
1508 #
1509 set cmd [concat | $cmd |& cat]
1510
1511 set fd_f [open $cmd r]
1512 fconfigure $fd_f -blocking 0 -translation binary
1513 fileevent $fd_f readable [list console_read $w $fd_f $after]
1514 }
1515
1516 proc console_read {w fd after} {
1517 global console_cr console_data
1518
1519 set buf [read $fd]
1520 if {$buf != {}} {
1521 if {![winfo exists $w]} {console_init $w}
1522 $w.m.t conf -state normal
1523 set c 0
1524 set n [string length $buf]
1525 while {$c < $n} {
1526 set cr [string first "\r" $buf $c]
1527 set lf [string first "\n" $buf $c]
1528 if {$cr < 0} {set cr [expr $n + 1]}
1529 if {$lf < 0} {set lf [expr $n + 1]}
1530
1531 if {$lf < $cr} {
1532 $w.m.t insert end [string range $buf $c $lf]
1533 set console_cr($w) [$w.m.t index {end -1c}]
1534 set c $lf
1535 incr c
1536 } else {
1537 $w.m.t delete $console_cr($w) end
1538 $w.m.t insert end "\n"
1539 $w.m.t insert end [string range $buf $c $cr]
1540 set c $cr
1541 incr c
1542 }
1543 }
1544 $w.m.t conf -state disabled
1545 $w.m.t see end
1546 }
1547
1548 fconfigure $fd -blocking 1
1549 if {[eof $fd]} {
1550 if {[catch {close $fd}]} {
1551 if {![winfo exists $w]} {console_init $w}
1552 $w.m.s conf -background red -text {Error: Command Failed}
1553 $w.ok conf -text Close
1554 $w.ok conf -state normal
1555 set ok 0
1556 } elseif {[winfo exists $w]} {
1557 $w.m.s conf -background green -text {Success}
1558 $w.ok conf -text Close
1559 $w.ok conf -state normal
1560 set ok 1
1561 }
1562 array unset console_cr $w
1563 array unset console_data $w
1564 if {$after != {}} {
1565 uplevel #0 $after $ok
1566 }
1567 return
1568 }
1569 fconfigure $fd -blocking 0
1570 }
1571
1572 ######################################################################
1573 ##
1574 ## ui commands
1575
1576 set starting_gitk_msg {Please wait... Starting gitk...}
1577
1578 proc do_gitk {} {
1579 global tcl_platform ui_status_value starting_gitk_msg
1580
1581 set ui_status_value $starting_gitk_msg
1582 after 10000 {
1583 if {$ui_status_value == $starting_gitk_msg} {
1584 set ui_status_value {Ready.}
1585 }
1586 }
1587
1588 if {$tcl_platform(platform) == {windows}} {
1589 exec sh -c gitk &
1590 } else {
1591 exec gitk &
1592 }
1593 }
1594
1595 proc do_repack {} {
1596 set w [new_console "repack" "Repacking the object database"]
1597 set cmd [list git repack]
1598 lappend cmd -a
1599 lappend cmd -d
1600 console_exec $w $cmd
1601 }
1602
1603 set is_quitting 0
1604
1605 proc do_quit {} {
1606 global gitdir ui_comm is_quitting repo_config
1607
1608 if {$is_quitting} return
1609 set is_quitting 1
1610
1611 # -- Stash our current commit buffer.
1612 #
1613 set save [file join $gitdir GITGUI_MSG]
1614 set msg [string trim [$ui_comm get 0.0 end]]
1615 if {[$ui_comm edit modified] && $msg != {}} {
1616 catch {
1617 set fd [open $save w]
1618 puts $fd [string trim [$ui_comm get 0.0 end]]
1619 close $fd
1620 }
1621 } elseif {$msg == {} && [file exists $save]} {
1622 file delete $save
1623 }
1624
1625 # -- Stash our current window geometry into this repository.
1626 #
1627 set cfg_geometry [list]
1628 lappend cfg_geometry [wm geometry .]
1629 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1630 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1631 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1632 set rc_geometry {}
1633 }
1634 if {$cfg_geometry != $rc_geometry} {
1635 catch {exec git repo-config gui.geometry $cfg_geometry}
1636 }
1637
1638 destroy .
1639 }
1640
1641 proc do_rescan {} {
1642 update_status
1643 }
1644
1645 proc do_include_all {} {
1646 global file_states
1647
1648 if {![lock_index begin-update]} return
1649
1650 set pathList [list]
1651 foreach path [array names file_states] {
1652 set s $file_states($path)
1653 set m [lindex $s 0]
1654 switch -- $m {
1655 AM -
1656 MM -
1657 _M -
1658 _D {lappend pathList $path}
1659 }
1660 }
1661 if {$pathList == {}} {
1662 unlock_index
1663 } else {
1664 update_index $pathList
1665 }
1666 }
1667
1668 set GIT_COMMITTER_IDENT {}
1669
1670 proc do_signoff {} {
1671 global ui_comm GIT_COMMITTER_IDENT
1672
1673 if {$GIT_COMMITTER_IDENT == {}} {
1674 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1675 error_popup "Unable to obtain your identity:\n\n$err"
1676 return
1677 }
1678 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1679 $me me GIT_COMMITTER_IDENT]} {
1680 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1681 return
1682 }
1683 }
1684
1685 set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1686 set last [$ui_comm get {end -1c linestart} {end -1c}]
1687 if {$last != $sob} {
1688 $ui_comm edit separator
1689 if {$last != {}
1690 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1691 $ui_comm insert end "\n"
1692 }
1693 $ui_comm insert end "\n$sob"
1694 $ui_comm edit separator
1695 $ui_comm see end
1696 }
1697 }
1698
1699 proc do_amend_last {} {
1700 load_last_commit
1701 }
1702
1703 proc do_commit {} {
1704 commit_tree
1705 }
1706
1707 proc do_options {} {
1708 global appname gitdir font_descs
1709 global repo_config global_config
1710 global repo_config_new global_config_new
1711
1712 load_config
1713 array unset repo_config_new
1714 array unset global_config_new
1715 foreach name [array names repo_config] {
1716 set repo_config_new($name) $repo_config($name)
1717 }
1718 foreach name [array names global_config] {
1719 set global_config_new($name) $global_config($name)
1720 }
1721 set reponame [lindex [file split \
1722 [file normalize [file dirname $gitdir]]] \
1723 end]
1724
1725 set w .options_editor
1726 toplevel $w
1727 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1728
1729 label $w.header -text "$appname Options" \
1730 -font font_uibold
1731 pack $w.header -side top -fill x
1732
1733 frame $w.buttons
1734 button $w.buttons.restore -text {Restore Defaults} \
1735 -font font_ui \
1736 -command do_restore_defaults
1737 pack $w.buttons.restore -side left
1738 button $w.buttons.save -text Save \
1739 -font font_ui \
1740 -command [list do_save_config $w]
1741 pack $w.buttons.save -side right
1742 button $w.buttons.cancel -text {Cancel} \
1743 -font font_ui \
1744 -command [list destroy $w]
1745 pack $w.buttons.cancel -side right
1746 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1747
1748 labelframe $w.repo -text "$reponame Repository" \
1749 -font font_ui \
1750 -relief raised -borderwidth 2
1751 labelframe $w.global -text {Global (All Repositories)} \
1752 -font font_ui \
1753 -relief raised -borderwidth 2
1754 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1755 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1756
1757 foreach option {
1758 {trustmtime {Trust File Modification Timestamps}}
1759 } {
1760 set name [lindex $option 0]
1761 set text [lindex $option 1]
1762 foreach f {repo global} {
1763 checkbutton $w.$f.$name -text $text \
1764 -variable ${f}_config_new(gui.$name) \
1765 -onvalue true \
1766 -offvalue false \
1767 -font font_ui
1768 pack $w.$f.$name -side top -anchor w
1769 }
1770 }
1771
1772 set all_fonts [lsort [font families]]
1773 foreach option $font_descs {
1774 set name [lindex $option 0]
1775 set font [lindex $option 1]
1776 set text [lindex $option 2]
1777
1778 set global_config_new(gui.$font^^family) \
1779 [font configure $font -family]
1780 set global_config_new(gui.$font^^size) \
1781 [font configure $font -size]
1782
1783 frame $w.global.$name
1784 label $w.global.$name.l -text "$text:" -font font_ui
1785 pack $w.global.$name.l -side left -anchor w -fill x
1786 eval tk_optionMenu $w.global.$name.family \
1787 global_config_new(gui.$font^^family) \
1788 $all_fonts
1789 spinbox $w.global.$name.size \
1790 -textvariable global_config_new(gui.$font^^size) \
1791 -from 2 -to 80 -increment 1 \
1792 -width 3 \
1793 -font font_ui
1794 pack $w.global.$name.size -side right -anchor e
1795 pack $w.global.$name.family -side right -anchor e
1796 pack $w.global.$name -side top -anchor w -fill x
1797 }
1798
1799 bind $w <Visibility> "grab $w; focus $w"
1800 bind $w <Key-Escape> "destroy $w"
1801 wm title $w "$appname ($reponame): Options"
1802 tkwait window $w
1803 }
1804
1805 proc do_restore_defaults {} {
1806 global font_descs default_config
1807 global repo_config_new global_config_new
1808
1809 foreach name [array names default_config] {
1810 set repo_config_new($name) $default_config($name)
1811 set global_config_new($name) $default_config($name)
1812 }
1813
1814 foreach option $font_descs {
1815 set name [lindex $option 0]
1816 set repo_config($name) $default_config(gui.$name)
1817 }
1818 apply_config
1819
1820 foreach option $font_descs {
1821 set name [lindex $option 0]
1822 set font [lindex $option 1]
1823 set global_config_new(gui.$font^^family) \
1824 [font configure $font -family]
1825 set global_config_new(gui.$font^^size) \
1826 [font configure $font -size]
1827 }
1828 }
1829
1830 proc do_save_config {w} {
1831 if {[catch {save_config} err]} {
1832 error_popup "Failed to completely save options:\n\n$err"
1833 }
1834 destroy $w
1835 }
1836
1837 # shift == 1: left click
1838 # 3: right click
1839 proc click {w x y shift wx wy} {
1840 global ui_index ui_other file_lists
1841
1842 set pos [split [$w index @$x,$y] .]
1843 set lno [lindex $pos 0]
1844 set col [lindex $pos 1]
1845 set path [lindex $file_lists($w) [expr $lno - 1]]
1846 if {$path == {}} return
1847
1848 if {$col > 0 && $shift == 1} {
1849 show_diff $path $w $lno
1850 }
1851 }
1852
1853 proc unclick {w x y} {
1854 global file_lists
1855
1856 set pos [split [$w index @$x,$y] .]
1857 set lno [lindex $pos 0]
1858 set col [lindex $pos 1]
1859 set path [lindex $file_lists($w) [expr $lno - 1]]
1860 if {$path == {}} return
1861
1862 if {$col == 0} {
1863 update_index [list $path]
1864 }
1865 }
1866
1867 ######################################################################
1868 ##
1869 ## config defaults
1870
1871 set cursor_ptr arrow
1872 font create font_diff -family Courier -size 10
1873 font create font_ui
1874 catch {
1875 label .dummy
1876 eval font configure font_ui [font actual [.dummy cget -font]]
1877 destroy .dummy
1878 }
1879
1880 font create font_uibold
1881 font create font_diffbold
1882
1883 set M1B M1
1884 set M1T M1
1885 if {$tcl_platform(platform) == {windows}} {
1886 set M1B Control
1887 set M1T Ctrl
1888 } elseif {[is_MacOSX]} {
1889 set M1B M1
1890 set M1T Cmd
1891 }
1892
1893 proc apply_config {} {
1894 global repo_config font_descs
1895
1896 foreach option $font_descs {
1897 set name [lindex $option 0]
1898 set font [lindex $option 1]
1899 if {[catch {
1900 foreach {cn cv} $repo_config(gui.$name) {
1901 font configure $font $cn $cv
1902 }
1903 } err]} {
1904 error_popup "Invalid font specified in gui.$name:\n\n$err"
1905 }
1906 foreach {cn cv} [font configure $font] {
1907 font configure ${font}bold $cn $cv
1908 }
1909 font configure ${font}bold -weight bold
1910 }
1911 }
1912
1913 set default_config(gui.trustmtime) false
1914 set default_config(gui.fontui) [font configure font_ui]
1915 set default_config(gui.fontdiff) [font configure font_diff]
1916 set font_descs {
1917 {fontui font_ui {Main Font}}
1918 {fontdiff font_diff {Diff/Console Font}}
1919 }
1920 load_config
1921 apply_config
1922
1923 ######################################################################
1924 ##
1925 ## ui construction
1926
1927 # -- Menu Bar
1928 menu .mbar -tearoff 0
1929 .mbar add cascade -label Project -menu .mbar.project
1930 .mbar add cascade -label Edit -menu .mbar.edit
1931 .mbar add cascade -label Commit -menu .mbar.commit
1932 .mbar add cascade -label Fetch -menu .mbar.fetch
1933 .mbar add cascade -label Pull -menu .mbar.pull
1934 .mbar add cascade -label Push -menu .mbar.push
1935 . configure -menu .mbar
1936
1937 # -- Project Menu
1938 menu .mbar.project
1939 .mbar.project add command -label Visualize \
1940 -command do_gitk \
1941 -font font_ui
1942 .mbar.project add command -label {Repack Database} \
1943 -command do_repack \
1944 -font font_ui
1945 .mbar.project add command -label Quit \
1946 -command do_quit \
1947 -accelerator $M1T-Q \
1948 -font font_ui
1949
1950 # -- Edit Menu
1951 #
1952 menu .mbar.edit
1953 .mbar.edit add command -label Undo \
1954 -command {catch {[focus] edit undo}} \
1955 -accelerator $M1T-Z \
1956 -font font_ui
1957 .mbar.edit add command -label Redo \
1958 -command {catch {[focus] edit redo}} \
1959 -accelerator $M1T-Y \
1960 -font font_ui
1961 .mbar.edit add separator
1962 .mbar.edit add command -label Cut \
1963 -command {catch {tk_textCut [focus]}} \
1964 -accelerator $M1T-X \
1965 -font font_ui
1966 .mbar.edit add command -label Copy \
1967 -command {catch {tk_textCopy [focus]}} \
1968 -accelerator $M1T-C \
1969 -font font_ui
1970 .mbar.edit add command -label Paste \
1971 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1972 -accelerator $M1T-V \
1973 -font font_ui
1974 .mbar.edit add command -label Delete \
1975 -command {catch {[focus] delete sel.first sel.last}} \
1976 -accelerator Del \
1977 -font font_ui
1978 .mbar.edit add separator
1979 .mbar.edit add command -label {Select All} \
1980 -command {catch {[focus] tag add sel 0.0 end}} \
1981 -accelerator $M1T-A \
1982 -font font_ui
1983 .mbar.edit add separator
1984 .mbar.edit add command -label {Options...} \
1985 -command do_options \
1986 -font font_ui
1987
1988 # -- Commit Menu
1989 menu .mbar.commit
1990 .mbar.commit add command -label Rescan \
1991 -command do_rescan \
1992 -accelerator F5 \
1993 -font font_ui
1994 lappend disable_on_lock \
1995 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1996 .mbar.commit add command -label {Amend Last Commit} \
1997 -command do_amend_last \
1998 -font font_ui
1999 lappend disable_on_lock \
2000 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2001 .mbar.commit add command -label {Include All Files} \
2002 -command do_include_all \
2003 -accelerator $M1T-I \
2004 -font font_ui
2005 lappend disable_on_lock \
2006 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2007 .mbar.commit add command -label {Sign Off} \
2008 -command do_signoff \
2009 -accelerator $M1T-S \
2010 -font font_ui
2011 .mbar.commit add command -label Commit \
2012 -command do_commit \
2013 -accelerator $M1T-Return \
2014 -font font_ui
2015 lappend disable_on_lock \
2016 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2017
2018 # -- Fetch Menu
2019 menu .mbar.fetch
2020
2021 # -- Pull Menu
2022 menu .mbar.pull
2023
2024 # -- Push Menu
2025 menu .mbar.push
2026
2027 # -- Main Window Layout
2028 panedwindow .vpane -orient vertical
2029 panedwindow .vpane.files -orient horizontal
2030 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2031 pack .vpane -anchor n -side top -fill both -expand 1
2032
2033 # -- Index File List
2034 frame .vpane.files.index -height 100 -width 400
2035 label .vpane.files.index.title -text {Modified Files} \
2036 -background green \
2037 -font font_ui
2038 text $ui_index -background white -borderwidth 0 \
2039 -width 40 -height 10 \
2040 -font font_ui \
2041 -cursor $cursor_ptr \
2042 -yscrollcommand {.vpane.files.index.sb set} \
2043 -state disabled
2044 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2045 pack .vpane.files.index.title -side top -fill x
2046 pack .vpane.files.index.sb -side right -fill y
2047 pack $ui_index -side left -fill both -expand 1
2048 .vpane.files add .vpane.files.index -sticky nsew
2049
2050 # -- Other (Add) File List
2051 frame .vpane.files.other -height 100 -width 100
2052 label .vpane.files.other.title -text {Untracked Files} \
2053 -background red \
2054 -font font_ui
2055 text $ui_other -background white -borderwidth 0 \
2056 -width 40 -height 10 \
2057 -font font_ui \
2058 -cursor $cursor_ptr \
2059 -yscrollcommand {.vpane.files.other.sb set} \
2060 -state disabled
2061 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2062 pack .vpane.files.other.title -side top -fill x
2063 pack .vpane.files.other.sb -side right -fill y
2064 pack $ui_other -side left -fill both -expand 1
2065 .vpane.files add .vpane.files.other -sticky nsew
2066
2067 $ui_index tag conf in_diff -font font_uibold
2068 $ui_other tag conf in_diff -font font_uibold
2069
2070 # -- Diff and Commit Area
2071 frame .vpane.lower -height 400 -width 400
2072 frame .vpane.lower.commarea
2073 frame .vpane.lower.diff -relief sunken -borderwidth 1
2074 pack .vpane.lower.commarea -side top -fill x
2075 pack .vpane.lower.diff -side bottom -fill both -expand 1
2076 .vpane add .vpane.lower -stick nsew
2077
2078 # -- Commit Area Buttons
2079 frame .vpane.lower.commarea.buttons
2080 label .vpane.lower.commarea.buttons.l -text {} \
2081 -anchor w \
2082 -justify left \
2083 -font font_ui
2084 pack .vpane.lower.commarea.buttons.l -side top -fill x
2085 pack .vpane.lower.commarea.buttons -side left -fill y
2086
2087 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2088 -command do_rescan \
2089 -font font_ui
2090 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2091 lappend disable_on_lock \
2092 {.vpane.lower.commarea.buttons.rescan conf -state}
2093
2094 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2095 -command do_amend_last \
2096 -font font_ui
2097 pack .vpane.lower.commarea.buttons.amend -side top -fill x
2098 lappend disable_on_lock \
2099 {.vpane.lower.commarea.buttons.amend conf -state}
2100
2101 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2102 -command do_include_all \
2103 -font font_ui
2104 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2105 lappend disable_on_lock \
2106 {.vpane.lower.commarea.buttons.incall conf -state}
2107
2108 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2109 -command do_signoff \
2110 -font font_ui
2111 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2112
2113 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2114 -command do_commit \
2115 -font font_ui
2116 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2117 lappend disable_on_lock \
2118 {.vpane.lower.commarea.buttons.commit conf -state}
2119
2120 # -- Commit Message Buffer
2121 frame .vpane.lower.commarea.buffer
2122 set ui_comm .vpane.lower.commarea.buffer.t
2123 set ui_coml .vpane.lower.commarea.buffer.l
2124 label $ui_coml -text {Commit Message:} \
2125 -anchor w \
2126 -justify left \
2127 -font font_ui
2128 trace add variable commit_type write {uplevel #0 {
2129 switch -glob $commit_type \
2130 initial {$ui_coml conf -text {Initial Commit Message:}} \
2131 amend {$ui_coml conf -text {Amended Commit Message:}} \
2132 merge {$ui_coml conf -text {Merge Commit Message:}} \
2133 * {$ui_coml conf -text {Commit Message:}}
2134 }}
2135 text $ui_comm -background white -borderwidth 1 \
2136 -undo true \
2137 -maxundo 20 \
2138 -autoseparators true \
2139 -relief sunken \
2140 -width 75 -height 9 -wrap none \
2141 -font font_diff \
2142 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2143 scrollbar .vpane.lower.commarea.buffer.sby \
2144 -command [list $ui_comm yview]
2145 pack $ui_coml -side top -fill x
2146 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2147 pack $ui_comm -side left -fill y
2148 pack .vpane.lower.commarea.buffer -side left -fill y
2149
2150 # -- Commit Message Buffer Context Menu
2151 #
2152 menu $ui_comm.ctxm -tearoff 0
2153 $ui_comm.ctxm add command -label "Cut" \
2154 -font font_ui \
2155 -command "tk_textCut $ui_comm"
2156 $ui_comm.ctxm add command -label "Copy" \
2157 -font font_ui \
2158 -command "tk_textCopy $ui_comm"
2159 $ui_comm.ctxm add command -label "Paste" \
2160 -font font_ui \
2161 -command "tk_textPaste $ui_comm"
2162 $ui_comm.ctxm add command -label "Delete" \
2163 -font font_ui \
2164 -command "$ui_comm delete sel.first sel.last"
2165 $ui_comm.ctxm add separator
2166 $ui_comm.ctxm add command -label "Select All" \
2167 -font font_ui \
2168 -command "$ui_comm tag add sel 0.0 end"
2169 $ui_comm.ctxm add command -label "Copy All" \
2170 -font font_ui \
2171 -command "
2172 $ui_comm tag add sel 0.0 end
2173 tk_textCopy $ui_comm
2174 $ui_comm tag remove sel 0.0 end
2175 "
2176 $ui_comm.ctxm add separator
2177 $ui_comm.ctxm add command -label "Sign Off" \
2178 -font font_ui \
2179 -command do_signoff
2180 bind_button3 $ui_comm "tk_popup $ui_comm.ctxm %X %Y"
2181
2182 # -- Diff Header
2183 set ui_fname_value {}
2184 set ui_fstatus_value {}
2185 frame .vpane.lower.diff.header -background orange
2186 label .vpane.lower.diff.header.l1 -text {File:} \
2187 -background orange \
2188 -font font_ui
2189 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
2190 -background orange \
2191 -anchor w \
2192 -justify left \
2193 -font font_ui
2194 label .vpane.lower.diff.header.l3 -text {Status:} \
2195 -background orange \
2196 -font font_ui
2197 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
2198 -background orange \
2199 -width $max_status_desc \
2200 -anchor w \
2201 -justify left \
2202 -font font_ui
2203 pack .vpane.lower.diff.header.l1 -side left
2204 pack .vpane.lower.diff.header.l2 -side left -fill x
2205 pack .vpane.lower.diff.header.l4 -side right
2206 pack .vpane.lower.diff.header.l3 -side right
2207
2208 # -- Diff Body
2209 frame .vpane.lower.diff.body
2210 set ui_diff .vpane.lower.diff.body.t
2211 text $ui_diff -background white -borderwidth 0 \
2212 -width 80 -height 15 -wrap none \
2213 -font font_diff \
2214 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2215 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2216 -state disabled
2217 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2218 -command [list $ui_diff xview]
2219 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2220 -command [list $ui_diff yview]
2221 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2222 pack .vpane.lower.diff.body.sby -side right -fill y
2223 pack $ui_diff -side left -fill both -expand 1
2224 pack .vpane.lower.diff.header -side top -fill x
2225 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2226
2227 $ui_diff tag conf dm -foreground red
2228 $ui_diff tag conf dp -foreground blue
2229 $ui_diff tag conf di -foreground {#00a000}
2230 $ui_diff tag conf dni -foreground {#a000a0}
2231 $ui_diff tag conf da -font font_diffbold
2232 $ui_diff tag conf bold -font font_diffbold
2233
2234 # -- Diff Body Context Menu
2235 #
2236 menu $ui_diff.ctxm -tearoff 0
2237 $ui_diff.ctxm add command -label "Copy" \
2238 -font font_ui \
2239 -command "tk_textCopy $ui_diff"
2240 $ui_diff.ctxm add command -label "Select All" \
2241 -font font_ui \
2242 -command "$ui_diff tag add sel 0.0 end"
2243 $ui_diff.ctxm add command -label "Copy All" \
2244 -font font_ui \
2245 -command "
2246 $ui_diff tag add sel 0.0 end
2247 tk_textCopy $ui_diff
2248 $ui_diff tag remove sel 0.0 end
2249 "
2250 $ui_diff.ctxm add separator
2251 $ui_diff.ctxm add command -label "Decrease Font Size" \
2252 -font font_ui \
2253 -command {incr_font_size font_diff -1}
2254 $ui_diff.ctxm add command -label "Increase Font Size" \
2255 -font font_ui \
2256 -command {incr_font_size font_diff 1}
2257 bind_button3 $ui_diff "tk_popup $ui_diff.ctxm %X %Y"
2258
2259 # -- Status Bar
2260 set ui_status_value {Initializing...}
2261 label .status -textvariable ui_status_value \
2262 -anchor w \
2263 -justify left \
2264 -borderwidth 1 \
2265 -relief sunken \
2266 -font font_ui
2267 pack .status -anchor w -side bottom -fill x
2268
2269 # -- Load geometry
2270 catch {
2271 set gm $repo_config(gui.geometry)
2272 wm geometry . [lindex $gm 0]
2273 .vpane sash place 0 \
2274 [lindex [.vpane sash coord 0] 0] \
2275 [lindex $gm 1]
2276 .vpane.files sash place 0 \
2277 [lindex $gm 2] \
2278 [lindex [.vpane.files sash coord 0] 1]
2279 unset gm
2280 }
2281
2282 # -- Key Bindings
2283 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2284 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2285 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2286 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2287 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2288 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2289 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2290 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2291 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2292 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2293 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2294
2295 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2296 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2297 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2298 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2299 bind $ui_diff <$M1B-Key-v> {break}
2300 bind $ui_diff <$M1B-Key-V> {break}
2301 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2302 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2303 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2304 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2305 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2306 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2307
2308 bind . <Destroy> do_quit
2309 bind all <Key-F5> do_rescan
2310 bind all <$M1B-Key-r> do_rescan
2311 bind all <$M1B-Key-R> do_rescan
2312 bind . <$M1B-Key-s> do_signoff
2313 bind . <$M1B-Key-S> do_signoff
2314 bind . <$M1B-Key-i> do_include_all
2315 bind . <$M1B-Key-I> do_include_all
2316 bind . <$M1B-Key-Return> do_commit
2317 bind all <$M1B-Key-q> do_quit
2318 bind all <$M1B-Key-Q> do_quit
2319 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2320 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2321 foreach i [list $ui_index $ui_other] {
2322 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
2323 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
2324 bind_button3 $i {click %W %x %y 3 %X %Y; break}
2325 }
2326 unset i
2327
2328 set file_lists($ui_index) [list]
2329 set file_lists($ui_other) [list]
2330
2331 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2332 focus -force $ui_comm
2333 load_all_remotes
2334 populate_remote_menu .mbar.fetch From fetch_from
2335 populate_remote_menu .mbar.push To push_to
2336 populate_pull_menu .mbar.pull
2337 tkwait visibility .
2338 update_status
MinGW port of GIT