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