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