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