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