git-gui: Improve the Windows and Mac OS X shortcut creators
[git-gui.git] / git-gui.sh
blob2077261e647904d9871479411263d0fdcbb79662
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 global _reponame
158 return $_reponame
161 proc is_MacOSX {} {
162 global tcl_platform tk_library
163 if {[tk windowingsystem] eq {aqua}} {
164 return 1
166 return 0
169 proc is_Windows {} {
170 global tcl_platform
171 if {$tcl_platform(platform) eq {windows}} {
172 return 1
174 return 0
177 proc is_Cygwin {} {
178 global tcl_platform _iscygwin
179 if {$_iscygwin eq {}} {
180 if {$tcl_platform(platform) eq {windows}} {
181 if {[catch {set p [exec cygpath --windir]} err]} {
182 set _iscygwin 0
183 } else {
184 set _iscygwin 1
186 } else {
187 set _iscygwin 0
190 return $_iscygwin
193 proc is_enabled {option} {
194 global enabled_options
195 if {[catch {set on $enabled_options($option)}]} {return 0}
196 return $on
199 proc enable_option {option} {
200 global enabled_options
201 set enabled_options($option) 1
204 proc disable_option {option} {
205 global enabled_options
206 set enabled_options($option) 0
209 ######################################################################
211 ## config
213 proc is_many_config {name} {
214 switch -glob -- $name {
215 remote.*.fetch -
216 remote.*.push
217 {return 1}
219 {return 0}
223 proc is_config_true {name} {
224 global repo_config
225 if {[catch {set v $repo_config($name)}]} {
226 return 0
227 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
228 return 1
229 } else {
230 return 0
234 proc get_config {name} {
235 global repo_config
236 if {[catch {set v $repo_config($name)}]} {
237 return {}
238 } else {
239 return $v
243 proc load_config {include_global} {
244 global repo_config global_config default_config
246 array unset global_config
247 if {$include_global} {
248 catch {
249 set fd_rc [git_read config --global --list]
250 while {[gets $fd_rc line] >= 0} {
251 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
252 if {[is_many_config $name]} {
253 lappend global_config($name) $value
254 } else {
255 set global_config($name) $value
259 close $fd_rc
263 array unset repo_config
264 catch {
265 set fd_rc [git_read config --list]
266 while {[gets $fd_rc line] >= 0} {
267 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
268 if {[is_many_config $name]} {
269 lappend repo_config($name) $value
270 } else {
271 set repo_config($name) $value
275 close $fd_rc
278 foreach name [array names default_config] {
279 if {[catch {set v $global_config($name)}]} {
280 set global_config($name) $default_config($name)
282 if {[catch {set v $repo_config($name)}]} {
283 set repo_config($name) $default_config($name)
288 ######################################################################
290 ## handy utils
292 proc _git_cmd {name} {
293 global _git_cmd_path
295 if {[catch {set v $_git_cmd_path($name)}]} {
296 switch -- $name {
297 version -
298 --version -
299 --exec-path { return [list $::_git $name] }
302 set p [gitexec git-$name$::_search_exe]
303 if {[file exists $p]} {
304 set v [list $p]
305 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
306 # Try to determine what sort of magic will make
307 # git-$name go and do its thing, because native
308 # Tcl on Windows doesn't know it.
310 set p [gitexec git-$name]
311 set f [open $p r]
312 set s [gets $f]
313 close $f
315 switch -glob -- $s {
316 #!*sh { set i sh }
317 #!*perl { set i perl }
318 #!*python { set i python }
319 default { error "git-$name is not supported: $s" }
322 upvar #0 _$i interp
323 if {![info exists interp]} {
324 set interp [_which $i]
326 if {$interp eq {}} {
327 error "git-$name requires $i (not in PATH)"
329 set v [list $interp $p]
330 } else {
331 # Assume it is builtin to git somehow and we
332 # aren't actually able to see a file for it.
334 set v [list $::_git $name]
336 set _git_cmd_path($name) $v
338 return $v
341 proc _which {what} {
342 global env _search_exe _search_path
344 if {$_search_path eq {}} {
345 if {[is_Cygwin]} {
346 set _search_path [split [exec cygpath \
347 --windows \
348 --path \
349 --absolute \
350 $env(PATH)] {;}]
351 set _search_exe .exe
352 } elseif {[is_Windows]} {
353 set _search_path [split $env(PATH) {;}]
354 set _search_exe .exe
355 } else {
356 set _search_path [split $env(PATH) :]
357 set _search_exe {}
361 foreach p $_search_path {
362 set p [file join $p $what$_search_exe]
363 if {[file exists $p]} {
364 return [file normalize $p]
367 return {}
370 proc git {args} {
371 set opt [list exec]
373 while {1} {
374 switch -- [lindex $args 0] {
375 --nice {
376 global _nice
377 if {$_nice ne {}} {
378 lappend opt $_nice
382 default {
383 break
388 set args [lrange $args 1 end]
391 set cmdp [_git_cmd [lindex $args 0]]
392 set args [lrange $args 1 end]
394 return [eval $opt $cmdp $args]
397 proc _open_stdout_stderr {cmd} {
398 if {[catch {
399 set fd [open $cmd r]
400 } err]} {
401 if { [lindex $cmd end] eq {2>@1}
402 && $err eq {can not find channel named "1"}
404 # Older versions of Tcl 8.4 don't have this 2>@1 IO
405 # redirect operator. Fallback to |& cat for those.
406 # The command was not actually started, so its safe
407 # to try to start it a second time.
409 set fd [open [concat \
410 [lrange $cmd 0 end-1] \
411 [list |& cat] \
412 ] r]
413 } else {
414 error $err
417 return $fd
420 proc git_read {args} {
421 set opt [list |]
423 while {1} {
424 switch -- [lindex $args 0] {
425 --nice {
426 global _nice
427 if {$_nice ne {}} {
428 lappend opt $_nice
432 --stderr {
433 lappend args 2>@1
436 default {
437 break
442 set args [lrange $args 1 end]
445 set cmdp [_git_cmd [lindex $args 0]]
446 set args [lrange $args 1 end]
448 return [_open_stdout_stderr [concat $opt $cmdp $args]]
451 proc git_write {args} {
452 set opt [list |]
454 while {1} {
455 switch -- [lindex $args 0] {
456 --nice {
457 global _nice
458 if {$_nice ne {}} {
459 lappend opt $_nice
463 default {
464 break
469 set args [lrange $args 1 end]
472 set cmdp [_git_cmd [lindex $args 0]]
473 set args [lrange $args 1 end]
475 return [open [concat $opt $cmdp $args] w]
478 proc sq {value} {
479 regsub -all ' $value "'\\''" value
480 return "'$value'"
483 proc load_current_branch {} {
484 global current_branch is_detached
486 set fd [open [gitdir HEAD] r]
487 if {[gets $fd ref] < 1} {
488 set ref {}
490 close $fd
492 set pfx {ref: refs/heads/}
493 set len [string length $pfx]
494 if {[string equal -length $len $pfx $ref]} {
495 # We're on a branch. It might not exist. But
496 # HEAD looks good enough to be a branch.
498 set current_branch [string range $ref $len end]
499 set is_detached 0
500 } else {
501 # Assume this is a detached head.
503 set current_branch HEAD
504 set is_detached 1
508 auto_load tk_optionMenu
509 rename tk_optionMenu real__tkOptionMenu
510 proc tk_optionMenu {w varName args} {
511 set m [eval real__tkOptionMenu $w $varName $args]
512 $m configure -font font_ui
513 $w configure -font font_ui
514 return $m
517 ######################################################################
519 ## find git
521 set _git [_which git]
522 if {$_git eq {}} {
523 catch {wm withdraw .}
524 error_popup "Cannot find git in PATH."
525 exit 1
527 set _nice [_which nice]
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
547 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
548 regsub {\.rc[0-9]+$} $_git_version {} _git_version
550 proc git-version {args} {
551 global _git_version
553 switch [llength $args] {
555 return $_git_version
559 set op [lindex $args 0]
560 set vr [lindex $args 1]
561 set cm [package vcompare $_git_version $vr]
562 return [expr $cm $op 0]
566 set type [lindex $args 0]
567 set name [lindex $args 1]
568 set parm [lindex $args 2]
569 set body [lindex $args 3]
571 if {($type ne {proc} && $type ne {method})} {
572 error "Invalid arguments to git-version"
574 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
575 error "Last arm of $type $name must be default"
578 foreach {op vr cb} [lrange $body 0 end-2] {
579 if {[git-version $op $vr]} {
580 return [uplevel [list $type $name $parm $cb]]
584 return [uplevel [list $type $name $parm [lindex $body end]]]
587 default {
588 error "git-version >= x"
594 if {[git-version < 1.5]} {
595 catch {wm withdraw .}
596 error_popup "[appname] requires Git 1.5.0 or later.
598 You are using [git-version]:
600 [git --version]"
601 exit 1
604 ######################################################################
606 ## repository setup
608 if {[catch {
609 set _gitdir $env(GIT_DIR)
610 set _prefix {}
612 && [catch {
613 set _gitdir [git rev-parse --git-dir]
614 set _prefix [git rev-parse --show-prefix]
615 } err]} {
616 catch {wm withdraw .}
617 error_popup "Cannot find the git directory:\n\n$err"
618 exit 1
620 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
621 catch {set _gitdir [exec cygpath --unix $_gitdir]}
623 if {![file isdirectory $_gitdir]} {
624 catch {wm withdraw .}
625 error_popup "Git directory not found:\n\n$_gitdir"
626 exit 1
628 if {[lindex [file split $_gitdir] end] ne {.git}} {
629 catch {wm withdraw .}
630 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
631 exit 1
633 if {[catch {cd [file dirname $_gitdir]} err]} {
634 catch {wm withdraw .}
635 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
636 exit 1
638 set _reponame [lindex [file split \
639 [file normalize [file dirname $_gitdir]]] \
640 end]
642 ######################################################################
644 ## global init
646 set current_diff_path {}
647 set current_diff_side {}
648 set diff_actions [list]
650 set HEAD {}
651 set PARENT {}
652 set MERGE_HEAD [list]
653 set commit_type {}
654 set empty_tree {}
655 set current_branch {}
656 set is_detached 0
657 set current_diff_path {}
658 set selected_commit_type new
660 ######################################################################
662 ## task management
664 set rescan_active 0
665 set diff_active 0
666 set last_clicked {}
668 set disable_on_lock [list]
669 set index_lock_type none
671 proc lock_index {type} {
672 global index_lock_type disable_on_lock
674 if {$index_lock_type eq {none}} {
675 set index_lock_type $type
676 foreach w $disable_on_lock {
677 uplevel #0 $w disabled
679 return 1
680 } elseif {$index_lock_type eq "begin-$type"} {
681 set index_lock_type $type
682 return 1
684 return 0
687 proc unlock_index {} {
688 global index_lock_type disable_on_lock
690 set index_lock_type none
691 foreach w $disable_on_lock {
692 uplevel #0 $w normal
696 ######################################################################
698 ## status
700 proc repository_state {ctvar hdvar mhvar} {
701 global current_branch
702 upvar $ctvar ct $hdvar hd $mhvar mh
704 set mh [list]
706 load_current_branch
707 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
708 set hd {}
709 set ct initial
710 return
713 set merge_head [gitdir MERGE_HEAD]
714 if {[file exists $merge_head]} {
715 set ct merge
716 set fd_mh [open $merge_head r]
717 while {[gets $fd_mh line] >= 0} {
718 lappend mh $line
720 close $fd_mh
721 return
724 set ct normal
727 proc PARENT {} {
728 global PARENT empty_tree
730 set p [lindex $PARENT 0]
731 if {$p ne {}} {
732 return $p
734 if {$empty_tree eq {}} {
735 set empty_tree [git mktree << {}]
737 return $empty_tree
740 proc rescan {after {honor_trustmtime 1}} {
741 global HEAD PARENT MERGE_HEAD commit_type
742 global ui_index ui_workdir ui_comm
743 global rescan_active file_states
744 global repo_config
746 if {$rescan_active > 0 || ![lock_index read]} return
748 repository_state newType newHEAD newMERGE_HEAD
749 if {[string match amend* $commit_type]
750 && $newType eq {normal}
751 && $newHEAD eq $HEAD} {
752 } else {
753 set HEAD $newHEAD
754 set PARENT $newHEAD
755 set MERGE_HEAD $newMERGE_HEAD
756 set commit_type $newType
759 array unset file_states
761 if {![$ui_comm edit modified]
762 || [string trim [$ui_comm get 0.0 end]] eq {}} {
763 if {[string match amend* $commit_type]} {
764 } elseif {[load_message GITGUI_MSG]} {
765 } elseif {[load_message MERGE_MSG]} {
766 } elseif {[load_message SQUASH_MSG]} {
768 $ui_comm edit reset
769 $ui_comm edit modified false
772 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
773 rescan_stage2 {} $after
774 } else {
775 set rescan_active 1
776 ui_status {Refreshing file status...}
777 set fd_rf [git_read update-index \
778 -q \
779 --unmerged \
780 --ignore-missing \
781 --refresh \
783 fconfigure $fd_rf -blocking 0 -translation binary
784 fileevent $fd_rf readable \
785 [list rescan_stage2 $fd_rf $after]
789 proc rescan_stage2 {fd after} {
790 global rescan_active buf_rdi buf_rdf buf_rlo
792 if {$fd ne {}} {
793 read $fd
794 if {![eof $fd]} return
795 close $fd
798 set ls_others [list --exclude-per-directory=.gitignore]
799 set info_exclude [gitdir info exclude]
800 if {[file readable $info_exclude]} {
801 lappend ls_others "--exclude-from=$info_exclude"
804 set buf_rdi {}
805 set buf_rdf {}
806 set buf_rlo {}
808 set rescan_active 3
809 ui_status {Scanning for modified files ...}
810 set fd_di [git_read diff-index --cached -z [PARENT]]
811 set fd_df [git_read diff-files -z]
812 set fd_lo [eval git_read ls-files --others -z $ls_others]
814 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
815 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
816 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
817 fileevent $fd_di readable [list read_diff_index $fd_di $after]
818 fileevent $fd_df readable [list read_diff_files $fd_df $after]
819 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
822 proc load_message {file} {
823 global ui_comm
825 set f [gitdir $file]
826 if {[file isfile $f]} {
827 if {[catch {set fd [open $f r]}]} {
828 return 0
830 set content [string trim [read $fd]]
831 close $fd
832 regsub -all -line {[ \r\t]+$} $content {} content
833 $ui_comm delete 0.0 end
834 $ui_comm insert end $content
835 return 1
837 return 0
840 proc read_diff_index {fd after} {
841 global buf_rdi
843 append buf_rdi [read $fd]
844 set c 0
845 set n [string length $buf_rdi]
846 while {$c < $n} {
847 set z1 [string first "\0" $buf_rdi $c]
848 if {$z1 == -1} break
849 incr z1
850 set z2 [string first "\0" $buf_rdi $z1]
851 if {$z2 == -1} break
853 incr c
854 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
855 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
856 merge_state \
857 [encoding convertfrom $p] \
858 [lindex $i 4]? \
859 [list [lindex $i 0] [lindex $i 2]] \
860 [list]
861 set c $z2
862 incr c
864 if {$c < $n} {
865 set buf_rdi [string range $buf_rdi $c end]
866 } else {
867 set buf_rdi {}
870 rescan_done $fd buf_rdi $after
873 proc read_diff_files {fd after} {
874 global buf_rdf
876 append buf_rdf [read $fd]
877 set c 0
878 set n [string length $buf_rdf]
879 while {$c < $n} {
880 set z1 [string first "\0" $buf_rdf $c]
881 if {$z1 == -1} break
882 incr z1
883 set z2 [string first "\0" $buf_rdf $z1]
884 if {$z2 == -1} break
886 incr c
887 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
888 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
889 merge_state \
890 [encoding convertfrom $p] \
891 ?[lindex $i 4] \
892 [list] \
893 [list [lindex $i 0] [lindex $i 2]]
894 set c $z2
895 incr c
897 if {$c < $n} {
898 set buf_rdf [string range $buf_rdf $c end]
899 } else {
900 set buf_rdf {}
903 rescan_done $fd buf_rdf $after
906 proc read_ls_others {fd after} {
907 global buf_rlo
909 append buf_rlo [read $fd]
910 set pck [split $buf_rlo "\0"]
911 set buf_rlo [lindex $pck end]
912 foreach p [lrange $pck 0 end-1] {
913 merge_state [encoding convertfrom $p] ?O
915 rescan_done $fd buf_rlo $after
918 proc rescan_done {fd buf after} {
919 global rescan_active current_diff_path
920 global file_states repo_config
921 upvar $buf to_clear
923 if {![eof $fd]} return
924 set to_clear {}
925 close $fd
926 if {[incr rescan_active -1] > 0} return
928 prune_selection
929 unlock_index
930 display_all_files
931 if {$current_diff_path ne {}} reshow_diff
932 uplevel #0 $after
935 proc prune_selection {} {
936 global file_states selected_paths
938 foreach path [array names selected_paths] {
939 if {[catch {set still_here $file_states($path)}]} {
940 unset selected_paths($path)
945 ######################################################################
947 ## ui helpers
949 proc mapicon {w state path} {
950 global all_icons
952 if {[catch {set r $all_icons($state$w)}]} {
953 puts "error: no icon for $w state={$state} $path"
954 return file_plain
956 return $r
959 proc mapdesc {state path} {
960 global all_descs
962 if {[catch {set r $all_descs($state)}]} {
963 puts "error: no desc for state={$state} $path"
964 return $state
966 return $r
969 proc ui_status {msg} {
970 $::main_status show $msg
973 proc ui_ready {{test {}}} {
974 $::main_status show {Ready.} $test
977 proc escape_path {path} {
978 regsub -all {\\} $path "\\\\" path
979 regsub -all "\n" $path "\\n" path
980 return $path
983 proc short_path {path} {
984 return [escape_path [lindex [file split $path] end]]
987 set next_icon_id 0
988 set null_sha1 [string repeat 0 40]
990 proc merge_state {path new_state {head_info {}} {index_info {}}} {
991 global file_states next_icon_id null_sha1
993 set s0 [string index $new_state 0]
994 set s1 [string index $new_state 1]
996 if {[catch {set info $file_states($path)}]} {
997 set state __
998 set icon n[incr next_icon_id]
999 } else {
1000 set state [lindex $info 0]
1001 set icon [lindex $info 1]
1002 if {$head_info eq {}} {set head_info [lindex $info 2]}
1003 if {$index_info eq {}} {set index_info [lindex $info 3]}
1006 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1007 elseif {$s0 eq {_}} {set s0 _}
1009 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1010 elseif {$s1 eq {_}} {set s1 _}
1012 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1013 set head_info [list 0 $null_sha1]
1014 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1015 && $head_info eq {}} {
1016 set head_info $index_info
1019 set file_states($path) [list $s0$s1 $icon \
1020 $head_info $index_info \
1022 return $state
1025 proc display_file_helper {w path icon_name old_m new_m} {
1026 global file_lists
1028 if {$new_m eq {_}} {
1029 set lno [lsearch -sorted -exact $file_lists($w) $path]
1030 if {$lno >= 0} {
1031 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1032 incr lno
1033 $w conf -state normal
1034 $w delete $lno.0 [expr {$lno + 1}].0
1035 $w conf -state disabled
1037 } elseif {$old_m eq {_} && $new_m ne {_}} {
1038 lappend file_lists($w) $path
1039 set file_lists($w) [lsort -unique $file_lists($w)]
1040 set lno [lsearch -sorted -exact $file_lists($w) $path]
1041 incr lno
1042 $w conf -state normal
1043 $w image create $lno.0 \
1044 -align center -padx 5 -pady 1 \
1045 -name $icon_name \
1046 -image [mapicon $w $new_m $path]
1047 $w insert $lno.1 "[escape_path $path]\n"
1048 $w conf -state disabled
1049 } elseif {$old_m ne $new_m} {
1050 $w conf -state normal
1051 $w image conf $icon_name -image [mapicon $w $new_m $path]
1052 $w conf -state disabled
1056 proc display_file {path state} {
1057 global file_states selected_paths
1058 global ui_index ui_workdir
1060 set old_m [merge_state $path $state]
1061 set s $file_states($path)
1062 set new_m [lindex $s 0]
1063 set icon_name [lindex $s 1]
1065 set o [string index $old_m 0]
1066 set n [string index $new_m 0]
1067 if {$o eq {U}} {
1068 set o _
1070 if {$n eq {U}} {
1071 set n _
1073 display_file_helper $ui_index $path $icon_name $o $n
1075 if {[string index $old_m 0] eq {U}} {
1076 set o U
1077 } else {
1078 set o [string index $old_m 1]
1080 if {[string index $new_m 0] eq {U}} {
1081 set n U
1082 } else {
1083 set n [string index $new_m 1]
1085 display_file_helper $ui_workdir $path $icon_name $o $n
1087 if {$new_m eq {__}} {
1088 unset file_states($path)
1089 catch {unset selected_paths($path)}
1093 proc display_all_files_helper {w path icon_name m} {
1094 global file_lists
1096 lappend file_lists($w) $path
1097 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1098 $w image create end \
1099 -align center -padx 5 -pady 1 \
1100 -name $icon_name \
1101 -image [mapicon $w $m $path]
1102 $w insert end "[escape_path $path]\n"
1105 proc display_all_files {} {
1106 global ui_index ui_workdir
1107 global file_states file_lists
1108 global last_clicked
1110 $ui_index conf -state normal
1111 $ui_workdir conf -state normal
1113 $ui_index delete 0.0 end
1114 $ui_workdir delete 0.0 end
1115 set last_clicked {}
1117 set file_lists($ui_index) [list]
1118 set file_lists($ui_workdir) [list]
1120 foreach path [lsort [array names file_states]] {
1121 set s $file_states($path)
1122 set m [lindex $s 0]
1123 set icon_name [lindex $s 1]
1125 set s [string index $m 0]
1126 if {$s ne {U} && $s ne {_}} {
1127 display_all_files_helper $ui_index $path \
1128 $icon_name $s
1131 if {[string index $m 0] eq {U}} {
1132 set s U
1133 } else {
1134 set s [string index $m 1]
1136 if {$s ne {_}} {
1137 display_all_files_helper $ui_workdir $path \
1138 $icon_name $s
1142 $ui_index conf -state disabled
1143 $ui_workdir conf -state disabled
1146 ######################################################################
1148 ## icons
1150 set filemask {
1151 #define mask_width 14
1152 #define mask_height 15
1153 static unsigned char mask_bits[] = {
1154 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1155 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1156 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1159 image create bitmap file_plain -background white -foreground black -data {
1160 #define plain_width 14
1161 #define plain_height 15
1162 static unsigned char plain_bits[] = {
1163 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1164 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1165 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1166 } -maskdata $filemask
1168 image create bitmap file_mod -background white -foreground blue -data {
1169 #define mod_width 14
1170 #define mod_height 15
1171 static unsigned char mod_bits[] = {
1172 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1173 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1174 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1175 } -maskdata $filemask
1177 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1178 #define file_fulltick_width 14
1179 #define file_fulltick_height 15
1180 static unsigned char file_fulltick_bits[] = {
1181 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1182 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1183 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1184 } -maskdata $filemask
1186 image create bitmap file_parttick -background white -foreground "#005050" -data {
1187 #define parttick_width 14
1188 #define parttick_height 15
1189 static unsigned char parttick_bits[] = {
1190 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1191 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1192 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1193 } -maskdata $filemask
1195 image create bitmap file_question -background white -foreground black -data {
1196 #define file_question_width 14
1197 #define file_question_height 15
1198 static unsigned char file_question_bits[] = {
1199 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1200 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1201 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1202 } -maskdata $filemask
1204 image create bitmap file_removed -background white -foreground red -data {
1205 #define file_removed_width 14
1206 #define file_removed_height 15
1207 static unsigned char file_removed_bits[] = {
1208 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1209 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1210 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1211 } -maskdata $filemask
1213 image create bitmap file_merge -background white -foreground blue -data {
1214 #define file_merge_width 14
1215 #define file_merge_height 15
1216 static unsigned char file_merge_bits[] = {
1217 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1218 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1219 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1220 } -maskdata $filemask
1222 set file_dir_data {
1223 #define file_width 18
1224 #define file_height 18
1225 static unsigned char file_bits[] = {
1226 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
1227 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
1228 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
1229 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
1230 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
1232 image create bitmap file_dir -background white -foreground blue \
1233 -data $file_dir_data -maskdata $file_dir_data
1234 unset file_dir_data
1236 set file_uplevel_data {
1237 #define up_width 15
1238 #define up_height 15
1239 static unsigned char up_bits[] = {
1240 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
1241 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
1242 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
1244 image create bitmap file_uplevel -background white -foreground red \
1245 -data $file_uplevel_data -maskdata $file_uplevel_data
1246 unset file_uplevel_data
1248 set ui_index .vpane.files.index.list
1249 set ui_workdir .vpane.files.workdir.list
1251 set all_icons(_$ui_index) file_plain
1252 set all_icons(A$ui_index) file_fulltick
1253 set all_icons(M$ui_index) file_fulltick
1254 set all_icons(D$ui_index) file_removed
1255 set all_icons(U$ui_index) file_merge
1257 set all_icons(_$ui_workdir) file_plain
1258 set all_icons(M$ui_workdir) file_mod
1259 set all_icons(D$ui_workdir) file_question
1260 set all_icons(U$ui_workdir) file_merge
1261 set all_icons(O$ui_workdir) file_plain
1263 set max_status_desc 0
1264 foreach i {
1265 {__ "Unmodified"}
1267 {_M "Modified, not staged"}
1268 {M_ "Staged for commit"}
1269 {MM "Portions staged for commit"}
1270 {MD "Staged for commit, missing"}
1272 {_O "Untracked, not staged"}
1273 {A_ "Staged for commit"}
1274 {AM "Portions staged for commit"}
1275 {AD "Staged for commit, missing"}
1277 {_D "Missing"}
1278 {D_ "Staged for removal"}
1279 {DO "Staged for removal, still present"}
1281 {U_ "Requires merge resolution"}
1282 {UU "Requires merge resolution"}
1283 {UM "Requires merge resolution"}
1284 {UD "Requires merge resolution"}
1286 if {$max_status_desc < [string length [lindex $i 1]]} {
1287 set max_status_desc [string length [lindex $i 1]]
1289 set all_descs([lindex $i 0]) [lindex $i 1]
1291 unset i
1293 ######################################################################
1295 ## util
1297 proc bind_button3 {w cmd} {
1298 bind $w <Any-Button-3> $cmd
1299 if {[is_MacOSX]} {
1300 bind $w <Control-Button-1> $cmd
1304 proc scrollbar2many {list mode args} {
1305 foreach w $list {eval $w $mode $args}
1308 proc many2scrollbar {list mode sb top bottom} {
1309 $sb set $top $bottom
1310 foreach w $list {$w $mode moveto $top}
1313 proc incr_font_size {font {amt 1}} {
1314 set sz [font configure $font -size]
1315 incr sz $amt
1316 font configure $font -size $sz
1317 font configure ${font}bold -size $sz
1318 font configure ${font}italic -size $sz
1321 ######################################################################
1323 ## ui commands
1325 set starting_gitk_msg {Starting gitk... please wait...}
1327 proc do_gitk {revs} {
1328 # -- Always start gitk through whatever we were loaded with. This
1329 # lets us bypass using shell process on Windows systems.
1331 set exe [file join [file dirname $::_git] gitk]
1332 set cmd [list [info nameofexecutable] $exe]
1333 if {! [file exists $exe]} {
1334 error_popup "Unable to start gitk:\n\n$exe does not exist"
1335 } else {
1336 eval exec $cmd $revs &
1337 ui_status $::starting_gitk_msg
1338 after 10000 {
1339 ui_ready $starting_gitk_msg
1344 set is_quitting 0
1346 proc do_quit {} {
1347 global ui_comm is_quitting repo_config commit_type
1349 if {$is_quitting} return
1350 set is_quitting 1
1352 if {[winfo exists $ui_comm]} {
1353 # -- Stash our current commit buffer.
1355 set save [gitdir GITGUI_MSG]
1356 set msg [string trim [$ui_comm get 0.0 end]]
1357 regsub -all -line {[ \r\t]+$} $msg {} msg
1358 if {(![string match amend* $commit_type]
1359 || [$ui_comm edit modified])
1360 && $msg ne {}} {
1361 catch {
1362 set fd [open $save w]
1363 puts -nonewline $fd $msg
1364 close $fd
1366 } else {
1367 catch {file delete $save}
1370 # -- Stash our current window geometry into this repository.
1372 set cfg_geometry [list]
1373 lappend cfg_geometry [wm geometry .]
1374 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1375 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1376 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1377 set rc_geometry {}
1379 if {$cfg_geometry ne $rc_geometry} {
1380 catch {git config gui.geometry $cfg_geometry}
1384 destroy .
1387 proc do_rescan {} {
1388 rescan ui_ready
1391 proc do_commit {} {
1392 commit_tree
1395 proc toggle_or_diff {w x y} {
1396 global file_states file_lists current_diff_path ui_index ui_workdir
1397 global last_clicked selected_paths
1399 set pos [split [$w index @$x,$y] .]
1400 set lno [lindex $pos 0]
1401 set col [lindex $pos 1]
1402 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1403 if {$path eq {}} {
1404 set last_clicked {}
1405 return
1408 set last_clicked [list $w $lno]
1409 array unset selected_paths
1410 $ui_index tag remove in_sel 0.0 end
1411 $ui_workdir tag remove in_sel 0.0 end
1413 if {$col == 0} {
1414 if {$current_diff_path eq $path} {
1415 set after {reshow_diff;}
1416 } else {
1417 set after {}
1419 if {$w eq $ui_index} {
1420 update_indexinfo \
1421 "Unstaging [short_path $path] from commit" \
1422 [list $path] \
1423 [concat $after [list ui_ready]]
1424 } elseif {$w eq $ui_workdir} {
1425 update_index \
1426 "Adding [short_path $path]" \
1427 [list $path] \
1428 [concat $after [list ui_ready]]
1430 } else {
1431 show_diff $path $w $lno
1435 proc add_one_to_selection {w x y} {
1436 global file_lists last_clicked selected_paths
1438 set lno [lindex [split [$w index @$x,$y] .] 0]
1439 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1440 if {$path eq {}} {
1441 set last_clicked {}
1442 return
1445 if {$last_clicked ne {}
1446 && [lindex $last_clicked 0] ne $w} {
1447 array unset selected_paths
1448 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1451 set last_clicked [list $w $lno]
1452 if {[catch {set in_sel $selected_paths($path)}]} {
1453 set in_sel 0
1455 if {$in_sel} {
1456 unset selected_paths($path)
1457 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1458 } else {
1459 set selected_paths($path) 1
1460 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1464 proc add_range_to_selection {w x y} {
1465 global file_lists last_clicked selected_paths
1467 if {[lindex $last_clicked 0] ne $w} {
1468 toggle_or_diff $w $x $y
1469 return
1472 set lno [lindex [split [$w index @$x,$y] .] 0]
1473 set lc [lindex $last_clicked 1]
1474 if {$lc < $lno} {
1475 set begin $lc
1476 set end $lno
1477 } else {
1478 set begin $lno
1479 set end $lc
1482 foreach path [lrange $file_lists($w) \
1483 [expr {$begin - 1}] \
1484 [expr {$end - 1}]] {
1485 set selected_paths($path) 1
1487 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1490 ######################################################################
1492 ## config defaults
1494 set cursor_ptr arrow
1495 font create font_diff -family Courier -size 10
1496 font create font_ui
1497 catch {
1498 label .dummy
1499 eval font configure font_ui [font actual [.dummy cget -font]]
1500 destroy .dummy
1503 font create font_uiitalic
1504 font create font_uibold
1505 font create font_diffbold
1506 font create font_diffitalic
1508 foreach class {Button Checkbutton Entry Label
1509 Labelframe Listbox Menu Message
1510 Radiobutton Spinbox Text} {
1511 option add *$class.font font_ui
1513 unset class
1515 if {[is_Windows] || [is_MacOSX]} {
1516 option add *Menu.tearOff 0
1519 if {[is_MacOSX]} {
1520 set M1B M1
1521 set M1T Cmd
1522 } else {
1523 set M1B Control
1524 set M1T Ctrl
1527 proc apply_config {} {
1528 global repo_config font_descs
1530 foreach option $font_descs {
1531 set name [lindex $option 0]
1532 set font [lindex $option 1]
1533 if {[catch {
1534 foreach {cn cv} $repo_config(gui.$name) {
1535 font configure $font $cn $cv
1537 } err]} {
1538 error_popup "Invalid font specified in gui.$name:\n\n$err"
1540 foreach {cn cv} [font configure $font] {
1541 font configure ${font}bold $cn $cv
1542 font configure ${font}italic $cn $cv
1544 font configure ${font}bold -weight bold
1545 font configure ${font}italic -slant italic
1549 set default_config(merge.diffstat) true
1550 set default_config(merge.summary) false
1551 set default_config(merge.verbosity) 2
1552 set default_config(user.name) {}
1553 set default_config(user.email) {}
1555 set default_config(gui.matchtrackingbranch) false
1556 set default_config(gui.pruneduringfetch) false
1557 set default_config(gui.trustmtime) false
1558 set default_config(gui.diffcontext) 5
1559 set default_config(gui.newbranchtemplate) {}
1560 set default_config(gui.fontui) [font configure font_ui]
1561 set default_config(gui.fontdiff) [font configure font_diff]
1562 set font_descs {
1563 {fontui font_ui {Main Font}}
1564 {fontdiff font_diff {Diff/Console Font}}
1566 load_config 0
1567 apply_config
1569 ######################################################################
1571 ## feature option selection
1573 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
1574 unset _junk
1575 } else {
1576 set subcommand gui
1578 if {$subcommand eq {gui.sh}} {
1579 set subcommand gui
1581 if {$subcommand eq {gui} && [llength $argv] > 0} {
1582 set subcommand [lindex $argv 0]
1583 set argv [lrange $argv 1 end]
1586 enable_option multicommit
1587 enable_option branch
1588 enable_option transport
1590 switch -- $subcommand {
1591 browser -
1592 blame {
1593 disable_option multicommit
1594 disable_option branch
1595 disable_option transport
1597 citool {
1598 enable_option singlecommit
1600 disable_option multicommit
1601 disable_option branch
1602 disable_option transport
1606 ######################################################################
1608 ## ui construction
1610 set ui_comm {}
1612 # -- Menu Bar
1614 menu .mbar -tearoff 0
1615 .mbar add cascade -label Repository -menu .mbar.repository
1616 .mbar add cascade -label Edit -menu .mbar.edit
1617 if {[is_enabled branch]} {
1618 .mbar add cascade -label Branch -menu .mbar.branch
1620 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1621 .mbar add cascade -label Commit -menu .mbar.commit
1623 if {[is_enabled transport]} {
1624 .mbar add cascade -label Merge -menu .mbar.merge
1625 .mbar add cascade -label Fetch -menu .mbar.fetch
1626 .mbar add cascade -label Push -menu .mbar.push
1628 . configure -menu .mbar
1630 # -- Repository Menu
1632 menu .mbar.repository
1634 .mbar.repository add command \
1635 -label {Browse Current Branch} \
1636 -command {browser::new $current_branch}
1637 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1638 .mbar.repository add separator
1640 .mbar.repository add command \
1641 -label {Visualize Current Branch} \
1642 -command {do_gitk $current_branch}
1643 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1644 .mbar.repository add command \
1645 -label {Visualize All Branches} \
1646 -command {do_gitk --all}
1647 .mbar.repository add separator
1649 if {[is_enabled multicommit]} {
1650 .mbar.repository add command -label {Database Statistics} \
1651 -command do_stats
1653 .mbar.repository add command -label {Compress Database} \
1654 -command do_gc
1656 .mbar.repository add command -label {Verify Database} \
1657 -command do_fsck_objects
1659 .mbar.repository add separator
1661 if {[is_Cygwin]} {
1662 .mbar.repository add command \
1663 -label {Create Desktop Icon} \
1664 -command do_cygwin_shortcut
1665 } elseif {[is_Windows]} {
1666 .mbar.repository add command \
1667 -label {Create Desktop Icon} \
1668 -command do_windows_shortcut
1669 } elseif {[is_MacOSX]} {
1670 .mbar.repository add command \
1671 -label {Create Desktop Icon} \
1672 -command do_macosx_app
1676 .mbar.repository add command -label Quit \
1677 -command do_quit \
1678 -accelerator $M1T-Q
1680 # -- Edit Menu
1682 menu .mbar.edit
1683 .mbar.edit add command -label Undo \
1684 -command {catch {[focus] edit undo}} \
1685 -accelerator $M1T-Z
1686 .mbar.edit add command -label Redo \
1687 -command {catch {[focus] edit redo}} \
1688 -accelerator $M1T-Y
1689 .mbar.edit add separator
1690 .mbar.edit add command -label Cut \
1691 -command {catch {tk_textCut [focus]}} \
1692 -accelerator $M1T-X
1693 .mbar.edit add command -label Copy \
1694 -command {catch {tk_textCopy [focus]}} \
1695 -accelerator $M1T-C
1696 .mbar.edit add command -label Paste \
1697 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1698 -accelerator $M1T-V
1699 .mbar.edit add command -label Delete \
1700 -command {catch {[focus] delete sel.first sel.last}} \
1701 -accelerator Del
1702 .mbar.edit add separator
1703 .mbar.edit add command -label {Select All} \
1704 -command {catch {[focus] tag add sel 0.0 end}} \
1705 -accelerator $M1T-A
1707 # -- Branch Menu
1709 if {[is_enabled branch]} {
1710 menu .mbar.branch
1712 .mbar.branch add command -label {Create...} \
1713 -command branch_create::dialog \
1714 -accelerator $M1T-N
1715 lappend disable_on_lock [list .mbar.branch entryconf \
1716 [.mbar.branch index last] -state]
1718 .mbar.branch add command -label {Checkout...} \
1719 -command branch_checkout::dialog \
1720 -accelerator $M1T-O
1721 lappend disable_on_lock [list .mbar.branch entryconf \
1722 [.mbar.branch index last] -state]
1724 .mbar.branch add command -label {Rename...} \
1725 -command branch_rename::dialog
1726 lappend disable_on_lock [list .mbar.branch entryconf \
1727 [.mbar.branch index last] -state]
1729 .mbar.branch add command -label {Delete...} \
1730 -command branch_delete::dialog
1731 lappend disable_on_lock [list .mbar.branch entryconf \
1732 [.mbar.branch index last] -state]
1734 .mbar.branch add command -label {Reset...} \
1735 -command merge::reset_hard
1736 lappend disable_on_lock [list .mbar.branch entryconf \
1737 [.mbar.branch index last] -state]
1740 # -- Commit Menu
1742 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1743 menu .mbar.commit
1745 .mbar.commit add radiobutton \
1746 -label {New Commit} \
1747 -command do_select_commit_type \
1748 -variable selected_commit_type \
1749 -value new
1750 lappend disable_on_lock \
1751 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1753 .mbar.commit add radiobutton \
1754 -label {Amend Last Commit} \
1755 -command do_select_commit_type \
1756 -variable selected_commit_type \
1757 -value amend
1758 lappend disable_on_lock \
1759 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1761 .mbar.commit add separator
1763 .mbar.commit add command -label Rescan \
1764 -command do_rescan \
1765 -accelerator F5
1766 lappend disable_on_lock \
1767 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1769 .mbar.commit add command -label {Add To Commit} \
1770 -command do_add_selection
1771 lappend disable_on_lock \
1772 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1774 .mbar.commit add command -label {Add Existing To Commit} \
1775 -command do_add_all \
1776 -accelerator $M1T-I
1777 lappend disable_on_lock \
1778 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1780 .mbar.commit add command -label {Unstage From Commit} \
1781 -command do_unstage_selection
1782 lappend disable_on_lock \
1783 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1785 .mbar.commit add command -label {Revert Changes} \
1786 -command do_revert_selection
1787 lappend disable_on_lock \
1788 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1790 .mbar.commit add separator
1792 .mbar.commit add command -label {Sign Off} \
1793 -command do_signoff \
1794 -accelerator $M1T-S
1796 .mbar.commit add command -label Commit \
1797 -command do_commit \
1798 -accelerator $M1T-Return
1799 lappend disable_on_lock \
1800 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1803 # -- Merge Menu
1805 if {[is_enabled branch]} {
1806 menu .mbar.merge
1807 .mbar.merge add command -label {Local Merge...} \
1808 -command merge::dialog
1809 lappend disable_on_lock \
1810 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1811 .mbar.merge add command -label {Abort Merge...} \
1812 -command merge::reset_hard
1813 lappend disable_on_lock \
1814 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1818 # -- Transport Menu
1820 if {[is_enabled transport]} {
1821 menu .mbar.fetch
1823 menu .mbar.push
1824 .mbar.push add command -label {Push...} \
1825 -command do_push_anywhere \
1826 -accelerator $M1T-P
1827 .mbar.push add command -label {Delete...} \
1828 -command remote_branch_delete::dialog
1831 if {[is_MacOSX]} {
1832 # -- Apple Menu (Mac OS X only)
1834 .mbar add cascade -label Apple -menu .mbar.apple
1835 menu .mbar.apple
1837 .mbar.apple add command -label "About [appname]" \
1838 -command do_about
1839 .mbar.apple add command -label "Options..." \
1840 -command do_options
1841 } else {
1842 # -- Edit Menu
1844 .mbar.edit add separator
1845 .mbar.edit add command -label {Options...} \
1846 -command do_options
1848 # -- Tools Menu
1850 if {[is_Cygwin] && [file exists /usr/local/miga/lib/gui-miga]} {
1851 proc do_miga {} {
1852 if {![lock_index update]} return
1853 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1854 set miga_fd [open "|$cmd" r]
1855 fconfigure $miga_fd -blocking 0
1856 fileevent $miga_fd readable [list miga_done $miga_fd]
1857 ui_status {Running miga...}
1859 proc miga_done {fd} {
1860 read $fd 512
1861 if {[eof $fd]} {
1862 close $fd
1863 unlock_index
1864 rescan ui_ready
1867 .mbar add cascade -label Tools -menu .mbar.tools
1868 menu .mbar.tools
1869 .mbar.tools add command -label "Migrate" \
1870 -command do_miga
1871 lappend disable_on_lock \
1872 [list .mbar.tools entryconf [.mbar.tools index last] -state]
1876 # -- Help Menu
1878 .mbar add cascade -label Help -menu .mbar.help
1879 menu .mbar.help
1881 if {![is_MacOSX]} {
1882 .mbar.help add command -label "About [appname]" \
1883 -command do_about
1886 set browser {}
1887 catch {set browser $repo_config(instaweb.browser)}
1888 set doc_path [file dirname [gitexec]]
1889 set doc_path [file join $doc_path Documentation index.html]
1891 if {[is_Cygwin]} {
1892 set doc_path [exec cygpath --mixed $doc_path]
1895 if {$browser eq {}} {
1896 if {[is_MacOSX]} {
1897 set browser open
1898 } elseif {[is_Cygwin]} {
1899 set program_files [file dirname [exec cygpath --windir]]
1900 set program_files [file join $program_files {Program Files}]
1901 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1902 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1903 if {[file exists $firefox]} {
1904 set browser $firefox
1905 } elseif {[file exists $ie]} {
1906 set browser $ie
1908 unset program_files firefox ie
1912 if {[file isfile $doc_path]} {
1913 set doc_url "file:$doc_path"
1914 } else {
1915 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1918 if {$browser ne {}} {
1919 .mbar.help add command -label {Online Documentation} \
1920 -command [list exec $browser $doc_url &]
1922 unset browser doc_path doc_url
1924 # -- Standard bindings
1926 wm protocol . WM_DELETE_WINDOW do_quit
1927 bind all <$M1B-Key-q> do_quit
1928 bind all <$M1B-Key-Q> do_quit
1929 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1930 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1932 set subcommand_args {}
1933 proc usage {} {
1934 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1935 exit 1
1938 # -- Not a normal commit type invocation? Do that instead!
1940 switch -- $subcommand {
1941 browser {
1942 set subcommand_args {rev?}
1943 switch [llength $argv] {
1944 0 { load_current_branch }
1946 set current_branch [lindex $argv 0]
1947 if {[regexp {^[0-9a-f]{1,39}$} $current_branch]} {
1948 if {[catch {
1949 set current_branch \
1950 [git rev-parse --verify $current_branch]
1951 } err]} {
1952 puts stderr $err
1953 exit 1
1957 default usage
1959 browser::new $current_branch
1960 return
1962 blame {
1963 set subcommand_args {rev? path?}
1964 set head {}
1965 set path {}
1966 set is_path 0
1967 foreach a $argv {
1968 if {$is_path || [file exists $_prefix$a]} {
1969 if {$path ne {}} usage
1970 set path $_prefix$a
1971 break
1972 } elseif {$a eq {--}} {
1973 if {$path ne {}} {
1974 if {$head ne {}} usage
1975 set head $path
1976 set path {}
1978 set is_path 1
1979 } elseif {$head eq {}} {
1980 if {$head ne {}} usage
1981 set head $a
1982 } else {
1983 usage
1986 unset is_path
1988 if {$head eq {}} {
1989 load_current_branch
1990 } else {
1991 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
1992 if {[catch {
1993 set head [git rev-parse --verify $head]
1994 } err]} {
1995 puts stderr $err
1996 exit 1
1999 set current_branch $head
2002 if {$path eq {}} usage
2003 blame::new $head $path
2004 return
2006 citool -
2007 gui {
2008 if {[llength $argv] != 0} {
2009 puts -nonewline stderr "usage: $argv0"
2010 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2011 puts -nonewline stderr " $subcommand"
2013 puts stderr {}
2014 exit 1
2016 # fall through to setup UI for commits
2018 default {
2019 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2020 exit 1
2024 # -- Branch Control
2026 frame .branch \
2027 -borderwidth 1 \
2028 -relief sunken
2029 label .branch.l1 \
2030 -text {Current Branch:} \
2031 -anchor w \
2032 -justify left
2033 label .branch.cb \
2034 -textvariable current_branch \
2035 -anchor w \
2036 -justify left
2037 pack .branch.l1 -side left
2038 pack .branch.cb -side left -fill x
2039 pack .branch -side top -fill x
2041 # -- Main Window Layout
2043 panedwindow .vpane -orient vertical
2044 panedwindow .vpane.files -orient horizontal
2045 .vpane add .vpane.files -sticky nsew -height 100 -width 200
2046 pack .vpane -anchor n -side top -fill both -expand 1
2048 # -- Index File List
2050 frame .vpane.files.index -height 100 -width 200
2051 label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2052 -background lightgreen
2053 text $ui_index -background white -borderwidth 0 \
2054 -width 20 -height 10 \
2055 -wrap none \
2056 -cursor $cursor_ptr \
2057 -xscrollcommand {.vpane.files.index.sx set} \
2058 -yscrollcommand {.vpane.files.index.sy set} \
2059 -state disabled
2060 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2061 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2062 pack .vpane.files.index.title -side top -fill x
2063 pack .vpane.files.index.sx -side bottom -fill x
2064 pack .vpane.files.index.sy -side right -fill y
2065 pack $ui_index -side left -fill both -expand 1
2066 .vpane.files add .vpane.files.index -sticky nsew
2068 # -- Working Directory File List
2070 frame .vpane.files.workdir -height 100 -width 200
2071 label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2072 -background lightsalmon
2073 text $ui_workdir -background white -borderwidth 0 \
2074 -width 20 -height 10 \
2075 -wrap none \
2076 -cursor $cursor_ptr \
2077 -xscrollcommand {.vpane.files.workdir.sx set} \
2078 -yscrollcommand {.vpane.files.workdir.sy set} \
2079 -state disabled
2080 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2081 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2082 pack .vpane.files.workdir.title -side top -fill x
2083 pack .vpane.files.workdir.sx -side bottom -fill x
2084 pack .vpane.files.workdir.sy -side right -fill y
2085 pack $ui_workdir -side left -fill both -expand 1
2086 .vpane.files add .vpane.files.workdir -sticky nsew
2088 foreach i [list $ui_index $ui_workdir] {
2089 $i tag conf in_diff -background lightgray
2090 $i tag conf in_sel -background lightgray
2092 unset i
2094 # -- Diff and Commit Area
2096 frame .vpane.lower -height 300 -width 400
2097 frame .vpane.lower.commarea
2098 frame .vpane.lower.diff -relief sunken -borderwidth 1
2099 pack .vpane.lower.commarea -side top -fill x
2100 pack .vpane.lower.diff -side bottom -fill both -expand 1
2101 .vpane add .vpane.lower -sticky nsew
2103 # -- Commit Area Buttons
2105 frame .vpane.lower.commarea.buttons
2106 label .vpane.lower.commarea.buttons.l -text {} \
2107 -anchor w \
2108 -justify left
2109 pack .vpane.lower.commarea.buttons.l -side top -fill x
2110 pack .vpane.lower.commarea.buttons -side left -fill y
2112 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2113 -command do_rescan
2114 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2115 lappend disable_on_lock \
2116 {.vpane.lower.commarea.buttons.rescan conf -state}
2118 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
2119 -command do_add_all
2120 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2121 lappend disable_on_lock \
2122 {.vpane.lower.commarea.buttons.incall conf -state}
2124 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2125 -command do_signoff
2126 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2128 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2129 -command do_commit
2130 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2131 lappend disable_on_lock \
2132 {.vpane.lower.commarea.buttons.commit conf -state}
2134 button .vpane.lower.commarea.buttons.push -text {Push} \
2135 -command do_push_anywhere
2136 pack .vpane.lower.commarea.buttons.push -side top -fill x
2138 # -- Commit Message Buffer
2140 frame .vpane.lower.commarea.buffer
2141 frame .vpane.lower.commarea.buffer.header
2142 set ui_comm .vpane.lower.commarea.buffer.t
2143 set ui_coml .vpane.lower.commarea.buffer.header.l
2144 radiobutton .vpane.lower.commarea.buffer.header.new \
2145 -text {New Commit} \
2146 -command do_select_commit_type \
2147 -variable selected_commit_type \
2148 -value new
2149 lappend disable_on_lock \
2150 [list .vpane.lower.commarea.buffer.header.new conf -state]
2151 radiobutton .vpane.lower.commarea.buffer.header.amend \
2152 -text {Amend Last Commit} \
2153 -command do_select_commit_type \
2154 -variable selected_commit_type \
2155 -value amend
2156 lappend disable_on_lock \
2157 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2158 label $ui_coml \
2159 -anchor w \
2160 -justify left
2161 proc trace_commit_type {varname args} {
2162 global ui_coml commit_type
2163 switch -glob -- $commit_type {
2164 initial {set txt {Initial Commit Message:}}
2165 amend {set txt {Amended Commit Message:}}
2166 amend-initial {set txt {Amended Initial Commit Message:}}
2167 amend-merge {set txt {Amended Merge Commit Message:}}
2168 merge {set txt {Merge Commit Message:}}
2169 * {set txt {Commit Message:}}
2171 $ui_coml conf -text $txt
2173 trace add variable commit_type write trace_commit_type
2174 pack $ui_coml -side left -fill x
2175 pack .vpane.lower.commarea.buffer.header.amend -side right
2176 pack .vpane.lower.commarea.buffer.header.new -side right
2178 text $ui_comm -background white -borderwidth 1 \
2179 -undo true \
2180 -maxundo 20 \
2181 -autoseparators true \
2182 -relief sunken \
2183 -width 75 -height 9 -wrap none \
2184 -font font_diff \
2185 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2186 scrollbar .vpane.lower.commarea.buffer.sby \
2187 -command [list $ui_comm yview]
2188 pack .vpane.lower.commarea.buffer.header -side top -fill x
2189 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2190 pack $ui_comm -side left -fill y
2191 pack .vpane.lower.commarea.buffer -side left -fill y
2193 # -- Commit Message Buffer Context Menu
2195 set ctxm .vpane.lower.commarea.buffer.ctxm
2196 menu $ctxm -tearoff 0
2197 $ctxm add command \
2198 -label {Cut} \
2199 -command {tk_textCut $ui_comm}
2200 $ctxm add command \
2201 -label {Copy} \
2202 -command {tk_textCopy $ui_comm}
2203 $ctxm add command \
2204 -label {Paste} \
2205 -command {tk_textPaste $ui_comm}
2206 $ctxm add command \
2207 -label {Delete} \
2208 -command {$ui_comm delete sel.first sel.last}
2209 $ctxm add separator
2210 $ctxm add command \
2211 -label {Select All} \
2212 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2213 $ctxm add command \
2214 -label {Copy All} \
2215 -command {
2216 $ui_comm tag add sel 0.0 end
2217 tk_textCopy $ui_comm
2218 $ui_comm tag remove sel 0.0 end
2220 $ctxm add separator
2221 $ctxm add command \
2222 -label {Sign Off} \
2223 -command do_signoff
2224 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2226 # -- Diff Header
2228 proc trace_current_diff_path {varname args} {
2229 global current_diff_path diff_actions file_states
2230 if {$current_diff_path eq {}} {
2231 set s {}
2232 set f {}
2233 set p {}
2234 set o disabled
2235 } else {
2236 set p $current_diff_path
2237 set s [mapdesc [lindex $file_states($p) 0] $p]
2238 set f {File:}
2239 set p [escape_path $p]
2240 set o normal
2243 .vpane.lower.diff.header.status configure -text $s
2244 .vpane.lower.diff.header.file configure -text $f
2245 .vpane.lower.diff.header.path configure -text $p
2246 foreach w $diff_actions {
2247 uplevel #0 $w $o
2250 trace add variable current_diff_path write trace_current_diff_path
2252 frame .vpane.lower.diff.header -background gold
2253 label .vpane.lower.diff.header.status \
2254 -background gold \
2255 -width $max_status_desc \
2256 -anchor w \
2257 -justify left
2258 label .vpane.lower.diff.header.file \
2259 -background gold \
2260 -anchor w \
2261 -justify left
2262 label .vpane.lower.diff.header.path \
2263 -background gold \
2264 -anchor w \
2265 -justify left
2266 pack .vpane.lower.diff.header.status -side left
2267 pack .vpane.lower.diff.header.file -side left
2268 pack .vpane.lower.diff.header.path -fill x
2269 set ctxm .vpane.lower.diff.header.ctxm
2270 menu $ctxm -tearoff 0
2271 $ctxm add command \
2272 -label {Copy} \
2273 -command {
2274 clipboard clear
2275 clipboard append \
2276 -format STRING \
2277 -type STRING \
2278 -- $current_diff_path
2280 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2281 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2283 # -- Diff Body
2285 frame .vpane.lower.diff.body
2286 set ui_diff .vpane.lower.diff.body.t
2287 text $ui_diff -background white -borderwidth 0 \
2288 -width 80 -height 15 -wrap none \
2289 -font font_diff \
2290 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2291 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2292 -state disabled
2293 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2294 -command [list $ui_diff xview]
2295 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2296 -command [list $ui_diff yview]
2297 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2298 pack .vpane.lower.diff.body.sby -side right -fill y
2299 pack $ui_diff -side left -fill both -expand 1
2300 pack .vpane.lower.diff.header -side top -fill x
2301 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2303 $ui_diff tag conf d_cr -elide true
2304 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
2305 $ui_diff tag conf d_+ -foreground {#00a000}
2306 $ui_diff tag conf d_- -foreground red
2308 $ui_diff tag conf d_++ -foreground {#00a000}
2309 $ui_diff tag conf d_-- -foreground red
2310 $ui_diff tag conf d_+s \
2311 -foreground {#00a000} \
2312 -background {#e2effa}
2313 $ui_diff tag conf d_-s \
2314 -foreground red \
2315 -background {#e2effa}
2316 $ui_diff tag conf d_s+ \
2317 -foreground {#00a000} \
2318 -background ivory1
2319 $ui_diff tag conf d_s- \
2320 -foreground red \
2321 -background ivory1
2323 $ui_diff tag conf d<<<<<<< \
2324 -foreground orange \
2325 -font font_diffbold
2326 $ui_diff tag conf d======= \
2327 -foreground orange \
2328 -font font_diffbold
2329 $ui_diff tag conf d>>>>>>> \
2330 -foreground orange \
2331 -font font_diffbold
2333 $ui_diff tag raise sel
2335 # -- Diff Body Context Menu
2337 set ctxm .vpane.lower.diff.body.ctxm
2338 menu $ctxm -tearoff 0
2339 $ctxm add command \
2340 -label {Refresh} \
2341 -command reshow_diff
2342 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2343 $ctxm add command \
2344 -label {Copy} \
2345 -command {tk_textCopy $ui_diff}
2346 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2347 $ctxm add command \
2348 -label {Select All} \
2349 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2350 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2351 $ctxm add command \
2352 -label {Copy All} \
2353 -command {
2354 $ui_diff tag add sel 0.0 end
2355 tk_textCopy $ui_diff
2356 $ui_diff tag remove sel 0.0 end
2358 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2359 $ctxm add separator
2360 $ctxm add command \
2361 -label {Apply/Reverse Hunk} \
2362 -command {apply_hunk $cursorX $cursorY}
2363 set ui_diff_applyhunk [$ctxm index last]
2364 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2365 $ctxm add separator
2366 $ctxm add command \
2367 -label {Decrease Font Size} \
2368 -command {incr_font_size font_diff -1}
2369 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2370 $ctxm add command \
2371 -label {Increase Font Size} \
2372 -command {incr_font_size font_diff 1}
2373 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2374 $ctxm add separator
2375 $ctxm add command \
2376 -label {Show Less Context} \
2377 -command {if {$repo_config(gui.diffcontext) >= 1} {
2378 incr repo_config(gui.diffcontext) -1
2379 reshow_diff
2381 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2382 $ctxm add command \
2383 -label {Show More Context} \
2384 -command {if {$repo_config(gui.diffcontext) < 99} {
2385 incr repo_config(gui.diffcontext)
2386 reshow_diff
2388 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2389 $ctxm add separator
2390 $ctxm add command -label {Options...} \
2391 -command do_options
2392 bind_button3 $ui_diff "
2393 set cursorX %x
2394 set cursorY %y
2395 if {\$ui_index eq \$current_diff_side} {
2396 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2397 } else {
2398 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2400 tk_popup $ctxm %X %Y
2402 unset ui_diff_applyhunk
2404 # -- Status Bar
2406 set main_status [::status_bar::new .status]
2407 pack .status -anchor w -side bottom -fill x
2408 $main_status show {Initializing...}
2410 # -- Load geometry
2412 catch {
2413 set gm $repo_config(gui.geometry)
2414 wm geometry . [lindex $gm 0]
2415 .vpane sash place 0 \
2416 [lindex [.vpane sash coord 0] 0] \
2417 [lindex $gm 1]
2418 .vpane.files sash place 0 \
2419 [lindex $gm 2] \
2420 [lindex [.vpane.files sash coord 0] 1]
2421 unset gm
2424 # -- Key Bindings
2426 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2427 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2428 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2429 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2430 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2431 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2432 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2433 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2434 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2435 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2436 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2438 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2439 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2440 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2441 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2442 bind $ui_diff <$M1B-Key-v> {break}
2443 bind $ui_diff <$M1B-Key-V> {break}
2444 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2445 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2446 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2447 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2448 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2449 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2450 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2451 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2452 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2453 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2454 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2455 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2456 bind $ui_diff <Button-1> {focus %W}
2458 if {[is_enabled branch]} {
2459 bind . <$M1B-Key-n> branch_create::dialog
2460 bind . <$M1B-Key-N> branch_create::dialog
2461 bind . <$M1B-Key-o> branch_checkout::dialog
2462 bind . <$M1B-Key-O> branch_checkout::dialog
2464 if {[is_enabled transport]} {
2465 bind . <$M1B-Key-p> do_push_anywhere
2466 bind . <$M1B-Key-P> do_push_anywhere
2469 bind . <Key-F5> do_rescan
2470 bind . <$M1B-Key-r> do_rescan
2471 bind . <$M1B-Key-R> do_rescan
2472 bind . <$M1B-Key-s> do_signoff
2473 bind . <$M1B-Key-S> do_signoff
2474 bind . <$M1B-Key-i> do_add_all
2475 bind . <$M1B-Key-I> do_add_all
2476 bind . <$M1B-Key-Return> do_commit
2477 foreach i [list $ui_index $ui_workdir] {
2478 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2479 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2480 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2482 unset i
2484 set file_lists($ui_index) [list]
2485 set file_lists($ui_workdir) [list]
2487 wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2488 focus -force $ui_comm
2490 # -- Warn the user about environmental problems. Cygwin's Tcl
2491 # does *not* pass its env array onto any processes it spawns.
2492 # This means that git processes get none of our environment.
2494 if {[is_Cygwin]} {
2495 set ignored_env 0
2496 set suggest_user {}
2497 set msg "Possible environment issues exist.
2499 The following environment variables are probably
2500 going to be ignored by any Git subprocess run
2501 by [appname]:
2504 foreach name [array names env] {
2505 switch -regexp -- $name {
2506 {^GIT_INDEX_FILE$} -
2507 {^GIT_OBJECT_DIRECTORY$} -
2508 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2509 {^GIT_DIFF_OPTS$} -
2510 {^GIT_EXTERNAL_DIFF$} -
2511 {^GIT_PAGER$} -
2512 {^GIT_TRACE$} -
2513 {^GIT_CONFIG$} -
2514 {^GIT_CONFIG_LOCAL$} -
2515 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2516 append msg " - $name\n"
2517 incr ignored_env
2519 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2520 append msg " - $name\n"
2521 incr ignored_env
2522 set suggest_user $name
2526 if {$ignored_env > 0} {
2527 append msg "
2528 This is due to a known issue with the
2529 Tcl binary distributed by Cygwin."
2531 if {$suggest_user ne {}} {
2532 append msg "
2534 A good replacement for $suggest_user
2535 is placing values for the user.name and
2536 user.email settings into your personal
2537 ~/.gitconfig file.
2540 warn_popup $msg
2542 unset ignored_env msg suggest_user name
2545 # -- Only initialize complex UI if we are going to stay running.
2547 if {[is_enabled transport]} {
2548 load_all_remotes
2550 populate_fetch_menu
2551 populate_push_menu
2554 # -- Only suggest a gc run if we are going to stay running.
2556 if {[is_enabled multicommit]} {
2557 set object_limit 2000
2558 if {[is_Windows]} {set object_limit 200}
2559 regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
2560 if {$objects_current >= $object_limit} {
2561 if {[ask_popup \
2562 "This repository currently has $objects_current loose objects.
2564 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2566 Compress the database now?"] eq yes} {
2567 do_gc
2570 unset object_limit _junk objects_current
2573 lock_index begin-read
2574 after 1 do_rescan