git-gui: Cache the GIT_COMMITTER_IDENT value on first sign-off.
[git-gui.git] / git-gui
blobad3aa0727c55a8e62609cec658108e7ecf3dedd6
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 ######################################################################
12 ## task management
14 set single_commit 0
15 set status_active 0
16 set diff_active 0
17 set update_active 0
18 set commit_active 0
19 set update_index_fd {}
21 set disable_on_lock [list]
22 set index_lock_type none
24 set HEAD {}
25 set PARENT {}
26 set commit_type {}
28 proc lock_index {type} {
29 global index_lock_type disable_on_lock
31 if {$index_lock_type == {none}} {
32 set index_lock_type $type
33 foreach w $disable_on_lock {
34 uplevel #0 $w disabled
36 return 1
37 } elseif {$index_lock_type == {begin-update} && $type == {update}} {
38 set index_lock_type $type
39 return 1
41 return 0
44 proc unlock_index {} {
45 global index_lock_type disable_on_lock
47 set index_lock_type none
48 foreach w $disable_on_lock {
49 uplevel #0 $w normal
53 ######################################################################
55 ## status
57 proc repository_state {hdvar ctvar} {
58 global gitdir
59 upvar $hdvar hd $ctvar ct
61 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
62 set ct initial
63 } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
64 set ct merge
65 } else {
66 set ct normal
70 proc update_status {{final Ready.}} {
71 global HEAD PARENT commit_type
72 global ui_index ui_other ui_status_value ui_comm
73 global status_active file_states
74 global cfg_trust_mtime
76 if {$status_active || ![lock_index read]} return
78 repository_state new_HEAD new_type
79 if {$commit_type == {amend}
80 && $new_type == {normal}
81 && $new_HEAD == $HEAD} {
82 } else {
83 set HEAD $new_HEAD
84 set PARENT $new_HEAD
85 set commit_type $new_type
88 array unset file_states
89 foreach w [list $ui_index $ui_other] {
90 $w conf -state normal
91 $w delete 0.0 end
92 $w conf -state disabled
95 if {![$ui_comm edit modified]
96 || [string trim [$ui_comm get 0.0 end]] == {}} {
97 if {[load_message GITGUI_MSG]} {
98 } elseif {[load_message MERGE_MSG]} {
99 } elseif {[load_message SQUASH_MSG]} {
101 $ui_comm edit modified false
104 if {$cfg_trust_mtime == {true}} {
105 update_status_stage2 {} $final
106 } else {
107 set status_active 1
108 set ui_status_value {Refreshing file status...}
109 set fd_rf [open "| git update-index -q --unmerged --refresh" r]
110 fconfigure $fd_rf -blocking 0 -translation binary
111 fileevent $fd_rf readable [list update_status_stage2 $fd_rf $final]
115 proc update_status_stage2 {fd final} {
116 global gitdir PARENT commit_type
117 global ui_index ui_other ui_status_value ui_comm
118 global status_active file_states
119 global buf_rdi buf_rdf buf_rlo
121 if {$fd != {}} {
122 read $fd
123 if {![eof $fd]} return
124 close $fd
127 set ls_others [list | git ls-files --others -z \
128 --exclude-per-directory=.gitignore]
129 set info_exclude [file join $gitdir info exclude]
130 if {[file readable $info_exclude]} {
131 lappend ls_others "--exclude-from=$info_exclude"
134 set buf_rdi {}
135 set buf_rdf {}
136 set buf_rlo {}
138 set status_active 3
139 set ui_status_value {Scanning for modified files ...}
140 set fd_di [open "| git diff-index --cached -z $PARENT" r]
141 set fd_df [open "| git diff-files -z" r]
142 set fd_lo [open $ls_others r]
144 fconfigure $fd_di -blocking 0 -translation binary
145 fconfigure $fd_df -blocking 0 -translation binary
146 fconfigure $fd_lo -blocking 0 -translation binary
147 fileevent $fd_di readable [list read_diff_index $fd_di $final]
148 fileevent $fd_df readable [list read_diff_files $fd_df $final]
149 fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
152 proc load_message {file} {
153 global gitdir ui_comm
155 set f [file join $gitdir $file]
156 if {[file isfile $f]} {
157 if {[catch {set fd [open $f r]}]} {
158 return 0
160 set content [string trim [read $fd]]
161 close $fd
162 $ui_comm delete 0.0 end
163 $ui_comm insert end $content
164 return 1
166 return 0
169 proc read_diff_index {fd final} {
170 global buf_rdi
172 append buf_rdi [read $fd]
173 set c 0
174 set n [string length $buf_rdi]
175 while {$c < $n} {
176 set z1 [string first "\0" $buf_rdi $c]
177 if {$z1 == -1} break
178 incr z1
179 set z2 [string first "\0" $buf_rdi $z1]
180 if {$z2 == -1} break
182 set c $z2
183 incr z2 -1
184 display_file \
185 [string range $buf_rdi $z1 $z2] \
186 [string index $buf_rdi [expr $z1 - 2]]_
187 incr c
189 if {$c < $n} {
190 set buf_rdi [string range $buf_rdi $c end]
191 } else {
192 set buf_rdi {}
195 status_eof $fd buf_rdi $final
198 proc read_diff_files {fd final} {
199 global buf_rdf
201 append buf_rdf [read $fd]
202 set c 0
203 set n [string length $buf_rdf]
204 while {$c < $n} {
205 set z1 [string first "\0" $buf_rdf $c]
206 if {$z1 == -1} break
207 incr z1
208 set z2 [string first "\0" $buf_rdf $z1]
209 if {$z2 == -1} break
211 set c $z2
212 incr z2 -1
213 display_file \
214 [string range $buf_rdf $z1 $z2] \
215 _[string index $buf_rdf [expr $z1 - 2]]
216 incr c
218 if {$c < $n} {
219 set buf_rdf [string range $buf_rdf $c end]
220 } else {
221 set buf_rdf {}
224 status_eof $fd buf_rdf $final
227 proc read_ls_others {fd final} {
228 global buf_rlo
230 append buf_rlo [read $fd]
231 set pck [split $buf_rlo "\0"]
232 set buf_rlo [lindex $pck end]
233 foreach p [lrange $pck 0 end-1] {
234 display_file $p _O
236 status_eof $fd buf_rlo $final
239 proc status_eof {fd buf final} {
240 global status_active $buf
241 global ui_fname_value ui_status_value file_states
243 if {[eof $fd]} {
244 set $buf {}
245 close $fd
247 if {[incr status_active -1] == 0} {
248 unlock_index
250 display_all_files
251 set ui_status_value $final
253 if {$ui_fname_value != {} && [array names file_states \
254 -exact $ui_fname_value] != {}} {
255 show_diff $ui_fname_value
256 } else {
257 clear_diff
263 ######################################################################
265 ## diff
267 proc clear_diff {} {
268 global ui_diff ui_fname_value ui_fstatus_value
270 $ui_diff conf -state normal
271 $ui_diff delete 0.0 end
272 $ui_diff conf -state disabled
273 set ui_fname_value {}
274 set ui_fstatus_value {}
277 proc show_diff {path} {
278 global file_states PARENT diff_3way diff_active
279 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
281 if {$diff_active || ![lock_index read]} return
283 clear_diff
284 set s $file_states($path)
285 set m [lindex $s 0]
286 set diff_3way 0
287 set diff_active 1
288 set ui_fname_value $path
289 set ui_fstatus_value [mapdesc $m $path]
290 set ui_status_value "Loading diff of $path..."
292 set cmd [list | git diff-index -p $PARENT -- $path]
293 switch $m {
294 AM {
296 MM {
297 set cmd [list | git diff-index -p -c $PARENT $path]
299 _O {
300 if {[catch {
301 set fd [open $path r]
302 set content [read $fd]
303 close $fd
304 } err ]} {
305 set diff_active 0
306 unlock_index
307 set ui_status_value "Unable to display $path"
308 error_popup "Error loading file:\n$err"
309 return
311 $ui_diff conf -state normal
312 $ui_diff insert end $content
313 $ui_diff conf -state disabled
314 set diff_active 0
315 unlock_index
316 set ui_status_value {Ready.}
317 return
321 if {[catch {set fd [open $cmd r]} err]} {
322 set diff_active 0
323 unlock_index
324 set ui_status_value "Unable to display $path"
325 error_popup "Error loading diff:\n$err"
326 return
329 fconfigure $fd -blocking 0 -translation auto
330 fileevent $fd readable [list read_diff $fd]
333 proc read_diff {fd} {
334 global ui_diff ui_status_value diff_3way diff_active
336 while {[gets $fd line] >= 0} {
337 if {[string match {diff --git *} $line]} continue
338 if {[string match {diff --combined *} $line]} continue
339 if {[string match {--- *} $line]} continue
340 if {[string match {+++ *} $line]} continue
341 if {[string match index* $line]} {
342 if {[string first , $line] >= 0} {
343 set diff_3way 1
347 $ui_diff conf -state normal
348 if {!$diff_3way} {
349 set x [string index $line 0]
350 switch -- $x {
351 "@" {set tags da}
352 "+" {set tags dp}
353 "-" {set tags dm}
354 default {set tags {}}
356 } else {
357 set x [string range $line 0 1]
358 switch -- $x {
359 default {set tags {}}
360 "@@" {set tags da}
361 "++" {set tags dp; set x " +"}
362 " +" {set tags {di bold}; set x "++"}
363 "+ " {set tags dni; set x "-+"}
364 "--" {set tags dm; set x " -"}
365 " -" {set tags {dm bold}; set x "--"}
366 "- " {set tags di; set x "+-"}
367 default {set tags {}}
369 set line [string replace $line 0 1 $x]
371 $ui_diff insert end $line $tags
372 $ui_diff insert end "\n"
373 $ui_diff conf -state disabled
376 if {[eof $fd]} {
377 close $fd
378 set diff_active 0
379 unlock_index
380 set ui_status_value {Ready.}
384 ######################################################################
386 ## commit
388 proc load_last_commit {} {
389 global HEAD PARENT commit_type ui_comm
391 if {$commit_type == {amend}} return
392 if {$commit_type != {normal}} {
393 error_popup "Can't amend a $commit_type commit."
394 return
397 set msg {}
398 set parent {}
399 set parent_count 0
400 if {[catch {
401 set fd [open "| git cat-file commit $HEAD" r]
402 while {[gets $fd line] > 0} {
403 if {[string match {parent *} $line]} {
404 set parent [string range $line 7 end]
405 incr parent_count
408 set msg [string trim [read $fd]]
409 close $fd
410 } err]} {
411 error_popup "Error loading commit data for amend:\n$err"
412 return
415 if {$parent_count == 0} {
416 set commit_type amend
417 set HEAD {}
418 set PARENT {}
419 update_status
420 } elseif {$parent_count == 1} {
421 set commit_type amend
422 set PARENT $parent
423 $ui_comm delete 0.0 end
424 $ui_comm insert end $msg
425 $ui_comm edit modified false
426 update_status
427 } else {
428 error_popup {You can't amend a merge commit.}
429 return
433 proc commit_tree {} {
434 global tcl_platform HEAD gitdir commit_type file_states
435 global commit_active ui_status_value
436 global ui_comm
438 if {$commit_active || ![lock_index update]} return
440 # -- Our in memory state should match the repository.
442 repository_state curHEAD cur_type
443 if {$commit_type == {amend}
444 && $cur_type == {normal}
445 && $curHEAD == $HEAD} {
446 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
447 error_popup {Last scanned state does not match repository state.
449 Its highly likely that another Git program modified the
450 repository since our last scan. A rescan is required
451 before committing.
453 unlock_index
454 update_status
455 return
458 # -- At least one file should differ in the index.
460 set files_ready 0
461 foreach path [array names file_states] {
462 set s $file_states($path)
463 switch -glob -- [lindex $s 0] {
464 _* {continue}
465 A* -
466 D* -
467 M* {set files_ready 1; break}
468 U* {
469 error_popup "Unmerged files cannot be committed.
471 File $path has merge conflicts.
472 You must resolve them and include the file before committing.
474 unlock_index
475 return
477 default {
478 error_popup "Unknown file state [lindex $s 0] detected.
480 File $path cannot be committed by this program.
485 if {!$files_ready} {
486 error_popup {No included files to commit.
488 You must include at least 1 file before you can commit.
490 unlock_index
491 return
494 # -- A message is required.
496 set msg [string trim [$ui_comm get 1.0 end]]
497 if {$msg == {}} {
498 error_popup {Please supply a commit message.
500 A good commit message has the following format:
502 - First line: Describe in one sentance what you did.
503 - Second line: Blank
504 - Remaining lines: Describe why this change is good.
506 unlock_index
507 return
510 # -- Ask the pre-commit hook for the go-ahead.
512 set pchook [file join $gitdir hooks pre-commit]
513 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
514 set pchook [list sh -c \
515 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
516 } elseif {[file executable $pchook]} {
517 set pchook [list $pchook]
518 } else {
519 set pchook {}
521 if {$pchook != {} && [catch {eval exec $pchook} err]} {
522 hook_failed_popup pre-commit $err
523 unlock_index
524 return
527 # -- Write the tree in the background.
529 set commit_active 1
530 set ui_status_value {Committing changes...}
532 set fd_wt [open "| git write-tree" r]
533 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
536 proc commit_stage2 {fd_wt curHEAD msg} {
537 global single_commit gitdir PARENT commit_type
538 global commit_active ui_status_value ui_comm
540 gets $fd_wt tree_id
541 close $fd_wt
543 if {$tree_id == {}} {
544 error_popup "write-tree failed"
545 set commit_active 0
546 set ui_status_value {Commit failed.}
547 unlock_index
548 return
551 # -- Create the commit.
553 set cmd [list git commit-tree $tree_id]
554 if {$PARENT != {}} {
555 lappend cmd -p $PARENT
557 if {$commit_type == {merge}} {
558 if {[catch {
559 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
560 while {[gets $fd_mh merge_head] >= 0} {
561 lappend cmd -p $merge_head
563 close $fd_mh
564 } err]} {
565 error_popup "Loading MERGE_HEADs failed:\n$err"
566 set commit_active 0
567 set ui_status_value {Commit failed.}
568 unlock_index
569 return
572 if {$PARENT == {}} {
573 # git commit-tree writes to stderr during initial commit.
574 lappend cmd 2>/dev/null
576 lappend cmd << $msg
577 if {[catch {set cmt_id [eval exec $cmd]} err]} {
578 error_popup "commit-tree failed:\n$err"
579 set commit_active 0
580 set ui_status_value {Commit failed.}
581 unlock_index
582 return
585 # -- Update the HEAD ref.
587 set reflogm commit
588 if {$commit_type != {normal}} {
589 append reflogm " ($commit_type)"
591 set i [string first "\n" $msg]
592 if {$i >= 0} {
593 append reflogm {: } [string range $msg 0 [expr $i - 1]]
594 } else {
595 append reflogm {: } $msg
597 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
598 if {[catch {eval exec $cmd} err]} {
599 error_popup "update-ref failed:\n$err"
600 set commit_active 0
601 set ui_status_value {Commit failed.}
602 unlock_index
603 return
606 # -- Cleanup after ourselves.
608 catch {file delete [file join $gitdir MERGE_HEAD]}
609 catch {file delete [file join $gitdir MERGE_MSG]}
610 catch {file delete [file join $gitdir SQUASH_MSG]}
611 catch {file delete [file join $gitdir GITGUI_MSG]}
613 # -- Let rerere do its thing.
615 if {[file isdirectory [file join $gitdir rr-cache]]} {
616 catch {exec git rerere}
619 $ui_comm delete 0.0 end
620 $ui_comm edit modified false
622 if {$single_commit} do_quit
624 set commit_type {}
625 set commit_active 0
626 set HEAD $cmt_id
627 set PARENT $cmt_id
628 unlock_index
629 update_status "Changes committed as [string range $cmt_id 0 7]."
632 ######################################################################
634 ## fetch pull push
636 proc fetch_from {remote} {
637 set w [new_console "fetch $remote" \
638 "Fetching new changes from $remote"]
639 set cmd [list git fetch]
640 lappend cmd $remote
641 console_exec $w $cmd
644 proc pull_remote {remote branch} {
645 global HEAD commit_type
646 global file_states
648 if {![lock_index update]} return
650 # -- Our in memory state should match the repository.
652 repository_state curHEAD cur_type
653 if {$commit_type != $cur_type || $HEAD != $curHEAD} {
654 error_popup {Last scanned state does not match repository state.
656 Its highly likely that another Git program modified the
657 repository since our last scan. A rescan is required
658 before a pull can be started.
660 unlock_index
661 update_status
662 return
665 # -- No differences should exist before a pull.
667 if {[array size file_states] != 0} {
668 error_popup {Uncommitted but modified files are present.
670 You should not perform a pull with unmodified files in your working
671 directory as Git would be unable to recover from an incorrect merge.
673 Commit or throw away all changes before starting a pull operation.
675 unlock_index
676 return
679 set w [new_console "pull $remote $branch" \
680 "Pulling new changes from branch $branch in $remote"]
681 set cmd [list git pull]
682 lappend cmd $remote
683 lappend cmd $branch
684 console_exec $w $cmd [list post_pull_remote $remote $branch]
687 proc post_pull_remote {remote branch success} {
688 global HEAD PARENT commit_type
689 global ui_status_value
691 unlock_index
692 if {$success} {
693 repository_state HEAD commit_type
694 set PARENT $HEAD
695 set $ui_status_value {Ready.}
696 } else {
697 update_status "Conflicts detected while pulling $branch from $remote."
701 proc push_to {remote} {
702 set w [new_console "push $remote" \
703 "Pushing changes to $remote"]
704 set cmd [list git push]
705 lappend cmd $remote
706 console_exec $w $cmd
709 ######################################################################
711 ## ui helpers
713 proc mapcol {state path} {
714 global all_cols ui_other
716 if {[catch {set r $all_cols($state)}]} {
717 puts "error: no column for state={$state} $path"
718 return $ui_other
720 return $r
723 proc mapicon {state path} {
724 global all_icons
726 if {[catch {set r $all_icons($state)}]} {
727 puts "error: no icon for state={$state} $path"
728 return file_plain
730 return $r
733 proc mapdesc {state path} {
734 global all_descs
736 if {[catch {set r $all_descs($state)}]} {
737 puts "error: no desc for state={$state} $path"
738 return $state
740 return $r
743 proc bsearch {w path} {
744 set hi [expr [lindex [split [$w index end] .] 0] - 2]
745 if {$hi == 0} {
746 return -1
748 set lo 0
749 while {$lo < $hi} {
750 set mi [expr [expr $lo + $hi] / 2]
751 set ti [expr $mi + 1]
752 set cmp [string compare [$w get $ti.1 $ti.end] $path]
753 if {$cmp < 0} {
754 set lo $ti
755 } elseif {$cmp == 0} {
756 return $mi
757 } else {
758 set hi $mi
761 return -[expr $lo + 1]
764 set next_icon_id 0
766 proc merge_state {path new_state} {
767 global file_states next_icon_id
769 set s0 [string index $new_state 0]
770 set s1 [string index $new_state 1]
772 if {[catch {set info $file_states($path)}]} {
773 set state __
774 set icon n[incr next_icon_id]
775 } else {
776 set state [lindex $info 0]
777 set icon [lindex $info 1]
780 if {$s0 == {_}} {
781 set s0 [string index $state 0]
782 } elseif {$s0 == {*}} {
783 set s0 _
786 if {$s1 == {_}} {
787 set s1 [string index $state 1]
788 } elseif {$s1 == {*}} {
789 set s1 _
792 set file_states($path) [list $s0$s1 $icon]
793 return $state
796 proc display_file {path state} {
797 global ui_index ui_other file_states status_active
799 set old_m [merge_state $path $state]
800 if {$status_active} return
802 set s $file_states($path)
803 set new_m [lindex $s 0]
804 set new_w [mapcol $new_m $path]
805 set old_w [mapcol $old_m $path]
806 set new_icon [mapicon $new_m $path]
808 if {$new_w != $old_w} {
809 set lno [bsearch $old_w $path]
810 if {$lno >= 0} {
811 incr lno
812 $old_w conf -state normal
813 $old_w delete $lno.0 [expr $lno + 1].0
814 $old_w conf -state disabled
817 set lno [expr abs([bsearch $new_w $path] + 1) + 1]
818 $new_w conf -state normal
819 $new_w image create $lno.0 \
820 -align center -padx 5 -pady 1 \
821 -name [lindex $s 1] \
822 -image $new_icon
823 $new_w insert $lno.1 "$path\n"
824 $new_w conf -state disabled
825 } elseif {$new_icon != [mapicon $old_m $path]} {
826 $new_w conf -state normal
827 $new_w image conf [lindex $s 1] -image $new_icon
828 $new_w conf -state disabled
832 proc display_all_files {} {
833 global ui_index ui_other file_states
835 $ui_index conf -state normal
836 $ui_other conf -state normal
838 foreach path [lsort [array names file_states]] {
839 set s $file_states($path)
840 set m [lindex $s 0]
841 set w [mapcol $m $path]
842 $w image create end \
843 -align center -padx 5 -pady 1 \
844 -name [lindex $s 1] \
845 -image [mapicon $m $path]
846 $w insert end "$path\n"
849 $ui_index conf -state disabled
850 $ui_other conf -state disabled
853 proc with_update_index {body} {
854 global update_index_fd
856 if {$update_index_fd == {}} {
857 if {![lock_index update]} return
858 set update_index_fd [open \
859 "| git update-index --add --remove -z --stdin" \
861 fconfigure $update_index_fd -translation binary
862 uplevel 1 $body
863 close $update_index_fd
864 set update_index_fd {}
865 unlock_index
866 } else {
867 uplevel 1 $body
871 proc update_index {path} {
872 global update_index_fd
874 if {$update_index_fd == {}} {
875 error {not in with_update_index}
876 } else {
877 puts -nonewline $update_index_fd "$path\0"
881 proc toggle_mode {path} {
882 global file_states ui_fname_value
884 set s $file_states($path)
885 set m [lindex $s 0]
887 switch -- $m {
888 AM -
889 _O {set new A*}
890 _M -
891 MM {set new M*}
892 AD -
893 _D {set new D*}
894 default {return}
897 with_update_index {update_index $path}
898 display_file $path $new
899 if {$ui_fname_value == $path} {
900 show_diff $path
904 ######################################################################
906 ## config (fetch push pull)
908 proc load_repo_config {} {
909 global repo_config
910 global cfg_trust_mtime
912 array unset repo_config
913 catch {
914 set fd_rc [open "| git repo-config --list" r]
915 while {[gets $fd_rc line] >= 0} {
916 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
917 lappend repo_config($name) $value
920 close $fd_rc
923 if {[catch {set cfg_trust_mtime $repo_config(gui.trustmtime)}]} {
924 set cfg_trust_mtime false
928 proc save_my_config {} {
929 global repo_config
930 global cfg_trust_mtime
932 if {[catch {set rc_trustMTime $repo_config(gui.trustmtime)}]} {
933 set rc_trustMTime false
935 if {$cfg_trust_mtime != $rc_trustMTime} {
936 exec git repo-config gui.trustMTime $cfg_trust_mtime
940 proc load_all_remotes {} {
941 global gitdir all_remotes repo_config
943 set all_remotes [list]
944 set rm_dir [file join $gitdir remotes]
945 if {[file isdirectory $rm_dir]} {
946 set all_remotes [concat $all_remotes [glob \
947 -types f \
948 -tails \
949 -nocomplain \
950 -directory $rm_dir *]]
953 foreach line [array names repo_config remote.*.url] {
954 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
955 lappend all_remotes $name
959 set all_remotes [lsort -unique $all_remotes]
962 proc populate_remote_menu {m pfx op} {
963 global all_remotes mainfont
965 foreach remote $all_remotes {
966 $m add command -label "$pfx $remote..." \
967 -command [list $op $remote] \
968 -font $mainfont
972 proc populate_pull_menu {m} {
973 global gitdir repo_config all_remotes mainfont disable_on_lock
975 foreach remote $all_remotes {
976 set rb {}
977 if {[array get repo_config remote.$remote.url] != {}} {
978 if {[array get repo_config remote.$remote.fetch] != {}} {
979 regexp {^([^:]+):} \
980 [lindex $repo_config(remote.$remote.fetch) 0] \
981 line rb
983 } else {
984 catch {
985 set fd [open [file join $gitdir remotes $remote] r]
986 while {[gets $fd line] >= 0} {
987 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
988 break
991 close $fd
995 set rb_short $rb
996 regsub ^refs/heads/ $rb {} rb_short
997 if {$rb_short != {}} {
998 $m add command \
999 -label "Branch $rb_short from $remote..." \
1000 -command [list pull_remote $remote $rb] \
1001 -font $mainfont
1002 lappend disable_on_lock \
1003 [list $m entryconf [$m index last] -state]
1008 ######################################################################
1010 ## icons
1012 set filemask {
1013 #define mask_width 14
1014 #define mask_height 15
1015 static unsigned char mask_bits[] = {
1016 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1017 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1018 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1021 image create bitmap file_plain -background white -foreground black -data {
1022 #define plain_width 14
1023 #define plain_height 15
1024 static unsigned char plain_bits[] = {
1025 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1026 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1027 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1028 } -maskdata $filemask
1030 image create bitmap file_mod -background white -foreground blue -data {
1031 #define mod_width 14
1032 #define mod_height 15
1033 static unsigned char mod_bits[] = {
1034 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1035 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1036 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1037 } -maskdata $filemask
1039 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1040 #define file_fulltick_width 14
1041 #define file_fulltick_height 15
1042 static unsigned char file_fulltick_bits[] = {
1043 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1044 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1045 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1046 } -maskdata $filemask
1048 image create bitmap file_parttick -background white -foreground "#005050" -data {
1049 #define parttick_width 14
1050 #define parttick_height 15
1051 static unsigned char parttick_bits[] = {
1052 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1053 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1054 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1055 } -maskdata $filemask
1057 image create bitmap file_question -background white -foreground black -data {
1058 #define file_question_width 14
1059 #define file_question_height 15
1060 static unsigned char file_question_bits[] = {
1061 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1062 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1063 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1064 } -maskdata $filemask
1066 image create bitmap file_removed -background white -foreground red -data {
1067 #define file_removed_width 14
1068 #define file_removed_height 15
1069 static unsigned char file_removed_bits[] = {
1070 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1071 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1072 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1073 } -maskdata $filemask
1075 image create bitmap file_merge -background white -foreground blue -data {
1076 #define file_merge_width 14
1077 #define file_merge_height 15
1078 static unsigned char file_merge_bits[] = {
1079 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1080 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1081 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1082 } -maskdata $filemask
1084 set ui_index .vpane.files.index.list
1085 set ui_other .vpane.files.other.list
1086 set max_status_desc 0
1087 foreach i {
1088 {__ i plain "Unmodified"}
1089 {_M i mod "Modified"}
1090 {M_ i fulltick "Checked in"}
1091 {MM i parttick "Partially included"}
1093 {_O o plain "Untracked"}
1094 {A_ o fulltick "Added"}
1095 {AM o parttick "Partially added"}
1096 {AD o question "Added (but now gone)"}
1098 {_D i question "Missing"}
1099 {D_ i removed "Removed"}
1100 {DD i removed "Removed"}
1101 {DO i removed "Removed (still exists)"}
1103 {UM i merge "Merge conflicts"}
1104 {U_ i merge "Merge conflicts"}
1106 if {$max_status_desc < [string length [lindex $i 3]]} {
1107 set max_status_desc [string length [lindex $i 3]]
1109 if {[lindex $i 1] == {i}} {
1110 set all_cols([lindex $i 0]) $ui_index
1111 } else {
1112 set all_cols([lindex $i 0]) $ui_other
1114 set all_icons([lindex $i 0]) file_[lindex $i 2]
1115 set all_descs([lindex $i 0]) [lindex $i 3]
1117 unset filemask i
1119 ######################################################################
1121 ## util
1123 proc error_popup {msg} {
1124 set w .error
1125 toplevel $w
1126 wm transient $w .
1127 show_msg $w $w $msg
1130 proc show_msg {w top msg} {
1131 global gitdir appname mainfont
1133 message $w.m -text $msg -justify left -aspect 400
1134 pack $w.m -side top -fill x -padx 5 -pady 10
1135 button $w.ok -text OK \
1136 -width 15 \
1137 -font $mainfont \
1138 -command "destroy $top"
1139 pack $w.ok -side bottom
1140 bind $top <Visibility> "grab $top; focus $top"
1141 bind $top <Key-Return> "destroy $top"
1142 wm title $w "$appname ([lindex [file split \
1143 [file normalize [file dirname $gitdir]]] \
1144 end]): error"
1145 tkwait window $top
1148 proc hook_failed_popup {hook msg} {
1149 global gitdir mainfont difffont appname
1151 set w .hookfail
1152 toplevel $w
1153 wm transient $w .
1155 frame $w.m
1156 label $w.m.l1 -text "$hook hook failed:" \
1157 -anchor w \
1158 -justify left \
1159 -font [concat $mainfont bold]
1160 text $w.m.t \
1161 -background white -borderwidth 1 \
1162 -relief sunken \
1163 -width 80 -height 10 \
1164 -font $difffont \
1165 -yscrollcommand [list $w.m.sby set]
1166 label $w.m.l2 \
1167 -text {You must correct the above errors before committing.} \
1168 -anchor w \
1169 -justify left \
1170 -font [concat $mainfont bold]
1171 scrollbar $w.m.sby -command [list $w.m.t yview]
1172 pack $w.m.l1 -side top -fill x
1173 pack $w.m.l2 -side bottom -fill x
1174 pack $w.m.sby -side right -fill y
1175 pack $w.m.t -side left -fill both -expand 1
1176 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1178 $w.m.t insert 1.0 $msg
1179 $w.m.t conf -state disabled
1181 button $w.ok -text OK \
1182 -width 15 \
1183 -font $mainfont \
1184 -command "destroy $w"
1185 pack $w.ok -side bottom
1187 bind $w <Visibility> "grab $w; focus $w"
1188 bind $w <Key-Return> "destroy $w"
1189 wm title $w "$appname ([lindex [file split \
1190 [file normalize [file dirname $gitdir]]] \
1191 end]): error"
1192 tkwait window $w
1195 set next_console_id 0
1197 proc new_console {short_title long_title} {
1198 global next_console_id console_data
1199 set w .console[incr next_console_id]
1200 set console_data($w) [list $short_title $long_title]
1201 return [console_init $w]
1204 proc console_init {w} {
1205 global console_cr console_data
1206 global gitdir appname mainfont difffont
1208 set console_cr($w) 1.0
1209 toplevel $w
1210 frame $w.m
1211 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1212 -anchor w \
1213 -justify left \
1214 -font [concat $mainfont bold]
1215 text $w.m.t \
1216 -background white -borderwidth 1 \
1217 -relief sunken \
1218 -width 80 -height 10 \
1219 -font $difffont \
1220 -state disabled \
1221 -yscrollcommand [list $w.m.sby set]
1222 label $w.m.s -anchor w \
1223 -justify left \
1224 -font [concat $mainfont bold]
1225 scrollbar $w.m.sby -command [list $w.m.t yview]
1226 pack $w.m.l1 -side top -fill x
1227 pack $w.m.s -side bottom -fill x
1228 pack $w.m.sby -side right -fill y
1229 pack $w.m.t -side left -fill both -expand 1
1230 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1232 button $w.ok -text {Running...} \
1233 -width 15 \
1234 -font $mainfont \
1235 -state disabled \
1236 -command "destroy $w"
1237 pack $w.ok -side bottom
1239 bind $w <Visibility> "focus $w"
1240 wm title $w "$appname ([lindex [file split \
1241 [file normalize [file dirname $gitdir]]] \
1242 end]): [lindex $console_data($w) 0]"
1243 return $w
1246 proc console_exec {w cmd {after {}}} {
1247 global tcl_platform
1249 # -- Windows tosses the enviroment when we exec our child.
1250 # But most users need that so we have to relogin. :-(
1252 if {$tcl_platform(platform) == {windows}} {
1253 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1256 # -- Tcl won't let us redirect both stdout and stderr to
1257 # the same pipe. So pass it through cat...
1259 set cmd [concat | $cmd |& cat]
1261 set fd_f [open $cmd r]
1262 fconfigure $fd_f -blocking 0 -translation binary
1263 fileevent $fd_f readable [list console_read $w $fd_f $after]
1266 proc console_read {w fd after} {
1267 global console_cr console_data
1269 set buf [read $fd]
1270 if {$buf != {}} {
1271 if {![winfo exists $w]} {console_init $w}
1272 $w.m.t conf -state normal
1273 set c 0
1274 set n [string length $buf]
1275 while {$c < $n} {
1276 set cr [string first "\r" $buf $c]
1277 set lf [string first "\n" $buf $c]
1278 if {$cr < 0} {set cr [expr $n + 1]}
1279 if {$lf < 0} {set lf [expr $n + 1]}
1281 if {$lf < $cr} {
1282 $w.m.t insert end [string range $buf $c $lf]
1283 set console_cr($w) [$w.m.t index {end -1c}]
1284 set c $lf
1285 incr c
1286 } else {
1287 $w.m.t delete $console_cr($w) end
1288 $w.m.t insert end "\n"
1289 $w.m.t insert end [string range $buf $c $cr]
1290 set c $cr
1291 incr c
1294 $w.m.t conf -state disabled
1295 $w.m.t see end
1298 fconfigure $fd -blocking 1
1299 if {[eof $fd]} {
1300 if {[catch {close $fd}]} {
1301 if {![winfo exists $w]} {console_init $w}
1302 $w.m.s conf -background red -text {Error: Command Failed}
1303 $w.ok conf -text Close
1304 $w.ok conf -state normal
1305 set ok 0
1306 } elseif {[winfo exists $w]} {
1307 $w.m.s conf -background green -text {Success}
1308 $w.ok conf -text Close
1309 $w.ok conf -state normal
1310 set ok 1
1312 array unset console_cr $w
1313 array unset console_data $w
1314 if {$after != {}} {
1315 uplevel #0 $after $ok
1317 return
1319 fconfigure $fd -blocking 0
1322 ######################################################################
1324 ## ui commands
1326 set starting_gitk_msg {Please wait... Starting gitk...}
1328 proc do_gitk {} {
1329 global tcl_platform ui_status_value starting_gitk_msg
1331 set ui_status_value $starting_gitk_msg
1332 after 10000 {
1333 if {$ui_status_value == $starting_gitk_msg} {
1334 set ui_status_value {Ready.}
1338 if {$tcl_platform(platform) == {windows}} {
1339 exec sh -c gitk &
1340 } else {
1341 exec gitk &
1345 proc do_repack {} {
1346 set w [new_console "repack" "Repacking the object database"]
1347 set cmd [list git repack]
1348 lappend cmd -a
1349 lappend cmd -d
1350 console_exec $w $cmd
1353 proc do_quit {} {
1354 global gitdir ui_comm
1356 set save [file join $gitdir GITGUI_MSG]
1357 set msg [string trim [$ui_comm get 0.0 end]]
1358 if {[$ui_comm edit modified] && $msg != {}} {
1359 catch {
1360 set fd [open $save w]
1361 puts $fd [string trim [$ui_comm get 0.0 end]]
1362 close $fd
1364 } elseif {$msg == {} && [file exists $save]} {
1365 file delete $save
1368 save_my_config
1369 destroy .
1372 proc do_rescan {} {
1373 update_status
1376 proc do_include_all {} {
1377 global update_active ui_status_value
1379 if {$update_active || ![lock_index begin-update]} return
1381 set update_active 1
1382 set ui_status_value {Including all modified files...}
1383 after 1 {
1384 with_update_index {
1385 foreach path [array names file_states] {
1386 set s $file_states($path)
1387 set m [lindex $s 0]
1388 switch -- $m {
1389 AM -
1390 MM -
1391 _M -
1392 _D {toggle_mode $path}
1396 set update_active 0
1397 set ui_status_value {Ready.}
1401 set GIT_COMMITTER_IDENT {}
1403 proc do_signoff {} {
1404 global ui_comm GIT_COMMITTER_IDENT
1406 if {$GIT_COMMITTER_IDENT == {}} {
1407 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1408 error_popup "Unable to obtain your identity:\n$err"
1409 return
1411 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1412 $me me GIT_COMMITTER_IDENT]} {
1413 error_popup "Invalid GIT_COMMITTER_IDENT:\n$me"
1414 return
1418 set str "Signed-off-by: $GIT_COMMITTER_IDENT"
1419 if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1420 $ui_comm insert end "\n"
1421 $ui_comm insert end $str
1422 $ui_comm see end
1426 proc do_amend_last {} {
1427 load_last_commit
1430 proc do_commit {} {
1431 commit_tree
1434 # shift == 1: left click
1435 # 3: right click
1436 proc click {w x y shift wx wy} {
1437 global ui_index ui_other
1439 set pos [split [$w index @$x,$y] .]
1440 set lno [lindex $pos 0]
1441 set col [lindex $pos 1]
1442 set path [$w get $lno.1 $lno.end]
1443 if {$path == {}} return
1445 if {$col > 0 && $shift == 1} {
1446 $ui_index tag remove in_diff 0.0 end
1447 $ui_other tag remove in_diff 0.0 end
1448 $w tag add in_diff $lno.0 [expr $lno + 1].0
1449 show_diff $path
1453 proc unclick {w x y} {
1454 set pos [split [$w index @$x,$y] .]
1455 set lno [lindex $pos 0]
1456 set col [lindex $pos 1]
1457 set path [$w get $lno.1 $lno.end]
1458 if {$path == {}} return
1460 if {$col == 0} {
1461 toggle_mode $path
1465 ######################################################################
1467 ## ui init
1469 set mainfont {Helvetica 10}
1470 set difffont {Courier 10}
1471 set maincursor [. cget -cursor]
1473 switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1474 windows,* {set M1B Control; set M1T Ctrl}
1475 unix,Darwin {set M1B M1; set M1T Cmd}
1476 default {set M1B M1; set M1T M1}
1479 # -- Menu Bar
1480 menu .mbar -tearoff 0
1481 .mbar add cascade -label Project -menu .mbar.project
1482 .mbar add cascade -label Commit -menu .mbar.commit
1483 .mbar add cascade -label Fetch -menu .mbar.fetch
1484 .mbar add cascade -label Pull -menu .mbar.pull
1485 .mbar add cascade -label Push -menu .mbar.push
1486 .mbar add cascade -label Options -menu .mbar.options
1487 . configure -menu .mbar
1489 # -- Project Menu
1490 menu .mbar.project
1491 .mbar.project add command -label Visualize \
1492 -command do_gitk \
1493 -font $mainfont
1494 .mbar.project add command -label {Repack Database} \
1495 -command do_repack \
1496 -font $mainfont
1497 .mbar.project add command -label Quit \
1498 -command do_quit \
1499 -accelerator $M1T-Q \
1500 -font $mainfont
1502 # -- Commit Menu
1503 menu .mbar.commit
1504 .mbar.commit add command -label Rescan \
1505 -command do_rescan \
1506 -accelerator F5 \
1507 -font $mainfont
1508 lappend disable_on_lock \
1509 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1510 .mbar.commit add command -label {Amend Last Commit} \
1511 -command do_amend_last \
1512 -font $mainfont
1513 lappend disable_on_lock \
1514 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1515 .mbar.commit add command -label {Include All Files} \
1516 -command do_include_all \
1517 -accelerator $M1T-U \
1518 -font $mainfont
1519 lappend disable_on_lock \
1520 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1521 .mbar.commit add command -label {Sign Off} \
1522 -command do_signoff \
1523 -accelerator $M1T-S \
1524 -font $mainfont
1525 .mbar.commit add command -label Commit \
1526 -command do_commit \
1527 -accelerator $M1T-Return \
1528 -font $mainfont
1529 lappend disable_on_lock \
1530 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1532 # -- Fetch Menu
1533 menu .mbar.fetch
1535 # -- Pull Menu
1536 menu .mbar.pull
1538 # -- Push Menu
1539 menu .mbar.push
1541 # -- Options Menu
1542 menu .mbar.options
1543 .mbar.options add checkbutton -label {Trust File Modification Timestamps} \
1544 -offvalue false \
1545 -onvalue true \
1546 -variable cfg_trust_mtime
1548 # -- Main Window Layout
1549 panedwindow .vpane -orient vertical
1550 panedwindow .vpane.files -orient horizontal
1551 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1552 pack .vpane -anchor n -side top -fill both -expand 1
1554 # -- Index File List
1555 frame .vpane.files.index -height 100 -width 400
1556 label .vpane.files.index.title -text {Modified Files} \
1557 -background green \
1558 -font $mainfont
1559 text $ui_index -background white -borderwidth 0 \
1560 -width 40 -height 10 \
1561 -font $mainfont \
1562 -yscrollcommand {.vpane.files.index.sb set} \
1563 -cursor $maincursor \
1564 -state disabled
1565 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1566 pack .vpane.files.index.title -side top -fill x
1567 pack .vpane.files.index.sb -side right -fill y
1568 pack $ui_index -side left -fill both -expand 1
1569 .vpane.files add .vpane.files.index -sticky nsew
1571 # -- Other (Add) File List
1572 frame .vpane.files.other -height 100 -width 100
1573 label .vpane.files.other.title -text {Untracked Files} \
1574 -background red \
1575 -font $mainfont
1576 text $ui_other -background white -borderwidth 0 \
1577 -width 40 -height 10 \
1578 -font $mainfont \
1579 -yscrollcommand {.vpane.files.other.sb set} \
1580 -cursor $maincursor \
1581 -state disabled
1582 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1583 pack .vpane.files.other.title -side top -fill x
1584 pack .vpane.files.other.sb -side right -fill y
1585 pack $ui_other -side left -fill both -expand 1
1586 .vpane.files add .vpane.files.other -sticky nsew
1588 $ui_index tag conf in_diff -font [concat $mainfont bold]
1589 $ui_other tag conf in_diff -font [concat $mainfont bold]
1591 # -- Diff and Commit Area
1592 frame .vpane.lower -height 400 -width 400
1593 frame .vpane.lower.commarea
1594 frame .vpane.lower.diff -relief sunken -borderwidth 1
1595 pack .vpane.lower.commarea -side top -fill x
1596 pack .vpane.lower.diff -side bottom -fill both -expand 1
1597 .vpane add .vpane.lower -stick nsew
1599 # -- Commit Area Buttons
1600 frame .vpane.lower.commarea.buttons
1601 label .vpane.lower.commarea.buttons.l -text {} \
1602 -anchor w \
1603 -justify left \
1604 -font $mainfont
1605 pack .vpane.lower.commarea.buttons.l -side top -fill x
1606 pack .vpane.lower.commarea.buttons -side left -fill y
1608 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1609 -command do_rescan \
1610 -font $mainfont
1611 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1612 lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
1614 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1615 -command do_amend_last \
1616 -font $mainfont
1617 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1618 lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
1620 button .vpane.lower.commarea.buttons.incall -text {Include All} \
1621 -command do_include_all \
1622 -font $mainfont
1623 pack .vpane.lower.commarea.buttons.incall -side top -fill x
1624 lappend disable_on_lock {.vpane.lower.commarea.buttons.incall conf -state}
1626 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1627 -command do_signoff \
1628 -font $mainfont
1629 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1631 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1632 -command do_commit \
1633 -font $mainfont
1634 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1635 lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
1637 # -- Commit Message Buffer
1638 frame .vpane.lower.commarea.buffer
1639 set ui_comm .vpane.lower.commarea.buffer.t
1640 set ui_coml .vpane.lower.commarea.buffer.l
1641 label $ui_coml -text {Commit Message:} \
1642 -anchor w \
1643 -justify left \
1644 -font $mainfont
1645 trace add variable commit_type write {uplevel #0 {
1646 switch -glob $commit_type \
1647 initial {$ui_coml conf -text {Initial Commit Message:}} \
1648 amend {$ui_coml conf -text {Amended Commit Message:}} \
1649 merge {$ui_coml conf -text {Merge Commit Message:}} \
1650 * {$ui_coml conf -text {Commit Message:}}
1652 text $ui_comm -background white -borderwidth 1 \
1653 -relief sunken \
1654 -width 75 -height 9 -wrap none \
1655 -font $difffont \
1656 -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1657 -cursor $maincursor
1658 scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
1659 pack $ui_coml -side top -fill x
1660 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1661 pack $ui_comm -side left -fill y
1662 pack .vpane.lower.commarea.buffer -side left -fill y
1664 # -- Diff Header
1665 set ui_fname_value {}
1666 set ui_fstatus_value {}
1667 frame .vpane.lower.diff.header -background orange
1668 label .vpane.lower.diff.header.l1 -text {File:} \
1669 -background orange \
1670 -font $mainfont
1671 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1672 -background orange \
1673 -anchor w \
1674 -justify left \
1675 -font $mainfont
1676 label .vpane.lower.diff.header.l3 -text {Status:} \
1677 -background orange \
1678 -font $mainfont
1679 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1680 -background orange \
1681 -width $max_status_desc \
1682 -anchor w \
1683 -justify left \
1684 -font $mainfont
1685 pack .vpane.lower.diff.header.l1 -side left
1686 pack .vpane.lower.diff.header.l2 -side left -fill x
1687 pack .vpane.lower.diff.header.l4 -side right
1688 pack .vpane.lower.diff.header.l3 -side right
1690 # -- Diff Body
1691 frame .vpane.lower.diff.body
1692 set ui_diff .vpane.lower.diff.body.t
1693 text $ui_diff -background white -borderwidth 0 \
1694 -width 80 -height 15 -wrap none \
1695 -font $difffont \
1696 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1697 -yscrollcommand {.vpane.lower.diff.body.sby set} \
1698 -cursor $maincursor \
1699 -state disabled
1700 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1701 -command [list $ui_diff xview]
1702 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1703 -command [list $ui_diff yview]
1704 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1705 pack .vpane.lower.diff.body.sby -side right -fill y
1706 pack $ui_diff -side left -fill both -expand 1
1707 pack .vpane.lower.diff.header -side top -fill x
1708 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1710 $ui_diff tag conf dm -foreground red
1711 $ui_diff tag conf dp -foreground blue
1712 $ui_diff tag conf da -font [concat $difffont bold]
1713 $ui_diff tag conf di -foreground "#00a000"
1714 $ui_diff tag conf dni -foreground "#a000a0"
1715 $ui_diff tag conf bold -font [concat $difffont bold]
1717 # -- Status Bar
1718 set ui_status_value {Initializing...}
1719 label .status -textvariable ui_status_value \
1720 -anchor w \
1721 -justify left \
1722 -borderwidth 1 \
1723 -relief sunken \
1724 -font $mainfont
1725 pack .status -anchor w -side bottom -fill x
1727 # -- Key Bindings
1728 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1729 bind . <Destroy> do_quit
1730 bind all <Key-F5> do_rescan
1731 bind all <$M1B-Key-r> do_rescan
1732 bind all <$M1B-Key-R> do_rescan
1733 bind . <$M1B-Key-s> do_signoff
1734 bind . <$M1B-Key-S> do_signoff
1735 bind . <$M1B-Key-u> do_include_all
1736 bind . <$M1B-Key-U> do_include_all
1737 bind . <$M1B-Key-Return> do_commit
1738 bind all <$M1B-Key-q> do_quit
1739 bind all <$M1B-Key-Q> do_quit
1740 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1741 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1742 foreach i [list $ui_index $ui_other] {
1743 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1744 bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1745 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1747 unset i M1B M1T
1749 ######################################################################
1751 ## main
1753 set appname [lindex [file split $argv0] end]
1754 set gitdir {}
1756 if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
1757 show_msg {} . "Cannot find the git directory: $err"
1758 exit 1
1760 if {$cdup != ""} {
1761 cd $cdup
1763 unset cdup
1765 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1766 show_msg {} . "Cannot find the git directory: $err"
1767 exit 1
1770 if {$appname == {git-citool}} {
1771 set single_commit 1
1774 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1775 focus -force $ui_comm
1776 load_repo_config
1777 load_all_remotes
1778 populate_remote_menu .mbar.fetch From fetch_from
1779 populate_remote_menu .mbar.push To push_to
1780 populate_pull_menu .mbar.pull
1781 update_status