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