git-gui: Suggest when running 'git gc' may be worthwhile.
[git-gui/me-and.git] / git-gui.sh
blobfb2d92d17c020a98d803c8135611d695790eb89d
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 set copyright {
6 Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2 of the License, or
11 (at your option) any later version.
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with this program; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
22 set appvers {@@GIT_VERSION@@}
23 set appname [lindex [file split $argv0] end]
24 set gitdir {}
26 ######################################################################
28 ## config
30 proc is_many_config {name} {
31 switch -glob -- $name {
32 remote.*.fetch -
33 remote.*.push
34 {return 1}
36 {return 0}
40 proc load_config {include_global} {
41 global repo_config global_config default_config
43 array unset global_config
44 if {$include_global} {
45 catch {
46 set fd_rc [open "| git repo-config --global --list" r]
47 while {[gets $fd_rc line] >= 0} {
48 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
49 if {[is_many_config $name]} {
50 lappend global_config($name) $value
51 } else {
52 set global_config($name) $value
56 close $fd_rc
60 array unset repo_config
61 catch {
62 set fd_rc [open "| git repo-config --list" r]
63 while {[gets $fd_rc line] >= 0} {
64 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
65 if {[is_many_config $name]} {
66 lappend repo_config($name) $value
67 } else {
68 set repo_config($name) $value
72 close $fd_rc
75 foreach name [array names default_config] {
76 if {[catch {set v $global_config($name)}]} {
77 set global_config($name) $default_config($name)
79 if {[catch {set v $repo_config($name)}]} {
80 set repo_config($name) $default_config($name)
85 proc save_config {} {
86 global default_config font_descs
87 global repo_config global_config
88 global repo_config_new global_config_new
90 foreach option $font_descs {
91 set name [lindex $option 0]
92 set font [lindex $option 1]
93 font configure $font \
94 -family $global_config_new(gui.$font^^family) \
95 -size $global_config_new(gui.$font^^size)
96 font configure ${font}bold \
97 -family $global_config_new(gui.$font^^family) \
98 -size $global_config_new(gui.$font^^size)
99 set global_config_new(gui.$name) [font configure $font]
100 unset global_config_new(gui.$font^^family)
101 unset global_config_new(gui.$font^^size)
104 foreach name [array names default_config] {
105 set value $global_config_new($name)
106 if {$value ne $global_config($name)} {
107 if {$value eq $default_config($name)} {
108 catch {exec git repo-config --global --unset $name}
109 } else {
110 regsub -all "\[{}\]" $value {"} value
111 exec git repo-config --global $name $value
113 set global_config($name) $value
114 if {$value eq $repo_config($name)} {
115 catch {exec git repo-config --unset $name}
116 set repo_config($name) $value
121 foreach name [array names default_config] {
122 set value $repo_config_new($name)
123 if {$value ne $repo_config($name)} {
124 if {$value eq $global_config($name)} {
125 catch {exec git repo-config --unset $name}
126 } else {
127 regsub -all "\[{}\]" $value {"} value
128 exec git repo-config $name $value
130 set repo_config($name) $value
135 proc error_popup {msg} {
136 global gitdir appname
138 set title $appname
139 if {$gitdir ne {}} {
140 append title { (}
141 append title [lindex \
142 [file split [file normalize [file dirname $gitdir]]] \
143 end]
144 append title {)}
146 set cmd [list tk_messageBox \
147 -icon error \
148 -type ok \
149 -title "$title: error" \
150 -message $msg]
151 if {[winfo ismapped .]} {
152 lappend cmd -parent .
154 eval $cmd
157 proc warn_popup {msg} {
158 global gitdir appname
160 set title $appname
161 if {$gitdir ne {}} {
162 append title { (}
163 append title [lindex \
164 [file split [file normalize [file dirname $gitdir]]] \
165 end]
166 append title {)}
168 set cmd [list tk_messageBox \
169 -icon warning \
170 -type ok \
171 -title "$title: warning" \
172 -message $msg]
173 if {[winfo ismapped .]} {
174 lappend cmd -parent .
176 eval $cmd
179 proc info_popup {msg} {
180 global gitdir appname
182 set title $appname
183 if {$gitdir ne {}} {
184 append title { (}
185 append title [lindex \
186 [file split [file normalize [file dirname $gitdir]]] \
187 end]
188 append title {)}
190 tk_messageBox \
191 -parent . \
192 -icon info \
193 -type ok \
194 -title $title \
195 -message $msg
198 proc ask_popup {msg} {
199 global gitdir appname
201 set title $appname
202 if {$gitdir ne {}} {
203 append title { (}
204 append title [lindex \
205 [file split [file normalize [file dirname $gitdir]]] \
206 end]
207 append title {)}
209 return [tk_messageBox \
210 -parent . \
211 -icon question \
212 -type yesno \
213 -title $title \
214 -message $msg]
217 ######################################################################
219 ## repository setup
221 if { [catch {set gitdir $env(GIT_DIR)}]
222 && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
223 catch {wm withdraw .}
224 error_popup "Cannot find the git directory:\n\n$err"
225 exit 1
227 if {![file isdirectory $gitdir]} {
228 catch {wm withdraw .}
229 error_popup "Git directory not found:\n\n$gitdir"
230 exit 1
232 if {[lindex [file split $gitdir] end] ne {.git}} {
233 catch {wm withdraw .}
234 error_popup "Cannot use funny .git directory:\n\n$gitdir"
235 exit 1
237 if {[catch {cd [file dirname $gitdir]} err]} {
238 catch {wm withdraw .}
239 error_popup "No working directory [file dirname $gitdir]:\n\n$err"
240 exit 1
243 set single_commit 0
244 if {$appname eq {git-citool}} {
245 set single_commit 1
248 ######################################################################
250 ## task management
252 set rescan_active 0
253 set diff_active 0
254 set last_clicked {}
256 set disable_on_lock [list]
257 set index_lock_type none
259 proc lock_index {type} {
260 global index_lock_type disable_on_lock
262 if {$index_lock_type eq {none}} {
263 set index_lock_type $type
264 foreach w $disable_on_lock {
265 uplevel #0 $w disabled
267 return 1
268 } elseif {$index_lock_type eq "begin-$type"} {
269 set index_lock_type $type
270 return 1
272 return 0
275 proc unlock_index {} {
276 global index_lock_type disable_on_lock
278 set index_lock_type none
279 foreach w $disable_on_lock {
280 uplevel #0 $w normal
284 ######################################################################
286 ## status
288 proc repository_state {ctvar hdvar mhvar} {
289 global gitdir current_branch
290 upvar $ctvar ct $hdvar hd $mhvar mh
292 set mh [list]
294 if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
295 set current_branch {}
296 } else {
297 regsub ^refs/((heads|tags|remotes)/)? \
298 $current_branch \
299 {} \
300 current_branch
303 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
304 set hd {}
305 set ct initial
306 return
309 set merge_head [file join $gitdir MERGE_HEAD]
310 if {[file exists $merge_head]} {
311 set ct merge
312 set fd_mh [open $merge_head r]
313 while {[gets $fd_mh line] >= 0} {
314 lappend mh $line
316 close $fd_mh
317 return
320 set ct normal
323 proc PARENT {} {
324 global PARENT empty_tree
326 set p [lindex $PARENT 0]
327 if {$p ne {}} {
328 return $p
330 if {$empty_tree eq {}} {
331 set empty_tree [exec git mktree << {}]
333 return $empty_tree
336 proc rescan {after} {
337 global HEAD PARENT MERGE_HEAD commit_type
338 global ui_index ui_other ui_status_value ui_comm
339 global rescan_active file_states
340 global repo_config
342 if {$rescan_active > 0 || ![lock_index read]} return
344 repository_state newType newHEAD newMERGE_HEAD
345 if {[string match amend* $commit_type]
346 && $newType eq {normal}
347 && $newHEAD eq $HEAD} {
348 } else {
349 set HEAD $newHEAD
350 set PARENT $newHEAD
351 set MERGE_HEAD $newMERGE_HEAD
352 set commit_type $newType
355 array unset file_states
357 if {![$ui_comm edit modified]
358 || [string trim [$ui_comm get 0.0 end]] eq {}} {
359 if {[load_message GITGUI_MSG]} {
360 } elseif {[load_message MERGE_MSG]} {
361 } elseif {[load_message SQUASH_MSG]} {
363 $ui_comm edit reset
364 $ui_comm edit modified false
367 if {$repo_config(gui.trustmtime) eq {true}} {
368 rescan_stage2 {} $after
369 } else {
370 set rescan_active 1
371 set ui_status_value {Refreshing file status...}
372 set cmd [list git update-index]
373 lappend cmd -q
374 lappend cmd --unmerged
375 lappend cmd --ignore-missing
376 lappend cmd --refresh
377 set fd_rf [open "| $cmd" r]
378 fconfigure $fd_rf -blocking 0 -translation binary
379 fileevent $fd_rf readable \
380 [list rescan_stage2 $fd_rf $after]
384 proc rescan_stage2 {fd after} {
385 global gitdir ui_status_value
386 global rescan_active buf_rdi buf_rdf buf_rlo
388 if {$fd ne {}} {
389 read $fd
390 if {![eof $fd]} return
391 close $fd
394 set ls_others [list | git ls-files --others -z \
395 --exclude-per-directory=.gitignore]
396 set info_exclude [file join $gitdir info exclude]
397 if {[file readable $info_exclude]} {
398 lappend ls_others "--exclude-from=$info_exclude"
401 set buf_rdi {}
402 set buf_rdf {}
403 set buf_rlo {}
405 set rescan_active 3
406 set ui_status_value {Scanning for modified files ...}
407 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
408 set fd_df [open "| git diff-files -z" r]
409 set fd_lo [open $ls_others r]
411 fconfigure $fd_di -blocking 0 -translation binary
412 fconfigure $fd_df -blocking 0 -translation binary
413 fconfigure $fd_lo -blocking 0 -translation binary
414 fileevent $fd_di readable [list read_diff_index $fd_di $after]
415 fileevent $fd_df readable [list read_diff_files $fd_df $after]
416 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
419 proc load_message {file} {
420 global gitdir ui_comm
422 set f [file join $gitdir $file]
423 if {[file isfile $f]} {
424 if {[catch {set fd [open $f r]}]} {
425 return 0
427 set content [string trim [read $fd]]
428 close $fd
429 $ui_comm delete 0.0 end
430 $ui_comm insert end $content
431 return 1
433 return 0
436 proc read_diff_index {fd after} {
437 global buf_rdi
439 append buf_rdi [read $fd]
440 set c 0
441 set n [string length $buf_rdi]
442 while {$c < $n} {
443 set z1 [string first "\0" $buf_rdi $c]
444 if {$z1 == -1} break
445 incr z1
446 set z2 [string first "\0" $buf_rdi $z1]
447 if {$z2 == -1} break
449 incr c
450 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
451 merge_state \
452 [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
453 [lindex $i 4]? \
454 [list [lindex $i 0] [lindex $i 2]] \
455 [list]
456 set c $z2
457 incr c
459 if {$c < $n} {
460 set buf_rdi [string range $buf_rdi $c end]
461 } else {
462 set buf_rdi {}
465 rescan_done $fd buf_rdi $after
468 proc read_diff_files {fd after} {
469 global buf_rdf
471 append buf_rdf [read $fd]
472 set c 0
473 set n [string length $buf_rdf]
474 while {$c < $n} {
475 set z1 [string first "\0" $buf_rdf $c]
476 if {$z1 == -1} break
477 incr z1
478 set z2 [string first "\0" $buf_rdf $z1]
479 if {$z2 == -1} break
481 incr c
482 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
483 merge_state \
484 [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
485 ?[lindex $i 4] \
486 [list] \
487 [list [lindex $i 0] [lindex $i 2]]
488 set c $z2
489 incr c
491 if {$c < $n} {
492 set buf_rdf [string range $buf_rdf $c end]
493 } else {
494 set buf_rdf {}
497 rescan_done $fd buf_rdf $after
500 proc read_ls_others {fd after} {
501 global buf_rlo
503 append buf_rlo [read $fd]
504 set pck [split $buf_rlo "\0"]
505 set buf_rlo [lindex $pck end]
506 foreach p [lrange $pck 0 end-1] {
507 merge_state $p ?O
509 rescan_done $fd buf_rlo $after
512 proc rescan_done {fd buf after} {
513 global rescan_active
514 global file_states repo_config
515 upvar $buf to_clear
517 if {![eof $fd]} return
518 set to_clear {}
519 close $fd
520 if {[incr rescan_active -1] > 0} return
522 prune_selection
523 unlock_index
524 display_all_files
526 if {$repo_config(gui.partialinclude) ne {true}} {
527 set pathList [list]
528 foreach path [array names file_states] {
529 switch -- [lindex $file_states($path) 0] {
530 A? -
531 M? {lappend pathList $path}
534 if {$pathList ne {}} {
535 update_index \
536 "Updating included files" \
537 $pathList \
538 [concat {reshow_diff;} $after]
539 return
543 reshow_diff
544 uplevel #0 $after
547 proc prune_selection {} {
548 global file_states selected_paths
550 foreach path [array names selected_paths] {
551 if {[catch {set still_here $file_states($path)}]} {
552 unset selected_paths($path)
557 ######################################################################
559 ## diff
561 proc clear_diff {} {
562 global ui_diff current_diff ui_index ui_other
564 $ui_diff conf -state normal
565 $ui_diff delete 0.0 end
566 $ui_diff conf -state disabled
568 set current_diff {}
570 $ui_index tag remove in_diff 0.0 end
571 $ui_other tag remove in_diff 0.0 end
574 proc reshow_diff {} {
575 global current_diff ui_status_value file_states
577 if {$current_diff eq {}
578 || [catch {set s $file_states($current_diff)}]} {
579 clear_diff
580 } else {
581 show_diff $current_diff
585 proc handle_empty_diff {} {
586 global current_diff file_states file_lists
588 set path $current_diff
589 set s $file_states($path)
590 if {[lindex $s 0] ne {_M}} return
592 info_popup "No differences detected.
594 [short_path $path] has no changes.
596 The modification date of this file was updated
597 by another application and you currently have
598 the Trust File Modification Timestamps option
599 enabled, so Git did not automatically detect
600 that there are no content differences in this
601 file.
603 This file will now be removed from the modified
604 files list, to prevent possible confusion.
606 if {[catch {exec git update-index -- $path} err]} {
607 error_popup "Failed to refresh index:\n\n$err"
610 clear_diff
611 set old_w [mapcol [lindex $file_states($path) 0] $path]
612 set lno [lsearch -sorted $file_lists($old_w) $path]
613 if {$lno >= 0} {
614 set file_lists($old_w) \
615 [lreplace $file_lists($old_w) $lno $lno]
616 incr lno
617 $old_w conf -state normal
618 $old_w delete $lno.0 [expr {$lno + 1}].0
619 $old_w conf -state disabled
623 proc show_diff {path {w {}} {lno {}}} {
624 global file_states file_lists
625 global is_3way_diff diff_active repo_config
626 global ui_diff current_diff ui_status_value
628 if {$diff_active || ![lock_index read]} return
630 clear_diff
631 if {$w eq {} || $lno == {}} {
632 foreach w [array names file_lists] {
633 set lno [lsearch -sorted $file_lists($w) $path]
634 if {$lno >= 0} {
635 incr lno
636 break
640 if {$w ne {} && $lno >= 1} {
641 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
644 set s $file_states($path)
645 set m [lindex $s 0]
646 set is_3way_diff 0
647 set diff_active 1
648 set current_diff $path
649 set ui_status_value "Loading diff of [escape_path $path]..."
651 set cmd [list | git diff-index]
652 lappend cmd --no-color
653 if {$repo_config(gui.diffcontext) > 0} {
654 lappend cmd "-U$repo_config(gui.diffcontext)"
656 lappend cmd -p
658 switch $m {
659 MM {
660 lappend cmd -c
662 _O {
663 if {[catch {
664 set fd [open $path r]
665 set content [read $fd]
666 close $fd
667 } err ]} {
668 set diff_active 0
669 unlock_index
670 set ui_status_value "Unable to display [escape_path $path]"
671 error_popup "Error loading file:\n\n$err"
672 return
674 $ui_diff conf -state normal
675 $ui_diff insert end $content
676 $ui_diff conf -state disabled
677 set diff_active 0
678 unlock_index
679 set ui_status_value {Ready.}
680 return
684 lappend cmd [PARENT]
685 lappend cmd --
686 lappend cmd $path
688 if {[catch {set fd [open $cmd r]} err]} {
689 set diff_active 0
690 unlock_index
691 set ui_status_value "Unable to display [escape_path $path]"
692 error_popup "Error loading diff:\n\n$err"
693 return
696 fconfigure $fd -blocking 0 -translation auto
697 fileevent $fd readable [list read_diff $fd]
700 proc read_diff {fd} {
701 global ui_diff ui_status_value is_3way_diff diff_active
702 global repo_config
704 $ui_diff conf -state normal
705 while {[gets $fd line] >= 0} {
706 # -- Cleanup uninteresting diff header lines.
708 if {[string match {diff --git *} $line]} continue
709 if {[string match {diff --combined *} $line]} continue
710 if {[string match {--- *} $line]} continue
711 if {[string match {+++ *} $line]} continue
712 if {$line eq {deleted file mode 120000}} {
713 set line "deleted symlink"
716 # -- Automatically detect if this is a 3 way diff.
718 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
720 # -- Reformat a 3 way diff, 'cause its too weird.
722 if {$is_3way_diff} {
723 set op [string range $line 0 1]
724 switch -- $op {
725 {@@} {set tags d_@}
726 {++} {set tags d_+ ; set op { +}}
727 {--} {set tags d_- ; set op { -}}
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 default {set tags {}}
734 set line [string replace $line 0 1 $op]
735 } else {
736 switch -- [string index $line 0] {
737 @ {set tags d_@}
738 + {set tags d_+}
739 - {set tags d_-}
740 default {set tags {}}
743 $ui_diff insert end $line $tags
744 $ui_diff insert end "\n" $tags
746 $ui_diff conf -state disabled
748 if {[eof $fd]} {
749 close $fd
750 set diff_active 0
751 unlock_index
752 set ui_status_value {Ready.}
754 if {$repo_config(gui.trustmtime) eq {true}
755 && [$ui_diff index end] eq {2.0}} {
756 handle_empty_diff
761 ######################################################################
763 ## commit
765 proc load_last_commit {} {
766 global HEAD PARENT MERGE_HEAD commit_type ui_comm
768 if {[llength $PARENT] == 0} {
769 error_popup {There is nothing to amend.
771 You are about to create the initial commit.
772 There is no commit before this to amend.
774 return
777 repository_state curType curHEAD curMERGE_HEAD
778 if {$curType eq {merge}} {
779 error_popup {Cannot amend while merging.
781 You are currently in the middle of a merge that
782 has not been fully completed. You cannot amend
783 the prior commit unless you first abort the
784 current merge activity.
786 return
789 set msg {}
790 set parents [list]
791 if {[catch {
792 set fd [open "| git cat-file commit $curHEAD" r]
793 while {[gets $fd line] > 0} {
794 if {[string match {parent *} $line]} {
795 lappend parents [string range $line 7 end]
798 set msg [string trim [read $fd]]
799 close $fd
800 } err]} {
801 error_popup "Error loading commit data for amend:\n\n$err"
802 return
805 set HEAD $curHEAD
806 set PARENT $parents
807 set MERGE_HEAD [list]
808 switch -- [llength $parents] {
809 0 {set commit_type amend-initial}
810 1 {set commit_type amend}
811 default {set commit_type amend-merge}
814 $ui_comm delete 0.0 end
815 $ui_comm insert end $msg
816 $ui_comm edit reset
817 $ui_comm edit modified false
818 rescan {set ui_status_value {Ready.}}
821 proc create_new_commit {} {
822 global commit_type ui_comm
824 set commit_type normal
825 $ui_comm delete 0.0 end
826 $ui_comm edit reset
827 $ui_comm edit modified false
828 rescan {set ui_status_value {Ready.}}
831 set GIT_COMMITTER_IDENT {}
833 proc committer_ident {} {
834 global GIT_COMMITTER_IDENT
836 if {$GIT_COMMITTER_IDENT eq {}} {
837 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
838 error_popup "Unable to obtain your identity:\n\n$err"
839 return {}
841 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
842 $me me GIT_COMMITTER_IDENT]} {
843 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
844 return {}
848 return $GIT_COMMITTER_IDENT
851 proc commit_tree {} {
852 global HEAD commit_type file_states ui_comm repo_config
854 if {![lock_index update]} return
855 if {[committer_ident] eq {}} return
857 # -- Our in memory state should match the repository.
859 repository_state curType curHEAD curMERGE_HEAD
860 if {[string match amend* $commit_type]
861 && $curType eq {normal}
862 && $curHEAD eq $HEAD} {
863 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
864 info_popup {Last scanned state does not match repository state.
866 Another Git program has modified this repository
867 since the last scan. A rescan must be performed
868 before another commit can be created.
870 The rescan will be automatically started now.
872 unlock_index
873 rescan {set ui_status_value {Ready.}}
874 return
877 # -- At least one file should differ in the index.
879 set files_ready 0
880 foreach path [array names file_states] {
881 switch -glob -- [lindex $file_states($path) 0] {
882 _? {continue}
883 A? -
884 D? -
885 M? {set files_ready 1; break}
886 U? {
887 error_popup "Unmerged files cannot be committed.
889 File [short_path $path] has merge conflicts.
890 You must resolve them and include the file before committing.
892 unlock_index
893 return
895 default {
896 error_popup "Unknown file state [lindex $s 0] detected.
898 File [short_path $path] cannot be committed by this program.
903 if {!$files_ready} {
904 error_popup {No included files to commit.
906 You must include at least 1 file before you can commit.
908 unlock_index
909 return
912 # -- A message is required.
914 set msg [string trim [$ui_comm get 1.0 end]]
915 if {$msg eq {}} {
916 error_popup {Please supply a commit message.
918 A good commit message has the following format:
920 - First line: Describe in one sentance what you did.
921 - Second line: Blank
922 - Remaining lines: Describe why this change is good.
924 unlock_index
925 return
928 # -- Update included files if partialincludes are off.
930 if {$repo_config(gui.partialinclude) ne {true}} {
931 set pathList [list]
932 foreach path [array names file_states] {
933 switch -glob -- [lindex $file_states($path) 0] {
934 A? -
935 M? {lappend pathList $path}
938 if {$pathList ne {}} {
939 unlock_index
940 update_index \
941 "Updating included files" \
942 $pathList \
943 [concat {lock_index update;} \
944 [list commit_prehook $curHEAD $msg]]
945 return
949 commit_prehook $curHEAD $msg
952 proc commit_prehook {curHEAD msg} {
953 global gitdir ui_status_value pch_error
955 set pchook [file join $gitdir hooks pre-commit]
957 # On Cygwin [file executable] might lie so we need to ask
958 # the shell if the hook is executable. Yes that's annoying.
960 if {[is_Windows] && [file isfile $pchook]} {
961 set pchook [list sh -c [concat \
962 "if test -x \"$pchook\";" \
963 "then exec \"$pchook\" 2>&1;" \
964 "fi"]]
965 } elseif {[file executable $pchook]} {
966 set pchook [list $pchook |& cat]
967 } else {
968 commit_writetree $curHEAD $msg
969 return
972 set ui_status_value {Calling pre-commit hook...}
973 set pch_error {}
974 set fd_ph [open "| $pchook" r]
975 fconfigure $fd_ph -blocking 0 -translation binary
976 fileevent $fd_ph readable \
977 [list commit_prehook_wait $fd_ph $curHEAD $msg]
980 proc commit_prehook_wait {fd_ph curHEAD msg} {
981 global pch_error ui_status_value
983 append pch_error [read $fd_ph]
984 fconfigure $fd_ph -blocking 1
985 if {[eof $fd_ph]} {
986 if {[catch {close $fd_ph}]} {
987 set ui_status_value {Commit declined by pre-commit hook.}
988 hook_failed_popup pre-commit $pch_error
989 unlock_index
990 } else {
991 commit_writetree $curHEAD $msg
993 set pch_error {}
994 return
996 fconfigure $fd_ph -blocking 0
999 proc commit_writetree {curHEAD msg} {
1000 global ui_status_value
1002 set ui_status_value {Committing changes...}
1003 set fd_wt [open "| git write-tree" r]
1004 fileevent $fd_wt readable \
1005 [list commit_committree $fd_wt $curHEAD $msg]
1008 proc commit_committree {fd_wt curHEAD msg} {
1009 global HEAD PARENT MERGE_HEAD commit_type
1010 global single_commit gitdir
1011 global ui_status_value ui_comm selected_commit_type
1012 global file_states selected_paths rescan_active
1014 gets $fd_wt tree_id
1015 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1016 error_popup "write-tree failed:\n\n$err"
1017 set ui_status_value {Commit failed.}
1018 unlock_index
1019 return
1022 # -- Create the commit.
1024 set cmd [list git commit-tree $tree_id]
1025 set parents [concat $PARENT $MERGE_HEAD]
1026 if {[llength $parents] > 0} {
1027 foreach p $parents {
1028 lappend cmd -p $p
1030 } else {
1031 # git commit-tree writes to stderr during initial commit.
1032 lappend cmd 2>/dev/null
1034 lappend cmd << $msg
1035 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1036 error_popup "commit-tree failed:\n\n$err"
1037 set ui_status_value {Commit failed.}
1038 unlock_index
1039 return
1042 # -- Update the HEAD ref.
1044 set reflogm commit
1045 if {$commit_type ne {normal}} {
1046 append reflogm " ($commit_type)"
1048 set i [string first "\n" $msg]
1049 if {$i >= 0} {
1050 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1051 } else {
1052 append reflogm {: } $msg
1054 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1055 if {[catch {eval exec $cmd} err]} {
1056 error_popup "update-ref failed:\n\n$err"
1057 set ui_status_value {Commit failed.}
1058 unlock_index
1059 return
1062 # -- Cleanup after ourselves.
1064 catch {file delete [file join $gitdir MERGE_HEAD]}
1065 catch {file delete [file join $gitdir MERGE_MSG]}
1066 catch {file delete [file join $gitdir SQUASH_MSG]}
1067 catch {file delete [file join $gitdir GITGUI_MSG]}
1069 # -- Let rerere do its thing.
1071 if {[file isdirectory [file join $gitdir rr-cache]]} {
1072 catch {exec git rerere}
1075 # -- Run the post-commit hook.
1077 set pchook [file join $gitdir hooks post-commit]
1078 if {[is_Windows] && [file isfile $pchook]} {
1079 set pchook [list sh -c [concat \
1080 "if test -x \"$pchook\";" \
1081 "then exec \"$pchook\";" \
1082 "fi"]]
1083 } elseif {![file executable $pchook]} {
1084 set pchook {}
1086 if {$pchook ne {}} {
1087 catch {exec $pchook &}
1090 $ui_comm delete 0.0 end
1091 $ui_comm edit reset
1092 $ui_comm edit modified false
1094 if {$single_commit} do_quit
1096 # -- Update in memory status
1098 set selected_commit_type new
1099 set commit_type normal
1100 set HEAD $cmt_id
1101 set PARENT $cmt_id
1102 set MERGE_HEAD [list]
1104 foreach path [array names file_states] {
1105 set s $file_states($path)
1106 set m [lindex $s 0]
1107 switch -glob -- $m {
1108 _O -
1109 _M -
1110 _D {continue}
1111 __ -
1112 A_ -
1113 M_ -
1114 DD {
1115 unset file_states($path)
1116 catch {unset selected_paths($path)}
1118 DO {
1119 set file_states($path) [list _O [lindex $s 1] {} {}]
1121 AM -
1122 AD -
1123 MM -
1124 MD -
1125 DM {
1126 set file_states($path) [list \
1127 _[string index $m 1] \
1128 [lindex $s 1] \
1129 [lindex $s 3] \
1135 display_all_files
1136 unlock_index
1137 reshow_diff
1138 set ui_status_value \
1139 "Changes committed as [string range $cmt_id 0 7]."
1142 ######################################################################
1144 ## fetch pull push
1146 proc fetch_from {remote} {
1147 set w [new_console "fetch $remote" \
1148 "Fetching new changes from $remote"]
1149 set cmd [list git fetch]
1150 lappend cmd $remote
1151 console_exec $w $cmd
1154 proc pull_remote {remote branch} {
1155 global HEAD commit_type file_states repo_config
1157 if {![lock_index update]} return
1159 # -- Our in memory state should match the repository.
1161 repository_state curType curHEAD curMERGE_HEAD
1162 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1163 info_popup {Last scanned state does not match repository state.
1165 Another Git program has modified this repository
1166 since the last scan. A rescan must be performed
1167 before a pull operation can be started.
1169 The rescan will be automatically started now.
1171 unlock_index
1172 rescan {set ui_status_value {Ready.}}
1173 return
1176 # -- No differences should exist before a pull.
1178 if {[array size file_states] != 0} {
1179 error_popup {Uncommitted but modified files are present.
1181 You should not perform a pull with unmodified
1182 files in your working directory as Git will be
1183 unable to recover from an incorrect merge.
1185 You should commit or revert all changes before
1186 starting a pull operation.
1188 unlock_index
1189 return
1192 set w [new_console "pull $remote $branch" \
1193 "Pulling new changes from branch $branch in $remote"]
1194 set cmd [list git pull]
1195 if {$repo_config(gui.pullsummary) eq {false}} {
1196 lappend cmd --no-summary
1198 lappend cmd $remote
1199 lappend cmd $branch
1200 console_exec $w $cmd [list post_pull_remote $remote $branch]
1203 proc post_pull_remote {remote branch success} {
1204 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1205 global ui_status_value
1207 unlock_index
1208 if {$success} {
1209 repository_state commit_type HEAD MERGE_HEAD
1210 set PARENT $HEAD
1211 set selected_commit_type new
1212 set ui_status_value "Pulling $branch from $remote complete."
1213 } else {
1214 rescan [list set ui_status_value \
1215 "Conflicts detected while pulling $branch from $remote."]
1219 proc push_to {remote} {
1220 set w [new_console "push $remote" \
1221 "Pushing changes to $remote"]
1222 set cmd [list git push]
1223 lappend cmd $remote
1224 console_exec $w $cmd
1227 ######################################################################
1229 ## ui helpers
1231 proc mapcol {state path} {
1232 global all_cols ui_other
1234 if {[catch {set r $all_cols($state)}]} {
1235 puts "error: no column for state={$state} $path"
1236 return $ui_other
1238 return $r
1241 proc mapicon {state path} {
1242 global all_icons
1244 if {[catch {set r $all_icons($state)}]} {
1245 puts "error: no icon for state={$state} $path"
1246 return file_plain
1248 return $r
1251 proc mapdesc {state path} {
1252 global all_descs
1254 if {[catch {set r $all_descs($state)}]} {
1255 puts "error: no desc for state={$state} $path"
1256 return $state
1258 return $r
1261 proc escape_path {path} {
1262 regsub -all "\n" $path "\\n" path
1263 return $path
1266 proc short_path {path} {
1267 return [escape_path [lindex [file split $path] end]]
1270 set next_icon_id 0
1271 set null_sha1 [string repeat 0 40]
1273 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1274 global file_states next_icon_id null_sha1
1276 set s0 [string index $new_state 0]
1277 set s1 [string index $new_state 1]
1279 if {[catch {set info $file_states($path)}]} {
1280 set state __
1281 set icon n[incr next_icon_id]
1282 } else {
1283 set state [lindex $info 0]
1284 set icon [lindex $info 1]
1285 if {$head_info eq {}} {set head_info [lindex $info 2]}
1286 if {$index_info eq {}} {set index_info [lindex $info 3]}
1289 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1290 elseif {$s0 eq {_}} {set s0 _}
1292 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1293 elseif {$s1 eq {_}} {set s1 _}
1295 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1296 set head_info [list 0 $null_sha1]
1297 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1298 && $head_info eq {}} {
1299 set head_info $index_info
1302 set file_states($path) [list $s0$s1 $icon \
1303 $head_info $index_info \
1305 return $state
1308 proc display_file {path state} {
1309 global file_states file_lists selected_paths
1311 set old_m [merge_state $path $state]
1312 set s $file_states($path)
1313 set new_m [lindex $s 0]
1314 set new_w [mapcol $new_m $path]
1315 set old_w [mapcol $old_m $path]
1316 set new_icon [mapicon $new_m $path]
1318 if {$new_m eq {__}} {
1319 set lno [lsearch -sorted $file_lists($old_w) $path]
1320 if {$lno >= 0} {
1321 set file_lists($old_w) \
1322 [lreplace $file_lists($old_w) $lno $lno]
1323 incr lno
1324 $old_w conf -state normal
1325 $old_w delete $lno.0 [expr {$lno + 1}].0
1326 $old_w conf -state disabled
1328 unset file_states($path)
1329 catch {unset selected_paths($path)}
1330 return
1333 if {$new_w ne $old_w} {
1334 set lno [lsearch -sorted $file_lists($old_w) $path]
1335 if {$lno >= 0} {
1336 set file_lists($old_w) \
1337 [lreplace $file_lists($old_w) $lno $lno]
1338 incr lno
1339 $old_w conf -state normal
1340 $old_w delete $lno.0 [expr {$lno + 1}].0
1341 $old_w conf -state disabled
1344 lappend file_lists($new_w) $path
1345 set file_lists($new_w) [lsort $file_lists($new_w)]
1346 set lno [lsearch -sorted $file_lists($new_w) $path]
1347 incr lno
1348 $new_w conf -state normal
1349 $new_w image create $lno.0 \
1350 -align center -padx 5 -pady 1 \
1351 -name [lindex $s 1] \
1352 -image $new_icon
1353 $new_w insert $lno.1 "[escape_path $path]\n"
1354 if {[catch {set in_sel $selected_paths($path)}]} {
1355 set in_sel 0
1357 if {$in_sel} {
1358 $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1360 $new_w conf -state disabled
1361 } elseif {$new_icon ne [mapicon $old_m $path]} {
1362 $new_w conf -state normal
1363 $new_w image conf [lindex $s 1] -image $new_icon
1364 $new_w conf -state disabled
1368 proc display_all_files {} {
1369 global ui_index ui_other
1370 global file_states file_lists
1371 global last_clicked selected_paths
1373 $ui_index conf -state normal
1374 $ui_other conf -state normal
1376 $ui_index delete 0.0 end
1377 $ui_other delete 0.0 end
1378 set last_clicked {}
1380 set file_lists($ui_index) [list]
1381 set file_lists($ui_other) [list]
1383 foreach path [lsort [array names file_states]] {
1384 set s $file_states($path)
1385 set m [lindex $s 0]
1386 set w [mapcol $m $path]
1387 lappend file_lists($w) $path
1388 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1389 $w image create end \
1390 -align center -padx 5 -pady 1 \
1391 -name [lindex $s 1] \
1392 -image [mapicon $m $path]
1393 $w insert end "[escape_path $path]\n"
1394 if {[catch {set in_sel $selected_paths($path)}]} {
1395 set in_sel 0
1397 if {$in_sel} {
1398 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1402 $ui_index conf -state disabled
1403 $ui_other conf -state disabled
1406 proc update_indexinfo {msg pathList after} {
1407 global update_index_cp ui_status_value
1409 if {![lock_index update]} return
1411 set update_index_cp 0
1412 set pathList [lsort $pathList]
1413 set totalCnt [llength $pathList]
1414 set batch [expr {int($totalCnt * .01) + 1}]
1415 if {$batch > 25} {set batch 25}
1417 set ui_status_value [format \
1418 "$msg... %i/%i files (%.2f%%)" \
1419 $update_index_cp \
1420 $totalCnt \
1421 0.0]
1422 set fd [open "| git update-index -z --index-info" w]
1423 fconfigure $fd \
1424 -blocking 0 \
1425 -buffering full \
1426 -buffersize 512 \
1427 -translation binary
1428 fileevent $fd writable [list \
1429 write_update_indexinfo \
1430 $fd \
1431 $pathList \
1432 $totalCnt \
1433 $batch \
1434 $msg \
1435 $after \
1439 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1440 global update_index_cp ui_status_value
1441 global file_states current_diff
1443 if {$update_index_cp >= $totalCnt} {
1444 close $fd
1445 unlock_index
1446 uplevel #0 $after
1447 return
1450 for {set i $batch} \
1451 {$update_index_cp < $totalCnt && $i > 0} \
1452 {incr i -1} {
1453 set path [lindex $pathList $update_index_cp]
1454 incr update_index_cp
1456 set s $file_states($path)
1457 switch -glob -- [lindex $s 0] {
1458 A? {set new _O}
1459 M? {set new _M}
1460 D_ {set new _D}
1461 D? {set new _?}
1462 ?? {continue}
1464 set info [lindex $s 2]
1465 if {$info eq {}} continue
1467 puts -nonewline $fd $info
1468 puts -nonewline $fd "\t"
1469 puts -nonewline $fd $path
1470 puts -nonewline $fd "\0"
1471 display_file $path $new
1474 set ui_status_value [format \
1475 "$msg... %i/%i files (%.2f%%)" \
1476 $update_index_cp \
1477 $totalCnt \
1478 [expr {100.0 * $update_index_cp / $totalCnt}]]
1481 proc update_index {msg pathList after} {
1482 global update_index_cp ui_status_value
1484 if {![lock_index update]} return
1486 set update_index_cp 0
1487 set pathList [lsort $pathList]
1488 set totalCnt [llength $pathList]
1489 set batch [expr {int($totalCnt * .01) + 1}]
1490 if {$batch > 25} {set batch 25}
1492 set ui_status_value [format \
1493 "$msg... %i/%i files (%.2f%%)" \
1494 $update_index_cp \
1495 $totalCnt \
1496 0.0]
1497 set fd [open "| git update-index --add --remove -z --stdin" w]
1498 fconfigure $fd \
1499 -blocking 0 \
1500 -buffering full \
1501 -buffersize 512 \
1502 -translation binary
1503 fileevent $fd writable [list \
1504 write_update_index \
1505 $fd \
1506 $pathList \
1507 $totalCnt \
1508 $batch \
1509 $msg \
1510 $after \
1514 proc write_update_index {fd pathList totalCnt batch msg after} {
1515 global update_index_cp ui_status_value
1516 global file_states current_diff
1518 if {$update_index_cp >= $totalCnt} {
1519 close $fd
1520 unlock_index
1521 uplevel #0 $after
1522 return
1525 for {set i $batch} \
1526 {$update_index_cp < $totalCnt && $i > 0} \
1527 {incr i -1} {
1528 set path [lindex $pathList $update_index_cp]
1529 incr update_index_cp
1531 switch -glob -- [lindex $file_states($path) 0] {
1532 AD -
1533 MD -
1534 UD -
1535 _D {set new DD}
1537 _M -
1538 MM -
1539 UM -
1540 U_ -
1541 M_ {set new M_}
1543 _O -
1544 AM -
1545 A_ {set new A_}
1547 ?? {continue}
1550 puts -nonewline $fd $path
1551 puts -nonewline $fd "\0"
1552 display_file $path $new
1555 set ui_status_value [format \
1556 "$msg... %i/%i files (%.2f%%)" \
1557 $update_index_cp \
1558 $totalCnt \
1559 [expr {100.0 * $update_index_cp / $totalCnt}]]
1562 proc checkout_index {msg pathList after} {
1563 global update_index_cp ui_status_value
1565 if {![lock_index update]} return
1567 set update_index_cp 0
1568 set pathList [lsort $pathList]
1569 set totalCnt [llength $pathList]
1570 set batch [expr {int($totalCnt * .01) + 1}]
1571 if {$batch > 25} {set batch 25}
1573 set ui_status_value [format \
1574 "$msg... %i/%i files (%.2f%%)" \
1575 $update_index_cp \
1576 $totalCnt \
1577 0.0]
1578 set cmd [list git checkout-index]
1579 lappend cmd --index
1580 lappend cmd --quiet
1581 lappend cmd --force
1582 lappend cmd -z
1583 lappend cmd --stdin
1584 set fd [open "| $cmd " w]
1585 fconfigure $fd \
1586 -blocking 0 \
1587 -buffering full \
1588 -buffersize 512 \
1589 -translation binary
1590 fileevent $fd writable [list \
1591 write_checkout_index \
1592 $fd \
1593 $pathList \
1594 $totalCnt \
1595 $batch \
1596 $msg \
1597 $after \
1601 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1602 global update_index_cp ui_status_value
1603 global file_states current_diff
1605 if {$update_index_cp >= $totalCnt} {
1606 close $fd
1607 unlock_index
1608 uplevel #0 $after
1609 return
1612 for {set i $batch} \
1613 {$update_index_cp < $totalCnt && $i > 0} \
1614 {incr i -1} {
1615 set path [lindex $pathList $update_index_cp]
1616 incr update_index_cp
1618 switch -glob -- [lindex $file_states($path) 0] {
1619 AM -
1620 AD {set new A_}
1621 MM -
1622 MD {set new M_}
1623 _M -
1624 _D {set new __}
1625 ?? {continue}
1628 puts -nonewline $fd $path
1629 puts -nonewline $fd "\0"
1630 display_file $path $new
1633 set ui_status_value [format \
1634 "$msg... %i/%i files (%.2f%%)" \
1635 $update_index_cp \
1636 $totalCnt \
1637 [expr {100.0 * $update_index_cp / $totalCnt}]]
1640 ######################################################################
1642 ## branch management
1644 proc load_all_heads {} {
1645 global all_heads tracking_branches
1647 set all_heads [list]
1648 set cmd [list git for-each-ref]
1649 lappend cmd --format=%(refname)
1650 lappend cmd refs/heads
1651 set fd [open "| $cmd" r]
1652 while {[gets $fd line] > 0} {
1653 if {![catch {set info $tracking_branches($line)}]} continue
1654 if {![regsub ^refs/heads/ $line {} name]} continue
1655 lappend all_heads $name
1657 close $fd
1659 set all_heads [lsort $all_heads]
1662 proc populate_branch_menu {m} {
1663 global all_heads disable_on_lock
1665 $m add separator
1666 foreach b $all_heads {
1667 $m add radiobutton \
1668 -label $b \
1669 -command [list switch_branch $b] \
1670 -variable current_branch \
1671 -value $b \
1672 -font font_ui
1673 lappend disable_on_lock \
1674 [list $m entryconf [$m index last] -state]
1678 proc do_create_branch {} {
1679 error "NOT IMPLEMENTED"
1682 proc do_delete_branch {} {
1683 error "NOT IMPLEMENTED"
1686 proc switch_branch {b} {
1687 global HEAD commit_type file_states current_branch
1688 global selected_commit_type ui_comm
1690 if {![lock_index switch]} return
1692 # -- Backup the selected branch (repository_state resets it)
1694 set new_branch $current_branch
1696 # -- Our in memory state should match the repository.
1698 repository_state curType curHEAD curMERGE_HEAD
1699 if {[string match amend* $commit_type]
1700 && $curType eq {normal}
1701 && $curHEAD eq $HEAD} {
1702 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1703 info_popup {Last scanned state does not match repository state.
1705 Another Git program has modified this repository
1706 since the last scan. A rescan must be performed
1707 before the current branch can be changed.
1709 The rescan will be automatically started now.
1711 unlock_index
1712 rescan {set ui_status_value {Ready.}}
1713 return
1716 # -- Toss the message buffer if we are in amend mode.
1718 if {[string match amend* $curType]} {
1719 $ui_comm delete 0.0 end
1720 $ui_comm edit reset
1721 $ui_comm edit modified false
1724 set selected_commit_type new
1725 set current_branch $new_branch
1727 unlock_index
1728 error "NOT FINISHED"
1731 ######################################################################
1733 ## remote management
1735 proc load_all_remotes {} {
1736 global gitdir repo_config
1737 global all_remotes tracking_branches
1739 set all_remotes [list]
1740 array unset tracking_branches
1742 set rm_dir [file join $gitdir remotes]
1743 if {[file isdirectory $rm_dir]} {
1744 set all_remotes [glob \
1745 -types f \
1746 -tails \
1747 -nocomplain \
1748 -directory $rm_dir *]
1750 foreach name $all_remotes {
1751 catch {
1752 set fd [open [file join $rm_dir $name] r]
1753 while {[gets $fd line] >= 0} {
1754 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
1755 $line line src dst]} continue
1756 if {![regexp ^refs/ $dst]} {
1757 set dst "refs/heads/$dst"
1759 set tracking_branches($dst) [list $name $src]
1761 close $fd
1766 foreach line [array names repo_config remote.*.url] {
1767 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
1768 lappend all_remotes $name
1770 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
1771 set fl {}
1773 foreach line $fl {
1774 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
1775 if {![regexp ^refs/ $dst]} {
1776 set dst "refs/heads/$dst"
1778 set tracking_branches($dst) [list $name $src]
1782 set all_remotes [lsort -unique $all_remotes]
1785 proc populate_fetch_menu {m} {
1786 global gitdir all_remotes repo_config
1788 foreach r $all_remotes {
1789 set enable 0
1790 if {![catch {set a $repo_config(remote.$r.url)}]} {
1791 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1792 set enable 1
1794 } else {
1795 catch {
1796 set fd [open [file join $gitdir remotes $r] r]
1797 while {[gets $fd n] >= 0} {
1798 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1799 set enable 1
1800 break
1803 close $fd
1807 if {$enable} {
1808 $m add command \
1809 -label "Fetch from $r..." \
1810 -command [list fetch_from $r] \
1811 -font font_ui
1816 proc populate_push_menu {m} {
1817 global gitdir all_remotes repo_config
1819 foreach r $all_remotes {
1820 set enable 0
1821 if {![catch {set a $repo_config(remote.$r.url)}]} {
1822 if {![catch {set a $repo_config(remote.$r.push)}]} {
1823 set enable 1
1825 } else {
1826 catch {
1827 set fd [open [file join $gitdir remotes $r] r]
1828 while {[gets $fd n] >= 0} {
1829 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1830 set enable 1
1831 break
1834 close $fd
1838 if {$enable} {
1839 $m add command \
1840 -label "Push to $r..." \
1841 -command [list push_to $r] \
1842 -font font_ui
1847 proc populate_pull_menu {m} {
1848 global gitdir repo_config all_remotes disable_on_lock
1850 foreach remote $all_remotes {
1851 set rb_list [list]
1852 if {[array get repo_config remote.$remote.url] ne {}} {
1853 if {[array get repo_config remote.$remote.fetch] ne {}} {
1854 foreach line $repo_config(remote.$remote.fetch) {
1855 if {[regexp {^([^:]+):} $line line rb]} {
1856 lappend rb_list $rb
1860 } else {
1861 catch {
1862 set fd [open [file join $gitdir remotes $remote] r]
1863 while {[gets $fd line] >= 0} {
1864 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1865 lappend rb_list $rb
1868 close $fd
1872 foreach rb $rb_list {
1873 regsub ^refs/heads/ $rb {} rb_short
1874 $m add command \
1875 -label "Branch $rb_short from $remote..." \
1876 -command [list pull_remote $remote $rb] \
1877 -font font_ui
1878 lappend disable_on_lock \
1879 [list $m entryconf [$m index last] -state]
1884 ######################################################################
1886 ## icons
1888 set filemask {
1889 #define mask_width 14
1890 #define mask_height 15
1891 static unsigned char mask_bits[] = {
1892 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1893 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1894 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1897 image create bitmap file_plain -background white -foreground black -data {
1898 #define plain_width 14
1899 #define plain_height 15
1900 static unsigned char plain_bits[] = {
1901 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1902 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1903 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1904 } -maskdata $filemask
1906 image create bitmap file_mod -background white -foreground blue -data {
1907 #define mod_width 14
1908 #define mod_height 15
1909 static unsigned char mod_bits[] = {
1910 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1911 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1912 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1913 } -maskdata $filemask
1915 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1916 #define file_fulltick_width 14
1917 #define file_fulltick_height 15
1918 static unsigned char file_fulltick_bits[] = {
1919 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1920 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1921 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1922 } -maskdata $filemask
1924 image create bitmap file_parttick -background white -foreground "#005050" -data {
1925 #define parttick_width 14
1926 #define parttick_height 15
1927 static unsigned char parttick_bits[] = {
1928 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1929 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1930 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1931 } -maskdata $filemask
1933 image create bitmap file_question -background white -foreground black -data {
1934 #define file_question_width 14
1935 #define file_question_height 15
1936 static unsigned char file_question_bits[] = {
1937 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1938 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1939 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1940 } -maskdata $filemask
1942 image create bitmap file_removed -background white -foreground red -data {
1943 #define file_removed_width 14
1944 #define file_removed_height 15
1945 static unsigned char file_removed_bits[] = {
1946 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1947 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1948 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1949 } -maskdata $filemask
1951 image create bitmap file_merge -background white -foreground blue -data {
1952 #define file_merge_width 14
1953 #define file_merge_height 15
1954 static unsigned char file_merge_bits[] = {
1955 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1956 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1957 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1958 } -maskdata $filemask
1960 set ui_index .vpane.files.index.list
1961 set ui_other .vpane.files.other.list
1962 set max_status_desc 0
1963 foreach i {
1964 {__ i plain "Unmodified"}
1965 {_M i mod "Modified"}
1966 {M_ i fulltick "Added to commit"}
1967 {MM i parttick "Partially included"}
1968 {MD i question "Added (but gone)"}
1970 {_O o plain "Untracked"}
1971 {A_ o fulltick "Added by commit"}
1972 {AM o parttick "Partially added"}
1973 {AD o question "Added (but gone)"}
1975 {_D i question "Missing"}
1976 {DD i removed "Removed by commit"}
1977 {D_ i removed "Removed by commit"}
1978 {DO i removed "Removed (still exists)"}
1979 {DM i removed "Removed (but modified)"}
1981 {UD i merge "Merge conflicts"}
1982 {UM i merge "Merge conflicts"}
1983 {U_ i merge "Merge conflicts"}
1985 if {$max_status_desc < [string length [lindex $i 3]]} {
1986 set max_status_desc [string length [lindex $i 3]]
1988 if {[lindex $i 1] eq {i}} {
1989 set all_cols([lindex $i 0]) $ui_index
1990 } else {
1991 set all_cols([lindex $i 0]) $ui_other
1993 set all_icons([lindex $i 0]) file_[lindex $i 2]
1994 set all_descs([lindex $i 0]) [lindex $i 3]
1996 unset filemask i
1998 ######################################################################
2000 ## util
2002 proc is_MacOSX {} {
2003 global tcl_platform tk_library
2004 if {[tk windowingsystem] eq {aqua}} {
2005 return 1
2007 return 0
2010 proc is_Windows {} {
2011 global tcl_platform
2012 if {$tcl_platform(platform) eq {windows}} {
2013 return 1
2015 return 0
2018 proc bind_button3 {w cmd} {
2019 bind $w <Any-Button-3> $cmd
2020 if {[is_MacOSX]} {
2021 bind $w <Control-Button-1> $cmd
2025 proc incr_font_size {font {amt 1}} {
2026 set sz [font configure $font -size]
2027 incr sz $amt
2028 font configure $font -size $sz
2029 font configure ${font}bold -size $sz
2032 proc hook_failed_popup {hook msg} {
2033 global gitdir appname
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 ([lindex [file split \
2073 [file normalize [file dirname $gitdir]]] \
2074 end]): error"
2075 tkwait window $w
2078 set next_console_id 0
2080 proc new_console {short_title long_title} {
2081 global next_console_id console_data
2082 set w .console[incr next_console_id]
2083 set console_data($w) [list $short_title $long_title]
2084 return [console_init $w]
2087 proc console_init {w} {
2088 global console_cr console_data
2089 global gitdir appname M1B
2091 set console_cr($w) 1.0
2092 toplevel $w
2093 frame $w.m
2094 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2095 -anchor w \
2096 -justify left \
2097 -font font_uibold
2098 text $w.m.t \
2099 -background white -borderwidth 1 \
2100 -relief sunken \
2101 -width 80 -height 10 \
2102 -font font_diff \
2103 -state disabled \
2104 -yscrollcommand [list $w.m.sby set]
2105 label $w.m.s -text {Working... please wait...} \
2106 -anchor w \
2107 -justify left \
2108 -font font_uibold
2109 scrollbar $w.m.sby -command [list $w.m.t yview]
2110 pack $w.m.l1 -side top -fill x
2111 pack $w.m.s -side bottom -fill x
2112 pack $w.m.sby -side right -fill y
2113 pack $w.m.t -side left -fill both -expand 1
2114 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2116 menu $w.ctxm -tearoff 0
2117 $w.ctxm add command -label "Copy" \
2118 -font font_ui \
2119 -command "tk_textCopy $w.m.t"
2120 $w.ctxm add command -label "Select All" \
2121 -font font_ui \
2122 -command "$w.m.t tag add sel 0.0 end"
2123 $w.ctxm add command -label "Copy All" \
2124 -font font_ui \
2125 -command "
2126 $w.m.t tag add sel 0.0 end
2127 tk_textCopy $w.m.t
2128 $w.m.t tag remove sel 0.0 end
2131 button $w.ok -text {Close} \
2132 -font font_ui \
2133 -state disabled \
2134 -command "destroy $w"
2135 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2137 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2138 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2139 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2140 bind $w <Visibility> "focus $w"
2141 wm title $w "$appname ([lindex [file split \
2142 [file normalize [file dirname $gitdir]]] \
2143 end]): [lindex $console_data($w) 0]"
2144 return $w
2147 proc console_exec {w cmd {after {}}} {
2148 # -- Windows tosses the enviroment when we exec our child.
2149 # But most users need that so we have to relogin. :-(
2151 if {[is_Windows]} {
2152 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2155 # -- Tcl won't let us redirect both stdout and stderr to
2156 # the same pipe. So pass it through cat...
2158 set cmd [concat | $cmd |& cat]
2160 set fd_f [open $cmd r]
2161 fconfigure $fd_f -blocking 0 -translation binary
2162 fileevent $fd_f readable [list console_read $w $fd_f $after]
2165 proc console_read {w fd after} {
2166 global console_cr console_data
2168 set buf [read $fd]
2169 if {$buf ne {}} {
2170 if {![winfo exists $w]} {console_init $w}
2171 $w.m.t conf -state normal
2172 set c 0
2173 set n [string length $buf]
2174 while {$c < $n} {
2175 set cr [string first "\r" $buf $c]
2176 set lf [string first "\n" $buf $c]
2177 if {$cr < 0} {set cr [expr {$n + 1}]}
2178 if {$lf < 0} {set lf [expr {$n + 1}]}
2180 if {$lf < $cr} {
2181 $w.m.t insert end [string range $buf $c $lf]
2182 set console_cr($w) [$w.m.t index {end -1c}]
2183 set c $lf
2184 incr c
2185 } else {
2186 $w.m.t delete $console_cr($w) end
2187 $w.m.t insert end "\n"
2188 $w.m.t insert end [string range $buf $c $cr]
2189 set c $cr
2190 incr c
2193 $w.m.t conf -state disabled
2194 $w.m.t see end
2197 fconfigure $fd -blocking 1
2198 if {[eof $fd]} {
2199 if {[catch {close $fd}]} {
2200 if {![winfo exists $w]} {console_init $w}
2201 $w.m.s conf -background red -text {Error: Command Failed}
2202 $w.ok conf -state normal
2203 set ok 0
2204 } elseif {[winfo exists $w]} {
2205 $w.m.s conf -background green -text {Success}
2206 $w.ok conf -state normal
2207 set ok 1
2209 array unset console_cr $w
2210 array unset console_data $w
2211 if {$after ne {}} {
2212 uplevel #0 $after $ok
2214 return
2216 fconfigure $fd -blocking 0
2219 ######################################################################
2221 ## ui commands
2223 set starting_gitk_msg {Please wait... Starting gitk...}
2225 proc do_gitk {revs} {
2226 global ui_status_value starting_gitk_msg
2228 set cmd gitk
2229 if {$revs ne {}} {
2230 append cmd { }
2231 append cmd $revs
2233 if {[is_Windows]} {
2234 set cmd "sh -c \"exec $cmd\""
2236 append cmd { &}
2238 if {[catch {eval exec $cmd} err]} {
2239 error_popup "Failed to start gitk:\n\n$err"
2240 } else {
2241 set ui_status_value $starting_gitk_msg
2242 after 10000 {
2243 if {$ui_status_value eq $starting_gitk_msg} {
2244 set ui_status_value {Ready.}
2250 proc do_gc {} {
2251 set w [new_console {gc} {Compressing the object database}]
2252 console_exec $w {git gc}
2255 proc do_fsck_objects {} {
2256 set w [new_console {fsck-objects} \
2257 {Verifying the object database with fsck-objects}]
2258 set cmd [list git fsck-objects]
2259 lappend cmd --full
2260 lappend cmd --cache
2261 lappend cmd --strict
2262 console_exec $w $cmd
2265 set is_quitting 0
2267 proc do_quit {} {
2268 global gitdir ui_comm is_quitting repo_config commit_type
2270 if {$is_quitting} return
2271 set is_quitting 1
2273 # -- Stash our current commit buffer.
2275 set save [file join $gitdir GITGUI_MSG]
2276 set msg [string trim [$ui_comm get 0.0 end]]
2277 if {![string match amend* $commit_type]
2278 && [$ui_comm edit modified]
2279 && $msg ne {}} {
2280 catch {
2281 set fd [open $save w]
2282 puts $fd [string trim [$ui_comm get 0.0 end]]
2283 close $fd
2285 } else {
2286 catch {file delete $save}
2289 # -- Stash our current window geometry into this repository.
2291 set cfg_geometry [list]
2292 lappend cfg_geometry [wm geometry .]
2293 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2294 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2295 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2296 set rc_geometry {}
2298 if {$cfg_geometry ne $rc_geometry} {
2299 catch {exec git repo-config gui.geometry $cfg_geometry}
2302 destroy .
2305 proc do_rescan {} {
2306 rescan {set ui_status_value {Ready.}}
2309 proc remove_helper {txt paths} {
2310 global file_states current_diff
2312 if {![lock_index begin-update]} return
2314 set pathList [list]
2315 set after {}
2316 foreach path $paths {
2317 switch -glob -- [lindex $file_states($path) 0] {
2318 A? -
2319 M? -
2320 D? {
2321 lappend pathList $path
2322 if {$path eq $current_diff} {
2323 set after {reshow_diff;}
2328 if {$pathList eq {}} {
2329 unlock_index
2330 } else {
2331 update_indexinfo \
2332 $txt \
2333 $pathList \
2334 [concat $after {set ui_status_value {Ready.}}]
2338 proc do_remove_selection {} {
2339 global current_diff selected_paths
2341 if {[array size selected_paths] > 0} {
2342 remove_helper \
2343 {Removing selected files from commit} \
2344 [array names selected_paths]
2345 } elseif {$current_diff ne {}} {
2346 remove_helper \
2347 "Removing [short_path $current_diff] from commit" \
2348 [list $current_diff]
2352 proc include_helper {txt paths} {
2353 global file_states current_diff
2355 if {![lock_index begin-update]} return
2357 set pathList [list]
2358 set after {}
2359 foreach path $paths {
2360 switch -glob -- [lindex $file_states($path) 0] {
2361 AM -
2362 AD -
2363 MM -
2364 MD -
2365 U? -
2366 _M -
2367 _D -
2368 _O {
2369 lappend pathList $path
2370 if {$path eq $current_diff} {
2371 set after {reshow_diff;}
2376 if {$pathList eq {}} {
2377 unlock_index
2378 } else {
2379 update_index \
2380 $txt \
2381 $pathList \
2382 [concat $after {set ui_status_value {Ready to commit.}}]
2386 proc do_include_selection {} {
2387 global current_diff selected_paths
2389 if {[array size selected_paths] > 0} {
2390 include_helper \
2391 {Adding selected files} \
2392 [array names selected_paths]
2393 } elseif {$current_diff ne {}} {
2394 include_helper \
2395 "Adding [short_path $current_diff]" \
2396 [list $current_diff]
2400 proc do_include_all {} {
2401 global file_states
2403 set paths [list]
2404 foreach path [array names file_states] {
2405 switch -- [lindex $file_states($path) 0] {
2406 AM -
2407 AD -
2408 MM -
2409 MD -
2410 _M -
2411 _D {lappend paths $path}
2414 include_helper \
2415 {Adding all modified files} \
2416 $paths
2419 proc revert_helper {txt paths} {
2420 global gitdir appname
2421 global file_states current_diff
2423 if {![lock_index begin-update]} return
2425 set pathList [list]
2426 set after {}
2427 foreach path $paths {
2428 switch -glob -- [lindex $file_states($path) 0] {
2429 AM -
2430 AD -
2431 MM -
2432 MD -
2433 _M -
2434 _D {
2435 lappend pathList $path
2436 if {$path eq $current_diff} {
2437 set after {reshow_diff;}
2443 set n [llength $pathList]
2444 if {$n == 0} {
2445 unlock_index
2446 return
2447 } elseif {$n == 1} {
2448 set s "[short_path [lindex $pathList]]"
2449 } else {
2450 set s "these $n files"
2453 set reponame [lindex [file split \
2454 [file normalize [file dirname $gitdir]]] \
2455 end]
2457 set reply [tk_dialog \
2458 .confirm_revert \
2459 "$appname ($reponame)" \
2460 "Revert changes in $s?
2462 Any unadded changes will be permanently lost by the revert." \
2463 question \
2465 {Do Nothing} \
2466 {Revert Changes} \
2468 if {$reply == 1} {
2469 checkout_index \
2470 $txt \
2471 $pathList \
2472 [concat $after {set ui_status_value {Ready.}}]
2473 } else {
2474 unlock_index
2478 proc do_revert_selection {} {
2479 global current_diff selected_paths
2481 if {[array size selected_paths] > 0} {
2482 revert_helper \
2483 {Reverting selected files} \
2484 [array names selected_paths]
2485 } elseif {$current_diff ne {}} {
2486 revert_helper \
2487 "Reverting [short_path $current_diff]" \
2488 [list $current_diff]
2492 proc do_signoff {} {
2493 global ui_comm
2495 set me [committer_ident]
2496 if {$me eq {}} return
2498 set sob "Signed-off-by: $me"
2499 set last [$ui_comm get {end -1c linestart} {end -1c}]
2500 if {$last ne $sob} {
2501 $ui_comm edit separator
2502 if {$last ne {}
2503 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2504 $ui_comm insert end "\n"
2506 $ui_comm insert end "\n$sob"
2507 $ui_comm edit separator
2508 $ui_comm see end
2512 proc do_select_commit_type {} {
2513 global commit_type selected_commit_type
2515 if {$selected_commit_type eq {new}
2516 && [string match amend* $commit_type]} {
2517 create_new_commit
2518 } elseif {$selected_commit_type eq {amend}
2519 && ![string match amend* $commit_type]} {
2520 load_last_commit
2522 # The amend request was rejected...
2524 if {![string match amend* $commit_type]} {
2525 set selected_commit_type new
2530 proc do_commit {} {
2531 commit_tree
2534 proc do_about {} {
2535 global appname appvers copyright
2536 global tcl_patchLevel tk_patchLevel
2538 set w .about_dialog
2539 toplevel $w
2540 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2542 label $w.header -text "About $appname" \
2543 -font font_uibold
2544 pack $w.header -side top -fill x
2546 frame $w.buttons
2547 button $w.buttons.close -text {Close} \
2548 -font font_ui \
2549 -command [list destroy $w]
2550 pack $w.buttons.close -side right
2551 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2553 label $w.desc \
2554 -text "$appname - a commit creation tool for Git.
2555 $copyright" \
2556 -padx 5 -pady 5 \
2557 -justify left \
2558 -anchor w \
2559 -borderwidth 1 \
2560 -relief solid \
2561 -font font_ui
2562 pack $w.desc -side top -fill x -padx 5 -pady 5
2564 set v {}
2565 append v "$appname version $appvers\n"
2566 append v "[exec git version]\n"
2567 append v "\n"
2568 if {$tcl_patchLevel eq $tk_patchLevel} {
2569 append v "Tcl/Tk version $tcl_patchLevel"
2570 } else {
2571 append v "Tcl version $tcl_patchLevel"
2572 append v ", Tk version $tk_patchLevel"
2575 label $w.vers \
2576 -text $v \
2577 -padx 5 -pady 5 \
2578 -justify left \
2579 -anchor w \
2580 -borderwidth 1 \
2581 -relief solid \
2582 -font font_ui
2583 pack $w.vers -side top -fill x -padx 5 -pady 5
2585 menu $w.ctxm -tearoff 0
2586 $w.ctxm add command \
2587 -label {Copy} \
2588 -font font_ui \
2589 -command "
2590 clipboard clear
2591 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2594 bind $w <Visibility> "grab $w; focus $w"
2595 bind $w <Key-Escape> "destroy $w"
2596 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2597 wm title $w "About $appname"
2598 tkwait window $w
2601 proc do_options {} {
2602 global appname gitdir font_descs
2603 global repo_config global_config
2604 global repo_config_new global_config_new
2606 array unset repo_config_new
2607 array unset global_config_new
2608 foreach name [array names repo_config] {
2609 set repo_config_new($name) $repo_config($name)
2611 load_config 1
2612 foreach name [array names repo_config] {
2613 switch -- $name {
2614 gui.diffcontext {continue}
2616 set repo_config_new($name) $repo_config($name)
2618 foreach name [array names global_config] {
2619 set global_config_new($name) $global_config($name)
2621 set reponame [lindex [file split \
2622 [file normalize [file dirname $gitdir]]] \
2623 end]
2625 set w .options_editor
2626 toplevel $w
2627 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2629 label $w.header -text "$appname Options" \
2630 -font font_uibold
2631 pack $w.header -side top -fill x
2633 frame $w.buttons
2634 button $w.buttons.restore -text {Restore Defaults} \
2635 -font font_ui \
2636 -command do_restore_defaults
2637 pack $w.buttons.restore -side left
2638 button $w.buttons.save -text Save \
2639 -font font_ui \
2640 -command [list do_save_config $w]
2641 pack $w.buttons.save -side right
2642 button $w.buttons.cancel -text {Cancel} \
2643 -font font_ui \
2644 -command [list destroy $w]
2645 pack $w.buttons.cancel -side right
2646 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2648 labelframe $w.repo -text "$reponame Repository" \
2649 -font font_ui \
2650 -relief raised -borderwidth 2
2651 labelframe $w.global -text {Global (All Repositories)} \
2652 -font font_ui \
2653 -relief raised -borderwidth 2
2654 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2655 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2657 foreach option {
2658 {b partialinclude {Allow Partially Added Files}}
2659 {b pullsummary {Show Pull Summary}}
2660 {b trustmtime {Trust File Modification Timestamps}}
2661 {i diffcontext {Number of Diff Context Lines}}
2663 set type [lindex $option 0]
2664 set name [lindex $option 1]
2665 set text [lindex $option 2]
2666 foreach f {repo global} {
2667 switch $type {
2669 checkbutton $w.$f.$name -text $text \
2670 -variable ${f}_config_new(gui.$name) \
2671 -onvalue true \
2672 -offvalue false \
2673 -font font_ui
2674 pack $w.$f.$name -side top -anchor w
2677 frame $w.$f.$name
2678 label $w.$f.$name.l -text "$text:" -font font_ui
2679 pack $w.$f.$name.l -side left -anchor w -fill x
2680 spinbox $w.$f.$name.v \
2681 -textvariable ${f}_config_new(gui.$name) \
2682 -from 1 -to 99 -increment 1 \
2683 -width 3 \
2684 -font font_ui
2685 pack $w.$f.$name.v -side right -anchor e
2686 pack $w.$f.$name -side top -anchor w -fill x
2692 set all_fonts [lsort [font families]]
2693 foreach option $font_descs {
2694 set name [lindex $option 0]
2695 set font [lindex $option 1]
2696 set text [lindex $option 2]
2698 set global_config_new(gui.$font^^family) \
2699 [font configure $font -family]
2700 set global_config_new(gui.$font^^size) \
2701 [font configure $font -size]
2703 frame $w.global.$name
2704 label $w.global.$name.l -text "$text:" -font font_ui
2705 pack $w.global.$name.l -side left -anchor w -fill x
2706 eval tk_optionMenu $w.global.$name.family \
2707 global_config_new(gui.$font^^family) \
2708 $all_fonts
2709 spinbox $w.global.$name.size \
2710 -textvariable global_config_new(gui.$font^^size) \
2711 -from 2 -to 80 -increment 1 \
2712 -width 3 \
2713 -font font_ui
2714 pack $w.global.$name.size -side right -anchor e
2715 pack $w.global.$name.family -side right -anchor e
2716 pack $w.global.$name -side top -anchor w -fill x
2719 bind $w <Visibility> "grab $w; focus $w"
2720 bind $w <Key-Escape> "destroy $w"
2721 wm title $w "$appname ($reponame): Options"
2722 tkwait window $w
2725 proc do_restore_defaults {} {
2726 global font_descs default_config repo_config
2727 global repo_config_new global_config_new
2729 foreach name [array names default_config] {
2730 set repo_config_new($name) $default_config($name)
2731 set global_config_new($name) $default_config($name)
2734 foreach option $font_descs {
2735 set name [lindex $option 0]
2736 set repo_config(gui.$name) $default_config(gui.$name)
2738 apply_config
2740 foreach option $font_descs {
2741 set name [lindex $option 0]
2742 set font [lindex $option 1]
2743 set global_config_new(gui.$font^^family) \
2744 [font configure $font -family]
2745 set global_config_new(gui.$font^^size) \
2746 [font configure $font -size]
2750 proc do_save_config {w} {
2751 if {[catch {save_config} err]} {
2752 error_popup "Failed to completely save options:\n\n$err"
2754 reshow_diff
2755 destroy $w
2758 proc do_windows_shortcut {} {
2759 global gitdir appname argv0
2761 set reponame [lindex [file split \
2762 [file normalize [file dirname $gitdir]]] \
2763 end]
2765 if {[catch {
2766 set desktop [exec cygpath \
2767 --windows \
2768 --absolute \
2769 --long-name \
2770 --desktop]
2771 }]} {
2772 set desktop .
2774 set fn [tk_getSaveFile \
2775 -parent . \
2776 -title "$appname ($reponame): Create Desktop Icon" \
2777 -initialdir $desktop \
2778 -initialfile "Git $reponame.bat"]
2779 if {$fn != {}} {
2780 if {[catch {
2781 set fd [open $fn w]
2782 set sh [exec cygpath \
2783 --windows \
2784 --absolute \
2785 /bin/sh]
2786 set me [exec cygpath \
2787 --unix \
2788 --absolute \
2789 $argv0]
2790 set gd [exec cygpath \
2791 --unix \
2792 --absolute \
2793 $gitdir]
2794 regsub -all ' $me "'\\''" me
2795 regsub -all ' $gd "'\\''" gd
2796 puts $fd "@ECHO Starting git-gui... Please wait..."
2797 puts -nonewline $fd "@\"$sh\" --login -c \""
2798 puts -nonewline $fd "GIT_DIR='$gd'"
2799 puts -nonewline $fd " '$me'"
2800 puts $fd "&\""
2801 close $fd
2802 } err]} {
2803 error_popup "Cannot write script:\n\n$err"
2808 proc do_macosx_app {} {
2809 global gitdir appname argv0 env
2811 set reponame [lindex [file split \
2812 [file normalize [file dirname $gitdir]]] \
2813 end]
2815 set fn [tk_getSaveFile \
2816 -parent . \
2817 -title "$appname ($reponame): Create Desktop Icon" \
2818 -initialdir [file join $env(HOME) Desktop] \
2819 -initialfile "Git $reponame.app"]
2820 if {$fn != {}} {
2821 if {[catch {
2822 set Contents [file join $fn Contents]
2823 set MacOS [file join $Contents MacOS]
2824 set exe [file join $MacOS git-gui]
2826 file mkdir $MacOS
2828 set fd [open [file join $Contents Info.plist] w]
2829 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2830 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2831 <plist version="1.0">
2832 <dict>
2833 <key>CFBundleDevelopmentRegion</key>
2834 <string>English</string>
2835 <key>CFBundleExecutable</key>
2836 <string>git-gui</string>
2837 <key>CFBundleIdentifier</key>
2838 <string>org.spearce.git-gui</string>
2839 <key>CFBundleInfoDictionaryVersion</key>
2840 <string>6.0</string>
2841 <key>CFBundlePackageType</key>
2842 <string>APPL</string>
2843 <key>CFBundleSignature</key>
2844 <string>????</string>
2845 <key>CFBundleVersion</key>
2846 <string>1.0</string>
2847 <key>NSPrincipalClass</key>
2848 <string>NSApplication</string>
2849 </dict>
2850 </plist>}
2851 close $fd
2853 set fd [open $exe w]
2854 set gd [file normalize $gitdir]
2855 set ep [file normalize [exec git --exec-path]]
2856 regsub -all ' $gd "'\\''" gd
2857 regsub -all ' $ep "'\\''" ep
2858 puts $fd "#!/bin/sh"
2859 foreach name [array names env] {
2860 if {[string match GIT_* $name]} {
2861 regsub -all ' $env($name) "'\\''" v
2862 puts $fd "export $name='$v'"
2865 puts $fd "export PATH='$ep':\$PATH"
2866 puts $fd "export GIT_DIR='$gd'"
2867 puts $fd "exec [file normalize $argv0]"
2868 close $fd
2870 file attributes $exe -permissions u+x,g+x,o+x
2871 } err]} {
2872 error_popup "Cannot write icon:\n\n$err"
2877 proc toggle_or_diff {w x y} {
2878 global file_states file_lists current_diff ui_index ui_other
2879 global last_clicked selected_paths
2881 set pos [split [$w index @$x,$y] .]
2882 set lno [lindex $pos 0]
2883 set col [lindex $pos 1]
2884 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2885 if {$path eq {}} {
2886 set last_clicked {}
2887 return
2890 set last_clicked [list $w $lno]
2891 array unset selected_paths
2892 $ui_index tag remove in_sel 0.0 end
2893 $ui_other tag remove in_sel 0.0 end
2895 if {$col == 0} {
2896 if {$current_diff eq $path} {
2897 set after {reshow_diff;}
2898 } else {
2899 set after {}
2901 switch -glob -- [lindex $file_states($path) 0] {
2902 A_ -
2903 M_ -
2904 DD -
2905 DO -
2906 DM {
2907 update_indexinfo \
2908 "Removing [short_path $path] from commit" \
2909 [list $path] \
2910 [concat $after {set ui_status_value {Ready.}}]
2912 ?? {
2913 update_index \
2914 "Adding [short_path $path]" \
2915 [list $path] \
2916 [concat $after {set ui_status_value {Ready.}}]
2919 } else {
2920 show_diff $path $w $lno
2924 proc add_one_to_selection {w x y} {
2925 global file_lists
2926 global last_clicked selected_paths
2928 set pos [split [$w index @$x,$y] .]
2929 set lno [lindex $pos 0]
2930 set col [lindex $pos 1]
2931 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2932 if {$path eq {}} {
2933 set last_clicked {}
2934 return
2937 set last_clicked [list $w $lno]
2938 if {[catch {set in_sel $selected_paths($path)}]} {
2939 set in_sel 0
2941 if {$in_sel} {
2942 unset selected_paths($path)
2943 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2944 } else {
2945 set selected_paths($path) 1
2946 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2950 proc add_range_to_selection {w x y} {
2951 global file_lists
2952 global last_clicked selected_paths
2954 if {[lindex $last_clicked 0] ne $w} {
2955 toggle_or_diff $w $x $y
2956 return
2959 set pos [split [$w index @$x,$y] .]
2960 set lno [lindex $pos 0]
2961 set lc [lindex $last_clicked 1]
2962 if {$lc < $lno} {
2963 set begin $lc
2964 set end $lno
2965 } else {
2966 set begin $lno
2967 set end $lc
2970 foreach path [lrange $file_lists($w) \
2971 [expr {$begin - 1}] \
2972 [expr {$end - 1}]] {
2973 set selected_paths($path) 1
2975 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2978 ######################################################################
2980 ## config defaults
2982 set cursor_ptr arrow
2983 font create font_diff -family Courier -size 10
2984 font create font_ui
2985 catch {
2986 label .dummy
2987 eval font configure font_ui [font actual [.dummy cget -font]]
2988 destroy .dummy
2991 font create font_uibold
2992 font create font_diffbold
2994 if {[is_Windows]} {
2995 set M1B Control
2996 set M1T Ctrl
2997 } elseif {[is_MacOSX]} {
2998 set M1B M1
2999 set M1T Cmd
3000 } else {
3001 set M1B M1
3002 set M1T M1
3005 proc apply_config {} {
3006 global repo_config font_descs
3008 foreach option $font_descs {
3009 set name [lindex $option 0]
3010 set font [lindex $option 1]
3011 if {[catch {
3012 foreach {cn cv} $repo_config(gui.$name) {
3013 font configure $font $cn $cv
3015 } err]} {
3016 error_popup "Invalid font specified in gui.$name:\n\n$err"
3018 foreach {cn cv} [font configure $font] {
3019 font configure ${font}bold $cn $cv
3021 font configure ${font}bold -weight bold
3025 set default_config(gui.trustmtime) false
3026 set default_config(gui.pullsummary) true
3027 set default_config(gui.partialinclude) false
3028 set default_config(gui.diffcontext) 5
3029 set default_config(gui.fontui) [font configure font_ui]
3030 set default_config(gui.fontdiff) [font configure font_diff]
3031 set font_descs {
3032 {fontui font_ui {Main Font}}
3033 {fontdiff font_diff {Diff/Console Font}}
3035 load_config 0
3036 apply_config
3038 ######################################################################
3040 ## ui construction
3042 # -- Menu Bar
3044 menu .mbar -tearoff 0
3045 .mbar add cascade -label Repository -menu .mbar.repository
3046 .mbar add cascade -label Edit -menu .mbar.edit
3047 if {!$single_commit} {
3048 .mbar add cascade -label Branch -menu .mbar.branch
3050 .mbar add cascade -label Commit -menu .mbar.commit
3051 if {!$single_commit} {
3052 .mbar add cascade -label Fetch -menu .mbar.fetch
3053 .mbar add cascade -label Pull -menu .mbar.pull
3054 .mbar add cascade -label Push -menu .mbar.push
3056 . configure -menu .mbar
3058 # -- Repository Menu
3060 menu .mbar.repository
3061 .mbar.repository add command \
3062 -label {Visualize Current Branch} \
3063 -command {do_gitk {}} \
3064 -font font_ui
3065 if {![is_MacOSX]} {
3066 .mbar.repository add command \
3067 -label {Visualize All Branches} \
3068 -command {do_gitk {--all}} \
3069 -font font_ui
3071 .mbar.repository add separator
3073 if {!$single_commit} {
3074 .mbar.repository add command -label {Compress Database} \
3075 -command do_gc \
3076 -font font_ui
3078 .mbar.repository add command -label {Verify Database} \
3079 -command do_fsck_objects \
3080 -font font_ui
3082 .mbar.repository add separator
3084 if {[is_Windows]} {
3085 .mbar.repository add command \
3086 -label {Create Desktop Icon} \
3087 -command do_windows_shortcut \
3088 -font font_ui
3089 } elseif {[is_MacOSX]} {
3090 .mbar.repository add command \
3091 -label {Create Desktop Icon} \
3092 -command do_macosx_app \
3093 -font font_ui
3097 .mbar.repository add command -label Quit \
3098 -command do_quit \
3099 -accelerator $M1T-Q \
3100 -font font_ui
3102 # -- Edit Menu
3104 menu .mbar.edit
3105 .mbar.edit add command -label Undo \
3106 -command {catch {[focus] edit undo}} \
3107 -accelerator $M1T-Z \
3108 -font font_ui
3109 .mbar.edit add command -label Redo \
3110 -command {catch {[focus] edit redo}} \
3111 -accelerator $M1T-Y \
3112 -font font_ui
3113 .mbar.edit add separator
3114 .mbar.edit add command -label Cut \
3115 -command {catch {tk_textCut [focus]}} \
3116 -accelerator $M1T-X \
3117 -font font_ui
3118 .mbar.edit add command -label Copy \
3119 -command {catch {tk_textCopy [focus]}} \
3120 -accelerator $M1T-C \
3121 -font font_ui
3122 .mbar.edit add command -label Paste \
3123 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3124 -accelerator $M1T-V \
3125 -font font_ui
3126 .mbar.edit add command -label Delete \
3127 -command {catch {[focus] delete sel.first sel.last}} \
3128 -accelerator Del \
3129 -font font_ui
3130 .mbar.edit add separator
3131 .mbar.edit add command -label {Select All} \
3132 -command {catch {[focus] tag add sel 0.0 end}} \
3133 -accelerator $M1T-A \
3134 -font font_ui
3136 # -- Branch Menu
3138 if {!$single_commit} {
3139 menu .mbar.branch
3141 .mbar.branch add command -label {Create...} \
3142 -command do_create_branch \
3143 -font font_ui
3144 lappend disable_on_lock [list .mbar.branch entryconf \
3145 [.mbar.branch index last] -state]
3147 .mbar.branch add command -label {Delete...} \
3148 -command do_delete_branch \
3149 -font font_ui
3150 lappend disable_on_lock [list .mbar.branch entryconf \
3151 [.mbar.branch index last] -state]
3154 # -- Commit Menu
3156 menu .mbar.commit
3158 .mbar.commit add radiobutton \
3159 -label {New Commit} \
3160 -command do_select_commit_type \
3161 -variable selected_commit_type \
3162 -value new \
3163 -font font_ui
3164 lappend disable_on_lock \
3165 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3167 .mbar.commit add radiobutton \
3168 -label {Amend Last Commit} \
3169 -command do_select_commit_type \
3170 -variable selected_commit_type \
3171 -value amend \
3172 -font font_ui
3173 lappend disable_on_lock \
3174 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3176 .mbar.commit add separator
3178 .mbar.commit add command -label Rescan \
3179 -command do_rescan \
3180 -accelerator F5 \
3181 -font font_ui
3182 lappend disable_on_lock \
3183 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3185 .mbar.commit add command -label {Add To Commit} \
3186 -command do_include_selection \
3187 -font font_ui
3188 lappend disable_on_lock \
3189 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3191 .mbar.commit add command -label {Add All To Commit} \
3192 -command do_include_all \
3193 -accelerator $M1T-I \
3194 -font font_ui
3195 lappend disable_on_lock \
3196 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3198 .mbar.commit add command -label {Remove From Commit} \
3199 -command do_remove_selection \
3200 -font font_ui
3201 lappend disable_on_lock \
3202 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3204 .mbar.commit add command -label {Revert Changes} \
3205 -command do_revert_selection \
3206 -font font_ui
3207 lappend disable_on_lock \
3208 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3210 .mbar.commit add separator
3212 .mbar.commit add command -label {Sign Off} \
3213 -command do_signoff \
3214 -accelerator $M1T-S \
3215 -font font_ui
3217 .mbar.commit add command -label Commit \
3218 -command do_commit \
3219 -accelerator $M1T-Return \
3220 -font font_ui
3221 lappend disable_on_lock \
3222 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3224 # -- Transport menus
3226 if {!$single_commit} {
3227 menu .mbar.fetch
3228 menu .mbar.pull
3229 menu .mbar.push
3232 if {[is_MacOSX]} {
3233 # -- Apple Menu (Mac OS X only)
3235 .mbar add cascade -label Apple -menu .mbar.apple
3236 menu .mbar.apple
3238 .mbar.apple add command -label "About $appname" \
3239 -command do_about \
3240 -font font_ui
3241 .mbar.apple add command -label "$appname Options..." \
3242 -command do_options \
3243 -font font_ui
3244 } else {
3245 # -- Edit Menu
3247 .mbar.edit add separator
3248 .mbar.edit add command -label {Options...} \
3249 -command do_options \
3250 -font font_ui
3252 # -- Tools Menu
3254 if {[file exists /usr/local/miga/lib/gui-miga]
3255 && [file exists .pvcsrc]} {
3256 proc do_miga {} {
3257 global gitdir ui_status_value
3258 if {![lock_index update]} return
3259 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3260 set miga_fd [open "|$cmd" r]
3261 fconfigure $miga_fd -blocking 0
3262 fileevent $miga_fd readable [list miga_done $miga_fd]
3263 set ui_status_value {Running miga...}
3265 proc miga_done {fd} {
3266 read $fd 512
3267 if {[eof $fd]} {
3268 close $fd
3269 unlock_index
3270 rescan [list set ui_status_value {Ready.}]
3273 .mbar add cascade -label Tools -menu .mbar.tools
3274 menu .mbar.tools
3275 .mbar.tools add command -label "Migrate" \
3276 -command do_miga \
3277 -font font_ui
3278 lappend disable_on_lock \
3279 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3282 # -- Help Menu
3284 .mbar add cascade -label Help -menu .mbar.help
3285 menu .mbar.help
3287 .mbar.help add command -label "About $appname" \
3288 -command do_about \
3289 -font font_ui
3293 # -- Branch Control
3295 frame .branch \
3296 -borderwidth 1 \
3297 -relief sunken
3298 label .branch.l1 \
3299 -text {Current Branch:} \
3300 -anchor w \
3301 -justify left \
3302 -font font_ui
3303 label .branch.cb \
3304 -textvariable current_branch \
3305 -anchor w \
3306 -justify left \
3307 -font font_ui
3308 pack .branch.l1 -side left
3309 pack .branch.cb -side left -fill x
3310 pack .branch -side top -fill x
3312 # -- Main Window Layout
3314 panedwindow .vpane -orient vertical
3315 panedwindow .vpane.files -orient horizontal
3316 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3317 pack .vpane -anchor n -side top -fill both -expand 1
3319 # -- Index File List
3321 frame .vpane.files.index -height 100 -width 400
3322 label .vpane.files.index.title -text {Modified Files} \
3323 -background green \
3324 -font font_ui
3325 text $ui_index -background white -borderwidth 0 \
3326 -width 40 -height 10 \
3327 -font font_ui \
3328 -cursor $cursor_ptr \
3329 -yscrollcommand {.vpane.files.index.sb set} \
3330 -state disabled
3331 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3332 pack .vpane.files.index.title -side top -fill x
3333 pack .vpane.files.index.sb -side right -fill y
3334 pack $ui_index -side left -fill both -expand 1
3335 .vpane.files add .vpane.files.index -sticky nsew
3337 # -- Other (Add) File List
3339 frame .vpane.files.other -height 100 -width 100
3340 label .vpane.files.other.title -text {Untracked Files} \
3341 -background red \
3342 -font font_ui
3343 text $ui_other -background white -borderwidth 0 \
3344 -width 40 -height 10 \
3345 -font font_ui \
3346 -cursor $cursor_ptr \
3347 -yscrollcommand {.vpane.files.other.sb set} \
3348 -state disabled
3349 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3350 pack .vpane.files.other.title -side top -fill x
3351 pack .vpane.files.other.sb -side right -fill y
3352 pack $ui_other -side left -fill both -expand 1
3353 .vpane.files add .vpane.files.other -sticky nsew
3355 foreach i [list $ui_index $ui_other] {
3356 $i tag conf in_diff -font font_uibold
3357 $i tag conf in_sel \
3358 -background [$i cget -foreground] \
3359 -foreground [$i cget -background]
3361 unset i
3363 # -- Diff and Commit Area
3365 frame .vpane.lower -height 300 -width 400
3366 frame .vpane.lower.commarea
3367 frame .vpane.lower.diff -relief sunken -borderwidth 1
3368 pack .vpane.lower.commarea -side top -fill x
3369 pack .vpane.lower.diff -side bottom -fill both -expand 1
3370 .vpane add .vpane.lower -stick nsew
3372 # -- Commit Area Buttons
3374 frame .vpane.lower.commarea.buttons
3375 label .vpane.lower.commarea.buttons.l -text {} \
3376 -anchor w \
3377 -justify left \
3378 -font font_ui
3379 pack .vpane.lower.commarea.buttons.l -side top -fill x
3380 pack .vpane.lower.commarea.buttons -side left -fill y
3382 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3383 -command do_rescan \
3384 -font font_ui
3385 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3386 lappend disable_on_lock \
3387 {.vpane.lower.commarea.buttons.rescan conf -state}
3389 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3390 -command do_include_all \
3391 -font font_ui
3392 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3393 lappend disable_on_lock \
3394 {.vpane.lower.commarea.buttons.incall conf -state}
3396 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3397 -command do_signoff \
3398 -font font_ui
3399 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3401 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3402 -command do_commit \
3403 -font font_ui
3404 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3405 lappend disable_on_lock \
3406 {.vpane.lower.commarea.buttons.commit conf -state}
3408 # -- Commit Message Buffer
3410 frame .vpane.lower.commarea.buffer
3411 frame .vpane.lower.commarea.buffer.header
3412 set ui_comm .vpane.lower.commarea.buffer.t
3413 set ui_coml .vpane.lower.commarea.buffer.header.l
3414 radiobutton .vpane.lower.commarea.buffer.header.new \
3415 -text {New Commit} \
3416 -command do_select_commit_type \
3417 -variable selected_commit_type \
3418 -value new \
3419 -font font_ui
3420 lappend disable_on_lock \
3421 [list .vpane.lower.commarea.buffer.header.new conf -state]
3422 radiobutton .vpane.lower.commarea.buffer.header.amend \
3423 -text {Amend Last Commit} \
3424 -command do_select_commit_type \
3425 -variable selected_commit_type \
3426 -value amend \
3427 -font font_ui
3428 lappend disable_on_lock \
3429 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3430 label $ui_coml \
3431 -anchor w \
3432 -justify left \
3433 -font font_ui
3434 proc trace_commit_type {varname args} {
3435 global ui_coml commit_type
3436 switch -glob -- $commit_type {
3437 initial {set txt {Initial Commit Message:}}
3438 amend {set txt {Amended Commit Message:}}
3439 amend-initial {set txt {Amended Initial Commit Message:}}
3440 amend-merge {set txt {Amended Merge Commit Message:}}
3441 merge {set txt {Merge Commit Message:}}
3442 * {set txt {Commit Message:}}
3444 $ui_coml conf -text $txt
3446 trace add variable commit_type write trace_commit_type
3447 pack $ui_coml -side left -fill x
3448 pack .vpane.lower.commarea.buffer.header.amend -side right
3449 pack .vpane.lower.commarea.buffer.header.new -side right
3451 text $ui_comm -background white -borderwidth 1 \
3452 -undo true \
3453 -maxundo 20 \
3454 -autoseparators true \
3455 -relief sunken \
3456 -width 75 -height 9 -wrap none \
3457 -font font_diff \
3458 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3459 scrollbar .vpane.lower.commarea.buffer.sby \
3460 -command [list $ui_comm yview]
3461 pack .vpane.lower.commarea.buffer.header -side top -fill x
3462 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3463 pack $ui_comm -side left -fill y
3464 pack .vpane.lower.commarea.buffer -side left -fill y
3466 # -- Commit Message Buffer Context Menu
3468 set ctxm .vpane.lower.commarea.buffer.ctxm
3469 menu $ctxm -tearoff 0
3470 $ctxm add command \
3471 -label {Cut} \
3472 -font font_ui \
3473 -command {tk_textCut $ui_comm}
3474 $ctxm add command \
3475 -label {Copy} \
3476 -font font_ui \
3477 -command {tk_textCopy $ui_comm}
3478 $ctxm add command \
3479 -label {Paste} \
3480 -font font_ui \
3481 -command {tk_textPaste $ui_comm}
3482 $ctxm add command \
3483 -label {Delete} \
3484 -font font_ui \
3485 -command {$ui_comm delete sel.first sel.last}
3486 $ctxm add separator
3487 $ctxm add command \
3488 -label {Select All} \
3489 -font font_ui \
3490 -command {$ui_comm tag add sel 0.0 end}
3491 $ctxm add command \
3492 -label {Copy All} \
3493 -font font_ui \
3494 -command {
3495 $ui_comm tag add sel 0.0 end
3496 tk_textCopy $ui_comm
3497 $ui_comm tag remove sel 0.0 end
3499 $ctxm add separator
3500 $ctxm add command \
3501 -label {Sign Off} \
3502 -font font_ui \
3503 -command do_signoff
3504 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3506 # -- Diff Header
3508 set current_diff {}
3509 set diff_actions [list]
3510 proc trace_current_diff {varname args} {
3511 global current_diff diff_actions file_states
3512 if {$current_diff eq {}} {
3513 set s {}
3514 set f {}
3515 set p {}
3516 set o disabled
3517 } else {
3518 set p $current_diff
3519 set s [mapdesc [lindex $file_states($p) 0] $p]
3520 set f {File:}
3521 set p [escape_path $p]
3522 set o normal
3525 .vpane.lower.diff.header.status configure -text $s
3526 .vpane.lower.diff.header.file configure -text $f
3527 .vpane.lower.diff.header.path configure -text $p
3528 foreach w $diff_actions {
3529 uplevel #0 $w $o
3532 trace add variable current_diff write trace_current_diff
3534 frame .vpane.lower.diff.header -background orange
3535 label .vpane.lower.diff.header.status \
3536 -background orange \
3537 -width $max_status_desc \
3538 -anchor w \
3539 -justify left \
3540 -font font_ui
3541 label .vpane.lower.diff.header.file \
3542 -background orange \
3543 -anchor w \
3544 -justify left \
3545 -font font_ui
3546 label .vpane.lower.diff.header.path \
3547 -background orange \
3548 -anchor w \
3549 -justify left \
3550 -font font_ui
3551 pack .vpane.lower.diff.header.status -side left
3552 pack .vpane.lower.diff.header.file -side left
3553 pack .vpane.lower.diff.header.path -fill x
3554 set ctxm .vpane.lower.diff.header.ctxm
3555 menu $ctxm -tearoff 0
3556 $ctxm add command \
3557 -label {Copy} \
3558 -font font_ui \
3559 -command {
3560 clipboard clear
3561 clipboard append \
3562 -format STRING \
3563 -type STRING \
3564 -- $current_diff
3566 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3567 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3569 # -- Diff Body
3571 frame .vpane.lower.diff.body
3572 set ui_diff .vpane.lower.diff.body.t
3573 text $ui_diff -background white -borderwidth 0 \
3574 -width 80 -height 15 -wrap none \
3575 -font font_diff \
3576 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3577 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3578 -state disabled
3579 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3580 -command [list $ui_diff xview]
3581 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3582 -command [list $ui_diff yview]
3583 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3584 pack .vpane.lower.diff.body.sby -side right -fill y
3585 pack $ui_diff -side left -fill both -expand 1
3586 pack .vpane.lower.diff.header -side top -fill x
3587 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3589 $ui_diff tag conf d_@ -font font_diffbold
3590 $ui_diff tag conf d_+ -foreground blue
3591 $ui_diff tag conf d_- -foreground red
3592 $ui_diff tag conf d_++ -foreground {#00a000}
3593 $ui_diff tag conf d_-- -foreground {#a000a0}
3594 $ui_diff tag conf d_+- \
3595 -foreground red \
3596 -background {light goldenrod yellow}
3597 $ui_diff tag conf d_-+ \
3598 -foreground blue \
3599 -background azure2
3601 # -- Diff Body Context Menu
3603 set ctxm .vpane.lower.diff.body.ctxm
3604 menu $ctxm -tearoff 0
3605 $ctxm add command \
3606 -label {Copy} \
3607 -font font_ui \
3608 -command {tk_textCopy $ui_diff}
3609 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3610 $ctxm add command \
3611 -label {Select All} \
3612 -font font_ui \
3613 -command {$ui_diff tag add sel 0.0 end}
3614 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3615 $ctxm add command \
3616 -label {Copy All} \
3617 -font font_ui \
3618 -command {
3619 $ui_diff tag add sel 0.0 end
3620 tk_textCopy $ui_diff
3621 $ui_diff tag remove sel 0.0 end
3623 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3624 $ctxm add separator
3625 $ctxm add command \
3626 -label {Decrease Font Size} \
3627 -font font_ui \
3628 -command {incr_font_size font_diff -1}
3629 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3630 $ctxm add command \
3631 -label {Increase Font Size} \
3632 -font font_ui \
3633 -command {incr_font_size font_diff 1}
3634 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3635 $ctxm add separator
3636 $ctxm add command \
3637 -label {Show Less Context} \
3638 -font font_ui \
3639 -command {if {$repo_config(gui.diffcontext) >= 2} {
3640 incr repo_config(gui.diffcontext) -1
3641 reshow_diff
3643 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3644 $ctxm add command \
3645 -label {Show More Context} \
3646 -font font_ui \
3647 -command {
3648 incr repo_config(gui.diffcontext)
3649 reshow_diff
3651 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3652 $ctxm add separator
3653 $ctxm add command -label {Options...} \
3654 -font font_ui \
3655 -command do_options
3656 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3658 # -- Status Bar
3660 set ui_status_value {Initializing...}
3661 label .status -textvariable ui_status_value \
3662 -anchor w \
3663 -justify left \
3664 -borderwidth 1 \
3665 -relief sunken \
3666 -font font_ui
3667 pack .status -anchor w -side bottom -fill x
3669 # -- Load geometry
3671 catch {
3672 set gm $repo_config(gui.geometry)
3673 wm geometry . [lindex $gm 0]
3674 .vpane sash place 0 \
3675 [lindex [.vpane sash coord 0] 0] \
3676 [lindex $gm 1]
3677 .vpane.files sash place 0 \
3678 [lindex $gm 2] \
3679 [lindex [.vpane.files sash coord 0] 1]
3680 unset gm
3683 # -- Key Bindings
3685 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3686 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3687 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3688 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3689 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3690 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3691 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3692 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3693 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3694 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3695 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3697 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3698 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3699 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3700 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3701 bind $ui_diff <$M1B-Key-v> {break}
3702 bind $ui_diff <$M1B-Key-V> {break}
3703 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3704 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3705 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3706 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3707 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3708 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3710 bind . <Destroy> do_quit
3711 bind all <Key-F5> do_rescan
3712 bind all <$M1B-Key-r> do_rescan
3713 bind all <$M1B-Key-R> do_rescan
3714 bind . <$M1B-Key-s> do_signoff
3715 bind . <$M1B-Key-S> do_signoff
3716 bind . <$M1B-Key-i> do_include_all
3717 bind . <$M1B-Key-I> do_include_all
3718 bind . <$M1B-Key-Return> do_commit
3719 bind all <$M1B-Key-q> do_quit
3720 bind all <$M1B-Key-Q> do_quit
3721 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3722 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3723 foreach i [list $ui_index $ui_other] {
3724 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3725 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3726 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3728 unset i
3730 set file_lists($ui_index) [list]
3731 set file_lists($ui_other) [list]
3733 set HEAD {}
3734 set PARENT {}
3735 set MERGE_HEAD [list]
3736 set commit_type {}
3737 set empty_tree {}
3738 set current_branch {}
3739 set current_diff {}
3740 set selected_commit_type new
3742 wm title . "$appname ([file normalize [file dirname $gitdir]])"
3743 focus -force $ui_comm
3745 # -- Warn the user about environmental problems. Cygwin's Tcl
3746 # does *not* pass its env array onto any processes it spawns.
3747 # This means that git processes get none of our environment.
3749 if {[is_Windows]} {
3750 set ignored_env 0
3751 set suggest_user {}
3752 set msg "Possible environment issues exist.
3754 The following environment variables are probably
3755 going to be ignored by any Git subprocess run
3756 by $appname:
3759 foreach name [array names env] {
3760 switch -regexp -- $name {
3761 {^GIT_INDEX_FILE$} -
3762 {^GIT_OBJECT_DIRECTORY$} -
3763 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3764 {^GIT_DIFF_OPTS$} -
3765 {^GIT_EXTERNAL_DIFF$} -
3766 {^GIT_PAGER$} -
3767 {^GIT_TRACE$} -
3768 {^GIT_CONFIG$} -
3769 {^GIT_CONFIG_LOCAL$} -
3770 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3771 append msg " - $name\n"
3772 incr ignored_env
3774 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3775 append msg " - $name\n"
3776 incr ignored_env
3777 set suggest_user $name
3781 if {$ignored_env > 0} {
3782 append msg "
3783 This is due to a known issue with the
3784 Tcl binary distributed by Cygwin."
3786 if {$suggest_user ne {}} {
3787 append msg "
3789 A good replacement for $suggest_user
3790 is placing values for the user.name and
3791 user.email settings into your personal
3792 ~/.gitconfig file.
3795 warn_popup $msg
3797 unset ignored_env msg suggest_user name
3800 # -- Only initialize complex UI if we are going to stay running.
3802 if {!$single_commit} {
3803 load_all_remotes
3804 load_all_heads
3806 populate_branch_menu .mbar.branch
3807 populate_fetch_menu .mbar.fetch
3808 populate_pull_menu .mbar.pull
3809 populate_push_menu .mbar.push
3812 # -- Only suggest a gc run if we are going to stay running.
3814 if {!$single_commit} {
3815 set object_limit 2000
3816 if {[is_Windows]} {set object_limit 200}
3817 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3818 if {$objects_current >= $object_limit} {
3819 if {[ask_popup \
3820 "This repository currently has $objects_current loose objects.
3822 To maintain optimal performance it is strongly
3823 recommended that you compress the database
3824 when more than $object_limit loose objects exist.
3826 Compress the database now?"] eq yes} {
3827 do_gc
3830 unset object_limit _junk objects_current
3833 lock_index begin-read
3834 after 1 do_rescan