54cc5faad2af6900f4bae060b572d6f57ee277af
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4set copyright {
6Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
7This program is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation; either version 2 of the License, or
11(at your option) any later version.
12This program is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17You should have received a copy of the GNU General Public License
19along with this program; if not, write to the Free Software
20Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
21set appvers {@@GIT_VERSION@@}
23set appname [lindex [file split $argv0] end]
24set gitdir {}
25######################################################################
27##
28## config
29proc is_many_config {name} {
31 switch -glob -- $name {
32 remote.*.fetch -
33 remote.*.push
34 {return 1}
35 *
36 {return 0}
37 }
38}
39proc load_config {include_global} {
41 global repo_config global_config default_config
42 array unset global_config
44 if {$include_global} {
45 catch {
46 set fd_rc [open "| git repo-config --global --list" r]
47 while {[gets $fd_rc line] >= 0} {
48 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
49 if {[is_many_config $name]} {
50 lappend global_config($name) $value
51 } else {
52 set global_config($name) $value
53 }
54 }
55 }
56 close $fd_rc
57 }
58 }
59 array unset repo_config
61 catch {
62 set fd_rc [open "| git repo-config --list" r]
63 while {[gets $fd_rc line] >= 0} {
64 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
65 if {[is_many_config $name]} {
66 lappend repo_config($name) $value
67 } else {
68 set repo_config($name) $value
69 }
70 }
71 }
72 close $fd_rc
73 }
74 foreach name [array names default_config] {
76 if {[catch {set v $global_config($name)}]} {
77 set global_config($name) $default_config($name)
78 }
79 if {[catch {set v $repo_config($name)}]} {
80 set repo_config($name) $default_config($name)
81 }
82 }
83}
84proc save_config {} {
86 global default_config font_descs
87 global repo_config global_config
88 global repo_config_new global_config_new
89 foreach option $font_descs {
91 set name [lindex $option 0]
92 set font [lindex $option 1]
93 font configure $font \
94 -family $global_config_new(gui.$font^^family) \
95 -size $global_config_new(gui.$font^^size)
96 font configure ${font}bold \
97 -family $global_config_new(gui.$font^^family) \
98 -size $global_config_new(gui.$font^^size)
99 set global_config_new(gui.$name) [font configure $font]
100 unset global_config_new(gui.$font^^family)
101 unset global_config_new(gui.$font^^size)
102 }
103 foreach name [array names default_config] {
105 set value $global_config_new($name)
106 if {$value ne $global_config($name)} {
107 if {$value eq $default_config($name)} {
108 catch {exec git repo-config --global --unset $name}
109 } else {
110 regsub -all "\[{}\]" $value {"} value
111 exec git repo-config --global $name $value
112 }
113 set global_config($name) $value
114 if {$value eq $repo_config($name)} {
115 catch {exec git repo-config --unset $name}
116 set repo_config($name) $value
117 }
118 }
119 }
120 foreach name [array names default_config] {
122 set value $repo_config_new($name)
123 if {$value ne $repo_config($name)} {
124 if {$value eq $global_config($name)} {
125 catch {exec git repo-config --unset $name}
126 } else {
127 regsub -all "\[{}\]" $value {"} value
128 exec git repo-config $name $value
129 }
130 set repo_config($name) $value
131 }
132 }
133}
134proc error_popup {msg} {
136 global gitdir appname
137 set title $appname
139 if {$gitdir ne {}} {
140 append title { (}
141 append title [lindex \
142 [file split [file normalize [file dirname $gitdir]]] \
143 end]
144 append title {)}
145 }
146 set cmd [list tk_messageBox \
147 -icon error \
148 -type ok \
149 -title "$title: error" \
150 -message $msg]
151 if {[winfo ismapped .]} {
152 lappend cmd -parent .
153 }
154 eval $cmd
155}
156proc warn_popup {msg} {
158 global gitdir appname
159 set title $appname
161 if {$gitdir ne {}} {
162 append title { (}
163 append title [lindex \
164 [file split [file normalize [file dirname $gitdir]]] \
165 end]
166 append title {)}
167 }
168 set cmd [list tk_messageBox \
169 -icon warning \
170 -type ok \
171 -title "$title: warning" \
172 -message $msg]
173 if {[winfo ismapped .]} {
174 lappend cmd -parent .
175 }
176 eval $cmd
177}
178proc info_popup {msg} {
180 global gitdir appname
181 set title $appname
183 if {$gitdir ne {}} {
184 append title { (}
185 append title [lindex \
186 [file split [file normalize [file dirname $gitdir]]] \
187 end]
188 append title {)}
189 }
190 tk_messageBox \
191 -parent . \
192 -icon info \
193 -type ok \
194 -title $title \
195 -message $msg
196}
197proc ask_popup {msg} {
199 global gitdir appname
200 set title $appname
202 if {$gitdir ne {}} {
203 append title { (}
204 append title [lindex \
205 [file split [file normalize [file dirname $gitdir]]] \
206 end]
207 append title {)}
208 }
209 return [tk_messageBox \
210 -parent . \
211 -icon question \
212 -type yesno \
213 -title $title \
214 -message $msg]
215}
216######################################################################
218##
219## repository setup
220if { [catch {set gitdir $env(GIT_DIR)}]
222 && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
223 catch {wm withdraw .}
224 error_popup "Cannot find the git directory:\n\n$err"
225 exit 1
226}
227if {![file isdirectory $gitdir]} {
228 catch {wm withdraw .}
229 error_popup "Git directory not found:\n\n$gitdir"
230 exit 1
231}
232if {[lindex [file split $gitdir] end] ne {.git}} {
233 catch {wm withdraw .}
234 error_popup "Cannot use funny .git directory:\n\n$gitdir"
235 exit 1
236}
237if {[catch {cd [file dirname $gitdir]} err]} {
238 catch {wm withdraw .}
239 error_popup "No working directory [file dirname $gitdir]:\n\n$err"
240 exit 1
241}
242set reponame [lindex [file split \
243 [file normalize [file dirname $gitdir]]] \
244 end]
245set single_commit 0
247if {$appname eq {git-citool}} {
248 set single_commit 1
249}
250######################################################################
252##
253## task management
254set rescan_active 0
256set diff_active 0
257set last_clicked {}
258set disable_on_lock [list]
260set index_lock_type none
261proc lock_index {type} {
263 global index_lock_type disable_on_lock
264 if {$index_lock_type eq {none}} {
266 set index_lock_type $type
267 foreach w $disable_on_lock {
268 uplevel #0 $w disabled
269 }
270 return 1
271 } elseif {$index_lock_type eq "begin-$type"} {
272 set index_lock_type $type
273 return 1
274 }
275 return 0
276}
277proc unlock_index {} {
279 global index_lock_type disable_on_lock
280 set index_lock_type none
282 foreach w $disable_on_lock {
283 uplevel #0 $w normal
284 }
285}
286######################################################################
288##
289## status
290proc repository_state {ctvar hdvar mhvar} {
292 global gitdir current_branch
293 upvar $ctvar ct $hdvar hd $mhvar mh
294 set mh [list]
296 if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
298 set current_branch {}
299 } else {
300 regsub ^refs/((heads|tags|remotes)/)? \
301 $current_branch \
302 {} \
303 current_branch
304 }
305 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
307 set hd {}
308 set ct initial
309 return
310 }
311 set merge_head [file join $gitdir MERGE_HEAD]
313 if {[file exists $merge_head]} {
314 set ct merge
315 set fd_mh [open $merge_head r]
316 while {[gets $fd_mh line] >= 0} {
317 lappend mh $line
318 }
319 close $fd_mh
320 return
321 }
322 set ct normal
324}
325proc PARENT {} {
327 global PARENT empty_tree
328 set p [lindex $PARENT 0]
330 if {$p ne {}} {
331 return $p
332 }
333 if {$empty_tree eq {}} {
334 set empty_tree [exec git mktree << {}]
335 }
336 return $empty_tree
337}
338proc rescan {after} {
340 global HEAD PARENT MERGE_HEAD commit_type
341 global ui_index ui_other ui_status_value ui_comm
342 global rescan_active file_states
343 global repo_config
344 if {$rescan_active > 0 || ![lock_index read]} return
346 repository_state newType newHEAD newMERGE_HEAD
348 if {[string match amend* $commit_type]
349 && $newType eq {normal}
350 && $newHEAD eq $HEAD} {
351 } else {
352 set HEAD $newHEAD
353 set PARENT $newHEAD
354 set MERGE_HEAD $newMERGE_HEAD
355 set commit_type $newType
356 }
357 array unset file_states
359 if {![$ui_comm edit modified]
361 || [string trim [$ui_comm get 0.0 end]] eq {}} {
362 if {[load_message GITGUI_MSG]} {
363 } elseif {[load_message MERGE_MSG]} {
364 } elseif {[load_message SQUASH_MSG]} {
365 }
366 $ui_comm edit reset
367 $ui_comm edit modified false
368 }
369 if {$repo_config(gui.trustmtime) eq {true}} {
371 rescan_stage2 {} $after
372 } else {
373 set rescan_active 1
374 set ui_status_value {Refreshing file status...}
375 set cmd [list git update-index]
376 lappend cmd -q
377 lappend cmd --unmerged
378 lappend cmd --ignore-missing
379 lappend cmd --refresh
380 set fd_rf [open "| $cmd" r]
381 fconfigure $fd_rf -blocking 0 -translation binary
382 fileevent $fd_rf readable \
383 [list rescan_stage2 $fd_rf $after]
384 }
385}
386proc rescan_stage2 {fd after} {
388 global gitdir ui_status_value
389 global rescan_active buf_rdi buf_rdf buf_rlo
390 if {$fd ne {}} {
392 read $fd
393 if {![eof $fd]} return
394 close $fd
395 }
396 set ls_others [list | git ls-files --others -z \
398 --exclude-per-directory=.gitignore]
399 set info_exclude [file join $gitdir info exclude]
400 if {[file readable $info_exclude]} {
401 lappend ls_others "--exclude-from=$info_exclude"
402 }
403 set buf_rdi {}
405 set buf_rdf {}
406 set buf_rlo {}
407 set rescan_active 3
409 set ui_status_value {Scanning for modified files ...}
410 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
411 set fd_df [open "| git diff-files -z" r]
412 set fd_lo [open $ls_others r]
413 fconfigure $fd_di -blocking 0 -translation binary
415 fconfigure $fd_df -blocking 0 -translation binary
416 fconfigure $fd_lo -blocking 0 -translation binary
417 fileevent $fd_di readable [list read_diff_index $fd_di $after]
418 fileevent $fd_df readable [list read_diff_files $fd_df $after]
419 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
420}
421proc load_message {file} {
423 global gitdir ui_comm
424 set f [file join $gitdir $file]
426 if {[file isfile $f]} {
427 if {[catch {set fd [open $f r]}]} {
428 return 0
429 }
430 set content [string trim [read $fd]]
431 close $fd
432 $ui_comm delete 0.0 end
433 $ui_comm insert end $content
434 return 1
435 }
436 return 0
437}
438proc read_diff_index {fd after} {
440 global buf_rdi
441 append buf_rdi [read $fd]
443 set c 0
444 set n [string length $buf_rdi]
445 while {$c < $n} {
446 set z1 [string first "\0" $buf_rdi $c]
447 if {$z1 == -1} break
448 incr z1
449 set z2 [string first "\0" $buf_rdi $z1]
450 if {$z2 == -1} break
451 incr c
453 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
454 merge_state \
455 [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
456 [lindex $i 4]? \
457 [list [lindex $i 0] [lindex $i 2]] \
458 [list]
459 set c $z2
460 incr c
461 }
462 if {$c < $n} {
463 set buf_rdi [string range $buf_rdi $c end]
464 } else {
465 set buf_rdi {}
466 }
467 rescan_done $fd buf_rdi $after
469}
470proc read_diff_files {fd after} {
472 global buf_rdf
473 append buf_rdf [read $fd]
475 set c 0
476 set n [string length $buf_rdf]
477 while {$c < $n} {
478 set z1 [string first "\0" $buf_rdf $c]
479 if {$z1 == -1} break
480 incr z1
481 set z2 [string first "\0" $buf_rdf $z1]
482 if {$z2 == -1} break
483 incr c
485 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
486 merge_state \
487 [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
488 ?[lindex $i 4] \
489 [list] \
490 [list [lindex $i 0] [lindex $i 2]]
491 set c $z2
492 incr c
493 }
494 if {$c < $n} {
495 set buf_rdf [string range $buf_rdf $c end]
496 } else {
497 set buf_rdf {}
498 }
499 rescan_done $fd buf_rdf $after
501}
502proc read_ls_others {fd after} {
504 global buf_rlo
505 append buf_rlo [read $fd]
507 set pck [split $buf_rlo "\0"]
508 set buf_rlo [lindex $pck end]
509 foreach p [lrange $pck 0 end-1] {
510 merge_state $p ?O
511 }
512 rescan_done $fd buf_rlo $after
513}
514proc rescan_done {fd buf after} {
516 global rescan_active
517 global file_states repo_config
518 upvar $buf to_clear
519 if {![eof $fd]} return
521 set to_clear {}
522 close $fd
523 if {[incr rescan_active -1] > 0} return
524 prune_selection
526 unlock_index
527 display_all_files
528 if {$repo_config(gui.partialinclude) ne {true}} {
530 set pathList [list]
531 foreach path [array names file_states] {
532 switch -- [lindex $file_states($path) 0] {
533 A? -
534 M? {lappend pathList $path}
535 }
536 }
537 if {$pathList ne {}} {
538 update_index \
539 "Updating included files" \
540 $pathList \
541 [concat {reshow_diff;} $after]
542 return
543 }
544 }
545 reshow_diff
547 uplevel #0 $after
548}
549proc prune_selection {} {
551 global file_states selected_paths
552 foreach path [array names selected_paths] {
554 if {[catch {set still_here $file_states($path)}]} {
555 unset selected_paths($path)
556 }
557 }
558}
559######################################################################
561##
562## diff
563proc clear_diff {} {
565 global ui_diff current_diff ui_index ui_other
566 $ui_diff conf -state normal
568 $ui_diff delete 0.0 end
569 $ui_diff conf -state disabled
570 set current_diff {}
572 $ui_index tag remove in_diff 0.0 end
574 $ui_other tag remove in_diff 0.0 end
575}
576proc reshow_diff {} {
578 global current_diff ui_status_value file_states
579 if {$current_diff eq {}
581 || [catch {set s $file_states($current_diff)}]} {
582 clear_diff
583 } else {
584 show_diff $current_diff
585 }
586}
587proc handle_empty_diff {} {
589 global current_diff file_states file_lists
590 set path $current_diff
592 set s $file_states($path)
593 if {[lindex $s 0] ne {_M}} return
594 info_popup "No differences detected.
596[short_path $path] has no changes.
598The modification date of this file was updated
600by another application and you currently have
601the Trust File Modification Timestamps option
602enabled, so Git did not automatically detect
603that there are no content differences in this
604file.
605This file will now be removed from the modified
607files list, to prevent possible confusion.
608"
609 if {[catch {exec git update-index -- $path} err]} {
610 error_popup "Failed to refresh index:\n\n$err"
611 }
612 clear_diff
614 set old_w [mapcol [lindex $file_states($path) 0] $path]
615 set lno [lsearch -sorted $file_lists($old_w) $path]
616 if {$lno >= 0} {
617 set file_lists($old_w) \
618 [lreplace $file_lists($old_w) $lno $lno]
619 incr lno
620 $old_w conf -state normal
621 $old_w delete $lno.0 [expr {$lno + 1}].0
622 $old_w conf -state disabled
623 }
624}
625proc show_diff {path {w {}} {lno {}}} {
627 global file_states file_lists
628 global is_3way_diff diff_active repo_config
629 global ui_diff current_diff ui_status_value
630 if {$diff_active || ![lock_index read]} return
632 clear_diff
634 if {$w eq {} || $lno == {}} {
635 foreach w [array names file_lists] {
636 set lno [lsearch -sorted $file_lists($w) $path]
637 if {$lno >= 0} {
638 incr lno
639 break
640 }
641 }
642 }
643 if {$w ne {} && $lno >= 1} {
644 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
645 }
646 set s $file_states($path)
648 set m [lindex $s 0]
649 set is_3way_diff 0
650 set diff_active 1
651 set current_diff $path
652 set ui_status_value "Loading diff of [escape_path $path]..."
653 set cmd [list | git diff-index]
655 lappend cmd --no-color
656 if {$repo_config(gui.diffcontext) > 0} {
657 lappend cmd "-U$repo_config(gui.diffcontext)"
658 }
659 lappend cmd -p
660 switch $m {
662 MM {
663 lappend cmd -c
664 }
665 _O {
666 if {[catch {
667 set fd [open $path r]
668 set content [read $fd]
669 close $fd
670 } err ]} {
671 set diff_active 0
672 unlock_index
673 set ui_status_value "Unable to display [escape_path $path]"
674 error_popup "Error loading file:\n\n$err"
675 return
676 }
677 $ui_diff conf -state normal
678 $ui_diff insert end $content
679 $ui_diff conf -state disabled
680 set diff_active 0
681 unlock_index
682 set ui_status_value {Ready.}
683 return
684 }
685 }
686 lappend cmd [PARENT]
688 lappend cmd --
689 lappend cmd $path
690 if {[catch {set fd [open $cmd r]} err]} {
692 set diff_active 0
693 unlock_index
694 set ui_status_value "Unable to display [escape_path $path]"
695 error_popup "Error loading diff:\n\n$err"
696 return
697 }
698 fconfigure $fd -blocking 0 -translation auto
700 fileevent $fd readable [list read_diff $fd]
701}
702proc read_diff {fd} {
704 global ui_diff ui_status_value is_3way_diff diff_active
705 global repo_config
706 $ui_diff conf -state normal
708 while {[gets $fd line] >= 0} {
709 # -- Cleanup uninteresting diff header lines.
710 #
711 if {[string match {diff --git *} $line]} continue
712 if {[string match {diff --combined *} $line]} continue
713 if {[string match {--- *} $line]} continue
714 if {[string match {+++ *} $line]} continue
715 if {$line eq {deleted file mode 120000}} {
716 set line "deleted symlink"
717 }
718 # -- Automatically detect if this is a 3 way diff.
720 #
721 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
722 # -- Reformat a 3 way diff, 'cause its too weird.
724 #
725 if {$is_3way_diff} {
726 set op [string range $line 0 1]
727 switch -- $op {
728 {@@} {set tags d_@}
729 {++} {set tags d_+ ; set op { +}}
730 {--} {set tags d_- ; set op { -}}
731 { +} {set tags d_++; set op {++}}
732 { -} {set tags d_--; set op {--}}
733 {+ } {set tags d_-+; set op {-+}}
734 {- } {set tags d_+-; set op {+-}}
735 default {set tags {}}
736 }
737 set line [string replace $line 0 1 $op]
738 } else {
739 switch -- [string index $line 0] {
740 @ {set tags d_@}
741 + {set tags d_+}
742 - {set tags d_-}
743 default {set tags {}}
744 }
745 }
746 $ui_diff insert end $line $tags
747 $ui_diff insert end "\n" $tags
748 }
749 $ui_diff conf -state disabled
750 if {[eof $fd]} {
752 close $fd
753 set diff_active 0
754 unlock_index
755 set ui_status_value {Ready.}
756 if {$repo_config(gui.trustmtime) eq {true}
758 && [$ui_diff index end] eq {2.0}} {
759 handle_empty_diff
760 }
761 }
762}
763######################################################################
765##
766## commit
767proc load_last_commit {} {
769 global HEAD PARENT MERGE_HEAD commit_type ui_comm
770 if {[llength $PARENT] == 0} {
772 error_popup {There is nothing to amend.
773You are about to create the initial commit.
775There is no commit before this to amend.
776}
777 return
778 }
779 repository_state curType curHEAD curMERGE_HEAD
781 if {$curType eq {merge}} {
782 error_popup {Cannot amend while merging.
783You are currently in the middle of a merge that
785has not been fully completed. You cannot amend
786the prior commit unless you first abort the
787current merge activity.
788}
789 return
790 }
791 set msg {}
793 set parents [list]
794 if {[catch {
795 set fd [open "| git cat-file commit $curHEAD" r]
796 while {[gets $fd line] > 0} {
797 if {[string match {parent *} $line]} {
798 lappend parents [string range $line 7 end]
799 }
800 }
801 set msg [string trim [read $fd]]
802 close $fd
803 } err]} {
804 error_popup "Error loading commit data for amend:\n\n$err"
805 return
806 }
807 set HEAD $curHEAD
809 set PARENT $parents
810 set MERGE_HEAD [list]
811 switch -- [llength $parents] {
812 0 {set commit_type amend-initial}
813 1 {set commit_type amend}
814 default {set commit_type amend-merge}
815 }
816 $ui_comm delete 0.0 end
818 $ui_comm insert end $msg
819 $ui_comm edit reset
820 $ui_comm edit modified false
821 rescan {set ui_status_value {Ready.}}
822}
823proc create_new_commit {} {
825 global commit_type ui_comm
826 set commit_type normal
828 $ui_comm delete 0.0 end
829 $ui_comm edit reset
830 $ui_comm edit modified false
831 rescan {set ui_status_value {Ready.}}
832}
833set GIT_COMMITTER_IDENT {}
835proc committer_ident {} {
837 global GIT_COMMITTER_IDENT
838 if {$GIT_COMMITTER_IDENT eq {}} {
840 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
841 error_popup "Unable to obtain your identity:\n\n$err"
842 return {}
843 }
844 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
845 $me me GIT_COMMITTER_IDENT]} {
846 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
847 return {}
848 }
849 }
850 return $GIT_COMMITTER_IDENT
852}
853proc commit_tree {} {
855 global HEAD commit_type file_states ui_comm repo_config
856 if {![lock_index update]} return
858 if {[committer_ident] eq {}} return
859 # -- Our in memory state should match the repository.
861 #
862 repository_state curType curHEAD curMERGE_HEAD
863 if {[string match amend* $commit_type]
864 && $curType eq {normal}
865 && $curHEAD eq $HEAD} {
866 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
867 info_popup {Last scanned state does not match repository state.
868Another Git program has modified this repository
870since the last scan. A rescan must be performed
871before another commit can be created.
872The rescan will be automatically started now.
874}
875 unlock_index
876 rescan {set ui_status_value {Ready.}}
877 return
878 }
879 # -- At least one file should differ in the index.
881 #
882 set files_ready 0
883 foreach path [array names file_states] {
884 switch -glob -- [lindex $file_states($path) 0] {
885 _? {continue}
886 A? -
887 D? -
888 M? {set files_ready 1; break}
889 U? {
890 error_popup "Unmerged files cannot be committed.
891File [short_path $path] has merge conflicts.
893You must resolve them and include the file before committing.
894"
895 unlock_index
896 return
897 }
898 default {
899 error_popup "Unknown file state [lindex $s 0] detected.
900File [short_path $path] cannot be committed by this program.
902"
903 }
904 }
905 }
906 if {!$files_ready} {
907 error_popup {No included files to commit.
908You must include at least 1 file before you can commit.
910}
911 unlock_index
912 return
913 }
914 # -- A message is required.
916 #
917 set msg [string trim [$ui_comm get 1.0 end]]
918 if {$msg eq {}} {
919 error_popup {Please supply a commit message.
920A good commit message has the following format:
922- First line: Describe in one sentance what you did.
924- Second line: Blank
925- Remaining lines: Describe why this change is good.
926}
927 unlock_index
928 return
929 }
930 # -- Update included files if partialincludes are off.
932 #
933 if {$repo_config(gui.partialinclude) ne {true}} {
934 set pathList [list]
935 foreach path [array names file_states] {
936 switch -glob -- [lindex $file_states($path) 0] {
937 A? -
938 M? {lappend pathList $path}
939 }
940 }
941 if {$pathList ne {}} {
942 unlock_index
943 update_index \
944 "Updating included files" \
945 $pathList \
946 [concat {lock_index update;} \
947 [list commit_prehook $curHEAD $msg]]
948 return
949 }
950 }
951 commit_prehook $curHEAD $msg
953}
954proc commit_prehook {curHEAD msg} {
956 global gitdir ui_status_value pch_error
957 set pchook [file join $gitdir hooks pre-commit]
959 # On Cygwin [file executable] might lie so we need to ask
961 # the shell if the hook is executable. Yes that's annoying.
962 #
963 if {[is_Windows] && [file isfile $pchook]} {
964 set pchook [list sh -c [concat \
965 "if test -x \"$pchook\";" \
966 "then exec \"$pchook\" 2>&1;" \
967 "fi"]]
968 } elseif {[file executable $pchook]} {
969 set pchook [list $pchook |& cat]
970 } else {
971 commit_writetree $curHEAD $msg
972 return
973 }
974 set ui_status_value {Calling pre-commit hook...}
976 set pch_error {}
977 set fd_ph [open "| $pchook" r]
978 fconfigure $fd_ph -blocking 0 -translation binary
979 fileevent $fd_ph readable \
980 [list commit_prehook_wait $fd_ph $curHEAD $msg]
981}
982proc commit_prehook_wait {fd_ph curHEAD msg} {
984 global pch_error ui_status_value
985 append pch_error [read $fd_ph]
987 fconfigure $fd_ph -blocking 1
988 if {[eof $fd_ph]} {
989 if {[catch {close $fd_ph}]} {
990 set ui_status_value {Commit declined by pre-commit hook.}
991 hook_failed_popup pre-commit $pch_error
992 unlock_index
993 } else {
994 commit_writetree $curHEAD $msg
995 }
996 set pch_error {}
997 return
998 }
999 fconfigure $fd_ph -blocking 0
1000}
1001proc commit_writetree {curHEAD msg} {
1003 global ui_status_value
1004 set ui_status_value {Committing changes...}
1006 set fd_wt [open "| git write-tree" r]
1007 fileevent $fd_wt readable \
1008 [list commit_committree $fd_wt $curHEAD $msg]
1009}
1010proc commit_committree {fd_wt curHEAD msg} {
1012 global HEAD PARENT MERGE_HEAD commit_type
1013 global single_commit gitdir
1014 global ui_status_value ui_comm selected_commit_type
1015 global file_states selected_paths rescan_active
1016 gets $fd_wt tree_id
1018 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1019 error_popup "write-tree failed:\n\n$err"
1020 set ui_status_value {Commit failed.}
1021 unlock_index
1022 return
1023 }
1024 # -- Create the commit.
1026 #
1027 set cmd [list git commit-tree $tree_id]
1028 set parents [concat $PARENT $MERGE_HEAD]
1029 if {[llength $parents] > 0} {
1030 foreach p $parents {
1031 lappend cmd -p $p
1032 }
1033 } else {
1034 # git commit-tree writes to stderr during initial commit.
1035 lappend cmd 2>/dev/null
1036 }
1037 lappend cmd << $msg
1038 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1039 error_popup "commit-tree failed:\n\n$err"
1040 set ui_status_value {Commit failed.}
1041 unlock_index
1042 return
1043 }
1044 # -- Update the HEAD ref.
1046 #
1047 set reflogm commit
1048 if {$commit_type ne {normal}} {
1049 append reflogm " ($commit_type)"
1050 }
1051 set i [string first "\n" $msg]
1052 if {$i >= 0} {
1053 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1054 } else {
1055 append reflogm {: } $msg
1056 }
1057 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1058 if {[catch {eval exec $cmd} err]} {
1059 error_popup "update-ref failed:\n\n$err"
1060 set ui_status_value {Commit failed.}
1061 unlock_index
1062 return
1063 }
1064 # -- Cleanup after ourselves.
1066 #
1067 catch {file delete [file join $gitdir MERGE_HEAD]}
1068 catch {file delete [file join $gitdir MERGE_MSG]}
1069 catch {file delete [file join $gitdir SQUASH_MSG]}
1070 catch {file delete [file join $gitdir GITGUI_MSG]}
1071 # -- Let rerere do its thing.
1073 #
1074 if {[file isdirectory [file join $gitdir rr-cache]]} {
1075 catch {exec git rerere}
1076 }
1077 # -- Run the post-commit hook.
1079 #
1080 set pchook [file join $gitdir hooks post-commit]
1081 if {[is_Windows] && [file isfile $pchook]} {
1082 set pchook [list sh -c [concat \
1083 "if test -x \"$pchook\";" \
1084 "then exec \"$pchook\";" \
1085 "fi"]]
1086 } elseif {![file executable $pchook]} {
1087 set pchook {}
1088 }
1089 if {$pchook ne {}} {
1090 catch {exec $pchook &}
1091 }
1092 $ui_comm delete 0.0 end
1094 $ui_comm edit reset
1095 $ui_comm edit modified false
1096 if {$single_commit} do_quit
1098 # -- Update in memory status
1100 #
1101 set selected_commit_type new
1102 set commit_type normal
1103 set HEAD $cmt_id
1104 set PARENT $cmt_id
1105 set MERGE_HEAD [list]
1106 foreach path [array names file_states] {
1108 set s $file_states($path)
1109 set m [lindex $s 0]
1110 switch -glob -- $m {
1111 _O -
1112 _M -
1113 _D {continue}
1114 __ -
1115 A_ -
1116 M_ -
1117 DD {
1118 unset file_states($path)
1119 catch {unset selected_paths($path)}
1120 }
1121 DO {
1122 set file_states($path) [list _O [lindex $s 1] {} {}]
1123 }
1124 AM -
1125 AD -
1126 MM -
1127 MD -
1128 DM {
1129 set file_states($path) [list \
1130 _[string index $m 1] \
1131 [lindex $s 1] \
1132 [lindex $s 3] \
1133 {}]
1134 }
1135 }
1136 }
1137 display_all_files
1139 unlock_index
1140 reshow_diff
1141 set ui_status_value \
1142 "Changes committed as [string range $cmt_id 0 7]."
1143}
1144######################################################################
1146##
1147## fetch pull push
1148proc fetch_from {remote} {
1150 set w [new_console "fetch $remote" \
1151 "Fetching new changes from $remote"]
1152 set cmd [list git fetch]
1153 lappend cmd $remote
1154 console_exec $w $cmd
1155}
1156proc pull_remote {remote branch} {
1158 global HEAD commit_type file_states repo_config
1159 if {![lock_index update]} return
1161 # -- Our in memory state should match the repository.
1163 #
1164 repository_state curType curHEAD curMERGE_HEAD
1165 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1166 info_popup {Last scanned state does not match repository state.
1167Another Git program has modified this repository
1169since the last scan. A rescan must be performed
1170before a pull operation can be started.
1171The rescan will be automatically started now.
1173}
1174 unlock_index
1175 rescan {set ui_status_value {Ready.}}
1176 return
1177 }
1178 # -- No differences should exist before a pull.
1180 #
1181 if {[array size file_states] != 0} {
1182 error_popup {Uncommitted but modified files are present.
1183You should not perform a pull with unmodified
1185files in your working directory as Git will be
1186unable to recover from an incorrect merge.
1187You should commit or revert all changes before
1189starting a pull operation.
1190}
1191 unlock_index
1192 return
1193 }
1194 set w [new_console "pull $remote $branch" \
1196 "Pulling new changes from branch $branch in $remote"]
1197 set cmd [list git pull]
1198 if {$repo_config(gui.pullsummary) eq {false}} {
1199 lappend cmd --no-summary
1200 }
1201 lappend cmd $remote
1202 lappend cmd $branch
1203 console_exec $w $cmd [list post_pull_remote $remote $branch]
1204}
1205proc post_pull_remote {remote branch success} {
1207 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1208 global ui_status_value
1209 unlock_index
1211 if {$success} {
1212 repository_state commit_type HEAD MERGE_HEAD
1213 set PARENT $HEAD
1214 set selected_commit_type new
1215 set ui_status_value "Pulling $branch from $remote complete."
1216 } else {
1217 rescan [list set ui_status_value \
1218 "Conflicts detected while pulling $branch from $remote."]
1219 }
1220}
1221proc push_to {remote} {
1223 set w [new_console "push $remote" \
1224 "Pushing changes to $remote"]
1225 set cmd [list git push]
1226 lappend cmd $remote
1227 console_exec $w $cmd
1228}
1229######################################################################
1231##
1232## ui helpers
1233proc mapcol {state path} {
1235 global all_cols ui_other
1236 if {[catch {set r $all_cols($state)}]} {
1238 puts "error: no column for state={$state} $path"
1239 return $ui_other
1240 }
1241 return $r
1242}
1243proc mapicon {state path} {
1245 global all_icons
1246 if {[catch {set r $all_icons($state)}]} {
1248 puts "error: no icon for state={$state} $path"
1249 return file_plain
1250 }
1251 return $r
1252}
1253proc mapdesc {state path} {
1255 global all_descs
1256 if {[catch {set r $all_descs($state)}]} {
1258 puts "error: no desc for state={$state} $path"
1259 return $state
1260 }
1261 return $r
1262}
1263proc escape_path {path} {
1265 regsub -all "\n" $path "\\n" path
1266 return $path
1267}
1268proc short_path {path} {
1270 return [escape_path [lindex [file split $path] end]]
1271}
1272set next_icon_id 0
1274set null_sha1 [string repeat 0 40]
1275proc merge_state {path new_state {head_info {}} {index_info {}}} {
1277 global file_states next_icon_id null_sha1
1278 set s0 [string index $new_state 0]
1280 set s1 [string index $new_state 1]
1281 if {[catch {set info $file_states($path)}]} {
1283 set state __
1284 set icon n[incr next_icon_id]
1285 } else {
1286 set state [lindex $info 0]
1287 set icon [lindex $info 1]
1288 if {$head_info eq {}} {set head_info [lindex $info 2]}
1289 if {$index_info eq {}} {set index_info [lindex $info 3]}
1290 }
1291 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1293 elseif {$s0 eq {_}} {set s0 _}
1294 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1296 elseif {$s1 eq {_}} {set s1 _}
1297 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1299 set head_info [list 0 $null_sha1]
1300 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1301 && $head_info eq {}} {
1302 set head_info $index_info
1303 }
1304 set file_states($path) [list $s0$s1 $icon \
1306 $head_info $index_info \
1307 ]
1308 return $state
1309}
1310proc display_file {path state} {
1312 global file_states file_lists selected_paths
1313 set old_m [merge_state $path $state]
1315 set s $file_states($path)
1316 set new_m [lindex $s 0]
1317 set new_w [mapcol $new_m $path]
1318 set old_w [mapcol $old_m $path]
1319 set new_icon [mapicon $new_m $path]
1320 if {$new_m eq {__}} {
1322 set lno [lsearch -sorted $file_lists($old_w) $path]
1323 if {$lno >= 0} {
1324 set file_lists($old_w) \
1325 [lreplace $file_lists($old_w) $lno $lno]
1326 incr lno
1327 $old_w conf -state normal
1328 $old_w delete $lno.0 [expr {$lno + 1}].0
1329 $old_w conf -state disabled
1330 }
1331 unset file_states($path)
1332 catch {unset selected_paths($path)}
1333 return
1334 }
1335 if {$new_w ne $old_w} {
1337 set lno [lsearch -sorted $file_lists($old_w) $path]
1338 if {$lno >= 0} {
1339 set file_lists($old_w) \
1340 [lreplace $file_lists($old_w) $lno $lno]
1341 incr lno
1342 $old_w conf -state normal
1343 $old_w delete $lno.0 [expr {$lno + 1}].0
1344 $old_w conf -state disabled
1345 }
1346 lappend file_lists($new_w) $path
1348 set file_lists($new_w) [lsort $file_lists($new_w)]
1349 set lno [lsearch -sorted $file_lists($new_w) $path]
1350 incr lno
1351 $new_w conf -state normal
1352 $new_w image create $lno.0 \
1353 -align center -padx 5 -pady 1 \
1354 -name [lindex $s 1] \
1355 -image $new_icon
1356 $new_w insert $lno.1 "[escape_path $path]\n"
1357 if {[catch {set in_sel $selected_paths($path)}]} {
1358 set in_sel 0
1359 }
1360 if {$in_sel} {
1361 $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1362 }
1363 $new_w conf -state disabled
1364 } elseif {$new_icon ne [mapicon $old_m $path]} {
1365 $new_w conf -state normal
1366 $new_w image conf [lindex $s 1] -image $new_icon
1367 $new_w conf -state disabled
1368 }
1369}
1370proc display_all_files {} {
1372 global ui_index ui_other
1373 global file_states file_lists
1374 global last_clicked selected_paths
1375 $ui_index conf -state normal
1377 $ui_other conf -state normal
1378 $ui_index delete 0.0 end
1380 $ui_other delete 0.0 end
1381 set last_clicked {}
1382 set file_lists($ui_index) [list]
1384 set file_lists($ui_other) [list]
1385 foreach path [lsort [array names file_states]] {
1387 set s $file_states($path)
1388 set m [lindex $s 0]
1389 set w [mapcol $m $path]
1390 lappend file_lists($w) $path
1391 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1392 $w image create end \
1393 -align center -padx 5 -pady 1 \
1394 -name [lindex $s 1] \
1395 -image [mapicon $m $path]
1396 $w insert end "[escape_path $path]\n"
1397 if {[catch {set in_sel $selected_paths($path)}]} {
1398 set in_sel 0
1399 }
1400 if {$in_sel} {
1401 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1402 }
1403 }
1404 $ui_index conf -state disabled
1406 $ui_other conf -state disabled
1407}
1408proc update_indexinfo {msg pathList after} {
1410 global update_index_cp ui_status_value
1411 if {![lock_index update]} return
1413 set update_index_cp 0
1415 set pathList [lsort $pathList]
1416 set totalCnt [llength $pathList]
1417 set batch [expr {int($totalCnt * .01) + 1}]
1418 if {$batch > 25} {set batch 25}
1419 set ui_status_value [format \
1421 "$msg... %i/%i files (%.2f%%)" \
1422 $update_index_cp \
1423 $totalCnt \
1424 0.0]
1425 set fd [open "| git update-index -z --index-info" w]
1426 fconfigure $fd \
1427 -blocking 0 \
1428 -buffering full \
1429 -buffersize 512 \
1430 -translation binary
1431 fileevent $fd writable [list \
1432 write_update_indexinfo \
1433 $fd \
1434 $pathList \
1435 $totalCnt \
1436 $batch \
1437 $msg \
1438 $after \
1439 ]
1440}
1441proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1443 global update_index_cp ui_status_value
1444 global file_states current_diff
1445 if {$update_index_cp >= $totalCnt} {
1447 close $fd
1448 unlock_index
1449 uplevel #0 $after
1450 return
1451 }
1452 for {set i $batch} \
1454 {$update_index_cp < $totalCnt && $i > 0} \
1455 {incr i -1} {
1456 set path [lindex $pathList $update_index_cp]
1457 incr update_index_cp
1458 set s $file_states($path)
1460 switch -glob -- [lindex $s 0] {
1461 A? {set new _O}
1462 M? {set new _M}
1463 D_ {set new _D}
1464 D? {set new _?}
1465 ?? {continue}
1466 }
1467 set info [lindex $s 2]
1468 if {$info eq {}} continue
1469 puts -nonewline $fd $info
1471 puts -nonewline $fd "\t"
1472 puts -nonewline $fd $path
1473 puts -nonewline $fd "\0"
1474 display_file $path $new
1475 }
1476 set ui_status_value [format \
1478 "$msg... %i/%i files (%.2f%%)" \
1479 $update_index_cp \
1480 $totalCnt \
1481 [expr {100.0 * $update_index_cp / $totalCnt}]]
1482}
1483proc update_index {msg pathList after} {
1485 global update_index_cp ui_status_value
1486 if {![lock_index update]} return
1488 set update_index_cp 0
1490 set pathList [lsort $pathList]
1491 set totalCnt [llength $pathList]
1492 set batch [expr {int($totalCnt * .01) + 1}]
1493 if {$batch > 25} {set batch 25}
1494 set ui_status_value [format \
1496 "$msg... %i/%i files (%.2f%%)" \
1497 $update_index_cp \
1498 $totalCnt \
1499 0.0]
1500 set fd [open "| git update-index --add --remove -z --stdin" w]
1501 fconfigure $fd \
1502 -blocking 0 \
1503 -buffering full \
1504 -buffersize 512 \
1505 -translation binary
1506 fileevent $fd writable [list \
1507 write_update_index \
1508 $fd \
1509 $pathList \
1510 $totalCnt \
1511 $batch \
1512 $msg \
1513 $after \
1514 ]
1515}
1516proc write_update_index {fd pathList totalCnt batch msg after} {
1518 global update_index_cp ui_status_value
1519 global file_states current_diff
1520 if {$update_index_cp >= $totalCnt} {
1522 close $fd
1523 unlock_index
1524 uplevel #0 $after
1525 return
1526 }
1527 for {set i $batch} \
1529 {$update_index_cp < $totalCnt && $i > 0} \
1530 {incr i -1} {
1531 set path [lindex $pathList $update_index_cp]
1532 incr update_index_cp
1533 switch -glob -- [lindex $file_states($path) 0] {
1535 AD -
1536 MD -
1537 UD -
1538 _D {set new DD}
1539 _M -
1541 MM -
1542 UM -
1543 U_ -
1544 M_ {set new M_}
1545 _O -
1547 AM -
1548 A_ {set new A_}
1549 ?? {continue}
1551 }
1552 puts -nonewline $fd $path
1554 puts -nonewline $fd "\0"
1555 display_file $path $new
1556 }
1557 set ui_status_value [format \
1559 "$msg... %i/%i files (%.2f%%)" \
1560 $update_index_cp \
1561 $totalCnt \
1562 [expr {100.0 * $update_index_cp / $totalCnt}]]
1563}
1564proc checkout_index {msg pathList after} {
1566 global update_index_cp ui_status_value
1567 if {![lock_index update]} return
1569 set update_index_cp 0
1571 set pathList [lsort $pathList]
1572 set totalCnt [llength $pathList]
1573 set batch [expr {int($totalCnt * .01) + 1}]
1574 if {$batch > 25} {set batch 25}
1575 set ui_status_value [format \
1577 "$msg... %i/%i files (%.2f%%)" \
1578 $update_index_cp \
1579 $totalCnt \
1580 0.0]
1581 set cmd [list git checkout-index]
1582 lappend cmd --index
1583 lappend cmd --quiet
1584 lappend cmd --force
1585 lappend cmd -z
1586 lappend cmd --stdin
1587 set fd [open "| $cmd " w]
1588 fconfigure $fd \
1589 -blocking 0 \
1590 -buffering full \
1591 -buffersize 512 \
1592 -translation binary
1593 fileevent $fd writable [list \
1594 write_checkout_index \
1595 $fd \
1596 $pathList \
1597 $totalCnt \
1598 $batch \
1599 $msg \
1600 $after \
1601 ]
1602}
1603proc write_checkout_index {fd pathList totalCnt batch msg after} {
1605 global update_index_cp ui_status_value
1606 global file_states current_diff
1607 if {$update_index_cp >= $totalCnt} {
1609 close $fd
1610 unlock_index
1611 uplevel #0 $after
1612 return
1613 }
1614 for {set i $batch} \
1616 {$update_index_cp < $totalCnt && $i > 0} \
1617 {incr i -1} {
1618 set path [lindex $pathList $update_index_cp]
1619 incr update_index_cp
1620 switch -glob -- [lindex $file_states($path) 0] {
1622 AM -
1623 AD {set new A_}
1624 MM -
1625 MD {set new M_}
1626 _M -
1627 _D {set new __}
1628 ?? {continue}
1629 }
1630 puts -nonewline $fd $path
1632 puts -nonewline $fd "\0"
1633 display_file $path $new
1634 }
1635 set ui_status_value [format \
1637 "$msg... %i/%i files (%.2f%%)" \
1638 $update_index_cp \
1639 $totalCnt \
1640 [expr {100.0 * $update_index_cp / $totalCnt}]]
1641}
1642######################################################################
1644##
1645## branch management
1646proc load_all_heads {} {
1648 global all_heads tracking_branches
1649 set all_heads [list]
1651 set cmd [list git for-each-ref]
1652 lappend cmd --format=%(refname)
1653 lappend cmd refs/heads
1654 set fd [open "| $cmd" r]
1655 while {[gets $fd line] > 0} {
1656 if {![catch {set info $tracking_branches($line)}]} continue
1657 if {![regsub ^refs/heads/ $line {} name]} continue
1658 lappend all_heads $name
1659 }
1660 close $fd
1661 set all_heads [lsort $all_heads]
1663}
1664proc populate_branch_menu {m} {
1666 global all_heads disable_on_lock
1667 $m add separator
1669 foreach b $all_heads {
1670 $m add radiobutton \
1671 -label $b \
1672 -command [list switch_branch $b] \
1673 -variable current_branch \
1674 -value $b \
1675 -font font_ui
1676 lappend disable_on_lock \
1677 [list $m entryconf [$m index last] -state]
1678 }
1679}
1680proc do_create_branch {} {
1682 error "NOT IMPLEMENTED"
1683}
1684proc do_delete_branch {} {
1686 error "NOT IMPLEMENTED"
1687}
1688proc switch_branch {b} {
1690 global HEAD commit_type file_states current_branch
1691 global selected_commit_type ui_comm
1692 if {![lock_index switch]} return
1694 # -- Backup the selected branch (repository_state resets it)
1696 #
1697 set new_branch $current_branch
1698 # -- Our in memory state should match the repository.
1700 #
1701 repository_state curType curHEAD curMERGE_HEAD
1702 if {[string match amend* $commit_type]
1703 && $curType eq {normal}
1704 && $curHEAD eq $HEAD} {
1705 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1706 info_popup {Last scanned state does not match repository state.
1707Another Git program has modified this repository
1709since the last scan. A rescan must be performed
1710before the current branch can be changed.
1711The rescan will be automatically started now.
1713}
1714 unlock_index
1715 rescan {set ui_status_value {Ready.}}
1716 return
1717 }
1718 # -- Toss the message buffer if we are in amend mode.
1720 #
1721 if {[string match amend* $curType]} {
1722 $ui_comm delete 0.0 end
1723 $ui_comm edit reset
1724 $ui_comm edit modified false
1725 }
1726 set selected_commit_type new
1728 set current_branch $new_branch
1729 unlock_index
1731 error "NOT FINISHED"
1732}
1733######################################################################
1735##
1736## remote management
1737proc load_all_remotes {} {
1739 global gitdir repo_config
1740 global all_remotes tracking_branches
1741 set all_remotes [list]
1743 array unset tracking_branches
1744 set rm_dir [file join $gitdir remotes]
1746 if {[file isdirectory $rm_dir]} {
1747 set all_remotes [glob \
1748 -types f \
1749 -tails \
1750 -nocomplain \
1751 -directory $rm_dir *]
1752 foreach name $all_remotes {
1754 catch {
1755 set fd [open [file join $rm_dir $name] r]
1756 while {[gets $fd line] >= 0} {
1757 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
1758 $line line src dst]} continue
1759 if {![regexp ^refs/ $dst]} {
1760 set dst "refs/heads/$dst"
1761 }
1762 set tracking_branches($dst) [list $name $src]
1763 }
1764 close $fd
1765 }
1766 }
1767 }
1768 foreach line [array names repo_config remote.*.url] {
1770 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
1771 lappend all_remotes $name
1772 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
1774 set fl {}
1775 }
1776 foreach line $fl {
1777 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
1778 if {![regexp ^refs/ $dst]} {
1779 set dst "refs/heads/$dst"
1780 }
1781 set tracking_branches($dst) [list $name $src]
1782 }
1783 }
1784 set all_remotes [lsort -unique $all_remotes]
1786}
1787proc populate_fetch_menu {m} {
1789 global gitdir all_remotes repo_config
1790 foreach r $all_remotes {
1792 set enable 0
1793 if {![catch {set a $repo_config(remote.$r.url)}]} {
1794 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1795 set enable 1
1796 }
1797 } else {
1798 catch {
1799 set fd [open [file join $gitdir remotes $r] r]
1800 while {[gets $fd n] >= 0} {
1801 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1802 set enable 1
1803 break
1804 }
1805 }
1806 close $fd
1807 }
1808 }
1809 if {$enable} {
1811 $m add command \
1812 -label "Fetch from $r..." \
1813 -command [list fetch_from $r] \
1814 -font font_ui
1815 }
1816 }
1817}
1818proc populate_push_menu {m} {
1820 global gitdir all_remotes repo_config
1821 foreach r $all_remotes {
1823 set enable 0
1824 if {![catch {set a $repo_config(remote.$r.url)}]} {
1825 if {![catch {set a $repo_config(remote.$r.push)}]} {
1826 set enable 1
1827 }
1828 } else {
1829 catch {
1830 set fd [open [file join $gitdir remotes $r] r]
1831 while {[gets $fd n] >= 0} {
1832 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1833 set enable 1
1834 break
1835 }
1836 }
1837 close $fd
1838 }
1839 }
1840 if {$enable} {
1842 $m add command \
1843 -label "Push to $r..." \
1844 -command [list push_to $r] \
1845 -font font_ui
1846 }
1847 }
1848}
1849proc populate_pull_menu {m} {
1851 global gitdir repo_config all_remotes disable_on_lock
1852 foreach remote $all_remotes {
1854 set rb_list [list]
1855 if {[array get repo_config remote.$remote.url] ne {}} {
1856 if {[array get repo_config remote.$remote.fetch] ne {}} {
1857 foreach line $repo_config(remote.$remote.fetch) {
1858 if {[regexp {^([^:]+):} $line line rb]} {
1859 lappend rb_list $rb
1860 }
1861 }
1862 }
1863 } else {
1864 catch {
1865 set fd [open [file join $gitdir remotes $remote] r]
1866 while {[gets $fd line] >= 0} {
1867 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1868 lappend rb_list $rb
1869 }
1870 }
1871 close $fd
1872 }
1873 }
1874 foreach rb $rb_list {
1876 regsub ^refs/heads/ $rb {} rb_short
1877 $m add command \
1878 -label "Branch $rb_short from $remote..." \
1879 -command [list pull_remote $remote $rb] \
1880 -font font_ui
1881 lappend disable_on_lock \
1882 [list $m entryconf [$m index last] -state]
1883 }
1884 }
1885}
1886######################################################################
1888##
1889## icons
1890set filemask {
1892#define mask_width 14
1893#define mask_height 15
1894static unsigned char mask_bits[] = {
1895 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1896 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1897 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1898}
1899image create bitmap file_plain -background white -foreground black -data {
1901#define plain_width 14
1902#define plain_height 15
1903static unsigned char plain_bits[] = {
1904 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1905 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1906 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1907} -maskdata $filemask
1908image create bitmap file_mod -background white -foreground blue -data {
1910#define mod_width 14
1911#define mod_height 15
1912static unsigned char mod_bits[] = {
1913 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1914 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1915 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1916} -maskdata $filemask
1917image create bitmap file_fulltick -background white -foreground "#007000" -data {
1919#define file_fulltick_width 14
1920#define file_fulltick_height 15
1921static unsigned char file_fulltick_bits[] = {
1922 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1923 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1924 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1925} -maskdata $filemask
1926image create bitmap file_parttick -background white -foreground "#005050" -data {
1928#define parttick_width 14
1929#define parttick_height 15
1930static unsigned char parttick_bits[] = {
1931 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1932 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1933 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1934} -maskdata $filemask
1935image create bitmap file_question -background white -foreground black -data {
1937#define file_question_width 14
1938#define file_question_height 15
1939static unsigned char file_question_bits[] = {
1940 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1941 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1942 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1943} -maskdata $filemask
1944image create bitmap file_removed -background white -foreground red -data {
1946#define file_removed_width 14
1947#define file_removed_height 15
1948static unsigned char file_removed_bits[] = {
1949 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1950 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1951 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1952} -maskdata $filemask
1953image create bitmap file_merge -background white -foreground blue -data {
1955#define file_merge_width 14
1956#define file_merge_height 15
1957static unsigned char file_merge_bits[] = {
1958 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1959 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1960 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1961} -maskdata $filemask
1962set ui_index .vpane.files.index.list
1964set ui_other .vpane.files.other.list
1965set max_status_desc 0
1966foreach i {
1967 {__ i plain "Unmodified"}
1968 {_M i mod "Modified"}
1969 {M_ i fulltick "Added to commit"}
1970 {MM i parttick "Partially included"}
1971 {MD i question "Added (but gone)"}
1972 {_O o plain "Untracked"}
1974 {A_ o fulltick "Added by commit"}
1975 {AM o parttick "Partially added"}
1976 {AD o question "Added (but gone)"}
1977 {_D i question "Missing"}
1979 {DD i removed "Removed by commit"}
1980 {D_ i removed "Removed by commit"}
1981 {DO i removed "Removed (still exists)"}
1982 {DM i removed "Removed (but modified)"}
1983 {UD i merge "Merge conflicts"}
1985 {UM i merge "Merge conflicts"}
1986 {U_ i merge "Merge conflicts"}
1987 } {
1988 if {$max_status_desc < [string length [lindex $i 3]]} {
1989 set max_status_desc [string length [lindex $i 3]]
1990 }
1991 if {[lindex $i 1] eq {i}} {
1992 set all_cols([lindex $i 0]) $ui_index
1993 } else {
1994 set all_cols([lindex $i 0]) $ui_other
1995 }
1996 set all_icons([lindex $i 0]) file_[lindex $i 2]
1997 set all_descs([lindex $i 0]) [lindex $i 3]
1998}
1999unset filemask i
2000######################################################################
2002##
2003## util
2004proc is_MacOSX {} {
2006 global tcl_platform tk_library
2007 if {[tk windowingsystem] eq {aqua}} {
2008 return 1
2009 }
2010 return 0
2011}
2012proc is_Windows {} {
2014 global tcl_platform
2015 if {$tcl_platform(platform) eq {windows}} {
2016 return 1
2017 }
2018 return 0
2019}
2020proc bind_button3 {w cmd} {
2022 bind $w <Any-Button-3> $cmd
2023 if {[is_MacOSX]} {
2024 bind $w <Control-Button-1> $cmd
2025 }
2026}
2027proc incr_font_size {font {amt 1}} {
2029 set sz [font configure $font -size]
2030 incr sz $amt
2031 font configure $font -size $sz
2032 font configure ${font}bold -size $sz
2033}
2034proc hook_failed_popup {hook msg} {
2036 global gitdir appname
2037 set w .hookfail
2039 toplevel $w
2040 frame $w.m
2042 label $w.m.l1 -text "$hook hook failed:" \
2043 -anchor w \
2044 -justify left \
2045 -font font_uibold
2046 text $w.m.t \
2047 -background white -borderwidth 1 \
2048 -relief sunken \
2049 -width 80 -height 10 \
2050 -font font_diff \
2051 -yscrollcommand [list $w.m.sby set]
2052 label $w.m.l2 \
2053 -text {You must correct the above errors before committing.} \
2054 -anchor w \
2055 -justify left \
2056 -font font_uibold
2057 scrollbar $w.m.sby -command [list $w.m.t yview]
2058 pack $w.m.l1 -side top -fill x
2059 pack $w.m.l2 -side bottom -fill x
2060 pack $w.m.sby -side right -fill y
2061 pack $w.m.t -side left -fill both -expand 1
2062 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2063 $w.m.t insert 1.0 $msg
2065 $w.m.t conf -state disabled
2066 button $w.ok -text OK \
2068 -width 15 \
2069 -font font_ui \
2070 -command "destroy $w"
2071 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2072 bind $w <Visibility> "grab $w; focus $w"
2074 bind $w <Key-Return> "destroy $w"
2075 wm title $w "$appname ([lindex [file split \
2076 [file normalize [file dirname $gitdir]]] \
2077 end]): error"
2078 tkwait window $w
2079}
2080set next_console_id 0
2082proc new_console {short_title long_title} {
2084 global next_console_id console_data
2085 set w .console[incr next_console_id]
2086 set console_data($w) [list $short_title $long_title]
2087 return [console_init $w]
2088}
2089proc console_init {w} {
2091 global console_cr console_data
2092 global gitdir appname M1B
2093 set console_cr($w) 1.0
2095 toplevel $w
2096 frame $w.m
2097 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2098 -anchor w \
2099 -justify left \
2100 -font font_uibold
2101 text $w.m.t \
2102 -background white -borderwidth 1 \
2103 -relief sunken \
2104 -width 80 -height 10 \
2105 -font font_diff \
2106 -state disabled \
2107 -yscrollcommand [list $w.m.sby set]
2108 label $w.m.s -text {Working... please wait...} \
2109 -anchor w \
2110 -justify left \
2111 -font font_uibold
2112 scrollbar $w.m.sby -command [list $w.m.t yview]
2113 pack $w.m.l1 -side top -fill x
2114 pack $w.m.s -side bottom -fill x
2115 pack $w.m.sby -side right -fill y
2116 pack $w.m.t -side left -fill both -expand 1
2117 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2118 menu $w.ctxm -tearoff 0
2120 $w.ctxm add command -label "Copy" \
2121 -font font_ui \
2122 -command "tk_textCopy $w.m.t"
2123 $w.ctxm add command -label "Select All" \
2124 -font font_ui \
2125 -command "$w.m.t tag add sel 0.0 end"
2126 $w.ctxm add command -label "Copy All" \
2127 -font font_ui \
2128 -command "
2129 $w.m.t tag add sel 0.0 end
2130 tk_textCopy $w.m.t
2131 $w.m.t tag remove sel 0.0 end
2132 "
2133 button $w.ok -text {Close} \
2135 -font font_ui \
2136 -state disabled \
2137 -command "destroy $w"
2138 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2139 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2141 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2142 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2143 bind $w <Visibility> "focus $w"
2144 wm title $w "$appname ([lindex [file split \
2145 [file normalize [file dirname $gitdir]]] \
2146 end]): [lindex $console_data($w) 0]"
2147 return $w
2148}
2149proc console_exec {w cmd {after {}}} {
2151 # -- Windows tosses the enviroment when we exec our child.
2152 # But most users need that so we have to relogin. :-(
2153 #
2154 if {[is_Windows]} {
2155 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2156 }
2157 # -- Tcl won't let us redirect both stdout and stderr to
2159 # the same pipe. So pass it through cat...
2160 #
2161 set cmd [concat | $cmd |& cat]
2162 set fd_f [open $cmd r]
2164 fconfigure $fd_f -blocking 0 -translation binary
2165 fileevent $fd_f readable [list console_read $w $fd_f $after]
2166}
2167proc console_read {w fd after} {
2169 global console_cr console_data
2170 set buf [read $fd]
2172 if {$buf ne {}} {
2173 if {![winfo exists $w]} {console_init $w}
2174 $w.m.t conf -state normal
2175 set c 0
2176 set n [string length $buf]
2177 while {$c < $n} {
2178 set cr [string first "\r" $buf $c]
2179 set lf [string first "\n" $buf $c]
2180 if {$cr < 0} {set cr [expr {$n + 1}]}
2181 if {$lf < 0} {set lf [expr {$n + 1}]}
2182 if {$lf < $cr} {
2184 $w.m.t insert end [string range $buf $c $lf]
2185 set console_cr($w) [$w.m.t index {end -1c}]
2186 set c $lf
2187 incr c
2188 } else {
2189 $w.m.t delete $console_cr($w) end
2190 $w.m.t insert end "\n"
2191 $w.m.t insert end [string range $buf $c $cr]
2192 set c $cr
2193 incr c
2194 }
2195 }
2196 $w.m.t conf -state disabled
2197 $w.m.t see end
2198 }
2199 fconfigure $fd -blocking 1
2201 if {[eof $fd]} {
2202 if {[catch {close $fd}]} {
2203 if {![winfo exists $w]} {console_init $w}
2204 $w.m.s conf -background red -text {Error: Command Failed}
2205 $w.ok conf -state normal
2206 set ok 0
2207 } elseif {[winfo exists $w]} {
2208 $w.m.s conf -background green -text {Success}
2209 $w.ok conf -state normal
2210 set ok 1
2211 }
2212 array unset console_cr $w
2213 array unset console_data $w
2214 if {$after ne {}} {
2215 uplevel #0 $after $ok
2216 }
2217 return
2218 }
2219 fconfigure $fd -blocking 0
2220}
2221######################################################################
2223##
2224## ui commands
2225set starting_gitk_msg {Please wait... Starting gitk...}
2227proc do_gitk {revs} {
2229 global ui_status_value starting_gitk_msg
2230 set cmd gitk
2232 if {$revs ne {}} {
2233 append cmd { }
2234 append cmd $revs
2235 }
2236 if {[is_Windows]} {
2237 set cmd "sh -c \"exec $cmd\""
2238 }
2239 append cmd { &}
2240 if {[catch {eval exec $cmd} err]} {
2242 error_popup "Failed to start gitk:\n\n$err"
2243 } else {
2244 set ui_status_value $starting_gitk_msg
2245 after 10000 {
2246 if {$ui_status_value eq $starting_gitk_msg} {
2247 set ui_status_value {Ready.}
2248 }
2249 }
2250 }
2251}
2252proc do_gc {} {
2254 set w [new_console {gc} {Compressing the object database}]
2255 console_exec $w {git gc}
2256}
2257proc do_fsck_objects {} {
2259 set w [new_console {fsck-objects} \
2260 {Verifying the object database with fsck-objects}]
2261 set cmd [list git fsck-objects]
2262 lappend cmd --full
2263 lappend cmd --cache
2264 lappend cmd --strict
2265 console_exec $w $cmd
2266}
2267set is_quitting 0
2269proc do_quit {} {
2271 global gitdir ui_comm is_quitting repo_config commit_type
2272 if {$is_quitting} return
2274 set is_quitting 1
2275 # -- Stash our current commit buffer.
2277 #
2278 set save [file join $gitdir GITGUI_MSG]
2279 set msg [string trim [$ui_comm get 0.0 end]]
2280 if {![string match amend* $commit_type]
2281 && [$ui_comm edit modified]
2282 && $msg ne {}} {
2283 catch {
2284 set fd [open $save w]
2285 puts $fd [string trim [$ui_comm get 0.0 end]]
2286 close $fd
2287 }
2288 } else {
2289 catch {file delete $save}
2290 }
2291 # -- Stash our current window geometry into this repository.
2293 #
2294 set cfg_geometry [list]
2295 lappend cfg_geometry [wm geometry .]
2296 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2297 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2298 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2299 set rc_geometry {}
2300 }
2301 if {$cfg_geometry ne $rc_geometry} {
2302 catch {exec git repo-config gui.geometry $cfg_geometry}
2303 }
2304 destroy .
2306}
2307proc do_rescan {} {
2309 rescan {set ui_status_value {Ready.}}
2310}
2311proc remove_helper {txt paths} {
2313 global file_states current_diff
2314 if {![lock_index begin-update]} return
2316 set pathList [list]
2318 set after {}
2319 foreach path $paths {
2320 switch -glob -- [lindex $file_states($path) 0] {
2321 A? -
2322 M? -
2323 D? {
2324 lappend pathList $path
2325 if {$path eq $current_diff} {
2326 set after {reshow_diff;}
2327 }
2328 }
2329 }
2330 }
2331 if {$pathList eq {}} {
2332 unlock_index
2333 } else {
2334 update_indexinfo \
2335 $txt \
2336 $pathList \
2337 [concat $after {set ui_status_value {Ready.}}]
2338 }
2339}
2340proc do_remove_selection {} {
2342 global current_diff selected_paths
2343 if {[array size selected_paths] > 0} {
2345 remove_helper \
2346 {Removing selected files from commit} \
2347 [array names selected_paths]
2348 } elseif {$current_diff ne {}} {
2349 remove_helper \
2350 "Removing [short_path $current_diff] from commit" \
2351 [list $current_diff]
2352 }
2353}
2354proc include_helper {txt paths} {
2356 global file_states current_diff
2357 if {![lock_index begin-update]} return
2359 set pathList [list]
2361 set after {}
2362 foreach path $paths {
2363 switch -glob -- [lindex $file_states($path) 0] {
2364 AM -
2365 AD -
2366 MM -
2367 MD -
2368 U? -
2369 _M -
2370 _D -
2371 _O {
2372 lappend pathList $path
2373 if {$path eq $current_diff} {
2374 set after {reshow_diff;}
2375 }
2376 }
2377 }
2378 }
2379 if {$pathList eq {}} {
2380 unlock_index
2381 } else {
2382 update_index \
2383 $txt \
2384 $pathList \
2385 [concat $after {set ui_status_value {Ready to commit.}}]
2386 }
2387}
2388proc do_include_selection {} {
2390 global current_diff selected_paths
2391 if {[array size selected_paths] > 0} {
2393 include_helper \
2394 {Adding selected files} \
2395 [array names selected_paths]
2396 } elseif {$current_diff ne {}} {
2397 include_helper \
2398 "Adding [short_path $current_diff]" \
2399 [list $current_diff]
2400 }
2401}
2402proc do_include_all {} {
2404 global file_states
2405 set paths [list]
2407 foreach path [array names file_states] {
2408 switch -- [lindex $file_states($path) 0] {
2409 AM -
2410 AD -
2411 MM -
2412 MD -
2413 _M -
2414 _D {lappend paths $path}
2415 }
2416 }
2417 include_helper \
2418 {Adding all modified files} \
2419 $paths
2420}
2421proc revert_helper {txt paths} {
2423 global gitdir appname reponame
2424 global file_states current_diff
2425 if {![lock_index begin-update]} return
2427 set pathList [list]
2429 set after {}
2430 foreach path $paths {
2431 switch -glob -- [lindex $file_states($path) 0] {
2432 AM -
2433 AD -
2434 MM -
2435 MD -
2436 _M -
2437 _D {
2438 lappend pathList $path
2439 if {$path eq $current_diff} {
2440 set after {reshow_diff;}
2441 }
2442 }
2443 }
2444 }
2445 set n [llength $pathList]
2447 if {$n == 0} {
2448 unlock_index
2449 return
2450 } elseif {$n == 1} {
2451 set s "[short_path [lindex $pathList]]"
2452 } else {
2453 set s "these $n files"
2454 }
2455 set reply [tk_dialog \
2457 .confirm_revert \
2458 "$appname ($reponame)" \
2459 "Revert changes in $s?
2460Any unadded changes will be permanently lost by the revert." \
2462 question \
2463 1 \
2464 {Do Nothing} \
2465 {Revert Changes} \
2466 ]
2467 if {$reply == 1} {
2468 checkout_index \
2469 $txt \
2470 $pathList \
2471 [concat $after {set ui_status_value {Ready.}}]
2472 } else {
2473 unlock_index
2474 }
2475}
2476proc do_revert_selection {} {
2478 global current_diff selected_paths
2479 if {[array size selected_paths] > 0} {
2481 revert_helper \
2482 {Reverting selected files} \
2483 [array names selected_paths]
2484 } elseif {$current_diff ne {}} {
2485 revert_helper \
2486 "Reverting [short_path $current_diff]" \
2487 [list $current_diff]
2488 }
2489}
2490proc do_signoff {} {
2492 global ui_comm
2493 set me [committer_ident]
2495 if {$me eq {}} return
2496 set sob "Signed-off-by: $me"
2498 set last [$ui_comm get {end -1c linestart} {end -1c}]
2499 if {$last ne $sob} {
2500 $ui_comm edit separator
2501 if {$last ne {}
2502 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2503 $ui_comm insert end "\n"
2504 }
2505 $ui_comm insert end "\n$sob"
2506 $ui_comm edit separator
2507 $ui_comm see end
2508 }
2509}
2510proc do_select_commit_type {} {
2512 global commit_type selected_commit_type
2513 if {$selected_commit_type eq {new}
2515 && [string match amend* $commit_type]} {
2516 create_new_commit
2517 } elseif {$selected_commit_type eq {amend}
2518 && ![string match amend* $commit_type]} {
2519 load_last_commit
2520 # The amend request was rejected...
2522 #
2523 if {![string match amend* $commit_type]} {
2524 set selected_commit_type new
2525 }
2526 }
2527}
2528proc do_commit {} {
2530 commit_tree
2531}
2532proc do_about {} {
2534 global appname appvers copyright
2535 global tcl_patchLevel tk_patchLevel
2536 set w .about_dialog
2538 toplevel $w
2539 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2540 label $w.header -text "About $appname" \
2542 -font font_uibold
2543 pack $w.header -side top -fill x
2544 frame $w.buttons
2546 button $w.buttons.close -text {Close} \
2547 -font font_ui \
2548 -command [list destroy $w]
2549 pack $w.buttons.close -side right
2550 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2551 label $w.desc \
2553 -text "$appname - a commit creation tool for Git.
2554$copyright" \
2555 -padx 5 -pady 5 \
2556 -justify left \
2557 -anchor w \
2558 -borderwidth 1 \
2559 -relief solid \
2560 -font font_ui
2561 pack $w.desc -side top -fill x -padx 5 -pady 5
2562 set v {}
2564 append v "$appname version $appvers\n"
2565 append v "[exec git version]\n"
2566 append v "\n"
2567 if {$tcl_patchLevel eq $tk_patchLevel} {
2568 append v "Tcl/Tk version $tcl_patchLevel"
2569 } else {
2570 append v "Tcl version $tcl_patchLevel"
2571 append v ", Tk version $tk_patchLevel"
2572 }
2573 label $w.vers \
2575 -text $v \
2576 -padx 5 -pady 5 \
2577 -justify left \
2578 -anchor w \
2579 -borderwidth 1 \
2580 -relief solid \
2581 -font font_ui
2582 pack $w.vers -side top -fill x -padx 5 -pady 5
2583 menu $w.ctxm -tearoff 0
2585 $w.ctxm add command \
2586 -label {Copy} \
2587 -font font_ui \
2588 -command "
2589 clipboard clear
2590 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2591 "
2592 bind $w <Visibility> "grab $w; focus $w"
2594 bind $w <Key-Escape> "destroy $w"
2595 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2596 wm title $w "About $appname"
2597 tkwait window $w
2598}
2599proc do_options {} {
2601 global appname gitdir reponame font_descs
2602 global repo_config global_config
2603 global repo_config_new global_config_new
2604 array unset repo_config_new
2606 array unset global_config_new
2607 foreach name [array names repo_config] {
2608 set repo_config_new($name) $repo_config($name)
2609 }
2610 load_config 1
2611 foreach name [array names repo_config] {
2612 switch -- $name {
2613 gui.diffcontext {continue}
2614 }
2615 set repo_config_new($name) $repo_config($name)
2616 }
2617 foreach name [array names global_config] {
2618 set global_config_new($name) $global_config($name)
2619 }
2620 set w .options_editor
2622 toplevel $w
2623 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2624 label $w.header -text "$appname Options" \
2626 -font font_uibold
2627 pack $w.header -side top -fill x
2628 frame $w.buttons
2630 button $w.buttons.restore -text {Restore Defaults} \
2631 -font font_ui \
2632 -command do_restore_defaults
2633 pack $w.buttons.restore -side left
2634 button $w.buttons.save -text Save \
2635 -font font_ui \
2636 -command [list do_save_config $w]
2637 pack $w.buttons.save -side right
2638 button $w.buttons.cancel -text {Cancel} \
2639 -font font_ui \
2640 -command [list destroy $w]
2641 pack $w.buttons.cancel -side right
2642 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2643 labelframe $w.repo -text "$reponame Repository" \
2645 -font font_ui \
2646 -relief raised -borderwidth 2
2647 labelframe $w.global -text {Global (All Repositories)} \
2648 -font font_ui \
2649 -relief raised -borderwidth 2
2650 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2651 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2652 foreach option {
2654 {b partialinclude {Allow Partially Added Files}}
2655 {b pullsummary {Show Pull Summary}}
2656 {b trustmtime {Trust File Modification Timestamps}}
2657 {i diffcontext {Number of Diff Context Lines}}
2658 } {
2659 set type [lindex $option 0]
2660 set name [lindex $option 1]
2661 set text [lindex $option 2]
2662 foreach f {repo global} {
2663 switch $type {
2664 b {
2665 checkbutton $w.$f.$name -text $text \
2666 -variable ${f}_config_new(gui.$name) \
2667 -onvalue true \
2668 -offvalue false \
2669 -font font_ui
2670 pack $w.$f.$name -side top -anchor w
2671 }
2672 i {
2673 frame $w.$f.$name
2674 label $w.$f.$name.l -text "$text:" -font font_ui
2675 pack $w.$f.$name.l -side left -anchor w -fill x
2676 spinbox $w.$f.$name.v \
2677 -textvariable ${f}_config_new(gui.$name) \
2678 -from 1 -to 99 -increment 1 \
2679 -width 3 \
2680 -font font_ui
2681 pack $w.$f.$name.v -side right -anchor e
2682 pack $w.$f.$name -side top -anchor w -fill x
2683 }
2684 }
2685 }
2686 }
2687 set all_fonts [lsort [font families]]
2689 foreach option $font_descs {
2690 set name [lindex $option 0]
2691 set font [lindex $option 1]
2692 set text [lindex $option 2]
2693 set global_config_new(gui.$font^^family) \
2695 [font configure $font -family]
2696 set global_config_new(gui.$font^^size) \
2697 [font configure $font -size]
2698 frame $w.global.$name
2700 label $w.global.$name.l -text "$text:" -font font_ui
2701 pack $w.global.$name.l -side left -anchor w -fill x
2702 eval tk_optionMenu $w.global.$name.family \
2703 global_config_new(gui.$font^^family) \
2704 $all_fonts
2705 spinbox $w.global.$name.size \
2706 -textvariable global_config_new(gui.$font^^size) \
2707 -from 2 -to 80 -increment 1 \
2708 -width 3 \
2709 -font font_ui
2710 pack $w.global.$name.size -side right -anchor e
2711 pack $w.global.$name.family -side right -anchor e
2712 pack $w.global.$name -side top -anchor w -fill x
2713 }
2714 bind $w <Visibility> "grab $w; focus $w"
2716 bind $w <Key-Escape> "destroy $w"
2717 wm title $w "$appname ($reponame): Options"
2718 tkwait window $w
2719}
2720proc do_restore_defaults {} {
2722 global font_descs default_config repo_config
2723 global repo_config_new global_config_new
2724 foreach name [array names default_config] {
2726 set repo_config_new($name) $default_config($name)
2727 set global_config_new($name) $default_config($name)
2728 }
2729 foreach option $font_descs {
2731 set name [lindex $option 0]
2732 set repo_config(gui.$name) $default_config(gui.$name)
2733 }
2734 apply_config
2735 foreach option $font_descs {
2737 set name [lindex $option 0]
2738 set font [lindex $option 1]
2739 set global_config_new(gui.$font^^family) \
2740 [font configure $font -family]
2741 set global_config_new(gui.$font^^size) \
2742 [font configure $font -size]
2743 }
2744}
2745proc do_save_config {w} {
2747 if {[catch {save_config} err]} {
2748 error_popup "Failed to completely save options:\n\n$err"
2749 }
2750 reshow_diff
2751 destroy $w
2752}
2753proc do_windows_shortcut {} {
2755 global gitdir appname reponame argv0
2756 if {[catch {
2758 set desktop [exec cygpath \
2759 --windows \
2760 --absolute \
2761 --long-name \
2762 --desktop]
2763 }]} {
2764 set desktop .
2765 }
2766 set fn [tk_getSaveFile \
2767 -parent . \
2768 -title "$appname ($reponame): Create Desktop Icon" \
2769 -initialdir $desktop \
2770 -initialfile "Git $reponame.bat"]
2771 if {$fn != {}} {
2772 if {[catch {
2773 set fd [open $fn w]
2774 set sh [exec cygpath \
2775 --windows \
2776 --absolute \
2777 /bin/sh]
2778 set me [exec cygpath \
2779 --unix \
2780 --absolute \
2781 $argv0]
2782 set gd [exec cygpath \
2783 --unix \
2784 --absolute \
2785 $gitdir]
2786 regsub -all ' $me "'\\''" me
2787 regsub -all ' $gd "'\\''" gd
2788 puts $fd "@ECHO Starting git-gui... Please wait..."
2789 puts -nonewline $fd "@\"$sh\" --login -c \""
2790 puts -nonewline $fd "GIT_DIR='$gd'"
2791 puts -nonewline $fd " '$me'"
2792 puts $fd "&\""
2793 close $fd
2794 } err]} {
2795 error_popup "Cannot write script:\n\n$err"
2796 }
2797 }
2798}
2799proc do_macosx_app {} {
2801 global gitdir appname reponame argv0 env
2802 set fn [tk_getSaveFile \
2804 -parent . \
2805 -title "$appname ($reponame): Create Desktop Icon" \
2806 -initialdir [file join $env(HOME) Desktop] \
2807 -initialfile "Git $reponame.app"]
2808 if {$fn != {}} {
2809 if {[catch {
2810 set Contents [file join $fn Contents]
2811 set MacOS [file join $Contents MacOS]
2812 set exe [file join $MacOS git-gui]
2813 file mkdir $MacOS
2815 set fd [open [file join $Contents Info.plist] w]
2817 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2818<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2819<plist version="1.0">
2820<dict>
2821 <key>CFBundleDevelopmentRegion</key>
2822 <string>English</string>
2823 <key>CFBundleExecutable</key>
2824 <string>git-gui</string>
2825 <key>CFBundleIdentifier</key>
2826 <string>org.spearce.git-gui</string>
2827 <key>CFBundleInfoDictionaryVersion</key>
2828 <string>6.0</string>
2829 <key>CFBundlePackageType</key>
2830 <string>APPL</string>
2831 <key>CFBundleSignature</key>
2832 <string>????</string>
2833 <key>CFBundleVersion</key>
2834 <string>1.0</string>
2835 <key>NSPrincipalClass</key>
2836 <string>NSApplication</string>
2837</dict>
2838</plist>}
2839 close $fd
2840 set fd [open $exe w]
2842 set gd [file normalize $gitdir]
2843 set ep [file normalize [exec git --exec-path]]
2844 regsub -all ' $gd "'\\''" gd
2845 regsub -all ' $ep "'\\''" ep
2846 puts $fd "#!/bin/sh"
2847 foreach name [array names env] {
2848 if {[string match GIT_* $name]} {
2849 regsub -all ' $env($name) "'\\''" v
2850 puts $fd "export $name='$v'"
2851 }
2852 }
2853 puts $fd "export PATH='$ep':\$PATH"
2854 puts $fd "export GIT_DIR='$gd'"
2855 puts $fd "exec [file normalize $argv0]"
2856 close $fd
2857 file attributes $exe -permissions u+x,g+x,o+x
2859 } err]} {
2860 error_popup "Cannot write icon:\n\n$err"
2861 }
2862 }
2863}
2864proc toggle_or_diff {w x y} {
2866 global file_states file_lists current_diff ui_index ui_other
2867 global last_clicked selected_paths
2868 set pos [split [$w index @$x,$y] .]
2870 set lno [lindex $pos 0]
2871 set col [lindex $pos 1]
2872 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2873 if {$path eq {}} {
2874 set last_clicked {}
2875 return
2876 }
2877 set last_clicked [list $w $lno]
2879 array unset selected_paths
2880 $ui_index tag remove in_sel 0.0 end
2881 $ui_other tag remove in_sel 0.0 end
2882 if {$col == 0} {
2884 if {$current_diff eq $path} {
2885 set after {reshow_diff;}
2886 } else {
2887 set after {}
2888 }
2889 switch -glob -- [lindex $file_states($path) 0] {
2890 A_ -
2891 M_ -
2892 DD -
2893 DO -
2894 DM {
2895 update_indexinfo \
2896 "Removing [short_path $path] from commit" \
2897 [list $path] \
2898 [concat $after {set ui_status_value {Ready.}}]
2899 }
2900 ?? {
2901 update_index \
2902 "Adding [short_path $path]" \
2903 [list $path] \
2904 [concat $after {set ui_status_value {Ready.}}]
2905 }
2906 }
2907 } else {
2908 show_diff $path $w $lno
2909 }
2910}
2911proc add_one_to_selection {w x y} {
2913 global file_lists
2914 global last_clicked selected_paths
2915 set pos [split [$w index @$x,$y] .]
2917 set lno [lindex $pos 0]
2918 set col [lindex $pos 1]
2919 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2920 if {$path eq {}} {
2921 set last_clicked {}
2922 return
2923 }
2924 set last_clicked [list $w $lno]
2926 if {[catch {set in_sel $selected_paths($path)}]} {
2927 set in_sel 0
2928 }
2929 if {$in_sel} {
2930 unset selected_paths($path)
2931 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2932 } else {
2933 set selected_paths($path) 1
2934 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2935 }
2936}
2937proc add_range_to_selection {w x y} {
2939 global file_lists
2940 global last_clicked selected_paths
2941 if {[lindex $last_clicked 0] ne $w} {
2943 toggle_or_diff $w $x $y
2944 return
2945 }
2946 set pos [split [$w index @$x,$y] .]
2948 set lno [lindex $pos 0]
2949 set lc [lindex $last_clicked 1]
2950 if {$lc < $lno} {
2951 set begin $lc
2952 set end $lno
2953 } else {
2954 set begin $lno
2955 set end $lc
2956 }
2957 foreach path [lrange $file_lists($w) \
2959 [expr {$begin - 1}] \
2960 [expr {$end - 1}]] {
2961 set selected_paths($path) 1
2962 }
2963 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2964}
2965######################################################################
2967##
2968## config defaults
2969set cursor_ptr arrow
2971font create font_diff -family Courier -size 10
2972font create font_ui
2973catch {
2974 label .dummy
2975 eval font configure font_ui [font actual [.dummy cget -font]]
2976 destroy .dummy
2977}
2978font create font_uibold
2980font create font_diffbold
2981if {[is_Windows]} {
2983 set M1B Control
2984 set M1T Ctrl
2985} elseif {[is_MacOSX]} {
2986 set M1B M1
2987 set M1T Cmd
2988} else {
2989 set M1B M1
2990 set M1T M1
2991}
2992proc apply_config {} {
2994 global repo_config font_descs
2995 foreach option $font_descs {
2997 set name [lindex $option 0]
2998 set font [lindex $option 1]
2999 if {[catch {
3000 foreach {cn cv} $repo_config(gui.$name) {
3001 font configure $font $cn $cv
3002 }
3003 } err]} {
3004 error_popup "Invalid font specified in gui.$name:\n\n$err"
3005 }
3006 foreach {cn cv} [font configure $font] {
3007 font configure ${font}bold $cn $cv
3008 }
3009 font configure ${font}bold -weight bold
3010 }
3011}
3012set default_config(gui.trustmtime) false
3014set default_config(gui.pullsummary) true
3015set default_config(gui.partialinclude) false
3016set default_config(gui.diffcontext) 5
3017set default_config(gui.fontui) [font configure font_ui]
3018set default_config(gui.fontdiff) [font configure font_diff]
3019set font_descs {
3020 {fontui font_ui {Main Font}}
3021 {fontdiff font_diff {Diff/Console Font}}
3022}
3023load_config 0
3024apply_config
3025######################################################################
3027##
3028## ui construction
3029# -- Menu Bar
3031#
3032menu .mbar -tearoff 0
3033.mbar add cascade -label Repository -menu .mbar.repository
3034.mbar add cascade -label Edit -menu .mbar.edit
3035if {!$single_commit} {
3036 .mbar add cascade -label Branch -menu .mbar.branch
3037}
3038.mbar add cascade -label Commit -menu .mbar.commit
3039if {!$single_commit} {
3040 .mbar add cascade -label Fetch -menu .mbar.fetch
3041 .mbar add cascade -label Pull -menu .mbar.pull
3042 .mbar add cascade -label Push -menu .mbar.push
3043}
3044. configure -menu .mbar
3045# -- Repository Menu
3047#
3048menu .mbar.repository
3049.mbar.repository add command \
3050 -label {Visualize Current Branch} \
3051 -command {do_gitk {}} \
3052 -font font_ui
3053if {![is_MacOSX]} {
3054 .mbar.repository add command \
3055 -label {Visualize All Branches} \
3056 -command {do_gitk {--all}} \
3057 -font font_ui
3058}
3059.mbar.repository add separator
3060if {!$single_commit} {
3062 .mbar.repository add command -label {Compress Database} \
3063 -command do_gc \
3064 -font font_ui
3065 .mbar.repository add command -label {Verify Database} \
3067 -command do_fsck_objects \
3068 -font font_ui
3069 .mbar.repository add separator
3071 if {[is_Windows]} {
3073 .mbar.repository add command \
3074 -label {Create Desktop Icon} \
3075 -command do_windows_shortcut \
3076 -font font_ui
3077 } elseif {[is_MacOSX]} {
3078 .mbar.repository add command \
3079 -label {Create Desktop Icon} \
3080 -command do_macosx_app \
3081 -font font_ui
3082 }
3083}
3084.mbar.repository add command -label Quit \
3086 -command do_quit \
3087 -accelerator $M1T-Q \
3088 -font font_ui
3089# -- Edit Menu
3091#
3092menu .mbar.edit
3093.mbar.edit add command -label Undo \
3094 -command {catch {[focus] edit undo}} \
3095 -accelerator $M1T-Z \
3096 -font font_ui
3097.mbar.edit add command -label Redo \
3098 -command {catch {[focus] edit redo}} \
3099 -accelerator $M1T-Y \
3100 -font font_ui
3101.mbar.edit add separator
3102.mbar.edit add command -label Cut \
3103 -command {catch {tk_textCut [focus]}} \
3104 -accelerator $M1T-X \
3105 -font font_ui
3106.mbar.edit add command -label Copy \
3107 -command {catch {tk_textCopy [focus]}} \
3108 -accelerator $M1T-C \
3109 -font font_ui
3110.mbar.edit add command -label Paste \
3111 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3112 -accelerator $M1T-V \
3113 -font font_ui
3114.mbar.edit add command -label Delete \
3115 -command {catch {[focus] delete sel.first sel.last}} \
3116 -accelerator Del \
3117 -font font_ui
3118.mbar.edit add separator
3119.mbar.edit add command -label {Select All} \
3120 -command {catch {[focus] tag add sel 0.0 end}} \
3121 -accelerator $M1T-A \
3122 -font font_ui
3123# -- Branch Menu
3125#
3126if {!$single_commit} {
3127 menu .mbar.branch
3128 .mbar.branch add command -label {Create...} \
3130 -command do_create_branch \
3131 -font font_ui
3132 lappend disable_on_lock [list .mbar.branch entryconf \
3133 [.mbar.branch index last] -state]
3134 .mbar.branch add command -label {Delete...} \
3136 -command do_delete_branch \
3137 -font font_ui
3138 lappend disable_on_lock [list .mbar.branch entryconf \
3139 [.mbar.branch index last] -state]
3140}
3141# -- Commit Menu
3143#
3144menu .mbar.commit
3145.mbar.commit add radiobutton \
3147 -label {New Commit} \
3148 -command do_select_commit_type \
3149 -variable selected_commit_type \
3150 -value new \
3151 -font font_ui
3152lappend disable_on_lock \
3153 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3154.mbar.commit add radiobutton \
3156 -label {Amend Last Commit} \
3157 -command do_select_commit_type \
3158 -variable selected_commit_type \
3159 -value amend \
3160 -font font_ui
3161lappend disable_on_lock \
3162 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3163.mbar.commit add separator
3165.mbar.commit add command -label Rescan \
3167 -command do_rescan \
3168 -accelerator F5 \
3169 -font font_ui
3170lappend disable_on_lock \
3171 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3172.mbar.commit add command -label {Add To Commit} \
3174 -command do_include_selection \
3175 -font font_ui
3176lappend disable_on_lock \
3177 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3178.mbar.commit add command -label {Add All To Commit} \
3180 -command do_include_all \
3181 -accelerator $M1T-I \
3182 -font font_ui
3183lappend disable_on_lock \
3184 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3185.mbar.commit add command -label {Remove From Commit} \
3187 -command do_remove_selection \
3188 -font font_ui
3189lappend disable_on_lock \
3190 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3191.mbar.commit add command -label {Revert Changes} \
3193 -command do_revert_selection \
3194 -font font_ui
3195lappend disable_on_lock \
3196 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3197.mbar.commit add separator
3199.mbar.commit add command -label {Sign Off} \
3201 -command do_signoff \
3202 -accelerator $M1T-S \
3203 -font font_ui
3204.mbar.commit add command -label Commit \
3206 -command do_commit \
3207 -accelerator $M1T-Return \
3208 -font font_ui
3209lappend disable_on_lock \
3210 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3211# -- Transport menus
3213#
3214if {!$single_commit} {
3215 menu .mbar.fetch
3216 menu .mbar.pull
3217 menu .mbar.push
3218}
3219if {[is_MacOSX]} {
3221 # -- Apple Menu (Mac OS X only)
3222 #
3223 .mbar add cascade -label Apple -menu .mbar.apple
3224 menu .mbar.apple
3225 .mbar.apple add command -label "About $appname" \
3227 -command do_about \
3228 -font font_ui
3229 .mbar.apple add command -label "$appname Options..." \
3230 -command do_options \
3231 -font font_ui
3232} else {
3233 # -- Edit Menu
3234 #
3235 .mbar.edit add separator
3236 .mbar.edit add command -label {Options...} \
3237 -command do_options \
3238 -font font_ui
3239 # -- Tools Menu
3241 #
3242 if {[file exists /usr/local/miga/lib/gui-miga]
3243 && [file exists .pvcsrc]} {
3244 proc do_miga {} {
3245 global gitdir ui_status_value
3246 if {![lock_index update]} return
3247 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3248 set miga_fd [open "|$cmd" r]
3249 fconfigure $miga_fd -blocking 0
3250 fileevent $miga_fd readable [list miga_done $miga_fd]
3251 set ui_status_value {Running miga...}
3252 }
3253 proc miga_done {fd} {
3254 read $fd 512
3255 if {[eof $fd]} {
3256 close $fd
3257 unlock_index
3258 rescan [list set ui_status_value {Ready.}]
3259 }
3260 }
3261 .mbar add cascade -label Tools -menu .mbar.tools
3262 menu .mbar.tools
3263 .mbar.tools add command -label "Migrate" \
3264 -command do_miga \
3265 -font font_ui
3266 lappend disable_on_lock \
3267 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3268 }
3269 # -- Help Menu
3271 #
3272 .mbar add cascade -label Help -menu .mbar.help
3273 menu .mbar.help
3274 .mbar.help add command -label "About $appname" \
3276 -command do_about \
3277 -font font_ui
3278}
3279# -- Branch Control
3282#
3283frame .branch \
3284 -borderwidth 1 \
3285 -relief sunken
3286label .branch.l1 \
3287 -text {Current Branch:} \
3288 -anchor w \
3289 -justify left \
3290 -font font_ui
3291label .branch.cb \
3292 -textvariable current_branch \
3293 -anchor w \
3294 -justify left \
3295 -font font_ui
3296pack .branch.l1 -side left
3297pack .branch.cb -side left -fill x
3298pack .branch -side top -fill x
3299# -- Main Window Layout
3301#
3302panedwindow .vpane -orient vertical
3303panedwindow .vpane.files -orient horizontal
3304.vpane add .vpane.files -sticky nsew -height 100 -width 400
3305pack .vpane -anchor n -side top -fill both -expand 1
3306# -- Index File List
3308#
3309frame .vpane.files.index -height 100 -width 400
3310label .vpane.files.index.title -text {Modified Files} \
3311 -background green \
3312 -font font_ui
3313text $ui_index -background white -borderwidth 0 \
3314 -width 40 -height 10 \
3315 -font font_ui \
3316 -cursor $cursor_ptr \
3317 -yscrollcommand {.vpane.files.index.sb set} \
3318 -state disabled
3319scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3320pack .vpane.files.index.title -side top -fill x
3321pack .vpane.files.index.sb -side right -fill y
3322pack $ui_index -side left -fill both -expand 1
3323.vpane.files add .vpane.files.index -sticky nsew
3324# -- Other (Add) File List
3326#
3327frame .vpane.files.other -height 100 -width 100
3328label .vpane.files.other.title -text {Untracked Files} \
3329 -background red \
3330 -font font_ui
3331text $ui_other -background white -borderwidth 0 \
3332 -width 40 -height 10 \
3333 -font font_ui \
3334 -cursor $cursor_ptr \
3335 -yscrollcommand {.vpane.files.other.sb set} \
3336 -state disabled
3337scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3338pack .vpane.files.other.title -side top -fill x
3339pack .vpane.files.other.sb -side right -fill y
3340pack $ui_other -side left -fill both -expand 1
3341.vpane.files add .vpane.files.other -sticky nsew
3342foreach i [list $ui_index $ui_other] {
3344 $i tag conf in_diff -font font_uibold
3345 $i tag conf in_sel \
3346 -background [$i cget -foreground] \
3347 -foreground [$i cget -background]
3348}
3349unset i
3350# -- Diff and Commit Area
3352#
3353frame .vpane.lower -height 300 -width 400
3354frame .vpane.lower.commarea
3355frame .vpane.lower.diff -relief sunken -borderwidth 1
3356pack .vpane.lower.commarea -side top -fill x
3357pack .vpane.lower.diff -side bottom -fill both -expand 1
3358.vpane add .vpane.lower -stick nsew
3359# -- Commit Area Buttons
3361#
3362frame .vpane.lower.commarea.buttons
3363label .vpane.lower.commarea.buttons.l -text {} \
3364 -anchor w \
3365 -justify left \
3366 -font font_ui
3367pack .vpane.lower.commarea.buttons.l -side top -fill x
3368pack .vpane.lower.commarea.buttons -side left -fill y
3369button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3371 -command do_rescan \
3372 -font font_ui
3373pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3374lappend disable_on_lock \
3375 {.vpane.lower.commarea.buttons.rescan conf -state}
3376button .vpane.lower.commarea.buttons.incall -text {Add All} \
3378 -command do_include_all \
3379 -font font_ui
3380pack .vpane.lower.commarea.buttons.incall -side top -fill x
3381lappend disable_on_lock \
3382 {.vpane.lower.commarea.buttons.incall conf -state}
3383button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3385 -command do_signoff \
3386 -font font_ui
3387pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3388button .vpane.lower.commarea.buttons.commit -text {Commit} \
3390 -command do_commit \
3391 -font font_ui
3392pack .vpane.lower.commarea.buttons.commit -side top -fill x
3393lappend disable_on_lock \
3394 {.vpane.lower.commarea.buttons.commit conf -state}
3395# -- Commit Message Buffer
3397#
3398frame .vpane.lower.commarea.buffer
3399frame .vpane.lower.commarea.buffer.header
3400set ui_comm .vpane.lower.commarea.buffer.t
3401set ui_coml .vpane.lower.commarea.buffer.header.l
3402radiobutton .vpane.lower.commarea.buffer.header.new \
3403 -text {New Commit} \
3404 -command do_select_commit_type \
3405 -variable selected_commit_type \
3406 -value new \
3407 -font font_ui
3408lappend disable_on_lock \
3409 [list .vpane.lower.commarea.buffer.header.new conf -state]
3410radiobutton .vpane.lower.commarea.buffer.header.amend \
3411 -text {Amend Last Commit} \
3412 -command do_select_commit_type \
3413 -variable selected_commit_type \
3414 -value amend \
3415 -font font_ui
3416lappend disable_on_lock \
3417 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3418label $ui_coml \
3419 -anchor w \
3420 -justify left \
3421 -font font_ui
3422proc trace_commit_type {varname args} {
3423 global ui_coml commit_type
3424 switch -glob -- $commit_type {
3425 initial {set txt {Initial Commit Message:}}
3426 amend {set txt {Amended Commit Message:}}
3427 amend-initial {set txt {Amended Initial Commit Message:}}
3428 amend-merge {set txt {Amended Merge Commit Message:}}
3429 merge {set txt {Merge Commit Message:}}
3430 * {set txt {Commit Message:}}
3431 }
3432 $ui_coml conf -text $txt
3433}
3434trace add variable commit_type write trace_commit_type
3435pack $ui_coml -side left -fill x
3436pack .vpane.lower.commarea.buffer.header.amend -side right
3437pack .vpane.lower.commarea.buffer.header.new -side right
3438text $ui_comm -background white -borderwidth 1 \
3440 -undo true \
3441 -maxundo 20 \
3442 -autoseparators true \
3443 -relief sunken \
3444 -width 75 -height 9 -wrap none \
3445 -font font_diff \
3446 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3447scrollbar .vpane.lower.commarea.buffer.sby \
3448 -command [list $ui_comm yview]
3449pack .vpane.lower.commarea.buffer.header -side top -fill x
3450pack .vpane.lower.commarea.buffer.sby -side right -fill y
3451pack $ui_comm -side left -fill y
3452pack .vpane.lower.commarea.buffer -side left -fill y
3453# -- Commit Message Buffer Context Menu
3455#
3456set ctxm .vpane.lower.commarea.buffer.ctxm
3457menu $ctxm -tearoff 0
3458$ctxm add command \
3459 -label {Cut} \
3460 -font font_ui \
3461 -command {tk_textCut $ui_comm}
3462$ctxm add command \
3463 -label {Copy} \
3464 -font font_ui \
3465 -command {tk_textCopy $ui_comm}
3466$ctxm add command \
3467 -label {Paste} \
3468 -font font_ui \
3469 -command {tk_textPaste $ui_comm}
3470$ctxm add command \
3471 -label {Delete} \
3472 -font font_ui \
3473 -command {$ui_comm delete sel.first sel.last}
3474$ctxm add separator
3475$ctxm add command \
3476 -label {Select All} \
3477 -font font_ui \
3478 -command {$ui_comm tag add sel 0.0 end}
3479$ctxm add command \
3480 -label {Copy All} \
3481 -font font_ui \
3482 -command {
3483 $ui_comm tag add sel 0.0 end
3484 tk_textCopy $ui_comm
3485 $ui_comm tag remove sel 0.0 end
3486 }
3487$ctxm add separator
3488$ctxm add command \
3489 -label {Sign Off} \
3490 -font font_ui \
3491 -command do_signoff
3492bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3493# -- Diff Header
3495#
3496set current_diff {}
3497set diff_actions [list]
3498proc trace_current_diff {varname args} {
3499 global current_diff diff_actions file_states
3500 if {$current_diff eq {}} {
3501 set s {}
3502 set f {}
3503 set p {}
3504 set o disabled
3505 } else {
3506 set p $current_diff
3507 set s [mapdesc [lindex $file_states($p) 0] $p]
3508 set f {File:}
3509 set p [escape_path $p]
3510 set o normal
3511 }
3512 .vpane.lower.diff.header.status configure -text $s
3514 .vpane.lower.diff.header.file configure -text $f
3515 .vpane.lower.diff.header.path configure -text $p
3516 foreach w $diff_actions {
3517 uplevel #0 $w $o
3518 }
3519}
3520trace add variable current_diff write trace_current_diff
3521frame .vpane.lower.diff.header -background orange
3523label .vpane.lower.diff.header.status \
3524 -background orange \
3525 -width $max_status_desc \
3526 -anchor w \
3527 -justify left \
3528 -font font_ui
3529label .vpane.lower.diff.header.file \
3530 -background orange \
3531 -anchor w \
3532 -justify left \
3533 -font font_ui
3534label .vpane.lower.diff.header.path \
3535 -background orange \
3536 -anchor w \
3537 -justify left \
3538 -font font_ui
3539pack .vpane.lower.diff.header.status -side left
3540pack .vpane.lower.diff.header.file -side left
3541pack .vpane.lower.diff.header.path -fill x
3542set ctxm .vpane.lower.diff.header.ctxm
3543menu $ctxm -tearoff 0
3544$ctxm add command \
3545 -label {Copy} \
3546 -font font_ui \
3547 -command {
3548 clipboard clear
3549 clipboard append \
3550 -format STRING \
3551 -type STRING \
3552 -- $current_diff
3553 }
3554lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3555bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3556# -- Diff Body
3558#
3559frame .vpane.lower.diff.body
3560set ui_diff .vpane.lower.diff.body.t
3561text $ui_diff -background white -borderwidth 0 \
3562 -width 80 -height 15 -wrap none \
3563 -font font_diff \
3564 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3565 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3566 -state disabled
3567scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3568 -command [list $ui_diff xview]
3569scrollbar .vpane.lower.diff.body.sby -orient vertical \
3570 -command [list $ui_diff yview]
3571pack .vpane.lower.diff.body.sbx -side bottom -fill x
3572pack .vpane.lower.diff.body.sby -side right -fill y
3573pack $ui_diff -side left -fill both -expand 1
3574pack .vpane.lower.diff.header -side top -fill x
3575pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3576$ui_diff tag conf d_@ -font font_diffbold
3578$ui_diff tag conf d_+ -foreground blue
3579$ui_diff tag conf d_- -foreground red
3580$ui_diff tag conf d_++ -foreground {#00a000}
3581$ui_diff tag conf d_-- -foreground {#a000a0}
3582$ui_diff tag conf d_+- \
3583 -foreground red \
3584 -background {light goldenrod yellow}
3585$ui_diff tag conf d_-+ \
3586 -foreground blue \
3587 -background azure2
3588# -- Diff Body Context Menu
3590#
3591set ctxm .vpane.lower.diff.body.ctxm
3592menu $ctxm -tearoff 0
3593$ctxm add command \
3594 -label {Copy} \
3595 -font font_ui \
3596 -command {tk_textCopy $ui_diff}
3597lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3598$ctxm add command \
3599 -label {Select All} \
3600 -font font_ui \
3601 -command {$ui_diff tag add sel 0.0 end}
3602lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3603$ctxm add command \
3604 -label {Copy All} \
3605 -font font_ui \
3606 -command {
3607 $ui_diff tag add sel 0.0 end
3608 tk_textCopy $ui_diff
3609 $ui_diff tag remove sel 0.0 end
3610 }
3611lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3612$ctxm add separator
3613$ctxm add command \
3614 -label {Decrease Font Size} \
3615 -font font_ui \
3616 -command {incr_font_size font_diff -1}
3617lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3618$ctxm add command \
3619 -label {Increase Font Size} \
3620 -font font_ui \
3621 -command {incr_font_size font_diff 1}
3622lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3623$ctxm add separator
3624$ctxm add command \
3625 -label {Show Less Context} \
3626 -font font_ui \
3627 -command {if {$repo_config(gui.diffcontext) >= 2} {
3628 incr repo_config(gui.diffcontext) -1
3629 reshow_diff
3630 }}
3631lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3632$ctxm add command \
3633 -label {Show More Context} \
3634 -font font_ui \
3635 -command {
3636 incr repo_config(gui.diffcontext)
3637 reshow_diff
3638 }
3639lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3640$ctxm add separator
3641$ctxm add command -label {Options...} \
3642 -font font_ui \
3643 -command do_options
3644bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3645# -- Status Bar
3647#
3648set ui_status_value {Initializing...}
3649label .status -textvariable ui_status_value \
3650 -anchor w \
3651 -justify left \
3652 -borderwidth 1 \
3653 -relief sunken \
3654 -font font_ui
3655pack .status -anchor w -side bottom -fill x
3656# -- Load geometry
3658#
3659catch {
3660set gm $repo_config(gui.geometry)
3661wm geometry . [lindex $gm 0]
3662.vpane sash place 0 \
3663 [lindex [.vpane sash coord 0] 0] \
3664 [lindex $gm 1]
3665.vpane.files sash place 0 \
3666 [lindex $gm 2] \
3667 [lindex [.vpane.files sash coord 0] 1]
3668unset gm
3669}
3670# -- Key Bindings
3672#
3673bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3674bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3675bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3676bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3677bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3678bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3679bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3680bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3681bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3682bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3683bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3684bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3686bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3687bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3688bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3689bind $ui_diff <$M1B-Key-v> {break}
3690bind $ui_diff <$M1B-Key-V> {break}
3691bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3692bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3693bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3694bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3695bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3696bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3697bind . <Destroy> do_quit
3699bind all <Key-F5> do_rescan
3700bind all <$M1B-Key-r> do_rescan
3701bind all <$M1B-Key-R> do_rescan
3702bind . <$M1B-Key-s> do_signoff
3703bind . <$M1B-Key-S> do_signoff
3704bind . <$M1B-Key-i> do_include_all
3705bind . <$M1B-Key-I> do_include_all
3706bind . <$M1B-Key-Return> do_commit
3707bind all <$M1B-Key-q> do_quit
3708bind all <$M1B-Key-Q> do_quit
3709bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3710bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3711foreach i [list $ui_index $ui_other] {
3712 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3713 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3714 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3715}
3716unset i
3717set file_lists($ui_index) [list]
3719set file_lists($ui_other) [list]
3720set HEAD {}
3722set PARENT {}
3723set MERGE_HEAD [list]
3724set commit_type {}
3725set empty_tree {}
3726set current_branch {}
3727set current_diff {}
3728set selected_commit_type new
3729wm title . "$appname ([file normalize [file dirname $gitdir]])"
3731focus -force $ui_comm
3732# -- Warn the user about environmental problems. Cygwin's Tcl
3734# does *not* pass its env array onto any processes it spawns.
3735# This means that git processes get none of our environment.
3736#
3737if {[is_Windows]} {
3738 set ignored_env 0
3739 set suggest_user {}
3740 set msg "Possible environment issues exist.
3741The following environment variables are probably
3743going to be ignored by any Git subprocess run
3744by $appname:
3745"
3747 foreach name [array names env] {
3748 switch -regexp -- $name {
3749 {^GIT_INDEX_FILE$} -
3750 {^GIT_OBJECT_DIRECTORY$} -
3751 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3752 {^GIT_DIFF_OPTS$} -
3753 {^GIT_EXTERNAL_DIFF$} -
3754 {^GIT_PAGER$} -
3755 {^GIT_TRACE$} -
3756 {^GIT_CONFIG$} -
3757 {^GIT_CONFIG_LOCAL$} -
3758 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3759 append msg " - $name\n"
3760 incr ignored_env
3761 }
3762 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3763 append msg " - $name\n"
3764 incr ignored_env
3765 set suggest_user $name
3766 }
3767 }
3768 }
3769 if {$ignored_env > 0} {
3770 append msg "
3771This is due to a known issue with the
3772Tcl binary distributed by Cygwin."
3773 if {$suggest_user ne {}} {
3775 append msg "
3776A good replacement for $suggest_user
3778is placing values for the user.name and
3779user.email settings into your personal
3780~/.gitconfig file.
3781"
3782 }
3783 warn_popup $msg
3784 }
3785 unset ignored_env msg suggest_user name
3786}
3787# -- Only initialize complex UI if we are going to stay running.
3789#
3790if {!$single_commit} {
3791 load_all_remotes
3792 load_all_heads
3793 populate_branch_menu .mbar.branch
3795 populate_fetch_menu .mbar.fetch
3796 populate_pull_menu .mbar.pull
3797 populate_push_menu .mbar.push
3798}
3799# -- Only suggest a gc run if we are going to stay running.
3801#
3802if {!$single_commit} {
3803 set object_limit 2000
3804 if {[is_Windows]} {set object_limit 200}
3805 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3806 if {$objects_current >= $object_limit} {
3807 if {[ask_popup \
3808 "This repository currently has $objects_current loose objects.
3809To maintain optimal performance it is strongly
3811recommended that you compress the database
3812when more than $object_limit loose objects exist.
3813Compress the database now?"] eq yes} {
3815 do_gc
3816 }
3817 }
3818 unset object_limit _junk objects_current
3819}
3820lock_index begin-read
3822after 1 do_rescan