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