?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
git-gui: Created edit menu and basic editing bindings.
[git-gui.git] / git-gui
blob640519c204c904eb3982a827f44c997165639dd2
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec 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
14 proc 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
36 proc 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
66 set appname [lindex [file split $argv0] end]
67 set gitdir {}
68 set GIT_COMMITTER_IDENT {}
69
70 if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
71 show_msg {} . "Cannot find the git directory: $err"
72 exit 1
73 }
74 if {$cdup != ""} {
75 cd $cdup
76 }
77 unset cdup
78
79 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
80 show_msg {} . "Cannot find the git directory: $err"
81 exit 1
82 }
83
84 if {$appname == {git-citool}} {
85 set single_commit 1
86 }
87
88 load_repo_config
89
90 ######################################################################
91 ##
92 ## task management
93
94 set single_commit 0
95 set status_active 0
96 set diff_active 0
97 set update_active 0
98 set commit_active 0
99 set update_index_fd {}
100
101 set disable_on_lock [list]
102 set index_lock_type none
103
104 set HEAD {}
105 set PARENT {}
106 set commit_type {}
107
108 proc 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
124 proc 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
137 proc 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
150 proc 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
195 proc 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
232 proc 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
249 proc 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
278 proc 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
307 proc 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
319 proc 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
347 proc 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
357 proc 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
413 proc 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
468 proc 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
513 proc 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
529 Its highly likely that another Git program modified the
530 repository since our last scan. A rescan is required
531 before 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
551 File $path has merge conflicts.
552 You 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
560 File $path cannot be committed by this program.
561 "
562 }
563 }
564 }
565 if {!$files_ready} {
566 error_popup {No included files to commit.
567
568 You 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
580 A 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
616 proc 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
716 proc 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
724 proc 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
736 Its highly likely that another Git program modified the
737 repository since our last scan. A rescan is required
738 before 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
750 You should not perform a pull with unmodified files in your working
751 directory as Git would be unable to recover from an incorrect merge.
752
753 Commit 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
767 proc 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
781 proc 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
793 proc 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
803 proc 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
813 proc 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
823 proc 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
844 set next_icon_id 0
845
846 proc 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
876 proc 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
912 proc 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
933 proc 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
951 proc 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
961 proc 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
988 proc 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
1010 proc 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
1020 proc 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
1060 set filemask {
1061 #define mask_width 14
1062 #define mask_height 15
1063 static 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
1069 image create bitmap file_plain -background white -foreground black -data {
1070 #define plain_width 14
1071 #define plain_height 15
1072 static 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
1078 image create bitmap file_mod -background white -foreground blue -data {
1079 #define mod_width 14
1080 #define mod_height 15
1081 static 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
1087 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1088 #define file_fulltick_width 14
1089 #define file_fulltick_height 15
1090 static 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
1096 image create bitmap file_parttick -background white -foreground "#005050" -data {
1097 #define parttick_width 14
1098 #define parttick_height 15
1099 static 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
1105 image create bitmap file_question -background white -foreground black -data {
1106 #define file_question_width 14
1107 #define file_question_height 15
1108 static 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
1114 image create bitmap file_removed -background white -foreground red -data {
1115 #define file_removed_width 14
1116 #define file_removed_height 15
1117 static 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
1123 image create bitmap file_merge -background white -foreground blue -data {
1124 #define file_merge_width 14
1125 #define file_merge_height 15
1126 static 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
1132 set ui_index .vpane.files.index.list
1133 set ui_other .vpane.files.other.list
1134 set max_status_desc 0
1135 foreach 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 }
1165 unset filemask i
1166
1167 ######################################################################
1168 ##
1169 ## util
1170
1171 proc error_popup {msg} {
1172 set w .error
1173 toplevel $w
1174 wm transient $w .
1175 show_msg $w $w $msg
1176 }
1177
1178 proc 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
1196 proc 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
1243 set next_console_id 0
1244
1245 proc 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
1252 proc 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
1294 proc 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
1314 proc 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
1374 set starting_gitk_msg {Please wait... Starting gitk...}
1375
1376 proc 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
1393 proc 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
1401 proc 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
1420 proc do_rescan {} {
1421 update_status
1422 }
1423
1424 proc 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
1449 proc 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
1472 proc do_amend_last {} {
1473 load_last_commit
1474 }
1475
1476 proc do_commit {} {
1477 commit_tree
1478 }
1479
1480 # shift == 1: left click
1481 # 3: right click
1482 proc 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
1499 proc 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
1515 set mainfont {Helvetica 10}
1516 set difffont {Courier 10}
1517 set maincursor [. cget -cursor]
1518
1519 switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1520 windows,* {set M1B Control; set M1T Ctrl}
1521 unix,Darwin {set M1B M1; set M1T Cmd}
1522 default {set M1B M1; set M1T M1}
1523 }
1524
1525 # -- Menu Bar
1526 menu .mbar -tearoff 0
1527 .mbar add cascade -label Project -menu .mbar.project
1528 .mbar add cascade -label Edit -menu .mbar.edit
1529 .mbar add cascade -label Commit -menu .mbar.commit
1530 .mbar add cascade -label Fetch -menu .mbar.fetch
1531 .mbar add cascade -label Pull -menu .mbar.pull
1532 .mbar add cascade -label Push -menu .mbar.push
1533 .mbar add cascade -label Options -menu .mbar.options
1534 . configure -menu .mbar
1535
1536 # -- Project Menu
1537 menu .mbar.project
1538 .mbar.project add command -label Visualize \
1539 -command do_gitk \
1540 -font $mainfont
1541 .mbar.project add command -label {Repack Database} \
1542 -command do_repack \
1543 -font $mainfont
1544 .mbar.project add command -label Quit \
1545 -command do_quit \
1546 -accelerator $M1T-Q \
1547 -font $mainfont
1548
1549 # -- Edit Menu
1550 #
1551 menu .mbar.edit
1552 .mbar.edit add command -label Undo \
1553 -command {catch {[focus] edit undo}} \
1554 -accelerator $M1T-Z \
1555 -font $mainfont
1556 .mbar.edit add command -label Redo \
1557 -command {catch {[focus] edit redo}} \
1558 -accelerator $M1T-Y \
1559 -font $mainfont
1560 .mbar.edit add separator
1561 .mbar.edit add command -label Cut \
1562 -command {catch {tk_textCut [focus]}} \
1563 -accelerator $M1T-X \
1564 -font $mainfont
1565 .mbar.edit add command -label Copy \
1566 -command {catch {tk_textCopy [focus]}} \
1567 -accelerator $M1T-C \
1568 -font $mainfont
1569 .mbar.edit add command -label Paste \
1570 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1571 -accelerator $M1T-V \
1572 -font $mainfont
1573 .mbar.edit add command -label Delete \
1574 -command {catch {[focus] delete sel.first sel.last}} \
1575 -accelerator Del \
1576 -font $mainfont
1577 .mbar.edit add separator
1578 .mbar.edit add command -label {Select All} \
1579 -command {catch {[focus] tag add sel 0.0 end}} \
1580 -accelerator $M1T-A \
1581 -font $mainfont
1582
1583 # -- Commit Menu
1584 menu .mbar.commit
1585 .mbar.commit add command -label Rescan \
1586 -command do_rescan \
1587 -accelerator F5 \
1588 -font $mainfont
1589 lappend disable_on_lock \
1590 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1591 .mbar.commit add command -label {Amend Last Commit} \
1592 -command do_amend_last \
1593 -font $mainfont
1594 lappend disable_on_lock \
1595 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1596 .mbar.commit add command -label {Include All Files} \
1597 -command do_include_all \
1598 -accelerator $M1T-I \
1599 -font $mainfont
1600 lappend disable_on_lock \
1601 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1602 .mbar.commit add command -label {Sign Off} \
1603 -command do_signoff \
1604 -accelerator $M1T-S \
1605 -font $mainfont
1606 .mbar.commit add command -label Commit \
1607 -command do_commit \
1608 -accelerator $M1T-Return \
1609 -font $mainfont
1610 lappend disable_on_lock \
1611 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1612
1613 # -- Fetch Menu
1614 menu .mbar.fetch
1615
1616 # -- Pull Menu
1617 menu .mbar.pull
1618
1619 # -- Push Menu
1620 menu .mbar.push
1621
1622 # -- Options Menu
1623 menu .mbar.options
1624 .mbar.options add checkbutton \
1625 -label {Trust File Modification Timestamps} \
1626 -offvalue false \
1627 -onvalue true \
1628 -variable cfg_trust_mtime
1629
1630 # -- Main Window Layout
1631 panedwindow .vpane -orient vertical
1632 panedwindow .vpane.files -orient horizontal
1633 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1634 pack .vpane -anchor n -side top -fill both -expand 1
1635
1636 # -- Index File List
1637 frame .vpane.files.index -height 100 -width 400
1638 label .vpane.files.index.title -text {Modified Files} \
1639 -background green \
1640 -font $mainfont
1641 text $ui_index -background white -borderwidth 0 \
1642 -width 40 -height 10 \
1643 -font $mainfont \
1644 -yscrollcommand {.vpane.files.index.sb set} \
1645 -cursor $maincursor \
1646 -state disabled
1647 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1648 pack .vpane.files.index.title -side top -fill x
1649 pack .vpane.files.index.sb -side right -fill y
1650 pack $ui_index -side left -fill both -expand 1
1651 .vpane.files add .vpane.files.index -sticky nsew
1652
1653 # -- Other (Add) File List
1654 frame .vpane.files.other -height 100 -width 100
1655 label .vpane.files.other.title -text {Untracked Files} \
1656 -background red \
1657 -font $mainfont
1658 text $ui_other -background white -borderwidth 0 \
1659 -width 40 -height 10 \
1660 -font $mainfont \
1661 -yscrollcommand {.vpane.files.other.sb set} \
1662 -cursor $maincursor \
1663 -state disabled
1664 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1665 pack .vpane.files.other.title -side top -fill x
1666 pack .vpane.files.other.sb -side right -fill y
1667 pack $ui_other -side left -fill both -expand 1
1668 .vpane.files add .vpane.files.other -sticky nsew
1669
1670 $ui_index tag conf in_diff -font [concat $mainfont bold]
1671 $ui_other tag conf in_diff -font [concat $mainfont bold]
1672
1673 # -- Diff and Commit Area
1674 frame .vpane.lower -height 400 -width 400
1675 frame .vpane.lower.commarea
1676 frame .vpane.lower.diff -relief sunken -borderwidth 1
1677 pack .vpane.lower.commarea -side top -fill x
1678 pack .vpane.lower.diff -side bottom -fill both -expand 1
1679 .vpane add .vpane.lower -stick nsew
1680
1681 # -- Commit Area Buttons
1682 frame .vpane.lower.commarea.buttons
1683 label .vpane.lower.commarea.buttons.l -text {} \
1684 -anchor w \
1685 -justify left \
1686 -font $mainfont
1687 pack .vpane.lower.commarea.buttons.l -side top -fill x
1688 pack .vpane.lower.commarea.buttons -side left -fill y
1689
1690 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1691 -command do_rescan \
1692 -font $mainfont
1693 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1694 lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
1695
1696 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1697 -command do_amend_last \
1698 -font $mainfont
1699 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1700 lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
1701
1702 button .vpane.lower.commarea.buttons.incall -text {Include All} \
1703 -command do_include_all \
1704 -font $mainfont
1705 pack .vpane.lower.commarea.buttons.incall -side top -fill x
1706 lappend disable_on_lock {.vpane.lower.commarea.buttons.incall conf -state}
1707
1708 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1709 -command do_signoff \
1710 -font $mainfont
1711 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1712
1713 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1714 -command do_commit \
1715 -font $mainfont
1716 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1717 lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
1718
1719 # -- Commit Message Buffer
1720 frame .vpane.lower.commarea.buffer
1721 set ui_comm .vpane.lower.commarea.buffer.t
1722 set ui_coml .vpane.lower.commarea.buffer.l
1723 label $ui_coml -text {Commit Message:} \
1724 -anchor w \
1725 -justify left \
1726 -font $mainfont
1727 trace add variable commit_type write {uplevel #0 {
1728 switch -glob $commit_type \
1729 initial {$ui_coml conf -text {Initial Commit Message:}} \
1730 amend {$ui_coml conf -text {Amended Commit Message:}} \
1731 merge {$ui_coml conf -text {Merge Commit Message:}} \
1732 * {$ui_coml conf -text {Commit Message:}}
1733 }}
1734 text $ui_comm -background white -borderwidth 1 \
1735 -undo true \
1736 -autoseparators true \
1737 -relief sunken \
1738 -width 75 -height 9 -wrap none \
1739 -font $difffont \
1740 -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1741 -cursor $maincursor
1742 scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
1743 pack $ui_coml -side top -fill x
1744 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1745 pack $ui_comm -side left -fill y
1746 pack .vpane.lower.commarea.buffer -side left -fill y
1747
1748 # -- Diff Header
1749 set ui_fname_value {}
1750 set ui_fstatus_value {}
1751 frame .vpane.lower.diff.header -background orange
1752 label .vpane.lower.diff.header.l1 -text {File:} \
1753 -background orange \
1754 -font $mainfont
1755 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1756 -background orange \
1757 -anchor w \
1758 -justify left \
1759 -font $mainfont
1760 label .vpane.lower.diff.header.l3 -text {Status:} \
1761 -background orange \
1762 -font $mainfont
1763 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1764 -background orange \
1765 -width $max_status_desc \
1766 -anchor w \
1767 -justify left \
1768 -font $mainfont
1769 pack .vpane.lower.diff.header.l1 -side left
1770 pack .vpane.lower.diff.header.l2 -side left -fill x
1771 pack .vpane.lower.diff.header.l4 -side right
1772 pack .vpane.lower.diff.header.l3 -side right
1773
1774 # -- Diff Body
1775 frame .vpane.lower.diff.body
1776 set ui_diff .vpane.lower.diff.body.t
1777 text $ui_diff -background white -borderwidth 0 \
1778 -width 80 -height 15 -wrap none \
1779 -font $difffont \
1780 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1781 -yscrollcommand {.vpane.lower.diff.body.sby set} \
1782 -cursor $maincursor \
1783 -state disabled
1784 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1785 -command [list $ui_diff xview]
1786 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1787 -command [list $ui_diff yview]
1788 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1789 pack .vpane.lower.diff.body.sby -side right -fill y
1790 pack $ui_diff -side left -fill both -expand 1
1791 pack .vpane.lower.diff.header -side top -fill x
1792 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1793
1794 $ui_diff tag conf dm -foreground red
1795 $ui_diff tag conf dp -foreground blue
1796 $ui_diff tag conf da -font [concat $difffont bold]
1797 $ui_diff tag conf di -foreground "#00a000"
1798 $ui_diff tag conf dni -foreground "#a000a0"
1799 $ui_diff tag conf bold -font [concat $difffont bold]
1800
1801 # -- Status Bar
1802 set ui_status_value {Initializing...}
1803 label .status -textvariable ui_status_value \
1804 -anchor w \
1805 -justify left \
1806 -borderwidth 1 \
1807 -relief sunken \
1808 -font $mainfont
1809 pack .status -anchor w -side bottom -fill x
1810
1811 # -- Load geometry
1812 catch {
1813 wm geometry . [lindex $repo_config(gui.geometry) 0 0]
1814 eval .vpane sash place 0 [lindex $repo_config(gui.geometry) 0 1]
1815 eval .vpane.files sash place 0 [lindex $repo_config(gui.geometry) 0 2]
1816 }
1817
1818 # -- Key Bindings
1819 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1820 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
1821 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
1822 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
1823 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
1824 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
1825 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
1826 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
1827 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
1828 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1829 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1830
1831 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
1832 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
1833 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
1834 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
1835 bind $ui_diff <$M1B-Key-v> {break}
1836 bind $ui_diff <$M1B-Key-V> {break}
1837 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1838 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1839 bind $ui_diff <Key-Up> {%W yview scroll -1 units}
1840 bind $ui_diff <Key-Down> {%W yview scroll 1 units}
1841 bind $ui_diff <Key-Left> {%W xview scroll -1 units}
1842 bind $ui_diff <Key-Right> {%W xview scroll 1 units}
1843
1844 bind . <Destroy> do_quit
1845 bind all <Key-F5> do_rescan
1846 bind all <$M1B-Key-r> do_rescan
1847 bind all <$M1B-Key-R> do_rescan
1848 bind . <$M1B-Key-s> do_signoff
1849 bind . <$M1B-Key-S> do_signoff
1850 bind . <$M1B-Key-i> do_include_all
1851 bind . <$M1B-Key-I> do_include_all
1852 bind . <$M1B-Key-Return> do_commit
1853 bind all <$M1B-Key-q> do_quit
1854 bind all <$M1B-Key-Q> do_quit
1855 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1856 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1857 foreach i [list $ui_index $ui_other] {
1858 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1859 bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1860 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1861 }
1862 unset i M1B M1T
1863
1864 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1865 focus -force $ui_comm
1866 load_all_remotes
1867 populate_remote_menu .mbar.fetch From fetch_from
1868 populate_remote_menu .mbar.push To push_to
1869 populate_pull_menu .mbar.pull
1870 update_status
Tk based UI for Git