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