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