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