d0b75c044c4f0f519ff2f942b1c1b22168c496da
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" -- "$@"
10
11set appvers {@@GITGUI_VERSION@@}
12set copyright {
13Copyright © 2006, 2007 Shawn Pearce, et. al.
14
15This program is free software; you can redistribute it and/or modify
16it under the terms of the GNU General Public License as published by
17the Free Software Foundation; either version 2 of the License, or
18(at your option) any later version.
19
20This program is distributed in the hope that it will be useful,
21but WITHOUT ANY WARRANTY; without even the implied warranty of
22MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23GNU General Public License for more details.
24
25You should have received a copy of the GNU General Public License
26along with this program; if not, write to the Free Software
27Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
28
29######################################################################
30##
31## Tcl/Tk sanity check
32
33if {[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
43}
44
45######################################################################
46##
47## enable verbose loading?
48
49if {![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]
55 }
56 rename source real__source
57 proc source {name} {
58 puts stderr "source $name"
59 uplevel 1 real__source $name
60 }
61}
62
63######################################################################
64##
65## configure our library
66
67set oguilib {@@GITGUI_LIBDIR@@}
68set oguirel {@@GITGUI_RELATIVE@@}
69if {$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]
74}
75
76set idx [file join $oguilib tclIndex]
77if {[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
85}
86if {[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
91 }
92 }
93} else {
94 set idx {}
95}
96close $fd
97
98if {$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
104 }
105 unset loaded p
106} else {
107 set auto_path [concat [list $oguilib] $auto_path]
108}
109unset -nocomplain oguirel idx fd
110
111######################################################################
112##
113## read only globals
114
115set _appname [lindex [file split $argv0] end]
116set _gitdir {}
117set _gitexec {}
118set _reponame {}
119set _iscygwin {}
120set _search_path {}
121
122proc appname {} {
123 global _appname
124 return $_appname
125}
126
127proc gitdir {args} {
128 global _gitdir
129 if {$args eq {}} {
130 return $_gitdir
131 }
132 return [eval [list file join $_gitdir] $args]
133}
134
135proc 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"
140 }
141 if {[is_Cygwin]} {
142 set _gitexec [exec cygpath \
143 --windows \
144 --absolute \
145 $_gitexec]
146 } else {
147 set _gitexec [file normalize $_gitexec]
148 }
149 }
150 if {$args eq {}} {
151 return $_gitexec
152 }
153 return [eval [list file join $_gitexec] $args]
154}
155
156proc reponame {} {
157 global _reponame
158 return $_reponame
159}
160
161proc is_MacOSX {} {
162 global tcl_platform tk_library
163 if {[tk windowingsystem] eq {aqua}} {
164 return 1
165 }
166 return 0
167}
168
169proc is_Windows {} {
170 global tcl_platform
171 if {$tcl_platform(platform) eq {windows}} {
172 return 1
173 }
174 return 0
175}
176
177proc 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
185 }
186 } else {
187 set _iscygwin 0
188 }
189 }
190 return $_iscygwin
191}
192
193proc is_enabled {option} {
194 global enabled_options
195 if {[catch {set on $enabled_options($option)}]} {return 0}
196 return $on
197}
198
199proc enable_option {option} {
200 global enabled_options
201 set enabled_options($option) 1
202}
203
204proc disable_option {option} {
205 global enabled_options
206 set enabled_options($option) 0
207}
208
209######################################################################
210##
211## config
212
213proc is_many_config {name} {
214 switch -glob -- $name {
215 remote.*.fetch -
216 remote.*.push
217 {return 1}
218 *
219 {return 0}
220 }
221}
222
223proc 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
231 }
232}
233
234proc get_config {name} {
235 global repo_config
236 if {[catch {set v $repo_config($name)}]} {
237 return {}
238 } else {
239 return $v
240 }
241}
242
243proc load_config {include_global} {
244 global repo_config global_config default_config
245
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
256 }
257 }
258 }
259 close $fd_rc
260 }
261 }
262
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
272 }
273 }
274 }
275 close $fd_rc
276 }
277
278 foreach name [array names default_config] {
279 if {[catch {set v $global_config($name)}]} {
280 set global_config($name) $default_config($name)
281 }
282 if {[catch {set v $repo_config($name)}]} {
283 set repo_config($name) $default_config($name)
284 }
285 }
286}
287
288######################################################################
289##
290## handy utils
291
292proc _git_cmd {name} {
293 global _git_cmd_path
294
295 if {[catch {set v $_git_cmd_path($name)}]} {
296 switch -- $name {
297 version -
298 --version -
299 --exec-path { return [list $::_git $name] }
300 }
301
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.
309 #
310 set p [gitexec git-$name]
311 set f [open $p r]
312 set s [gets $f]
313 close $f
314
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" }
320 }
321
322 upvar #0 _$i interp
323 if {![info exists interp]} {
324 set interp [_which $i]
325 }
326 if {$interp eq {}} {
327 error "git-$name requires $i (not in PATH)"
328 }
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.
333 #
334 set v [list $::_git $name]
335 }
336 set _git_cmd_path($name) $v
337 }
338 return $v
339}
340
341proc _which {what} {
342 global env _search_exe _search_path
343
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 {}
358 }
359 }
360
361 foreach p $_search_path {
362 set p [file join $p $what$_search_exe]
363 if {[file exists $p]} {
364 return [file normalize $p]
365 }
366 }
367 return {}
368}
369
370proc git {args} {
371 set opt [list exec]
372
373 while {1} {
374 switch -- [lindex $args 0] {
375 --nice {
376 global _nice
377 if {$_nice ne {}} {
378 lappend opt $_nice
379 }
380 }
381
382 default {
383 break
384 }
385
386 }
387
388 set args [lrange $args 1 end]
389 }
390
391 set cmdp [_git_cmd [lindex $args 0]]
392 set args [lrange $args 1 end]
393
394 return [eval $opt $cmdp $args]
395}
396
397proc _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"}
403 } {
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.
408 #
409 set fd [open [concat \
410 [lrange $cmd 0 end-1] \
411 [list |& cat] \
412 ] r]
413 } else {
414 error $err
415 }
416 }
417 fconfigure $fd -eofchar {}
418 return $fd
419}
420
421proc git_read {args} {
422 set opt [list |]
423
424 while {1} {
425 switch -- [lindex $args 0] {
426 --nice {
427 global _nice
428 if {$_nice ne {}} {
429 lappend opt $_nice
430 }
431 }
432
433 --stderr {
434 lappend args 2>@1
435 }
436
437 default {
438 break
439 }
440
441 }
442
443 set args [lrange $args 1 end]
444 }
445
446 set cmdp [_git_cmd [lindex $args 0]]
447 set args [lrange $args 1 end]
448
449 return [_open_stdout_stderr [concat $opt $cmdp $args]]
450}
451
452proc git_write {args} {
453 set opt [list |]
454
455 while {1} {
456 switch -- [lindex $args 0] {
457 --nice {
458 global _nice
459 if {$_nice ne {}} {
460 lappend opt $_nice
461 }
462 }
463
464 default {
465 break
466 }
467
468 }
469
470 set args [lrange $args 1 end]
471 }
472
473 set cmdp [_git_cmd [lindex $args 0]]
474 set args [lrange $args 1 end]
475
476 return [open [concat $opt $cmdp $args] w]
477}
478
479proc sq {value} {
480 regsub -all ' $value "'\\''" value
481 return "'$value'"
482}
483
484proc load_current_branch {} {
485 global current_branch is_detached
486
487 set fd [open [gitdir HEAD] r]
488 if {[gets $fd ref] < 1} {
489 set ref {}
490 }
491 close $fd
492
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.
498 #
499 set current_branch [string range $ref $len end]
500 set is_detached 0
501 } else {
502 # Assume this is a detached head.
503 #
504 set current_branch HEAD
505 set is_detached 1
506 }
507}
508
509auto_load tk_optionMenu
510rename tk_optionMenu real__tkOptionMenu
511proc 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
516}
517
518######################################################################
519##
520## find git
521
522set _git [_which git]
523if {$_git eq {}} {
524 catch {wm withdraw .}
525 error_popup "Cannot find git in PATH."
526 exit 1
527}
528set _nice [_which nice]
529
530######################################################################
531##
532## version check
533
534if {[catch {set _git_version [git --version]} err]} {
535 catch {wm withdraw .}
536 error_popup "Cannot determine Git version:
537
538$err
539
540[appname] requires Git 1.5.0 or later."
541 exit 1
542}
543if {![regsub {^git version } $_git_version {} _git_version]} {
544 catch {wm withdraw .}
545 error_popup "Cannot parse Git version string:\n\n$_git_version"
546 exit 1
547}
548regsub -- {-dirty$} $_git_version {} _git_version
549regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
550regsub {\.rc[0-9]+$} $_git_version {} _git_version
551
552proc git-version {args} {
553 global _git_version
554
555 switch [llength $args] {
556 0 {
557 return $_git_version
558 }
559
560 2 {
561 set op [lindex $args 0]
562 set vr [lindex $args 1]
563 set cm [package vcompare $_git_version $vr]
564 return [expr $cm $op 0]
565 }
566
567 4 {
568 set type [lindex $args 0]
569 set name [lindex $args 1]
570 set parm [lindex $args 2]
571 set body [lindex $args 3]
572
573 if {($type ne {proc} && $type ne {method})} {
574 error "Invalid arguments to git-version"
575 }
576 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
577 error "Last arm of $type $name must be default"
578 }
579
580 foreach {op vr cb} [lrange $body 0 end-2] {
581 if {[git-version $op $vr]} {
582 return [uplevel [list $type $name $parm $cb]]
583 }
584 }
585
586 return [uplevel [list $type $name $parm [lindex $body end]]]
587 }
588
589 default {
590 error "git-version >= x"
591 }
592
593 }
594}
595
596if {[git-version < 1.5]} {
597 catch {wm withdraw .}
598 error_popup "[appname] requires Git 1.5.0 or later.
599
600You are using [git-version]:
601
602[git --version]"
603 exit 1
604}
605
606######################################################################
607##
608## repository setup
609
610if {[catch {
611 set _gitdir $env(GIT_DIR)
612 set _prefix {}
613 }]
614 && [catch {
615 set _gitdir [git rev-parse --git-dir]
616 set _prefix [git rev-parse --show-prefix]
617 } err]} {
618 catch {wm withdraw .}
619 error_popup "Cannot find the git directory:\n\n$err"
620 exit 1
621}
622if {![file isdirectory $_gitdir] && [is_Cygwin]} {
623 catch {set _gitdir [exec cygpath --unix $_gitdir]}
624}
625if {![file isdirectory $_gitdir]} {
626 catch {wm withdraw .}
627 error_popup "Git directory not found:\n\n$_gitdir"
628 exit 1
629}
630if {[lindex [file split $_gitdir] end] ne {.git}} {
631 catch {wm withdraw .}
632 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
633 exit 1
634}
635if {[catch {cd [file dirname $_gitdir]} err]} {
636 catch {wm withdraw .}
637 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
638 exit 1
639}
640set _reponame [lindex [file split \
641 [file normalize [file dirname $_gitdir]]] \
642 end]
643
644######################################################################
645##
646## global init
647
648set current_diff_path {}
649set current_diff_side {}
650set diff_actions [list]
651
652set HEAD {}
653set PARENT {}
654set MERGE_HEAD [list]
655set commit_type {}
656set empty_tree {}
657set current_branch {}
658set is_detached 0
659set current_diff_path {}
660set selected_commit_type new
661
662######################################################################
663##
664## task management
665
666set rescan_active 0
667set diff_active 0
668set last_clicked {}
669
670set disable_on_lock [list]
671set index_lock_type none
672
673proc lock_index {type} {
674 global index_lock_type disable_on_lock
675
676 if {$index_lock_type eq {none}} {
677 set index_lock_type $type
678 foreach w $disable_on_lock {
679 uplevel #0 $w disabled
680 }
681 return 1
682 } elseif {$index_lock_type eq "begin-$type"} {
683 set index_lock_type $type
684 return 1
685 }
686 return 0
687}
688
689proc unlock_index {} {
690 global index_lock_type disable_on_lock
691
692 set index_lock_type none
693 foreach w $disable_on_lock {
694 uplevel #0 $w normal
695 }
696}
697
698######################################################################
699##
700## status
701
702proc repository_state {ctvar hdvar mhvar} {
703 global current_branch
704 upvar $ctvar ct $hdvar hd $mhvar mh
705
706 set mh [list]
707
708 load_current_branch
709 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
710 set hd {}
711 set ct initial
712 return
713 }
714
715 set merge_head [gitdir MERGE_HEAD]
716 if {[file exists $merge_head]} {
717 set ct merge
718 set fd_mh [open $merge_head r]
719 while {[gets $fd_mh line] >= 0} {
720 lappend mh $line
721 }
722 close $fd_mh
723 return
724 }
725
726 set ct normal
727}
728
729proc PARENT {} {
730 global PARENT empty_tree
731
732 set p [lindex $PARENT 0]
733 if {$p ne {}} {
734 return $p
735 }
736 if {$empty_tree eq {}} {
737 set empty_tree [git mktree << {}]
738 }
739 return $empty_tree
740}
741
742proc rescan {after {honor_trustmtime 1}} {
743 global HEAD PARENT MERGE_HEAD commit_type
744 global ui_index ui_workdir ui_comm
745 global rescan_active file_states
746 global repo_config
747
748 if {$rescan_active > 0 || ![lock_index read]} return
749
750 repository_state newType newHEAD newMERGE_HEAD
751 if {[string match amend* $commit_type]
752 && $newType eq {normal}
753 && $newHEAD eq $HEAD} {
754 } else {
755 set HEAD $newHEAD
756 set PARENT $newHEAD
757 set MERGE_HEAD $newMERGE_HEAD
758 set commit_type $newType
759 }
760
761 array unset file_states
762
763 if {![$ui_comm edit modified]
764 || [string trim [$ui_comm get 0.0 end]] eq {}} {
765 if {[string match amend* $commit_type]} {
766 } elseif {[load_message GITGUI_MSG]} {
767 } elseif {[load_message MERGE_MSG]} {
768 } elseif {[load_message SQUASH_MSG]} {
769 }
770 $ui_comm edit reset
771 $ui_comm edit modified false
772 }
773
774 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
775 rescan_stage2 {} $after
776 } else {
777 set rescan_active 1
778 ui_status {Refreshing file status...}
779 set fd_rf [git_read update-index \
780 -q \
781 --unmerged \
782 --ignore-missing \
783 --refresh \
784 ]
785 fconfigure $fd_rf -blocking 0 -translation binary
786 fileevent $fd_rf readable \
787 [list rescan_stage2 $fd_rf $after]
788 }
789}
790
791proc rescan_stage2 {fd after} {
792 global rescan_active buf_rdi buf_rdf buf_rlo
793
794 if {$fd ne {}} {
795 read $fd
796 if {![eof $fd]} return
797 close $fd
798 }
799
800 set ls_others [list --exclude-per-directory=.gitignore]
801 set info_exclude [gitdir info exclude]
802 if {[file readable $info_exclude]} {
803 lappend ls_others "--exclude-from=$info_exclude"
804 }
805
806 set buf_rdi {}
807 set buf_rdf {}
808 set buf_rlo {}
809
810 set rescan_active 3
811 ui_status {Scanning for modified files ...}
812 set fd_di [git_read diff-index --cached -z [PARENT]]
813 set fd_df [git_read diff-files -z]
814 set fd_lo [eval git_read ls-files --others -z $ls_others]
815
816 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
817 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
818 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
819 fileevent $fd_di readable [list read_diff_index $fd_di $after]
820 fileevent $fd_df readable [list read_diff_files $fd_df $after]
821 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
822}
823
824proc load_message {file} {
825 global ui_comm
826
827 set f [gitdir $file]
828 if {[file isfile $f]} {
829 if {[catch {set fd [open $f r]}]} {
830 return 0
831 }
832 fconfigure $fd -eofchar {}
833 set content [string trim [read $fd]]
834 close $fd
835 regsub -all -line {[ \r\t]+$} $content {} content
836 $ui_comm delete 0.0 end
837 $ui_comm insert end $content
838 return 1
839 }
840 return 0
841}
842
843proc read_diff_index {fd after} {
844 global buf_rdi
845
846 append buf_rdi [read $fd]
847 set c 0
848 set n [string length $buf_rdi]
849 while {$c < $n} {
850 set z1 [string first "\0" $buf_rdi $c]
851 if {$z1 == -1} break
852 incr z1
853 set z2 [string first "\0" $buf_rdi $z1]
854 if {$z2 == -1} break
855
856 incr c
857 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
858 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
859 merge_state \
860 [encoding convertfrom $p] \
861 [lindex $i 4]? \
862 [list [lindex $i 0] [lindex $i 2]] \
863 [list]
864 set c $z2
865 incr c
866 }
867 if {$c < $n} {
868 set buf_rdi [string range $buf_rdi $c end]
869 } else {
870 set buf_rdi {}
871 }
872
873 rescan_done $fd buf_rdi $after
874}
875
876proc read_diff_files {fd after} {
877 global buf_rdf
878
879 append buf_rdf [read $fd]
880 set c 0
881 set n [string length $buf_rdf]
882 while {$c < $n} {
883 set z1 [string first "\0" $buf_rdf $c]
884 if {$z1 == -1} break
885 incr z1
886 set z2 [string first "\0" $buf_rdf $z1]
887 if {$z2 == -1} break
888
889 incr c
890 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
891 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
892 merge_state \
893 [encoding convertfrom $p] \
894 ?[lindex $i 4] \
895 [list] \
896 [list [lindex $i 0] [lindex $i 2]]
897 set c $z2
898 incr c
899 }
900 if {$c < $n} {
901 set buf_rdf [string range $buf_rdf $c end]
902 } else {
903 set buf_rdf {}
904 }
905
906 rescan_done $fd buf_rdf $after
907}
908
909proc read_ls_others {fd after} {
910 global buf_rlo
911
912 append buf_rlo [read $fd]
913 set pck [split $buf_rlo "\0"]
914 set buf_rlo [lindex $pck end]
915 foreach p [lrange $pck 0 end-1] {
916 merge_state [encoding convertfrom $p] ?O
917 }
918 rescan_done $fd buf_rlo $after
919}
920
921proc rescan_done {fd buf after} {
922 global rescan_active current_diff_path
923 global file_states repo_config
924 upvar $buf to_clear
925
926 if {![eof $fd]} return
927 set to_clear {}
928 close $fd
929 if {[incr rescan_active -1] > 0} return
930
931 prune_selection
932 unlock_index
933 display_all_files
934 if {$current_diff_path ne {}} reshow_diff
935 uplevel #0 $after
936}
937
938proc prune_selection {} {
939 global file_states selected_paths
940
941 foreach path [array names selected_paths] {
942 if {[catch {set still_here $file_states($path)}]} {
943 unset selected_paths($path)
944 }
945 }
946}
947
948######################################################################
949##
950## ui helpers
951
952proc mapicon {w state path} {
953 global all_icons
954
955 if {[catch {set r $all_icons($state$w)}]} {
956 puts "error: no icon for $w state={$state} $path"
957 return file_plain
958 }
959 return $r
960}
961
962proc mapdesc {state path} {
963 global all_descs
964
965 if {[catch {set r $all_descs($state)}]} {
966 puts "error: no desc for state={$state} $path"
967 return $state
968 }
969 return $r
970}
971
972proc ui_status {msg} {
973 $::main_status show $msg
974}
975
976proc ui_ready {{test {}}} {
977 $::main_status show {Ready.} $test
978}
979
980proc escape_path {path} {
981 regsub -all {\\} $path "\\\\" path
982 regsub -all "\n" $path "\\n" path
983 return $path
984}
985
986proc short_path {path} {
987 return [escape_path [lindex [file split $path] end]]
988}
989
990set next_icon_id 0
991set null_sha1 [string repeat 0 40]
992
993proc merge_state {path new_state {head_info {}} {index_info {}}} {
994 global file_states next_icon_id null_sha1
995
996 set s0 [string index $new_state 0]
997 set s1 [string index $new_state 1]
998
999 if {[catch {set info $file_states($path)}]} {
1000 set state __
1001 set icon n[incr next_icon_id]
1002 } else {
1003 set state [lindex $info 0]
1004 set icon [lindex $info 1]
1005 if {$head_info eq {}} {set head_info [lindex $info 2]}
1006 if {$index_info eq {}} {set index_info [lindex $info 3]}
1007 }
1008
1009 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1010 elseif {$s0 eq {_}} {set s0 _}
1011
1012 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1013 elseif {$s1 eq {_}} {set s1 _}
1014
1015 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1016 set head_info [list 0 $null_sha1]
1017 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1018 && $head_info eq {}} {
1019 set head_info $index_info
1020 }
1021
1022 set file_states($path) [list $s0$s1 $icon \
1023 $head_info $index_info \
1024 ]
1025 return $state
1026}
1027
1028proc display_file_helper {w path icon_name old_m new_m} {
1029 global file_lists
1030
1031 if {$new_m eq {_}} {
1032 set lno [lsearch -sorted -exact $file_lists($w) $path]
1033 if {$lno >= 0} {
1034 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1035 incr lno
1036 $w conf -state normal
1037 $w delete $lno.0 [expr {$lno + 1}].0
1038 $w conf -state disabled
1039 }
1040 } elseif {$old_m eq {_} && $new_m ne {_}} {
1041 lappend file_lists($w) $path
1042 set file_lists($w) [lsort -unique $file_lists($w)]
1043 set lno [lsearch -sorted -exact $file_lists($w) $path]
1044 incr lno
1045 $w conf -state normal
1046 $w image create $lno.0 \
1047 -align center -padx 5 -pady 1 \
1048 -name $icon_name \
1049 -image [mapicon $w $new_m $path]
1050 $w insert $lno.1 "[escape_path $path]\n"
1051 $w conf -state disabled
1052 } elseif {$old_m ne $new_m} {
1053 $w conf -state normal
1054 $w image conf $icon_name -image [mapicon $w $new_m $path]
1055 $w conf -state disabled
1056 }
1057}
1058
1059proc display_file {path state} {
1060 global file_states selected_paths
1061 global ui_index ui_workdir
1062
1063 set old_m [merge_state $path $state]
1064 set s $file_states($path)
1065 set new_m [lindex $s 0]
1066 set icon_name [lindex $s 1]
1067
1068 set o [string index $old_m 0]
1069 set n [string index $new_m 0]
1070 if {$o eq {U}} {
1071 set o _
1072 }
1073 if {$n eq {U}} {
1074 set n _
1075 }
1076 display_file_helper $ui_index $path $icon_name $o $n
1077
1078 if {[string index $old_m 0] eq {U}} {
1079 set o U
1080 } else {
1081 set o [string index $old_m 1]
1082 }
1083 if {[string index $new_m 0] eq {U}} {
1084 set n U
1085 } else {
1086 set n [string index $new_m 1]
1087 }
1088 display_file_helper $ui_workdir $path $icon_name $o $n
1089
1090 if {$new_m eq {__}} {
1091 unset file_states($path)
1092 catch {unset selected_paths($path)}
1093 }
1094}
1095
1096proc display_all_files_helper {w path icon_name m} {
1097 global file_lists
1098
1099 lappend file_lists($w) $path
1100 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1101 $w image create end \
1102 -align center -padx 5 -pady 1 \
1103 -name $icon_name \
1104 -image [mapicon $w $m $path]
1105 $w insert end "[escape_path $path]\n"
1106}
1107
1108proc display_all_files {} {
1109 global ui_index ui_workdir
1110 global file_states file_lists
1111 global last_clicked
1112
1113 $ui_index conf -state normal
1114 $ui_workdir conf -state normal
1115
1116 $ui_index delete 0.0 end
1117 $ui_workdir delete 0.0 end
1118 set last_clicked {}
1119
1120 set file_lists($ui_index) [list]
1121 set file_lists($ui_workdir) [list]
1122
1123 foreach path [lsort [array names file_states]] {
1124 set s $file_states($path)
1125 set m [lindex $s 0]
1126 set icon_name [lindex $s 1]
1127
1128 set s [string index $m 0]
1129 if {$s ne {U} && $s ne {_}} {
1130 display_all_files_helper $ui_index $path \
1131 $icon_name $s
1132 }
1133
1134 if {[string index $m 0] eq {U}} {
1135 set s U
1136 } else {
1137 set s [string index $m 1]
1138 }
1139 if {$s ne {_}} {
1140 display_all_files_helper $ui_workdir $path \
1141 $icon_name $s
1142 }
1143 }
1144
1145 $ui_index conf -state disabled
1146 $ui_workdir conf -state disabled
1147}
1148
1149######################################################################
1150##
1151## icons
1152
1153set filemask {
1154#define mask_width 14
1155#define mask_height 15
1156static unsigned char mask_bits[] = {
1157 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1158 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1159 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1160}
1161
1162image create bitmap file_plain -background white -foreground black -data {
1163#define plain_width 14
1164#define plain_height 15
1165static unsigned char plain_bits[] = {
1166 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1167 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1168 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1169} -maskdata $filemask
1170
1171image create bitmap file_mod -background white -foreground blue -data {
1172#define mod_width 14
1173#define mod_height 15
1174static unsigned char mod_bits[] = {
1175 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1176 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1177 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1178} -maskdata $filemask
1179
1180image create bitmap file_fulltick -background white -foreground "#007000" -data {
1181#define file_fulltick_width 14
1182#define file_fulltick_height 15
1183static unsigned char file_fulltick_bits[] = {
1184 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1185 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1186 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1187} -maskdata $filemask
1188
1189image create bitmap file_parttick -background white -foreground "#005050" -data {
1190#define parttick_width 14
1191#define parttick_height 15
1192static unsigned char parttick_bits[] = {
1193 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1194 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1195 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1196} -maskdata $filemask
1197
1198image create bitmap file_question -background white -foreground black -data {
1199#define file_question_width 14
1200#define file_question_height 15
1201static unsigned char file_question_bits[] = {
1202 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1203 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1204 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1205} -maskdata $filemask
1206
1207image create bitmap file_removed -background white -foreground red -data {
1208#define file_removed_width 14
1209#define file_removed_height 15
1210static unsigned char file_removed_bits[] = {
1211 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1212 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1213 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1214} -maskdata $filemask
1215
1216image create bitmap file_merge -background white -foreground blue -data {
1217#define file_merge_width 14
1218#define file_merge_height 15
1219static unsigned char file_merge_bits[] = {
1220 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1221 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1222 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1223} -maskdata $filemask
1224
1225set file_dir_data {
1226#define file_width 18
1227#define file_height 18
1228static unsigned char file_bits[] = {
1229 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
1230 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
1231 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
1232 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
1233 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
1234}
1235image create bitmap file_dir -background white -foreground blue \
1236 -data $file_dir_data -maskdata $file_dir_data
1237unset file_dir_data
1238
1239set file_uplevel_data {
1240#define up_width 15
1241#define up_height 15
1242static unsigned char up_bits[] = {
1243 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
1244 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
1245 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
1246}
1247image create bitmap file_uplevel -background white -foreground red \
1248 -data $file_uplevel_data -maskdata $file_uplevel_data
1249unset file_uplevel_data
1250
1251set ui_index .vpane.files.index.list
1252set ui_workdir .vpane.files.workdir.list
1253
1254set all_icons(_$ui_index) file_plain
1255set all_icons(A$ui_index) file_fulltick
1256set all_icons(M$ui_index) file_fulltick
1257set all_icons(D$ui_index) file_removed
1258set all_icons(U$ui_index) file_merge
1259
1260set all_icons(_$ui_workdir) file_plain
1261set all_icons(M$ui_workdir) file_mod
1262set all_icons(D$ui_workdir) file_question
1263set all_icons(U$ui_workdir) file_merge
1264set all_icons(O$ui_workdir) file_plain
1265
1266set max_status_desc 0
1267foreach i {
1268 {__ "Unmodified"}
1269
1270 {_M "Modified, not staged"}
1271 {M_ "Staged for commit"}
1272 {MM "Portions staged for commit"}
1273 {MD "Staged for commit, missing"}
1274
1275 {_O "Untracked, not staged"}
1276 {A_ "Staged for commit"}
1277 {AM "Portions staged for commit"}
1278 {AD "Staged for commit, missing"}
1279
1280 {_D "Missing"}
1281 {D_ "Staged for removal"}
1282 {DO "Staged for removal, still present"}
1283
1284 {U_ "Requires merge resolution"}
1285 {UU "Requires merge resolution"}
1286 {UM "Requires merge resolution"}
1287 {UD "Requires merge resolution"}
1288 } {
1289 if {$max_status_desc < [string length [lindex $i 1]]} {
1290 set max_status_desc [string length [lindex $i 1]]
1291 }
1292 set all_descs([lindex $i 0]) [lindex $i 1]
1293}
1294unset i
1295
1296######################################################################
1297##
1298## util
1299
1300proc bind_button3 {w cmd} {
1301 bind $w <Any-Button-3> $cmd
1302 if {[is_MacOSX]} {
1303 bind $w <Control-Button-1> $cmd
1304 }
1305}
1306
1307proc scrollbar2many {list mode args} {
1308 foreach w $list {eval $w $mode $args}
1309}
1310
1311proc many2scrollbar {list mode sb top bottom} {
1312 $sb set $top $bottom
1313 foreach w $list {$w $mode moveto $top}
1314}
1315
1316proc incr_font_size {font {amt 1}} {
1317 set sz [font configure $font -size]
1318 incr sz $amt
1319 font configure $font -size $sz
1320 font configure ${font}bold -size $sz
1321 font configure ${font}italic -size $sz
1322}
1323
1324######################################################################
1325##
1326## ui commands
1327
1328set starting_gitk_msg {Starting gitk... please wait...}
1329
1330proc do_gitk {revs} {
1331 # -- Always start gitk through whatever we were loaded with. This
1332 # lets us bypass using shell process on Windows systems.
1333 #
1334 set exe [file join [file dirname $::_git] gitk]
1335 set cmd [list [info nameofexecutable] $exe]
1336 if {! [file exists $exe]} {
1337 error_popup "Unable to start gitk:\n\n$exe does not exist"
1338 } else {
1339 eval exec $cmd $revs &
1340 ui_status $::starting_gitk_msg
1341 after 10000 {
1342 ui_ready $starting_gitk_msg
1343 }
1344 }
1345}
1346
1347set is_quitting 0
1348
1349proc do_quit {} {
1350 global ui_comm is_quitting repo_config commit_type
1351
1352 if {$is_quitting} return
1353 set is_quitting 1
1354
1355 if {[winfo exists $ui_comm]} {
1356 # -- Stash our current commit buffer.
1357 #
1358 set save [gitdir GITGUI_MSG]
1359 set msg [string trim [$ui_comm get 0.0 end]]
1360 regsub -all -line {[ \r\t]+$} $msg {} msg
1361 if {(![string match amend* $commit_type]
1362 || [$ui_comm edit modified])
1363 && $msg ne {}} {
1364 catch {
1365 set fd [open $save w]
1366 puts -nonewline $fd $msg
1367 close $fd
1368 }
1369 } else {
1370 catch {file delete $save}
1371 }
1372
1373 # -- Stash our current window geometry into this repository.
1374 #
1375 set cfg_geometry [list]
1376 lappend cfg_geometry [wm geometry .]
1377 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1378 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1379 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1380 set rc_geometry {}
1381 }
1382 if {$cfg_geometry ne $rc_geometry} {
1383 catch {git config gui.geometry $cfg_geometry}
1384 }
1385 }
1386
1387 destroy .
1388}
1389
1390proc do_rescan {} {
1391 rescan ui_ready
1392}
1393
1394proc do_commit {} {
1395 commit_tree
1396}
1397
1398proc toggle_or_diff {w x y} {
1399 global file_states file_lists current_diff_path ui_index ui_workdir
1400 global last_clicked selected_paths
1401
1402 set pos [split [$w index @$x,$y] .]
1403 set lno [lindex $pos 0]
1404 set col [lindex $pos 1]
1405 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1406 if {$path eq {}} {
1407 set last_clicked {}
1408 return
1409 }
1410
1411 set last_clicked [list $w $lno]
1412 array unset selected_paths
1413 $ui_index tag remove in_sel 0.0 end
1414 $ui_workdir tag remove in_sel 0.0 end
1415
1416 if {$col == 0} {
1417 if {$current_diff_path eq $path} {
1418 set after {reshow_diff;}
1419 } else {
1420 set after {}
1421 }
1422 if {$w eq $ui_index} {
1423 update_indexinfo \
1424 "Unstaging [short_path $path] from commit" \
1425 [list $path] \
1426 [concat $after [list ui_ready]]
1427 } elseif {$w eq $ui_workdir} {
1428 update_index \
1429 "Adding [short_path $path]" \
1430 [list $path] \
1431 [concat $after [list ui_ready]]
1432 }
1433 } else {
1434 show_diff $path $w $lno
1435 }
1436}
1437
1438proc add_one_to_selection {w x y} {
1439 global file_lists last_clicked selected_paths
1440
1441 set lno [lindex [split [$w index @$x,$y] .] 0]
1442 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1443 if {$path eq {}} {
1444 set last_clicked {}
1445 return
1446 }
1447
1448 if {$last_clicked ne {}
1449 && [lindex $last_clicked 0] ne $w} {
1450 array unset selected_paths
1451 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1452 }
1453
1454 set last_clicked [list $w $lno]
1455 if {[catch {set in_sel $selected_paths($path)}]} {
1456 set in_sel 0
1457 }
1458 if {$in_sel} {
1459 unset selected_paths($path)
1460 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1461 } else {
1462 set selected_paths($path) 1
1463 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1464 }
1465}
1466
1467proc add_range_to_selection {w x y} {
1468 global file_lists last_clicked selected_paths
1469
1470 if {[lindex $last_clicked 0] ne $w} {
1471 toggle_or_diff $w $x $y
1472 return
1473 }
1474
1475 set lno [lindex [split [$w index @$x,$y] .] 0]
1476 set lc [lindex $last_clicked 1]
1477 if {$lc < $lno} {
1478 set begin $lc
1479 set end $lno
1480 } else {
1481 set begin $lno
1482 set end $lc
1483 }
1484
1485 foreach path [lrange $file_lists($w) \
1486 [expr {$begin - 1}] \
1487 [expr {$end - 1}]] {
1488 set selected_paths($path) 1
1489 }
1490 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1491}
1492
1493######################################################################
1494##
1495## config defaults
1496
1497set cursor_ptr arrow
1498font create font_diff -family Courier -size 10
1499font create font_ui
1500catch {
1501 label .dummy
1502 eval font configure font_ui [font actual [.dummy cget -font]]
1503 destroy .dummy
1504}
1505
1506font create font_uiitalic
1507font create font_uibold
1508font create font_diffbold
1509font create font_diffitalic
1510
1511foreach class {Button Checkbutton Entry Label
1512 Labelframe Listbox Menu Message
1513 Radiobutton Spinbox Text} {
1514 option add *$class.font font_ui
1515}
1516unset class
1517
1518if {[is_Windows] || [is_MacOSX]} {
1519 option add *Menu.tearOff 0
1520}
1521
1522if {[is_MacOSX]} {
1523 set M1B M1
1524 set M1T Cmd
1525} else {
1526 set M1B Control
1527 set M1T Ctrl
1528}
1529
1530proc apply_config {} {
1531 global repo_config font_descs
1532
1533 foreach option $font_descs {
1534 set name [lindex $option 0]
1535 set font [lindex $option 1]
1536 if {[catch {
1537 foreach {cn cv} $repo_config(gui.$name) {
1538 font configure $font $cn $cv
1539 }
1540 } err]} {
1541 error_popup "Invalid font specified in gui.$name:\n\n$err"
1542 }
1543 foreach {cn cv} [font configure $font] {
1544 font configure ${font}bold $cn $cv
1545 font configure ${font}italic $cn $cv
1546 }
1547 font configure ${font}bold -weight bold
1548 font configure ${font}italic -slant italic
1549 }
1550}
1551
1552set default_config(merge.diffstat) true
1553set default_config(merge.summary) false
1554set default_config(merge.verbosity) 2
1555set default_config(user.name) {}
1556set default_config(user.email) {}
1557
1558set default_config(gui.matchtrackingbranch) false
1559set default_config(gui.pruneduringfetch) false
1560set default_config(gui.trustmtime) false
1561set default_config(gui.diffcontext) 5
1562set default_config(gui.newbranchtemplate) {}
1563set default_config(gui.fontui) [font configure font_ui]
1564set default_config(gui.fontdiff) [font configure font_diff]
1565set font_descs {
1566 {fontui font_ui {Main Font}}
1567 {fontdiff font_diff {Diff/Console Font}}
1568}
1569load_config 0
1570apply_config
1571
1572######################################################################
1573##
1574## feature option selection
1575
1576if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
1577 unset _junk
1578} else {
1579 set subcommand gui
1580}
1581if {$subcommand eq {gui.sh}} {
1582 set subcommand gui
1583}
1584if {$subcommand eq {gui} && [llength $argv] > 0} {
1585 set subcommand [lindex $argv 0]
1586 set argv [lrange $argv 1 end]
1587}
1588
1589enable_option multicommit
1590enable_option branch
1591enable_option transport
1592
1593switch -- $subcommand {
1594browser -
1595blame {
1596 disable_option multicommit
1597 disable_option branch
1598 disable_option transport
1599}
1600citool {
1601 enable_option singlecommit
1602
1603 disable_option multicommit
1604 disable_option branch
1605 disable_option transport
1606}
1607}
1608
1609######################################################################
1610##
1611## ui construction
1612
1613set ui_comm {}
1614
1615# -- Menu Bar
1616#
1617menu .mbar -tearoff 0
1618.mbar add cascade -label Repository -menu .mbar.repository
1619.mbar add cascade -label Edit -menu .mbar.edit
1620if {[is_enabled branch]} {
1621 .mbar add cascade -label Branch -menu .mbar.branch
1622}
1623if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1624 .mbar add cascade -label Commit -menu .mbar.commit
1625}
1626if {[is_enabled transport]} {
1627 .mbar add cascade -label Merge -menu .mbar.merge
1628 .mbar add cascade -label Fetch -menu .mbar.fetch
1629 .mbar add cascade -label Push -menu .mbar.push
1630}
1631. configure -menu .mbar
1632
1633# -- Repository Menu
1634#
1635menu .mbar.repository
1636
1637.mbar.repository add command \
1638 -label {Browse Current Branch} \
1639 -command {browser::new $current_branch}
1640trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1641.mbar.repository add separator
1642
1643.mbar.repository add command \
1644 -label {Visualize Current Branch} \
1645 -command {do_gitk $current_branch}
1646trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1647.mbar.repository add command \
1648 -label {Visualize All Branches} \
1649 -command {do_gitk --all}
1650.mbar.repository add separator
1651
1652if {[is_enabled multicommit]} {
1653 .mbar.repository add command -label {Database Statistics} \
1654 -command do_stats
1655
1656 .mbar.repository add command -label {Compress Database} \
1657 -command do_gc
1658
1659 .mbar.repository add command -label {Verify Database} \
1660 -command do_fsck_objects
1661
1662 .mbar.repository add separator
1663
1664 if {[is_Cygwin]} {
1665 .mbar.repository add command \
1666 -label {Create Desktop Icon} \
1667 -command do_cygwin_shortcut
1668 } elseif {[is_Windows]} {
1669 .mbar.repository add command \
1670 -label {Create Desktop Icon} \
1671 -command do_windows_shortcut
1672 } elseif {[is_MacOSX]} {
1673 .mbar.repository add command \
1674 -label {Create Desktop Icon} \
1675 -command do_macosx_app
1676 }
1677}
1678
1679.mbar.repository add command -label Quit \
1680 -command do_quit \
1681 -accelerator $M1T-Q
1682
1683# -- Edit Menu
1684#
1685menu .mbar.edit
1686.mbar.edit add command -label Undo \
1687 -command {catch {[focus] edit undo}} \
1688 -accelerator $M1T-Z
1689.mbar.edit add command -label Redo \
1690 -command {catch {[focus] edit redo}} \
1691 -accelerator $M1T-Y
1692.mbar.edit add separator
1693.mbar.edit add command -label Cut \
1694 -command {catch {tk_textCut [focus]}} \
1695 -accelerator $M1T-X
1696.mbar.edit add command -label Copy \
1697 -command {catch {tk_textCopy [focus]}} \
1698 -accelerator $M1T-C
1699.mbar.edit add command -label Paste \
1700 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1701 -accelerator $M1T-V
1702.mbar.edit add command -label Delete \
1703 -command {catch {[focus] delete sel.first sel.last}} \
1704 -accelerator Del
1705.mbar.edit add separator
1706.mbar.edit add command -label {Select All} \
1707 -command {catch {[focus] tag add sel 0.0 end}} \
1708 -accelerator $M1T-A
1709
1710# -- Branch Menu
1711#
1712if {[is_enabled branch]} {
1713 menu .mbar.branch
1714
1715 .mbar.branch add command -label {Create...} \
1716 -command branch_create::dialog \
1717 -accelerator $M1T-N
1718 lappend disable_on_lock [list .mbar.branch entryconf \
1719 [.mbar.branch index last] -state]
1720
1721 .mbar.branch add command -label {Checkout...} \
1722 -command branch_checkout::dialog \
1723 -accelerator $M1T-O
1724 lappend disable_on_lock [list .mbar.branch entryconf \
1725 [.mbar.branch index last] -state]
1726
1727 .mbar.branch add command -label {Rename...} \
1728 -command branch_rename::dialog
1729 lappend disable_on_lock [list .mbar.branch entryconf \
1730 [.mbar.branch index last] -state]
1731
1732 .mbar.branch add command -label {Delete...} \
1733 -command branch_delete::dialog
1734 lappend disable_on_lock [list .mbar.branch entryconf \
1735 [.mbar.branch index last] -state]
1736
1737 .mbar.branch add command -label {Reset...} \
1738 -command merge::reset_hard
1739 lappend disable_on_lock [list .mbar.branch entryconf \
1740 [.mbar.branch index last] -state]
1741}
1742
1743# -- Commit Menu
1744#
1745if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1746 menu .mbar.commit
1747
1748 .mbar.commit add radiobutton \
1749 -label {New Commit} \
1750 -command do_select_commit_type \
1751 -variable selected_commit_type \
1752 -value new
1753 lappend disable_on_lock \
1754 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1755
1756 .mbar.commit add radiobutton \
1757 -label {Amend Last Commit} \
1758 -command do_select_commit_type \
1759 -variable selected_commit_type \
1760 -value amend
1761 lappend disable_on_lock \
1762 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1763
1764 .mbar.commit add separator
1765
1766 .mbar.commit add command -label Rescan \
1767 -command do_rescan \
1768 -accelerator F5
1769 lappend disable_on_lock \
1770 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1771
1772 .mbar.commit add command -label {Add To Commit} \
1773 -command do_add_selection
1774 lappend disable_on_lock \
1775 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1776
1777 .mbar.commit add command -label {Add Existing To Commit} \
1778 -command do_add_all \
1779 -accelerator $M1T-I
1780 lappend disable_on_lock \
1781 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1782
1783 .mbar.commit add command -label {Unstage From Commit} \
1784 -command do_unstage_selection
1785 lappend disable_on_lock \
1786 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1787
1788 .mbar.commit add command -label {Revert Changes} \
1789 -command do_revert_selection
1790 lappend disable_on_lock \
1791 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1792
1793 .mbar.commit add separator
1794
1795 .mbar.commit add command -label {Sign Off} \
1796 -command do_signoff \
1797 -accelerator $M1T-S
1798
1799 .mbar.commit add command -label Commit \
1800 -command do_commit \
1801 -accelerator $M1T-Return
1802 lappend disable_on_lock \
1803 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1804}
1805
1806# -- Merge Menu
1807#
1808if {[is_enabled branch]} {
1809 menu .mbar.merge
1810 .mbar.merge add command -label {Local Merge...} \
1811 -command merge::dialog
1812 lappend disable_on_lock \
1813 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1814 .mbar.merge add command -label {Abort Merge...} \
1815 -command merge::reset_hard
1816 lappend disable_on_lock \
1817 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1818
1819}
1820
1821# -- Transport Menu
1822#
1823if {[is_enabled transport]} {
1824 menu .mbar.fetch
1825
1826 menu .mbar.push
1827 .mbar.push add command -label {Push...} \
1828 -command do_push_anywhere \
1829 -accelerator $M1T-P
1830 .mbar.push add command -label {Delete...} \
1831 -command remote_branch_delete::dialog
1832}
1833
1834if {[is_MacOSX]} {
1835 # -- Apple Menu (Mac OS X only)
1836 #
1837 .mbar add cascade -label Apple -menu .mbar.apple
1838 menu .mbar.apple
1839
1840 .mbar.apple add command -label "About [appname]" \
1841 -command do_about
1842 .mbar.apple add command -label "Options..." \
1843 -command do_options
1844} else {
1845 # -- Edit Menu
1846 #
1847 .mbar.edit add separator
1848 .mbar.edit add command -label {Options...} \
1849 -command do_options
1850
1851 # -- Tools Menu
1852 #
1853 if {[is_Cygwin] && [file exists /usr/local/miga/lib/gui-miga]} {
1854 proc do_miga {} {
1855 if {![lock_index update]} return
1856 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1857 set miga_fd [open "|$cmd" r]
1858 fconfigure $miga_fd -blocking 0
1859 fileevent $miga_fd readable [list miga_done $miga_fd]
1860 ui_status {Running miga...}
1861 }
1862 proc miga_done {fd} {
1863 read $fd 512
1864 if {[eof $fd]} {
1865 close $fd
1866 unlock_index
1867 rescan ui_ready
1868 }
1869 }
1870 .mbar add cascade -label Tools -menu .mbar.tools
1871 menu .mbar.tools
1872 .mbar.tools add command -label "Migrate" \
1873 -command do_miga
1874 lappend disable_on_lock \
1875 [list .mbar.tools entryconf [.mbar.tools index last] -state]
1876 }
1877}
1878
1879# -- Help Menu
1880#
1881.mbar add cascade -label Help -menu .mbar.help
1882menu .mbar.help
1883
1884if {![is_MacOSX]} {
1885 .mbar.help add command -label "About [appname]" \
1886 -command do_about
1887}
1888
1889set browser {}
1890catch {set browser $repo_config(instaweb.browser)}
1891set doc_path [file dirname [gitexec]]
1892set doc_path [file join $doc_path Documentation index.html]
1893
1894if {[is_Cygwin]} {
1895 set doc_path [exec cygpath --mixed $doc_path]
1896}
1897
1898if {$browser eq {}} {
1899 if {[is_MacOSX]} {
1900 set browser open
1901 } elseif {[is_Cygwin]} {
1902 set program_files [file dirname [exec cygpath --windir]]
1903 set program_files [file join $program_files {Program Files}]
1904 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1905 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1906 if {[file exists $firefox]} {
1907 set browser $firefox
1908 } elseif {[file exists $ie]} {
1909 set browser $ie
1910 }
1911 unset program_files firefox ie
1912 }
1913}
1914
1915if {[file isfile $doc_path]} {
1916 set doc_url "file:$doc_path"
1917} else {
1918 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1919}
1920
1921if {$browser ne {}} {
1922 .mbar.help add command -label {Online Documentation} \
1923 -command [list exec $browser $doc_url &]
1924}
1925unset browser doc_path doc_url
1926
1927# -- Standard bindings
1928#
1929wm protocol . WM_DELETE_WINDOW do_quit
1930bind all <$M1B-Key-q> do_quit
1931bind all <$M1B-Key-Q> do_quit
1932bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1933bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1934
1935set subcommand_args {}
1936proc usage {} {
1937 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1938 exit 1
1939}
1940
1941# -- Not a normal commit type invocation? Do that instead!
1942#
1943switch -- $subcommand {
1944browser {
1945 set subcommand_args {rev?}
1946 switch [llength $argv] {
1947 0 { load_current_branch }
1948 1 {
1949 set current_branch [lindex $argv 0]
1950 if {[regexp {^[0-9a-f]{1,39}$} $current_branch]} {
1951 if {[catch {
1952 set current_branch \
1953 [git rev-parse --verify $current_branch]
1954 } err]} {
1955 puts stderr $err
1956 exit 1
1957 }
1958 }
1959 }
1960 default usage
1961 }
1962 browser::new $current_branch
1963 return
1964}
1965blame {
1966 set subcommand_args {rev? path?}
1967 set head {}
1968 set path {}
1969 set is_path 0
1970 foreach a $argv {
1971 if {$is_path || [file exists $_prefix$a]} {
1972 if {$path ne {}} usage
1973 set path $_prefix$a
1974 break
1975 } elseif {$a eq {--}} {
1976 if {$path ne {}} {
1977 if {$head ne {}} usage
1978 set head $path
1979 set path {}
1980 }
1981 set is_path 1
1982 } elseif {$head eq {}} {
1983 if {$head ne {}} usage
1984 set head $a
1985 } else {
1986 usage
1987 }
1988 }
1989 unset is_path
1990
1991 if {$head eq {}} {
1992 load_current_branch
1993 } else {
1994 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
1995 if {[catch {
1996 set head [git rev-parse --verify $head]
1997 } err]} {
1998 puts stderr $err
1999 exit 1
2000 }
2001 }
2002 set current_branch $head
2003 }
2004
2005 if {$path eq {}} usage
2006 blame::new $head $path
2007 return
2008}
2009citool -
2010gui {
2011 if {[llength $argv] != 0} {
2012 puts -nonewline stderr "usage: $argv0"
2013 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2014 puts -nonewline stderr " $subcommand"
2015 }
2016 puts stderr {}
2017 exit 1
2018 }
2019 # fall through to setup UI for commits
2020}
2021default {
2022 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2023 exit 1
2024}
2025}
2026
2027# -- Branch Control
2028#
2029frame .branch \
2030 -borderwidth 1 \
2031 -relief sunken
2032label .branch.l1 \
2033 -text {Current Branch:} \
2034 -anchor w \
2035 -justify left
2036label .branch.cb \
2037 -textvariable current_branch \
2038 -anchor w \
2039 -justify left
2040pack .branch.l1 -side left
2041pack .branch.cb -side left -fill x
2042pack .branch -side top -fill x
2043
2044# -- Main Window Layout
2045#
2046panedwindow .vpane -orient vertical
2047panedwindow .vpane.files -orient horizontal
2048.vpane add .vpane.files -sticky nsew -height 100 -width 200
2049pack .vpane -anchor n -side top -fill both -expand 1
2050
2051# -- Index File List
2052#
2053frame .vpane.files.index -height 100 -width 200
2054label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2055 -background lightgreen
2056text $ui_index -background white -borderwidth 0 \
2057 -width 20 -height 10 \
2058 -wrap none \
2059 -cursor $cursor_ptr \
2060 -xscrollcommand {.vpane.files.index.sx set} \
2061 -yscrollcommand {.vpane.files.index.sy set} \
2062 -state disabled
2063scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2064scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2065pack .vpane.files.index.title -side top -fill x
2066pack .vpane.files.index.sx -side bottom -fill x
2067pack .vpane.files.index.sy -side right -fill y
2068pack $ui_index -side left -fill both -expand 1
2069.vpane.files add .vpane.files.index -sticky nsew
2070
2071# -- Working Directory File List
2072#
2073frame .vpane.files.workdir -height 100 -width 200
2074label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2075 -background lightsalmon
2076text $ui_workdir -background white -borderwidth 0 \
2077 -width 20 -height 10 \
2078 -wrap none \
2079 -cursor $cursor_ptr \
2080 -xscrollcommand {.vpane.files.workdir.sx set} \
2081 -yscrollcommand {.vpane.files.workdir.sy set} \
2082 -state disabled
2083scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2084scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2085pack .vpane.files.workdir.title -side top -fill x
2086pack .vpane.files.workdir.sx -side bottom -fill x
2087pack .vpane.files.workdir.sy -side right -fill y
2088pack $ui_workdir -side left -fill both -expand 1
2089.vpane.files add .vpane.files.workdir -sticky nsew
2090
2091foreach i [list $ui_index $ui_workdir] {
2092 $i tag conf in_diff -background lightgray
2093 $i tag conf in_sel -background lightgray
2094}
2095unset i
2096
2097# -- Diff and Commit Area
2098#
2099frame .vpane.lower -height 300 -width 400
2100frame .vpane.lower.commarea
2101frame .vpane.lower.diff -relief sunken -borderwidth 1
2102pack .vpane.lower.commarea -side top -fill x
2103pack .vpane.lower.diff -side bottom -fill both -expand 1
2104.vpane add .vpane.lower -sticky nsew
2105
2106# -- Commit Area Buttons
2107#
2108frame .vpane.lower.commarea.buttons
2109label .vpane.lower.commarea.buttons.l -text {} \
2110 -anchor w \
2111 -justify left
2112pack .vpane.lower.commarea.buttons.l -side top -fill x
2113pack .vpane.lower.commarea.buttons -side left -fill y
2114
2115button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2116 -command do_rescan
2117pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2118lappend disable_on_lock \
2119 {.vpane.lower.commarea.buttons.rescan conf -state}
2120
2121button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
2122 -command do_add_all
2123pack .vpane.lower.commarea.buttons.incall -side top -fill x
2124lappend disable_on_lock \
2125 {.vpane.lower.commarea.buttons.incall conf -state}
2126
2127button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2128 -command do_signoff
2129pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2130
2131button .vpane.lower.commarea.buttons.commit -text {Commit} \
2132 -command do_commit
2133pack .vpane.lower.commarea.buttons.commit -side top -fill x
2134lappend disable_on_lock \
2135 {.vpane.lower.commarea.buttons.commit conf -state}
2136
2137button .vpane.lower.commarea.buttons.push -text {Push} \
2138 -command do_push_anywhere
2139pack .vpane.lower.commarea.buttons.push -side top -fill x
2140
2141# -- Commit Message Buffer
2142#
2143frame .vpane.lower.commarea.buffer
2144frame .vpane.lower.commarea.buffer.header
2145set ui_comm .vpane.lower.commarea.buffer.t
2146set ui_coml .vpane.lower.commarea.buffer.header.l
2147radiobutton .vpane.lower.commarea.buffer.header.new \
2148 -text {New Commit} \
2149 -command do_select_commit_type \
2150 -variable selected_commit_type \
2151 -value new
2152lappend disable_on_lock \
2153 [list .vpane.lower.commarea.buffer.header.new conf -state]
2154radiobutton .vpane.lower.commarea.buffer.header.amend \
2155 -text {Amend Last Commit} \
2156 -command do_select_commit_type \
2157 -variable selected_commit_type \
2158 -value amend
2159lappend disable_on_lock \
2160 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2161label $ui_coml \
2162 -anchor w \
2163 -justify left
2164proc trace_commit_type {varname args} {
2165 global ui_coml commit_type
2166 switch -glob -- $commit_type {
2167 initial {set txt {Initial Commit Message:}}
2168 amend {set txt {Amended Commit Message:}}
2169 amend-initial {set txt {Amended Initial Commit Message:}}
2170 amend-merge {set txt {Amended Merge Commit Message:}}
2171 merge {set txt {Merge Commit Message:}}
2172 * {set txt {Commit Message:}}
2173 }
2174 $ui_coml conf -text $txt
2175}
2176trace add variable commit_type write trace_commit_type
2177pack $ui_coml -side left -fill x
2178pack .vpane.lower.commarea.buffer.header.amend -side right
2179pack .vpane.lower.commarea.buffer.header.new -side right
2180
2181text $ui_comm -background white -borderwidth 1 \
2182 -undo true \
2183 -maxundo 20 \
2184 -autoseparators true \
2185 -relief sunken \
2186 -width 75 -height 9 -wrap none \
2187 -font font_diff \
2188 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2189scrollbar .vpane.lower.commarea.buffer.sby \
2190 -command [list $ui_comm yview]
2191pack .vpane.lower.commarea.buffer.header -side top -fill x
2192pack .vpane.lower.commarea.buffer.sby -side right -fill y
2193pack $ui_comm -side left -fill y
2194pack .vpane.lower.commarea.buffer -side left -fill y
2195
2196# -- Commit Message Buffer Context Menu
2197#
2198set ctxm .vpane.lower.commarea.buffer.ctxm
2199menu $ctxm -tearoff 0
2200$ctxm add command \
2201 -label {Cut} \
2202 -command {tk_textCut $ui_comm}
2203$ctxm add command \
2204 -label {Copy} \
2205 -command {tk_textCopy $ui_comm}
2206$ctxm add command \
2207 -label {Paste} \
2208 -command {tk_textPaste $ui_comm}
2209$ctxm add command \
2210 -label {Delete} \
2211 -command {$ui_comm delete sel.first sel.last}
2212$ctxm add separator
2213$ctxm add command \
2214 -label {Select All} \
2215 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2216$ctxm add command \
2217 -label {Copy All} \
2218 -command {
2219 $ui_comm tag add sel 0.0 end
2220 tk_textCopy $ui_comm
2221 $ui_comm tag remove sel 0.0 end
2222 }
2223$ctxm add separator
2224$ctxm add command \
2225 -label {Sign Off} \
2226 -command do_signoff
2227bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2228
2229# -- Diff Header
2230#
2231proc trace_current_diff_path {varname args} {
2232 global current_diff_path diff_actions file_states
2233 if {$current_diff_path eq {}} {
2234 set s {}
2235 set f {}
2236 set p {}
2237 set o disabled
2238 } else {
2239 set p $current_diff_path
2240 set s [mapdesc [lindex $file_states($p) 0] $p]
2241 set f {File:}
2242 set p [escape_path $p]
2243 set o normal
2244 }
2245
2246 .vpane.lower.diff.header.status configure -text $s
2247 .vpane.lower.diff.header.file configure -text $f
2248 .vpane.lower.diff.header.path configure -text $p
2249 foreach w $diff_actions {
2250 uplevel #0 $w $o
2251 }
2252}
2253trace add variable current_diff_path write trace_current_diff_path
2254
2255frame .vpane.lower.diff.header -background gold
2256label .vpane.lower.diff.header.status \
2257 -background gold \
2258 -width $max_status_desc \
2259 -anchor w \
2260 -justify left
2261label .vpane.lower.diff.header.file \
2262 -background gold \
2263 -anchor w \
2264 -justify left
2265label .vpane.lower.diff.header.path \
2266 -background gold \
2267 -anchor w \
2268 -justify left
2269pack .vpane.lower.diff.header.status -side left
2270pack .vpane.lower.diff.header.file -side left
2271pack .vpane.lower.diff.header.path -fill x
2272set ctxm .vpane.lower.diff.header.ctxm
2273menu $ctxm -tearoff 0
2274$ctxm add command \
2275 -label {Copy} \
2276 -command {
2277 clipboard clear
2278 clipboard append \
2279 -format STRING \
2280 -type STRING \
2281 -- $current_diff_path
2282 }
2283lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2284bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2285
2286# -- Diff Body
2287#
2288frame .vpane.lower.diff.body
2289set ui_diff .vpane.lower.diff.body.t
2290text $ui_diff -background white -borderwidth 0 \
2291 -width 80 -height 15 -wrap none \
2292 -font font_diff \
2293 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2294 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2295 -state disabled
2296scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2297 -command [list $ui_diff xview]
2298scrollbar .vpane.lower.diff.body.sby -orient vertical \
2299 -command [list $ui_diff yview]
2300pack .vpane.lower.diff.body.sbx -side bottom -fill x
2301pack .vpane.lower.diff.body.sby -side right -fill y
2302pack $ui_diff -side left -fill both -expand 1
2303pack .vpane.lower.diff.header -side top -fill x
2304pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2305
2306$ui_diff tag conf d_cr -elide true
2307$ui_diff tag conf d_@ -foreground blue -font font_diffbold
2308$ui_diff tag conf d_+ -foreground {#00a000}
2309$ui_diff tag conf d_- -foreground red
2310
2311$ui_diff tag conf d_++ -foreground {#00a000}
2312$ui_diff tag conf d_-- -foreground red
2313$ui_diff tag conf d_+s \
2314 -foreground {#00a000} \
2315 -background {#e2effa}
2316$ui_diff tag conf d_-s \
2317 -foreground red \
2318 -background {#e2effa}
2319$ui_diff tag conf d_s+ \
2320 -foreground {#00a000} \
2321 -background ivory1
2322$ui_diff tag conf d_s- \
2323 -foreground red \
2324 -background ivory1
2325
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
2332$ui_diff tag conf d>>>>>>> \
2333 -foreground orange \
2334 -font font_diffbold
2335
2336$ui_diff tag raise sel
2337
2338# -- Diff Body Context Menu
2339#
2340set ctxm .vpane.lower.diff.body.ctxm
2341menu $ctxm -tearoff 0
2342$ctxm add command \
2343 -label {Refresh} \
2344 -command reshow_diff
2345lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2346$ctxm add command \
2347 -label {Copy} \
2348 -command {tk_textCopy $ui_diff}
2349lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2350$ctxm add command \
2351 -label {Select All} \
2352 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2353lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2354$ctxm add command \
2355 -label {Copy All} \
2356 -command {
2357 $ui_diff tag add sel 0.0 end
2358 tk_textCopy $ui_diff
2359 $ui_diff tag remove sel 0.0 end
2360 }
2361lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2362$ctxm add separator
2363$ctxm add command \
2364 -label {Apply/Reverse Hunk} \
2365 -command {apply_hunk $cursorX $cursorY}
2366set ui_diff_applyhunk [$ctxm index last]
2367lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2368$ctxm add separator
2369$ctxm add command \
2370 -label {Decrease Font Size} \
2371 -command {incr_font_size font_diff -1}
2372lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2373$ctxm add command \
2374 -label {Increase Font Size} \
2375 -command {incr_font_size font_diff 1}
2376lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2377$ctxm add separator
2378$ctxm add command \
2379 -label {Show Less Context} \
2380 -command {if {$repo_config(gui.diffcontext) >= 1} {
2381 incr repo_config(gui.diffcontext) -1
2382 reshow_diff
2383 }}
2384lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2385$ctxm add command \
2386 -label {Show More Context} \
2387 -command {if {$repo_config(gui.diffcontext) < 99} {
2388 incr repo_config(gui.diffcontext)
2389 reshow_diff
2390 }}
2391lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2392$ctxm add separator
2393$ctxm add command -label {Options...} \
2394 -command do_options
2395bind_button3 $ui_diff "
2396 set cursorX %x
2397 set cursorY %y
2398 if {\$ui_index eq \$current_diff_side} {
2399 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2400 } else {
2401 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2402 }
2403 tk_popup $ctxm %X %Y
2404"
2405unset ui_diff_applyhunk
2406
2407# -- Status Bar
2408#
2409set main_status [::status_bar::new .status]
2410pack .status -anchor w -side bottom -fill x
2411$main_status show {Initializing...}
2412
2413# -- Load geometry
2414#
2415catch {
2416set gm $repo_config(gui.geometry)
2417wm geometry . [lindex $gm 0]
2418.vpane sash place 0 \
2419 [lindex [.vpane sash coord 0] 0] \
2420 [lindex $gm 1]
2421.vpane.files sash place 0 \
2422 [lindex $gm 2] \
2423 [lindex [.vpane.files sash coord 0] 1]
2424unset gm
2425}
2426
2427# -- Key Bindings
2428#
2429bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2430bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2431bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2432bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2433bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2434bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2435bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2436bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2437bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2438bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2439bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2440
2441bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2442bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2443bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2444bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2445bind $ui_diff <$M1B-Key-v> {break}
2446bind $ui_diff <$M1B-Key-V> {break}
2447bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2448bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2449bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2450bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2451bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2452bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2453bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2454bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2455bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2456bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2457bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2458bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2459bind $ui_diff <Button-1> {focus %W}
2460
2461if {[is_enabled branch]} {
2462 bind . <$M1B-Key-n> branch_create::dialog
2463 bind . <$M1B-Key-N> branch_create::dialog
2464 bind . <$M1B-Key-o> branch_checkout::dialog
2465 bind . <$M1B-Key-O> branch_checkout::dialog
2466}
2467if {[is_enabled transport]} {
2468 bind . <$M1B-Key-p> do_push_anywhere
2469 bind . <$M1B-Key-P> do_push_anywhere
2470}
2471
2472bind . <Key-F5> do_rescan
2473bind . <$M1B-Key-r> do_rescan
2474bind . <$M1B-Key-R> do_rescan
2475bind . <$M1B-Key-s> do_signoff
2476bind . <$M1B-Key-S> do_signoff
2477bind . <$M1B-Key-i> do_add_all
2478bind . <$M1B-Key-I> do_add_all
2479bind . <$M1B-Key-Return> do_commit
2480foreach i [list $ui_index $ui_workdir] {
2481 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2482 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2483 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2484}
2485unset i
2486
2487set file_lists($ui_index) [list]
2488set file_lists($ui_workdir) [list]
2489
2490wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2491focus -force $ui_comm
2492
2493# -- Warn the user about environmental problems. Cygwin's Tcl
2494# does *not* pass its env array onto any processes it spawns.
2495# This means that git processes get none of our environment.
2496#
2497if {[is_Cygwin]} {
2498 set ignored_env 0
2499 set suggest_user {}
2500 set msg "Possible environment issues exist.
2501
2502The following environment variables are probably
2503going to be ignored by any Git subprocess run
2504by [appname]:
2505
2506"
2507 foreach name [array names env] {
2508 switch -regexp -- $name {
2509 {^GIT_INDEX_FILE$} -
2510 {^GIT_OBJECT_DIRECTORY$} -
2511 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2512 {^GIT_DIFF_OPTS$} -
2513 {^GIT_EXTERNAL_DIFF$} -
2514 {^GIT_PAGER$} -
2515 {^GIT_TRACE$} -
2516 {^GIT_CONFIG$} -
2517 {^GIT_CONFIG_LOCAL$} -
2518 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2519 append msg " - $name\n"
2520 incr ignored_env
2521 }
2522 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2523 append msg " - $name\n"
2524 incr ignored_env
2525 set suggest_user $name
2526 }
2527 }
2528 }
2529 if {$ignored_env > 0} {
2530 append msg "
2531This is due to a known issue with the
2532Tcl binary distributed by Cygwin."
2533
2534 if {$suggest_user ne {}} {
2535 append msg "
2536
2537A good replacement for $suggest_user
2538is placing values for the user.name and
2539user.email settings into your personal
2540~/.gitconfig file.
2541"
2542 }
2543 warn_popup $msg
2544 }
2545 unset ignored_env msg suggest_user name
2546}
2547
2548# -- Only initialize complex UI if we are going to stay running.
2549#
2550if {[is_enabled transport]} {
2551 load_all_remotes
2552
2553 populate_fetch_menu
2554 populate_push_menu
2555}
2556
2557# -- Only suggest a gc run if we are going to stay running.
2558#
2559if {[is_enabled multicommit]} {
2560 set object_limit 2000
2561 if {[is_Windows]} {set object_limit 200}
2562 regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
2563 if {$objects_current >= $object_limit} {
2564 if {[ask_popup \
2565 "This repository currently has $objects_current loose objects.
2566
2567To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2568
2569Compress the database now?"] eq yes} {
2570 do_gc
2571 }
2572 }
2573 unset object_limit _junk objects_current
2574}
2575
2576lock_index begin-read
2577after 1 do_rescan