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