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 ######################################################################
11 ##
12 ## task management
14 set single_commit 0
15 set status_active 0
16 set diff_active 0
17 set checkin_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
35 }
36 return 1
37 } elseif {$index_lock_type == {begin-update} && $type == {update}} {
38 set index_lock_type $type
39 return 1
40 }
41 return 0
42 }
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
50 }
51 }
53 ######################################################################
54 ##
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
67 }
68 }
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
86 }
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
93 }
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]} {
100 }
101 $ui_comm edit modified false
102 }
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]
112 }
113 }
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
125 }
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"
132 }
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]
150 }
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
159 }
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
165 }
166 return 0
167 }
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
188 }
189 if {$c < $n} {
190 set buf_rdi [string range $buf_rdi $c end]
191 } else {
192 set buf_rdi {}
193 }
195 status_eof $fd buf_rdi $final
196 }
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
217 }
218 if {$c < $n} {
219 set buf_rdf [string range $buf_rdf $c end]
220 } else {
221 set buf_rdf {}
222 }
224 status_eof $fd buf_rdf $final
225 }
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
235 }
236 status_eof $fd buf_rlo $final
237 }
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
258 }
259 }
260 }
261 }
263 ######################################################################
264 ##
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 {}
275 }
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 {
295 }
296 MM {
297 set cmd [list | git diff-index -p -c $PARENT $path]
298 }
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
310 }
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
318 }
319 }
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
327 }
329 fconfigure $fd -blocking 0 -translation auto
330 fileevent $fd readable [list read_diff $fd]
331 }
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
344 }
345 }
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 {}}
355 }
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 {}}
368 }
369 set line [string replace $line 0 1 $x]
370 }
371 $ui_diff insert end $line $tags
372 $ui_diff insert end "\n"
373 $ui_diff conf -state disabled
374 }
376 if {[eof $fd]} {
377 close $fd
378 set diff_active 0
379 unlock_index
380 set ui_status_value {Ready.}
381 }
382 }
384 ######################################################################
385 ##
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
395 }
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
406 }
407 }
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
413 }
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
430 }
431 }
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.
441 #
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.
452 }
453 unlock_index
454 update_status
455 return
456 }
458 # -- At least one file should differ in the index.
459 #
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 check the file in before committing.
473 "
474 unlock_index
475 return
476 }
477 default {
478 error_popup "Unknown file state [lindex $s 0] detected.
480 File $path cannot be committed by this program.
481 "
482 }
483 }
484 }
485 if {!$files_ready} {
486 error_popup {No checked-in files to commit.
488 You must check-in at least 1 file before you can commit.
489 }
490 unlock_index
491 return
492 }
494 # -- A message is required.
495 #
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.
505 }
506 unlock_index
507 return
508 }
510 # -- Ask the pre-commit hook for the go-ahead.
511 #
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 {}
520 }
521 if {$pchook != {} && [catch {eval exec $pchook} err]} {
522 hook_failed_popup pre-commit $err
523 unlock_index
524 return
525 }
527 # -- Write the tree in the background.
528 #
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]
534 }
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
549 }
551 # -- Create the commit.
552 #
553 set cmd [list git commit-tree $tree_id]
554 if {$PARENT != {}} {
555 lappend cmd -p $PARENT
556 }
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
562 }
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
570 }
571 }
572 if {$PARENT == {}} {
573 # git commit-tree writes to stderr during initial commit.
574 lappend cmd 2>/dev/null
575 }
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
583 }
585 # -- Update the HEAD ref.
586 #
587 set reflogm commit
588 if {$commit_type != {normal}} {
589 append reflogm " ($commit_type)"
590 }
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
596 }
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
604 }
606 # -- Cleanup after ourselves.
607 #
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.
614 #
615 if {[file isdirectory [file join $gitdir rr-cache]]} {
616 catch {exec git rerere}
617 }
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 $cmt_id."
630 }
632 ######################################################################
633 ##
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
642 }
644 proc pull_remote {remote branch} {
645 if {![lock_index update]} return
646 set w [new_console "pull $remote $branch" \
647 "Pulling new changes from branch $branch in $remote"]
648 set cmd [list git pull]
649 lappend cmd $remote
650 lappend cmd $branch
651 console_exec $w $cmd [list post_pull_remote $remote $branch]
652 }
654 proc post_pull_remote {remote branch success} {
655 unlock_index
656 if {$success} {
657 update_status "Successfully pulled $branch from $remote."
658 } else {
659 update_status "Conflicts detected while pulling $branch from $remote."
660 }
661 }
663 proc push_to {remote} {
664 set w [new_console "push $remote" \
665 "Pushing changes to $remote"]
666 set cmd [list git push]
667 lappend cmd $remote
668 console_exec $w $cmd
669 }
671 ######################################################################
672 ##
673 ## ui helpers
675 proc mapcol {state path} {
676 global all_cols ui_other
678 if {[catch {set r $all_cols($state)}]} {
679 puts "error: no column for state={$state} $path"
680 return $ui_other
681 }
682 return $r
683 }
685 proc mapicon {state path} {
686 global all_icons
688 if {[catch {set r $all_icons($state)}]} {
689 puts "error: no icon for state={$state} $path"
690 return file_plain
691 }
692 return $r
693 }
695 proc mapdesc {state path} {
696 global all_descs
698 if {[catch {set r $all_descs($state)}]} {
699 puts "error: no desc for state={$state} $path"
700 return $state
701 }
702 return $r
703 }
705 proc bsearch {w path} {
706 set hi [expr [lindex [split [$w index end] .] 0] - 2]
707 if {$hi == 0} {
708 return -1
709 }
710 set lo 0
711 while {$lo < $hi} {
712 set mi [expr [expr $lo + $hi] / 2]
713 set ti [expr $mi + 1]
714 set cmp [string compare [$w get $ti.1 $ti.end] $path]
715 if {$cmp < 0} {
716 set lo $ti
717 } elseif {$cmp == 0} {
718 return $mi
719 } else {
720 set hi $mi
721 }
722 }
723 return -[expr $lo + 1]
724 }
726 set next_icon_id 0
728 proc merge_state {path new_state} {
729 global file_states next_icon_id
731 set s0 [string index $new_state 0]
732 set s1 [string index $new_state 1]
734 if {[catch {set info $file_states($path)}]} {
735 set state __
736 set icon n[incr next_icon_id]
737 } else {
738 set state [lindex $info 0]
739 set icon [lindex $info 1]
740 }
742 if {$s0 == {_}} {
743 set s0 [string index $state 0]
744 } elseif {$s0 == {*}} {
745 set s0 _
746 }
748 if {$s1 == {_}} {
749 set s1 [string index $state 1]
750 } elseif {$s1 == {*}} {
751 set s1 _
752 }
754 set file_states($path) [list $s0$s1 $icon]
755 return $state
756 }
758 proc display_file {path state} {
759 global ui_index ui_other file_states status_active
761 set old_m [merge_state $path $state]
762 if {$status_active} return
764 set s $file_states($path)
765 set new_m [lindex $s 0]
766 set new_w [mapcol $new_m $path]
767 set old_w [mapcol $old_m $path]
768 set new_icon [mapicon $new_m $path]
770 if {$new_w != $old_w} {
771 set lno [bsearch $old_w $path]
772 if {$lno >= 0} {
773 incr lno
774 $old_w conf -state normal
775 $old_w delete $lno.0 [expr $lno + 1].0
776 $old_w conf -state disabled
777 }
779 set lno [expr abs([bsearch $new_w $path] + 1) + 1]
780 $new_w conf -state normal
781 $new_w image create $lno.0 \
782 -align center -padx 5 -pady 1 \
783 -name [lindex $s 1] \
784 -image [mapicon $m $path]
785 $new_w insert $lno.1 "$path\n"
786 $new_w conf -state disabled
787 } elseif {$new_icon != [mapicon $old_m $path]} {
788 $new_w conf -state normal
789 $new_w image conf [lindex $s 1] -image $new_icon
790 $new_w conf -state disabled
791 }
792 }
794 proc display_all_files {} {
795 global ui_index ui_other file_states
797 $ui_index conf -state normal
798 $ui_other conf -state normal
800 foreach path [lsort [array names file_states]] {
801 set s $file_states($path)
802 set m [lindex $s 0]
803 set w [mapcol $m $path]
804 $w image create end \
805 -align center -padx 5 -pady 1 \
806 -name [lindex $s 1] \
807 -image [mapicon $m $path]
808 $w insert end "$path\n"
809 }
811 $ui_index conf -state disabled
812 $ui_other conf -state disabled
813 }
815 proc with_update_index {body} {
816 global update_index_fd
818 if {$update_index_fd == {}} {
819 if {![lock_index update]} return
820 set update_index_fd [open \
821 "| git update-index --add --remove -z --stdin" \
822 w]
823 fconfigure $update_index_fd -translation binary
824 uplevel 1 $body
825 close $update_index_fd
826 set update_index_fd {}
827 unlock_index
828 } else {
829 uplevel 1 $body
830 }
831 }
833 proc update_index {path} {
834 global update_index_fd
836 if {$update_index_fd == {}} {
837 error {not in with_update_index}
838 } else {
839 puts -nonewline $update_index_fd "$path\0"
840 }
841 }
843 proc toggle_mode {path} {
844 global file_states ui_fname_value
846 set s $file_states($path)
847 set m [lindex $s 0]
849 switch -- $m {
850 AM -
851 _O {set new A*}
852 _M -
853 MM {set new M*}
854 AD -
855 _D {set new D*}
856 default {return}
857 }
859 with_update_index {update_index $path}
860 display_file $path $new
861 if {$ui_fname_value == $path} {
862 show_diff $path
863 }
864 }
866 ######################################################################
867 ##
868 ## config (fetch push pull)
870 proc load_repo_config {} {
871 global repo_config
872 global cfg_trust_mtime
874 array unset repo_config
875 catch {
876 set fd_rc [open "| git repo-config --list" r]
877 while {[gets $fd_rc line] >= 0} {
878 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
879 lappend repo_config($name) $value
880 }
881 }
882 close $fd_rc
883 }
885 if {[catch {set cfg_trust_mtime $repo_config(gui.trustmtime)}]} {
886 set cfg_trust_mtime false
887 }
888 }
890 proc save_my_config {} {
891 global repo_config
892 global cfg_trust_mtime
894 if {[catch {set rc_trustMTime $repo_config(gui.trustmtime)}]} {
895 set rc_trustMTime false
896 }
897 if {$cfg_trust_mtime != $rc_trustMTime} {
898 exec git repo-config gui.trustMTime $cfg_trust_mtime
899 }
900 }
902 proc load_all_remotes {} {
903 global gitdir all_remotes repo_config
905 set all_remotes [list]
906 set rm_dir [file join $gitdir remotes]
907 if {[file isdirectory $rm_dir]} {
908 set all_remotes [concat $all_remotes [glob \
909 -types f \
910 -tails \
911 -nocomplain \
912 -directory $rm_dir *]]
913 }
915 foreach line [array names repo_config remote.*.url] {
916 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
917 lappend all_remotes $name
918 }
919 }
921 set all_remotes [lsort -unique $all_remotes]
922 }
924 proc populate_remote_menu {m pfx op} {
925 global all_remotes mainfont
927 foreach remote $all_remotes {
928 $m add command -label "$pfx $remote..." \
929 -command [list $op $remote] \
930 -font $mainfont
931 }
932 }
934 proc populate_pull_menu {m} {
935 global gitdir repo_config all_remotes mainfont
937 foreach remote $all_remotes {
938 set rb {}
939 if {[array get repo_config remote.$remote.url] != {}} {
940 if {[array get repo_config remote.$remote.fetch] != {}} {
941 regexp {^([^:]+):} \
942 [lindex $repo_config(remote.$remote.fetch) 0] \
943 line rb
944 }
945 } else {
946 catch {
947 set fd [open [file join $gitdir remotes $remote] r]
948 while {[gets $fd line] >= 0} {
949 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
950 break
951 }
952 }
953 close $fd
954 }
955 }
957 set rb_short $rb
958 regsub ^refs/heads/ $rb {} rb_short
959 if {$rb_short != {}} {
960 $m add command \
961 -label "Branch $rb_short from $remote..." \
962 -command [list pull_remote $remote $rb] \
963 -font $mainfont
964 }
965 }
966 }
968 ######################################################################
969 ##
970 ## icons
972 set filemask {
973 #define mask_width 14
974 #define mask_height 15
975 static unsigned char mask_bits[] = {
976 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
977 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
978 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
979 }
981 image create bitmap file_plain -background white -foreground black -data {
982 #define plain_width 14
983 #define plain_height 15
984 static unsigned char plain_bits[] = {
985 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
986 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
987 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
988 } -maskdata $filemask
990 image create bitmap file_mod -background white -foreground blue -data {
991 #define mod_width 14
992 #define mod_height 15
993 static unsigned char mod_bits[] = {
994 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
995 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
996 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
997 } -maskdata $filemask
999 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1000 #define file_fulltick_width 14
1001 #define file_fulltick_height 15
1002 static unsigned char file_fulltick_bits[] = {
1003 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1004 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1005 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1006 } -maskdata $filemask
1008 image create bitmap file_parttick -background white -foreground "#005050" -data {
1009 #define parttick_width 14
1010 #define parttick_height 15
1011 static unsigned char parttick_bits[] = {
1012 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1013 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1014 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1015 } -maskdata $filemask
1017 image create bitmap file_question -background white -foreground black -data {
1018 #define file_question_width 14
1019 #define file_question_height 15
1020 static unsigned char file_question_bits[] = {
1021 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1022 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1023 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1024 } -maskdata $filemask
1026 image create bitmap file_removed -background white -foreground red -data {
1027 #define file_removed_width 14
1028 #define file_removed_height 15
1029 static unsigned char file_removed_bits[] = {
1030 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1031 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1032 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1033 } -maskdata $filemask
1035 image create bitmap file_merge -background white -foreground blue -data {
1036 #define file_merge_width 14
1037 #define file_merge_height 15
1038 static unsigned char file_merge_bits[] = {
1039 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1040 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1041 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1042 } -maskdata $filemask
1044 set ui_index .vpane.files.index.list
1045 set ui_other .vpane.files.other.list
1046 set max_status_desc 0
1047 foreach i {
1048 {__ i plain "Unmodified"}
1049 {_M i mod "Modified"}
1050 {M_ i fulltick "Checked in"}
1051 {MM i parttick "Partially checked in"}
1053 {_O o plain "Untracked"}
1054 {A_ o fulltick "Added"}
1055 {AM o parttick "Partially added"}
1056 {AD o question "Added (but now gone)"}
1058 {_D i question "Missing"}
1059 {D_ i removed "Removed"}
1060 {DD i removed "Removed"}
1061 {DO i removed "Removed (still exists)"}
1063 {UM i merge "Merge conflicts"}
1064 {U_ i merge "Merge conflicts"}
1065 } {
1066 if {$max_status_desc < [string length [lindex $i 3]]} {
1067 set max_status_desc [string length [lindex $i 3]]
1068 }
1069 if {[lindex $i 1] == {i}} {
1070 set all_cols([lindex $i 0]) $ui_index
1071 } else {
1072 set all_cols([lindex $i 0]) $ui_other
1073 }
1074 set all_icons([lindex $i 0]) file_[lindex $i 2]
1075 set all_descs([lindex $i 0]) [lindex $i 3]
1076 }
1077 unset filemask i
1079 ######################################################################
1080 ##
1081 ## util
1083 proc error_popup {msg} {
1084 set w .error
1085 toplevel $w
1086 wm transient $w .
1087 show_msg $w $w $msg
1088 }
1090 proc show_msg {w top msg} {
1091 global gitdir appname mainfont
1093 message $w.m -text $msg -justify left -aspect 400
1094 pack $w.m -side top -fill x -padx 5 -pady 10
1095 button $w.ok -text OK \
1096 -width 15 \
1097 -font $mainfont \
1098 -command "destroy $top"
1099 pack $w.ok -side bottom
1100 bind $top <Visibility> "grab $top; focus $top"
1101 bind $top <Key-Return> "destroy $top"
1102 wm title $w "$appname ([lindex [file split \
1103 [file normalize [file dirname $gitdir]]] \
1104 end]): error"
1105 tkwait window $top
1106 }
1108 proc hook_failed_popup {hook msg} {
1109 global gitdir mainfont difffont appname
1111 set w .hookfail
1112 toplevel $w
1113 wm transient $w .
1115 frame $w.m
1116 label $w.m.l1 -text "$hook hook failed:" \
1117 -anchor w \
1118 -justify left \
1119 -font [concat $mainfont bold]
1120 text $w.m.t \
1121 -background white -borderwidth 1 \
1122 -relief sunken \
1123 -width 80 -height 10 \
1124 -font $difffont \
1125 -yscrollcommand [list $w.m.sby set]
1126 label $w.m.l2 \
1127 -text {You must correct the above errors before committing.} \
1128 -anchor w \
1129 -justify left \
1130 -font [concat $mainfont bold]
1131 scrollbar $w.m.sby -command [list $w.m.t yview]
1132 pack $w.m.l1 -side top -fill x
1133 pack $w.m.l2 -side bottom -fill x
1134 pack $w.m.sby -side right -fill y
1135 pack $w.m.t -side left -fill both -expand 1
1136 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1138 $w.m.t insert 1.0 $msg
1139 $w.m.t conf -state disabled
1141 button $w.ok -text OK \
1142 -width 15 \
1143 -font $mainfont \
1144 -command "destroy $w"
1145 pack $w.ok -side bottom
1147 bind $w <Visibility> "grab $w; focus $w"
1148 bind $w <Key-Return> "destroy $w"
1149 wm title $w "$appname ([lindex [file split \
1150 [file normalize [file dirname $gitdir]]] \
1151 end]): error"
1152 tkwait window $w
1153 }
1155 set next_console_id 0
1157 proc new_console {short_title long_title} {
1158 global next_console_id console_data
1159 set w .console[incr next_console_id]
1160 set console_data($w) [list $short_title $long_title]
1161 return [console_init $w]
1162 }
1164 proc console_init {w} {
1165 global console_cr console_data
1166 global gitdir appname mainfont difffont
1168 set console_cr($w) 1.0
1169 toplevel $w
1170 frame $w.m
1171 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1172 -anchor w \
1173 -justify left \
1174 -font [concat $mainfont bold]
1175 text $w.m.t \
1176 -background white -borderwidth 1 \
1177 -relief sunken \
1178 -width 80 -height 10 \
1179 -font $difffont \
1180 -state disabled \
1181 -yscrollcommand [list $w.m.sby set]
1182 label $w.m.s -anchor w \
1183 -justify left \
1184 -font [concat $mainfont bold]
1185 scrollbar $w.m.sby -command [list $w.m.t yview]
1186 pack $w.m.l1 -side top -fill x
1187 pack $w.m.s -side bottom -fill x
1188 pack $w.m.sby -side right -fill y
1189 pack $w.m.t -side left -fill both -expand 1
1190 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1192 button $w.ok -text {Running...} \
1193 -width 15 \
1194 -font $mainfont \
1195 -state disabled \
1196 -command "destroy $w"
1197 pack $w.ok -side bottom
1199 bind $w <Visibility> "focus $w"
1200 wm title $w "$appname ([lindex [file split \
1201 [file normalize [file dirname $gitdir]]] \
1202 end]): [lindex $console_data($w) 0]"
1203 return $w
1204 }
1206 proc console_exec {w cmd {after {}}} {
1207 global tcl_platform
1209 # -- Windows tosses the enviroment when we exec our child.
1210 # But most users need that so we have to relogin. :-(
1211 #
1212 if {$tcl_platform(platform) == {windows}} {
1213 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1214 }
1216 # -- Tcl won't let us redirect both stdout and stderr to
1217 # the same pipe. So pass it through cat...
1218 #
1219 set cmd [concat | $cmd |& cat]
1221 set fd_f [open $cmd r]
1222 fconfigure $fd_f -blocking 0 -translation binary
1223 fileevent $fd_f readable [list console_read $w $fd_f $after]
1224 }
1226 proc console_read {w fd after} {
1227 global console_cr console_data
1229 set buf [read $fd]
1230 if {$buf != {}} {
1231 if {![winfo exists $w]} {console_init $w}
1232 $w.m.t conf -state normal
1233 set c 0
1234 set n [string length $buf]
1235 while {$c < $n} {
1236 set cr [string first "\r" $buf $c]
1237 set lf [string first "\n" $buf $c]
1238 if {$cr < 0} {set cr [expr $n + 1]}
1239 if {$lf < 0} {set lf [expr $n + 1]}
1241 if {$lf < $cr} {
1242 $w.m.t insert end [string range $buf $c $lf]
1243 set console_cr($w) [$w.m.t index {end -1c}]
1244 set c $lf
1245 incr c
1246 } else {
1247 $w.m.t delete $console_cr($w) end
1248 $w.m.t insert end "\n"
1249 $w.m.t insert end [string range $buf $c $cr]
1250 set c $cr
1251 incr c
1252 }
1253 }
1254 $w.m.t conf -state disabled
1255 $w.m.t see end
1256 }
1258 fconfigure $fd -blocking 1
1259 if {[eof $fd]} {
1260 if {[catch {close $fd}]} {
1261 if {![winfo exists $w]} {console_init $w}
1262 $w.m.s conf -background red -text {Error: Command Failed}
1263 $w.ok conf -text Close
1264 $w.ok conf -state normal
1265 set ok 0
1266 } elseif {[winfo exists $w]} {
1267 $w.m.s conf -background green -text {Success}
1268 $w.ok conf -text Close
1269 $w.ok conf -state normal
1270 set ok 1
1271 }
1272 array unset console_cr $w
1273 array unset console_data $w
1274 if {$after != {}} {
1275 uplevel #0 $after $ok
1276 }
1277 return
1278 }
1279 fconfigure $fd -blocking 0
1280 }
1282 ######################################################################
1283 ##
1284 ## ui commands
1286 set starting_gitk_msg {Please wait... Starting gitk...}
1288 proc do_gitk {} {
1289 global tcl_platform ui_status_value starting_gitk_msg
1291 set ui_status_value $starting_gitk_msg
1292 after 10000 {
1293 if {$ui_status_value == $starting_gitk_msg} {
1294 set ui_status_value {Ready.}
1295 }
1296 }
1298 if {$tcl_platform(platform) == {windows}} {
1299 exec sh -c gitk &
1300 } else {
1301 exec gitk &
1302 }
1303 }
1305 proc do_repack {} {
1306 set w [new_console "repack" "Repacking the object database"]
1307 set cmd [list git repack]
1308 lappend cmd -a
1309 lappend cmd -d
1310 console_exec $w $cmd
1311 }
1313 proc do_quit {} {
1314 global gitdir ui_comm
1316 set save [file join $gitdir GITGUI_MSG]
1317 set msg [string trim [$ui_comm get 0.0 end]]
1318 if {[$ui_comm edit modified] && $msg != {}} {
1319 catch {
1320 set fd [open $save w]
1321 puts $fd [string trim [$ui_comm get 0.0 end]]
1322 close $fd
1323 }
1324 } elseif {$msg == {} && [file exists $save]} {
1325 file delete $save
1326 }
1328 save_my_config
1329 destroy .
1330 }
1332 proc do_rescan {} {
1333 update_status
1334 }
1336 proc do_checkin_all {} {
1337 global checkin_active ui_status_value
1339 if {$checkin_active || ![lock_index begin-update]} return
1341 set checkin_active 1
1342 set ui_status_value {Checking in all files...}
1343 after 1 {
1344 with_update_index {
1345 foreach path [array names file_states] {
1346 set s $file_states($path)
1347 set m [lindex $s 0]
1348 switch -- $m {
1349 AM -
1350 MM -
1351 _M -
1352 _D {toggle_mode $path}
1353 }
1354 }
1355 }
1356 set checkin_active 0
1357 set ui_status_value {Ready.}
1358 }
1359 }
1361 proc do_signoff {} {
1362 global ui_comm
1364 catch {
1365 set me [exec git var GIT_COMMITTER_IDENT]
1366 if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
1367 set str "Signed-off-by: $name"
1368 if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1369 $ui_comm insert end "\n"
1370 $ui_comm insert end $str
1371 $ui_comm see end
1372 }
1373 }
1374 }
1375 }
1377 proc do_amend_last {} {
1378 load_last_commit
1379 }
1381 proc do_commit {} {
1382 commit_tree
1383 }
1385 # shift == 1: left click
1386 # 3: right click
1387 proc click {w x y shift wx wy} {
1388 global ui_index ui_other
1390 set pos [split [$w index @$x,$y] .]
1391 set lno [lindex $pos 0]
1392 set col [lindex $pos 1]
1393 set path [$w get $lno.1 $lno.end]
1394 if {$path == {}} return
1396 if {$col > 0 && $shift == 1} {
1397 $ui_index tag remove in_diff 0.0 end
1398 $ui_other tag remove in_diff 0.0 end
1399 $w tag add in_diff $lno.0 [expr $lno + 1].0
1400 show_diff $path
1401 }
1402 }
1404 proc unclick {w x y} {
1405 set pos [split [$w index @$x,$y] .]
1406 set lno [lindex $pos 0]
1407 set col [lindex $pos 1]
1408 set path [$w get $lno.1 $lno.end]
1409 if {$path == {}} return
1411 if {$col == 0} {
1412 toggle_mode $path
1413 }
1414 }
1416 ######################################################################
1417 ##
1418 ## ui init
1420 set mainfont {Helvetica 10}
1421 set difffont {Courier 10}
1422 set maincursor [. cget -cursor]
1424 switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1425 windows,* {set M1B Control; set M1T Ctrl}
1426 unix,Darwin {set M1B M1; set M1T Cmd}
1427 default {set M1B M1; set M1T M1}
1428 }
1430 # -- Menu Bar
1431 menu .mbar -tearoff 0
1432 .mbar add cascade -label Project -menu .mbar.project
1433 .mbar add cascade -label Commit -menu .mbar.commit
1434 .mbar add cascade -label Fetch -menu .mbar.fetch
1435 .mbar add cascade -label Pull -menu .mbar.pull
1436 .mbar add cascade -label Push -menu .mbar.push
1437 .mbar add cascade -label Options -menu .mbar.options
1438 . configure -menu .mbar
1440 # -- Project Menu
1441 menu .mbar.project
1442 .mbar.project add command -label Visualize \
1443 -command do_gitk \
1444 -font $mainfont
1445 .mbar.project add command -label {Repack Database} \
1446 -command do_repack \
1447 -font $mainfont
1448 .mbar.project add command -label Quit \
1449 -command do_quit \
1450 -accelerator $M1T-Q \
1451 -font $mainfont
1453 # -- Commit Menu
1454 menu .mbar.commit
1455 .mbar.commit add command -label Rescan \
1456 -command do_rescan \
1457 -accelerator F5 \
1458 -font $mainfont
1459 lappend disable_on_lock \
1460 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1461 .mbar.commit add command -label {Amend Last Commit} \
1462 -command do_amend_last \
1463 -font $mainfont
1464 lappend disable_on_lock \
1465 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1466 .mbar.commit add command -label {Check-in All Files} \
1467 -command do_checkin_all \
1468 -accelerator $M1T-U \
1469 -font $mainfont
1470 lappend disable_on_lock \
1471 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1472 .mbar.commit add command -label {Sign Off} \
1473 -command do_signoff \
1474 -accelerator $M1T-S \
1475 -font $mainfont
1476 .mbar.commit add command -label Commit \
1477 -command do_commit \
1478 -accelerator $M1T-Return \
1479 -font $mainfont
1480 lappend disable_on_lock \
1481 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1483 # -- Fetch Menu
1484 menu .mbar.fetch
1486 # -- Pull Menu
1487 menu .mbar.pull
1489 # -- Push Menu
1490 menu .mbar.push
1492 # -- Options Menu
1493 menu .mbar.options
1494 .mbar.options add checkbutton -label {Trust File Modification Timestamp} \
1495 -offvalue false \
1496 -onvalue true \
1497 -variable cfg_trust_mtime
1499 # -- Main Window Layout
1500 panedwindow .vpane -orient vertical
1501 panedwindow .vpane.files -orient horizontal
1502 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1503 pack .vpane -anchor n -side top -fill both -expand 1
1505 # -- Index File List
1506 frame .vpane.files.index -height 100 -width 400
1507 label .vpane.files.index.title -text {Modified Files} \
1508 -background green \
1509 -font $mainfont
1510 text $ui_index -background white -borderwidth 0 \
1511 -width 40 -height 10 \
1512 -font $mainfont \
1513 -yscrollcommand {.vpane.files.index.sb set} \
1514 -cursor $maincursor \
1515 -state disabled
1516 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1517 pack .vpane.files.index.title -side top -fill x
1518 pack .vpane.files.index.sb -side right -fill y
1519 pack $ui_index -side left -fill both -expand 1
1520 .vpane.files add .vpane.files.index -sticky nsew
1522 # -- Other (Add) File List
1523 frame .vpane.files.other -height 100 -width 100
1524 label .vpane.files.other.title -text {Untracked Files} \
1525 -background red \
1526 -font $mainfont
1527 text $ui_other -background white -borderwidth 0 \
1528 -width 40 -height 10 \
1529 -font $mainfont \
1530 -yscrollcommand {.vpane.files.other.sb set} \
1531 -cursor $maincursor \
1532 -state disabled
1533 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1534 pack .vpane.files.other.title -side top -fill x
1535 pack .vpane.files.other.sb -side right -fill y
1536 pack $ui_other -side left -fill both -expand 1
1537 .vpane.files add .vpane.files.other -sticky nsew
1539 $ui_index tag conf in_diff -font [concat $mainfont bold]
1540 $ui_other tag conf in_diff -font [concat $mainfont bold]
1542 # -- Diff and Commit Area
1543 frame .vpane.lower -height 400 -width 400
1544 frame .vpane.lower.commarea
1545 frame .vpane.lower.diff -relief sunken -borderwidth 1
1546 pack .vpane.lower.commarea -side top -fill x
1547 pack .vpane.lower.diff -side bottom -fill both -expand 1
1548 .vpane add .vpane.lower -stick nsew
1550 # -- Commit Area Buttons
1551 frame .vpane.lower.commarea.buttons
1552 label .vpane.lower.commarea.buttons.l -text {} \
1553 -anchor w \
1554 -justify left \
1555 -font $mainfont
1556 pack .vpane.lower.commarea.buttons.l -side top -fill x
1557 pack .vpane.lower.commarea.buttons -side left -fill y
1559 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1560 -command do_rescan \
1561 -font $mainfont
1562 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1563 lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
1565 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1566 -command do_amend_last \
1567 -font $mainfont
1568 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1569 lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
1571 button .vpane.lower.commarea.buttons.ciall -text {Check-in All} \
1572 -command do_checkin_all \
1573 -font $mainfont
1574 pack .vpane.lower.commarea.buttons.ciall -side top -fill x
1575 lappend disable_on_lock {.vpane.lower.commarea.buttons.ciall conf -state}
1577 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1578 -command do_signoff \
1579 -font $mainfont
1580 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1582 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1583 -command do_commit \
1584 -font $mainfont
1585 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1586 lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
1588 # -- Commit Message Buffer
1589 frame .vpane.lower.commarea.buffer
1590 set ui_comm .vpane.lower.commarea.buffer.t
1591 set ui_coml .vpane.lower.commarea.buffer.l
1592 label $ui_coml -text {Commit Message:} \
1593 -anchor w \
1594 -justify left \
1595 -font $mainfont
1596 trace add variable commit_type write {uplevel #0 {
1597 switch -glob $commit_type \
1598 initial {$ui_coml conf -text {Initial Commit Message:}} \
1599 amend {$ui_coml conf -text {Amended Commit Message:}} \
1600 merge {$ui_coml conf -text {Merge Commit Message:}} \
1601 * {$ui_coml conf -text {Commit Message:}}
1602 }}
1603 text $ui_comm -background white -borderwidth 1 \
1604 -relief sunken \
1605 -width 75 -height 9 -wrap none \
1606 -font $difffont \
1607 -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1608 -cursor $maincursor
1609 scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
1610 pack $ui_coml -side top -fill x
1611 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1612 pack $ui_comm -side left -fill y
1613 pack .vpane.lower.commarea.buffer -side left -fill y
1615 # -- Diff Header
1616 set ui_fname_value {}
1617 set ui_fstatus_value {}
1618 frame .vpane.lower.diff.header -background orange
1619 label .vpane.lower.diff.header.l1 -text {File:} \
1620 -background orange \
1621 -font $mainfont
1622 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1623 -background orange \
1624 -anchor w \
1625 -justify left \
1626 -font $mainfont
1627 label .vpane.lower.diff.header.l3 -text {Status:} \
1628 -background orange \
1629 -font $mainfont
1630 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1631 -background orange \
1632 -width $max_status_desc \
1633 -anchor w \
1634 -justify left \
1635 -font $mainfont
1636 pack .vpane.lower.diff.header.l1 -side left
1637 pack .vpane.lower.diff.header.l2 -side left -fill x
1638 pack .vpane.lower.diff.header.l4 -side right
1639 pack .vpane.lower.diff.header.l3 -side right
1641 # -- Diff Body
1642 frame .vpane.lower.diff.body
1643 set ui_diff .vpane.lower.diff.body.t
1644 text $ui_diff -background white -borderwidth 0 \
1645 -width 80 -height 15 -wrap none \
1646 -font $difffont \
1647 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1648 -yscrollcommand {.vpane.lower.diff.body.sby set} \
1649 -cursor $maincursor \
1650 -state disabled
1651 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1652 -command [list $ui_diff xview]
1653 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1654 -command [list $ui_diff yview]
1655 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1656 pack .vpane.lower.diff.body.sby -side right -fill y
1657 pack $ui_diff -side left -fill both -expand 1
1658 pack .vpane.lower.diff.header -side top -fill x
1659 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1661 $ui_diff tag conf dm -foreground red
1662 $ui_diff tag conf dp -foreground blue
1663 $ui_diff tag conf da -font [concat $difffont bold]
1664 $ui_diff tag conf di -foreground "#00a000"
1665 $ui_diff tag conf dni -foreground "#a000a0"
1666 $ui_diff tag conf bold -font [concat $difffont bold]
1668 # -- Status Bar
1669 set ui_status_value {Initializing...}
1670 label .status -textvariable ui_status_value \
1671 -anchor w \
1672 -justify left \
1673 -borderwidth 1 \
1674 -relief sunken \
1675 -font $mainfont
1676 pack .status -anchor w -side bottom -fill x
1678 # -- Key Bindings
1679 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1680 bind . <Destroy> do_quit
1681 bind all <Key-F5> do_rescan
1682 bind all <$M1B-Key-r> do_rescan
1683 bind all <$M1B-Key-R> do_rescan
1684 bind . <$M1B-Key-s> do_signoff
1685 bind . <$M1B-Key-S> do_signoff
1686 bind . <$M1B-Key-u> do_checkin_all
1687 bind . <$M1B-Key-U> do_checkin_all
1688 bind . <$M1B-Key-Return> do_commit
1689 bind all <$M1B-Key-q> do_quit
1690 bind all <$M1B-Key-Q> do_quit
1691 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1692 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1693 foreach i [list $ui_index $ui_other] {
1694 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1695 bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1696 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1697 }
1698 unset i M1B M1T
1700 ######################################################################
1701 ##
1702 ## main
1704 set appname [lindex [file split $argv0] end]
1705 set gitdir {}
1707 if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
1708 show_msg {} . "Cannot find the git directory: $err"
1709 exit 1
1710 }
1711 if {$cdup != ""} {
1712 cd $cdup
1713 }
1714 unset cdup
1716 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1717 show_msg {} . "Cannot find the git directory: $err"
1718 exit 1
1719 }
1721 if {$appname == {git-citool}} {
1722 set single_commit 1
1723 }
1725 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1726 focus -force $ui_comm
1727 load_repo_config
1728 load_all_remotes
1729 populate_remote_menu .mbar.fetch From fetch_from
1730 populate_remote_menu .mbar.push To push_to
1731 populate_pull_menu .mbar.pull
1732 update_status