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