git-gui: Cleanup usage of gitdir global variable.
[git-gui.git] / git-gui.sh
blobb937cf216358e83656ed3802778a698bdcb7de15
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
5 set appvers {@@GIT_VERSION@@}
6 set copyright {
7 Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
23 ######################################################################
25 ## read only globals
27 set _appname [lindex [file split $argv0] end]
28 set _gitdir {}
29 set _reponame {}
31 proc appname {} {
32 global _appname
33 return $_appname
36 proc gitdir {} {
37 global _gitdir
38 return $_gitdir
41 proc reponame {} {
42 global _reponame
43 return $_reponame
46 ######################################################################
48 ## config
50 proc is_many_config {name} {
51 switch -glob -- $name {
52 remote.*.fetch -
53 remote.*.push
54 {return 1}
56 {return 0}
60 proc load_config {include_global} {
61 global repo_config global_config default_config
63 array unset global_config
64 if {$include_global} {
65 catch {
66 set fd_rc [open "| git repo-config --global --list" r]
67 while {[gets $fd_rc line] >= 0} {
68 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
69 if {[is_many_config $name]} {
70 lappend global_config($name) $value
71 } else {
72 set global_config($name) $value
76 close $fd_rc
80 array unset repo_config
81 catch {
82 set fd_rc [open "| git repo-config --list" r]
83 while {[gets $fd_rc line] >= 0} {
84 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
85 if {[is_many_config $name]} {
86 lappend repo_config($name) $value
87 } else {
88 set repo_config($name) $value
92 close $fd_rc
95 foreach name [array names default_config] {
96 if {[catch {set v $global_config($name)}]} {
97 set global_config($name) $default_config($name)
99 if {[catch {set v $repo_config($name)}]} {
100 set repo_config($name) $default_config($name)
105 proc save_config {} {
106 global default_config font_descs
107 global repo_config global_config
108 global repo_config_new global_config_new
110 foreach option $font_descs {
111 set name [lindex $option 0]
112 set font [lindex $option 1]
113 font configure $font \
114 -family $global_config_new(gui.$font^^family) \
115 -size $global_config_new(gui.$font^^size)
116 font configure ${font}bold \
117 -family $global_config_new(gui.$font^^family) \
118 -size $global_config_new(gui.$font^^size)
119 set global_config_new(gui.$name) [font configure $font]
120 unset global_config_new(gui.$font^^family)
121 unset global_config_new(gui.$font^^size)
124 foreach name [array names default_config] {
125 set value $global_config_new($name)
126 if {$value ne $global_config($name)} {
127 if {$value eq $default_config($name)} {
128 catch {exec git repo-config --global --unset $name}
129 } else {
130 regsub -all "\[{}\]" $value {"} value
131 exec git repo-config --global $name $value
133 set global_config($name) $value
134 if {$value eq $repo_config($name)} {
135 catch {exec git repo-config --unset $name}
136 set repo_config($name) $value
141 foreach name [array names default_config] {
142 set value $repo_config_new($name)
143 if {$value ne $repo_config($name)} {
144 if {$value eq $global_config($name)} {
145 catch {exec git repo-config --unset $name}
146 } else {
147 regsub -all "\[{}\]" $value {"} value
148 exec git repo-config $name $value
150 set repo_config($name) $value
155 proc error_popup {msg} {
156 set title [appname]
157 if {[reponame] ne {}} {
158 append title " ([reponame])"
160 set cmd [list tk_messageBox \
161 -icon error \
162 -type ok \
163 -title "$title: error" \
164 -message $msg]
165 if {[winfo ismapped .]} {
166 lappend cmd -parent .
168 eval $cmd
171 proc warn_popup {msg} {
172 set title [appname]
173 if {[reponame] ne {}} {
174 append title " ([reponame])"
176 set cmd [list tk_messageBox \
177 -icon warning \
178 -type ok \
179 -title "$title: warning" \
180 -message $msg]
181 if {[winfo ismapped .]} {
182 lappend cmd -parent .
184 eval $cmd
187 proc info_popup {msg} {
188 set title [appname]
189 if {[reponame] ne {}} {
190 append title " ([reponame])"
192 tk_messageBox \
193 -parent . \
194 -icon info \
195 -type ok \
196 -title $title \
197 -message $msg
200 proc ask_popup {msg} {
201 set title [appname]
202 if {[reponame] ne {}} {
203 append title " ([reponame])"
205 return [tk_messageBox \
206 -parent . \
207 -icon question \
208 -type yesno \
209 -title $title \
210 -message $msg]
213 ######################################################################
215 ## repository setup
217 if { [catch {set _gitdir $env(GIT_DIR)}]
218 && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
219 catch {wm withdraw .}
220 error_popup "Cannot find the git directory:\n\n$err"
221 exit 1
223 if {![file isdirectory $_gitdir]} {
224 catch {wm withdraw .}
225 error_popup "Git directory not found:\n\n$_gitdir"
226 exit 1
228 if {[lindex [file split $_gitdir] end] ne {.git}} {
229 catch {wm withdraw .}
230 error_popup "Cannot use funny .git directory:\n\n$gitdir"
231 exit 1
233 if {[catch {cd [file dirname $_gitdir]} err]} {
234 catch {wm withdraw .}
235 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
236 exit 1
238 set _reponame [lindex [file split \
239 [file normalize [file dirname $_gitdir]]] \
240 end]
242 set single_commit 0
243 if {[appname] eq {git-citool}} {
244 set single_commit 1
247 ######################################################################
249 ## task management
251 set rescan_active 0
252 set diff_active 0
253 set last_clicked {}
255 set disable_on_lock [list]
256 set index_lock_type none
258 proc lock_index {type} {
259 global index_lock_type disable_on_lock
261 if {$index_lock_type eq {none}} {
262 set index_lock_type $type
263 foreach w $disable_on_lock {
264 uplevel #0 $w disabled
266 return 1
267 } elseif {$index_lock_type eq "begin-$type"} {
268 set index_lock_type $type
269 return 1
271 return 0
274 proc unlock_index {} {
275 global index_lock_type disable_on_lock
277 set index_lock_type none
278 foreach w $disable_on_lock {
279 uplevel #0 $w normal
283 ######################################################################
285 ## status
287 proc repository_state {ctvar hdvar mhvar} {
288 global current_branch
289 upvar $ctvar ct $hdvar hd $mhvar mh
291 set mh [list]
293 if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
294 set current_branch {}
295 } else {
296 regsub ^refs/((heads|tags|remotes)/)? \
297 $current_branch \
298 {} \
299 current_branch
302 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
303 set hd {}
304 set ct initial
305 return
308 set merge_head [file join [gitdir] MERGE_HEAD]
309 if {[file exists $merge_head]} {
310 set ct merge
311 set fd_mh [open $merge_head r]
312 while {[gets $fd_mh line] >= 0} {
313 lappend mh $line
315 close $fd_mh
316 return
319 set ct normal
322 proc PARENT {} {
323 global PARENT empty_tree
325 set p [lindex $PARENT 0]
326 if {$p ne {}} {
327 return $p
329 if {$empty_tree eq {}} {
330 set empty_tree [exec git mktree << {}]
332 return $empty_tree
335 proc rescan {after} {
336 global HEAD PARENT MERGE_HEAD commit_type
337 global ui_index ui_other ui_status_value ui_comm
338 global rescan_active file_states
339 global repo_config
341 if {$rescan_active > 0 || ![lock_index read]} return
343 repository_state newType newHEAD newMERGE_HEAD
344 if {[string match amend* $commit_type]
345 && $newType eq {normal}
346 && $newHEAD eq $HEAD} {
347 } else {
348 set HEAD $newHEAD
349 set PARENT $newHEAD
350 set MERGE_HEAD $newMERGE_HEAD
351 set commit_type $newType
354 array unset file_states
356 if {![$ui_comm edit modified]
357 || [string trim [$ui_comm get 0.0 end]] eq {}} {
358 if {[load_message GITGUI_MSG]} {
359 } elseif {[load_message MERGE_MSG]} {
360 } elseif {[load_message SQUASH_MSG]} {
362 $ui_comm edit reset
363 $ui_comm edit modified false
366 if {$repo_config(gui.trustmtime) eq {true}} {
367 rescan_stage2 {} $after
368 } else {
369 set rescan_active 1
370 set ui_status_value {Refreshing file status...}
371 set cmd [list git update-index]
372 lappend cmd -q
373 lappend cmd --unmerged
374 lappend cmd --ignore-missing
375 lappend cmd --refresh
376 set fd_rf [open "| $cmd" r]
377 fconfigure $fd_rf -blocking 0 -translation binary
378 fileevent $fd_rf readable \
379 [list rescan_stage2 $fd_rf $after]
383 proc rescan_stage2 {fd after} {
384 global ui_status_value
385 global rescan_active buf_rdi buf_rdf buf_rlo
387 if {$fd ne {}} {
388 read $fd
389 if {![eof $fd]} return
390 close $fd
393 set ls_others [list | git ls-files --others -z \
394 --exclude-per-directory=.gitignore]
395 set info_exclude [file join [gitdir] info exclude]
396 if {[file readable $info_exclude]} {
397 lappend ls_others "--exclude-from=$info_exclude"
400 set buf_rdi {}
401 set buf_rdf {}
402 set buf_rlo {}
404 set rescan_active 3
405 set ui_status_value {Scanning for modified files ...}
406 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
407 set fd_df [open "| git diff-files -z" r]
408 set fd_lo [open $ls_others r]
410 fconfigure $fd_di -blocking 0 -translation binary
411 fconfigure $fd_df -blocking 0 -translation binary
412 fconfigure $fd_lo -blocking 0 -translation binary
413 fileevent $fd_di readable [list read_diff_index $fd_di $after]
414 fileevent $fd_df readable [list read_diff_files $fd_df $after]
415 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
418 proc load_message {file} {
419 global ui_comm
421 set f [file join [gitdir] $file]
422 if {[file isfile $f]} {
423 if {[catch {set fd [open $f r]}]} {
424 return 0
426 set content [string trim [read $fd]]
427 close $fd
428 $ui_comm delete 0.0 end
429 $ui_comm insert end $content
430 return 1
432 return 0
435 proc read_diff_index {fd after} {
436 global buf_rdi
438 append buf_rdi [read $fd]
439 set c 0
440 set n [string length $buf_rdi]
441 while {$c < $n} {
442 set z1 [string first "\0" $buf_rdi $c]
443 if {$z1 == -1} break
444 incr z1
445 set z2 [string first "\0" $buf_rdi $z1]
446 if {$z2 == -1} break
448 incr c
449 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
450 merge_state \
451 [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
452 [lindex $i 4]? \
453 [list [lindex $i 0] [lindex $i 2]] \
454 [list]
455 set c $z2
456 incr c
458 if {$c < $n} {
459 set buf_rdi [string range $buf_rdi $c end]
460 } else {
461 set buf_rdi {}
464 rescan_done $fd buf_rdi $after
467 proc read_diff_files {fd after} {
468 global buf_rdf
470 append buf_rdf [read $fd]
471 set c 0
472 set n [string length $buf_rdf]
473 while {$c < $n} {
474 set z1 [string first "\0" $buf_rdf $c]
475 if {$z1 == -1} break
476 incr z1
477 set z2 [string first "\0" $buf_rdf $z1]
478 if {$z2 == -1} break
480 incr c
481 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
482 merge_state \
483 [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
484 ?[lindex $i 4] \
485 [list] \
486 [list [lindex $i 0] [lindex $i 2]]
487 set c $z2
488 incr c
490 if {$c < $n} {
491 set buf_rdf [string range $buf_rdf $c end]
492 } else {
493 set buf_rdf {}
496 rescan_done $fd buf_rdf $after
499 proc read_ls_others {fd after} {
500 global buf_rlo
502 append buf_rlo [read $fd]
503 set pck [split $buf_rlo "\0"]
504 set buf_rlo [lindex $pck end]
505 foreach p [lrange $pck 0 end-1] {
506 merge_state $p ?O
508 rescan_done $fd buf_rlo $after
511 proc rescan_done {fd buf after} {
512 global rescan_active
513 global file_states repo_config
514 upvar $buf to_clear
516 if {![eof $fd]} return
517 set to_clear {}
518 close $fd
519 if {[incr rescan_active -1] > 0} return
521 prune_selection
522 unlock_index
523 display_all_files
525 if {$repo_config(gui.partialinclude) ne {true}} {
526 set pathList [list]
527 foreach path [array names file_states] {
528 switch -- [lindex $file_states($path) 0] {
529 A? -
530 M? {lappend pathList $path}
533 if {$pathList ne {}} {
534 update_index \
535 "Updating included files" \
536 $pathList \
537 [concat {reshow_diff;} $after]
538 return
542 reshow_diff
543 uplevel #0 $after
546 proc prune_selection {} {
547 global file_states selected_paths
549 foreach path [array names selected_paths] {
550 if {[catch {set still_here $file_states($path)}]} {
551 unset selected_paths($path)
556 ######################################################################
558 ## diff
560 proc clear_diff {} {
561 global ui_diff current_diff ui_index ui_other
563 $ui_diff conf -state normal
564 $ui_diff delete 0.0 end
565 $ui_diff conf -state disabled
567 set current_diff {}
569 $ui_index tag remove in_diff 0.0 end
570 $ui_other tag remove in_diff 0.0 end
573 proc reshow_diff {} {
574 global current_diff ui_status_value file_states
576 if {$current_diff eq {}
577 || [catch {set s $file_states($current_diff)}]} {
578 clear_diff
579 } else {
580 show_diff $current_diff
584 proc handle_empty_diff {} {
585 global current_diff file_states file_lists
587 set path $current_diff
588 set s $file_states($path)
589 if {[lindex $s 0] ne {_M}} return
591 info_popup "No differences detected.
593 [short_path $path] has no changes.
595 The modification date of this file was updated
596 by another application and you currently have
597 the Trust File Modification Timestamps option
598 enabled, so Git did not automatically detect
599 that there are no content differences in this
600 file.
602 This file will now be removed from the modified
603 files list, to prevent possible confusion.
605 if {[catch {exec git update-index -- $path} err]} {
606 error_popup "Failed to refresh index:\n\n$err"
609 clear_diff
610 set old_w [mapcol [lindex $file_states($path) 0] $path]
611 set lno [lsearch -sorted $file_lists($old_w) $path]
612 if {$lno >= 0} {
613 set file_lists($old_w) \
614 [lreplace $file_lists($old_w) $lno $lno]
615 incr lno
616 $old_w conf -state normal
617 $old_w delete $lno.0 [expr {$lno + 1}].0
618 $old_w conf -state disabled
622 proc show_diff {path {w {}} {lno {}}} {
623 global file_states file_lists
624 global is_3way_diff diff_active repo_config
625 global ui_diff current_diff ui_status_value
627 if {$diff_active || ![lock_index read]} return
629 clear_diff
630 if {$w eq {} || $lno == {}} {
631 foreach w [array names file_lists] {
632 set lno [lsearch -sorted $file_lists($w) $path]
633 if {$lno >= 0} {
634 incr lno
635 break
639 if {$w ne {} && $lno >= 1} {
640 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
643 set s $file_states($path)
644 set m [lindex $s 0]
645 set is_3way_diff 0
646 set diff_active 1
647 set current_diff $path
648 set ui_status_value "Loading diff of [escape_path $path]..."
650 set cmd [list | git diff-index]
651 lappend cmd --no-color
652 if {$repo_config(gui.diffcontext) > 0} {
653 lappend cmd "-U$repo_config(gui.diffcontext)"
655 lappend cmd -p
657 switch $m {
658 MM {
659 lappend cmd -c
661 _O {
662 if {[catch {
663 set fd [open $path r]
664 set content [read $fd]
665 close $fd
666 } err ]} {
667 set diff_active 0
668 unlock_index
669 set ui_status_value "Unable to display [escape_path $path]"
670 error_popup "Error loading file:\n\n$err"
671 return
673 $ui_diff conf -state normal
674 $ui_diff insert end $content
675 $ui_diff conf -state disabled
676 set diff_active 0
677 unlock_index
678 set ui_status_value {Ready.}
679 return
683 lappend cmd [PARENT]
684 lappend cmd --
685 lappend cmd $path
687 if {[catch {set fd [open $cmd r]} err]} {
688 set diff_active 0
689 unlock_index
690 set ui_status_value "Unable to display [escape_path $path]"
691 error_popup "Error loading diff:\n\n$err"
692 return
695 fconfigure $fd -blocking 0 -translation auto
696 fileevent $fd readable [list read_diff $fd]
699 proc read_diff {fd} {
700 global ui_diff ui_status_value is_3way_diff diff_active
701 global repo_config
703 $ui_diff conf -state normal
704 while {[gets $fd line] >= 0} {
705 # -- Cleanup uninteresting diff header lines.
707 if {[string match {diff --git *} $line]} continue
708 if {[string match {diff --combined *} $line]} continue
709 if {[string match {--- *} $line]} continue
710 if {[string match {+++ *} $line]} continue
711 if {$line eq {deleted file mode 120000}} {
712 set line "deleted symlink"
715 # -- Automatically detect if this is a 3 way diff.
717 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
719 # -- Reformat a 3 way diff, 'cause its too weird.
721 if {$is_3way_diff} {
722 set op [string range $line 0 1]
723 switch -- $op {
724 {@@} {set tags d_@}
725 {++} {set tags d_+ ; set op { +}}
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 default {set tags {}}
733 set line [string replace $line 0 1 $op]
734 } else {
735 switch -- [string index $line 0] {
736 @ {set tags d_@}
737 + {set tags d_+}
738 - {set tags d_-}
739 default {set tags {}}
742 $ui_diff insert end $line $tags
743 $ui_diff insert end "\n" $tags
745 $ui_diff conf -state disabled
747 if {[eof $fd]} {
748 close $fd
749 set diff_active 0
750 unlock_index
751 set ui_status_value {Ready.}
753 if {$repo_config(gui.trustmtime) eq {true}
754 && [$ui_diff index end] eq {2.0}} {
755 handle_empty_diff
760 ######################################################################
762 ## commit
764 proc load_last_commit {} {
765 global HEAD PARENT MERGE_HEAD commit_type ui_comm
767 if {[llength $PARENT] == 0} {
768 error_popup {There is nothing to amend.
770 You are about to create the initial commit.
771 There is no commit before this to amend.
773 return
776 repository_state curType curHEAD curMERGE_HEAD
777 if {$curType eq {merge}} {
778 error_popup {Cannot amend while merging.
780 You are currently in the middle of a merge that
781 has not been fully completed. You cannot amend
782 the prior commit unless you first abort the
783 current merge activity.
785 return
788 set msg {}
789 set parents [list]
790 if {[catch {
791 set fd [open "| git cat-file commit $curHEAD" r]
792 while {[gets $fd line] > 0} {
793 if {[string match {parent *} $line]} {
794 lappend parents [string range $line 7 end]
797 set msg [string trim [read $fd]]
798 close $fd
799 } err]} {
800 error_popup "Error loading commit data for amend:\n\n$err"
801 return
804 set HEAD $curHEAD
805 set PARENT $parents
806 set MERGE_HEAD [list]
807 switch -- [llength $parents] {
808 0 {set commit_type amend-initial}
809 1 {set commit_type amend}
810 default {set commit_type amend-merge}
813 $ui_comm delete 0.0 end
814 $ui_comm insert end $msg
815 $ui_comm edit reset
816 $ui_comm edit modified false
817 rescan {set ui_status_value {Ready.}}
820 proc create_new_commit {} {
821 global commit_type ui_comm
823 set commit_type normal
824 $ui_comm delete 0.0 end
825 $ui_comm edit reset
826 $ui_comm edit modified false
827 rescan {set ui_status_value {Ready.}}
830 set GIT_COMMITTER_IDENT {}
832 proc committer_ident {} {
833 global GIT_COMMITTER_IDENT
835 if {$GIT_COMMITTER_IDENT eq {}} {
836 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
837 error_popup "Unable to obtain your identity:\n\n$err"
838 return {}
840 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
841 $me me GIT_COMMITTER_IDENT]} {
842 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
843 return {}
847 return $GIT_COMMITTER_IDENT
850 proc commit_tree {} {
851 global HEAD commit_type file_states ui_comm repo_config
853 if {![lock_index update]} return
854 if {[committer_ident] eq {}} return
856 # -- Our in memory state should match the repository.
858 repository_state curType curHEAD curMERGE_HEAD
859 if {[string match amend* $commit_type]
860 && $curType eq {normal}
861 && $curHEAD eq $HEAD} {
862 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
863 info_popup {Last scanned state does not match repository state.
865 Another Git program has modified this repository
866 since the last scan. A rescan must be performed
867 before another commit can be created.
869 The rescan will be automatically started now.
871 unlock_index
872 rescan {set ui_status_value {Ready.}}
873 return
876 # -- At least one file should differ in the index.
878 set files_ready 0
879 foreach path [array names file_states] {
880 switch -glob -- [lindex $file_states($path) 0] {
881 _? {continue}
882 A? -
883 D? -
884 M? {set files_ready 1; break}
885 U? {
886 error_popup "Unmerged files cannot be committed.
888 File [short_path $path] has merge conflicts.
889 You must resolve them and include the file before committing.
891 unlock_index
892 return
894 default {
895 error_popup "Unknown file state [lindex $s 0] detected.
897 File [short_path $path] cannot be committed by this program.
902 if {!$files_ready} {
903 error_popup {No included files to commit.
905 You must include at least 1 file before you can commit.
907 unlock_index
908 return
911 # -- A message is required.
913 set msg [string trim [$ui_comm get 1.0 end]]
914 if {$msg eq {}} {
915 error_popup {Please supply a commit message.
917 A good commit message has the following format:
919 - First line: Describe in one sentance what you did.
920 - Second line: Blank
921 - Remaining lines: Describe why this change is good.
923 unlock_index
924 return
927 # -- Update included files if partialincludes are off.
929 if {$repo_config(gui.partialinclude) ne {true}} {
930 set pathList [list]
931 foreach path [array names file_states] {
932 switch -glob -- [lindex $file_states($path) 0] {
933 A? -
934 M? {lappend pathList $path}
937 if {$pathList ne {}} {
938 unlock_index
939 update_index \
940 "Updating included files" \
941 $pathList \
942 [concat {lock_index update;} \
943 [list commit_prehook $curHEAD $msg]]
944 return
948 commit_prehook $curHEAD $msg
951 proc commit_prehook {curHEAD msg} {
952 global ui_status_value pch_error
954 set pchook [file join [gitdir] hooks pre-commit]
956 # On Cygwin [file executable] might lie so we need to ask
957 # the shell if the hook is executable. Yes that's annoying.
959 if {[is_Windows] && [file isfile $pchook]} {
960 set pchook [list sh -c [concat \
961 "if test -x \"$pchook\";" \
962 "then exec \"$pchook\" 2>&1;" \
963 "fi"]]
964 } elseif {[file executable $pchook]} {
965 set pchook [list $pchook |& cat]
966 } else {
967 commit_writetree $curHEAD $msg
968 return
971 set ui_status_value {Calling pre-commit hook...}
972 set pch_error {}
973 set fd_ph [open "| $pchook" r]
974 fconfigure $fd_ph -blocking 0 -translation binary
975 fileevent $fd_ph readable \
976 [list commit_prehook_wait $fd_ph $curHEAD $msg]
979 proc commit_prehook_wait {fd_ph curHEAD msg} {
980 global pch_error ui_status_value
982 append pch_error [read $fd_ph]
983 fconfigure $fd_ph -blocking 1
984 if {[eof $fd_ph]} {
985 if {[catch {close $fd_ph}]} {
986 set ui_status_value {Commit declined by pre-commit hook.}
987 hook_failed_popup pre-commit $pch_error
988 unlock_index
989 } else {
990 commit_writetree $curHEAD $msg
992 set pch_error {}
993 return
995 fconfigure $fd_ph -blocking 0
998 proc commit_writetree {curHEAD msg} {
999 global ui_status_value
1001 set ui_status_value {Committing changes...}
1002 set fd_wt [open "| git write-tree" r]
1003 fileevent $fd_wt readable \
1004 [list commit_committree $fd_wt $curHEAD $msg]
1007 proc commit_committree {fd_wt curHEAD msg} {
1008 global HEAD PARENT MERGE_HEAD commit_type
1009 global single_commit
1010 global ui_status_value ui_comm selected_commit_type
1011 global file_states selected_paths rescan_active
1013 gets $fd_wt tree_id
1014 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1015 error_popup "write-tree failed:\n\n$err"
1016 set ui_status_value {Commit failed.}
1017 unlock_index
1018 return
1021 # -- Create the commit.
1023 set cmd [list git commit-tree $tree_id]
1024 set parents [concat $PARENT $MERGE_HEAD]
1025 if {[llength $parents] > 0} {
1026 foreach p $parents {
1027 lappend cmd -p $p
1029 } else {
1030 # git commit-tree writes to stderr during initial commit.
1031 lappend cmd 2>/dev/null
1033 lappend cmd << $msg
1034 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1035 error_popup "commit-tree failed:\n\n$err"
1036 set ui_status_value {Commit failed.}
1037 unlock_index
1038 return
1041 # -- Update the HEAD ref.
1043 set reflogm commit
1044 if {$commit_type ne {normal}} {
1045 append reflogm " ($commit_type)"
1047 set i [string first "\n" $msg]
1048 if {$i >= 0} {
1049 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1050 } else {
1051 append reflogm {: } $msg
1053 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1054 if {[catch {eval exec $cmd} err]} {
1055 error_popup "update-ref failed:\n\n$err"
1056 set ui_status_value {Commit failed.}
1057 unlock_index
1058 return
1061 # -- Cleanup after ourselves.
1063 catch {file delete [file join [gitdir] MERGE_HEAD]}
1064 catch {file delete [file join [gitdir] MERGE_MSG]}
1065 catch {file delete [file join [gitdir] SQUASH_MSG]}
1066 catch {file delete [file join [gitdir] GITGUI_MSG]}
1068 # -- Let rerere do its thing.
1070 if {[file isdirectory [file join [gitdir] rr-cache]]} {
1071 catch {exec git rerere}
1074 # -- Run the post-commit hook.
1076 set pchook [file join [gitdir] hooks post-commit]
1077 if {[is_Windows] && [file isfile $pchook]} {
1078 set pchook [list sh -c [concat \
1079 "if test -x \"$pchook\";" \
1080 "then exec \"$pchook\";" \
1081 "fi"]]
1082 } elseif {![file executable $pchook]} {
1083 set pchook {}
1085 if {$pchook ne {}} {
1086 catch {exec $pchook &}
1089 $ui_comm delete 0.0 end
1090 $ui_comm edit reset
1091 $ui_comm edit modified false
1093 if {$single_commit} do_quit
1095 # -- Update in memory status
1097 set selected_commit_type new
1098 set commit_type normal
1099 set HEAD $cmt_id
1100 set PARENT $cmt_id
1101 set MERGE_HEAD [list]
1103 foreach path [array names file_states] {
1104 set s $file_states($path)
1105 set m [lindex $s 0]
1106 switch -glob -- $m {
1107 _O -
1108 _M -
1109 _D {continue}
1110 __ -
1111 A_ -
1112 M_ -
1113 DD {
1114 unset file_states($path)
1115 catch {unset selected_paths($path)}
1117 DO {
1118 set file_states($path) [list _O [lindex $s 1] {} {}]
1120 AM -
1121 AD -
1122 MM -
1123 MD -
1124 DM {
1125 set file_states($path) [list \
1126 _[string index $m 1] \
1127 [lindex $s 1] \
1128 [lindex $s 3] \
1134 display_all_files
1135 unlock_index
1136 reshow_diff
1137 set ui_status_value \
1138 "Changes committed as [string range $cmt_id 0 7]."
1141 ######################################################################
1143 ## fetch pull push
1145 proc fetch_from {remote} {
1146 set w [new_console "fetch $remote" \
1147 "Fetching new changes from $remote"]
1148 set cmd [list git fetch]
1149 lappend cmd $remote
1150 console_exec $w $cmd
1153 proc pull_remote {remote branch} {
1154 global HEAD commit_type file_states repo_config
1156 if {![lock_index update]} return
1158 # -- Our in memory state should match the repository.
1160 repository_state curType curHEAD curMERGE_HEAD
1161 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1162 info_popup {Last scanned state does not match repository state.
1164 Another Git program has modified this repository
1165 since the last scan. A rescan must be performed
1166 before a pull operation can be started.
1168 The rescan will be automatically started now.
1170 unlock_index
1171 rescan {set ui_status_value {Ready.}}
1172 return
1175 # -- No differences should exist before a pull.
1177 if {[array size file_states] != 0} {
1178 error_popup {Uncommitted but modified files are present.
1180 You should not perform a pull with unmodified
1181 files in your working directory as Git will be
1182 unable to recover from an incorrect merge.
1184 You should commit or revert all changes before
1185 starting a pull operation.
1187 unlock_index
1188 return
1191 set w [new_console "pull $remote $branch" \
1192 "Pulling new changes from branch $branch in $remote"]
1193 set cmd [list git pull]
1194 if {$repo_config(gui.pullsummary) eq {false}} {
1195 lappend cmd --no-summary
1197 lappend cmd $remote
1198 lappend cmd $branch
1199 console_exec $w $cmd [list post_pull_remote $remote $branch]
1202 proc post_pull_remote {remote branch success} {
1203 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1204 global ui_status_value
1206 unlock_index
1207 if {$success} {
1208 repository_state commit_type HEAD MERGE_HEAD
1209 set PARENT $HEAD
1210 set selected_commit_type new
1211 set ui_status_value "Pulling $branch from $remote complete."
1212 } else {
1213 rescan [list set ui_status_value \
1214 "Conflicts detected while pulling $branch from $remote."]
1218 proc push_to {remote} {
1219 set w [new_console "push $remote" \
1220 "Pushing changes to $remote"]
1221 set cmd [list git push]
1222 lappend cmd $remote
1223 console_exec $w $cmd
1226 ######################################################################
1228 ## ui helpers
1230 proc mapcol {state path} {
1231 global all_cols ui_other
1233 if {[catch {set r $all_cols($state)}]} {
1234 puts "error: no column for state={$state} $path"
1235 return $ui_other
1237 return $r
1240 proc mapicon {state path} {
1241 global all_icons
1243 if {[catch {set r $all_icons($state)}]} {
1244 puts "error: no icon for state={$state} $path"
1245 return file_plain
1247 return $r
1250 proc mapdesc {state path} {
1251 global all_descs
1253 if {[catch {set r $all_descs($state)}]} {
1254 puts "error: no desc for state={$state} $path"
1255 return $state
1257 return $r
1260 proc escape_path {path} {
1261 regsub -all "\n" $path "\\n" path
1262 return $path
1265 proc short_path {path} {
1266 return [escape_path [lindex [file split $path] end]]
1269 set next_icon_id 0
1270 set null_sha1 [string repeat 0 40]
1272 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1273 global file_states next_icon_id null_sha1
1275 set s0 [string index $new_state 0]
1276 set s1 [string index $new_state 1]
1278 if {[catch {set info $file_states($path)}]} {
1279 set state __
1280 set icon n[incr next_icon_id]
1281 } else {
1282 set state [lindex $info 0]
1283 set icon [lindex $info 1]
1284 if {$head_info eq {}} {set head_info [lindex $info 2]}
1285 if {$index_info eq {}} {set index_info [lindex $info 3]}
1288 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1289 elseif {$s0 eq {_}} {set s0 _}
1291 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1292 elseif {$s1 eq {_}} {set s1 _}
1294 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1295 set head_info [list 0 $null_sha1]
1296 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1297 && $head_info eq {}} {
1298 set head_info $index_info
1301 set file_states($path) [list $s0$s1 $icon \
1302 $head_info $index_info \
1304 return $state
1307 proc display_file {path state} {
1308 global file_states file_lists selected_paths
1310 set old_m [merge_state $path $state]
1311 set s $file_states($path)
1312 set new_m [lindex $s 0]
1313 set new_w [mapcol $new_m $path]
1314 set old_w [mapcol $old_m $path]
1315 set new_icon [mapicon $new_m $path]
1317 if {$new_m eq {__}} {
1318 set lno [lsearch -sorted $file_lists($old_w) $path]
1319 if {$lno >= 0} {
1320 set file_lists($old_w) \
1321 [lreplace $file_lists($old_w) $lno $lno]
1322 incr lno
1323 $old_w conf -state normal
1324 $old_w delete $lno.0 [expr {$lno + 1}].0
1325 $old_w conf -state disabled
1327 unset file_states($path)
1328 catch {unset selected_paths($path)}
1329 return
1332 if {$new_w ne $old_w} {
1333 set lno [lsearch -sorted $file_lists($old_w) $path]
1334 if {$lno >= 0} {
1335 set file_lists($old_w) \
1336 [lreplace $file_lists($old_w) $lno $lno]
1337 incr lno
1338 $old_w conf -state normal
1339 $old_w delete $lno.0 [expr {$lno + 1}].0
1340 $old_w conf -state disabled
1343 lappend file_lists($new_w) $path
1344 set file_lists($new_w) [lsort $file_lists($new_w)]
1345 set lno [lsearch -sorted $file_lists($new_w) $path]
1346 incr lno
1347 $new_w conf -state normal
1348 $new_w image create $lno.0 \
1349 -align center -padx 5 -pady 1 \
1350 -name [lindex $s 1] \
1351 -image $new_icon
1352 $new_w insert $lno.1 "[escape_path $path]\n"
1353 if {[catch {set in_sel $selected_paths($path)}]} {
1354 set in_sel 0
1356 if {$in_sel} {
1357 $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1359 $new_w conf -state disabled
1360 } elseif {$new_icon ne [mapicon $old_m $path]} {
1361 $new_w conf -state normal
1362 $new_w image conf [lindex $s 1] -image $new_icon
1363 $new_w conf -state disabled
1367 proc display_all_files {} {
1368 global ui_index ui_other
1369 global file_states file_lists
1370 global last_clicked selected_paths
1372 $ui_index conf -state normal
1373 $ui_other conf -state normal
1375 $ui_index delete 0.0 end
1376 $ui_other delete 0.0 end
1377 set last_clicked {}
1379 set file_lists($ui_index) [list]
1380 set file_lists($ui_other) [list]
1382 foreach path [lsort [array names file_states]] {
1383 set s $file_states($path)
1384 set m [lindex $s 0]
1385 set w [mapcol $m $path]
1386 lappend file_lists($w) $path
1387 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1388 $w image create end \
1389 -align center -padx 5 -pady 1 \
1390 -name [lindex $s 1] \
1391 -image [mapicon $m $path]
1392 $w insert end "[escape_path $path]\n"
1393 if {[catch {set in_sel $selected_paths($path)}]} {
1394 set in_sel 0
1396 if {$in_sel} {
1397 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1401 $ui_index conf -state disabled
1402 $ui_other conf -state disabled
1405 proc update_indexinfo {msg pathList after} {
1406 global update_index_cp ui_status_value
1408 if {![lock_index update]} return
1410 set update_index_cp 0
1411 set pathList [lsort $pathList]
1412 set totalCnt [llength $pathList]
1413 set batch [expr {int($totalCnt * .01) + 1}]
1414 if {$batch > 25} {set batch 25}
1416 set ui_status_value [format \
1417 "$msg... %i/%i files (%.2f%%)" \
1418 $update_index_cp \
1419 $totalCnt \
1420 0.0]
1421 set fd [open "| git update-index -z --index-info" w]
1422 fconfigure $fd \
1423 -blocking 0 \
1424 -buffering full \
1425 -buffersize 512 \
1426 -translation binary
1427 fileevent $fd writable [list \
1428 write_update_indexinfo \
1429 $fd \
1430 $pathList \
1431 $totalCnt \
1432 $batch \
1433 $msg \
1434 $after \
1438 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1439 global update_index_cp ui_status_value
1440 global file_states current_diff
1442 if {$update_index_cp >= $totalCnt} {
1443 close $fd
1444 unlock_index
1445 uplevel #0 $after
1446 return
1449 for {set i $batch} \
1450 {$update_index_cp < $totalCnt && $i > 0} \
1451 {incr i -1} {
1452 set path [lindex $pathList $update_index_cp]
1453 incr update_index_cp
1455 set s $file_states($path)
1456 switch -glob -- [lindex $s 0] {
1457 A? {set new _O}
1458 M? {set new _M}
1459 D_ {set new _D}
1460 D? {set new _?}
1461 ?? {continue}
1463 set info [lindex $s 2]
1464 if {$info eq {}} continue
1466 puts -nonewline $fd $info
1467 puts -nonewline $fd "\t"
1468 puts -nonewline $fd $path
1469 puts -nonewline $fd "\0"
1470 display_file $path $new
1473 set ui_status_value [format \
1474 "$msg... %i/%i files (%.2f%%)" \
1475 $update_index_cp \
1476 $totalCnt \
1477 [expr {100.0 * $update_index_cp / $totalCnt}]]
1480 proc update_index {msg pathList after} {
1481 global update_index_cp ui_status_value
1483 if {![lock_index update]} return
1485 set update_index_cp 0
1486 set pathList [lsort $pathList]
1487 set totalCnt [llength $pathList]
1488 set batch [expr {int($totalCnt * .01) + 1}]
1489 if {$batch > 25} {set batch 25}
1491 set ui_status_value [format \
1492 "$msg... %i/%i files (%.2f%%)" \
1493 $update_index_cp \
1494 $totalCnt \
1495 0.0]
1496 set fd [open "| git update-index --add --remove -z --stdin" w]
1497 fconfigure $fd \
1498 -blocking 0 \
1499 -buffering full \
1500 -buffersize 512 \
1501 -translation binary
1502 fileevent $fd writable [list \
1503 write_update_index \
1504 $fd \
1505 $pathList \
1506 $totalCnt \
1507 $batch \
1508 $msg \
1509 $after \
1513 proc write_update_index {fd pathList totalCnt batch msg after} {
1514 global update_index_cp ui_status_value
1515 global file_states current_diff
1517 if {$update_index_cp >= $totalCnt} {
1518 close $fd
1519 unlock_index
1520 uplevel #0 $after
1521 return
1524 for {set i $batch} \
1525 {$update_index_cp < $totalCnt && $i > 0} \
1526 {incr i -1} {
1527 set path [lindex $pathList $update_index_cp]
1528 incr update_index_cp
1530 switch -glob -- [lindex $file_states($path) 0] {
1531 AD -
1532 MD -
1533 UD -
1534 _D {set new DD}
1536 _M -
1537 MM -
1538 UM -
1539 U_ -
1540 M_ {set new M_}
1542 _O -
1543 AM -
1544 A_ {set new A_}
1546 ?? {continue}
1549 puts -nonewline $fd $path
1550 puts -nonewline $fd "\0"
1551 display_file $path $new
1554 set ui_status_value [format \
1555 "$msg... %i/%i files (%.2f%%)" \
1556 $update_index_cp \
1557 $totalCnt \
1558 [expr {100.0 * $update_index_cp / $totalCnt}]]
1561 proc checkout_index {msg pathList after} {
1562 global update_index_cp ui_status_value
1564 if {![lock_index update]} return
1566 set update_index_cp 0
1567 set pathList [lsort $pathList]
1568 set totalCnt [llength $pathList]
1569 set batch [expr {int($totalCnt * .01) + 1}]
1570 if {$batch > 25} {set batch 25}
1572 set ui_status_value [format \
1573 "$msg... %i/%i files (%.2f%%)" \
1574 $update_index_cp \
1575 $totalCnt \
1576 0.0]
1577 set cmd [list git checkout-index]
1578 lappend cmd --index
1579 lappend cmd --quiet
1580 lappend cmd --force
1581 lappend cmd -z
1582 lappend cmd --stdin
1583 set fd [open "| $cmd " w]
1584 fconfigure $fd \
1585 -blocking 0 \
1586 -buffering full \
1587 -buffersize 512 \
1588 -translation binary
1589 fileevent $fd writable [list \
1590 write_checkout_index \
1591 $fd \
1592 $pathList \
1593 $totalCnt \
1594 $batch \
1595 $msg \
1596 $after \
1600 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1601 global update_index_cp ui_status_value
1602 global file_states current_diff
1604 if {$update_index_cp >= $totalCnt} {
1605 close $fd
1606 unlock_index
1607 uplevel #0 $after
1608 return
1611 for {set i $batch} \
1612 {$update_index_cp < $totalCnt && $i > 0} \
1613 {incr i -1} {
1614 set path [lindex $pathList $update_index_cp]
1615 incr update_index_cp
1617 switch -glob -- [lindex $file_states($path) 0] {
1618 AM -
1619 AD {set new A_}
1620 MM -
1621 MD {set new M_}
1622 _M -
1623 _D {set new __}
1624 ?? {continue}
1627 puts -nonewline $fd $path
1628 puts -nonewline $fd "\0"
1629 display_file $path $new
1632 set ui_status_value [format \
1633 "$msg... %i/%i files (%.2f%%)" \
1634 $update_index_cp \
1635 $totalCnt \
1636 [expr {100.0 * $update_index_cp / $totalCnt}]]
1639 ######################################################################
1641 ## branch management
1643 proc load_all_heads {} {
1644 global all_heads tracking_branches
1646 set all_heads [list]
1647 set cmd [list git for-each-ref]
1648 lappend cmd --format=%(refname)
1649 lappend cmd refs/heads
1650 set fd [open "| $cmd" r]
1651 while {[gets $fd line] > 0} {
1652 if {![catch {set info $tracking_branches($line)}]} continue
1653 if {![regsub ^refs/heads/ $line {} name]} continue
1654 lappend all_heads $name
1656 close $fd
1658 set all_heads [lsort $all_heads]
1661 proc populate_branch_menu {m} {
1662 global all_heads disable_on_lock
1664 $m add separator
1665 foreach b $all_heads {
1666 $m add radiobutton \
1667 -label $b \
1668 -command [list switch_branch $b] \
1669 -variable current_branch \
1670 -value $b \
1671 -font font_ui
1672 lappend disable_on_lock \
1673 [list $m entryconf [$m index last] -state]
1677 proc do_create_branch {} {
1678 error "NOT IMPLEMENTED"
1681 proc do_delete_branch {} {
1682 error "NOT IMPLEMENTED"
1685 proc switch_branch {b} {
1686 global HEAD commit_type file_states current_branch
1687 global selected_commit_type ui_comm
1689 if {![lock_index switch]} return
1691 # -- Backup the selected branch (repository_state resets it)
1693 set new_branch $current_branch
1695 # -- Our in memory state should match the repository.
1697 repository_state curType curHEAD curMERGE_HEAD
1698 if {[string match amend* $commit_type]
1699 && $curType eq {normal}
1700 && $curHEAD eq $HEAD} {
1701 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1702 info_popup {Last scanned state does not match repository state.
1704 Another Git program has modified this repository
1705 since the last scan. A rescan must be performed
1706 before the current branch can be changed.
1708 The rescan will be automatically started now.
1710 unlock_index
1711 rescan {set ui_status_value {Ready.}}
1712 return
1715 # -- Toss the message buffer if we are in amend mode.
1717 if {[string match amend* $curType]} {
1718 $ui_comm delete 0.0 end
1719 $ui_comm edit reset
1720 $ui_comm edit modified false
1723 set selected_commit_type new
1724 set current_branch $new_branch
1726 unlock_index
1727 error "NOT FINISHED"
1730 ######################################################################
1732 ## remote management
1734 proc load_all_remotes {} {
1735 global repo_config
1736 global all_remotes tracking_branches
1738 set all_remotes [list]
1739 array unset tracking_branches
1741 set rm_dir [file join [gitdir] remotes]
1742 if {[file isdirectory $rm_dir]} {
1743 set all_remotes [glob \
1744 -types f \
1745 -tails \
1746 -nocomplain \
1747 -directory $rm_dir *]
1749 foreach name $all_remotes {
1750 catch {
1751 set fd [open [file join $rm_dir $name] r]
1752 while {[gets $fd line] >= 0} {
1753 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
1754 $line line src dst]} continue
1755 if {![regexp ^refs/ $dst]} {
1756 set dst "refs/heads/$dst"
1758 set tracking_branches($dst) [list $name $src]
1760 close $fd
1765 foreach line [array names repo_config remote.*.url] {
1766 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
1767 lappend all_remotes $name
1769 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
1770 set fl {}
1772 foreach line $fl {
1773 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
1774 if {![regexp ^refs/ $dst]} {
1775 set dst "refs/heads/$dst"
1777 set tracking_branches($dst) [list $name $src]
1781 set all_remotes [lsort -unique $all_remotes]
1784 proc populate_fetch_menu {m} {
1785 global all_remotes repo_config
1787 foreach r $all_remotes {
1788 set enable 0
1789 if {![catch {set a $repo_config(remote.$r.url)}]} {
1790 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1791 set enable 1
1793 } else {
1794 catch {
1795 set fd [open [file join [gitdir] remotes $r] r]
1796 while {[gets $fd n] >= 0} {
1797 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1798 set enable 1
1799 break
1802 close $fd
1806 if {$enable} {
1807 $m add command \
1808 -label "Fetch from $r..." \
1809 -command [list fetch_from $r] \
1810 -font font_ui
1815 proc populate_push_menu {m} {
1816 global all_remotes repo_config
1818 foreach r $all_remotes {
1819 set enable 0
1820 if {![catch {set a $repo_config(remote.$r.url)}]} {
1821 if {![catch {set a $repo_config(remote.$r.push)}]} {
1822 set enable 1
1824 } else {
1825 catch {
1826 set fd [open [file join [gitdir] remotes $r] r]
1827 while {[gets $fd n] >= 0} {
1828 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1829 set enable 1
1830 break
1833 close $fd
1837 if {$enable} {
1838 $m add command \
1839 -label "Push to $r..." \
1840 -command [list push_to $r] \
1841 -font font_ui
1846 proc populate_pull_menu {m} {
1847 global repo_config all_remotes disable_on_lock
1849 foreach remote $all_remotes {
1850 set rb_list [list]
1851 if {[array get repo_config remote.$remote.url] ne {}} {
1852 if {[array get repo_config remote.$remote.fetch] ne {}} {
1853 foreach line $repo_config(remote.$remote.fetch) {
1854 if {[regexp {^([^:]+):} $line line rb]} {
1855 lappend rb_list $rb
1859 } else {
1860 catch {
1861 set fd [open [file join [gitdir] remotes $remote] r]
1862 while {[gets $fd line] >= 0} {
1863 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1864 lappend rb_list $rb
1867 close $fd
1871 foreach rb $rb_list {
1872 regsub ^refs/heads/ $rb {} rb_short
1873 $m add command \
1874 -label "Branch $rb_short from $remote..." \
1875 -command [list pull_remote $remote $rb] \
1876 -font font_ui
1877 lappend disable_on_lock \
1878 [list $m entryconf [$m index last] -state]
1883 ######################################################################
1885 ## icons
1887 set filemask {
1888 #define mask_width 14
1889 #define mask_height 15
1890 static unsigned char mask_bits[] = {
1891 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1892 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1893 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1896 image create bitmap file_plain -background white -foreground black -data {
1897 #define plain_width 14
1898 #define plain_height 15
1899 static unsigned char plain_bits[] = {
1900 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1901 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1902 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1903 } -maskdata $filemask
1905 image create bitmap file_mod -background white -foreground blue -data {
1906 #define mod_width 14
1907 #define mod_height 15
1908 static unsigned char mod_bits[] = {
1909 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1910 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1911 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1912 } -maskdata $filemask
1914 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1915 #define file_fulltick_width 14
1916 #define file_fulltick_height 15
1917 static unsigned char file_fulltick_bits[] = {
1918 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1919 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1920 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1921 } -maskdata $filemask
1923 image create bitmap file_parttick -background white -foreground "#005050" -data {
1924 #define parttick_width 14
1925 #define parttick_height 15
1926 static unsigned char parttick_bits[] = {
1927 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1928 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1929 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1930 } -maskdata $filemask
1932 image create bitmap file_question -background white -foreground black -data {
1933 #define file_question_width 14
1934 #define file_question_height 15
1935 static unsigned char file_question_bits[] = {
1936 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1937 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1938 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1939 } -maskdata $filemask
1941 image create bitmap file_removed -background white -foreground red -data {
1942 #define file_removed_width 14
1943 #define file_removed_height 15
1944 static unsigned char file_removed_bits[] = {
1945 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1946 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1947 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1948 } -maskdata $filemask
1950 image create bitmap file_merge -background white -foreground blue -data {
1951 #define file_merge_width 14
1952 #define file_merge_height 15
1953 static unsigned char file_merge_bits[] = {
1954 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1955 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1956 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1957 } -maskdata $filemask
1959 set ui_index .vpane.files.index.list
1960 set ui_other .vpane.files.other.list
1961 set max_status_desc 0
1962 foreach i {
1963 {__ i plain "Unmodified"}
1964 {_M i mod "Modified"}
1965 {M_ i fulltick "Added to commit"}
1966 {MM i parttick "Partially included"}
1967 {MD i question "Added (but gone)"}
1969 {_O o plain "Untracked"}
1970 {A_ o fulltick "Added by commit"}
1971 {AM o parttick "Partially added"}
1972 {AD o question "Added (but gone)"}
1974 {_D i question "Missing"}
1975 {DD i removed "Removed by commit"}
1976 {D_ i removed "Removed by commit"}
1977 {DO i removed "Removed (still exists)"}
1978 {DM i removed "Removed (but modified)"}
1980 {UD i merge "Merge conflicts"}
1981 {UM i merge "Merge conflicts"}
1982 {U_ i merge "Merge conflicts"}
1984 if {$max_status_desc < [string length [lindex $i 3]]} {
1985 set max_status_desc [string length [lindex $i 3]]
1987 if {[lindex $i 1] eq {i}} {
1988 set all_cols([lindex $i 0]) $ui_index
1989 } else {
1990 set all_cols([lindex $i 0]) $ui_other
1992 set all_icons([lindex $i 0]) file_[lindex $i 2]
1993 set all_descs([lindex $i 0]) [lindex $i 3]
1995 unset filemask i
1997 ######################################################################
1999 ## util
2001 proc is_MacOSX {} {
2002 global tcl_platform tk_library
2003 if {[tk windowingsystem] eq {aqua}} {
2004 return 1
2006 return 0
2009 proc is_Windows {} {
2010 global tcl_platform
2011 if {$tcl_platform(platform) eq {windows}} {
2012 return 1
2014 return 0
2017 proc bind_button3 {w cmd} {
2018 bind $w <Any-Button-3> $cmd
2019 if {[is_MacOSX]} {
2020 bind $w <Control-Button-1> $cmd
2024 proc incr_font_size {font {amt 1}} {
2025 set sz [font configure $font -size]
2026 incr sz $amt
2027 font configure $font -size $sz
2028 font configure ${font}bold -size $sz
2031 proc hook_failed_popup {hook msg} {
2032 set w .hookfail
2033 toplevel $w
2035 frame $w.m
2036 label $w.m.l1 -text "$hook hook failed:" \
2037 -anchor w \
2038 -justify left \
2039 -font font_uibold
2040 text $w.m.t \
2041 -background white -borderwidth 1 \
2042 -relief sunken \
2043 -width 80 -height 10 \
2044 -font font_diff \
2045 -yscrollcommand [list $w.m.sby set]
2046 label $w.m.l2 \
2047 -text {You must correct the above errors before committing.} \
2048 -anchor w \
2049 -justify left \
2050 -font font_uibold
2051 scrollbar $w.m.sby -command [list $w.m.t yview]
2052 pack $w.m.l1 -side top -fill x
2053 pack $w.m.l2 -side bottom -fill x
2054 pack $w.m.sby -side right -fill y
2055 pack $w.m.t -side left -fill both -expand 1
2056 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2058 $w.m.t insert 1.0 $msg
2059 $w.m.t conf -state disabled
2061 button $w.ok -text OK \
2062 -width 15 \
2063 -font font_ui \
2064 -command "destroy $w"
2065 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2067 bind $w <Visibility> "grab $w; focus $w"
2068 bind $w <Key-Return> "destroy $w"
2069 wm title $w "[appname] ([reponame]): error"
2070 tkwait window $w
2073 set next_console_id 0
2075 proc new_console {short_title long_title} {
2076 global next_console_id console_data
2077 set w .console[incr next_console_id]
2078 set console_data($w) [list $short_title $long_title]
2079 return [console_init $w]
2082 proc console_init {w} {
2083 global console_cr console_data M1B
2085 set console_cr($w) 1.0
2086 toplevel $w
2087 frame $w.m
2088 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2089 -anchor w \
2090 -justify left \
2091 -font font_uibold
2092 text $w.m.t \
2093 -background white -borderwidth 1 \
2094 -relief sunken \
2095 -width 80 -height 10 \
2096 -font font_diff \
2097 -state disabled \
2098 -yscrollcommand [list $w.m.sby set]
2099 label $w.m.s -text {Working... please wait...} \
2100 -anchor w \
2101 -justify left \
2102 -font font_uibold
2103 scrollbar $w.m.sby -command [list $w.m.t yview]
2104 pack $w.m.l1 -side top -fill x
2105 pack $w.m.s -side bottom -fill x
2106 pack $w.m.sby -side right -fill y
2107 pack $w.m.t -side left -fill both -expand 1
2108 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2110 menu $w.ctxm -tearoff 0
2111 $w.ctxm add command -label "Copy" \
2112 -font font_ui \
2113 -command "tk_textCopy $w.m.t"
2114 $w.ctxm add command -label "Select All" \
2115 -font font_ui \
2116 -command "$w.m.t tag add sel 0.0 end"
2117 $w.ctxm add command -label "Copy All" \
2118 -font font_ui \
2119 -command "
2120 $w.m.t tag add sel 0.0 end
2121 tk_textCopy $w.m.t
2122 $w.m.t tag remove sel 0.0 end
2125 button $w.ok -text {Close} \
2126 -font font_ui \
2127 -state disabled \
2128 -command "destroy $w"
2129 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2131 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2132 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2133 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2134 bind $w <Visibility> "focus $w"
2135 wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2136 return $w
2139 proc console_exec {w cmd {after {}}} {
2140 # -- Windows tosses the enviroment when we exec our child.
2141 # But most users need that so we have to relogin. :-(
2143 if {[is_Windows]} {
2144 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2147 # -- Tcl won't let us redirect both stdout and stderr to
2148 # the same pipe. So pass it through cat...
2150 set cmd [concat | $cmd |& cat]
2152 set fd_f [open $cmd r]
2153 fconfigure $fd_f -blocking 0 -translation binary
2154 fileevent $fd_f readable [list console_read $w $fd_f $after]
2157 proc console_read {w fd after} {
2158 global console_cr console_data
2160 set buf [read $fd]
2161 if {$buf ne {}} {
2162 if {![winfo exists $w]} {console_init $w}
2163 $w.m.t conf -state normal
2164 set c 0
2165 set n [string length $buf]
2166 while {$c < $n} {
2167 set cr [string first "\r" $buf $c]
2168 set lf [string first "\n" $buf $c]
2169 if {$cr < 0} {set cr [expr {$n + 1}]}
2170 if {$lf < 0} {set lf [expr {$n + 1}]}
2172 if {$lf < $cr} {
2173 $w.m.t insert end [string range $buf $c $lf]
2174 set console_cr($w) [$w.m.t index {end -1c}]
2175 set c $lf
2176 incr c
2177 } else {
2178 $w.m.t delete $console_cr($w) end
2179 $w.m.t insert end "\n"
2180 $w.m.t insert end [string range $buf $c $cr]
2181 set c $cr
2182 incr c
2185 $w.m.t conf -state disabled
2186 $w.m.t see end
2189 fconfigure $fd -blocking 1
2190 if {[eof $fd]} {
2191 if {[catch {close $fd}]} {
2192 if {![winfo exists $w]} {console_init $w}
2193 $w.m.s conf -background red -text {Error: Command Failed}
2194 $w.ok conf -state normal
2195 set ok 0
2196 } elseif {[winfo exists $w]} {
2197 $w.m.s conf -background green -text {Success}
2198 $w.ok conf -state normal
2199 set ok 1
2201 array unset console_cr $w
2202 array unset console_data $w
2203 if {$after ne {}} {
2204 uplevel #0 $after $ok
2206 return
2208 fconfigure $fd -blocking 0
2211 ######################################################################
2213 ## ui commands
2215 set starting_gitk_msg {Please wait... Starting gitk...}
2217 proc do_gitk {revs} {
2218 global ui_status_value starting_gitk_msg
2220 set cmd gitk
2221 if {$revs ne {}} {
2222 append cmd { }
2223 append cmd $revs
2225 if {[is_Windows]} {
2226 set cmd "sh -c \"exec $cmd\""
2228 append cmd { &}
2230 if {[catch {eval exec $cmd} err]} {
2231 error_popup "Failed to start gitk:\n\n$err"
2232 } else {
2233 set ui_status_value $starting_gitk_msg
2234 after 10000 {
2235 if {$ui_status_value eq $starting_gitk_msg} {
2236 set ui_status_value {Ready.}
2242 proc do_gc {} {
2243 set w [new_console {gc} {Compressing the object database}]
2244 console_exec $w {git gc}
2247 proc do_fsck_objects {} {
2248 set w [new_console {fsck-objects} \
2249 {Verifying the object database with fsck-objects}]
2250 set cmd [list git fsck-objects]
2251 lappend cmd --full
2252 lappend cmd --cache
2253 lappend cmd --strict
2254 console_exec $w $cmd
2257 set is_quitting 0
2259 proc do_quit {} {
2260 global ui_comm is_quitting repo_config commit_type
2262 if {$is_quitting} return
2263 set is_quitting 1
2265 # -- Stash our current commit buffer.
2267 set save [file join [gitdir] GITGUI_MSG]
2268 set msg [string trim [$ui_comm get 0.0 end]]
2269 if {![string match amend* $commit_type]
2270 && [$ui_comm edit modified]
2271 && $msg ne {}} {
2272 catch {
2273 set fd [open $save w]
2274 puts $fd [string trim [$ui_comm get 0.0 end]]
2275 close $fd
2277 } else {
2278 catch {file delete $save}
2281 # -- Stash our current window geometry into this repository.
2283 set cfg_geometry [list]
2284 lappend cfg_geometry [wm geometry .]
2285 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2286 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2287 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2288 set rc_geometry {}
2290 if {$cfg_geometry ne $rc_geometry} {
2291 catch {exec git repo-config gui.geometry $cfg_geometry}
2294 destroy .
2297 proc do_rescan {} {
2298 rescan {set ui_status_value {Ready.}}
2301 proc remove_helper {txt paths} {
2302 global file_states current_diff
2304 if {![lock_index begin-update]} return
2306 set pathList [list]
2307 set after {}
2308 foreach path $paths {
2309 switch -glob -- [lindex $file_states($path) 0] {
2310 A? -
2311 M? -
2312 D? {
2313 lappend pathList $path
2314 if {$path eq $current_diff} {
2315 set after {reshow_diff;}
2320 if {$pathList eq {}} {
2321 unlock_index
2322 } else {
2323 update_indexinfo \
2324 $txt \
2325 $pathList \
2326 [concat $after {set ui_status_value {Ready.}}]
2330 proc do_remove_selection {} {
2331 global current_diff selected_paths
2333 if {[array size selected_paths] > 0} {
2334 remove_helper \
2335 {Removing selected files from commit} \
2336 [array names selected_paths]
2337 } elseif {$current_diff ne {}} {
2338 remove_helper \
2339 "Removing [short_path $current_diff] from commit" \
2340 [list $current_diff]
2344 proc include_helper {txt paths} {
2345 global file_states current_diff
2347 if {![lock_index begin-update]} return
2349 set pathList [list]
2350 set after {}
2351 foreach path $paths {
2352 switch -glob -- [lindex $file_states($path) 0] {
2353 AM -
2354 AD -
2355 MM -
2356 MD -
2357 U? -
2358 _M -
2359 _D -
2360 _O {
2361 lappend pathList $path
2362 if {$path eq $current_diff} {
2363 set after {reshow_diff;}
2368 if {$pathList eq {}} {
2369 unlock_index
2370 } else {
2371 update_index \
2372 $txt \
2373 $pathList \
2374 [concat $after {set ui_status_value {Ready to commit.}}]
2378 proc do_include_selection {} {
2379 global current_diff selected_paths
2381 if {[array size selected_paths] > 0} {
2382 include_helper \
2383 {Adding selected files} \
2384 [array names selected_paths]
2385 } elseif {$current_diff ne {}} {
2386 include_helper \
2387 "Adding [short_path $current_diff]" \
2388 [list $current_diff]
2392 proc do_include_all {} {
2393 global file_states
2395 set paths [list]
2396 foreach path [array names file_states] {
2397 switch -- [lindex $file_states($path) 0] {
2398 AM -
2399 AD -
2400 MM -
2401 MD -
2402 _M -
2403 _D {lappend paths $path}
2406 include_helper \
2407 {Adding all modified files} \
2408 $paths
2411 proc revert_helper {txt paths} {
2412 global file_states current_diff
2414 if {![lock_index begin-update]} return
2416 set pathList [list]
2417 set after {}
2418 foreach path $paths {
2419 switch -glob -- [lindex $file_states($path) 0] {
2420 AM -
2421 AD -
2422 MM -
2423 MD -
2424 _M -
2425 _D {
2426 lappend pathList $path
2427 if {$path eq $current_diff} {
2428 set after {reshow_diff;}
2434 set n [llength $pathList]
2435 if {$n == 0} {
2436 unlock_index
2437 return
2438 } elseif {$n == 1} {
2439 set s "[short_path [lindex $pathList]]"
2440 } else {
2441 set s "these $n files"
2444 set reply [tk_dialog \
2445 .confirm_revert \
2446 "[appname] ([reponame])" \
2447 "Revert changes in $s?
2449 Any unadded changes will be permanently lost by the revert." \
2450 question \
2452 {Do Nothing} \
2453 {Revert Changes} \
2455 if {$reply == 1} {
2456 checkout_index \
2457 $txt \
2458 $pathList \
2459 [concat $after {set ui_status_value {Ready.}}]
2460 } else {
2461 unlock_index
2465 proc do_revert_selection {} {
2466 global current_diff selected_paths
2468 if {[array size selected_paths] > 0} {
2469 revert_helper \
2470 {Reverting selected files} \
2471 [array names selected_paths]
2472 } elseif {$current_diff ne {}} {
2473 revert_helper \
2474 "Reverting [short_path $current_diff]" \
2475 [list $current_diff]
2479 proc do_signoff {} {
2480 global ui_comm
2482 set me [committer_ident]
2483 if {$me eq {}} return
2485 set sob "Signed-off-by: $me"
2486 set last [$ui_comm get {end -1c linestart} {end -1c}]
2487 if {$last ne $sob} {
2488 $ui_comm edit separator
2489 if {$last ne {}
2490 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2491 $ui_comm insert end "\n"
2493 $ui_comm insert end "\n$sob"
2494 $ui_comm edit separator
2495 $ui_comm see end
2499 proc do_select_commit_type {} {
2500 global commit_type selected_commit_type
2502 if {$selected_commit_type eq {new}
2503 && [string match amend* $commit_type]} {
2504 create_new_commit
2505 } elseif {$selected_commit_type eq {amend}
2506 && ![string match amend* $commit_type]} {
2507 load_last_commit
2509 # The amend request was rejected...
2511 if {![string match amend* $commit_type]} {
2512 set selected_commit_type new
2517 proc do_commit {} {
2518 commit_tree
2521 proc do_about {} {
2522 global appvers copyright
2523 global tcl_patchLevel tk_patchLevel
2525 set w .about_dialog
2526 toplevel $w
2527 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2529 label $w.header -text "About [appname]" \
2530 -font font_uibold
2531 pack $w.header -side top -fill x
2533 frame $w.buttons
2534 button $w.buttons.close -text {Close} \
2535 -font font_ui \
2536 -command [list destroy $w]
2537 pack $w.buttons.close -side right
2538 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2540 label $w.desc \
2541 -text "[appname] - a commit creation tool for Git.
2542 $copyright" \
2543 -padx 5 -pady 5 \
2544 -justify left \
2545 -anchor w \
2546 -borderwidth 1 \
2547 -relief solid \
2548 -font font_ui
2549 pack $w.desc -side top -fill x -padx 5 -pady 5
2551 set v {}
2552 append v "[appname] version $appvers\n"
2553 append v "[exec git version]\n"
2554 append v "\n"
2555 if {$tcl_patchLevel eq $tk_patchLevel} {
2556 append v "Tcl/Tk version $tcl_patchLevel"
2557 } else {
2558 append v "Tcl version $tcl_patchLevel"
2559 append v ", Tk version $tk_patchLevel"
2562 label $w.vers \
2563 -text $v \
2564 -padx 5 -pady 5 \
2565 -justify left \
2566 -anchor w \
2567 -borderwidth 1 \
2568 -relief solid \
2569 -font font_ui
2570 pack $w.vers -side top -fill x -padx 5 -pady 5
2572 menu $w.ctxm -tearoff 0
2573 $w.ctxm add command \
2574 -label {Copy} \
2575 -font font_ui \
2576 -command "
2577 clipboard clear
2578 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2581 bind $w <Visibility> "grab $w; focus $w"
2582 bind $w <Key-Escape> "destroy $w"
2583 bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2584 wm title $w "About [appname]"
2585 tkwait window $w
2588 proc do_options {} {
2589 global repo_config global_config font_descs
2590 global repo_config_new global_config_new
2592 array unset repo_config_new
2593 array unset global_config_new
2594 foreach name [array names repo_config] {
2595 set repo_config_new($name) $repo_config($name)
2597 load_config 1
2598 foreach name [array names repo_config] {
2599 switch -- $name {
2600 gui.diffcontext {continue}
2602 set repo_config_new($name) $repo_config($name)
2604 foreach name [array names global_config] {
2605 set global_config_new($name) $global_config($name)
2608 set w .options_editor
2609 toplevel $w
2610 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2612 label $w.header -text "[appname] Options" \
2613 -font font_uibold
2614 pack $w.header -side top -fill x
2616 frame $w.buttons
2617 button $w.buttons.restore -text {Restore Defaults} \
2618 -font font_ui \
2619 -command do_restore_defaults
2620 pack $w.buttons.restore -side left
2621 button $w.buttons.save -text Save \
2622 -font font_ui \
2623 -command [list do_save_config $w]
2624 pack $w.buttons.save -side right
2625 button $w.buttons.cancel -text {Cancel} \
2626 -font font_ui \
2627 -command [list destroy $w]
2628 pack $w.buttons.cancel -side right
2629 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2631 labelframe $w.repo -text "[reponame] Repository" \
2632 -font font_ui \
2633 -relief raised -borderwidth 2
2634 labelframe $w.global -text {Global (All Repositories)} \
2635 -font font_ui \
2636 -relief raised -borderwidth 2
2637 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2638 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2640 foreach option {
2641 {b partialinclude {Allow Partially Added Files}}
2642 {b pullsummary {Show Pull Summary}}
2643 {b trustmtime {Trust File Modification Timestamps}}
2644 {i diffcontext {Number of Diff Context Lines}}
2646 set type [lindex $option 0]
2647 set name [lindex $option 1]
2648 set text [lindex $option 2]
2649 foreach f {repo global} {
2650 switch $type {
2652 checkbutton $w.$f.$name -text $text \
2653 -variable ${f}_config_new(gui.$name) \
2654 -onvalue true \
2655 -offvalue false \
2656 -font font_ui
2657 pack $w.$f.$name -side top -anchor w
2660 frame $w.$f.$name
2661 label $w.$f.$name.l -text "$text:" -font font_ui
2662 pack $w.$f.$name.l -side left -anchor w -fill x
2663 spinbox $w.$f.$name.v \
2664 -textvariable ${f}_config_new(gui.$name) \
2665 -from 1 -to 99 -increment 1 \
2666 -width 3 \
2667 -font font_ui
2668 pack $w.$f.$name.v -side right -anchor e
2669 pack $w.$f.$name -side top -anchor w -fill x
2675 set all_fonts [lsort [font families]]
2676 foreach option $font_descs {
2677 set name [lindex $option 0]
2678 set font [lindex $option 1]
2679 set text [lindex $option 2]
2681 set global_config_new(gui.$font^^family) \
2682 [font configure $font -family]
2683 set global_config_new(gui.$font^^size) \
2684 [font configure $font -size]
2686 frame $w.global.$name
2687 label $w.global.$name.l -text "$text:" -font font_ui
2688 pack $w.global.$name.l -side left -anchor w -fill x
2689 eval tk_optionMenu $w.global.$name.family \
2690 global_config_new(gui.$font^^family) \
2691 $all_fonts
2692 spinbox $w.global.$name.size \
2693 -textvariable global_config_new(gui.$font^^size) \
2694 -from 2 -to 80 -increment 1 \
2695 -width 3 \
2696 -font font_ui
2697 pack $w.global.$name.size -side right -anchor e
2698 pack $w.global.$name.family -side right -anchor e
2699 pack $w.global.$name -side top -anchor w -fill x
2702 bind $w <Visibility> "grab $w; focus $w"
2703 bind $w <Key-Escape> "destroy $w"
2704 wm title $w "[appname] ([reponame]): Options"
2705 tkwait window $w
2708 proc do_restore_defaults {} {
2709 global font_descs default_config repo_config
2710 global repo_config_new global_config_new
2712 foreach name [array names default_config] {
2713 set repo_config_new($name) $default_config($name)
2714 set global_config_new($name) $default_config($name)
2717 foreach option $font_descs {
2718 set name [lindex $option 0]
2719 set repo_config(gui.$name) $default_config(gui.$name)
2721 apply_config
2723 foreach option $font_descs {
2724 set name [lindex $option 0]
2725 set font [lindex $option 1]
2726 set global_config_new(gui.$font^^family) \
2727 [font configure $font -family]
2728 set global_config_new(gui.$font^^size) \
2729 [font configure $font -size]
2733 proc do_save_config {w} {
2734 if {[catch {save_config} err]} {
2735 error_popup "Failed to completely save options:\n\n$err"
2737 reshow_diff
2738 destroy $w
2741 proc do_windows_shortcut {} {
2742 global argv0
2744 if {[catch {
2745 set desktop [exec cygpath \
2746 --windows \
2747 --absolute \
2748 --long-name \
2749 --desktop]
2750 }]} {
2751 set desktop .
2753 set fn [tk_getSaveFile \
2754 -parent . \
2755 -title "[appname] ([reponame]): Create Desktop Icon" \
2756 -initialdir $desktop \
2757 -initialfile "Git [reponame].bat"]
2758 if {$fn != {}} {
2759 if {[catch {
2760 set fd [open $fn w]
2761 set sh [exec cygpath \
2762 --windows \
2763 --absolute \
2764 /bin/sh]
2765 set me [exec cygpath \
2766 --unix \
2767 --absolute \
2768 $argv0]
2769 set gd [exec cygpath \
2770 --unix \
2771 --absolute \
2772 [gitdir]]
2773 regsub -all ' $me "'\\''" me
2774 regsub -all ' $gd "'\\''" gd
2775 puts $fd "@ECHO Starting git-gui... Please wait..."
2776 puts -nonewline $fd "@\"$sh\" --login -c \""
2777 puts -nonewline $fd "GIT_DIR='$gd'"
2778 puts -nonewline $fd " '$me'"
2779 puts $fd "&\""
2780 close $fd
2781 } err]} {
2782 error_popup "Cannot write script:\n\n$err"
2787 proc do_macosx_app {} {
2788 global argv0 env
2790 set fn [tk_getSaveFile \
2791 -parent . \
2792 -title "[appname] ([reponame]): Create Desktop Icon" \
2793 -initialdir [file join $env(HOME) Desktop] \
2794 -initialfile "Git [reponame].app"]
2795 if {$fn != {}} {
2796 if {[catch {
2797 set Contents [file join $fn Contents]
2798 set MacOS [file join $Contents MacOS]
2799 set exe [file join $MacOS git-gui]
2801 file mkdir $MacOS
2803 set fd [open [file join $Contents Info.plist] w]
2804 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2805 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2806 <plist version="1.0">
2807 <dict>
2808 <key>CFBundleDevelopmentRegion</key>
2809 <string>English</string>
2810 <key>CFBundleExecutable</key>
2811 <string>git-gui</string>
2812 <key>CFBundleIdentifier</key>
2813 <string>org.spearce.git-gui</string>
2814 <key>CFBundleInfoDictionaryVersion</key>
2815 <string>6.0</string>
2816 <key>CFBundlePackageType</key>
2817 <string>APPL</string>
2818 <key>CFBundleSignature</key>
2819 <string>????</string>
2820 <key>CFBundleVersion</key>
2821 <string>1.0</string>
2822 <key>NSPrincipalClass</key>
2823 <string>NSApplication</string>
2824 </dict>
2825 </plist>}
2826 close $fd
2828 set fd [open $exe w]
2829 set gd [file normalize [gitdir]]
2830 set ep [file normalize [exec git --exec-path]]
2831 regsub -all ' $gd "'\\''" gd
2832 regsub -all ' $ep "'\\''" ep
2833 puts $fd "#!/bin/sh"
2834 foreach name [array names env] {
2835 if {[string match GIT_* $name]} {
2836 regsub -all ' $env($name) "'\\''" v
2837 puts $fd "export $name='$v'"
2840 puts $fd "export PATH='$ep':\$PATH"
2841 puts $fd "export GIT_DIR='$gd'"
2842 puts $fd "exec [file normalize $argv0]"
2843 close $fd
2845 file attributes $exe -permissions u+x,g+x,o+x
2846 } err]} {
2847 error_popup "Cannot write icon:\n\n$err"
2852 proc toggle_or_diff {w x y} {
2853 global file_states file_lists current_diff ui_index ui_other
2854 global last_clicked selected_paths
2856 set pos [split [$w index @$x,$y] .]
2857 set lno [lindex $pos 0]
2858 set col [lindex $pos 1]
2859 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2860 if {$path eq {}} {
2861 set last_clicked {}
2862 return
2865 set last_clicked [list $w $lno]
2866 array unset selected_paths
2867 $ui_index tag remove in_sel 0.0 end
2868 $ui_other tag remove in_sel 0.0 end
2870 if {$col == 0} {
2871 if {$current_diff eq $path} {
2872 set after {reshow_diff;}
2873 } else {
2874 set after {}
2876 switch -glob -- [lindex $file_states($path) 0] {
2877 A_ -
2878 M_ -
2879 DD -
2880 DO -
2881 DM {
2882 update_indexinfo \
2883 "Removing [short_path $path] from commit" \
2884 [list $path] \
2885 [concat $after {set ui_status_value {Ready.}}]
2887 ?? {
2888 update_index \
2889 "Adding [short_path $path]" \
2890 [list $path] \
2891 [concat $after {set ui_status_value {Ready.}}]
2894 } else {
2895 show_diff $path $w $lno
2899 proc add_one_to_selection {w x y} {
2900 global file_lists
2901 global last_clicked selected_paths
2903 set pos [split [$w index @$x,$y] .]
2904 set lno [lindex $pos 0]
2905 set col [lindex $pos 1]
2906 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2907 if {$path eq {}} {
2908 set last_clicked {}
2909 return
2912 set last_clicked [list $w $lno]
2913 if {[catch {set in_sel $selected_paths($path)}]} {
2914 set in_sel 0
2916 if {$in_sel} {
2917 unset selected_paths($path)
2918 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2919 } else {
2920 set selected_paths($path) 1
2921 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2925 proc add_range_to_selection {w x y} {
2926 global file_lists
2927 global last_clicked selected_paths
2929 if {[lindex $last_clicked 0] ne $w} {
2930 toggle_or_diff $w $x $y
2931 return
2934 set pos [split [$w index @$x,$y] .]
2935 set lno [lindex $pos 0]
2936 set lc [lindex $last_clicked 1]
2937 if {$lc < $lno} {
2938 set begin $lc
2939 set end $lno
2940 } else {
2941 set begin $lno
2942 set end $lc
2945 foreach path [lrange $file_lists($w) \
2946 [expr {$begin - 1}] \
2947 [expr {$end - 1}]] {
2948 set selected_paths($path) 1
2950 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2953 ######################################################################
2955 ## config defaults
2957 set cursor_ptr arrow
2958 font create font_diff -family Courier -size 10
2959 font create font_ui
2960 catch {
2961 label .dummy
2962 eval font configure font_ui [font actual [.dummy cget -font]]
2963 destroy .dummy
2966 font create font_uibold
2967 font create font_diffbold
2969 if {[is_Windows]} {
2970 set M1B Control
2971 set M1T Ctrl
2972 } elseif {[is_MacOSX]} {
2973 set M1B M1
2974 set M1T Cmd
2975 } else {
2976 set M1B M1
2977 set M1T M1
2980 proc apply_config {} {
2981 global repo_config font_descs
2983 foreach option $font_descs {
2984 set name [lindex $option 0]
2985 set font [lindex $option 1]
2986 if {[catch {
2987 foreach {cn cv} $repo_config(gui.$name) {
2988 font configure $font $cn $cv
2990 } err]} {
2991 error_popup "Invalid font specified in gui.$name:\n\n$err"
2993 foreach {cn cv} [font configure $font] {
2994 font configure ${font}bold $cn $cv
2996 font configure ${font}bold -weight bold
3000 set default_config(gui.trustmtime) false
3001 set default_config(gui.pullsummary) true
3002 set default_config(gui.partialinclude) false
3003 set default_config(gui.diffcontext) 5
3004 set default_config(gui.fontui) [font configure font_ui]
3005 set default_config(gui.fontdiff) [font configure font_diff]
3006 set font_descs {
3007 {fontui font_ui {Main Font}}
3008 {fontdiff font_diff {Diff/Console Font}}
3010 load_config 0
3011 apply_config
3013 ######################################################################
3015 ## ui construction
3017 # -- Menu Bar
3019 menu .mbar -tearoff 0
3020 .mbar add cascade -label Repository -menu .mbar.repository
3021 .mbar add cascade -label Edit -menu .mbar.edit
3022 if {!$single_commit} {
3023 .mbar add cascade -label Branch -menu .mbar.branch
3025 .mbar add cascade -label Commit -menu .mbar.commit
3026 if {!$single_commit} {
3027 .mbar add cascade -label Fetch -menu .mbar.fetch
3028 .mbar add cascade -label Pull -menu .mbar.pull
3029 .mbar add cascade -label Push -menu .mbar.push
3031 . configure -menu .mbar
3033 # -- Repository Menu
3035 menu .mbar.repository
3036 .mbar.repository add command \
3037 -label {Visualize Current Branch} \
3038 -command {do_gitk {}} \
3039 -font font_ui
3040 if {![is_MacOSX]} {
3041 .mbar.repository add command \
3042 -label {Visualize All Branches} \
3043 -command {do_gitk {--all}} \
3044 -font font_ui
3046 .mbar.repository add separator
3048 if {!$single_commit} {
3049 .mbar.repository add command -label {Compress Database} \
3050 -command do_gc \
3051 -font font_ui
3053 .mbar.repository add command -label {Verify Database} \
3054 -command do_fsck_objects \
3055 -font font_ui
3057 .mbar.repository add separator
3059 if {[is_Windows]} {
3060 .mbar.repository add command \
3061 -label {Create Desktop Icon} \
3062 -command do_windows_shortcut \
3063 -font font_ui
3064 } elseif {[is_MacOSX]} {
3065 .mbar.repository add command \
3066 -label {Create Desktop Icon} \
3067 -command do_macosx_app \
3068 -font font_ui
3072 .mbar.repository add command -label Quit \
3073 -command do_quit \
3074 -accelerator $M1T-Q \
3075 -font font_ui
3077 # -- Edit Menu
3079 menu .mbar.edit
3080 .mbar.edit add command -label Undo \
3081 -command {catch {[focus] edit undo}} \
3082 -accelerator $M1T-Z \
3083 -font font_ui
3084 .mbar.edit add command -label Redo \
3085 -command {catch {[focus] edit redo}} \
3086 -accelerator $M1T-Y \
3087 -font font_ui
3088 .mbar.edit add separator
3089 .mbar.edit add command -label Cut \
3090 -command {catch {tk_textCut [focus]}} \
3091 -accelerator $M1T-X \
3092 -font font_ui
3093 .mbar.edit add command -label Copy \
3094 -command {catch {tk_textCopy [focus]}} \
3095 -accelerator $M1T-C \
3096 -font font_ui
3097 .mbar.edit add command -label Paste \
3098 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3099 -accelerator $M1T-V \
3100 -font font_ui
3101 .mbar.edit add command -label Delete \
3102 -command {catch {[focus] delete sel.first sel.last}} \
3103 -accelerator Del \
3104 -font font_ui
3105 .mbar.edit add separator
3106 .mbar.edit add command -label {Select All} \
3107 -command {catch {[focus] tag add sel 0.0 end}} \
3108 -accelerator $M1T-A \
3109 -font font_ui
3111 # -- Branch Menu
3113 if {!$single_commit} {
3114 menu .mbar.branch
3116 .mbar.branch add command -label {Create...} \
3117 -command do_create_branch \
3118 -font font_ui
3119 lappend disable_on_lock [list .mbar.branch entryconf \
3120 [.mbar.branch index last] -state]
3122 .mbar.branch add command -label {Delete...} \
3123 -command do_delete_branch \
3124 -font font_ui
3125 lappend disable_on_lock [list .mbar.branch entryconf \
3126 [.mbar.branch index last] -state]
3129 # -- Commit Menu
3131 menu .mbar.commit
3133 .mbar.commit add radiobutton \
3134 -label {New Commit} \
3135 -command do_select_commit_type \
3136 -variable selected_commit_type \
3137 -value new \
3138 -font font_ui
3139 lappend disable_on_lock \
3140 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3142 .mbar.commit add radiobutton \
3143 -label {Amend Last Commit} \
3144 -command do_select_commit_type \
3145 -variable selected_commit_type \
3146 -value amend \
3147 -font font_ui
3148 lappend disable_on_lock \
3149 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3151 .mbar.commit add separator
3153 .mbar.commit add command -label Rescan \
3154 -command do_rescan \
3155 -accelerator F5 \
3156 -font font_ui
3157 lappend disable_on_lock \
3158 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3160 .mbar.commit add command -label {Add To Commit} \
3161 -command do_include_selection \
3162 -font font_ui
3163 lappend disable_on_lock \
3164 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3166 .mbar.commit add command -label {Add All To Commit} \
3167 -command do_include_all \
3168 -accelerator $M1T-I \
3169 -font font_ui
3170 lappend disable_on_lock \
3171 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3173 .mbar.commit add command -label {Remove From Commit} \
3174 -command do_remove_selection \
3175 -font font_ui
3176 lappend disable_on_lock \
3177 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3179 .mbar.commit add command -label {Revert Changes} \
3180 -command do_revert_selection \
3181 -font font_ui
3182 lappend disable_on_lock \
3183 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3185 .mbar.commit add separator
3187 .mbar.commit add command -label {Sign Off} \
3188 -command do_signoff \
3189 -accelerator $M1T-S \
3190 -font font_ui
3192 .mbar.commit add command -label Commit \
3193 -command do_commit \
3194 -accelerator $M1T-Return \
3195 -font font_ui
3196 lappend disable_on_lock \
3197 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3199 # -- Transport menus
3201 if {!$single_commit} {
3202 menu .mbar.fetch
3203 menu .mbar.pull
3204 menu .mbar.push
3207 if {[is_MacOSX]} {
3208 # -- Apple Menu (Mac OS X only)
3210 .mbar add cascade -label Apple -menu .mbar.apple
3211 menu .mbar.apple
3213 .mbar.apple add command -label "About [appname]" \
3214 -command do_about \
3215 -font font_ui
3216 .mbar.apple add command -label "[appname] Options..." \
3217 -command do_options \
3218 -font font_ui
3219 } else {
3220 # -- Edit Menu
3222 .mbar.edit add separator
3223 .mbar.edit add command -label {Options...} \
3224 -command do_options \
3225 -font font_ui
3227 # -- Tools Menu
3229 if {[file exists /usr/local/miga/lib/gui-miga]
3230 && [file exists .pvcsrc]} {
3231 proc do_miga {} {
3232 global ui_status_value
3233 if {![lock_index update]} return
3234 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3235 set miga_fd [open "|$cmd" r]
3236 fconfigure $miga_fd -blocking 0
3237 fileevent $miga_fd readable [list miga_done $miga_fd]
3238 set ui_status_value {Running miga...}
3240 proc miga_done {fd} {
3241 read $fd 512
3242 if {[eof $fd]} {
3243 close $fd
3244 unlock_index
3245 rescan [list set ui_status_value {Ready.}]
3248 .mbar add cascade -label Tools -menu .mbar.tools
3249 menu .mbar.tools
3250 .mbar.tools add command -label "Migrate" \
3251 -command do_miga \
3252 -font font_ui
3253 lappend disable_on_lock \
3254 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3257 # -- Help Menu
3259 .mbar add cascade -label Help -menu .mbar.help
3260 menu .mbar.help
3262 .mbar.help add command -label "About [appname]" \
3263 -command do_about \
3264 -font font_ui
3268 # -- Branch Control
3270 frame .branch \
3271 -borderwidth 1 \
3272 -relief sunken
3273 label .branch.l1 \
3274 -text {Current Branch:} \
3275 -anchor w \
3276 -justify left \
3277 -font font_ui
3278 label .branch.cb \
3279 -textvariable current_branch \
3280 -anchor w \
3281 -justify left \
3282 -font font_ui
3283 pack .branch.l1 -side left
3284 pack .branch.cb -side left -fill x
3285 pack .branch -side top -fill x
3287 # -- Main Window Layout
3289 panedwindow .vpane -orient vertical
3290 panedwindow .vpane.files -orient horizontal
3291 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3292 pack .vpane -anchor n -side top -fill both -expand 1
3294 # -- Index File List
3296 frame .vpane.files.index -height 100 -width 400
3297 label .vpane.files.index.title -text {Modified Files} \
3298 -background green \
3299 -font font_ui
3300 text $ui_index -background white -borderwidth 0 \
3301 -width 40 -height 10 \
3302 -font font_ui \
3303 -cursor $cursor_ptr \
3304 -yscrollcommand {.vpane.files.index.sb set} \
3305 -state disabled
3306 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3307 pack .vpane.files.index.title -side top -fill x
3308 pack .vpane.files.index.sb -side right -fill y
3309 pack $ui_index -side left -fill both -expand 1
3310 .vpane.files add .vpane.files.index -sticky nsew
3312 # -- Other (Add) File List
3314 frame .vpane.files.other -height 100 -width 100
3315 label .vpane.files.other.title -text {Untracked Files} \
3316 -background red \
3317 -font font_ui
3318 text $ui_other -background white -borderwidth 0 \
3319 -width 40 -height 10 \
3320 -font font_ui \
3321 -cursor $cursor_ptr \
3322 -yscrollcommand {.vpane.files.other.sb set} \
3323 -state disabled
3324 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3325 pack .vpane.files.other.title -side top -fill x
3326 pack .vpane.files.other.sb -side right -fill y
3327 pack $ui_other -side left -fill both -expand 1
3328 .vpane.files add .vpane.files.other -sticky nsew
3330 foreach i [list $ui_index $ui_other] {
3331 $i tag conf in_diff -font font_uibold
3332 $i tag conf in_sel \
3333 -background [$i cget -foreground] \
3334 -foreground [$i cget -background]
3336 unset i
3338 # -- Diff and Commit Area
3340 frame .vpane.lower -height 300 -width 400
3341 frame .vpane.lower.commarea
3342 frame .vpane.lower.diff -relief sunken -borderwidth 1
3343 pack .vpane.lower.commarea -side top -fill x
3344 pack .vpane.lower.diff -side bottom -fill both -expand 1
3345 .vpane add .vpane.lower -stick nsew
3347 # -- Commit Area Buttons
3349 frame .vpane.lower.commarea.buttons
3350 label .vpane.lower.commarea.buttons.l -text {} \
3351 -anchor w \
3352 -justify left \
3353 -font font_ui
3354 pack .vpane.lower.commarea.buttons.l -side top -fill x
3355 pack .vpane.lower.commarea.buttons -side left -fill y
3357 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3358 -command do_rescan \
3359 -font font_ui
3360 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3361 lappend disable_on_lock \
3362 {.vpane.lower.commarea.buttons.rescan conf -state}
3364 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3365 -command do_include_all \
3366 -font font_ui
3367 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3368 lappend disable_on_lock \
3369 {.vpane.lower.commarea.buttons.incall conf -state}
3371 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3372 -command do_signoff \
3373 -font font_ui
3374 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3376 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3377 -command do_commit \
3378 -font font_ui
3379 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3380 lappend disable_on_lock \
3381 {.vpane.lower.commarea.buttons.commit conf -state}
3383 # -- Commit Message Buffer
3385 frame .vpane.lower.commarea.buffer
3386 frame .vpane.lower.commarea.buffer.header
3387 set ui_comm .vpane.lower.commarea.buffer.t
3388 set ui_coml .vpane.lower.commarea.buffer.header.l
3389 radiobutton .vpane.lower.commarea.buffer.header.new \
3390 -text {New Commit} \
3391 -command do_select_commit_type \
3392 -variable selected_commit_type \
3393 -value new \
3394 -font font_ui
3395 lappend disable_on_lock \
3396 [list .vpane.lower.commarea.buffer.header.new conf -state]
3397 radiobutton .vpane.lower.commarea.buffer.header.amend \
3398 -text {Amend Last Commit} \
3399 -command do_select_commit_type \
3400 -variable selected_commit_type \
3401 -value amend \
3402 -font font_ui
3403 lappend disable_on_lock \
3404 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3405 label $ui_coml \
3406 -anchor w \
3407 -justify left \
3408 -font font_ui
3409 proc trace_commit_type {varname args} {
3410 global ui_coml commit_type
3411 switch -glob -- $commit_type {
3412 initial {set txt {Initial Commit Message:}}
3413 amend {set txt {Amended Commit Message:}}
3414 amend-initial {set txt {Amended Initial Commit Message:}}
3415 amend-merge {set txt {Amended Merge Commit Message:}}
3416 merge {set txt {Merge Commit Message:}}
3417 * {set txt {Commit Message:}}
3419 $ui_coml conf -text $txt
3421 trace add variable commit_type write trace_commit_type
3422 pack $ui_coml -side left -fill x
3423 pack .vpane.lower.commarea.buffer.header.amend -side right
3424 pack .vpane.lower.commarea.buffer.header.new -side right
3426 text $ui_comm -background white -borderwidth 1 \
3427 -undo true \
3428 -maxundo 20 \
3429 -autoseparators true \
3430 -relief sunken \
3431 -width 75 -height 9 -wrap none \
3432 -font font_diff \
3433 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3434 scrollbar .vpane.lower.commarea.buffer.sby \
3435 -command [list $ui_comm yview]
3436 pack .vpane.lower.commarea.buffer.header -side top -fill x
3437 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3438 pack $ui_comm -side left -fill y
3439 pack .vpane.lower.commarea.buffer -side left -fill y
3441 # -- Commit Message Buffer Context Menu
3443 set ctxm .vpane.lower.commarea.buffer.ctxm
3444 menu $ctxm -tearoff 0
3445 $ctxm add command \
3446 -label {Cut} \
3447 -font font_ui \
3448 -command {tk_textCut $ui_comm}
3449 $ctxm add command \
3450 -label {Copy} \
3451 -font font_ui \
3452 -command {tk_textCopy $ui_comm}
3453 $ctxm add command \
3454 -label {Paste} \
3455 -font font_ui \
3456 -command {tk_textPaste $ui_comm}
3457 $ctxm add command \
3458 -label {Delete} \
3459 -font font_ui \
3460 -command {$ui_comm delete sel.first sel.last}
3461 $ctxm add separator
3462 $ctxm add command \
3463 -label {Select All} \
3464 -font font_ui \
3465 -command {$ui_comm tag add sel 0.0 end}
3466 $ctxm add command \
3467 -label {Copy All} \
3468 -font font_ui \
3469 -command {
3470 $ui_comm tag add sel 0.0 end
3471 tk_textCopy $ui_comm
3472 $ui_comm tag remove sel 0.0 end
3474 $ctxm add separator
3475 $ctxm add command \
3476 -label {Sign Off} \
3477 -font font_ui \
3478 -command do_signoff
3479 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3481 # -- Diff Header
3483 set current_diff {}
3484 set diff_actions [list]
3485 proc trace_current_diff {varname args} {
3486 global current_diff diff_actions file_states
3487 if {$current_diff eq {}} {
3488 set s {}
3489 set f {}
3490 set p {}
3491 set o disabled
3492 } else {
3493 set p $current_diff
3494 set s [mapdesc [lindex $file_states($p) 0] $p]
3495 set f {File:}
3496 set p [escape_path $p]
3497 set o normal
3500 .vpane.lower.diff.header.status configure -text $s
3501 .vpane.lower.diff.header.file configure -text $f
3502 .vpane.lower.diff.header.path configure -text $p
3503 foreach w $diff_actions {
3504 uplevel #0 $w $o
3507 trace add variable current_diff write trace_current_diff
3509 frame .vpane.lower.diff.header -background orange
3510 label .vpane.lower.diff.header.status \
3511 -background orange \
3512 -width $max_status_desc \
3513 -anchor w \
3514 -justify left \
3515 -font font_ui
3516 label .vpane.lower.diff.header.file \
3517 -background orange \
3518 -anchor w \
3519 -justify left \
3520 -font font_ui
3521 label .vpane.lower.diff.header.path \
3522 -background orange \
3523 -anchor w \
3524 -justify left \
3525 -font font_ui
3526 pack .vpane.lower.diff.header.status -side left
3527 pack .vpane.lower.diff.header.file -side left
3528 pack .vpane.lower.diff.header.path -fill x
3529 set ctxm .vpane.lower.diff.header.ctxm
3530 menu $ctxm -tearoff 0
3531 $ctxm add command \
3532 -label {Copy} \
3533 -font font_ui \
3534 -command {
3535 clipboard clear
3536 clipboard append \
3537 -format STRING \
3538 -type STRING \
3539 -- $current_diff
3541 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3542 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3544 # -- Diff Body
3546 frame .vpane.lower.diff.body
3547 set ui_diff .vpane.lower.diff.body.t
3548 text $ui_diff -background white -borderwidth 0 \
3549 -width 80 -height 15 -wrap none \
3550 -font font_diff \
3551 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3552 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3553 -state disabled
3554 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3555 -command [list $ui_diff xview]
3556 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3557 -command [list $ui_diff yview]
3558 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3559 pack .vpane.lower.diff.body.sby -side right -fill y
3560 pack $ui_diff -side left -fill both -expand 1
3561 pack .vpane.lower.diff.header -side top -fill x
3562 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3564 $ui_diff tag conf d_@ -font font_diffbold
3565 $ui_diff tag conf d_+ -foreground blue
3566 $ui_diff tag conf d_- -foreground red
3567 $ui_diff tag conf d_++ -foreground {#00a000}
3568 $ui_diff tag conf d_-- -foreground {#a000a0}
3569 $ui_diff tag conf d_+- \
3570 -foreground red \
3571 -background {light goldenrod yellow}
3572 $ui_diff tag conf d_-+ \
3573 -foreground blue \
3574 -background azure2
3576 # -- Diff Body Context Menu
3578 set ctxm .vpane.lower.diff.body.ctxm
3579 menu $ctxm -tearoff 0
3580 $ctxm add command \
3581 -label {Copy} \
3582 -font font_ui \
3583 -command {tk_textCopy $ui_diff}
3584 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3585 $ctxm add command \
3586 -label {Select All} \
3587 -font font_ui \
3588 -command {$ui_diff tag add sel 0.0 end}
3589 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3590 $ctxm add command \
3591 -label {Copy All} \
3592 -font font_ui \
3593 -command {
3594 $ui_diff tag add sel 0.0 end
3595 tk_textCopy $ui_diff
3596 $ui_diff tag remove sel 0.0 end
3598 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3599 $ctxm add separator
3600 $ctxm add command \
3601 -label {Decrease Font Size} \
3602 -font font_ui \
3603 -command {incr_font_size font_diff -1}
3604 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3605 $ctxm add command \
3606 -label {Increase Font Size} \
3607 -font font_ui \
3608 -command {incr_font_size font_diff 1}
3609 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3610 $ctxm add separator
3611 $ctxm add command \
3612 -label {Show Less Context} \
3613 -font font_ui \
3614 -command {if {$repo_config(gui.diffcontext) >= 2} {
3615 incr repo_config(gui.diffcontext) -1
3616 reshow_diff
3618 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3619 $ctxm add command \
3620 -label {Show More Context} \
3621 -font font_ui \
3622 -command {
3623 incr repo_config(gui.diffcontext)
3624 reshow_diff
3626 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3627 $ctxm add separator
3628 $ctxm add command -label {Options...} \
3629 -font font_ui \
3630 -command do_options
3631 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3633 # -- Status Bar
3635 set ui_status_value {Initializing...}
3636 label .status -textvariable ui_status_value \
3637 -anchor w \
3638 -justify left \
3639 -borderwidth 1 \
3640 -relief sunken \
3641 -font font_ui
3642 pack .status -anchor w -side bottom -fill x
3644 # -- Load geometry
3646 catch {
3647 set gm $repo_config(gui.geometry)
3648 wm geometry . [lindex $gm 0]
3649 .vpane sash place 0 \
3650 [lindex [.vpane sash coord 0] 0] \
3651 [lindex $gm 1]
3652 .vpane.files sash place 0 \
3653 [lindex $gm 2] \
3654 [lindex [.vpane.files sash coord 0] 1]
3655 unset gm
3658 # -- Key Bindings
3660 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3661 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3662 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3663 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3664 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3665 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3666 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3667 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3668 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3669 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3670 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3672 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3673 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3674 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3675 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3676 bind $ui_diff <$M1B-Key-v> {break}
3677 bind $ui_diff <$M1B-Key-V> {break}
3678 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3679 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3680 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3681 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3682 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3683 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3685 bind . <Destroy> do_quit
3686 bind all <Key-F5> do_rescan
3687 bind all <$M1B-Key-r> do_rescan
3688 bind all <$M1B-Key-R> do_rescan
3689 bind . <$M1B-Key-s> do_signoff
3690 bind . <$M1B-Key-S> do_signoff
3691 bind . <$M1B-Key-i> do_include_all
3692 bind . <$M1B-Key-I> do_include_all
3693 bind . <$M1B-Key-Return> do_commit
3694 bind all <$M1B-Key-q> do_quit
3695 bind all <$M1B-Key-Q> do_quit
3696 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3697 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3698 foreach i [list $ui_index $ui_other] {
3699 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3700 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3701 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3703 unset i
3705 set file_lists($ui_index) [list]
3706 set file_lists($ui_other) [list]
3708 set HEAD {}
3709 set PARENT {}
3710 set MERGE_HEAD [list]
3711 set commit_type {}
3712 set empty_tree {}
3713 set current_branch {}
3714 set current_diff {}
3715 set selected_commit_type new
3717 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
3718 focus -force $ui_comm
3720 # -- Warn the user about environmental problems. Cygwin's Tcl
3721 # does *not* pass its env array onto any processes it spawns.
3722 # This means that git processes get none of our environment.
3724 if {[is_Windows]} {
3725 set ignored_env 0
3726 set suggest_user {}
3727 set msg "Possible environment issues exist.
3729 The following environment variables are probably
3730 going to be ignored by any Git subprocess run
3731 by [appname]:
3734 foreach name [array names env] {
3735 switch -regexp -- $name {
3736 {^GIT_INDEX_FILE$} -
3737 {^GIT_OBJECT_DIRECTORY$} -
3738 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3739 {^GIT_DIFF_OPTS$} -
3740 {^GIT_EXTERNAL_DIFF$} -
3741 {^GIT_PAGER$} -
3742 {^GIT_TRACE$} -
3743 {^GIT_CONFIG$} -
3744 {^GIT_CONFIG_LOCAL$} -
3745 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3746 append msg " - $name\n"
3747 incr ignored_env
3749 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3750 append msg " - $name\n"
3751 incr ignored_env
3752 set suggest_user $name
3756 if {$ignored_env > 0} {
3757 append msg "
3758 This is due to a known issue with the
3759 Tcl binary distributed by Cygwin."
3761 if {$suggest_user ne {}} {
3762 append msg "
3764 A good replacement for $suggest_user
3765 is placing values for the user.name and
3766 user.email settings into your personal
3767 ~/.gitconfig file.
3770 warn_popup $msg
3772 unset ignored_env msg suggest_user name
3775 # -- Only initialize complex UI if we are going to stay running.
3777 if {!$single_commit} {
3778 load_all_remotes
3779 load_all_heads
3781 populate_branch_menu .mbar.branch
3782 populate_fetch_menu .mbar.fetch
3783 populate_pull_menu .mbar.pull
3784 populate_push_menu .mbar.push
3787 # -- Only suggest a gc run if we are going to stay running.
3789 if {!$single_commit} {
3790 set object_limit 2000
3791 if {[is_Windows]} {set object_limit 200}
3792 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3793 if {$objects_current >= $object_limit} {
3794 if {[ask_popup \
3795 "This repository currently has $objects_current loose objects.
3797 To maintain optimal performance it is strongly
3798 recommended that you compress the database
3799 when more than $object_limit loose objects exist.
3801 Compress the database now?"] eq yes} {
3802 do_gc
3805 unset object_limit _junk objects_current
3808 lock_index begin-read
3809 after 1 do_rescan