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