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