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