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