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 {honor_trustmtime 1}} {
339 global HEAD PARENT MERGE_HEAD commit_type
340 global ui_index ui_workdir ui_status_value ui_comm
341 global rescan_active file_states
342 global repo_config
343 if {$rescan_active > 0 || ![lock_index read]} return
345 repository_state newType newHEAD newMERGE_HEAD
347 if {[string match amend* $commit_type]
348 && $newType eq {normal}
349 && $newHEAD eq $HEAD} {
350 } else {
351 set HEAD $newHEAD
352 set PARENT $newHEAD
353 set MERGE_HEAD $newMERGE_HEAD
354 set commit_type $newType
355 }
356 array unset file_states
358 if {![$ui_comm edit modified]
360 || [string trim [$ui_comm get 0.0 end]] eq {}} {
361 if {[load_message GITGUI_MSG]} {
362 } elseif {[load_message MERGE_MSG]} {
363 } elseif {[load_message SQUASH_MSG]} {
364 }
365 $ui_comm edit reset
366 $ui_comm edit modified false
367 }
368 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
370 rescan_stage2 {} $after
371 } else {
372 set rescan_active 1
373 set ui_status_value {Refreshing file status...}
374 set cmd [list git update-index]
375 lappend cmd -q
376 lappend cmd --unmerged
377 lappend cmd --ignore-missing
378 lappend cmd --refresh
379 set fd_rf [open "| $cmd" r]
380 fconfigure $fd_rf -blocking 0 -translation binary
381 fileevent $fd_rf readable \
382 [list rescan_stage2 $fd_rf $after]
383 }
384}
385proc rescan_stage2 {fd after} {
387 global ui_status_value
388 global rescan_active buf_rdi buf_rdf buf_rlo
389 if {$fd ne {}} {
391 read $fd
392 if {![eof $fd]} return
393 close $fd
394 }
395 set ls_others [list | git ls-files --others -z \
397 --exclude-per-directory=.gitignore]
398 set info_exclude [gitdir info exclude]
399 if {[file readable $info_exclude]} {
400 lappend ls_others "--exclude-from=$info_exclude"
401 }
402 set buf_rdi {}
404 set buf_rdf {}
405 set buf_rlo {}
406 set rescan_active 3
408 set ui_status_value {Scanning for modified files ...}
409 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
410 set fd_df [open "| git diff-files -z" r]
411 set fd_lo [open $ls_others r]
412 fconfigure $fd_di -blocking 0 -translation binary
414 fconfigure $fd_df -blocking 0 -translation binary
415 fconfigure $fd_lo -blocking 0 -translation binary
416 fileevent $fd_di readable [list read_diff_index $fd_di $after]
417 fileevent $fd_df readable [list read_diff_files $fd_df $after]
418 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
419}
420proc load_message {file} {
422 global ui_comm
423 set f [gitdir $file]
425 if {[file isfile $f]} {
426 if {[catch {set fd [open $f r]}]} {
427 return 0
428 }
429 set content [string trim [read $fd]]
430 close $fd
431 $ui_comm delete 0.0 end
432 $ui_comm insert end $content
433 return 1
434 }
435 return 0
436}
437proc read_diff_index {fd after} {
439 global buf_rdi
440 append buf_rdi [read $fd]
442 set c 0
443 set n [string length $buf_rdi]
444 while {$c < $n} {
445 set z1 [string first "\0" $buf_rdi $c]
446 if {$z1 == -1} break
447 incr z1
448 set z2 [string first "\0" $buf_rdi $z1]
449 if {$z2 == -1} break
450 incr c
452 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
453 merge_state \
454 [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
455 [lindex $i 4]? \
456 [list [lindex $i 0] [lindex $i 2]] \
457 [list]
458 set c $z2
459 incr c
460 }
461 if {$c < $n} {
462 set buf_rdi [string range $buf_rdi $c end]
463 } else {
464 set buf_rdi {}
465 }
466 rescan_done $fd buf_rdi $after
468}
469proc read_diff_files {fd after} {
471 global buf_rdf
472 append buf_rdf [read $fd]
474 set c 0
475 set n [string length $buf_rdf]
476 while {$c < $n} {
477 set z1 [string first "\0" $buf_rdf $c]
478 if {$z1 == -1} break
479 incr z1
480 set z2 [string first "\0" $buf_rdf $z1]
481 if {$z2 == -1} break
482 incr c
484 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
485 merge_state \
486 [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
487 ?[lindex $i 4] \
488 [list] \
489 [list [lindex $i 0] [lindex $i 2]]
490 set c $z2
491 incr c
492 }
493 if {$c < $n} {
494 set buf_rdf [string range $buf_rdf $c end]
495 } else {
496 set buf_rdf {}
497 }
498 rescan_done $fd buf_rdf $after
500}
501proc read_ls_others {fd after} {
503 global buf_rlo
504 append buf_rlo [read $fd]
506 set pck [split $buf_rlo "\0"]
507 set buf_rlo [lindex $pck end]
508 foreach p [lrange $pck 0 end-1] {
509 merge_state $p ?O
510 }
511 rescan_done $fd buf_rlo $after
512}
513proc rescan_done {fd buf after} {
515 global rescan_active
516 global file_states repo_config
517 upvar $buf to_clear
518 if {![eof $fd]} return
520 set to_clear {}
521 close $fd
522 if {[incr rescan_active -1] > 0} return
523 prune_selection
525 unlock_index
526 display_all_files
527 reshow_diff
528 uplevel #0 $after
529}
530proc prune_selection {} {
532 global file_states selected_paths
533 foreach path [array names selected_paths] {
535 if {[catch {set still_here $file_states($path)}]} {
536 unset selected_paths($path)
537 }
538 }
539}
540######################################################################
542##
543## diff
544proc clear_diff {} {
546 global ui_diff current_diff_path ui_index ui_workdir
547 $ui_diff conf -state normal
549 $ui_diff delete 0.0 end
550 $ui_diff conf -state disabled
551 set current_diff_path {}
553 $ui_index tag remove in_diff 0.0 end
555 $ui_workdir tag remove in_diff 0.0 end
556}
557proc reshow_diff {} {
559 global ui_status_value file_states file_lists
560 global current_diff_path current_diff_side
561 set p $current_diff_path
563 if {$p eq {}
564 || $current_diff_side eq {}
565 || [catch {set s $file_states($p)}]
566 || [lsearch -sorted $file_lists($current_diff_side) $p] == -1} {
567 clear_diff
568 } else {
569 show_diff $p $current_diff_side
570 }
571}
572proc handle_empty_diff {} {
574 global current_diff_path file_states file_lists
575 set path $current_diff_path
577 set s $file_states($path)
578 if {[lindex $s 0] ne {_M}} return
579 info_popup "No differences detected.
581[short_path $path] has no changes.
583The modification date of this file was updated
585by another application and you currently have
586the Trust File Modification Timestamps option
587enabled, so Git did not automatically detect
588that there are no content differences in this
589file."
590 clear_diff
592 display_file $path __
593 rescan {set ui_status_value {Ready.}} 0
594}
595proc show_diff {path w {lno {}}} {
597 global file_states file_lists
598 global is_3way_diff diff_active repo_config
599 global ui_diff ui_status_value ui_index ui_workdir
600 global current_diff_path current_diff_side
601 if {$diff_active || ![lock_index read]} return
603 clear_diff
605 if {$w eq {} || $lno == {}} {
606 foreach w [array names file_lists] {
607 set lno [lsearch -sorted $file_lists($w) $path]
608 if {$lno >= 0} {
609 incr lno
610 break
611 }
612 }
613 }
614 if {$w ne {} && $lno >= 1} {
615 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
616 }
617 set s $file_states($path)
619 set m [lindex $s 0]
620 set is_3way_diff 0
621 set diff_active 1
622 set current_diff_path $path
623 set current_diff_side $w
624 set ui_status_value "Loading diff of [escape_path $path]..."
625 # - Git won't give us the diff, there's nothing to compare to!
627 #
628 if {$m eq {_O}} {
629 if {[catch {
630 set fd [open $path r]
631 set content [read $fd]
632 close $fd
633 } err ]} {
634 set diff_active 0
635 unlock_index
636 set ui_status_value "Unable to display [escape_path $path]"
637 error_popup "Error loading file:\n\n$err"
638 return
639 }
640 $ui_diff conf -state normal
641 $ui_diff insert end $content
642 $ui_diff conf -state disabled
643 set diff_active 0
644 unlock_index
645 set ui_status_value {Ready.}
646 return
647 }
648 set cmd [list | git]
650 if {$w eq $ui_index} {
651 lappend cmd diff-index
652 lappend cmd --cached
653 } elseif {$w eq $ui_workdir} {
654 if {[string index $m 0] eq {U}} {
655 lappend cmd diff
656 } else {
657 lappend cmd diff-files
658 }
659 }
660 lappend cmd -p
662 lappend cmd --no-color
663 if {$repo_config(gui.diffcontext) > 0} {
664 lappend cmd "-U$repo_config(gui.diffcontext)"
665 }
666 if {$w eq $ui_index} {
667 lappend cmd [PARENT]
668 }
669 lappend cmd --
670 lappend cmd $path
671 if {[catch {set fd [open $cmd r]} err]} {
673 set diff_active 0
674 unlock_index
675 set ui_status_value "Unable to display [escape_path $path]"
676 error_popup "Error loading diff:\n\n$err"
677 return
678 }
679 fconfigure $fd -blocking 0 -translation auto
681 fileevent $fd readable [list read_diff $fd]
682}
683proc read_diff {fd} {
685 global ui_diff ui_status_value is_3way_diff diff_active
686 global repo_config
687 $ui_diff conf -state normal
689 while {[gets $fd line] >= 0} {
690 # -- Cleanup uninteresting diff header lines.
691 #
692 if {[string match {diff --git *} $line]} continue
693 if {[string match {diff --cc *} $line]} continue
694 if {[string match {diff --combined *} $line]} continue
695 if {[string match {--- *} $line]} continue
696 if {[string match {+++ *} $line]} continue
697 if {$line eq {deleted file mode 120000}} {
698 set line "deleted symlink"
699 }
700 # -- Automatically detect if this is a 3 way diff.
702 #
703 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
704 if {[string match {index *} $line]
706 || [string match {mode *} $line]
707 || [string match {new file *} $line]
708 || [string match {deleted file *} $line]
709 || [regexp {^\* Unmerged path } $line]} {
710 set tags {}
711 } elseif {$is_3way_diff} {
712 set op [string range $line 0 1]
713 switch -- $op {
714 { } {set tags {}}
715 {@@} {set tags d_@}
716 { +} {set tags d_s+}
717 { -} {set tags d_s-}
718 {+ } {set tags d_+s}
719 {- } {set tags d_-s}
720 {--} {set tags d_--}
721 {++} {
722 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
723 set line [string replace $line 0 1 { }]
724 set tags d$op
725 } else {
726 set tags d_++
727 }
728 }
729 default {
730 puts "error: Unhandled 3 way diff marker: {$op}"
731 set tags {}
732 }
733 }
734 } else {
735 set op [string index $line 0]
736 switch -- $op {
737 { } {set tags {}}
738 {@} {set tags d_@}
739 {-} {set tags d_-}
740 {+} {
741 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
742 set line [string replace $line 0 0 { }]
743 set tags d$op
744 } else {
745 set tags d_+
746 }
747 }
748 default {
749 puts "error: Unhandled 2 way diff marker: {$op}"
750 set tags {}
751 }
752 }
753 }
754 $ui_diff insert end $line $tags
755 $ui_diff insert end "\n" $tags
756 }
757 $ui_diff conf -state disabled
758 if {[eof $fd]} {
760 close $fd
761 set diff_active 0
762 unlock_index
763 set ui_status_value {Ready.}
764 if {$repo_config(gui.trustmtime) eq {true}
766 && [$ui_diff index end] eq {2.0}} {
767 handle_empty_diff
768 }
769 }
770}
771######################################################################
773##
774## commit
775proc load_last_commit {} {
777 global HEAD PARENT MERGE_HEAD commit_type ui_comm
778 if {[llength $PARENT] == 0} {
780 error_popup {There is nothing to amend.
781You are about to create the initial commit.
783There is no commit before this to amend.
784}
785 return
786 }
787 repository_state curType curHEAD curMERGE_HEAD
789 if {$curType eq {merge}} {
790 error_popup {Cannot amend while merging.
791You are currently in the middle of a merge that
793has not been fully completed. You cannot amend
794the prior commit unless you first abort the
795current merge activity.
796}
797 return
798 }
799 set msg {}
801 set parents [list]
802 if {[catch {
803 set fd [open "| git cat-file commit $curHEAD" r]
804 while {[gets $fd line] > 0} {
805 if {[string match {parent *} $line]} {
806 lappend parents [string range $line 7 end]
807 }
808 }
809 set msg [string trim [read $fd]]
810 close $fd
811 } err]} {
812 error_popup "Error loading commit data for amend:\n\n$err"
813 return
814 }
815 set HEAD $curHEAD
817 set PARENT $parents
818 set MERGE_HEAD [list]
819 switch -- [llength $parents] {
820 0 {set commit_type amend-initial}
821 1 {set commit_type amend}
822 default {set commit_type amend-merge}
823 }
824 $ui_comm delete 0.0 end
826 $ui_comm insert end $msg
827 $ui_comm edit reset
828 $ui_comm edit modified false
829 rescan {set ui_status_value {Ready.}}
830}
831proc create_new_commit {} {
833 global commit_type ui_comm
834 set commit_type normal
836 $ui_comm delete 0.0 end
837 $ui_comm edit reset
838 $ui_comm edit modified false
839 rescan {set ui_status_value {Ready.}}
840}
841set GIT_COMMITTER_IDENT {}
843proc committer_ident {} {
845 global GIT_COMMITTER_IDENT
846 if {$GIT_COMMITTER_IDENT eq {}} {
848 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
849 error_popup "Unable to obtain your identity:\n\n$err"
850 return {}
851 }
852 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
853 $me me GIT_COMMITTER_IDENT]} {
854 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
855 return {}
856 }
857 }
858 return $GIT_COMMITTER_IDENT
860}
861proc commit_tree {} {
863 global HEAD commit_type file_states ui_comm repo_config
864 global ui_status_value pch_error
865 if {![lock_index update]} return
867 if {[committer_ident] eq {}} return
868 # -- Our in memory state should match the repository.
870 #
871 repository_state curType curHEAD curMERGE_HEAD
872 if {[string match amend* $commit_type]
873 && $curType eq {normal}
874 && $curHEAD eq $HEAD} {
875 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
876 info_popup {Last scanned state does not match repository state.
877Another Git program has modified this repository
879since the last scan. A rescan must be performed
880before another commit can be created.
881The rescan will be automatically started now.
883}
884 unlock_index
885 rescan {set ui_status_value {Ready.}}
886 return
887 }
888 # -- At least one file should differ in the index.
890 #
891 set files_ready 0
892 foreach path [array names file_states] {
893 switch -glob -- [lindex $file_states($path) 0] {
894 _? {continue}
895 A? -
896 D? -
897 M? {set files_ready 1}
898 U? {
899 error_popup "Unmerged files cannot be committed.
900File [short_path $path] has merge conflicts.
902You must resolve them and add the file before committing.
903"
904 unlock_index
905 return
906 }
907 default {
908 error_popup "Unknown file state [lindex $s 0] detected.
909File [short_path $path] cannot be committed by this program.
911"
912 }
913 }
914 }
915 if {!$files_ready} {
916 info_popup {No changes to commit.
917You must add at least 1 file before you can commit.
919}
920 unlock_index
921 return
922 }
923 # -- A message is required.
925 #
926 set msg [string trim [$ui_comm get 1.0 end]]
927 if {$msg eq {}} {
928 error_popup {Please supply a commit message.
929A good commit message has the following format:
931- First line: Describe in one sentance what you did.
933- Second line: Blank
934- Remaining lines: Describe why this change is good.
935}
936 unlock_index
937 return
938 }
939 # -- Run the pre-commit hook.
941 #
942 set pchook [gitdir hooks pre-commit]
943 # On Cygwin [file executable] might lie so we need to ask
945 # the shell if the hook is executable. Yes that's annoying.
946 #
947 if {[is_Windows] && [file isfile $pchook]} {
948 set pchook [list sh -c [concat \
949 "if test -x \"$pchook\";" \
950 "then exec \"$pchook\" 2>&1;" \
951 "fi"]]
952 } elseif {[file executable $pchook]} {
953 set pchook [list $pchook |& cat]
954 } else {
955 commit_writetree $curHEAD $msg
956 return
957 }
958 set ui_status_value {Calling pre-commit hook...}
960 set pch_error {}
961 set fd_ph [open "| $pchook" r]
962 fconfigure $fd_ph -blocking 0 -translation binary
963 fileevent $fd_ph readable \
964 [list commit_prehook_wait $fd_ph $curHEAD $msg]
965}
966proc commit_prehook_wait {fd_ph curHEAD msg} {
968 global pch_error ui_status_value
969 append pch_error [read $fd_ph]
971 fconfigure $fd_ph -blocking 1
972 if {[eof $fd_ph]} {
973 if {[catch {close $fd_ph}]} {
974 set ui_status_value {Commit declined by pre-commit hook.}
975 hook_failed_popup pre-commit $pch_error
976 unlock_index
977 } else {
978 commit_writetree $curHEAD $msg
979 }
980 set pch_error {}
981 return
982 }
983 fconfigure $fd_ph -blocking 0
984}
985proc commit_writetree {curHEAD msg} {
987 global ui_status_value
988 set ui_status_value {Committing changes...}
990 set fd_wt [open "| git write-tree" r]
991 fileevent $fd_wt readable \
992 [list commit_committree $fd_wt $curHEAD $msg]
993}
994proc commit_committree {fd_wt curHEAD msg} {
996 global HEAD PARENT MERGE_HEAD commit_type
997 global single_commit all_heads current_branch
998 global ui_status_value ui_comm selected_commit_type
999 global file_states selected_paths rescan_active
1000 gets $fd_wt tree_id
1002 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1003 error_popup "write-tree failed:\n\n$err"
1004 set ui_status_value {Commit failed.}
1005 unlock_index
1006 return
1007 }
1008 # -- Create the commit.
1010 #
1011 set cmd [list git commit-tree $tree_id]
1012 set parents [concat $PARENT $MERGE_HEAD]
1013 if {[llength $parents] > 0} {
1014 foreach p $parents {
1015 lappend cmd -p $p
1016 }
1017 } else {
1018 # git commit-tree writes to stderr during initial commit.
1019 lappend cmd 2>/dev/null
1020 }
1021 lappend cmd << $msg
1022 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1023 error_popup "commit-tree failed:\n\n$err"
1024 set ui_status_value {Commit failed.}
1025 unlock_index
1026 return
1027 }
1028 # -- Update the HEAD ref.
1030 #
1031 set reflogm commit
1032 if {$commit_type ne {normal}} {
1033 append reflogm " ($commit_type)"
1034 }
1035 set i [string first "\n" $msg]
1036 if {$i >= 0} {
1037 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1038 } else {
1039 append reflogm {: } $msg
1040 }
1041 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1042 if {[catch {eval exec $cmd} err]} {
1043 error_popup "update-ref failed:\n\n$err"
1044 set ui_status_value {Commit failed.}
1045 unlock_index
1046 return
1047 }
1048 # -- Make sure our current branch exists.
1050 #
1051 if {$commit_type eq {initial}} {
1052 lappend all_heads $current_branch
1053 set all_heads [lsort -unique $all_heads]
1054 populate_branch_menu
1055 }
1056 # -- Cleanup after ourselves.
1058 #
1059 catch {file delete [gitdir MERGE_HEAD]}
1060 catch {file delete [gitdir MERGE_MSG]}
1061 catch {file delete [gitdir SQUASH_MSG]}
1062 catch {file delete [gitdir GITGUI_MSG]}
1063 # -- Let rerere do its thing.
1065 #
1066 if {[file isdirectory [gitdir rr-cache]]} {
1067 catch {exec git rerere}
1068 }
1069 # -- Run the post-commit hook.
1071 #
1072 set pchook [gitdir hooks post-commit]
1073 if {[is_Windows] && [file isfile $pchook]} {
1074 set pchook [list sh -c [concat \
1075 "if test -x \"$pchook\";" \
1076 "then exec \"$pchook\";" \
1077 "fi"]]
1078 } elseif {![file executable $pchook]} {
1079 set pchook {}
1080 }
1081 if {$pchook ne {}} {
1082 catch {exec $pchook &}
1083 }
1084 $ui_comm delete 0.0 end
1086 $ui_comm edit reset
1087 $ui_comm edit modified false
1088 if {$single_commit} do_quit
1090 # -- Update in memory status
1092 #
1093 set selected_commit_type new
1094 set commit_type normal
1095 set HEAD $cmt_id
1096 set PARENT $cmt_id
1097 set MERGE_HEAD [list]
1098 foreach path [array names file_states] {
1100 set s $file_states($path)
1101 set m [lindex $s 0]
1102 switch -glob -- $m {
1103 _O -
1104 _M -
1105 _D {continue}
1106 __ -
1107 A_ -
1108 M_ -
1109 D_ {
1110 unset file_states($path)
1111 catch {unset selected_paths($path)}
1112 }
1113 DO {
1114 set file_states($path) [list _O [lindex $s 1] {} {}]
1115 }
1116 AM -
1117 AD -
1118 MM -
1119 MD {
1120 set file_states($path) [list \
1121 _[string index $m 1] \
1122 [lindex $s 1] \
1123 [lindex $s 3] \
1124 {}]
1125 }
1126 }
1127 }
1128 display_all_files
1130 unlock_index
1131 reshow_diff
1132 set ui_status_value \
1133 "Changes committed as [string range $cmt_id 0 7]."
1134}
1135######################################################################
1137##
1138## fetch pull push
1139proc fetch_from {remote} {
1141 set w [new_console "fetch $remote" \
1142 "Fetching new changes from $remote"]
1143 set cmd [list git fetch]
1144 lappend cmd $remote
1145 console_exec $w $cmd
1146}
1147proc pull_remote {remote branch} {
1149 global HEAD commit_type file_states repo_config
1150 if {![lock_index update]} return
1152 # -- Our in memory state should match the repository.
1154 #
1155 repository_state curType curHEAD curMERGE_HEAD
1156 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1157 info_popup {Last scanned state does not match repository state.
1158Another Git program has modified this repository
1160since the last scan. A rescan must be performed
1161before a pull operation can be started.
1162The rescan will be automatically started now.
1164}
1165 unlock_index
1166 rescan {set ui_status_value {Ready.}}
1167 return
1168 }
1169 # -- No differences should exist before a pull.
1171 #
1172 if {[array size file_states] != 0} {
1173 error_popup {Uncommitted but modified files are present.
1174You should not perform a pull with unmodified
1176files in your working directory as Git will be
1177unable to recover from an incorrect merge.
1178You should commit or revert all changes before
1180starting a pull operation.
1181}
1182 unlock_index
1183 return
1184 }
1185 set w [new_console "pull $remote $branch" \
1187 "Pulling new changes from branch $branch in $remote"]
1188 set cmd [list git pull]
1189 if {$repo_config(gui.pullsummary) eq {false}} {
1190 lappend cmd --no-summary
1191 }
1192 lappend cmd $remote
1193 lappend cmd $branch
1194 console_exec $w $cmd [list post_pull_remote $remote $branch]
1195}
1196proc post_pull_remote {remote branch success} {
1198 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1199 global ui_status_value
1200 unlock_index
1202 if {$success} {
1203 repository_state commit_type HEAD MERGE_HEAD
1204 set PARENT $HEAD
1205 set selected_commit_type new
1206 set ui_status_value "Pulling $branch from $remote complete."
1207 } else {
1208 rescan [list set ui_status_value \
1209 "Conflicts detected while pulling $branch from $remote."]
1210 }
1211}
1212proc push_to {remote} {
1214 set w [new_console "push $remote" \
1215 "Pushing changes to $remote"]
1216 set cmd [list git push]
1217 lappend cmd $remote
1218 console_exec $w $cmd
1219}
1220######################################################################
1222##
1223## ui helpers
1224proc mapicon {w state path} {
1226 global all_icons
1227 if {[catch {set r $all_icons($state$w)}]} {
1229 puts "error: no icon for $w state={$state} $path"
1230 return file_plain
1231 }
1232 return $r
1233}
1234proc mapdesc {state path} {
1236 global all_descs
1237 if {[catch {set r $all_descs($state)}]} {
1239 puts "error: no desc for state={$state} $path"
1240 return $state
1241 }
1242 return $r
1243}
1244proc escape_path {path} {
1246 regsub -all "\n" $path "\\n" path
1247 return $path
1248}
1249proc short_path {path} {
1251 return [escape_path [lindex [file split $path] end]]
1252}
1253set next_icon_id 0
1255set null_sha1 [string repeat 0 40]
1256proc merge_state {path new_state {head_info {}} {index_info {}}} {
1258 global file_states next_icon_id null_sha1
1259 set s0 [string index $new_state 0]
1261 set s1 [string index $new_state 1]
1262 if {[catch {set info $file_states($path)}]} {
1264 set state __
1265 set icon n[incr next_icon_id]
1266 } else {
1267 set state [lindex $info 0]
1268 set icon [lindex $info 1]
1269 if {$head_info eq {}} {set head_info [lindex $info 2]}
1270 if {$index_info eq {}} {set index_info [lindex $info 3]}
1271 }
1272 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1274 elseif {$s0 eq {_}} {set s0 _}
1275 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1277 elseif {$s1 eq {_}} {set s1 _}
1278 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1280 set head_info [list 0 $null_sha1]
1281 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1282 && $head_info eq {}} {
1283 set head_info $index_info
1284 }
1285 set file_states($path) [list $s0$s1 $icon \
1287 $head_info $index_info \
1288 ]
1289 return $state
1290}
1291proc display_file_helper {w path icon_name old_m new_m} {
1293 global file_lists
1294 if {$new_m eq {_}} {
1296 set lno [lsearch -sorted $file_lists($w) $path]
1297 if {$lno >= 0} {
1298 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1299 incr lno
1300 $w conf -state normal
1301 $w delete $lno.0 [expr {$lno + 1}].0
1302 $w conf -state disabled
1303 }
1304 } elseif {$old_m eq {_} && $new_m ne {_}} {
1305 lappend file_lists($w) $path
1306 set file_lists($w) [lsort -unique $file_lists($w)]
1307 set lno [lsearch -sorted $file_lists($w) $path]
1308 incr lno
1309 $w conf -state normal
1310 $w image create $lno.0 \
1311 -align center -padx 5 -pady 1 \
1312 -name $icon_name \
1313 -image [mapicon $w $new_m $path]
1314 $w insert $lno.1 "[escape_path $path]\n"
1315 $w conf -state disabled
1316 } elseif {$old_m ne $new_m} {
1317 $w conf -state normal
1318 $w image conf $icon_name -image [mapicon $w $new_m $path]
1319 $w conf -state disabled
1320 }
1321}
1322proc display_file {path state} {
1324 global file_states selected_paths
1325 global ui_index ui_workdir
1326 set old_m [merge_state $path $state]
1328 set s $file_states($path)
1329 set new_m [lindex $s 0]
1330 set icon_name [lindex $s 1]
1331 set o [string index $old_m 0]
1333 set n [string index $new_m 0]
1334 if {$o eq {U}} {
1335 set o _
1336 }
1337 if {$n eq {U}} {
1338 set n _
1339 }
1340 display_file_helper $ui_index $path $icon_name $o $n
1341 if {[string index $old_m 0] eq {U}} {
1343 set o U
1344 } else {
1345 set o [string index $old_m 1]
1346 }
1347 if {[string index $new_m 0] eq {U}} {
1348 set n U
1349 } else {
1350 set n [string index $new_m 1]
1351 }
1352 display_file_helper $ui_workdir $path $icon_name $o $n
1353 if {$new_m eq {__}} {
1355 unset file_states($path)
1356 catch {unset selected_paths($path)}
1357 }
1358}
1359proc display_all_files_helper {w path icon_name m} {
1361 global file_lists
1362 lappend file_lists($w) $path
1364 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1365 $w image create end \
1366 -align center -padx 5 -pady 1 \
1367 -name $icon_name \
1368 -image [mapicon $w $m $path]
1369 $w insert end "[escape_path $path]\n"
1370}
1371proc display_all_files {} {
1373 global ui_index ui_workdir
1374 global file_states file_lists
1375 global last_clicked
1376 $ui_index conf -state normal
1378 $ui_workdir conf -state normal
1379 $ui_index delete 0.0 end
1381 $ui_workdir delete 0.0 end
1382 set last_clicked {}
1383 set file_lists($ui_index) [list]
1385 set file_lists($ui_workdir) [list]
1386 foreach path [lsort [array names file_states]] {
1388 set s $file_states($path)
1389 set m [lindex $s 0]
1390 set icon_name [lindex $s 1]
1391 set s [string index $m 0]
1393 if {$s ne {U} && $s ne {_}} {
1394 display_all_files_helper $ui_index $path \
1395 $icon_name $s
1396 }
1397 if {[string index $m 0] eq {U}} {
1399 set s U
1400 } else {
1401 set s [string index $m 1]
1402 }
1403 if {$s ne {_}} {
1404 display_all_files_helper $ui_workdir $path \
1405 $icon_name $s
1406 }
1407 }
1408 $ui_index conf -state disabled
1410 $ui_workdir conf -state disabled
1411}
1412proc update_indexinfo {msg pathList after} {
1414 global update_index_cp ui_status_value
1415 if {![lock_index update]} return
1417 set update_index_cp 0
1419 set pathList [lsort $pathList]
1420 set totalCnt [llength $pathList]
1421 set batch [expr {int($totalCnt * .01) + 1}]
1422 if {$batch > 25} {set batch 25}
1423 set ui_status_value [format \
1425 "$msg... %i/%i files (%.2f%%)" \
1426 $update_index_cp \
1427 $totalCnt \
1428 0.0]
1429 set fd [open "| git update-index -z --index-info" w]
1430 fconfigure $fd \
1431 -blocking 0 \
1432 -buffering full \
1433 -buffersize 512 \
1434 -translation binary
1435 fileevent $fd writable [list \
1436 write_update_indexinfo \
1437 $fd \
1438 $pathList \
1439 $totalCnt \
1440 $batch \
1441 $msg \
1442 $after \
1443 ]
1444}
1445proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1447 global update_index_cp ui_status_value
1448 global file_states current_diff_path
1449 if {$update_index_cp >= $totalCnt} {
1451 close $fd
1452 unlock_index
1453 uplevel #0 $after
1454 return
1455 }
1456 for {set i $batch} \
1458 {$update_index_cp < $totalCnt && $i > 0} \
1459 {incr i -1} {
1460 set path [lindex $pathList $update_index_cp]
1461 incr update_index_cp
1462 set s $file_states($path)
1464 switch -glob -- [lindex $s 0] {
1465 A? {set new _O}
1466 M? {set new _M}
1467 D_ {set new _D}
1468 D? {set new _?}
1469 ?? {continue}
1470 }
1471 set info [lindex $s 2]
1472 if {$info eq {}} continue
1473 puts -nonewline $fd "$info\t$path\0"
1475 display_file $path $new
1476 }
1477 set ui_status_value [format \
1479 "$msg... %i/%i files (%.2f%%)" \
1480 $update_index_cp \
1481 $totalCnt \
1482 [expr {100.0 * $update_index_cp / $totalCnt}]]
1483}
1484proc update_index {msg pathList after} {
1486 global update_index_cp ui_status_value
1487 if {![lock_index update]} return
1489 set update_index_cp 0
1491 set pathList [lsort $pathList]
1492 set totalCnt [llength $pathList]
1493 set batch [expr {int($totalCnt * .01) + 1}]
1494 if {$batch > 25} {set batch 25}
1495 set ui_status_value [format \
1497 "$msg... %i/%i files (%.2f%%)" \
1498 $update_index_cp \
1499 $totalCnt \
1500 0.0]
1501 set fd [open "| git update-index --add --remove -z --stdin" w]
1502 fconfigure $fd \
1503 -blocking 0 \
1504 -buffering full \
1505 -buffersize 512 \
1506 -translation binary
1507 fileevent $fd writable [list \
1508 write_update_index \
1509 $fd \
1510 $pathList \
1511 $totalCnt \
1512 $batch \
1513 $msg \
1514 $after \
1515 ]
1516}
1517proc write_update_index {fd pathList totalCnt batch msg after} {
1519 global update_index_cp ui_status_value
1520 global file_states current_diff_path
1521 if {$update_index_cp >= $totalCnt} {
1523 close $fd
1524 unlock_index
1525 uplevel #0 $after
1526 return
1527 }
1528 for {set i $batch} \
1530 {$update_index_cp < $totalCnt && $i > 0} \
1531 {incr i -1} {
1532 set path [lindex $pathList $update_index_cp]
1533 incr update_index_cp
1534 switch -glob -- [lindex $file_states($path) 0] {
1536 AD {set new __}
1537 ?D {set new D_}
1538 _O -
1539 AM {set new A_}
1540 U? {
1541 if {[file exists $path]} {
1542 set new M_
1543 } else {
1544 set new D_
1545 }
1546 }
1547 ?M {set new M_}
1548 ?? {continue}
1549 }
1550 puts -nonewline $fd "$path\0"
1551 display_file $path $new
1552 }
1553 set ui_status_value [format \
1555 "$msg... %i/%i files (%.2f%%)" \
1556 $update_index_cp \
1557 $totalCnt \
1558 [expr {100.0 * $update_index_cp / $totalCnt}]]
1559}
1560proc checkout_index {msg pathList after} {
1562 global update_index_cp ui_status_value
1563 if {![lock_index update]} return
1565 set update_index_cp 0
1567 set pathList [lsort $pathList]
1568 set totalCnt [llength $pathList]
1569 set batch [expr {int($totalCnt * .01) + 1}]
1570 if {$batch > 25} {set batch 25}
1571 set ui_status_value [format \
1573 "$msg... %i/%i files (%.2f%%)" \
1574 $update_index_cp \
1575 $totalCnt \
1576 0.0]
1577 set cmd [list git checkout-index]
1578 lappend cmd --index
1579 lappend cmd --quiet
1580 lappend cmd --force
1581 lappend cmd -z
1582 lappend cmd --stdin
1583 set fd [open "| $cmd " w]
1584 fconfigure $fd \
1585 -blocking 0 \
1586 -buffering full \
1587 -buffersize 512 \
1588 -translation binary
1589 fileevent $fd writable [list \
1590 write_checkout_index \
1591 $fd \
1592 $pathList \
1593 $totalCnt \
1594 $batch \
1595 $msg \
1596 $after \
1597 ]
1598}
1599proc write_checkout_index {fd pathList totalCnt batch msg after} {
1601 global update_index_cp ui_status_value
1602 global file_states current_diff_path
1603 if {$update_index_cp >= $totalCnt} {
1605 close $fd
1606 unlock_index
1607 uplevel #0 $after
1608 return
1609 }
1610 for {set i $batch} \
1612 {$update_index_cp < $totalCnt && $i > 0} \
1613 {incr i -1} {
1614 set path [lindex $pathList $update_index_cp]
1615 incr update_index_cp
1616 switch -glob -- [lindex $file_states($path) 0] {
1617 U? {continue}
1618 ?M -
1619 ?D {
1620 puts -nonewline $fd "$path\0"
1621 display_file $path ?_
1622 }
1623 }
1624 }
1625 set ui_status_value [format \
1627 "$msg... %i/%i files (%.2f%%)" \
1628 $update_index_cp \
1629 $totalCnt \
1630 [expr {100.0 * $update_index_cp / $totalCnt}]]
1631}
1632######################################################################
1634##
1635## branch management
1636proc is_tracking_branch {name} {
1638 global tracking_branches
1639 if {![catch {set info $tracking_branches($name)}]} {
1641 return 1
1642 }
1643 foreach t [array names tracking_branches] {
1644 if {[string match {*/\*} $t] && [string match $t $name]} {
1645 return 1
1646 }
1647 }
1648 return 0
1649}
1650proc load_all_heads {} {
1652 global all_heads
1653 set all_heads [list]
1655 set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1656 while {[gets $fd line] > 0} {
1657 if {[is_tracking_branch $line]} continue
1658 if {![regsub ^refs/heads/ $line {} name]} continue
1659 lappend all_heads $name
1660 }
1661 close $fd
1662 set all_heads [lsort $all_heads]
1664}
1665proc populate_branch_menu {} {
1667 global all_heads disable_on_lock
1668 set m .mbar.branch
1670 set last [$m index last]
1671 for {set i 0} {$i <= $last} {incr i} {
1672 if {[$m type $i] eq {separator}} {
1673 $m delete $i last
1674 set new_dol [list]
1675 foreach a $disable_on_lock {
1676 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1677 lappend new_dol $a
1678 }
1679 }
1680 set disable_on_lock $new_dol
1681 break
1682 }
1683 }
1684 $m add separator
1686 foreach b $all_heads {
1687 $m add radiobutton \
1688 -label $b \
1689 -command [list switch_branch $b] \
1690 -variable current_branch \
1691 -value $b \
1692 -font font_ui
1693 lappend disable_on_lock \
1694 [list $m entryconf [$m index last] -state]
1695 }
1696}
1697proc all_tracking_branches {} {
1699 global tracking_branches
1700 set all_trackings {}
1702 set cmd {}
1703 foreach name [array names tracking_branches] {
1704 if {[regsub {/\*$} $name {} name]} {
1705 lappend cmd $name
1706 } else {
1707 regsub ^refs/(heads|remotes)/ $name {} name
1708 lappend all_trackings $name
1709 }
1710 }
1711 if {$cmd ne {}} {
1713 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1714 while {[gets $fd name] > 0} {
1715 regsub ^refs/(heads|remotes)/ $name {} name
1716 lappend all_trackings $name
1717 }
1718 close $fd
1719 }
1720 return [lsort -unique $all_trackings]
1722}
1723proc do_create_branch_action {w} {
1725 global all_heads null_sha1 repo_config
1726 global create_branch_checkout create_branch_revtype
1727 global create_branch_head create_branch_trackinghead
1728 set newbranch [string trim [$w.desc.name_t get 0.0 end]]
1730 if {$newbranch eq {}
1731 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1732 tk_messageBox \
1733 -icon error \
1734 -type ok \
1735 -title [wm title $w] \
1736 -parent $w \
1737 -message "Please supply a branch name."
1738 focus $w.desc.name_t
1739 return
1740 }
1741 if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1742 tk_messageBox \
1743 -icon error \
1744 -type ok \
1745 -title [wm title $w] \
1746 -parent $w \
1747 -message "Branch '$newbranch' already exists."
1748 focus $w.desc.name_t
1749 return
1750 }
1751 if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1752 tk_messageBox \
1753 -icon error \
1754 -type ok \
1755 -title [wm title $w] \
1756 -parent $w \
1757 -message "We do not like '$newbranch' as a branch name."
1758 focus $w.desc.name_t
1759 return
1760 }
1761 set rev {}
1763 switch -- $create_branch_revtype {
1764 head {set rev $create_branch_head}
1765 tracking {set rev $create_branch_trackinghead}
1766 expression {set rev [string trim [$w.from.exp_t get 0.0 end]]}
1767 }
1768 if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1769 tk_messageBox \
1770 -icon error \
1771 -type ok \
1772 -title [wm title $w] \
1773 -parent $w \
1774 -message "Invalid starting revision: $rev"
1775 return
1776 }
1777 set cmd [list git update-ref]
1778 lappend cmd -m
1779 lappend cmd "branch: Created from $rev"
1780 lappend cmd "refs/heads/$newbranch"
1781 lappend cmd $cmt
1782 lappend cmd $null_sha1
1783 if {[catch {eval exec $cmd} err]} {
1784 tk_messageBox \
1785 -icon error \
1786 -type ok \
1787 -title [wm title $w] \
1788 -parent $w \
1789 -message "Failed to create '$newbranch'.\n\n$err"
1790 return
1791 }
1792 lappend all_heads $newbranch
1794 set all_heads [lsort $all_heads]
1795 populate_branch_menu
1796 destroy $w
1797 if {$create_branch_checkout} {
1798 switch_branch $newbranch
1799 }
1800}
1801proc radio_selector {varname value args} {
1803 upvar #0 $varname var
1804 set var $value
1805}
1806trace add variable create_branch_head write \
1808 [list radio_selector create_branch_revtype head]
1809trace add variable create_branch_trackinghead write \
1810 [list radio_selector create_branch_revtype tracking]
1811trace add variable delete_branch_head write \
1813 [list radio_selector delete_branch_checktype head]
1814trace add variable delete_branch_trackinghead write \
1815 [list radio_selector delete_branch_checktype tracking]
1816proc do_create_branch {} {
1818 global all_heads current_branch repo_config
1819 global create_branch_checkout create_branch_revtype
1820 global create_branch_head create_branch_trackinghead
1821 set w .branch_editor
1823 toplevel $w
1824 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1825 label $w.header -text {Create New Branch} \
1827 -font font_uibold
1828 pack $w.header -side top -fill x
1829 frame $w.buttons
1831 button $w.buttons.create -text Create \
1832 -font font_ui \
1833 -default active \
1834 -command [list do_create_branch_action $w]
1835 pack $w.buttons.create -side right
1836 button $w.buttons.cancel -text {Cancel} \
1837 -font font_ui \
1838 -command [list destroy $w]
1839 pack $w.buttons.cancel -side right -padx 5
1840 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1841 labelframe $w.desc \
1843 -text {Branch Description} \
1844 -font font_ui
1845 label $w.desc.name_l -text {Name:} -font font_ui
1846 text $w.desc.name_t \
1847 -borderwidth 1 \
1848 -relief sunken \
1849 -height 1 \
1850 -width 40 \
1851 -font font_ui
1852 $w.desc.name_t insert 0.0 $repo_config(gui.newbranchtemplate)
1853 grid $w.desc.name_l $w.desc.name_t -stick we -padx {0 5}
1854 bind $w.desc.name_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
1855 bind $w.desc.name_t <Key-Tab> {focus [tk_focusNext %W];break}
1856 bind $w.desc.name_t <Key-Return> "do_create_branch_action $w;break"
1857 bind $w.desc.name_t <Key> {
1858 if {{%K} ne {BackSpace}
1859 && {%K} ne {Tab}
1860 && {%K} ne {Escape}
1861 && {%K} ne {Return}} {
1862 if {%k <= 32} break
1863 if {[string first %A {~^:?*[}] >= 0} break
1864 }
1865 }
1866 grid columnconfigure $w.desc 1 -weight 1
1867 pack $w.desc -anchor nw -fill x -pady 5 -padx 5
1868 labelframe $w.from \
1870 -text {Starting Revision} \
1871 -font font_ui
1872 radiobutton $w.from.head_r \
1873 -text {Local Branch:} \
1874 -value head \
1875 -variable create_branch_revtype \
1876 -font font_ui
1877 eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
1878 grid $w.from.head_r $w.from.head_m -sticky w
1879 set all_trackings [all_tracking_branches]
1880 if {$all_trackings ne {}} {
1881 set create_branch_trackinghead [lindex $all_trackings 0]
1882 radiobutton $w.from.tracking_r \
1883 -text {Tracking Branch:} \
1884 -value tracking \
1885 -variable create_branch_revtype \
1886 -font font_ui
1887 eval tk_optionMenu $w.from.tracking_m \
1888 create_branch_trackinghead \
1889 $all_trackings
1890 grid $w.from.tracking_r $w.from.tracking_m -sticky w
1891 }
1892 radiobutton $w.from.exp_r \
1893 -text {Revision Expression:} \
1894 -value expression \
1895 -variable create_branch_revtype \
1896 -font font_ui
1897 text $w.from.exp_t \
1898 -borderwidth 1 \
1899 -relief sunken \
1900 -height 1 \
1901 -width 50 \
1902 -font font_ui
1903 grid $w.from.exp_r $w.from.exp_t -stick we -padx {0 5}
1904 bind $w.from.exp_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
1905 bind $w.from.exp_t <Key-Tab> {focus [tk_focusNext %W];break}
1906 bind $w.from.exp_t <Key-Return> "do_create_branch_action $w;break"
1907 bind $w.from.exp_t <Key-space> break
1908 bind $w.from.exp_t <Key> {set create_branch_revtype expression}
1909 grid columnconfigure $w.from 1 -weight 1
1910 pack $w.from -anchor nw -fill x -pady 5 -padx 5
1911 labelframe $w.postActions \
1913 -text {Post Creation Actions} \
1914 -font font_ui
1915 checkbutton $w.postActions.checkout \
1916 -text {Checkout after creation} \
1917 -variable create_branch_checkout \
1918 -font font_ui
1919 pack $w.postActions.checkout -anchor nw
1920 pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
1921 set create_branch_checkout 1
1923 set create_branch_head $current_branch
1924 set create_branch_revtype head
1925 bind $w <Visibility> "grab $w; focus $w.desc.name_t"
1927 bind $w <Key-Escape> "destroy $w"
1928 bind $w <Key-Return> "do_create_branch_action $w;break"
1929 wm title $w "[appname] ([reponame]): Create Branch"
1930 tkwait window $w
1931}
1932proc do_delete_branch_action {w} {
1934 global all_heads
1935 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
1936 set check_rev {}
1938 switch -- $delete_branch_checktype {
1939 head {set check_rev $delete_branch_head}
1940 tracking {set check_rev $delete_branch_trackinghead}
1941 always {set check_rev {:none}}
1942 }
1943 if {$check_rev eq {:none}} {
1944 set check_cmt {}
1945 } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
1946 tk_messageBox \
1947 -icon error \
1948 -type ok \
1949 -title [wm title $w] \
1950 -parent $w \
1951 -message "Invalid check revision: $check_rev"
1952 return
1953 }
1954 set to_delete [list]
1956 set not_merged [list]
1957 foreach i [$w.list.l curselection] {
1958 set b [$w.list.l get $i]
1959 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
1960 if {$check_cmt ne {}} {
1961 if {$b eq $check_rev} continue
1962 if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
1963 if {$o ne $m} {
1964 lappend not_merged $b
1965 continue
1966 }
1967 }
1968 lappend to_delete [list $b $o]
1969 }
1970 if {$not_merged ne {}} {
1971 set msg "The following branches are not completely merged into $check_rev:
1972 - [join $not_merged "\n - "]"
1974 tk_messageBox \
1975 -icon info \
1976 -type ok \
1977 -title [wm title $w] \
1978 -parent $w \
1979 -message $msg
1980 }
1981 if {$to_delete eq {}} return
1982 if {$delete_branch_checktype eq {always}} {
1983 set msg {Recovering deleted branches is difficult.
1984Delete the selected branches?}
1986 if {[tk_messageBox \
1987 -icon warning \
1988 -type yesno \
1989 -title [wm title $w] \
1990 -parent $w \
1991 -message $msg] ne yes} {
1992 return
1993 }
1994 }
1995 set failed {}
1997 foreach i $to_delete {
1998 set b [lindex $i 0]
1999 set o [lindex $i 1]
2000 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2001 append failed " - $b: $err\n"
2002 } else {
2003 set x [lsearch -sorted $all_heads $b]
2004 if {$x >= 0} {
2005 set all_heads [lreplace $all_heads $x $x]
2006 }
2007 }
2008 }
2009 if {$failed ne {}} {
2011 tk_messageBox \
2012 -icon error \
2013 -type ok \
2014 -title [wm title $w] \
2015 -parent $w \
2016 -message "Failed to delete branches:\n$failed"
2017 }
2018 set all_heads [lsort $all_heads]
2020 populate_branch_menu
2021 destroy $w
2022}
2023proc do_delete_branch {} {
2025 global all_heads tracking_branches current_branch
2026 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2027 set w .branch_editor
2029 toplevel $w
2030 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2031 label $w.header -text {Delete Local Branch} \
2033 -font font_uibold
2034 pack $w.header -side top -fill x
2035 frame $w.buttons
2037 button $w.buttons.create -text Delete \
2038 -font font_ui \
2039 -command [list do_delete_branch_action $w]
2040 pack $w.buttons.create -side right
2041 button $w.buttons.cancel -text {Cancel} \
2042 -font font_ui \
2043 -command [list destroy $w]
2044 pack $w.buttons.cancel -side right -padx 5
2045 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2046 labelframe $w.list \
2048 -text {Local Branches} \
2049 -font font_ui
2050 listbox $w.list.l \
2051 -height 10 \
2052 -width 50 \
2053 -selectmode extended \
2054 -font font_ui
2055 foreach h $all_heads {
2056 if {$h ne $current_branch} {
2057 $w.list.l insert end $h
2058 }
2059 }
2060 pack $w.list.l -fill both -pady 5 -padx 5
2061 pack $w.list -fill both -pady 5 -padx 5
2062 labelframe $w.validate \
2064 -text {Delete Only If} \
2065 -font font_ui
2066 radiobutton $w.validate.head_r \
2067 -text {Merged Into Local Branch:} \
2068 -value head \
2069 -variable delete_branch_checktype \
2070 -font font_ui
2071 eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2072 grid $w.validate.head_r $w.validate.head_m -sticky w
2073 set all_trackings [all_tracking_branches]
2074 if {$all_trackings ne {}} {
2075 set delete_branch_trackinghead [lindex $all_trackings 0]
2076 radiobutton $w.validate.tracking_r \
2077 -text {Merged Into Tracking Branch:} \
2078 -value tracking \
2079 -variable delete_branch_checktype \
2080 -font font_ui
2081 eval tk_optionMenu $w.validate.tracking_m \
2082 delete_branch_trackinghead \
2083 $all_trackings
2084 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2085 }
2086 radiobutton $w.validate.always_r \
2087 -text {Always (Do not perform merge checks)} \
2088 -value always \
2089 -variable delete_branch_checktype \
2090 -font font_ui
2091 grid $w.validate.always_r -columnspan 2 -sticky w
2092 grid columnconfigure $w.validate 1 -weight 1
2093 pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2094 set delete_branch_head $current_branch
2096 set delete_branch_checktype head
2097 bind $w <Visibility> "grab $w; focus $w"
2099 bind $w <Key-Escape> "destroy $w"
2100 wm title $w "[appname] ([reponame]): Delete Branch"
2101 tkwait window $w
2102}
2103proc switch_branch {b} {
2105 global HEAD commit_type file_states current_branch
2106 global selected_commit_type ui_comm
2107 if {![lock_index switch]} return
2109 # -- Backup the selected branch (repository_state resets it)
2111 #
2112 set new_branch $current_branch
2113 # -- Our in memory state should match the repository.
2115 #
2116 repository_state curType curHEAD curMERGE_HEAD
2117 if {[string match amend* $commit_type]
2118 && $curType eq {normal}
2119 && $curHEAD eq $HEAD} {
2120 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2121 info_popup {Last scanned state does not match repository state.
2122Another Git program has modified this repository
2124since the last scan. A rescan must be performed
2125before the current branch can be changed.
2126The rescan will be automatically started now.
2128}
2129 unlock_index
2130 rescan {set ui_status_value {Ready.}}
2131 return
2132 }
2133 # -- Toss the message buffer if we are in amend mode.
2135 #
2136 if {[string match amend* $curType]} {
2137 $ui_comm delete 0.0 end
2138 $ui_comm edit reset
2139 $ui_comm edit modified false
2140 }
2141 set selected_commit_type new
2143 set current_branch $new_branch
2144 unlock_index
2146 error "NOT FINISHED"
2147}
2148######################################################################
2150##
2151## remote management
2152proc load_all_remotes {} {
2154 global repo_config
2155 global all_remotes tracking_branches
2156 set all_remotes [list]
2158 array unset tracking_branches
2159 set rm_dir [gitdir remotes]
2161 if {[file isdirectory $rm_dir]} {
2162 set all_remotes [glob \
2163 -types f \
2164 -tails \
2165 -nocomplain \
2166 -directory $rm_dir *]
2167 foreach name $all_remotes {
2169 catch {
2170 set fd [open [file join $rm_dir $name] r]
2171 while {[gets $fd line] >= 0} {
2172 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
2173 $line line src dst]} continue
2174 if {![regexp ^refs/ $dst]} {
2175 set dst "refs/heads/$dst"
2176 }
2177 set tracking_branches($dst) [list $name $src]
2178 }
2179 close $fd
2180 }
2181 }
2182 }
2183 foreach line [array names repo_config remote.*.url] {
2185 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2186 lappend all_remotes $name
2187 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2189 set fl {}
2190 }
2191 foreach line $fl {
2192 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2193 if {![regexp ^refs/ $dst]} {
2194 set dst "refs/heads/$dst"
2195 }
2196 set tracking_branches($dst) [list $name $src]
2197 }
2198 }
2199 set all_remotes [lsort -unique $all_remotes]
2201}
2202proc populate_fetch_menu {m} {
2204 global all_remotes repo_config
2205 foreach r $all_remotes {
2207 set enable 0
2208 if {![catch {set a $repo_config(remote.$r.url)}]} {
2209 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2210 set enable 1
2211 }
2212 } else {
2213 catch {
2214 set fd [open [gitdir remotes $r] r]
2215 while {[gets $fd n] >= 0} {
2216 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2217 set enable 1
2218 break
2219 }
2220 }
2221 close $fd
2222 }
2223 }
2224 if {$enable} {
2226 $m add command \
2227 -label "Fetch from $r..." \
2228 -command [list fetch_from $r] \
2229 -font font_ui
2230 }
2231 }
2232}
2233proc populate_push_menu {m} {
2235 global all_remotes repo_config
2236 foreach r $all_remotes {
2238 set enable 0
2239 if {![catch {set a $repo_config(remote.$r.url)}]} {
2240 if {![catch {set a $repo_config(remote.$r.push)}]} {
2241 set enable 1
2242 }
2243 } else {
2244 catch {
2245 set fd [open [gitdir remotes $r] r]
2246 while {[gets $fd n] >= 0} {
2247 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2248 set enable 1
2249 break
2250 }
2251 }
2252 close $fd
2253 }
2254 }
2255 if {$enable} {
2257 $m add command \
2258 -label "Push to $r..." \
2259 -command [list push_to $r] \
2260 -font font_ui
2261 }
2262 }
2263}
2264proc populate_pull_menu {m} {
2266 global repo_config all_remotes disable_on_lock
2267 foreach remote $all_remotes {
2269 set rb_list [list]
2270 if {[array get repo_config remote.$remote.url] ne {}} {
2271 if {[array get repo_config remote.$remote.fetch] ne {}} {
2272 foreach line $repo_config(remote.$remote.fetch) {
2273 if {[regexp {^([^:]+):} $line line rb]} {
2274 lappend rb_list $rb
2275 }
2276 }
2277 }
2278 } else {
2279 catch {
2280 set fd [open [gitdir remotes $remote] r]
2281 while {[gets $fd line] >= 0} {
2282 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
2283 lappend rb_list $rb
2284 }
2285 }
2286 close $fd
2287 }
2288 }
2289 foreach rb $rb_list {
2291 regsub ^refs/heads/ $rb {} rb_short
2292 $m add command \
2293 -label "Branch $rb_short from $remote..." \
2294 -command [list pull_remote $remote $rb] \
2295 -font font_ui
2296 lappend disable_on_lock \
2297 [list $m entryconf [$m index last] -state]
2298 }
2299 }
2300}
2301######################################################################
2303##
2304## icons
2305set filemask {
2307#define mask_width 14
2308#define mask_height 15
2309static unsigned char mask_bits[] = {
2310 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2311 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2312 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2313}
2314image create bitmap file_plain -background white -foreground black -data {
2316#define plain_width 14
2317#define plain_height 15
2318static unsigned char plain_bits[] = {
2319 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2320 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2321 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2322} -maskdata $filemask
2323image create bitmap file_mod -background white -foreground blue -data {
2325#define mod_width 14
2326#define mod_height 15
2327static unsigned char mod_bits[] = {
2328 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2329 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2330 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2331} -maskdata $filemask
2332image create bitmap file_fulltick -background white -foreground "#007000" -data {
2334#define file_fulltick_width 14
2335#define file_fulltick_height 15
2336static unsigned char file_fulltick_bits[] = {
2337 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2338 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2339 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2340} -maskdata $filemask
2341image create bitmap file_parttick -background white -foreground "#005050" -data {
2343#define parttick_width 14
2344#define parttick_height 15
2345static unsigned char parttick_bits[] = {
2346 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2347 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2348 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2349} -maskdata $filemask
2350image create bitmap file_question -background white -foreground black -data {
2352#define file_question_width 14
2353#define file_question_height 15
2354static unsigned char file_question_bits[] = {
2355 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2356 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2357 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2358} -maskdata $filemask
2359image create bitmap file_removed -background white -foreground red -data {
2361#define file_removed_width 14
2362#define file_removed_height 15
2363static unsigned char file_removed_bits[] = {
2364 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2365 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2366 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2367} -maskdata $filemask
2368image create bitmap file_merge -background white -foreground blue -data {
2370#define file_merge_width 14
2371#define file_merge_height 15
2372static unsigned char file_merge_bits[] = {
2373 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2374 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2375 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2376} -maskdata $filemask
2377set ui_index .vpane.files.index.list
2379set ui_workdir .vpane.files.workdir.list
2380set all_icons(_$ui_index) file_plain
2382set all_icons(A$ui_index) file_fulltick
2383set all_icons(M$ui_index) file_fulltick
2384set all_icons(D$ui_index) file_removed
2385set all_icons(U$ui_index) file_merge
2386set all_icons(_$ui_workdir) file_plain
2388set all_icons(M$ui_workdir) file_mod
2389set all_icons(D$ui_workdir) file_question
2390set all_icons(U$ui_workdir) file_merge
2391set all_icons(O$ui_workdir) file_plain
2392set max_status_desc 0
2394foreach i {
2395 {__ "Unmodified"}
2396 {_M "Modified, not staged"}
2398 {M_ "Staged for commit"}
2399 {MM "Portions staged for commit"}
2400 {MD "Staged for commit, missing"}
2401 {_O "Untracked, not staged"}
2403 {A_ "Staged for commit"}
2404 {AM "Portions staged for commit"}
2405 {AD "Staged for commit, missing"}
2406 {_D "Missing"}
2408 {D_ "Staged for removal"}
2409 {DO "Staged for removal, still present"}
2410 {U_ "Requires merge resolution"}
2412 {UU "Requires merge resolution"}
2413 {UM "Requires merge resolution"}
2414 {UD "Requires merge resolution"}
2415 } {
2416 if {$max_status_desc < [string length [lindex $i 1]]} {
2417 set max_status_desc [string length [lindex $i 1]]
2418 }
2419 set all_descs([lindex $i 0]) [lindex $i 1]
2420}
2421unset i
2422######################################################################
2424##
2425## util
2426proc is_MacOSX {} {
2428 global tcl_platform tk_library
2429 if {[tk windowingsystem] eq {aqua}} {
2430 return 1
2431 }
2432 return 0
2433}
2434proc is_Windows {} {
2436 global tcl_platform
2437 if {$tcl_platform(platform) eq {windows}} {
2438 return 1
2439 }
2440 return 0
2441}
2442proc bind_button3 {w cmd} {
2444 bind $w <Any-Button-3> $cmd
2445 if {[is_MacOSX]} {
2446 bind $w <Control-Button-1> $cmd
2447 }
2448}
2449proc incr_font_size {font {amt 1}} {
2451 set sz [font configure $font -size]
2452 incr sz $amt
2453 font configure $font -size $sz
2454 font configure ${font}bold -size $sz
2455}
2456proc hook_failed_popup {hook msg} {
2458 set w .hookfail
2459 toplevel $w
2460 frame $w.m
2462 label $w.m.l1 -text "$hook hook failed:" \
2463 -anchor w \
2464 -justify left \
2465 -font font_uibold
2466 text $w.m.t \
2467 -background white -borderwidth 1 \
2468 -relief sunken \
2469 -width 80 -height 10 \
2470 -font font_diff \
2471 -yscrollcommand [list $w.m.sby set]
2472 label $w.m.l2 \
2473 -text {You must correct the above errors before committing.} \
2474 -anchor w \
2475 -justify left \
2476 -font font_uibold
2477 scrollbar $w.m.sby -command [list $w.m.t yview]
2478 pack $w.m.l1 -side top -fill x
2479 pack $w.m.l2 -side bottom -fill x
2480 pack $w.m.sby -side right -fill y
2481 pack $w.m.t -side left -fill both -expand 1
2482 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2483 $w.m.t insert 1.0 $msg
2485 $w.m.t conf -state disabled
2486 button $w.ok -text OK \
2488 -width 15 \
2489 -font font_ui \
2490 -command "destroy $w"
2491 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2492 bind $w <Visibility> "grab $w; focus $w"
2494 bind $w <Key-Return> "destroy $w"
2495 wm title $w "[appname] ([reponame]): error"
2496 tkwait window $w
2497}
2498set next_console_id 0
2500proc new_console {short_title long_title} {
2502 global next_console_id console_data
2503 set w .console[incr next_console_id]
2504 set console_data($w) [list $short_title $long_title]
2505 return [console_init $w]
2506}
2507proc console_init {w} {
2509 global console_cr console_data M1B
2510 set console_cr($w) 1.0
2512 toplevel $w
2513 frame $w.m
2514 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2515 -anchor w \
2516 -justify left \
2517 -font font_uibold
2518 text $w.m.t \
2519 -background white -borderwidth 1 \
2520 -relief sunken \
2521 -width 80 -height 10 \
2522 -font font_diff \
2523 -state disabled \
2524 -yscrollcommand [list $w.m.sby set]
2525 label $w.m.s -text {Working... please wait...} \
2526 -anchor w \
2527 -justify left \
2528 -font font_uibold
2529 scrollbar $w.m.sby -command [list $w.m.t yview]
2530 pack $w.m.l1 -side top -fill x
2531 pack $w.m.s -side bottom -fill x
2532 pack $w.m.sby -side right -fill y
2533 pack $w.m.t -side left -fill both -expand 1
2534 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2535 menu $w.ctxm -tearoff 0
2537 $w.ctxm add command -label "Copy" \
2538 -font font_ui \
2539 -command "tk_textCopy $w.m.t"
2540 $w.ctxm add command -label "Select All" \
2541 -font font_ui \
2542 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
2543 $w.ctxm add command -label "Copy All" \
2544 -font font_ui \
2545 -command "
2546 $w.m.t tag add sel 0.0 end
2547 tk_textCopy $w.m.t
2548 $w.m.t tag remove sel 0.0 end
2549 "
2550 button $w.ok -text {Close} \
2552 -font font_ui \
2553 -state disabled \
2554 -command "destroy $w"
2555 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2556 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2558 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2559 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2560 bind $w <Visibility> "focus $w"
2561 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2562 return $w
2563}
2564proc console_exec {w cmd {after {}}} {
2566 # -- Windows tosses the enviroment when we exec our child.
2567 # But most users need that so we have to relogin. :-(
2568 #
2569 if {[is_Windows]} {
2570 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2571 }
2572 # -- Tcl won't let us redirect both stdout and stderr to
2574 # the same pipe. So pass it through cat...
2575 #
2576 set cmd [concat | $cmd |& cat]
2577 set fd_f [open $cmd r]
2579 fconfigure $fd_f -blocking 0 -translation binary
2580 fileevent $fd_f readable [list console_read $w $fd_f $after]
2581}
2582proc console_read {w fd after} {
2584 global console_cr console_data
2585 set buf [read $fd]
2587 if {$buf ne {}} {
2588 if {![winfo exists $w]} {console_init $w}
2589 $w.m.t conf -state normal
2590 set c 0
2591 set n [string length $buf]
2592 while {$c < $n} {
2593 set cr [string first "\r" $buf $c]
2594 set lf [string first "\n" $buf $c]
2595 if {$cr < 0} {set cr [expr {$n + 1}]}
2596 if {$lf < 0} {set lf [expr {$n + 1}]}
2597 if {$lf < $cr} {
2599 $w.m.t insert end [string range $buf $c $lf]
2600 set console_cr($w) [$w.m.t index {end -1c}]
2601 set c $lf
2602 incr c
2603 } else {
2604 $w.m.t delete $console_cr($w) end
2605 $w.m.t insert end "\n"
2606 $w.m.t insert end [string range $buf $c $cr]
2607 set c $cr
2608 incr c
2609 }
2610 }
2611 $w.m.t conf -state disabled
2612 $w.m.t see end
2613 }
2614 fconfigure $fd -blocking 1
2616 if {[eof $fd]} {
2617 if {[catch {close $fd}]} {
2618 if {![winfo exists $w]} {console_init $w}
2619 $w.m.s conf -background red -text {Error: Command Failed}
2620 $w.ok conf -state normal
2621 set ok 0
2622 } elseif {[winfo exists $w]} {
2623 $w.m.s conf -background green -text {Success}
2624 $w.ok conf -state normal
2625 set ok 1
2626 }
2627 array unset console_cr $w
2628 array unset console_data $w
2629 if {$after ne {}} {
2630 uplevel #0 $after $ok
2631 }
2632 return
2633 }
2634 fconfigure $fd -blocking 0
2635}
2636######################################################################
2638##
2639## ui commands
2640set starting_gitk_msg {Starting gitk... please wait...}
2642proc do_gitk {revs} {
2644 global ui_status_value starting_gitk_msg
2645 set cmd gitk
2647 if {$revs ne {}} {
2648 append cmd { }
2649 append cmd $revs
2650 }
2651 if {[is_Windows]} {
2652 set cmd "sh -c \"exec $cmd\""
2653 }
2654 append cmd { &}
2655 if {[catch {eval exec $cmd} err]} {
2657 error_popup "Failed to start gitk:\n\n$err"
2658 } else {
2659 set ui_status_value $starting_gitk_msg
2660 after 10000 {
2661 if {$ui_status_value eq $starting_gitk_msg} {
2662 set ui_status_value {Ready.}
2663 }
2664 }
2665 }
2666}
2667proc do_gc {} {
2669 set w [new_console {gc} {Compressing the object database}]
2670 console_exec $w {git gc}
2671}
2672proc do_fsck_objects {} {
2674 set w [new_console {fsck-objects} \
2675 {Verifying the object database with fsck-objects}]
2676 set cmd [list git fsck-objects]
2677 lappend cmd --full
2678 lappend cmd --cache
2679 lappend cmd --strict
2680 console_exec $w $cmd
2681}
2682set is_quitting 0
2684proc do_quit {} {
2686 global ui_comm is_quitting repo_config commit_type
2687 if {$is_quitting} return
2689 set is_quitting 1
2690 # -- Stash our current commit buffer.
2692 #
2693 set save [gitdir GITGUI_MSG]
2694 set msg [string trim [$ui_comm get 0.0 end]]
2695 if {![string match amend* $commit_type]
2696 && [$ui_comm edit modified]
2697 && $msg ne {}} {
2698 catch {
2699 set fd [open $save w]
2700 puts $fd [string trim [$ui_comm get 0.0 end]]
2701 close $fd
2702 }
2703 } else {
2704 catch {file delete $save}
2705 }
2706 # -- Stash our current window geometry into this repository.
2708 #
2709 set cfg_geometry [list]
2710 lappend cfg_geometry [wm geometry .]
2711 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2712 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2713 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2714 set rc_geometry {}
2715 }
2716 if {$cfg_geometry ne $rc_geometry} {
2717 catch {exec git repo-config gui.geometry $cfg_geometry}
2718 }
2719 destroy .
2721}
2722proc do_rescan {} {
2724 rescan {set ui_status_value {Ready.}}
2725}
2726proc unstage_helper {txt paths} {
2728 global file_states current_diff_path
2729 if {![lock_index begin-update]} return
2731 set pathList [list]
2733 set after {}
2734 foreach path $paths {
2735 switch -glob -- [lindex $file_states($path) 0] {
2736 A? -
2737 M? -
2738 D? {
2739 lappend pathList $path
2740 if {$path eq $current_diff_path} {
2741 set after {reshow_diff;}
2742 }
2743 }
2744 }
2745 }
2746 if {$pathList eq {}} {
2747 unlock_index
2748 } else {
2749 update_indexinfo \
2750 $txt \
2751 $pathList \
2752 [concat $after {set ui_status_value {Ready.}}]
2753 }
2754}
2755proc do_unstage_selection {} {
2757 global current_diff_path selected_paths
2758 if {[array size selected_paths] > 0} {
2760 unstage_helper \
2761 {Unstaging selected files from commit} \
2762 [array names selected_paths]
2763 } elseif {$current_diff_path ne {}} {
2764 unstage_helper \
2765 "Unstaging [short_path $current_diff_path] from commit" \
2766 [list $current_diff_path]
2767 }
2768}
2769proc add_helper {txt paths} {
2771 global file_states current_diff_path
2772 if {![lock_index begin-update]} return
2774 set pathList [list]
2776 set after {}
2777 foreach path $paths {
2778 switch -glob -- [lindex $file_states($path) 0] {
2779 _O -
2780 ?M -
2781 ?D -
2782 U? {
2783 lappend pathList $path
2784 if {$path eq $current_diff_path} {
2785 set after {reshow_diff;}
2786 }
2787 }
2788 }
2789 }
2790 if {$pathList eq {}} {
2791 unlock_index
2792 } else {
2793 update_index \
2794 $txt \
2795 $pathList \
2796 [concat $after {set ui_status_value {Ready to commit.}}]
2797 }
2798}
2799proc do_add_selection {} {
2801 global current_diff_path selected_paths
2802 if {[array size selected_paths] > 0} {
2804 add_helper \
2805 {Adding selected files} \
2806 [array names selected_paths]
2807 } elseif {$current_diff_path ne {}} {
2808 add_helper \
2809 "Adding [short_path $current_diff_path]" \
2810 [list $current_diff_path]
2811 }
2812}
2813proc do_add_all {} {
2815 global file_states
2816 set paths [list]
2818 foreach path [array names file_states] {
2819 switch -glob -- [lindex $file_states($path) 0] {
2820 U? {continue}
2821 ?M -
2822 ?D {lappend paths $path}
2823 }
2824 }
2825 add_helper {Adding all changed files} $paths
2826}
2827proc revert_helper {txt paths} {
2829 global file_states current_diff_path
2830 if {![lock_index begin-update]} return
2832 set pathList [list]
2834 set after {}
2835 foreach path $paths {
2836 switch -glob -- [lindex $file_states($path) 0] {
2837 U? {continue}
2838 ?M -
2839 ?D {
2840 lappend pathList $path
2841 if {$path eq $current_diff_path} {
2842 set after {reshow_diff;}
2843 }
2844 }
2845 }
2846 }
2847 set n [llength $pathList]
2849 if {$n == 0} {
2850 unlock_index
2851 return
2852 } elseif {$n == 1} {
2853 set s "[short_path [lindex $pathList]]"
2854 } else {
2855 set s "these $n files"
2856 }
2857 set reply [tk_dialog \
2859 .confirm_revert \
2860 "[appname] ([reponame])" \
2861 "Revert changes in $s?
2862Any unadded changes will be permanently lost by the revert." \
2864 question \
2865 1 \
2866 {Do Nothing} \
2867 {Revert Changes} \
2868 ]
2869 if {$reply == 1} {
2870 checkout_index \
2871 $txt \
2872 $pathList \
2873 [concat $after {set ui_status_value {Ready.}}]
2874 } else {
2875 unlock_index
2876 }
2877}
2878proc do_revert_selection {} {
2880 global current_diff_path selected_paths
2881 if {[array size selected_paths] > 0} {
2883 revert_helper \
2884 {Reverting selected files} \
2885 [array names selected_paths]
2886 } elseif {$current_diff_path ne {}} {
2887 revert_helper \
2888 "Reverting [short_path $current_diff_path]" \
2889 [list $current_diff_path]
2890 }
2891}
2892proc do_signoff {} {
2894 global ui_comm
2895 set me [committer_ident]
2897 if {$me eq {}} return
2898 set sob "Signed-off-by: $me"
2900 set last [$ui_comm get {end -1c linestart} {end -1c}]
2901 if {$last ne $sob} {
2902 $ui_comm edit separator
2903 if {$last ne {}
2904 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2905 $ui_comm insert end "\n"
2906 }
2907 $ui_comm insert end "\n$sob"
2908 $ui_comm edit separator
2909 $ui_comm see end
2910 }
2911}
2912proc do_select_commit_type {} {
2914 global commit_type selected_commit_type
2915 if {$selected_commit_type eq {new}
2917 && [string match amend* $commit_type]} {
2918 create_new_commit
2919 } elseif {$selected_commit_type eq {amend}
2920 && ![string match amend* $commit_type]} {
2921 load_last_commit
2922 # The amend request was rejected...
2924 #
2925 if {![string match amend* $commit_type]} {
2926 set selected_commit_type new
2927 }
2928 }
2929}
2930proc do_commit {} {
2932 commit_tree
2933}
2934proc do_about {} {
2936 global appvers copyright
2937 global tcl_patchLevel tk_patchLevel
2938 set w .about_dialog
2940 toplevel $w
2941 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2942 label $w.header -text "About [appname]" \
2944 -font font_uibold
2945 pack $w.header -side top -fill x
2946 frame $w.buttons
2948 button $w.buttons.close -text {Close} \
2949 -font font_ui \
2950 -command [list destroy $w]
2951 pack $w.buttons.close -side right
2952 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2953 label $w.desc \
2955 -text "[appname] - a commit creation tool for Git.
2956$copyright" \
2957 -padx 5 -pady 5 \
2958 -justify left \
2959 -anchor w \
2960 -borderwidth 1 \
2961 -relief solid \
2962 -font font_ui
2963 pack $w.desc -side top -fill x -padx 5 -pady 5
2964 set v {}
2966 append v "[appname] version $appvers\n"
2967 append v "[exec git version]\n"
2968 append v "\n"
2969 if {$tcl_patchLevel eq $tk_patchLevel} {
2970 append v "Tcl/Tk version $tcl_patchLevel"
2971 } else {
2972 append v "Tcl version $tcl_patchLevel"
2973 append v ", Tk version $tk_patchLevel"
2974 }
2975 label $w.vers \
2977 -text $v \
2978 -padx 5 -pady 5 \
2979 -justify left \
2980 -anchor w \
2981 -borderwidth 1 \
2982 -relief solid \
2983 -font font_ui
2984 pack $w.vers -side top -fill x -padx 5 -pady 5
2985 menu $w.ctxm -tearoff 0
2987 $w.ctxm add command \
2988 -label {Copy} \
2989 -font font_ui \
2990 -command "
2991 clipboard clear
2992 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2993 "
2994 bind $w <Visibility> "grab $w; focus $w"
2996 bind $w <Key-Escape> "destroy $w"
2997 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2998 wm title $w "About [appname]"
2999 tkwait window $w
3000}
3001proc do_options {} {
3003 global repo_config global_config font_descs
3004 global repo_config_new global_config_new
3005 array unset repo_config_new
3007 array unset global_config_new
3008 foreach name [array names repo_config] {
3009 set repo_config_new($name) $repo_config($name)
3010 }
3011 load_config 1
3012 foreach name [array names repo_config] {
3013 switch -- $name {
3014 gui.diffcontext {continue}
3015 }
3016 set repo_config_new($name) $repo_config($name)
3017 }
3018 foreach name [array names global_config] {
3019 set global_config_new($name) $global_config($name)
3020 }
3021 set w .options_editor
3023 toplevel $w
3024 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3025 label $w.header -text "[appname] Options" \
3027 -font font_uibold
3028 pack $w.header -side top -fill x
3029 frame $w.buttons
3031 button $w.buttons.restore -text {Restore Defaults} \
3032 -font font_ui \
3033 -command do_restore_defaults
3034 pack $w.buttons.restore -side left
3035 button $w.buttons.save -text Save \
3036 -font font_ui \
3037 -command "
3038 catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
3039 do_save_config $w
3040 "
3041 pack $w.buttons.save -side right
3042 button $w.buttons.cancel -text {Cancel} \
3043 -font font_ui \
3044 -command [list destroy $w]
3045 pack $w.buttons.cancel -side right -padx 5
3046 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3047 labelframe $w.repo -text "[reponame] Repository" \
3049 -font font_ui \
3050 -relief raised -borderwidth 2
3051 labelframe $w.global -text {Global (All Repositories)} \
3052 -font font_ui \
3053 -relief raised -borderwidth 2
3054 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
3055 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
3056 foreach option {
3058 {b pullsummary {Show Pull Summary}}
3059 {b trustmtime {Trust File Modification Timestamps}}
3060 {i diffcontext {Number of Diff Context Lines}}
3061 {t newbranchtemplate {New Branch Name Template}}
3062 } {
3063 set type [lindex $option 0]
3064 set name [lindex $option 1]
3065 set text [lindex $option 2]
3066 foreach f {repo global} {
3067 switch $type {
3068 b {
3069 checkbutton $w.$f.$name -text $text \
3070 -variable ${f}_config_new(gui.$name) \
3071 -onvalue true \
3072 -offvalue false \
3073 -font font_ui
3074 pack $w.$f.$name -side top -anchor w
3075 }
3076 i {
3077 frame $w.$f.$name
3078 label $w.$f.$name.l -text "$text:" -font font_ui
3079 pack $w.$f.$name.l -side left -anchor w -fill x
3080 spinbox $w.$f.$name.v \
3081 -textvariable ${f}_config_new(gui.$name) \
3082 -from 1 -to 99 -increment 1 \
3083 -width 3 \
3084 -font font_ui
3085 bind $w.$f.$name.v <FocusIn> {%W selection range 0 end}
3086 pack $w.$f.$name.v -side right -anchor e -padx 5
3087 pack $w.$f.$name -side top -anchor w -fill x
3088 }
3089 t {
3090 frame $w.$f.$name
3091 label $w.$f.$name.l -text "$text:" -font font_ui
3092 text $w.$f.$name.v \
3093 -borderwidth 1 \
3094 -relief sunken \
3095 -height 1 \
3096 -width 20 \
3097 -font font_ui
3098 $w.$f.$name.v insert 0.0 [set ${f}_config_new(gui.$name)]
3099 bind $w.$f.$name.v <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
3100 bind $w.$f.$name.v <Key-Tab> {focus [tk_focusNext %W];break}
3101 bind $w.$f.$name.v <Key-Return> break
3102 bind $w.$f.$name.v <FocusIn> "$w.$f.$name.v tag add sel 0.0 end"
3103 bind $w.$f.$name.v <FocusOut> "
3104 set ${f}_config_new(gui.$name) \
3105 \[string trim \[$w.$f.$name.v get 0.0 end\]\]
3106 "
3107 pack $w.$f.$name.l -side left -anchor w
3108 pack $w.$f.$name.v -side left -anchor w \
3109 -fill x -expand 1 \
3110 -padx 5
3111 pack $w.$f.$name -side top -anchor w -fill x
3112 }
3113 }
3114 }
3115 }
3116 set all_fonts [lsort [font families]]
3118 foreach option $font_descs {
3119 set name [lindex $option 0]
3120 set font [lindex $option 1]
3121 set text [lindex $option 2]
3122 set global_config_new(gui.$font^^family) \
3124 [font configure $font -family]
3125 set global_config_new(gui.$font^^size) \
3126 [font configure $font -size]
3127 frame $w.global.$name
3129 label $w.global.$name.l -text "$text:" -font font_ui
3130 pack $w.global.$name.l -side left -anchor w -fill x
3131 eval tk_optionMenu $w.global.$name.family \
3132 global_config_new(gui.$font^^family) \
3133 $all_fonts
3134 spinbox $w.global.$name.size \
3135 -textvariable global_config_new(gui.$font^^size) \
3136 -from 2 -to 80 -increment 1 \
3137 -width 3 \
3138 -font font_ui
3139 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3140 pack $w.global.$name.size -side right -anchor e
3141 pack $w.global.$name.family -side right -anchor e
3142 pack $w.global.$name -side top -anchor w -fill x
3143 }
3144 bind $w <Visibility> "grab $w; focus $w"
3146 bind $w <Key-Escape> "destroy $w"
3147 wm title $w "[appname] ([reponame]): Options"
3148 tkwait window $w
3149}
3150proc do_restore_defaults {} {
3152 global font_descs default_config repo_config
3153 global repo_config_new global_config_new
3154 foreach name [array names default_config] {
3156 set repo_config_new($name) $default_config($name)
3157 set global_config_new($name) $default_config($name)
3158 }
3159 foreach option $font_descs {
3161 set name [lindex $option 0]
3162 set repo_config(gui.$name) $default_config(gui.$name)
3163 }
3164 apply_config
3165 foreach option $font_descs {
3167 set name [lindex $option 0]
3168 set font [lindex $option 1]
3169 set global_config_new(gui.$font^^family) \
3170 [font configure $font -family]
3171 set global_config_new(gui.$font^^size) \
3172 [font configure $font -size]
3173 }
3174}
3175proc do_save_config {w} {
3177 if {[catch {save_config} err]} {
3178 error_popup "Failed to completely save options:\n\n$err"
3179 }
3180 reshow_diff
3181 destroy $w
3182}
3183proc do_windows_shortcut {} {
3185 global argv0
3186 if {[catch {
3188 set desktop [exec cygpath \
3189 --windows \
3190 --absolute \
3191 --long-name \
3192 --desktop]
3193 }]} {
3194 set desktop .
3195 }
3196 set fn [tk_getSaveFile \
3197 -parent . \
3198 -title "[appname] ([reponame]): Create Desktop Icon" \
3199 -initialdir $desktop \
3200 -initialfile "Git [reponame].bat"]
3201 if {$fn != {}} {
3202 if {[catch {
3203 set fd [open $fn w]
3204 set sh [exec cygpath \
3205 --windows \
3206 --absolute \
3207 /bin/sh]
3208 set me [exec cygpath \
3209 --unix \
3210 --absolute \
3211 $argv0]
3212 set gd [exec cygpath \
3213 --unix \
3214 --absolute \
3215 [gitdir]]
3216 set gw [exec cygpath \
3217 --windows \
3218 --absolute \
3219 [file dirname [gitdir]]]
3220 regsub -all ' $me "'\\''" me
3221 regsub -all ' $gd "'\\''" gd
3222 puts $fd "@ECHO Entering $gw"
3223 puts $fd "@ECHO Starting git-gui... please wait..."
3224 puts -nonewline $fd "@\"$sh\" --login -c \""
3225 puts -nonewline $fd "GIT_DIR='$gd'"
3226 puts -nonewline $fd " '$me'"
3227 puts $fd "&\""
3228 close $fd
3229 } err]} {
3230 error_popup "Cannot write script:\n\n$err"
3231 }
3232 }
3233}
3234proc do_macosx_app {} {
3236 global argv0 env
3237 set fn [tk_getSaveFile \
3239 -parent . \
3240 -title "[appname] ([reponame]): Create Desktop Icon" \
3241 -initialdir [file join $env(HOME) Desktop] \
3242 -initialfile "Git [reponame].app"]
3243 if {$fn != {}} {
3244 if {[catch {
3245 set Contents [file join $fn Contents]
3246 set MacOS [file join $Contents MacOS]
3247 set exe [file join $MacOS git-gui]
3248 file mkdir $MacOS
3250 set fd [open [file join $Contents Info.plist] w]
3252 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3253<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3254<plist version="1.0">
3255<dict>
3256 <key>CFBundleDevelopmentRegion</key>
3257 <string>English</string>
3258 <key>CFBundleExecutable</key>
3259 <string>git-gui</string>
3260 <key>CFBundleIdentifier</key>
3261 <string>org.spearce.git-gui</string>
3262 <key>CFBundleInfoDictionaryVersion</key>
3263 <string>6.0</string>
3264 <key>CFBundlePackageType</key>
3265 <string>APPL</string>
3266 <key>CFBundleSignature</key>
3267 <string>????</string>
3268 <key>CFBundleVersion</key>
3269 <string>1.0</string>
3270 <key>NSPrincipalClass</key>
3271 <string>NSApplication</string>
3272</dict>
3273</plist>}
3274 close $fd
3275 set fd [open $exe w]
3277 set gd [file normalize [gitdir]]
3278 set ep [file normalize [exec git --exec-path]]
3279 regsub -all ' $gd "'\\''" gd
3280 regsub -all ' $ep "'\\''" ep
3281 puts $fd "#!/bin/sh"
3282 foreach name [array names env] {
3283 if {[string match GIT_* $name]} {
3284 regsub -all ' $env($name) "'\\''" v
3285 puts $fd "export $name='$v'"
3286 }
3287 }
3288 puts $fd "export PATH='$ep':\$PATH"
3289 puts $fd "export GIT_DIR='$gd'"
3290 puts $fd "exec [file normalize $argv0]"
3291 close $fd
3292 file attributes $exe -permissions u+x,g+x,o+x
3294 } err]} {
3295 error_popup "Cannot write icon:\n\n$err"
3296 }
3297 }
3298}
3299proc toggle_or_diff {w x y} {
3301 global file_states file_lists current_diff_path ui_index ui_workdir
3302 global last_clicked selected_paths
3303 set pos [split [$w index @$x,$y] .]
3305 set lno [lindex $pos 0]
3306 set col [lindex $pos 1]
3307 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3308 if {$path eq {}} {
3309 set last_clicked {}
3310 return
3311 }
3312 set last_clicked [list $w $lno]
3314 array unset selected_paths
3315 $ui_index tag remove in_sel 0.0 end
3316 $ui_workdir tag remove in_sel 0.0 end
3317 if {$col == 0} {
3319 if {$current_diff_path eq $path} {
3320 set after {reshow_diff;}
3321 } else {
3322 set after {}
3323 }
3324 if {$w eq $ui_index} {
3325 update_indexinfo \
3326 "Unstaging [short_path $path] from commit" \
3327 [list $path] \
3328 [concat $after {set ui_status_value {Ready.}}]
3329 } elseif {$w eq $ui_workdir} {
3330 update_index \
3331 "Adding [short_path $path]" \
3332 [list $path] \
3333 [concat $after {set ui_status_value {Ready.}}]
3334 }
3335 } else {
3336 show_diff $path $w $lno
3337 }
3338}
3339proc add_one_to_selection {w x y} {
3341 global file_lists last_clicked selected_paths
3342 set lno [lindex [split [$w index @$x,$y] .] 0]
3344 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3345 if {$path eq {}} {
3346 set last_clicked {}
3347 return
3348 }
3349 if {$last_clicked ne {}
3351 && [lindex $last_clicked 0] ne $w} {
3352 array unset selected_paths
3353 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3354 }
3355 set last_clicked [list $w $lno]
3357 if {[catch {set in_sel $selected_paths($path)}]} {
3358 set in_sel 0
3359 }
3360 if {$in_sel} {
3361 unset selected_paths($path)
3362 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3363 } else {
3364 set selected_paths($path) 1
3365 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3366 }
3367}
3368proc add_range_to_selection {w x y} {
3370 global file_lists last_clicked selected_paths
3371 if {[lindex $last_clicked 0] ne $w} {
3373 toggle_or_diff $w $x $y
3374 return
3375 }
3376 set lno [lindex [split [$w index @$x,$y] .] 0]
3378 set lc [lindex $last_clicked 1]
3379 if {$lc < $lno} {
3380 set begin $lc
3381 set end $lno
3382 } else {
3383 set begin $lno
3384 set end $lc
3385 }
3386 foreach path [lrange $file_lists($w) \
3388 [expr {$begin - 1}] \
3389 [expr {$end - 1}]] {
3390 set selected_paths($path) 1
3391 }
3392 $w tag add in_sel $begin.0 [expr {$end + 1}].0
3393}
3394######################################################################
3396##
3397## config defaults
3398set cursor_ptr arrow
3400font create font_diff -family Courier -size 10
3401font create font_ui
3402catch {
3403 label .dummy
3404 eval font configure font_ui [font actual [.dummy cget -font]]
3405 destroy .dummy
3406}
3407font create font_uibold
3409font create font_diffbold
3410if {[is_Windows]} {
3412 set M1B Control
3413 set M1T Ctrl
3414} elseif {[is_MacOSX]} {
3415 set M1B M1
3416 set M1T Cmd
3417} else {
3418 set M1B M1
3419 set M1T M1
3420}
3421proc apply_config {} {
3423 global repo_config font_descs
3424 foreach option $font_descs {
3426 set name [lindex $option 0]
3427 set font [lindex $option 1]
3428 if {[catch {
3429 foreach {cn cv} $repo_config(gui.$name) {
3430 font configure $font $cn $cv
3431 }
3432 } err]} {
3433 error_popup "Invalid font specified in gui.$name:\n\n$err"
3434 }
3435 foreach {cn cv} [font configure $font] {
3436 font configure ${font}bold $cn $cv
3437 }
3438 font configure ${font}bold -weight bold
3439 }
3440}
3441set default_config(gui.trustmtime) false
3443set default_config(gui.pullsummary) true
3444set default_config(gui.diffcontext) 5
3445set default_config(gui.newbranchtemplate) {}
3446set default_config(gui.fontui) [font configure font_ui]
3447set default_config(gui.fontdiff) [font configure font_diff]
3448set font_descs {
3449 {fontui font_ui {Main Font}}
3450 {fontdiff font_diff {Diff/Console Font}}
3451}
3452load_config 0
3453apply_config
3454######################################################################
3456##
3457## ui construction
3458# -- Menu Bar
3460#
3461menu .mbar -tearoff 0
3462.mbar add cascade -label Repository -menu .mbar.repository
3463.mbar add cascade -label Edit -menu .mbar.edit
3464if {!$single_commit} {
3465 .mbar add cascade -label Branch -menu .mbar.branch
3466}
3467.mbar add cascade -label Commit -menu .mbar.commit
3468if {!$single_commit} {
3469 .mbar add cascade -label Fetch -menu .mbar.fetch
3470 .mbar add cascade -label Pull -menu .mbar.pull
3471 .mbar add cascade -label Push -menu .mbar.push
3472}
3473. configure -menu .mbar
3474# -- Repository Menu
3476#
3477menu .mbar.repository
3478.mbar.repository add command \
3479 -label {Visualize Current Branch} \
3480 -command {do_gitk {}} \
3481 -font font_ui
3482if {![is_MacOSX]} {
3483 .mbar.repository add command \
3484 -label {Visualize All Branches} \
3485 -command {do_gitk {--all}} \
3486 -font font_ui
3487}
3488.mbar.repository add separator
3489if {!$single_commit} {
3491 .mbar.repository add command -label {Compress Database} \
3492 -command do_gc \
3493 -font font_ui
3494 .mbar.repository add command -label {Verify Database} \
3496 -command do_fsck_objects \
3497 -font font_ui
3498 .mbar.repository add separator
3500 if {[is_Windows]} {
3502 .mbar.repository add command \
3503 -label {Create Desktop Icon} \
3504 -command do_windows_shortcut \
3505 -font font_ui
3506 } elseif {[is_MacOSX]} {
3507 .mbar.repository add command \
3508 -label {Create Desktop Icon} \
3509 -command do_macosx_app \
3510 -font font_ui
3511 }
3512}
3513.mbar.repository add command -label Quit \
3515 -command do_quit \
3516 -accelerator $M1T-Q \
3517 -font font_ui
3518# -- Edit Menu
3520#
3521menu .mbar.edit
3522.mbar.edit add command -label Undo \
3523 -command {catch {[focus] edit undo}} \
3524 -accelerator $M1T-Z \
3525 -font font_ui
3526.mbar.edit add command -label Redo \
3527 -command {catch {[focus] edit redo}} \
3528 -accelerator $M1T-Y \
3529 -font font_ui
3530.mbar.edit add separator
3531.mbar.edit add command -label Cut \
3532 -command {catch {tk_textCut [focus]}} \
3533 -accelerator $M1T-X \
3534 -font font_ui
3535.mbar.edit add command -label Copy \
3536 -command {catch {tk_textCopy [focus]}} \
3537 -accelerator $M1T-C \
3538 -font font_ui
3539.mbar.edit add command -label Paste \
3540 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3541 -accelerator $M1T-V \
3542 -font font_ui
3543.mbar.edit add command -label Delete \
3544 -command {catch {[focus] delete sel.first sel.last}} \
3545 -accelerator Del \
3546 -font font_ui
3547.mbar.edit add separator
3548.mbar.edit add command -label {Select All} \
3549 -command {catch {[focus] tag add sel 0.0 end}} \
3550 -accelerator $M1T-A \
3551 -font font_ui
3552# -- Branch Menu
3554#
3555if {!$single_commit} {
3556 menu .mbar.branch
3557 .mbar.branch add command -label {Create...} \
3559 -command do_create_branch \
3560 -accelerator $M1T-N \
3561 -font font_ui
3562 lappend disable_on_lock [list .mbar.branch entryconf \
3563 [.mbar.branch index last] -state]
3564 .mbar.branch add command -label {Delete...} \
3566 -command do_delete_branch \
3567 -font font_ui
3568 lappend disable_on_lock [list .mbar.branch entryconf \
3569 [.mbar.branch index last] -state]
3570}
3571# -- Commit Menu
3573#
3574menu .mbar.commit
3575.mbar.commit add radiobutton \
3577 -label {New Commit} \
3578 -command do_select_commit_type \
3579 -variable selected_commit_type \
3580 -value new \
3581 -font font_ui
3582lappend disable_on_lock \
3583 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3584.mbar.commit add radiobutton \
3586 -label {Amend Last Commit} \
3587 -command do_select_commit_type \
3588 -variable selected_commit_type \
3589 -value amend \
3590 -font font_ui
3591lappend disable_on_lock \
3592 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3593.mbar.commit add separator
3595.mbar.commit add command -label Rescan \
3597 -command do_rescan \
3598 -accelerator F5 \
3599 -font font_ui
3600lappend disable_on_lock \
3601 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3602.mbar.commit add command -label {Add To Commit} \
3604 -command do_add_selection \
3605 -font font_ui
3606lappend disable_on_lock \
3607 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3608.mbar.commit add command -label {Add All To Commit} \
3610 -command do_add_all \
3611 -accelerator $M1T-I \
3612 -font font_ui
3613lappend disable_on_lock \
3614 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3615.mbar.commit add command -label {Unstage From Commit} \
3617 -command do_unstage_selection \
3618 -font font_ui
3619lappend disable_on_lock \
3620 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3621.mbar.commit add command -label {Revert Changes} \
3623 -command do_revert_selection \
3624 -font font_ui
3625lappend disable_on_lock \
3626 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3627.mbar.commit add separator
3629.mbar.commit add command -label {Sign Off} \
3631 -command do_signoff \
3632 -accelerator $M1T-S \
3633 -font font_ui
3634.mbar.commit add command -label Commit \
3636 -command do_commit \
3637 -accelerator $M1T-Return \
3638 -font font_ui
3639lappend disable_on_lock \
3640 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3641# -- Transport menus
3643#
3644if {!$single_commit} {
3645 menu .mbar.fetch
3646 menu .mbar.pull
3647 menu .mbar.push
3648}
3649if {[is_MacOSX]} {
3651 # -- Apple Menu (Mac OS X only)
3652 #
3653 .mbar add cascade -label Apple -menu .mbar.apple
3654 menu .mbar.apple
3655 .mbar.apple add command -label "About [appname]" \
3657 -command do_about \
3658 -font font_ui
3659 .mbar.apple add command -label "[appname] Options..." \
3660 -command do_options \
3661 -font font_ui
3662} else {
3663 # -- Edit Menu
3664 #
3665 .mbar.edit add separator
3666 .mbar.edit add command -label {Options...} \
3667 -command do_options \
3668 -font font_ui
3669 # -- Tools Menu
3671 #
3672 if {[file exists /usr/local/miga/lib/gui-miga]
3673 && [file exists .pvcsrc]} {
3674 proc do_miga {} {
3675 global ui_status_value
3676 if {![lock_index update]} return
3677 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3678 set miga_fd [open "|$cmd" r]
3679 fconfigure $miga_fd -blocking 0
3680 fileevent $miga_fd readable [list miga_done $miga_fd]
3681 set ui_status_value {Running miga...}
3682 }
3683 proc miga_done {fd} {
3684 read $fd 512
3685 if {[eof $fd]} {
3686 close $fd
3687 unlock_index
3688 rescan [list set ui_status_value {Ready.}]
3689 }
3690 }
3691 .mbar add cascade -label Tools -menu .mbar.tools
3692 menu .mbar.tools
3693 .mbar.tools add command -label "Migrate" \
3694 -command do_miga \
3695 -font font_ui
3696 lappend disable_on_lock \
3697 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3698 }
3699 # -- Help Menu
3701 #
3702 .mbar add cascade -label Help -menu .mbar.help
3703 menu .mbar.help
3704 .mbar.help add command -label "About [appname]" \
3706 -command do_about \
3707 -font font_ui
3708}
3709# -- Branch Control
3712#
3713frame .branch \
3714 -borderwidth 1 \
3715 -relief sunken
3716label .branch.l1 \
3717 -text {Current Branch:} \
3718 -anchor w \
3719 -justify left \
3720 -font font_ui
3721label .branch.cb \
3722 -textvariable current_branch \
3723 -anchor w \
3724 -justify left \
3725 -font font_ui
3726pack .branch.l1 -side left
3727pack .branch.cb -side left -fill x
3728pack .branch -side top -fill x
3729# -- Main Window Layout
3731#
3732panedwindow .vpane -orient vertical
3733panedwindow .vpane.files -orient horizontal
3734.vpane add .vpane.files -sticky nsew -height 100 -width 200
3735pack .vpane -anchor n -side top -fill both -expand 1
3736# -- Index File List
3738#
3739frame .vpane.files.index -height 100 -width 200
3740label .vpane.files.index.title -text {Changes To Be Committed} \
3741 -background green \
3742 -font font_ui
3743text $ui_index -background white -borderwidth 0 \
3744 -width 20 -height 10 \
3745 -wrap none \
3746 -font font_ui \
3747 -cursor $cursor_ptr \
3748 -xscrollcommand {.vpane.files.index.sx set} \
3749 -yscrollcommand {.vpane.files.index.sy set} \
3750 -state disabled
3751scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3752scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3753pack .vpane.files.index.title -side top -fill x
3754pack .vpane.files.index.sx -side bottom -fill x
3755pack .vpane.files.index.sy -side right -fill y
3756pack $ui_index -side left -fill both -expand 1
3757.vpane.files add .vpane.files.index -sticky nsew
3758# -- Working Directory File List
3760#
3761frame .vpane.files.workdir -height 100 -width 200
3762label .vpane.files.workdir.title -text {Changed But Not Updated} \
3763 -background red \
3764 -font font_ui
3765text $ui_workdir -background white -borderwidth 0 \
3766 -width 20 -height 10 \
3767 -wrap none \
3768 -font font_ui \
3769 -cursor $cursor_ptr \
3770 -xscrollcommand {.vpane.files.workdir.sx set} \
3771 -yscrollcommand {.vpane.files.workdir.sy set} \
3772 -state disabled
3773scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3774scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3775pack .vpane.files.workdir.title -side top -fill x
3776pack .vpane.files.workdir.sx -side bottom -fill x
3777pack .vpane.files.workdir.sy -side right -fill y
3778pack $ui_workdir -side left -fill both -expand 1
3779.vpane.files add .vpane.files.workdir -sticky nsew
3780foreach i [list $ui_index $ui_workdir] {
3782 $i tag conf in_diff -font font_uibold
3783 $i tag conf in_sel \
3784 -background [$i cget -foreground] \
3785 -foreground [$i cget -background]
3786}
3787unset i
3788# -- Diff and Commit Area
3790#
3791frame .vpane.lower -height 300 -width 400
3792frame .vpane.lower.commarea
3793frame .vpane.lower.diff -relief sunken -borderwidth 1
3794pack .vpane.lower.commarea -side top -fill x
3795pack .vpane.lower.diff -side bottom -fill both -expand 1
3796.vpane add .vpane.lower -stick nsew
3797# -- Commit Area Buttons
3799#
3800frame .vpane.lower.commarea.buttons
3801label .vpane.lower.commarea.buttons.l -text {} \
3802 -anchor w \
3803 -justify left \
3804 -font font_ui
3805pack .vpane.lower.commarea.buttons.l -side top -fill x
3806pack .vpane.lower.commarea.buttons -side left -fill y
3807button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3809 -command do_rescan \
3810 -font font_ui
3811pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3812lappend disable_on_lock \
3813 {.vpane.lower.commarea.buttons.rescan conf -state}
3814button .vpane.lower.commarea.buttons.incall -text {Add All} \
3816 -command do_add_all \
3817 -font font_ui
3818pack .vpane.lower.commarea.buttons.incall -side top -fill x
3819lappend disable_on_lock \
3820 {.vpane.lower.commarea.buttons.incall conf -state}
3821button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3823 -command do_signoff \
3824 -font font_ui
3825pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3826button .vpane.lower.commarea.buttons.commit -text {Commit} \
3828 -command do_commit \
3829 -font font_ui
3830pack .vpane.lower.commarea.buttons.commit -side top -fill x
3831lappend disable_on_lock \
3832 {.vpane.lower.commarea.buttons.commit conf -state}
3833# -- Commit Message Buffer
3835#
3836frame .vpane.lower.commarea.buffer
3837frame .vpane.lower.commarea.buffer.header
3838set ui_comm .vpane.lower.commarea.buffer.t
3839set ui_coml .vpane.lower.commarea.buffer.header.l
3840radiobutton .vpane.lower.commarea.buffer.header.new \
3841 -text {New Commit} \
3842 -command do_select_commit_type \
3843 -variable selected_commit_type \
3844 -value new \
3845 -font font_ui
3846lappend disable_on_lock \
3847 [list .vpane.lower.commarea.buffer.header.new conf -state]
3848radiobutton .vpane.lower.commarea.buffer.header.amend \
3849 -text {Amend Last Commit} \
3850 -command do_select_commit_type \
3851 -variable selected_commit_type \
3852 -value amend \
3853 -font font_ui
3854lappend disable_on_lock \
3855 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3856label $ui_coml \
3857 -anchor w \
3858 -justify left \
3859 -font font_ui
3860proc trace_commit_type {varname args} {
3861 global ui_coml commit_type
3862 switch -glob -- $commit_type {
3863 initial {set txt {Initial Commit Message:}}
3864 amend {set txt {Amended Commit Message:}}
3865 amend-initial {set txt {Amended Initial Commit Message:}}
3866 amend-merge {set txt {Amended Merge Commit Message:}}
3867 merge {set txt {Merge Commit Message:}}
3868 * {set txt {Commit Message:}}
3869 }
3870 $ui_coml conf -text $txt
3871}
3872trace add variable commit_type write trace_commit_type
3873pack $ui_coml -side left -fill x
3874pack .vpane.lower.commarea.buffer.header.amend -side right
3875pack .vpane.lower.commarea.buffer.header.new -side right
3876text $ui_comm -background white -borderwidth 1 \
3878 -undo true \
3879 -maxundo 20 \
3880 -autoseparators true \
3881 -relief sunken \
3882 -width 75 -height 9 -wrap none \
3883 -font font_diff \
3884 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3885scrollbar .vpane.lower.commarea.buffer.sby \
3886 -command [list $ui_comm yview]
3887pack .vpane.lower.commarea.buffer.header -side top -fill x
3888pack .vpane.lower.commarea.buffer.sby -side right -fill y
3889pack $ui_comm -side left -fill y
3890pack .vpane.lower.commarea.buffer -side left -fill y
3891# -- Commit Message Buffer Context Menu
3893#
3894set ctxm .vpane.lower.commarea.buffer.ctxm
3895menu $ctxm -tearoff 0
3896$ctxm add command \
3897 -label {Cut} \
3898 -font font_ui \
3899 -command {tk_textCut $ui_comm}
3900$ctxm add command \
3901 -label {Copy} \
3902 -font font_ui \
3903 -command {tk_textCopy $ui_comm}
3904$ctxm add command \
3905 -label {Paste} \
3906 -font font_ui \
3907 -command {tk_textPaste $ui_comm}
3908$ctxm add command \
3909 -label {Delete} \
3910 -font font_ui \
3911 -command {$ui_comm delete sel.first sel.last}
3912$ctxm add separator
3913$ctxm add command \
3914 -label {Select All} \
3915 -font font_ui \
3916 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3917$ctxm add command \
3918 -label {Copy All} \
3919 -font font_ui \
3920 -command {
3921 $ui_comm tag add sel 0.0 end
3922 tk_textCopy $ui_comm
3923 $ui_comm tag remove sel 0.0 end
3924 }
3925$ctxm add separator
3926$ctxm add command \
3927 -label {Sign Off} \
3928 -font font_ui \
3929 -command do_signoff
3930bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3931# -- Diff Header
3933#
3934set current_diff_path {}
3935set diff_actions [list]
3936proc trace_current_diff_path {varname args} {
3937 global current_diff_path diff_actions file_states
3938 if {$current_diff_path eq {}} {
3939 set s {}
3940 set f {}
3941 set p {}
3942 set o disabled
3943 } else {
3944 set p $current_diff_path
3945 set s [mapdesc [lindex $file_states($p) 0] $p]
3946 set f {File:}
3947 set p [escape_path $p]
3948 set o normal
3949 }
3950 .vpane.lower.diff.header.status configure -text $s
3952 .vpane.lower.diff.header.file configure -text $f
3953 .vpane.lower.diff.header.path configure -text $p
3954 foreach w $diff_actions {
3955 uplevel #0 $w $o
3956 }
3957}
3958trace add variable current_diff_path write trace_current_diff_path
3959frame .vpane.lower.diff.header -background orange
3961label .vpane.lower.diff.header.status \
3962 -background orange \
3963 -width $max_status_desc \
3964 -anchor w \
3965 -justify left \
3966 -font font_ui
3967label .vpane.lower.diff.header.file \
3968 -background orange \
3969 -anchor w \
3970 -justify left \
3971 -font font_ui
3972label .vpane.lower.diff.header.path \
3973 -background orange \
3974 -anchor w \
3975 -justify left \
3976 -font font_ui
3977pack .vpane.lower.diff.header.status -side left
3978pack .vpane.lower.diff.header.file -side left
3979pack .vpane.lower.diff.header.path -fill x
3980set ctxm .vpane.lower.diff.header.ctxm
3981menu $ctxm -tearoff 0
3982$ctxm add command \
3983 -label {Copy} \
3984 -font font_ui \
3985 -command {
3986 clipboard clear
3987 clipboard append \
3988 -format STRING \
3989 -type STRING \
3990 -- $current_diff_path
3991 }
3992lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3993bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3994# -- Diff Body
3996#
3997frame .vpane.lower.diff.body
3998set ui_diff .vpane.lower.diff.body.t
3999text $ui_diff -background white -borderwidth 0 \
4000 -width 80 -height 15 -wrap none \
4001 -font font_diff \
4002 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4003 -yscrollcommand {.vpane.lower.diff.body.sby set} \
4004 -state disabled
4005scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4006 -command [list $ui_diff xview]
4007scrollbar .vpane.lower.diff.body.sby -orient vertical \
4008 -command [list $ui_diff yview]
4009pack .vpane.lower.diff.body.sbx -side bottom -fill x
4010pack .vpane.lower.diff.body.sby -side right -fill y
4011pack $ui_diff -side left -fill both -expand 1
4012pack .vpane.lower.diff.header -side top -fill x
4013pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4014$ui_diff tag conf d_@ -foreground blue -font font_diffbold
4016$ui_diff tag conf d_+ -foreground {#00a000}
4017$ui_diff tag conf d_- -foreground red
4018$ui_diff tag conf d_++ -foreground {#00a000}
4020$ui_diff tag conf d_-- -foreground red
4021$ui_diff tag conf d_+s \
4022 -foreground {#00a000} \
4023 -background {#e2effa}
4024$ui_diff tag conf d_-s \
4025 -foreground red \
4026 -background {#e2effa}
4027$ui_diff tag conf d_s+ \
4028 -foreground {#00a000} \
4029 -background ivory1
4030$ui_diff tag conf d_s- \
4031 -foreground red \
4032 -background ivory1
4033$ui_diff tag conf d<<<<<<< \
4035 -foreground orange \
4036 -font font_diffbold
4037$ui_diff tag conf d======= \
4038 -foreground orange \
4039 -font font_diffbold
4040$ui_diff tag conf d>>>>>>> \
4041 -foreground orange \
4042 -font font_diffbold
4043$ui_diff tag raise sel
4045# -- Diff Body Context Menu
4047#
4048set ctxm .vpane.lower.diff.body.ctxm
4049menu $ctxm -tearoff 0
4050$ctxm add command \
4051 -label {Refresh} \
4052 -font font_ui \
4053 -command reshow_diff
4054$ctxm add command \
4055 -label {Copy} \
4056 -font font_ui \
4057 -command {tk_textCopy $ui_diff}
4058lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4059$ctxm add command \
4060 -label {Select All} \
4061 -font font_ui \
4062 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4063lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4064$ctxm add command \
4065 -label {Copy All} \
4066 -font font_ui \
4067 -command {
4068 $ui_diff tag add sel 0.0 end
4069 tk_textCopy $ui_diff
4070 $ui_diff tag remove sel 0.0 end
4071 }
4072lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4073$ctxm add separator
4074$ctxm add command \
4075 -label {Decrease Font Size} \
4076 -font font_ui \
4077 -command {incr_font_size font_diff -1}
4078lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4079$ctxm add command \
4080 -label {Increase Font Size} \
4081 -font font_ui \
4082 -command {incr_font_size font_diff 1}
4083lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4084$ctxm add separator
4085$ctxm add command \
4086 -label {Show Less Context} \
4087 -font font_ui \
4088 -command {if {$repo_config(gui.diffcontext) >= 2} {
4089 incr repo_config(gui.diffcontext) -1
4090 reshow_diff
4091 }}
4092lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4093$ctxm add command \
4094 -label {Show More Context} \
4095 -font font_ui \
4096 -command {
4097 incr repo_config(gui.diffcontext)
4098 reshow_diff
4099 }
4100lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4101$ctxm add separator
4102$ctxm add command -label {Options...} \
4103 -font font_ui \
4104 -command do_options
4105bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
4106# -- Status Bar
4108#
4109set ui_status_value {Initializing...}
4110label .status -textvariable ui_status_value \
4111 -anchor w \
4112 -justify left \
4113 -borderwidth 1 \
4114 -relief sunken \
4115 -font font_ui
4116pack .status -anchor w -side bottom -fill x
4117# -- Load geometry
4119#
4120catch {
4121set gm $repo_config(gui.geometry)
4122wm geometry . [lindex $gm 0]
4123.vpane sash place 0 \
4124 [lindex [.vpane sash coord 0] 0] \
4125 [lindex $gm 1]
4126.vpane.files sash place 0 \
4127 [lindex $gm 2] \
4128 [lindex [.vpane.files sash coord 0] 1]
4129unset gm
4130}
4131# -- Key Bindings
4133#
4134bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4135bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4136bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4137bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4138bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4139bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4140bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4141bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4142bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4143bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4144bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4145bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4147bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4148bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4149bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4150bind $ui_diff <$M1B-Key-v> {break}
4151bind $ui_diff <$M1B-Key-V> {break}
4152bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4153bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4154bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
4155bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
4156bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
4157bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
4158if {!$single_commit} {
4160 bind . <$M1B-Key-n> do_create_branch
4161 bind . <$M1B-Key-N> do_create_branch
4162}
4163bind . <Destroy> do_quit
4165bind all <Key-F5> do_rescan
4166bind all <$M1B-Key-r> do_rescan
4167bind all <$M1B-Key-R> do_rescan
4168bind . <$M1B-Key-s> do_signoff
4169bind . <$M1B-Key-S> do_signoff
4170bind . <$M1B-Key-i> do_add_all
4171bind . <$M1B-Key-I> do_add_all
4172bind . <$M1B-Key-Return> do_commit
4173bind all <$M1B-Key-q> do_quit
4174bind all <$M1B-Key-Q> do_quit
4175bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4176bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4177foreach i [list $ui_index $ui_workdir] {
4178 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
4179 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
4180 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4181}
4182unset i
4183set file_lists($ui_index) [list]
4185set file_lists($ui_workdir) [list]
4186set HEAD {}
4188set PARENT {}
4189set MERGE_HEAD [list]
4190set commit_type {}
4191set empty_tree {}
4192set current_branch {}
4193set current_diff_path {}
4194set selected_commit_type new
4195wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
4197focus -force $ui_comm
4198# -- Warn the user about environmental problems. Cygwin's Tcl
4200# does *not* pass its env array onto any processes it spawns.
4201# This means that git processes get none of our environment.
4202#
4203if {[is_Windows]} {
4204 set ignored_env 0
4205 set suggest_user {}
4206 set msg "Possible environment issues exist.
4207The following environment variables are probably
4209going to be ignored by any Git subprocess run
4210by [appname]:
4211"
4213 foreach name [array names env] {
4214 switch -regexp -- $name {
4215 {^GIT_INDEX_FILE$} -
4216 {^GIT_OBJECT_DIRECTORY$} -
4217 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4218 {^GIT_DIFF_OPTS$} -
4219 {^GIT_EXTERNAL_DIFF$} -
4220 {^GIT_PAGER$} -
4221 {^GIT_TRACE$} -
4222 {^GIT_CONFIG$} -
4223 {^GIT_CONFIG_LOCAL$} -
4224 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4225 append msg " - $name\n"
4226 incr ignored_env
4227 }
4228 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4229 append msg " - $name\n"
4230 incr ignored_env
4231 set suggest_user $name
4232 }
4233 }
4234 }
4235 if {$ignored_env > 0} {
4236 append msg "
4237This is due to a known issue with the
4238Tcl binary distributed by Cygwin."
4239 if {$suggest_user ne {}} {
4241 append msg "
4242A good replacement for $suggest_user
4244is placing values for the user.name and
4245user.email settings into your personal
4246~/.gitconfig file.
4247"
4248 }
4249 warn_popup $msg
4250 }
4251 unset ignored_env msg suggest_user name
4252}
4253# -- Only initialize complex UI if we are going to stay running.
4255#
4256if {!$single_commit} {
4257 load_all_remotes
4258 load_all_heads
4259 populate_branch_menu
4261 populate_fetch_menu .mbar.fetch
4262 populate_pull_menu .mbar.pull
4263 populate_push_menu .mbar.push
4264}
4265# -- Only suggest a gc run if we are going to stay running.
4267#
4268if {!$single_commit} {
4269 set object_limit 2000
4270 if {[is_Windows]} {set object_limit 200}
4271 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4272 if {$objects_current >= $object_limit} {
4273 if {[ask_popup \
4274 "This repository currently has $objects_current loose objects.
4275To maintain optimal performance it is strongly
4277recommended that you compress the database
4278when more than $object_limit loose objects exist.
4279Compress the database now?"] eq yes} {
4281 do_gc
4282 }
4283 }
4284 unset object_limit _junk objects_current
4285}
4286lock_index begin-read
4288after 1 do_rescan