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]]] \
133 set cmd [list tk_messageBox \
136 -title "$title: error" \
138 if {[winfo ismapped .]} {
139 lappend cmd -parent .
144 proc info_popup {msg} {
145 global gitdir appname
150 append title [lindex \
151 [file split [file normalize [file dirname $gitdir]]] \
163 ######################################################################
167 if { [catch {set gitdir $env(GIT_DIR)}]
168 && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
169 catch {wm withdraw .}
170 error_popup "Cannot find the git directory:\n\n$err"
173 if {![file isdirectory $gitdir]} {
174 catch {wm withdraw .}
175 error_popup "Git directory not found:\n\n$gitdir"
178 if {[lindex [file split $gitdir] end] ne {.git}} {
179 catch {wm withdraw .}
180 error_popup "Cannot use funny .git directory:\n\n$gitdir"
183 if {[catch {cd [file dirname $gitdir]} err]} {
184 catch {wm withdraw .}
185 error_popup "No working directory [file dirname $gitdir]:\n\n$err"
190 if {$appname eq {git-citool}} {
194 ######################################################################
202 set disable_on_lock [list]
203 set index_lock_type none
205 proc lock_index {type} {
206 global index_lock_type disable_on_lock
208 if {$index_lock_type eq {none}} {
209 set index_lock_type $type
210 foreach w $disable_on_lock {
211 uplevel #0 $w disabled
214 } elseif {$index_lock_type eq "begin-$type"} {
215 set index_lock_type $type
221 proc unlock_index {} {
222 global index_lock_type disable_on_lock
224 set index_lock_type none
225 foreach w $disable_on_lock {
230 ######################################################################
234 proc repository_state {hdvar ctvar} {
236 upvar $hdvar hd $ctvar ct
238 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
241 } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
249 global PARENT empty_tree
254 if {$empty_tree eq {}} {
255 set empty_tree [exec git mktree << {}]
260 proc rescan {after} {
261 global HEAD PARENT commit_type
262 global ui_index ui_other ui_status_value ui_comm
263 global rescan_active file_states
266 if {$rescan_active > 0 || ![lock_index read]} return
268 repository_state new_HEAD new_type
269 if {[string match amend* $commit_type]
270 && $new_type eq {normal}
271 && $new_HEAD eq $HEAD} {
275 set commit_type $new_type
278 array unset file_states
280 if {![$ui_comm edit modified]
281 || [string trim [$ui_comm get 0.0 end]] eq {}} {
282 if {[load_message GITGUI_MSG]} {
283 } elseif {[load_message MERGE_MSG]} {
284 } elseif {[load_message SQUASH_MSG]} {
286 $ui_comm edit modified false
290 if {$repo_config(gui.trustmtime) eq {true}} {
291 rescan_stage2 {} $after
294 set ui_status_value {Refreshing file status...}
295 set cmd [list git update-index]
297 lappend cmd --unmerged
298 lappend cmd --ignore-missing
299 lappend cmd --refresh
300 set fd_rf [open "| $cmd" r]
301 fconfigure $fd_rf -blocking 0 -translation binary
302 fileevent $fd_rf readable \
303 [list rescan_stage2 $fd_rf $after]
307 proc rescan_stage2 {fd after} {
308 global gitdir ui_status_value
309 global rescan_active buf_rdi buf_rdf buf_rlo
313 if {![eof $fd]} return
317 set ls_others [list | git ls-files --others -z \
318 --exclude-per-directory=.gitignore]
319 set info_exclude [file join $gitdir info exclude]
320 if {[file readable $info_exclude]} {
321 lappend ls_others "--exclude-from=$info_exclude"
329 set ui_status_value {Scanning for modified files ...}
330 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
331 set fd_df [open "| git diff-files -z" r]
332 set fd_lo [open $ls_others r]
334 fconfigure $fd_di -blocking 0 -translation binary
335 fconfigure $fd_df -blocking 0 -translation binary
336 fconfigure $fd_lo -blocking 0 -translation binary
337 fileevent $fd_di readable [list read_diff_index $fd_di $after]
338 fileevent $fd_df readable [list read_diff_files $fd_df $after]
339 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
342 proc load_message {file} {
343 global gitdir ui_comm
345 set f [file join $gitdir $file]
346 if {[file isfile $f]} {
347 if {[catch {set fd [open $f r]}]} {
350 set content [string trim [read $fd]]
352 $ui_comm delete 0.0 end
353 $ui_comm insert end $content
359 proc read_diff_index {fd after} {
362 append buf_rdi [read $fd]
364 set n [string length $buf_rdi]
366 set z1 [string first "\0" $buf_rdi $c]
369 set z2 [string first "\0" $buf_rdi $z1]
375 [string range $buf_rdi $z1 $z2] \
376 [string index $buf_rdi [expr {$z1 - 2}]]?
380 set buf_rdi [string range $buf_rdi $c end]
385 rescan_done $fd buf_rdi $after
388 proc read_diff_files {fd after} {
391 append buf_rdf [read $fd]
393 set n [string length $buf_rdf]
395 set z1 [string first "\0" $buf_rdf $c]
398 set z2 [string first "\0" $buf_rdf $z1]
404 [string range $buf_rdf $z1 $z2] \
405 ?[string index $buf_rdf [expr {$z1 - 2}]]
409 set buf_rdf [string range $buf_rdf $c end]
414 rescan_done $fd buf_rdf $after
417 proc read_ls_others {fd after} {
420 append buf_rlo [read $fd]
421 set pck [split $buf_rlo "\0"]
422 set buf_rlo [lindex $pck end]
423 foreach p [lrange $pck 0 end-1] {
426 rescan_done $fd buf_rlo $after
429 proc rescan_done {fd buf after} {
431 global file_states repo_config
434 if {![eof $fd]} return
437 if {[incr rescan_active -1] > 0} return
443 if {$repo_config(gui.partialinclude) ne {true}} {
445 foreach path [array names file_states] {
446 switch -- [lindex $file_states($path) 0] {
448 MM {lappend pathList $path}
451 if {$pathList ne {}} {
453 "Updating included files" \
455 [concat {reshow_diff;} $after]
464 proc prune_selection {} {
465 global file_states selected_paths
467 foreach path [array names selected_paths] {
468 if {[catch {set still_here $file_states($path)}]} {
469 unset selected_paths($path)
474 ######################################################################
479 global ui_diff current_diff ui_index ui_other
481 $ui_diff conf -state normal
482 $ui_diff delete 0.0 end
483 $ui_diff conf -state disabled
487 $ui_index tag remove in_diff 0.0 end
488 $ui_other tag remove in_diff 0.0 end
491 proc reshow_diff {} {
492 global current_diff ui_status_value file_states
494 if {$current_diff eq {}
495 || [catch {set s $file_states($current_diff)}]} {
498 show_diff $current_diff
502 proc handle_empty_diff {} {
503 global current_diff file_states file_lists
505 set path $current_diff
506 set s $file_states($path)
507 if {[lindex $s 0] ne {_M}} return
509 info_popup "No differences detected.
511 [short_path $path] has no changes.
513 The modification date of this file was updated
514 by another application and you currently have
515 the Trust File Modification Timestamps option
516 enabled, so Git did not automatically detect
517 that there are no content differences in this
520 This file will now be removed from the modified
521 files list, to prevent possible confusion.
523 if {[catch {exec git update-index -- $path} err]} {
524 error_popup "Failed to refresh index:\n\n$err"
528 set old_w [mapcol [lindex $file_states($path) 0] $path]
529 set lno [lsearch -sorted $file_lists($old_w) $path]
531 set file_lists($old_w) \
532 [lreplace $file_lists($old_w) $lno $lno]
534 $old_w conf -state normal
535 $old_w delete $lno.0 [expr {$lno + 1}].0
536 $old_w conf -state disabled
540 proc show_diff {path {w {}} {lno {}}} {
541 global file_states file_lists
542 global diff_3way diff_active repo_config
543 global ui_diff current_diff ui_status_value
545 if {$diff_active || ![lock_index read]} return
548 if {$w eq {} || $lno == {}} {
549 foreach w [array names file_lists] {
550 set lno [lsearch -sorted $file_lists($w) $path]
557 if {$w ne {} && $lno >= 1} {
558 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
561 set s $file_states($path)
565 set current_diff $path
566 set ui_status_value "Loading diff of [escape_path $path]..."
568 set cmd [list | git diff-index]
569 lappend cmd --no-color
570 if {$repo_config(gui.diffcontext) > 0} {
571 lappend cmd "-U$repo_config(gui.diffcontext)"
581 set fd [open $path r]
582 set content [read $fd]
587 set ui_status_value "Unable to display [escape_path $path]"
588 error_popup "Error loading file:\n\n$err"
591 $ui_diff conf -state normal
592 $ui_diff insert end $content
593 $ui_diff conf -state disabled
596 set ui_status_value {Ready.}
605 if {[catch {set fd [open $cmd r]} err]} {
608 set ui_status_value "Unable to display [escape_path $path]"
609 error_popup "Error loading diff:\n\n$err"
613 fconfigure $fd -blocking 0 -translation auto
614 fileevent $fd readable [list read_diff $fd]
617 proc read_diff {fd} {
618 global ui_diff ui_status_value diff_3way diff_active
621 while {[gets $fd line] >= 0} {
622 if {[string match {diff --git *} $line]} continue
623 if {[string match {diff --combined *} $line]} continue
624 if {[string match {--- *} $line]} continue
625 if {[string match {+++ *} $line]} continue
626 if {[string match index* $line]} {
627 if {[string first , $line] >= 0} {
632 $ui_diff conf -state normal
634 set x [string index $line 0]
639 default {set tags {}}
642 set x [string range $line 0 1]
644 default {set tags {}}
646 "++" {set tags dp; set x " +"}
647 " +" {set tags {di bold}; set x "++"}
648 "+ " {set tags dni; set x "-+"}
649 "--" {set tags dm; set x " -"}
650 " -" {set tags {dm bold}; set x "--"}
651 "- " {set tags di; set x "+-"}
652 default {set tags {}}
654 set line [string replace $line 0 1 $x]
656 $ui_diff insert end $line $tags
657 $ui_diff insert end "\n"
658 $ui_diff conf -state disabled
665 set ui_status_value {Ready.}
667 if {$repo_config(gui.trustmtime) eq {true}
668 && [$ui_diff index end] eq {2.0}} {
674 ######################################################################
678 proc load_last_commit {} {
679 global HEAD PARENT commit_type ui_comm
681 if {[string match amend* $commit_type]} return
682 if {$commit_type ne {normal}} {
683 error_popup "Can't amend a $commit_type commit."
691 set fd [open "| git cat-file commit $HEAD" r]
692 while {[gets $fd line] > 0} {
693 if {[string match {parent *} $line]} {
694 set parent [string range $line 7 end]
698 set msg [string trim [read $fd]]
701 error_popup "Error loading commit data for amend:\n\n$err"
705 if {$parent_count > 1} {
706 error_popup {Can't amend a merge commit.}
710 if {$parent_count == 0} {
711 set commit_type amend-initial
713 } elseif {$parent_count == 1} {
714 set commit_type amend
718 $ui_comm delete 0.0 end
719 $ui_comm insert end $msg
720 $ui_comm edit modified false
722 rescan {set ui_status_value {Ready.}}
725 proc commit_tree {} {
726 global HEAD commit_type file_states ui_comm repo_config
728 if {![lock_index update]} return
730 # -- Our in memory state should match the repository.
732 repository_state curHEAD cur_type
733 if {[string match amend* $commit_type]
734 && $cur_type eq {normal}
735 && $curHEAD eq $HEAD} {
736 } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
737 error_popup {Last scanned state does not match repository state.
739 Its highly likely that another Git program modified the
740 repository since the last scan. A rescan is required
743 A rescan will be automatically started now.
746 rescan {set ui_status_value {Ready.}}
750 # -- At least one file should differ in the index.
753 foreach path [array names file_states] {
754 switch -glob -- [lindex $file_states($path) 0] {
758 M? {set files_ready 1; break}
760 error_popup "Unmerged files cannot be committed.
762 File [short_path $path] has merge conflicts.
763 You must resolve them and include the file before committing.
769 error_popup "Unknown file state [lindex $s 0] detected.
771 File [short_path $path] cannot be committed by this program.
777 error_popup {No included files to commit.
779 You must include at least 1 file before you can commit.
785 # -- A message is required.
787 set msg [string trim [$ui_comm get 1.0 end]]
789 error_popup {Please supply a commit message.
791 A good commit message has the following format:
793 - First line: Describe in one sentance what you did.
795 - Remaining lines: Describe why this change is good.
801 # -- Update included files if partialincludes are off.
803 if {$repo_config(gui.partialinclude) ne {true}} {
805 foreach path [array names file_states] {
806 switch -glob -- [lindex $file_states($path) 0] {
808 M? {lappend pathList $path}
811 if {$pathList ne {}} {
814 "Updating included files" \
816 [concat {lock_index update;} \
817 [list commit_prehook $curHEAD $msg]]
822 commit_prehook $curHEAD $msg
825 proc commit_prehook {curHEAD msg} {
826 global tcl_platform gitdir ui_status_value pch_error
828 # On Cygwin [file executable] might lie so we need to ask
829 # the shell if the hook is executable. Yes that's annoying.
831 set pchook [file join $gitdir hooks pre-commit]
832 if {$tcl_platform(platform) eq {windows}
833 && [file isfile $pchook]} {
834 set pchook [list sh -c [concat \
835 "if test -x \"$pchook\";" \
836 "then exec \"$pchook\" 2>&1;" \
838 } elseif {[file executable $pchook]} {
839 set pchook [list $pchook |& cat]
841 commit_writetree $curHEAD $msg
845 set ui_status_value {Calling pre-commit hook...}
847 set fd_ph [open "| $pchook" r]
848 fconfigure $fd_ph -blocking 0 -translation binary
849 fileevent $fd_ph readable \
850 [list commit_prehook_wait $fd_ph $curHEAD $msg]
853 proc commit_prehook_wait {fd_ph curHEAD msg} {
854 global pch_error ui_status_value
856 append pch_error [read $fd_ph]
857 fconfigure $fd_ph -blocking 1
859 if {[catch {close $fd_ph}]} {
860 set ui_status_value {Commit declined by pre-commit hook.}
861 hook_failed_popup pre-commit $pch_error
864 commit_writetree $curHEAD $msg
869 fconfigure $fd_ph -blocking 0
872 proc commit_writetree {curHEAD msg} {
873 global ui_status_value
875 set ui_status_value {Committing changes...}
876 set fd_wt [open "| git write-tree" r]
877 fileevent $fd_wt readable \
878 [list commit_committree $fd_wt $curHEAD $msg]
881 proc commit_committree {fd_wt curHEAD msg} {
882 global single_commit gitdir HEAD PARENT commit_type tcl_platform
883 global ui_status_value ui_comm
884 global file_states selected_paths
887 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
888 error_popup "write-tree failed:\n\n$err"
889 set ui_status_value {Commit failed.}
894 # -- Create the commit.
896 set cmd [list git commit-tree $tree_id]
898 lappend cmd -p $PARENT
900 if {$commit_type eq {merge}} {
902 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
903 while {[gets $fd_mh merge_head] >= 0} {
904 lappend cmd -p $merge_head
908 error_popup "Loading MERGE_HEAD failed:\n\n$err"
909 set ui_status_value {Commit failed.}
915 # git commit-tree writes to stderr during initial commit.
916 lappend cmd 2>/dev/null
919 if {[catch {set cmt_id [eval exec $cmd]} err]} {
920 error_popup "commit-tree failed:\n\n$err"
921 set ui_status_value {Commit failed.}
926 # -- Update the HEAD ref.
929 if {$commit_type ne {normal}} {
930 append reflogm " ($commit_type)"
932 set i [string first "\n" $msg]
934 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
936 append reflogm {: } $msg
938 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
939 if {[catch {eval exec $cmd} err]} {
940 error_popup "update-ref failed:\n\n$err"
941 set ui_status_value {Commit failed.}
946 # -- Cleanup after ourselves.
948 catch {file delete [file join $gitdir MERGE_HEAD]}
949 catch {file delete [file join $gitdir MERGE_MSG]}
950 catch {file delete [file join $gitdir SQUASH_MSG]}
951 catch {file delete [file join $gitdir GITGUI_MSG]}
953 # -- Let rerere do its thing.
955 if {[file isdirectory [file join $gitdir rr-cache]]} {
956 catch {exec git rerere}
959 # -- Run the post-commit hook.
961 set pchook [file join $gitdir hooks post-commit]
962 if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
963 set pchook [list sh -c [concat \
964 "if test -x \"$pchook\";" \
965 "then exec \"$pchook\";" \
967 } elseif {![file executable $pchook]} {
971 catch {exec $pchook &}
974 $ui_comm delete 0.0 end
975 $ui_comm edit modified false
978 if {$single_commit} do_quit
980 # -- Update status without invoking any git commands.
982 set commit_type normal
986 foreach path [array names file_states] {
987 set s $file_states($path)
992 D? {set m _[string index $m 1]}
996 unset file_states($path)
997 catch {unset selected_paths($path)}
999 lset file_states($path) 0 $m
1006 set ui_status_value \
1007 "Changes committed as [string range $cmt_id 0 7]."
1010 ######################################################################
1014 proc fetch_from {remote} {
1015 set w [new_console "fetch $remote" \
1016 "Fetching new changes from $remote"]
1017 set cmd [list git fetch]
1019 console_exec $w $cmd
1022 proc pull_remote {remote branch} {
1023 global HEAD commit_type file_states repo_config
1025 if {![lock_index update]} return
1027 # -- Our in memory state should match the repository.
1029 repository_state curHEAD cur_type
1030 if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
1031 error_popup {Last scanned state does not match repository state.
1033 Its highly likely that another Git program modified the
1034 repository since our last scan. A rescan is required
1035 before a pull can be started.
1038 rescan {set ui_status_value {Ready.}}
1042 # -- No differences should exist before a pull.
1044 if {[array size file_states] != 0} {
1045 error_popup {Uncommitted but modified files are present.
1047 You should not perform a pull with unmodified files in your working
1048 directory as Git would be unable to recover from an incorrect merge.
1050 Commit or throw away all changes before starting a pull operation.
1056 set w [new_console "pull $remote $branch" \
1057 "Pulling new changes from branch $branch in $remote"]
1058 set cmd [list git pull]
1059 if {$repo_config(gui.pullsummary) eq {false}} {
1060 lappend cmd --no-summary
1064 console_exec $w $cmd [list post_pull_remote $remote $branch]
1067 proc post_pull_remote {remote branch success} {
1068 global HEAD PARENT commit_type
1069 global ui_status_value
1073 repository_state HEAD commit_type
1075 set $ui_status_value "Pulling $branch from $remote complete."
1077 set m "Conflicts detected while pulling $branch from $remote."
1078 rescan "set ui_status_value {$m}"
1082 proc push_to {remote} {
1083 set w [new_console "push $remote" \
1084 "Pushing changes to $remote"]
1085 set cmd [list git push]
1087 console_exec $w $cmd
1090 ######################################################################
1094 proc mapcol {state path} {
1095 global all_cols ui_other
1097 if {[catch {set r $all_cols($state)}]} {
1098 puts "error: no column for state={$state} $path"
1104 proc mapicon {state path} {
1107 if {[catch {set r $all_icons($state)}]} {
1108 puts "error: no icon for state={$state} $path"
1114 proc mapdesc {state path} {
1117 if {[catch {set r $all_descs($state)}]} {
1118 puts "error: no desc for state={$state} $path"
1124 proc escape_path {path} {
1125 regsub -all "\n" $path "\\n" path
1129 proc short_path {path} {
1130 return [escape_path [lindex [file split $path] end]]
1135 proc merge_state {path new_state} {
1136 global file_states next_icon_id
1138 set s0 [string index $new_state 0]
1139 set s1 [string index $new_state 1]
1141 if {[catch {set info $file_states($path)}]} {
1143 set icon n[incr next_icon_id]
1145 set state [lindex $info 0]
1146 set icon [lindex $info 1]
1150 set s0 [string index $state 0]
1151 } elseif {$s0 eq {_}} {
1156 set s1 [string index $state 1]
1157 } elseif {$s1 eq {_}} {
1161 set file_states($path) [list $s0$s1 $icon]
1165 proc display_file {path state} {
1166 global file_states file_lists selected_paths rescan_active
1168 set old_m [merge_state $path $state]
1169 if {$rescan_active > 0} return
1171 set s $file_states($path)
1172 set new_m [lindex $s 0]
1173 set new_w [mapcol $new_m $path]
1174 set old_w [mapcol $old_m $path]
1175 set new_icon [mapicon $new_m $path]
1177 if {$new_w ne $old_w} {
1178 set lno [lsearch -sorted $file_lists($old_w) $path]
1181 $old_w conf -state normal
1182 $old_w delete $lno.0 [expr {$lno + 1}].0
1183 $old_w conf -state disabled
1186 lappend file_lists($new_w) $path
1187 set file_lists($new_w) [lsort $file_lists($new_w)]
1188 set lno [lsearch -sorted $file_lists($new_w) $path]
1190 $new_w conf -state normal
1191 $new_w image create $lno.0 \
1192 -align center -padx 5 -pady 1 \
1193 -name [lindex $s 1] \
1195 $new_w insert $lno.1 "[escape_path $path]\n"
1196 if {[catch {set in_sel $selected_paths($path)}]} {
1200 $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1202 $new_w conf -state disabled
1203 } elseif {$new_icon ne [mapicon $old_m $path]} {
1204 $new_w conf -state normal
1205 $new_w image conf [lindex $s 1] -image $new_icon
1206 $new_w conf -state disabled
1210 proc display_all_files {} {
1211 global ui_index ui_other
1212 global file_states file_lists
1213 global last_clicked selected_paths
1215 $ui_index conf -state normal
1216 $ui_other conf -state normal
1218 $ui_index delete 0.0 end
1219 $ui_other delete 0.0 end
1222 set file_lists($ui_index) [list]
1223 set file_lists($ui_other) [list]
1225 foreach path [lsort [array names file_states]] {
1226 set s $file_states($path)
1228 set w [mapcol $m $path]
1229 lappend file_lists($w) $path
1230 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1231 $w image create end \
1232 -align center -padx 5 -pady 1 \
1233 -name [lindex $s 1] \
1234 -image [mapicon $m $path]
1235 $w insert end "[escape_path $path]\n"
1236 if {[catch {set in_sel $selected_paths($path)}]} {
1240 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1244 $ui_index conf -state disabled
1245 $ui_other conf -state disabled
1248 proc update_index {msg pathList after} {
1249 global update_index_cp ui_status_value
1251 if {![lock_index update]} return
1253 set update_index_cp 0
1254 set pathList [lsort $pathList]
1255 set totalCnt [llength $pathList]
1256 set batch [expr {int($totalCnt * .01) + 1}]
1257 if {$batch > 25} {set batch 25}
1259 set ui_status_value [format \
1260 "$msg... %i/%i files (%.2f%%)" \
1264 set fd [open "| git update-index --add --remove -z --stdin" w]
1270 fileevent $fd writable [list \
1271 write_update_index \
1281 proc write_update_index {fd pathList totalCnt batch msg after} {
1282 global update_index_cp ui_status_value
1283 global file_states current_diff
1285 if {$update_index_cp >= $totalCnt} {
1292 for {set i $batch} \
1293 {$update_index_cp < $totalCnt && $i > 0} \
1295 set path [lindex $pathList $update_index_cp]
1296 incr update_index_cp
1298 switch -glob -- [lindex $file_states($path) 0] {
1314 puts -nonewline $fd $path
1315 puts -nonewline $fd "\0"
1316 display_file $path $new
1319 set ui_status_value [format \
1320 "$msg... %i/%i files (%.2f%%)" \
1323 [expr {100.0 * $update_index_cp / $totalCnt}]]
1326 ######################################################################
1328 ## remote management
1330 proc load_all_remotes {} {
1331 global gitdir all_remotes repo_config
1333 set all_remotes [list]
1334 set rm_dir [file join $gitdir remotes]
1335 if {[file isdirectory $rm_dir]} {
1336 set all_remotes [concat $all_remotes [glob \
1340 -directory $rm_dir *]]
1343 foreach line [array names repo_config remote.*.url] {
1344 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1345 lappend all_remotes $name
1349 set all_remotes [lsort -unique $all_remotes]
1352 proc populate_fetch_menu {m} {
1353 global gitdir all_remotes repo_config
1355 foreach r $all_remotes {
1357 if {![catch {set a $repo_config(remote.$r.url)}]} {
1358 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1363 set fd [open [file join $gitdir remotes $r] r]
1364 while {[gets $fd n] >= 0} {
1365 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1376 -label "Fetch from $r..." \
1377 -command [list fetch_from $r] \
1383 proc populate_push_menu {m} {
1384 global gitdir all_remotes repo_config
1386 foreach r $all_remotes {
1388 if {![catch {set a $repo_config(remote.$r.url)}]} {
1389 if {![catch {set a $repo_config(remote.$r.push)}]} {
1394 set fd [open [file join $gitdir remotes $r] r]
1395 while {[gets $fd n] >= 0} {
1396 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1407 -label "Push to $r..." \
1408 -command [list push_to $r] \
1414 proc populate_pull_menu {m} {
1415 global gitdir repo_config all_remotes disable_on_lock
1417 foreach remote $all_remotes {
1419 if {[array get repo_config remote.$remote.url] ne {}} {
1420 if {[array get repo_config remote.$remote.fetch] ne {}} {
1421 regexp {^([^:]+):} \
1422 [lindex $repo_config(remote.$remote.fetch) 0] \
1427 set fd [open [file join $gitdir remotes $remote] r]
1428 while {[gets $fd line] >= 0} {
1429 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1438 regsub ^refs/heads/ $rb {} rb_short
1439 if {$rb_short ne {}} {
1441 -label "Branch $rb_short from $remote..." \
1442 -command [list pull_remote $remote $rb] \
1444 lappend disable_on_lock \
1445 [list $m entryconf [$m index last] -state]
1450 ######################################################################
1455 #define mask_width 14
1456 #define mask_height 15
1457 static unsigned char mask_bits[] = {
1458 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1459 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1460 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1463 image create bitmap file_plain -background white -foreground black -data {
1464 #define plain_width 14
1465 #define plain_height 15
1466 static unsigned char plain_bits[] = {
1467 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1468 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1469 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1470 } -maskdata $filemask
1472 image create bitmap file_mod -background white -foreground blue -data {
1473 #define mod_width 14
1474 #define mod_height 15
1475 static unsigned char mod_bits[] = {
1476 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1477 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1478 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1479 } -maskdata $filemask
1481 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1482 #define file_fulltick_width 14
1483 #define file_fulltick_height 15
1484 static unsigned char file_fulltick_bits[] = {
1485 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1486 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1487 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1488 } -maskdata $filemask
1490 image create bitmap file_parttick -background white -foreground "#005050" -data {
1491 #define parttick_width 14
1492 #define parttick_height 15
1493 static unsigned char parttick_bits[] = {
1494 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1495 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1496 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1497 } -maskdata $filemask
1499 image create bitmap file_question -background white -foreground black -data {
1500 #define file_question_width 14
1501 #define file_question_height 15
1502 static unsigned char file_question_bits[] = {
1503 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1504 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1505 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1506 } -maskdata $filemask
1508 image create bitmap file_removed -background white -foreground red -data {
1509 #define file_removed_width 14
1510 #define file_removed_height 15
1511 static unsigned char file_removed_bits[] = {
1512 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1513 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1514 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1515 } -maskdata $filemask
1517 image create bitmap file_merge -background white -foreground blue -data {
1518 #define file_merge_width 14
1519 #define file_merge_height 15
1520 static unsigned char file_merge_bits[] = {
1521 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1522 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1523 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1524 } -maskdata $filemask
1526 set ui_index .vpane.files.index.list
1527 set ui_other .vpane.files.other.list
1528 set max_status_desc 0
1530 {__ i plain "Unmodified"}
1531 {_M i mod "Modified"}
1532 {M_ i fulltick "Included in commit"}
1533 {MM i parttick "Partially included"}
1535 {_O o plain "Untracked"}
1536 {A_ o fulltick "Added by commit"}
1537 {AM o parttick "Partially added"}
1538 {AD o question "Added (but now gone)"}
1540 {_D i question "Missing"}
1541 {D_ i removed "Removed by commit"}
1542 {DD i removed "Removed by commit"}
1543 {DO i removed "Removed (still exists)"}
1545 {UM i merge "Merge conflicts"}
1546 {U_ i merge "Merge conflicts"}
1548 if {$max_status_desc < [string length [lindex $i 3]]} {
1549 set max_status_desc [string length [lindex $i 3]]
1551 if {[lindex $i 1] eq {i}} {
1552 set all_cols([lindex $i 0]) $ui_index
1554 set all_cols([lindex $i 0]) $ui_other
1556 set all_icons([lindex $i 0]) file_[lindex $i 2]
1557 set all_descs([lindex $i 0]) [lindex $i 3]
1561 ######################################################################
1566 global tcl_platform tk_library
1567 if {$tcl_platform(platform) eq {unix}
1568 && $tcl_platform(os) eq {Darwin}
1569 && [string match /Library/Frameworks/* $tk_library]} {
1575 proc bind_button3 {w cmd} {
1576 bind $w <Any-Button-3> $cmd
1578 bind $w <Control-Button-1> $cmd
1582 proc incr_font_size {font {amt 1}} {
1583 set sz [font configure $font -size]
1585 font configure $font -size $sz
1586 font configure ${font}bold -size $sz
1589 proc hook_failed_popup {hook msg} {
1590 global gitdir appname
1596 label $w.m.l1 -text "$hook hook failed:" \
1601 -background white -borderwidth 1 \
1603 -width 80 -height 10 \
1605 -yscrollcommand [list $w.m.sby set]
1607 -text {You must correct the above errors before committing.} \
1611 scrollbar $w.m.sby -command [list $w.m.t yview]
1612 pack $w.m.l1 -side top -fill x
1613 pack $w.m.l2 -side bottom -fill x
1614 pack $w.m.sby -side right -fill y
1615 pack $w.m.t -side left -fill both -expand 1
1616 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1618 $w.m.t insert 1.0 $msg
1619 $w.m.t conf -state disabled
1621 button $w.ok -text OK \
1624 -command "destroy $w"
1625 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1627 bind $w <Visibility> "grab $w; focus $w"
1628 bind $w <Key-Return> "destroy $w"
1629 wm title $w "$appname ([lindex [file split \
1630 [file normalize [file dirname $gitdir]]] \
1635 set next_console_id 0
1637 proc new_console {short_title long_title} {
1638 global next_console_id console_data
1639 set w .console[incr next_console_id]
1640 set console_data($w) [list $short_title $long_title]
1641 return [console_init $w]
1644 proc console_init {w} {
1645 global console_cr console_data
1646 global gitdir appname M1B
1648 set console_cr($w) 1.0
1651 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1656 -background white -borderwidth 1 \
1658 -width 80 -height 10 \
1661 -yscrollcommand [list $w.m.sby set]
1662 label $w.m.s -text {Working... please wait...} \
1666 scrollbar $w.m.sby -command [list $w.m.t yview]
1667 pack $w.m.l1 -side top -fill x
1668 pack $w.m.s -side bottom -fill x
1669 pack $w.m.sby -side right -fill y
1670 pack $w.m.t -side left -fill both -expand 1
1671 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1673 menu $w.ctxm -tearoff 0
1674 $w.ctxm add command -label "Copy" \
1676 -command "tk_textCopy $w.m.t"
1677 $w.ctxm add command -label "Select All" \
1679 -command "$w.m.t tag add sel 0.0 end"
1680 $w.ctxm add command -label "Copy All" \
1683 $w.m.t tag add sel 0.0 end
1685 $w.m.t tag remove sel 0.0 end
1688 button $w.ok -text {Close} \
1691 -command "destroy $w"
1692 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1694 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1695 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1696 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1697 bind $w <Visibility> "focus $w"
1698 wm title $w "$appname ([lindex [file split \
1699 [file normalize [file dirname $gitdir]]] \
1700 end]): [lindex $console_data($w) 0]"
1704 proc console_exec {w cmd {after {}}} {
1707 # -- Windows tosses the enviroment when we exec our child.
1708 # But most users need that so we have to relogin. :-(
1710 if {$tcl_platform(platform) eq {windows}} {
1711 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1714 # -- Tcl won't let us redirect both stdout and stderr to
1715 # the same pipe. So pass it through cat...
1717 set cmd [concat | $cmd |& cat]
1719 set fd_f [open $cmd r]
1720 fconfigure $fd_f -blocking 0 -translation binary
1721 fileevent $fd_f readable [list console_read $w $fd_f $after]
1724 proc console_read {w fd after} {
1725 global console_cr console_data
1729 if {![winfo exists $w]} {console_init $w}
1730 $w.m.t conf -state normal
1732 set n [string length $buf]
1734 set cr [string first "\r" $buf $c]
1735 set lf [string first "\n" $buf $c]
1736 if {$cr < 0} {set cr [expr {$n + 1}]}
1737 if {$lf < 0} {set lf [expr {$n + 1}]}
1740 $w.m.t insert end [string range $buf $c $lf]
1741 set console_cr($w) [$w.m.t index {end -1c}]
1745 $w.m.t delete $console_cr($w) end
1746 $w.m.t insert end "\n"
1747 $w.m.t insert end [string range $buf $c $cr]
1752 $w.m.t conf -state disabled
1756 fconfigure $fd -blocking 1
1758 if {[catch {close $fd}]} {
1759 if {![winfo exists $w]} {console_init $w}
1760 $w.m.s conf -background red -text {Error: Command Failed}
1761 $w.ok conf -state normal
1763 } elseif {[winfo exists $w]} {
1764 $w.m.s conf -background green -text {Success}
1765 $w.ok conf -state normal
1768 array unset console_cr $w
1769 array unset console_data $w
1771 uplevel #0 $after $ok
1775 fconfigure $fd -blocking 0
1778 ######################################################################
1782 set starting_gitk_msg {Please wait... Starting gitk...}
1785 global tcl_platform ui_status_value starting_gitk_msg
1787 set ui_status_value $starting_gitk_msg
1789 if {$ui_status_value eq $starting_gitk_msg} {
1790 set ui_status_value {Ready.}
1794 if {$tcl_platform(platform) eq {windows}} {
1802 set w [new_console "repack" "Repacking the object database"]
1803 set cmd [list git repack]
1806 console_exec $w $cmd
1812 global gitdir ui_comm is_quitting repo_config
1814 if {$is_quitting} return
1817 # -- Stash our current commit buffer.
1819 set save [file join $gitdir GITGUI_MSG]
1820 set msg [string trim [$ui_comm get 0.0 end]]
1821 if {[$ui_comm edit modified] && $msg ne {}} {
1823 set fd [open $save w]
1824 puts $fd [string trim [$ui_comm get 0.0 end]]
1827 } elseif {$msg eq {} && [file exists $save]} {
1831 # -- Stash our current window geometry into this repository.
1833 set cfg_geometry [list]
1834 lappend cfg_geometry [wm geometry .]
1835 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1836 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1837 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1840 if {$cfg_geometry ne $rc_geometry} {
1841 catch {exec git repo-config gui.geometry $cfg_geometry}
1848 rescan {set ui_status_value {Ready.}}
1851 proc include_helper {txt paths} {
1852 global file_states current_diff
1854 if {![lock_index begin-update]} return
1858 foreach path $paths {
1859 switch -- [lindex $file_states($path) 0] {
1864 lappend pathList $path
1865 if {$path eq $current_diff} {
1866 set after {reshow_diff;}
1871 if {$pathList eq {}} {
1877 [concat $after {set ui_status_value {Ready to commit.}}]
1881 proc do_include_selection {} {
1882 global current_diff selected_paths
1884 if {[array size selected_paths] > 0} {
1886 {Including selected files} \
1887 [array names selected_paths]
1888 } elseif {$current_diff ne {}} {
1890 "Including [short_path $current_diff]" \
1891 [list $current_diff]
1895 proc do_include_all {} {
1898 {Including all modified files} \
1899 [array names file_states]
1902 set GIT_COMMITTER_IDENT {}
1904 proc do_signoff {} {
1905 global ui_comm GIT_COMMITTER_IDENT
1907 if {$GIT_COMMITTER_IDENT eq {}} {
1908 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1909 error_popup "Unable to obtain your identity:\n\n$err"
1912 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1913 $me me GIT_COMMITTER_IDENT]} {
1914 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1919 set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1920 set last [$ui_comm get {end -1c linestart} {end -1c}]
1921 if {$last ne $sob} {
1922 $ui_comm edit separator
1924 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1925 $ui_comm insert end "\n"
1927 $ui_comm insert end "\n$sob"
1928 $ui_comm edit separator
1933 proc do_amend_last {} {
1941 proc do_options {} {
1942 global appname gitdir font_descs
1943 global repo_config global_config
1944 global repo_config_new global_config_new
1946 array unset repo_config_new
1947 array unset global_config_new
1948 foreach name [array names repo_config] {
1949 set repo_config_new($name) $repo_config($name)
1952 foreach name [array names repo_config] {
1954 gui.diffcontext {continue}
1956 set repo_config_new($name) $repo_config($name)
1958 foreach name [array names global_config] {
1959 set global_config_new($name) $global_config($name)
1961 set reponame [lindex [file split \
1962 [file normalize [file dirname $gitdir]]] \
1965 set w .options_editor
1967 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1969 label $w.header -text "$appname Options" \
1971 pack $w.header -side top -fill x
1974 button $w.buttons.restore -text {Restore Defaults} \
1976 -command do_restore_defaults
1977 pack $w.buttons.restore -side left
1978 button $w.buttons.save -text Save \
1980 -command [list do_save_config $w]
1981 pack $w.buttons.save -side right
1982 button $w.buttons.cancel -text {Cancel} \
1984 -command [list destroy $w]
1985 pack $w.buttons.cancel -side right
1986 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1988 labelframe $w.repo -text "$reponame Repository" \
1990 -relief raised -borderwidth 2
1991 labelframe $w.global -text {Global (All Repositories)} \
1993 -relief raised -borderwidth 2
1994 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1995 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1998 {b partialinclude {Allow Partially Included Files}}
1999 {b pullsummary {Show Pull Summary}}
2000 {b trustmtime {Trust File Modification Timestamps}}
2001 {i diffcontext {Number of Diff Context Lines}}
2003 set type [lindex $option 0]
2004 set name [lindex $option 1]
2005 set text [lindex $option 2]
2006 foreach f {repo global} {
2009 checkbutton $w.$f.$name -text $text \
2010 -variable ${f}_config_new(gui.$name) \
2014 pack $w.$f.$name -side top -anchor w
2018 label $w.$f.$name.l -text "$text:" -font font_ui
2019 pack $w.$f.$name.l -side left -anchor w -fill x
2020 spinbox $w.$f.$name.v \
2021 -textvariable ${f}_config_new(gui.$name) \
2022 -from 1 -to 99 -increment 1 \
2025 pack $w.$f.$name.v -side right -anchor e
2026 pack $w.$f.$name -side top -anchor w -fill x
2032 set all_fonts [lsort [font families]]
2033 foreach option $font_descs {
2034 set name [lindex $option 0]
2035 set font [lindex $option 1]
2036 set text [lindex $option 2]
2038 set global_config_new(gui.$font^^family) \
2039 [font configure $font -family]
2040 set global_config_new(gui.$font^^size) \
2041 [font configure $font -size]
2043 frame $w.global.$name
2044 label $w.global.$name.l -text "$text:" -font font_ui
2045 pack $w.global.$name.l -side left -anchor w -fill x
2046 eval tk_optionMenu $w.global.$name.family \
2047 global_config_new(gui.$font^^family) \
2049 spinbox $w.global.$name.size \
2050 -textvariable global_config_new(gui.$font^^size) \
2051 -from 2 -to 80 -increment 1 \
2054 pack $w.global.$name.size -side right -anchor e
2055 pack $w.global.$name.family -side right -anchor e
2056 pack $w.global.$name -side top -anchor w -fill x
2059 bind $w <Visibility> "grab $w; focus $w"
2060 bind $w <Key-Escape> "destroy $w"
2061 wm title $w "$appname ($reponame): Options"
2065 proc do_restore_defaults {} {
2066 global font_descs default_config repo_config
2067 global repo_config_new global_config_new
2069 foreach name [array names default_config] {
2070 set repo_config_new($name) $default_config($name)
2071 set global_config_new($name) $default_config($name)
2074 foreach option $font_descs {
2075 set name [lindex $option 0]
2076 set repo_config(gui.$name) $default_config(gui.$name)
2080 foreach option $font_descs {
2081 set name [lindex $option 0]
2082 set font [lindex $option 1]
2083 set global_config_new(gui.$font^^family) \
2084 [font configure $font -family]
2085 set global_config_new(gui.$font^^size) \
2086 [font configure $font -size]
2090 proc do_save_config {w} {
2091 if {[catch {save_config} err]} {
2092 error_popup "Failed to completely save options:\n\n$err"
2098 proc do_windows_shortcut {} {
2099 global gitdir appname argv0
2101 set reponame [lindex [file split \
2102 [file normalize [file dirname $gitdir]]] \
2106 set desktop [exec cygpath \
2114 set fn [tk_getSaveFile \
2116 -title "$appname ($reponame): Create Desktop Icon" \
2117 -initialdir $desktop \
2118 -initialfile "Git $reponame.bat"]
2122 set sh [exec cygpath \
2127 set me [exec cygpath \
2131 set gd [exec cygpath \
2135 regsub -all ' $me "'\\''" me
2136 regsub -all ' $gd "'\\''" gd
2137 puts -nonewline $fd "\"$sh\" --login -c \""
2138 puts -nonewline $fd "GIT_DIR='$gd'"
2139 puts -nonewline $fd " '$me'"
2143 error_popup "Cannot write script:\n\n$err"
2148 proc do_macosx_app {} {
2149 global gitdir appname argv0 env
2151 set reponame [lindex [file split \
2152 [file normalize [file dirname $gitdir]]] \
2155 set fn [tk_getSaveFile \
2157 -title "$appname ($reponame): Create Desktop Icon" \
2158 -initialdir [file join $env(HOME) Desktop] \
2159 -initialfile "Git $reponame.app"]
2162 set Contents [file join $fn Contents]
2163 set MacOS [file join $Contents MacOS]
2164 set exe [file join $MacOS git-gui]
2168 set fd [open [file join $Contents PkgInfo] w]
2169 puts -nonewline $fd {APPL????}
2172 set fd [open [file join $Contents Info.plist] w]
2173 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2174 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2175 <plist version="1.0">
2177 <key>CFBundleDevelopmentRegion</key>
2178 <string>English</string>
2179 <key>CFBundleExecutable</key>
2180 <string>git-gui</string>
2181 <key>CFBundleIdentifier</key>
2182 <string>org.spearce.git-gui</string>
2183 <key>CFBundleInfoDictionaryVersion</key>
2184 <string>6.0</string>
2185 <key>CFBundlePackageType</key>
2186 <string>APPL</string>
2187 <key>CFBundleSignature</key>
2188 <string>????</string>
2189 <key>CFBundleVersion</key>
2190 <string>1.0</string>
2191 <key>NSPrincipalClass</key>
2192 <string>NSApplication</string>
2197 set fd [open $exe w]
2198 set gd [file normalize $gitdir]
2199 set ep [file normalize [exec git --exec-path]]
2200 regsub -all ' $gd "'\\''" gd
2201 regsub -all ' $ep "'\\''" ep
2202 puts $fd "#!/bin/sh"
2203 foreach name [array names env] {
2204 if {[string match GIT_* $name]} {
2205 regsub -all ' $env($name) "'\\''" v
2206 puts $fd "export $name='$v'"
2209 puts $fd "export PATH='$ep':\$PATH"
2210 puts $fd "export GIT_DIR='$gd'"
2211 puts $fd "exec [file normalize $argv0]"
2214 file attributes $exe -permissions u+x,g+x,o+x
2216 error_popup "Cannot write icon:\n\n$err"
2221 proc toggle_or_diff {w x y} {
2222 global file_lists current_diff ui_index ui_other
2223 global last_clicked selected_paths
2225 set pos [split [$w index @$x,$y] .]
2226 set lno [lindex $pos 0]
2227 set col [lindex $pos 1]
2228 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2234 set last_clicked [list $w $lno]
2235 array unset selected_paths
2236 $ui_index tag remove in_sel 0.0 end
2237 $ui_other tag remove in_sel 0.0 end
2240 if {$current_diff eq $path} {
2241 set after {reshow_diff;}
2246 "Including [short_path $path]" \
2248 [concat $after {set ui_status_value {Ready.}}]
2250 show_diff $path $w $lno
2254 proc add_one_to_selection {w x y} {
2256 global last_clicked selected_paths
2258 set pos [split [$w index @$x,$y] .]
2259 set lno [lindex $pos 0]
2260 set col [lindex $pos 1]
2261 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2267 set last_clicked [list $w $lno]
2268 if {[catch {set in_sel $selected_paths($path)}]} {
2272 unset selected_paths($path)
2273 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2275 set selected_paths($path) 1
2276 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2280 proc add_range_to_selection {w x y} {
2282 global last_clicked selected_paths
2284 if {[lindex $last_clicked 0] ne $w} {
2285 toggle_or_diff $w $x $y
2289 set pos [split [$w index @$x,$y] .]
2290 set lno [lindex $pos 0]
2291 set lc [lindex $last_clicked 1]
2300 foreach path [lrange $file_lists($w) \
2301 [expr {$begin - 1}] \
2302 [expr {$end - 1}]] {
2303 set selected_paths($path) 1
2305 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2308 ######################################################################
2312 set cursor_ptr arrow
2313 font create font_diff -family Courier -size 10
2317 eval font configure font_ui [font actual [.dummy cget -font]]
2321 font create font_uibold
2322 font create font_diffbold
2326 if {$tcl_platform(platform) eq {windows}} {
2329 } elseif {[is_MacOSX]} {
2334 proc apply_config {} {
2335 global repo_config font_descs
2337 foreach option $font_descs {
2338 set name [lindex $option 0]
2339 set font [lindex $option 1]
2341 foreach {cn cv} $repo_config(gui.$name) {
2342 font configure $font $cn $cv
2345 error_popup "Invalid font specified in gui.$name:\n\n$err"
2347 foreach {cn cv} [font configure $font] {
2348 font configure ${font}bold $cn $cv
2350 font configure ${font}bold -weight bold
2354 set default_config(gui.trustmtime) false
2355 set default_config(gui.pullsummary) true
2356 set default_config(gui.partialinclude) false
2357 set default_config(gui.diffcontext) 5
2358 set default_config(gui.fontui) [font configure font_ui]
2359 set default_config(gui.fontdiff) [font configure font_diff]
2361 {fontui font_ui {Main Font}}
2362 {fontdiff font_diff {Diff/Console Font}}
2367 ######################################################################
2373 menu .mbar -tearoff 0
2374 .mbar add cascade -label Project -menu .mbar.project
2375 .mbar add cascade -label Edit -menu .mbar.edit
2376 .mbar add cascade -label Commit -menu .mbar.commit
2377 if {!$single_commit} {
2378 .mbar add cascade -label Fetch -menu .mbar.fetch
2379 .mbar add cascade -label Pull -menu .mbar.pull
2380 .mbar add cascade -label Push -menu .mbar.push
2382 . configure -menu .mbar
2387 .mbar.project add command -label Visualize \
2390 if {!$single_commit} {
2391 .mbar.project add command -label {Repack Database} \
2392 -command do_repack \
2395 if {$tcl_platform(platform) eq {windows}} {
2396 .mbar.project add command \
2397 -label {Create Desktop Icon} \
2398 -command do_windows_shortcut \
2400 } elseif {[is_MacOSX]} {
2401 .mbar.project add command \
2402 -label {Create Desktop Icon} \
2403 -command do_macosx_app \
2407 .mbar.project add command -label Quit \
2409 -accelerator $M1T-Q \
2415 .mbar.edit add command -label Undo \
2416 -command {catch {[focus] edit undo}} \
2417 -accelerator $M1T-Z \
2419 .mbar.edit add command -label Redo \
2420 -command {catch {[focus] edit redo}} \
2421 -accelerator $M1T-Y \
2423 .mbar.edit add separator
2424 .mbar.edit add command -label Cut \
2425 -command {catch {tk_textCut [focus]}} \
2426 -accelerator $M1T-X \
2428 .mbar.edit add command -label Copy \
2429 -command {catch {tk_textCopy [focus]}} \
2430 -accelerator $M1T-C \
2432 .mbar.edit add command -label Paste \
2433 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2434 -accelerator $M1T-V \
2436 .mbar.edit add command -label Delete \
2437 -command {catch {[focus] delete sel.first sel.last}} \
2440 .mbar.edit add separator
2441 .mbar.edit add command -label {Select All} \
2442 -command {catch {[focus] tag add sel 0.0 end}} \
2443 -accelerator $M1T-A \
2445 .mbar.edit add separator
2446 .mbar.edit add command -label {Options...} \
2447 -command do_options \
2453 .mbar.commit add command -label Rescan \
2454 -command do_rescan \
2457 lappend disable_on_lock \
2458 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2459 .mbar.commit add command -label {Amend Last Commit} \
2460 -command do_amend_last \
2462 lappend disable_on_lock \
2463 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2464 .mbar.commit add command -label {Include Selected Files} \
2465 -command do_include_selection \
2467 lappend disable_on_lock \
2468 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2469 .mbar.commit add command -label {Include All Files} \
2470 -command do_include_all \
2471 -accelerator $M1T-I \
2473 lappend disable_on_lock \
2474 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2475 .mbar.commit add command -label {Sign Off} \
2476 -command do_signoff \
2477 -accelerator $M1T-S \
2479 .mbar.commit add command -label Commit \
2480 -command do_commit \
2481 -accelerator $M1T-Return \
2483 lappend disable_on_lock \
2484 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2486 # -- Transport menus
2488 if {!$single_commit} {
2494 # -- Main Window Layout
2496 panedwindow .vpane -orient vertical
2497 panedwindow .vpane.files -orient horizontal
2498 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2499 pack .vpane -anchor n -side top -fill both -expand 1
2501 # -- Index File List
2503 frame .vpane.files.index -height 100 -width 400
2504 label .vpane.files.index.title -text {Modified Files} \
2507 text $ui_index -background white -borderwidth 0 \
2508 -width 40 -height 10 \
2510 -cursor $cursor_ptr \
2511 -yscrollcommand {.vpane.files.index.sb set} \
2513 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2514 pack .vpane.files.index.title -side top -fill x
2515 pack .vpane.files.index.sb -side right -fill y
2516 pack $ui_index -side left -fill both -expand 1
2517 .vpane.files add .vpane.files.index -sticky nsew
2519 # -- Other (Add) File List
2521 frame .vpane.files.other -height 100 -width 100
2522 label .vpane.files.other.title -text {Untracked Files} \
2525 text $ui_other -background white -borderwidth 0 \
2526 -width 40 -height 10 \
2528 -cursor $cursor_ptr \
2529 -yscrollcommand {.vpane.files.other.sb set} \
2531 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2532 pack .vpane.files.other.title -side top -fill x
2533 pack .vpane.files.other.sb -side right -fill y
2534 pack $ui_other -side left -fill both -expand 1
2535 .vpane.files add .vpane.files.other -sticky nsew
2537 foreach i [list $ui_index $ui_other] {
2538 $i tag conf in_diff -font font_uibold
2539 $i tag conf in_sel \
2540 -background [$i cget -foreground] \
2541 -foreground [$i cget -background]
2545 # -- Diff and Commit Area
2547 frame .vpane.lower -height 300 -width 400
2548 frame .vpane.lower.commarea
2549 frame .vpane.lower.diff -relief sunken -borderwidth 1
2550 pack .vpane.lower.commarea -side top -fill x
2551 pack .vpane.lower.diff -side bottom -fill both -expand 1
2552 .vpane add .vpane.lower -stick nsew
2554 # -- Commit Area Buttons
2556 frame .vpane.lower.commarea.buttons
2557 label .vpane.lower.commarea.buttons.l -text {} \
2561 pack .vpane.lower.commarea.buttons.l -side top -fill x
2562 pack .vpane.lower.commarea.buttons -side left -fill y
2564 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2565 -command do_rescan \
2567 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2568 lappend disable_on_lock \
2569 {.vpane.lower.commarea.buttons.rescan conf -state}
2571 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2572 -command do_amend_last \
2574 pack .vpane.lower.commarea.buttons.amend -side top -fill x
2575 lappend disable_on_lock \
2576 {.vpane.lower.commarea.buttons.amend conf -state}
2578 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2579 -command do_include_all \
2581 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2582 lappend disable_on_lock \
2583 {.vpane.lower.commarea.buttons.incall conf -state}
2585 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2586 -command do_signoff \
2588 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2590 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2591 -command do_commit \
2593 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2594 lappend disable_on_lock \
2595 {.vpane.lower.commarea.buttons.commit conf -state}
2597 # -- Commit Message Buffer
2599 frame .vpane.lower.commarea.buffer
2600 set ui_comm .vpane.lower.commarea.buffer.t
2601 set ui_coml .vpane.lower.commarea.buffer.l
2606 proc trace_commit_type {varname args} {
2607 global ui_coml commit_type
2608 switch -glob -- $commit_type {
2609 initial {set txt {Initial Commit Message:}}
2610 amend {set txt {Amended Commit Message:}}
2611 amend-initial {set txt {Amended Initial Commit Message:}}
2612 merge {set txt {Merge Commit Message:}}
2613 * {set txt {Commit Message:}}
2615 $ui_coml conf -text $txt
2617 trace add variable commit_type write trace_commit_type
2618 text $ui_comm -background white -borderwidth 1 \
2621 -autoseparators true \
2623 -width 75 -height 9 -wrap none \
2625 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2626 scrollbar .vpane.lower.commarea.buffer.sby \
2627 -command [list $ui_comm yview]
2628 pack $ui_coml -side top -fill x
2629 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2630 pack $ui_comm -side left -fill y
2631 pack .vpane.lower.commarea.buffer -side left -fill y
2633 # -- Commit Message Buffer Context Menu
2635 set ctxm .vpane.lower.commarea.buffer.ctxm
2636 menu $ctxm -tearoff 0
2640 -command {tk_textCut $ui_comm}
2644 -command {tk_textCopy $ui_comm}
2648 -command {tk_textPaste $ui_comm}
2652 -command {$ui_comm delete sel.first sel.last}
2655 -label {Select All} \
2657 -command {$ui_comm tag add sel 0.0 end}
2662 $ui_comm tag add sel 0.0 end
2663 tk_textCopy $ui_comm
2664 $ui_comm tag remove sel 0.0 end
2671 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2676 set diff_actions [list]
2677 proc trace_current_diff {varname args} {
2678 global current_diff diff_actions file_states
2679 if {$current_diff eq {}} {
2686 set s [mapdesc [lindex $file_states($p) 0] $p]
2688 set p [escape_path $p]
2692 .vpane.lower.diff.header.status configure -text $s
2693 .vpane.lower.diff.header.file configure -text $f
2694 .vpane.lower.diff.header.path configure -text $p
2695 foreach w $diff_actions {
2699 trace add variable current_diff write trace_current_diff
2701 frame .vpane.lower.diff.header -background orange
2702 label .vpane.lower.diff.header.status \
2703 -background orange \
2704 -width $max_status_desc \
2708 label .vpane.lower.diff.header.file \
2709 -background orange \
2713 label .vpane.lower.diff.header.path \
2714 -background orange \
2718 pack .vpane.lower.diff.header.status -side left
2719 pack .vpane.lower.diff.header.file -side left
2720 pack .vpane.lower.diff.header.path -fill x
2721 set ctxm .vpane.lower.diff.header.ctxm
2722 menu $ctxm -tearoff 0
2733 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2734 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2738 frame .vpane.lower.diff.body
2739 set ui_diff .vpane.lower.diff.body.t
2740 text $ui_diff -background white -borderwidth 0 \
2741 -width 80 -height 15 -wrap none \
2743 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2744 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2746 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2747 -command [list $ui_diff xview]
2748 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2749 -command [list $ui_diff yview]
2750 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2751 pack .vpane.lower.diff.body.sby -side right -fill y
2752 pack $ui_diff -side left -fill both -expand 1
2753 pack .vpane.lower.diff.header -side top -fill x
2754 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2756 $ui_diff tag conf dm -foreground red
2757 $ui_diff tag conf dp -foreground blue
2758 $ui_diff tag conf di -foreground {#00a000}
2759 $ui_diff tag conf dni -foreground {#a000a0}
2760 $ui_diff tag conf da -font font_diffbold
2761 $ui_diff tag conf bold -font font_diffbold
2763 # -- Diff Body Context Menu
2765 set ctxm .vpane.lower.diff.body.ctxm
2766 menu $ctxm -tearoff 0
2770 -command {tk_textCopy $ui_diff}
2771 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2773 -label {Select All} \
2775 -command {$ui_diff tag add sel 0.0 end}
2776 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2781 $ui_diff tag add sel 0.0 end
2782 tk_textCopy $ui_diff
2783 $ui_diff tag remove sel 0.0 end
2785 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2788 -label {Decrease Font Size} \
2790 -command {incr_font_size font_diff -1}
2791 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2793 -label {Increase Font Size} \
2795 -command {incr_font_size font_diff 1}
2796 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2799 -label {Show Less Context} \
2801 -command {if {$repo_config(gui.diffcontext) >= 2} {
2802 incr repo_config(gui.diffcontext) -1
2805 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2807 -label {Show More Context} \
2810 incr repo_config(gui.diffcontext)
2813 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2815 $ctxm add command -label {Options...} \
2818 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
2822 set ui_status_value {Initializing...}
2823 label .status -textvariable ui_status_value \
2829 pack .status -anchor w -side bottom -fill x
2834 set gm $repo_config(gui.geometry)
2835 wm geometry . [lindex $gm 0]
2836 .vpane sash place 0 \
2837 [lindex [.vpane sash coord 0] 0] \
2839 .vpane.files sash place 0 \
2841 [lindex [.vpane.files sash coord 0] 1]
2847 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2848 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2849 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2850 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2851 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2852 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2853 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2854 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2855 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2856 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2857 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2859 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2860 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2861 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2862 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2863 bind $ui_diff <$M1B-Key-v> {break}
2864 bind $ui_diff <$M1B-Key-V> {break}
2865 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2866 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2867 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2868 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2869 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2870 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2872 bind . <Destroy> do_quit
2873 bind all <Key-F5> do_rescan
2874 bind all <$M1B-Key-r> do_rescan
2875 bind all <$M1B-Key-R> do_rescan
2876 bind . <$M1B-Key-s> do_signoff
2877 bind . <$M1B-Key-S> do_signoff
2878 bind . <$M1B-Key-i> do_include_all
2879 bind . <$M1B-Key-I> do_include_all
2880 bind . <$M1B-Key-Return> do_commit
2881 bind all <$M1B-Key-q> do_quit
2882 bind all <$M1B-Key-Q> do_quit
2883 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2884 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2885 foreach i [list $ui_index $ui_other] {
2886 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2887 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2888 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2892 set file_lists($ui_index) [list]
2893 set file_lists($ui_other) [list]
2901 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2902 focus -force $ui_comm
2903 if {!$single_commit} {
2905 populate_fetch_menu .mbar.fetch
2906 populate_pull_menu .mbar.pull
2907 populate_push_menu .mbar.push
2909 lock_index begin-read