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