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