1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4
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.
9
10######################################################################
11##
12## task management
13
14set single_commit 0
15set status_active 0
16set diff_active 0
17set checkin_active 0
18set commit_active 0
19set update_index_fd {}
20
21set disable_on_lock [list]
22set index_lock_type none
23
24set HEAD {}
25set PARENT {}
26set commit_type {}
27
28proc lock_index {type} {
29 global index_lock_type disable_on_lock
30
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}
43
44proc unlock_index {} {
45 global index_lock_type disable_on_lock
46
47 set index_lock_type none
48 foreach w $disable_on_lock {
49 uplevel #0 $w normal
50 }
51}
52
53######################################################################
54##
55## status
56
57proc repository_state {hdvar ctvar} {
58 global gitdir
59 upvar $hdvar hd $ctvar ct
60
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}
69
70proc 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
75 if {$status_active || ![lock_index read]} return
76
77 repository_state new_HEAD new_type
78 if {$commit_type == {amend}
79 && $new_type == {normal}
80 && $new_HEAD == $HEAD} {
81 } else {
82 set HEAD $new_HEAD
83 set PARENT $new_HEAD
84 set commit_type $new_type
85 }
86
87 array unset file_states
88 foreach w [list $ui_index $ui_other] {
89 $w conf -state normal
90 $w delete 0.0 end
91 $w conf -state disabled
92 }
93
94 if {![$ui_comm edit modified]
95 || [string trim [$ui_comm get 0.0 end]] == {}} {
96 if {[load_message GITGUI_MSG]} {
97 } elseif {[load_message MERGE_MSG]} {
98 } elseif {[load_message SQUASH_MSG]} {
99 }
100 $ui_comm edit modified false
101 }
102
103 set status_active 1
104 set ui_status_value {Refreshing file status...}
105 set fd_rf [open "| git update-index -q --unmerged --refresh" r]
106 fconfigure $fd_rf -blocking 0 -translation binary
107 fileevent $fd_rf readable [list read_refresh $fd_rf $final]
108}
109
110proc read_refresh {fd final} {
111 global gitdir PARENT commit_type
112 global ui_index ui_other ui_status_value ui_comm
113 global status_active file_states
114 global buf_rdi buf_rdf buf_rlo
115
116 read $fd
117 if {![eof $fd]} return
118 close $fd
119
120 set ls_others [list | git ls-files --others -z \
121 --exclude-per-directory=.gitignore]
122 set info_exclude [file join $gitdir info exclude]
123 if {[file readable $info_exclude]} {
124 lappend ls_others "--exclude-from=$info_exclude"
125 }
126
127 set buf_rdi {}
128 set buf_rdf {}
129 set buf_rlo {}
130
131 set status_active 3
132 set ui_status_value {Scanning for modified files ...}
133 set fd_di [open "| git diff-index --cached -z $PARENT" r]
134 set fd_df [open "| git diff-files -z" r]
135 set fd_lo [open $ls_others r]
136
137 fconfigure $fd_di -blocking 0 -translation binary
138 fconfigure $fd_df -blocking 0 -translation binary
139 fconfigure $fd_lo -blocking 0 -translation binary
140 fileevent $fd_di readable [list read_diff_index $fd_di $final]
141 fileevent $fd_df readable [list read_diff_files $fd_df $final]
142 fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
143}
144
145proc load_message {file} {
146 global gitdir ui_comm
147
148 set f [file join $gitdir $file]
149 if {[file isfile $f]} {
150 if {[catch {set fd [open $f r]}]} {
151 return 0
152 }
153 set content [string trim [read $fd]]
154 close $fd
155 $ui_comm delete 0.0 end
156 $ui_comm insert end $content
157 return 1
158 }
159 return 0
160}
161
162proc read_diff_index {fd final} {
163 global buf_rdi
164
165 append buf_rdi [read $fd]
166 set c 0
167 set n [string length $buf_rdi]
168 while {$c < $n} {
169 set z1 [string first "\0" $buf_rdi $c]
170 if {$z1 == -1} break
171 incr z1
172 set z2 [string first "\0" $buf_rdi $z1]
173 if {$z2 == -1} break
174
175 set c $z2
176 incr z2 -1
177 display_file \
178 [string range $buf_rdi $z1 $z2] \
179 [string index $buf_rdi [expr $z1 - 2]]_
180 incr c
181 }
182 if {$c < $n} {
183 set buf_rdi [string range $buf_rdi $c end]
184 } else {
185 set buf_rdi {}
186 }
187
188 status_eof $fd buf_rdi $final
189}
190
191proc read_diff_files {fd final} {
192 global buf_rdf
193
194 append buf_rdf [read $fd]
195 set c 0
196 set n [string length $buf_rdf]
197 while {$c < $n} {
198 set z1 [string first "\0" $buf_rdf $c]
199 if {$z1 == -1} break
200 incr z1
201 set z2 [string first "\0" $buf_rdf $z1]
202 if {$z2 == -1} break
203
204 set c $z2
205 incr z2 -1
206 display_file \
207 [string range $buf_rdf $z1 $z2] \
208 _[string index $buf_rdf [expr $z1 - 2]]
209 incr c
210 }
211 if {$c < $n} {
212 set buf_rdf [string range $buf_rdf $c end]
213 } else {
214 set buf_rdf {}
215 }
216
217 status_eof $fd buf_rdf $final
218}
219
220proc read_ls_others {fd final} {
221 global buf_rlo
222
223 append buf_rlo [read $fd]
224 set pck [split $buf_rlo "\0"]
225 set buf_rlo [lindex $pck end]
226 foreach p [lrange $pck 0 end-1] {
227 display_file $p _O
228 }
229 status_eof $fd buf_rlo $final
230}
231
232proc status_eof {fd buf final} {
233 global status_active $buf
234 global ui_fname_value ui_status_value file_states
235
236 if {[eof $fd]} {
237 set $buf {}
238 close $fd
239 if {[incr status_active -1] == 0} {
240 unlock_index
241
242 set ui_status_value $final
243 if {$ui_fname_value != {} && [array names file_states \
244 -exact $ui_fname_value] != {}} {
245 show_diff $ui_fname_value
246 } else {
247 clear_diff
248 }
249 }
250 }
251}
252
253######################################################################
254##
255## diff
256
257proc clear_diff {} {
258 global ui_diff ui_fname_value ui_fstatus_value
259
260 $ui_diff conf -state normal
261 $ui_diff delete 0.0 end
262 $ui_diff conf -state disabled
263 set ui_fname_value {}
264 set ui_fstatus_value {}
265}
266
267proc show_diff {path} {
268 global file_states PARENT diff_3way diff_active
269 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
270
271 if {$diff_active || ![lock_index read]} return
272
273 clear_diff
274 set s $file_states($path)
275 set m [lindex $s 0]
276 set diff_3way 0
277 set diff_active 1
278 set ui_fname_value $path
279 set ui_fstatus_value [mapdesc $m $path]
280 set ui_status_value "Loading diff of $path..."
281
282 set cmd [list | git diff-index -p $PARENT -- $path]
283 switch $m {
284 AM {
285 }
286 MM {
287 set cmd [list | git diff-index -p -c $PARENT $path]
288 }
289 _O {
290 if {[catch {
291 set fd [open $path r]
292 set content [read $fd]
293 close $fd
294 } err ]} {
295 set diff_active 0
296 unlock_index
297 set ui_status_value "Unable to display $path"
298 error_popup "Error loading file:\n$err"
299 return
300 }
301 $ui_diff conf -state normal
302 $ui_diff insert end $content
303 $ui_diff conf -state disabled
304 set diff_active 0
305 unlock_index
306 set ui_status_value {Ready.}
307 return
308 }
309 }
310
311 if {[catch {set fd [open $cmd r]} err]} {
312 set diff_active 0
313 unlock_index
314 set ui_status_value "Unable to display $path"
315 error_popup "Error loading diff:\n$err"
316 return
317 }
318
319 fconfigure $fd -blocking 0 -translation auto
320 fileevent $fd readable [list read_diff $fd]
321}
322
323proc read_diff {fd} {
324 global ui_diff ui_status_value diff_3way diff_active
325
326 while {[gets $fd line] >= 0} {
327 if {[string match {diff --git *} $line]} continue
328 if {[string match {diff --combined *} $line]} continue
329 if {[string match {--- *} $line]} continue
330 if {[string match {+++ *} $line]} continue
331 if {[string match index* $line]} {
332 if {[string first , $line] >= 0} {
333 set diff_3way 1
334 }
335 }
336
337 $ui_diff conf -state normal
338 if {!$diff_3way} {
339 set x [string index $line 0]
340 switch -- $x {
341 "@" {set tags da}
342 "+" {set tags dp}
343 "-" {set tags dm}
344 default {set tags {}}
345 }
346 } else {
347 set x [string range $line 0 1]
348 switch -- $x {
349 default {set tags {}}
350 "@@" {set tags da}
351 "++" {set tags dp; set x " +"}
352 " +" {set tags {di bold}; set x "++"}
353 "+ " {set tags dni; set x "-+"}
354 "--" {set tags dm; set x " -"}
355 " -" {set tags {dm bold}; set x "--"}
356 "- " {set tags di; set x "+-"}
357 default {set tags {}}
358 }
359 set line [string replace $line 0 1 $x]
360 }
361 $ui_diff insert end $line $tags
362 $ui_diff insert end "\n"
363 $ui_diff conf -state disabled
364 }
365
366 if {[eof $fd]} {
367 close $fd
368 set diff_active 0
369 unlock_index
370 set ui_status_value {Ready.}
371 }
372}
373
374######################################################################
375##
376## commit
377
378proc load_last_commit {} {
379 global HEAD PARENT commit_type ui_comm
380
381 if {$commit_type == {amend}} return
382 if {$commit_type != {normal}} {
383 error_popup "Can't amend a $commit_type commit."
384 return
385 }
386
387 set msg {}
388 set parent {}
389 set parent_count 0
390 if {[catch {
391 set fd [open "| git cat-file commit $HEAD" r]
392 while {[gets $fd line] > 0} {
393 if {[string match {parent *} $line]} {
394 set parent [string range $line 7 end]
395 incr parent_count
396 }
397 }
398 set msg [string trim [read $fd]]
399 close $fd
400 } err]} {
401 error_popup "Error loading commit data for amend:\n$err"
402 return
403 }
404
405 if {$parent_count == 0} {
406 set commit_type amend
407 set HEAD {}
408 set PARENT {}
409 update_status
410 } elseif {$parent_count == 1} {
411 set commit_type amend
412 set PARENT $parent
413 $ui_comm delete 0.0 end
414 $ui_comm insert end $msg
415 $ui_comm edit modified false
416 update_status
417 } else {
418 error_popup {You can't amend a merge commit.}
419 return
420 }
421}
422
423proc commit_tree {} {
424 global tcl_platform HEAD gitdir commit_type file_states
425 global commit_active ui_status_value
426 global ui_comm
427
428 if {$commit_active || ![lock_index update]} return
429
430 # -- Our in memory state should match the repository.
431 #
432 repository_state curHEAD cur_type
433 if {$commit_type == {amend}
434 && $cur_type == {normal}
435 && $curHEAD == $HEAD} {
436 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
437 error_popup {Last scanned state does not match repository state.
438
439Its highly likely that another Git program modified the
440repository since our last scan. A rescan is required
441before committing.
442}
443 unlock_index
444 update_status
445 return
446 }
447
448 # -- At least one file should differ in the index.
449 #
450 set files_ready 0
451 foreach path [array names file_states] {
452 set s $file_states($path)
453 switch -glob -- [lindex $s 0] {
454 _* {continue}
455 A* -
456 D* -
457 M* {set files_ready 1; break}
458 U* {
459 error_popup "Unmerged files cannot be committed.
460
461File $path has merge conflicts.
462You must resolve them and check the file in before committing.
463"
464 unlock_index
465 return
466 }
467 default {
468 error_popup "Unknown file state [lindex $s 0] detected.
469
470File $path cannot be committed by this program.
471"
472 }
473 }
474 }
475 if {!$files_ready} {
476 error_popup {No checked-in files to commit.
477
478You must check-in at least 1 file before you can commit.
479}
480 unlock_index
481 return
482 }
483
484 # -- A message is required.
485 #
486 set msg [string trim [$ui_comm get 1.0 end]]
487 if {$msg == {}} {
488 error_popup {Please supply a commit message.
489
490A good commit message has the following format:
491
492- First line: Describe in one sentance what you did.
493- Second line: Blank
494- Remaining lines: Describe why this change is good.
495}
496 unlock_index
497 return
498 }
499
500 # -- Ask the pre-commit hook for the go-ahead.
501 #
502 set pchook [file join $gitdir hooks pre-commit]
503 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
504 set pchook [list sh -c \
505 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
506 } elseif {[file executable $pchook]} {
507 set pchook [list $pchook]
508 } else {
509 set pchook {}
510 }
511 if {$pchook != {} && [catch {eval exec $pchook} err]} {
512 hook_failed_popup pre-commit $err
513 unlock_index
514 return
515 }
516
517 # -- Write the tree in the background.
518 #
519 set commit_active 1
520 set ui_status_value {Committing changes...}
521
522 set fd_wt [open "| git write-tree" r]
523 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
524}
525
526proc commit_stage2 {fd_wt curHEAD msg} {
527 global single_commit gitdir PARENT commit_type
528 global commit_active ui_status_value ui_comm
529
530 gets $fd_wt tree_id
531 close $fd_wt
532
533 if {$tree_id == {}} {
534 error_popup "write-tree failed"
535 set commit_active 0
536 set ui_status_value {Commit failed.}
537 unlock_index
538 return
539 }
540
541 # -- Create the commit.
542 #
543 set cmd [list git commit-tree $tree_id]
544 if {$PARENT != {}} {
545 lappend cmd -p $PARENT
546 }
547 if {$commit_type == {merge}} {
548 if {[catch {
549 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
550 while {[gets $fd_mh merge_head] >= 0} {
551 lappend cmd -p $merge_head
552 }
553 close $fd_mh
554 } err]} {
555 error_popup "Loading MERGE_HEADs failed:\n$err"
556 set commit_active 0
557 set ui_status_value {Commit failed.}
558 unlock_index
559 return
560 }
561 }
562 if {$PARENT == {}} {
563 # git commit-tree writes to stderr during initial commit.
564 lappend cmd 2>/dev/null
565 }
566 lappend cmd << $msg
567 if {[catch {set cmt_id [eval exec $cmd]} err]} {
568 error_popup "commit-tree failed:\n$err"
569 set commit_active 0
570 set ui_status_value {Commit failed.}
571 unlock_index
572 return
573 }
574
575 # -- Update the HEAD ref.
576 #
577 set reflogm commit
578 if {$commit_type != {normal}} {
579 append reflogm " ($commit_type)"
580 }
581 set i [string first "\n" $msg]
582 if {$i >= 0} {
583 append reflogm {: } [string range $msg 0 [expr $i - 1]]
584 } else {
585 append reflogm {: } $msg
586 }
587 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
588 if {[catch {eval exec $cmd} err]} {
589 error_popup "update-ref failed:\n$err"
590 set commit_active 0
591 set ui_status_value {Commit failed.}
592 unlock_index
593 return
594 }
595
596 # -- Cleanup after ourselves.
597 #
598 catch {file delete [file join $gitdir MERGE_HEAD]}
599 catch {file delete [file join $gitdir MERGE_MSG]}
600 catch {file delete [file join $gitdir SQUASH_MSG]}
601 catch {file delete [file join $gitdir GITGUI_MSG]}
602
603 # -- Let rerere do its thing.
604 #
605 if {[file isdirectory [file join $gitdir rr-cache]]} {
606 catch {exec git rerere}
607 }
608
609 $ui_comm delete 0.0 end
610 $ui_comm edit modified false
611
612 if {$single_commit} do_quit
613
614 set commit_type {}
615 set commit_active 0
616 set HEAD $cmt_id
617 set PARENT $cmt_id
618 unlock_index
619 update_status "Changes committed as $cmt_id."
620}
621
622######################################################################
623##
624## fetch pull push
625
626proc fetch_from {remote} {
627 set w [new_console "fetch $remote" \
628 "Fetching new changes from $remote"]
629 set cmd [list git fetch]
630 lappend cmd $remote
631 console_exec $w $cmd
632}
633
634proc pull_remote {remote branch} {
635 set w [new_console "pull $remote $branch" \
636 "Pulling new changes from branch $branch in $remote"]
637 set cmd [list git pull]
638 lappend cmd $remote
639 lappend cmd $branch
640 console_exec $w $cmd [list post_pull_remote $remote $branch]
641}
642
643proc post_pull_remote {remote branch success} {
644 if {$success} {
645 update_status "Successfully pulled $branch from $remote."
646 } else {
647 update_status "Conflicts detected while pulling $branch from $remote."
648 }
649}
650
651proc push_to {remote} {
652 set w [new_console "push $remote" \
653 "Pushing changes to $remote"]
654 set cmd [list git push]
655 lappend cmd $remote
656 console_exec $w $cmd
657}
658
659######################################################################
660##
661## ui helpers
662
663proc mapcol {state path} {
664 global all_cols
665
666 if {[catch {set r $all_cols($state)}]} {
667 puts "error: no column for state={$state} $path"
668 return o
669 }
670 return $r
671}
672
673proc mapicon {state path} {
674 global all_icons
675
676 if {[catch {set r $all_icons($state)}]} {
677 puts "error: no icon for state={$state} $path"
678 return file_plain
679 }
680 return $r
681}
682
683proc mapdesc {state path} {
684 global all_descs
685
686 if {[catch {set r $all_descs($state)}]} {
687 puts "error: no desc for state={$state} $path"
688 return $state
689 }
690 return $r
691}
692
693proc bsearch {w path} {
694 set hi [expr [lindex [split [$w index end] .] 0] - 2]
695 if {$hi == 0} {
696 return -1
697 }
698 set lo 0
699 while {$lo < $hi} {
700 set mi [expr [expr $lo + $hi] / 2]
701 set ti [expr $mi + 1]
702 set cmp [string compare [$w get $ti.1 $ti.end] $path]
703 if {$cmp < 0} {
704 set lo $ti
705 } elseif {$cmp == 0} {
706 return $mi
707 } else {
708 set hi $mi
709 }
710 }
711 return -[expr $lo + 1]
712}
713
714proc merge_state {path state} {
715 global file_states
716
717 if {[array names file_states -exact $path] == {}} {
718 set o __
719 set s [list $o none none]
720 } else {
721 set s $file_states($path)
722 set o [lindex $s 0]
723 }
724
725 set m [lindex $s 0]
726 if {[string index $state 0] == "_"} {
727 set state [string index $m 0][string index $state 1]
728 } elseif {[string index $state 0] == "*"} {
729 set state _[string index $state 1]
730 }
731
732 if {[string index $state 1] == "_"} {
733 set state [string index $state 0][string index $m 1]
734 } elseif {[string index $state 1] == "*"} {
735 set state [string index $state 0]_
736 }
737
738 set file_states($path) [lreplace $s 0 0 $state]
739 return $o
740}
741
742proc display_file {path state} {
743 global ui_index ui_other file_states
744
745 set old_m [merge_state $path $state]
746 set s $file_states($path)
747 set m [lindex $s 0]
748
749 if {[mapcol $m $path] == "o"} {
750 set ii 1
751 set ai 2
752 set iw $ui_index
753 set aw $ui_other
754 } else {
755 set ii 2
756 set ai 1
757 set iw $ui_other
758 set aw $ui_index
759 }
760
761 set d [lindex $s $ii]
762 if {$d != "none"} {
763 set lno [bsearch $iw $path]
764 if {$lno >= 0} {
765 incr lno
766 $iw conf -state normal
767 $iw delete $lno.0 [expr $lno + 1].0
768 $iw conf -state disabled
769 set s [lreplace $s $ii $ii none]
770 }
771 }
772
773 set d [lindex $s $ai]
774 if {$d == "none"} {
775 set lno [expr abs([bsearch $aw $path] + 1) + 1]
776 $aw conf -state normal
777 set ico [$aw image create $lno.0 \
778 -align center -padx 5 -pady 1 \
779 -image [mapicon $m $path]]
780 $aw insert $lno.1 "$path\n"
781 $aw conf -state disabled
782 set file_states($path) [lreplace $s $ai $ai [list $ico]]
783 } elseif {[mapicon $m $path] != [mapicon $old_m $path]} {
784 set ico [lindex $d 0]
785 $aw image conf $ico -image [mapicon $m $path]
786 }
787}
788
789proc with_update_index {body} {
790 global update_index_fd
791
792 if {$update_index_fd == {}} {
793 if {![lock_index update]} return
794 set update_index_fd [open \
795 "| git update-index --add --remove -z --stdin" \
796 w]
797 fconfigure $update_index_fd -translation binary
798 uplevel 1 $body
799 close $update_index_fd
800 set update_index_fd {}
801 unlock_index
802 } else {
803 uplevel 1 $body
804 }
805}
806
807proc update_index {path} {
808 global update_index_fd
809
810 if {$update_index_fd == {}} {
811 error {not in with_update_index}
812 } else {
813 puts -nonewline $update_index_fd "$path\0"
814 }
815}
816
817proc toggle_mode {path} {
818 global file_states ui_fname_value
819
820 set s $file_states($path)
821 set m [lindex $s 0]
822
823 switch -- $m {
824 AM -
825 _O {set new A*}
826 _M -
827 MM {set new M*}
828 AD -
829 _D {set new D*}
830 default {return}
831 }
832
833 with_update_index {update_index $path}
834 display_file $path $new
835 if {$ui_fname_value == $path} {
836 show_diff $path
837 }
838}
839
840######################################################################
841##
842## config (fetch push pull)
843
844proc load_repo_config {} {
845 global repo_config
846
847 array unset repo_config
848 catch {
849 set fd_rc [open "| git repo-config --list" r]
850 while {[gets $fd_rc line] >= 0} {
851 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
852 lappend repo_config($name) $value
853 }
854 }
855 close $fd_rc
856 }
857}
858
859proc load_all_remotes {} {
860 global gitdir all_remotes repo_config
861
862 set all_remotes [list]
863 set rm_dir [file join $gitdir remotes]
864 if {[file isdirectory $rm_dir]} {
865 set all_remotes [concat $all_remotes [glob \
866 -types f \
867 -tails \
868 -nocomplain \
869 -directory $rm_dir *]]
870 }
871
872 foreach line [array names repo_config remote.*.url] {
873 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
874 lappend all_remotes $name
875 }
876 }
877
878 set all_remotes [lsort -unique $all_remotes]
879}
880
881proc populate_remote_menu {m pfx op} {
882 global all_remotes mainfont
883
884 foreach remote $all_remotes {
885 $m add command -label "$pfx $remote..." \
886 -command [list $op $remote] \
887 -font $mainfont
888 }
889}
890
891proc populate_pull_menu {m} {
892 global gitdir repo_config all_remotes mainfont
893
894 foreach remote $all_remotes {
895 set rb {}
896 if {[array get repo_config remote.$remote.url] != {}} {
897 if {[array get repo_config remote.$remote.fetch] != {}} {
898 regexp {^([^:]+):} \
899 [lindex $repo_config(remote.$remote.fetch) 0] \
900 line rb
901 }
902 } else {
903 catch {
904 set fd [open [file join $gitdir remotes $remote] r]
905 while {[gets $fd line] >= 0} {
906 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
907 break
908 }
909 }
910 close $fd
911 }
912 }
913
914 set rb_short $rb
915 regsub ^refs/heads/ $rb {} rb_short
916 if {$rb_short != {}} {
917 $m add command \
918 -label "Branch $rb_short from $remote..." \
919 -command [list pull_remote $remote $rb] \
920 -font $mainfont
921 }
922 }
923}
924
925######################################################################
926##
927## icons
928
929set filemask {
930#define mask_width 14
931#define mask_height 15
932static unsigned char mask_bits[] = {
933 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
934 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
935 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
936}
937
938image create bitmap file_plain -background white -foreground black -data {
939#define plain_width 14
940#define plain_height 15
941static unsigned char plain_bits[] = {
942 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
943 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
944 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
945} -maskdata $filemask
946
947image create bitmap file_mod -background white -foreground blue -data {
948#define mod_width 14
949#define mod_height 15
950static unsigned char mod_bits[] = {
951 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
952 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
953 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
954} -maskdata $filemask
955
956image create bitmap file_fulltick -background white -foreground "#007000" -data {
957#define file_fulltick_width 14
958#define file_fulltick_height 15
959static unsigned char file_fulltick_bits[] = {
960 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
961 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
962 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
963} -maskdata $filemask
964
965image create bitmap file_parttick -background white -foreground "#005050" -data {
966#define parttick_width 14
967#define parttick_height 15
968static unsigned char parttick_bits[] = {
969 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
970 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
971 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
972} -maskdata $filemask
973
974image create bitmap file_question -background white -foreground black -data {
975#define file_question_width 14
976#define file_question_height 15
977static unsigned char file_question_bits[] = {
978 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
979 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
980 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
981} -maskdata $filemask
982
983image create bitmap file_removed -background white -foreground red -data {
984#define file_removed_width 14
985#define file_removed_height 15
986static unsigned char file_removed_bits[] = {
987 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
988 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
989 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
990} -maskdata $filemask
991
992image create bitmap file_merge -background white -foreground blue -data {
993#define file_merge_width 14
994#define file_merge_height 15
995static unsigned char file_merge_bits[] = {
996 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
997 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
998 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
999} -maskdata $filemask
1000
1001set max_status_desc 0
1002foreach i {
1003 {__ i plain "Unmodified"}
1004 {_M i mod "Modified"}
1005 {M_ i fulltick "Checked in"}
1006 {MM i parttick "Partially checked in"}
1007
1008 {_O o plain "Untracked"}
1009 {A_ o fulltick "Added"}
1010 {AM o parttick "Partially added"}
1011 {AD o question "Added (but now gone)"}
1012
1013 {_D i question "Missing"}
1014 {D_ i removed "Removed"}
1015 {DD i removed "Removed"}
1016 {DO i removed "Removed (still exists)"}
1017
1018 {UM i merge "Merge conflicts"}
1019 {U_ i merge "Merge conflicts"}
1020 } {
1021 if {$max_status_desc < [string length [lindex $i 3]]} {
1022 set max_status_desc [string length [lindex $i 3]]
1023 }
1024 set all_cols([lindex $i 0]) [lindex $i 1]
1025 set all_icons([lindex $i 0]) file_[lindex $i 2]
1026 set all_descs([lindex $i 0]) [lindex $i 3]
1027}
1028unset filemask i
1029
1030######################################################################
1031##
1032## util
1033
1034proc error_popup {msg} {
1035 set w .error
1036 toplevel $w
1037 wm transient $w .
1038 show_msg $w $w $msg
1039}
1040
1041proc show_msg {w top msg} {
1042 global gitdir appname mainfont
1043
1044 message $w.m -text $msg -justify left -aspect 400
1045 pack $w.m -side top -fill x -padx 5 -pady 10
1046 button $w.ok -text OK \
1047 -width 15 \
1048 -font $mainfont \
1049 -command "destroy $top"
1050 pack $w.ok -side bottom
1051 bind $top <Visibility> "grab $top; focus $top"
1052 bind $top <Key-Return> "destroy $top"
1053 wm title $w "$appname ([lindex [file split \
1054 [file normalize [file dirname $gitdir]]] \
1055 end]): error"
1056 tkwait window $top
1057}
1058
1059proc hook_failed_popup {hook msg} {
1060 global gitdir mainfont difffont appname
1061
1062 set w .hookfail
1063 toplevel $w
1064 wm transient $w .
1065
1066 frame $w.m
1067 label $w.m.l1 -text "$hook hook failed:" \
1068 -anchor w \
1069 -justify left \
1070 -font [concat $mainfont bold]
1071 text $w.m.t \
1072 -background white -borderwidth 1 \
1073 -relief sunken \
1074 -width 80 -height 10 \
1075 -font $difffont \
1076 -yscrollcommand [list $w.m.sby set]
1077 label $w.m.l2 \
1078 -text {You must correct the above errors before committing.} \
1079 -anchor w \
1080 -justify left \
1081 -font [concat $mainfont bold]
1082 scrollbar $w.m.sby -command [list $w.m.t yview]
1083 pack $w.m.l1 -side top -fill x
1084 pack $w.m.l2 -side bottom -fill x
1085 pack $w.m.sby -side right -fill y
1086 pack $w.m.t -side left -fill both -expand 1
1087 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1088
1089 $w.m.t insert 1.0 $msg
1090 $w.m.t conf -state disabled
1091
1092 button $w.ok -text OK \
1093 -width 15 \
1094 -font $mainfont \
1095 -command "destroy $w"
1096 pack $w.ok -side bottom
1097
1098 bind $w <Visibility> "grab $w; focus $w"
1099 bind $w <Key-Return> "destroy $w"
1100 wm title $w "$appname ([lindex [file split \
1101 [file normalize [file dirname $gitdir]]] \
1102 end]): error"
1103 tkwait window $w
1104}
1105
1106set next_console_id 0
1107
1108proc new_console {short_title long_title} {
1109 global next_console_id console_data
1110 set w .console[incr next_console_id]
1111 set console_data($w) [list $short_title $long_title]
1112 return [console_init $w]
1113}
1114
1115proc console_init {w} {
1116 global console_cr console_data
1117 global gitdir appname mainfont difffont
1118
1119 set console_cr($w) 1.0
1120 toplevel $w
1121 frame $w.m
1122 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1123 -anchor w \
1124 -justify left \
1125 -font [concat $mainfont bold]
1126 text $w.m.t \
1127 -background white -borderwidth 1 \
1128 -relief sunken \
1129 -width 80 -height 10 \
1130 -font $difffont \
1131 -state disabled \
1132 -yscrollcommand [list $w.m.sby set]
1133 label $w.m.s -anchor w \
1134 -justify left \
1135 -font [concat $mainfont bold]
1136 scrollbar $w.m.sby -command [list $w.m.t yview]
1137 pack $w.m.l1 -side top -fill x
1138 pack $w.m.s -side bottom -fill x
1139 pack $w.m.sby -side right -fill y
1140 pack $w.m.t -side left -fill both -expand 1
1141 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1142
1143 button $w.ok -text {Running...} \
1144 -width 15 \
1145 -font $mainfont \
1146 -state disabled \
1147 -command "destroy $w"
1148 pack $w.ok -side bottom
1149
1150 bind $w <Visibility> "focus $w"
1151 wm title $w "$appname ([lindex [file split \
1152 [file normalize [file dirname $gitdir]]] \
1153 end]): [lindex $console_data($w) 0]"
1154 return $w
1155}
1156
1157proc console_exec {w cmd {after {}}} {
1158 global tcl_platform
1159
1160 # -- Windows tosses the enviroment when we exec our child.
1161 # But most users need that so we have to relogin. :-(
1162 #
1163 if {$tcl_platform(platform) == {windows}} {
1164 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1165 }
1166
1167 # -- Tcl won't let us redirect both stdout and stderr to
1168 # the same pipe. So pass it through cat...
1169 #
1170 set cmd [concat | $cmd |& cat]
1171
1172 set fd_f [open $cmd r]
1173 fconfigure $fd_f -blocking 0 -translation binary
1174 fileevent $fd_f readable [list console_read $w $fd_f $after]
1175}
1176
1177proc console_read {w fd after} {
1178 global console_cr console_data
1179
1180 set buf [read $fd]
1181 if {$buf != {}} {
1182 if {![winfo exists $w]} {console_init $w}
1183 $w.m.t conf -state normal
1184 set c 0
1185 set n [string length $buf]
1186 while {$c < $n} {
1187 set cr [string first "\r" $buf $c]
1188 set lf [string first "\n" $buf $c]
1189 if {$cr < 0} {set cr [expr $n + 1]}
1190 if {$lf < 0} {set lf [expr $n + 1]}
1191
1192 if {$lf < $cr} {
1193 $w.m.t insert end [string range $buf $c $lf]
1194 set console_cr($w) [$w.m.t index {end -1c}]
1195 set c $lf
1196 incr c
1197 } else {
1198 $w.m.t delete $console_cr($w) end
1199 $w.m.t insert end "\n"
1200 $w.m.t insert end [string range $buf $c $cr]
1201 set c $cr
1202 incr c
1203 }
1204 }
1205 $w.m.t conf -state disabled
1206 $w.m.t see end
1207 }
1208
1209 fconfigure $fd -blocking 1
1210 if {[eof $fd]} {
1211 if {[catch {close $fd}]} {
1212 if {![winfo exists $w]} {console_init $w}
1213 $w.m.s conf -background red -text {Error: Command Failed}
1214 $w.ok conf -text Close
1215 $w.ok conf -state normal
1216 set ok 0
1217 } elseif {[winfo exists $w]} {
1218 $w.m.s conf -background green -text {Success}
1219 $w.ok conf -text Close
1220 $w.ok conf -state normal
1221 set ok 1
1222 }
1223 array unset console_cr $w
1224 array unset console_data $w
1225 if {$after != {}} {
1226 uplevel #0 $after $ok
1227 }
1228 return
1229 }
1230 fconfigure $fd -blocking 0
1231}
1232
1233######################################################################
1234##
1235## ui commands
1236
1237set starting_gitk_msg {Please wait... Starting gitk...}
1238
1239proc do_gitk {} {
1240 global tcl_platform ui_status_value starting_gitk_msg
1241
1242 set ui_status_value $starting_gitk_msg
1243 after 10000 {
1244 if {$ui_status_value == $starting_gitk_msg} {
1245 set ui_status_value {Ready.}
1246 }
1247 }
1248
1249 if {$tcl_platform(platform) == {windows}} {
1250 exec sh -c gitk &
1251 } else {
1252 exec gitk &
1253 }
1254}
1255
1256proc do_quit {} {
1257 global gitdir ui_comm
1258
1259 set save [file join $gitdir GITGUI_MSG]
1260 set msg [string trim [$ui_comm get 0.0 end]]
1261 if {[$ui_comm edit modified] && $msg != {}} {
1262 catch {
1263 set fd [open $save w]
1264 puts $fd [string trim [$ui_comm get 0.0 end]]
1265 close $fd
1266 }
1267 } elseif {$msg == {} && [file exists $save]} {
1268 file delete $save
1269 }
1270
1271 destroy .
1272}
1273
1274proc do_rescan {} {
1275 update_status
1276}
1277
1278proc do_checkin_all {} {
1279 global checkin_active ui_status_value
1280
1281 if {$checkin_active || ![lock_index begin-update]} return
1282
1283 set checkin_active 1
1284 set ui_status_value {Checking in all files...}
1285 after 1 {
1286 with_update_index {
1287 foreach path [array names file_states] {
1288 set s $file_states($path)
1289 set m [lindex $s 0]
1290 switch -- $m {
1291 AM -
1292 MM -
1293 _M -
1294 _D {toggle_mode $path}
1295 }
1296 }
1297 }
1298 set checkin_active 0
1299 set ui_status_value {Ready.}
1300 }
1301}
1302
1303proc do_signoff {} {
1304 global ui_comm
1305
1306 catch {
1307 set me [exec git var GIT_COMMITTER_IDENT]
1308 if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
1309 set str "Signed-off-by: $name"
1310 if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1311 $ui_comm insert end "\n"
1312 $ui_comm insert end $str
1313 $ui_comm see end
1314 }
1315 }
1316 }
1317}
1318
1319proc do_amend_last {} {
1320 load_last_commit
1321}
1322
1323proc do_commit {} {
1324 commit_tree
1325}
1326
1327# shift == 1: left click
1328# 3: right click
1329proc click {w x y shift wx wy} {
1330 global ui_index ui_other
1331
1332 set pos [split [$w index @$x,$y] .]
1333 set lno [lindex $pos 0]
1334 set col [lindex $pos 1]
1335 set path [$w get $lno.1 $lno.end]
1336 if {$path == {}} return
1337
1338 if {$col > 0 && $shift == 1} {
1339 $ui_index tag remove in_diff 0.0 end
1340 $ui_other tag remove in_diff 0.0 end
1341 $w tag add in_diff $lno.0 [expr $lno + 1].0
1342 show_diff $path
1343 }
1344}
1345
1346proc unclick {w x y} {
1347 set pos [split [$w index @$x,$y] .]
1348 set lno [lindex $pos 0]
1349 set col [lindex $pos 1]
1350 set path [$w get $lno.1 $lno.end]
1351 if {$path == {}} return
1352
1353 if {$col == 0} {
1354 toggle_mode $path
1355 }
1356}
1357
1358######################################################################
1359##
1360## ui init
1361
1362set mainfont {Helvetica 10}
1363set difffont {Courier 10}
1364set maincursor [. cget -cursor]
1365
1366switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1367windows,* {set M1B Control; set M1T Ctrl}
1368unix,Darwin {set M1B M1; set M1T Cmd}
1369default {set M1B M1; set M1T M1}
1370}
1371
1372# -- Menu Bar
1373menu .mbar -tearoff 0
1374.mbar add cascade -label Project -menu .mbar.project
1375.mbar add cascade -label Commit -menu .mbar.commit
1376.mbar add cascade -label Fetch -menu .mbar.fetch
1377.mbar add cascade -label Pull -menu .mbar.pull
1378.mbar add cascade -label Push -menu .mbar.push
1379. configure -menu .mbar
1380
1381# -- Project Menu
1382menu .mbar.project
1383.mbar.project add command -label Visualize \
1384 -command do_gitk \
1385 -font $mainfont
1386.mbar.project add command -label Quit \
1387 -command do_quit \
1388 -accelerator $M1T-Q \
1389 -font $mainfont
1390
1391# -- Commit Menu
1392menu .mbar.commit
1393.mbar.commit add command -label Rescan \
1394 -command do_rescan \
1395 -accelerator F5 \
1396 -font $mainfont
1397lappend disable_on_lock \
1398 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1399.mbar.commit add command -label {Amend Last Commit} \
1400 -command do_amend_last \
1401 -font $mainfont
1402lappend disable_on_lock \
1403 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1404.mbar.commit add command -label {Check-in All Files} \
1405 -command do_checkin_all \
1406 -accelerator $M1T-U \
1407 -font $mainfont
1408lappend disable_on_lock \
1409 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1410.mbar.commit add command -label {Sign Off} \
1411 -command do_signoff \
1412 -accelerator $M1T-S \
1413 -font $mainfont
1414.mbar.commit add command -label Commit \
1415 -command do_commit \
1416 -accelerator $M1T-Return \
1417 -font $mainfont
1418lappend disable_on_lock \
1419 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1420
1421# -- Fetch Menu
1422menu .mbar.fetch
1423
1424# -- Pull Menu
1425menu .mbar.pull
1426
1427# -- Push Menu
1428menu .mbar.push
1429
1430# -- Main Window Layout
1431panedwindow .vpane -orient vertical
1432panedwindow .vpane.files -orient horizontal
1433.vpane add .vpane.files -sticky nsew -height 100 -width 400
1434pack .vpane -anchor n -side top -fill both -expand 1
1435
1436# -- Index File List
1437set ui_index .vpane.files.index.list
1438frame .vpane.files.index -height 100 -width 400
1439label .vpane.files.index.title -text {Modified Files} \
1440 -background green \
1441 -font $mainfont
1442text $ui_index -background white -borderwidth 0 \
1443 -width 40 -height 10 \
1444 -font $mainfont \
1445 -yscrollcommand {.vpane.files.index.sb set} \
1446 -cursor $maincursor \
1447 -state disabled
1448scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1449pack .vpane.files.index.title -side top -fill x
1450pack .vpane.files.index.sb -side right -fill y
1451pack $ui_index -side left -fill both -expand 1
1452.vpane.files add .vpane.files.index -sticky nsew
1453
1454# -- Other (Add) File List
1455set ui_other .vpane.files.other.list
1456frame .vpane.files.other -height 100 -width 100
1457label .vpane.files.other.title -text {Untracked Files} \
1458 -background red \
1459 -font $mainfont
1460text $ui_other -background white -borderwidth 0 \
1461 -width 40 -height 10 \
1462 -font $mainfont \
1463 -yscrollcommand {.vpane.files.other.sb set} \
1464 -cursor $maincursor \
1465 -state disabled
1466scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1467pack .vpane.files.other.title -side top -fill x
1468pack .vpane.files.other.sb -side right -fill y
1469pack $ui_other -side left -fill both -expand 1
1470.vpane.files add .vpane.files.other -sticky nsew
1471
1472$ui_index tag conf in_diff -font [concat $mainfont bold]
1473$ui_other tag conf in_diff -font [concat $mainfont bold]
1474
1475# -- Diff Header
1476set ui_fname_value {}
1477set ui_fstatus_value {}
1478frame .vpane.diff -height 200 -width 400
1479frame .vpane.diff.header
1480label .vpane.diff.header.l1 -text {File:} -font $mainfont
1481label .vpane.diff.header.l2 -textvariable ui_fname_value \
1482 -anchor w \
1483 -justify left \
1484 -font $mainfont
1485label .vpane.diff.header.l3 -text {Status:} -font $mainfont
1486label .vpane.diff.header.l4 -textvariable ui_fstatus_value \
1487 -width $max_status_desc \
1488 -anchor w \
1489 -justify left \
1490 -font $mainfont
1491pack .vpane.diff.header.l1 -side left
1492pack .vpane.diff.header.l2 -side left -fill x
1493pack .vpane.diff.header.l4 -side right
1494pack .vpane.diff.header.l3 -side right
1495
1496# -- Diff Body
1497frame .vpane.diff.body
1498set ui_diff .vpane.diff.body.t
1499text $ui_diff -background white -borderwidth 0 \
1500 -width 80 -height 15 -wrap none \
1501 -font $difffont \
1502 -xscrollcommand {.vpane.diff.body.sbx set} \
1503 -yscrollcommand {.vpane.diff.body.sby set} \
1504 -cursor $maincursor \
1505 -state disabled
1506scrollbar .vpane.diff.body.sbx -orient horizontal \
1507 -command [list $ui_diff xview]
1508scrollbar .vpane.diff.body.sby -orient vertical \
1509 -command [list $ui_diff yview]
1510pack .vpane.diff.body.sbx -side bottom -fill x
1511pack .vpane.diff.body.sby -side right -fill y
1512pack $ui_diff -side left -fill both -expand 1
1513pack .vpane.diff.header -side top -fill x
1514pack .vpane.diff.body -side bottom -fill both -expand 1
1515.vpane add .vpane.diff -stick nsew
1516
1517$ui_diff tag conf dm -foreground red
1518$ui_diff tag conf dp -foreground blue
1519$ui_diff tag conf da -font [concat $difffont bold]
1520$ui_diff tag conf di -foreground "#00a000"
1521$ui_diff tag conf dni -foreground "#a000a0"
1522$ui_diff tag conf bold -font [concat $difffont bold]
1523
1524# -- Commit Area
1525frame .vpane.commarea -height 170
1526.vpane add .vpane.commarea -stick nsew
1527
1528# -- Commit Area Buttons
1529frame .vpane.commarea.buttons
1530label .vpane.commarea.buttons.l -text {} \
1531 -anchor w \
1532 -justify left \
1533 -font $mainfont
1534pack .vpane.commarea.buttons.l -side top -fill x
1535pack .vpane.commarea.buttons -side left -fill y
1536
1537button .vpane.commarea.buttons.rescan -text {Rescan} \
1538 -command do_rescan \
1539 -font $mainfont
1540pack .vpane.commarea.buttons.rescan -side top -fill x
1541lappend disable_on_lock {.vpane.commarea.buttons.rescan conf -state}
1542
1543button .vpane.commarea.buttons.amend -text {Amend Last} \
1544 -command do_amend_last \
1545 -font $mainfont
1546pack .vpane.commarea.buttons.amend -side top -fill x
1547lappend disable_on_lock {.vpane.commarea.buttons.amend conf -state}
1548
1549button .vpane.commarea.buttons.ciall -text {Check-in All} \
1550 -command do_checkin_all \
1551 -font $mainfont
1552pack .vpane.commarea.buttons.ciall -side top -fill x
1553lappend disable_on_lock {.vpane.commarea.buttons.ciall conf -state}
1554
1555button .vpane.commarea.buttons.signoff -text {Sign Off} \
1556 -command do_signoff \
1557 -font $mainfont
1558pack .vpane.commarea.buttons.signoff -side top -fill x
1559
1560button .vpane.commarea.buttons.commit -text {Commit} \
1561 -command do_commit \
1562 -font $mainfont
1563pack .vpane.commarea.buttons.commit -side top -fill x
1564lappend disable_on_lock {.vpane.commarea.buttons.commit conf -state}
1565
1566# -- Commit Message Buffer
1567frame .vpane.commarea.buffer
1568set ui_comm .vpane.commarea.buffer.t
1569set ui_coml .vpane.commarea.buffer.l
1570label $ui_coml -text {Commit Message:} \
1571 -anchor w \
1572 -justify left \
1573 -font $mainfont
1574trace add variable commit_type write {uplevel #0 {
1575 switch -glob $commit_type \
1576 initial {$ui_coml conf -text {Initial Commit Message:}} \
1577 amend {$ui_coml conf -text {Amended Commit Message:}} \
1578 merge {$ui_coml conf -text {Merge Commit Message:}} \
1579 * {$ui_coml conf -text {Commit Message:}}
1580}}
1581text $ui_comm -background white -borderwidth 1 \
1582 -relief sunken \
1583 -width 75 -height 10 -wrap none \
1584 -font $difffont \
1585 -yscrollcommand {.vpane.commarea.buffer.sby set} \
1586 -cursor $maincursor
1587scrollbar .vpane.commarea.buffer.sby -command [list $ui_comm yview]
1588pack $ui_coml -side top -fill x
1589pack .vpane.commarea.buffer.sby -side right -fill y
1590pack $ui_comm -side left -fill y
1591pack .vpane.commarea.buffer -side left -fill y
1592
1593# -- Status Bar
1594set ui_status_value {Initializing...}
1595label .status -textvariable ui_status_value \
1596 -anchor w \
1597 -justify left \
1598 -borderwidth 1 \
1599 -relief sunken \
1600 -font $mainfont
1601pack .status -anchor w -side bottom -fill x
1602
1603# -- Key Bindings
1604bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1605bind . <Destroy> do_quit
1606bind all <Key-F5> do_rescan
1607bind all <$M1B-Key-r> do_rescan
1608bind all <$M1B-Key-R> do_rescan
1609bind . <$M1B-Key-s> do_signoff
1610bind . <$M1B-Key-S> do_signoff
1611bind . <$M1B-Key-u> do_checkin_all
1612bind . <$M1B-Key-U> do_checkin_all
1613bind . <$M1B-Key-Return> do_commit
1614bind all <$M1B-Key-q> do_quit
1615bind all <$M1B-Key-Q> do_quit
1616bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1617bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1618foreach i [list $ui_index $ui_other] {
1619 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1620 bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1621 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1622}
1623unset i M1B M1T
1624
1625######################################################################
1626##
1627## main
1628
1629set appname [lindex [file split $argv0] end]
1630set gitdir {}
1631
1632if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
1633 show_msg {} . "Cannot find the git directory: $err"
1634 exit 1
1635}
1636if {$cdup != ""} {
1637 cd $cdup
1638}
1639unset cdup
1640
1641if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1642 show_msg {} . "Cannot find the git directory: $err"
1643 exit 1
1644}
1645
1646if {$appname == {git-citool}} {
1647 set single_commit 1
1648}
1649
1650wm title . "$appname ([file normalize [file dirname $gitdir]])"
1651focus -force $ui_comm
1652load_repo_config
1653load_all_remotes
1654populate_remote_menu .mbar.fetch From fetch_from
1655populate_remote_menu .mbar.push To push_to
1656populate_pull_menu .mbar.pull
1657update_status