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