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