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