git-gui: Paper bag fix "Stage Hunk For Commit" in diff context menu
[git-gui.git] / git-gui.sh
blobd5517b921db27cc3f9b2b9619f651435e2eb1d48
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 || test "z$*" = z--version; \
5 then \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
7 exit; \
8 fi; \
9 exec wish "$0" -- "$@"
11 set appvers {@@GITGUI_VERSION@@}
12 set copyright {
13 Copyright © 2006, 2007 Shawn Pearce, et. al.
15 This program is free software; you can redistribute it and/or modify
16 it under the terms of the GNU General Public License as published by
17 the Free Software Foundation; either version 2 of the License, or
18 (at your option) any later version.
20 This program is distributed in the hope that it will be useful,
21 but WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 GNU General Public License for more details.
25 You should have received a copy of the GNU General Public License
26 along with this program; if not, write to the Free Software
27 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
29 ######################################################################
31 ## Tcl/Tk sanity check
33 if {[catch {package require Tcl 8.4} err]
34 || [catch {package require Tk 8.4} err]
35 } {
36 catch {wm withdraw .}
37 tk_messageBox \
38 -icon error \
39 -type ok \
40 -title "git-gui: fatal error" \
41 -message $err
42 exit 1
45 ######################################################################
47 ## enable verbose loading?
49 if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
50 unset _verbose
51 rename auto_load real__auto_load
52 proc auto_load {name args} {
53 puts stderr "auto_load $name"
54 return [uplevel 1 real__auto_load $name $args]
56 rename source real__source
57 proc source {name} {
58 puts stderr "source $name"
59 uplevel 1 real__source $name
63 ######################################################################
65 ## configure our library
67 set oguilib {@@GITGUI_LIBDIR@@}
68 set oguirel {@@GITGUI_RELATIVE@@}
69 if {$oguirel eq {1}} {
70 set oguilib [file dirname [file dirname [file normalize $argv0]]]
71 set oguilib [file join $oguilib share git-gui lib]
72 } elseif {[string match @@* $oguirel]} {
73 set oguilib [file join [file dirname [file normalize $argv0]] lib]
76 set idx [file join $oguilib tclIndex]
77 if {[catch {set fd [open $idx r]} err]} {
78 catch {wm withdraw .}
79 tk_messageBox \
80 -icon error \
81 -type ok \
82 -title "git-gui: fatal error" \
83 -message $err
84 exit 1
86 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
87 set idx [list]
88 while {[gets $fd n] >= 0} {
89 if {$n ne {} && ![string match #* $n]} {
90 lappend idx $n
93 } else {
94 set idx {}
96 close $fd
98 if {$idx ne {}} {
99 set loaded [list]
100 foreach p $idx {
101 if {[lsearch -exact $loaded $p] >= 0} continue
102 source [file join $oguilib $p]
103 lappend loaded $p
105 unset loaded p
106 } else {
107 set auto_path [concat [list $oguilib] $auto_path]
109 unset -nocomplain oguirel idx fd
111 ######################################################################
113 ## read only globals
115 set _appname [lindex [file split $argv0] end]
116 set _gitdir {}
117 set _gitexec {}
118 set _reponame {}
119 set _iscygwin {}
120 set _search_path {}
122 proc appname {} {
123 global _appname
124 return $_appname
127 proc gitdir {args} {
128 global _gitdir
129 if {$args eq {}} {
130 return $_gitdir
132 return [eval [list file join $_gitdir] $args]
135 proc gitexec {args} {
136 global _gitexec
137 if {$_gitexec eq {}} {
138 if {[catch {set _gitexec [git --exec-path]} err]} {
139 error "Git not installed?\n\n$err"
141 if {[is_Cygwin]} {
142 set _gitexec [exec cygpath \
143 --windows \
144 --absolute \
145 $_gitexec]
146 } else {
147 set _gitexec [file normalize $_gitexec]
150 if {$args eq {}} {
151 return $_gitexec
153 return [eval [list file join $_gitexec] $args]
156 proc reponame {} {
157 return $::_reponame
160 proc is_MacOSX {} {
161 if {[tk windowingsystem] eq {aqua}} {
162 return 1
164 return 0
167 proc is_Windows {} {
168 if {$::tcl_platform(platform) eq {windows}} {
169 return 1
171 return 0
174 proc is_Cygwin {} {
175 global _iscygwin
176 if {$_iscygwin eq {}} {
177 if {$::tcl_platform(platform) eq {windows}} {
178 if {[catch {set p [exec cygpath --windir]} err]} {
179 set _iscygwin 0
180 } else {
181 set _iscygwin 1
183 } else {
184 set _iscygwin 0
187 return $_iscygwin
190 proc is_enabled {option} {
191 global enabled_options
192 if {[catch {set on $enabled_options($option)}]} {return 0}
193 return $on
196 proc enable_option {option} {
197 global enabled_options
198 set enabled_options($option) 1
201 proc disable_option {option} {
202 global enabled_options
203 set enabled_options($option) 0
206 ######################################################################
208 ## config
210 proc is_many_config {name} {
211 switch -glob -- $name {
212 remote.*.fetch -
213 remote.*.push
214 {return 1}
216 {return 0}
220 proc is_config_true {name} {
221 global repo_config
222 if {[catch {set v $repo_config($name)}]} {
223 return 0
224 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
225 return 1
226 } else {
227 return 0
231 proc get_config {name} {
232 global repo_config
233 if {[catch {set v $repo_config($name)}]} {
234 return {}
235 } else {
236 return $v
240 proc load_config {include_global} {
241 global repo_config global_config default_config
243 array unset global_config
244 if {$include_global} {
245 catch {
246 set fd_rc [git_read config --global --list]
247 while {[gets $fd_rc line] >= 0} {
248 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
249 if {[is_many_config $name]} {
250 lappend global_config($name) $value
251 } else {
252 set global_config($name) $value
256 close $fd_rc
260 array unset repo_config
261 catch {
262 set fd_rc [git_read config --list]
263 while {[gets $fd_rc line] >= 0} {
264 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
265 if {[is_many_config $name]} {
266 lappend repo_config($name) $value
267 } else {
268 set repo_config($name) $value
272 close $fd_rc
275 foreach name [array names default_config] {
276 if {[catch {set v $global_config($name)}]} {
277 set global_config($name) $default_config($name)
279 if {[catch {set v $repo_config($name)}]} {
280 set repo_config($name) $default_config($name)
285 ######################################################################
287 ## handy utils
289 proc _git_cmd {name} {
290 global _git_cmd_path
292 if {[catch {set v $_git_cmd_path($name)}]} {
293 switch -- $name {
294 version -
295 --version -
296 --exec-path { return [list $::_git $name] }
299 set p [gitexec git-$name$::_search_exe]
300 if {[file exists $p]} {
301 set v [list $p]
302 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
303 # Try to determine what sort of magic will make
304 # git-$name go and do its thing, because native
305 # Tcl on Windows doesn't know it.
307 set p [gitexec git-$name]
308 set f [open $p r]
309 set s [gets $f]
310 close $f
312 switch -glob -- $s {
313 #!*sh { set i sh }
314 #!*perl { set i perl }
315 #!*python { set i python }
316 default { error "git-$name is not supported: $s" }
319 upvar #0 _$i interp
320 if {![info exists interp]} {
321 set interp [_which $i]
323 if {$interp eq {}} {
324 error "git-$name requires $i (not in PATH)"
326 set v [list $interp $p]
327 } else {
328 # Assume it is builtin to git somehow and we
329 # aren't actually able to see a file for it.
331 set v [list $::_git $name]
333 set _git_cmd_path($name) $v
335 return $v
338 proc _which {what} {
339 global env _search_exe _search_path
341 if {$_search_path eq {}} {
342 if {[is_Cygwin]} {
343 set _search_path [split [exec cygpath \
344 --windows \
345 --path \
346 --absolute \
347 $env(PATH)] {;}]
348 set _search_exe .exe
349 } elseif {[is_Windows]} {
350 set _search_path [split $env(PATH) {;}]
351 set _search_exe .exe
352 } else {
353 set _search_path [split $env(PATH) :]
354 set _search_exe {}
358 foreach p $_search_path {
359 set p [file join $p $what$_search_exe]
360 if {[file exists $p]} {
361 return [file normalize $p]
364 return {}
367 proc _lappend_nice {cmd_var} {
368 global _nice
369 upvar $cmd_var cmd
371 if {![info exists _nice]} {
372 set _nice [_which nice]
374 if {$_nice ne {}} {
375 lappend cmd $_nice
379 proc git {args} {
380 set opt [list exec]
382 while {1} {
383 switch -- [lindex $args 0] {
384 --nice {
385 _lappend_nice opt
388 default {
389 break
394 set args [lrange $args 1 end]
397 set cmdp [_git_cmd [lindex $args 0]]
398 set args [lrange $args 1 end]
400 return [eval $opt $cmdp $args]
403 proc _open_stdout_stderr {cmd} {
404 if {[catch {
405 set fd [open $cmd r]
406 } err]} {
407 if { [lindex $cmd end] eq {2>@1}
408 && $err eq {can not find channel named "1"}
410 # Older versions of Tcl 8.4 don't have this 2>@1 IO
411 # redirect operator. Fallback to |& cat for those.
412 # The command was not actually started, so its safe
413 # to try to start it a second time.
415 set fd [open [concat \
416 [lrange $cmd 0 end-1] \
417 [list |& cat] \
418 ] r]
419 } else {
420 error $err
423 fconfigure $fd -eofchar {}
424 return $fd
427 proc git_read {args} {
428 set opt [list |]
430 while {1} {
431 switch -- [lindex $args 0] {
432 --nice {
433 _lappend_nice opt
436 --stderr {
437 lappend args 2>@1
440 default {
441 break
446 set args [lrange $args 1 end]
449 set cmdp [_git_cmd [lindex $args 0]]
450 set args [lrange $args 1 end]
452 return [_open_stdout_stderr [concat $opt $cmdp $args]]
455 proc git_write {args} {
456 set opt [list |]
458 while {1} {
459 switch -- [lindex $args 0] {
460 --nice {
461 _lappend_nice opt
464 default {
465 break
470 set args [lrange $args 1 end]
473 set cmdp [_git_cmd [lindex $args 0]]
474 set args [lrange $args 1 end]
476 return [open [concat $opt $cmdp $args] w]
479 proc sq {value} {
480 regsub -all ' $value "'\\''" value
481 return "'$value'"
484 proc load_current_branch {} {
485 global current_branch is_detached
487 set fd [open [gitdir HEAD] r]
488 if {[gets $fd ref] < 1} {
489 set ref {}
491 close $fd
493 set pfx {ref: refs/heads/}
494 set len [string length $pfx]
495 if {[string equal -length $len $pfx $ref]} {
496 # We're on a branch. It might not exist. But
497 # HEAD looks good enough to be a branch.
499 set current_branch [string range $ref $len end]
500 set is_detached 0
501 } else {
502 # Assume this is a detached head.
504 set current_branch HEAD
505 set is_detached 1
509 auto_load tk_optionMenu
510 rename tk_optionMenu real__tkOptionMenu
511 proc tk_optionMenu {w varName args} {
512 set m [eval real__tkOptionMenu $w $varName $args]
513 $m configure -font font_ui
514 $w configure -font font_ui
515 return $m
518 ######################################################################
520 ## find git
522 set _git [_which git]
523 if {$_git eq {}} {
524 catch {wm withdraw .}
525 error_popup "Cannot find git in PATH."
526 exit 1
529 ######################################################################
531 ## version check
533 if {[catch {set _git_version [git --version]} err]} {
534 catch {wm withdraw .}
535 error_popup "Cannot determine Git version:
537 $err
539 [appname] requires Git 1.5.0 or later."
540 exit 1
542 if {![regsub {^git version } $_git_version {} _git_version]} {
543 catch {wm withdraw .}
544 error_popup "Cannot parse Git version string:\n\n$_git_version"
545 exit 1
548 set _real_git_version $_git_version
549 regsub -- {-dirty$} $_git_version {} _git_version
550 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
551 regsub {\.rc[0-9]+$} $_git_version {} _git_version
552 regsub {\.GIT$} $_git_version {} _git_version
554 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
555 catch {wm withdraw .}
556 if {[tk_messageBox \
557 -icon warning \
558 -type yesno \
559 -default no \
560 -title "[appname]: warning" \
561 -message "Git version cannot be determined.
563 $_git claims it is version '$_real_git_version'.
565 [appname] requires at least Git 1.5.0 or later.
567 Assume '$_real_git_version' is version 1.5.0?
568 "] eq {yes}} {
569 set _git_version 1.5.0
570 } else {
571 exit 1
574 unset _real_git_version
576 proc git-version {args} {
577 global _git_version
579 switch [llength $args] {
581 return $_git_version
585 set op [lindex $args 0]
586 set vr [lindex $args 1]
587 set cm [package vcompare $_git_version $vr]
588 return [expr $cm $op 0]
592 set type [lindex $args 0]
593 set name [lindex $args 1]
594 set parm [lindex $args 2]
595 set body [lindex $args 3]
597 if {($type ne {proc} && $type ne {method})} {
598 error "Invalid arguments to git-version"
600 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
601 error "Last arm of $type $name must be default"
604 foreach {op vr cb} [lrange $body 0 end-2] {
605 if {[git-version $op $vr]} {
606 return [uplevel [list $type $name $parm $cb]]
610 return [uplevel [list $type $name $parm [lindex $body end]]]
613 default {
614 error "git-version >= x"
620 if {[git-version < 1.5]} {
621 catch {wm withdraw .}
622 error_popup "[appname] requires Git 1.5.0 or later.
624 You are using [git-version]:
626 [git --version]"
627 exit 1
630 ######################################################################
632 ## feature option selection
634 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
635 unset _junk
636 } else {
637 set subcommand gui
639 if {$subcommand eq {gui.sh}} {
640 set subcommand gui
642 if {$subcommand eq {gui} && [llength $argv] > 0} {
643 set subcommand [lindex $argv 0]
644 set argv [lrange $argv 1 end]
647 enable_option multicommit
648 enable_option branch
649 enable_option transport
650 disable_option bare
652 switch -- $subcommand {
653 browser -
654 blame {
655 enable_option bare
657 disable_option multicommit
658 disable_option branch
659 disable_option transport
661 citool {
662 enable_option singlecommit
664 disable_option multicommit
665 disable_option branch
666 disable_option transport
670 ######################################################################
672 ## repository setup
674 if {[catch {
675 set _gitdir $env(GIT_DIR)
676 set _prefix {}
678 && [catch {
679 set _gitdir [git rev-parse --git-dir]
680 set _prefix [git rev-parse --show-prefix]
681 } err]} {
682 catch {wm withdraw .}
683 error_popup "Cannot find the git directory:\n\n$err"
684 exit 1
686 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
687 catch {set _gitdir [exec cygpath --unix $_gitdir]}
689 if {![file isdirectory $_gitdir]} {
690 catch {wm withdraw .}
691 error_popup "Git directory not found:\n\n$_gitdir"
692 exit 1
694 if {![is_enabled bare]} {
695 if {[lindex [file split $_gitdir] end] ne {.git}} {
696 catch {wm withdraw .}
697 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
698 exit 1
700 if {[catch {cd [file dirname $_gitdir]} err]} {
701 catch {wm withdraw .}
702 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
703 exit 1
706 set _reponame [file split [file normalize $_gitdir]]
707 if {[lindex $_reponame end] eq {.git}} {
708 set _reponame [lindex $_reponame end-1]
709 } else {
710 set _reponame [lindex $_reponame end]
713 ######################################################################
715 ## global init
717 set current_diff_path {}
718 set current_diff_side {}
719 set diff_actions [list]
721 set HEAD {}
722 set PARENT {}
723 set MERGE_HEAD [list]
724 set commit_type {}
725 set empty_tree {}
726 set current_branch {}
727 set is_detached 0
728 set current_diff_path {}
729 set selected_commit_type new
731 ######################################################################
733 ## task management
735 set rescan_active 0
736 set diff_active 0
737 set last_clicked {}
739 set disable_on_lock [list]
740 set index_lock_type none
742 proc lock_index {type} {
743 global index_lock_type disable_on_lock
745 if {$index_lock_type eq {none}} {
746 set index_lock_type $type
747 foreach w $disable_on_lock {
748 uplevel #0 $w disabled
750 return 1
751 } elseif {$index_lock_type eq "begin-$type"} {
752 set index_lock_type $type
753 return 1
755 return 0
758 proc unlock_index {} {
759 global index_lock_type disable_on_lock
761 set index_lock_type none
762 foreach w $disable_on_lock {
763 uplevel #0 $w normal
767 ######################################################################
769 ## status
771 proc repository_state {ctvar hdvar mhvar} {
772 global current_branch
773 upvar $ctvar ct $hdvar hd $mhvar mh
775 set mh [list]
777 load_current_branch
778 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
779 set hd {}
780 set ct initial
781 return
784 set merge_head [gitdir MERGE_HEAD]
785 if {[file exists $merge_head]} {
786 set ct merge
787 set fd_mh [open $merge_head r]
788 while {[gets $fd_mh line] >= 0} {
789 lappend mh $line
791 close $fd_mh
792 return
795 set ct normal
798 proc PARENT {} {
799 global PARENT empty_tree
801 set p [lindex $PARENT 0]
802 if {$p ne {}} {
803 return $p
805 if {$empty_tree eq {}} {
806 set empty_tree [git mktree << {}]
808 return $empty_tree
811 proc rescan {after {honor_trustmtime 1}} {
812 global HEAD PARENT MERGE_HEAD commit_type
813 global ui_index ui_workdir ui_comm
814 global rescan_active file_states
815 global repo_config
817 if {$rescan_active > 0 || ![lock_index read]} return
819 repository_state newType newHEAD newMERGE_HEAD
820 if {[string match amend* $commit_type]
821 && $newType eq {normal}
822 && $newHEAD eq $HEAD} {
823 } else {
824 set HEAD $newHEAD
825 set PARENT $newHEAD
826 set MERGE_HEAD $newMERGE_HEAD
827 set commit_type $newType
830 array unset file_states
832 if {!$::GITGUI_BCK_exists &&
833 (![$ui_comm edit modified]
834 || [string trim [$ui_comm get 0.0 end]] eq {})} {
835 if {[string match amend* $commit_type]} {
836 } elseif {[load_message GITGUI_MSG]} {
837 } elseif {[load_message MERGE_MSG]} {
838 } elseif {[load_message SQUASH_MSG]} {
840 $ui_comm edit reset
841 $ui_comm edit modified false
844 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
845 rescan_stage2 {} $after
846 } else {
847 set rescan_active 1
848 ui_status {Refreshing file status...}
849 set fd_rf [git_read update-index \
850 -q \
851 --unmerged \
852 --ignore-missing \
853 --refresh \
855 fconfigure $fd_rf -blocking 0 -translation binary
856 fileevent $fd_rf readable \
857 [list rescan_stage2 $fd_rf $after]
861 proc rescan_stage2 {fd after} {
862 global rescan_active buf_rdi buf_rdf buf_rlo
864 if {$fd ne {}} {
865 read $fd
866 if {![eof $fd]} return
867 close $fd
870 set ls_others [list --exclude-per-directory=.gitignore]
871 set info_exclude [gitdir info exclude]
872 if {[file readable $info_exclude]} {
873 lappend ls_others "--exclude-from=$info_exclude"
875 set user_exclude [get_config core.excludesfile]
876 if {$user_exclude ne {} && [file readable $user_exclude]} {
877 lappend ls_others "--exclude-from=$user_exclude"
880 set buf_rdi {}
881 set buf_rdf {}
882 set buf_rlo {}
884 set rescan_active 3
885 ui_status {Scanning for modified files ...}
886 set fd_di [git_read diff-index --cached -z [PARENT]]
887 set fd_df [git_read diff-files -z]
888 set fd_lo [eval git_read ls-files --others -z $ls_others]
890 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
891 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
892 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
893 fileevent $fd_di readable [list read_diff_index $fd_di $after]
894 fileevent $fd_df readable [list read_diff_files $fd_df $after]
895 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
898 proc load_message {file} {
899 global ui_comm
901 set f [gitdir $file]
902 if {[file isfile $f]} {
903 if {[catch {set fd [open $f r]}]} {
904 return 0
906 fconfigure $fd -eofchar {}
907 set content [string trim [read $fd]]
908 close $fd
909 regsub -all -line {[ \r\t]+$} $content {} content
910 $ui_comm delete 0.0 end
911 $ui_comm insert end $content
912 return 1
914 return 0
917 proc read_diff_index {fd after} {
918 global buf_rdi
920 append buf_rdi [read $fd]
921 set c 0
922 set n [string length $buf_rdi]
923 while {$c < $n} {
924 set z1 [string first "\0" $buf_rdi $c]
925 if {$z1 == -1} break
926 incr z1
927 set z2 [string first "\0" $buf_rdi $z1]
928 if {$z2 == -1} break
930 incr c
931 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
932 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
933 merge_state \
934 [encoding convertfrom $p] \
935 [lindex $i 4]? \
936 [list [lindex $i 0] [lindex $i 2]] \
937 [list]
938 set c $z2
939 incr c
941 if {$c < $n} {
942 set buf_rdi [string range $buf_rdi $c end]
943 } else {
944 set buf_rdi {}
947 rescan_done $fd buf_rdi $after
950 proc read_diff_files {fd after} {
951 global buf_rdf
953 append buf_rdf [read $fd]
954 set c 0
955 set n [string length $buf_rdf]
956 while {$c < $n} {
957 set z1 [string first "\0" $buf_rdf $c]
958 if {$z1 == -1} break
959 incr z1
960 set z2 [string first "\0" $buf_rdf $z1]
961 if {$z2 == -1} break
963 incr c
964 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
965 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
966 merge_state \
967 [encoding convertfrom $p] \
968 ?[lindex $i 4] \
969 [list] \
970 [list [lindex $i 0] [lindex $i 2]]
971 set c $z2
972 incr c
974 if {$c < $n} {
975 set buf_rdf [string range $buf_rdf $c end]
976 } else {
977 set buf_rdf {}
980 rescan_done $fd buf_rdf $after
983 proc read_ls_others {fd after} {
984 global buf_rlo
986 append buf_rlo [read $fd]
987 set pck [split $buf_rlo "\0"]
988 set buf_rlo [lindex $pck end]
989 foreach p [lrange $pck 0 end-1] {
990 merge_state [encoding convertfrom $p] ?O
992 rescan_done $fd buf_rlo $after
995 proc rescan_done {fd buf after} {
996 global rescan_active current_diff_path
997 global file_states repo_config
998 upvar $buf to_clear
1000 if {![eof $fd]} return
1001 set to_clear {}
1002 close $fd
1003 if {[incr rescan_active -1] > 0} return
1005 prune_selection
1006 unlock_index
1007 display_all_files
1008 if {$current_diff_path ne {}} reshow_diff
1009 uplevel #0 $after
1012 proc prune_selection {} {
1013 global file_states selected_paths
1015 foreach path [array names selected_paths] {
1016 if {[catch {set still_here $file_states($path)}]} {
1017 unset selected_paths($path)
1022 ######################################################################
1024 ## ui helpers
1026 proc mapicon {w state path} {
1027 global all_icons
1029 if {[catch {set r $all_icons($state$w)}]} {
1030 puts "error: no icon for $w state={$state} $path"
1031 return file_plain
1033 return $r
1036 proc mapdesc {state path} {
1037 global all_descs
1039 if {[catch {set r $all_descs($state)}]} {
1040 puts "error: no desc for state={$state} $path"
1041 return $state
1043 return $r
1046 proc ui_status {msg} {
1047 $::main_status show $msg
1050 proc ui_ready {{test {}}} {
1051 $::main_status show {Ready.} $test
1054 proc escape_path {path} {
1055 regsub -all {\\} $path "\\\\" path
1056 regsub -all "\n" $path "\\n" path
1057 return $path
1060 proc short_path {path} {
1061 return [escape_path [lindex [file split $path] end]]
1064 set next_icon_id 0
1065 set null_sha1 [string repeat 0 40]
1067 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1068 global file_states next_icon_id null_sha1
1070 set s0 [string index $new_state 0]
1071 set s1 [string index $new_state 1]
1073 if {[catch {set info $file_states($path)}]} {
1074 set state __
1075 set icon n[incr next_icon_id]
1076 } else {
1077 set state [lindex $info 0]
1078 set icon [lindex $info 1]
1079 if {$head_info eq {}} {set head_info [lindex $info 2]}
1080 if {$index_info eq {}} {set index_info [lindex $info 3]}
1083 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1084 elseif {$s0 eq {_}} {set s0 _}
1086 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1087 elseif {$s1 eq {_}} {set s1 _}
1089 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1090 set head_info [list 0 $null_sha1]
1091 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1092 && $head_info eq {}} {
1093 set head_info $index_info
1096 set file_states($path) [list $s0$s1 $icon \
1097 $head_info $index_info \
1099 return $state
1102 proc display_file_helper {w path icon_name old_m new_m} {
1103 global file_lists
1105 if {$new_m eq {_}} {
1106 set lno [lsearch -sorted -exact $file_lists($w) $path]
1107 if {$lno >= 0} {
1108 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1109 incr lno
1110 $w conf -state normal
1111 $w delete $lno.0 [expr {$lno + 1}].0
1112 $w conf -state disabled
1114 } elseif {$old_m eq {_} && $new_m ne {_}} {
1115 lappend file_lists($w) $path
1116 set file_lists($w) [lsort -unique $file_lists($w)]
1117 set lno [lsearch -sorted -exact $file_lists($w) $path]
1118 incr lno
1119 $w conf -state normal
1120 $w image create $lno.0 \
1121 -align center -padx 5 -pady 1 \
1122 -name $icon_name \
1123 -image [mapicon $w $new_m $path]
1124 $w insert $lno.1 "[escape_path $path]\n"
1125 $w conf -state disabled
1126 } elseif {$old_m ne $new_m} {
1127 $w conf -state normal
1128 $w image conf $icon_name -image [mapicon $w $new_m $path]
1129 $w conf -state disabled
1133 proc display_file {path state} {
1134 global file_states selected_paths
1135 global ui_index ui_workdir
1137 set old_m [merge_state $path $state]
1138 set s $file_states($path)
1139 set new_m [lindex $s 0]
1140 set icon_name [lindex $s 1]
1142 set o [string index $old_m 0]
1143 set n [string index $new_m 0]
1144 if {$o eq {U}} {
1145 set o _
1147 if {$n eq {U}} {
1148 set n _
1150 display_file_helper $ui_index $path $icon_name $o $n
1152 if {[string index $old_m 0] eq {U}} {
1153 set o U
1154 } else {
1155 set o [string index $old_m 1]
1157 if {[string index $new_m 0] eq {U}} {
1158 set n U
1159 } else {
1160 set n [string index $new_m 1]
1162 display_file_helper $ui_workdir $path $icon_name $o $n
1164 if {$new_m eq {__}} {
1165 unset file_states($path)
1166 catch {unset selected_paths($path)}
1170 proc display_all_files_helper {w path icon_name m} {
1171 global file_lists
1173 lappend file_lists($w) $path
1174 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1175 $w image create end \
1176 -align center -padx 5 -pady 1 \
1177 -name $icon_name \
1178 -image [mapicon $w $m $path]
1179 $w insert end "[escape_path $path]\n"
1182 proc display_all_files {} {
1183 global ui_index ui_workdir
1184 global file_states file_lists
1185 global last_clicked
1187 $ui_index conf -state normal
1188 $ui_workdir conf -state normal
1190 $ui_index delete 0.0 end
1191 $ui_workdir delete 0.0 end
1192 set last_clicked {}
1194 set file_lists($ui_index) [list]
1195 set file_lists($ui_workdir) [list]
1197 foreach path [lsort [array names file_states]] {
1198 set s $file_states($path)
1199 set m [lindex $s 0]
1200 set icon_name [lindex $s 1]
1202 set s [string index $m 0]
1203 if {$s ne {U} && $s ne {_}} {
1204 display_all_files_helper $ui_index $path \
1205 $icon_name $s
1208 if {[string index $m 0] eq {U}} {
1209 set s U
1210 } else {
1211 set s [string index $m 1]
1213 if {$s ne {_}} {
1214 display_all_files_helper $ui_workdir $path \
1215 $icon_name $s
1219 $ui_index conf -state disabled
1220 $ui_workdir conf -state disabled
1223 ######################################################################
1225 ## icons
1227 set filemask {
1228 #define mask_width 14
1229 #define mask_height 15
1230 static unsigned char mask_bits[] = {
1231 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1232 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1233 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1236 image create bitmap file_plain -background white -foreground black -data {
1237 #define plain_width 14
1238 #define plain_height 15
1239 static unsigned char plain_bits[] = {
1240 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1241 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1242 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1243 } -maskdata $filemask
1245 image create bitmap file_mod -background white -foreground blue -data {
1246 #define mod_width 14
1247 #define mod_height 15
1248 static unsigned char mod_bits[] = {
1249 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1250 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1251 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1252 } -maskdata $filemask
1254 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1255 #define file_fulltick_width 14
1256 #define file_fulltick_height 15
1257 static unsigned char file_fulltick_bits[] = {
1258 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1259 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1260 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1261 } -maskdata $filemask
1263 image create bitmap file_parttick -background white -foreground "#005050" -data {
1264 #define parttick_width 14
1265 #define parttick_height 15
1266 static unsigned char parttick_bits[] = {
1267 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1268 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1269 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1270 } -maskdata $filemask
1272 image create bitmap file_question -background white -foreground black -data {
1273 #define file_question_width 14
1274 #define file_question_height 15
1275 static unsigned char file_question_bits[] = {
1276 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1277 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1278 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1279 } -maskdata $filemask
1281 image create bitmap file_removed -background white -foreground red -data {
1282 #define file_removed_width 14
1283 #define file_removed_height 15
1284 static unsigned char file_removed_bits[] = {
1285 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1286 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1287 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1288 } -maskdata $filemask
1290 image create bitmap file_merge -background white -foreground blue -data {
1291 #define file_merge_width 14
1292 #define file_merge_height 15
1293 static unsigned char file_merge_bits[] = {
1294 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1295 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1296 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1297 } -maskdata $filemask
1299 set ui_index .vpane.files.index.list
1300 set ui_workdir .vpane.files.workdir.list
1302 set all_icons(_$ui_index) file_plain
1303 set all_icons(A$ui_index) file_fulltick
1304 set all_icons(M$ui_index) file_fulltick
1305 set all_icons(D$ui_index) file_removed
1306 set all_icons(U$ui_index) file_merge
1308 set all_icons(_$ui_workdir) file_plain
1309 set all_icons(M$ui_workdir) file_mod
1310 set all_icons(D$ui_workdir) file_question
1311 set all_icons(U$ui_workdir) file_merge
1312 set all_icons(O$ui_workdir) file_plain
1314 set max_status_desc 0
1315 foreach i {
1316 {__ "Unmodified"}
1318 {_M "Modified, not staged"}
1319 {M_ "Staged for commit"}
1320 {MM "Portions staged for commit"}
1321 {MD "Staged for commit, missing"}
1323 {_O "Untracked, not staged"}
1324 {A_ "Staged for commit"}
1325 {AM "Portions staged for commit"}
1326 {AD "Staged for commit, missing"}
1328 {_D "Missing"}
1329 {D_ "Staged for removal"}
1330 {DO "Staged for removal, still present"}
1332 {U_ "Requires merge resolution"}
1333 {UU "Requires merge resolution"}
1334 {UM "Requires merge resolution"}
1335 {UD "Requires merge resolution"}
1337 if {$max_status_desc < [string length [lindex $i 1]]} {
1338 set max_status_desc [string length [lindex $i 1]]
1340 set all_descs([lindex $i 0]) [lindex $i 1]
1342 unset i
1344 ######################################################################
1346 ## util
1348 proc bind_button3 {w cmd} {
1349 bind $w <Any-Button-3> $cmd
1350 if {[is_MacOSX]} {
1351 # Mac OS X sends Button-2 on right click through three-button mouse,
1352 # or through trackpad right-clicking (two-finger touch + click).
1353 bind $w <Any-Button-2> $cmd
1354 bind $w <Control-Button-1> $cmd
1358 proc scrollbar2many {list mode args} {
1359 foreach w $list {eval $w $mode $args}
1362 proc many2scrollbar {list mode sb top bottom} {
1363 $sb set $top $bottom
1364 foreach w $list {$w $mode moveto $top}
1367 proc incr_font_size {font {amt 1}} {
1368 set sz [font configure $font -size]
1369 incr sz $amt
1370 font configure $font -size $sz
1371 font configure ${font}bold -size $sz
1372 font configure ${font}italic -size $sz
1375 ######################################################################
1377 ## ui commands
1379 set starting_gitk_msg {Starting gitk... please wait...}
1381 proc do_gitk {revs} {
1382 # -- Always start gitk through whatever we were loaded with. This
1383 # lets us bypass using shell process on Windows systems.
1385 set exe [file join [file dirname $::_git] gitk]
1386 set cmd [list [info nameofexecutable] $exe]
1387 if {! [file exists $exe]} {
1388 error_popup "Unable to start gitk:\n\n$exe does not exist"
1389 } else {
1390 eval exec $cmd $revs &
1391 ui_status $::starting_gitk_msg
1392 after 10000 {
1393 ui_ready $starting_gitk_msg
1398 set is_quitting 0
1400 proc do_quit {} {
1401 global ui_comm is_quitting repo_config commit_type
1402 global GITGUI_BCK_exists GITGUI_BCK_i
1404 if {$is_quitting} return
1405 set is_quitting 1
1407 if {[winfo exists $ui_comm]} {
1408 # -- Stash our current commit buffer.
1410 set save [gitdir GITGUI_MSG]
1411 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1412 file rename -force [gitdir GITGUI_BCK] $save
1413 set GITGUI_BCK_exists 0
1414 } else {
1415 set msg [string trim [$ui_comm get 0.0 end]]
1416 regsub -all -line {[ \r\t]+$} $msg {} msg
1417 if {(![string match amend* $commit_type]
1418 || [$ui_comm edit modified])
1419 && $msg ne {}} {
1420 catch {
1421 set fd [open $save w]
1422 puts -nonewline $fd $msg
1423 close $fd
1425 } else {
1426 catch {file delete $save}
1430 # -- Remove our editor backup, its not needed.
1432 after cancel $GITGUI_BCK_i
1433 if {$GITGUI_BCK_exists} {
1434 catch {file delete [gitdir GITGUI_BCK]}
1437 # -- Stash our current window geometry into this repository.
1439 set cfg_geometry [list]
1440 lappend cfg_geometry [wm geometry .]
1441 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1442 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1443 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1444 set rc_geometry {}
1446 if {$cfg_geometry ne $rc_geometry} {
1447 catch {git config gui.geometry $cfg_geometry}
1451 destroy .
1454 proc do_rescan {} {
1455 rescan ui_ready
1458 proc do_commit {} {
1459 commit_tree
1462 proc toggle_or_diff {w x y} {
1463 global file_states file_lists current_diff_path ui_index ui_workdir
1464 global last_clicked selected_paths
1466 set pos [split [$w index @$x,$y] .]
1467 set lno [lindex $pos 0]
1468 set col [lindex $pos 1]
1469 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1470 if {$path eq {}} {
1471 set last_clicked {}
1472 return
1475 set last_clicked [list $w $lno]
1476 array unset selected_paths
1477 $ui_index tag remove in_sel 0.0 end
1478 $ui_workdir tag remove in_sel 0.0 end
1480 if {$col == 0} {
1481 if {$current_diff_path eq $path} {
1482 set after {reshow_diff;}
1483 } else {
1484 set after {}
1486 if {$w eq $ui_index} {
1487 update_indexinfo \
1488 "Unstaging [short_path $path] from commit" \
1489 [list $path] \
1490 [concat $after [list ui_ready]]
1491 } elseif {$w eq $ui_workdir} {
1492 update_index \
1493 "Adding [short_path $path]" \
1494 [list $path] \
1495 [concat $after [list ui_ready]]
1497 } else {
1498 show_diff $path $w $lno
1502 proc add_one_to_selection {w x y} {
1503 global file_lists last_clicked selected_paths
1505 set lno [lindex [split [$w index @$x,$y] .] 0]
1506 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1507 if {$path eq {}} {
1508 set last_clicked {}
1509 return
1512 if {$last_clicked ne {}
1513 && [lindex $last_clicked 0] ne $w} {
1514 array unset selected_paths
1515 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1518 set last_clicked [list $w $lno]
1519 if {[catch {set in_sel $selected_paths($path)}]} {
1520 set in_sel 0
1522 if {$in_sel} {
1523 unset selected_paths($path)
1524 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1525 } else {
1526 set selected_paths($path) 1
1527 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1531 proc add_range_to_selection {w x y} {
1532 global file_lists last_clicked selected_paths
1534 if {[lindex $last_clicked 0] ne $w} {
1535 toggle_or_diff $w $x $y
1536 return
1539 set lno [lindex [split [$w index @$x,$y] .] 0]
1540 set lc [lindex $last_clicked 1]
1541 if {$lc < $lno} {
1542 set begin $lc
1543 set end $lno
1544 } else {
1545 set begin $lno
1546 set end $lc
1549 foreach path [lrange $file_lists($w) \
1550 [expr {$begin - 1}] \
1551 [expr {$end - 1}]] {
1552 set selected_paths($path) 1
1554 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1557 ######################################################################
1559 ## config defaults
1561 set cursor_ptr arrow
1562 font create font_diff -family Courier -size 10
1563 font create font_ui
1564 catch {
1565 label .dummy
1566 eval font configure font_ui [font actual [.dummy cget -font]]
1567 destroy .dummy
1570 font create font_uiitalic
1571 font create font_uibold
1572 font create font_diffbold
1573 font create font_diffitalic
1575 foreach class {Button Checkbutton Entry Label
1576 Labelframe Listbox Menu Message
1577 Radiobutton Spinbox Text} {
1578 option add *$class.font font_ui
1580 unset class
1582 if {[is_Windows] || [is_MacOSX]} {
1583 option add *Menu.tearOff 0
1586 if {[is_MacOSX]} {
1587 set M1B M1
1588 set M1T Cmd
1589 } else {
1590 set M1B Control
1591 set M1T Ctrl
1594 proc apply_config {} {
1595 global repo_config font_descs
1597 foreach option $font_descs {
1598 set name [lindex $option 0]
1599 set font [lindex $option 1]
1600 if {[catch {
1601 foreach {cn cv} $repo_config(gui.$name) {
1602 font configure $font $cn $cv
1604 } err]} {
1605 error_popup "Invalid font specified in gui.$name:\n\n$err"
1607 foreach {cn cv} [font configure $font] {
1608 font configure ${font}bold $cn $cv
1609 font configure ${font}italic $cn $cv
1611 font configure ${font}bold -weight bold
1612 font configure ${font}italic -slant italic
1616 set default_config(merge.diffstat) true
1617 set default_config(merge.summary) false
1618 set default_config(merge.verbosity) 2
1619 set default_config(user.name) {}
1620 set default_config(user.email) {}
1622 set default_config(gui.matchtrackingbranch) false
1623 set default_config(gui.pruneduringfetch) false
1624 set default_config(gui.trustmtime) false
1625 set default_config(gui.diffcontext) 5
1626 set default_config(gui.newbranchtemplate) {}
1627 set default_config(gui.fontui) [font configure font_ui]
1628 set default_config(gui.fontdiff) [font configure font_diff]
1629 set font_descs {
1630 {fontui font_ui {Main Font}}
1631 {fontdiff font_diff {Diff/Console Font}}
1633 load_config 0
1634 apply_config
1636 ######################################################################
1638 ## ui construction
1640 set ui_comm {}
1642 # -- Menu Bar
1644 menu .mbar -tearoff 0
1645 .mbar add cascade -label Repository -menu .mbar.repository
1646 .mbar add cascade -label Edit -menu .mbar.edit
1647 if {[is_enabled branch]} {
1648 .mbar add cascade -label Branch -menu .mbar.branch
1650 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1651 .mbar add cascade -label Commit -menu .mbar.commit
1653 if {[is_enabled transport]} {
1654 .mbar add cascade -label Merge -menu .mbar.merge
1655 .mbar add cascade -label Fetch -menu .mbar.fetch
1656 .mbar add cascade -label Push -menu .mbar.push
1658 . configure -menu .mbar
1660 # -- Repository Menu
1662 menu .mbar.repository
1664 .mbar.repository add command \
1665 -label {Browse Current Branch's Files} \
1666 -command {browser::new $current_branch}
1667 set ui_browse_current [.mbar.repository index last]
1668 .mbar.repository add command \
1669 -label {Browse Branch Files...} \
1670 -command browser_open::dialog
1671 .mbar.repository add separator
1673 .mbar.repository add command \
1674 -label {Visualize Current Branch's History} \
1675 -command {do_gitk $current_branch}
1676 set ui_visualize_current [.mbar.repository index last]
1677 .mbar.repository add command \
1678 -label {Visualize All Branch History} \
1679 -command {do_gitk --all}
1680 .mbar.repository add separator
1682 proc current_branch_write {args} {
1683 global current_branch
1684 .mbar.repository entryconf $::ui_browse_current \
1685 -label "Browse $current_branch's Files"
1686 .mbar.repository entryconf $::ui_visualize_current \
1687 -label "Visualize $current_branch's History"
1689 trace add variable current_branch write current_branch_write
1691 if {[is_enabled multicommit]} {
1692 .mbar.repository add command -label {Database Statistics} \
1693 -command do_stats
1695 .mbar.repository add command -label {Compress Database} \
1696 -command do_gc
1698 .mbar.repository add command -label {Verify Database} \
1699 -command do_fsck_objects
1701 .mbar.repository add separator
1703 if {[is_Cygwin]} {
1704 .mbar.repository add command \
1705 -label {Create Desktop Icon} \
1706 -command do_cygwin_shortcut
1707 } elseif {[is_Windows]} {
1708 .mbar.repository add command \
1709 -label {Create Desktop Icon} \
1710 -command do_windows_shortcut
1711 } elseif {[is_MacOSX]} {
1712 .mbar.repository add command \
1713 -label {Create Desktop Icon} \
1714 -command do_macosx_app
1718 .mbar.repository add command -label Quit \
1719 -command do_quit \
1720 -accelerator $M1T-Q
1722 # -- Edit Menu
1724 menu .mbar.edit
1725 .mbar.edit add command -label Undo \
1726 -command {catch {[focus] edit undo}} \
1727 -accelerator $M1T-Z
1728 .mbar.edit add command -label Redo \
1729 -command {catch {[focus] edit redo}} \
1730 -accelerator $M1T-Y
1731 .mbar.edit add separator
1732 .mbar.edit add command -label Cut \
1733 -command {catch {tk_textCut [focus]}} \
1734 -accelerator $M1T-X
1735 .mbar.edit add command -label Copy \
1736 -command {catch {tk_textCopy [focus]}} \
1737 -accelerator $M1T-C
1738 .mbar.edit add command -label Paste \
1739 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1740 -accelerator $M1T-V
1741 .mbar.edit add command -label Delete \
1742 -command {catch {[focus] delete sel.first sel.last}} \
1743 -accelerator Del
1744 .mbar.edit add separator
1745 .mbar.edit add command -label {Select All} \
1746 -command {catch {[focus] tag add sel 0.0 end}} \
1747 -accelerator $M1T-A
1749 # -- Branch Menu
1751 if {[is_enabled branch]} {
1752 menu .mbar.branch
1754 .mbar.branch add command -label {Create...} \
1755 -command branch_create::dialog \
1756 -accelerator $M1T-N
1757 lappend disable_on_lock [list .mbar.branch entryconf \
1758 [.mbar.branch index last] -state]
1760 .mbar.branch add command -label {Checkout...} \
1761 -command branch_checkout::dialog \
1762 -accelerator $M1T-O
1763 lappend disable_on_lock [list .mbar.branch entryconf \
1764 [.mbar.branch index last] -state]
1766 .mbar.branch add command -label {Rename...} \
1767 -command branch_rename::dialog
1768 lappend disable_on_lock [list .mbar.branch entryconf \
1769 [.mbar.branch index last] -state]
1771 .mbar.branch add command -label {Delete...} \
1772 -command branch_delete::dialog
1773 lappend disable_on_lock [list .mbar.branch entryconf \
1774 [.mbar.branch index last] -state]
1776 .mbar.branch add command -label {Reset...} \
1777 -command merge::reset_hard
1778 lappend disable_on_lock [list .mbar.branch entryconf \
1779 [.mbar.branch index last] -state]
1782 # -- Commit Menu
1784 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1785 menu .mbar.commit
1787 .mbar.commit add radiobutton \
1788 -label {New Commit} \
1789 -command do_select_commit_type \
1790 -variable selected_commit_type \
1791 -value new
1792 lappend disable_on_lock \
1793 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1795 .mbar.commit add radiobutton \
1796 -label {Amend Last Commit} \
1797 -command do_select_commit_type \
1798 -variable selected_commit_type \
1799 -value amend
1800 lappend disable_on_lock \
1801 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1803 .mbar.commit add separator
1805 .mbar.commit add command -label Rescan \
1806 -command do_rescan \
1807 -accelerator F5
1808 lappend disable_on_lock \
1809 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1811 .mbar.commit add command -label {Stage To Commit} \
1812 -command do_add_selection
1813 lappend disable_on_lock \
1814 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1816 .mbar.commit add command -label {Stage Changed Files To Commit} \
1817 -command do_add_all \
1818 -accelerator $M1T-I
1819 lappend disable_on_lock \
1820 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1822 .mbar.commit add command -label {Unstage From Commit} \
1823 -command do_unstage_selection
1824 lappend disable_on_lock \
1825 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1827 .mbar.commit add command -label {Revert Changes} \
1828 -command do_revert_selection
1829 lappend disable_on_lock \
1830 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1832 .mbar.commit add separator
1834 .mbar.commit add command -label {Sign Off} \
1835 -command do_signoff \
1836 -accelerator $M1T-S
1838 .mbar.commit add command -label Commit \
1839 -command do_commit \
1840 -accelerator $M1T-Return
1841 lappend disable_on_lock \
1842 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1845 # -- Merge Menu
1847 if {[is_enabled branch]} {
1848 menu .mbar.merge
1849 .mbar.merge add command -label {Local Merge...} \
1850 -command merge::dialog \
1851 -accelerator $M1T-M
1852 lappend disable_on_lock \
1853 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1854 .mbar.merge add command -label {Abort Merge...} \
1855 -command merge::reset_hard
1856 lappend disable_on_lock \
1857 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1860 # -- Transport Menu
1862 if {[is_enabled transport]} {
1863 menu .mbar.fetch
1865 menu .mbar.push
1866 .mbar.push add command -label {Push...} \
1867 -command do_push_anywhere \
1868 -accelerator $M1T-P
1869 .mbar.push add command -label {Delete...} \
1870 -command remote_branch_delete::dialog
1873 if {[is_MacOSX]} {
1874 # -- Apple Menu (Mac OS X only)
1876 .mbar add cascade -label Apple -menu .mbar.apple
1877 menu .mbar.apple
1879 .mbar.apple add command -label "About [appname]" \
1880 -command do_about
1881 .mbar.apple add command -label "Options..." \
1882 -command do_options
1883 } else {
1884 # -- Edit Menu
1886 .mbar.edit add separator
1887 .mbar.edit add command -label {Options...} \
1888 -command do_options
1891 # -- Help Menu
1893 .mbar add cascade -label Help -menu .mbar.help
1894 menu .mbar.help
1896 if {![is_MacOSX]} {
1897 .mbar.help add command -label "About [appname]" \
1898 -command do_about
1901 set browser {}
1902 catch {set browser $repo_config(instaweb.browser)}
1903 set doc_path [file dirname [gitexec]]
1904 set doc_path [file join $doc_path Documentation index.html]
1906 if {[is_Cygwin]} {
1907 set doc_path [exec cygpath --mixed $doc_path]
1910 if {$browser eq {}} {
1911 if {[is_MacOSX]} {
1912 set browser open
1913 } elseif {[is_Cygwin]} {
1914 set program_files [file dirname [exec cygpath --windir]]
1915 set program_files [file join $program_files {Program Files}]
1916 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1917 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1918 if {[file exists $firefox]} {
1919 set browser $firefox
1920 } elseif {[file exists $ie]} {
1921 set browser $ie
1923 unset program_files firefox ie
1927 if {[file isfile $doc_path]} {
1928 set doc_url "file:$doc_path"
1929 } else {
1930 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1933 if {$browser ne {}} {
1934 .mbar.help add command -label {Online Documentation} \
1935 -command [list exec $browser $doc_url &]
1937 unset browser doc_path doc_url
1939 set root_exists 0
1940 bind . <Visibility> {
1941 bind . <Visibility> {}
1942 set root_exists 1
1945 # -- Standard bindings
1947 wm protocol . WM_DELETE_WINDOW do_quit
1948 bind all <$M1B-Key-q> do_quit
1949 bind all <$M1B-Key-Q> do_quit
1950 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1951 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1953 set subcommand_args {}
1954 proc usage {} {
1955 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1956 exit 1
1959 # -- Not a normal commit type invocation? Do that instead!
1961 switch -- $subcommand {
1962 browser -
1963 blame {
1964 set subcommand_args {rev? path}
1965 if {$argv eq {}} usage
1966 set head {}
1967 set path {}
1968 set is_path 0
1969 foreach a $argv {
1970 if {$is_path || [file exists $_prefix$a]} {
1971 if {$path ne {}} usage
1972 set path $_prefix$a
1973 break
1974 } elseif {$a eq {--}} {
1975 if {$path ne {}} {
1976 if {$head ne {}} usage
1977 set head $path
1978 set path {}
1980 set is_path 1
1981 } elseif {$head eq {}} {
1982 if {$head ne {}} usage
1983 set head $a
1984 set is_path 1
1985 } else {
1986 usage
1989 unset is_path
1991 if {$head ne {} && $path eq {}} {
1992 set path $_prefix$head
1993 set head {}
1996 if {$head eq {}} {
1997 load_current_branch
1998 } else {
1999 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2000 if {[catch {
2001 set head [git rev-parse --verify $head]
2002 } err]} {
2003 puts stderr $err
2004 exit 1
2007 set current_branch $head
2010 switch -- $subcommand {
2011 browser {
2012 if {$head eq {}} {
2013 if {$path ne {} && [file isdirectory $path]} {
2014 set head $current_branch
2015 } else {
2016 set head $path
2017 set path {}
2020 browser::new $head $path
2022 blame {
2023 if {$head eq {} && ![file exists $path]} {
2024 puts stderr "fatal: cannot stat path $path: No such file or directory"
2025 exit 1
2027 blame::new $head $path
2030 return
2032 citool -
2033 gui {
2034 if {[llength $argv] != 0} {
2035 puts -nonewline stderr "usage: $argv0"
2036 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2037 puts -nonewline stderr " $subcommand"
2039 puts stderr {}
2040 exit 1
2042 # fall through to setup UI for commits
2044 default {
2045 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2046 exit 1
2050 # -- Branch Control
2052 frame .branch \
2053 -borderwidth 1 \
2054 -relief sunken
2055 label .branch.l1 \
2056 -text {Current Branch:} \
2057 -anchor w \
2058 -justify left
2059 label .branch.cb \
2060 -textvariable current_branch \
2061 -anchor w \
2062 -justify left
2063 pack .branch.l1 -side left
2064 pack .branch.cb -side left -fill x
2065 pack .branch -side top -fill x
2067 # -- Main Window Layout
2069 panedwindow .vpane -orient vertical
2070 panedwindow .vpane.files -orient horizontal
2071 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2072 pack .vpane -anchor n -side top -fill both -expand 1
2074 # -- Index File List
2076 frame .vpane.files.index -height 100 -width 200
2077 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2078 -background lightgreen
2079 text $ui_index -background white -borderwidth 0 \
2080 -width 20 -height 10 \
2081 -wrap none \
2082 -cursor $cursor_ptr \
2083 -xscrollcommand {.vpane.files.index.sx set} \
2084 -yscrollcommand {.vpane.files.index.sy set} \
2085 -state disabled
2086 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2087 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2088 pack .vpane.files.index.title -side top -fill x
2089 pack .vpane.files.index.sx -side bottom -fill x
2090 pack .vpane.files.index.sy -side right -fill y
2091 pack $ui_index -side left -fill both -expand 1
2092 .vpane.files add .vpane.files.index -sticky nsew
2094 # -- Working Directory File List
2096 frame .vpane.files.workdir -height 100 -width 200
2097 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2098 -background lightsalmon
2099 text $ui_workdir -background white -borderwidth 0 \
2100 -width 20 -height 10 \
2101 -wrap none \
2102 -cursor $cursor_ptr \
2103 -xscrollcommand {.vpane.files.workdir.sx set} \
2104 -yscrollcommand {.vpane.files.workdir.sy set} \
2105 -state disabled
2106 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2107 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2108 pack .vpane.files.workdir.title -side top -fill x
2109 pack .vpane.files.workdir.sx -side bottom -fill x
2110 pack .vpane.files.workdir.sy -side right -fill y
2111 pack $ui_workdir -side left -fill both -expand 1
2112 .vpane.files add .vpane.files.workdir -sticky nsew
2114 foreach i [list $ui_index $ui_workdir] {
2115 $i tag conf in_diff -background lightgray
2116 $i tag conf in_sel -background lightgray
2118 unset i
2120 # -- Diff and Commit Area
2122 frame .vpane.lower -height 300 -width 400
2123 frame .vpane.lower.commarea
2124 frame .vpane.lower.diff -relief sunken -borderwidth 1
2125 pack .vpane.lower.commarea -side top -fill x
2126 pack .vpane.lower.diff -side bottom -fill both -expand 1
2127 .vpane add .vpane.lower -sticky nsew
2129 # -- Commit Area Buttons
2131 frame .vpane.lower.commarea.buttons
2132 label .vpane.lower.commarea.buttons.l -text {} \
2133 -anchor w \
2134 -justify left
2135 pack .vpane.lower.commarea.buttons.l -side top -fill x
2136 pack .vpane.lower.commarea.buttons -side left -fill y
2138 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2139 -command do_rescan
2140 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2141 lappend disable_on_lock \
2142 {.vpane.lower.commarea.buttons.rescan conf -state}
2144 button .vpane.lower.commarea.buttons.incall -text {Stage Changed} \
2145 -command do_add_all
2146 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2147 lappend disable_on_lock \
2148 {.vpane.lower.commarea.buttons.incall conf -state}
2150 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2151 -command do_signoff
2152 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2154 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2155 -command do_commit
2156 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2157 lappend disable_on_lock \
2158 {.vpane.lower.commarea.buttons.commit conf -state}
2160 button .vpane.lower.commarea.buttons.push -text {Push} \
2161 -command do_push_anywhere
2162 pack .vpane.lower.commarea.buttons.push -side top -fill x
2164 # -- Commit Message Buffer
2166 frame .vpane.lower.commarea.buffer
2167 frame .vpane.lower.commarea.buffer.header
2168 set ui_comm .vpane.lower.commarea.buffer.t
2169 set ui_coml .vpane.lower.commarea.buffer.header.l
2170 radiobutton .vpane.lower.commarea.buffer.header.new \
2171 -text {New Commit} \
2172 -command do_select_commit_type \
2173 -variable selected_commit_type \
2174 -value new
2175 lappend disable_on_lock \
2176 [list .vpane.lower.commarea.buffer.header.new conf -state]
2177 radiobutton .vpane.lower.commarea.buffer.header.amend \
2178 -text {Amend Last Commit} \
2179 -command do_select_commit_type \
2180 -variable selected_commit_type \
2181 -value amend
2182 lappend disable_on_lock \
2183 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2184 label $ui_coml \
2185 -anchor w \
2186 -justify left
2187 proc trace_commit_type {varname args} {
2188 global ui_coml commit_type
2189 switch -glob -- $commit_type {
2190 initial {set txt {Initial Commit Message:}}
2191 amend {set txt {Amended Commit Message:}}
2192 amend-initial {set txt {Amended Initial Commit Message:}}
2193 amend-merge {set txt {Amended Merge Commit Message:}}
2194 merge {set txt {Merge Commit Message:}}
2195 * {set txt {Commit Message:}}
2197 $ui_coml conf -text $txt
2199 trace add variable commit_type write trace_commit_type
2200 pack $ui_coml -side left -fill x
2201 pack .vpane.lower.commarea.buffer.header.amend -side right
2202 pack .vpane.lower.commarea.buffer.header.new -side right
2204 text $ui_comm -background white -borderwidth 1 \
2205 -undo true \
2206 -maxundo 20 \
2207 -autoseparators true \
2208 -relief sunken \
2209 -width 75 -height 9 -wrap none \
2210 -font font_diff \
2211 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2212 scrollbar .vpane.lower.commarea.buffer.sby \
2213 -command [list $ui_comm yview]
2214 pack .vpane.lower.commarea.buffer.header -side top -fill x
2215 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2216 pack $ui_comm -side left -fill y
2217 pack .vpane.lower.commarea.buffer -side left -fill y
2219 # -- Commit Message Buffer Context Menu
2221 set ctxm .vpane.lower.commarea.buffer.ctxm
2222 menu $ctxm -tearoff 0
2223 $ctxm add command \
2224 -label {Cut} \
2225 -command {tk_textCut $ui_comm}
2226 $ctxm add command \
2227 -label {Copy} \
2228 -command {tk_textCopy $ui_comm}
2229 $ctxm add command \
2230 -label {Paste} \
2231 -command {tk_textPaste $ui_comm}
2232 $ctxm add command \
2233 -label {Delete} \
2234 -command {$ui_comm delete sel.first sel.last}
2235 $ctxm add separator
2236 $ctxm add command \
2237 -label {Select All} \
2238 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2239 $ctxm add command \
2240 -label {Copy All} \
2241 -command {
2242 $ui_comm tag add sel 0.0 end
2243 tk_textCopy $ui_comm
2244 $ui_comm tag remove sel 0.0 end
2246 $ctxm add separator
2247 $ctxm add command \
2248 -label {Sign Off} \
2249 -command do_signoff
2250 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2252 # -- Diff Header
2254 proc trace_current_diff_path {varname args} {
2255 global current_diff_path diff_actions file_states
2256 if {$current_diff_path eq {}} {
2257 set s {}
2258 set f {}
2259 set p {}
2260 set o disabled
2261 } else {
2262 set p $current_diff_path
2263 set s [mapdesc [lindex $file_states($p) 0] $p]
2264 set f {File:}
2265 set p [escape_path $p]
2266 set o normal
2269 .vpane.lower.diff.header.status configure -text $s
2270 .vpane.lower.diff.header.file configure -text $f
2271 .vpane.lower.diff.header.path configure -text $p
2272 foreach w $diff_actions {
2273 uplevel #0 $w $o
2276 trace add variable current_diff_path write trace_current_diff_path
2278 frame .vpane.lower.diff.header -background gold
2279 label .vpane.lower.diff.header.status \
2280 -background gold \
2281 -width $max_status_desc \
2282 -anchor w \
2283 -justify left
2284 label .vpane.lower.diff.header.file \
2285 -background gold \
2286 -anchor w \
2287 -justify left
2288 label .vpane.lower.diff.header.path \
2289 -background gold \
2290 -anchor w \
2291 -justify left
2292 pack .vpane.lower.diff.header.status -side left
2293 pack .vpane.lower.diff.header.file -side left
2294 pack .vpane.lower.diff.header.path -fill x
2295 set ctxm .vpane.lower.diff.header.ctxm
2296 menu $ctxm -tearoff 0
2297 $ctxm add command \
2298 -label {Copy} \
2299 -command {
2300 clipboard clear
2301 clipboard append \
2302 -format STRING \
2303 -type STRING \
2304 -- $current_diff_path
2306 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2307 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2309 # -- Diff Body
2311 frame .vpane.lower.diff.body
2312 set ui_diff .vpane.lower.diff.body.t
2313 text $ui_diff -background white -borderwidth 0 \
2314 -width 80 -height 15 -wrap none \
2315 -font font_diff \
2316 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2317 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2318 -state disabled
2319 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2320 -command [list $ui_diff xview]
2321 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2322 -command [list $ui_diff yview]
2323 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2324 pack .vpane.lower.diff.body.sby -side right -fill y
2325 pack $ui_diff -side left -fill both -expand 1
2326 pack .vpane.lower.diff.header -side top -fill x
2327 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2329 $ui_diff tag conf d_cr -elide true
2330 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2331 $ui_diff tag conf d_+ -foreground {#00a000}
2332 $ui_diff tag conf d_- -foreground red
2334 $ui_diff tag conf d_++ -foreground {#00a000}
2335 $ui_diff tag conf d_-- -foreground red
2336 $ui_diff tag conf d_+s \
2337 -foreground {#00a000} \
2338 -background {#e2effa}
2339 $ui_diff tag conf d_-s \
2340 -foreground red \
2341 -background {#e2effa}
2342 $ui_diff tag conf d_s+ \
2343 -foreground {#00a000} \
2344 -background ivory1
2345 $ui_diff tag conf d_s- \
2346 -foreground red \
2347 -background ivory1
2349 $ui_diff tag conf d<<<<<<< \
2350 -foreground orange \
2351 -font font_diffbold
2352 $ui_diff tag conf d======= \
2353 -foreground orange \
2354 -font font_diffbold
2355 $ui_diff tag conf d>>>>>>> \
2356 -foreground orange \
2357 -font font_diffbold
2359 $ui_diff tag raise sel
2361 # -- Diff Body Context Menu
2363 set ctxm .vpane.lower.diff.body.ctxm
2364 menu $ctxm -tearoff 0
2365 $ctxm add command \
2366 -label {Refresh} \
2367 -command reshow_diff
2368 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2369 $ctxm add command \
2370 -label {Copy} \
2371 -command {tk_textCopy $ui_diff}
2372 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2373 $ctxm add command \
2374 -label {Select All} \
2375 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2376 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2377 $ctxm add command \
2378 -label {Copy All} \
2379 -command {
2380 $ui_diff tag add sel 0.0 end
2381 tk_textCopy $ui_diff
2382 $ui_diff tag remove sel 0.0 end
2384 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2385 $ctxm add separator
2386 $ctxm add command \
2387 -label {Apply/Reverse Hunk} \
2388 -command {apply_hunk $cursorX $cursorY}
2389 set ui_diff_applyhunk [$ctxm index last]
2390 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2391 $ctxm add separator
2392 $ctxm add command \
2393 -label {Decrease Font Size} \
2394 -command {incr_font_size font_diff -1}
2395 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2396 $ctxm add command \
2397 -label {Increase Font Size} \
2398 -command {incr_font_size font_diff 1}
2399 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2400 $ctxm add separator
2401 $ctxm add command \
2402 -label {Show Less Context} \
2403 -command {if {$repo_config(gui.diffcontext) >= 1} {
2404 incr repo_config(gui.diffcontext) -1
2405 reshow_diff
2407 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2408 $ctxm add command \
2409 -label {Show More Context} \
2410 -command {if {$repo_config(gui.diffcontext) < 99} {
2411 incr repo_config(gui.diffcontext)
2412 reshow_diff
2414 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2415 $ctxm add separator
2416 $ctxm add command -label {Options...} \
2417 -command do_options
2418 proc popup_diff_menu {ctxm x y X Y} {
2419 global current_diff_path file_states
2420 set ::cursorX $x
2421 set ::cursorY $y
2422 if {$::ui_index eq $::current_diff_side} {
2423 $ctxm entryconf $::ui_diff_applyhunk \
2424 -state normal \
2425 -label {Unstage Hunk From Commit}
2426 } elseif {$current_diff_path eq {}
2427 || ![info exists file_states($current_diff_path)]
2428 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2429 $ctxm entryconf $::ui_diff_applyhunk \
2430 -state disabled \
2431 -label {Stage Hunk For Commit}
2432 } else {
2433 $ctxm entryconf $::ui_diff_applyhunk \
2434 -state normal \
2435 -label {Stage Hunk For Commit}
2437 tk_popup $ctxm $X $Y
2439 bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2441 # -- Status Bar
2443 set main_status [::status_bar::new .status]
2444 pack .status -anchor w -side bottom -fill x
2445 $main_status show {Initializing...}
2447 # -- Load geometry
2449 catch {
2450 set gm $repo_config(gui.geometry)
2451 wm geometry . [lindex $gm 0]
2452 .vpane sash place 0 \
2453 [lindex [.vpane sash coord 0] 0] \
2454 [lindex $gm 1]
2455 .vpane.files sash place 0 \
2456 [lindex $gm 2] \
2457 [lindex [.vpane.files sash coord 0] 1]
2458 unset gm
2461 # -- Key Bindings
2463 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2464 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2465 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2466 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2467 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2468 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2469 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2470 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2471 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2472 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2473 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2475 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2476 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2477 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2478 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2479 bind $ui_diff <$M1B-Key-v> {break}
2480 bind $ui_diff <$M1B-Key-V> {break}
2481 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2482 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2483 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2484 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2485 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2486 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2487 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2488 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2489 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2490 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2491 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2492 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2493 bind $ui_diff <Button-1> {focus %W}
2495 if {[is_enabled branch]} {
2496 bind . <$M1B-Key-n> branch_create::dialog
2497 bind . <$M1B-Key-N> branch_create::dialog
2498 bind . <$M1B-Key-o> branch_checkout::dialog
2499 bind . <$M1B-Key-O> branch_checkout::dialog
2500 bind . <$M1B-Key-m> merge::dialog
2501 bind . <$M1B-Key-M> merge::dialog
2503 if {[is_enabled transport]} {
2504 bind . <$M1B-Key-p> do_push_anywhere
2505 bind . <$M1B-Key-P> do_push_anywhere
2508 bind . <Key-F5> do_rescan
2509 bind . <$M1B-Key-r> do_rescan
2510 bind . <$M1B-Key-R> do_rescan
2511 bind . <$M1B-Key-s> do_signoff
2512 bind . <$M1B-Key-S> do_signoff
2513 bind . <$M1B-Key-i> do_add_all
2514 bind . <$M1B-Key-I> do_add_all
2515 bind . <$M1B-Key-Return> do_commit
2516 foreach i [list $ui_index $ui_workdir] {
2517 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2518 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2519 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2521 unset i
2523 set file_lists($ui_index) [list]
2524 set file_lists($ui_workdir) [list]
2526 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2527 focus -force $ui_comm
2529 # -- Warn the user about environmental problems. Cygwin's Tcl
2530 # does *not* pass its env array onto any processes it spawns.
2531 # This means that git processes get none of our environment.
2533 if {[is_Cygwin]} {
2534 set ignored_env 0
2535 set suggest_user {}
2536 set msg "Possible environment issues exist.
2538 The following environment variables are probably
2539 going to be ignored by any Git subprocess run
2540 by [appname]:
2543 foreach name [array names env] {
2544 switch -regexp -- $name {
2545 {^GIT_INDEX_FILE$} -
2546 {^GIT_OBJECT_DIRECTORY$} -
2547 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2548 {^GIT_DIFF_OPTS$} -
2549 {^GIT_EXTERNAL_DIFF$} -
2550 {^GIT_PAGER$} -
2551 {^GIT_TRACE$} -
2552 {^GIT_CONFIG$} -
2553 {^GIT_CONFIG_LOCAL$} -
2554 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2555 append msg " - $name\n"
2556 incr ignored_env
2558 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2559 append msg " - $name\n"
2560 incr ignored_env
2561 set suggest_user $name
2565 if {$ignored_env > 0} {
2566 append msg "
2567 This is due to a known issue with the
2568 Tcl binary distributed by Cygwin."
2570 if {$suggest_user ne {}} {
2571 append msg "
2573 A good replacement for $suggest_user
2574 is placing values for the user.name and
2575 user.email settings into your personal
2576 ~/.gitconfig file.
2579 warn_popup $msg
2581 unset ignored_env msg suggest_user name
2584 # -- Only initialize complex UI if we are going to stay running.
2586 if {[is_enabled transport]} {
2587 load_all_remotes
2589 populate_fetch_menu
2590 populate_push_menu
2593 if {[winfo exists $ui_comm]} {
2594 set GITGUI_BCK_exists [load_message GITGUI_BCK]
2596 # -- If both our backup and message files exist use the
2597 # newer of the two files to initialize the buffer.
2599 if {$GITGUI_BCK_exists} {
2600 set m [gitdir GITGUI_MSG]
2601 if {[file isfile $m]} {
2602 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2603 catch {file delete [gitdir GITGUI_MSG]}
2604 } else {
2605 $ui_comm delete 0.0 end
2606 $ui_comm edit reset
2607 $ui_comm edit modified false
2608 catch {file delete [gitdir GITGUI_BCK]}
2609 set GITGUI_BCK_exists 0
2612 unset m
2615 proc backup_commit_buffer {} {
2616 global ui_comm GITGUI_BCK_exists
2618 set m [$ui_comm edit modified]
2619 if {$m || $GITGUI_BCK_exists} {
2620 set msg [string trim [$ui_comm get 0.0 end]]
2621 regsub -all -line {[ \r\t]+$} $msg {} msg
2623 if {$msg eq {}} {
2624 if {$GITGUI_BCK_exists} {
2625 catch {file delete [gitdir GITGUI_BCK]}
2626 set GITGUI_BCK_exists 0
2628 } elseif {$m} {
2629 catch {
2630 set fd [open [gitdir GITGUI_BCK] w]
2631 puts -nonewline $fd $msg
2632 close $fd
2633 set GITGUI_BCK_exists 1
2637 $ui_comm edit modified false
2640 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2643 backup_commit_buffer
2646 lock_index begin-read
2647 if {![winfo ismapped .]} {
2648 wm deiconify .
2650 after 1 do_rescan
2651 if {[is_enabled multicommit]} {
2652 after 1000 hint_gc