git-gui: Refactor options menu into an options dialog.
[git-gui.git] / git-gui
blob520ec1efffe1bb2fe993bcbf141246060683059b
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
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]
11 set gitdir {}
13 ######################################################################
15 ## config
17 set default_config(gui.trustmtime) false
19 proc is_many_config {name} {
20 switch -glob -- $name {
21 remote.*.fetch -
22 remote.*.push
23 {return 1}
25 {return 0}
29 proc load_config {} {
30 global repo_config global_config default_config
32 array unset global_config
33 array unset repo_config
34 catch {
35 set fd_rc [open "| git repo-config --global --list" r]
36 while {[gets $fd_rc line] >= 0} {
37 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
38 if {[is_many_config $name]} {
39 lappend global_config($name) $value
40 } else {
41 set global_config($name) $value
45 close $fd_rc
47 catch {
48 set fd_rc [open "| git repo-config --list" r]
49 while {[gets $fd_rc line] >= 0} {
50 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
51 if {[is_many_config $name]} {
52 lappend repo_config($name) $value
53 } else {
54 set repo_config($name) $value
58 close $fd_rc
61 foreach name [array names default_config] {
62 if {[catch {set v $global_config($name)}]} {
63 set global_config($name) $default_config($name)
65 if {[catch {set v $repo_config($name)}]} {
66 set repo_config($name) $default_config($name)
71 proc save_config {} {
72 global repo_config global_config default_config
73 global repo_config_new global_config_new
75 foreach name [array names global_config_new] {
76 set value $global_config_new($name)
77 if {$value != $global_config($name)} {
78 if {$value == $default_config($name)} {
79 catch {exec git repo-config --global --unset $name}
80 } else {
81 catch {exec git repo-config --global $name $value}
83 set global_config($name) $value
84 if {$value == $repo_config($name)} {
85 catch {exec git repo-config --unset $name}
86 set repo_config($name) $value
91 foreach name [array names repo_config_new] {
92 set value $repo_config_new($name)
93 if {$value != $repo_config($name)} {
94 if {$value == $global_config($name)} {
95 catch {exec git repo-config --unset $name}
96 } else {
97 catch {exec git repo-config $name $value}
99 set repo_config($name) $value
104 proc error_popup {msg} {
105 global gitdir appname
107 set title $appname
108 if {$gitdir != {}} {
109 append title { (}
110 append title [lindex \
111 [file split [file normalize [file dirname $gitdir]]] \
112 end]
113 append title {)}
115 tk_messageBox \
116 -parent . \
117 -icon error \
118 -type ok \
119 -title "$title: error" \
120 -message $msg
123 proc info_popup {msg} {
124 global gitdir appname
126 set title $appname
127 if {$gitdir != {}} {
128 append title { (}
129 append title [lindex \
130 [file split [file normalize [file dirname $gitdir]]] \
131 end]
132 append title {)}
134 tk_messageBox \
135 -parent . \
136 -icon error \
137 -type ok \
138 -title $title \
139 -message $msg
142 ######################################################################
144 ## repository setup
146 if { [catch {set cdup [exec git rev-parse --show-cdup]} err]
147 || [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
148 catch {wm withdraw .}
149 error_popup "Cannot find the git directory:\n\n$err"
150 exit 1
152 if {$cdup != ""} {
153 cd $cdup
155 unset cdup
157 if {$appname == {git-citool}} {
158 set single_commit 1
161 load_config
163 ######################################################################
165 ## task management
167 set single_commit 0
168 set status_active 0
169 set diff_active 0
170 set update_active 0
171 set commit_active 0
172 set update_index_fd {}
174 set disable_on_lock [list]
175 set index_lock_type none
177 set HEAD {}
178 set PARENT {}
179 set commit_type {}
181 proc lock_index {type} {
182 global index_lock_type disable_on_lock
184 if {$index_lock_type == {none}} {
185 set index_lock_type $type
186 foreach w $disable_on_lock {
187 uplevel #0 $w disabled
189 return 1
190 } elseif {$index_lock_type == {begin-update} && $type == {update}} {
191 set index_lock_type $type
192 return 1
194 return 0
197 proc unlock_index {} {
198 global index_lock_type disable_on_lock
200 set index_lock_type none
201 foreach w $disable_on_lock {
202 uplevel #0 $w normal
206 ######################################################################
208 ## status
210 proc repository_state {hdvar ctvar} {
211 global gitdir
212 upvar $hdvar hd $ctvar ct
214 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
215 set ct initial
216 } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
217 set ct merge
218 } else {
219 set ct normal
223 proc update_status {{final Ready.}} {
224 global HEAD PARENT commit_type
225 global ui_index ui_other ui_status_value ui_comm
226 global status_active file_states
227 global repo_config
229 if {$status_active || ![lock_index read]} return
231 repository_state new_HEAD new_type
232 if {$commit_type == {amend}
233 && $new_type == {normal}
234 && $new_HEAD == $HEAD} {
235 } else {
236 set HEAD $new_HEAD
237 set PARENT $new_HEAD
238 set commit_type $new_type
241 array unset file_states
243 if {![$ui_comm edit modified]
244 || [string trim [$ui_comm get 0.0 end]] == {}} {
245 if {[load_message GITGUI_MSG]} {
246 } elseif {[load_message MERGE_MSG]} {
247 } elseif {[load_message SQUASH_MSG]} {
249 $ui_comm edit modified false
250 $ui_comm edit reset
253 if {$repo_config(gui.trustmtime) == {true}} {
254 update_status_stage2 {} $final
255 } else {
256 set status_active 1
257 set ui_status_value {Refreshing file status...}
258 set cmd [list git update-index]
259 lappend cmd -q
260 lappend cmd --unmerged
261 lappend cmd --ignore-missing
262 lappend cmd --refresh
263 set fd_rf [open "| $cmd" r]
264 fconfigure $fd_rf -blocking 0 -translation binary
265 fileevent $fd_rf readable \
266 [list update_status_stage2 $fd_rf $final]
270 proc update_status_stage2 {fd final} {
271 global gitdir PARENT commit_type
272 global ui_index ui_other ui_status_value ui_comm
273 global status_active
274 global buf_rdi buf_rdf buf_rlo
276 if {$fd != {}} {
277 read $fd
278 if {![eof $fd]} return
279 close $fd
282 set ls_others [list | git ls-files --others -z \
283 --exclude-per-directory=.gitignore]
284 set info_exclude [file join $gitdir info exclude]
285 if {[file readable $info_exclude]} {
286 lappend ls_others "--exclude-from=$info_exclude"
289 set buf_rdi {}
290 set buf_rdf {}
291 set buf_rlo {}
293 set status_active 3
294 set ui_status_value {Scanning for modified files ...}
295 set fd_di [open "| git diff-index --cached -z $PARENT" r]
296 set fd_df [open "| git diff-files -z" r]
297 set fd_lo [open $ls_others r]
299 fconfigure $fd_di -blocking 0 -translation binary
300 fconfigure $fd_df -blocking 0 -translation binary
301 fconfigure $fd_lo -blocking 0 -translation binary
302 fileevent $fd_di readable [list read_diff_index $fd_di $final]
303 fileevent $fd_df readable [list read_diff_files $fd_df $final]
304 fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
307 proc load_message {file} {
308 global gitdir ui_comm
310 set f [file join $gitdir $file]
311 if {[file isfile $f]} {
312 if {[catch {set fd [open $f r]}]} {
313 return 0
315 set content [string trim [read $fd]]
316 close $fd
317 $ui_comm delete 0.0 end
318 $ui_comm insert end $content
319 return 1
321 return 0
324 proc read_diff_index {fd final} {
325 global buf_rdi
327 append buf_rdi [read $fd]
328 set c 0
329 set n [string length $buf_rdi]
330 while {$c < $n} {
331 set z1 [string first "\0" $buf_rdi $c]
332 if {$z1 == -1} break
333 incr z1
334 set z2 [string first "\0" $buf_rdi $z1]
335 if {$z2 == -1} break
337 set c $z2
338 incr z2 -1
339 display_file \
340 [string range $buf_rdi $z1 $z2] \
341 [string index $buf_rdi [expr $z1 - 2]]_
342 incr c
344 if {$c < $n} {
345 set buf_rdi [string range $buf_rdi $c end]
346 } else {
347 set buf_rdi {}
350 status_eof $fd buf_rdi $final
353 proc read_diff_files {fd final} {
354 global buf_rdf
356 append buf_rdf [read $fd]
357 set c 0
358 set n [string length $buf_rdf]
359 while {$c < $n} {
360 set z1 [string first "\0" $buf_rdf $c]
361 if {$z1 == -1} break
362 incr z1
363 set z2 [string first "\0" $buf_rdf $z1]
364 if {$z2 == -1} break
366 set c $z2
367 incr z2 -1
368 display_file \
369 [string range $buf_rdf $z1 $z2] \
370 _[string index $buf_rdf [expr $z1 - 2]]
371 incr c
373 if {$c < $n} {
374 set buf_rdf [string range $buf_rdf $c end]
375 } else {
376 set buf_rdf {}
379 status_eof $fd buf_rdf $final
382 proc read_ls_others {fd final} {
383 global buf_rlo
385 append buf_rlo [read $fd]
386 set pck [split $buf_rlo "\0"]
387 set buf_rlo [lindex $pck end]
388 foreach p [lrange $pck 0 end-1] {
389 display_file $p _O
391 status_eof $fd buf_rlo $final
394 proc status_eof {fd buf final} {
395 global status_active ui_status_value
396 upvar $buf to_clear
398 if {[eof $fd]} {
399 set to_clear {}
400 close $fd
402 if {[incr status_active -1] == 0} {
403 display_all_files
404 unlock_index
405 reshow_diff
406 set ui_status_value $final
411 ######################################################################
413 ## diff
415 proc clear_diff {} {
416 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
418 $ui_diff conf -state normal
419 $ui_diff delete 0.0 end
420 $ui_diff conf -state disabled
422 set ui_fname_value {}
423 set ui_fstatus_value {}
425 $ui_index tag remove in_diff 0.0 end
426 $ui_other tag remove in_diff 0.0 end
429 proc reshow_diff {} {
430 global ui_fname_value ui_status_value file_states
432 if {$ui_fname_value == {}
433 || [catch {set s $file_states($ui_fname_value)}]} {
434 clear_diff
435 } else {
436 show_diff $ui_fname_value
440 proc handle_empty_diff {} {
441 global ui_fname_value file_states file_lists
443 set path $ui_fname_value
444 set s $file_states($path)
445 if {[lindex $s 0] != {_M}} return
447 info_popup "No differences detected.
449 [short_path $path] has no changes.
451 The modification date of this file was updated by another
452 application and you currently have the Trust File Modification
453 Timestamps option enabled, so Git did not automatically detect
454 that there are no content differences in this file.
456 This file will now be removed from the modified files list, to
457 prevent possible confusion.
459 if {[catch {exec git update-index -- $path} err]} {
460 error_popup "Failed to refresh index:\n\n$err"
463 clear_diff
464 set old_w [mapcol [lindex $file_states($path) 0] $path]
465 set lno [lsearch -sorted $file_lists($old_w) $path]
466 if {$lno >= 0} {
467 set file_lists($old_w) \
468 [lreplace $file_lists($old_w) $lno $lno]
469 incr lno
470 $old_w conf -state normal
471 $old_w delete $lno.0 [expr $lno + 1].0
472 $old_w conf -state disabled
476 proc show_diff {path {w {}} {lno {}}} {
477 global file_states file_lists
478 global PARENT diff_3way diff_active
479 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
481 if {$diff_active || ![lock_index read]} return
483 clear_diff
484 if {$w == {} || $lno == {}} {
485 foreach w [array names file_lists] {
486 set lno [lsearch -sorted $file_lists($w) $path]
487 if {$lno >= 0} {
488 incr lno
489 break
493 if {$w != {} && $lno >= 1} {
494 $w tag add in_diff $lno.0 [expr $lno + 1].0
497 set s $file_states($path)
498 set m [lindex $s 0]
499 set diff_3way 0
500 set diff_active 1
501 set ui_fname_value [escape_path $path]
502 set ui_fstatus_value [mapdesc $m $path]
503 set ui_status_value "Loading diff of [escape_path $path]..."
505 set cmd [list | git diff-index -p $PARENT -- $path]
506 switch $m {
507 MM {
508 set cmd [list | git diff-index -p -c $PARENT $path]
510 _O {
511 if {[catch {
512 set fd [open $path r]
513 set content [read $fd]
514 close $fd
515 } err ]} {
516 set diff_active 0
517 unlock_index
518 set ui_status_value "Unable to display [escape_path $path]"
519 error_popup "Error loading file:\n\n$err"
520 return
522 $ui_diff conf -state normal
523 $ui_diff insert end $content
524 $ui_diff conf -state disabled
525 set diff_active 0
526 unlock_index
527 set ui_status_value {Ready.}
528 return
532 if {[catch {set fd [open $cmd r]} err]} {
533 set diff_active 0
534 unlock_index
535 set ui_status_value "Unable to display [escape_path $path]"
536 error_popup "Error loading diff:\n\n$err"
537 return
540 fconfigure $fd -blocking 0 -translation auto
541 fileevent $fd readable [list read_diff $fd]
544 proc read_diff {fd} {
545 global ui_diff ui_status_value diff_3way diff_active
546 global repo_config
548 while {[gets $fd line] >= 0} {
549 if {[string match {diff --git *} $line]} continue
550 if {[string match {diff --combined *} $line]} continue
551 if {[string match {--- *} $line]} continue
552 if {[string match {+++ *} $line]} continue
553 if {[string match index* $line]} {
554 if {[string first , $line] >= 0} {
555 set diff_3way 1
559 $ui_diff conf -state normal
560 if {!$diff_3way} {
561 set x [string index $line 0]
562 switch -- $x {
563 "@" {set tags da}
564 "+" {set tags dp}
565 "-" {set tags dm}
566 default {set tags {}}
568 } else {
569 set x [string range $line 0 1]
570 switch -- $x {
571 default {set tags {}}
572 "@@" {set tags da}
573 "++" {set tags dp; set x " +"}
574 " +" {set tags {di bold}; set x "++"}
575 "+ " {set tags dni; set x "-+"}
576 "--" {set tags dm; set x " -"}
577 " -" {set tags {dm bold}; set x "--"}
578 "- " {set tags di; set x "+-"}
579 default {set tags {}}
581 set line [string replace $line 0 1 $x]
583 $ui_diff insert end $line $tags
584 $ui_diff insert end "\n"
585 $ui_diff conf -state disabled
588 if {[eof $fd]} {
589 close $fd
590 set diff_active 0
591 unlock_index
592 set ui_status_value {Ready.}
594 if {$repo_config(gui.trustmtime) == {true}
595 && [$ui_diff index end] == {2.0}} {
596 handle_empty_diff
601 ######################################################################
603 ## commit
605 proc load_last_commit {} {
606 global HEAD PARENT commit_type ui_comm
608 if {$commit_type == {amend}} return
609 if {$commit_type != {normal}} {
610 error_popup "Can't amend a $commit_type commit."
611 return
614 set msg {}
615 set parent {}
616 set parent_count 0
617 if {[catch {
618 set fd [open "| git cat-file commit $HEAD" r]
619 while {[gets $fd line] > 0} {
620 if {[string match {parent *} $line]} {
621 set parent [string range $line 7 end]
622 incr parent_count
625 set msg [string trim [read $fd]]
626 close $fd
627 } err]} {
628 error_popup "Error loading commit data for amend:\n\n$err"
629 return
632 if {$parent_count == 0} {
633 set commit_type amend
634 set HEAD {}
635 set PARENT {}
636 update_status
637 } elseif {$parent_count == 1} {
638 set commit_type amend
639 set PARENT $parent
640 $ui_comm delete 0.0 end
641 $ui_comm insert end $msg
642 $ui_comm edit modified false
643 $ui_comm edit reset
644 update_status
645 } else {
646 error_popup {You can't amend a merge commit.}
647 return
651 proc commit_tree {} {
652 global tcl_platform HEAD gitdir commit_type file_states
653 global commit_active ui_status_value
654 global ui_comm
656 if {$commit_active || ![lock_index update]} return
658 # -- Our in memory state should match the repository.
660 repository_state curHEAD cur_type
661 if {$commit_type == {amend}
662 && $cur_type == {normal}
663 && $curHEAD == $HEAD} {
664 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
665 error_popup {Last scanned state does not match repository state.
667 Its highly likely that another Git program modified the
668 repository since our last scan. A rescan is required
669 before committing.
671 unlock_index
672 update_status
673 return
676 # -- At least one file should differ in the index.
678 set files_ready 0
679 foreach path [array names file_states] {
680 set s $file_states($path)
681 switch -glob -- [lindex $s 0] {
682 _? {continue}
683 A? -
684 D? -
685 M? {set files_ready 1; break}
686 U? {
687 error_popup "Unmerged files cannot be committed.
689 File [short_path $path] has merge conflicts.
690 You must resolve them and include the file before committing.
692 unlock_index
693 return
695 default {
696 error_popup "Unknown file state [lindex $s 0] detected.
698 File [short_path $path] cannot be committed by this program.
703 if {!$files_ready} {
704 error_popup {No included files to commit.
706 You must include at least 1 file before you can commit.
708 unlock_index
709 return
712 # -- A message is required.
714 set msg [string trim [$ui_comm get 1.0 end]]
715 if {$msg == {}} {
716 error_popup {Please supply a commit message.
718 A good commit message has the following format:
720 - First line: Describe in one sentance what you did.
721 - Second line: Blank
722 - Remaining lines: Describe why this change is good.
724 unlock_index
725 return
728 # -- Ask the pre-commit hook for the go-ahead.
730 set pchook [file join $gitdir hooks pre-commit]
731 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
732 set pchook [list sh -c \
733 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
734 } elseif {[file executable $pchook]} {
735 set pchook [list $pchook]
736 } else {
737 set pchook {}
739 if {$pchook != {} && [catch {eval exec $pchook} err]} {
740 hook_failed_popup pre-commit $err
741 unlock_index
742 return
745 # -- Write the tree in the background.
747 set commit_active 1
748 set ui_status_value {Committing changes...}
750 set fd_wt [open "| git write-tree" r]
751 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
754 proc commit_stage2 {fd_wt curHEAD msg} {
755 global single_commit gitdir HEAD PARENT commit_type
756 global commit_active ui_status_value ui_comm
757 global file_states
759 gets $fd_wt tree_id
760 if {$tree_id == {} || [catch {close $fd_wt} err]} {
761 error_popup "write-tree failed:\n\n$err"
762 set commit_active 0
763 set ui_status_value {Commit failed.}
764 unlock_index
765 return
768 # -- Create the commit.
770 set cmd [list git commit-tree $tree_id]
771 if {$PARENT != {}} {
772 lappend cmd -p $PARENT
774 if {$commit_type == {merge}} {
775 if {[catch {
776 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
777 while {[gets $fd_mh merge_head] >= 0} {
778 lappend cmd -p $merge_head
780 close $fd_mh
781 } err]} {
782 error_popup "Loading MERGE_HEAD failed:\n\n$err"
783 set commit_active 0
784 set ui_status_value {Commit failed.}
785 unlock_index
786 return
789 if {$PARENT == {}} {
790 # git commit-tree writes to stderr during initial commit.
791 lappend cmd 2>/dev/null
793 lappend cmd << $msg
794 if {[catch {set cmt_id [eval exec $cmd]} err]} {
795 error_popup "commit-tree failed:\n\n$err"
796 set commit_active 0
797 set ui_status_value {Commit failed.}
798 unlock_index
799 return
802 # -- Update the HEAD ref.
804 set reflogm commit
805 if {$commit_type != {normal}} {
806 append reflogm " ($commit_type)"
808 set i [string first "\n" $msg]
809 if {$i >= 0} {
810 append reflogm {: } [string range $msg 0 [expr $i - 1]]
811 } else {
812 append reflogm {: } $msg
814 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
815 if {[catch {eval exec $cmd} err]} {
816 error_popup "update-ref failed:\n\n$err"
817 set commit_active 0
818 set ui_status_value {Commit failed.}
819 unlock_index
820 return
823 # -- Cleanup after ourselves.
825 catch {file delete [file join $gitdir MERGE_HEAD]}
826 catch {file delete [file join $gitdir MERGE_MSG]}
827 catch {file delete [file join $gitdir SQUASH_MSG]}
828 catch {file delete [file join $gitdir GITGUI_MSG]}
830 # -- Let rerere do its thing.
832 if {[file isdirectory [file join $gitdir rr-cache]]} {
833 catch {exec git rerere}
836 $ui_comm delete 0.0 end
837 $ui_comm edit modified false
838 $ui_comm edit reset
840 if {$single_commit} do_quit
842 # -- Update status without invoking any git commands.
844 set commit_active 0
845 set commit_type normal
846 set HEAD $cmt_id
847 set PARENT $cmt_id
849 foreach path [array names file_states] {
850 set s $file_states($path)
851 set m [lindex $s 0]
852 switch -glob -- $m {
853 A? -
854 M? -
855 D? {set m _[string index $m 1]}
858 if {$m == {__}} {
859 unset file_states($path)
860 } else {
861 lset file_states($path) 0 $m
865 display_all_files
866 unlock_index
867 reshow_diff
868 set ui_status_value \
869 "Changes committed as [string range $cmt_id 0 7]."
872 ######################################################################
874 ## fetch pull push
876 proc fetch_from {remote} {
877 set w [new_console "fetch $remote" \
878 "Fetching new changes from $remote"]
879 set cmd [list git fetch]
880 lappend cmd $remote
881 console_exec $w $cmd
884 proc pull_remote {remote branch} {
885 global HEAD commit_type
886 global file_states
888 if {![lock_index update]} return
890 # -- Our in memory state should match the repository.
892 repository_state curHEAD cur_type
893 if {$commit_type != $cur_type || $HEAD != $curHEAD} {
894 error_popup {Last scanned state does not match repository state.
896 Its highly likely that another Git program modified the
897 repository since our last scan. A rescan is required
898 before a pull can be started.
900 unlock_index
901 update_status
902 return
905 # -- No differences should exist before a pull.
907 if {[array size file_states] != 0} {
908 error_popup {Uncommitted but modified files are present.
910 You should not perform a pull with unmodified files in your working
911 directory as Git would be unable to recover from an incorrect merge.
913 Commit or throw away all changes before starting a pull operation.
915 unlock_index
916 return
919 set w [new_console "pull $remote $branch" \
920 "Pulling new changes from branch $branch in $remote"]
921 set cmd [list git pull]
922 lappend cmd $remote
923 lappend cmd $branch
924 console_exec $w $cmd [list post_pull_remote $remote $branch]
927 proc post_pull_remote {remote branch success} {
928 global HEAD PARENT commit_type
929 global ui_status_value
931 unlock_index
932 if {$success} {
933 repository_state HEAD commit_type
934 set PARENT $HEAD
935 set $ui_status_value {Ready.}
936 } else {
937 update_status \
938 "Conflicts detected while pulling $branch from $remote."
942 proc push_to {remote} {
943 set w [new_console "push $remote" \
944 "Pushing changes to $remote"]
945 set cmd [list git push]
946 lappend cmd $remote
947 console_exec $w $cmd
950 ######################################################################
952 ## ui helpers
954 proc mapcol {state path} {
955 global all_cols ui_other
957 if {[catch {set r $all_cols($state)}]} {
958 puts "error: no column for state={$state} $path"
959 return $ui_other
961 return $r
964 proc mapicon {state path} {
965 global all_icons
967 if {[catch {set r $all_icons($state)}]} {
968 puts "error: no icon for state={$state} $path"
969 return file_plain
971 return $r
974 proc mapdesc {state path} {
975 global all_descs
977 if {[catch {set r $all_descs($state)}]} {
978 puts "error: no desc for state={$state} $path"
979 return $state
981 return $r
984 proc escape_path {path} {
985 regsub -all "\n" $path "\\n" path
986 return $path
989 proc short_path {path} {
990 return [escape_path [lindex [file split $path] end]]
993 set next_icon_id 0
995 proc merge_state {path new_state} {
996 global file_states next_icon_id
998 set s0 [string index $new_state 0]
999 set s1 [string index $new_state 1]
1001 if {[catch {set info $file_states($path)}]} {
1002 set state __
1003 set icon n[incr next_icon_id]
1004 } else {
1005 set state [lindex $info 0]
1006 set icon [lindex $info 1]
1009 if {$s0 == {_}} {
1010 set s0 [string index $state 0]
1011 } elseif {$s0 == {*}} {
1012 set s0 _
1015 if {$s1 == {_}} {
1016 set s1 [string index $state 1]
1017 } elseif {$s1 == {*}} {
1018 set s1 _
1021 set file_states($path) [list $s0$s1 $icon]
1022 return $state
1025 proc display_file {path state} {
1026 global file_states file_lists status_active
1028 set old_m [merge_state $path $state]
1029 if {$status_active} return
1031 set s $file_states($path)
1032 set new_m [lindex $s 0]
1033 set new_w [mapcol $new_m $path]
1034 set old_w [mapcol $old_m $path]
1035 set new_icon [mapicon $new_m $path]
1037 if {$new_w != $old_w} {
1038 set lno [lsearch -sorted $file_lists($old_w) $path]
1039 if {$lno >= 0} {
1040 incr lno
1041 $old_w conf -state normal
1042 $old_w delete $lno.0 [expr $lno + 1].0
1043 $old_w conf -state disabled
1046 lappend file_lists($new_w) $path
1047 set file_lists($new_w) [lsort $file_lists($new_w)]
1048 set lno [lsearch -sorted $file_lists($new_w) $path]
1049 incr lno
1050 $new_w conf -state normal
1051 $new_w image create $lno.0 \
1052 -align center -padx 5 -pady 1 \
1053 -name [lindex $s 1] \
1054 -image $new_icon
1055 $new_w insert $lno.1 "[escape_path $path]\n"
1056 $new_w conf -state disabled
1057 } elseif {$new_icon != [mapicon $old_m $path]} {
1058 $new_w conf -state normal
1059 $new_w image conf [lindex $s 1] -image $new_icon
1060 $new_w conf -state disabled
1064 proc display_all_files {} {
1065 global ui_index ui_other file_states file_lists
1067 $ui_index conf -state normal
1068 $ui_other conf -state normal
1070 $ui_index delete 0.0 end
1071 $ui_other delete 0.0 end
1073 set file_lists($ui_index) [list]
1074 set file_lists($ui_other) [list]
1076 foreach path [lsort [array names file_states]] {
1077 set s $file_states($path)
1078 set m [lindex $s 0]
1079 set w [mapcol $m $path]
1080 lappend file_lists($w) $path
1081 $w image create end \
1082 -align center -padx 5 -pady 1 \
1083 -name [lindex $s 1] \
1084 -image [mapicon $m $path]
1085 $w insert end "[escape_path $path]\n"
1088 $ui_index conf -state disabled
1089 $ui_other conf -state disabled
1092 proc with_update_index {body} {
1093 global update_index_fd
1095 if {$update_index_fd == {}} {
1096 if {![lock_index update]} return
1097 set update_index_fd [open \
1098 "| git update-index --add --remove -z --stdin" \
1100 fconfigure $update_index_fd -translation binary
1101 uplevel 1 $body
1102 close $update_index_fd
1103 set update_index_fd {}
1104 unlock_index
1105 } else {
1106 uplevel 1 $body
1110 proc update_index {path} {
1111 global update_index_fd
1113 if {$update_index_fd == {}} {
1114 error {not in with_update_index}
1115 } else {
1116 puts -nonewline $update_index_fd "$path\0"
1120 proc toggle_mode {path} {
1121 global file_states ui_fname_value
1123 set s $file_states($path)
1124 set m [lindex $s 0]
1126 switch -- $m {
1127 AM -
1128 _O {set new A*}
1129 _M -
1130 MM {set new M*}
1131 AD -
1132 _D {set new D*}
1133 default {return}
1136 with_update_index {update_index $path}
1137 display_file $path $new
1138 if {$ui_fname_value == $path} {
1139 show_diff $path
1143 ######################################################################
1145 ## remote management
1147 proc load_all_remotes {} {
1148 global gitdir all_remotes repo_config
1150 set all_remotes [list]
1151 set rm_dir [file join $gitdir remotes]
1152 if {[file isdirectory $rm_dir]} {
1153 set all_remotes [concat $all_remotes [glob \
1154 -types f \
1155 -tails \
1156 -nocomplain \
1157 -directory $rm_dir *]]
1160 foreach line [array names repo_config remote.*.url] {
1161 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1162 lappend all_remotes $name
1166 set all_remotes [lsort -unique $all_remotes]
1169 proc populate_remote_menu {m pfx op} {
1170 global all_remotes
1172 foreach remote $all_remotes {
1173 $m add command -label "$pfx $remote..." \
1174 -command [list $op $remote] \
1175 -font font_ui
1179 proc populate_pull_menu {m} {
1180 global gitdir repo_config all_remotes disable_on_lock
1182 foreach remote $all_remotes {
1183 set rb {}
1184 if {[array get repo_config remote.$remote.url] != {}} {
1185 if {[array get repo_config remote.$remote.fetch] != {}} {
1186 regexp {^([^:]+):} \
1187 [lindex $repo_config(remote.$remote.fetch) 0] \
1188 line rb
1190 } else {
1191 catch {
1192 set fd [open [file join $gitdir remotes $remote] r]
1193 while {[gets $fd line] >= 0} {
1194 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1195 break
1198 close $fd
1202 set rb_short $rb
1203 regsub ^refs/heads/ $rb {} rb_short
1204 if {$rb_short != {}} {
1205 $m add command \
1206 -label "Branch $rb_short from $remote..." \
1207 -command [list pull_remote $remote $rb] \
1208 -font font_ui
1209 lappend disable_on_lock \
1210 [list $m entryconf [$m index last] -state]
1215 ######################################################################
1217 ## icons
1219 set filemask {
1220 #define mask_width 14
1221 #define mask_height 15
1222 static unsigned char mask_bits[] = {
1223 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1224 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1225 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1228 image create bitmap file_plain -background white -foreground black -data {
1229 #define plain_width 14
1230 #define plain_height 15
1231 static unsigned char plain_bits[] = {
1232 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1233 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1234 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1235 } -maskdata $filemask
1237 image create bitmap file_mod -background white -foreground blue -data {
1238 #define mod_width 14
1239 #define mod_height 15
1240 static unsigned char mod_bits[] = {
1241 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1242 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1243 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1244 } -maskdata $filemask
1246 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1247 #define file_fulltick_width 14
1248 #define file_fulltick_height 15
1249 static unsigned char file_fulltick_bits[] = {
1250 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1251 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1252 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1253 } -maskdata $filemask
1255 image create bitmap file_parttick -background white -foreground "#005050" -data {
1256 #define parttick_width 14
1257 #define parttick_height 15
1258 static unsigned char parttick_bits[] = {
1259 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1260 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1261 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1262 } -maskdata $filemask
1264 image create bitmap file_question -background white -foreground black -data {
1265 #define file_question_width 14
1266 #define file_question_height 15
1267 static unsigned char file_question_bits[] = {
1268 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1269 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1270 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1271 } -maskdata $filemask
1273 image create bitmap file_removed -background white -foreground red -data {
1274 #define file_removed_width 14
1275 #define file_removed_height 15
1276 static unsigned char file_removed_bits[] = {
1277 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1278 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1279 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1280 } -maskdata $filemask
1282 image create bitmap file_merge -background white -foreground blue -data {
1283 #define file_merge_width 14
1284 #define file_merge_height 15
1285 static unsigned char file_merge_bits[] = {
1286 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1287 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1288 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1289 } -maskdata $filemask
1291 set ui_index .vpane.files.index.list
1292 set ui_other .vpane.files.other.list
1293 set max_status_desc 0
1294 foreach i {
1295 {__ i plain "Unmodified"}
1296 {_M i mod "Modified"}
1297 {M_ i fulltick "Checked in"}
1298 {MM i parttick "Partially included"}
1300 {_O o plain "Untracked"}
1301 {A_ o fulltick "Added"}
1302 {AM o parttick "Partially added"}
1303 {AD o question "Added (but now gone)"}
1305 {_D i question "Missing"}
1306 {D_ i removed "Removed"}
1307 {DD i removed "Removed"}
1308 {DO i removed "Removed (still exists)"}
1310 {UM i merge "Merge conflicts"}
1311 {U_ i merge "Merge conflicts"}
1313 if {$max_status_desc < [string length [lindex $i 3]]} {
1314 set max_status_desc [string length [lindex $i 3]]
1316 if {[lindex $i 1] == {i}} {
1317 set all_cols([lindex $i 0]) $ui_index
1318 } else {
1319 set all_cols([lindex $i 0]) $ui_other
1321 set all_icons([lindex $i 0]) file_[lindex $i 2]
1322 set all_descs([lindex $i 0]) [lindex $i 3]
1324 unset filemask i
1326 ######################################################################
1328 ## util
1330 proc is_MacOSX {} {
1331 global tcl_platform tk_library
1332 if {$tcl_platform(platform) == {unix}
1333 && $tcl_platform(os) == {Darwin}
1334 && [string match /Library/Frameworks/* $tk_library]} {
1335 return 1
1337 return 0
1340 proc bind_button3 {w cmd} {
1341 bind $w <Any-Button-3> $cmd
1342 if {[is_MacOSX]} {
1343 bind $w <Control-Button-1> $cmd
1347 proc incr_font_size {font {amt 1}} {
1348 set sz [font configure $font -size]
1349 incr sz $amt
1350 font configure $font -size $sz
1351 font configure ${font}bold -size $sz
1354 proc hook_failed_popup {hook msg} {
1355 global gitdir appname
1357 set w .hookfail
1358 toplevel $w
1360 frame $w.m
1361 label $w.m.l1 -text "$hook hook failed:" \
1362 -anchor w \
1363 -justify left \
1364 -font font_uibold
1365 text $w.m.t \
1366 -background white -borderwidth 1 \
1367 -relief sunken \
1368 -width 80 -height 10 \
1369 -font font_diff \
1370 -yscrollcommand [list $w.m.sby set]
1371 label $w.m.l2 \
1372 -text {You must correct the above errors before committing.} \
1373 -anchor w \
1374 -justify left \
1375 -font font_uibold
1376 scrollbar $w.m.sby -command [list $w.m.t yview]
1377 pack $w.m.l1 -side top -fill x
1378 pack $w.m.l2 -side bottom -fill x
1379 pack $w.m.sby -side right -fill y
1380 pack $w.m.t -side left -fill both -expand 1
1381 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1383 $w.m.t insert 1.0 $msg
1384 $w.m.t conf -state disabled
1386 button $w.ok -text OK \
1387 -width 15 \
1388 -font font_ui \
1389 -command "destroy $w"
1390 pack $w.ok -side bottom
1392 bind $w <Visibility> "grab $w; focus $w"
1393 bind $w <Key-Return> "destroy $w"
1394 wm title $w "$appname ([lindex [file split \
1395 [file normalize [file dirname $gitdir]]] \
1396 end]): error"
1397 tkwait window $w
1400 set next_console_id 0
1402 proc new_console {short_title long_title} {
1403 global next_console_id console_data
1404 set w .console[incr next_console_id]
1405 set console_data($w) [list $short_title $long_title]
1406 return [console_init $w]
1409 proc console_init {w} {
1410 global console_cr console_data
1411 global gitdir appname M1B
1413 set console_cr($w) 1.0
1414 toplevel $w
1415 frame $w.m
1416 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1417 -anchor w \
1418 -justify left \
1419 -font font_uibold
1420 text $w.m.t \
1421 -background white -borderwidth 1 \
1422 -relief sunken \
1423 -width 80 -height 10 \
1424 -font font_diff \
1425 -state disabled \
1426 -yscrollcommand [list $w.m.sby set]
1427 label $w.m.s -anchor w \
1428 -justify left \
1429 -font font_uibold
1430 scrollbar $w.m.sby -command [list $w.m.t yview]
1431 pack $w.m.l1 -side top -fill x
1432 pack $w.m.s -side bottom -fill x
1433 pack $w.m.sby -side right -fill y
1434 pack $w.m.t -side left -fill both -expand 1
1435 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1437 menu $w.ctxm -tearoff 0
1438 $w.ctxm add command -label "Copy" \
1439 -font font_ui \
1440 -command "tk_textCopy $w.m.t"
1441 $w.ctxm add command -label "Select All" \
1442 -font font_ui \
1443 -command "$w.m.t tag add sel 0.0 end"
1444 $w.ctxm add command -label "Copy All" \
1445 -font font_ui \
1446 -command "
1447 $w.m.t tag add sel 0.0 end
1448 tk_textCopy $w.m.t
1449 $w.m.t tag remove sel 0.0 end
1452 button $w.ok -text {Running...} \
1453 -width 15 \
1454 -font font_ui \
1455 -state disabled \
1456 -command "destroy $w"
1457 pack $w.ok -side bottom
1459 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1460 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1461 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1462 bind $w <Visibility> "focus $w"
1463 wm title $w "$appname ([lindex [file split \
1464 [file normalize [file dirname $gitdir]]] \
1465 end]): [lindex $console_data($w) 0]"
1466 return $w
1469 proc console_exec {w cmd {after {}}} {
1470 global tcl_platform
1472 # -- Windows tosses the enviroment when we exec our child.
1473 # But most users need that so we have to relogin. :-(
1475 if {$tcl_platform(platform) == {windows}} {
1476 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1479 # -- Tcl won't let us redirect both stdout and stderr to
1480 # the same pipe. So pass it through cat...
1482 set cmd [concat | $cmd |& cat]
1484 set fd_f [open $cmd r]
1485 fconfigure $fd_f -blocking 0 -translation binary
1486 fileevent $fd_f readable [list console_read $w $fd_f $after]
1489 proc console_read {w fd after} {
1490 global console_cr console_data
1492 set buf [read $fd]
1493 if {$buf != {}} {
1494 if {![winfo exists $w]} {console_init $w}
1495 $w.m.t conf -state normal
1496 set c 0
1497 set n [string length $buf]
1498 while {$c < $n} {
1499 set cr [string first "\r" $buf $c]
1500 set lf [string first "\n" $buf $c]
1501 if {$cr < 0} {set cr [expr $n + 1]}
1502 if {$lf < 0} {set lf [expr $n + 1]}
1504 if {$lf < $cr} {
1505 $w.m.t insert end [string range $buf $c $lf]
1506 set console_cr($w) [$w.m.t index {end -1c}]
1507 set c $lf
1508 incr c
1509 } else {
1510 $w.m.t delete $console_cr($w) end
1511 $w.m.t insert end "\n"
1512 $w.m.t insert end [string range $buf $c $cr]
1513 set c $cr
1514 incr c
1517 $w.m.t conf -state disabled
1518 $w.m.t see end
1521 fconfigure $fd -blocking 1
1522 if {[eof $fd]} {
1523 if {[catch {close $fd}]} {
1524 if {![winfo exists $w]} {console_init $w}
1525 $w.m.s conf -background red -text {Error: Command Failed}
1526 $w.ok conf -text Close
1527 $w.ok conf -state normal
1528 set ok 0
1529 } elseif {[winfo exists $w]} {
1530 $w.m.s conf -background green -text {Success}
1531 $w.ok conf -text Close
1532 $w.ok conf -state normal
1533 set ok 1
1535 array unset console_cr $w
1536 array unset console_data $w
1537 if {$after != {}} {
1538 uplevel #0 $after $ok
1540 return
1542 fconfigure $fd -blocking 0
1545 ######################################################################
1547 ## ui commands
1549 set starting_gitk_msg {Please wait... Starting gitk...}
1551 proc do_gitk {} {
1552 global tcl_platform ui_status_value starting_gitk_msg
1554 set ui_status_value $starting_gitk_msg
1555 after 10000 {
1556 if {$ui_status_value == $starting_gitk_msg} {
1557 set ui_status_value {Ready.}
1561 if {$tcl_platform(platform) == {windows}} {
1562 exec sh -c gitk &
1563 } else {
1564 exec gitk &
1568 proc do_repack {} {
1569 set w [new_console "repack" "Repacking the object database"]
1570 set cmd [list git repack]
1571 lappend cmd -a
1572 lappend cmd -d
1573 console_exec $w $cmd
1576 set is_quitting 0
1578 proc do_quit {} {
1579 global gitdir ui_comm is_quitting repo_config
1581 if {$is_quitting} return
1582 set is_quitting 1
1584 # -- Stash our current commit buffer.
1586 set save [file join $gitdir GITGUI_MSG]
1587 set msg [string trim [$ui_comm get 0.0 end]]
1588 if {[$ui_comm edit modified] && $msg != {}} {
1589 catch {
1590 set fd [open $save w]
1591 puts $fd [string trim [$ui_comm get 0.0 end]]
1592 close $fd
1594 } elseif {$msg == {} && [file exists $save]} {
1595 file delete $save
1598 # -- Stash our current window geometry into this repository.
1600 set cfg_geometry [list]
1601 lappend cfg_geometry [wm geometry .]
1602 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1603 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1604 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1605 set rc_geometry {}
1607 if {$cfg_geometry != $rc_geometry} {
1608 catch {exec git repo-config gui.geometry $cfg_geometry}
1611 destroy .
1614 proc do_rescan {} {
1615 update_status
1618 proc do_include_all {} {
1619 global update_active ui_status_value
1621 if {$update_active || ![lock_index begin-update]} return
1623 set update_active 1
1624 set ui_status_value {Including all modified files...}
1625 after 1 {
1626 with_update_index {
1627 foreach path [array names file_states] {
1628 set s $file_states($path)
1629 set m [lindex $s 0]
1630 switch -- $m {
1631 AM -
1632 MM -
1633 _M -
1634 _D {toggle_mode $path}
1638 set update_active 0
1639 set ui_status_value {Ready.}
1643 set GIT_COMMITTER_IDENT {}
1645 proc do_signoff {} {
1646 global ui_comm GIT_COMMITTER_IDENT
1648 if {$GIT_COMMITTER_IDENT == {}} {
1649 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1650 error_popup "Unable to obtain your identity:\n\n$err"
1651 return
1653 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1654 $me me GIT_COMMITTER_IDENT]} {
1655 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1656 return
1660 set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1661 set last [$ui_comm get {end -1c linestart} {end -1c}]
1662 if {$last != $sob} {
1663 $ui_comm edit separator
1664 if {$last != {}
1665 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1666 $ui_comm insert end "\n"
1668 $ui_comm insert end "\n$sob"
1669 $ui_comm edit separator
1670 $ui_comm see end
1674 proc do_amend_last {} {
1675 load_last_commit
1678 proc do_commit {} {
1679 commit_tree
1682 proc do_options {} {
1683 global appname gitdir
1684 global repo_config global_config
1685 global repo_config_new global_config_new
1687 load_config
1688 array unset repo_config_new
1689 array unset global_config_new
1690 foreach name [array names repo_config] {
1691 set repo_config_new($name) $repo_config($name)
1693 foreach name [array names global_config] {
1694 set global_config_new($name) $global_config($name)
1697 set w .options_editor
1698 toplevel $w
1700 label $w.header -text "$appname Options" \
1701 -font font_uibold
1702 pack $w.header -side top -fill x
1704 frame $w.buttons
1705 button $w.buttons.save -text Save \
1706 -font font_ui \
1707 -command "save_config; destroy $w"
1708 pack $w.buttons.save -side right
1709 button $w.buttons.cancel -text {Cancel} \
1710 -font font_ui \
1711 -command "destroy $w"
1712 pack $w.buttons.cancel -side right
1713 pack $w.buttons -side bottom -anchor e -pady 10 -padx 10
1715 labelframe $w.repo -text {This Repository} \
1716 -relief raised -borderwidth 2
1717 labelframe $w.global -text {Global (All Repositories)} \
1718 -relief raised -borderwidth 2
1719 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1720 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1722 foreach option {
1723 {trustmtime {Trust File Modification Timestamps}}
1725 set name [lindex $option 0]
1726 set text [lindex $option 1]
1727 foreach f {repo global} {
1728 checkbutton $w.$f.$name -text $text \
1729 -variable ${f}_config_new(gui.$name) \
1730 -onvalue true \
1731 -offvalue false \
1732 -font font_ui
1733 pack $w.$f.$name -side top -anchor w
1737 bind $w <Visibility> "grab $w; focus $w"
1738 bind $w <Key-Escape> "destroy $w"
1739 wm title $w "$appname ([lindex [file split \
1740 [file normalize [file dirname $gitdir]]] \
1741 end]): Options"
1742 tkwait window $w
1745 # shift == 1: left click
1746 # 3: right click
1747 proc click {w x y shift wx wy} {
1748 global ui_index ui_other file_lists
1750 set pos [split [$w index @$x,$y] .]
1751 set lno [lindex $pos 0]
1752 set col [lindex $pos 1]
1753 set path [lindex $file_lists($w) [expr $lno - 1]]
1754 if {$path == {}} return
1756 if {$col > 0 && $shift == 1} {
1757 show_diff $path $w $lno
1761 proc unclick {w x y} {
1762 global file_lists
1764 set pos [split [$w index @$x,$y] .]
1765 set lno [lindex $pos 0]
1766 set col [lindex $pos 1]
1767 set path [lindex $file_lists($w) [expr $lno - 1]]
1768 if {$path == {}} return
1770 if {$col == 0} {
1771 toggle_mode $path
1775 ######################################################################
1777 ## ui init
1779 set cursor_ptr arrow
1780 font create font_diff -family Courier -size 10
1781 font create font_ui
1782 catch {
1783 label .dummy
1784 eval font configure font_ui [font actual [.dummy cget -font]]
1785 destroy .dummy
1788 eval font create font_uibold [font configure font_ui]
1789 font configure font_uibold -weight bold
1790 eval font create font_diffbold [font configure font_diff]
1791 font configure font_diffbold -weight bold
1793 set M1B M1
1794 set M1T M1
1795 if {$tcl_platform(platform) == {windows}} {
1796 set M1B Control
1797 set M1T Ctrl
1798 } elseif {[is_MacOSX]} {
1799 set M1B M1
1800 set M1T Cmd
1803 # -- Menu Bar
1804 menu .mbar -tearoff 0
1805 .mbar add cascade -label Project -menu .mbar.project
1806 .mbar add cascade -label Edit -menu .mbar.edit
1807 .mbar add cascade -label Commit -menu .mbar.commit
1808 .mbar add cascade -label Fetch -menu .mbar.fetch
1809 .mbar add cascade -label Pull -menu .mbar.pull
1810 .mbar add cascade -label Push -menu .mbar.push
1811 . configure -menu .mbar
1813 # -- Project Menu
1814 menu .mbar.project
1815 .mbar.project add command -label Visualize \
1816 -command do_gitk \
1817 -font font_ui
1818 .mbar.project add command -label {Repack Database} \
1819 -command do_repack \
1820 -font font_ui
1821 .mbar.project add command -label Quit \
1822 -command do_quit \
1823 -accelerator $M1T-Q \
1824 -font font_ui
1826 # -- Edit Menu
1828 menu .mbar.edit
1829 .mbar.edit add command -label Undo \
1830 -command {catch {[focus] edit undo}} \
1831 -accelerator $M1T-Z \
1832 -font font_ui
1833 .mbar.edit add command -label Redo \
1834 -command {catch {[focus] edit redo}} \
1835 -accelerator $M1T-Y \
1836 -font font_ui
1837 .mbar.edit add separator
1838 .mbar.edit add command -label Cut \
1839 -command {catch {tk_textCut [focus]}} \
1840 -accelerator $M1T-X \
1841 -font font_ui
1842 .mbar.edit add command -label Copy \
1843 -command {catch {tk_textCopy [focus]}} \
1844 -accelerator $M1T-C \
1845 -font font_ui
1846 .mbar.edit add command -label Paste \
1847 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1848 -accelerator $M1T-V \
1849 -font font_ui
1850 .mbar.edit add command -label Delete \
1851 -command {catch {[focus] delete sel.first sel.last}} \
1852 -accelerator Del \
1853 -font font_ui
1854 .mbar.edit add separator
1855 .mbar.edit add command -label {Select All} \
1856 -command {catch {[focus] tag add sel 0.0 end}} \
1857 -accelerator $M1T-A \
1858 -font font_ui
1859 .mbar.edit add separator
1860 .mbar.edit add command -label {Options...} \
1861 -command do_options \
1862 -font font_ui
1864 # -- Commit Menu
1865 menu .mbar.commit
1866 .mbar.commit add command -label Rescan \
1867 -command do_rescan \
1868 -accelerator F5 \
1869 -font font_ui
1870 lappend disable_on_lock \
1871 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1872 .mbar.commit add command -label {Amend Last Commit} \
1873 -command do_amend_last \
1874 -font font_ui
1875 lappend disable_on_lock \
1876 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1877 .mbar.commit add command -label {Include All Files} \
1878 -command do_include_all \
1879 -accelerator $M1T-I \
1880 -font font_ui
1881 lappend disable_on_lock \
1882 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1883 .mbar.commit add command -label {Sign Off} \
1884 -command do_signoff \
1885 -accelerator $M1T-S \
1886 -font font_ui
1887 .mbar.commit add command -label Commit \
1888 -command do_commit \
1889 -accelerator $M1T-Return \
1890 -font font_ui
1891 lappend disable_on_lock \
1892 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1894 # -- Fetch Menu
1895 menu .mbar.fetch
1897 # -- Pull Menu
1898 menu .mbar.pull
1900 # -- Push Menu
1901 menu .mbar.push
1903 # -- Main Window Layout
1904 panedwindow .vpane -orient vertical
1905 panedwindow .vpane.files -orient horizontal
1906 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1907 pack .vpane -anchor n -side top -fill both -expand 1
1909 # -- Index File List
1910 frame .vpane.files.index -height 100 -width 400
1911 label .vpane.files.index.title -text {Modified Files} \
1912 -background green \
1913 -font font_ui
1914 text $ui_index -background white -borderwidth 0 \
1915 -width 40 -height 10 \
1916 -font font_ui \
1917 -cursor $cursor_ptr \
1918 -yscrollcommand {.vpane.files.index.sb set} \
1919 -state disabled
1920 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1921 pack .vpane.files.index.title -side top -fill x
1922 pack .vpane.files.index.sb -side right -fill y
1923 pack $ui_index -side left -fill both -expand 1
1924 .vpane.files add .vpane.files.index -sticky nsew
1926 # -- Other (Add) File List
1927 frame .vpane.files.other -height 100 -width 100
1928 label .vpane.files.other.title -text {Untracked Files} \
1929 -background red \
1930 -font font_ui
1931 text $ui_other -background white -borderwidth 0 \
1932 -width 40 -height 10 \
1933 -font font_ui \
1934 -cursor $cursor_ptr \
1935 -yscrollcommand {.vpane.files.other.sb set} \
1936 -state disabled
1937 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1938 pack .vpane.files.other.title -side top -fill x
1939 pack .vpane.files.other.sb -side right -fill y
1940 pack $ui_other -side left -fill both -expand 1
1941 .vpane.files add .vpane.files.other -sticky nsew
1943 $ui_index tag conf in_diff -font font_uibold
1944 $ui_other tag conf in_diff -font font_uibold
1946 # -- Diff and Commit Area
1947 frame .vpane.lower -height 400 -width 400
1948 frame .vpane.lower.commarea
1949 frame .vpane.lower.diff -relief sunken -borderwidth 1
1950 pack .vpane.lower.commarea -side top -fill x
1951 pack .vpane.lower.diff -side bottom -fill both -expand 1
1952 .vpane add .vpane.lower -stick nsew
1954 # -- Commit Area Buttons
1955 frame .vpane.lower.commarea.buttons
1956 label .vpane.lower.commarea.buttons.l -text {} \
1957 -anchor w \
1958 -justify left \
1959 -font font_ui
1960 pack .vpane.lower.commarea.buttons.l -side top -fill x
1961 pack .vpane.lower.commarea.buttons -side left -fill y
1963 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1964 -command do_rescan \
1965 -font font_ui
1966 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1967 lappend disable_on_lock \
1968 {.vpane.lower.commarea.buttons.rescan conf -state}
1970 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1971 -command do_amend_last \
1972 -font font_ui
1973 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1974 lappend disable_on_lock \
1975 {.vpane.lower.commarea.buttons.amend conf -state}
1977 button .vpane.lower.commarea.buttons.incall -text {Include All} \
1978 -command do_include_all \
1979 -font font_ui
1980 pack .vpane.lower.commarea.buttons.incall -side top -fill x
1981 lappend disable_on_lock \
1982 {.vpane.lower.commarea.buttons.incall conf -state}
1984 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1985 -command do_signoff \
1986 -font font_ui
1987 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1989 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1990 -command do_commit \
1991 -font font_ui
1992 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1993 lappend disable_on_lock \
1994 {.vpane.lower.commarea.buttons.commit conf -state}
1996 # -- Commit Message Buffer
1997 frame .vpane.lower.commarea.buffer
1998 set ui_comm .vpane.lower.commarea.buffer.t
1999 set ui_coml .vpane.lower.commarea.buffer.l
2000 label $ui_coml -text {Commit Message:} \
2001 -anchor w \
2002 -justify left \
2003 -font font_ui
2004 trace add variable commit_type write {uplevel #0 {
2005 switch -glob $commit_type \
2006 initial {$ui_coml conf -text {Initial Commit Message:}} \
2007 amend {$ui_coml conf -text {Amended Commit Message:}} \
2008 merge {$ui_coml conf -text {Merge Commit Message:}} \
2009 * {$ui_coml conf -text {Commit Message:}}
2011 text $ui_comm -background white -borderwidth 1 \
2012 -undo true \
2013 -maxundo 20 \
2014 -autoseparators true \
2015 -relief sunken \
2016 -width 75 -height 9 -wrap none \
2017 -font font_diff \
2018 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2019 scrollbar .vpane.lower.commarea.buffer.sby \
2020 -command [list $ui_comm yview]
2021 pack $ui_coml -side top -fill x
2022 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2023 pack $ui_comm -side left -fill y
2024 pack .vpane.lower.commarea.buffer -side left -fill y
2026 # -- Commit Message Buffer Context Menu
2028 menu $ui_comm.ctxm -tearoff 0
2029 $ui_comm.ctxm add command -label "Cut" \
2030 -font font_ui \
2031 -command "tk_textCut $ui_comm"
2032 $ui_comm.ctxm add command -label "Copy" \
2033 -font font_ui \
2034 -command "tk_textCopy $ui_comm"
2035 $ui_comm.ctxm add command -label "Paste" \
2036 -font font_ui \
2037 -command "tk_textPaste $ui_comm"
2038 $ui_comm.ctxm add command -label "Delete" \
2039 -font font_ui \
2040 -command "$ui_comm delete sel.first sel.last"
2041 $ui_comm.ctxm add separator
2042 $ui_comm.ctxm add command -label "Select All" \
2043 -font font_ui \
2044 -command "$ui_comm tag add sel 0.0 end"
2045 $ui_comm.ctxm add command -label "Copy All" \
2046 -font font_ui \
2047 -command "
2048 $ui_comm tag add sel 0.0 end
2049 tk_textCopy $ui_comm
2050 $ui_comm tag remove sel 0.0 end
2052 $ui_comm.ctxm add separator
2053 $ui_comm.ctxm add command -label "Sign Off" \
2054 -font font_ui \
2055 -command do_signoff
2056 bind_button3 $ui_comm "tk_popup $ui_comm.ctxm %X %Y"
2058 # -- Diff Header
2059 set ui_fname_value {}
2060 set ui_fstatus_value {}
2061 frame .vpane.lower.diff.header -background orange
2062 label .vpane.lower.diff.header.l1 -text {File:} \
2063 -background orange \
2064 -font font_ui
2065 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
2066 -background orange \
2067 -anchor w \
2068 -justify left \
2069 -font font_ui
2070 label .vpane.lower.diff.header.l3 -text {Status:} \
2071 -background orange \
2072 -font font_ui
2073 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
2074 -background orange \
2075 -width $max_status_desc \
2076 -anchor w \
2077 -justify left \
2078 -font font_ui
2079 pack .vpane.lower.diff.header.l1 -side left
2080 pack .vpane.lower.diff.header.l2 -side left -fill x
2081 pack .vpane.lower.diff.header.l4 -side right
2082 pack .vpane.lower.diff.header.l3 -side right
2084 # -- Diff Body
2085 frame .vpane.lower.diff.body
2086 set ui_diff .vpane.lower.diff.body.t
2087 text $ui_diff -background white -borderwidth 0 \
2088 -width 80 -height 15 -wrap none \
2089 -font font_diff \
2090 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2091 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2092 -state disabled
2093 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2094 -command [list $ui_diff xview]
2095 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2096 -command [list $ui_diff yview]
2097 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2098 pack .vpane.lower.diff.body.sby -side right -fill y
2099 pack $ui_diff -side left -fill both -expand 1
2100 pack .vpane.lower.diff.header -side top -fill x
2101 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2103 $ui_diff tag conf dm -foreground red
2104 $ui_diff tag conf dp -foreground blue
2105 $ui_diff tag conf di -foreground {#00a000}
2106 $ui_diff tag conf dni -foreground {#a000a0}
2107 $ui_diff tag conf da -font font_diffbold
2108 $ui_diff tag conf bold -font font_diffbold
2110 # -- Diff Body Context Menu
2112 menu $ui_diff.ctxm -tearoff 0
2113 $ui_diff.ctxm add command -label "Copy" \
2114 -font font_ui \
2115 -command "tk_textCopy $ui_diff"
2116 $ui_diff.ctxm add command -label "Select All" \
2117 -font font_ui \
2118 -command "$ui_diff tag add sel 0.0 end"
2119 $ui_diff.ctxm add command -label "Copy All" \
2120 -font font_ui \
2121 -command "
2122 $ui_diff tag add sel 0.0 end
2123 tk_textCopy $ui_diff
2124 $ui_diff tag remove sel 0.0 end
2126 $ui_diff.ctxm add separator
2127 $ui_diff.ctxm add command -label "Decrease Font Size" \
2128 -font font_ui \
2129 -command {incr_font_size font_diff -1}
2130 $ui_diff.ctxm add command -label "Increase Font Size" \
2131 -font font_ui \
2132 -command {incr_font_size font_diff 1}
2133 bind_button3 $ui_diff "tk_popup $ui_diff.ctxm %X %Y"
2135 # -- Status Bar
2136 set ui_status_value {Initializing...}
2137 label .status -textvariable ui_status_value \
2138 -anchor w \
2139 -justify left \
2140 -borderwidth 1 \
2141 -relief sunken \
2142 -font font_ui
2143 pack .status -anchor w -side bottom -fill x
2145 # -- Load geometry
2146 catch {
2147 set gm $repo_config(gui.geometry)
2148 wm geometry . [lindex $gm 0]
2149 .vpane sash place 0 \
2150 [lindex [.vpane sash coord 0] 0] \
2151 [lindex $gm 1]
2152 .vpane.files sash place 0 \
2153 [lindex $gm 2] \
2154 [lindex [.vpane.files sash coord 0] 1]
2155 unset gm
2158 # -- Key Bindings
2159 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2160 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2161 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2162 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2163 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2164 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2165 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2166 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2167 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2168 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2169 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2171 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2172 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2173 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2174 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2175 bind $ui_diff <$M1B-Key-v> {break}
2176 bind $ui_diff <$M1B-Key-V> {break}
2177 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2178 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2179 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2180 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2181 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2182 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2184 bind . <Destroy> do_quit
2185 bind all <Key-F5> do_rescan
2186 bind all <$M1B-Key-r> do_rescan
2187 bind all <$M1B-Key-R> do_rescan
2188 bind . <$M1B-Key-s> do_signoff
2189 bind . <$M1B-Key-S> do_signoff
2190 bind . <$M1B-Key-i> do_include_all
2191 bind . <$M1B-Key-I> do_include_all
2192 bind . <$M1B-Key-Return> do_commit
2193 bind all <$M1B-Key-q> do_quit
2194 bind all <$M1B-Key-Q> do_quit
2195 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2196 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2197 foreach i [list $ui_index $ui_other] {
2198 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
2199 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
2200 bind_button3 $i {click %W %x %y 3 %X %Y; break}
2202 unset i
2204 set file_lists($ui_index) [list]
2205 set file_lists($ui_other) [list]
2207 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2208 focus -force $ui_comm
2209 load_all_remotes
2210 populate_remote_menu .mbar.fetch From fetch_from
2211 populate_remote_menu .mbar.push To push_to
2212 populate_pull_menu .mbar.pull
2213 update_status