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