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