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 {
27 proc load_config {include_global} {
28 global repo_config global_config default_config
30 array unset global_config
31 if {$include_global} {
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
47 array unset repo_config
49 set fd_rc [open "| git repo-config --list" r]
50 while {[gets $fd_rc line] >= 0} {
51 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
52 if {[is_many_config $name]} {
53 lappend repo_config($name) $value
55 set repo_config($name) $value
62 foreach name [array names default_config] {
63 if {[catch {set v $global_config($name)}]} {
64 set global_config($name) $default_config($name)
66 if {[catch {set v $repo_config($name)}]} {
67 set repo_config($name) $default_config($name)
73 global default_config font_descs
74 global repo_config global_config
75 global repo_config_new global_config_new
77 foreach option $font_descs {
78 set name [lindex $option 0]
79 set font [lindex $option 1]
80 font configure $font \
81 -family $global_config_new(gui.$font^^family) \
82 -size $global_config_new(gui.$font^^size)
83 font configure ${font}bold \
84 -family $global_config_new(gui.$font^^family) \
85 -size $global_config_new(gui.$font^^size)
86 set global_config_new(gui.$name) [font configure $font]
87 unset global_config_new(gui.$font^^family)
88 unset global_config_new(gui.$font^^size)
91 foreach name [array names default_config] {
92 set value $global_config_new($name)
93 if {$value ne $global_config($name)} {
94 if {$value eq $default_config($name)} {
95 catch {exec git repo-config --global --unset $name}
97 regsub -all "\[{}\]" $value {"} value
98 exec git repo-config --global $name $value
100 set global_config($name) $value
101 if {$value eq $repo_config($name)} {
102 catch {exec git repo-config --unset $name}
103 set repo_config($name) $value
108 foreach name [array names default_config] {
109 set value $repo_config_new($name)
110 if {$value ne $repo_config($name)} {
111 if {$value eq $global_config($name)} {
112 catch {exec git repo-config --unset $name}
114 regsub -all "\[{}\]" $value {"} value
115 exec git repo-config $name $value
117 set repo_config($name) $value
122 proc error_popup {msg} {
123 global gitdir appname
128 append title [lindex \
129 [file split [file normalize [file dirname $gitdir]]] \
137 -title "$title: error" \
141 proc info_popup {msg} {
142 global gitdir appname
147 append title [lindex \
148 [file split [file normalize [file dirname $gitdir]]] \
160 ######################################################################
164 if { [catch {set cdup [exec git rev-parse --show-cdup]} err]
165 || [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
166 catch {wm withdraw .}
167 error_popup "Cannot find the git directory:\n\n$err"
176 if {$appname eq {git-citool}} {
180 ######################################################################
187 set disable_on_lock [list]
188 set index_lock_type none
194 proc lock_index {type} {
195 global index_lock_type disable_on_lock
197 if {$index_lock_type eq {none}} {
198 set index_lock_type $type
199 foreach w $disable_on_lock {
200 uplevel #0 $w disabled
203 } elseif {$index_lock_type eq {begin-update} && $type eq {update}} {
204 set index_lock_type $type
210 proc unlock_index {} {
211 global index_lock_type disable_on_lock
213 set index_lock_type none
214 foreach w $disable_on_lock {
219 ######################################################################
223 proc repository_state {hdvar ctvar} {
225 upvar $hdvar hd $ctvar ct
227 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
229 } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
236 proc update_status {{final Ready.}} {
237 global HEAD PARENT commit_type
238 global ui_index ui_other ui_status_value ui_comm
239 global status_active file_states
242 if {$status_active || ![lock_index read]} return
244 repository_state new_HEAD new_type
245 if {$commit_type eq {amend}
246 && $new_type eq {normal}
247 && $new_HEAD eq $HEAD} {
251 set commit_type $new_type
254 array unset file_states
256 if {![$ui_comm edit modified]
257 || [string trim [$ui_comm get 0.0 end]] eq {}} {
258 if {[load_message GITGUI_MSG]} {
259 } elseif {[load_message MERGE_MSG]} {
260 } elseif {[load_message SQUASH_MSG]} {
262 $ui_comm edit modified false
266 if {$repo_config(gui.trustmtime) eq {true}} {
267 update_status_stage2 {} $final
270 set ui_status_value {Refreshing file status...}
271 set cmd [list git update-index]
273 lappend cmd --unmerged
274 lappend cmd --ignore-missing
275 lappend cmd --refresh
276 set fd_rf [open "| $cmd" r]
277 fconfigure $fd_rf -blocking 0 -translation binary
278 fileevent $fd_rf readable \
279 [list update_status_stage2 $fd_rf $final]
283 proc update_status_stage2 {fd final} {
284 global gitdir PARENT commit_type
285 global ui_index ui_other ui_status_value ui_comm
287 global buf_rdi buf_rdf buf_rlo
291 if {![eof $fd]} return
295 set ls_others [list | git ls-files --others -z \
296 --exclude-per-directory=.gitignore]
297 set info_exclude [file join $gitdir info exclude]
298 if {[file readable $info_exclude]} {
299 lappend ls_others "--exclude-from=$info_exclude"
307 set ui_status_value {Scanning for modified files ...}
308 set fd_di [open "| git diff-index --cached -z $PARENT" r]
309 set fd_df [open "| git diff-files -z" r]
310 set fd_lo [open $ls_others r]
312 fconfigure $fd_di -blocking 0 -translation binary
313 fconfigure $fd_df -blocking 0 -translation binary
314 fconfigure $fd_lo -blocking 0 -translation binary
315 fileevent $fd_di readable [list read_diff_index $fd_di $final]
316 fileevent $fd_df readable [list read_diff_files $fd_df $final]
317 fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
320 proc load_message {file} {
321 global gitdir ui_comm
323 set f [file join $gitdir $file]
324 if {[file isfile $f]} {
325 if {[catch {set fd [open $f r]}]} {
328 set content [string trim [read $fd]]
330 $ui_comm delete 0.0 end
331 $ui_comm insert end $content
337 proc read_diff_index {fd final} {
340 append buf_rdi [read $fd]
342 set n [string length $buf_rdi]
344 set z1 [string first "\0" $buf_rdi $c]
347 set z2 [string first "\0" $buf_rdi $z1]
353 [string range $buf_rdi $z1 $z2] \
354 [string index $buf_rdi [expr $z1 - 2]]_
358 set buf_rdi [string range $buf_rdi $c end]
363 status_eof $fd buf_rdi $final
366 proc read_diff_files {fd final} {
369 append buf_rdf [read $fd]
371 set n [string length $buf_rdf]
373 set z1 [string first "\0" $buf_rdf $c]
376 set z2 [string first "\0" $buf_rdf $z1]
382 [string range $buf_rdf $z1 $z2] \
383 _[string index $buf_rdf [expr $z1 - 2]]
387 set buf_rdf [string range $buf_rdf $c end]
392 status_eof $fd buf_rdf $final
395 proc read_ls_others {fd final} {
398 append buf_rlo [read $fd]
399 set pck [split $buf_rlo "\0"]
400 set buf_rlo [lindex $pck end]
401 foreach p [lrange $pck 0 end-1] {
404 status_eof $fd buf_rlo $final
407 proc status_eof {fd buf final} {
408 global status_active ui_status_value
409 global file_states repo_config
412 if {![eof $fd]} return
415 if {[incr status_active -1] > 0} return
420 if {$repo_config(gui.partialinclude) ne {true}} {
422 foreach path [array names file_states] {
423 switch -- [lindex $file_states($path) 0] {
425 MM {lappend pathList $path}
428 if {$pathList ne {}} {
429 update_index $pathList
435 set ui_status_value $final
438 ######################################################################
443 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
445 $ui_diff conf -state normal
446 $ui_diff delete 0.0 end
447 $ui_diff conf -state disabled
449 set ui_fname_value {}
450 set ui_fstatus_value {}
452 $ui_index tag remove in_diff 0.0 end
453 $ui_other tag remove in_diff 0.0 end
456 proc reshow_diff {} {
457 global ui_fname_value ui_status_value file_states
459 if {$ui_fname_value eq {}
460 || [catch {set s $file_states($ui_fname_value)}]} {
463 show_diff $ui_fname_value
467 proc handle_empty_diff {} {
468 global ui_fname_value file_states file_lists
470 set path $ui_fname_value
471 set s $file_states($path)
472 if {[lindex $s 0] ne {_M}} return
474 info_popup "No differences detected.
476 [short_path $path] has no changes.
478 The modification date of this file was updated by another
479 application and you currently have the Trust File Modification
480 Timestamps option enabled, so Git did not automatically detect
481 that there are no content differences in this file.
483 This file will now be removed from the modified files list, to
484 prevent possible confusion.
486 if {[catch {exec git update-index -- $path} err]} {
487 error_popup "Failed to refresh index:\n\n$err"
491 set old_w [mapcol [lindex $file_states($path) 0] $path]
492 set lno [lsearch -sorted $file_lists($old_w) $path]
494 set file_lists($old_w) \
495 [lreplace $file_lists($old_w) $lno $lno]
497 $old_w conf -state normal
498 $old_w delete $lno.0 [expr $lno + 1].0
499 $old_w conf -state disabled
503 proc show_diff {path {w {}} {lno {}}} {
504 global file_states file_lists
505 global PARENT diff_3way diff_active repo_config
506 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
508 if {$diff_active || ![lock_index read]} return
511 if {$w eq {} || $lno == {}} {
512 foreach w [array names file_lists] {
513 set lno [lsearch -sorted $file_lists($w) $path]
520 if {$w ne {} && $lno >= 1} {
521 $w tag add in_diff $lno.0 [expr $lno + 1].0
524 set s $file_states($path)
528 set ui_fname_value $path
529 set ui_fstatus_value [mapdesc $m $path]
530 set ui_status_value "Loading diff of [escape_path $path]..."
532 set cmd [list | git diff-index]
533 lappend cmd --no-color
534 if {$repo_config(gui.diffcontext) > 0} {
535 lappend cmd "-U$repo_config(gui.diffcontext)"
545 set fd [open $path r]
546 set content [read $fd]
551 set ui_status_value "Unable to display [escape_path $path]"
552 error_popup "Error loading file:\n\n$err"
555 $ui_diff conf -state normal
556 $ui_diff insert end $content
557 $ui_diff conf -state disabled
560 set ui_status_value {Ready.}
569 if {[catch {set fd [open $cmd r]} err]} {
572 set ui_status_value "Unable to display [escape_path $path]"
573 error_popup "Error loading diff:\n\n$err"
577 fconfigure $fd -blocking 0 -translation auto
578 fileevent $fd readable [list read_diff $fd]
581 proc read_diff {fd} {
582 global ui_diff ui_status_value diff_3way diff_active
585 while {[gets $fd line] >= 0} {
586 if {[string match {diff --git *} $line]} continue
587 if {[string match {diff --combined *} $line]} continue
588 if {[string match {--- *} $line]} continue
589 if {[string match {+++ *} $line]} continue
590 if {[string match index* $line]} {
591 if {[string first , $line] >= 0} {
596 $ui_diff conf -state normal
598 set x [string index $line 0]
603 default {set tags {}}
606 set x [string range $line 0 1]
608 default {set tags {}}
610 "++" {set tags dp; set x " +"}
611 " +" {set tags {di bold}; set x "++"}
612 "+ " {set tags dni; set x "-+"}
613 "--" {set tags dm; set x " -"}
614 " -" {set tags {dm bold}; set x "--"}
615 "- " {set tags di; set x "+-"}
616 default {set tags {}}
618 set line [string replace $line 0 1 $x]
620 $ui_diff insert end $line $tags
621 $ui_diff insert end "\n"
622 $ui_diff conf -state disabled
629 set ui_status_value {Ready.}
631 if {$repo_config(gui.trustmtime) eq {true}
632 && [$ui_diff index end] eq {2.0}} {
638 ######################################################################
642 proc load_last_commit {} {
643 global HEAD PARENT commit_type ui_comm
645 if {$commit_type eq {amend}} return
646 if {$commit_type ne {normal}} {
647 error_popup "Can't amend a $commit_type commit."
655 set fd [open "| git cat-file commit $HEAD" r]
656 while {[gets $fd line] > 0} {
657 if {[string match {parent *} $line]} {
658 set parent [string range $line 7 end]
662 set msg [string trim [read $fd]]
665 error_popup "Error loading commit data for amend:\n\n$err"
669 if {$parent_count == 0} {
670 set commit_type amend
674 } elseif {$parent_count == 1} {
675 set commit_type amend
677 $ui_comm delete 0.0 end
678 $ui_comm insert end $msg
679 $ui_comm edit modified false
683 error_popup {You can't amend a merge commit.}
688 proc commit_tree {} {
689 global tcl_platform HEAD gitdir commit_type file_states
691 global ui_status_value ui_comm
693 if {![lock_index update]} return
695 # -- Our in memory state should match the repository.
697 repository_state curHEAD cur_type
698 if {$commit_type eq {amend}
699 && $cur_type eq {normal}
700 && $curHEAD eq $HEAD} {
701 } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
702 error_popup {Last scanned state does not match repository state.
704 Its highly likely that another Git program modified the
705 repository since our last scan. A rescan is required
713 # -- At least one file should differ in the index.
716 foreach path [array names file_states] {
717 set s $file_states($path)
718 switch -glob -- [lindex $s 0] {
722 M? {set files_ready 1; break}
724 error_popup "Unmerged files cannot be committed.
726 File [short_path $path] has merge conflicts.
727 You must resolve them and include the file before committing.
733 error_popup "Unknown file state [lindex $s 0] detected.
735 File [short_path $path] cannot be committed by this program.
741 error_popup {No included files to commit.
743 You must include at least 1 file before you can commit.
749 # -- A message is required.
751 set msg [string trim [$ui_comm get 1.0 end]]
753 error_popup {Please supply a commit message.
755 A good commit message has the following format:
757 - First line: Describe in one sentance what you did.
759 - Remaining lines: Describe why this change is good.
765 # -- Ask the pre-commit hook for the go-ahead.
767 set pchook [file join $gitdir hooks pre-commit]
768 if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
769 set pchook [list sh -c [concat \
770 "if test -x \"$pchook\";" \
771 "then exec \"$pchook\" 2>&1;" \
773 } elseif {[file executable $pchook]} {
774 set pchook [list $pchook |& cat]
779 set ui_status_value {Calling pre-commit hook...}
781 set fd_ph [open "| $pchook" r]
782 fconfigure $fd_ph -blocking 0 -translation binary
783 fileevent $fd_ph readable \
784 [list commit_stage1 $fd_ph $curHEAD $msg]
786 commit_stage2 $curHEAD $msg
790 proc commit_stage1 {fd_ph curHEAD msg} {
791 global pch_error ui_status_value
793 append pch_error [read $fd_ph]
794 fconfigure $fd_ph -blocking 1
796 if {[catch {close $fd_ph}]} {
797 set ui_status_value {Commit declined by pre-commit hook.}
798 hook_failed_popup pre-commit $pch_error
801 commit_stage2 $curHEAD $msg
805 fconfigure $fd_ph -blocking 0
809 proc commit_stage2 {curHEAD msg} {
810 global ui_status_value
812 # -- Write the tree in the background.
814 set ui_status_value {Committing changes...}
815 set fd_wt [open "| git write-tree" r]
816 fileevent $fd_wt readable [list commit_stage3 $fd_wt $curHEAD $msg]
819 proc commit_stage3 {fd_wt curHEAD msg} {
820 global single_commit gitdir HEAD PARENT commit_type tcl_platform
821 global ui_status_value ui_comm
825 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
826 error_popup "write-tree failed:\n\n$err"
827 set ui_status_value {Commit failed.}
832 # -- Create the commit.
834 set cmd [list git commit-tree $tree_id]
836 lappend cmd -p $PARENT
838 if {$commit_type eq {merge}} {
840 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
841 while {[gets $fd_mh merge_head] >= 0} {
842 lappend cmd -p $merge_head
846 error_popup "Loading MERGE_HEAD failed:\n\n$err"
847 set ui_status_value {Commit failed.}
853 # git commit-tree writes to stderr during initial commit.
854 lappend cmd 2>/dev/null
857 if {[catch {set cmt_id [eval exec $cmd]} err]} {
858 error_popup "commit-tree failed:\n\n$err"
859 set ui_status_value {Commit failed.}
864 # -- Update the HEAD ref.
867 if {$commit_type ne {normal}} {
868 append reflogm " ($commit_type)"
870 set i [string first "\n" $msg]
872 append reflogm {: } [string range $msg 0 [expr $i - 1]]
874 append reflogm {: } $msg
876 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
877 if {[catch {eval exec $cmd} err]} {
878 error_popup "update-ref failed:\n\n$err"
879 set ui_status_value {Commit failed.}
884 # -- Cleanup after ourselves.
886 catch {file delete [file join $gitdir MERGE_HEAD]}
887 catch {file delete [file join $gitdir MERGE_MSG]}
888 catch {file delete [file join $gitdir SQUASH_MSG]}
889 catch {file delete [file join $gitdir GITGUI_MSG]}
891 # -- Let rerere do its thing.
893 if {[file isdirectory [file join $gitdir rr-cache]]} {
894 catch {exec git rerere}
897 # -- Run the post-commit hook.
899 set pchook [file join $gitdir hooks post-commit]
900 if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
901 set pchook [list sh -c [concat \
902 "if test -x \"$pchook\";" \
903 "then exec \"$pchook\";" \
905 } elseif {![file executable $pchook]} {
909 catch {exec $pchook &}
912 $ui_comm delete 0.0 end
913 $ui_comm edit modified false
916 if {$single_commit} do_quit
918 # -- Update status without invoking any git commands.
920 set commit_type normal
924 foreach path [array names file_states] {
925 set s $file_states($path)
930 D? {set m _[string index $m 1]}
934 unset file_states($path)
936 lset file_states($path) 0 $m
943 set ui_status_value \
944 "Changes committed as [string range $cmt_id 0 7]."
947 ######################################################################
951 proc fetch_from {remote} {
952 set w [new_console "fetch $remote" \
953 "Fetching new changes from $remote"]
954 set cmd [list git fetch]
959 proc pull_remote {remote branch} {
960 global HEAD commit_type file_states repo_config
962 if {![lock_index update]} return
964 # -- Our in memory state should match the repository.
966 repository_state curHEAD cur_type
967 if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
968 error_popup {Last scanned state does not match repository state.
970 Its highly likely that another Git program modified the
971 repository since our last scan. A rescan is required
972 before a pull can be started.
979 # -- No differences should exist before a pull.
981 if {[array size file_states] != 0} {
982 error_popup {Uncommitted but modified files are present.
984 You should not perform a pull with unmodified files in your working
985 directory as Git would be unable to recover from an incorrect merge.
987 Commit or throw away all changes before starting a pull operation.
993 set w [new_console "pull $remote $branch" \
994 "Pulling new changes from branch $branch in $remote"]
995 set cmd [list git pull]
996 if {$repo_config(gui.pullsummary) eq {false}} {
997 lappend cmd --no-summary
1001 console_exec $w $cmd [list post_pull_remote $remote $branch]
1004 proc post_pull_remote {remote branch success} {
1005 global HEAD PARENT commit_type
1006 global ui_status_value
1010 repository_state HEAD commit_type
1012 set $ui_status_value {Ready.}
1015 "Conflicts detected while pulling $branch from $remote."
1019 proc push_to {remote} {
1020 set w [new_console "push $remote" \
1021 "Pushing changes to $remote"]
1022 set cmd [list git push]
1024 console_exec $w $cmd
1027 ######################################################################
1031 proc mapcol {state path} {
1032 global all_cols ui_other
1034 if {[catch {set r $all_cols($state)}]} {
1035 puts "error: no column for state={$state} $path"
1041 proc mapicon {state path} {
1044 if {[catch {set r $all_icons($state)}]} {
1045 puts "error: no icon for state={$state} $path"
1051 proc mapdesc {state path} {
1054 if {[catch {set r $all_descs($state)}]} {
1055 puts "error: no desc for state={$state} $path"
1061 proc escape_path {path} {
1062 regsub -all "\n" $path "\\n" path
1066 proc short_path {path} {
1067 return [escape_path [lindex [file split $path] end]]
1072 proc merge_state {path new_state} {
1073 global file_states next_icon_id
1075 set s0 [string index $new_state 0]
1076 set s1 [string index $new_state 1]
1078 if {[catch {set info $file_states($path)}]} {
1080 set icon n[incr next_icon_id]
1082 set state [lindex $info 0]
1083 set icon [lindex $info 1]
1087 set s0 [string index $state 0]
1088 } elseif {$s0 eq {*}} {
1093 set s1 [string index $state 1]
1094 } elseif {$s1 eq {*}} {
1098 set file_states($path) [list $s0$s1 $icon]
1102 proc display_file {path state} {
1103 global file_states file_lists status_active
1105 set old_m [merge_state $path $state]
1106 if {$status_active} return
1108 set s $file_states($path)
1109 set new_m [lindex $s 0]
1110 set new_w [mapcol $new_m $path]
1111 set old_w [mapcol $old_m $path]
1112 set new_icon [mapicon $new_m $path]
1114 if {$new_w ne $old_w} {
1115 set lno [lsearch -sorted $file_lists($old_w) $path]
1118 $old_w conf -state normal
1119 $old_w delete $lno.0 [expr $lno + 1].0
1120 $old_w conf -state disabled
1123 lappend file_lists($new_w) $path
1124 set file_lists($new_w) [lsort $file_lists($new_w)]
1125 set lno [lsearch -sorted $file_lists($new_w) $path]
1127 $new_w conf -state normal
1128 $new_w image create $lno.0 \
1129 -align center -padx 5 -pady 1 \
1130 -name [lindex $s 1] \
1132 $new_w insert $lno.1 "[escape_path $path]\n"
1133 $new_w conf -state disabled
1134 } elseif {$new_icon ne [mapicon $old_m $path]} {
1135 $new_w conf -state normal
1136 $new_w image conf [lindex $s 1] -image $new_icon
1137 $new_w conf -state disabled
1141 proc display_all_files {} {
1142 global ui_index ui_other file_states file_lists
1144 $ui_index conf -state normal
1145 $ui_other conf -state normal
1147 $ui_index delete 0.0 end
1148 $ui_other delete 0.0 end
1150 set file_lists($ui_index) [list]
1151 set file_lists($ui_other) [list]
1153 foreach path [lsort [array names file_states]] {
1154 set s $file_states($path)
1156 set w [mapcol $m $path]
1157 lappend file_lists($w) $path
1158 $w image create end \
1159 -align center -padx 5 -pady 1 \
1160 -name [lindex $s 1] \
1161 -image [mapicon $m $path]
1162 $w insert end "[escape_path $path]\n"
1165 $ui_index conf -state disabled
1166 $ui_other conf -state disabled
1169 proc update_index {pathList} {
1170 global update_index_cp update_index_rsd ui_status_value
1172 if {![lock_index update]} return
1174 set update_index_cp 0
1175 set update_index_rsd 0
1176 set pathList [lsort $pathList]
1177 set totalCnt [llength $pathList]
1178 set batch [expr {int($totalCnt * .01) + 1}]
1179 if {$batch > 25} {set batch 25}
1181 set ui_status_value [format \
1182 "Including files ... %i/%i files (%.2f%%)" \
1186 set fd [open "| git update-index --add --remove -z --stdin" w]
1192 fileevent $fd writable [list \
1193 write_update_index \
1201 proc write_update_index {fd pathList totalCnt batch} {
1202 global update_index_cp update_index_rsd ui_status_value
1203 global file_states ui_fname_value
1205 if {$update_index_cp >= $totalCnt} {
1208 set ui_status_value {Ready.}
1209 if {$update_index_rsd} {
1215 for {set i $batch} \
1216 {$update_index_cp < $totalCnt && $i > 0} \
1218 set path [lindex $pathList $update_index_cp]
1219 incr update_index_cp
1221 switch -- [lindex $file_states($path) 0] {
1231 puts -nonewline $fd $path
1232 puts -nonewline $fd "\0"
1233 display_file $path $new
1234 if {$ui_fname_value eq $path} {
1235 set update_index_rsd 1
1239 set ui_status_value [format \
1240 "Including files ... %i/%i files (%.2f%%)" \
1243 [expr {100.0 * $update_index_cp / $totalCnt}]]
1246 ######################################################################
1248 ## remote management
1250 proc load_all_remotes {} {
1251 global gitdir all_remotes repo_config
1253 set all_remotes [list]
1254 set rm_dir [file join $gitdir remotes]
1255 if {[file isdirectory $rm_dir]} {
1256 set all_remotes [concat $all_remotes [glob \
1260 -directory $rm_dir *]]
1263 foreach line [array names repo_config remote.*.url] {
1264 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1265 lappend all_remotes $name
1269 set all_remotes [lsort -unique $all_remotes]
1272 proc populate_remote_menu {m pfx op} {
1275 foreach remote $all_remotes {
1276 $m add command -label "$pfx $remote..." \
1277 -command [list $op $remote] \
1282 proc populate_pull_menu {m} {
1283 global gitdir repo_config all_remotes disable_on_lock
1285 foreach remote $all_remotes {
1287 if {[array get repo_config remote.$remote.url] ne {}} {
1288 if {[array get repo_config remote.$remote.fetch] ne {}} {
1289 regexp {^([^:]+):} \
1290 [lindex $repo_config(remote.$remote.fetch) 0] \
1295 set fd [open [file join $gitdir remotes $remote] r]
1296 while {[gets $fd line] >= 0} {
1297 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1306 regsub ^refs/heads/ $rb {} rb_short
1307 if {$rb_short ne {}} {
1309 -label "Branch $rb_short from $remote..." \
1310 -command [list pull_remote $remote $rb] \
1312 lappend disable_on_lock \
1313 [list $m entryconf [$m index last] -state]
1318 ######################################################################
1323 #define mask_width 14
1324 #define mask_height 15
1325 static unsigned char mask_bits[] = {
1326 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1327 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1328 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1331 image create bitmap file_plain -background white -foreground black -data {
1332 #define plain_width 14
1333 #define plain_height 15
1334 static unsigned char plain_bits[] = {
1335 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1336 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1337 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1338 } -maskdata $filemask
1340 image create bitmap file_mod -background white -foreground blue -data {
1341 #define mod_width 14
1342 #define mod_height 15
1343 static unsigned char mod_bits[] = {
1344 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1345 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1346 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1347 } -maskdata $filemask
1349 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1350 #define file_fulltick_width 14
1351 #define file_fulltick_height 15
1352 static unsigned char file_fulltick_bits[] = {
1353 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1354 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1355 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1356 } -maskdata $filemask
1358 image create bitmap file_parttick -background white -foreground "#005050" -data {
1359 #define parttick_width 14
1360 #define parttick_height 15
1361 static unsigned char parttick_bits[] = {
1362 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1363 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1364 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1365 } -maskdata $filemask
1367 image create bitmap file_question -background white -foreground black -data {
1368 #define file_question_width 14
1369 #define file_question_height 15
1370 static unsigned char file_question_bits[] = {
1371 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1372 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1373 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1374 } -maskdata $filemask
1376 image create bitmap file_removed -background white -foreground red -data {
1377 #define file_removed_width 14
1378 #define file_removed_height 15
1379 static unsigned char file_removed_bits[] = {
1380 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1381 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1382 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1383 } -maskdata $filemask
1385 image create bitmap file_merge -background white -foreground blue -data {
1386 #define file_merge_width 14
1387 #define file_merge_height 15
1388 static unsigned char file_merge_bits[] = {
1389 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1390 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1391 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1392 } -maskdata $filemask
1394 set ui_index .vpane.files.index.list
1395 set ui_other .vpane.files.other.list
1396 set max_status_desc 0
1398 {__ i plain "Unmodified"}
1399 {_M i mod "Modified"}
1400 {M_ i fulltick "Included in commit"}
1401 {MM i parttick "Partially included"}
1403 {_O o plain "Untracked"}
1404 {A_ o fulltick "Added by commit"}
1405 {AM o parttick "Partially added"}
1406 {AD o question "Added (but now gone)"}
1408 {_D i question "Missing"}
1409 {D_ i removed "Removed by commit"}
1410 {DD i removed "Removed by commit"}
1411 {DO i removed "Removed (still exists)"}
1413 {UM i merge "Merge conflicts"}
1414 {U_ i merge "Merge conflicts"}
1416 if {$max_status_desc < [string length [lindex $i 3]]} {
1417 set max_status_desc [string length [lindex $i 3]]
1419 if {[lindex $i 1] eq {i}} {
1420 set all_cols([lindex $i 0]) $ui_index
1422 set all_cols([lindex $i 0]) $ui_other
1424 set all_icons([lindex $i 0]) file_[lindex $i 2]
1425 set all_descs([lindex $i 0]) [lindex $i 3]
1429 ######################################################################
1434 global tcl_platform tk_library
1435 if {$tcl_platform(platform) eq {unix}
1436 && $tcl_platform(os) eq {Darwin}
1437 && [string match /Library/Frameworks/* $tk_library]} {
1443 proc bind_button3 {w cmd} {
1444 bind $w <Any-Button-3> $cmd
1446 bind $w <Control-Button-1> $cmd
1450 proc incr_font_size {font {amt 1}} {
1451 set sz [font configure $font -size]
1453 font configure $font -size $sz
1454 font configure ${font}bold -size $sz
1457 proc hook_failed_popup {hook msg} {
1458 global gitdir appname
1464 label $w.m.l1 -text "$hook hook failed:" \
1469 -background white -borderwidth 1 \
1471 -width 80 -height 10 \
1473 -yscrollcommand [list $w.m.sby set]
1475 -text {You must correct the above errors before committing.} \
1479 scrollbar $w.m.sby -command [list $w.m.t yview]
1480 pack $w.m.l1 -side top -fill x
1481 pack $w.m.l2 -side bottom -fill x
1482 pack $w.m.sby -side right -fill y
1483 pack $w.m.t -side left -fill both -expand 1
1484 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1486 $w.m.t insert 1.0 $msg
1487 $w.m.t conf -state disabled
1489 button $w.ok -text OK \
1492 -command "destroy $w"
1493 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1495 bind $w <Visibility> "grab $w; focus $w"
1496 bind $w <Key-Return> "destroy $w"
1497 wm title $w "$appname ([lindex [file split \
1498 [file normalize [file dirname $gitdir]]] \
1503 set next_console_id 0
1505 proc new_console {short_title long_title} {
1506 global next_console_id console_data
1507 set w .console[incr next_console_id]
1508 set console_data($w) [list $short_title $long_title]
1509 return [console_init $w]
1512 proc console_init {w} {
1513 global console_cr console_data
1514 global gitdir appname M1B
1516 set console_cr($w) 1.0
1519 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1524 -background white -borderwidth 1 \
1526 -width 80 -height 10 \
1529 -yscrollcommand [list $w.m.sby set]
1530 label $w.m.s -text {Working... please wait...} \
1534 scrollbar $w.m.sby -command [list $w.m.t yview]
1535 pack $w.m.l1 -side top -fill x
1536 pack $w.m.s -side bottom -fill x
1537 pack $w.m.sby -side right -fill y
1538 pack $w.m.t -side left -fill both -expand 1
1539 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1541 menu $w.ctxm -tearoff 0
1542 $w.ctxm add command -label "Copy" \
1544 -command "tk_textCopy $w.m.t"
1545 $w.ctxm add command -label "Select All" \
1547 -command "$w.m.t tag add sel 0.0 end"
1548 $w.ctxm add command -label "Copy All" \
1551 $w.m.t tag add sel 0.0 end
1553 $w.m.t tag remove sel 0.0 end
1556 button $w.ok -text {Close} \
1559 -command "destroy $w"
1560 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1562 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1563 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1564 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1565 bind $w <Visibility> "focus $w"
1566 wm title $w "$appname ([lindex [file split \
1567 [file normalize [file dirname $gitdir]]] \
1568 end]): [lindex $console_data($w) 0]"
1572 proc console_exec {w cmd {after {}}} {
1575 # -- Windows tosses the enviroment when we exec our child.
1576 # But most users need that so we have to relogin. :-(
1578 if {$tcl_platform(platform) eq {windows}} {
1579 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1582 # -- Tcl won't let us redirect both stdout and stderr to
1583 # the same pipe. So pass it through cat...
1585 set cmd [concat | $cmd |& cat]
1587 set fd_f [open $cmd r]
1588 fconfigure $fd_f -blocking 0 -translation binary
1589 fileevent $fd_f readable [list console_read $w $fd_f $after]
1592 proc console_read {w fd after} {
1593 global console_cr console_data
1597 if {![winfo exists $w]} {console_init $w}
1598 $w.m.t conf -state normal
1600 set n [string length $buf]
1602 set cr [string first "\r" $buf $c]
1603 set lf [string first "\n" $buf $c]
1604 if {$cr < 0} {set cr [expr $n + 1]}
1605 if {$lf < 0} {set lf [expr $n + 1]}
1608 $w.m.t insert end [string range $buf $c $lf]
1609 set console_cr($w) [$w.m.t index {end -1c}]
1613 $w.m.t delete $console_cr($w) end
1614 $w.m.t insert end "\n"
1615 $w.m.t insert end [string range $buf $c $cr]
1620 $w.m.t conf -state disabled
1624 fconfigure $fd -blocking 1
1626 if {[catch {close $fd}]} {
1627 if {![winfo exists $w]} {console_init $w}
1628 $w.m.s conf -background red -text {Error: Command Failed}
1629 $w.ok conf -state normal
1631 } elseif {[winfo exists $w]} {
1632 $w.m.s conf -background green -text {Success}
1633 $w.ok conf -state normal
1636 array unset console_cr $w
1637 array unset console_data $w
1639 uplevel #0 $after $ok
1643 fconfigure $fd -blocking 0
1646 ######################################################################
1650 set starting_gitk_msg {Please wait... Starting gitk...}
1653 global tcl_platform ui_status_value starting_gitk_msg
1655 set ui_status_value $starting_gitk_msg
1657 if {$ui_status_value eq $starting_gitk_msg} {
1658 set ui_status_value {Ready.}
1662 if {$tcl_platform(platform) eq {windows}} {
1670 set w [new_console "repack" "Repacking the object database"]
1671 set cmd [list git repack]
1674 console_exec $w $cmd
1680 global gitdir ui_comm is_quitting repo_config
1682 if {$is_quitting} return
1685 # -- Stash our current commit buffer.
1687 set save [file join $gitdir GITGUI_MSG]
1688 set msg [string trim [$ui_comm get 0.0 end]]
1689 if {[$ui_comm edit modified] && $msg ne {}} {
1691 set fd [open $save w]
1692 puts $fd [string trim [$ui_comm get 0.0 end]]
1695 } elseif {$msg eq {} && [file exists $save]} {
1699 # -- Stash our current window geometry into this repository.
1701 set cfg_geometry [list]
1702 lappend cfg_geometry [wm geometry .]
1703 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1704 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1705 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1708 if {$cfg_geometry ne $rc_geometry} {
1709 catch {exec git repo-config gui.geometry $cfg_geometry}
1719 proc do_include_all {} {
1722 if {![lock_index begin-update]} return
1725 foreach path [array names file_states] {
1726 set s $file_states($path)
1732 _D {lappend pathList $path}
1735 if {$pathList eq {}} {
1738 update_index $pathList
1742 set GIT_COMMITTER_IDENT {}
1744 proc do_signoff {} {
1745 global ui_comm GIT_COMMITTER_IDENT
1747 if {$GIT_COMMITTER_IDENT eq {}} {
1748 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1749 error_popup "Unable to obtain your identity:\n\n$err"
1752 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1753 $me me GIT_COMMITTER_IDENT]} {
1754 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1759 set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1760 set last [$ui_comm get {end -1c linestart} {end -1c}]
1761 if {$last ne $sob} {
1762 $ui_comm edit separator
1764 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1765 $ui_comm insert end "\n"
1767 $ui_comm insert end "\n$sob"
1768 $ui_comm edit separator
1773 proc do_amend_last {} {
1781 proc do_options {} {
1782 global appname gitdir font_descs
1783 global repo_config global_config
1784 global repo_config_new global_config_new
1786 array unset repo_config_new
1787 array unset global_config_new
1788 foreach name [array names repo_config] {
1789 set repo_config_new($name) $repo_config($name)
1792 foreach name [array names repo_config] {
1794 gui.diffcontext {continue}
1796 set repo_config_new($name) $repo_config($name)
1798 foreach name [array names global_config] {
1799 set global_config_new($name) $global_config($name)
1801 set reponame [lindex [file split \
1802 [file normalize [file dirname $gitdir]]] \
1805 set w .options_editor
1807 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1809 label $w.header -text "$appname Options" \
1811 pack $w.header -side top -fill x
1814 button $w.buttons.restore -text {Restore Defaults} \
1816 -command do_restore_defaults
1817 pack $w.buttons.restore -side left
1818 button $w.buttons.save -text Save \
1820 -command [list do_save_config $w]
1821 pack $w.buttons.save -side right
1822 button $w.buttons.cancel -text {Cancel} \
1824 -command [list destroy $w]
1825 pack $w.buttons.cancel -side right
1826 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1828 labelframe $w.repo -text "$reponame Repository" \
1830 -relief raised -borderwidth 2
1831 labelframe $w.global -text {Global (All Repositories)} \
1833 -relief raised -borderwidth 2
1834 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1835 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1838 {b partialinclude {Allow Partially Included Files}}
1839 {b pullsummary {Show Pull Summary}}
1840 {b trustmtime {Trust File Modification Timestamps}}
1841 {i diffcontext {Number of Diff Context Lines}}
1843 set type [lindex $option 0]
1844 set name [lindex $option 1]
1845 set text [lindex $option 2]
1846 foreach f {repo global} {
1849 checkbutton $w.$f.$name -text $text \
1850 -variable ${f}_config_new(gui.$name) \
1854 pack $w.$f.$name -side top -anchor w
1858 label $w.$f.$name.l -text "$text:" -font font_ui
1859 pack $w.$f.$name.l -side left -anchor w -fill x
1860 spinbox $w.$f.$name.v \
1861 -textvariable ${f}_config_new(gui.$name) \
1862 -from 1 -to 99 -increment 1 \
1865 pack $w.$f.$name.v -side right -anchor e
1866 pack $w.$f.$name -side top -anchor w -fill x
1872 set all_fonts [lsort [font families]]
1873 foreach option $font_descs {
1874 set name [lindex $option 0]
1875 set font [lindex $option 1]
1876 set text [lindex $option 2]
1878 set global_config_new(gui.$font^^family) \
1879 [font configure $font -family]
1880 set global_config_new(gui.$font^^size) \
1881 [font configure $font -size]
1883 frame $w.global.$name
1884 label $w.global.$name.l -text "$text:" -font font_ui
1885 pack $w.global.$name.l -side left -anchor w -fill x
1886 eval tk_optionMenu $w.global.$name.family \
1887 global_config_new(gui.$font^^family) \
1889 spinbox $w.global.$name.size \
1890 -textvariable global_config_new(gui.$font^^size) \
1891 -from 2 -to 80 -increment 1 \
1894 pack $w.global.$name.size -side right -anchor e
1895 pack $w.global.$name.family -side right -anchor e
1896 pack $w.global.$name -side top -anchor w -fill x
1899 bind $w <Visibility> "grab $w; focus $w"
1900 bind $w <Key-Escape> "destroy $w"
1901 wm title $w "$appname ($reponame): Options"
1905 proc do_restore_defaults {} {
1906 global font_descs default_config repo_config
1907 global repo_config_new global_config_new
1909 foreach name [array names default_config] {
1910 set repo_config_new($name) $default_config($name)
1911 set global_config_new($name) $default_config($name)
1914 foreach option $font_descs {
1915 set name [lindex $option 0]
1916 set repo_config(gui.$name) $default_config(gui.$name)
1920 foreach option $font_descs {
1921 set name [lindex $option 0]
1922 set font [lindex $option 1]
1923 set global_config_new(gui.$font^^family) \
1924 [font configure $font -family]
1925 set global_config_new(gui.$font^^size) \
1926 [font configure $font -size]
1930 proc do_save_config {w} {
1931 if {[catch {save_config} err]} {
1932 error_popup "Failed to completely save options:\n\n$err"
1938 # shift == 1: left click
1940 proc click {w x y shift wx wy} {
1941 global ui_index ui_other file_lists
1943 set pos [split [$w index @$x,$y] .]
1944 set lno [lindex $pos 0]
1945 set col [lindex $pos 1]
1946 set path [lindex $file_lists($w) [expr $lno - 1]]
1947 if {$path eq {}} return
1949 if {$col > 0 && $shift == 1} {
1950 show_diff $path $w $lno
1954 proc unclick {w x y} {
1957 set pos [split [$w index @$x,$y] .]
1958 set lno [lindex $pos 0]
1959 set col [lindex $pos 1]
1960 set path [lindex $file_lists($w) [expr $lno - 1]]
1961 if {$path eq {}} return
1964 update_index [list $path]
1968 ######################################################################
1972 set cursor_ptr arrow
1973 font create font_diff -family Courier -size 10
1977 eval font configure font_ui [font actual [.dummy cget -font]]
1981 font create font_uibold
1982 font create font_diffbold
1986 if {$tcl_platform(platform) eq {windows}} {
1989 } elseif {[is_MacOSX]} {
1994 proc apply_config {} {
1995 global repo_config font_descs
1997 foreach option $font_descs {
1998 set name [lindex $option 0]
1999 set font [lindex $option 1]
2001 foreach {cn cv} $repo_config(gui.$name) {
2002 font configure $font $cn $cv
2005 error_popup "Invalid font specified in gui.$name:\n\n$err"
2007 foreach {cn cv} [font configure $font] {
2008 font configure ${font}bold $cn $cv
2010 font configure ${font}bold -weight bold
2014 set default_config(gui.trustmtime) false
2015 set default_config(gui.pullsummary) true
2016 set default_config(gui.partialinclude) false
2017 set default_config(gui.diffcontext) 5
2018 set default_config(gui.fontui) [font configure font_ui]
2019 set default_config(gui.fontdiff) [font configure font_diff]
2021 {fontui font_ui {Main Font}}
2022 {fontdiff font_diff {Diff/Console Font}}
2027 ######################################################################
2032 menu .mbar -tearoff 0
2033 .mbar add cascade -label Project -menu .mbar.project
2034 .mbar add cascade -label Edit -menu .mbar.edit
2035 .mbar add cascade -label Commit -menu .mbar.commit
2036 if {!$single_commit} {
2037 .mbar add cascade -label Fetch -menu .mbar.fetch
2038 .mbar add cascade -label Pull -menu .mbar.pull
2039 .mbar add cascade -label Push -menu .mbar.push
2041 . configure -menu .mbar
2045 .mbar.project add command -label Visualize \
2048 if {!$single_commit} {
2049 .mbar.project add command -label {Repack Database} \
2050 -command do_repack \
2053 .mbar.project add command -label Quit \
2055 -accelerator $M1T-Q \
2061 .mbar.edit add command -label Undo \
2062 -command {catch {[focus] edit undo}} \
2063 -accelerator $M1T-Z \
2065 .mbar.edit add command -label Redo \
2066 -command {catch {[focus] edit redo}} \
2067 -accelerator $M1T-Y \
2069 .mbar.edit add separator
2070 .mbar.edit add command -label Cut \
2071 -command {catch {tk_textCut [focus]}} \
2072 -accelerator $M1T-X \
2074 .mbar.edit add command -label Copy \
2075 -command {catch {tk_textCopy [focus]}} \
2076 -accelerator $M1T-C \
2078 .mbar.edit add command -label Paste \
2079 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2080 -accelerator $M1T-V \
2082 .mbar.edit add command -label Delete \
2083 -command {catch {[focus] delete sel.first sel.last}} \
2086 .mbar.edit add separator
2087 .mbar.edit add command -label {Select All} \
2088 -command {catch {[focus] tag add sel 0.0 end}} \
2089 -accelerator $M1T-A \
2091 .mbar.edit add separator
2092 .mbar.edit add command -label {Options...} \
2093 -command do_options \
2098 .mbar.commit add command -label Rescan \
2099 -command do_rescan \
2102 lappend disable_on_lock \
2103 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2104 .mbar.commit add command -label {Amend Last Commit} \
2105 -command do_amend_last \
2107 lappend disable_on_lock \
2108 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2109 .mbar.commit add command -label {Include All Files} \
2110 -command do_include_all \
2111 -accelerator $M1T-I \
2113 lappend disable_on_lock \
2114 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2115 .mbar.commit add command -label {Sign Off} \
2116 -command do_signoff \
2117 -accelerator $M1T-S \
2119 .mbar.commit add command -label Commit \
2120 -command do_commit \
2121 -accelerator $M1T-Return \
2123 lappend disable_on_lock \
2124 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2126 if {!$single_commit} {
2137 # -- Main Window Layout
2138 panedwindow .vpane -orient vertical
2139 panedwindow .vpane.files -orient horizontal
2140 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2141 pack .vpane -anchor n -side top -fill both -expand 1
2143 # -- Index File List
2144 frame .vpane.files.index -height 100 -width 400
2145 label .vpane.files.index.title -text {Modified Files} \
2148 text $ui_index -background white -borderwidth 0 \
2149 -width 40 -height 10 \
2151 -cursor $cursor_ptr \
2152 -yscrollcommand {.vpane.files.index.sb set} \
2154 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2155 pack .vpane.files.index.title -side top -fill x
2156 pack .vpane.files.index.sb -side right -fill y
2157 pack $ui_index -side left -fill both -expand 1
2158 .vpane.files add .vpane.files.index -sticky nsew
2160 # -- Other (Add) File List
2161 frame .vpane.files.other -height 100 -width 100
2162 label .vpane.files.other.title -text {Untracked Files} \
2165 text $ui_other -background white -borderwidth 0 \
2166 -width 40 -height 10 \
2168 -cursor $cursor_ptr \
2169 -yscrollcommand {.vpane.files.other.sb set} \
2171 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2172 pack .vpane.files.other.title -side top -fill x
2173 pack .vpane.files.other.sb -side right -fill y
2174 pack $ui_other -side left -fill both -expand 1
2175 .vpane.files add .vpane.files.other -sticky nsew
2177 $ui_index tag conf in_diff -font font_uibold
2178 $ui_other tag conf in_diff -font font_uibold
2180 # -- Diff and Commit Area
2181 frame .vpane.lower -height 300 -width 400
2182 frame .vpane.lower.commarea
2183 frame .vpane.lower.diff -relief sunken -borderwidth 1
2184 pack .vpane.lower.commarea -side top -fill x
2185 pack .vpane.lower.diff -side bottom -fill both -expand 1
2186 .vpane add .vpane.lower -stick nsew
2188 # -- Commit Area Buttons
2189 frame .vpane.lower.commarea.buttons
2190 label .vpane.lower.commarea.buttons.l -text {} \
2194 pack .vpane.lower.commarea.buttons.l -side top -fill x
2195 pack .vpane.lower.commarea.buttons -side left -fill y
2197 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2198 -command do_rescan \
2200 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2201 lappend disable_on_lock \
2202 {.vpane.lower.commarea.buttons.rescan conf -state}
2204 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2205 -command do_amend_last \
2207 pack .vpane.lower.commarea.buttons.amend -side top -fill x
2208 lappend disable_on_lock \
2209 {.vpane.lower.commarea.buttons.amend conf -state}
2211 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2212 -command do_include_all \
2214 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2215 lappend disable_on_lock \
2216 {.vpane.lower.commarea.buttons.incall conf -state}
2218 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2219 -command do_signoff \
2221 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2223 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2224 -command do_commit \
2226 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2227 lappend disable_on_lock \
2228 {.vpane.lower.commarea.buttons.commit conf -state}
2230 # -- Commit Message Buffer
2231 frame .vpane.lower.commarea.buffer
2232 set ui_comm .vpane.lower.commarea.buffer.t
2233 set ui_coml .vpane.lower.commarea.buffer.l
2234 label $ui_coml -text {Commit Message:} \
2238 trace add variable commit_type write {uplevel #0 {
2239 switch -glob $commit_type \
2240 initial {$ui_coml conf -text {Initial Commit Message:}} \
2241 amend {$ui_coml conf -text {Amended Commit Message:}} \
2242 merge {$ui_coml conf -text {Merge Commit Message:}} \
2243 * {$ui_coml conf -text {Commit Message:}}
2245 text $ui_comm -background white -borderwidth 1 \
2248 -autoseparators true \
2250 -width 75 -height 9 -wrap none \
2252 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2253 scrollbar .vpane.lower.commarea.buffer.sby \
2254 -command [list $ui_comm yview]
2255 pack $ui_coml -side top -fill x
2256 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2257 pack $ui_comm -side left -fill y
2258 pack .vpane.lower.commarea.buffer -side left -fill y
2260 # -- Commit Message Buffer Context Menu
2262 menu $ui_comm.ctxm -tearoff 0
2263 $ui_comm.ctxm add command -label "Cut" \
2265 -command "tk_textCut $ui_comm"
2266 $ui_comm.ctxm add command -label "Copy" \
2268 -command "tk_textCopy $ui_comm"
2269 $ui_comm.ctxm add command -label "Paste" \
2271 -command "tk_textPaste $ui_comm"
2272 $ui_comm.ctxm add command -label "Delete" \
2274 -command "$ui_comm delete sel.first sel.last"
2275 $ui_comm.ctxm add separator
2276 $ui_comm.ctxm add command -label "Select All" \
2278 -command "$ui_comm tag add sel 0.0 end"
2279 $ui_comm.ctxm add command -label "Copy All" \
2282 $ui_comm tag add sel 0.0 end
2283 tk_textCopy $ui_comm
2284 $ui_comm tag remove sel 0.0 end
2286 $ui_comm.ctxm add separator
2287 $ui_comm.ctxm add command -label "Sign Off" \
2290 bind_button3 $ui_comm "tk_popup $ui_comm.ctxm %X %Y"
2293 set ui_fname_value {}
2294 set ui_fstatus_value {}
2295 frame .vpane.lower.diff.header -background orange
2296 label .vpane.lower.diff.header.l4 \
2297 -textvariable ui_fstatus_value \
2298 -background orange \
2299 -width $max_status_desc \
2303 label .vpane.lower.diff.header.l1 -text {File:} \
2304 -background orange \
2306 set ui_fname .vpane.lower.diff.header.l2
2308 -textvariable ui_fname_value \
2309 -background orange \
2313 menu $ui_fname.ctxm -tearoff 0
2314 $ui_fname.ctxm add command -label "Copy" \
2323 bind_button3 $ui_fname "tk_popup $ui_fname.ctxm %X %Y"
2324 pack .vpane.lower.diff.header.l4 -side left
2325 pack .vpane.lower.diff.header.l1 -side left
2326 pack $ui_fname -fill x
2329 frame .vpane.lower.diff.body
2330 set ui_diff .vpane.lower.diff.body.t
2331 text $ui_diff -background white -borderwidth 0 \
2332 -width 80 -height 15 -wrap none \
2334 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2335 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2337 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2338 -command [list $ui_diff xview]
2339 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2340 -command [list $ui_diff yview]
2341 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2342 pack .vpane.lower.diff.body.sby -side right -fill y
2343 pack $ui_diff -side left -fill both -expand 1
2344 pack .vpane.lower.diff.header -side top -fill x
2345 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2347 $ui_diff tag conf dm -foreground red
2348 $ui_diff tag conf dp -foreground blue
2349 $ui_diff tag conf di -foreground {#00a000}
2350 $ui_diff tag conf dni -foreground {#a000a0}
2351 $ui_diff tag conf da -font font_diffbold
2352 $ui_diff tag conf bold -font font_diffbold
2354 # -- Diff Body Context Menu
2356 menu $ui_diff.ctxm -tearoff 0
2357 $ui_diff.ctxm add command -label "Copy" \
2359 -command "tk_textCopy $ui_diff"
2360 $ui_diff.ctxm add command -label "Select All" \
2362 -command "$ui_diff tag add sel 0.0 end"
2363 $ui_diff.ctxm add command -label "Copy All" \
2366 $ui_diff tag add sel 0.0 end
2367 tk_textCopy $ui_diff
2368 $ui_diff tag remove sel 0.0 end
2370 $ui_diff.ctxm add separator
2371 $ui_diff.ctxm add command -label "Decrease Font Size" \
2373 -command {incr_font_size font_diff -1}
2374 $ui_diff.ctxm add command -label "Increase Font Size" \
2376 -command {incr_font_size font_diff 1}
2377 $ui_diff.ctxm add separator
2378 $ui_diff.ctxm add command -label "Show Less Context" \
2380 -command {if {$ui_fname_value ne {}
2381 && $repo_config(gui.diffcontext) >= 2} {
2382 incr repo_config(gui.diffcontext) -1
2385 $ui_diff.ctxm add command -label "Show More Context" \
2387 -command {if {$ui_fname_value ne {}} {
2388 incr repo_config(gui.diffcontext)
2391 $ui_diff.ctxm add separator
2392 $ui_diff.ctxm add command -label {Options...} \
2395 bind_button3 $ui_diff "tk_popup $ui_diff.ctxm %X %Y"
2398 set ui_status_value {Initializing...}
2399 label .status -textvariable ui_status_value \
2405 pack .status -anchor w -side bottom -fill x
2409 set gm $repo_config(gui.geometry)
2410 wm geometry . [lindex $gm 0]
2411 .vpane sash place 0 \
2412 [lindex [.vpane sash coord 0] 0] \
2414 .vpane.files sash place 0 \
2416 [lindex [.vpane.files sash coord 0] 1]
2421 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2422 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2423 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2424 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2425 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2426 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2427 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2428 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2429 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2430 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2431 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2433 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2434 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2435 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2436 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2437 bind $ui_diff <$M1B-Key-v> {break}
2438 bind $ui_diff <$M1B-Key-V> {break}
2439 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2440 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2441 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2442 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2443 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2444 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2446 bind . <Destroy> do_quit
2447 bind all <Key-F5> do_rescan
2448 bind all <$M1B-Key-r> do_rescan
2449 bind all <$M1B-Key-R> do_rescan
2450 bind . <$M1B-Key-s> do_signoff
2451 bind . <$M1B-Key-S> do_signoff
2452 bind . <$M1B-Key-i> do_include_all
2453 bind . <$M1B-Key-I> do_include_all
2454 bind . <$M1B-Key-Return> do_commit
2455 bind all <$M1B-Key-q> do_quit
2456 bind all <$M1B-Key-Q> do_quit
2457 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2458 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2459 foreach i [list $ui_index $ui_other] {
2460 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
2461 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
2462 bind_button3 $i {click %W %x %y 3 %X %Y; break}
2466 set file_lists($ui_index) [list]
2467 set file_lists($ui_other) [list]
2469 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2470 focus -force $ui_comm
2471 if {!$single_commit} {
2473 populate_remote_menu .mbar.fetch From fetch_from
2474 populate_remote_menu .mbar.push To push_to
2475 populate_pull_menu .mbar.pull
2477 after 1 update_status