64c2ae30e7c90b01683567637f5b765e2684b981
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4set appvers {@@GIT_VERSION@@}
6set copyright {
7Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
8This program is free software; you can redistribute it and/or modify
10it under the terms of the GNU General Public License as published by
11the Free Software Foundation; either version 2 of the License, or
12(at your option) any later version.
13This program is distributed in the hope that it will be useful,
15but WITHOUT ANY WARRANTY; without even the implied warranty of
16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17GNU General Public License for more details.
18You should have received a copy of the GNU General Public License
20along with this program; if not, write to the Free Software
21Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
22######################################################################
24##
25## read only globals
26set _appname [lindex [file split $argv0] end]
28set _gitdir {}
29set _reponame {}
30proc appname {} {
32 global _appname
33 return $_appname
34}
35proc gitdir {args} {
37 global _gitdir
38 if {$args eq {}} {
39 return $_gitdir
40 }
41 return [eval [concat [list file join $_gitdir] $args]]
42}
43proc reponame {} {
45 global _reponame
46 return $_reponame
47}
48######################################################################
50##
51## config
52proc is_many_config {name} {
54 switch -glob -- $name {
55 remote.*.fetch -
56 remote.*.push
57 {return 1}
58 *
59 {return 0}
60 }
61}
62proc load_config {include_global} {
64 global repo_config global_config default_config
65 array unset global_config
67 if {$include_global} {
68 catch {
69 set fd_rc [open "| git repo-config --global --list" r]
70 while {[gets $fd_rc line] >= 0} {
71 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
72 if {[is_many_config $name]} {
73 lappend global_config($name) $value
74 } else {
75 set global_config($name) $value
76 }
77 }
78 }
79 close $fd_rc
80 }
81 }
82 array unset repo_config
84 catch {
85 set fd_rc [open "| git repo-config --list" r]
86 while {[gets $fd_rc line] >= 0} {
87 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
88 if {[is_many_config $name]} {
89 lappend repo_config($name) $value
90 } else {
91 set repo_config($name) $value
92 }
93 }
94 }
95 close $fd_rc
96 }
97 foreach name [array names default_config] {
99 if {[catch {set v $global_config($name)}]} {
100 set global_config($name) $default_config($name)
101 }
102 if {[catch {set v $repo_config($name)}]} {
103 set repo_config($name) $default_config($name)
104 }
105 }
106}
107proc save_config {} {
109 global default_config font_descs
110 global repo_config global_config
111 global repo_config_new global_config_new
112 foreach option $font_descs {
114 set name [lindex $option 0]
115 set font [lindex $option 1]
116 font configure $font \
117 -family $global_config_new(gui.$font^^family) \
118 -size $global_config_new(gui.$font^^size)
119 font configure ${font}bold \
120 -family $global_config_new(gui.$font^^family) \
121 -size $global_config_new(gui.$font^^size)
122 set global_config_new(gui.$name) [font configure $font]
123 unset global_config_new(gui.$font^^family)
124 unset global_config_new(gui.$font^^size)
125 }
126 foreach name [array names default_config] {
128 set value $global_config_new($name)
129 if {$value ne $global_config($name)} {
130 if {$value eq $default_config($name)} {
131 catch {exec git repo-config --global --unset $name}
132 } else {
133 regsub -all "\[{}\]" $value {"} value
134 exec git repo-config --global $name $value
135 }
136 set global_config($name) $value
137 if {$value eq $repo_config($name)} {
138 catch {exec git repo-config --unset $name}
139 set repo_config($name) $value
140 }
141 }
142 }
143 foreach name [array names default_config] {
145 set value $repo_config_new($name)
146 if {$value ne $repo_config($name)} {
147 if {$value eq $global_config($name)} {
148 catch {exec git repo-config --unset $name}
149 } else {
150 regsub -all "\[{}\]" $value {"} value
151 exec git repo-config $name $value
152 }
153 set repo_config($name) $value
154 }
155 }
156}
157proc error_popup {msg} {
159 set title [appname]
160 if {[reponame] ne {}} {
161 append title " ([reponame])"
162 }
163 set cmd [list tk_messageBox \
164 -icon error \
165 -type ok \
166 -title "$title: error" \
167 -message $msg]
168 if {[winfo ismapped .]} {
169 lappend cmd -parent .
170 }
171 eval $cmd
172}
173proc warn_popup {msg} {
175 set title [appname]
176 if {[reponame] ne {}} {
177 append title " ([reponame])"
178 }
179 set cmd [list tk_messageBox \
180 -icon warning \
181 -type ok \
182 -title "$title: warning" \
183 -message $msg]
184 if {[winfo ismapped .]} {
185 lappend cmd -parent .
186 }
187 eval $cmd
188}
189proc info_popup {msg} {
191 set title [appname]
192 if {[reponame] ne {}} {
193 append title " ([reponame])"
194 }
195 tk_messageBox \
196 -parent . \
197 -icon info \
198 -type ok \
199 -title $title \
200 -message $msg
201}
202proc ask_popup {msg} {
204 set title [appname]
205 if {[reponame] ne {}} {
206 append title " ([reponame])"
207 }
208 return [tk_messageBox \
209 -parent . \
210 -icon question \
211 -type yesno \
212 -title $title \
213 -message $msg]
214}
215######################################################################
217##
218## repository setup
219if { [catch {set _gitdir $env(GIT_DIR)}]
221 && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
222 catch {wm withdraw .}
223 error_popup "Cannot find the git directory:\n\n$err"
224 exit 1
225}
226if {![file isdirectory $_gitdir]} {
227 catch {wm withdraw .}
228 error_popup "Git directory not found:\n\n$_gitdir"
229 exit 1
230}
231if {[lindex [file split $_gitdir] end] ne {.git}} {
232 catch {wm withdraw .}
233 error_popup "Cannot use funny .git directory:\n\n$gitdir"
234 exit 1
235}
236if {[catch {cd [file dirname $_gitdir]} err]} {
237 catch {wm withdraw .}
238 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
239 exit 1
240}
241set _reponame [lindex [file split \
242 [file normalize [file dirname $_gitdir]]] \
243 end]
244set single_commit 0
246if {[appname] eq {git-citool}} {
247 set single_commit 1
248}
249######################################################################
251##
252## task management
253set rescan_active 0
255set diff_active 0
256set last_clicked {}
257set disable_on_lock [list]
259set index_lock_type none
260proc lock_index {type} {
262 global index_lock_type disable_on_lock
263 if {$index_lock_type eq {none}} {
265 set index_lock_type $type
266 foreach w $disable_on_lock {
267 uplevel #0 $w disabled
268 }
269 return 1
270 } elseif {$index_lock_type eq "begin-$type"} {
271 set index_lock_type $type
272 return 1
273 }
274 return 0
275}
276proc unlock_index {} {
278 global index_lock_type disable_on_lock
279 set index_lock_type none
281 foreach w $disable_on_lock {
282 uplevel #0 $w normal
283 }
284}
285######################################################################
287##
288## status
289proc repository_state {ctvar hdvar mhvar} {
291 global current_branch
292 upvar $ctvar ct $hdvar hd $mhvar mh
293 set mh [list]
295 if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
297 set current_branch {}
298 } else {
299 regsub ^refs/((heads|tags|remotes)/)? \
300 $current_branch \
301 {} \
302 current_branch
303 }
304 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
306 set hd {}
307 set ct initial
308 return
309 }
310 set merge_head [gitdir MERGE_HEAD]
312 if {[file exists $merge_head]} {
313 set ct merge
314 set fd_mh [open $merge_head r]
315 while {[gets $fd_mh line] >= 0} {
316 lappend mh $line
317 }
318 close $fd_mh
319 return
320 }
321 set ct normal
323}
324proc PARENT {} {
326 global PARENT empty_tree
327 set p [lindex $PARENT 0]
329 if {$p ne {}} {
330 return $p
331 }
332 if {$empty_tree eq {}} {
333 set empty_tree [exec git mktree << {}]
334 }
335 return $empty_tree
336}
337proc rescan {after} {
339 global HEAD PARENT MERGE_HEAD commit_type
340 global ui_index ui_workdir ui_status_value ui_comm
341 global rescan_active file_states
342 global repo_config
343 if {$rescan_active > 0 || ![lock_index read]} return
345 repository_state newType newHEAD newMERGE_HEAD
347 if {[string match amend* $commit_type]
348 && $newType eq {normal}
349 && $newHEAD eq $HEAD} {
350 } else {
351 set HEAD $newHEAD
352 set PARENT $newHEAD
353 set MERGE_HEAD $newMERGE_HEAD
354 set commit_type $newType
355 }
356 array unset file_states
358 if {![$ui_comm edit modified]
360 || [string trim [$ui_comm get 0.0 end]] eq {}} {
361 if {[load_message GITGUI_MSG]} {
362 } elseif {[load_message MERGE_MSG]} {
363 } elseif {[load_message SQUASH_MSG]} {
364 }
365 $ui_comm edit reset
366 $ui_comm edit modified false
367 }
368 if {$repo_config(gui.trustmtime) eq {true}} {
370 rescan_stage2 {} $after
371 } else {
372 set rescan_active 1
373 set ui_status_value {Refreshing file status...}
374 set cmd [list git update-index]
375 lappend cmd -q
376 lappend cmd --unmerged
377 lappend cmd --ignore-missing
378 lappend cmd --refresh
379 set fd_rf [open "| $cmd" r]
380 fconfigure $fd_rf -blocking 0 -translation binary
381 fileevent $fd_rf readable \
382 [list rescan_stage2 $fd_rf $after]
383 }
384}
385proc rescan_stage2 {fd after} {
387 global ui_status_value
388 global rescan_active buf_rdi buf_rdf buf_rlo
389 if {$fd ne {}} {
391 read $fd
392 if {![eof $fd]} return
393 close $fd
394 }
395 set ls_others [list | git ls-files --others -z \
397 --exclude-per-directory=.gitignore]
398 set info_exclude [gitdir info exclude]
399 if {[file readable $info_exclude]} {
400 lappend ls_others "--exclude-from=$info_exclude"
401 }
402 set buf_rdi {}
404 set buf_rdf {}
405 set buf_rlo {}
406 set rescan_active 3
408 set ui_status_value {Scanning for modified files ...}
409 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
410 set fd_df [open "| git diff-files -z" r]
411 set fd_lo [open $ls_others r]
412 fconfigure $fd_di -blocking 0 -translation binary
414 fconfigure $fd_df -blocking 0 -translation binary
415 fconfigure $fd_lo -blocking 0 -translation binary
416 fileevent $fd_di readable [list read_diff_index $fd_di $after]
417 fileevent $fd_df readable [list read_diff_files $fd_df $after]
418 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
419}
420proc load_message {file} {
422 global ui_comm
423 set f [gitdir $file]
425 if {[file isfile $f]} {
426 if {[catch {set fd [open $f r]}]} {
427 return 0
428 }
429 set content [string trim [read $fd]]
430 close $fd
431 $ui_comm delete 0.0 end
432 $ui_comm insert end $content
433 return 1
434 }
435 return 0
436}
437proc read_diff_index {fd after} {
439 global buf_rdi
440 append buf_rdi [read $fd]
442 set c 0
443 set n [string length $buf_rdi]
444 while {$c < $n} {
445 set z1 [string first "\0" $buf_rdi $c]
446 if {$z1 == -1} break
447 incr z1
448 set z2 [string first "\0" $buf_rdi $z1]
449 if {$z2 == -1} break
450 incr c
452 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
453 merge_state \
454 [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
455 [lindex $i 4]? \
456 [list [lindex $i 0] [lindex $i 2]] \
457 [list]
458 set c $z2
459 incr c
460 }
461 if {$c < $n} {
462 set buf_rdi [string range $buf_rdi $c end]
463 } else {
464 set buf_rdi {}
465 }
466 rescan_done $fd buf_rdi $after
468}
469proc read_diff_files {fd after} {
471 global buf_rdf
472 append buf_rdf [read $fd]
474 set c 0
475 set n [string length $buf_rdf]
476 while {$c < $n} {
477 set z1 [string first "\0" $buf_rdf $c]
478 if {$z1 == -1} break
479 incr z1
480 set z2 [string first "\0" $buf_rdf $z1]
481 if {$z2 == -1} break
482 incr c
484 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
485 merge_state \
486 [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
487 ?[lindex $i 4] \
488 [list] \
489 [list [lindex $i 0] [lindex $i 2]]
490 set c $z2
491 incr c
492 }
493 if {$c < $n} {
494 set buf_rdf [string range $buf_rdf $c end]
495 } else {
496 set buf_rdf {}
497 }
498 rescan_done $fd buf_rdf $after
500}
501proc read_ls_others {fd after} {
503 global buf_rlo
504 append buf_rlo [read $fd]
506 set pck [split $buf_rlo "\0"]
507 set buf_rlo [lindex $pck end]
508 foreach p [lrange $pck 0 end-1] {
509 merge_state $p ?O
510 }
511 rescan_done $fd buf_rlo $after
512}
513proc rescan_done {fd buf after} {
515 global rescan_active
516 global file_states repo_config
517 upvar $buf to_clear
518 if {![eof $fd]} return
520 set to_clear {}
521 close $fd
522 if {[incr rescan_active -1] > 0} return
523 prune_selection
525 unlock_index
526 display_all_files
527 reshow_diff
528 uplevel #0 $after
529}
530proc prune_selection {} {
532 global file_states selected_paths
533 foreach path [array names selected_paths] {
535 if {[catch {set still_here $file_states($path)}]} {
536 unset selected_paths($path)
537 }
538 }
539}
540######################################################################
542##
543## diff
544proc clear_diff {} {
546 global ui_diff current_diff_path ui_index ui_workdir
547 $ui_diff conf -state normal
549 $ui_diff delete 0.0 end
550 $ui_diff conf -state disabled
551 set current_diff_path {}
553 $ui_index tag remove in_diff 0.0 end
555 $ui_workdir tag remove in_diff 0.0 end
556}
557proc reshow_diff {} {
559 global ui_status_value file_states
560 global current_diff_path current_diff_side
561 if {$current_diff_path eq {}
563 || [catch {set s $file_states($current_diff_path)}]} {
564 clear_diff
565 } else {
566 show_diff $current_diff_path $current_diff_side
567 }
568}
569proc handle_empty_diff {} {
571 global current_diff_path file_states file_lists
572 set path $current_diff_path
574 set s $file_states($path)
575 if {[lindex $s 0] ne {_M}} return
576 info_popup "No differences detected.
578[short_path $path] has no changes.
580The modification date of this file was updated
582by another application and you currently have
583the Trust File Modification Timestamps option
584enabled, so Git did not automatically detect
585that there are no content differences in this
586file.
587This file will now be removed from the modified
589files list, to prevent possible confusion.
590"
591 if {[catch {exec git update-index -- $path} err]} {
592 error_popup "Failed to refresh index:\n\n$err"
593 }
594 clear_diff
596 display_file $path __
597}
598proc show_diff {path w {lno {}}} {
600 global file_states file_lists
601 global is_3way_diff diff_active repo_config
602 global ui_diff ui_status_value ui_index ui_workdir
603 global current_diff_path current_diff_side
604 if {$diff_active || ![lock_index read]} return
606 clear_diff
608 if {$w eq {} || $lno == {}} {
609 foreach w [array names file_lists] {
610 set lno [lsearch -sorted $file_lists($w) $path]
611 if {$lno >= 0} {
612 incr lno
613 break
614 }
615 }
616 }
617 if {$w ne {} && $lno >= 1} {
618 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
619 }
620 set s $file_states($path)
622 set m [lindex $s 0]
623 set is_3way_diff 0
624 set diff_active 1
625 set current_diff_path $path
626 set current_diff_side $w
627 set ui_status_value "Loading diff of [escape_path $path]..."
628 # - Git won't give us the diff, there's nothing to compare to!
630 #
631 if {$m eq {_O}} {
632 if {[catch {
633 set fd [open $path r]
634 set content [read $fd]
635 close $fd
636 } err ]} {
637 set diff_active 0
638 unlock_index
639 set ui_status_value "Unable to display [escape_path $path]"
640 error_popup "Error loading file:\n\n$err"
641 return
642 }
643 $ui_diff conf -state normal
644 $ui_diff insert end $content
645 $ui_diff conf -state disabled
646 set diff_active 0
647 unlock_index
648 set ui_status_value {Ready.}
649 return
650 }
651 set cmd [list | git]
653 if {$w eq $ui_index} {
654 lappend cmd diff-index
655 lappend cmd --cached
656 } elseif {$w eq $ui_workdir} {
657 lappend cmd diff-files
658 }
659 lappend cmd -p
661 lappend cmd --no-color
662 if {$repo_config(gui.diffcontext) > 0} {
663 lappend cmd "-U$repo_config(gui.diffcontext)"
664 }
665 if {$w eq $ui_index} {
666 lappend cmd [PARENT]
667 }
668 lappend cmd --
669 lappend cmd $path
670 if {[catch {set fd [open $cmd r]} err]} {
672 set diff_active 0
673 unlock_index
674 set ui_status_value "Unable to display [escape_path $path]"
675 error_popup "Error loading diff:\n\n$err"
676 return
677 }
678 fconfigure $fd -blocking 0 -translation auto
680 fileevent $fd readable [list read_diff $fd]
681}
682proc read_diff {fd} {
684 global ui_diff ui_status_value is_3way_diff diff_active
685 global repo_config
686 $ui_diff conf -state normal
688 while {[gets $fd line] >= 0} {
689 # -- Cleanup uninteresting diff header lines.
690 #
691 if {[string match {diff --git *} $line]} continue
692 if {[string match {diff --combined *} $line]} continue
693 if {[string match {--- *} $line]} continue
694 if {[string match {+++ *} $line]} continue
695 if {$line eq {deleted file mode 120000}} {
696 set line "deleted symlink"
697 }
698 # -- Automatically detect if this is a 3 way diff.
700 #
701 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
702 # -- Reformat a 3 way diff, 'cause its too weird.
704 #
705 if {$is_3way_diff} {
706 set op [string range $line 0 1]
707 switch -- $op {
708 {@@} {set tags d_@}
709 {++} {set tags d_+ ; set op { +}}
710 {--} {set tags d_- ; set op { -}}
711 { +} {set tags d_++; set op {++}}
712 { -} {set tags d_--; set op {--}}
713 {+ } {set tags d_-+; set op {-+}}
714 {- } {set tags d_+-; set op {+-}}
715 default {set tags {}}
716 }
717 set line [string replace $line 0 1 $op]
718 } else {
719 switch -- [string index $line 0] {
720 @ {set tags d_@}
721 + {set tags d_+}
722 - {set tags d_-}
723 default {set tags {}}
724 }
725 }
726 $ui_diff insert end $line $tags
727 $ui_diff insert end "\n" $tags
728 }
729 $ui_diff conf -state disabled
730 if {[eof $fd]} {
732 close $fd
733 set diff_active 0
734 unlock_index
735 set ui_status_value {Ready.}
736 if {$repo_config(gui.trustmtime) eq {true}
738 && [$ui_diff index end] eq {2.0}} {
739 handle_empty_diff
740 }
741 }
742}
743######################################################################
745##
746## commit
747proc load_last_commit {} {
749 global HEAD PARENT MERGE_HEAD commit_type ui_comm
750 if {[llength $PARENT] == 0} {
752 error_popup {There is nothing to amend.
753You are about to create the initial commit.
755There is no commit before this to amend.
756}
757 return
758 }
759 repository_state curType curHEAD curMERGE_HEAD
761 if {$curType eq {merge}} {
762 error_popup {Cannot amend while merging.
763You are currently in the middle of a merge that
765has not been fully completed. You cannot amend
766the prior commit unless you first abort the
767current merge activity.
768}
769 return
770 }
771 set msg {}
773 set parents [list]
774 if {[catch {
775 set fd [open "| git cat-file commit $curHEAD" r]
776 while {[gets $fd line] > 0} {
777 if {[string match {parent *} $line]} {
778 lappend parents [string range $line 7 end]
779 }
780 }
781 set msg [string trim [read $fd]]
782 close $fd
783 } err]} {
784 error_popup "Error loading commit data for amend:\n\n$err"
785 return
786 }
787 set HEAD $curHEAD
789 set PARENT $parents
790 set MERGE_HEAD [list]
791 switch -- [llength $parents] {
792 0 {set commit_type amend-initial}
793 1 {set commit_type amend}
794 default {set commit_type amend-merge}
795 }
796 $ui_comm delete 0.0 end
798 $ui_comm insert end $msg
799 $ui_comm edit reset
800 $ui_comm edit modified false
801 rescan {set ui_status_value {Ready.}}
802}
803proc create_new_commit {} {
805 global commit_type ui_comm
806 set commit_type normal
808 $ui_comm delete 0.0 end
809 $ui_comm edit reset
810 $ui_comm edit modified false
811 rescan {set ui_status_value {Ready.}}
812}
813set GIT_COMMITTER_IDENT {}
815proc committer_ident {} {
817 global GIT_COMMITTER_IDENT
818 if {$GIT_COMMITTER_IDENT eq {}} {
820 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
821 error_popup "Unable to obtain your identity:\n\n$err"
822 return {}
823 }
824 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
825 $me me GIT_COMMITTER_IDENT]} {
826 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
827 return {}
828 }
829 }
830 return $GIT_COMMITTER_IDENT
832}
833proc commit_tree {} {
835 global HEAD commit_type file_states ui_comm repo_config
836 global ui_status_value pch_error
837 if {![lock_index update]} return
839 if {[committer_ident] eq {}} return
840 # -- Our in memory state should match the repository.
842 #
843 repository_state curType curHEAD curMERGE_HEAD
844 if {[string match amend* $commit_type]
845 && $curType eq {normal}
846 && $curHEAD eq $HEAD} {
847 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
848 info_popup {Last scanned state does not match repository state.
849Another Git program has modified this repository
851since the last scan. A rescan must be performed
852before another commit can be created.
853The rescan will be automatically started now.
855}
856 unlock_index
857 rescan {set ui_status_value {Ready.}}
858 return
859 }
860 # -- At least one file should differ in the index.
862 #
863 set files_ready 0
864 foreach path [array names file_states] {
865 switch -glob -- [lindex $file_states($path) 0] {
866 _? {continue}
867 A? -
868 D? -
869 M? {set files_ready 1; break}
870 U? {
871 error_popup "Unmerged files cannot be committed.
872File [short_path $path] has merge conflicts.
874You must resolve them and include the file before committing.
875"
876 unlock_index
877 return
878 }
879 default {
880 error_popup "Unknown file state [lindex $s 0] detected.
881File [short_path $path] cannot be committed by this program.
883"
884 }
885 }
886 }
887 if {!$files_ready} {
888 error_popup {No included files to commit.
889You must include at least 1 file before you can commit.
891}
892 unlock_index
893 return
894 }
895 # -- A message is required.
897 #
898 set msg [string trim [$ui_comm get 1.0 end]]
899 if {$msg eq {}} {
900 error_popup {Please supply a commit message.
901A good commit message has the following format:
903- First line: Describe in one sentance what you did.
905- Second line: Blank
906- Remaining lines: Describe why this change is good.
907}
908 unlock_index
909 return
910 }
911 # -- Run the pre-commit hook.
913 #
914 set pchook [gitdir hooks pre-commit]
915 # On Cygwin [file executable] might lie so we need to ask
917 # the shell if the hook is executable. Yes that's annoying.
918 #
919 if {[is_Windows] && [file isfile $pchook]} {
920 set pchook [list sh -c [concat \
921 "if test -x \"$pchook\";" \
922 "then exec \"$pchook\" 2>&1;" \
923 "fi"]]
924 } elseif {[file executable $pchook]} {
925 set pchook [list $pchook |& cat]
926 } else {
927 commit_writetree $curHEAD $msg
928 return
929 }
930 set ui_status_value {Calling pre-commit hook...}
932 set pch_error {}
933 set fd_ph [open "| $pchook" r]
934 fconfigure $fd_ph -blocking 0 -translation binary
935 fileevent $fd_ph readable \
936 [list commit_prehook_wait $fd_ph $curHEAD $msg]
937}
938proc commit_prehook_wait {fd_ph curHEAD msg} {
940 global pch_error ui_status_value
941 append pch_error [read $fd_ph]
943 fconfigure $fd_ph -blocking 1
944 if {[eof $fd_ph]} {
945 if {[catch {close $fd_ph}]} {
946 set ui_status_value {Commit declined by pre-commit hook.}
947 hook_failed_popup pre-commit $pch_error
948 unlock_index
949 } else {
950 commit_writetree $curHEAD $msg
951 }
952 set pch_error {}
953 return
954 }
955 fconfigure $fd_ph -blocking 0
956}
957proc commit_writetree {curHEAD msg} {
959 global ui_status_value
960 set ui_status_value {Committing changes...}
962 set fd_wt [open "| git write-tree" r]
963 fileevent $fd_wt readable \
964 [list commit_committree $fd_wt $curHEAD $msg]
965}
966proc commit_committree {fd_wt curHEAD msg} {
968 global HEAD PARENT MERGE_HEAD commit_type
969 global single_commit
970 global ui_status_value ui_comm selected_commit_type
971 global file_states selected_paths rescan_active
972 gets $fd_wt tree_id
974 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
975 error_popup "write-tree failed:\n\n$err"
976 set ui_status_value {Commit failed.}
977 unlock_index
978 return
979 }
980 # -- Create the commit.
982 #
983 set cmd [list git commit-tree $tree_id]
984 set parents [concat $PARENT $MERGE_HEAD]
985 if {[llength $parents] > 0} {
986 foreach p $parents {
987 lappend cmd -p $p
988 }
989 } else {
990 # git commit-tree writes to stderr during initial commit.
991 lappend cmd 2>/dev/null
992 }
993 lappend cmd << $msg
994 if {[catch {set cmt_id [eval exec $cmd]} err]} {
995 error_popup "commit-tree failed:\n\n$err"
996 set ui_status_value {Commit failed.}
997 unlock_index
998 return
999 }
1000 # -- Update the HEAD ref.
1002 #
1003 set reflogm commit
1004 if {$commit_type ne {normal}} {
1005 append reflogm " ($commit_type)"
1006 }
1007 set i [string first "\n" $msg]
1008 if {$i >= 0} {
1009 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1010 } else {
1011 append reflogm {: } $msg
1012 }
1013 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1014 if {[catch {eval exec $cmd} err]} {
1015 error_popup "update-ref failed:\n\n$err"
1016 set ui_status_value {Commit failed.}
1017 unlock_index
1018 return
1019 }
1020 # -- Cleanup after ourselves.
1022 #
1023 catch {file delete [gitdir MERGE_HEAD]}
1024 catch {file delete [gitdir MERGE_MSG]}
1025 catch {file delete [gitdir SQUASH_MSG]}
1026 catch {file delete [gitdir GITGUI_MSG]}
1027 # -- Let rerere do its thing.
1029 #
1030 if {[file isdirectory [gitdir rr-cache]]} {
1031 catch {exec git rerere}
1032 }
1033 # -- Run the post-commit hook.
1035 #
1036 set pchook [gitdir hooks post-commit]
1037 if {[is_Windows] && [file isfile $pchook]} {
1038 set pchook [list sh -c [concat \
1039 "if test -x \"$pchook\";" \
1040 "then exec \"$pchook\";" \
1041 "fi"]]
1042 } elseif {![file executable $pchook]} {
1043 set pchook {}
1044 }
1045 if {$pchook ne {}} {
1046 catch {exec $pchook &}
1047 }
1048 $ui_comm delete 0.0 end
1050 $ui_comm edit reset
1051 $ui_comm edit modified false
1052 if {$single_commit} do_quit
1054 # -- Update in memory status
1056 #
1057 set selected_commit_type new
1058 set commit_type normal
1059 set HEAD $cmt_id
1060 set PARENT $cmt_id
1061 set MERGE_HEAD [list]
1062 foreach path [array names file_states] {
1064 set s $file_states($path)
1065 set m [lindex $s 0]
1066 switch -glob -- $m {
1067 _O -
1068 _M -
1069 _D {continue}
1070 __ -
1071 A_ -
1072 M_ -
1073 D_ {
1074 unset file_states($path)
1075 catch {unset selected_paths($path)}
1076 }
1077 DO {
1078 set file_states($path) [list _O [lindex $s 1] {} {}]
1079 }
1080 AM -
1081 AD -
1082 MM -
1083 MD {
1084 set file_states($path) [list \
1085 _[string index $m 1] \
1086 [lindex $s 1] \
1087 [lindex $s 3] \
1088 {}]
1089 }
1090 }
1091 }
1092 display_all_files
1094 unlock_index
1095 reshow_diff
1096 set ui_status_value \
1097 "Changes committed as [string range $cmt_id 0 7]."
1098}
1099######################################################################
1101##
1102## fetch pull push
1103proc fetch_from {remote} {
1105 set w [new_console "fetch $remote" \
1106 "Fetching new changes from $remote"]
1107 set cmd [list git fetch]
1108 lappend cmd $remote
1109 console_exec $w $cmd
1110}
1111proc pull_remote {remote branch} {
1113 global HEAD commit_type file_states repo_config
1114 if {![lock_index update]} return
1116 # -- Our in memory state should match the repository.
1118 #
1119 repository_state curType curHEAD curMERGE_HEAD
1120 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1121 info_popup {Last scanned state does not match repository state.
1122Another Git program has modified this repository
1124since the last scan. A rescan must be performed
1125before a pull operation can be started.
1126The rescan will be automatically started now.
1128}
1129 unlock_index
1130 rescan {set ui_status_value {Ready.}}
1131 return
1132 }
1133 # -- No differences should exist before a pull.
1135 #
1136 if {[array size file_states] != 0} {
1137 error_popup {Uncommitted but modified files are present.
1138You should not perform a pull with unmodified
1140files in your working directory as Git will be
1141unable to recover from an incorrect merge.
1142You should commit or revert all changes before
1144starting a pull operation.
1145}
1146 unlock_index
1147 return
1148 }
1149 set w [new_console "pull $remote $branch" \
1151 "Pulling new changes from branch $branch in $remote"]
1152 set cmd [list git pull]
1153 if {$repo_config(gui.pullsummary) eq {false}} {
1154 lappend cmd --no-summary
1155 }
1156 lappend cmd $remote
1157 lappend cmd $branch
1158 console_exec $w $cmd [list post_pull_remote $remote $branch]
1159}
1160proc post_pull_remote {remote branch success} {
1162 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1163 global ui_status_value
1164 unlock_index
1166 if {$success} {
1167 repository_state commit_type HEAD MERGE_HEAD
1168 set PARENT $HEAD
1169 set selected_commit_type new
1170 set ui_status_value "Pulling $branch from $remote complete."
1171 } else {
1172 rescan [list set ui_status_value \
1173 "Conflicts detected while pulling $branch from $remote."]
1174 }
1175}
1176proc push_to {remote} {
1178 set w [new_console "push $remote" \
1179 "Pushing changes to $remote"]
1180 set cmd [list git push]
1181 lappend cmd $remote
1182 console_exec $w $cmd
1183}
1184######################################################################
1186##
1187## ui helpers
1188proc mapicon {w state path} {
1190 global all_icons
1191 if {[catch {set r $all_icons($state$w)}]} {
1193 puts "error: no icon for $w state={$state} $path"
1194 return file_plain
1195 }
1196 return $r
1197}
1198proc mapdesc {state path} {
1200 global all_descs
1201 if {[catch {set r $all_descs($state)}]} {
1203 puts "error: no desc for state={$state} $path"
1204 return $state
1205 }
1206 return $r
1207}
1208proc escape_path {path} {
1210 regsub -all "\n" $path "\\n" path
1211 return $path
1212}
1213proc short_path {path} {
1215 return [escape_path [lindex [file split $path] end]]
1216}
1217set next_icon_id 0
1219set null_sha1 [string repeat 0 40]
1220proc merge_state {path new_state {head_info {}} {index_info {}}} {
1222 global file_states next_icon_id null_sha1
1223 set s0 [string index $new_state 0]
1225 set s1 [string index $new_state 1]
1226 if {[catch {set info $file_states($path)}]} {
1228 set state __
1229 set icon n[incr next_icon_id]
1230 } else {
1231 set state [lindex $info 0]
1232 set icon [lindex $info 1]
1233 if {$head_info eq {}} {set head_info [lindex $info 2]}
1234 if {$index_info eq {}} {set index_info [lindex $info 3]}
1235 }
1236 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1238 elseif {$s0 eq {_}} {set s0 _}
1239 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1241 elseif {$s1 eq {_}} {set s1 _}
1242 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1244 set head_info [list 0 $null_sha1]
1245 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1246 && $head_info eq {}} {
1247 set head_info $index_info
1248 }
1249 set file_states($path) [list $s0$s1 $icon \
1251 $head_info $index_info \
1252 ]
1253 return $state
1254}
1255proc display_file_helper {w path icon_name old_m new_m} {
1257 global file_lists
1258 if {$new_m eq {_}} {
1260 set lno [lsearch -sorted $file_lists($w) $path]
1261 if {$lno >= 0} {
1262 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1263 incr lno
1264 $w conf -state normal
1265 $w delete $lno.0 [expr {$lno + 1}].0
1266 $w conf -state disabled
1267 }
1268 } elseif {$old_m eq {_} && $new_m ne {_}} {
1269 lappend file_lists($w) $path
1270 set file_lists($w) [lsort -unique $file_lists($w)]
1271 set lno [lsearch -sorted $file_lists($w) $path]
1272 incr lno
1273 $w conf -state normal
1274 $w image create $lno.0 \
1275 -align center -padx 5 -pady 1 \
1276 -name $icon_name \
1277 -image [mapicon $w $new_m $path]
1278 $w insert $lno.1 "[escape_path $path]\n"
1279 $w conf -state disabled
1280 } elseif {$old_m ne $new_m} {
1281 $w conf -state normal
1282 $w image conf $icon_name -image [mapicon $w $new_m $path]
1283 $w conf -state disabled
1284 }
1285}
1286proc display_file {path state} {
1288 global file_states selected_paths
1289 global ui_index ui_workdir
1290 set old_m [merge_state $path $state]
1292 set s $file_states($path)
1293 set new_m [lindex $s 0]
1294 set icon_name [lindex $s 1]
1295 display_file_helper $ui_index $path $icon_name \
1297 [string index $old_m 0] \
1298 [string index $new_m 0]
1299 display_file_helper $ui_workdir $path $icon_name \
1300 [string index $old_m 1] \
1301 [string index $new_m 1]
1302 if {$new_m eq {__}} {
1304 unset file_states($path)
1305 catch {unset selected_paths($path)}
1306 }
1307}
1308proc display_all_files_helper {w path icon_name m} {
1310 global file_lists
1311 lappend file_lists($w) $path
1313 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1314 $w image create end \
1315 -align center -padx 5 -pady 1 \
1316 -name $icon_name \
1317 -image [mapicon $w $m $path]
1318 $w insert end "[escape_path $path]\n"
1319}
1320proc display_all_files {} {
1322 global ui_index ui_workdir
1323 global file_states file_lists
1324 global last_clicked
1325 $ui_index conf -state normal
1327 $ui_workdir conf -state normal
1328 $ui_index delete 0.0 end
1330 $ui_workdir delete 0.0 end
1331 set last_clicked {}
1332 set file_lists($ui_index) [list]
1334 set file_lists($ui_workdir) [list]
1335 foreach path [lsort [array names file_states]] {
1337 set s $file_states($path)
1338 set m [lindex $s 0]
1339 set icon_name [lindex $s 1]
1340 if {[string index $m 0] ne {_}} {
1342 display_all_files_helper $ui_index $path \
1343 $icon_name [string index $m 0]
1344 }
1345 if {[string index $m 1] ne {_}} {
1346 display_all_files_helper $ui_workdir $path \
1347 $icon_name [string index $m 1]
1348 }
1349 }
1350 $ui_index conf -state disabled
1352 $ui_workdir conf -state disabled
1353}
1354proc update_indexinfo {msg pathList after} {
1356 global update_index_cp ui_status_value
1357 if {![lock_index update]} return
1359 set update_index_cp 0
1361 set pathList [lsort $pathList]
1362 set totalCnt [llength $pathList]
1363 set batch [expr {int($totalCnt * .01) + 1}]
1364 if {$batch > 25} {set batch 25}
1365 set ui_status_value [format \
1367 "$msg... %i/%i files (%.2f%%)" \
1368 $update_index_cp \
1369 $totalCnt \
1370 0.0]
1371 set fd [open "| git update-index -z --index-info" w]
1372 fconfigure $fd \
1373 -blocking 0 \
1374 -buffering full \
1375 -buffersize 512 \
1376 -translation binary
1377 fileevent $fd writable [list \
1378 write_update_indexinfo \
1379 $fd \
1380 $pathList \
1381 $totalCnt \
1382 $batch \
1383 $msg \
1384 $after \
1385 ]
1386}
1387proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1389 global update_index_cp ui_status_value
1390 global file_states current_diff_path
1391 if {$update_index_cp >= $totalCnt} {
1393 close $fd
1394 unlock_index
1395 uplevel #0 $after
1396 return
1397 }
1398 for {set i $batch} \
1400 {$update_index_cp < $totalCnt && $i > 0} \
1401 {incr i -1} {
1402 set path [lindex $pathList $update_index_cp]
1403 incr update_index_cp
1404 set s $file_states($path)
1406 switch -glob -- [lindex $s 0] {
1407 A? {set new _O}
1408 M? {set new _M}
1409 D_ {set new _D}
1410 D? {set new _?}
1411 ?? {continue}
1412 }
1413 set info [lindex $s 2]
1414 if {$info eq {}} continue
1415 puts -nonewline $fd "$info\t$path\0"
1417 display_file $path $new
1418 }
1419 set ui_status_value [format \
1421 "$msg... %i/%i files (%.2f%%)" \
1422 $update_index_cp \
1423 $totalCnt \
1424 [expr {100.0 * $update_index_cp / $totalCnt}]]
1425}
1426proc update_index {msg pathList after} {
1428 global update_index_cp ui_status_value
1429 if {![lock_index update]} return
1431 set update_index_cp 0
1433 set pathList [lsort $pathList]
1434 set totalCnt [llength $pathList]
1435 set batch [expr {int($totalCnt * .01) + 1}]
1436 if {$batch > 25} {set batch 25}
1437 set ui_status_value [format \
1439 "$msg... %i/%i files (%.2f%%)" \
1440 $update_index_cp \
1441 $totalCnt \
1442 0.0]
1443 set fd [open "| git update-index --add --remove -z --stdin" w]
1444 fconfigure $fd \
1445 -blocking 0 \
1446 -buffering full \
1447 -buffersize 512 \
1448 -translation binary
1449 fileevent $fd writable [list \
1450 write_update_index \
1451 $fd \
1452 $pathList \
1453 $totalCnt \
1454 $batch \
1455 $msg \
1456 $after \
1457 ]
1458}
1459proc write_update_index {fd pathList totalCnt batch msg after} {
1461 global update_index_cp ui_status_value
1462 global file_states current_diff_path
1463 if {$update_index_cp >= $totalCnt} {
1465 close $fd
1466 unlock_index
1467 uplevel #0 $after
1468 return
1469 }
1470 for {set i $batch} \
1472 {$update_index_cp < $totalCnt && $i > 0} \
1473 {incr i -1} {
1474 set path [lindex $pathList $update_index_cp]
1475 incr update_index_cp
1476 switch -glob -- [lindex $file_states($path) 0] {
1478 AD {set new __}
1479 ?D {set new D_}
1480 _O -
1481 AM {set new A_}
1482 U_ -
1483 ?M {set new M_}
1484 ?? {continue}
1485 }
1486 puts -nonewline $fd "$path\0"
1487 display_file $path $new
1488 }
1489 set ui_status_value [format \
1491 "$msg... %i/%i files (%.2f%%)" \
1492 $update_index_cp \
1493 $totalCnt \
1494 [expr {100.0 * $update_index_cp / $totalCnt}]]
1495}
1496proc checkout_index {msg pathList after} {
1498 global update_index_cp ui_status_value
1499 if {![lock_index update]} return
1501 set update_index_cp 0
1503 set pathList [lsort $pathList]
1504 set totalCnt [llength $pathList]
1505 set batch [expr {int($totalCnt * .01) + 1}]
1506 if {$batch > 25} {set batch 25}
1507 set ui_status_value [format \
1509 "$msg... %i/%i files (%.2f%%)" \
1510 $update_index_cp \
1511 $totalCnt \
1512 0.0]
1513 set cmd [list git checkout-index]
1514 lappend cmd --index
1515 lappend cmd --quiet
1516 lappend cmd --force
1517 lappend cmd -z
1518 lappend cmd --stdin
1519 set fd [open "| $cmd " w]
1520 fconfigure $fd \
1521 -blocking 0 \
1522 -buffering full \
1523 -buffersize 512 \
1524 -translation binary
1525 fileevent $fd writable [list \
1526 write_checkout_index \
1527 $fd \
1528 $pathList \
1529 $totalCnt \
1530 $batch \
1531 $msg \
1532 $after \
1533 ]
1534}
1535proc write_checkout_index {fd pathList totalCnt batch msg after} {
1537 global update_index_cp ui_status_value
1538 global file_states current_diff_path
1539 if {$update_index_cp >= $totalCnt} {
1541 close $fd
1542 unlock_index
1543 uplevel #0 $after
1544 return
1545 }
1546 for {set i $batch} \
1548 {$update_index_cp < $totalCnt && $i > 0} \
1549 {incr i -1} {
1550 set path [lindex $pathList $update_index_cp]
1551 incr update_index_cp
1552 switch -glob -- [lindex $file_states($path) 0] {
1553 U? {continue}
1554 ?M -
1555 ?D {
1556 puts -nonewline $fd "$path\0"
1557 display_file $path ?_
1558 }
1559 }
1560 }
1561 set ui_status_value [format \
1563 "$msg... %i/%i files (%.2f%%)" \
1564 $update_index_cp \
1565 $totalCnt \
1566 [expr {100.0 * $update_index_cp / $totalCnt}]]
1567}
1568######################################################################
1570##
1571## branch management
1572proc load_all_heads {} {
1574 global all_heads tracking_branches
1575 set all_heads [list]
1577 set cmd [list git for-each-ref]
1578 lappend cmd --format=%(refname)
1579 lappend cmd refs/heads
1580 set fd [open "| $cmd" r]
1581 while {[gets $fd line] > 0} {
1582 if {![catch {set info $tracking_branches($line)}]} continue
1583 if {![regsub ^refs/heads/ $line {} name]} continue
1584 lappend all_heads $name
1585 }
1586 close $fd
1587 set all_heads [lsort $all_heads]
1589}
1590proc populate_branch_menu {} {
1592 global all_heads disable_on_lock
1593 set m .mbar.branch
1595 set last [$m index last]
1596 for {set i 0} {$i <= $last} {incr i} {
1597 if {[$m type $i] eq {separator}} {
1598 $m delete $i last
1599 set new_dol [list]
1600 foreach a $disable_on_lock {
1601 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1602 lappend new_dol $a
1603 }
1604 }
1605 set disable_on_lock $new_dol
1606 break
1607 }
1608 }
1609 $m add separator
1611 foreach b $all_heads {
1612 $m add radiobutton \
1613 -label $b \
1614 -command [list switch_branch $b] \
1615 -variable current_branch \
1616 -value $b \
1617 -font font_ui
1618 lappend disable_on_lock \
1619 [list $m entryconf [$m index last] -state]
1620 }
1621}
1622proc do_create_branch_action {w} {
1624 global all_heads null_sha1
1625 global create_branch_checkout create_branch_revtype
1626 global create_branch_head create_branch_trackinghead
1627 set newbranch [string trim [$w.name.t get 0.0 end]]
1629 if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1630 tk_messageBox \
1631 -icon error \
1632 -type ok \
1633 -title [wm title $w] \
1634 -parent $w \
1635 -message "Branch '$newbranch' already exists."
1636 focus $w.name.t
1637 return
1638 }
1639 if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1640 tk_messageBox \
1641 -icon error \
1642 -type ok \
1643 -title [wm title $w] \
1644 -parent $w \
1645 -message "We do not like '$newbranch' as a branch name."
1646 focus $w.name.t
1647 return
1648 }
1649 set rev {}
1651 switch -- $create_branch_revtype {
1652 head {set rev $create_branch_head}
1653 tracking {set rev $create_branch_trackinghead}
1654 expression {set rev [string trim [$w.from.exp.t get 0.0 end]]}
1655 }
1656 if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1657 tk_messageBox \
1658 -icon error \
1659 -type ok \
1660 -title [wm title $w] \
1661 -parent $w \
1662 -message "Invalid starting revision: $rev"
1663 return
1664 }
1665 set cmd [list git update-ref]
1666 lappend cmd -m
1667 lappend cmd "branch: Created from $rev"
1668 lappend cmd "refs/heads/$newbranch"
1669 lappend cmd $cmt
1670 lappend cmd $null_sha1
1671 if {[catch {eval exec $cmd} err]} {
1672 tk_messageBox \
1673 -icon error \
1674 -type ok \
1675 -title [wm title $w] \
1676 -parent $w \
1677 -message "Failed to create '$newbranch'.\n\n$err"
1678 return
1679 }
1680 lappend all_heads $newbranch
1682 set all_heads [lsort $all_heads]
1683 populate_branch_menu
1684 destroy $w
1685 if {$create_branch_checkout} {
1686 switch_branch $newbranch
1687 }
1688}
1689proc do_create_branch {} {
1691 global all_heads current_branch tracking_branches
1692 global create_branch_checkout create_branch_revtype
1693 global create_branch_head create_branch_trackinghead
1694 set create_branch_checkout 1
1696 set create_branch_revtype head
1697 set create_branch_head $current_branch
1698 set create_branch_trackinghead {}
1699 set w .branch_editor
1701 toplevel $w
1702 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1703 label $w.header -text {Create New Branch} \
1705 -font font_uibold
1706 pack $w.header -side top -fill x
1707 frame $w.buttons
1709 button $w.buttons.create -text Create \
1710 -font font_ui \
1711 -default active \
1712 -command [list do_create_branch_action $w]
1713 pack $w.buttons.create -side right
1714 button $w.buttons.cancel -text {Cancel} \
1715 -font font_ui \
1716 -command [list destroy $w]
1717 pack $w.buttons.cancel -side right -padx 5
1718 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1719 labelframe $w.name \
1721 -text {Branch Description} \
1722 -font font_ui
1723 label $w.name.l -text {Name:} -font font_ui
1724 text $w.name.t \
1725 -borderwidth 1 \
1726 -relief sunken \
1727 -height 1 \
1728 -width 40 \
1729 -font font_ui
1730 bind $w.name.t <Shift-Key-Tab> "focus $w.postActions.checkout;break"
1731 bind $w.name.t <Key-Tab> "focus $w.from.exp.t;break"
1732 bind $w.name.t <Key-Return> "do_create_branch_action $w;break"
1733 bind $w.name.t <Key> {
1734 if {{%K} ne {BackSpace}
1735 && {%K} ne {Tab}
1736 && {%K} ne {Escape}
1737 && {%K} ne {Return}} {
1738 if {%k <= 32} break
1739 if {[string first %A {~^:?*[}] >= 0} break
1740 }
1741 }
1742 pack $w.name.l -side left -padx 5
1743 pack $w.name.t -side left -fill x -expand 1
1744 pack $w.name -anchor nw -fill x -pady 5 -padx 5
1745 set all_trackings [list]
1747 foreach b [array names tracking_branches] {
1748 regsub ^refs/(heads|remotes)/ $b {} b
1749 lappend all_trackings $b
1750 }
1751 set all_trackings [lsort -unique $all_trackings]
1752 if {$all_trackings ne {}} {
1753 set create_branch_trackinghead [lindex $all_trackings 0]
1754 }
1755 labelframe $w.from \
1757 -text {Starting Revision} \
1758 -font font_ui
1759 frame $w.from.head
1760 radiobutton $w.from.head.r \
1761 -text {Local Branch:} \
1762 -value head \
1763 -variable create_branch_revtype \
1764 -font font_ui
1765 eval tk_optionMenu $w.from.head.m create_branch_head $all_heads
1766 pack $w.from.head.r -side left
1767 pack $w.from.head.m -side left
1768 frame $w.from.tracking
1769 radiobutton $w.from.tracking.r \
1770 -text {Tracking Branch:} \
1771 -value tracking \
1772 -variable create_branch_revtype \
1773 -font font_ui
1774 eval tk_optionMenu $w.from.tracking.m \
1775 create_branch_trackinghead \
1776 $all_trackings
1777 pack $w.from.tracking.r -side left
1778 pack $w.from.tracking.m -side left
1779 frame $w.from.exp
1780 radiobutton $w.from.exp.r \
1781 -text {Revision Expression:} \
1782 -value expression \
1783 -variable create_branch_revtype \
1784 -font font_ui
1785 text $w.from.exp.t \
1786 -borderwidth 1 \
1787 -relief sunken \
1788 -height 1 \
1789 -width 50 \
1790 -font font_ui
1791 bind $w.from.exp.t <Shift-Key-Tab> "focus $w.name.t;break"
1792 bind $w.from.exp.t <Key-Tab> "focus $w.postActions.checkout;break"
1793 bind $w.from.exp.t <Key-Return> "do_create_branch_action $w;break"
1794 pack $w.from.exp.r -side left
1795 pack $w.from.exp.t -side left -fill x -expand 1
1796 pack $w.from.head -padx 5 -fill x -expand 1
1797 pack $w.from.tracking -padx 5 -fill x -expand 1
1798 pack $w.from.exp -padx 5 -fill x -expand 1
1799 pack $w.from -anchor nw -fill x -pady 5 -padx 5
1800 labelframe $w.postActions \
1802 -text {Post Creation Actions} \
1803 -font font_ui
1804 checkbutton $w.postActions.checkout \
1805 -text {Checkout after creation} \
1806 -variable create_branch_checkout \
1807 -font font_ui
1808 pack $w.postActions.checkout -anchor nw
1809 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
1810 bind $w <Visibility> "grab $w; focus $w.name.t"
1812 bind $w <Key-Escape> "destroy $w"
1813 bind $w <Key-Return> "do_create_branch_action $w;break"
1814 wm title $w "[appname] ([reponame]): Create Branch"
1815 tkwait window $w
1816}
1817proc do_delete_branch_action {w} {
1819 global all_heads
1820 global delete_branch_checkhead delete_branch_head
1821 set to_delete [list]
1823 set not_merged [list]
1824 foreach i [$w.list.l curselection] {
1825 set b [$w.list.l get $i]
1826 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
1827 if {$delete_branch_checkhead} {
1828 if {$b eq $delete_branch_head} continue
1829 if {[catch {set m [exec git merge-base $o $delete_branch_head]}]} continue
1830 if {$o ne $m} {
1831 lappend not_merged $b
1832 continue
1833 }
1834 }
1835 lappend to_delete [list $b $o]
1836 }
1837 if {$not_merged ne {}} {
1838 set msg "The following branches are not completely merged into $delete_branch_head:
1839 - [join $not_merged "\n - "]"
1841 tk_messageBox \
1842 -icon info \
1843 -type ok \
1844 -title [wm title $w] \
1845 -parent $w \
1846 -message $msg
1847 }
1848 if {$to_delete eq {}} return
1849 if {!$delete_branch_checkhead} {
1850 set msg {Recovering deleted branches is difficult.
1851Delete the selected branches?}
1853 if {[tk_messageBox \
1854 -icon warning \
1855 -type yesno \
1856 -title [wm title $w] \
1857 -parent $w \
1858 -message $msg] ne yes} {
1859 return
1860 }
1861 }
1862 set failed {}
1864 foreach i $to_delete {
1865 set b [lindex $i 0]
1866 set o [lindex $i 1]
1867 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
1868 append failed " - $b: $err\n"
1869 } else {
1870 set x [lsearch -sorted $all_heads $b]
1871 if {$x >= 0} {
1872 set all_heads [lreplace $all_heads $x $x]
1873 }
1874 }
1875 }
1876 if {$failed ne {}} {
1878 tk_messageBox \
1879 -icon error \
1880 -type ok \
1881 -title [wm title $w] \
1882 -parent $w \
1883 -message "Failed to delete branches:\n$failed"
1884 }
1885 set all_heads [lsort $all_heads]
1887 populate_branch_menu
1888 destroy $w
1889}
1890proc do_delete_branch {} {
1892 global all_heads tracking_branches current_branch
1893 global delete_branch_checkhead delete_branch_head
1894 set delete_branch_checkhead 1
1896 set delete_branch_head $current_branch
1897 set w .branch_editor
1899 toplevel $w
1900 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1901 label $w.header -text {Delete Local Branch} \
1903 -font font_uibold
1904 pack $w.header -side top -fill x
1905 frame $w.buttons
1907 button $w.buttons.create -text Delete \
1908 -font font_ui \
1909 -command [list do_delete_branch_action $w]
1910 pack $w.buttons.create -side right
1911 button $w.buttons.cancel -text {Cancel} \
1912 -font font_ui \
1913 -command [list destroy $w]
1914 pack $w.buttons.cancel -side right -padx 5
1915 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1916 labelframe $w.list \
1918 -text {Local Branches} \
1919 -font font_ui
1920 listbox $w.list.l \
1921 -height 10 \
1922 -width 50 \
1923 -selectmode extended \
1924 -font font_ui
1925 foreach h $all_heads {
1926 if {$h ne $current_branch} {
1927 $w.list.l insert end $h
1928 }
1929 }
1930 pack $w.list.l -fill both -pady 5 -padx 5
1931 pack $w.list -fill both -pady 5 -padx 5
1932 set all_trackings [list]
1934 foreach b [array names tracking_branches] {
1935 regsub ^refs/(heads|remotes)/ $b {} b
1936 lappend all_trackings $b
1937 }
1938 labelframe $w.validate \
1940 -text {Only Delete If} \
1941 -font font_ui
1942 frame $w.validate.head
1943 checkbutton $w.validate.head.r \
1944 -text {Already Merged Into:} \
1945 -variable delete_branch_checkhead \
1946 -font font_ui
1947 eval tk_optionMenu $w.validate.head.m delete_branch_head \
1948 $all_heads \
1949 [lsort -unique $all_trackings]
1950 pack $w.validate.head.r -side left
1951 pack $w.validate.head.m -side left
1952 pack $w.validate.head -padx 5 -fill x -expand 1
1953 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
1954 bind $w <Visibility> "grab $w; focus $w"
1956 bind $w <Key-Escape> "destroy $w"
1957 wm title $w "[appname] ([reponame]): Delete Branch"
1958 tkwait window $w
1959}
1960proc switch_branch {b} {
1962 global HEAD commit_type file_states current_branch
1963 global selected_commit_type ui_comm
1964 if {![lock_index switch]} return
1966 # -- Backup the selected branch (repository_state resets it)
1968 #
1969 set new_branch $current_branch
1970 # -- Our in memory state should match the repository.
1972 #
1973 repository_state curType curHEAD curMERGE_HEAD
1974 if {[string match amend* $commit_type]
1975 && $curType eq {normal}
1976 && $curHEAD eq $HEAD} {
1977 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1978 info_popup {Last scanned state does not match repository state.
1979Another Git program has modified this repository
1981since the last scan. A rescan must be performed
1982before the current branch can be changed.
1983The rescan will be automatically started now.
1985}
1986 unlock_index
1987 rescan {set ui_status_value {Ready.}}
1988 return
1989 }
1990 # -- Toss the message buffer if we are in amend mode.
1992 #
1993 if {[string match amend* $curType]} {
1994 $ui_comm delete 0.0 end
1995 $ui_comm edit reset
1996 $ui_comm edit modified false
1997 }
1998 set selected_commit_type new
2000 set current_branch $new_branch
2001 unlock_index
2003 error "NOT FINISHED"
2004}
2005######################################################################
2007##
2008## remote management
2009proc load_all_remotes {} {
2011 global repo_config
2012 global all_remotes tracking_branches
2013 set all_remotes [list]
2015 array unset tracking_branches
2016 set rm_dir [gitdir remotes]
2018 if {[file isdirectory $rm_dir]} {
2019 set all_remotes [glob \
2020 -types f \
2021 -tails \
2022 -nocomplain \
2023 -directory $rm_dir *]
2024 foreach name $all_remotes {
2026 catch {
2027 set fd [open [file join $rm_dir $name] r]
2028 while {[gets $fd line] >= 0} {
2029 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2030 $line line src dst]} continue
2031 if {![regexp ^refs/ $dst]} {
2032 set dst "refs/heads/$dst"
2033 }
2034 set tracking_branches($dst) [list $name $src]
2035 }
2036 close $fd
2037 }
2038 }
2039 }
2040 foreach line [array names repo_config remote.*.url] {
2042 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2043 lappend all_remotes $name
2044 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2046 set fl {}
2047 }
2048 foreach line $fl {
2049 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2050 if {![regexp ^refs/ $dst]} {
2051 set dst "refs/heads/$dst"
2052 }
2053 set tracking_branches($dst) [list $name $src]
2054 }
2055 }
2056 set all_remotes [lsort -unique $all_remotes]
2058}
2059proc populate_fetch_menu {m} {
2061 global all_remotes repo_config
2062 foreach r $all_remotes {
2064 set enable 0
2065 if {![catch {set a $repo_config(remote.$r.url)}]} {
2066 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2067 set enable 1
2068 }
2069 } else {
2070 catch {
2071 set fd [open [gitdir remotes $r] r]
2072 while {[gets $fd n] >= 0} {
2073 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2074 set enable 1
2075 break
2076 }
2077 }
2078 close $fd
2079 }
2080 }
2081 if {$enable} {
2083 $m add command \
2084 -label "Fetch from $r..." \
2085 -command [list fetch_from $r] \
2086 -font font_ui
2087 }
2088 }
2089}
2090proc populate_push_menu {m} {
2092 global all_remotes repo_config
2093 foreach r $all_remotes {
2095 set enable 0
2096 if {![catch {set a $repo_config(remote.$r.url)}]} {
2097 if {![catch {set a $repo_config(remote.$r.push)}]} {
2098 set enable 1
2099 }
2100 } else {
2101 catch {
2102 set fd [open [gitdir remotes $r] r]
2103 while {[gets $fd n] >= 0} {
2104 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2105 set enable 1
2106 break
2107 }
2108 }
2109 close $fd
2110 }
2111 }
2112 if {$enable} {
2114 $m add command \
2115 -label "Push to $r..." \
2116 -command [list push_to $r] \
2117 -font font_ui
2118 }
2119 }
2120}
2121proc populate_pull_menu {m} {
2123 global repo_config all_remotes disable_on_lock
2124 foreach remote $all_remotes {
2126 set rb_list [list]
2127 if {[array get repo_config remote.$remote.url] ne {}} {
2128 if {[array get repo_config remote.$remote.fetch] ne {}} {
2129 foreach line $repo_config(remote.$remote.fetch) {
2130 if {[regexp {^([^:]+):} $line line rb]} {
2131 lappend rb_list $rb
2132 }
2133 }
2134 }
2135 } else {
2136 catch {
2137 set fd [open [gitdir remotes $remote] r]
2138 while {[gets $fd line] >= 0} {
2139 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
2140 lappend rb_list $rb
2141 }
2142 }
2143 close $fd
2144 }
2145 }
2146 foreach rb $rb_list {
2148 regsub ^refs/heads/ $rb {} rb_short
2149 $m add command \
2150 -label "Branch $rb_short from $remote..." \
2151 -command [list pull_remote $remote $rb] \
2152 -font font_ui
2153 lappend disable_on_lock \
2154 [list $m entryconf [$m index last] -state]
2155 }
2156 }
2157}
2158######################################################################
2160##
2161## icons
2162set filemask {
2164#define mask_width 14
2165#define mask_height 15
2166static unsigned char mask_bits[] = {
2167 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2168 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2169 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2170}
2171image create bitmap file_plain -background white -foreground black -data {
2173#define plain_width 14
2174#define plain_height 15
2175static unsigned char plain_bits[] = {
2176 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2177 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2178 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2179} -maskdata $filemask
2180image create bitmap file_mod -background white -foreground blue -data {
2182#define mod_width 14
2183#define mod_height 15
2184static unsigned char mod_bits[] = {
2185 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2186 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2187 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2188} -maskdata $filemask
2189image create bitmap file_fulltick -background white -foreground "#007000" -data {
2191#define file_fulltick_width 14
2192#define file_fulltick_height 15
2193static unsigned char file_fulltick_bits[] = {
2194 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2195 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2196 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2197} -maskdata $filemask
2198image create bitmap file_parttick -background white -foreground "#005050" -data {
2200#define parttick_width 14
2201#define parttick_height 15
2202static unsigned char parttick_bits[] = {
2203 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2204 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2205 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2206} -maskdata $filemask
2207image create bitmap file_question -background white -foreground black -data {
2209#define file_question_width 14
2210#define file_question_height 15
2211static unsigned char file_question_bits[] = {
2212 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2213 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2214 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2215} -maskdata $filemask
2216image create bitmap file_removed -background white -foreground red -data {
2218#define file_removed_width 14
2219#define file_removed_height 15
2220static unsigned char file_removed_bits[] = {
2221 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2222 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2223 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2224} -maskdata $filemask
2225image create bitmap file_merge -background white -foreground blue -data {
2227#define file_merge_width 14
2228#define file_merge_height 15
2229static unsigned char file_merge_bits[] = {
2230 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2231 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2232 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2233} -maskdata $filemask
2234set ui_index .vpane.files.index.list
2236set ui_workdir .vpane.files.workdir.list
2237set all_icons(_$ui_index) file_plain
2239set all_icons(A$ui_index) file_fulltick
2240set all_icons(M$ui_index) file_fulltick
2241set all_icons(D$ui_index) file_removed
2242set all_icons(U$ui_index) file_merge
2243set all_icons(_$ui_workdir) file_plain
2245set all_icons(M$ui_workdir) file_mod
2246set all_icons(D$ui_workdir) file_question
2247set all_icons(O$ui_workdir) file_plain
2248set max_status_desc 0
2250foreach i {
2251 {__ "Unmodified"}
2252 {_M "Modified, not staged"}
2254 {M_ "Staged for commit"}
2255 {MM "Portions staged for commit"}
2256 {MD "Staged for commit, missing"}
2257 {_O "Untracked, not staged"}
2259 {A_ "Staged for commit"}
2260 {AM "Portions staged for commit"}
2261 {AD "Staged for commit, missing"}
2262 {_D "Missing"}
2264 {D_ "Staged for removal"}
2265 {DO "Staged for removal, still present"}
2266 {U_ "Requires merge resolution"}
2268 {UM "Requires merge resolution"}
2269 {UD "Requires merge resolution"}
2270 } {
2271 if {$max_status_desc < [string length [lindex $i 1]]} {
2272 set max_status_desc [string length [lindex $i 1]]
2273 }
2274 set all_descs([lindex $i 0]) [lindex $i 1]
2275}
2276unset i
2277######################################################################
2279##
2280## util
2281proc is_MacOSX {} {
2283 global tcl_platform tk_library
2284 if {[tk windowingsystem] eq {aqua}} {
2285 return 1
2286 }
2287 return 0
2288}
2289proc is_Windows {} {
2291 global tcl_platform
2292 if {$tcl_platform(platform) eq {windows}} {
2293 return 1
2294 }
2295 return 0
2296}
2297proc bind_button3 {w cmd} {
2299 bind $w <Any-Button-3> $cmd
2300 if {[is_MacOSX]} {
2301 bind $w <Control-Button-1> $cmd
2302 }
2303}
2304proc incr_font_size {font {amt 1}} {
2306 set sz [font configure $font -size]
2307 incr sz $amt
2308 font configure $font -size $sz
2309 font configure ${font}bold -size $sz
2310}
2311proc hook_failed_popup {hook msg} {
2313 set w .hookfail
2314 toplevel $w
2315 frame $w.m
2317 label $w.m.l1 -text "$hook hook failed:" \
2318 -anchor w \
2319 -justify left \
2320 -font font_uibold
2321 text $w.m.t \
2322 -background white -borderwidth 1 \
2323 -relief sunken \
2324 -width 80 -height 10 \
2325 -font font_diff \
2326 -yscrollcommand [list $w.m.sby set]
2327 label $w.m.l2 \
2328 -text {You must correct the above errors before committing.} \
2329 -anchor w \
2330 -justify left \
2331 -font font_uibold
2332 scrollbar $w.m.sby -command [list $w.m.t yview]
2333 pack $w.m.l1 -side top -fill x
2334 pack $w.m.l2 -side bottom -fill x
2335 pack $w.m.sby -side right -fill y
2336 pack $w.m.t -side left -fill both -expand 1
2337 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2338 $w.m.t insert 1.0 $msg
2340 $w.m.t conf -state disabled
2341 button $w.ok -text OK \
2343 -width 15 \
2344 -font font_ui \
2345 -command "destroy $w"
2346 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2347 bind $w <Visibility> "grab $w; focus $w"
2349 bind $w <Key-Return> "destroy $w"
2350 wm title $w "[appname] ([reponame]): error"
2351 tkwait window $w
2352}
2353set next_console_id 0
2355proc new_console {short_title long_title} {
2357 global next_console_id console_data
2358 set w .console[incr next_console_id]
2359 set console_data($w) [list $short_title $long_title]
2360 return [console_init $w]
2361}
2362proc console_init {w} {
2364 global console_cr console_data M1B
2365 set console_cr($w) 1.0
2367 toplevel $w
2368 frame $w.m
2369 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2370 -anchor w \
2371 -justify left \
2372 -font font_uibold
2373 text $w.m.t \
2374 -background white -borderwidth 1 \
2375 -relief sunken \
2376 -width 80 -height 10 \
2377 -font font_diff \
2378 -state disabled \
2379 -yscrollcommand [list $w.m.sby set]
2380 label $w.m.s -text {Working... please wait...} \
2381 -anchor w \
2382 -justify left \
2383 -font font_uibold
2384 scrollbar $w.m.sby -command [list $w.m.t yview]
2385 pack $w.m.l1 -side top -fill x
2386 pack $w.m.s -side bottom -fill x
2387 pack $w.m.sby -side right -fill y
2388 pack $w.m.t -side left -fill both -expand 1
2389 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2390 menu $w.ctxm -tearoff 0
2392 $w.ctxm add command -label "Copy" \
2393 -font font_ui \
2394 -command "tk_textCopy $w.m.t"
2395 $w.ctxm add command -label "Select All" \
2396 -font font_ui \
2397 -command "$w.m.t tag add sel 0.0 end"
2398 $w.ctxm add command -label "Copy All" \
2399 -font font_ui \
2400 -command "
2401 $w.m.t tag add sel 0.0 end
2402 tk_textCopy $w.m.t
2403 $w.m.t tag remove sel 0.0 end
2404 "
2405 button $w.ok -text {Close} \
2407 -font font_ui \
2408 -state disabled \
2409 -command "destroy $w"
2410 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2411 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2413 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2414 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2415 bind $w <Visibility> "focus $w"
2416 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2417 return $w
2418}
2419proc console_exec {w cmd {after {}}} {
2421 # -- Windows tosses the enviroment when we exec our child.
2422 # But most users need that so we have to relogin. :-(
2423 #
2424 if {[is_Windows]} {
2425 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2426 }
2427 # -- Tcl won't let us redirect both stdout and stderr to
2429 # the same pipe. So pass it through cat...
2430 #
2431 set cmd [concat | $cmd |& cat]
2432 set fd_f [open $cmd r]
2434 fconfigure $fd_f -blocking 0 -translation binary
2435 fileevent $fd_f readable [list console_read $w $fd_f $after]
2436}
2437proc console_read {w fd after} {
2439 global console_cr console_data
2440 set buf [read $fd]
2442 if {$buf ne {}} {
2443 if {![winfo exists $w]} {console_init $w}
2444 $w.m.t conf -state normal
2445 set c 0
2446 set n [string length $buf]
2447 while {$c < $n} {
2448 set cr [string first "\r" $buf $c]
2449 set lf [string first "\n" $buf $c]
2450 if {$cr < 0} {set cr [expr {$n + 1}]}
2451 if {$lf < 0} {set lf [expr {$n + 1}]}
2452 if {$lf < $cr} {
2454 $w.m.t insert end [string range $buf $c $lf]
2455 set console_cr($w) [$w.m.t index {end -1c}]
2456 set c $lf
2457 incr c
2458 } else {
2459 $w.m.t delete $console_cr($w) end
2460 $w.m.t insert end "\n"
2461 $w.m.t insert end [string range $buf $c $cr]
2462 set c $cr
2463 incr c
2464 }
2465 }
2466 $w.m.t conf -state disabled
2467 $w.m.t see end
2468 }
2469 fconfigure $fd -blocking 1
2471 if {[eof $fd]} {
2472 if {[catch {close $fd}]} {
2473 if {![winfo exists $w]} {console_init $w}
2474 $w.m.s conf -background red -text {Error: Command Failed}
2475 $w.ok conf -state normal
2476 set ok 0
2477 } elseif {[winfo exists $w]} {
2478 $w.m.s conf -background green -text {Success}
2479 $w.ok conf -state normal
2480 set ok 1
2481 }
2482 array unset console_cr $w
2483 array unset console_data $w
2484 if {$after ne {}} {
2485 uplevel #0 $after $ok
2486 }
2487 return
2488 }
2489 fconfigure $fd -blocking 0
2490}
2491######################################################################
2493##
2494## ui commands
2495set starting_gitk_msg {Starting gitk... please wait...}
2497proc do_gitk {revs} {
2499 global ui_status_value starting_gitk_msg
2500 set cmd gitk
2502 if {$revs ne {}} {
2503 append cmd { }
2504 append cmd $revs
2505 }
2506 if {[is_Windows]} {
2507 set cmd "sh -c \"exec $cmd\""
2508 }
2509 append cmd { &}
2510 if {[catch {eval exec $cmd} err]} {
2512 error_popup "Failed to start gitk:\n\n$err"
2513 } else {
2514 set ui_status_value $starting_gitk_msg
2515 after 10000 {
2516 if {$ui_status_value eq $starting_gitk_msg} {
2517 set ui_status_value {Ready.}
2518 }
2519 }
2520 }
2521}
2522proc do_gc {} {
2524 set w [new_console {gc} {Compressing the object database}]
2525 console_exec $w {git gc}
2526}
2527proc do_fsck_objects {} {
2529 set w [new_console {fsck-objects} \
2530 {Verifying the object database with fsck-objects}]
2531 set cmd [list git fsck-objects]
2532 lappend cmd --full
2533 lappend cmd --cache
2534 lappend cmd --strict
2535 console_exec $w $cmd
2536}
2537set is_quitting 0
2539proc do_quit {} {
2541 global ui_comm is_quitting repo_config commit_type
2542 if {$is_quitting} return
2544 set is_quitting 1
2545 # -- Stash our current commit buffer.
2547 #
2548 set save [gitdir GITGUI_MSG]
2549 set msg [string trim [$ui_comm get 0.0 end]]
2550 if {![string match amend* $commit_type]
2551 && [$ui_comm edit modified]
2552 && $msg ne {}} {
2553 catch {
2554 set fd [open $save w]
2555 puts $fd [string trim [$ui_comm get 0.0 end]]
2556 close $fd
2557 }
2558 } else {
2559 catch {file delete $save}
2560 }
2561 # -- Stash our current window geometry into this repository.
2563 #
2564 set cfg_geometry [list]
2565 lappend cfg_geometry [wm geometry .]
2566 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2567 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2568 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2569 set rc_geometry {}
2570 }
2571 if {$cfg_geometry ne $rc_geometry} {
2572 catch {exec git repo-config gui.geometry $cfg_geometry}
2573 }
2574 destroy .
2576}
2577proc do_rescan {} {
2579 rescan {set ui_status_value {Ready.}}
2580}
2581proc unstage_helper {txt paths} {
2583 global file_states current_diff_path
2584 if {![lock_index begin-update]} return
2586 set pathList [list]
2588 set after {}
2589 foreach path $paths {
2590 switch -glob -- [lindex $file_states($path) 0] {
2591 A? -
2592 M? -
2593 D? {
2594 lappend pathList $path
2595 if {$path eq $current_diff_path} {
2596 set after {reshow_diff;}
2597 }
2598 }
2599 }
2600 }
2601 if {$pathList eq {}} {
2602 unlock_index
2603 } else {
2604 update_indexinfo \
2605 $txt \
2606 $pathList \
2607 [concat $after {set ui_status_value {Ready.}}]
2608 }
2609}
2610proc do_unstage_selection {} {
2612 global current_diff_path selected_paths
2613 if {[array size selected_paths] > 0} {
2615 unstage_helper \
2616 {Unstaging selected files from commit} \
2617 [array names selected_paths]
2618 } elseif {$current_diff_path ne {}} {
2619 unstage_helper \
2620 "Unstaging [short_path $current_diff_path] from commit" \
2621 [list $current_diff_path]
2622 }
2623}
2624proc add_helper {txt paths} {
2626 global file_states current_diff_path
2627 if {![lock_index begin-update]} return
2629 set pathList [list]
2631 set after {}
2632 foreach path $paths {
2633 switch -glob -- [lindex $file_states($path) 0] {
2634 _O -
2635 ?M -
2636 ?D -
2637 U? {
2638 lappend pathList $path
2639 if {$path eq $current_diff_path} {
2640 set after {reshow_diff;}
2641 }
2642 }
2643 }
2644 }
2645 if {$pathList eq {}} {
2646 unlock_index
2647 } else {
2648 update_index \
2649 $txt \
2650 $pathList \
2651 [concat $after {set ui_status_value {Ready to commit.}}]
2652 }
2653}
2654proc do_add_selection {} {
2656 global current_diff_path selected_paths
2657 if {[array size selected_paths] > 0} {
2659 add_helper \
2660 {Adding selected files} \
2661 [array names selected_paths]
2662 } elseif {$current_diff_path ne {}} {
2663 add_helper \
2664 "Adding [short_path $current_diff_path]" \
2665 [list $current_diff_path]
2666 }
2667}
2668proc do_add_all {} {
2670 global file_states
2671 set paths [list]
2673 foreach path [array names file_states] {
2674 switch -glob -- [lindex $file_states($path) 0] {
2675 U? {continue}
2676 ?M -
2677 ?D {lappend paths $path}
2678 }
2679 }
2680 add_helper {Adding all changed files} $paths
2681}
2682proc revert_helper {txt paths} {
2684 global file_states current_diff_path
2685 if {![lock_index begin-update]} return
2687 set pathList [list]
2689 set after {}
2690 foreach path $paths {
2691 switch -glob -- [lindex $file_states($path) 0] {
2692 U? {continue}
2693 ?M -
2694 ?D {
2695 lappend pathList $path
2696 if {$path eq $current_diff_path} {
2697 set after {reshow_diff;}
2698 }
2699 }
2700 }
2701 }
2702 set n [llength $pathList]
2704 if {$n == 0} {
2705 unlock_index
2706 return
2707 } elseif {$n == 1} {
2708 set s "[short_path [lindex $pathList]]"
2709 } else {
2710 set s "these $n files"
2711 }
2712 set reply [tk_dialog \
2714 .confirm_revert \
2715 "[appname] ([reponame])" \
2716 "Revert changes in $s?
2717Any unadded changes will be permanently lost by the revert." \
2719 question \
2720 1 \
2721 {Do Nothing} \
2722 {Revert Changes} \
2723 ]
2724 if {$reply == 1} {
2725 checkout_index \
2726 $txt \
2727 $pathList \
2728 [concat $after {set ui_status_value {Ready.}}]
2729 } else {
2730 unlock_index
2731 }
2732}
2733proc do_revert_selection {} {
2735 global current_diff_path selected_paths
2736 if {[array size selected_paths] > 0} {
2738 revert_helper \
2739 {Reverting selected files} \
2740 [array names selected_paths]
2741 } elseif {$current_diff_path ne {}} {
2742 revert_helper \
2743 "Reverting [short_path $current_diff_path]" \
2744 [list $current_diff_path]
2745 }
2746}
2747proc do_signoff {} {
2749 global ui_comm
2750 set me [committer_ident]
2752 if {$me eq {}} return
2753 set sob "Signed-off-by: $me"
2755 set last [$ui_comm get {end -1c linestart} {end -1c}]
2756 if {$last ne $sob} {
2757 $ui_comm edit separator
2758 if {$last ne {}
2759 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2760 $ui_comm insert end "\n"
2761 }
2762 $ui_comm insert end "\n$sob"
2763 $ui_comm edit separator
2764 $ui_comm see end
2765 }
2766}
2767proc do_select_commit_type {} {
2769 global commit_type selected_commit_type
2770 if {$selected_commit_type eq {new}
2772 && [string match amend* $commit_type]} {
2773 create_new_commit
2774 } elseif {$selected_commit_type eq {amend}
2775 && ![string match amend* $commit_type]} {
2776 load_last_commit
2777 # The amend request was rejected...
2779 #
2780 if {![string match amend* $commit_type]} {
2781 set selected_commit_type new
2782 }
2783 }
2784}
2785proc do_commit {} {
2787 commit_tree
2788}
2789proc do_about {} {
2791 global appvers copyright
2792 global tcl_patchLevel tk_patchLevel
2793 set w .about_dialog
2795 toplevel $w
2796 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2797 label $w.header -text "About [appname]" \
2799 -font font_uibold
2800 pack $w.header -side top -fill x
2801 frame $w.buttons
2803 button $w.buttons.close -text {Close} \
2804 -font font_ui \
2805 -command [list destroy $w]
2806 pack $w.buttons.close -side right
2807 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2808 label $w.desc \
2810 -text "[appname] - a commit creation tool for Git.
2811$copyright" \
2812 -padx 5 -pady 5 \
2813 -justify left \
2814 -anchor w \
2815 -borderwidth 1 \
2816 -relief solid \
2817 -font font_ui
2818 pack $w.desc -side top -fill x -padx 5 -pady 5
2819 set v {}
2821 append v "[appname] version $appvers\n"
2822 append v "[exec git version]\n"
2823 append v "\n"
2824 if {$tcl_patchLevel eq $tk_patchLevel} {
2825 append v "Tcl/Tk version $tcl_patchLevel"
2826 } else {
2827 append v "Tcl version $tcl_patchLevel"
2828 append v ", Tk version $tk_patchLevel"
2829 }
2830 label $w.vers \
2832 -text $v \
2833 -padx 5 -pady 5 \
2834 -justify left \
2835 -anchor w \
2836 -borderwidth 1 \
2837 -relief solid \
2838 -font font_ui
2839 pack $w.vers -side top -fill x -padx 5 -pady 5
2840 menu $w.ctxm -tearoff 0
2842 $w.ctxm add command \
2843 -label {Copy} \
2844 -font font_ui \
2845 -command "
2846 clipboard clear
2847 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2848 "
2849 bind $w <Visibility> "grab $w; focus $w"
2851 bind $w <Key-Escape> "destroy $w"
2852 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2853 wm title $w "About [appname]"
2854 tkwait window $w
2855}
2856proc do_options {} {
2858 global repo_config global_config font_descs
2859 global repo_config_new global_config_new
2860 array unset repo_config_new
2862 array unset global_config_new
2863 foreach name [array names repo_config] {
2864 set repo_config_new($name) $repo_config($name)
2865 }
2866 load_config 1
2867 foreach name [array names repo_config] {
2868 switch -- $name {
2869 gui.diffcontext {continue}
2870 }
2871 set repo_config_new($name) $repo_config($name)
2872 }
2873 foreach name [array names global_config] {
2874 set global_config_new($name) $global_config($name)
2875 }
2876 set w .options_editor
2878 toplevel $w
2879 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2880 label $w.header -text "[appname] Options" \
2882 -font font_uibold
2883 pack $w.header -side top -fill x
2884 frame $w.buttons
2886 button $w.buttons.restore -text {Restore Defaults} \
2887 -font font_ui \
2888 -command do_restore_defaults
2889 pack $w.buttons.restore -side left
2890 button $w.buttons.save -text Save \
2891 -font font_ui \
2892 -command [list do_save_config $w]
2893 pack $w.buttons.save -side right
2894 button $w.buttons.cancel -text {Cancel} \
2895 -font font_ui \
2896 -command [list destroy $w]
2897 pack $w.buttons.cancel -side right -padx 5
2898 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2899 labelframe $w.repo -text "[reponame] Repository" \
2901 -font font_ui \
2902 -relief raised -borderwidth 2
2903 labelframe $w.global -text {Global (All Repositories)} \
2904 -font font_ui \
2905 -relief raised -borderwidth 2
2906 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2907 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2908 foreach option {
2910 {b pullsummary {Show Pull Summary}}
2911 {b trustmtime {Trust File Modification Timestamps}}
2912 {i diffcontext {Number of Diff Context Lines}}
2913 } {
2914 set type [lindex $option 0]
2915 set name [lindex $option 1]
2916 set text [lindex $option 2]
2917 foreach f {repo global} {
2918 switch $type {
2919 b {
2920 checkbutton $w.$f.$name -text $text \
2921 -variable ${f}_config_new(gui.$name) \
2922 -onvalue true \
2923 -offvalue false \
2924 -font font_ui
2925 pack $w.$f.$name -side top -anchor w
2926 }
2927 i {
2928 frame $w.$f.$name
2929 label $w.$f.$name.l -text "$text:" -font font_ui
2930 pack $w.$f.$name.l -side left -anchor w -fill x
2931 spinbox $w.$f.$name.v \
2932 -textvariable ${f}_config_new(gui.$name) \
2933 -from 1 -to 99 -increment 1 \
2934 -width 3 \
2935 -font font_ui
2936 pack $w.$f.$name.v -side right -anchor e
2937 pack $w.$f.$name -side top -anchor w -fill x
2938 }
2939 }
2940 }
2941 }
2942 set all_fonts [lsort [font families]]
2944 foreach option $font_descs {
2945 set name [lindex $option 0]
2946 set font [lindex $option 1]
2947 set text [lindex $option 2]
2948 set global_config_new(gui.$font^^family) \
2950 [font configure $font -family]
2951 set global_config_new(gui.$font^^size) \
2952 [font configure $font -size]
2953 frame $w.global.$name
2955 label $w.global.$name.l -text "$text:" -font font_ui
2956 pack $w.global.$name.l -side left -anchor w -fill x
2957 eval tk_optionMenu $w.global.$name.family \
2958 global_config_new(gui.$font^^family) \
2959 $all_fonts
2960 spinbox $w.global.$name.size \
2961 -textvariable global_config_new(gui.$font^^size) \
2962 -from 2 -to 80 -increment 1 \
2963 -width 3 \
2964 -font font_ui
2965 pack $w.global.$name.size -side right -anchor e
2966 pack $w.global.$name.family -side right -anchor e
2967 pack $w.global.$name -side top -anchor w -fill x
2968 }
2969 bind $w <Visibility> "grab $w; focus $w"
2971 bind $w <Key-Escape> "destroy $w"
2972 wm title $w "[appname] ([reponame]): Options"
2973 tkwait window $w
2974}
2975proc do_restore_defaults {} {
2977 global font_descs default_config repo_config
2978 global repo_config_new global_config_new
2979 foreach name [array names default_config] {
2981 set repo_config_new($name) $default_config($name)
2982 set global_config_new($name) $default_config($name)
2983 }
2984 foreach option $font_descs {
2986 set name [lindex $option 0]
2987 set repo_config(gui.$name) $default_config(gui.$name)
2988 }
2989 apply_config
2990 foreach option $font_descs {
2992 set name [lindex $option 0]
2993 set font [lindex $option 1]
2994 set global_config_new(gui.$font^^family) \
2995 [font configure $font -family]
2996 set global_config_new(gui.$font^^size) \
2997 [font configure $font -size]
2998 }
2999}
3000proc do_save_config {w} {
3002 if {[catch {save_config} err]} {
3003 error_popup "Failed to completely save options:\n\n$err"
3004 }
3005 reshow_diff
3006 destroy $w
3007}
3008proc do_windows_shortcut {} {
3010 global argv0
3011 if {[catch {
3013 set desktop [exec cygpath \
3014 --windows \
3015 --absolute \
3016 --long-name \
3017 --desktop]
3018 }]} {
3019 set desktop .
3020 }
3021 set fn [tk_getSaveFile \
3022 -parent . \
3023 -title "[appname] ([reponame]): Create Desktop Icon" \
3024 -initialdir $desktop \
3025 -initialfile "Git [reponame].bat"]
3026 if {$fn != {}} {
3027 if {[catch {
3028 set fd [open $fn w]
3029 set sh [exec cygpath \
3030 --windows \
3031 --absolute \
3032 /bin/sh]
3033 set me [exec cygpath \
3034 --unix \
3035 --absolute \
3036 $argv0]
3037 set gd [exec cygpath \
3038 --unix \
3039 --absolute \
3040 [gitdir]]
3041 set gw [exec cygpath \
3042 --windows \
3043 --absolute \
3044 [file dirname [gitdir]]]
3045 regsub -all ' $me "'\\''" me
3046 regsub -all ' $gd "'\\''" gd
3047 puts $fd "@ECHO Entering $gw"
3048 puts $fd "@ECHO Starting git-gui... please wait..."
3049 puts -nonewline $fd "@\"$sh\" --login -c \""
3050 puts -nonewline $fd "GIT_DIR='$gd'"
3051 puts -nonewline $fd " '$me'"
3052 puts $fd "&\""
3053 close $fd
3054 } err]} {
3055 error_popup "Cannot write script:\n\n$err"
3056 }
3057 }
3058}
3059proc do_macosx_app {} {
3061 global argv0 env
3062 set fn [tk_getSaveFile \
3064 -parent . \
3065 -title "[appname] ([reponame]): Create Desktop Icon" \
3066 -initialdir [file join $env(HOME) Desktop] \
3067 -initialfile "Git [reponame].app"]
3068 if {$fn != {}} {
3069 if {[catch {
3070 set Contents [file join $fn Contents]
3071 set MacOS [file join $Contents MacOS]
3072 set exe [file join $MacOS git-gui]
3073 file mkdir $MacOS
3075 set fd [open [file join $Contents Info.plist] w]
3077 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3078<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3079<plist version="1.0">
3080<dict>
3081 <key>CFBundleDevelopmentRegion</key>
3082 <string>English</string>
3083 <key>CFBundleExecutable</key>
3084 <string>git-gui</string>
3085 <key>CFBundleIdentifier</key>
3086 <string>org.spearce.git-gui</string>
3087 <key>CFBundleInfoDictionaryVersion</key>
3088 <string>6.0</string>
3089 <key>CFBundlePackageType</key>
3090 <string>APPL</string>
3091 <key>CFBundleSignature</key>
3092 <string>????</string>
3093 <key>CFBundleVersion</key>
3094 <string>1.0</string>
3095 <key>NSPrincipalClass</key>
3096 <string>NSApplication</string>
3097</dict>
3098</plist>}
3099 close $fd
3100 set fd [open $exe w]
3102 set gd [file normalize [gitdir]]
3103 set ep [file normalize [exec git --exec-path]]
3104 regsub -all ' $gd "'\\''" gd
3105 regsub -all ' $ep "'\\''" ep
3106 puts $fd "#!/bin/sh"
3107 foreach name [array names env] {
3108 if {[string match GIT_* $name]} {
3109 regsub -all ' $env($name) "'\\''" v
3110 puts $fd "export $name='$v'"
3111 }
3112 }
3113 puts $fd "export PATH='$ep':\$PATH"
3114 puts $fd "export GIT_DIR='$gd'"
3115 puts $fd "exec [file normalize $argv0]"
3116 close $fd
3117 file attributes $exe -permissions u+x,g+x,o+x
3119 } err]} {
3120 error_popup "Cannot write icon:\n\n$err"
3121 }
3122 }
3123}
3124proc toggle_or_diff {w x y} {
3126 global file_states file_lists current_diff_path ui_index ui_workdir
3127 global last_clicked selected_paths
3128 set pos [split [$w index @$x,$y] .]
3130 set lno [lindex $pos 0]
3131 set col [lindex $pos 1]
3132 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3133 if {$path eq {}} {
3134 set last_clicked {}
3135 return
3136 }
3137 set last_clicked [list $w $lno]
3139 array unset selected_paths
3140 $ui_index tag remove in_sel 0.0 end
3141 $ui_workdir tag remove in_sel 0.0 end
3142 if {$col == 0} {
3144 if {$current_diff_path eq $path} {
3145 set after {reshow_diff;}
3146 } else {
3147 set after {}
3148 }
3149 if {$w eq $ui_index} {
3150 update_indexinfo \
3151 "Unstaging [short_path $path] from commit" \
3152 [list $path] \
3153 [concat $after {set ui_status_value {Ready.}}]
3154 } elseif {$w eq $ui_workdir} {
3155 update_index \
3156 "Adding [short_path $path]" \
3157 [list $path] \
3158 [concat $after {set ui_status_value {Ready.}}]
3159 }
3160 } else {
3161 show_diff $path $w $lno
3162 }
3163}
3164proc add_one_to_selection {w x y} {
3166 global file_lists last_clicked selected_paths
3167 set lno [lindex [split [$w index @$x,$y] .] 0]
3169 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3170 if {$path eq {}} {
3171 set last_clicked {}
3172 return
3173 }
3174 if {$last_clicked ne {}
3176 && [lindex $last_clicked 0] ne $w} {
3177 array unset selected_paths
3178 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3179 }
3180 set last_clicked [list $w $lno]
3182 if {[catch {set in_sel $selected_paths($path)}]} {
3183 set in_sel 0
3184 }
3185 if {$in_sel} {
3186 unset selected_paths($path)
3187 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3188 } else {
3189 set selected_paths($path) 1
3190 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3191 }
3192}
3193proc add_range_to_selection {w x y} {
3195 global file_lists last_clicked selected_paths
3196 if {[lindex $last_clicked 0] ne $w} {
3198 toggle_or_diff $w $x $y
3199 return
3200 }
3201 set lno [lindex [split [$w index @$x,$y] .] 0]
3203 set lc [lindex $last_clicked 1]
3204 if {$lc < $lno} {
3205 set begin $lc
3206 set end $lno
3207 } else {
3208 set begin $lno
3209 set end $lc
3210 }
3211 foreach path [lrange $file_lists($w) \
3213 [expr {$begin - 1}] \
3214 [expr {$end - 1}]] {
3215 set selected_paths($path) 1
3216 }
3217 $w tag add in_sel $begin.0 [expr {$end + 1}].0
3218}
3219######################################################################
3221##
3222## config defaults
3223set cursor_ptr arrow
3225font create font_diff -family Courier -size 10
3226font create font_ui
3227catch {
3228 label .dummy
3229 eval font configure font_ui [font actual [.dummy cget -font]]
3230 destroy .dummy
3231}
3232font create font_uibold
3234font create font_diffbold
3235if {[is_Windows]} {
3237 set M1B Control
3238 set M1T Ctrl
3239} elseif {[is_MacOSX]} {
3240 set M1B M1
3241 set M1T Cmd
3242} else {
3243 set M1B M1
3244 set M1T M1
3245}
3246proc apply_config {} {
3248 global repo_config font_descs
3249 foreach option $font_descs {
3251 set name [lindex $option 0]
3252 set font [lindex $option 1]
3253 if {[catch {
3254 foreach {cn cv} $repo_config(gui.$name) {
3255 font configure $font $cn $cv
3256 }
3257 } err]} {
3258 error_popup "Invalid font specified in gui.$name:\n\n$err"
3259 }
3260 foreach {cn cv} [font configure $font] {
3261 font configure ${font}bold $cn $cv
3262 }
3263 font configure ${font}bold -weight bold
3264 }
3265}
3266set default_config(gui.trustmtime) false
3268set default_config(gui.pullsummary) true
3269set default_config(gui.diffcontext) 5
3270set default_config(gui.fontui) [font configure font_ui]
3271set default_config(gui.fontdiff) [font configure font_diff]
3272set font_descs {
3273 {fontui font_ui {Main Font}}
3274 {fontdiff font_diff {Diff/Console Font}}
3275}
3276load_config 0
3277apply_config
3278######################################################################
3280##
3281## ui construction
3282# -- Menu Bar
3284#
3285menu .mbar -tearoff 0
3286.mbar add cascade -label Repository -menu .mbar.repository
3287.mbar add cascade -label Edit -menu .mbar.edit
3288if {!$single_commit} {
3289 .mbar add cascade -label Branch -menu .mbar.branch
3290}
3291.mbar add cascade -label Commit -menu .mbar.commit
3292if {!$single_commit} {
3293 .mbar add cascade -label Fetch -menu .mbar.fetch
3294 .mbar add cascade -label Pull -menu .mbar.pull
3295 .mbar add cascade -label Push -menu .mbar.push
3296}
3297. configure -menu .mbar
3298# -- Repository Menu
3300#
3301menu .mbar.repository
3302.mbar.repository add command \
3303 -label {Visualize Current Branch} \
3304 -command {do_gitk {}} \
3305 -font font_ui
3306if {![is_MacOSX]} {
3307 .mbar.repository add command \
3308 -label {Visualize All Branches} \
3309 -command {do_gitk {--all}} \
3310 -font font_ui
3311}
3312.mbar.repository add separator
3313if {!$single_commit} {
3315 .mbar.repository add command -label {Compress Database} \
3316 -command do_gc \
3317 -font font_ui
3318 .mbar.repository add command -label {Verify Database} \
3320 -command do_fsck_objects \
3321 -font font_ui
3322 .mbar.repository add separator
3324 if {[is_Windows]} {
3326 .mbar.repository add command \
3327 -label {Create Desktop Icon} \
3328 -command do_windows_shortcut \
3329 -font font_ui
3330 } elseif {[is_MacOSX]} {
3331 .mbar.repository add command \
3332 -label {Create Desktop Icon} \
3333 -command do_macosx_app \
3334 -font font_ui
3335 }
3336}
3337.mbar.repository add command -label Quit \
3339 -command do_quit \
3340 -accelerator $M1T-Q \
3341 -font font_ui
3342# -- Edit Menu
3344#
3345menu .mbar.edit
3346.mbar.edit add command -label Undo \
3347 -command {catch {[focus] edit undo}} \
3348 -accelerator $M1T-Z \
3349 -font font_ui
3350.mbar.edit add command -label Redo \
3351 -command {catch {[focus] edit redo}} \
3352 -accelerator $M1T-Y \
3353 -font font_ui
3354.mbar.edit add separator
3355.mbar.edit add command -label Cut \
3356 -command {catch {tk_textCut [focus]}} \
3357 -accelerator $M1T-X \
3358 -font font_ui
3359.mbar.edit add command -label Copy \
3360 -command {catch {tk_textCopy [focus]}} \
3361 -accelerator $M1T-C \
3362 -font font_ui
3363.mbar.edit add command -label Paste \
3364 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3365 -accelerator $M1T-V \
3366 -font font_ui
3367.mbar.edit add command -label Delete \
3368 -command {catch {[focus] delete sel.first sel.last}} \
3369 -accelerator Del \
3370 -font font_ui
3371.mbar.edit add separator
3372.mbar.edit add command -label {Select All} \
3373 -command {catch {[focus] tag add sel 0.0 end}} \
3374 -accelerator $M1T-A \
3375 -font font_ui
3376# -- Branch Menu
3378#
3379if {!$single_commit} {
3380 menu .mbar.branch
3381 .mbar.branch add command -label {Create...} \
3383 -command do_create_branch \
3384 -accelerator $M1T-N \
3385 -font font_ui
3386 lappend disable_on_lock [list .mbar.branch entryconf \
3387 [.mbar.branch index last] -state]
3388 .mbar.branch add command -label {Delete...} \
3390 -command do_delete_branch \
3391 -font font_ui
3392 lappend disable_on_lock [list .mbar.branch entryconf \
3393 [.mbar.branch index last] -state]
3394}
3395# -- Commit Menu
3397#
3398menu .mbar.commit
3399.mbar.commit add radiobutton \
3401 -label {New Commit} \
3402 -command do_select_commit_type \
3403 -variable selected_commit_type \
3404 -value new \
3405 -font font_ui
3406lappend disable_on_lock \
3407 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3408.mbar.commit add radiobutton \
3410 -label {Amend Last Commit} \
3411 -command do_select_commit_type \
3412 -variable selected_commit_type \
3413 -value amend \
3414 -font font_ui
3415lappend disable_on_lock \
3416 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3417.mbar.commit add separator
3419.mbar.commit add command -label Rescan \
3421 -command do_rescan \
3422 -accelerator F5 \
3423 -font font_ui
3424lappend disable_on_lock \
3425 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3426.mbar.commit add command -label {Add To Commit} \
3428 -command do_add_selection \
3429 -font font_ui
3430lappend disable_on_lock \
3431 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3432.mbar.commit add command -label {Add All To Commit} \
3434 -command do_add_all \
3435 -accelerator $M1T-I \
3436 -font font_ui
3437lappend disable_on_lock \
3438 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3439.mbar.commit add command -label {Unstage From Commit} \
3441 -command do_unstage_selection \
3442 -font font_ui
3443lappend disable_on_lock \
3444 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3445.mbar.commit add command -label {Revert Changes} \
3447 -command do_revert_selection \
3448 -font font_ui
3449lappend disable_on_lock \
3450 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3451.mbar.commit add separator
3453.mbar.commit add command -label {Sign Off} \
3455 -command do_signoff \
3456 -accelerator $M1T-S \
3457 -font font_ui
3458.mbar.commit add command -label Commit \
3460 -command do_commit \
3461 -accelerator $M1T-Return \
3462 -font font_ui
3463lappend disable_on_lock \
3464 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3465# -- Transport menus
3467#
3468if {!$single_commit} {
3469 menu .mbar.fetch
3470 menu .mbar.pull
3471 menu .mbar.push
3472}
3473if {[is_MacOSX]} {
3475 # -- Apple Menu (Mac OS X only)
3476 #
3477 .mbar add cascade -label Apple -menu .mbar.apple
3478 menu .mbar.apple
3479 .mbar.apple add command -label "About [appname]" \
3481 -command do_about \
3482 -font font_ui
3483 .mbar.apple add command -label "[appname] Options..." \
3484 -command do_options \
3485 -font font_ui
3486} else {
3487 # -- Edit Menu
3488 #
3489 .mbar.edit add separator
3490 .mbar.edit add command -label {Options...} \
3491 -command do_options \
3492 -font font_ui
3493 # -- Tools Menu
3495 #
3496 if {[file exists /usr/local/miga/lib/gui-miga]
3497 && [file exists .pvcsrc]} {
3498 proc do_miga {} {
3499 global ui_status_value
3500 if {![lock_index update]} return
3501 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3502 set miga_fd [open "|$cmd" r]
3503 fconfigure $miga_fd -blocking 0
3504 fileevent $miga_fd readable [list miga_done $miga_fd]
3505 set ui_status_value {Running miga...}
3506 }
3507 proc miga_done {fd} {
3508 read $fd 512
3509 if {[eof $fd]} {
3510 close $fd
3511 unlock_index
3512 rescan [list set ui_status_value {Ready.}]
3513 }
3514 }
3515 .mbar add cascade -label Tools -menu .mbar.tools
3516 menu .mbar.tools
3517 .mbar.tools add command -label "Migrate" \
3518 -command do_miga \
3519 -font font_ui
3520 lappend disable_on_lock \
3521 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3522 }
3523 # -- Help Menu
3525 #
3526 .mbar add cascade -label Help -menu .mbar.help
3527 menu .mbar.help
3528 .mbar.help add command -label "About [appname]" \
3530 -command do_about \
3531 -font font_ui
3532}
3533# -- Branch Control
3536#
3537frame .branch \
3538 -borderwidth 1 \
3539 -relief sunken
3540label .branch.l1 \
3541 -text {Current Branch:} \
3542 -anchor w \
3543 -justify left \
3544 -font font_ui
3545label .branch.cb \
3546 -textvariable current_branch \
3547 -anchor w \
3548 -justify left \
3549 -font font_ui
3550pack .branch.l1 -side left
3551pack .branch.cb -side left -fill x
3552pack .branch -side top -fill x
3553# -- Main Window Layout
3555#
3556panedwindow .vpane -orient vertical
3557panedwindow .vpane.files -orient horizontal
3558.vpane add .vpane.files -sticky nsew -height 100 -width 400
3559pack .vpane -anchor n -side top -fill both -expand 1
3560# -- Index File List
3562#
3563frame .vpane.files.index -height 100 -width 400
3564label .vpane.files.index.title -text {Changes To Be Committed} \
3565 -background green \
3566 -font font_ui
3567text $ui_index -background white -borderwidth 0 \
3568 -width 40 -height 10 \
3569 -font font_ui \
3570 -cursor $cursor_ptr \
3571 -yscrollcommand {.vpane.files.index.sb set} \
3572 -state disabled
3573scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3574pack .vpane.files.index.title -side top -fill x
3575pack .vpane.files.index.sb -side right -fill y
3576pack $ui_index -side left -fill both -expand 1
3577.vpane.files add .vpane.files.index -sticky nsew
3578# -- Working Directory File List
3580#
3581frame .vpane.files.workdir -height 100 -width 100
3582label .vpane.files.workdir.title -text {Changed But Not Updated} \
3583 -background red \
3584 -font font_ui
3585text $ui_workdir -background white -borderwidth 0 \
3586 -width 40 -height 10 \
3587 -font font_ui \
3588 -cursor $cursor_ptr \
3589 -yscrollcommand {.vpane.files.workdir.sb set} \
3590 -state disabled
3591scrollbar .vpane.files.workdir.sb -command [list $ui_workdir yview]
3592pack .vpane.files.workdir.title -side top -fill x
3593pack .vpane.files.workdir.sb -side right -fill y
3594pack $ui_workdir -side left -fill both -expand 1
3595.vpane.files add .vpane.files.workdir -sticky nsew
3596foreach i [list $ui_index $ui_workdir] {
3598 $i tag conf in_diff -font font_uibold
3599 $i tag conf in_sel \
3600 -background [$i cget -foreground] \
3601 -foreground [$i cget -background]
3602}
3603unset i
3604# -- Diff and Commit Area
3606#
3607frame .vpane.lower -height 300 -width 400
3608frame .vpane.lower.commarea
3609frame .vpane.lower.diff -relief sunken -borderwidth 1
3610pack .vpane.lower.commarea -side top -fill x
3611pack .vpane.lower.diff -side bottom -fill both -expand 1
3612.vpane add .vpane.lower -stick nsew
3613# -- Commit Area Buttons
3615#
3616frame .vpane.lower.commarea.buttons
3617label .vpane.lower.commarea.buttons.l -text {} \
3618 -anchor w \
3619 -justify left \
3620 -font font_ui
3621pack .vpane.lower.commarea.buttons.l -side top -fill x
3622pack .vpane.lower.commarea.buttons -side left -fill y
3623button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3625 -command do_rescan \
3626 -font font_ui
3627pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3628lappend disable_on_lock \
3629 {.vpane.lower.commarea.buttons.rescan conf -state}
3630button .vpane.lower.commarea.buttons.incall -text {Add All} \
3632 -command do_add_all \
3633 -font font_ui
3634pack .vpane.lower.commarea.buttons.incall -side top -fill x
3635lappend disable_on_lock \
3636 {.vpane.lower.commarea.buttons.incall conf -state}
3637button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3639 -command do_signoff \
3640 -font font_ui
3641pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3642button .vpane.lower.commarea.buttons.commit -text {Commit} \
3644 -command do_commit \
3645 -font font_ui
3646pack .vpane.lower.commarea.buttons.commit -side top -fill x
3647lappend disable_on_lock \
3648 {.vpane.lower.commarea.buttons.commit conf -state}
3649# -- Commit Message Buffer
3651#
3652frame .vpane.lower.commarea.buffer
3653frame .vpane.lower.commarea.buffer.header
3654set ui_comm .vpane.lower.commarea.buffer.t
3655set ui_coml .vpane.lower.commarea.buffer.header.l
3656radiobutton .vpane.lower.commarea.buffer.header.new \
3657 -text {New Commit} \
3658 -command do_select_commit_type \
3659 -variable selected_commit_type \
3660 -value new \
3661 -font font_ui
3662lappend disable_on_lock \
3663 [list .vpane.lower.commarea.buffer.header.new conf -state]
3664radiobutton .vpane.lower.commarea.buffer.header.amend \
3665 -text {Amend Last Commit} \
3666 -command do_select_commit_type \
3667 -variable selected_commit_type \
3668 -value amend \
3669 -font font_ui
3670lappend disable_on_lock \
3671 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3672label $ui_coml \
3673 -anchor w \
3674 -justify left \
3675 -font font_ui
3676proc trace_commit_type {varname args} {
3677 global ui_coml commit_type
3678 switch -glob -- $commit_type {
3679 initial {set txt {Initial Commit Message:}}
3680 amend {set txt {Amended Commit Message:}}
3681 amend-initial {set txt {Amended Initial Commit Message:}}
3682 amend-merge {set txt {Amended Merge Commit Message:}}
3683 merge {set txt {Merge Commit Message:}}
3684 * {set txt {Commit Message:}}
3685 }
3686 $ui_coml conf -text $txt
3687}
3688trace add variable commit_type write trace_commit_type
3689pack $ui_coml -side left -fill x
3690pack .vpane.lower.commarea.buffer.header.amend -side right
3691pack .vpane.lower.commarea.buffer.header.new -side right
3692text $ui_comm -background white -borderwidth 1 \
3694 -undo true \
3695 -maxundo 20 \
3696 -autoseparators true \
3697 -relief sunken \
3698 -width 75 -height 9 -wrap none \
3699 -font font_diff \
3700 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3701scrollbar .vpane.lower.commarea.buffer.sby \
3702 -command [list $ui_comm yview]
3703pack .vpane.lower.commarea.buffer.header -side top -fill x
3704pack .vpane.lower.commarea.buffer.sby -side right -fill y
3705pack $ui_comm -side left -fill y
3706pack .vpane.lower.commarea.buffer -side left -fill y
3707# -- Commit Message Buffer Context Menu
3709#
3710set ctxm .vpane.lower.commarea.buffer.ctxm
3711menu $ctxm -tearoff 0
3712$ctxm add command \
3713 -label {Cut} \
3714 -font font_ui \
3715 -command {tk_textCut $ui_comm}
3716$ctxm add command \
3717 -label {Copy} \
3718 -font font_ui \
3719 -command {tk_textCopy $ui_comm}
3720$ctxm add command \
3721 -label {Paste} \
3722 -font font_ui \
3723 -command {tk_textPaste $ui_comm}
3724$ctxm add command \
3725 -label {Delete} \
3726 -font font_ui \
3727 -command {$ui_comm delete sel.first sel.last}
3728$ctxm add separator
3729$ctxm add command \
3730 -label {Select All} \
3731 -font font_ui \
3732 -command {$ui_comm tag add sel 0.0 end}
3733$ctxm add command \
3734 -label {Copy All} \
3735 -font font_ui \
3736 -command {
3737 $ui_comm tag add sel 0.0 end
3738 tk_textCopy $ui_comm
3739 $ui_comm tag remove sel 0.0 end
3740 }
3741$ctxm add separator
3742$ctxm add command \
3743 -label {Sign Off} \
3744 -font font_ui \
3745 -command do_signoff
3746bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3747# -- Diff Header
3749#
3750set current_diff_path {}
3751set diff_actions [list]
3752proc trace_current_diff_path {varname args} {
3753 global current_diff_path diff_actions file_states
3754 if {$current_diff_path eq {}} {
3755 set s {}
3756 set f {}
3757 set p {}
3758 set o disabled
3759 } else {
3760 set p $current_diff_path
3761 set s [mapdesc [lindex $file_states($p) 0] $p]
3762 set f {File:}
3763 set p [escape_path $p]
3764 set o normal
3765 }
3766 .vpane.lower.diff.header.status configure -text $s
3768 .vpane.lower.diff.header.file configure -text $f
3769 .vpane.lower.diff.header.path configure -text $p
3770 foreach w $diff_actions {
3771 uplevel #0 $w $o
3772 }
3773}
3774trace add variable current_diff_path write trace_current_diff_path
3775frame .vpane.lower.diff.header -background orange
3777label .vpane.lower.diff.header.status \
3778 -background orange \
3779 -width $max_status_desc \
3780 -anchor w \
3781 -justify left \
3782 -font font_ui
3783label .vpane.lower.diff.header.file \
3784 -background orange \
3785 -anchor w \
3786 -justify left \
3787 -font font_ui
3788label .vpane.lower.diff.header.path \
3789 -background orange \
3790 -anchor w \
3791 -justify left \
3792 -font font_ui
3793pack .vpane.lower.diff.header.status -side left
3794pack .vpane.lower.diff.header.file -side left
3795pack .vpane.lower.diff.header.path -fill x
3796set ctxm .vpane.lower.diff.header.ctxm
3797menu $ctxm -tearoff 0
3798$ctxm add command \
3799 -label {Copy} \
3800 -font font_ui \
3801 -command {
3802 clipboard clear
3803 clipboard append \
3804 -format STRING \
3805 -type STRING \
3806 -- $current_diff_path
3807 }
3808lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3809bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3810# -- Diff Body
3812#
3813frame .vpane.lower.diff.body
3814set ui_diff .vpane.lower.diff.body.t
3815text $ui_diff -background white -borderwidth 0 \
3816 -width 80 -height 15 -wrap none \
3817 -font font_diff \
3818 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3819 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3820 -state disabled
3821scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3822 -command [list $ui_diff xview]
3823scrollbar .vpane.lower.diff.body.sby -orient vertical \
3824 -command [list $ui_diff yview]
3825pack .vpane.lower.diff.body.sbx -side bottom -fill x
3826pack .vpane.lower.diff.body.sby -side right -fill y
3827pack $ui_diff -side left -fill both -expand 1
3828pack .vpane.lower.diff.header -side top -fill x
3829pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3830$ui_diff tag conf d_@ -font font_diffbold
3832$ui_diff tag conf d_+ -foreground blue
3833$ui_diff tag conf d_- -foreground red
3834$ui_diff tag conf d_++ -foreground {#00a000}
3835$ui_diff tag conf d_-- -foreground {#a000a0}
3836$ui_diff tag conf d_+- \
3837 -foreground red \
3838 -background {light goldenrod yellow}
3839$ui_diff tag conf d_-+ \
3840 -foreground blue \
3841 -background azure2
3842# -- Diff Body Context Menu
3844#
3845set ctxm .vpane.lower.diff.body.ctxm
3846menu $ctxm -tearoff 0
3847$ctxm add command \
3848 -label {Copy} \
3849 -font font_ui \
3850 -command {tk_textCopy $ui_diff}
3851lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3852$ctxm add command \
3853 -label {Select All} \
3854 -font font_ui \
3855 -command {$ui_diff tag add sel 0.0 end}
3856lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3857$ctxm add command \
3858 -label {Copy All} \
3859 -font font_ui \
3860 -command {
3861 $ui_diff tag add sel 0.0 end
3862 tk_textCopy $ui_diff
3863 $ui_diff tag remove sel 0.0 end
3864 }
3865lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3866$ctxm add separator
3867$ctxm add command \
3868 -label {Decrease Font Size} \
3869 -font font_ui \
3870 -command {incr_font_size font_diff -1}
3871lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3872$ctxm add command \
3873 -label {Increase Font Size} \
3874 -font font_ui \
3875 -command {incr_font_size font_diff 1}
3876lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3877$ctxm add separator
3878$ctxm add command \
3879 -label {Show Less Context} \
3880 -font font_ui \
3881 -command {if {$repo_config(gui.diffcontext) >= 2} {
3882 incr repo_config(gui.diffcontext) -1
3883 reshow_diff
3884 }}
3885lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3886$ctxm add command \
3887 -label {Show More Context} \
3888 -font font_ui \
3889 -command {
3890 incr repo_config(gui.diffcontext)
3891 reshow_diff
3892 }
3893lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3894$ctxm add separator
3895$ctxm add command -label {Options...} \
3896 -font font_ui \
3897 -command do_options
3898bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3899# -- Status Bar
3901#
3902set ui_status_value {Initializing...}
3903label .status -textvariable ui_status_value \
3904 -anchor w \
3905 -justify left \
3906 -borderwidth 1 \
3907 -relief sunken \
3908 -font font_ui
3909pack .status -anchor w -side bottom -fill x
3910# -- Load geometry
3912#
3913catch {
3914set gm $repo_config(gui.geometry)
3915wm geometry . [lindex $gm 0]
3916.vpane sash place 0 \
3917 [lindex [.vpane sash coord 0] 0] \
3918 [lindex $gm 1]
3919.vpane.files sash place 0 \
3920 [lindex $gm 2] \
3921 [lindex [.vpane.files sash coord 0] 1]
3922unset gm
3923}
3924# -- Key Bindings
3926#
3927bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3928bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3929bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3930bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3931bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3932bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3933bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3934bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3935bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3936bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3937bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3938bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3940bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3941bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3942bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3943bind $ui_diff <$M1B-Key-v> {break}
3944bind $ui_diff <$M1B-Key-V> {break}
3945bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3946bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3947bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3948bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3949bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3950bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3951if {!$single_commit} {
3953 bind . <$M1B-Key-n> do_create_branch
3954 bind . <$M1B-Key-N> do_create_branch
3955}
3956bind . <Destroy> do_quit
3958bind all <Key-F5> do_rescan
3959bind all <$M1B-Key-r> do_rescan
3960bind all <$M1B-Key-R> do_rescan
3961bind . <$M1B-Key-s> do_signoff
3962bind . <$M1B-Key-S> do_signoff
3963bind . <$M1B-Key-i> do_add_all
3964bind . <$M1B-Key-I> do_add_all
3965bind . <$M1B-Key-Return> do_commit
3966bind all <$M1B-Key-q> do_quit
3967bind all <$M1B-Key-Q> do_quit
3968bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3969bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3970foreach i [list $ui_index $ui_workdir] {
3971 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3972 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3973 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3974}
3975unset i
3976set file_lists($ui_index) [list]
3978set file_lists($ui_workdir) [list]
3979set HEAD {}
3981set PARENT {}
3982set MERGE_HEAD [list]
3983set commit_type {}
3984set empty_tree {}
3985set current_branch {}
3986set current_diff_path {}
3987set selected_commit_type new
3988wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
3990focus -force $ui_comm
3991# -- Warn the user about environmental problems. Cygwin's Tcl
3993# does *not* pass its env array onto any processes it spawns.
3994# This means that git processes get none of our environment.
3995#
3996if {[is_Windows]} {
3997 set ignored_env 0
3998 set suggest_user {}
3999 set msg "Possible environment issues exist.
4000The following environment variables are probably
4002going to be ignored by any Git subprocess run
4003by [appname]:
4004"
4006 foreach name [array names env] {
4007 switch -regexp -- $name {
4008 {^GIT_INDEX_FILE$} -
4009 {^GIT_OBJECT_DIRECTORY$} -
4010 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4011 {^GIT_DIFF_OPTS$} -
4012 {^GIT_EXTERNAL_DIFF$} -
4013 {^GIT_PAGER$} -
4014 {^GIT_TRACE$} -
4015 {^GIT_CONFIG$} -
4016 {^GIT_CONFIG_LOCAL$} -
4017 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4018 append msg " - $name\n"
4019 incr ignored_env
4020 }
4021 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4022 append msg " - $name\n"
4023 incr ignored_env
4024 set suggest_user $name
4025 }
4026 }
4027 }
4028 if {$ignored_env > 0} {
4029 append msg "
4030This is due to a known issue with the
4031Tcl binary distributed by Cygwin."
4032 if {$suggest_user ne {}} {
4034 append msg "
4035A good replacement for $suggest_user
4037is placing values for the user.name and
4038user.email settings into your personal
4039~/.gitconfig file.
4040"
4041 }
4042 warn_popup $msg
4043 }
4044 unset ignored_env msg suggest_user name
4045}
4046# -- Only initialize complex UI if we are going to stay running.
4048#
4049if {!$single_commit} {
4050 load_all_remotes
4051 load_all_heads
4052 populate_branch_menu
4054 populate_fetch_menu .mbar.fetch
4055 populate_pull_menu .mbar.pull
4056 populate_push_menu .mbar.push
4057}
4058# -- Only suggest a gc run if we are going to stay running.
4060#
4061if {!$single_commit} {
4062 set object_limit 2000
4063 if {[is_Windows]} {set object_limit 200}
4064 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4065 if {$objects_current >= $object_limit} {
4066 if {[ask_popup \
4067 "This repository currently has $objects_current loose objects.
4068To maintain optimal performance it is strongly
4070recommended that you compress the database
4071when more than $object_limit loose objects exist.
4072Compress the database now?"] eq yes} {
4074 do_gc
4075 }
4076 }
4077 unset object_limit _junk objects_current
4078}
4079lock_index begin-read
4081after 1 do_rescan