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