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