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