git-gui: Make the gitk starting message match our usual format.
[git/dscho.git] / git-gui.sh
blob0851eaeebcc8a9c4c69bb1f1f47d76c7e68eab9d
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 set appvers {@@GIT_VERSION@@}
6 set copyright {
7 Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
23 ######################################################################
25 ## read only globals
27 set _appname [lindex [file split $argv0] end]
28 set _gitdir {}
29 set _reponame {}
31 proc appname {} {
32 global _appname
33 return $_appname
36 proc gitdir {args} {
37 global _gitdir
38 if {$args eq {}} {
39 return $_gitdir
41 return [eval [concat [list file join $_gitdir] $args]]
44 proc reponame {} {
45 global _reponame
46 return $_reponame
49 ######################################################################
51 ## config
53 proc is_many_config {name} {
54 switch -glob -- $name {
55 remote.*.fetch -
56 remote.*.push
57 {return 1}
59 {return 0}
63 proc load_config {include_global} {
64 global repo_config global_config default_config
66 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
79 close $fd_rc
83 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
95 close $fd_rc
98 foreach name [array names default_config] {
99 if {[catch {set v $global_config($name)}]} {
100 set global_config($name) $default_config($name)
102 if {[catch {set v $repo_config($name)}]} {
103 set repo_config($name) $default_config($name)
108 proc save_config {} {
109 global default_config font_descs
110 global repo_config global_config
111 global repo_config_new global_config_new
113 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)
127 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
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
144 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
153 set repo_config($name) $value
158 proc error_popup {msg} {
159 set title [appname]
160 if {[reponame] ne {}} {
161 append title " ([reponame])"
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 .
171 eval $cmd
174 proc warn_popup {msg} {
175 set title [appname]
176 if {[reponame] ne {}} {
177 append title " ([reponame])"
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 .
187 eval $cmd
190 proc info_popup {msg} {
191 set title [appname]
192 if {[reponame] ne {}} {
193 append title " ([reponame])"
195 tk_messageBox \
196 -parent . \
197 -icon info \
198 -type ok \
199 -title $title \
200 -message $msg
203 proc ask_popup {msg} {
204 set title [appname]
205 if {[reponame] ne {}} {
206 append title " ([reponame])"
208 return [tk_messageBox \
209 -parent . \
210 -icon question \
211 -type yesno \
212 -title $title \
213 -message $msg]
216 ######################################################################
218 ## repository setup
220 if { [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
226 if {![file isdirectory $_gitdir]} {
227 catch {wm withdraw .}
228 error_popup "Git directory not found:\n\n$_gitdir"
229 exit 1
231 if {[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
236 if {[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
241 set _reponame [lindex [file split \
242 [file normalize [file dirname $_gitdir]]] \
243 end]
245 set single_commit 0
246 if {[appname] eq {git-citool}} {
247 set single_commit 1
250 ######################################################################
252 ## task management
254 set rescan_active 0
255 set diff_active 0
256 set last_clicked {}
258 set disable_on_lock [list]
259 set index_lock_type none
261 proc lock_index {type} {
262 global index_lock_type disable_on_lock
264 if {$index_lock_type eq {none}} {
265 set index_lock_type $type
266 foreach w $disable_on_lock {
267 uplevel #0 $w disabled
269 return 1
270 } elseif {$index_lock_type eq "begin-$type"} {
271 set index_lock_type $type
272 return 1
274 return 0
277 proc unlock_index {} {
278 global index_lock_type disable_on_lock
280 set index_lock_type none
281 foreach w $disable_on_lock {
282 uplevel #0 $w normal
286 ######################################################################
288 ## status
290 proc repository_state {ctvar hdvar mhvar} {
291 global current_branch
292 upvar $ctvar ct $hdvar hd $mhvar mh
294 set mh [list]
296 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
305 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
306 set hd {}
307 set ct initial
308 return
311 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
318 close $fd_mh
319 return
322 set ct normal
325 proc PARENT {} {
326 global PARENT empty_tree
328 set p [lindex $PARENT 0]
329 if {$p ne {}} {
330 return $p
332 if {$empty_tree eq {}} {
333 set empty_tree [exec git mktree << {}]
335 return $empty_tree
338 proc rescan {after} {
339 global HEAD PARENT MERGE_HEAD commit_type
340 global ui_index ui_other ui_status_value ui_comm
341 global rescan_active file_states
342 global repo_config
344 if {$rescan_active > 0 || ![lock_index read]} return
346 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
357 array unset file_states
359 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]} {
365 $ui_comm edit reset
366 $ui_comm edit modified false
369 if {$repo_config(gui.trustmtime) eq {true}} {
370 rescan_stage2 {} $after
371 } else {
372 set rescan_active 1
373 set ui_status_value {Refreshing file status...}
374 set cmd [list git update-index]
375 lappend cmd -q
376 lappend cmd --unmerged
377 lappend cmd --ignore-missing
378 lappend cmd --refresh
379 set fd_rf [open "| $cmd" r]
380 fconfigure $fd_rf -blocking 0 -translation binary
381 fileevent $fd_rf readable \
382 [list rescan_stage2 $fd_rf $after]
386 proc rescan_stage2 {fd after} {
387 global ui_status_value
388 global rescan_active buf_rdi buf_rdf buf_rlo
390 if {$fd ne {}} {
391 read $fd
392 if {![eof $fd]} return
393 close $fd
396 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"
403 set buf_rdi {}
404 set buf_rdf {}
405 set buf_rlo {}
407 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]
413 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]
421 proc load_message {file} {
422 global ui_comm
424 set f [gitdir $file]
425 if {[file isfile $f]} {
426 if {[catch {set fd [open $f r]}]} {
427 return 0
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
435 return 0
438 proc read_diff_index {fd after} {
439 global buf_rdi
441 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
451 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
461 if {$c < $n} {
462 set buf_rdi [string range $buf_rdi $c end]
463 } else {
464 set buf_rdi {}
467 rescan_done $fd buf_rdi $after
470 proc read_diff_files {fd after} {
471 global buf_rdf
473 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
483 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
493 if {$c < $n} {
494 set buf_rdf [string range $buf_rdf $c end]
495 } else {
496 set buf_rdf {}
499 rescan_done $fd buf_rdf $after
502 proc read_ls_others {fd after} {
503 global buf_rlo
505 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
511 rescan_done $fd buf_rlo $after
514 proc rescan_done {fd buf after} {
515 global rescan_active
516 global file_states repo_config
517 upvar $buf to_clear
519 if {![eof $fd]} return
520 set to_clear {}
521 close $fd
522 if {[incr rescan_active -1] > 0} return
524 prune_selection
525 unlock_index
526 display_all_files
528 if {$repo_config(gui.partialinclude) ne {true}} {
529 set pathList [list]
530 foreach path [array names file_states] {
531 switch -- [lindex $file_states($path) 0] {
532 A? -
533 M? {lappend pathList $path}
536 if {$pathList ne {}} {
537 update_index \
538 "Updating included files" \
539 $pathList \
540 [concat {reshow_diff;} $after]
541 return
545 reshow_diff
546 uplevel #0 $after
549 proc prune_selection {} {
550 global file_states selected_paths
552 foreach path [array names selected_paths] {
553 if {[catch {set still_here $file_states($path)}]} {
554 unset selected_paths($path)
559 ######################################################################
561 ## diff
563 proc clear_diff {} {
564 global ui_diff current_diff ui_index ui_other
566 $ui_diff conf -state normal
567 $ui_diff delete 0.0 end
568 $ui_diff conf -state disabled
570 set current_diff {}
572 $ui_index tag remove in_diff 0.0 end
573 $ui_other tag remove in_diff 0.0 end
576 proc reshow_diff {} {
577 global current_diff ui_status_value file_states
579 if {$current_diff eq {}
580 || [catch {set s $file_states($current_diff)}]} {
581 clear_diff
582 } else {
583 show_diff $current_diff
587 proc handle_empty_diff {} {
588 global current_diff file_states file_lists
590 set path $current_diff
591 set s $file_states($path)
592 if {[lindex $s 0] ne {_M}} return
594 info_popup "No differences detected.
596 [short_path $path] has no changes.
598 The modification date of this file was updated
599 by another application and you currently have
600 the Trust File Modification Timestamps option
601 enabled, so Git did not automatically detect
602 that there are no content differences in this
603 file.
605 This file will now be removed from the modified
606 files list, to prevent possible confusion.
608 if {[catch {exec git update-index -- $path} err]} {
609 error_popup "Failed to refresh index:\n\n$err"
612 clear_diff
613 set old_w [mapcol [lindex $file_states($path) 0] $path]
614 set lno [lsearch -sorted $file_lists($old_w) $path]
615 if {$lno >= 0} {
616 set file_lists($old_w) \
617 [lreplace $file_lists($old_w) $lno $lno]
618 incr lno
619 $old_w conf -state normal
620 $old_w delete $lno.0 [expr {$lno + 1}].0
621 $old_w conf -state disabled
625 proc show_diff {path {w {}} {lno {}}} {
626 global file_states file_lists
627 global is_3way_diff diff_active repo_config
628 global ui_diff current_diff ui_status_value
630 if {$diff_active || ![lock_index read]} return
632 clear_diff
633 if {$w eq {} || $lno == {}} {
634 foreach w [array names file_lists] {
635 set lno [lsearch -sorted $file_lists($w) $path]
636 if {$lno >= 0} {
637 incr lno
638 break
642 if {$w ne {} && $lno >= 1} {
643 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
646 set s $file_states($path)
647 set m [lindex $s 0]
648 set is_3way_diff 0
649 set diff_active 1
650 set current_diff $path
651 set ui_status_value "Loading diff of [escape_path $path]..."
653 set cmd [list | git diff-index]
654 lappend cmd --no-color
655 if {$repo_config(gui.diffcontext) > 0} {
656 lappend cmd "-U$repo_config(gui.diffcontext)"
658 lappend cmd -p
660 switch $m {
661 MM {
662 lappend cmd -c
664 _O {
665 if {[catch {
666 set fd [open $path r]
667 set content [read $fd]
668 close $fd
669 } err ]} {
670 set diff_active 0
671 unlock_index
672 set ui_status_value "Unable to display [escape_path $path]"
673 error_popup "Error loading file:\n\n$err"
674 return
676 $ui_diff conf -state normal
677 $ui_diff insert end $content
678 $ui_diff conf -state disabled
679 set diff_active 0
680 unlock_index
681 set ui_status_value {Ready.}
682 return
686 lappend cmd [PARENT]
687 lappend cmd --
688 lappend cmd $path
690 if {[catch {set fd [open $cmd r]} err]} {
691 set diff_active 0
692 unlock_index
693 set ui_status_value "Unable to display [escape_path $path]"
694 error_popup "Error loading diff:\n\n$err"
695 return
698 fconfigure $fd -blocking 0 -translation auto
699 fileevent $fd readable [list read_diff $fd]
702 proc read_diff {fd} {
703 global ui_diff ui_status_value is_3way_diff diff_active
704 global repo_config
706 $ui_diff conf -state normal
707 while {[gets $fd line] >= 0} {
708 # -- Cleanup uninteresting diff header lines.
710 if {[string match {diff --git *} $line]} continue
711 if {[string match {diff --combined *} $line]} continue
712 if {[string match {--- *} $line]} continue
713 if {[string match {+++ *} $line]} continue
714 if {$line eq {deleted file mode 120000}} {
715 set line "deleted symlink"
718 # -- Automatically detect if this is a 3 way diff.
720 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
722 # -- Reformat a 3 way diff, 'cause its too weird.
724 if {$is_3way_diff} {
725 set op [string range $line 0 1]
726 switch -- $op {
727 {@@} {set tags d_@}
728 {++} {set tags d_+ ; set op { +}}
729 {--} {set tags d_- ; set op { -}}
730 { +} {set tags d_++; set op {++}}
731 { -} {set tags d_--; set op {--}}
732 {+ } {set tags d_-+; set op {-+}}
733 {- } {set tags d_+-; set op {+-}}
734 default {set tags {}}
736 set line [string replace $line 0 1 $op]
737 } else {
738 switch -- [string index $line 0] {
739 @ {set tags d_@}
740 + {set tags d_+}
741 - {set tags d_-}
742 default {set tags {}}
745 $ui_diff insert end $line $tags
746 $ui_diff insert end "\n" $tags
748 $ui_diff conf -state disabled
750 if {[eof $fd]} {
751 close $fd
752 set diff_active 0
753 unlock_index
754 set ui_status_value {Ready.}
756 if {$repo_config(gui.trustmtime) eq {true}
757 && [$ui_diff index end] eq {2.0}} {
758 handle_empty_diff
763 ######################################################################
765 ## commit
767 proc load_last_commit {} {
768 global HEAD PARENT MERGE_HEAD commit_type ui_comm
770 if {[llength $PARENT] == 0} {
771 error_popup {There is nothing to amend.
773 You are about to create the initial commit.
774 There is no commit before this to amend.
776 return
779 repository_state curType curHEAD curMERGE_HEAD
780 if {$curType eq {merge}} {
781 error_popup {Cannot amend while merging.
783 You are currently in the middle of a merge that
784 has not been fully completed. You cannot amend
785 the prior commit unless you first abort the
786 current merge activity.
788 return
791 set msg {}
792 set parents [list]
793 if {[catch {
794 set fd [open "| git cat-file commit $curHEAD" r]
795 while {[gets $fd line] > 0} {
796 if {[string match {parent *} $line]} {
797 lappend parents [string range $line 7 end]
800 set msg [string trim [read $fd]]
801 close $fd
802 } err]} {
803 error_popup "Error loading commit data for amend:\n\n$err"
804 return
807 set HEAD $curHEAD
808 set PARENT $parents
809 set MERGE_HEAD [list]
810 switch -- [llength $parents] {
811 0 {set commit_type amend-initial}
812 1 {set commit_type amend}
813 default {set commit_type amend-merge}
816 $ui_comm delete 0.0 end
817 $ui_comm insert end $msg
818 $ui_comm edit reset
819 $ui_comm edit modified false
820 rescan {set ui_status_value {Ready.}}
823 proc create_new_commit {} {
824 global commit_type ui_comm
826 set commit_type normal
827 $ui_comm delete 0.0 end
828 $ui_comm edit reset
829 $ui_comm edit modified false
830 rescan {set ui_status_value {Ready.}}
833 set GIT_COMMITTER_IDENT {}
835 proc committer_ident {} {
836 global GIT_COMMITTER_IDENT
838 if {$GIT_COMMITTER_IDENT eq {}} {
839 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
840 error_popup "Unable to obtain your identity:\n\n$err"
841 return {}
843 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
844 $me me GIT_COMMITTER_IDENT]} {
845 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
846 return {}
850 return $GIT_COMMITTER_IDENT
853 proc commit_tree {} {
854 global HEAD commit_type file_states ui_comm repo_config
856 if {![lock_index update]} return
857 if {[committer_ident] eq {}} return
859 # -- Our in memory state should match the repository.
861 repository_state curType curHEAD curMERGE_HEAD
862 if {[string match amend* $commit_type]
863 && $curType eq {normal}
864 && $curHEAD eq $HEAD} {
865 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
866 info_popup {Last scanned state does not match repository state.
868 Another Git program has modified this repository
869 since the last scan. A rescan must be performed
870 before another commit can be created.
872 The rescan will be automatically started now.
874 unlock_index
875 rescan {set ui_status_value {Ready.}}
876 return
879 # -- At least one file should differ in the index.
881 set files_ready 0
882 foreach path [array names file_states] {
883 switch -glob -- [lindex $file_states($path) 0] {
884 _? {continue}
885 A? -
886 D? -
887 M? {set files_ready 1; break}
888 U? {
889 error_popup "Unmerged files cannot be committed.
891 File [short_path $path] has merge conflicts.
892 You must resolve them and include the file before committing.
894 unlock_index
895 return
897 default {
898 error_popup "Unknown file state [lindex $s 0] detected.
900 File [short_path $path] cannot be committed by this program.
905 if {!$files_ready} {
906 error_popup {No included files to commit.
908 You must include at least 1 file before you can commit.
910 unlock_index
911 return
914 # -- A message is required.
916 set msg [string trim [$ui_comm get 1.0 end]]
917 if {$msg eq {}} {
918 error_popup {Please supply a commit message.
920 A good commit message has the following format:
922 - First line: Describe in one sentance what you did.
923 - Second line: Blank
924 - Remaining lines: Describe why this change is good.
926 unlock_index
927 return
930 # -- Update included files if partialincludes are off.
932 if {$repo_config(gui.partialinclude) ne {true}} {
933 set pathList [list]
934 foreach path [array names file_states] {
935 switch -glob -- [lindex $file_states($path) 0] {
936 A? -
937 M? {lappend pathList $path}
940 if {$pathList ne {}} {
941 unlock_index
942 update_index \
943 "Updating included files" \
944 $pathList \
945 [concat {lock_index update;} \
946 [list commit_prehook $curHEAD $msg]]
947 return
951 commit_prehook $curHEAD $msg
954 proc commit_prehook {curHEAD msg} {
955 global ui_status_value pch_error
957 set pchook [gitdir hooks pre-commit]
959 # On Cygwin [file executable] might lie so we need to ask
960 # the shell if the hook is executable. Yes that's annoying.
962 if {[is_Windows] && [file isfile $pchook]} {
963 set pchook [list sh -c [concat \
964 "if test -x \"$pchook\";" \
965 "then exec \"$pchook\" 2>&1;" \
966 "fi"]]
967 } elseif {[file executable $pchook]} {
968 set pchook [list $pchook |& cat]
969 } else {
970 commit_writetree $curHEAD $msg
971 return
974 set ui_status_value {Calling pre-commit hook...}
975 set pch_error {}
976 set fd_ph [open "| $pchook" r]
977 fconfigure $fd_ph -blocking 0 -translation binary
978 fileevent $fd_ph readable \
979 [list commit_prehook_wait $fd_ph $curHEAD $msg]
982 proc commit_prehook_wait {fd_ph curHEAD msg} {
983 global pch_error ui_status_value
985 append pch_error [read $fd_ph]
986 fconfigure $fd_ph -blocking 1
987 if {[eof $fd_ph]} {
988 if {[catch {close $fd_ph}]} {
989 set ui_status_value {Commit declined by pre-commit hook.}
990 hook_failed_popup pre-commit $pch_error
991 unlock_index
992 } else {
993 commit_writetree $curHEAD $msg
995 set pch_error {}
996 return
998 fconfigure $fd_ph -blocking 0
1001 proc commit_writetree {curHEAD msg} {
1002 global ui_status_value
1004 set ui_status_value {Committing changes...}
1005 set fd_wt [open "| git write-tree" r]
1006 fileevent $fd_wt readable \
1007 [list commit_committree $fd_wt $curHEAD $msg]
1010 proc commit_committree {fd_wt curHEAD msg} {
1011 global HEAD PARENT MERGE_HEAD commit_type
1012 global single_commit
1013 global ui_status_value ui_comm selected_commit_type
1014 global file_states selected_paths rescan_active
1016 gets $fd_wt tree_id
1017 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1018 error_popup "write-tree failed:\n\n$err"
1019 set ui_status_value {Commit failed.}
1020 unlock_index
1021 return
1024 # -- Create the commit.
1026 set cmd [list git commit-tree $tree_id]
1027 set parents [concat $PARENT $MERGE_HEAD]
1028 if {[llength $parents] > 0} {
1029 foreach p $parents {
1030 lappend cmd -p $p
1032 } else {
1033 # git commit-tree writes to stderr during initial commit.
1034 lappend cmd 2>/dev/null
1036 lappend cmd << $msg
1037 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1038 error_popup "commit-tree failed:\n\n$err"
1039 set ui_status_value {Commit failed.}
1040 unlock_index
1041 return
1044 # -- Update the HEAD ref.
1046 set reflogm commit
1047 if {$commit_type ne {normal}} {
1048 append reflogm " ($commit_type)"
1050 set i [string first "\n" $msg]
1051 if {$i >= 0} {
1052 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1053 } else {
1054 append reflogm {: } $msg
1056 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1057 if {[catch {eval exec $cmd} err]} {
1058 error_popup "update-ref failed:\n\n$err"
1059 set ui_status_value {Commit failed.}
1060 unlock_index
1061 return
1064 # -- Cleanup after ourselves.
1066 catch {file delete [gitdir MERGE_HEAD]}
1067 catch {file delete [gitdir MERGE_MSG]}
1068 catch {file delete [gitdir SQUASH_MSG]}
1069 catch {file delete [gitdir GITGUI_MSG]}
1071 # -- Let rerere do its thing.
1073 if {[file isdirectory [gitdir rr-cache]]} {
1074 catch {exec git rerere}
1077 # -- Run the post-commit hook.
1079 set pchook [gitdir hooks post-commit]
1080 if {[is_Windows] && [file isfile $pchook]} {
1081 set pchook [list sh -c [concat \
1082 "if test -x \"$pchook\";" \
1083 "then exec \"$pchook\";" \
1084 "fi"]]
1085 } elseif {![file executable $pchook]} {
1086 set pchook {}
1088 if {$pchook ne {}} {
1089 catch {exec $pchook &}
1092 $ui_comm delete 0.0 end
1093 $ui_comm edit reset
1094 $ui_comm edit modified false
1096 if {$single_commit} do_quit
1098 # -- Update in memory status
1100 set selected_commit_type new
1101 set commit_type normal
1102 set HEAD $cmt_id
1103 set PARENT $cmt_id
1104 set MERGE_HEAD [list]
1106 foreach path [array names file_states] {
1107 set s $file_states($path)
1108 set m [lindex $s 0]
1109 switch -glob -- $m {
1110 _O -
1111 _M -
1112 _D {continue}
1113 __ -
1114 A_ -
1115 M_ -
1116 DD {
1117 unset file_states($path)
1118 catch {unset selected_paths($path)}
1120 DO {
1121 set file_states($path) [list _O [lindex $s 1] {} {}]
1123 AM -
1124 AD -
1125 MM -
1126 MD -
1127 DM {
1128 set file_states($path) [list \
1129 _[string index $m 1] \
1130 [lindex $s 1] \
1131 [lindex $s 3] \
1137 display_all_files
1138 unlock_index
1139 reshow_diff
1140 set ui_status_value \
1141 "Changes committed as [string range $cmt_id 0 7]."
1144 ######################################################################
1146 ## fetch pull push
1148 proc fetch_from {remote} {
1149 set w [new_console "fetch $remote" \
1150 "Fetching new changes from $remote"]
1151 set cmd [list git fetch]
1152 lappend cmd $remote
1153 console_exec $w $cmd
1156 proc pull_remote {remote branch} {
1157 global HEAD commit_type file_states repo_config
1159 if {![lock_index update]} return
1161 # -- Our in memory state should match the repository.
1163 repository_state curType curHEAD curMERGE_HEAD
1164 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1165 info_popup {Last scanned state does not match repository state.
1167 Another Git program has modified this repository
1168 since the last scan. A rescan must be performed
1169 before a pull operation can be started.
1171 The rescan will be automatically started now.
1173 unlock_index
1174 rescan {set ui_status_value {Ready.}}
1175 return
1178 # -- No differences should exist before a pull.
1180 if {[array size file_states] != 0} {
1181 error_popup {Uncommitted but modified files are present.
1183 You should not perform a pull with unmodified
1184 files in your working directory as Git will be
1185 unable to recover from an incorrect merge.
1187 You should commit or revert all changes before
1188 starting a pull operation.
1190 unlock_index
1191 return
1194 set w [new_console "pull $remote $branch" \
1195 "Pulling new changes from branch $branch in $remote"]
1196 set cmd [list git pull]
1197 if {$repo_config(gui.pullsummary) eq {false}} {
1198 lappend cmd --no-summary
1200 lappend cmd $remote
1201 lappend cmd $branch
1202 console_exec $w $cmd [list post_pull_remote $remote $branch]
1205 proc post_pull_remote {remote branch success} {
1206 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1207 global ui_status_value
1209 unlock_index
1210 if {$success} {
1211 repository_state commit_type HEAD MERGE_HEAD
1212 set PARENT $HEAD
1213 set selected_commit_type new
1214 set ui_status_value "Pulling $branch from $remote complete."
1215 } else {
1216 rescan [list set ui_status_value \
1217 "Conflicts detected while pulling $branch from $remote."]
1221 proc push_to {remote} {
1222 set w [new_console "push $remote" \
1223 "Pushing changes to $remote"]
1224 set cmd [list git push]
1225 lappend cmd $remote
1226 console_exec $w $cmd
1229 ######################################################################
1231 ## ui helpers
1233 proc mapcol {state path} {
1234 global all_cols ui_other
1236 if {[catch {set r $all_cols($state)}]} {
1237 puts "error: no column for state={$state} $path"
1238 return $ui_other
1240 return $r
1243 proc mapicon {state path} {
1244 global all_icons
1246 if {[catch {set r $all_icons($state)}]} {
1247 puts "error: no icon for state={$state} $path"
1248 return file_plain
1250 return $r
1253 proc mapdesc {state path} {
1254 global all_descs
1256 if {[catch {set r $all_descs($state)}]} {
1257 puts "error: no desc for state={$state} $path"
1258 return $state
1260 return $r
1263 proc escape_path {path} {
1264 regsub -all "\n" $path "\\n" path
1265 return $path
1268 proc short_path {path} {
1269 return [escape_path [lindex [file split $path] end]]
1272 set next_icon_id 0
1273 set null_sha1 [string repeat 0 40]
1275 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1276 global file_states next_icon_id null_sha1
1278 set s0 [string index $new_state 0]
1279 set s1 [string index $new_state 1]
1281 if {[catch {set info $file_states($path)}]} {
1282 set state __
1283 set icon n[incr next_icon_id]
1284 } else {
1285 set state [lindex $info 0]
1286 set icon [lindex $info 1]
1287 if {$head_info eq {}} {set head_info [lindex $info 2]}
1288 if {$index_info eq {}} {set index_info [lindex $info 3]}
1291 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1292 elseif {$s0 eq {_}} {set s0 _}
1294 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1295 elseif {$s1 eq {_}} {set s1 _}
1297 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1298 set head_info [list 0 $null_sha1]
1299 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1300 && $head_info eq {}} {
1301 set head_info $index_info
1304 set file_states($path) [list $s0$s1 $icon \
1305 $head_info $index_info \
1307 return $state
1310 proc display_file {path state} {
1311 global file_states file_lists selected_paths
1313 set old_m [merge_state $path $state]
1314 set s $file_states($path)
1315 set new_m [lindex $s 0]
1316 set new_w [mapcol $new_m $path]
1317 set old_w [mapcol $old_m $path]
1318 set new_icon [mapicon $new_m $path]
1320 if {$new_m eq {__}} {
1321 set lno [lsearch -sorted $file_lists($old_w) $path]
1322 if {$lno >= 0} {
1323 set file_lists($old_w) \
1324 [lreplace $file_lists($old_w) $lno $lno]
1325 incr lno
1326 $old_w conf -state normal
1327 $old_w delete $lno.0 [expr {$lno + 1}].0
1328 $old_w conf -state disabled
1330 unset file_states($path)
1331 catch {unset selected_paths($path)}
1332 return
1335 if {$new_w ne $old_w} {
1336 set lno [lsearch -sorted $file_lists($old_w) $path]
1337 if {$lno >= 0} {
1338 set file_lists($old_w) \
1339 [lreplace $file_lists($old_w) $lno $lno]
1340 incr lno
1341 $old_w conf -state normal
1342 $old_w delete $lno.0 [expr {$lno + 1}].0
1343 $old_w conf -state disabled
1346 lappend file_lists($new_w) $path
1347 set file_lists($new_w) [lsort $file_lists($new_w)]
1348 set lno [lsearch -sorted $file_lists($new_w) $path]
1349 incr lno
1350 $new_w conf -state normal
1351 $new_w image create $lno.0 \
1352 -align center -padx 5 -pady 1 \
1353 -name [lindex $s 1] \
1354 -image $new_icon
1355 $new_w insert $lno.1 "[escape_path $path]\n"
1356 if {[catch {set in_sel $selected_paths($path)}]} {
1357 set in_sel 0
1359 if {$in_sel} {
1360 $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1362 $new_w conf -state disabled
1363 } elseif {$new_icon ne [mapicon $old_m $path]} {
1364 $new_w conf -state normal
1365 $new_w image conf [lindex $s 1] -image $new_icon
1366 $new_w conf -state disabled
1370 proc display_all_files {} {
1371 global ui_index ui_other
1372 global file_states file_lists
1373 global last_clicked selected_paths
1375 $ui_index conf -state normal
1376 $ui_other conf -state normal
1378 $ui_index delete 0.0 end
1379 $ui_other delete 0.0 end
1380 set last_clicked {}
1382 set file_lists($ui_index) [list]
1383 set file_lists($ui_other) [list]
1385 foreach path [lsort [array names file_states]] {
1386 set s $file_states($path)
1387 set m [lindex $s 0]
1388 set w [mapcol $m $path]
1389 lappend file_lists($w) $path
1390 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1391 $w image create end \
1392 -align center -padx 5 -pady 1 \
1393 -name [lindex $s 1] \
1394 -image [mapicon $m $path]
1395 $w insert end "[escape_path $path]\n"
1396 if {[catch {set in_sel $selected_paths($path)}]} {
1397 set in_sel 0
1399 if {$in_sel} {
1400 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1404 $ui_index conf -state disabled
1405 $ui_other conf -state disabled
1408 proc update_indexinfo {msg pathList after} {
1409 global update_index_cp ui_status_value
1411 if {![lock_index update]} return
1413 set update_index_cp 0
1414 set pathList [lsort $pathList]
1415 set totalCnt [llength $pathList]
1416 set batch [expr {int($totalCnt * .01) + 1}]
1417 if {$batch > 25} {set batch 25}
1419 set ui_status_value [format \
1420 "$msg... %i/%i files (%.2f%%)" \
1421 $update_index_cp \
1422 $totalCnt \
1423 0.0]
1424 set fd [open "| git update-index -z --index-info" w]
1425 fconfigure $fd \
1426 -blocking 0 \
1427 -buffering full \
1428 -buffersize 512 \
1429 -translation binary
1430 fileevent $fd writable [list \
1431 write_update_indexinfo \
1432 $fd \
1433 $pathList \
1434 $totalCnt \
1435 $batch \
1436 $msg \
1437 $after \
1441 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1442 global update_index_cp ui_status_value
1443 global file_states current_diff
1445 if {$update_index_cp >= $totalCnt} {
1446 close $fd
1447 unlock_index
1448 uplevel #0 $after
1449 return
1452 for {set i $batch} \
1453 {$update_index_cp < $totalCnt && $i > 0} \
1454 {incr i -1} {
1455 set path [lindex $pathList $update_index_cp]
1456 incr update_index_cp
1458 set s $file_states($path)
1459 switch -glob -- [lindex $s 0] {
1460 A? {set new _O}
1461 M? {set new _M}
1462 D_ {set new _D}
1463 D? {set new _?}
1464 ?? {continue}
1466 set info [lindex $s 2]
1467 if {$info eq {}} continue
1469 puts -nonewline $fd $info
1470 puts -nonewline $fd "\t"
1471 puts -nonewline $fd $path
1472 puts -nonewline $fd "\0"
1473 display_file $path $new
1476 set ui_status_value [format \
1477 "$msg... %i/%i files (%.2f%%)" \
1478 $update_index_cp \
1479 $totalCnt \
1480 [expr {100.0 * $update_index_cp / $totalCnt}]]
1483 proc update_index {msg pathList after} {
1484 global update_index_cp ui_status_value
1486 if {![lock_index update]} return
1488 set update_index_cp 0
1489 set pathList [lsort $pathList]
1490 set totalCnt [llength $pathList]
1491 set batch [expr {int($totalCnt * .01) + 1}]
1492 if {$batch > 25} {set batch 25}
1494 set ui_status_value [format \
1495 "$msg... %i/%i files (%.2f%%)" \
1496 $update_index_cp \
1497 $totalCnt \
1498 0.0]
1499 set fd [open "| git update-index --add --remove -z --stdin" w]
1500 fconfigure $fd \
1501 -blocking 0 \
1502 -buffering full \
1503 -buffersize 512 \
1504 -translation binary
1505 fileevent $fd writable [list \
1506 write_update_index \
1507 $fd \
1508 $pathList \
1509 $totalCnt \
1510 $batch \
1511 $msg \
1512 $after \
1516 proc write_update_index {fd pathList totalCnt batch msg after} {
1517 global update_index_cp ui_status_value
1518 global file_states current_diff
1520 if {$update_index_cp >= $totalCnt} {
1521 close $fd
1522 unlock_index
1523 uplevel #0 $after
1524 return
1527 for {set i $batch} \
1528 {$update_index_cp < $totalCnt && $i > 0} \
1529 {incr i -1} {
1530 set path [lindex $pathList $update_index_cp]
1531 incr update_index_cp
1533 switch -glob -- [lindex $file_states($path) 0] {
1534 AD -
1535 MD -
1536 UD -
1537 _D {set new DD}
1539 _M -
1540 MM -
1541 UM -
1542 U_ -
1543 M_ {set new M_}
1545 _O -
1546 AM -
1547 A_ {set new A_}
1549 ?? {continue}
1552 puts -nonewline $fd $path
1553 puts -nonewline $fd "\0"
1554 display_file $path $new
1557 set ui_status_value [format \
1558 "$msg... %i/%i files (%.2f%%)" \
1559 $update_index_cp \
1560 $totalCnt \
1561 [expr {100.0 * $update_index_cp / $totalCnt}]]
1564 proc checkout_index {msg pathList after} {
1565 global update_index_cp ui_status_value
1567 if {![lock_index update]} return
1569 set update_index_cp 0
1570 set pathList [lsort $pathList]
1571 set totalCnt [llength $pathList]
1572 set batch [expr {int($totalCnt * .01) + 1}]
1573 if {$batch > 25} {set batch 25}
1575 set ui_status_value [format \
1576 "$msg... %i/%i files (%.2f%%)" \
1577 $update_index_cp \
1578 $totalCnt \
1579 0.0]
1580 set cmd [list git checkout-index]
1581 lappend cmd --index
1582 lappend cmd --quiet
1583 lappend cmd --force
1584 lappend cmd -z
1585 lappend cmd --stdin
1586 set fd [open "| $cmd " w]
1587 fconfigure $fd \
1588 -blocking 0 \
1589 -buffering full \
1590 -buffersize 512 \
1591 -translation binary
1592 fileevent $fd writable [list \
1593 write_checkout_index \
1594 $fd \
1595 $pathList \
1596 $totalCnt \
1597 $batch \
1598 $msg \
1599 $after \
1603 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1604 global update_index_cp ui_status_value
1605 global file_states current_diff
1607 if {$update_index_cp >= $totalCnt} {
1608 close $fd
1609 unlock_index
1610 uplevel #0 $after
1611 return
1614 for {set i $batch} \
1615 {$update_index_cp < $totalCnt && $i > 0} \
1616 {incr i -1} {
1617 set path [lindex $pathList $update_index_cp]
1618 incr update_index_cp
1620 switch -glob -- [lindex $file_states($path) 0] {
1621 AM -
1622 AD {set new A_}
1623 MM -
1624 MD {set new M_}
1625 _M -
1626 _D {set new __}
1627 ?? {continue}
1630 puts -nonewline $fd $path
1631 puts -nonewline $fd "\0"
1632 display_file $path $new
1635 set ui_status_value [format \
1636 "$msg... %i/%i files (%.2f%%)" \
1637 $update_index_cp \
1638 $totalCnt \
1639 [expr {100.0 * $update_index_cp / $totalCnt}]]
1642 ######################################################################
1644 ## branch management
1646 proc load_all_heads {} {
1647 global all_heads tracking_branches
1649 set all_heads [list]
1650 set cmd [list git for-each-ref]
1651 lappend cmd --format=%(refname)
1652 lappend cmd refs/heads
1653 set fd [open "| $cmd" r]
1654 while {[gets $fd line] > 0} {
1655 if {![catch {set info $tracking_branches($line)}]} continue
1656 if {![regsub ^refs/heads/ $line {} name]} continue
1657 lappend all_heads $name
1659 close $fd
1661 set all_heads [lsort $all_heads]
1664 proc populate_branch_menu {m} {
1665 global all_heads disable_on_lock
1667 $m add separator
1668 foreach b $all_heads {
1669 $m add radiobutton \
1670 -label $b \
1671 -command [list switch_branch $b] \
1672 -variable current_branch \
1673 -value $b \
1674 -font font_ui
1675 lappend disable_on_lock \
1676 [list $m entryconf [$m index last] -state]
1680 proc do_create_branch {} {
1681 error "NOT IMPLEMENTED"
1684 proc do_delete_branch {} {
1685 error "NOT IMPLEMENTED"
1688 proc switch_branch {b} {
1689 global HEAD commit_type file_states current_branch
1690 global selected_commit_type ui_comm
1692 if {![lock_index switch]} return
1694 # -- Backup the selected branch (repository_state resets it)
1696 set new_branch $current_branch
1698 # -- Our in memory state should match the repository.
1700 repository_state curType curHEAD curMERGE_HEAD
1701 if {[string match amend* $commit_type]
1702 && $curType eq {normal}
1703 && $curHEAD eq $HEAD} {
1704 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1705 info_popup {Last scanned state does not match repository state.
1707 Another Git program has modified this repository
1708 since the last scan. A rescan must be performed
1709 before the current branch can be changed.
1711 The rescan will be automatically started now.
1713 unlock_index
1714 rescan {set ui_status_value {Ready.}}
1715 return
1718 # -- Toss the message buffer if we are in amend mode.
1720 if {[string match amend* $curType]} {
1721 $ui_comm delete 0.0 end
1722 $ui_comm edit reset
1723 $ui_comm edit modified false
1726 set selected_commit_type new
1727 set current_branch $new_branch
1729 unlock_index
1730 error "NOT FINISHED"
1733 ######################################################################
1735 ## remote management
1737 proc load_all_remotes {} {
1738 global repo_config
1739 global all_remotes tracking_branches
1741 set all_remotes [list]
1742 array unset tracking_branches
1744 set rm_dir [gitdir remotes]
1745 if {[file isdirectory $rm_dir]} {
1746 set all_remotes [glob \
1747 -types f \
1748 -tails \
1749 -nocomplain \
1750 -directory $rm_dir *]
1752 foreach name $all_remotes {
1753 catch {
1754 set fd [open [file join $rm_dir $name] r]
1755 while {[gets $fd line] >= 0} {
1756 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
1757 $line line src dst]} continue
1758 if {![regexp ^refs/ $dst]} {
1759 set dst "refs/heads/$dst"
1761 set tracking_branches($dst) [list $name $src]
1763 close $fd
1768 foreach line [array names repo_config remote.*.url] {
1769 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
1770 lappend all_remotes $name
1772 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
1773 set fl {}
1775 foreach line $fl {
1776 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
1777 if {![regexp ^refs/ $dst]} {
1778 set dst "refs/heads/$dst"
1780 set tracking_branches($dst) [list $name $src]
1784 set all_remotes [lsort -unique $all_remotes]
1787 proc populate_fetch_menu {m} {
1788 global all_remotes repo_config
1790 foreach r $all_remotes {
1791 set enable 0
1792 if {![catch {set a $repo_config(remote.$r.url)}]} {
1793 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1794 set enable 1
1796 } else {
1797 catch {
1798 set fd [open [gitdir remotes $r] r]
1799 while {[gets $fd n] >= 0} {
1800 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1801 set enable 1
1802 break
1805 close $fd
1809 if {$enable} {
1810 $m add command \
1811 -label "Fetch from $r..." \
1812 -command [list fetch_from $r] \
1813 -font font_ui
1818 proc populate_push_menu {m} {
1819 global all_remotes repo_config
1821 foreach r $all_remotes {
1822 set enable 0
1823 if {![catch {set a $repo_config(remote.$r.url)}]} {
1824 if {![catch {set a $repo_config(remote.$r.push)}]} {
1825 set enable 1
1827 } else {
1828 catch {
1829 set fd [open [gitdir remotes $r] r]
1830 while {[gets $fd n] >= 0} {
1831 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1832 set enable 1
1833 break
1836 close $fd
1840 if {$enable} {
1841 $m add command \
1842 -label "Push to $r..." \
1843 -command [list push_to $r] \
1844 -font font_ui
1849 proc populate_pull_menu {m} {
1850 global repo_config all_remotes disable_on_lock
1852 foreach remote $all_remotes {
1853 set rb_list [list]
1854 if {[array get repo_config remote.$remote.url] ne {}} {
1855 if {[array get repo_config remote.$remote.fetch] ne {}} {
1856 foreach line $repo_config(remote.$remote.fetch) {
1857 if {[regexp {^([^:]+):} $line line rb]} {
1858 lappend rb_list $rb
1862 } else {
1863 catch {
1864 set fd [open [gitdir remotes $remote] r]
1865 while {[gets $fd line] >= 0} {
1866 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1867 lappend rb_list $rb
1870 close $fd
1874 foreach rb $rb_list {
1875 regsub ^refs/heads/ $rb {} rb_short
1876 $m add command \
1877 -label "Branch $rb_short from $remote..." \
1878 -command [list pull_remote $remote $rb] \
1879 -font font_ui
1880 lappend disable_on_lock \
1881 [list $m entryconf [$m index last] -state]
1886 ######################################################################
1888 ## icons
1890 set filemask {
1891 #define mask_width 14
1892 #define mask_height 15
1893 static unsigned char mask_bits[] = {
1894 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1895 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1896 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1899 image create bitmap file_plain -background white -foreground black -data {
1900 #define plain_width 14
1901 #define plain_height 15
1902 static unsigned char plain_bits[] = {
1903 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1904 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1905 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1906 } -maskdata $filemask
1908 image create bitmap file_mod -background white -foreground blue -data {
1909 #define mod_width 14
1910 #define mod_height 15
1911 static unsigned char mod_bits[] = {
1912 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1913 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1914 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1915 } -maskdata $filemask
1917 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1918 #define file_fulltick_width 14
1919 #define file_fulltick_height 15
1920 static unsigned char file_fulltick_bits[] = {
1921 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1922 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1923 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1924 } -maskdata $filemask
1926 image create bitmap file_parttick -background white -foreground "#005050" -data {
1927 #define parttick_width 14
1928 #define parttick_height 15
1929 static unsigned char parttick_bits[] = {
1930 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1931 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1932 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1933 } -maskdata $filemask
1935 image create bitmap file_question -background white -foreground black -data {
1936 #define file_question_width 14
1937 #define file_question_height 15
1938 static unsigned char file_question_bits[] = {
1939 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1940 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1941 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1942 } -maskdata $filemask
1944 image create bitmap file_removed -background white -foreground red -data {
1945 #define file_removed_width 14
1946 #define file_removed_height 15
1947 static unsigned char file_removed_bits[] = {
1948 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1949 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1950 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1951 } -maskdata $filemask
1953 image create bitmap file_merge -background white -foreground blue -data {
1954 #define file_merge_width 14
1955 #define file_merge_height 15
1956 static unsigned char file_merge_bits[] = {
1957 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1958 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1959 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1960 } -maskdata $filemask
1962 set ui_index .vpane.files.index.list
1963 set ui_other .vpane.files.other.list
1964 set max_status_desc 0
1965 foreach i {
1966 {__ i plain "Unmodified"}
1967 {_M i mod "Modified"}
1968 {M_ i fulltick "Added to commit"}
1969 {MM i parttick "Partially included"}
1970 {MD i question "Added (but gone)"}
1972 {_O o plain "Untracked"}
1973 {A_ o fulltick "Added by commit"}
1974 {AM o parttick "Partially added"}
1975 {AD o question "Added (but gone)"}
1977 {_D i question "Missing"}
1978 {DD i removed "Removed by commit"}
1979 {D_ i removed "Removed by commit"}
1980 {DO i removed "Removed (still exists)"}
1981 {DM i removed "Removed (but modified)"}
1983 {UD i merge "Merge conflicts"}
1984 {UM i merge "Merge conflicts"}
1985 {U_ i merge "Merge conflicts"}
1987 if {$max_status_desc < [string length [lindex $i 3]]} {
1988 set max_status_desc [string length [lindex $i 3]]
1990 if {[lindex $i 1] eq {i}} {
1991 set all_cols([lindex $i 0]) $ui_index
1992 } else {
1993 set all_cols([lindex $i 0]) $ui_other
1995 set all_icons([lindex $i 0]) file_[lindex $i 2]
1996 set all_descs([lindex $i 0]) [lindex $i 3]
1998 unset filemask i
2000 ######################################################################
2002 ## util
2004 proc is_MacOSX {} {
2005 global tcl_platform tk_library
2006 if {[tk windowingsystem] eq {aqua}} {
2007 return 1
2009 return 0
2012 proc is_Windows {} {
2013 global tcl_platform
2014 if {$tcl_platform(platform) eq {windows}} {
2015 return 1
2017 return 0
2020 proc bind_button3 {w cmd} {
2021 bind $w <Any-Button-3> $cmd
2022 if {[is_MacOSX]} {
2023 bind $w <Control-Button-1> $cmd
2027 proc incr_font_size {font {amt 1}} {
2028 set sz [font configure $font -size]
2029 incr sz $amt
2030 font configure $font -size $sz
2031 font configure ${font}bold -size $sz
2034 proc hook_failed_popup {hook msg} {
2035 set w .hookfail
2036 toplevel $w
2038 frame $w.m
2039 label $w.m.l1 -text "$hook hook failed:" \
2040 -anchor w \
2041 -justify left \
2042 -font font_uibold
2043 text $w.m.t \
2044 -background white -borderwidth 1 \
2045 -relief sunken \
2046 -width 80 -height 10 \
2047 -font font_diff \
2048 -yscrollcommand [list $w.m.sby set]
2049 label $w.m.l2 \
2050 -text {You must correct the above errors before committing.} \
2051 -anchor w \
2052 -justify left \
2053 -font font_uibold
2054 scrollbar $w.m.sby -command [list $w.m.t yview]
2055 pack $w.m.l1 -side top -fill x
2056 pack $w.m.l2 -side bottom -fill x
2057 pack $w.m.sby -side right -fill y
2058 pack $w.m.t -side left -fill both -expand 1
2059 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2061 $w.m.t insert 1.0 $msg
2062 $w.m.t conf -state disabled
2064 button $w.ok -text OK \
2065 -width 15 \
2066 -font font_ui \
2067 -command "destroy $w"
2068 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2070 bind $w <Visibility> "grab $w; focus $w"
2071 bind $w <Key-Return> "destroy $w"
2072 wm title $w "[appname] ([reponame]): error"
2073 tkwait window $w
2076 set next_console_id 0
2078 proc new_console {short_title long_title} {
2079 global next_console_id console_data
2080 set w .console[incr next_console_id]
2081 set console_data($w) [list $short_title $long_title]
2082 return [console_init $w]
2085 proc console_init {w} {
2086 global console_cr console_data M1B
2088 set console_cr($w) 1.0
2089 toplevel $w
2090 frame $w.m
2091 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2092 -anchor w \
2093 -justify left \
2094 -font font_uibold
2095 text $w.m.t \
2096 -background white -borderwidth 1 \
2097 -relief sunken \
2098 -width 80 -height 10 \
2099 -font font_diff \
2100 -state disabled \
2101 -yscrollcommand [list $w.m.sby set]
2102 label $w.m.s -text {Working... please wait...} \
2103 -anchor w \
2104 -justify left \
2105 -font font_uibold
2106 scrollbar $w.m.sby -command [list $w.m.t yview]
2107 pack $w.m.l1 -side top -fill x
2108 pack $w.m.s -side bottom -fill x
2109 pack $w.m.sby -side right -fill y
2110 pack $w.m.t -side left -fill both -expand 1
2111 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2113 menu $w.ctxm -tearoff 0
2114 $w.ctxm add command -label "Copy" \
2115 -font font_ui \
2116 -command "tk_textCopy $w.m.t"
2117 $w.ctxm add command -label "Select All" \
2118 -font font_ui \
2119 -command "$w.m.t tag add sel 0.0 end"
2120 $w.ctxm add command -label "Copy All" \
2121 -font font_ui \
2122 -command "
2123 $w.m.t tag add sel 0.0 end
2124 tk_textCopy $w.m.t
2125 $w.m.t tag remove sel 0.0 end
2128 button $w.ok -text {Close} \
2129 -font font_ui \
2130 -state disabled \
2131 -command "destroy $w"
2132 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2134 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2135 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2136 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2137 bind $w <Visibility> "focus $w"
2138 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2139 return $w
2142 proc console_exec {w cmd {after {}}} {
2143 # -- Windows tosses the enviroment when we exec our child.
2144 # But most users need that so we have to relogin. :-(
2146 if {[is_Windows]} {
2147 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2150 # -- Tcl won't let us redirect both stdout and stderr to
2151 # the same pipe. So pass it through cat...
2153 set cmd [concat | $cmd |& cat]
2155 set fd_f [open $cmd r]
2156 fconfigure $fd_f -blocking 0 -translation binary
2157 fileevent $fd_f readable [list console_read $w $fd_f $after]
2160 proc console_read {w fd after} {
2161 global console_cr console_data
2163 set buf [read $fd]
2164 if {$buf ne {}} {
2165 if {![winfo exists $w]} {console_init $w}
2166 $w.m.t conf -state normal
2167 set c 0
2168 set n [string length $buf]
2169 while {$c < $n} {
2170 set cr [string first "\r" $buf $c]
2171 set lf [string first "\n" $buf $c]
2172 if {$cr < 0} {set cr [expr {$n + 1}]}
2173 if {$lf < 0} {set lf [expr {$n + 1}]}
2175 if {$lf < $cr} {
2176 $w.m.t insert end [string range $buf $c $lf]
2177 set console_cr($w) [$w.m.t index {end -1c}]
2178 set c $lf
2179 incr c
2180 } else {
2181 $w.m.t delete $console_cr($w) end
2182 $w.m.t insert end "\n"
2183 $w.m.t insert end [string range $buf $c $cr]
2184 set c $cr
2185 incr c
2188 $w.m.t conf -state disabled
2189 $w.m.t see end
2192 fconfigure $fd -blocking 1
2193 if {[eof $fd]} {
2194 if {[catch {close $fd}]} {
2195 if {![winfo exists $w]} {console_init $w}
2196 $w.m.s conf -background red -text {Error: Command Failed}
2197 $w.ok conf -state normal
2198 set ok 0
2199 } elseif {[winfo exists $w]} {
2200 $w.m.s conf -background green -text {Success}
2201 $w.ok conf -state normal
2202 set ok 1
2204 array unset console_cr $w
2205 array unset console_data $w
2206 if {$after ne {}} {
2207 uplevel #0 $after $ok
2209 return
2211 fconfigure $fd -blocking 0
2214 ######################################################################
2216 ## ui commands
2218 set starting_gitk_msg {Starting gitk... please wait...}
2220 proc do_gitk {revs} {
2221 global ui_status_value starting_gitk_msg
2223 set cmd gitk
2224 if {$revs ne {}} {
2225 append cmd { }
2226 append cmd $revs
2228 if {[is_Windows]} {
2229 set cmd "sh -c \"exec $cmd\""
2231 append cmd { &}
2233 if {[catch {eval exec $cmd} err]} {
2234 error_popup "Failed to start gitk:\n\n$err"
2235 } else {
2236 set ui_status_value $starting_gitk_msg
2237 after 10000 {
2238 if {$ui_status_value eq $starting_gitk_msg} {
2239 set ui_status_value {Ready.}
2245 proc do_gc {} {
2246 set w [new_console {gc} {Compressing the object database}]
2247 console_exec $w {git gc}
2250 proc do_fsck_objects {} {
2251 set w [new_console {fsck-objects} \
2252 {Verifying the object database with fsck-objects}]
2253 set cmd [list git fsck-objects]
2254 lappend cmd --full
2255 lappend cmd --cache
2256 lappend cmd --strict
2257 console_exec $w $cmd
2260 set is_quitting 0
2262 proc do_quit {} {
2263 global ui_comm is_quitting repo_config commit_type
2265 if {$is_quitting} return
2266 set is_quitting 1
2268 # -- Stash our current commit buffer.
2270 set save [gitdir GITGUI_MSG]
2271 set msg [string trim [$ui_comm get 0.0 end]]
2272 if {![string match amend* $commit_type]
2273 && [$ui_comm edit modified]
2274 && $msg ne {}} {
2275 catch {
2276 set fd [open $save w]
2277 puts $fd [string trim [$ui_comm get 0.0 end]]
2278 close $fd
2280 } else {
2281 catch {file delete $save}
2284 # -- Stash our current window geometry into this repository.
2286 set cfg_geometry [list]
2287 lappend cfg_geometry [wm geometry .]
2288 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2289 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2290 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2291 set rc_geometry {}
2293 if {$cfg_geometry ne $rc_geometry} {
2294 catch {exec git repo-config gui.geometry $cfg_geometry}
2297 destroy .
2300 proc do_rescan {} {
2301 rescan {set ui_status_value {Ready.}}
2304 proc remove_helper {txt paths} {
2305 global file_states current_diff
2307 if {![lock_index begin-update]} return
2309 set pathList [list]
2310 set after {}
2311 foreach path $paths {
2312 switch -glob -- [lindex $file_states($path) 0] {
2313 A? -
2314 M? -
2315 D? {
2316 lappend pathList $path
2317 if {$path eq $current_diff} {
2318 set after {reshow_diff;}
2323 if {$pathList eq {}} {
2324 unlock_index
2325 } else {
2326 update_indexinfo \
2327 $txt \
2328 $pathList \
2329 [concat $after {set ui_status_value {Ready.}}]
2333 proc do_remove_selection {} {
2334 global current_diff selected_paths
2336 if {[array size selected_paths] > 0} {
2337 remove_helper \
2338 {Removing selected files from commit} \
2339 [array names selected_paths]
2340 } elseif {$current_diff ne {}} {
2341 remove_helper \
2342 "Removing [short_path $current_diff] from commit" \
2343 [list $current_diff]
2347 proc include_helper {txt paths} {
2348 global file_states current_diff
2350 if {![lock_index begin-update]} return
2352 set pathList [list]
2353 set after {}
2354 foreach path $paths {
2355 switch -glob -- [lindex $file_states($path) 0] {
2356 AM -
2357 AD -
2358 MM -
2359 MD -
2360 U? -
2361 _M -
2362 _D -
2363 _O {
2364 lappend pathList $path
2365 if {$path eq $current_diff} {
2366 set after {reshow_diff;}
2371 if {$pathList eq {}} {
2372 unlock_index
2373 } else {
2374 update_index \
2375 $txt \
2376 $pathList \
2377 [concat $after {set ui_status_value {Ready to commit.}}]
2381 proc do_include_selection {} {
2382 global current_diff selected_paths
2384 if {[array size selected_paths] > 0} {
2385 include_helper \
2386 {Adding selected files} \
2387 [array names selected_paths]
2388 } elseif {$current_diff ne {}} {
2389 include_helper \
2390 "Adding [short_path $current_diff]" \
2391 [list $current_diff]
2395 proc do_include_all {} {
2396 global file_states
2398 set paths [list]
2399 foreach path [array names file_states] {
2400 switch -- [lindex $file_states($path) 0] {
2401 AM -
2402 AD -
2403 MM -
2404 MD -
2405 _M -
2406 _D {lappend paths $path}
2409 include_helper \
2410 {Adding all modified files} \
2411 $paths
2414 proc revert_helper {txt paths} {
2415 global file_states current_diff
2417 if {![lock_index begin-update]} return
2419 set pathList [list]
2420 set after {}
2421 foreach path $paths {
2422 switch -glob -- [lindex $file_states($path) 0] {
2423 AM -
2424 AD -
2425 MM -
2426 MD -
2427 _M -
2428 _D {
2429 lappend pathList $path
2430 if {$path eq $current_diff} {
2431 set after {reshow_diff;}
2437 set n [llength $pathList]
2438 if {$n == 0} {
2439 unlock_index
2440 return
2441 } elseif {$n == 1} {
2442 set s "[short_path [lindex $pathList]]"
2443 } else {
2444 set s "these $n files"
2447 set reply [tk_dialog \
2448 .confirm_revert \
2449 "[appname] ([reponame])" \
2450 "Revert changes in $s?
2452 Any unadded changes will be permanently lost by the revert." \
2453 question \
2455 {Do Nothing} \
2456 {Revert Changes} \
2458 if {$reply == 1} {
2459 checkout_index \
2460 $txt \
2461 $pathList \
2462 [concat $after {set ui_status_value {Ready.}}]
2463 } else {
2464 unlock_index
2468 proc do_revert_selection {} {
2469 global current_diff selected_paths
2471 if {[array size selected_paths] > 0} {
2472 revert_helper \
2473 {Reverting selected files} \
2474 [array names selected_paths]
2475 } elseif {$current_diff ne {}} {
2476 revert_helper \
2477 "Reverting [short_path $current_diff]" \
2478 [list $current_diff]
2482 proc do_signoff {} {
2483 global ui_comm
2485 set me [committer_ident]
2486 if {$me eq {}} return
2488 set sob "Signed-off-by: $me"
2489 set last [$ui_comm get {end -1c linestart} {end -1c}]
2490 if {$last ne $sob} {
2491 $ui_comm edit separator
2492 if {$last ne {}
2493 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2494 $ui_comm insert end "\n"
2496 $ui_comm insert end "\n$sob"
2497 $ui_comm edit separator
2498 $ui_comm see end
2502 proc do_select_commit_type {} {
2503 global commit_type selected_commit_type
2505 if {$selected_commit_type eq {new}
2506 && [string match amend* $commit_type]} {
2507 create_new_commit
2508 } elseif {$selected_commit_type eq {amend}
2509 && ![string match amend* $commit_type]} {
2510 load_last_commit
2512 # The amend request was rejected...
2514 if {![string match amend* $commit_type]} {
2515 set selected_commit_type new
2520 proc do_commit {} {
2521 commit_tree
2524 proc do_about {} {
2525 global appvers copyright
2526 global tcl_patchLevel tk_patchLevel
2528 set w .about_dialog
2529 toplevel $w
2530 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2532 label $w.header -text "About [appname]" \
2533 -font font_uibold
2534 pack $w.header -side top -fill x
2536 frame $w.buttons
2537 button $w.buttons.close -text {Close} \
2538 -font font_ui \
2539 -command [list destroy $w]
2540 pack $w.buttons.close -side right
2541 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2543 label $w.desc \
2544 -text "[appname] - a commit creation tool for Git.
2545 $copyright" \
2546 -padx 5 -pady 5 \
2547 -justify left \
2548 -anchor w \
2549 -borderwidth 1 \
2550 -relief solid \
2551 -font font_ui
2552 pack $w.desc -side top -fill x -padx 5 -pady 5
2554 set v {}
2555 append v "[appname] version $appvers\n"
2556 append v "[exec git version]\n"
2557 append v "\n"
2558 if {$tcl_patchLevel eq $tk_patchLevel} {
2559 append v "Tcl/Tk version $tcl_patchLevel"
2560 } else {
2561 append v "Tcl version $tcl_patchLevel"
2562 append v ", Tk version $tk_patchLevel"
2565 label $w.vers \
2566 -text $v \
2567 -padx 5 -pady 5 \
2568 -justify left \
2569 -anchor w \
2570 -borderwidth 1 \
2571 -relief solid \
2572 -font font_ui
2573 pack $w.vers -side top -fill x -padx 5 -pady 5
2575 menu $w.ctxm -tearoff 0
2576 $w.ctxm add command \
2577 -label {Copy} \
2578 -font font_ui \
2579 -command "
2580 clipboard clear
2581 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2584 bind $w <Visibility> "grab $w; focus $w"
2585 bind $w <Key-Escape> "destroy $w"
2586 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2587 wm title $w "About [appname]"
2588 tkwait window $w
2591 proc do_options {} {
2592 global repo_config global_config font_descs
2593 global repo_config_new global_config_new
2595 array unset repo_config_new
2596 array unset global_config_new
2597 foreach name [array names repo_config] {
2598 set repo_config_new($name) $repo_config($name)
2600 load_config 1
2601 foreach name [array names repo_config] {
2602 switch -- $name {
2603 gui.diffcontext {continue}
2605 set repo_config_new($name) $repo_config($name)
2607 foreach name [array names global_config] {
2608 set global_config_new($name) $global_config($name)
2611 set w .options_editor
2612 toplevel $w
2613 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2615 label $w.header -text "[appname] Options" \
2616 -font font_uibold
2617 pack $w.header -side top -fill x
2619 frame $w.buttons
2620 button $w.buttons.restore -text {Restore Defaults} \
2621 -font font_ui \
2622 -command do_restore_defaults
2623 pack $w.buttons.restore -side left
2624 button $w.buttons.save -text Save \
2625 -font font_ui \
2626 -command [list do_save_config $w]
2627 pack $w.buttons.save -side right
2628 button $w.buttons.cancel -text {Cancel} \
2629 -font font_ui \
2630 -command [list destroy $w]
2631 pack $w.buttons.cancel -side right
2632 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2634 labelframe $w.repo -text "[reponame] Repository" \
2635 -font font_ui \
2636 -relief raised -borderwidth 2
2637 labelframe $w.global -text {Global (All Repositories)} \
2638 -font font_ui \
2639 -relief raised -borderwidth 2
2640 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2641 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2643 foreach option {
2644 {b partialinclude {Allow Partially Added Files}}
2645 {b pullsummary {Show Pull Summary}}
2646 {b trustmtime {Trust File Modification Timestamps}}
2647 {i diffcontext {Number of Diff Context Lines}}
2649 set type [lindex $option 0]
2650 set name [lindex $option 1]
2651 set text [lindex $option 2]
2652 foreach f {repo global} {
2653 switch $type {
2655 checkbutton $w.$f.$name -text $text \
2656 -variable ${f}_config_new(gui.$name) \
2657 -onvalue true \
2658 -offvalue false \
2659 -font font_ui
2660 pack $w.$f.$name -side top -anchor w
2663 frame $w.$f.$name
2664 label $w.$f.$name.l -text "$text:" -font font_ui
2665 pack $w.$f.$name.l -side left -anchor w -fill x
2666 spinbox $w.$f.$name.v \
2667 -textvariable ${f}_config_new(gui.$name) \
2668 -from 1 -to 99 -increment 1 \
2669 -width 3 \
2670 -font font_ui
2671 pack $w.$f.$name.v -side right -anchor e
2672 pack $w.$f.$name -side top -anchor w -fill x
2678 set all_fonts [lsort [font families]]
2679 foreach option $font_descs {
2680 set name [lindex $option 0]
2681 set font [lindex $option 1]
2682 set text [lindex $option 2]
2684 set global_config_new(gui.$font^^family) \
2685 [font configure $font -family]
2686 set global_config_new(gui.$font^^size) \
2687 [font configure $font -size]
2689 frame $w.global.$name
2690 label $w.global.$name.l -text "$text:" -font font_ui
2691 pack $w.global.$name.l -side left -anchor w -fill x
2692 eval tk_optionMenu $w.global.$name.family \
2693 global_config_new(gui.$font^^family) \
2694 $all_fonts
2695 spinbox $w.global.$name.size \
2696 -textvariable global_config_new(gui.$font^^size) \
2697 -from 2 -to 80 -increment 1 \
2698 -width 3 \
2699 -font font_ui
2700 pack $w.global.$name.size -side right -anchor e
2701 pack $w.global.$name.family -side right -anchor e
2702 pack $w.global.$name -side top -anchor w -fill x
2705 bind $w <Visibility> "grab $w; focus $w"
2706 bind $w <Key-Escape> "destroy $w"
2707 wm title $w "[appname] ([reponame]): Options"
2708 tkwait window $w
2711 proc do_restore_defaults {} {
2712 global font_descs default_config repo_config
2713 global repo_config_new global_config_new
2715 foreach name [array names default_config] {
2716 set repo_config_new($name) $default_config($name)
2717 set global_config_new($name) $default_config($name)
2720 foreach option $font_descs {
2721 set name [lindex $option 0]
2722 set repo_config(gui.$name) $default_config(gui.$name)
2724 apply_config
2726 foreach option $font_descs {
2727 set name [lindex $option 0]
2728 set font [lindex $option 1]
2729 set global_config_new(gui.$font^^family) \
2730 [font configure $font -family]
2731 set global_config_new(gui.$font^^size) \
2732 [font configure $font -size]
2736 proc do_save_config {w} {
2737 if {[catch {save_config} err]} {
2738 error_popup "Failed to completely save options:\n\n$err"
2740 reshow_diff
2741 destroy $w
2744 proc do_windows_shortcut {} {
2745 global argv0
2747 if {[catch {
2748 set desktop [exec cygpath \
2749 --windows \
2750 --absolute \
2751 --long-name \
2752 --desktop]
2753 }]} {
2754 set desktop .
2756 set fn [tk_getSaveFile \
2757 -parent . \
2758 -title "[appname] ([reponame]): Create Desktop Icon" \
2759 -initialdir $desktop \
2760 -initialfile "Git [reponame].bat"]
2761 if {$fn != {}} {
2762 if {[catch {
2763 set fd [open $fn w]
2764 set sh [exec cygpath \
2765 --windows \
2766 --absolute \
2767 /bin/sh]
2768 set me [exec cygpath \
2769 --unix \
2770 --absolute \
2771 $argv0]
2772 set gd [exec cygpath \
2773 --unix \
2774 --absolute \
2775 [gitdir]]
2776 regsub -all ' $me "'\\''" me
2777 regsub -all ' $gd "'\\''" gd
2778 puts $fd "@ECHO Starting git-gui... Please wait..."
2779 puts -nonewline $fd "@\"$sh\" --login -c \""
2780 puts -nonewline $fd "GIT_DIR='$gd'"
2781 puts -nonewline $fd " '$me'"
2782 puts $fd "&\""
2783 close $fd
2784 } err]} {
2785 error_popup "Cannot write script:\n\n$err"
2790 proc do_macosx_app {} {
2791 global argv0 env
2793 set fn [tk_getSaveFile \
2794 -parent . \
2795 -title "[appname] ([reponame]): Create Desktop Icon" \
2796 -initialdir [file join $env(HOME) Desktop] \
2797 -initialfile "Git [reponame].app"]
2798 if {$fn != {}} {
2799 if {[catch {
2800 set Contents [file join $fn Contents]
2801 set MacOS [file join $Contents MacOS]
2802 set exe [file join $MacOS git-gui]
2804 file mkdir $MacOS
2806 set fd [open [file join $Contents Info.plist] w]
2807 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2808 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2809 <plist version="1.0">
2810 <dict>
2811 <key>CFBundleDevelopmentRegion</key>
2812 <string>English</string>
2813 <key>CFBundleExecutable</key>
2814 <string>git-gui</string>
2815 <key>CFBundleIdentifier</key>
2816 <string>org.spearce.git-gui</string>
2817 <key>CFBundleInfoDictionaryVersion</key>
2818 <string>6.0</string>
2819 <key>CFBundlePackageType</key>
2820 <string>APPL</string>
2821 <key>CFBundleSignature</key>
2822 <string>????</string>
2823 <key>CFBundleVersion</key>
2824 <string>1.0</string>
2825 <key>NSPrincipalClass</key>
2826 <string>NSApplication</string>
2827 </dict>
2828 </plist>}
2829 close $fd
2831 set fd [open $exe w]
2832 set gd [file normalize [gitdir]]
2833 set ep [file normalize [exec git --exec-path]]
2834 regsub -all ' $gd "'\\''" gd
2835 regsub -all ' $ep "'\\''" ep
2836 puts $fd "#!/bin/sh"
2837 foreach name [array names env] {
2838 if {[string match GIT_* $name]} {
2839 regsub -all ' $env($name) "'\\''" v
2840 puts $fd "export $name='$v'"
2843 puts $fd "export PATH='$ep':\$PATH"
2844 puts $fd "export GIT_DIR='$gd'"
2845 puts $fd "exec [file normalize $argv0]"
2846 close $fd
2848 file attributes $exe -permissions u+x,g+x,o+x
2849 } err]} {
2850 error_popup "Cannot write icon:\n\n$err"
2855 proc toggle_or_diff {w x y} {
2856 global file_states file_lists current_diff ui_index ui_other
2857 global last_clicked selected_paths
2859 set pos [split [$w index @$x,$y] .]
2860 set lno [lindex $pos 0]
2861 set col [lindex $pos 1]
2862 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2863 if {$path eq {}} {
2864 set last_clicked {}
2865 return
2868 set last_clicked [list $w $lno]
2869 array unset selected_paths
2870 $ui_index tag remove in_sel 0.0 end
2871 $ui_other tag remove in_sel 0.0 end
2873 if {$col == 0} {
2874 if {$current_diff eq $path} {
2875 set after {reshow_diff;}
2876 } else {
2877 set after {}
2879 switch -glob -- [lindex $file_states($path) 0] {
2880 A_ -
2881 M_ -
2882 DD -
2883 DO -
2884 DM {
2885 update_indexinfo \
2886 "Removing [short_path $path] from commit" \
2887 [list $path] \
2888 [concat $after {set ui_status_value {Ready.}}]
2890 ?? {
2891 update_index \
2892 "Adding [short_path $path]" \
2893 [list $path] \
2894 [concat $after {set ui_status_value {Ready.}}]
2897 } else {
2898 show_diff $path $w $lno
2902 proc add_one_to_selection {w x y} {
2903 global file_lists
2904 global last_clicked selected_paths
2906 set pos [split [$w index @$x,$y] .]
2907 set lno [lindex $pos 0]
2908 set col [lindex $pos 1]
2909 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2910 if {$path eq {}} {
2911 set last_clicked {}
2912 return
2915 set last_clicked [list $w $lno]
2916 if {[catch {set in_sel $selected_paths($path)}]} {
2917 set in_sel 0
2919 if {$in_sel} {
2920 unset selected_paths($path)
2921 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2922 } else {
2923 set selected_paths($path) 1
2924 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2928 proc add_range_to_selection {w x y} {
2929 global file_lists
2930 global last_clicked selected_paths
2932 if {[lindex $last_clicked 0] ne $w} {
2933 toggle_or_diff $w $x $y
2934 return
2937 set pos [split [$w index @$x,$y] .]
2938 set lno [lindex $pos 0]
2939 set lc [lindex $last_clicked 1]
2940 if {$lc < $lno} {
2941 set begin $lc
2942 set end $lno
2943 } else {
2944 set begin $lno
2945 set end $lc
2948 foreach path [lrange $file_lists($w) \
2949 [expr {$begin - 1}] \
2950 [expr {$end - 1}]] {
2951 set selected_paths($path) 1
2953 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2956 ######################################################################
2958 ## config defaults
2960 set cursor_ptr arrow
2961 font create font_diff -family Courier -size 10
2962 font create font_ui
2963 catch {
2964 label .dummy
2965 eval font configure font_ui [font actual [.dummy cget -font]]
2966 destroy .dummy
2969 font create font_uibold
2970 font create font_diffbold
2972 if {[is_Windows]} {
2973 set M1B Control
2974 set M1T Ctrl
2975 } elseif {[is_MacOSX]} {
2976 set M1B M1
2977 set M1T Cmd
2978 } else {
2979 set M1B M1
2980 set M1T M1
2983 proc apply_config {} {
2984 global repo_config font_descs
2986 foreach option $font_descs {
2987 set name [lindex $option 0]
2988 set font [lindex $option 1]
2989 if {[catch {
2990 foreach {cn cv} $repo_config(gui.$name) {
2991 font configure $font $cn $cv
2993 } err]} {
2994 error_popup "Invalid font specified in gui.$name:\n\n$err"
2996 foreach {cn cv} [font configure $font] {
2997 font configure ${font}bold $cn $cv
2999 font configure ${font}bold -weight bold
3003 set default_config(gui.trustmtime) false
3004 set default_config(gui.pullsummary) true
3005 set default_config(gui.partialinclude) false
3006 set default_config(gui.diffcontext) 5
3007 set default_config(gui.fontui) [font configure font_ui]
3008 set default_config(gui.fontdiff) [font configure font_diff]
3009 set font_descs {
3010 {fontui font_ui {Main Font}}
3011 {fontdiff font_diff {Diff/Console Font}}
3013 load_config 0
3014 apply_config
3016 ######################################################################
3018 ## ui construction
3020 # -- Menu Bar
3022 menu .mbar -tearoff 0
3023 .mbar add cascade -label Repository -menu .mbar.repository
3024 .mbar add cascade -label Edit -menu .mbar.edit
3025 if {!$single_commit} {
3026 .mbar add cascade -label Branch -menu .mbar.branch
3028 .mbar add cascade -label Commit -menu .mbar.commit
3029 if {!$single_commit} {
3030 .mbar add cascade -label Fetch -menu .mbar.fetch
3031 .mbar add cascade -label Pull -menu .mbar.pull
3032 .mbar add cascade -label Push -menu .mbar.push
3034 . configure -menu .mbar
3036 # -- Repository Menu
3038 menu .mbar.repository
3039 .mbar.repository add command \
3040 -label {Visualize Current Branch} \
3041 -command {do_gitk {}} \
3042 -font font_ui
3043 if {![is_MacOSX]} {
3044 .mbar.repository add command \
3045 -label {Visualize All Branches} \
3046 -command {do_gitk {--all}} \
3047 -font font_ui
3049 .mbar.repository add separator
3051 if {!$single_commit} {
3052 .mbar.repository add command -label {Compress Database} \
3053 -command do_gc \
3054 -font font_ui
3056 .mbar.repository add command -label {Verify Database} \
3057 -command do_fsck_objects \
3058 -font font_ui
3060 .mbar.repository add separator
3062 if {[is_Windows]} {
3063 .mbar.repository add command \
3064 -label {Create Desktop Icon} \
3065 -command do_windows_shortcut \
3066 -font font_ui
3067 } elseif {[is_MacOSX]} {
3068 .mbar.repository add command \
3069 -label {Create Desktop Icon} \
3070 -command do_macosx_app \
3071 -font font_ui
3075 .mbar.repository add command -label Quit \
3076 -command do_quit \
3077 -accelerator $M1T-Q \
3078 -font font_ui
3080 # -- Edit Menu
3082 menu .mbar.edit
3083 .mbar.edit add command -label Undo \
3084 -command {catch {[focus] edit undo}} \
3085 -accelerator $M1T-Z \
3086 -font font_ui
3087 .mbar.edit add command -label Redo \
3088 -command {catch {[focus] edit redo}} \
3089 -accelerator $M1T-Y \
3090 -font font_ui
3091 .mbar.edit add separator
3092 .mbar.edit add command -label Cut \
3093 -command {catch {tk_textCut [focus]}} \
3094 -accelerator $M1T-X \
3095 -font font_ui
3096 .mbar.edit add command -label Copy \
3097 -command {catch {tk_textCopy [focus]}} \
3098 -accelerator $M1T-C \
3099 -font font_ui
3100 .mbar.edit add command -label Paste \
3101 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3102 -accelerator $M1T-V \
3103 -font font_ui
3104 .mbar.edit add command -label Delete \
3105 -command {catch {[focus] delete sel.first sel.last}} \
3106 -accelerator Del \
3107 -font font_ui
3108 .mbar.edit add separator
3109 .mbar.edit add command -label {Select All} \
3110 -command {catch {[focus] tag add sel 0.0 end}} \
3111 -accelerator $M1T-A \
3112 -font font_ui
3114 # -- Branch Menu
3116 if {!$single_commit} {
3117 menu .mbar.branch
3119 .mbar.branch add command -label {Create...} \
3120 -command do_create_branch \
3121 -font font_ui
3122 lappend disable_on_lock [list .mbar.branch entryconf \
3123 [.mbar.branch index last] -state]
3125 .mbar.branch add command -label {Delete...} \
3126 -command do_delete_branch \
3127 -font font_ui
3128 lappend disable_on_lock [list .mbar.branch entryconf \
3129 [.mbar.branch index last] -state]
3132 # -- Commit Menu
3134 menu .mbar.commit
3136 .mbar.commit add radiobutton \
3137 -label {New Commit} \
3138 -command do_select_commit_type \
3139 -variable selected_commit_type \
3140 -value new \
3141 -font font_ui
3142 lappend disable_on_lock \
3143 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3145 .mbar.commit add radiobutton \
3146 -label {Amend Last Commit} \
3147 -command do_select_commit_type \
3148 -variable selected_commit_type \
3149 -value amend \
3150 -font font_ui
3151 lappend disable_on_lock \
3152 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3154 .mbar.commit add separator
3156 .mbar.commit add command -label Rescan \
3157 -command do_rescan \
3158 -accelerator F5 \
3159 -font font_ui
3160 lappend disable_on_lock \
3161 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3163 .mbar.commit add command -label {Add To Commit} \
3164 -command do_include_selection \
3165 -font font_ui
3166 lappend disable_on_lock \
3167 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3169 .mbar.commit add command -label {Add All To Commit} \
3170 -command do_include_all \
3171 -accelerator $M1T-I \
3172 -font font_ui
3173 lappend disable_on_lock \
3174 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3176 .mbar.commit add command -label {Remove From Commit} \
3177 -command do_remove_selection \
3178 -font font_ui
3179 lappend disable_on_lock \
3180 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3182 .mbar.commit add command -label {Revert Changes} \
3183 -command do_revert_selection \
3184 -font font_ui
3185 lappend disable_on_lock \
3186 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3188 .mbar.commit add separator
3190 .mbar.commit add command -label {Sign Off} \
3191 -command do_signoff \
3192 -accelerator $M1T-S \
3193 -font font_ui
3195 .mbar.commit add command -label Commit \
3196 -command do_commit \
3197 -accelerator $M1T-Return \
3198 -font font_ui
3199 lappend disable_on_lock \
3200 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3202 # -- Transport menus
3204 if {!$single_commit} {
3205 menu .mbar.fetch
3206 menu .mbar.pull
3207 menu .mbar.push
3210 if {[is_MacOSX]} {
3211 # -- Apple Menu (Mac OS X only)
3213 .mbar add cascade -label Apple -menu .mbar.apple
3214 menu .mbar.apple
3216 .mbar.apple add command -label "About [appname]" \
3217 -command do_about \
3218 -font font_ui
3219 .mbar.apple add command -label "[appname] Options..." \
3220 -command do_options \
3221 -font font_ui
3222 } else {
3223 # -- Edit Menu
3225 .mbar.edit add separator
3226 .mbar.edit add command -label {Options...} \
3227 -command do_options \
3228 -font font_ui
3230 # -- Tools Menu
3232 if {[file exists /usr/local/miga/lib/gui-miga]
3233 && [file exists .pvcsrc]} {
3234 proc do_miga {} {
3235 global ui_status_value
3236 if {![lock_index update]} return
3237 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3238 set miga_fd [open "|$cmd" r]
3239 fconfigure $miga_fd -blocking 0
3240 fileevent $miga_fd readable [list miga_done $miga_fd]
3241 set ui_status_value {Running miga...}
3243 proc miga_done {fd} {
3244 read $fd 512
3245 if {[eof $fd]} {
3246 close $fd
3247 unlock_index
3248 rescan [list set ui_status_value {Ready.}]
3251 .mbar add cascade -label Tools -menu .mbar.tools
3252 menu .mbar.tools
3253 .mbar.tools add command -label "Migrate" \
3254 -command do_miga \
3255 -font font_ui
3256 lappend disable_on_lock \
3257 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3260 # -- Help Menu
3262 .mbar add cascade -label Help -menu .mbar.help
3263 menu .mbar.help
3265 .mbar.help add command -label "About [appname]" \
3266 -command do_about \
3267 -font font_ui
3271 # -- Branch Control
3273 frame .branch \
3274 -borderwidth 1 \
3275 -relief sunken
3276 label .branch.l1 \
3277 -text {Current Branch:} \
3278 -anchor w \
3279 -justify left \
3280 -font font_ui
3281 label .branch.cb \
3282 -textvariable current_branch \
3283 -anchor w \
3284 -justify left \
3285 -font font_ui
3286 pack .branch.l1 -side left
3287 pack .branch.cb -side left -fill x
3288 pack .branch -side top -fill x
3290 # -- Main Window Layout
3292 panedwindow .vpane -orient vertical
3293 panedwindow .vpane.files -orient horizontal
3294 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3295 pack .vpane -anchor n -side top -fill both -expand 1
3297 # -- Index File List
3299 frame .vpane.files.index -height 100 -width 400
3300 label .vpane.files.index.title -text {Modified Files} \
3301 -background green \
3302 -font font_ui
3303 text $ui_index -background white -borderwidth 0 \
3304 -width 40 -height 10 \
3305 -font font_ui \
3306 -cursor $cursor_ptr \
3307 -yscrollcommand {.vpane.files.index.sb set} \
3308 -state disabled
3309 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3310 pack .vpane.files.index.title -side top -fill x
3311 pack .vpane.files.index.sb -side right -fill y
3312 pack $ui_index -side left -fill both -expand 1
3313 .vpane.files add .vpane.files.index -sticky nsew
3315 # -- Other (Add) File List
3317 frame .vpane.files.other -height 100 -width 100
3318 label .vpane.files.other.title -text {Untracked Files} \
3319 -background red \
3320 -font font_ui
3321 text $ui_other -background white -borderwidth 0 \
3322 -width 40 -height 10 \
3323 -font font_ui \
3324 -cursor $cursor_ptr \
3325 -yscrollcommand {.vpane.files.other.sb set} \
3326 -state disabled
3327 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3328 pack .vpane.files.other.title -side top -fill x
3329 pack .vpane.files.other.sb -side right -fill y
3330 pack $ui_other -side left -fill both -expand 1
3331 .vpane.files add .vpane.files.other -sticky nsew
3333 foreach i [list $ui_index $ui_other] {
3334 $i tag conf in_diff -font font_uibold
3335 $i tag conf in_sel \
3336 -background [$i cget -foreground] \
3337 -foreground [$i cget -background]
3339 unset i
3341 # -- Diff and Commit Area
3343 frame .vpane.lower -height 300 -width 400
3344 frame .vpane.lower.commarea
3345 frame .vpane.lower.diff -relief sunken -borderwidth 1
3346 pack .vpane.lower.commarea -side top -fill x
3347 pack .vpane.lower.diff -side bottom -fill both -expand 1
3348 .vpane add .vpane.lower -stick nsew
3350 # -- Commit Area Buttons
3352 frame .vpane.lower.commarea.buttons
3353 label .vpane.lower.commarea.buttons.l -text {} \
3354 -anchor w \
3355 -justify left \
3356 -font font_ui
3357 pack .vpane.lower.commarea.buttons.l -side top -fill x
3358 pack .vpane.lower.commarea.buttons -side left -fill y
3360 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3361 -command do_rescan \
3362 -font font_ui
3363 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3364 lappend disable_on_lock \
3365 {.vpane.lower.commarea.buttons.rescan conf -state}
3367 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3368 -command do_include_all \
3369 -font font_ui
3370 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3371 lappend disable_on_lock \
3372 {.vpane.lower.commarea.buttons.incall conf -state}
3374 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3375 -command do_signoff \
3376 -font font_ui
3377 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3379 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3380 -command do_commit \
3381 -font font_ui
3382 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3383 lappend disable_on_lock \
3384 {.vpane.lower.commarea.buttons.commit conf -state}
3386 # -- Commit Message Buffer
3388 frame .vpane.lower.commarea.buffer
3389 frame .vpane.lower.commarea.buffer.header
3390 set ui_comm .vpane.lower.commarea.buffer.t
3391 set ui_coml .vpane.lower.commarea.buffer.header.l
3392 radiobutton .vpane.lower.commarea.buffer.header.new \
3393 -text {New Commit} \
3394 -command do_select_commit_type \
3395 -variable selected_commit_type \
3396 -value new \
3397 -font font_ui
3398 lappend disable_on_lock \
3399 [list .vpane.lower.commarea.buffer.header.new conf -state]
3400 radiobutton .vpane.lower.commarea.buffer.header.amend \
3401 -text {Amend Last Commit} \
3402 -command do_select_commit_type \
3403 -variable selected_commit_type \
3404 -value amend \
3405 -font font_ui
3406 lappend disable_on_lock \
3407 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3408 label $ui_coml \
3409 -anchor w \
3410 -justify left \
3411 -font font_ui
3412 proc trace_commit_type {varname args} {
3413 global ui_coml commit_type
3414 switch -glob -- $commit_type {
3415 initial {set txt {Initial Commit Message:}}
3416 amend {set txt {Amended Commit Message:}}
3417 amend-initial {set txt {Amended Initial Commit Message:}}
3418 amend-merge {set txt {Amended Merge Commit Message:}}
3419 merge {set txt {Merge Commit Message:}}
3420 * {set txt {Commit Message:}}
3422 $ui_coml conf -text $txt
3424 trace add variable commit_type write trace_commit_type
3425 pack $ui_coml -side left -fill x
3426 pack .vpane.lower.commarea.buffer.header.amend -side right
3427 pack .vpane.lower.commarea.buffer.header.new -side right
3429 text $ui_comm -background white -borderwidth 1 \
3430 -undo true \
3431 -maxundo 20 \
3432 -autoseparators true \
3433 -relief sunken \
3434 -width 75 -height 9 -wrap none \
3435 -font font_diff \
3436 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3437 scrollbar .vpane.lower.commarea.buffer.sby \
3438 -command [list $ui_comm yview]
3439 pack .vpane.lower.commarea.buffer.header -side top -fill x
3440 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3441 pack $ui_comm -side left -fill y
3442 pack .vpane.lower.commarea.buffer -side left -fill y
3444 # -- Commit Message Buffer Context Menu
3446 set ctxm .vpane.lower.commarea.buffer.ctxm
3447 menu $ctxm -tearoff 0
3448 $ctxm add command \
3449 -label {Cut} \
3450 -font font_ui \
3451 -command {tk_textCut $ui_comm}
3452 $ctxm add command \
3453 -label {Copy} \
3454 -font font_ui \
3455 -command {tk_textCopy $ui_comm}
3456 $ctxm add command \
3457 -label {Paste} \
3458 -font font_ui \
3459 -command {tk_textPaste $ui_comm}
3460 $ctxm add command \
3461 -label {Delete} \
3462 -font font_ui \
3463 -command {$ui_comm delete sel.first sel.last}
3464 $ctxm add separator
3465 $ctxm add command \
3466 -label {Select All} \
3467 -font font_ui \
3468 -command {$ui_comm tag add sel 0.0 end}
3469 $ctxm add command \
3470 -label {Copy All} \
3471 -font font_ui \
3472 -command {
3473 $ui_comm tag add sel 0.0 end
3474 tk_textCopy $ui_comm
3475 $ui_comm tag remove sel 0.0 end
3477 $ctxm add separator
3478 $ctxm add command \
3479 -label {Sign Off} \
3480 -font font_ui \
3481 -command do_signoff
3482 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3484 # -- Diff Header
3486 set current_diff {}
3487 set diff_actions [list]
3488 proc trace_current_diff {varname args} {
3489 global current_diff diff_actions file_states
3490 if {$current_diff eq {}} {
3491 set s {}
3492 set f {}
3493 set p {}
3494 set o disabled
3495 } else {
3496 set p $current_diff
3497 set s [mapdesc [lindex $file_states($p) 0] $p]
3498 set f {File:}
3499 set p [escape_path $p]
3500 set o normal
3503 .vpane.lower.diff.header.status configure -text $s
3504 .vpane.lower.diff.header.file configure -text $f
3505 .vpane.lower.diff.header.path configure -text $p
3506 foreach w $diff_actions {
3507 uplevel #0 $w $o
3510 trace add variable current_diff write trace_current_diff
3512 frame .vpane.lower.diff.header -background orange
3513 label .vpane.lower.diff.header.status \
3514 -background orange \
3515 -width $max_status_desc \
3516 -anchor w \
3517 -justify left \
3518 -font font_ui
3519 label .vpane.lower.diff.header.file \
3520 -background orange \
3521 -anchor w \
3522 -justify left \
3523 -font font_ui
3524 label .vpane.lower.diff.header.path \
3525 -background orange \
3526 -anchor w \
3527 -justify left \
3528 -font font_ui
3529 pack .vpane.lower.diff.header.status -side left
3530 pack .vpane.lower.diff.header.file -side left
3531 pack .vpane.lower.diff.header.path -fill x
3532 set ctxm .vpane.lower.diff.header.ctxm
3533 menu $ctxm -tearoff 0
3534 $ctxm add command \
3535 -label {Copy} \
3536 -font font_ui \
3537 -command {
3538 clipboard clear
3539 clipboard append \
3540 -format STRING \
3541 -type STRING \
3542 -- $current_diff
3544 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3545 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3547 # -- Diff Body
3549 frame .vpane.lower.diff.body
3550 set ui_diff .vpane.lower.diff.body.t
3551 text $ui_diff -background white -borderwidth 0 \
3552 -width 80 -height 15 -wrap none \
3553 -font font_diff \
3554 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3555 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3556 -state disabled
3557 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3558 -command [list $ui_diff xview]
3559 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3560 -command [list $ui_diff yview]
3561 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3562 pack .vpane.lower.diff.body.sby -side right -fill y
3563 pack $ui_diff -side left -fill both -expand 1
3564 pack .vpane.lower.diff.header -side top -fill x
3565 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3567 $ui_diff tag conf d_@ -font font_diffbold
3568 $ui_diff tag conf d_+ -foreground blue
3569 $ui_diff tag conf d_- -foreground red
3570 $ui_diff tag conf d_++ -foreground {#00a000}
3571 $ui_diff tag conf d_-- -foreground {#a000a0}
3572 $ui_diff tag conf d_+- \
3573 -foreground red \
3574 -background {light goldenrod yellow}
3575 $ui_diff tag conf d_-+ \
3576 -foreground blue \
3577 -background azure2
3579 # -- Diff Body Context Menu
3581 set ctxm .vpane.lower.diff.body.ctxm
3582 menu $ctxm -tearoff 0
3583 $ctxm add command \
3584 -label {Copy} \
3585 -font font_ui \
3586 -command {tk_textCopy $ui_diff}
3587 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3588 $ctxm add command \
3589 -label {Select All} \
3590 -font font_ui \
3591 -command {$ui_diff tag add sel 0.0 end}
3592 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3593 $ctxm add command \
3594 -label {Copy All} \
3595 -font font_ui \
3596 -command {
3597 $ui_diff tag add sel 0.0 end
3598 tk_textCopy $ui_diff
3599 $ui_diff tag remove sel 0.0 end
3601 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3602 $ctxm add separator
3603 $ctxm add command \
3604 -label {Decrease Font Size} \
3605 -font font_ui \
3606 -command {incr_font_size font_diff -1}
3607 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3608 $ctxm add command \
3609 -label {Increase Font Size} \
3610 -font font_ui \
3611 -command {incr_font_size font_diff 1}
3612 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3613 $ctxm add separator
3614 $ctxm add command \
3615 -label {Show Less Context} \
3616 -font font_ui \
3617 -command {if {$repo_config(gui.diffcontext) >= 2} {
3618 incr repo_config(gui.diffcontext) -1
3619 reshow_diff
3621 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3622 $ctxm add command \
3623 -label {Show More Context} \
3624 -font font_ui \
3625 -command {
3626 incr repo_config(gui.diffcontext)
3627 reshow_diff
3629 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3630 $ctxm add separator
3631 $ctxm add command -label {Options...} \
3632 -font font_ui \
3633 -command do_options
3634 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3636 # -- Status Bar
3638 set ui_status_value {Initializing...}
3639 label .status -textvariable ui_status_value \
3640 -anchor w \
3641 -justify left \
3642 -borderwidth 1 \
3643 -relief sunken \
3644 -font font_ui
3645 pack .status -anchor w -side bottom -fill x
3647 # -- Load geometry
3649 catch {
3650 set gm $repo_config(gui.geometry)
3651 wm geometry . [lindex $gm 0]
3652 .vpane sash place 0 \
3653 [lindex [.vpane sash coord 0] 0] \
3654 [lindex $gm 1]
3655 .vpane.files sash place 0 \
3656 [lindex $gm 2] \
3657 [lindex [.vpane.files sash coord 0] 1]
3658 unset gm
3661 # -- Key Bindings
3663 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3664 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3665 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3666 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3667 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3668 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3669 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3670 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3671 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3672 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3673 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3675 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3676 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3677 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3678 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3679 bind $ui_diff <$M1B-Key-v> {break}
3680 bind $ui_diff <$M1B-Key-V> {break}
3681 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3682 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3683 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3684 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3685 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3686 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3688 bind . <Destroy> do_quit
3689 bind all <Key-F5> do_rescan
3690 bind all <$M1B-Key-r> do_rescan
3691 bind all <$M1B-Key-R> do_rescan
3692 bind . <$M1B-Key-s> do_signoff
3693 bind . <$M1B-Key-S> do_signoff
3694 bind . <$M1B-Key-i> do_include_all
3695 bind . <$M1B-Key-I> do_include_all
3696 bind . <$M1B-Key-Return> do_commit
3697 bind all <$M1B-Key-q> do_quit
3698 bind all <$M1B-Key-Q> do_quit
3699 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3700 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3701 foreach i [list $ui_index $ui_other] {
3702 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3703 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3704 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3706 unset i
3708 set file_lists($ui_index) [list]
3709 set file_lists($ui_other) [list]
3711 set HEAD {}
3712 set PARENT {}
3713 set MERGE_HEAD [list]
3714 set commit_type {}
3715 set empty_tree {}
3716 set current_branch {}
3717 set current_diff {}
3718 set selected_commit_type new
3720 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
3721 focus -force $ui_comm
3723 # -- Warn the user about environmental problems. Cygwin's Tcl
3724 # does *not* pass its env array onto any processes it spawns.
3725 # This means that git processes get none of our environment.
3727 if {[is_Windows]} {
3728 set ignored_env 0
3729 set suggest_user {}
3730 set msg "Possible environment issues exist.
3732 The following environment variables are probably
3733 going to be ignored by any Git subprocess run
3734 by [appname]:
3737 foreach name [array names env] {
3738 switch -regexp -- $name {
3739 {^GIT_INDEX_FILE$} -
3740 {^GIT_OBJECT_DIRECTORY$} -
3741 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3742 {^GIT_DIFF_OPTS$} -
3743 {^GIT_EXTERNAL_DIFF$} -
3744 {^GIT_PAGER$} -
3745 {^GIT_TRACE$} -
3746 {^GIT_CONFIG$} -
3747 {^GIT_CONFIG_LOCAL$} -
3748 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3749 append msg " - $name\n"
3750 incr ignored_env
3752 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3753 append msg " - $name\n"
3754 incr ignored_env
3755 set suggest_user $name
3759 if {$ignored_env > 0} {
3760 append msg "
3761 This is due to a known issue with the
3762 Tcl binary distributed by Cygwin."
3764 if {$suggest_user ne {}} {
3765 append msg "
3767 A good replacement for $suggest_user
3768 is placing values for the user.name and
3769 user.email settings into your personal
3770 ~/.gitconfig file.
3773 warn_popup $msg
3775 unset ignored_env msg suggest_user name
3778 # -- Only initialize complex UI if we are going to stay running.
3780 if {!$single_commit} {
3781 load_all_remotes
3782 load_all_heads
3784 populate_branch_menu .mbar.branch
3785 populate_fetch_menu .mbar.fetch
3786 populate_pull_menu .mbar.pull
3787 populate_push_menu .mbar.push
3790 # -- Only suggest a gc run if we are going to stay running.
3792 if {!$single_commit} {
3793 set object_limit 2000
3794 if {[is_Windows]} {set object_limit 200}
3795 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3796 if {$objects_current >= $object_limit} {
3797 if {[ask_popup \
3798 "This repository currently has $objects_current loose objects.
3800 To maintain optimal performance it is strongly
3801 recommended that you compress the database
3802 when more than $object_limit loose objects exist.
3804 Compress the database now?"] eq yes} {
3805 do_gc
3808 unset object_limit _junk objects_current
3811 lock_index begin-read
3812 after 1 do_rescan