2 # Tcl ignores the next line -*- tcl -*- \
5 # 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.
10 set appname [lindex [file split $argv0] end]
13 ######################################################################
17 proc is_many_config {name} {
18 switch -glob -- $name {
28 global repo_config global_config default_config
30 array unset global_config
31 array unset repo_config
33 set fd_rc [open "| git repo-config --global --list" r]
34 while {[gets $fd_rc line] >= 0} {
35 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
36 if {[is_many_config $name]} {
37 lappend global_config($name) $value
39 set global_config($name) $value
46 set fd_rc [open "| git repo-config --list" r]
47 while {[gets $fd_rc line] >= 0} {
48 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
49 if {[is_many_config $name]} {
50 lappend repo_config($name) $value
52 set repo_config($name) $value
59 foreach name [array names default_config] {
60 if {[catch {set v $global_config($name)}]} {
61 set global_config($name) $default_config($name)
63 if {[catch {set v $repo_config($name)}]} {
64 set repo_config($name) $default_config($name)
70 global default_config font_descs
71 global repo_config global_config
72 global repo_config_new global_config_new
74 foreach option $font_descs {
75 set name [lindex $option 0]
76 set font [lindex $option 1]
77 font configure $font \
78 -family $global_config_new(gui.$font^^family) \
79 -size $global_config_new(gui.$font^^size)
80 font configure ${font}bold \
81 -family $global_config_new(gui.$font^^family) \
82 -size $global_config_new(gui.$font^^size)
83 set global_config_new(gui.$name) [font configure $font]
84 unset global_config_new(gui.$font^^family)
85 unset global_config_new(gui.$font^^size)
88 foreach name [array names default_config] {
89 set value $global_config_new($name)
90 if {$value != $global_config($name)} {
91 if {$value == $default_config($name)} {
92 catch {exec git repo-config --global --unset $name}
94 catch {exec git repo-config --global $name $value}
96 set global_config($name) $value
97 if {$value == $repo_config($name)} {
98 catch {exec git repo-config --unset $name}
99 set repo_config($name) $value
104 foreach name [array names default_config] {
105 set value $repo_config_new($name)
106 if {$value != $repo_config($name)} {
107 if {$value == $global_config($name)} {
108 catch {exec git repo-config --unset $name}
110 catch {exec git repo-config $name $value}
112 set repo_config($name) $value
117 proc error_popup {msg} {
118 global gitdir appname
123 append title [lindex \
124 [file split [file normalize [file dirname $gitdir]]] \
132 -title "$title: error" \
136 proc info_popup {msg} {
137 global gitdir appname
142 append title [lindex \
143 [file split [file normalize [file dirname $gitdir]]] \
155 ######################################################################
159 if { [catch {set cdup [exec git rev-parse --show-cdup]} err]
160 || [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
161 catch {wm withdraw .}
162 error_popup "Cannot find the git directory:\n\n$err"
170 if {$appname == {git-citool}} {
174 ######################################################################
183 set disable_on_lock [list]
184 set index_lock_type none
190 proc lock_index {type} {
191 global index_lock_type disable_on_lock
193 if {$index_lock_type == {none}} {
194 set index_lock_type $type
195 foreach w $disable_on_lock {
196 uplevel #0 $w disabled
199 } elseif {$index_lock_type == {begin-update} && $type == {update}} {
200 set index_lock_type $type
206 proc unlock_index {} {
207 global index_lock_type disable_on_lock
209 set index_lock_type none
210 foreach w $disable_on_lock {
215 ######################################################################
219 proc repository_state {hdvar ctvar} {
221 upvar $hdvar hd $ctvar ct
223 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
225 } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
232 proc update_status {{final Ready.}} {
233 global HEAD PARENT commit_type
234 global ui_index ui_other ui_status_value ui_comm
235 global status_active file_states
238 if {$status_active || ![lock_index read]} return
240 repository_state new_HEAD new_type
241 if {$commit_type == {amend}
242 && $new_type == {normal}
243 && $new_HEAD == $HEAD} {
247 set commit_type $new_type
250 array unset file_states
252 if {![$ui_comm edit modified]
253 || [string trim [$ui_comm get 0.0 end]] == {}} {
254 if {[load_message GITGUI_MSG]} {
255 } elseif {[load_message MERGE_MSG]} {
256 } elseif {[load_message SQUASH_MSG]} {
258 $ui_comm edit modified false
262 if {$repo_config(gui.trustmtime) == {true}} {
263 update_status_stage2 {} $final
266 set ui_status_value {Refreshing file status...}
267 set cmd [list git update-index]
269 lappend cmd --unmerged
270 lappend cmd --ignore-missing
271 lappend cmd --refresh
272 set fd_rf [open "| $cmd" r]
273 fconfigure $fd_rf -blocking 0 -translation binary
274 fileevent $fd_rf readable \
275 [list update_status_stage2 $fd_rf $final]
279 proc update_status_stage2 {fd final} {
280 global gitdir PARENT commit_type
281 global ui_index ui_other ui_status_value ui_comm
283 global buf_rdi buf_rdf buf_rlo
287 if {![eof $fd]} return
291 set ls_others [list | git ls-files --others -z \
292 --exclude-per-directory=.gitignore]
293 set info_exclude [file join $gitdir info exclude]
294 if {[file readable $info_exclude]} {
295 lappend ls_others "--exclude-from=$info_exclude"
303 set ui_status_value {Scanning for modified files ...}
304 set fd_di [open "| git diff-index --cached -z $PARENT" r]
305 set fd_df [open "| git diff-files -z" r]
306 set fd_lo [open $ls_others r]
308 fconfigure $fd_di -blocking 0 -translation binary
309 fconfigure $fd_df -blocking 0 -translation binary
310 fconfigure $fd_lo -blocking 0 -translation binary
311 fileevent $fd_di readable [list read_diff_index $fd_di $final]
312 fileevent $fd_df readable [list read_diff_files $fd_df $final]
313 fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
316 proc load_message {file} {
317 global gitdir ui_comm
319 set f [file join $gitdir $file]
320 if {[file isfile $f]} {
321 if {[catch {set fd [open $f r]}]} {
324 set content [string trim [read $fd]]
326 $ui_comm delete 0.0 end
327 $ui_comm insert end $content
333 proc read_diff_index {fd final} {
336 append buf_rdi [read $fd]
338 set n [string length $buf_rdi]
340 set z1 [string first "\0" $buf_rdi $c]
343 set z2 [string first "\0" $buf_rdi $z1]
349 [string range $buf_rdi $z1 $z2] \
350 [string index $buf_rdi [expr $z1 - 2]]_
354 set buf_rdi [string range $buf_rdi $c end]
359 status_eof $fd buf_rdi $final
362 proc read_diff_files {fd final} {
365 append buf_rdf [read $fd]
367 set n [string length $buf_rdf]
369 set z1 [string first "\0" $buf_rdf $c]
372 set z2 [string first "\0" $buf_rdf $z1]
378 [string range $buf_rdf $z1 $z2] \
379 _[string index $buf_rdf [expr $z1 - 2]]
383 set buf_rdf [string range $buf_rdf $c end]
388 status_eof $fd buf_rdf $final
391 proc read_ls_others {fd final} {
394 append buf_rlo [read $fd]
395 set pck [split $buf_rlo "\0"]
396 set buf_rlo [lindex $pck end]
397 foreach p [lrange $pck 0 end-1] {
400 status_eof $fd buf_rlo $final
403 proc status_eof {fd buf final} {
404 global status_active ui_status_value
411 if {[incr status_active -1] == 0} {
415 set ui_status_value $final
420 ######################################################################
425 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
427 $ui_diff conf -state normal
428 $ui_diff delete 0.0 end
429 $ui_diff conf -state disabled
431 set ui_fname_value {}
432 set ui_fstatus_value {}
434 $ui_index tag remove in_diff 0.0 end
435 $ui_other tag remove in_diff 0.0 end
438 proc reshow_diff {} {
439 global ui_fname_value ui_status_value file_states
441 if {$ui_fname_value == {}
442 || [catch {set s $file_states($ui_fname_value)}]} {
445 show_diff $ui_fname_value
449 proc handle_empty_diff {} {
450 global ui_fname_value file_states file_lists
452 set path $ui_fname_value
453 set s $file_states($path)
454 if {[lindex $s 0] != {_M}} return
456 info_popup "No differences detected.
458 [short_path $path] has no changes.
460 The modification date of this file was updated by another
461 application and you currently have the Trust File Modification
462 Timestamps option enabled, so Git did not automatically detect
463 that there are no content differences in this file.
465 This file will now be removed from the modified files list, to
466 prevent possible confusion.
468 if {[catch {exec git update-index -- $path} err]} {
469 error_popup "Failed to refresh index:\n\n$err"
473 set old_w [mapcol [lindex $file_states($path) 0] $path]
474 set lno [lsearch -sorted $file_lists($old_w) $path]
476 set file_lists($old_w) \
477 [lreplace $file_lists($old_w) $lno $lno]
479 $old_w conf -state normal
480 $old_w delete $lno.0 [expr $lno + 1].0
481 $old_w conf -state disabled
485 proc show_diff {path {w {}} {lno {}}} {
486 global file_states file_lists
487 global PARENT diff_3way diff_active
488 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
490 if {$diff_active || ![lock_index read]} return
493 if {$w == {} || $lno == {}} {
494 foreach w [array names file_lists] {
495 set lno [lsearch -sorted $file_lists($w) $path]
502 if {$w != {} && $lno >= 1} {
503 $w tag add in_diff $lno.0 [expr $lno + 1].0
506 set s $file_states($path)
510 set ui_fname_value [escape_path $path]
511 set ui_fstatus_value [mapdesc $m $path]
512 set ui_status_value "Loading diff of [escape_path $path]..."
514 set cmd [list | git diff-index -p $PARENT -- $path]
517 set cmd [list | git diff-index -p -c $PARENT $path]
521 set fd [open $path r]
522 set content [read $fd]
527 set ui_status_value "Unable to display [escape_path $path]"
528 error_popup "Error loading file:\n\n$err"
531 $ui_diff conf -state normal
532 $ui_diff insert end $content
533 $ui_diff conf -state disabled
536 set ui_status_value {Ready.}
541 if {[catch {set fd [open $cmd r]} err]} {
544 set ui_status_value "Unable to display [escape_path $path]"
545 error_popup "Error loading diff:\n\n$err"
549 fconfigure $fd -blocking 0 -translation auto
550 fileevent $fd readable [list read_diff $fd]
553 proc read_diff {fd} {
554 global ui_diff ui_status_value diff_3way diff_active
557 while {[gets $fd line] >= 0} {
558 if {[string match {diff --git *} $line]} continue
559 if {[string match {diff --combined *} $line]} continue
560 if {[string match {--- *} $line]} continue
561 if {[string match {+++ *} $line]} continue
562 if {[string match index* $line]} {
563 if {[string first , $line] >= 0} {
568 $ui_diff conf -state normal
570 set x [string index $line 0]
575 default {set tags {}}
578 set x [string range $line 0 1]
580 default {set tags {}}
582 "++" {set tags dp; set x " +"}
583 " +" {set tags {di bold}; set x "++"}
584 "+ " {set tags dni; set x "-+"}
585 "--" {set tags dm; set x " -"}
586 " -" {set tags {dm bold}; set x "--"}
587 "- " {set tags di; set x "+-"}
588 default {set tags {}}
590 set line [string replace $line 0 1 $x]
592 $ui_diff insert end $line $tags
593 $ui_diff insert end "\n"
594 $ui_diff conf -state disabled
601 set ui_status_value {Ready.}
603 if {$repo_config(gui.trustmtime) == {true}
604 && [$ui_diff index end] == {2.0}} {
610 ######################################################################
614 proc load_last_commit {} {
615 global HEAD PARENT commit_type ui_comm
617 if {$commit_type == {amend}} return
618 if {$commit_type != {normal}} {
619 error_popup "Can't amend a $commit_type commit."
627 set fd [open "| git cat-file commit $HEAD" r]
628 while {[gets $fd line] > 0} {
629 if {[string match {parent *} $line]} {
630 set parent [string range $line 7 end]
634 set msg [string trim [read $fd]]
637 error_popup "Error loading commit data for amend:\n\n$err"
641 if {$parent_count == 0} {
642 set commit_type amend
646 } elseif {$parent_count == 1} {
647 set commit_type amend
649 $ui_comm delete 0.0 end
650 $ui_comm insert end $msg
651 $ui_comm edit modified false
655 error_popup {You can't amend a merge commit.}
660 proc commit_tree {} {
661 global tcl_platform HEAD gitdir commit_type file_states
662 global commit_active ui_status_value
665 if {$commit_active || ![lock_index update]} return
667 # -- Our in memory state should match the repository.
669 repository_state curHEAD cur_type
670 if {$commit_type == {amend}
671 && $cur_type == {normal}
672 && $curHEAD == $HEAD} {
673 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
674 error_popup {Last scanned state does not match repository state.
676 Its highly likely that another Git program modified the
677 repository since our last scan. A rescan is required
685 # -- At least one file should differ in the index.
688 foreach path [array names file_states] {
689 set s $file_states($path)
690 switch -glob -- [lindex $s 0] {
694 M? {set files_ready 1; break}
696 error_popup "Unmerged files cannot be committed.
698 File [short_path $path] has merge conflicts.
699 You must resolve them and include the file before committing.
705 error_popup "Unknown file state [lindex $s 0] detected.
707 File [short_path $path] cannot be committed by this program.
713 error_popup {No included files to commit.
715 You must include at least 1 file before you can commit.
721 # -- A message is required.
723 set msg [string trim [$ui_comm get 1.0 end]]
725 error_popup {Please supply a commit message.
727 A good commit message has the following format:
729 - First line: Describe in one sentance what you did.
731 - Remaining lines: Describe why this change is good.
737 # -- Ask the pre-commit hook for the go-ahead.
739 set pchook [file join $gitdir hooks pre-commit]
740 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
741 set pchook [list sh -c \
742 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
743 } elseif {[file executable $pchook]} {
744 set pchook [list $pchook]
748 if {$pchook != {} && [catch {eval exec $pchook} err]} {
749 hook_failed_popup pre-commit $err
754 # -- Write the tree in the background.
757 set ui_status_value {Committing changes...}
759 set fd_wt [open "| git write-tree" r]
760 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
763 proc commit_stage2 {fd_wt curHEAD msg} {
764 global single_commit gitdir HEAD PARENT commit_type
765 global commit_active ui_status_value ui_comm
769 if {$tree_id == {} || [catch {close $fd_wt} err]} {
770 error_popup "write-tree failed:\n\n$err"
772 set ui_status_value {Commit failed.}
777 # -- Create the commit.
779 set cmd [list git commit-tree $tree_id]
781 lappend cmd -p $PARENT
783 if {$commit_type == {merge}} {
785 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
786 while {[gets $fd_mh merge_head] >= 0} {
787 lappend cmd -p $merge_head
791 error_popup "Loading MERGE_HEAD failed:\n\n$err"
793 set ui_status_value {Commit failed.}
799 # git commit-tree writes to stderr during initial commit.
800 lappend cmd 2>/dev/null
803 if {[catch {set cmt_id [eval exec $cmd]} err]} {
804 error_popup "commit-tree failed:\n\n$err"
806 set ui_status_value {Commit failed.}
811 # -- Update the HEAD ref.
814 if {$commit_type != {normal}} {
815 append reflogm " ($commit_type)"
817 set i [string first "\n" $msg]
819 append reflogm {: } [string range $msg 0 [expr $i - 1]]
821 append reflogm {: } $msg
823 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
824 if {[catch {eval exec $cmd} err]} {
825 error_popup "update-ref failed:\n\n$err"
827 set ui_status_value {Commit failed.}
832 # -- Cleanup after ourselves.
834 catch {file delete [file join $gitdir MERGE_HEAD]}
835 catch {file delete [file join $gitdir MERGE_MSG]}
836 catch {file delete [file join $gitdir SQUASH_MSG]}
837 catch {file delete [file join $gitdir GITGUI_MSG]}
839 # -- Let rerere do its thing.
841 if {[file isdirectory [file join $gitdir rr-cache]]} {
842 catch {exec git rerere}
845 $ui_comm delete 0.0 end
846 $ui_comm edit modified false
849 if {$single_commit} do_quit
851 # -- Update status without invoking any git commands.
854 set commit_type normal
858 foreach path [array names file_states] {
859 set s $file_states($path)
864 D? {set m _[string index $m 1]}
868 unset file_states($path)
870 lset file_states($path) 0 $m
877 set ui_status_value \
878 "Changes committed as [string range $cmt_id 0 7]."
881 ######################################################################
885 proc fetch_from {remote} {
886 set w [new_console "fetch $remote" \
887 "Fetching new changes from $remote"]
888 set cmd [list git fetch]
893 proc pull_remote {remote branch} {
894 global HEAD commit_type
897 if {![lock_index update]} return
899 # -- Our in memory state should match the repository.
901 repository_state curHEAD cur_type
902 if {$commit_type != $cur_type || $HEAD != $curHEAD} {
903 error_popup {Last scanned state does not match repository state.
905 Its highly likely that another Git program modified the
906 repository since our last scan. A rescan is required
907 before a pull can be started.
914 # -- No differences should exist before a pull.
916 if {[array size file_states] != 0} {
917 error_popup {Uncommitted but modified files are present.
919 You should not perform a pull with unmodified files in your working
920 directory as Git would be unable to recover from an incorrect merge.
922 Commit or throw away all changes before starting a pull operation.
928 set w [new_console "pull $remote $branch" \
929 "Pulling new changes from branch $branch in $remote"]
930 set cmd [list git pull]
933 console_exec $w $cmd [list post_pull_remote $remote $branch]
936 proc post_pull_remote {remote branch success} {
937 global HEAD PARENT commit_type
938 global ui_status_value
942 repository_state HEAD commit_type
944 set $ui_status_value {Ready.}
947 "Conflicts detected while pulling $branch from $remote."
951 proc push_to {remote} {
952 set w [new_console "push $remote" \
953 "Pushing changes to $remote"]
954 set cmd [list git push]
959 ######################################################################
963 proc mapcol {state path} {
964 global all_cols ui_other
966 if {[catch {set r $all_cols($state)}]} {
967 puts "error: no column for state={$state} $path"
973 proc mapicon {state path} {
976 if {[catch {set r $all_icons($state)}]} {
977 puts "error: no icon for state={$state} $path"
983 proc mapdesc {state path} {
986 if {[catch {set r $all_descs($state)}]} {
987 puts "error: no desc for state={$state} $path"
993 proc escape_path {path} {
994 regsub -all "\n" $path "\\n" path
998 proc short_path {path} {
999 return [escape_path [lindex [file split $path] end]]
1004 proc merge_state {path new_state} {
1005 global file_states next_icon_id
1007 set s0 [string index $new_state 0]
1008 set s1 [string index $new_state 1]
1010 if {[catch {set info $file_states($path)}]} {
1012 set icon n[incr next_icon_id]
1014 set state [lindex $info 0]
1015 set icon [lindex $info 1]
1019 set s0 [string index $state 0]
1020 } elseif {$s0 == {*}} {
1025 set s1 [string index $state 1]
1026 } elseif {$s1 == {*}} {
1030 set file_states($path) [list $s0$s1 $icon]
1034 proc display_file {path state} {
1035 global file_states file_lists status_active
1037 set old_m [merge_state $path $state]
1038 if {$status_active} return
1040 set s $file_states($path)
1041 set new_m [lindex $s 0]
1042 set new_w [mapcol $new_m $path]
1043 set old_w [mapcol $old_m $path]
1044 set new_icon [mapicon $new_m $path]
1046 if {$new_w != $old_w} {
1047 set lno [lsearch -sorted $file_lists($old_w) $path]
1050 $old_w conf -state normal
1051 $old_w delete $lno.0 [expr $lno + 1].0
1052 $old_w conf -state disabled
1055 lappend file_lists($new_w) $path
1056 set file_lists($new_w) [lsort $file_lists($new_w)]
1057 set lno [lsearch -sorted $file_lists($new_w) $path]
1059 $new_w conf -state normal
1060 $new_w image create $lno.0 \
1061 -align center -padx 5 -pady 1 \
1062 -name [lindex $s 1] \
1064 $new_w insert $lno.1 "[escape_path $path]\n"
1065 $new_w conf -state disabled
1066 } elseif {$new_icon != [mapicon $old_m $path]} {
1067 $new_w conf -state normal
1068 $new_w image conf [lindex $s 1] -image $new_icon
1069 $new_w conf -state disabled
1073 proc display_all_files {} {
1074 global ui_index ui_other file_states file_lists
1076 $ui_index conf -state normal
1077 $ui_other conf -state normal
1079 $ui_index delete 0.0 end
1080 $ui_other delete 0.0 end
1082 set file_lists($ui_index) [list]
1083 set file_lists($ui_other) [list]
1085 foreach path [lsort [array names file_states]] {
1086 set s $file_states($path)
1088 set w [mapcol $m $path]
1089 lappend file_lists($w) $path
1090 $w image create end \
1091 -align center -padx 5 -pady 1 \
1092 -name [lindex $s 1] \
1093 -image [mapicon $m $path]
1094 $w insert end "[escape_path $path]\n"
1097 $ui_index conf -state disabled
1098 $ui_other conf -state disabled
1101 proc update_index {pathList} {
1102 global update_index_cp ui_status_value
1104 if {![lock_index update]} return
1106 set update_index_cp 0
1107 set totalCnt [llength $pathList]
1108 set batch [expr {int($totalCnt * .01) + 1}]
1109 if {$batch > 25} {set batch 25}
1111 set ui_status_value "Including files ... 0/$totalCnt 0%"
1112 set ui_status_value [format \
1113 "Including files ... %i/%i files (%.2f%%)" \
1117 set fd [open "| git update-index --add --remove -z --stdin" w]
1118 fconfigure $fd -blocking 0 -translation binary
1119 fileevent $fd writable [list \
1120 write_update_index \
1128 proc write_update_index {fd pathList totalCnt batch} {
1129 global update_index_cp ui_status_value
1130 global file_states ui_fname_value
1132 if {$update_index_cp >= $totalCnt} {
1135 set ui_status_value {Ready.}
1139 for {set i $batch} \
1140 {$update_index_cp < $totalCnt && $i > 0} \
1142 set path [lindex $pathList $update_index_cp]
1143 incr update_index_cp
1145 switch -- [lindex $file_states($path) 0] {
1155 puts -nonewline $fd $path
1156 puts -nonewline $fd "\0"
1157 display_file $path $new
1158 if {$ui_fname_value == $path} {
1163 set ui_status_value [format \
1164 "Including files ... %i/%i files (%.2f%%)" \
1167 [expr {100.0 * $update_index_cp / $totalCnt}]]
1170 ######################################################################
1172 ## remote management
1174 proc load_all_remotes {} {
1175 global gitdir all_remotes repo_config
1177 set all_remotes [list]
1178 set rm_dir [file join $gitdir remotes]
1179 if {[file isdirectory $rm_dir]} {
1180 set all_remotes [concat $all_remotes [glob \
1184 -directory $rm_dir *]]
1187 foreach line [array names repo_config remote.*.url] {
1188 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1189 lappend all_remotes $name
1193 set all_remotes [lsort -unique $all_remotes]
1196 proc populate_remote_menu {m pfx op} {
1199 foreach remote $all_remotes {
1200 $m add command -label "$pfx $remote..." \
1201 -command [list $op $remote] \
1206 proc populate_pull_menu {m} {
1207 global gitdir repo_config all_remotes disable_on_lock
1209 foreach remote $all_remotes {
1211 if {[array get repo_config remote.$remote.url] != {}} {
1212 if {[array get repo_config remote.$remote.fetch] != {}} {
1213 regexp {^([^:]+):} \
1214 [lindex $repo_config(remote.$remote.fetch) 0] \
1219 set fd [open [file join $gitdir remotes $remote] r]
1220 while {[gets $fd line] >= 0} {
1221 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1230 regsub ^refs/heads/ $rb {} rb_short
1231 if {$rb_short != {}} {
1233 -label "Branch $rb_short from $remote..." \
1234 -command [list pull_remote $remote $rb] \
1236 lappend disable_on_lock \
1237 [list $m entryconf [$m index last] -state]
1242 ######################################################################
1247 #define mask_width 14
1248 #define mask_height 15
1249 static unsigned char mask_bits[] = {
1250 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1251 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1252 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1255 image create bitmap file_plain -background white -foreground black -data {
1256 #define plain_width 14
1257 #define plain_height 15
1258 static unsigned char plain_bits[] = {
1259 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1260 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1261 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1262 } -maskdata $filemask
1264 image create bitmap file_mod -background white -foreground blue -data {
1265 #define mod_width 14
1266 #define mod_height 15
1267 static unsigned char mod_bits[] = {
1268 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1269 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1270 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1271 } -maskdata $filemask
1273 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1274 #define file_fulltick_width 14
1275 #define file_fulltick_height 15
1276 static unsigned char file_fulltick_bits[] = {
1277 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1278 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1279 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1280 } -maskdata $filemask
1282 image create bitmap file_parttick -background white -foreground "#005050" -data {
1283 #define parttick_width 14
1284 #define parttick_height 15
1285 static unsigned char parttick_bits[] = {
1286 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1287 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1288 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1289 } -maskdata $filemask
1291 image create bitmap file_question -background white -foreground black -data {
1292 #define file_question_width 14
1293 #define file_question_height 15
1294 static unsigned char file_question_bits[] = {
1295 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1296 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1297 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1298 } -maskdata $filemask
1300 image create bitmap file_removed -background white -foreground red -data {
1301 #define file_removed_width 14
1302 #define file_removed_height 15
1303 static unsigned char file_removed_bits[] = {
1304 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1305 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1306 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1307 } -maskdata $filemask
1309 image create bitmap file_merge -background white -foreground blue -data {
1310 #define file_merge_width 14
1311 #define file_merge_height 15
1312 static unsigned char file_merge_bits[] = {
1313 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1314 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1315 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1316 } -maskdata $filemask
1318 set ui_index .vpane.files.index.list
1319 set ui_other .vpane.files.other.list
1320 set max_status_desc 0
1322 {__ i plain "Unmodified"}
1323 {_M i mod "Modified"}
1324 {M_ i fulltick "Checked in"}
1325 {MM i parttick "Partially included"}
1327 {_O o plain "Untracked"}
1328 {A_ o fulltick "Added"}
1329 {AM o parttick "Partially added"}
1330 {AD o question "Added (but now gone)"}
1332 {_D i question "Missing"}
1333 {D_ i removed "Removed"}
1334 {DD i removed "Removed"}
1335 {DO i removed "Removed (still exists)"}
1337 {UM i merge "Merge conflicts"}
1338 {U_ i merge "Merge conflicts"}
1340 if {$max_status_desc < [string length [lindex $i 3]]} {
1341 set max_status_desc [string length [lindex $i 3]]
1343 if {[lindex $i 1] == {i}} {
1344 set all_cols([lindex $i 0]) $ui_index
1346 set all_cols([lindex $i 0]) $ui_other
1348 set all_icons([lindex $i 0]) file_[lindex $i 2]
1349 set all_descs([lindex $i 0]) [lindex $i 3]
1353 ######################################################################
1358 global tcl_platform tk_library
1359 if {$tcl_platform(platform) == {unix}
1360 && $tcl_platform(os) == {Darwin}
1361 && [string match /Library/Frameworks/* $tk_library]} {
1367 proc bind_button3 {w cmd} {
1368 bind $w <Any-Button-3> $cmd
1370 bind $w <Control-Button-1> $cmd
1374 proc incr_font_size {font {amt 1}} {
1375 set sz [font configure $font -size]
1377 font configure $font -size $sz
1378 font configure ${font}bold -size $sz
1381 proc hook_failed_popup {hook msg} {
1382 global gitdir appname
1388 label $w.m.l1 -text "$hook hook failed:" \
1393 -background white -borderwidth 1 \
1395 -width 80 -height 10 \
1397 -yscrollcommand [list $w.m.sby set]
1399 -text {You must correct the above errors before committing.} \
1403 scrollbar $w.m.sby -command [list $w.m.t yview]
1404 pack $w.m.l1 -side top -fill x
1405 pack $w.m.l2 -side bottom -fill x
1406 pack $w.m.sby -side right -fill y
1407 pack $w.m.t -side left -fill both -expand 1
1408 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1410 $w.m.t insert 1.0 $msg
1411 $w.m.t conf -state disabled
1413 button $w.ok -text OK \
1416 -command "destroy $w"
1417 pack $w.ok -side bottom
1419 bind $w <Visibility> "grab $w; focus $w"
1420 bind $w <Key-Return> "destroy $w"
1421 wm title $w "$appname ([lindex [file split \
1422 [file normalize [file dirname $gitdir]]] \
1427 set next_console_id 0
1429 proc new_console {short_title long_title} {
1430 global next_console_id console_data
1431 set w .console[incr next_console_id]
1432 set console_data($w) [list $short_title $long_title]
1433 return [console_init $w]
1436 proc console_init {w} {
1437 global console_cr console_data
1438 global gitdir appname M1B
1440 set console_cr($w) 1.0
1443 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1448 -background white -borderwidth 1 \
1450 -width 80 -height 10 \
1453 -yscrollcommand [list $w.m.sby set]
1454 label $w.m.s -anchor w \
1457 scrollbar $w.m.sby -command [list $w.m.t yview]
1458 pack $w.m.l1 -side top -fill x
1459 pack $w.m.s -side bottom -fill x
1460 pack $w.m.sby -side right -fill y
1461 pack $w.m.t -side left -fill both -expand 1
1462 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1464 menu $w.ctxm -tearoff 0
1465 $w.ctxm add command -label "Copy" \
1467 -command "tk_textCopy $w.m.t"
1468 $w.ctxm add command -label "Select All" \
1470 -command "$w.m.t tag add sel 0.0 end"
1471 $w.ctxm add command -label "Copy All" \
1474 $w.m.t tag add sel 0.0 end
1476 $w.m.t tag remove sel 0.0 end
1479 button $w.ok -text {Running...} \
1483 -command "destroy $w"
1484 pack $w.ok -side bottom
1486 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1487 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1488 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1489 bind $w <Visibility> "focus $w"
1490 wm title $w "$appname ([lindex [file split \
1491 [file normalize [file dirname $gitdir]]] \
1492 end]): [lindex $console_data($w) 0]"
1496 proc console_exec {w cmd {after {}}} {
1499 # -- Windows tosses the enviroment when we exec our child.
1500 # But most users need that so we have to relogin. :-(
1502 if {$tcl_platform(platform) == {windows}} {
1503 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1506 # -- Tcl won't let us redirect both stdout and stderr to
1507 # the same pipe. So pass it through cat...
1509 set cmd [concat | $cmd |& cat]
1511 set fd_f [open $cmd r]
1512 fconfigure $fd_f -blocking 0 -translation binary
1513 fileevent $fd_f readable [list console_read $w $fd_f $after]
1516 proc console_read {w fd after} {
1517 global console_cr console_data
1521 if {![winfo exists $w]} {console_init $w}
1522 $w.m.t conf -state normal
1524 set n [string length $buf]
1526 set cr [string first "\r" $buf $c]
1527 set lf [string first "\n" $buf $c]
1528 if {$cr < 0} {set cr [expr $n + 1]}
1529 if {$lf < 0} {set lf [expr $n + 1]}
1532 $w.m.t insert end [string range $buf $c $lf]
1533 set console_cr($w) [$w.m.t index {end -1c}]
1537 $w.m.t delete $console_cr($w) end
1538 $w.m.t insert end "\n"
1539 $w.m.t insert end [string range $buf $c $cr]
1544 $w.m.t conf -state disabled
1548 fconfigure $fd -blocking 1
1550 if {[catch {close $fd}]} {
1551 if {![winfo exists $w]} {console_init $w}
1552 $w.m.s conf -background red -text {Error: Command Failed}
1553 $w.ok conf -text Close
1554 $w.ok conf -state normal
1556 } elseif {[winfo exists $w]} {
1557 $w.m.s conf -background green -text {Success}
1558 $w.ok conf -text Close
1559 $w.ok conf -state normal
1562 array unset console_cr $w
1563 array unset console_data $w
1565 uplevel #0 $after $ok
1569 fconfigure $fd -blocking 0
1572 ######################################################################
1576 set starting_gitk_msg {Please wait... Starting gitk...}
1579 global tcl_platform ui_status_value starting_gitk_msg
1581 set ui_status_value $starting_gitk_msg
1583 if {$ui_status_value == $starting_gitk_msg} {
1584 set ui_status_value {Ready.}
1588 if {$tcl_platform(platform) == {windows}} {
1596 set w [new_console "repack" "Repacking the object database"]
1597 set cmd [list git repack]
1600 console_exec $w $cmd
1606 global gitdir ui_comm is_quitting repo_config
1608 if {$is_quitting} return
1611 # -- Stash our current commit buffer.
1613 set save [file join $gitdir GITGUI_MSG]
1614 set msg [string trim [$ui_comm get 0.0 end]]
1615 if {[$ui_comm edit modified] && $msg != {}} {
1617 set fd [open $save w]
1618 puts $fd [string trim [$ui_comm get 0.0 end]]
1621 } elseif {$msg == {} && [file exists $save]} {
1625 # -- Stash our current window geometry into this repository.
1627 set cfg_geometry [list]
1628 lappend cfg_geometry [wm geometry .]
1629 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1630 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1631 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1634 if {$cfg_geometry != $rc_geometry} {
1635 catch {exec git repo-config gui.geometry $cfg_geometry}
1645 proc do_include_all {} {
1648 if {![lock_index begin-update]} return
1651 foreach path [array names file_states] {
1652 set s $file_states($path)
1658 _D {lappend pathList $path}
1661 if {$pathList == {}} {
1664 update_index $pathList
1668 set GIT_COMMITTER_IDENT {}
1670 proc do_signoff {} {
1671 global ui_comm GIT_COMMITTER_IDENT
1673 if {$GIT_COMMITTER_IDENT == {}} {
1674 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1675 error_popup "Unable to obtain your identity:\n\n$err"
1678 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1679 $me me GIT_COMMITTER_IDENT]} {
1680 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1685 set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1686 set last [$ui_comm get {end -1c linestart} {end -1c}]
1687 if {$last != $sob} {
1688 $ui_comm edit separator
1690 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1691 $ui_comm insert end "\n"
1693 $ui_comm insert end "\n$sob"
1694 $ui_comm edit separator
1699 proc do_amend_last {} {
1707 proc do_options {} {
1708 global appname gitdir font_descs
1709 global repo_config global_config
1710 global repo_config_new global_config_new
1713 array unset repo_config_new
1714 array unset global_config_new
1715 foreach name [array names repo_config] {
1716 set repo_config_new($name) $repo_config($name)
1718 foreach name [array names global_config] {
1719 set global_config_new($name) $global_config($name)
1722 set w .options_editor
1725 label $w.header -text "$appname Options" \
1727 pack $w.header -side top -fill x
1730 button $w.buttons.restore -text {Restore Defaults} \
1732 -command do_restore_defaults
1733 pack $w.buttons.restore -side left
1734 button $w.buttons.save -text Save \
1736 -command [list do_save_config $w]
1737 pack $w.buttons.save -side right
1738 button $w.buttons.cancel -text {Cancel} \
1740 -command [list destroy $w]
1741 pack $w.buttons.cancel -side right
1742 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1744 labelframe $w.repo -text {This Repository} \
1746 -relief raised -borderwidth 2
1747 labelframe $w.global -text {Global (All Repositories)} \
1749 -relief raised -borderwidth 2
1750 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1751 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1754 {trustmtime {Trust File Modification Timestamps}}
1756 set name [lindex $option 0]
1757 set text [lindex $option 1]
1758 foreach f {repo global} {
1759 checkbutton $w.$f.$name -text $text \
1760 -variable ${f}_config_new(gui.$name) \
1764 pack $w.$f.$name -side top -anchor w
1768 set all_fonts [lsort [font families]]
1769 foreach option $font_descs {
1770 set name [lindex $option 0]
1771 set font [lindex $option 1]
1772 set text [lindex $option 2]
1774 set global_config_new(gui.$font^^family) \
1775 [font configure $font -family]
1776 set global_config_new(gui.$font^^size) \
1777 [font configure $font -size]
1779 frame $w.global.$name
1780 label $w.global.$name.l -text "$text:" -font font_ui
1781 pack $w.global.$name.l -side left -anchor w -fill x
1782 eval tk_optionMenu $w.global.$name.family \
1783 global_config_new(gui.$font^^family) \
1785 spinbox $w.global.$name.size \
1786 -textvariable global_config_new(gui.$font^^size) \
1787 -from 2 -to 80 -increment 1 \
1790 pack $w.global.$name.size -side right -anchor e
1791 pack $w.global.$name.family -side right -anchor e
1792 pack $w.global.$name -side top -anchor w -fill x
1795 bind $w <Visibility> "grab $w; focus $w"
1796 bind $w <Key-Escape> "destroy $w"
1797 wm title $w "$appname ([lindex [file split \
1798 [file normalize [file dirname $gitdir]]] \
1803 proc do_restore_defaults {} {
1804 global font_descs default_config
1805 global repo_config_new global_config_new
1807 foreach name [array names default_config] {
1808 set repo_config_new($name) $default_config($name)
1809 set global_config_new($name) $default_config($name)
1812 foreach option $font_descs {
1813 set name [lindex $option 0]
1814 set repo_config($name) $default_config(gui.$name)
1818 foreach option $font_descs {
1819 set name [lindex $option 0]
1820 set font [lindex $option 1]
1821 set global_config_new(gui.$font^^family) \
1822 [font configure $font -family]
1823 set global_config_new(gui.$font^^size) \
1824 [font configure $font -size]
1828 proc do_save_config {w} {
1829 if {[catch {save_config} err]} {
1830 error_popup "Failed to completely save options:\n\n$err"
1835 # shift == 1: left click
1837 proc click {w x y shift wx wy} {
1838 global ui_index ui_other file_lists
1840 set pos [split [$w index @$x,$y] .]
1841 set lno [lindex $pos 0]
1842 set col [lindex $pos 1]
1843 set path [lindex $file_lists($w) [expr $lno - 1]]
1844 if {$path == {}} return
1846 if {$col > 0 && $shift == 1} {
1847 show_diff $path $w $lno
1851 proc unclick {w x y} {
1854 set pos [split [$w index @$x,$y] .]
1855 set lno [lindex $pos 0]
1856 set col [lindex $pos 1]
1857 set path [lindex $file_lists($w) [expr $lno - 1]]
1858 if {$path == {}} return
1861 update_index [list $path]
1865 ######################################################################
1869 set cursor_ptr arrow
1870 font create font_diff -family Courier -size 10
1874 eval font configure font_ui [font actual [.dummy cget -font]]
1878 font create font_uibold
1879 font create font_diffbold
1883 if {$tcl_platform(platform) == {windows}} {
1886 } elseif {[is_MacOSX]} {
1891 proc apply_config {} {
1892 global repo_config font_descs
1894 foreach option $font_descs {
1895 set name [lindex $option 0]
1896 set font [lindex $option 1]
1898 foreach {cn cv} $repo_config(gui.$name) {
1899 font configure $font $cn $cv
1902 error_popup "Invalid font specified in gui.$name:\n\n$err"
1904 foreach {cn cv} [font configure $font] {
1905 font configure ${font}bold $cn $cv
1907 font configure ${font}bold -weight bold
1911 set default_config(gui.trustmtime) false
1912 set default_config(gui.fontui) [font configure font_ui]
1913 set default_config(gui.fontdiff) [font configure font_diff]
1915 {fontui font_ui {Main Font}}
1916 {fontdiff font_diff {Diff/Console Font}}
1921 ######################################################################
1926 menu .mbar -tearoff 0
1927 .mbar add cascade -label Project -menu .mbar.project
1928 .mbar add cascade -label Edit -menu .mbar.edit
1929 .mbar add cascade -label Commit -menu .mbar.commit
1930 .mbar add cascade -label Fetch -menu .mbar.fetch
1931 .mbar add cascade -label Pull -menu .mbar.pull
1932 .mbar add cascade -label Push -menu .mbar.push
1933 . configure -menu .mbar
1937 .mbar.project add command -label Visualize \
1940 .mbar.project add command -label {Repack Database} \
1941 -command do_repack \
1943 .mbar.project add command -label Quit \
1945 -accelerator $M1T-Q \
1951 .mbar.edit add command -label Undo \
1952 -command {catch {[focus] edit undo}} \
1953 -accelerator $M1T-Z \
1955 .mbar.edit add command -label Redo \
1956 -command {catch {[focus] edit redo}} \
1957 -accelerator $M1T-Y \
1959 .mbar.edit add separator
1960 .mbar.edit add command -label Cut \
1961 -command {catch {tk_textCut [focus]}} \
1962 -accelerator $M1T-X \
1964 .mbar.edit add command -label Copy \
1965 -command {catch {tk_textCopy [focus]}} \
1966 -accelerator $M1T-C \
1968 .mbar.edit add command -label Paste \
1969 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1970 -accelerator $M1T-V \
1972 .mbar.edit add command -label Delete \
1973 -command {catch {[focus] delete sel.first sel.last}} \
1976 .mbar.edit add separator
1977 .mbar.edit add command -label {Select All} \
1978 -command {catch {[focus] tag add sel 0.0 end}} \
1979 -accelerator $M1T-A \
1981 .mbar.edit add separator
1982 .mbar.edit add command -label {Options...} \
1983 -command do_options \
1988 .mbar.commit add command -label Rescan \
1989 -command do_rescan \
1992 lappend disable_on_lock \
1993 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1994 .mbar.commit add command -label {Amend Last Commit} \
1995 -command do_amend_last \
1997 lappend disable_on_lock \
1998 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1999 .mbar.commit add command -label {Include All Files} \
2000 -command do_include_all \
2001 -accelerator $M1T-I \
2003 lappend disable_on_lock \
2004 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2005 .mbar.commit add command -label {Sign Off} \
2006 -command do_signoff \
2007 -accelerator $M1T-S \
2009 .mbar.commit add command -label Commit \
2010 -command do_commit \
2011 -accelerator $M1T-Return \
2013 lappend disable_on_lock \
2014 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2025 # -- Main Window Layout
2026 panedwindow .vpane -orient vertical
2027 panedwindow .vpane.files -orient horizontal
2028 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2029 pack .vpane -anchor n -side top -fill both -expand 1
2031 # -- Index File List
2032 frame .vpane.files.index -height 100 -width 400
2033 label .vpane.files.index.title -text {Modified Files} \
2036 text $ui_index -background white -borderwidth 0 \
2037 -width 40 -height 10 \
2039 -cursor $cursor_ptr \
2040 -yscrollcommand {.vpane.files.index.sb set} \
2042 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2043 pack .vpane.files.index.title -side top -fill x
2044 pack .vpane.files.index.sb -side right -fill y
2045 pack $ui_index -side left -fill both -expand 1
2046 .vpane.files add .vpane.files.index -sticky nsew
2048 # -- Other (Add) File List
2049 frame .vpane.files.other -height 100 -width 100
2050 label .vpane.files.other.title -text {Untracked Files} \
2053 text $ui_other -background white -borderwidth 0 \
2054 -width 40 -height 10 \
2056 -cursor $cursor_ptr \
2057 -yscrollcommand {.vpane.files.other.sb set} \
2059 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2060 pack .vpane.files.other.title -side top -fill x
2061 pack .vpane.files.other.sb -side right -fill y
2062 pack $ui_other -side left -fill both -expand 1
2063 .vpane.files add .vpane.files.other -sticky nsew
2065 $ui_index tag conf in_diff -font font_uibold
2066 $ui_other tag conf in_diff -font font_uibold
2068 # -- Diff and Commit Area
2069 frame .vpane.lower -height 400 -width 400
2070 frame .vpane.lower.commarea
2071 frame .vpane.lower.diff -relief sunken -borderwidth 1
2072 pack .vpane.lower.commarea -side top -fill x
2073 pack .vpane.lower.diff -side bottom -fill both -expand 1
2074 .vpane add .vpane.lower -stick nsew
2076 # -- Commit Area Buttons
2077 frame .vpane.lower.commarea.buttons
2078 label .vpane.lower.commarea.buttons.l -text {} \
2082 pack .vpane.lower.commarea.buttons.l -side top -fill x
2083 pack .vpane.lower.commarea.buttons -side left -fill y
2085 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2086 -command do_rescan \
2088 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2089 lappend disable_on_lock \
2090 {.vpane.lower.commarea.buttons.rescan conf -state}
2092 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2093 -command do_amend_last \
2095 pack .vpane.lower.commarea.buttons.amend -side top -fill x
2096 lappend disable_on_lock \
2097 {.vpane.lower.commarea.buttons.amend conf -state}
2099 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2100 -command do_include_all \
2102 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2103 lappend disable_on_lock \
2104 {.vpane.lower.commarea.buttons.incall conf -state}
2106 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2107 -command do_signoff \
2109 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2111 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2112 -command do_commit \
2114 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2115 lappend disable_on_lock \
2116 {.vpane.lower.commarea.buttons.commit conf -state}
2118 # -- Commit Message Buffer
2119 frame .vpane.lower.commarea.buffer
2120 set ui_comm .vpane.lower.commarea.buffer.t
2121 set ui_coml .vpane.lower.commarea.buffer.l
2122 label $ui_coml -text {Commit Message:} \
2126 trace add variable commit_type write {uplevel #0 {
2127 switch -glob $commit_type \
2128 initial {$ui_coml conf -text {Initial Commit Message:}} \
2129 amend {$ui_coml conf -text {Amended Commit Message:}} \
2130 merge {$ui_coml conf -text {Merge Commit Message:}} \
2131 * {$ui_coml conf -text {Commit Message:}}
2133 text $ui_comm -background white -borderwidth 1 \
2136 -autoseparators true \
2138 -width 75 -height 9 -wrap none \
2140 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2141 scrollbar .vpane.lower.commarea.buffer.sby \
2142 -command [list $ui_comm yview]
2143 pack $ui_coml -side top -fill x
2144 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2145 pack $ui_comm -side left -fill y
2146 pack .vpane.lower.commarea.buffer -side left -fill y
2148 # -- Commit Message Buffer Context Menu
2150 menu $ui_comm.ctxm -tearoff 0
2151 $ui_comm.ctxm add command -label "Cut" \
2153 -command "tk_textCut $ui_comm"
2154 $ui_comm.ctxm add command -label "Copy" \
2156 -command "tk_textCopy $ui_comm"
2157 $ui_comm.ctxm add command -label "Paste" \
2159 -command "tk_textPaste $ui_comm"
2160 $ui_comm.ctxm add command -label "Delete" \
2162 -command "$ui_comm delete sel.first sel.last"
2163 $ui_comm.ctxm add separator
2164 $ui_comm.ctxm add command -label "Select All" \
2166 -command "$ui_comm tag add sel 0.0 end"
2167 $ui_comm.ctxm add command -label "Copy All" \
2170 $ui_comm tag add sel 0.0 end
2171 tk_textCopy $ui_comm
2172 $ui_comm tag remove sel 0.0 end
2174 $ui_comm.ctxm add separator
2175 $ui_comm.ctxm add command -label "Sign Off" \
2178 bind_button3 $ui_comm "tk_popup $ui_comm.ctxm %X %Y"
2181 set ui_fname_value {}
2182 set ui_fstatus_value {}
2183 frame .vpane.lower.diff.header -background orange
2184 label .vpane.lower.diff.header.l1 -text {File:} \
2185 -background orange \
2187 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
2188 -background orange \
2192 label .vpane.lower.diff.header.l3 -text {Status:} \
2193 -background orange \
2195 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
2196 -background orange \
2197 -width $max_status_desc \
2201 pack .vpane.lower.diff.header.l1 -side left
2202 pack .vpane.lower.diff.header.l2 -side left -fill x
2203 pack .vpane.lower.diff.header.l4 -side right
2204 pack .vpane.lower.diff.header.l3 -side right
2207 frame .vpane.lower.diff.body
2208 set ui_diff .vpane.lower.diff.body.t
2209 text $ui_diff -background white -borderwidth 0 \
2210 -width 80 -height 15 -wrap none \
2212 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2213 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2215 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2216 -command [list $ui_diff xview]
2217 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2218 -command [list $ui_diff yview]
2219 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2220 pack .vpane.lower.diff.body.sby -side right -fill y
2221 pack $ui_diff -side left -fill both -expand 1
2222 pack .vpane.lower.diff.header -side top -fill x
2223 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2225 $ui_diff tag conf dm -foreground red
2226 $ui_diff tag conf dp -foreground blue
2227 $ui_diff tag conf di -foreground {#00a000}
2228 $ui_diff tag conf dni -foreground {#a000a0}
2229 $ui_diff tag conf da -font font_diffbold
2230 $ui_diff tag conf bold -font font_diffbold
2232 # -- Diff Body Context Menu
2234 menu $ui_diff.ctxm -tearoff 0
2235 $ui_diff.ctxm add command -label "Copy" \
2237 -command "tk_textCopy $ui_diff"
2238 $ui_diff.ctxm add command -label "Select All" \
2240 -command "$ui_diff tag add sel 0.0 end"
2241 $ui_diff.ctxm add command -label "Copy All" \
2244 $ui_diff tag add sel 0.0 end
2245 tk_textCopy $ui_diff
2246 $ui_diff tag remove sel 0.0 end
2248 $ui_diff.ctxm add separator
2249 $ui_diff.ctxm add command -label "Decrease Font Size" \
2251 -command {incr_font_size font_diff -1}
2252 $ui_diff.ctxm add command -label "Increase Font Size" \
2254 -command {incr_font_size font_diff 1}
2255 bind_button3 $ui_diff "tk_popup $ui_diff.ctxm %X %Y"
2258 set ui_status_value {Initializing...}
2259 label .status -textvariable ui_status_value \
2265 pack .status -anchor w -side bottom -fill x
2269 set gm $repo_config(gui.geometry)
2270 wm geometry . [lindex $gm 0]
2271 .vpane sash place 0 \
2272 [lindex [.vpane sash coord 0] 0] \
2274 .vpane.files sash place 0 \
2276 [lindex [.vpane.files sash coord 0] 1]
2281 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2282 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2283 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2284 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2285 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2286 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2287 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2288 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2289 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2290 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2291 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2293 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2294 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2295 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2296 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2297 bind $ui_diff <$M1B-Key-v> {break}
2298 bind $ui_diff <$M1B-Key-V> {break}
2299 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2300 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2301 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2302 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2303 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2304 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2306 bind . <Destroy> do_quit
2307 bind all <Key-F5> do_rescan
2308 bind all <$M1B-Key-r> do_rescan
2309 bind all <$M1B-Key-R> do_rescan
2310 bind . <$M1B-Key-s> do_signoff
2311 bind . <$M1B-Key-S> do_signoff
2312 bind . <$M1B-Key-i> do_include_all
2313 bind . <$M1B-Key-I> do_include_all
2314 bind . <$M1B-Key-Return> do_commit
2315 bind all <$M1B-Key-q> do_quit
2316 bind all <$M1B-Key-Q> do_quit
2317 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2318 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2319 foreach i [list $ui_index $ui_other] {
2320 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
2321 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
2322 bind_button3 $i {click %W %x %y 3 %X %Y; break}
2326 set file_lists($ui_index) [list]
2327 set file_lists($ui_other) [list]
2329 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2330 focus -force $ui_comm
2332 populate_remote_menu .mbar.fetch From fetch_from
2333 populate_remote_menu .mbar.push To push_to
2334 populate_pull_menu .mbar.pull