git-gui: Only reshow diff when really necessary.
[git-gui.git] / git-gui
blob62545b70945bad20779409c2cd2889c561735c0d
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 proc is_many_config {name} {
18 switch -glob -- $name {
19 remote.*.fetch -
20 remote.*.push
21 {return 1}
23 {return 0}
27 proc load_config {include_global} {
28 global repo_config global_config default_config
30 array unset global_config
31 if {$include_global} {
32 catch {
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
38 } else {
39 set global_config($name) $value
43 close $fd_rc
47 array unset repo_config
48 catch {
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
54 } else {
55 set repo_config($name) $value
59 close $fd_rc
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)
72 proc save_config {} {
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}
96 } else {
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}
113 } else {
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
125 set title $appname
126 if {$gitdir ne {}} {
127 append title { (}
128 append title [lindex \
129 [file split [file normalize [file dirname $gitdir]]] \
130 end]
131 append title {)}
133 set cmd [list tk_messageBox \
134 -icon error \
135 -type ok \
136 -title "$title: error" \
137 -message $msg]
138 if {[winfo ismapped .]} {
139 lappend cmd -parent .
141 eval $cmd
144 proc info_popup {msg} {
145 global gitdir appname
147 set title $appname
148 if {$gitdir ne {}} {
149 append title { (}
150 append title [lindex \
151 [file split [file normalize [file dirname $gitdir]]] \
152 end]
153 append title {)}
155 tk_messageBox \
156 -parent . \
157 -icon error \
158 -type ok \
159 -title $title \
160 -message $msg
163 ######################################################################
165 ## repository setup
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"
171 exit 1
173 if {![file isdirectory $gitdir]} {
174 catch {wm withdraw .}
175 error_popup "Git directory not found:\n\n$gitdir"
176 exit 1
178 if {[lindex [file split $gitdir] end] ne {.git}} {
179 catch {wm withdraw .}
180 error_popup "Cannot use funny .git directory:\n\n$gitdir"
181 exit 1
183 if {[catch {cd [file dirname $gitdir]} err]} {
184 catch {wm withdraw .}
185 error_popup "No working directory [file dirname $gitdir]:\n\n$err"
186 exit 1
189 set single_commit 0
190 if {$appname eq {git-citool}} {
191 set single_commit 1
194 ######################################################################
196 ## task management
198 set rescan_active 0
199 set diff_active 0
200 set last_clicked {}
202 set disable_on_lock [list]
203 set index_lock_type none
205 set HEAD {}
206 set PARENT {}
207 set commit_type {}
208 set empty_tree {}
210 proc lock_index {type} {
211 global index_lock_type disable_on_lock
213 if {$index_lock_type eq {none}} {
214 set index_lock_type $type
215 foreach w $disable_on_lock {
216 uplevel #0 $w disabled
218 return 1
219 } elseif {$index_lock_type eq {begin-update} && $type eq {update}} {
220 set index_lock_type $type
221 return 1
223 return 0
226 proc unlock_index {} {
227 global index_lock_type disable_on_lock
229 set index_lock_type none
230 foreach w $disable_on_lock {
231 uplevel #0 $w normal
235 ######################################################################
237 ## status
239 proc repository_state {hdvar ctvar} {
240 global gitdir
241 upvar $hdvar hd $ctvar ct
243 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
244 set hd {}
245 set ct initial
246 } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
247 set ct merge
248 } else {
249 set ct normal
253 proc PARENT {} {
254 global PARENT empty_tree
256 if {$PARENT ne {}} {
257 return $PARENT
259 if {$empty_tree eq {}} {
260 set empty_tree [exec git mktree << {}]
262 return $empty_tree
265 proc rescan {after} {
266 global HEAD PARENT commit_type
267 global ui_index ui_other ui_status_value ui_comm
268 global rescan_active file_states
269 global repo_config
271 if {$rescan_active > 0 || ![lock_index read]} return
273 repository_state new_HEAD new_type
274 if {[string match amend* $commit_type]
275 && $new_type eq {normal}
276 && $new_HEAD eq $HEAD} {
277 } else {
278 set HEAD $new_HEAD
279 set PARENT $new_HEAD
280 set commit_type $new_type
283 array unset file_states
285 if {![$ui_comm edit modified]
286 || [string trim [$ui_comm get 0.0 end]] eq {}} {
287 if {[load_message GITGUI_MSG]} {
288 } elseif {[load_message MERGE_MSG]} {
289 } elseif {[load_message SQUASH_MSG]} {
291 $ui_comm edit modified false
292 $ui_comm edit reset
295 if {$repo_config(gui.trustmtime) eq {true}} {
296 rescan_stage2 {} $after
297 } else {
298 set rescan_active 1
299 set ui_status_value {Refreshing file status...}
300 set cmd [list git update-index]
301 lappend cmd -q
302 lappend cmd --unmerged
303 lappend cmd --ignore-missing
304 lappend cmd --refresh
305 set fd_rf [open "| $cmd" r]
306 fconfigure $fd_rf -blocking 0 -translation binary
307 fileevent $fd_rf readable \
308 [list rescan_stage2 $fd_rf $after]
312 proc rescan_stage2 {fd after} {
313 global gitdir ui_status_value
314 global rescan_active buf_rdi buf_rdf buf_rlo
316 if {$fd ne {}} {
317 read $fd
318 if {![eof $fd]} return
319 close $fd
322 set ls_others [list | git ls-files --others -z \
323 --exclude-per-directory=.gitignore]
324 set info_exclude [file join $gitdir info exclude]
325 if {[file readable $info_exclude]} {
326 lappend ls_others "--exclude-from=$info_exclude"
329 set buf_rdi {}
330 set buf_rdf {}
331 set buf_rlo {}
333 set rescan_active 3
334 set ui_status_value {Scanning for modified files ...}
335 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
336 set fd_df [open "| git diff-files -z" r]
337 set fd_lo [open $ls_others r]
339 fconfigure $fd_di -blocking 0 -translation binary
340 fconfigure $fd_df -blocking 0 -translation binary
341 fconfigure $fd_lo -blocking 0 -translation binary
342 fileevent $fd_di readable [list read_diff_index $fd_di $after]
343 fileevent $fd_df readable [list read_diff_files $fd_df $after]
344 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
347 proc load_message {file} {
348 global gitdir ui_comm
350 set f [file join $gitdir $file]
351 if {[file isfile $f]} {
352 if {[catch {set fd [open $f r]}]} {
353 return 0
355 set content [string trim [read $fd]]
356 close $fd
357 $ui_comm delete 0.0 end
358 $ui_comm insert end $content
359 return 1
361 return 0
364 proc read_diff_index {fd after} {
365 global buf_rdi
367 append buf_rdi [read $fd]
368 set c 0
369 set n [string length $buf_rdi]
370 while {$c < $n} {
371 set z1 [string first "\0" $buf_rdi $c]
372 if {$z1 == -1} break
373 incr z1
374 set z2 [string first "\0" $buf_rdi $z1]
375 if {$z2 == -1} break
377 set c $z2
378 incr z2 -1
379 display_file \
380 [string range $buf_rdi $z1 $z2] \
381 [string index $buf_rdi [expr {$z1 - 2}]]_
382 incr c
384 if {$c < $n} {
385 set buf_rdi [string range $buf_rdi $c end]
386 } else {
387 set buf_rdi {}
390 rescan_done $fd buf_rdi $after
393 proc read_diff_files {fd after} {
394 global buf_rdf
396 append buf_rdf [read $fd]
397 set c 0
398 set n [string length $buf_rdf]
399 while {$c < $n} {
400 set z1 [string first "\0" $buf_rdf $c]
401 if {$z1 == -1} break
402 incr z1
403 set z2 [string first "\0" $buf_rdf $z1]
404 if {$z2 == -1} break
406 set c $z2
407 incr z2 -1
408 display_file \
409 [string range $buf_rdf $z1 $z2] \
410 _[string index $buf_rdf [expr {$z1 - 2}]]
411 incr c
413 if {$c < $n} {
414 set buf_rdf [string range $buf_rdf $c end]
415 } else {
416 set buf_rdf {}
419 rescan_done $fd buf_rdf $after
422 proc read_ls_others {fd after} {
423 global buf_rlo
425 append buf_rlo [read $fd]
426 set pck [split $buf_rlo "\0"]
427 set buf_rlo [lindex $pck end]
428 foreach p [lrange $pck 0 end-1] {
429 display_file $p _O
431 rescan_done $fd buf_rlo $after
434 proc rescan_done {fd buf after} {
435 global rescan_active
436 global file_states repo_config
437 upvar $buf to_clear
439 if {![eof $fd]} return
440 set to_clear {}
441 close $fd
442 if {[incr rescan_active -1] > 0} return
444 prune_selection
445 unlock_index
446 display_all_files
448 if {$repo_config(gui.partialinclude) ne {true}} {
449 set pathList [list]
450 foreach path [array names file_states] {
451 switch -- [lindex $file_states($path) 0] {
452 AM -
453 MM {lappend pathList $path}
456 if {$pathList ne {}} {
457 update_index \
458 "Updating included files" \
459 $pathList \
460 [concat {reshow_diff;} $after]
461 return
465 reshow_diff
466 uplevel #0 $after
469 proc prune_selection {} {
470 global file_states selected_paths
472 foreach path [array names selected_paths] {
473 if {[catch {set still_here $file_states($path)}]} {
474 unset selected_paths($path)
479 ######################################################################
481 ## diff
483 proc clear_diff {} {
484 global ui_diff current_diff ui_index ui_other
486 $ui_diff conf -state normal
487 $ui_diff delete 0.0 end
488 $ui_diff conf -state disabled
490 set current_diff {}
492 $ui_index tag remove in_diff 0.0 end
493 $ui_other tag remove in_diff 0.0 end
496 proc reshow_diff {} {
497 global current_diff ui_status_value file_states
499 if {$current_diff eq {}
500 || [catch {set s $file_states($current_diff)}]} {
501 clear_diff
502 } else {
503 show_diff $current_diff
507 proc handle_empty_diff {} {
508 global current_diff file_states file_lists
510 set path $current_diff
511 set s $file_states($path)
512 if {[lindex $s 0] ne {_M}} return
514 info_popup "No differences detected.
516 [short_path $path] has no changes.
518 The modification date of this file was updated
519 by another application and you currently have
520 the Trust File Modification Timestamps option
521 enabled, so Git did not automatically detect
522 that there are no content differences in this
523 file.
525 This file will now be removed from the modified
526 files list, to prevent possible confusion.
528 if {[catch {exec git update-index -- $path} err]} {
529 error_popup "Failed to refresh index:\n\n$err"
532 clear_diff
533 set old_w [mapcol [lindex $file_states($path) 0] $path]
534 set lno [lsearch -sorted $file_lists($old_w) $path]
535 if {$lno >= 0} {
536 set file_lists($old_w) \
537 [lreplace $file_lists($old_w) $lno $lno]
538 incr lno
539 $old_w conf -state normal
540 $old_w delete $lno.0 [expr {$lno + 1}].0
541 $old_w conf -state disabled
545 proc show_diff {path {w {}} {lno {}}} {
546 global file_states file_lists
547 global diff_3way diff_active repo_config
548 global ui_diff current_diff ui_status_value
550 if {$diff_active || ![lock_index read]} return
552 clear_diff
553 if {$w eq {} || $lno == {}} {
554 foreach w [array names file_lists] {
555 set lno [lsearch -sorted $file_lists($w) $path]
556 if {$lno >= 0} {
557 incr lno
558 break
562 if {$w ne {} && $lno >= 1} {
563 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
566 set s $file_states($path)
567 set m [lindex $s 0]
568 set diff_3way 0
569 set diff_active 1
570 set current_diff $path
571 set ui_status_value "Loading diff of [escape_path $path]..."
573 set cmd [list | git diff-index]
574 lappend cmd --no-color
575 if {$repo_config(gui.diffcontext) > 0} {
576 lappend cmd "-U$repo_config(gui.diffcontext)"
578 lappend cmd -p
580 switch $m {
581 MM {
582 lappend cmd -c
584 _O {
585 if {[catch {
586 set fd [open $path r]
587 set content [read $fd]
588 close $fd
589 } err ]} {
590 set diff_active 0
591 unlock_index
592 set ui_status_value "Unable to display [escape_path $path]"
593 error_popup "Error loading file:\n\n$err"
594 return
596 $ui_diff conf -state normal
597 $ui_diff insert end $content
598 $ui_diff conf -state disabled
599 set diff_active 0
600 unlock_index
601 set ui_status_value {Ready.}
602 return
606 lappend cmd [PARENT]
607 lappend cmd --
608 lappend cmd $path
610 if {[catch {set fd [open $cmd r]} err]} {
611 set diff_active 0
612 unlock_index
613 set ui_status_value "Unable to display [escape_path $path]"
614 error_popup "Error loading diff:\n\n$err"
615 return
618 fconfigure $fd -blocking 0 -translation auto
619 fileevent $fd readable [list read_diff $fd]
622 proc read_diff {fd} {
623 global ui_diff ui_status_value diff_3way diff_active
624 global repo_config
626 while {[gets $fd line] >= 0} {
627 if {[string match {diff --git *} $line]} continue
628 if {[string match {diff --combined *} $line]} continue
629 if {[string match {--- *} $line]} continue
630 if {[string match {+++ *} $line]} continue
631 if {[string match index* $line]} {
632 if {[string first , $line] >= 0} {
633 set diff_3way 1
637 $ui_diff conf -state normal
638 if {!$diff_3way} {
639 set x [string index $line 0]
640 switch -- $x {
641 "@" {set tags da}
642 "+" {set tags dp}
643 "-" {set tags dm}
644 default {set tags {}}
646 } else {
647 set x [string range $line 0 1]
648 switch -- $x {
649 default {set tags {}}
650 "@@" {set tags da}
651 "++" {set tags dp; set x " +"}
652 " +" {set tags {di bold}; set x "++"}
653 "+ " {set tags dni; set x "-+"}
654 "--" {set tags dm; set x " -"}
655 " -" {set tags {dm bold}; set x "--"}
656 "- " {set tags di; set x "+-"}
657 default {set tags {}}
659 set line [string replace $line 0 1 $x]
661 $ui_diff insert end $line $tags
662 $ui_diff insert end "\n"
663 $ui_diff conf -state disabled
666 if {[eof $fd]} {
667 close $fd
668 set diff_active 0
669 unlock_index
670 set ui_status_value {Ready.}
672 if {$repo_config(gui.trustmtime) eq {true}
673 && [$ui_diff index end] eq {2.0}} {
674 handle_empty_diff
679 ######################################################################
681 ## commit
683 proc load_last_commit {} {
684 global HEAD PARENT commit_type ui_comm
686 if {[string match amend* $commit_type]} return
687 if {$commit_type ne {normal}} {
688 error_popup "Can't amend a $commit_type commit."
689 return
692 set msg {}
693 set parent {}
694 set parent_count 0
695 if {[catch {
696 set fd [open "| git cat-file commit $HEAD" r]
697 while {[gets $fd line] > 0} {
698 if {[string match {parent *} $line]} {
699 set parent [string range $line 7 end]
700 incr parent_count
703 set msg [string trim [read $fd]]
704 close $fd
705 } err]} {
706 error_popup "Error loading commit data for amend:\n\n$err"
707 return
710 if {$parent_count > 1} {
711 error_popup {Can't amend a merge commit.}
712 return
715 if {$parent_count == 0} {
716 set commit_type amend-initial
717 set PARENT {}
718 } elseif {$parent_count == 1} {
719 set commit_type amend
720 set PARENT $parent
723 $ui_comm delete 0.0 end
724 $ui_comm insert end $msg
725 $ui_comm edit modified false
726 $ui_comm edit reset
727 rescan {set ui_status_value {Ready.}}
730 proc commit_tree {} {
731 global HEAD commit_type file_states ui_comm repo_config
733 if {![lock_index update]} return
735 # -- Our in memory state should match the repository.
737 repository_state curHEAD cur_type
738 if {[string match amend* $commit_type]
739 && $cur_type eq {normal}
740 && $curHEAD eq $HEAD} {
741 } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
742 error_popup {Last scanned state does not match repository state.
744 Its highly likely that another Git program modified the
745 repository since the last scan. A rescan is required
746 before committing.
748 A rescan will be automatically started now.
750 unlock_index
751 rescan {set ui_status_value {Ready.}}
752 return
755 # -- At least one file should differ in the index.
757 set files_ready 0
758 foreach path [array names file_states] {
759 switch -glob -- [lindex $file_states($path) 0] {
760 _? {continue}
761 A? -
762 D? -
763 M? {set files_ready 1; break}
764 U? {
765 error_popup "Unmerged files cannot be committed.
767 File [short_path $path] has merge conflicts.
768 You must resolve them and include the file before committing.
770 unlock_index
771 return
773 default {
774 error_popup "Unknown file state [lindex $s 0] detected.
776 File [short_path $path] cannot be committed by this program.
781 if {!$files_ready} {
782 error_popup {No included files to commit.
784 You must include at least 1 file before you can commit.
786 unlock_index
787 return
790 # -- A message is required.
792 set msg [string trim [$ui_comm get 1.0 end]]
793 if {$msg eq {}} {
794 error_popup {Please supply a commit message.
796 A good commit message has the following format:
798 - First line: Describe in one sentance what you did.
799 - Second line: Blank
800 - Remaining lines: Describe why this change is good.
802 unlock_index
803 return
806 # -- Update included files if partialincludes are off.
808 if {$repo_config(gui.partialinclude) ne {true}} {
809 set pathList [list]
810 foreach path [array names file_states] {
811 switch -glob -- [lindex $file_states($path) 0] {
812 A? -
813 M? {lappend pathList $path}
816 if {$pathList ne {}} {
817 unlock_index
818 update_index \
819 "Updating included files" \
820 $pathList \
821 [concat {lock_index update;} \
822 [list commit_prehook $curHEAD $msg]]
823 return
827 commit_prehook $curHEAD $msg
830 proc commit_prehook {curHEAD msg} {
831 global tcl_platform gitdir ui_status_value pch_error
833 # On Cygwin [file executable] might lie so we need to ask
834 # the shell if the hook is executable. Yes that's annoying.
836 set pchook [file join $gitdir hooks pre-commit]
837 if {$tcl_platform(platform) eq {windows}
838 && [file isfile $pchook]} {
839 set pchook [list sh -c [concat \
840 "if test -x \"$pchook\";" \
841 "then exec \"$pchook\" 2>&1;" \
842 "fi"]]
843 } elseif {[file executable $pchook]} {
844 set pchook [list $pchook |& cat]
845 } else {
846 commit_writetree $curHEAD $msg
847 return
850 set ui_status_value {Calling pre-commit hook...}
851 set pch_error {}
852 set fd_ph [open "| $pchook" r]
853 fconfigure $fd_ph -blocking 0 -translation binary
854 fileevent $fd_ph readable \
855 [list commit_prehook_wait $fd_ph $curHEAD $msg]
858 proc commit_prehook_wait {fd_ph curHEAD msg} {
859 global pch_error ui_status_value
861 append pch_error [read $fd_ph]
862 fconfigure $fd_ph -blocking 1
863 if {[eof $fd_ph]} {
864 if {[catch {close $fd_ph}]} {
865 set ui_status_value {Commit declined by pre-commit hook.}
866 hook_failed_popup pre-commit $pch_error
867 unlock_index
868 } else {
869 commit_writetree $curHEAD $msg
871 set pch_error {}
872 return
874 fconfigure $fd_ph -blocking 0
877 proc commit_writetree {curHEAD msg} {
878 global ui_status_value
880 set ui_status_value {Committing changes...}
881 set fd_wt [open "| git write-tree" r]
882 fileevent $fd_wt readable \
883 [list commit_committree $fd_wt $curHEAD $msg]
886 proc commit_committree {fd_wt curHEAD msg} {
887 global single_commit gitdir HEAD PARENT commit_type tcl_platform
888 global ui_status_value ui_comm
889 global file_states selected_paths
891 gets $fd_wt tree_id
892 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
893 error_popup "write-tree failed:\n\n$err"
894 set ui_status_value {Commit failed.}
895 unlock_index
896 return
899 # -- Create the commit.
901 set cmd [list git commit-tree $tree_id]
902 if {$PARENT ne {}} {
903 lappend cmd -p $PARENT
905 if {$commit_type eq {merge}} {
906 if {[catch {
907 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
908 while {[gets $fd_mh merge_head] >= 0} {
909 lappend cmd -p $merge_head
911 close $fd_mh
912 } err]} {
913 error_popup "Loading MERGE_HEAD failed:\n\n$err"
914 set ui_status_value {Commit failed.}
915 unlock_index
916 return
919 if {$PARENT eq {}} {
920 # git commit-tree writes to stderr during initial commit.
921 lappend cmd 2>/dev/null
923 lappend cmd << $msg
924 if {[catch {set cmt_id [eval exec $cmd]} err]} {
925 error_popup "commit-tree failed:\n\n$err"
926 set ui_status_value {Commit failed.}
927 unlock_index
928 return
931 # -- Update the HEAD ref.
933 set reflogm commit
934 if {$commit_type ne {normal}} {
935 append reflogm " ($commit_type)"
937 set i [string first "\n" $msg]
938 if {$i >= 0} {
939 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
940 } else {
941 append reflogm {: } $msg
943 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
944 if {[catch {eval exec $cmd} err]} {
945 error_popup "update-ref failed:\n\n$err"
946 set ui_status_value {Commit failed.}
947 unlock_index
948 return
951 # -- Cleanup after ourselves.
953 catch {file delete [file join $gitdir MERGE_HEAD]}
954 catch {file delete [file join $gitdir MERGE_MSG]}
955 catch {file delete [file join $gitdir SQUASH_MSG]}
956 catch {file delete [file join $gitdir GITGUI_MSG]}
958 # -- Let rerere do its thing.
960 if {[file isdirectory [file join $gitdir rr-cache]]} {
961 catch {exec git rerere}
964 # -- Run the post-commit hook.
966 set pchook [file join $gitdir hooks post-commit]
967 if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
968 set pchook [list sh -c [concat \
969 "if test -x \"$pchook\";" \
970 "then exec \"$pchook\";" \
971 "fi"]]
972 } elseif {![file executable $pchook]} {
973 set pchook {}
975 if {$pchook ne {}} {
976 catch {exec $pchook &}
979 $ui_comm delete 0.0 end
980 $ui_comm edit modified false
981 $ui_comm edit reset
983 if {$single_commit} do_quit
985 # -- Update status without invoking any git commands.
987 set commit_type normal
988 set HEAD $cmt_id
989 set PARENT $cmt_id
991 foreach path [array names file_states] {
992 set s $file_states($path)
993 set m [lindex $s 0]
994 switch -glob -- $m {
995 A? -
996 M? -
997 D? {set m _[string index $m 1]}
1000 if {$m eq {__}} {
1001 unset file_states($path)
1002 catch {unset selected_paths($path)}
1003 } else {
1004 lset file_states($path) 0 $m
1008 display_all_files
1009 unlock_index
1010 reshow_diff
1011 set ui_status_value \
1012 "Changes committed as [string range $cmt_id 0 7]."
1015 ######################################################################
1017 ## fetch pull push
1019 proc fetch_from {remote} {
1020 set w [new_console "fetch $remote" \
1021 "Fetching new changes from $remote"]
1022 set cmd [list git fetch]
1023 lappend cmd $remote
1024 console_exec $w $cmd
1027 proc pull_remote {remote branch} {
1028 global HEAD commit_type file_states repo_config
1030 if {![lock_index update]} return
1032 # -- Our in memory state should match the repository.
1034 repository_state curHEAD cur_type
1035 if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
1036 error_popup {Last scanned state does not match repository state.
1038 Its highly likely that another Git program modified the
1039 repository since our last scan. A rescan is required
1040 before a pull can be started.
1042 unlock_index
1043 rescan {set ui_status_value {Ready.}}
1044 return
1047 # -- No differences should exist before a pull.
1049 if {[array size file_states] != 0} {
1050 error_popup {Uncommitted but modified files are present.
1052 You should not perform a pull with unmodified files in your working
1053 directory as Git would be unable to recover from an incorrect merge.
1055 Commit or throw away all changes before starting a pull operation.
1057 unlock_index
1058 return
1061 set w [new_console "pull $remote $branch" \
1062 "Pulling new changes from branch $branch in $remote"]
1063 set cmd [list git pull]
1064 if {$repo_config(gui.pullsummary) eq {false}} {
1065 lappend cmd --no-summary
1067 lappend cmd $remote
1068 lappend cmd $branch
1069 console_exec $w $cmd [list post_pull_remote $remote $branch]
1072 proc post_pull_remote {remote branch success} {
1073 global HEAD PARENT commit_type
1074 global ui_status_value
1076 unlock_index
1077 if {$success} {
1078 repository_state HEAD commit_type
1079 set PARENT $HEAD
1080 set $ui_status_value "Pulling $branch from $remote complete."
1081 } else {
1082 set m "Conflicts detected while pulling $branch from $remote."
1083 rescan "set ui_status_value {$m}"
1087 proc push_to {remote} {
1088 set w [new_console "push $remote" \
1089 "Pushing changes to $remote"]
1090 set cmd [list git push]
1091 lappend cmd $remote
1092 console_exec $w $cmd
1095 ######################################################################
1097 ## ui helpers
1099 proc mapcol {state path} {
1100 global all_cols ui_other
1102 if {[catch {set r $all_cols($state)}]} {
1103 puts "error: no column for state={$state} $path"
1104 return $ui_other
1106 return $r
1109 proc mapicon {state path} {
1110 global all_icons
1112 if {[catch {set r $all_icons($state)}]} {
1113 puts "error: no icon for state={$state} $path"
1114 return file_plain
1116 return $r
1119 proc mapdesc {state path} {
1120 global all_descs
1122 if {[catch {set r $all_descs($state)}]} {
1123 puts "error: no desc for state={$state} $path"
1124 return $state
1126 return $r
1129 proc escape_path {path} {
1130 regsub -all "\n" $path "\\n" path
1131 return $path
1134 proc short_path {path} {
1135 return [escape_path [lindex [file split $path] end]]
1138 set next_icon_id 0
1140 proc merge_state {path new_state} {
1141 global file_states next_icon_id
1143 set s0 [string index $new_state 0]
1144 set s1 [string index $new_state 1]
1146 if {[catch {set info $file_states($path)}]} {
1147 set state __
1148 set icon n[incr next_icon_id]
1149 } else {
1150 set state [lindex $info 0]
1151 set icon [lindex $info 1]
1154 if {$s0 eq {_}} {
1155 set s0 [string index $state 0]
1156 } elseif {$s0 eq {*}} {
1157 set s0 _
1160 if {$s1 eq {_}} {
1161 set s1 [string index $state 1]
1162 } elseif {$s1 eq {*}} {
1163 set s1 _
1166 set file_states($path) [list $s0$s1 $icon]
1167 return $state
1170 proc display_file {path state} {
1171 global file_states file_lists selected_paths rescan_active
1173 set old_m [merge_state $path $state]
1174 if {$rescan_active > 0} return
1176 set s $file_states($path)
1177 set new_m [lindex $s 0]
1178 set new_w [mapcol $new_m $path]
1179 set old_w [mapcol $old_m $path]
1180 set new_icon [mapicon $new_m $path]
1182 if {$new_w ne $old_w} {
1183 set lno [lsearch -sorted $file_lists($old_w) $path]
1184 if {$lno >= 0} {
1185 incr lno
1186 $old_w conf -state normal
1187 $old_w delete $lno.0 [expr {$lno + 1}].0
1188 $old_w conf -state disabled
1191 lappend file_lists($new_w) $path
1192 set file_lists($new_w) [lsort $file_lists($new_w)]
1193 set lno [lsearch -sorted $file_lists($new_w) $path]
1194 incr lno
1195 $new_w conf -state normal
1196 $new_w image create $lno.0 \
1197 -align center -padx 5 -pady 1 \
1198 -name [lindex $s 1] \
1199 -image $new_icon
1200 $new_w insert $lno.1 "[escape_path $path]\n"
1201 if {[catch {set in_sel $selected_paths($path)}]} {
1202 set in_sel 0
1204 if {$in_sel} {
1205 $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1207 $new_w conf -state disabled
1208 } elseif {$new_icon ne [mapicon $old_m $path]} {
1209 $new_w conf -state normal
1210 $new_w image conf [lindex $s 1] -image $new_icon
1211 $new_w conf -state disabled
1215 proc display_all_files {} {
1216 global ui_index ui_other
1217 global file_states file_lists
1218 global last_clicked selected_paths
1220 $ui_index conf -state normal
1221 $ui_other conf -state normal
1223 $ui_index delete 0.0 end
1224 $ui_other delete 0.0 end
1225 set last_clicked {}
1227 set file_lists($ui_index) [list]
1228 set file_lists($ui_other) [list]
1230 foreach path [lsort [array names file_states]] {
1231 set s $file_states($path)
1232 set m [lindex $s 0]
1233 set w [mapcol $m $path]
1234 lappend file_lists($w) $path
1235 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1236 $w image create end \
1237 -align center -padx 5 -pady 1 \
1238 -name [lindex $s 1] \
1239 -image [mapicon $m $path]
1240 $w insert end "[escape_path $path]\n"
1241 if {[catch {set in_sel $selected_paths($path)}]} {
1242 set in_sel 0
1244 if {$in_sel} {
1245 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1249 $ui_index conf -state disabled
1250 $ui_other conf -state disabled
1253 proc update_index {msg pathList after} {
1254 global update_index_cp ui_status_value
1256 if {![lock_index update]} return
1258 set update_index_cp 0
1259 set pathList [lsort $pathList]
1260 set totalCnt [llength $pathList]
1261 set batch [expr {int($totalCnt * .01) + 1}]
1262 if {$batch > 25} {set batch 25}
1264 set ui_status_value [format \
1265 "$msg... %i/%i files (%.2f%%)" \
1266 $update_index_cp \
1267 $totalCnt \
1268 0.0]
1269 set fd [open "| git update-index --add --remove -z --stdin" w]
1270 fconfigure $fd \
1271 -blocking 0 \
1272 -buffering full \
1273 -buffersize 512 \
1274 -translation binary
1275 fileevent $fd writable [list \
1276 write_update_index \
1277 $fd \
1278 $pathList \
1279 $totalCnt \
1280 $batch \
1281 $msg \
1282 $after \
1286 proc write_update_index {fd pathList totalCnt batch msg after} {
1287 global update_index_cp ui_status_value
1288 global file_states current_diff
1290 if {$update_index_cp >= $totalCnt} {
1291 close $fd
1292 unlock_index
1293 uplevel #0 $after
1294 return
1297 for {set i $batch} \
1298 {$update_index_cp < $totalCnt && $i > 0} \
1299 {incr i -1} {
1300 set path [lindex $pathList $update_index_cp]
1301 incr update_index_cp
1303 switch -glob -- [lindex $file_states($path) 0] {
1304 AD -
1305 MD -
1306 _D {set new D*}
1308 _M -
1309 MM -
1310 M_ {set new M*}
1312 _O -
1313 AM -
1314 A_ {set new A*}
1316 ?? {continue}
1319 puts -nonewline $fd $path
1320 puts -nonewline $fd "\0"
1321 display_file $path $new
1324 set ui_status_value [format \
1325 "$msg... %i/%i files (%.2f%%)" \
1326 $update_index_cp \
1327 $totalCnt \
1328 [expr {100.0 * $update_index_cp / $totalCnt}]]
1331 ######################################################################
1333 ## remote management
1335 proc load_all_remotes {} {
1336 global gitdir all_remotes repo_config
1338 set all_remotes [list]
1339 set rm_dir [file join $gitdir remotes]
1340 if {[file isdirectory $rm_dir]} {
1341 set all_remotes [concat $all_remotes [glob \
1342 -types f \
1343 -tails \
1344 -nocomplain \
1345 -directory $rm_dir *]]
1348 foreach line [array names repo_config remote.*.url] {
1349 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1350 lappend all_remotes $name
1354 set all_remotes [lsort -unique $all_remotes]
1357 proc populate_fetch_menu {m} {
1358 global gitdir all_remotes repo_config
1360 foreach r $all_remotes {
1361 set enable 0
1362 if {![catch {set a $repo_config(remote.$r.url)}]} {
1363 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1364 set enable 1
1366 } else {
1367 catch {
1368 set fd [open [file join $gitdir remotes $r] r]
1369 while {[gets $fd n] >= 0} {
1370 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1371 set enable 1
1372 break
1375 close $fd
1379 if {$enable} {
1380 $m add command \
1381 -label "Fetch from $r..." \
1382 -command [list fetch_from $r] \
1383 -font font_ui
1388 proc populate_push_menu {m} {
1389 global gitdir all_remotes repo_config
1391 foreach r $all_remotes {
1392 set enable 0
1393 if {![catch {set a $repo_config(remote.$r.url)}]} {
1394 if {![catch {set a $repo_config(remote.$r.push)}]} {
1395 set enable 1
1397 } else {
1398 catch {
1399 set fd [open [file join $gitdir remotes $r] r]
1400 while {[gets $fd n] >= 0} {
1401 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1402 set enable 1
1403 break
1406 close $fd
1410 if {$enable} {
1411 $m add command \
1412 -label "Push to $r..." \
1413 -command [list push_to $r] \
1414 -font font_ui
1419 proc populate_pull_menu {m} {
1420 global gitdir repo_config all_remotes disable_on_lock
1422 foreach remote $all_remotes {
1423 set rb {}
1424 if {[array get repo_config remote.$remote.url] ne {}} {
1425 if {[array get repo_config remote.$remote.fetch] ne {}} {
1426 regexp {^([^:]+):} \
1427 [lindex $repo_config(remote.$remote.fetch) 0] \
1428 line rb
1430 } else {
1431 catch {
1432 set fd [open [file join $gitdir remotes $remote] r]
1433 while {[gets $fd line] >= 0} {
1434 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1435 break
1438 close $fd
1442 set rb_short $rb
1443 regsub ^refs/heads/ $rb {} rb_short
1444 if {$rb_short ne {}} {
1445 $m add command \
1446 -label "Branch $rb_short from $remote..." \
1447 -command [list pull_remote $remote $rb] \
1448 -font font_ui
1449 lappend disable_on_lock \
1450 [list $m entryconf [$m index last] -state]
1455 ######################################################################
1457 ## icons
1459 set filemask {
1460 #define mask_width 14
1461 #define mask_height 15
1462 static unsigned char mask_bits[] = {
1463 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1464 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1465 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1468 image create bitmap file_plain -background white -foreground black -data {
1469 #define plain_width 14
1470 #define plain_height 15
1471 static unsigned char plain_bits[] = {
1472 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1473 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1474 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1475 } -maskdata $filemask
1477 image create bitmap file_mod -background white -foreground blue -data {
1478 #define mod_width 14
1479 #define mod_height 15
1480 static unsigned char mod_bits[] = {
1481 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1482 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1483 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1484 } -maskdata $filemask
1486 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1487 #define file_fulltick_width 14
1488 #define file_fulltick_height 15
1489 static unsigned char file_fulltick_bits[] = {
1490 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1491 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1492 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1493 } -maskdata $filemask
1495 image create bitmap file_parttick -background white -foreground "#005050" -data {
1496 #define parttick_width 14
1497 #define parttick_height 15
1498 static unsigned char parttick_bits[] = {
1499 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1500 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1501 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1502 } -maskdata $filemask
1504 image create bitmap file_question -background white -foreground black -data {
1505 #define file_question_width 14
1506 #define file_question_height 15
1507 static unsigned char file_question_bits[] = {
1508 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1509 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1510 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1511 } -maskdata $filemask
1513 image create bitmap file_removed -background white -foreground red -data {
1514 #define file_removed_width 14
1515 #define file_removed_height 15
1516 static unsigned char file_removed_bits[] = {
1517 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1518 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1519 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1520 } -maskdata $filemask
1522 image create bitmap file_merge -background white -foreground blue -data {
1523 #define file_merge_width 14
1524 #define file_merge_height 15
1525 static unsigned char file_merge_bits[] = {
1526 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1527 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1528 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1529 } -maskdata $filemask
1531 set ui_index .vpane.files.index.list
1532 set ui_other .vpane.files.other.list
1533 set max_status_desc 0
1534 foreach i {
1535 {__ i plain "Unmodified"}
1536 {_M i mod "Modified"}
1537 {M_ i fulltick "Included in commit"}
1538 {MM i parttick "Partially included"}
1540 {_O o plain "Untracked"}
1541 {A_ o fulltick "Added by commit"}
1542 {AM o parttick "Partially added"}
1543 {AD o question "Added (but now gone)"}
1545 {_D i question "Missing"}
1546 {D_ i removed "Removed by commit"}
1547 {DD i removed "Removed by commit"}
1548 {DO i removed "Removed (still exists)"}
1550 {UM i merge "Merge conflicts"}
1551 {U_ i merge "Merge conflicts"}
1553 if {$max_status_desc < [string length [lindex $i 3]]} {
1554 set max_status_desc [string length [lindex $i 3]]
1556 if {[lindex $i 1] eq {i}} {
1557 set all_cols([lindex $i 0]) $ui_index
1558 } else {
1559 set all_cols([lindex $i 0]) $ui_other
1561 set all_icons([lindex $i 0]) file_[lindex $i 2]
1562 set all_descs([lindex $i 0]) [lindex $i 3]
1564 unset filemask i
1566 ######################################################################
1568 ## util
1570 proc is_MacOSX {} {
1571 global tcl_platform tk_library
1572 if {$tcl_platform(platform) eq {unix}
1573 && $tcl_platform(os) eq {Darwin}
1574 && [string match /Library/Frameworks/* $tk_library]} {
1575 return 1
1577 return 0
1580 proc bind_button3 {w cmd} {
1581 bind $w <Any-Button-3> $cmd
1582 if {[is_MacOSX]} {
1583 bind $w <Control-Button-1> $cmd
1587 proc incr_font_size {font {amt 1}} {
1588 set sz [font configure $font -size]
1589 incr sz $amt
1590 font configure $font -size $sz
1591 font configure ${font}bold -size $sz
1594 proc hook_failed_popup {hook msg} {
1595 global gitdir appname
1597 set w .hookfail
1598 toplevel $w
1600 frame $w.m
1601 label $w.m.l1 -text "$hook hook failed:" \
1602 -anchor w \
1603 -justify left \
1604 -font font_uibold
1605 text $w.m.t \
1606 -background white -borderwidth 1 \
1607 -relief sunken \
1608 -width 80 -height 10 \
1609 -font font_diff \
1610 -yscrollcommand [list $w.m.sby set]
1611 label $w.m.l2 \
1612 -text {You must correct the above errors before committing.} \
1613 -anchor w \
1614 -justify left \
1615 -font font_uibold
1616 scrollbar $w.m.sby -command [list $w.m.t yview]
1617 pack $w.m.l1 -side top -fill x
1618 pack $w.m.l2 -side bottom -fill x
1619 pack $w.m.sby -side right -fill y
1620 pack $w.m.t -side left -fill both -expand 1
1621 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1623 $w.m.t insert 1.0 $msg
1624 $w.m.t conf -state disabled
1626 button $w.ok -text OK \
1627 -width 15 \
1628 -font font_ui \
1629 -command "destroy $w"
1630 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1632 bind $w <Visibility> "grab $w; focus $w"
1633 bind $w <Key-Return> "destroy $w"
1634 wm title $w "$appname ([lindex [file split \
1635 [file normalize [file dirname $gitdir]]] \
1636 end]): error"
1637 tkwait window $w
1640 set next_console_id 0
1642 proc new_console {short_title long_title} {
1643 global next_console_id console_data
1644 set w .console[incr next_console_id]
1645 set console_data($w) [list $short_title $long_title]
1646 return [console_init $w]
1649 proc console_init {w} {
1650 global console_cr console_data
1651 global gitdir appname M1B
1653 set console_cr($w) 1.0
1654 toplevel $w
1655 frame $w.m
1656 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1657 -anchor w \
1658 -justify left \
1659 -font font_uibold
1660 text $w.m.t \
1661 -background white -borderwidth 1 \
1662 -relief sunken \
1663 -width 80 -height 10 \
1664 -font font_diff \
1665 -state disabled \
1666 -yscrollcommand [list $w.m.sby set]
1667 label $w.m.s -text {Working... please wait...} \
1668 -anchor w \
1669 -justify left \
1670 -font font_uibold
1671 scrollbar $w.m.sby -command [list $w.m.t yview]
1672 pack $w.m.l1 -side top -fill x
1673 pack $w.m.s -side bottom -fill x
1674 pack $w.m.sby -side right -fill y
1675 pack $w.m.t -side left -fill both -expand 1
1676 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1678 menu $w.ctxm -tearoff 0
1679 $w.ctxm add command -label "Copy" \
1680 -font font_ui \
1681 -command "tk_textCopy $w.m.t"
1682 $w.ctxm add command -label "Select All" \
1683 -font font_ui \
1684 -command "$w.m.t tag add sel 0.0 end"
1685 $w.ctxm add command -label "Copy All" \
1686 -font font_ui \
1687 -command "
1688 $w.m.t tag add sel 0.0 end
1689 tk_textCopy $w.m.t
1690 $w.m.t tag remove sel 0.0 end
1693 button $w.ok -text {Close} \
1694 -font font_ui \
1695 -state disabled \
1696 -command "destroy $w"
1697 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1699 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1700 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1701 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1702 bind $w <Visibility> "focus $w"
1703 wm title $w "$appname ([lindex [file split \
1704 [file normalize [file dirname $gitdir]]] \
1705 end]): [lindex $console_data($w) 0]"
1706 return $w
1709 proc console_exec {w cmd {after {}}} {
1710 global tcl_platform
1712 # -- Windows tosses the enviroment when we exec our child.
1713 # But most users need that so we have to relogin. :-(
1715 if {$tcl_platform(platform) eq {windows}} {
1716 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1719 # -- Tcl won't let us redirect both stdout and stderr to
1720 # the same pipe. So pass it through cat...
1722 set cmd [concat | $cmd |& cat]
1724 set fd_f [open $cmd r]
1725 fconfigure $fd_f -blocking 0 -translation binary
1726 fileevent $fd_f readable [list console_read $w $fd_f $after]
1729 proc console_read {w fd after} {
1730 global console_cr console_data
1732 set buf [read $fd]
1733 if {$buf ne {}} {
1734 if {![winfo exists $w]} {console_init $w}
1735 $w.m.t conf -state normal
1736 set c 0
1737 set n [string length $buf]
1738 while {$c < $n} {
1739 set cr [string first "\r" $buf $c]
1740 set lf [string first "\n" $buf $c]
1741 if {$cr < 0} {set cr [expr {$n + 1}]}
1742 if {$lf < 0} {set lf [expr {$n + 1}]}
1744 if {$lf < $cr} {
1745 $w.m.t insert end [string range $buf $c $lf]
1746 set console_cr($w) [$w.m.t index {end -1c}]
1747 set c $lf
1748 incr c
1749 } else {
1750 $w.m.t delete $console_cr($w) end
1751 $w.m.t insert end "\n"
1752 $w.m.t insert end [string range $buf $c $cr]
1753 set c $cr
1754 incr c
1757 $w.m.t conf -state disabled
1758 $w.m.t see end
1761 fconfigure $fd -blocking 1
1762 if {[eof $fd]} {
1763 if {[catch {close $fd}]} {
1764 if {![winfo exists $w]} {console_init $w}
1765 $w.m.s conf -background red -text {Error: Command Failed}
1766 $w.ok conf -state normal
1767 set ok 0
1768 } elseif {[winfo exists $w]} {
1769 $w.m.s conf -background green -text {Success}
1770 $w.ok conf -state normal
1771 set ok 1
1773 array unset console_cr $w
1774 array unset console_data $w
1775 if {$after ne {}} {
1776 uplevel #0 $after $ok
1778 return
1780 fconfigure $fd -blocking 0
1783 ######################################################################
1785 ## ui commands
1787 set starting_gitk_msg {Please wait... Starting gitk...}
1789 proc do_gitk {} {
1790 global tcl_platform ui_status_value starting_gitk_msg
1792 set ui_status_value $starting_gitk_msg
1793 after 10000 {
1794 if {$ui_status_value eq $starting_gitk_msg} {
1795 set ui_status_value {Ready.}
1799 if {$tcl_platform(platform) eq {windows}} {
1800 exec sh -c gitk &
1801 } else {
1802 exec gitk &
1806 proc do_repack {} {
1807 set w [new_console "repack" "Repacking the object database"]
1808 set cmd [list git repack]
1809 lappend cmd -a
1810 lappend cmd -d
1811 console_exec $w $cmd
1814 set is_quitting 0
1816 proc do_quit {} {
1817 global gitdir ui_comm is_quitting repo_config
1819 if {$is_quitting} return
1820 set is_quitting 1
1822 # -- Stash our current commit buffer.
1824 set save [file join $gitdir GITGUI_MSG]
1825 set msg [string trim [$ui_comm get 0.0 end]]
1826 if {[$ui_comm edit modified] && $msg ne {}} {
1827 catch {
1828 set fd [open $save w]
1829 puts $fd [string trim [$ui_comm get 0.0 end]]
1830 close $fd
1832 } elseif {$msg eq {} && [file exists $save]} {
1833 file delete $save
1836 # -- Stash our current window geometry into this repository.
1838 set cfg_geometry [list]
1839 lappend cfg_geometry [wm geometry .]
1840 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1841 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1842 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1843 set rc_geometry {}
1845 if {$cfg_geometry ne $rc_geometry} {
1846 catch {exec git repo-config gui.geometry $cfg_geometry}
1849 destroy .
1852 proc do_rescan {} {
1853 rescan {set ui_status_value {Ready.}}
1856 proc do_include_all {} {
1857 global file_states current_diff
1859 if {![lock_index begin-update]} return
1861 set pathList [list]
1862 set after {}
1863 foreach path [array names file_states] {
1864 switch -- [lindex $file_states($path) 0] {
1865 AM -
1866 MM -
1867 _M -
1868 _D {
1869 lappend pathList $path
1870 if {$path eq $current_diff} {
1871 set after {reshow_diff;}
1876 if {$pathList eq {}} {
1877 unlock_index
1878 } else {
1879 update_index \
1880 "Including all modified files" \
1881 $pathList \
1882 [concat $after {set ui_status_value {Ready to commit.}}]
1886 set GIT_COMMITTER_IDENT {}
1888 proc do_signoff {} {
1889 global ui_comm GIT_COMMITTER_IDENT
1891 if {$GIT_COMMITTER_IDENT eq {}} {
1892 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1893 error_popup "Unable to obtain your identity:\n\n$err"
1894 return
1896 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1897 $me me GIT_COMMITTER_IDENT]} {
1898 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1899 return
1903 set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1904 set last [$ui_comm get {end -1c linestart} {end -1c}]
1905 if {$last ne $sob} {
1906 $ui_comm edit separator
1907 if {$last ne {}
1908 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1909 $ui_comm insert end "\n"
1911 $ui_comm insert end "\n$sob"
1912 $ui_comm edit separator
1913 $ui_comm see end
1917 proc do_amend_last {} {
1918 load_last_commit
1921 proc do_commit {} {
1922 commit_tree
1925 proc do_options {} {
1926 global appname gitdir font_descs
1927 global repo_config global_config
1928 global repo_config_new global_config_new
1930 array unset repo_config_new
1931 array unset global_config_new
1932 foreach name [array names repo_config] {
1933 set repo_config_new($name) $repo_config($name)
1935 load_config 1
1936 foreach name [array names repo_config] {
1937 switch -- $name {
1938 gui.diffcontext {continue}
1940 set repo_config_new($name) $repo_config($name)
1942 foreach name [array names global_config] {
1943 set global_config_new($name) $global_config($name)
1945 set reponame [lindex [file split \
1946 [file normalize [file dirname $gitdir]]] \
1947 end]
1949 set w .options_editor
1950 toplevel $w
1951 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1953 label $w.header -text "$appname Options" \
1954 -font font_uibold
1955 pack $w.header -side top -fill x
1957 frame $w.buttons
1958 button $w.buttons.restore -text {Restore Defaults} \
1959 -font font_ui \
1960 -command do_restore_defaults
1961 pack $w.buttons.restore -side left
1962 button $w.buttons.save -text Save \
1963 -font font_ui \
1964 -command [list do_save_config $w]
1965 pack $w.buttons.save -side right
1966 button $w.buttons.cancel -text {Cancel} \
1967 -font font_ui \
1968 -command [list destroy $w]
1969 pack $w.buttons.cancel -side right
1970 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1972 labelframe $w.repo -text "$reponame Repository" \
1973 -font font_ui \
1974 -relief raised -borderwidth 2
1975 labelframe $w.global -text {Global (All Repositories)} \
1976 -font font_ui \
1977 -relief raised -borderwidth 2
1978 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1979 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1981 foreach option {
1982 {b partialinclude {Allow Partially Included Files}}
1983 {b pullsummary {Show Pull Summary}}
1984 {b trustmtime {Trust File Modification Timestamps}}
1985 {i diffcontext {Number of Diff Context Lines}}
1987 set type [lindex $option 0]
1988 set name [lindex $option 1]
1989 set text [lindex $option 2]
1990 foreach f {repo global} {
1991 switch $type {
1993 checkbutton $w.$f.$name -text $text \
1994 -variable ${f}_config_new(gui.$name) \
1995 -onvalue true \
1996 -offvalue false \
1997 -font font_ui
1998 pack $w.$f.$name -side top -anchor w
2001 frame $w.$f.$name
2002 label $w.$f.$name.l -text "$text:" -font font_ui
2003 pack $w.$f.$name.l -side left -anchor w -fill x
2004 spinbox $w.$f.$name.v \
2005 -textvariable ${f}_config_new(gui.$name) \
2006 -from 1 -to 99 -increment 1 \
2007 -width 3 \
2008 -font font_ui
2009 pack $w.$f.$name.v -side right -anchor e
2010 pack $w.$f.$name -side top -anchor w -fill x
2016 set all_fonts [lsort [font families]]
2017 foreach option $font_descs {
2018 set name [lindex $option 0]
2019 set font [lindex $option 1]
2020 set text [lindex $option 2]
2022 set global_config_new(gui.$font^^family) \
2023 [font configure $font -family]
2024 set global_config_new(gui.$font^^size) \
2025 [font configure $font -size]
2027 frame $w.global.$name
2028 label $w.global.$name.l -text "$text:" -font font_ui
2029 pack $w.global.$name.l -side left -anchor w -fill x
2030 eval tk_optionMenu $w.global.$name.family \
2031 global_config_new(gui.$font^^family) \
2032 $all_fonts
2033 spinbox $w.global.$name.size \
2034 -textvariable global_config_new(gui.$font^^size) \
2035 -from 2 -to 80 -increment 1 \
2036 -width 3 \
2037 -font font_ui
2038 pack $w.global.$name.size -side right -anchor e
2039 pack $w.global.$name.family -side right -anchor e
2040 pack $w.global.$name -side top -anchor w -fill x
2043 bind $w <Visibility> "grab $w; focus $w"
2044 bind $w <Key-Escape> "destroy $w"
2045 wm title $w "$appname ($reponame): Options"
2046 tkwait window $w
2049 proc do_restore_defaults {} {
2050 global font_descs default_config repo_config
2051 global repo_config_new global_config_new
2053 foreach name [array names default_config] {
2054 set repo_config_new($name) $default_config($name)
2055 set global_config_new($name) $default_config($name)
2058 foreach option $font_descs {
2059 set name [lindex $option 0]
2060 set repo_config(gui.$name) $default_config(gui.$name)
2062 apply_config
2064 foreach option $font_descs {
2065 set name [lindex $option 0]
2066 set font [lindex $option 1]
2067 set global_config_new(gui.$font^^family) \
2068 [font configure $font -family]
2069 set global_config_new(gui.$font^^size) \
2070 [font configure $font -size]
2074 proc do_save_config {w} {
2075 if {[catch {save_config} err]} {
2076 error_popup "Failed to completely save options:\n\n$err"
2078 reshow_diff
2079 destroy $w
2082 proc do_windows_shortcut {} {
2083 global gitdir appname argv0
2085 set reponame [lindex [file split \
2086 [file normalize [file dirname $gitdir]]] \
2087 end]
2089 if {[catch {
2090 set desktop [exec cygpath \
2091 --windows \
2092 --absolute \
2093 --long-name \
2094 --desktop]
2095 }]} {
2096 set desktop .
2098 set fn [tk_getSaveFile \
2099 -parent . \
2100 -title "$appname ($reponame): Create Desktop Icon" \
2101 -initialdir $desktop \
2102 -initialfile "Git $reponame.bat"]
2103 if {$fn != {}} {
2104 if {[catch {
2105 set fd [open $fn w]
2106 set sh [exec cygpath \
2107 --windows \
2108 --absolute \
2109 --long-name \
2110 /bin/sh]
2111 set me [exec cygpath \
2112 --unix \
2113 --absolute \
2114 $argv0]
2115 set gd [exec cygpath \
2116 --unix \
2117 --absolute \
2118 $gitdir]
2119 regsub -all ' $me "'\\''" me
2120 regsub -all ' $gd "'\\''" gd
2121 puts -nonewline $fd "\"$sh\" --login -c \""
2122 puts -nonewline $fd "GIT_DIR='$gd'"
2123 puts -nonewline $fd " '$me'"
2124 puts $fd "&\""
2125 close $fd
2126 } err]} {
2127 error_popup "Cannot write script:\n\n$err"
2132 proc do_macosx_app {} {
2133 global gitdir appname argv0 env
2135 set reponame [lindex [file split \
2136 [file normalize [file dirname $gitdir]]] \
2137 end]
2139 set fn [tk_getSaveFile \
2140 -parent . \
2141 -title "$appname ($reponame): Create Desktop Icon" \
2142 -initialdir [file join $env(HOME) Desktop] \
2143 -initialfile "Git $reponame.app"]
2144 if {$fn != {}} {
2145 if {[catch {
2146 set Contents [file join $fn Contents]
2147 set MacOS [file join $Contents MacOS]
2148 set exe [file join $MacOS git-gui]
2150 file mkdir $MacOS
2152 set fd [open [file join $Contents PkgInfo] w]
2153 puts -nonewline $fd {APPL????}
2154 close $fd
2156 set fd [open [file join $Contents Info.plist] w]
2157 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2158 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2159 <plist version="1.0">
2160 <dict>
2161 <key>CFBundleDevelopmentRegion</key>
2162 <string>English</string>
2163 <key>CFBundleExecutable</key>
2164 <string>git-gui</string>
2165 <key>CFBundleIdentifier</key>
2166 <string>org.spearce.git-gui</string>
2167 <key>CFBundleInfoDictionaryVersion</key>
2168 <string>6.0</string>
2169 <key>CFBundlePackageType</key>
2170 <string>APPL</string>
2171 <key>CFBundleSignature</key>
2172 <string>????</string>
2173 <key>CFBundleVersion</key>
2174 <string>1.0</string>
2175 <key>NSPrincipalClass</key>
2176 <string>NSApplication</string>
2177 </dict>
2178 </plist>}
2179 close $fd
2181 set fd [open $exe w]
2182 set gd [file normalize $gitdir]
2183 set ep [file normalize [exec git --exec-path]]
2184 regsub -all ' $gd "'\\''" gd
2185 regsub -all ' $ep "'\\''" ep
2186 puts $fd "#!/bin/sh"
2187 foreach name [array names env] {
2188 if {[string match GIT_* $name]} {
2189 regsub -all ' $env($name) "'\\''" v
2190 puts $fd "export $name='$v'"
2193 puts $fd "export PATH='$ep':\$PATH"
2194 puts $fd "export GIT_DIR='$gd'"
2195 puts $fd "exec [file normalize $argv0]"
2196 close $fd
2198 file attributes $exe -permissions u+x,g+x,o+x
2199 } err]} {
2200 error_popup "Cannot write icon:\n\n$err"
2205 proc toggle_or_diff {w x y} {
2206 global file_lists current_diff ui_index ui_other
2207 global last_clicked selected_paths
2209 set pos [split [$w index @$x,$y] .]
2210 set lno [lindex $pos 0]
2211 set col [lindex $pos 1]
2212 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2213 if {$path eq {}} {
2214 set last_clicked {}
2215 return
2218 set last_clicked [list $w $lno]
2219 array unset selected_paths
2220 $ui_index tag remove in_sel 0.0 end
2221 $ui_other tag remove in_sel 0.0 end
2223 if {$col == 0} {
2224 if {$current_diff eq $path} {
2225 set after {reshow_diff;}
2226 } else {
2227 set after {}
2229 update_index \
2230 "Including [short_path $path]" \
2231 [list $path] \
2232 [concat $after {set ui_status_value {Ready.}}]
2233 } else {
2234 show_diff $path $w $lno
2238 proc add_one_to_selection {w x y} {
2239 global file_lists
2240 global last_clicked selected_paths
2242 set pos [split [$w index @$x,$y] .]
2243 set lno [lindex $pos 0]
2244 set col [lindex $pos 1]
2245 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2246 if {$path eq {}} {
2247 set last_clicked {}
2248 return
2251 set last_clicked [list $w $lno]
2252 if {[catch {set in_sel $selected_paths($path)}]} {
2253 set in_sel 0
2255 if {$in_sel} {
2256 unset selected_paths($path)
2257 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2258 } else {
2259 set selected_paths($path) 1
2260 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2264 proc add_range_to_selection {w x y} {
2265 global file_lists
2266 global last_clicked selected_paths
2268 if {[lindex $last_clicked 0] ne $w} {
2269 toggle_or_diff $w $x $y
2270 return
2273 set pos [split [$w index @$x,$y] .]
2274 set lno [lindex $pos 0]
2275 set lc [lindex $last_clicked 1]
2276 if {$lc < $lno} {
2277 set begin $lc
2278 set end $lno
2279 } else {
2280 set begin $lno
2281 set end $lc
2284 foreach path [lrange $file_lists($w) \
2285 [expr {$begin - 1}] \
2286 [expr {$end - 1}]] {
2287 set selected_paths($path) 1
2289 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2292 ######################################################################
2294 ## config defaults
2296 set cursor_ptr arrow
2297 font create font_diff -family Courier -size 10
2298 font create font_ui
2299 catch {
2300 label .dummy
2301 eval font configure font_ui [font actual [.dummy cget -font]]
2302 destroy .dummy
2305 font create font_uibold
2306 font create font_diffbold
2308 set M1B M1
2309 set M1T M1
2310 if {$tcl_platform(platform) eq {windows}} {
2311 set M1B Control
2312 set M1T Ctrl
2313 } elseif {[is_MacOSX]} {
2314 set M1B M1
2315 set M1T Cmd
2318 proc apply_config {} {
2319 global repo_config font_descs
2321 foreach option $font_descs {
2322 set name [lindex $option 0]
2323 set font [lindex $option 1]
2324 if {[catch {
2325 foreach {cn cv} $repo_config(gui.$name) {
2326 font configure $font $cn $cv
2328 } err]} {
2329 error_popup "Invalid font specified in gui.$name:\n\n$err"
2331 foreach {cn cv} [font configure $font] {
2332 font configure ${font}bold $cn $cv
2334 font configure ${font}bold -weight bold
2338 set default_config(gui.trustmtime) false
2339 set default_config(gui.pullsummary) true
2340 set default_config(gui.partialinclude) false
2341 set default_config(gui.diffcontext) 5
2342 set default_config(gui.fontui) [font configure font_ui]
2343 set default_config(gui.fontdiff) [font configure font_diff]
2344 set font_descs {
2345 {fontui font_ui {Main Font}}
2346 {fontdiff font_diff {Diff/Console Font}}
2348 load_config 0
2349 apply_config
2351 ######################################################################
2353 ## ui construction
2355 # -- Menu Bar
2356 menu .mbar -tearoff 0
2357 .mbar add cascade -label Project -menu .mbar.project
2358 .mbar add cascade -label Edit -menu .mbar.edit
2359 .mbar add cascade -label Commit -menu .mbar.commit
2360 if {!$single_commit} {
2361 .mbar add cascade -label Fetch -menu .mbar.fetch
2362 .mbar add cascade -label Pull -menu .mbar.pull
2363 .mbar add cascade -label Push -menu .mbar.push
2365 . configure -menu .mbar
2367 # -- Project Menu
2368 menu .mbar.project
2369 .mbar.project add command -label Visualize \
2370 -command do_gitk \
2371 -font font_ui
2372 if {!$single_commit} {
2373 .mbar.project add command -label {Repack Database} \
2374 -command do_repack \
2375 -font font_ui
2377 if {$tcl_platform(platform) eq {windows}} {
2378 .mbar.project add command \
2379 -label {Create Desktop Icon} \
2380 -command do_windows_shortcut \
2381 -font font_ui
2382 } elseif {[is_MacOSX]} {
2383 .mbar.project add command \
2384 -label {Create Desktop Icon} \
2385 -command do_macosx_app \
2386 -font font_ui
2389 .mbar.project add command -label Quit \
2390 -command do_quit \
2391 -accelerator $M1T-Q \
2392 -font font_ui
2394 # -- Edit Menu
2396 menu .mbar.edit
2397 .mbar.edit add command -label Undo \
2398 -command {catch {[focus] edit undo}} \
2399 -accelerator $M1T-Z \
2400 -font font_ui
2401 .mbar.edit add command -label Redo \
2402 -command {catch {[focus] edit redo}} \
2403 -accelerator $M1T-Y \
2404 -font font_ui
2405 .mbar.edit add separator
2406 .mbar.edit add command -label Cut \
2407 -command {catch {tk_textCut [focus]}} \
2408 -accelerator $M1T-X \
2409 -font font_ui
2410 .mbar.edit add command -label Copy \
2411 -command {catch {tk_textCopy [focus]}} \
2412 -accelerator $M1T-C \
2413 -font font_ui
2414 .mbar.edit add command -label Paste \
2415 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2416 -accelerator $M1T-V \
2417 -font font_ui
2418 .mbar.edit add command -label Delete \
2419 -command {catch {[focus] delete sel.first sel.last}} \
2420 -accelerator Del \
2421 -font font_ui
2422 .mbar.edit add separator
2423 .mbar.edit add command -label {Select All} \
2424 -command {catch {[focus] tag add sel 0.0 end}} \
2425 -accelerator $M1T-A \
2426 -font font_ui
2427 .mbar.edit add separator
2428 .mbar.edit add command -label {Options...} \
2429 -command do_options \
2430 -font font_ui
2432 # -- Commit Menu
2433 menu .mbar.commit
2434 .mbar.commit add command -label Rescan \
2435 -command do_rescan \
2436 -accelerator F5 \
2437 -font font_ui
2438 lappend disable_on_lock \
2439 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2440 .mbar.commit add command -label {Amend Last Commit} \
2441 -command do_amend_last \
2442 -font font_ui
2443 lappend disable_on_lock \
2444 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2445 .mbar.commit add command -label {Include All Files} \
2446 -command do_include_all \
2447 -accelerator $M1T-I \
2448 -font font_ui
2449 lappend disable_on_lock \
2450 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2451 .mbar.commit add command -label {Sign Off} \
2452 -command do_signoff \
2453 -accelerator $M1T-S \
2454 -font font_ui
2455 .mbar.commit add command -label Commit \
2456 -command do_commit \
2457 -accelerator $M1T-Return \
2458 -font font_ui
2459 lappend disable_on_lock \
2460 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2462 if {!$single_commit} {
2463 # -- Fetch Menu
2464 menu .mbar.fetch
2466 # -- Pull Menu
2467 menu .mbar.pull
2469 # -- Push Menu
2470 menu .mbar.push
2473 # -- Main Window Layout
2474 panedwindow .vpane -orient vertical
2475 panedwindow .vpane.files -orient horizontal
2476 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2477 pack .vpane -anchor n -side top -fill both -expand 1
2479 # -- Index File List
2480 frame .vpane.files.index -height 100 -width 400
2481 label .vpane.files.index.title -text {Modified Files} \
2482 -background green \
2483 -font font_ui
2484 text $ui_index -background white -borderwidth 0 \
2485 -width 40 -height 10 \
2486 -font font_ui \
2487 -cursor $cursor_ptr \
2488 -yscrollcommand {.vpane.files.index.sb set} \
2489 -state disabled
2490 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2491 pack .vpane.files.index.title -side top -fill x
2492 pack .vpane.files.index.sb -side right -fill y
2493 pack $ui_index -side left -fill both -expand 1
2494 .vpane.files add .vpane.files.index -sticky nsew
2496 # -- Other (Add) File List
2497 frame .vpane.files.other -height 100 -width 100
2498 label .vpane.files.other.title -text {Untracked Files} \
2499 -background red \
2500 -font font_ui
2501 text $ui_other -background white -borderwidth 0 \
2502 -width 40 -height 10 \
2503 -font font_ui \
2504 -cursor $cursor_ptr \
2505 -yscrollcommand {.vpane.files.other.sb set} \
2506 -state disabled
2507 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2508 pack .vpane.files.other.title -side top -fill x
2509 pack .vpane.files.other.sb -side right -fill y
2510 pack $ui_other -side left -fill both -expand 1
2511 .vpane.files add .vpane.files.other -sticky nsew
2513 foreach i [list $ui_index $ui_other] {
2514 $i tag conf in_diff -font font_uibold
2515 $i tag conf in_sel \
2516 -background [$i cget -foreground] \
2517 -foreground [$i cget -background]
2519 unset i
2521 # -- Diff and Commit Area
2522 frame .vpane.lower -height 300 -width 400
2523 frame .vpane.lower.commarea
2524 frame .vpane.lower.diff -relief sunken -borderwidth 1
2525 pack .vpane.lower.commarea -side top -fill x
2526 pack .vpane.lower.diff -side bottom -fill both -expand 1
2527 .vpane add .vpane.lower -stick nsew
2529 # -- Commit Area Buttons
2530 frame .vpane.lower.commarea.buttons
2531 label .vpane.lower.commarea.buttons.l -text {} \
2532 -anchor w \
2533 -justify left \
2534 -font font_ui
2535 pack .vpane.lower.commarea.buttons.l -side top -fill x
2536 pack .vpane.lower.commarea.buttons -side left -fill y
2538 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2539 -command do_rescan \
2540 -font font_ui
2541 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2542 lappend disable_on_lock \
2543 {.vpane.lower.commarea.buttons.rescan conf -state}
2545 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2546 -command do_amend_last \
2547 -font font_ui
2548 pack .vpane.lower.commarea.buttons.amend -side top -fill x
2549 lappend disable_on_lock \
2550 {.vpane.lower.commarea.buttons.amend conf -state}
2552 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2553 -command do_include_all \
2554 -font font_ui
2555 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2556 lappend disable_on_lock \
2557 {.vpane.lower.commarea.buttons.incall conf -state}
2559 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2560 -command do_signoff \
2561 -font font_ui
2562 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2564 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2565 -command do_commit \
2566 -font font_ui
2567 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2568 lappend disable_on_lock \
2569 {.vpane.lower.commarea.buttons.commit conf -state}
2571 # -- Commit Message Buffer
2572 frame .vpane.lower.commarea.buffer
2573 set ui_comm .vpane.lower.commarea.buffer.t
2574 set ui_coml .vpane.lower.commarea.buffer.l
2575 label $ui_coml -text {Commit Message:} \
2576 -anchor w \
2577 -justify left \
2578 -font font_ui
2579 proc trace_commit_type {varname args} {
2580 global ui_coml commit_type
2581 switch -glob -- $commit_type {
2582 initial {set txt {Initial Commit Message:}}
2583 amend {set txt {Amended Commit Message:}}
2584 amend-initial {set txt {Amended Initial Commit Message:}}
2585 merge {set txt {Merge Commit Message:}}
2586 * {set txt {Commit Message:}}
2588 $ui_coml conf -text $txt
2590 trace add variable commit_type write trace_commit_type
2591 text $ui_comm -background white -borderwidth 1 \
2592 -undo true \
2593 -maxundo 20 \
2594 -autoseparators true \
2595 -relief sunken \
2596 -width 75 -height 9 -wrap none \
2597 -font font_diff \
2598 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2599 scrollbar .vpane.lower.commarea.buffer.sby \
2600 -command [list $ui_comm yview]
2601 pack $ui_coml -side top -fill x
2602 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2603 pack $ui_comm -side left -fill y
2604 pack .vpane.lower.commarea.buffer -side left -fill y
2606 # -- Commit Message Buffer Context Menu
2608 set ctxm .vpane.lower.commarea.buffer.ctxm
2609 menu $ctxm -tearoff 0
2610 $ctxm add command \
2611 -label {Cut} \
2612 -font font_ui \
2613 -command {tk_textCut $ui_comm}
2614 $ctxm add command \
2615 -label {Copy} \
2616 -font font_ui \
2617 -command {tk_textCopy $ui_comm}
2618 $ctxm add command \
2619 -label {Paste} \
2620 -font font_ui \
2621 -command {tk_textPaste $ui_comm}
2622 $ctxm add command \
2623 -label {Delete} \
2624 -font font_ui \
2625 -command {$ui_comm delete sel.first sel.last}
2626 $ctxm add separator
2627 $ctxm add command \
2628 -label {Select All} \
2629 -font font_ui \
2630 -command {$ui_comm tag add sel 0.0 end}
2631 $ctxm add command \
2632 -label {Copy All} \
2633 -font font_ui \
2634 -command {
2635 $ui_comm tag add sel 0.0 end
2636 tk_textCopy $ui_comm
2637 $ui_comm tag remove sel 0.0 end
2639 $ctxm add separator
2640 $ctxm add command \
2641 -label {Sign Off} \
2642 -font font_ui \
2643 -command do_signoff
2644 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2646 # -- Diff Header
2647 set current_diff {}
2648 set diff_actions [list]
2649 proc trace_current_diff {varname args} {
2650 global current_diff diff_actions file_states
2651 if {$current_diff eq {}} {
2652 set s {}
2653 set f {}
2654 set p {}
2655 set o disabled
2656 } else {
2657 set p $current_diff
2658 set s [mapdesc [lindex $file_states($p) 0] $p]
2659 set f {File:}
2660 set p [escape_path $p]
2661 set o normal
2664 .vpane.lower.diff.header.status configure -text $s
2665 .vpane.lower.diff.header.file configure -text $f
2666 .vpane.lower.diff.header.path configure -text $p
2667 foreach w $diff_actions {
2668 uplevel #0 $w $o
2671 trace add variable current_diff write trace_current_diff
2673 frame .vpane.lower.diff.header -background orange
2674 label .vpane.lower.diff.header.status \
2675 -background orange \
2676 -width $max_status_desc \
2677 -anchor w \
2678 -justify left \
2679 -font font_ui
2680 label .vpane.lower.diff.header.file \
2681 -background orange \
2682 -anchor w \
2683 -justify left \
2684 -font font_ui
2685 label .vpane.lower.diff.header.path \
2686 -background orange \
2687 -anchor w \
2688 -justify left \
2689 -font font_ui
2690 pack .vpane.lower.diff.header.status -side left
2691 pack .vpane.lower.diff.header.file -side left
2692 pack .vpane.lower.diff.header.path -fill x
2693 set ctxm .vpane.lower.diff.header.ctxm
2694 menu $ctxm -tearoff 0
2695 $ctxm add command \
2696 -label {Copy} \
2697 -font font_ui \
2698 -command {
2699 clipboard clear
2700 clipboard append \
2701 -format STRING \
2702 -type STRING \
2703 -- $current_diff
2705 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2706 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2708 # -- Diff Body
2709 frame .vpane.lower.diff.body
2710 set ui_diff .vpane.lower.diff.body.t
2711 text $ui_diff -background white -borderwidth 0 \
2712 -width 80 -height 15 -wrap none \
2713 -font font_diff \
2714 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2715 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2716 -state disabled
2717 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2718 -command [list $ui_diff xview]
2719 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2720 -command [list $ui_diff yview]
2721 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2722 pack .vpane.lower.diff.body.sby -side right -fill y
2723 pack $ui_diff -side left -fill both -expand 1
2724 pack .vpane.lower.diff.header -side top -fill x
2725 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2727 $ui_diff tag conf dm -foreground red
2728 $ui_diff tag conf dp -foreground blue
2729 $ui_diff tag conf di -foreground {#00a000}
2730 $ui_diff tag conf dni -foreground {#a000a0}
2731 $ui_diff tag conf da -font font_diffbold
2732 $ui_diff tag conf bold -font font_diffbold
2734 # -- Diff Body Context Menu
2736 set ctxm .vpane.lower.diff.body.ctxm
2737 menu $ctxm -tearoff 0
2738 $ctxm add command \
2739 -label {Copy} \
2740 -font font_ui \
2741 -command {tk_textCopy $ui_diff}
2742 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2743 $ctxm add command \
2744 -label {Select All} \
2745 -font font_ui \
2746 -command {$ui_diff tag add sel 0.0 end}
2747 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2748 $ctxm add command \
2749 -label {Copy All} \
2750 -font font_ui \
2751 -command {
2752 $ui_diff tag add sel 0.0 end
2753 tk_textCopy $ui_diff
2754 $ui_diff tag remove sel 0.0 end
2756 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2757 $ctxm add separator
2758 $ctxm add command \
2759 -label {Decrease Font Size} \
2760 -font font_ui \
2761 -command {incr_font_size font_diff -1}
2762 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2763 $ctxm add command \
2764 -label {Increase Font Size} \
2765 -font font_ui \
2766 -command {incr_font_size font_diff 1}
2767 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2768 $ctxm add separator
2769 $ctxm add command \
2770 -label {Show Less Context} \
2771 -font font_ui \
2772 -command {if {$repo_config(gui.diffcontext) >= 2} {
2773 incr repo_config(gui.diffcontext) -1
2774 reshow_diff
2776 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2777 $ctxm add command \
2778 -label {Show More Context} \
2779 -font font_ui \
2780 -command {
2781 incr repo_config(gui.diffcontext)
2782 reshow_diff
2784 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2785 $ctxm add separator
2786 $ctxm add command -label {Options...} \
2787 -font font_ui \
2788 -command do_options
2789 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
2791 # -- Status Bar
2793 set ui_status_value {Initializing...}
2794 label .status -textvariable ui_status_value \
2795 -anchor w \
2796 -justify left \
2797 -borderwidth 1 \
2798 -relief sunken \
2799 -font font_ui
2800 pack .status -anchor w -side bottom -fill x
2802 # -- Load geometry
2804 catch {
2805 set gm $repo_config(gui.geometry)
2806 wm geometry . [lindex $gm 0]
2807 .vpane sash place 0 \
2808 [lindex [.vpane sash coord 0] 0] \
2809 [lindex $gm 1]
2810 .vpane.files sash place 0 \
2811 [lindex $gm 2] \
2812 [lindex [.vpane.files sash coord 0] 1]
2813 unset gm
2816 # -- Key Bindings
2818 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2819 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2820 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2821 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2822 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2823 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2824 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2825 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2826 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2827 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2828 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2830 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2831 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2832 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2833 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2834 bind $ui_diff <$M1B-Key-v> {break}
2835 bind $ui_diff <$M1B-Key-V> {break}
2836 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2837 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2838 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2839 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2840 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2841 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2843 bind . <Destroy> do_quit
2844 bind all <Key-F5> do_rescan
2845 bind all <$M1B-Key-r> do_rescan
2846 bind all <$M1B-Key-R> do_rescan
2847 bind . <$M1B-Key-s> do_signoff
2848 bind . <$M1B-Key-S> do_signoff
2849 bind . <$M1B-Key-i> do_include_all
2850 bind . <$M1B-Key-I> do_include_all
2851 bind . <$M1B-Key-Return> do_commit
2852 bind all <$M1B-Key-q> do_quit
2853 bind all <$M1B-Key-Q> do_quit
2854 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2855 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2856 foreach i [list $ui_index $ui_other] {
2857 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2858 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2859 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2861 unset i
2863 set file_lists($ui_index) [list]
2864 set file_lists($ui_other) [list]
2865 set current_diff {}
2867 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2868 focus -force $ui_comm
2869 if {!$single_commit} {
2870 load_all_remotes
2871 populate_fetch_menu .mbar.fetch
2872 populate_pull_menu .mbar.pull
2873 populate_push_menu .mbar.push
2875 after 1 do_rescan