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