2 # Tcl ignores the next line -*- tcl -*- \
6 Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
22 set appvers {@@GIT_VERSION@@}
23 set appname [lindex [file split $argv0] end]
26 ######################################################################
30 proc is_many_config {name} {
31 switch -glob -- $name {
40 proc load_config {include_global} {
41 global repo_config global_config default_config
43 array unset global_config
44 if {$include_global} {
46 set fd_rc [open "| git repo-config --global --list" r]
47 while {[gets $fd_rc line] >= 0} {
48 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
49 if {[is_many_config $name]} {
50 lappend global_config($name) $value
52 set global_config($name) $value
60 array unset repo_config
62 set fd_rc [open "| git repo-config --list" r]
63 while {[gets $fd_rc line] >= 0} {
64 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
65 if {[is_many_config $name]} {
66 lappend repo_config($name) $value
68 set repo_config($name) $value
75 foreach name [array names default_config] {
76 if {[catch {set v $global_config($name)}]} {
77 set global_config($name) $default_config($name)
79 if {[catch {set v $repo_config($name)}]} {
80 set repo_config($name) $default_config($name)
86 global default_config font_descs
87 global repo_config global_config
88 global repo_config_new global_config_new
90 foreach option $font_descs {
91 set name [lindex $option 0]
92 set font [lindex $option 1]
93 font configure $font \
94 -family $global_config_new(gui.$font^^family) \
95 -size $global_config_new(gui.$font^^size)
96 font configure ${font}bold \
97 -family $global_config_new(gui.$font^^family) \
98 -size $global_config_new(gui.$font^^size)
99 set global_config_new(gui.$name) [font configure $font]
100 unset global_config_new(gui.$font^^family)
101 unset global_config_new(gui.$font^^size)
104 foreach name [array names default_config] {
105 set value $global_config_new($name)
106 if {$value ne $global_config($name)} {
107 if {$value eq $default_config($name)} {
108 catch {exec git repo-config --global --unset $name}
110 regsub -all "\[{}\]" $value {"} value
111 exec git repo-config --global $name $value
113 set global_config($name) $value
114 if {$value eq $repo_config($name)} {
115 catch {exec git repo-config --unset $name}
116 set repo_config($name) $value
121 foreach name [array names default_config] {
122 set value $repo_config_new($name)
123 if {$value ne $repo_config($name)} {
124 if {$value eq $global_config($name)} {
125 catch {exec git repo-config --unset $name}
127 regsub -all "\[{}\]" $value {"} value
128 exec git repo-config $name $value
130 set repo_config($name) $value
135 proc error_popup {msg} {
136 global gitdir appname
141 append title [lindex \
142 [file split [file normalize [file dirname $gitdir]]] \
146 set cmd [list tk_messageBox \
149 -title "$title: error" \
151 if {[winfo ismapped .]} {
152 lappend cmd -parent .
157 proc warn_popup {msg} {
158 global gitdir appname
163 append title [lindex \
164 [file split [file normalize [file dirname $gitdir]]] \
168 set cmd [list tk_messageBox \
171 -title "$title: warning" \
173 if {[winfo ismapped .]} {
174 lappend cmd -parent .
179 proc info_popup {msg} {
180 global gitdir appname
185 append title [lindex \
186 [file split [file normalize [file dirname $gitdir]]] \
198 proc ask_popup {msg} {
199 global gitdir appname
204 append title [lindex \
205 [file split [file normalize [file dirname $gitdir]]] \
209 return [tk_messageBox \
217 ######################################################################
221 if { [catch {set gitdir $env(GIT_DIR)}]
222 && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
223 catch {wm withdraw .}
224 error_popup "Cannot find the git directory:\n\n$err"
227 if {![file isdirectory $gitdir]} {
228 catch {wm withdraw .}
229 error_popup "Git directory not found:\n\n$gitdir"
232 if {[lindex [file split $gitdir] end] ne {.git}} {
233 catch {wm withdraw .}
234 error_popup "Cannot use funny .git directory:\n\n$gitdir"
237 if {[catch {cd [file dirname $gitdir]} err]} {
238 catch {wm withdraw .}
239 error_popup "No working directory [file dirname $gitdir]:\n\n$err"
244 if {$appname eq {git-citool}} {
248 ######################################################################
256 set disable_on_lock [list]
257 set index_lock_type none
259 proc lock_index {type} {
260 global index_lock_type disable_on_lock
262 if {$index_lock_type eq {none}} {
263 set index_lock_type $type
264 foreach w $disable_on_lock {
265 uplevel #0 $w disabled
268 } elseif {$index_lock_type eq "begin-$type"} {
269 set index_lock_type $type
275 proc unlock_index {} {
276 global index_lock_type disable_on_lock
278 set index_lock_type none
279 foreach w $disable_on_lock {
284 ######################################################################
288 proc repository_state {ctvar hdvar mhvar} {
289 global gitdir current_branch
290 upvar $ctvar ct $hdvar hd $mhvar mh
294 if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
295 set current_branch {}
297 regsub ^refs/((heads|tags|remotes)/)? \
303 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
309 set merge_head [file join $gitdir MERGE_HEAD]
310 if {[file exists $merge_head]} {
312 set fd_mh [open $merge_head r]
313 while {[gets $fd_mh line] >= 0} {
324 global PARENT empty_tree
326 set p [lindex $PARENT 0]
330 if {$empty_tree eq {}} {
331 set empty_tree [exec git mktree << {}]
336 proc rescan {after} {
337 global HEAD PARENT MERGE_HEAD commit_type
338 global ui_index ui_other ui_status_value ui_comm
339 global rescan_active file_states
342 if {$rescan_active > 0 || ![lock_index read]} return
344 repository_state newType newHEAD newMERGE_HEAD
345 if {[string match amend* $commit_type]
346 && $newType eq {normal}
347 && $newHEAD eq $HEAD} {
351 set MERGE_HEAD $newMERGE_HEAD
352 set commit_type $newType
355 array unset file_states
357 if {![$ui_comm edit modified]
358 || [string trim [$ui_comm get 0.0 end]] eq {}} {
359 if {[load_message GITGUI_MSG]} {
360 } elseif {[load_message MERGE_MSG]} {
361 } elseif {[load_message SQUASH_MSG]} {
364 $ui_comm edit modified false
367 if {$repo_config(gui.trustmtime) eq {true}} {
368 rescan_stage2 {} $after
371 set ui_status_value {Refreshing file status...}
372 set cmd [list git update-index]
374 lappend cmd --unmerged
375 lappend cmd --ignore-missing
376 lappend cmd --refresh
377 set fd_rf [open "| $cmd" r]
378 fconfigure $fd_rf -blocking 0 -translation binary
379 fileevent $fd_rf readable \
380 [list rescan_stage2 $fd_rf $after]
384 proc rescan_stage2 {fd after} {
385 global gitdir ui_status_value
386 global rescan_active buf_rdi buf_rdf buf_rlo
390 if {![eof $fd]} return
394 set ls_others [list | git ls-files --others -z \
395 --exclude-per-directory=.gitignore]
396 set info_exclude [file join $gitdir info exclude]
397 if {[file readable $info_exclude]} {
398 lappend ls_others "--exclude-from=$info_exclude"
406 set ui_status_value {Scanning for modified files ...}
407 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
408 set fd_df [open "| git diff-files -z" r]
409 set fd_lo [open $ls_others r]
411 fconfigure $fd_di -blocking 0 -translation binary
412 fconfigure $fd_df -blocking 0 -translation binary
413 fconfigure $fd_lo -blocking 0 -translation binary
414 fileevent $fd_di readable [list read_diff_index $fd_di $after]
415 fileevent $fd_df readable [list read_diff_files $fd_df $after]
416 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
419 proc load_message {file} {
420 global gitdir ui_comm
422 set f [file join $gitdir $file]
423 if {[file isfile $f]} {
424 if {[catch {set fd [open $f r]}]} {
427 set content [string trim [read $fd]]
429 $ui_comm delete 0.0 end
430 $ui_comm insert end $content
436 proc read_diff_index {fd after} {
439 append buf_rdi [read $fd]
441 set n [string length $buf_rdi]
443 set z1 [string first "\0" $buf_rdi $c]
446 set z2 [string first "\0" $buf_rdi $z1]
450 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
452 [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
454 [list [lindex $i 0] [lindex $i 2]] \
460 set buf_rdi [string range $buf_rdi $c end]
465 rescan_done $fd buf_rdi $after
468 proc read_diff_files {fd after} {
471 append buf_rdf [read $fd]
473 set n [string length $buf_rdf]
475 set z1 [string first "\0" $buf_rdf $c]
478 set z2 [string first "\0" $buf_rdf $z1]
482 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
484 [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
487 [list [lindex $i 0] [lindex $i 2]]
492 set buf_rdf [string range $buf_rdf $c end]
497 rescan_done $fd buf_rdf $after
500 proc read_ls_others {fd after} {
503 append buf_rlo [read $fd]
504 set pck [split $buf_rlo "\0"]
505 set buf_rlo [lindex $pck end]
506 foreach p [lrange $pck 0 end-1] {
509 rescan_done $fd buf_rlo $after
512 proc rescan_done {fd buf after} {
514 global file_states repo_config
517 if {![eof $fd]} return
520 if {[incr rescan_active -1] > 0} return
526 if {$repo_config(gui.partialinclude) ne {true}} {
528 foreach path [array names file_states] {
529 switch -- [lindex $file_states($path) 0] {
531 M? {lappend pathList $path}
534 if {$pathList ne {}} {
536 "Updating included files" \
538 [concat {reshow_diff;} $after]
547 proc prune_selection {} {
548 global file_states selected_paths
550 foreach path [array names selected_paths] {
551 if {[catch {set still_here $file_states($path)}]} {
552 unset selected_paths($path)
557 ######################################################################
562 global ui_diff current_diff ui_index ui_other
564 $ui_diff conf -state normal
565 $ui_diff delete 0.0 end
566 $ui_diff conf -state disabled
570 $ui_index tag remove in_diff 0.0 end
571 $ui_other tag remove in_diff 0.0 end
574 proc reshow_diff {} {
575 global current_diff ui_status_value file_states
577 if {$current_diff eq {}
578 || [catch {set s $file_states($current_diff)}]} {
581 show_diff $current_diff
585 proc handle_empty_diff {} {
586 global current_diff file_states file_lists
588 set path $current_diff
589 set s $file_states($path)
590 if {[lindex $s 0] ne {_M}} return
592 info_popup "No differences detected.
594 [short_path $path] has no changes.
596 The modification date of this file was updated
597 by another application and you currently have
598 the Trust File Modification Timestamps option
599 enabled, so Git did not automatically detect
600 that there are no content differences in this
603 This file will now be removed from the modified
604 files list, to prevent possible confusion.
606 if {[catch {exec git update-index -- $path} err]} {
607 error_popup "Failed to refresh index:\n\n$err"
611 set old_w [mapcol [lindex $file_states($path) 0] $path]
612 set lno [lsearch -sorted $file_lists($old_w) $path]
614 set file_lists($old_w) \
615 [lreplace $file_lists($old_w) $lno $lno]
617 $old_w conf -state normal
618 $old_w delete $lno.0 [expr {$lno + 1}].0
619 $old_w conf -state disabled
623 proc show_diff {path {w {}} {lno {}}} {
624 global file_states file_lists
625 global is_3way_diff diff_active repo_config
626 global ui_diff current_diff ui_status_value
628 if {$diff_active || ![lock_index read]} return
631 if {$w eq {} || $lno == {}} {
632 foreach w [array names file_lists] {
633 set lno [lsearch -sorted $file_lists($w) $path]
640 if {$w ne {} && $lno >= 1} {
641 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
644 set s $file_states($path)
648 set current_diff $path
649 set ui_status_value "Loading diff of [escape_path $path]..."
651 set cmd [list | git diff-index]
652 lappend cmd --no-color
653 if {$repo_config(gui.diffcontext) > 0} {
654 lappend cmd "-U$repo_config(gui.diffcontext)"
664 set fd [open $path r]
665 set content [read $fd]
670 set ui_status_value "Unable to display [escape_path $path]"
671 error_popup "Error loading file:\n\n$err"
674 $ui_diff conf -state normal
675 $ui_diff insert end $content
676 $ui_diff conf -state disabled
679 set ui_status_value {Ready.}
688 if {[catch {set fd [open $cmd r]} err]} {
691 set ui_status_value "Unable to display [escape_path $path]"
692 error_popup "Error loading diff:\n\n$err"
696 fconfigure $fd -blocking 0 -translation auto
697 fileevent $fd readable [list read_diff $fd]
700 proc read_diff {fd} {
701 global ui_diff ui_status_value is_3way_diff diff_active
704 $ui_diff conf -state normal
705 while {[gets $fd line] >= 0} {
706 # -- Cleanup uninteresting diff header lines.
708 if {[string match {diff --git *} $line]} continue
709 if {[string match {diff --combined *} $line]} continue
710 if {[string match {--- *} $line]} continue
711 if {[string match {+++ *} $line]} continue
712 if {$line eq {deleted file mode 120000}} {
713 set line "deleted symlink"
716 # -- Automatically detect if this is a 3 way diff.
718 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
720 # -- Reformat a 3 way diff, 'cause its too weird.
723 set op [string range $line 0 1]
726 {++} {set tags d_+ ; set op { +}}
727 {--} {set tags d_- ; set op { -}}
728 { +} {set tags d_++; set op {++}}
729 { -} {set tags d_--; set op {--}}
730 {+ } {set tags d_-+; set op {-+}}
731 {- } {set tags d_+-; set op {+-}}
732 default {set tags {}}
734 set line [string replace $line 0 1 $op]
736 switch -- [string index $line 0] {
740 default {set tags {}}
743 $ui_diff insert end $line $tags
744 $ui_diff insert end "\n" $tags
746 $ui_diff conf -state disabled
752 set ui_status_value {Ready.}
754 if {$repo_config(gui.trustmtime) eq {true}
755 && [$ui_diff index end] eq {2.0}} {
761 ######################################################################
765 proc load_last_commit {} {
766 global HEAD PARENT MERGE_HEAD commit_type ui_comm
768 if {[llength $PARENT] == 0} {
769 error_popup {There is nothing to amend.
771 You are about to create the initial commit.
772 There is no commit before this to amend.
777 repository_state curType curHEAD curMERGE_HEAD
778 if {$curType eq {merge}} {
779 error_popup {Cannot amend while merging.
781 You are currently in the middle of a merge that
782 has not been fully completed. You cannot amend
783 the prior commit unless you first abort the
784 current merge activity.
792 set fd [open "| git cat-file commit $curHEAD" r]
793 while {[gets $fd line] > 0} {
794 if {[string match {parent *} $line]} {
795 lappend parents [string range $line 7 end]
798 set msg [string trim [read $fd]]
801 error_popup "Error loading commit data for amend:\n\n$err"
807 set MERGE_HEAD [list]
808 switch -- [llength $parents] {
809 0 {set commit_type amend-initial}
810 1 {set commit_type amend}
811 default {set commit_type amend-merge}
814 $ui_comm delete 0.0 end
815 $ui_comm insert end $msg
817 $ui_comm edit modified false
818 rescan {set ui_status_value {Ready.}}
821 proc create_new_commit {} {
822 global commit_type ui_comm
824 set commit_type normal
825 $ui_comm delete 0.0 end
827 $ui_comm edit modified false
828 rescan {set ui_status_value {Ready.}}
831 set GIT_COMMITTER_IDENT {}
833 proc committer_ident {} {
834 global GIT_COMMITTER_IDENT
836 if {$GIT_COMMITTER_IDENT eq {}} {
837 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
838 error_popup "Unable to obtain your identity:\n\n$err"
841 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
842 $me me GIT_COMMITTER_IDENT]} {
843 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
848 return $GIT_COMMITTER_IDENT
851 proc commit_tree {} {
852 global HEAD commit_type file_states ui_comm repo_config
854 if {![lock_index update]} return
855 if {[committer_ident] eq {}} return
857 # -- Our in memory state should match the repository.
859 repository_state curType curHEAD curMERGE_HEAD
860 if {[string match amend* $commit_type]
861 && $curType eq {normal}
862 && $curHEAD eq $HEAD} {
863 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
864 info_popup {Last scanned state does not match repository state.
866 Another Git program has modified this repository
867 since the last scan. A rescan must be performed
868 before another commit can be created.
870 The rescan will be automatically started now.
873 rescan {set ui_status_value {Ready.}}
877 # -- At least one file should differ in the index.
880 foreach path [array names file_states] {
881 switch -glob -- [lindex $file_states($path) 0] {
885 M? {set files_ready 1; break}
887 error_popup "Unmerged files cannot be committed.
889 File [short_path $path] has merge conflicts.
890 You must resolve them and include the file before committing.
896 error_popup "Unknown file state [lindex $s 0] detected.
898 File [short_path $path] cannot be committed by this program.
904 error_popup {No included files to commit.
906 You must include at least 1 file before you can commit.
912 # -- A message is required.
914 set msg [string trim [$ui_comm get 1.0 end]]
916 error_popup {Please supply a commit message.
918 A good commit message has the following format:
920 - First line: Describe in one sentance what you did.
922 - Remaining lines: Describe why this change is good.
928 # -- Update included files if partialincludes are off.
930 if {$repo_config(gui.partialinclude) ne {true}} {
932 foreach path [array names file_states] {
933 switch -glob -- [lindex $file_states($path) 0] {
935 M? {lappend pathList $path}
938 if {$pathList ne {}} {
941 "Updating included files" \
943 [concat {lock_index update;} \
944 [list commit_prehook $curHEAD $msg]]
949 commit_prehook $curHEAD $msg
952 proc commit_prehook {curHEAD msg} {
953 global gitdir ui_status_value pch_error
955 set pchook [file join $gitdir hooks pre-commit]
957 # On Cygwin [file executable] might lie so we need to ask
958 # the shell if the hook is executable. Yes that's annoying.
960 if {[is_Windows] && [file isfile $pchook]} {
961 set pchook [list sh -c [concat \
962 "if test -x \"$pchook\";" \
963 "then exec \"$pchook\" 2>&1;" \
965 } elseif {[file executable $pchook]} {
966 set pchook [list $pchook |& cat]
968 commit_writetree $curHEAD $msg
972 set ui_status_value {Calling pre-commit hook...}
974 set fd_ph [open "| $pchook" r]
975 fconfigure $fd_ph -blocking 0 -translation binary
976 fileevent $fd_ph readable \
977 [list commit_prehook_wait $fd_ph $curHEAD $msg]
980 proc commit_prehook_wait {fd_ph curHEAD msg} {
981 global pch_error ui_status_value
983 append pch_error [read $fd_ph]
984 fconfigure $fd_ph -blocking 1
986 if {[catch {close $fd_ph}]} {
987 set ui_status_value {Commit declined by pre-commit hook.}
988 hook_failed_popup pre-commit $pch_error
991 commit_writetree $curHEAD $msg
996 fconfigure $fd_ph -blocking 0
999 proc commit_writetree {curHEAD msg} {
1000 global ui_status_value
1002 set ui_status_value {Committing changes...}
1003 set fd_wt [open "| git write-tree" r]
1004 fileevent $fd_wt readable \
1005 [list commit_committree $fd_wt $curHEAD $msg]
1008 proc commit_committree {fd_wt curHEAD msg} {
1009 global HEAD PARENT MERGE_HEAD commit_type
1010 global single_commit gitdir
1011 global ui_status_value ui_comm selected_commit_type
1012 global file_states selected_paths rescan_active
1015 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1016 error_popup "write-tree failed:\n\n$err"
1017 set ui_status_value {Commit failed.}
1022 # -- Create the commit.
1024 set cmd [list git commit-tree $tree_id]
1025 set parents [concat $PARENT $MERGE_HEAD]
1026 if {[llength $parents] > 0} {
1027 foreach p $parents {
1031 # git commit-tree writes to stderr during initial commit.
1032 lappend cmd 2>/dev/null
1035 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1036 error_popup "commit-tree failed:\n\n$err"
1037 set ui_status_value {Commit failed.}
1042 # -- Update the HEAD ref.
1045 if {$commit_type ne {normal}} {
1046 append reflogm " ($commit_type)"
1048 set i [string first "\n" $msg]
1050 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1052 append reflogm {: } $msg
1054 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1055 if {[catch {eval exec $cmd} err]} {
1056 error_popup "update-ref failed:\n\n$err"
1057 set ui_status_value {Commit failed.}
1062 # -- Cleanup after ourselves.
1064 catch {file delete [file join $gitdir MERGE_HEAD]}
1065 catch {file delete [file join $gitdir MERGE_MSG]}
1066 catch {file delete [file join $gitdir SQUASH_MSG]}
1067 catch {file delete [file join $gitdir GITGUI_MSG]}
1069 # -- Let rerere do its thing.
1071 if {[file isdirectory [file join $gitdir rr-cache]]} {
1072 catch {exec git rerere}
1075 # -- Run the post-commit hook.
1077 set pchook [file join $gitdir hooks post-commit]
1078 if {[is_Windows] && [file isfile $pchook]} {
1079 set pchook [list sh -c [concat \
1080 "if test -x \"$pchook\";" \
1081 "then exec \"$pchook\";" \
1083 } elseif {![file executable $pchook]} {
1086 if {$pchook ne {}} {
1087 catch {exec $pchook &}
1090 $ui_comm delete 0.0 end
1092 $ui_comm edit modified false
1094 if {$single_commit} do_quit
1096 # -- Update in memory status
1098 set selected_commit_type new
1099 set commit_type normal
1102 set MERGE_HEAD [list]
1104 foreach path [array names file_states] {
1105 set s $file_states($path)
1107 switch -glob -- $m {
1115 unset file_states($path)
1116 catch {unset selected_paths($path)}
1119 set file_states($path) [list _O [lindex $s 1] {} {}]
1126 set file_states($path) [list \
1127 _[string index $m 1] \
1138 set ui_status_value \
1139 "Changes committed as [string range $cmt_id 0 7]."
1142 ######################################################################
1146 proc fetch_from {remote} {
1147 set w [new_console "fetch $remote" \
1148 "Fetching new changes from $remote"]
1149 set cmd [list git fetch]
1151 console_exec $w $cmd
1154 proc pull_remote {remote branch} {
1155 global HEAD commit_type file_states repo_config
1157 if {![lock_index update]} return
1159 # -- Our in memory state should match the repository.
1161 repository_state curType curHEAD curMERGE_HEAD
1162 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1163 info_popup {Last scanned state does not match repository state.
1165 Another Git program has modified this repository
1166 since the last scan. A rescan must be performed
1167 before a pull operation can be started.
1169 The rescan will be automatically started now.
1172 rescan {set ui_status_value {Ready.}}
1176 # -- No differences should exist before a pull.
1178 if {[array size file_states] != 0} {
1179 error_popup {Uncommitted but modified files are present.
1181 You should not perform a pull with unmodified
1182 files in your working directory as Git will be
1183 unable to recover from an incorrect merge.
1185 You should commit or revert all changes before
1186 starting a pull operation.
1192 set w [new_console "pull $remote $branch" \
1193 "Pulling new changes from branch $branch in $remote"]
1194 set cmd [list git pull]
1195 if {$repo_config(gui.pullsummary) eq {false}} {
1196 lappend cmd --no-summary
1200 console_exec $w $cmd [list post_pull_remote $remote $branch]
1203 proc post_pull_remote {remote branch success} {
1204 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1205 global ui_status_value
1209 repository_state commit_type HEAD MERGE_HEAD
1211 set selected_commit_type new
1212 set ui_status_value "Pulling $branch from $remote complete."
1214 rescan [list set ui_status_value \
1215 "Conflicts detected while pulling $branch from $remote."]
1219 proc push_to {remote} {
1220 set w [new_console "push $remote" \
1221 "Pushing changes to $remote"]
1222 set cmd [list git push]
1224 console_exec $w $cmd
1227 ######################################################################
1231 proc mapcol {state path} {
1232 global all_cols ui_other
1234 if {[catch {set r $all_cols($state)}]} {
1235 puts "error: no column for state={$state} $path"
1241 proc mapicon {state path} {
1244 if {[catch {set r $all_icons($state)}]} {
1245 puts "error: no icon for state={$state} $path"
1251 proc mapdesc {state path} {
1254 if {[catch {set r $all_descs($state)}]} {
1255 puts "error: no desc for state={$state} $path"
1261 proc escape_path {path} {
1262 regsub -all "\n" $path "\\n" path
1266 proc short_path {path} {
1267 return [escape_path [lindex [file split $path] end]]
1271 set null_sha1 [string repeat 0 40]
1273 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1274 global file_states next_icon_id null_sha1
1276 set s0 [string index $new_state 0]
1277 set s1 [string index $new_state 1]
1279 if {[catch {set info $file_states($path)}]} {
1281 set icon n[incr next_icon_id]
1283 set state [lindex $info 0]
1284 set icon [lindex $info 1]
1285 if {$head_info eq {}} {set head_info [lindex $info 2]}
1286 if {$index_info eq {}} {set index_info [lindex $info 3]}
1289 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1290 elseif {$s0 eq {_}} {set s0 _}
1292 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1293 elseif {$s1 eq {_}} {set s1 _}
1295 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1296 set head_info [list 0 $null_sha1]
1297 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1298 && $head_info eq {}} {
1299 set head_info $index_info
1302 set file_states($path) [list $s0$s1 $icon \
1303 $head_info $index_info \
1308 proc display_file {path state} {
1309 global file_states file_lists selected_paths
1311 set old_m [merge_state $path $state]
1312 set s $file_states($path)
1313 set new_m [lindex $s 0]
1314 set new_w [mapcol $new_m $path]
1315 set old_w [mapcol $old_m $path]
1316 set new_icon [mapicon $new_m $path]
1318 if {$new_m eq {__}} {
1319 set lno [lsearch -sorted $file_lists($old_w) $path]
1321 set file_lists($old_w) \
1322 [lreplace $file_lists($old_w) $lno $lno]
1324 $old_w conf -state normal
1325 $old_w delete $lno.0 [expr {$lno + 1}].0
1326 $old_w conf -state disabled
1328 unset file_states($path)
1329 catch {unset selected_paths($path)}
1333 if {$new_w ne $old_w} {
1334 set lno [lsearch -sorted $file_lists($old_w) $path]
1336 set file_lists($old_w) \
1337 [lreplace $file_lists($old_w) $lno $lno]
1339 $old_w conf -state normal
1340 $old_w delete $lno.0 [expr {$lno + 1}].0
1341 $old_w conf -state disabled
1344 lappend file_lists($new_w) $path
1345 set file_lists($new_w) [lsort $file_lists($new_w)]
1346 set lno [lsearch -sorted $file_lists($new_w) $path]
1348 $new_w conf -state normal
1349 $new_w image create $lno.0 \
1350 -align center -padx 5 -pady 1 \
1351 -name [lindex $s 1] \
1353 $new_w insert $lno.1 "[escape_path $path]\n"
1354 if {[catch {set in_sel $selected_paths($path)}]} {
1358 $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1360 $new_w conf -state disabled
1361 } elseif {$new_icon ne [mapicon $old_m $path]} {
1362 $new_w conf -state normal
1363 $new_w image conf [lindex $s 1] -image $new_icon
1364 $new_w conf -state disabled
1368 proc display_all_files {} {
1369 global ui_index ui_other
1370 global file_states file_lists
1371 global last_clicked selected_paths
1373 $ui_index conf -state normal
1374 $ui_other conf -state normal
1376 $ui_index delete 0.0 end
1377 $ui_other delete 0.0 end
1380 set file_lists($ui_index) [list]
1381 set file_lists($ui_other) [list]
1383 foreach path [lsort [array names file_states]] {
1384 set s $file_states($path)
1386 set w [mapcol $m $path]
1387 lappend file_lists($w) $path
1388 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1389 $w image create end \
1390 -align center -padx 5 -pady 1 \
1391 -name [lindex $s 1] \
1392 -image [mapicon $m $path]
1393 $w insert end "[escape_path $path]\n"
1394 if {[catch {set in_sel $selected_paths($path)}]} {
1398 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1402 $ui_index conf -state disabled
1403 $ui_other conf -state disabled
1406 proc update_indexinfo {msg pathList after} {
1407 global update_index_cp ui_status_value
1409 if {![lock_index update]} return
1411 set update_index_cp 0
1412 set pathList [lsort $pathList]
1413 set totalCnt [llength $pathList]
1414 set batch [expr {int($totalCnt * .01) + 1}]
1415 if {$batch > 25} {set batch 25}
1417 set ui_status_value [format \
1418 "$msg... %i/%i files (%.2f%%)" \
1422 set fd [open "| git update-index -z --index-info" w]
1428 fileevent $fd writable [list \
1429 write_update_indexinfo \
1439 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1440 global update_index_cp ui_status_value
1441 global file_states current_diff
1443 if {$update_index_cp >= $totalCnt} {
1450 for {set i $batch} \
1451 {$update_index_cp < $totalCnt && $i > 0} \
1453 set path [lindex $pathList $update_index_cp]
1454 incr update_index_cp
1456 set s $file_states($path)
1457 switch -glob -- [lindex $s 0] {
1464 set info [lindex $s 2]
1465 if {$info eq {}} continue
1467 puts -nonewline $fd $info
1468 puts -nonewline $fd "\t"
1469 puts -nonewline $fd $path
1470 puts -nonewline $fd "\0"
1471 display_file $path $new
1474 set ui_status_value [format \
1475 "$msg... %i/%i files (%.2f%%)" \
1478 [expr {100.0 * $update_index_cp / $totalCnt}]]
1481 proc update_index {msg pathList after} {
1482 global update_index_cp ui_status_value
1484 if {![lock_index update]} return
1486 set update_index_cp 0
1487 set pathList [lsort $pathList]
1488 set totalCnt [llength $pathList]
1489 set batch [expr {int($totalCnt * .01) + 1}]
1490 if {$batch > 25} {set batch 25}
1492 set ui_status_value [format \
1493 "$msg... %i/%i files (%.2f%%)" \
1497 set fd [open "| git update-index --add --remove -z --stdin" w]
1503 fileevent $fd writable [list \
1504 write_update_index \
1514 proc write_update_index {fd pathList totalCnt batch msg after} {
1515 global update_index_cp ui_status_value
1516 global file_states current_diff
1518 if {$update_index_cp >= $totalCnt} {
1525 for {set i $batch} \
1526 {$update_index_cp < $totalCnt && $i > 0} \
1528 set path [lindex $pathList $update_index_cp]
1529 incr update_index_cp
1531 switch -glob -- [lindex $file_states($path) 0] {
1550 puts -nonewline $fd $path
1551 puts -nonewline $fd "\0"
1552 display_file $path $new
1555 set ui_status_value [format \
1556 "$msg... %i/%i files (%.2f%%)" \
1559 [expr {100.0 * $update_index_cp / $totalCnt}]]
1562 proc checkout_index {msg pathList after} {
1563 global update_index_cp ui_status_value
1565 if {![lock_index update]} return
1567 set update_index_cp 0
1568 set pathList [lsort $pathList]
1569 set totalCnt [llength $pathList]
1570 set batch [expr {int($totalCnt * .01) + 1}]
1571 if {$batch > 25} {set batch 25}
1573 set ui_status_value [format \
1574 "$msg... %i/%i files (%.2f%%)" \
1578 set cmd [list git checkout-index]
1584 set fd [open "| $cmd " w]
1590 fileevent $fd writable [list \
1591 write_checkout_index \
1601 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1602 global update_index_cp ui_status_value
1603 global file_states current_diff
1605 if {$update_index_cp >= $totalCnt} {
1612 for {set i $batch} \
1613 {$update_index_cp < $totalCnt && $i > 0} \
1615 set path [lindex $pathList $update_index_cp]
1616 incr update_index_cp
1618 switch -glob -- [lindex $file_states($path) 0] {
1628 puts -nonewline $fd $path
1629 puts -nonewline $fd "\0"
1630 display_file $path $new
1633 set ui_status_value [format \
1634 "$msg... %i/%i files (%.2f%%)" \
1637 [expr {100.0 * $update_index_cp / $totalCnt}]]
1640 ######################################################################
1642 ## branch management
1644 proc load_all_heads {} {
1645 global all_heads tracking_branches
1647 set all_heads [list]
1648 set cmd [list git for-each-ref]
1649 lappend cmd --format=%(refname)
1650 lappend cmd refs/heads
1651 set fd [open "| $cmd" r]
1652 while {[gets $fd line] > 0} {
1653 if {![catch {set info $tracking_branches($line)}]} continue
1654 if {![regsub ^refs/heads/ $line {} name]} continue
1655 lappend all_heads $name
1659 set all_heads [lsort $all_heads]
1662 proc populate_branch_menu {m} {
1663 global all_heads disable_on_lock
1666 foreach b $all_heads {
1667 $m add radiobutton \
1669 -command [list switch_branch $b] \
1670 -variable current_branch \
1673 lappend disable_on_lock \
1674 [list $m entryconf [$m index last] -state]
1678 proc do_create_branch {} {
1679 error "NOT IMPLEMENTED"
1682 proc do_delete_branch {} {
1683 error "NOT IMPLEMENTED"
1686 proc switch_branch {b} {
1687 global HEAD commit_type file_states current_branch
1688 global selected_commit_type ui_comm
1690 if {![lock_index switch]} return
1692 # -- Backup the selected branch (repository_state resets it)
1694 set new_branch $current_branch
1696 # -- Our in memory state should match the repository.
1698 repository_state curType curHEAD curMERGE_HEAD
1699 if {[string match amend* $commit_type]
1700 && $curType eq {normal}
1701 && $curHEAD eq $HEAD} {
1702 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1703 info_popup {Last scanned state does not match repository state.
1705 Another Git program has modified this repository
1706 since the last scan. A rescan must be performed
1707 before the current branch can be changed.
1709 The rescan will be automatically started now.
1712 rescan {set ui_status_value {Ready.}}
1716 # -- Toss the message buffer if we are in amend mode.
1718 if {[string match amend* $curType]} {
1719 $ui_comm delete 0.0 end
1721 $ui_comm edit modified false
1724 set selected_commit_type new
1725 set current_branch $new_branch
1728 error "NOT FINISHED"
1731 ######################################################################
1733 ## remote management
1735 proc load_all_remotes {} {
1736 global gitdir repo_config
1737 global all_remotes tracking_branches
1739 set all_remotes [list]
1740 array unset tracking_branches
1742 set rm_dir [file join $gitdir remotes]
1743 if {[file isdirectory $rm_dir]} {
1744 set all_remotes [glob \
1748 -directory $rm_dir *]
1750 foreach name $all_remotes {
1752 set fd [open [file join $rm_dir $name] r]
1753 while {[gets $fd line] >= 0} {
1754 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
1755 $line line src dst]} continue
1756 if {![regexp ^refs/ $dst]} {
1757 set dst "refs/heads/$dst"
1759 set tracking_branches($dst) [list $name $src]
1766 foreach line [array names repo_config remote.*.url] {
1767 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
1768 lappend all_remotes $name
1770 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
1774 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
1775 if {![regexp ^refs/ $dst]} {
1776 set dst "refs/heads/$dst"
1778 set tracking_branches($dst) [list $name $src]
1782 set all_remotes [lsort -unique $all_remotes]
1785 proc populate_fetch_menu {m} {
1786 global gitdir all_remotes repo_config
1788 foreach r $all_remotes {
1790 if {![catch {set a $repo_config(remote.$r.url)}]} {
1791 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1796 set fd [open [file join $gitdir remotes $r] r]
1797 while {[gets $fd n] >= 0} {
1798 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1809 -label "Fetch from $r..." \
1810 -command [list fetch_from $r] \
1816 proc populate_push_menu {m} {
1817 global gitdir all_remotes repo_config
1819 foreach r $all_remotes {
1821 if {![catch {set a $repo_config(remote.$r.url)}]} {
1822 if {![catch {set a $repo_config(remote.$r.push)}]} {
1827 set fd [open [file join $gitdir remotes $r] r]
1828 while {[gets $fd n] >= 0} {
1829 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1840 -label "Push to $r..." \
1841 -command [list push_to $r] \
1847 proc populate_pull_menu {m} {
1848 global gitdir repo_config all_remotes disable_on_lock
1850 foreach remote $all_remotes {
1852 if {[array get repo_config remote.$remote.url] ne {}} {
1853 if {[array get repo_config remote.$remote.fetch] ne {}} {
1854 foreach line $repo_config(remote.$remote.fetch) {
1855 if {[regexp {^([^:]+):} $line line rb]} {
1862 set fd [open [file join $gitdir remotes $remote] r]
1863 while {[gets $fd line] >= 0} {
1864 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1872 foreach rb $rb_list {
1873 regsub ^refs/heads/ $rb {} rb_short
1875 -label "Branch $rb_short from $remote..." \
1876 -command [list pull_remote $remote $rb] \
1878 lappend disable_on_lock \
1879 [list $m entryconf [$m index last] -state]
1884 ######################################################################
1889 #define mask_width 14
1890 #define mask_height 15
1891 static unsigned char mask_bits[] = {
1892 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1893 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1894 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1897 image create bitmap file_plain -background white -foreground black -data {
1898 #define plain_width 14
1899 #define plain_height 15
1900 static unsigned char plain_bits[] = {
1901 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1902 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1903 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1904 } -maskdata $filemask
1906 image create bitmap file_mod -background white -foreground blue -data {
1907 #define mod_width 14
1908 #define mod_height 15
1909 static unsigned char mod_bits[] = {
1910 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1911 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1912 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1913 } -maskdata $filemask
1915 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1916 #define file_fulltick_width 14
1917 #define file_fulltick_height 15
1918 static unsigned char file_fulltick_bits[] = {
1919 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1920 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1921 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1922 } -maskdata $filemask
1924 image create bitmap file_parttick -background white -foreground "#005050" -data {
1925 #define parttick_width 14
1926 #define parttick_height 15
1927 static unsigned char parttick_bits[] = {
1928 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1929 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1930 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1931 } -maskdata $filemask
1933 image create bitmap file_question -background white -foreground black -data {
1934 #define file_question_width 14
1935 #define file_question_height 15
1936 static unsigned char file_question_bits[] = {
1937 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1938 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1939 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1940 } -maskdata $filemask
1942 image create bitmap file_removed -background white -foreground red -data {
1943 #define file_removed_width 14
1944 #define file_removed_height 15
1945 static unsigned char file_removed_bits[] = {
1946 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1947 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1948 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1949 } -maskdata $filemask
1951 image create bitmap file_merge -background white -foreground blue -data {
1952 #define file_merge_width 14
1953 #define file_merge_height 15
1954 static unsigned char file_merge_bits[] = {
1955 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1956 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1957 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1958 } -maskdata $filemask
1960 set ui_index .vpane.files.index.list
1961 set ui_other .vpane.files.other.list
1962 set max_status_desc 0
1964 {__ i plain "Unmodified"}
1965 {_M i mod "Modified"}
1966 {M_ i fulltick "Added to commit"}
1967 {MM i parttick "Partially included"}
1968 {MD i question "Added (but gone)"}
1970 {_O o plain "Untracked"}
1971 {A_ o fulltick "Added by commit"}
1972 {AM o parttick "Partially added"}
1973 {AD o question "Added (but gone)"}
1975 {_D i question "Missing"}
1976 {DD i removed "Removed by commit"}
1977 {D_ i removed "Removed by commit"}
1978 {DO i removed "Removed (still exists)"}
1979 {DM i removed "Removed (but modified)"}
1981 {UD i merge "Merge conflicts"}
1982 {UM i merge "Merge conflicts"}
1983 {U_ i merge "Merge conflicts"}
1985 if {$max_status_desc < [string length [lindex $i 3]]} {
1986 set max_status_desc [string length [lindex $i 3]]
1988 if {[lindex $i 1] eq {i}} {
1989 set all_cols([lindex $i 0]) $ui_index
1991 set all_cols([lindex $i 0]) $ui_other
1993 set all_icons([lindex $i 0]) file_[lindex $i 2]
1994 set all_descs([lindex $i 0]) [lindex $i 3]
1998 ######################################################################
2003 global tcl_platform tk_library
2004 if {[tk windowingsystem] eq {aqua}} {
2010 proc is_Windows {} {
2012 if {$tcl_platform(platform) eq {windows}} {
2018 proc bind_button3 {w cmd} {
2019 bind $w <Any-Button-3> $cmd
2021 bind $w <Control-Button-1> $cmd
2025 proc incr_font_size {font {amt 1}} {
2026 set sz [font configure $font -size]
2028 font configure $font -size $sz
2029 font configure ${font}bold -size $sz
2032 proc hook_failed_popup {hook msg} {
2033 global gitdir appname
2039 label $w.m.l1 -text "$hook hook failed:" \
2044 -background white -borderwidth 1 \
2046 -width 80 -height 10 \
2048 -yscrollcommand [list $w.m.sby set]
2050 -text {You must correct the above errors before committing.} \
2054 scrollbar $w.m.sby -command [list $w.m.t yview]
2055 pack $w.m.l1 -side top -fill x
2056 pack $w.m.l2 -side bottom -fill x
2057 pack $w.m.sby -side right -fill y
2058 pack $w.m.t -side left -fill both -expand 1
2059 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2061 $w.m.t insert 1.0 $msg
2062 $w.m.t conf -state disabled
2064 button $w.ok -text OK \
2067 -command "destroy $w"
2068 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2070 bind $w <Visibility> "grab $w; focus $w"
2071 bind $w <Key-Return> "destroy $w"
2072 wm title $w "$appname ([lindex [file split \
2073 [file normalize [file dirname $gitdir]]] \
2078 set next_console_id 0
2080 proc new_console {short_title long_title} {
2081 global next_console_id console_data
2082 set w .console[incr next_console_id]
2083 set console_data($w) [list $short_title $long_title]
2084 return [console_init $w]
2087 proc console_init {w} {
2088 global console_cr console_data
2089 global gitdir appname M1B
2091 set console_cr($w) 1.0
2094 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2099 -background white -borderwidth 1 \
2101 -width 80 -height 10 \
2104 -yscrollcommand [list $w.m.sby set]
2105 label $w.m.s -text {Working... please wait...} \
2109 scrollbar $w.m.sby -command [list $w.m.t yview]
2110 pack $w.m.l1 -side top -fill x
2111 pack $w.m.s -side bottom -fill x
2112 pack $w.m.sby -side right -fill y
2113 pack $w.m.t -side left -fill both -expand 1
2114 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2116 menu $w.ctxm -tearoff 0
2117 $w.ctxm add command -label "Copy" \
2119 -command "tk_textCopy $w.m.t"
2120 $w.ctxm add command -label "Select All" \
2122 -command "$w.m.t tag add sel 0.0 end"
2123 $w.ctxm add command -label "Copy All" \
2126 $w.m.t tag add sel 0.0 end
2128 $w.m.t tag remove sel 0.0 end
2131 button $w.ok -text {Close} \
2134 -command "destroy $w"
2135 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2137 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2138 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2139 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2140 bind $w <Visibility> "focus $w"
2141 wm title $w "$appname ([lindex [file split \
2142 [file normalize [file dirname $gitdir]]] \
2143 end]): [lindex $console_data($w) 0]"
2147 proc console_exec {w cmd {after {}}} {
2148 # -- Windows tosses the enviroment when we exec our child.
2149 # But most users need that so we have to relogin. :-(
2152 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2155 # -- Tcl won't let us redirect both stdout and stderr to
2156 # the same pipe. So pass it through cat...
2158 set cmd [concat | $cmd |& cat]
2160 set fd_f [open $cmd r]
2161 fconfigure $fd_f -blocking 0 -translation binary
2162 fileevent $fd_f readable [list console_read $w $fd_f $after]
2165 proc console_read {w fd after} {
2166 global console_cr console_data
2170 if {![winfo exists $w]} {console_init $w}
2171 $w.m.t conf -state normal
2173 set n [string length $buf]
2175 set cr [string first "\r" $buf $c]
2176 set lf [string first "\n" $buf $c]
2177 if {$cr < 0} {set cr [expr {$n + 1}]}
2178 if {$lf < 0} {set lf [expr {$n + 1}]}
2181 $w.m.t insert end [string range $buf $c $lf]
2182 set console_cr($w) [$w.m.t index {end -1c}]
2186 $w.m.t delete $console_cr($w) end
2187 $w.m.t insert end "\n"
2188 $w.m.t insert end [string range $buf $c $cr]
2193 $w.m.t conf -state disabled
2197 fconfigure $fd -blocking 1
2199 if {[catch {close $fd}]} {
2200 if {![winfo exists $w]} {console_init $w}
2201 $w.m.s conf -background red -text {Error: Command Failed}
2202 $w.ok conf -state normal
2204 } elseif {[winfo exists $w]} {
2205 $w.m.s conf -background green -text {Success}
2206 $w.ok conf -state normal
2209 array unset console_cr $w
2210 array unset console_data $w
2212 uplevel #0 $after $ok
2216 fconfigure $fd -blocking 0
2219 ######################################################################
2223 set starting_gitk_msg {Please wait... Starting gitk...}
2225 proc do_gitk {revs} {
2226 global ui_status_value starting_gitk_msg
2234 set cmd "sh -c \"exec $cmd\""
2238 if {[catch {eval exec $cmd} err]} {
2239 error_popup "Failed to start gitk:\n\n$err"
2241 set ui_status_value $starting_gitk_msg
2243 if {$ui_status_value eq $starting_gitk_msg} {
2244 set ui_status_value {Ready.}
2251 set w [new_console {gc} {Compressing the object database}]
2252 console_exec $w {git gc}
2255 proc do_fsck_objects {} {
2256 set w [new_console {fsck-objects} \
2257 {Verifying the object database with fsck-objects}]
2258 set cmd [list git fsck-objects]
2261 lappend cmd --strict
2262 console_exec $w $cmd
2268 global gitdir ui_comm is_quitting repo_config commit_type
2270 if {$is_quitting} return
2273 # -- Stash our current commit buffer.
2275 set save [file join $gitdir GITGUI_MSG]
2276 set msg [string trim [$ui_comm get 0.0 end]]
2277 if {![string match amend* $commit_type]
2278 && [$ui_comm edit modified]
2281 set fd [open $save w]
2282 puts $fd [string trim [$ui_comm get 0.0 end]]
2286 catch {file delete $save}
2289 # -- Stash our current window geometry into this repository.
2291 set cfg_geometry [list]
2292 lappend cfg_geometry [wm geometry .]
2293 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2294 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2295 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2298 if {$cfg_geometry ne $rc_geometry} {
2299 catch {exec git repo-config gui.geometry $cfg_geometry}
2306 rescan {set ui_status_value {Ready.}}
2309 proc remove_helper {txt paths} {
2310 global file_states current_diff
2312 if {![lock_index begin-update]} return
2316 foreach path $paths {
2317 switch -glob -- [lindex $file_states($path) 0] {
2321 lappend pathList $path
2322 if {$path eq $current_diff} {
2323 set after {reshow_diff;}
2328 if {$pathList eq {}} {
2334 [concat $after {set ui_status_value {Ready.}}]
2338 proc do_remove_selection {} {
2339 global current_diff selected_paths
2341 if {[array size selected_paths] > 0} {
2343 {Removing selected files from commit} \
2344 [array names selected_paths]
2345 } elseif {$current_diff ne {}} {
2347 "Removing [short_path $current_diff] from commit" \
2348 [list $current_diff]
2352 proc include_helper {txt paths} {
2353 global file_states current_diff
2355 if {![lock_index begin-update]} return
2359 foreach path $paths {
2360 switch -glob -- [lindex $file_states($path) 0] {
2369 lappend pathList $path
2370 if {$path eq $current_diff} {
2371 set after {reshow_diff;}
2376 if {$pathList eq {}} {
2382 [concat $after {set ui_status_value {Ready to commit.}}]
2386 proc do_include_selection {} {
2387 global current_diff selected_paths
2389 if {[array size selected_paths] > 0} {
2391 {Adding selected files} \
2392 [array names selected_paths]
2393 } elseif {$current_diff ne {}} {
2395 "Adding [short_path $current_diff]" \
2396 [list $current_diff]
2400 proc do_include_all {} {
2404 foreach path [array names file_states] {
2405 switch -- [lindex $file_states($path) 0] {
2411 _D {lappend paths $path}
2415 {Adding all modified files} \
2419 proc revert_helper {txt paths} {
2420 global gitdir appname
2421 global file_states current_diff
2423 if {![lock_index begin-update]} return
2427 foreach path $paths {
2428 switch -glob -- [lindex $file_states($path) 0] {
2435 lappend pathList $path
2436 if {$path eq $current_diff} {
2437 set after {reshow_diff;}
2443 set n [llength $pathList]
2447 } elseif {$n == 1} {
2448 set s "[short_path [lindex $pathList]]"
2450 set s "these $n files"
2453 set reponame [lindex [file split \
2454 [file normalize [file dirname $gitdir]]] \
2457 set reply [tk_dialog \
2459 "$appname ($reponame)" \
2460 "Revert changes in $s?
2462 Any unadded changes will be permanently lost by the revert." \
2472 [concat $after {set ui_status_value {Ready.}}]
2478 proc do_revert_selection {} {
2479 global current_diff selected_paths
2481 if {[array size selected_paths] > 0} {
2483 {Reverting selected files} \
2484 [array names selected_paths]
2485 } elseif {$current_diff ne {}} {
2487 "Reverting [short_path $current_diff]" \
2488 [list $current_diff]
2492 proc do_signoff {} {
2495 set me [committer_ident]
2496 if {$me eq {}} return
2498 set sob "Signed-off-by: $me"
2499 set last [$ui_comm get {end -1c linestart} {end -1c}]
2500 if {$last ne $sob} {
2501 $ui_comm edit separator
2503 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2504 $ui_comm insert end "\n"
2506 $ui_comm insert end "\n$sob"
2507 $ui_comm edit separator
2512 proc do_select_commit_type {} {
2513 global commit_type selected_commit_type
2515 if {$selected_commit_type eq {new}
2516 && [string match amend* $commit_type]} {
2518 } elseif {$selected_commit_type eq {amend}
2519 && ![string match amend* $commit_type]} {
2522 # The amend request was rejected...
2524 if {![string match amend* $commit_type]} {
2525 set selected_commit_type new
2535 global appname appvers copyright
2536 global tcl_patchLevel tk_patchLevel
2540 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2542 label $w.header -text "About $appname" \
2544 pack $w.header -side top -fill x
2547 button $w.buttons.close -text {Close} \
2549 -command [list destroy $w]
2550 pack $w.buttons.close -side right
2551 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2554 -text "$appname - a commit creation tool for Git.
2562 pack $w.desc -side top -fill x -padx 5 -pady 5
2565 append v "$appname version $appvers\n"
2566 append v "[exec git version]\n"
2568 if {$tcl_patchLevel eq $tk_patchLevel} {
2569 append v "Tcl/Tk version $tcl_patchLevel"
2571 append v "Tcl version $tcl_patchLevel"
2572 append v ", Tk version $tk_patchLevel"
2583 pack $w.vers -side top -fill x -padx 5 -pady 5
2585 menu $w.ctxm -tearoff 0
2586 $w.ctxm add command \
2591 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2594 bind $w <Visibility> "grab $w; focus $w"
2595 bind $w <Key-Escape> "destroy $w"
2596 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2597 wm title $w "About $appname"
2601 proc do_options {} {
2602 global appname gitdir font_descs
2603 global repo_config global_config
2604 global repo_config_new global_config_new
2606 array unset repo_config_new
2607 array unset global_config_new
2608 foreach name [array names repo_config] {
2609 set repo_config_new($name) $repo_config($name)
2612 foreach name [array names repo_config] {
2614 gui.diffcontext {continue}
2616 set repo_config_new($name) $repo_config($name)
2618 foreach name [array names global_config] {
2619 set global_config_new($name) $global_config($name)
2621 set reponame [lindex [file split \
2622 [file normalize [file dirname $gitdir]]] \
2625 set w .options_editor
2627 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2629 label $w.header -text "$appname Options" \
2631 pack $w.header -side top -fill x
2634 button $w.buttons.restore -text {Restore Defaults} \
2636 -command do_restore_defaults
2637 pack $w.buttons.restore -side left
2638 button $w.buttons.save -text Save \
2640 -command [list do_save_config $w]
2641 pack $w.buttons.save -side right
2642 button $w.buttons.cancel -text {Cancel} \
2644 -command [list destroy $w]
2645 pack $w.buttons.cancel -side right
2646 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2648 labelframe $w.repo -text "$reponame Repository" \
2650 -relief raised -borderwidth 2
2651 labelframe $w.global -text {Global (All Repositories)} \
2653 -relief raised -borderwidth 2
2654 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2655 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2658 {b partialinclude {Allow Partially Added Files}}
2659 {b pullsummary {Show Pull Summary}}
2660 {b trustmtime {Trust File Modification Timestamps}}
2661 {i diffcontext {Number of Diff Context Lines}}
2663 set type [lindex $option 0]
2664 set name [lindex $option 1]
2665 set text [lindex $option 2]
2666 foreach f {repo global} {
2669 checkbutton $w.$f.$name -text $text \
2670 -variable ${f}_config_new(gui.$name) \
2674 pack $w.$f.$name -side top -anchor w
2678 label $w.$f.$name.l -text "$text:" -font font_ui
2679 pack $w.$f.$name.l -side left -anchor w -fill x
2680 spinbox $w.$f.$name.v \
2681 -textvariable ${f}_config_new(gui.$name) \
2682 -from 1 -to 99 -increment 1 \
2685 pack $w.$f.$name.v -side right -anchor e
2686 pack $w.$f.$name -side top -anchor w -fill x
2692 set all_fonts [lsort [font families]]
2693 foreach option $font_descs {
2694 set name [lindex $option 0]
2695 set font [lindex $option 1]
2696 set text [lindex $option 2]
2698 set global_config_new(gui.$font^^family) \
2699 [font configure $font -family]
2700 set global_config_new(gui.$font^^size) \
2701 [font configure $font -size]
2703 frame $w.global.$name
2704 label $w.global.$name.l -text "$text:" -font font_ui
2705 pack $w.global.$name.l -side left -anchor w -fill x
2706 eval tk_optionMenu $w.global.$name.family \
2707 global_config_new(gui.$font^^family) \
2709 spinbox $w.global.$name.size \
2710 -textvariable global_config_new(gui.$font^^size) \
2711 -from 2 -to 80 -increment 1 \
2714 pack $w.global.$name.size -side right -anchor e
2715 pack $w.global.$name.family -side right -anchor e
2716 pack $w.global.$name -side top -anchor w -fill x
2719 bind $w <Visibility> "grab $w; focus $w"
2720 bind $w <Key-Escape> "destroy $w"
2721 wm title $w "$appname ($reponame): Options"
2725 proc do_restore_defaults {} {
2726 global font_descs default_config repo_config
2727 global repo_config_new global_config_new
2729 foreach name [array names default_config] {
2730 set repo_config_new($name) $default_config($name)
2731 set global_config_new($name) $default_config($name)
2734 foreach option $font_descs {
2735 set name [lindex $option 0]
2736 set repo_config(gui.$name) $default_config(gui.$name)
2740 foreach option $font_descs {
2741 set name [lindex $option 0]
2742 set font [lindex $option 1]
2743 set global_config_new(gui.$font^^family) \
2744 [font configure $font -family]
2745 set global_config_new(gui.$font^^size) \
2746 [font configure $font -size]
2750 proc do_save_config {w} {
2751 if {[catch {save_config} err]} {
2752 error_popup "Failed to completely save options:\n\n$err"
2758 proc do_windows_shortcut {} {
2759 global gitdir appname argv0
2761 set reponame [lindex [file split \
2762 [file normalize [file dirname $gitdir]]] \
2766 set desktop [exec cygpath \
2774 set fn [tk_getSaveFile \
2776 -title "$appname ($reponame): Create Desktop Icon" \
2777 -initialdir $desktop \
2778 -initialfile "Git $reponame.bat"]
2782 set sh [exec cygpath \
2786 set me [exec cygpath \
2790 set gd [exec cygpath \
2794 regsub -all ' $me "'\\''" me
2795 regsub -all ' $gd "'\\''" gd
2796 puts $fd "@ECHO Starting git-gui... Please wait..."
2797 puts -nonewline $fd "@\"$sh\" --login -c \""
2798 puts -nonewline $fd "GIT_DIR='$gd'"
2799 puts -nonewline $fd " '$me'"
2803 error_popup "Cannot write script:\n\n$err"
2808 proc do_macosx_app {} {
2809 global gitdir appname argv0 env
2811 set reponame [lindex [file split \
2812 [file normalize [file dirname $gitdir]]] \
2815 set fn [tk_getSaveFile \
2817 -title "$appname ($reponame): Create Desktop Icon" \
2818 -initialdir [file join $env(HOME) Desktop] \
2819 -initialfile "Git $reponame.app"]
2822 set Contents [file join $fn Contents]
2823 set MacOS [file join $Contents MacOS]
2824 set exe [file join $MacOS git-gui]
2828 set fd [open [file join $Contents Info.plist] w]
2829 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2830 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2831 <plist version="1.0">
2833 <key>CFBundleDevelopmentRegion</key>
2834 <string>English</string>
2835 <key>CFBundleExecutable</key>
2836 <string>git-gui</string>
2837 <key>CFBundleIdentifier</key>
2838 <string>org.spearce.git-gui</string>
2839 <key>CFBundleInfoDictionaryVersion</key>
2840 <string>6.0</string>
2841 <key>CFBundlePackageType</key>
2842 <string>APPL</string>
2843 <key>CFBundleSignature</key>
2844 <string>????</string>
2845 <key>CFBundleVersion</key>
2846 <string>1.0</string>
2847 <key>NSPrincipalClass</key>
2848 <string>NSApplication</string>
2853 set fd [open $exe w]
2854 set gd [file normalize $gitdir]
2855 set ep [file normalize [exec git --exec-path]]
2856 regsub -all ' $gd "'\\''" gd
2857 regsub -all ' $ep "'\\''" ep
2858 puts $fd "#!/bin/sh"
2859 foreach name [array names env] {
2860 if {[string match GIT_* $name]} {
2861 regsub -all ' $env($name) "'\\''" v
2862 puts $fd "export $name='$v'"
2865 puts $fd "export PATH='$ep':\$PATH"
2866 puts $fd "export GIT_DIR='$gd'"
2867 puts $fd "exec [file normalize $argv0]"
2870 file attributes $exe -permissions u+x,g+x,o+x
2872 error_popup "Cannot write icon:\n\n$err"
2877 proc toggle_or_diff {w x y} {
2878 global file_states file_lists current_diff ui_index ui_other
2879 global last_clicked selected_paths
2881 set pos [split [$w index @$x,$y] .]
2882 set lno [lindex $pos 0]
2883 set col [lindex $pos 1]
2884 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2890 set last_clicked [list $w $lno]
2891 array unset selected_paths
2892 $ui_index tag remove in_sel 0.0 end
2893 $ui_other tag remove in_sel 0.0 end
2896 if {$current_diff eq $path} {
2897 set after {reshow_diff;}
2901 switch -glob -- [lindex $file_states($path) 0] {
2908 "Removing [short_path $path] from commit" \
2910 [concat $after {set ui_status_value {Ready.}}]
2914 "Adding [short_path $path]" \
2916 [concat $after {set ui_status_value {Ready.}}]
2920 show_diff $path $w $lno
2924 proc add_one_to_selection {w x y} {
2926 global last_clicked selected_paths
2928 set pos [split [$w index @$x,$y] .]
2929 set lno [lindex $pos 0]
2930 set col [lindex $pos 1]
2931 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2937 set last_clicked [list $w $lno]
2938 if {[catch {set in_sel $selected_paths($path)}]} {
2942 unset selected_paths($path)
2943 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2945 set selected_paths($path) 1
2946 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2950 proc add_range_to_selection {w x y} {
2952 global last_clicked selected_paths
2954 if {[lindex $last_clicked 0] ne $w} {
2955 toggle_or_diff $w $x $y
2959 set pos [split [$w index @$x,$y] .]
2960 set lno [lindex $pos 0]
2961 set lc [lindex $last_clicked 1]
2970 foreach path [lrange $file_lists($w) \
2971 [expr {$begin - 1}] \
2972 [expr {$end - 1}]] {
2973 set selected_paths($path) 1
2975 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2978 ######################################################################
2982 set cursor_ptr arrow
2983 font create font_diff -family Courier -size 10
2987 eval font configure font_ui [font actual [.dummy cget -font]]
2991 font create font_uibold
2992 font create font_diffbold
2997 } elseif {[is_MacOSX]} {
3005 proc apply_config {} {
3006 global repo_config font_descs
3008 foreach option $font_descs {
3009 set name [lindex $option 0]
3010 set font [lindex $option 1]
3012 foreach {cn cv} $repo_config(gui.$name) {
3013 font configure $font $cn $cv
3016 error_popup "Invalid font specified in gui.$name:\n\n$err"
3018 foreach {cn cv} [font configure $font] {
3019 font configure ${font}bold $cn $cv
3021 font configure ${font}bold -weight bold
3025 set default_config(gui.trustmtime) false
3026 set default_config(gui.pullsummary) true
3027 set default_config(gui.partialinclude) false
3028 set default_config(gui.diffcontext) 5
3029 set default_config(gui.fontui) [font configure font_ui]
3030 set default_config(gui.fontdiff) [font configure font_diff]
3032 {fontui font_ui {Main Font}}
3033 {fontdiff font_diff {Diff/Console Font}}
3038 ######################################################################
3044 menu .mbar -tearoff 0
3045 .mbar add cascade -label Repository -menu .mbar.repository
3046 .mbar add cascade -label Edit -menu .mbar.edit
3047 if {!$single_commit} {
3048 .mbar add cascade -label Branch -menu .mbar.branch
3050 .mbar add cascade -label Commit -menu .mbar.commit
3051 if {!$single_commit} {
3052 .mbar add cascade -label Fetch -menu .mbar.fetch
3053 .mbar add cascade -label Pull -menu .mbar.pull
3054 .mbar add cascade -label Push -menu .mbar.push
3056 . configure -menu .mbar
3058 # -- Repository Menu
3060 menu .mbar.repository
3061 .mbar.repository add command \
3062 -label {Visualize Current Branch} \
3063 -command {do_gitk {}} \
3066 .mbar.repository add command \
3067 -label {Visualize All Branches} \
3068 -command {do_gitk {--all}} \
3071 .mbar.repository add separator
3073 if {!$single_commit} {
3074 .mbar.repository add command -label {Compress Database} \
3078 .mbar.repository add command -label {Verify Database} \
3079 -command do_fsck_objects \
3082 .mbar.repository add separator
3085 .mbar.repository add command \
3086 -label {Create Desktop Icon} \
3087 -command do_windows_shortcut \
3089 } elseif {[is_MacOSX]} {
3090 .mbar.repository add command \
3091 -label {Create Desktop Icon} \
3092 -command do_macosx_app \
3097 .mbar.repository add command -label Quit \
3099 -accelerator $M1T-Q \
3105 .mbar.edit add command -label Undo \
3106 -command {catch {[focus] edit undo}} \
3107 -accelerator $M1T-Z \
3109 .mbar.edit add command -label Redo \
3110 -command {catch {[focus] edit redo}} \
3111 -accelerator $M1T-Y \
3113 .mbar.edit add separator
3114 .mbar.edit add command -label Cut \
3115 -command {catch {tk_textCut [focus]}} \
3116 -accelerator $M1T-X \
3118 .mbar.edit add command -label Copy \
3119 -command {catch {tk_textCopy [focus]}} \
3120 -accelerator $M1T-C \
3122 .mbar.edit add command -label Paste \
3123 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3124 -accelerator $M1T-V \
3126 .mbar.edit add command -label Delete \
3127 -command {catch {[focus] delete sel.first sel.last}} \
3130 .mbar.edit add separator
3131 .mbar.edit add command -label {Select All} \
3132 -command {catch {[focus] tag add sel 0.0 end}} \
3133 -accelerator $M1T-A \
3138 if {!$single_commit} {
3141 .mbar.branch add command -label {Create...} \
3142 -command do_create_branch \
3144 lappend disable_on_lock [list .mbar.branch entryconf \
3145 [.mbar.branch index last] -state]
3147 .mbar.branch add command -label {Delete...} \
3148 -command do_delete_branch \
3150 lappend disable_on_lock [list .mbar.branch entryconf \
3151 [.mbar.branch index last] -state]
3158 .mbar.commit add radiobutton \
3159 -label {New Commit} \
3160 -command do_select_commit_type \
3161 -variable selected_commit_type \
3164 lappend disable_on_lock \
3165 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3167 .mbar.commit add radiobutton \
3168 -label {Amend Last Commit} \
3169 -command do_select_commit_type \
3170 -variable selected_commit_type \
3173 lappend disable_on_lock \
3174 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3176 .mbar.commit add separator
3178 .mbar.commit add command -label Rescan \
3179 -command do_rescan \
3182 lappend disable_on_lock \
3183 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3185 .mbar.commit add command -label {Add To Commit} \
3186 -command do_include_selection \
3188 lappend disable_on_lock \
3189 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3191 .mbar.commit add command -label {Add All To Commit} \
3192 -command do_include_all \
3193 -accelerator $M1T-I \
3195 lappend disable_on_lock \
3196 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3198 .mbar.commit add command -label {Remove From Commit} \
3199 -command do_remove_selection \
3201 lappend disable_on_lock \
3202 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3204 .mbar.commit add command -label {Revert Changes} \
3205 -command do_revert_selection \
3207 lappend disable_on_lock \
3208 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3210 .mbar.commit add separator
3212 .mbar.commit add command -label {Sign Off} \
3213 -command do_signoff \
3214 -accelerator $M1T-S \
3217 .mbar.commit add command -label Commit \
3218 -command do_commit \
3219 -accelerator $M1T-Return \
3221 lappend disable_on_lock \
3222 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3224 # -- Transport menus
3226 if {!$single_commit} {
3233 # -- Apple Menu (Mac OS X only)
3235 .mbar add cascade -label Apple -menu .mbar.apple
3238 .mbar.apple add command -label "About $appname" \
3241 .mbar.apple add command -label "$appname Options..." \
3242 -command do_options \
3247 .mbar.edit add separator
3248 .mbar.edit add command -label {Options...} \
3249 -command do_options \
3254 if {[file exists /usr/local/miga/lib/gui-miga]
3255 && [file exists .pvcsrc]} {
3257 global gitdir ui_status_value
3258 if {![lock_index update]} return
3259 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3260 set miga_fd [open "|$cmd" r]
3261 fconfigure $miga_fd -blocking 0
3262 fileevent $miga_fd readable [list miga_done $miga_fd]
3263 set ui_status_value {Running miga...}
3265 proc miga_done {fd} {
3270 rescan [list set ui_status_value {Ready.}]
3273 .mbar add cascade -label Tools -menu .mbar.tools
3275 .mbar.tools add command -label "Migrate" \
3278 lappend disable_on_lock \
3279 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3284 .mbar add cascade -label Help -menu .mbar.help
3287 .mbar.help add command -label "About $appname" \
3299 -text {Current Branch:} \
3304 -textvariable current_branch \
3308 pack .branch.l1 -side left
3309 pack .branch.cb -side left -fill x
3310 pack .branch -side top -fill x
3312 # -- Main Window Layout
3314 panedwindow .vpane -orient vertical
3315 panedwindow .vpane.files -orient horizontal
3316 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3317 pack .vpane -anchor n -side top -fill both -expand 1
3319 # -- Index File List
3321 frame .vpane.files.index -height 100 -width 400
3322 label .vpane.files.index.title -text {Modified Files} \
3325 text $ui_index -background white -borderwidth 0 \
3326 -width 40 -height 10 \
3328 -cursor $cursor_ptr \
3329 -yscrollcommand {.vpane.files.index.sb set} \
3331 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3332 pack .vpane.files.index.title -side top -fill x
3333 pack .vpane.files.index.sb -side right -fill y
3334 pack $ui_index -side left -fill both -expand 1
3335 .vpane.files add .vpane.files.index -sticky nsew
3337 # -- Other (Add) File List
3339 frame .vpane.files.other -height 100 -width 100
3340 label .vpane.files.other.title -text {Untracked Files} \
3343 text $ui_other -background white -borderwidth 0 \
3344 -width 40 -height 10 \
3346 -cursor $cursor_ptr \
3347 -yscrollcommand {.vpane.files.other.sb set} \
3349 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3350 pack .vpane.files.other.title -side top -fill x
3351 pack .vpane.files.other.sb -side right -fill y
3352 pack $ui_other -side left -fill both -expand 1
3353 .vpane.files add .vpane.files.other -sticky nsew
3355 foreach i [list $ui_index $ui_other] {
3356 $i tag conf in_diff -font font_uibold
3357 $i tag conf in_sel \
3358 -background [$i cget -foreground] \
3359 -foreground [$i cget -background]
3363 # -- Diff and Commit Area
3365 frame .vpane.lower -height 300 -width 400
3366 frame .vpane.lower.commarea
3367 frame .vpane.lower.diff -relief sunken -borderwidth 1
3368 pack .vpane.lower.commarea -side top -fill x
3369 pack .vpane.lower.diff -side bottom -fill both -expand 1
3370 .vpane add .vpane.lower -stick nsew
3372 # -- Commit Area Buttons
3374 frame .vpane.lower.commarea.buttons
3375 label .vpane.lower.commarea.buttons.l -text {} \
3379 pack .vpane.lower.commarea.buttons.l -side top -fill x
3380 pack .vpane.lower.commarea.buttons -side left -fill y
3382 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3383 -command do_rescan \
3385 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3386 lappend disable_on_lock \
3387 {.vpane.lower.commarea.buttons.rescan conf -state}
3389 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3390 -command do_include_all \
3392 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3393 lappend disable_on_lock \
3394 {.vpane.lower.commarea.buttons.incall conf -state}
3396 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3397 -command do_signoff \
3399 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3401 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3402 -command do_commit \
3404 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3405 lappend disable_on_lock \
3406 {.vpane.lower.commarea.buttons.commit conf -state}
3408 # -- Commit Message Buffer
3410 frame .vpane.lower.commarea.buffer
3411 frame .vpane.lower.commarea.buffer.header
3412 set ui_comm .vpane.lower.commarea.buffer.t
3413 set ui_coml .vpane.lower.commarea.buffer.header.l
3414 radiobutton .vpane.lower.commarea.buffer.header.new \
3415 -text {New Commit} \
3416 -command do_select_commit_type \
3417 -variable selected_commit_type \
3420 lappend disable_on_lock \
3421 [list .vpane.lower.commarea.buffer.header.new conf -state]
3422 radiobutton .vpane.lower.commarea.buffer.header.amend \
3423 -text {Amend Last Commit} \
3424 -command do_select_commit_type \
3425 -variable selected_commit_type \
3428 lappend disable_on_lock \
3429 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3434 proc trace_commit_type {varname args} {
3435 global ui_coml commit_type
3436 switch -glob -- $commit_type {
3437 initial {set txt {Initial Commit Message:}}
3438 amend {set txt {Amended Commit Message:}}
3439 amend-initial {set txt {Amended Initial Commit Message:}}
3440 amend-merge {set txt {Amended Merge Commit Message:}}
3441 merge {set txt {Merge Commit Message:}}
3442 * {set txt {Commit Message:}}
3444 $ui_coml conf -text $txt
3446 trace add variable commit_type write trace_commit_type
3447 pack $ui_coml -side left -fill x
3448 pack .vpane.lower.commarea.buffer.header.amend -side right
3449 pack .vpane.lower.commarea.buffer.header.new -side right
3451 text $ui_comm -background white -borderwidth 1 \
3454 -autoseparators true \
3456 -width 75 -height 9 -wrap none \
3458 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3459 scrollbar .vpane.lower.commarea.buffer.sby \
3460 -command [list $ui_comm yview]
3461 pack .vpane.lower.commarea.buffer.header -side top -fill x
3462 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3463 pack $ui_comm -side left -fill y
3464 pack .vpane.lower.commarea.buffer -side left -fill y
3466 # -- Commit Message Buffer Context Menu
3468 set ctxm .vpane.lower.commarea.buffer.ctxm
3469 menu $ctxm -tearoff 0
3473 -command {tk_textCut $ui_comm}
3477 -command {tk_textCopy $ui_comm}
3481 -command {tk_textPaste $ui_comm}
3485 -command {$ui_comm delete sel.first sel.last}
3488 -label {Select All} \
3490 -command {$ui_comm tag add sel 0.0 end}
3495 $ui_comm tag add sel 0.0 end
3496 tk_textCopy $ui_comm
3497 $ui_comm tag remove sel 0.0 end
3504 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3509 set diff_actions [list]
3510 proc trace_current_diff {varname args} {
3511 global current_diff diff_actions file_states
3512 if {$current_diff eq {}} {
3519 set s [mapdesc [lindex $file_states($p) 0] $p]
3521 set p [escape_path $p]
3525 .vpane.lower.diff.header.status configure -text $s
3526 .vpane.lower.diff.header.file configure -text $f
3527 .vpane.lower.diff.header.path configure -text $p
3528 foreach w $diff_actions {
3532 trace add variable current_diff write trace_current_diff
3534 frame .vpane.lower.diff.header -background orange
3535 label .vpane.lower.diff.header.status \
3536 -background orange \
3537 -width $max_status_desc \
3541 label .vpane.lower.diff.header.file \
3542 -background orange \
3546 label .vpane.lower.diff.header.path \
3547 -background orange \
3551 pack .vpane.lower.diff.header.status -side left
3552 pack .vpane.lower.diff.header.file -side left
3553 pack .vpane.lower.diff.header.path -fill x
3554 set ctxm .vpane.lower.diff.header.ctxm
3555 menu $ctxm -tearoff 0
3566 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3567 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3571 frame .vpane.lower.diff.body
3572 set ui_diff .vpane.lower.diff.body.t
3573 text $ui_diff -background white -borderwidth 0 \
3574 -width 80 -height 15 -wrap none \
3576 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3577 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3579 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3580 -command [list $ui_diff xview]
3581 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3582 -command [list $ui_diff yview]
3583 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3584 pack .vpane.lower.diff.body.sby -side right -fill y
3585 pack $ui_diff -side left -fill both -expand 1
3586 pack .vpane.lower.diff.header -side top -fill x
3587 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3589 $ui_diff tag conf d_@ -font font_diffbold
3590 $ui_diff tag conf d_+ -foreground blue
3591 $ui_diff tag conf d_- -foreground red
3592 $ui_diff tag conf d_++ -foreground {#00a000}
3593 $ui_diff tag conf d_-- -foreground {#a000a0}
3594 $ui_diff tag conf d_+- \
3596 -background {light goldenrod yellow}
3597 $ui_diff tag conf d_-+ \
3601 # -- Diff Body Context Menu
3603 set ctxm .vpane.lower.diff.body.ctxm
3604 menu $ctxm -tearoff 0
3608 -command {tk_textCopy $ui_diff}
3609 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3611 -label {Select All} \
3613 -command {$ui_diff tag add sel 0.0 end}
3614 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3619 $ui_diff tag add sel 0.0 end
3620 tk_textCopy $ui_diff
3621 $ui_diff tag remove sel 0.0 end
3623 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3626 -label {Decrease Font Size} \
3628 -command {incr_font_size font_diff -1}
3629 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3631 -label {Increase Font Size} \
3633 -command {incr_font_size font_diff 1}
3634 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3637 -label {Show Less Context} \
3639 -command {if {$repo_config(gui.diffcontext) >= 2} {
3640 incr repo_config(gui.diffcontext) -1
3643 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3645 -label {Show More Context} \
3648 incr repo_config(gui.diffcontext)
3651 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3653 $ctxm add command -label {Options...} \
3656 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3660 set ui_status_value {Initializing...}
3661 label .status -textvariable ui_status_value \
3667 pack .status -anchor w -side bottom -fill x
3672 set gm $repo_config(gui.geometry)
3673 wm geometry . [lindex $gm 0]
3674 .vpane sash place 0 \
3675 [lindex [.vpane sash coord 0] 0] \
3677 .vpane.files sash place 0 \
3679 [lindex [.vpane.files sash coord 0] 1]
3685 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3686 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3687 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3688 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3689 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3690 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3691 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3692 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3693 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3694 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3695 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3697 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3698 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3699 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3700 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3701 bind $ui_diff <$M1B-Key-v> {break}
3702 bind $ui_diff <$M1B-Key-V> {break}
3703 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3704 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3705 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3706 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3707 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3708 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3710 bind . <Destroy> do_quit
3711 bind all <Key-F5> do_rescan
3712 bind all <$M1B-Key-r> do_rescan
3713 bind all <$M1B-Key-R> do_rescan
3714 bind . <$M1B-Key-s> do_signoff
3715 bind . <$M1B-Key-S> do_signoff
3716 bind . <$M1B-Key-i> do_include_all
3717 bind . <$M1B-Key-I> do_include_all
3718 bind . <$M1B-Key-Return> do_commit
3719 bind all <$M1B-Key-q> do_quit
3720 bind all <$M1B-Key-Q> do_quit
3721 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3722 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3723 foreach i [list $ui_index $ui_other] {
3724 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3725 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3726 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3730 set file_lists($ui_index) [list]
3731 set file_lists($ui_other) [list]
3735 set MERGE_HEAD [list]
3738 set current_branch {}
3740 set selected_commit_type new
3742 wm title . "$appname ([file normalize [file dirname $gitdir]])"
3743 focus -force $ui_comm
3745 # -- Warn the user about environmental problems. Cygwin's Tcl
3746 # does *not* pass its env array onto any processes it spawns.
3747 # This means that git processes get none of our environment.
3752 set msg "Possible environment issues exist.
3754 The following environment variables are probably
3755 going to be ignored by any Git subprocess run
3759 foreach name [array names env] {
3760 switch -regexp -- $name {
3761 {^GIT_INDEX_FILE$} -
3762 {^GIT_OBJECT_DIRECTORY$} -
3763 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3765 {^GIT_EXTERNAL_DIFF$} -
3769 {^GIT_CONFIG_LOCAL$} -
3770 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3771 append msg " - $name\n"
3774 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3775 append msg " - $name\n"
3777 set suggest_user $name
3781 if {$ignored_env > 0} {
3783 This is due to a known issue with the
3784 Tcl binary distributed by Cygwin."
3786 if {$suggest_user ne {}} {
3789 A good replacement for $suggest_user
3790 is placing values for the user.name and
3791 user.email settings into your personal
3797 unset ignored_env msg suggest_user name
3800 # -- Only initialize complex UI if we are going to stay running.
3802 if {!$single_commit} {
3806 populate_branch_menu .mbar.branch
3807 populate_fetch_menu .mbar.fetch
3808 populate_pull_menu .mbar.pull
3809 populate_push_menu .mbar.push
3812 # -- Only suggest a gc run if we are going to stay running.
3814 if {!$single_commit} {
3815 set object_limit 2000
3816 if {[is_Windows]} {set object_limit 200}
3817 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3818 if {$objects_current >= $object_limit} {
3820 "This repository currently has $objects_current loose objects.
3822 To maintain optimal performance it is strongly
3823 recommended that you compress the database
3824 when more than $object_limit loose objects exist.
3826 Compress the database now?"] eq yes} {
3830 unset object_limit _junk objects_current
3833 lock_index begin-read