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