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