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