3c0ce2602987c5ca04acbde27a021a0009917d6b
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 argv0=$0; \
10 exec wish "$argv0" -- "$@"
11
12set appvers {@@GITGUI_VERSION@@}
13set copyright [encoding convertfrom utf-8 {
14Copyright © 2006, 2007 Shawn Pearce, et. al.
15
16This program is free software; you can redistribute it and/or modify
17it under the terms of the GNU General Public License as published by
18the Free Software Foundation; either version 2 of the License, or
19(at your option) any later version.
20
21This program is distributed in the hope that it will be useful,
22but WITHOUT ANY WARRANTY; without even the implied warranty of
23MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24GNU General Public License for more details.
25
26You should have received a copy of the GNU General Public License
27along with this program; if not, write to the Free Software
28Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}]
29
30######################################################################
31##
32## Tcl/Tk sanity check
33
34if {[catch {package require Tcl 8.4} err]
35 || [catch {package require Tk 8.4} err]
36} {
37 catch {wm withdraw .}
38 tk_messageBox \
39 -icon error \
40 -type ok \
41 -title [mc "git-gui: fatal error"] \
42 -message $err
43 exit 1
44}
45
46catch {rename send {}} ; # What an evil concept...
47
48######################################################################
49##
50## locate our library
51
52set oguilib {@@GITGUI_LIBDIR@@}
53set oguirel {@@GITGUI_RELATIVE@@}
54if {$oguirel eq {1}} {
55 set oguilib [file dirname [file normalize $argv0]]
56 if {[file tail $oguilib] eq {git-core}} {
57 set oguilib [file dirname $oguilib]
58 }
59 set oguilib [file dirname $oguilib]
60 set oguilib [file join $oguilib share git-gui lib]
61 set oguimsg [file join $oguilib msgs]
62} elseif {[string match @@* $oguirel]} {
63 set oguilib [file join [file dirname [file normalize $argv0]] lib]
64 set oguimsg [file join [file dirname [file normalize $argv0]] po]
65} else {
66 set oguimsg [file join $oguilib msgs]
67}
68unset oguirel
69
70######################################################################
71##
72## enable verbose loading?
73
74if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
75 unset _verbose
76 rename auto_load real__auto_load
77 proc auto_load {name args} {
78 puts stderr "auto_load $name"
79 return [uplevel 1 real__auto_load $name $args]
80 }
81 rename source real__source
82 proc source {name} {
83 puts stderr "source $name"
84 uplevel 1 real__source $name
85 }
86}
87
88######################################################################
89##
90## Internationalization (i18n) through msgcat and gettext. See
91## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
92
93package require msgcat
94
95proc _mc_trim {fmt} {
96 set cmk [string first @@ $fmt]
97 if {$cmk > 0} {
98 return [string range $fmt 0 [expr {$cmk - 1}]]
99 }
100 return $fmt
101}
102
103proc mc {en_fmt args} {
104 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
105 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
106 set msg [eval [list format [_mc_trim $en_fmt]] $args]
107 }
108 return $msg
109}
110
111proc strcat {args} {
112 return [join $args {}]
113}
114
115::msgcat::mcload $oguimsg
116unset oguimsg
117
118######################################################################
119##
120## read only globals
121
122set _appname {Git Gui}
123set _gitdir {}
124set _gitexec {}
125set _githtmldir {}
126set _reponame {}
127set _iscygwin {}
128set _search_path {}
129
130set _trace [lsearch -exact $argv --trace]
131if {$_trace >= 0} {
132 set argv [lreplace $argv $_trace $_trace]
133 set _trace 1
134} else {
135 set _trace 0
136}
137
138proc appname {} {
139 global _appname
140 return $_appname
141}
142
143proc gitdir {args} {
144 global _gitdir
145 if {$args eq {}} {
146 return $_gitdir
147 }
148 return [eval [list file join $_gitdir] $args]
149}
150
151proc gitexec {args} {
152 global _gitexec
153 if {$_gitexec eq {}} {
154 if {[catch {set _gitexec [git --exec-path]} err]} {
155 error "Git not installed?\n\n$err"
156 }
157 if {[is_Cygwin]} {
158 set _gitexec [exec cygpath \
159 --windows \
160 --absolute \
161 $_gitexec]
162 } else {
163 set _gitexec [file normalize $_gitexec]
164 }
165 }
166 if {$args eq {}} {
167 return $_gitexec
168 }
169 return [eval [list file join $_gitexec] $args]
170}
171
172proc githtmldir {args} {
173 global _githtmldir
174 if {$_githtmldir eq {}} {
175 if {[catch {set _githtmldir [git --html-path]}]} {
176 # Git not installed or option not yet supported
177 return {}
178 }
179 if {[is_Cygwin]} {
180 set _githtmldir [exec cygpath \
181 --windows \
182 --absolute \
183 $_githtmldir]
184 } else {
185 set _githtmldir [file normalize $_githtmldir]
186 }
187 }
188 if {$args eq {}} {
189 return $_githtmldir
190 }
191 return [eval [list file join $_githtmldir] $args]
192}
193
194proc reponame {} {
195 return $::_reponame
196}
197
198proc is_MacOSX {} {
199 if {[tk windowingsystem] eq {aqua}} {
200 return 1
201 }
202 return 0
203}
204
205proc is_Windows {} {
206 if {$::tcl_platform(platform) eq {windows}} {
207 return 1
208 }
209 return 0
210}
211
212proc is_Cygwin {} {
213 global _iscygwin
214 if {$_iscygwin eq {}} {
215 if {$::tcl_platform(platform) eq {windows}} {
216 if {[catch {set p [exec cygpath --windir]} err]} {
217 set _iscygwin 0
218 } else {
219 set _iscygwin 1
220 }
221 } else {
222 set _iscygwin 0
223 }
224 }
225 return $_iscygwin
226}
227
228proc is_enabled {option} {
229 global enabled_options
230 if {[catch {set on $enabled_options($option)}]} {return 0}
231 return $on
232}
233
234proc enable_option {option} {
235 global enabled_options
236 set enabled_options($option) 1
237}
238
239proc disable_option {option} {
240 global enabled_options
241 set enabled_options($option) 0
242}
243
244######################################################################
245##
246## config
247
248proc is_many_config {name} {
249 switch -glob -- $name {
250 gui.recentrepo -
251 remote.*.fetch -
252 remote.*.push
253 {return 1}
254 *
255 {return 0}
256 }
257}
258
259proc is_config_true {name} {
260 global repo_config
261 if {[catch {set v $repo_config($name)}]} {
262 return 0
263 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
264 return 1
265 } else {
266 return 0
267 }
268}
269
270proc get_config {name} {
271 global repo_config
272 if {[catch {set v $repo_config($name)}]} {
273 return {}
274 } else {
275 return $v
276 }
277}
278
279######################################################################
280##
281## handy utils
282
283proc _trace_exec {cmd} {
284 if {!$::_trace} return
285 set d {}
286 foreach v $cmd {
287 if {$d ne {}} {
288 append d { }
289 }
290 if {[regexp {[ \t\r\n'"$?*]} $v]} {
291 set v [sq $v]
292 }
293 append d $v
294 }
295 puts stderr $d
296}
297
298proc _git_cmd {name} {
299 global _git_cmd_path
300
301 if {[catch {set v $_git_cmd_path($name)}]} {
302 switch -- $name {
303 version -
304 --version -
305 --exec-path { return [list $::_git $name] }
306 }
307
308 set p [gitexec git-$name$::_search_exe]
309 if {[file exists $p]} {
310 set v [list $p]
311 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
312 # Try to determine what sort of magic will make
313 # git-$name go and do its thing, because native
314 # Tcl on Windows doesn't know it.
315 #
316 set p [gitexec git-$name]
317 set f [open $p r]
318 set s [gets $f]
319 close $f
320
321 switch -glob -- [lindex $s 0] {
322 #!*sh { set i sh }
323 #!*perl { set i perl }
324 #!*python { set i python }
325 default { error "git-$name is not supported: $s" }
326 }
327
328 upvar #0 _$i interp
329 if {![info exists interp]} {
330 set interp [_which $i]
331 }
332 if {$interp eq {}} {
333 error "git-$name requires $i (not in PATH)"
334 }
335 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
336 } else {
337 # Assume it is builtin to git somehow and we
338 # aren't actually able to see a file for it.
339 #
340 set v [list $::_git $name]
341 }
342 set _git_cmd_path($name) $v
343 }
344 return $v
345}
346
347proc _which {what args} {
348 global env _search_exe _search_path
349
350 if {$_search_path eq {}} {
351 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
352 set _search_path [split [exec cygpath \
353 --windows \
354 --path \
355 --absolute \
356 $env(PATH)] {;}]
357 set _search_exe .exe
358 } elseif {[is_Windows]} {
359 set gitguidir [file dirname [info script]]
360 regsub -all ";" $gitguidir "\\;" gitguidir
361 set env(PATH) "$gitguidir;$env(PATH)"
362 set _search_path [split $env(PATH) {;}]
363 set _search_exe .exe
364 } else {
365 set _search_path [split $env(PATH) :]
366 set _search_exe {}
367 }
368 }
369
370 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
371 set suffix {}
372 } else {
373 set suffix $_search_exe
374 }
375
376 foreach p $_search_path {
377 set p [file join $p $what$suffix]
378 if {[file exists $p]} {
379 return [file normalize $p]
380 }
381 }
382 return {}
383}
384
385proc _lappend_nice {cmd_var} {
386 global _nice
387 upvar $cmd_var cmd
388
389 if {![info exists _nice]} {
390 set _nice [_which nice]
391 }
392 if {$_nice ne {}} {
393 lappend cmd $_nice
394 }
395}
396
397proc git {args} {
398 set opt [list]
399
400 while {1} {
401 switch -- [lindex $args 0] {
402 --nice {
403 _lappend_nice opt
404 }
405
406 default {
407 break
408 }
409
410 }
411
412 set args [lrange $args 1 end]
413 }
414
415 set cmdp [_git_cmd [lindex $args 0]]
416 set args [lrange $args 1 end]
417
418 _trace_exec [concat $opt $cmdp $args]
419 set result [eval exec $opt $cmdp $args]
420 if {$::_trace} {
421 puts stderr "< $result"
422 }
423 return $result
424}
425
426proc _open_stdout_stderr {cmd} {
427 _trace_exec $cmd
428 if {[catch {
429 set fd [open [concat [list | ] $cmd] r]
430 } err]} {
431 if { [lindex $cmd end] eq {2>@1}
432 && $err eq {can not find channel named "1"}
433 } {
434 # Older versions of Tcl 8.4 don't have this 2>@1 IO
435 # redirect operator. Fallback to |& cat for those.
436 # The command was not actually started, so its safe
437 # to try to start it a second time.
438 #
439 set fd [open [concat \
440 [list | ] \
441 [lrange $cmd 0 end-1] \
442 [list |& cat] \
443 ] r]
444 } else {
445 error $err
446 }
447 }
448 fconfigure $fd -eofchar {}
449 return $fd
450}
451
452proc git_read {args} {
453 set opt [list]
454
455 while {1} {
456 switch -- [lindex $args 0] {
457 --nice {
458 _lappend_nice opt
459 }
460
461 --stderr {
462 lappend args 2>@1
463 }
464
465 default {
466 break
467 }
468
469 }
470
471 set args [lrange $args 1 end]
472 }
473
474 set cmdp [_git_cmd [lindex $args 0]]
475 set args [lrange $args 1 end]
476
477 return [_open_stdout_stderr [concat $opt $cmdp $args]]
478}
479
480proc git_write {args} {
481 set opt [list]
482
483 while {1} {
484 switch -- [lindex $args 0] {
485 --nice {
486 _lappend_nice opt
487 }
488
489 default {
490 break
491 }
492
493 }
494
495 set args [lrange $args 1 end]
496 }
497
498 set cmdp [_git_cmd [lindex $args 0]]
499 set args [lrange $args 1 end]
500
501 _trace_exec [concat $opt $cmdp $args]
502 return [open [concat [list | ] $opt $cmdp $args] w]
503}
504
505proc githook_read {hook_name args} {
506 set pchook [gitdir hooks $hook_name]
507 lappend args 2>@1
508
509 # On Windows [file executable] might lie so we need to ask
510 # the shell if the hook is executable. Yes that's annoying.
511 #
512 if {[is_Windows]} {
513 upvar #0 _sh interp
514 if {![info exists interp]} {
515 set interp [_which sh]
516 }
517 if {$interp eq {}} {
518 error "hook execution requires sh (not in PATH)"
519 }
520
521 set scr {if test -x "$1";then exec "$@";fi}
522 set sh_c [list $interp -c $scr $interp $pchook]
523 return [_open_stdout_stderr [concat $sh_c $args]]
524 }
525
526 if {[file executable $pchook]} {
527 return [_open_stdout_stderr [concat [list $pchook] $args]]
528 }
529
530 return {}
531}
532
533proc kill_file_process {fd} {
534 set process [pid $fd]
535
536 catch {
537 if {[is_Windows]} {
538 # Use a Cygwin-specific flag to allow killing
539 # native Windows processes
540 exec kill -f $process
541 } else {
542 exec kill $process
543 }
544 }
545}
546
547proc gitattr {path attr default} {
548 if {[catch {set r [git check-attr $attr -- $path]}]} {
549 set r unspecified
550 } else {
551 set r [join [lrange [split $r :] 2 end] :]
552 regsub {^ } $r {} r
553 }
554 if {$r eq {unspecified}} {
555 return $default
556 }
557 return $r
558}
559
560proc sq {value} {
561 regsub -all ' $value "'\\''" value
562 return "'$value'"
563}
564
565proc load_current_branch {} {
566 global current_branch is_detached
567
568 set fd [open [gitdir HEAD] r]
569 if {[gets $fd ref] < 1} {
570 set ref {}
571 }
572 close $fd
573
574 set pfx {ref: refs/heads/}
575 set len [string length $pfx]
576 if {[string equal -length $len $pfx $ref]} {
577 # We're on a branch. It might not exist. But
578 # HEAD looks good enough to be a branch.
579 #
580 set current_branch [string range $ref $len end]
581 set is_detached 0
582 } else {
583 # Assume this is a detached head.
584 #
585 set current_branch HEAD
586 set is_detached 1
587 }
588}
589
590auto_load tk_optionMenu
591rename tk_optionMenu real__tkOptionMenu
592proc tk_optionMenu {w varName args} {
593 set m [eval real__tkOptionMenu $w $varName $args]
594 $m configure -font font_ui
595 $w configure -font font_ui
596 return $m
597}
598
599proc rmsel_tag {text} {
600 $text tag conf sel \
601 -background [$text cget -background] \
602 -foreground [$text cget -foreground] \
603 -borderwidth 0
604 $text tag conf in_sel -background lightgray
605 bind $text <Motion> break
606 return $text
607}
608
609set root_exists 0
610bind . <Visibility> {
611 bind . <Visibility> {}
612 set root_exists 1
613}
614
615if {[is_Windows]} {
616 wm iconbitmap . -default $oguilib/git-gui.ico
617 set ::tk::AlwaysShowSelection 1
618
619 # Spoof an X11 display for SSH
620 if {![info exists env(DISPLAY)]} {
621 set env(DISPLAY) :9999
622 }
623} else {
624 catch {
625 image create photo gitlogo -width 16 -height 16
626
627 gitlogo put #33CC33 -to 7 0 9 2
628 gitlogo put #33CC33 -to 4 2 12 4
629 gitlogo put #33CC33 -to 7 4 9 6
630 gitlogo put #CC3333 -to 4 6 12 8
631 gitlogo put gray26 -to 4 9 6 10
632 gitlogo put gray26 -to 3 10 6 12
633 gitlogo put gray26 -to 8 9 13 11
634 gitlogo put gray26 -to 8 11 10 12
635 gitlogo put gray26 -to 11 11 13 14
636 gitlogo put gray26 -to 3 12 5 14
637 gitlogo put gray26 -to 5 13
638 gitlogo put gray26 -to 10 13
639 gitlogo put gray26 -to 4 14 12 15
640 gitlogo put gray26 -to 5 15 11 16
641 gitlogo redither
642
643 wm iconphoto . -default gitlogo
644 }
645}
646
647######################################################################
648##
649## config defaults
650
651set cursor_ptr arrow
652font create font_diff -family Courier -size 10
653font create font_ui
654catch {
655 label .dummy
656 eval font configure font_ui [font actual [.dummy cget -font]]
657 destroy .dummy
658}
659
660font create font_uiitalic
661font create font_uibold
662font create font_diffbold
663font create font_diffitalic
664
665foreach class {Button Checkbutton Entry Label
666 Labelframe Listbox Message
667 Radiobutton Spinbox Text} {
668 option add *$class.font font_ui
669}
670if {![is_MacOSX]} {
671 option add *Menu.font font_ui
672}
673unset class
674
675if {[is_Windows] || [is_MacOSX]} {
676 option add *Menu.tearOff 0
677}
678
679if {[is_MacOSX]} {
680 set M1B M1
681 set M1T Cmd
682} else {
683 set M1B Control
684 set M1T Ctrl
685}
686
687proc bind_button3 {w cmd} {
688 bind $w <Any-Button-3> $cmd
689 if {[is_MacOSX]} {
690 # Mac OS X sends Button-2 on right click through three-button mouse,
691 # or through trackpad right-clicking (two-finger touch + click).
692 bind $w <Any-Button-2> $cmd
693 bind $w <Control-Button-1> $cmd
694 }
695}
696
697proc apply_config {} {
698 global repo_config font_descs
699
700 foreach option $font_descs {
701 set name [lindex $option 0]
702 set font [lindex $option 1]
703 if {[catch {
704 set need_weight 1
705 foreach {cn cv} $repo_config(gui.$name) {
706 if {$cn eq {-weight}} {
707 set need_weight 0
708 }
709 font configure $font $cn $cv
710 }
711 if {$need_weight} {
712 font configure $font -weight normal
713 }
714 } err]} {
715 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
716 }
717 foreach {cn cv} [font configure $font] {
718 font configure ${font}bold $cn $cv
719 font configure ${font}italic $cn $cv
720 }
721 font configure ${font}bold -weight bold
722 font configure ${font}italic -slant italic
723 }
724}
725
726set default_config(branch.autosetupmerge) true
727set default_config(merge.tool) {}
728set default_config(mergetool.keepbackup) true
729set default_config(merge.diffstat) true
730set default_config(merge.summary) false
731set default_config(merge.verbosity) 2
732set default_config(user.name) {}
733set default_config(user.email) {}
734
735set default_config(gui.encoding) [encoding system]
736set default_config(gui.matchtrackingbranch) false
737set default_config(gui.pruneduringfetch) false
738set default_config(gui.trustmtime) false
739set default_config(gui.fastcopyblame) false
740set default_config(gui.copyblamethreshold) 40
741set default_config(gui.blamehistoryctx) 7
742set default_config(gui.diffcontext) 5
743set default_config(gui.commitmsgwidth) 75
744set default_config(gui.newbranchtemplate) {}
745set default_config(gui.spellingdictionary) {}
746set default_config(gui.fontui) [font configure font_ui]
747set default_config(gui.fontdiff) [font configure font_diff]
748set font_descs {
749 {fontui font_ui {mc "Main Font"}}
750 {fontdiff font_diff {mc "Diff/Console Font"}}
751}
752
753######################################################################
754##
755## find git
756
757set _git [_which git]
758if {$_git eq {}} {
759 catch {wm withdraw .}
760 tk_messageBox \
761 -icon error \
762 -type ok \
763 -title [mc "git-gui: fatal error"] \
764 -message [mc "Cannot find git in PATH."]
765 exit 1
766}
767
768######################################################################
769##
770## version check
771
772if {[catch {set _git_version [git --version]} err]} {
773 catch {wm withdraw .}
774 tk_messageBox \
775 -icon error \
776 -type ok \
777 -title [mc "git-gui: fatal error"] \
778 -message "Cannot determine Git version:
779
780$err
781
782[appname] requires Git 1.5.0 or later."
783 exit 1
784}
785if {![regsub {^git version } $_git_version {} _git_version]} {
786 catch {wm withdraw .}
787 tk_messageBox \
788 -icon error \
789 -type ok \
790 -title [mc "git-gui: fatal error"] \
791 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
792 exit 1
793}
794
795set _real_git_version $_git_version
796regsub -- {[\-\.]dirty$} $_git_version {} _git_version
797regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
798regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
799regsub {\.GIT$} $_git_version {} _git_version
800regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
801
802if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
803 catch {wm withdraw .}
804 if {[tk_messageBox \
805 -icon warning \
806 -type yesno \
807 -default no \
808 -title "[appname]: warning" \
809 -message [mc "Git version cannot be determined.
810
811%s claims it is version '%s'.
812
813%s requires at least Git 1.5.0 or later.
814
815Assume '%s' is version 1.5.0?
816" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
817 set _git_version 1.5.0
818 } else {
819 exit 1
820 }
821}
822unset _real_git_version
823
824proc git-version {args} {
825 global _git_version
826
827 switch [llength $args] {
828 0 {
829 return $_git_version
830 }
831
832 2 {
833 set op [lindex $args 0]
834 set vr [lindex $args 1]
835 set cm [package vcompare $_git_version $vr]
836 return [expr $cm $op 0]
837 }
838
839 4 {
840 set type [lindex $args 0]
841 set name [lindex $args 1]
842 set parm [lindex $args 2]
843 set body [lindex $args 3]
844
845 if {($type ne {proc} && $type ne {method})} {
846 error "Invalid arguments to git-version"
847 }
848 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
849 error "Last arm of $type $name must be default"
850 }
851
852 foreach {op vr cb} [lrange $body 0 end-2] {
853 if {[git-version $op $vr]} {
854 return [uplevel [list $type $name $parm $cb]]
855 }
856 }
857
858 return [uplevel [list $type $name $parm [lindex $body end]]]
859 }
860
861 default {
862 error "git-version >= x"
863 }
864
865 }
866}
867
868if {[git-version < 1.5]} {
869 catch {wm withdraw .}
870 tk_messageBox \
871 -icon error \
872 -type ok \
873 -title [mc "git-gui: fatal error"] \
874 -message "[appname] requires Git 1.5.0 or later.
875
876You are using [git-version]:
877
878[git --version]"
879 exit 1
880}
881
882######################################################################
883##
884## configure our library
885
886set idx [file join $oguilib tclIndex]
887if {[catch {set fd [open $idx r]} err]} {
888 catch {wm withdraw .}
889 tk_messageBox \
890 -icon error \
891 -type ok \
892 -title [mc "git-gui: fatal error"] \
893 -message $err
894 exit 1
895}
896if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
897 set idx [list]
898 while {[gets $fd n] >= 0} {
899 if {$n ne {} && ![string match #* $n]} {
900 lappend idx $n
901 }
902 }
903} else {
904 set idx {}
905}
906close $fd
907
908if {$idx ne {}} {
909 set loaded [list]
910 foreach p $idx {
911 if {[lsearch -exact $loaded $p] >= 0} continue
912 source [file join $oguilib $p]
913 lappend loaded $p
914 }
915 unset loaded p
916} else {
917 set auto_path [concat [list $oguilib] $auto_path]
918}
919unset -nocomplain idx fd
920
921######################################################################
922##
923## config file parsing
924
925git-version proc _parse_config {arr_name args} {
926 >= 1.5.3 {
927 upvar $arr_name arr
928 array unset arr
929 set buf {}
930 catch {
931 set fd_rc [eval \
932 [list git_read config] \
933 $args \
934 [list --null --list]]
935 fconfigure $fd_rc -translation binary
936 set buf [read $fd_rc]
937 close $fd_rc
938 }
939 foreach line [split $buf "\0"] {
940 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
941 if {[is_many_config $name]} {
942 lappend arr($name) $value
943 } else {
944 set arr($name) $value
945 }
946 }
947 }
948 }
949 default {
950 upvar $arr_name arr
951 array unset arr
952 catch {
953 set fd_rc [eval [list git_read config --list] $args]
954 while {[gets $fd_rc line] >= 0} {
955 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
956 if {[is_many_config $name]} {
957 lappend arr($name) $value
958 } else {
959 set arr($name) $value
960 }
961 }
962 }
963 close $fd_rc
964 }
965 }
966}
967
968proc load_config {include_global} {
969 global repo_config global_config system_config default_config
970
971 if {$include_global} {
972 _parse_config system_config --system
973 _parse_config global_config --global
974 }
975 _parse_config repo_config
976
977 foreach name [array names default_config] {
978 if {[catch {set v $system_config($name)}]} {
979 set system_config($name) $default_config($name)
980 }
981 }
982 foreach name [array names system_config] {
983 if {[catch {set v $global_config($name)}]} {
984 set global_config($name) $system_config($name)
985 }
986 if {[catch {set v $repo_config($name)}]} {
987 set repo_config($name) $system_config($name)
988 }
989 }
990}
991
992######################################################################
993##
994## feature option selection
995
996if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
997 unset _junk
998} else {
999 set subcommand gui
1000}
1001if {$subcommand eq {gui.sh}} {
1002 set subcommand gui
1003}
1004if {$subcommand eq {gui} && [llength $argv] > 0} {
1005 set subcommand [lindex $argv 0]
1006 set argv [lrange $argv 1 end]
1007}
1008
1009enable_option multicommit
1010enable_option branch
1011enable_option transport
1012disable_option bare
1013
1014switch -- $subcommand {
1015browser -
1016blame {
1017 enable_option bare
1018
1019 disable_option multicommit
1020 disable_option branch
1021 disable_option transport
1022}
1023citool {
1024 enable_option singlecommit
1025 enable_option retcode
1026
1027 disable_option multicommit
1028 disable_option branch
1029 disable_option transport
1030
1031 while {[llength $argv] > 0} {
1032 set a [lindex $argv 0]
1033 switch -- $a {
1034 --amend {
1035 enable_option initialamend
1036 }
1037 --nocommit {
1038 enable_option nocommit
1039 enable_option nocommitmsg
1040 }
1041 --commitmsg {
1042 disable_option nocommitmsg
1043 }
1044 default {
1045 break
1046 }
1047 }
1048
1049 set argv [lrange $argv 1 end]
1050 }
1051}
1052}
1053
1054######################################################################
1055##
1056## execution environment
1057
1058set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1059
1060# Suggest our implementation of askpass, if none is set
1061if {![info exists env(SSH_ASKPASS)]} {
1062 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1063}
1064
1065######################################################################
1066##
1067## repository setup
1068
1069set picked 0
1070if {[catch {
1071 set _gitdir $env(GIT_DIR)
1072 set _prefix {}
1073 }]
1074 && [catch {
1075 set _gitdir [git rev-parse --git-dir]
1076 set _prefix [git rev-parse --show-prefix]
1077 } err]} {
1078 load_config 1
1079 apply_config
1080 choose_repository::pick
1081 set picked 1
1082}
1083if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1084 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1085}
1086if {![file isdirectory $_gitdir]} {
1087 catch {wm withdraw .}
1088 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1089 exit 1
1090}
1091if {$_prefix ne {}} {
1092 regsub -all {[^/]+/} $_prefix ../ cdup
1093 if {[catch {cd $cdup} err]} {
1094 catch {wm withdraw .}
1095 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1096 exit 1
1097 }
1098 unset cdup
1099} elseif {![is_enabled bare]} {
1100 if {[lindex [file split $_gitdir] end] ne {.git}} {
1101 catch {wm withdraw .}
1102 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
1103 exit 1
1104 }
1105 if {[catch {cd [file dirname $_gitdir]} err]} {
1106 catch {wm withdraw .}
1107 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
1108 exit 1
1109 }
1110}
1111set _reponame [file split [file normalize $_gitdir]]
1112if {[lindex $_reponame end] eq {.git}} {
1113 set _reponame [lindex $_reponame end-1]
1114} else {
1115 set _reponame [lindex $_reponame end]
1116}
1117
1118######################################################################
1119##
1120## global init
1121
1122set current_diff_path {}
1123set current_diff_side {}
1124set diff_actions [list]
1125
1126set HEAD {}
1127set PARENT {}
1128set MERGE_HEAD [list]
1129set commit_type {}
1130set empty_tree {}
1131set current_branch {}
1132set is_detached 0
1133set current_diff_path {}
1134set is_3way_diff 0
1135set is_conflict_diff 0
1136set selected_commit_type new
1137set diff_empty_count 0
1138
1139set nullid "0000000000000000000000000000000000000000"
1140set nullid2 "0000000000000000000000000000000000000001"
1141
1142######################################################################
1143##
1144## task management
1145
1146set rescan_active 0
1147set diff_active 0
1148set last_clicked {}
1149
1150set disable_on_lock [list]
1151set index_lock_type none
1152
1153proc lock_index {type} {
1154 global index_lock_type disable_on_lock
1155
1156 if {$index_lock_type eq {none}} {
1157 set index_lock_type $type
1158 foreach w $disable_on_lock {
1159 uplevel #0 $w disabled
1160 }
1161 return 1
1162 } elseif {$index_lock_type eq "begin-$type"} {
1163 set index_lock_type $type
1164 return 1
1165 }
1166 return 0
1167}
1168
1169proc unlock_index {} {
1170 global index_lock_type disable_on_lock
1171
1172 set index_lock_type none
1173 foreach w $disable_on_lock {
1174 uplevel #0 $w normal
1175 }
1176}
1177
1178######################################################################
1179##
1180## status
1181
1182proc repository_state {ctvar hdvar mhvar} {
1183 global current_branch
1184 upvar $ctvar ct $hdvar hd $mhvar mh
1185
1186 set mh [list]
1187
1188 load_current_branch
1189 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1190 set hd {}
1191 set ct initial
1192 return
1193 }
1194
1195 set merge_head [gitdir MERGE_HEAD]
1196 if {[file exists $merge_head]} {
1197 set ct merge
1198 set fd_mh [open $merge_head r]
1199 while {[gets $fd_mh line] >= 0} {
1200 lappend mh $line
1201 }
1202 close $fd_mh
1203 return
1204 }
1205
1206 set ct normal
1207}
1208
1209proc PARENT {} {
1210 global PARENT empty_tree
1211
1212 set p [lindex $PARENT 0]
1213 if {$p ne {}} {
1214 return $p
1215 }
1216 if {$empty_tree eq {}} {
1217 set empty_tree [git mktree << {}]
1218 }
1219 return $empty_tree
1220}
1221
1222proc force_amend {} {
1223 global selected_commit_type
1224 global HEAD PARENT MERGE_HEAD commit_type
1225
1226 repository_state newType newHEAD newMERGE_HEAD
1227 set HEAD $newHEAD
1228 set PARENT $newHEAD
1229 set MERGE_HEAD $newMERGE_HEAD
1230 set commit_type $newType
1231
1232 set selected_commit_type amend
1233 do_select_commit_type
1234}
1235
1236proc rescan {after {honor_trustmtime 1}} {
1237 global HEAD PARENT MERGE_HEAD commit_type
1238 global ui_index ui_workdir ui_comm
1239 global rescan_active file_states
1240 global repo_config
1241
1242 if {$rescan_active > 0 || ![lock_index read]} return
1243
1244 repository_state newType newHEAD newMERGE_HEAD
1245 if {[string match amend* $commit_type]
1246 && $newType eq {normal}
1247 && $newHEAD eq $HEAD} {
1248 } else {
1249 set HEAD $newHEAD
1250 set PARENT $newHEAD
1251 set MERGE_HEAD $newMERGE_HEAD
1252 set commit_type $newType
1253 }
1254
1255 array unset file_states
1256
1257 if {!$::GITGUI_BCK_exists &&
1258 (![$ui_comm edit modified]
1259 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1260 if {[string match amend* $commit_type]} {
1261 } elseif {[load_message GITGUI_MSG]} {
1262 } elseif {[run_prepare_commit_msg_hook]} {
1263 } elseif {[load_message MERGE_MSG]} {
1264 } elseif {[load_message SQUASH_MSG]} {
1265 }
1266 $ui_comm edit reset
1267 $ui_comm edit modified false
1268 }
1269
1270 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1271 rescan_stage2 {} $after
1272 } else {
1273 set rescan_active 1
1274 ui_status [mc "Refreshing file status..."]
1275 set fd_rf [git_read update-index \
1276 -q \
1277 --unmerged \
1278 --ignore-missing \
1279 --refresh \
1280 ]
1281 fconfigure $fd_rf -blocking 0 -translation binary
1282 fileevent $fd_rf readable \
1283 [list rescan_stage2 $fd_rf $after]
1284 }
1285}
1286
1287if {[is_Cygwin]} {
1288 set is_git_info_exclude {}
1289 proc have_info_exclude {} {
1290 global is_git_info_exclude
1291
1292 if {$is_git_info_exclude eq {}} {
1293 if {[catch {exec test -f [gitdir info exclude]}]} {
1294 set is_git_info_exclude 0
1295 } else {
1296 set is_git_info_exclude 1
1297 }
1298 }
1299 return $is_git_info_exclude
1300 }
1301} else {
1302 proc have_info_exclude {} {
1303 return [file readable [gitdir info exclude]]
1304 }
1305}
1306
1307proc rescan_stage2 {fd after} {
1308 global rescan_active buf_rdi buf_rdf buf_rlo
1309
1310 if {$fd ne {}} {
1311 read $fd
1312 if {![eof $fd]} return
1313 close $fd
1314 }
1315
1316 set ls_others [list --exclude-per-directory=.gitignore]
1317 if {[have_info_exclude]} {
1318 lappend ls_others "--exclude-from=[gitdir info exclude]"
1319 }
1320 set user_exclude [get_config core.excludesfile]
1321 if {$user_exclude ne {} && [file readable $user_exclude]} {
1322 lappend ls_others "--exclude-from=$user_exclude"
1323 }
1324
1325 set buf_rdi {}
1326 set buf_rdf {}
1327 set buf_rlo {}
1328
1329 set rescan_active 3
1330 ui_status [mc "Scanning for modified files ..."]
1331 set fd_di [git_read diff-index --cached -z [PARENT]]
1332 set fd_df [git_read diff-files -z]
1333 set fd_lo [eval git_read ls-files --others -z $ls_others]
1334
1335 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1336 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1337 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1338 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1339 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1340 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1341}
1342
1343proc load_message {file} {
1344 global ui_comm
1345
1346 set f [gitdir $file]
1347 if {[file isfile $f]} {
1348 if {[catch {set fd [open $f r]}]} {
1349 return 0
1350 }
1351 fconfigure $fd -eofchar {}
1352 set content [string trim [read $fd]]
1353 close $fd
1354 regsub -all -line {[ \r\t]+$} $content {} content
1355 $ui_comm delete 0.0 end
1356 $ui_comm insert end $content
1357 return 1
1358 }
1359 return 0
1360}
1361
1362proc run_prepare_commit_msg_hook {} {
1363 global pch_error
1364
1365 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1366 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1367 # empty file but existant file.
1368
1369 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1370
1371 if {[file isfile [gitdir MERGE_MSG]]} {
1372 set pcm_source "merge"
1373 set fd_mm [open [gitdir MERGE_MSG] r]
1374 puts -nonewline $fd_pcm [read $fd_mm]
1375 close $fd_mm
1376 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1377 set pcm_source "squash"
1378 set fd_sm [open [gitdir SQUASH_MSG] r]
1379 puts -nonewline $fd_pcm [read $fd_sm]
1380 close $fd_sm
1381 } else {
1382 set pcm_source ""
1383 }
1384
1385 close $fd_pcm
1386
1387 set fd_ph [githook_read prepare-commit-msg \
1388 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1389 if {$fd_ph eq {}} {
1390 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1391 return 0;
1392 }
1393
1394 ui_status [mc "Calling prepare-commit-msg hook..."]
1395 set pch_error {}
1396
1397 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1398 fileevent $fd_ph readable \
1399 [list prepare_commit_msg_hook_wait $fd_ph]
1400
1401 return 1;
1402}
1403
1404proc prepare_commit_msg_hook_wait {fd_ph} {
1405 global pch_error
1406
1407 append pch_error [read $fd_ph]
1408 fconfigure $fd_ph -blocking 1
1409 if {[eof $fd_ph]} {
1410 if {[catch {close $fd_ph}]} {
1411 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1412 hook_failed_popup prepare-commit-msg $pch_error
1413 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1414 exit 1
1415 } else {
1416 load_message PREPARE_COMMIT_MSG
1417 }
1418 set pch_error {}
1419 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1420 return
1421 }
1422 fconfigure $fd_ph -blocking 0
1423 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1424}
1425
1426proc read_diff_index {fd after} {
1427 global buf_rdi
1428
1429 append buf_rdi [read $fd]
1430 set c 0
1431 set n [string length $buf_rdi]
1432 while {$c < $n} {
1433 set z1 [string first "\0" $buf_rdi $c]
1434 if {$z1 == -1} break
1435 incr z1
1436 set z2 [string first "\0" $buf_rdi $z1]
1437 if {$z2 == -1} break
1438
1439 incr c
1440 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1441 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1442 merge_state \
1443 [encoding convertfrom $p] \
1444 [lindex $i 4]? \
1445 [list [lindex $i 0] [lindex $i 2]] \
1446 [list]
1447 set c $z2
1448 incr c
1449 }
1450 if {$c < $n} {
1451 set buf_rdi [string range $buf_rdi $c end]
1452 } else {
1453 set buf_rdi {}
1454 }
1455
1456 rescan_done $fd buf_rdi $after
1457}
1458
1459proc read_diff_files {fd after} {
1460 global buf_rdf
1461
1462 append buf_rdf [read $fd]
1463 set c 0
1464 set n [string length $buf_rdf]
1465 while {$c < $n} {
1466 set z1 [string first "\0" $buf_rdf $c]
1467 if {$z1 == -1} break
1468 incr z1
1469 set z2 [string first "\0" $buf_rdf $z1]
1470 if {$z2 == -1} break
1471
1472 incr c
1473 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1474 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1475 merge_state \
1476 [encoding convertfrom $p] \
1477 ?[lindex $i 4] \
1478 [list] \
1479 [list [lindex $i 0] [lindex $i 2]]
1480 set c $z2
1481 incr c
1482 }
1483 if {$c < $n} {
1484 set buf_rdf [string range $buf_rdf $c end]
1485 } else {
1486 set buf_rdf {}
1487 }
1488
1489 rescan_done $fd buf_rdf $after
1490}
1491
1492proc read_ls_others {fd after} {
1493 global buf_rlo
1494
1495 append buf_rlo [read $fd]
1496 set pck [split $buf_rlo "\0"]
1497 set buf_rlo [lindex $pck end]
1498 foreach p [lrange $pck 0 end-1] {
1499 set p [encoding convertfrom $p]
1500 if {[string index $p end] eq {/}} {
1501 set p [string range $p 0 end-1]
1502 }
1503 merge_state $p ?O
1504 }
1505 rescan_done $fd buf_rlo $after
1506}
1507
1508proc rescan_done {fd buf after} {
1509 global rescan_active current_diff_path
1510 global file_states repo_config
1511 upvar $buf to_clear
1512
1513 if {![eof $fd]} return
1514 set to_clear {}
1515 close $fd
1516 if {[incr rescan_active -1] > 0} return
1517
1518 prune_selection
1519 unlock_index
1520 display_all_files
1521 if {$current_diff_path ne {}} { reshow_diff $after }
1522 if {$current_diff_path eq {}} { select_first_diff $after }
1523}
1524
1525proc prune_selection {} {
1526 global file_states selected_paths
1527
1528 foreach path [array names selected_paths] {
1529 if {[catch {set still_here $file_states($path)}]} {
1530 unset selected_paths($path)
1531 }
1532 }
1533}
1534
1535######################################################################
1536##
1537## ui helpers
1538
1539proc mapicon {w state path} {
1540 global all_icons
1541
1542 if {[catch {set r $all_icons($state$w)}]} {
1543 puts "error: no icon for $w state={$state} $path"
1544 return file_plain
1545 }
1546 return $r
1547}
1548
1549proc mapdesc {state path} {
1550 global all_descs
1551
1552 if {[catch {set r $all_descs($state)}]} {
1553 puts "error: no desc for state={$state} $path"
1554 return $state
1555 }
1556 return $r
1557}
1558
1559proc ui_status {msg} {
1560 global main_status
1561 if {[info exists main_status]} {
1562 $main_status show $msg
1563 }
1564}
1565
1566proc ui_ready {{test {}}} {
1567 global main_status
1568 if {[info exists main_status]} {
1569 $main_status show [mc "Ready."] $test
1570 }
1571}
1572
1573proc escape_path {path} {
1574 regsub -all {\\} $path "\\\\" path
1575 regsub -all "\n" $path "\\n" path
1576 return $path
1577}
1578
1579proc short_path {path} {
1580 return [escape_path [lindex [file split $path] end]]
1581}
1582
1583set next_icon_id 0
1584set null_sha1 [string repeat 0 40]
1585
1586proc merge_state {path new_state {head_info {}} {index_info {}}} {
1587 global file_states next_icon_id null_sha1
1588
1589 set s0 [string index $new_state 0]
1590 set s1 [string index $new_state 1]
1591
1592 if {[catch {set info $file_states($path)}]} {
1593 set state __
1594 set icon n[incr next_icon_id]
1595 } else {
1596 set state [lindex $info 0]
1597 set icon [lindex $info 1]
1598 if {$head_info eq {}} {set head_info [lindex $info 2]}
1599 if {$index_info eq {}} {set index_info [lindex $info 3]}
1600 }
1601
1602 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1603 elseif {$s0 eq {_}} {set s0 _}
1604
1605 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1606 elseif {$s1 eq {_}} {set s1 _}
1607
1608 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1609 set head_info [list 0 $null_sha1]
1610 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1611 && $head_info eq {}} {
1612 set head_info $index_info
1613 }
1614
1615 set file_states($path) [list $s0$s1 $icon \
1616 $head_info $index_info \
1617 ]
1618 return $state
1619}
1620
1621proc display_file_helper {w path icon_name old_m new_m} {
1622 global file_lists
1623
1624 if {$new_m eq {_}} {
1625 set lno [lsearch -sorted -exact $file_lists($w) $path]
1626 if {$lno >= 0} {
1627 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1628 incr lno
1629 $w conf -state normal
1630 $w delete $lno.0 [expr {$lno + 1}].0
1631 $w conf -state disabled
1632 }
1633 } elseif {$old_m eq {_} && $new_m ne {_}} {
1634 lappend file_lists($w) $path
1635 set file_lists($w) [lsort -unique $file_lists($w)]
1636 set lno [lsearch -sorted -exact $file_lists($w) $path]
1637 incr lno
1638 $w conf -state normal
1639 $w image create $lno.0 \
1640 -align center -padx 5 -pady 1 \
1641 -name $icon_name \
1642 -image [mapicon $w $new_m $path]
1643 $w insert $lno.1 "[escape_path $path]\n"
1644 $w conf -state disabled
1645 } elseif {$old_m ne $new_m} {
1646 $w conf -state normal
1647 $w image conf $icon_name -image [mapicon $w $new_m $path]
1648 $w conf -state disabled
1649 }
1650}
1651
1652proc display_file {path state} {
1653 global file_states selected_paths
1654 global ui_index ui_workdir
1655
1656 set old_m [merge_state $path $state]
1657 set s $file_states($path)
1658 set new_m [lindex $s 0]
1659 set icon_name [lindex $s 1]
1660
1661 set o [string index $old_m 0]
1662 set n [string index $new_m 0]
1663 if {$o eq {U}} {
1664 set o _
1665 }
1666 if {$n eq {U}} {
1667 set n _
1668 }
1669 display_file_helper $ui_index $path $icon_name $o $n
1670
1671 if {[string index $old_m 0] eq {U}} {
1672 set o U
1673 } else {
1674 set o [string index $old_m 1]
1675 }
1676 if {[string index $new_m 0] eq {U}} {
1677 set n U
1678 } else {
1679 set n [string index $new_m 1]
1680 }
1681 display_file_helper $ui_workdir $path $icon_name $o $n
1682
1683 if {$new_m eq {__}} {
1684 unset file_states($path)
1685 catch {unset selected_paths($path)}
1686 }
1687}
1688
1689proc display_all_files_helper {w path icon_name m} {
1690 global file_lists
1691
1692 lappend file_lists($w) $path
1693 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1694 $w image create end \
1695 -align center -padx 5 -pady 1 \
1696 -name $icon_name \
1697 -image [mapicon $w $m $path]
1698 $w insert end "[escape_path $path]\n"
1699}
1700
1701proc display_all_files {} {
1702 global ui_index ui_workdir
1703 global file_states file_lists
1704 global last_clicked
1705
1706 $ui_index conf -state normal
1707 $ui_workdir conf -state normal
1708
1709 $ui_index delete 0.0 end
1710 $ui_workdir delete 0.0 end
1711 set last_clicked {}
1712
1713 set file_lists($ui_index) [list]
1714 set file_lists($ui_workdir) [list]
1715
1716 foreach path [lsort [array names file_states]] {
1717 set s $file_states($path)
1718 set m [lindex $s 0]
1719 set icon_name [lindex $s 1]
1720
1721 set s [string index $m 0]
1722 if {$s ne {U} && $s ne {_}} {
1723 display_all_files_helper $ui_index $path \
1724 $icon_name $s
1725 }
1726
1727 if {[string index $m 0] eq {U}} {
1728 set s U
1729 } else {
1730 set s [string index $m 1]
1731 }
1732 if {$s ne {_}} {
1733 display_all_files_helper $ui_workdir $path \
1734 $icon_name $s
1735 }
1736 }
1737
1738 $ui_index conf -state disabled
1739 $ui_workdir conf -state disabled
1740}
1741
1742######################################################################
1743##
1744## icons
1745
1746set filemask {
1747#define mask_width 14
1748#define mask_height 15
1749static unsigned char mask_bits[] = {
1750 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1751 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1752 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1753}
1754
1755image create bitmap file_plain -background white -foreground black -data {
1756#define plain_width 14
1757#define plain_height 15
1758static unsigned char plain_bits[] = {
1759 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1760 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1761 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1762} -maskdata $filemask
1763
1764image create bitmap file_mod -background white -foreground blue -data {
1765#define mod_width 14
1766#define mod_height 15
1767static unsigned char mod_bits[] = {
1768 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1769 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1770 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1771} -maskdata $filemask
1772
1773image create bitmap file_fulltick -background white -foreground "#007000" -data {
1774#define file_fulltick_width 14
1775#define file_fulltick_height 15
1776static unsigned char file_fulltick_bits[] = {
1777 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1778 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1779 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1780} -maskdata $filemask
1781
1782image create bitmap file_parttick -background white -foreground "#005050" -data {
1783#define parttick_width 14
1784#define parttick_height 15
1785static unsigned char parttick_bits[] = {
1786 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1787 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1788 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1789} -maskdata $filemask
1790
1791image create bitmap file_question -background white -foreground black -data {
1792#define file_question_width 14
1793#define file_question_height 15
1794static unsigned char file_question_bits[] = {
1795 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1796 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1797 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1798} -maskdata $filemask
1799
1800image create bitmap file_removed -background white -foreground red -data {
1801#define file_removed_width 14
1802#define file_removed_height 15
1803static unsigned char file_removed_bits[] = {
1804 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1805 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1806 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1807} -maskdata $filemask
1808
1809image create bitmap file_merge -background white -foreground blue -data {
1810#define file_merge_width 14
1811#define file_merge_height 15
1812static unsigned char file_merge_bits[] = {
1813 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1814 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1815 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1816} -maskdata $filemask
1817
1818image create bitmap file_statechange -background white -foreground green -data {
1819#define file_merge_width 14
1820#define file_merge_height 15
1821static unsigned char file_statechange_bits[] = {
1822 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1823 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1824 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1825} -maskdata $filemask
1826
1827set ui_index .vpane.files.index.list
1828set ui_workdir .vpane.files.workdir.list
1829
1830set all_icons(_$ui_index) file_plain
1831set all_icons(A$ui_index) file_fulltick
1832set all_icons(M$ui_index) file_fulltick
1833set all_icons(D$ui_index) file_removed
1834set all_icons(U$ui_index) file_merge
1835set all_icons(T$ui_index) file_statechange
1836
1837set all_icons(_$ui_workdir) file_plain
1838set all_icons(M$ui_workdir) file_mod
1839set all_icons(D$ui_workdir) file_question
1840set all_icons(U$ui_workdir) file_merge
1841set all_icons(O$ui_workdir) file_plain
1842set all_icons(T$ui_workdir) file_statechange
1843
1844set max_status_desc 0
1845foreach i {
1846 {__ {mc "Unmodified"}}
1847
1848 {_M {mc "Modified, not staged"}}
1849 {M_ {mc "Staged for commit"}}
1850 {MM {mc "Portions staged for commit"}}
1851 {MD {mc "Staged for commit, missing"}}
1852
1853 {_T {mc "File type changed, not staged"}}
1854 {T_ {mc "File type changed, staged"}}
1855
1856 {_O {mc "Untracked, not staged"}}
1857 {A_ {mc "Staged for commit"}}
1858 {AM {mc "Portions staged for commit"}}
1859 {AD {mc "Staged for commit, missing"}}
1860
1861 {_D {mc "Missing"}}
1862 {D_ {mc "Staged for removal"}}
1863 {DO {mc "Staged for removal, still present"}}
1864
1865 {_U {mc "Requires merge resolution"}}
1866 {U_ {mc "Requires merge resolution"}}
1867 {UU {mc "Requires merge resolution"}}
1868 {UM {mc "Requires merge resolution"}}
1869 {UD {mc "Requires merge resolution"}}
1870 {UT {mc "Requires merge resolution"}}
1871 } {
1872 set text [eval [lindex $i 1]]
1873 if {$max_status_desc < [string length $text]} {
1874 set max_status_desc [string length $text]
1875 }
1876 set all_descs([lindex $i 0]) $text
1877}
1878unset i
1879
1880######################################################################
1881##
1882## util
1883
1884proc scrollbar2many {list mode args} {
1885 foreach w $list {eval $w $mode $args}
1886}
1887
1888proc many2scrollbar {list mode sb top bottom} {
1889 $sb set $top $bottom
1890 foreach w $list {$w $mode moveto $top}
1891}
1892
1893proc incr_font_size {font {amt 1}} {
1894 set sz [font configure $font -size]
1895 incr sz $amt
1896 font configure $font -size $sz
1897 font configure ${font}bold -size $sz
1898 font configure ${font}italic -size $sz
1899}
1900
1901######################################################################
1902##
1903## ui commands
1904
1905set starting_gitk_msg [mc "Starting gitk... please wait..."]
1906
1907proc do_gitk {revs} {
1908 # -- Always start gitk through whatever we were loaded with. This
1909 # lets us bypass using shell process on Windows systems.
1910 #
1911 set exe [_which gitk -script]
1912 set cmd [list [info nameofexecutable] $exe]
1913 if {$exe eq {}} {
1914 error_popup [mc "Couldn't find gitk in PATH"]
1915 } else {
1916 global env
1917
1918 if {[info exists env(GIT_DIR)]} {
1919 set old_GIT_DIR $env(GIT_DIR)
1920 } else {
1921 set old_GIT_DIR {}
1922 }
1923
1924 set pwd [pwd]
1925 cd [file dirname [gitdir]]
1926 set env(GIT_DIR) [file tail [gitdir]]
1927
1928 eval exec $cmd $revs &
1929
1930 if {$old_GIT_DIR eq {}} {
1931 unset env(GIT_DIR)
1932 } else {
1933 set env(GIT_DIR) $old_GIT_DIR
1934 }
1935 cd $pwd
1936
1937 ui_status $::starting_gitk_msg
1938 after 10000 {
1939 ui_ready $starting_gitk_msg
1940 }
1941 }
1942}
1943
1944proc do_explore {} {
1945 set explorer {}
1946 if {[is_Cygwin] || [is_Windows]} {
1947 set explorer "explorer.exe"
1948 } elseif {[is_MacOSX]} {
1949 set explorer "open"
1950 } else {
1951 # freedesktop.org-conforming system is our best shot
1952 set explorer "xdg-open"
1953 }
1954 eval exec $explorer [list [file nativename [file dirname [gitdir]]]] &
1955}
1956
1957set is_quitting 0
1958set ret_code 1
1959
1960proc terminate_me {win} {
1961 global ret_code
1962 if {$win ne {.}} return
1963 exit $ret_code
1964}
1965
1966proc do_quit {{rc {1}}} {
1967 global ui_comm is_quitting repo_config commit_type
1968 global GITGUI_BCK_exists GITGUI_BCK_i
1969 global ui_comm_spell
1970 global ret_code
1971
1972 if {$is_quitting} return
1973 set is_quitting 1
1974
1975 if {[winfo exists $ui_comm]} {
1976 # -- Stash our current commit buffer.
1977 #
1978 set save [gitdir GITGUI_MSG]
1979 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1980 file rename -force [gitdir GITGUI_BCK] $save
1981 set GITGUI_BCK_exists 0
1982 } else {
1983 set msg [string trim [$ui_comm get 0.0 end]]
1984 regsub -all -line {[ \r\t]+$} $msg {} msg
1985 if {(![string match amend* $commit_type]
1986 || [$ui_comm edit modified])
1987 && $msg ne {}} {
1988 catch {
1989 set fd [open $save w]
1990 puts -nonewline $fd $msg
1991 close $fd
1992 }
1993 } else {
1994 catch {file delete $save}
1995 }
1996 }
1997
1998 # -- Cancel our spellchecker if its running.
1999 #
2000 if {[info exists ui_comm_spell]} {
2001 $ui_comm_spell stop
2002 }
2003
2004 # -- Remove our editor backup, its not needed.
2005 #
2006 after cancel $GITGUI_BCK_i
2007 if {$GITGUI_BCK_exists} {
2008 catch {file delete [gitdir GITGUI_BCK]}
2009 }
2010
2011 # -- Stash our current window geometry into this repository.
2012 #
2013 set cfg_geometry [list]
2014 lappend cfg_geometry [wm geometry .]
2015 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2016 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2017 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2018 set rc_geometry {}
2019 }
2020 if {$cfg_geometry ne $rc_geometry} {
2021 catch {git config gui.geometry $cfg_geometry}
2022 }
2023 }
2024
2025 set ret_code $rc
2026 destroy .
2027}
2028
2029proc do_rescan {} {
2030 rescan ui_ready
2031}
2032
2033proc ui_do_rescan {} {
2034 rescan {force_first_diff ui_ready}
2035}
2036
2037proc do_commit {} {
2038 commit_tree
2039}
2040
2041proc next_diff {{after {}}} {
2042 global next_diff_p next_diff_w next_diff_i
2043 show_diff $next_diff_p $next_diff_w {} {} $after
2044}
2045
2046proc find_anchor_pos {lst name} {
2047 set lid [lsearch -sorted -exact $lst $name]
2048
2049 if {$lid == -1} {
2050 set lid 0
2051 foreach lname $lst {
2052 if {$lname >= $name} break
2053 incr lid
2054 }
2055 }
2056
2057 return $lid
2058}
2059
2060proc find_file_from {flist idx delta path mmask} {
2061 global file_states
2062
2063 set len [llength $flist]
2064 while {$idx >= 0 && $idx < $len} {
2065 set name [lindex $flist $idx]
2066
2067 if {$name ne $path && [info exists file_states($name)]} {
2068 set state [lindex $file_states($name) 0]
2069
2070 if {$mmask eq {} || [regexp $mmask $state]} {
2071 return $idx
2072 }
2073 }
2074
2075 incr idx $delta
2076 }
2077
2078 return {}
2079}
2080
2081proc find_next_diff {w path {lno {}} {mmask {}}} {
2082 global next_diff_p next_diff_w next_diff_i
2083 global file_lists ui_index ui_workdir
2084
2085 set flist $file_lists($w)
2086 if {$lno eq {}} {
2087 set lno [find_anchor_pos $flist $path]
2088 } else {
2089 incr lno -1
2090 }
2091
2092 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2093 if {$w eq $ui_index} {
2094 set mmask "^$mmask"
2095 } else {
2096 set mmask "$mmask\$"
2097 }
2098 }
2099
2100 set idx [find_file_from $flist $lno 1 $path $mmask]
2101 if {$idx eq {}} {
2102 incr lno -1
2103 set idx [find_file_from $flist $lno -1 $path $mmask]
2104 }
2105
2106 if {$idx ne {}} {
2107 set next_diff_w $w
2108 set next_diff_p [lindex $flist $idx]
2109 set next_diff_i [expr {$idx+1}]
2110 return 1
2111 } else {
2112 return 0
2113 }
2114}
2115
2116proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2117 global current_diff_path
2118
2119 if {$path ne $current_diff_path} {
2120 return {}
2121 } elseif {[find_next_diff $w $path $lno $mmask]} {
2122 return {next_diff;}
2123 } else {
2124 return {reshow_diff;}
2125 }
2126}
2127
2128proc select_first_diff {after} {
2129 global ui_workdir
2130
2131 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2132 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2133 next_diff $after
2134 } else {
2135 uplevel #0 $after
2136 }
2137}
2138
2139proc force_first_diff {after} {
2140 global ui_workdir current_diff_path file_states
2141
2142 if {[info exists file_states($current_diff_path)]} {
2143 set state [lindex $file_states($current_diff_path) 0]
2144 } else {
2145 set state {OO}
2146 }
2147
2148 set reselect 0
2149 if {[string first {U} $state] >= 0} {
2150 # Already a conflict, do nothing
2151 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2152 set reselect 1
2153 } elseif {[string index $state 1] ne {O}} {
2154 # Already a diff & no conflicts, do nothing
2155 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2156 set reselect 1
2157 }
2158
2159 if {$reselect} {
2160 next_diff $after
2161 } else {
2162 uplevel #0 $after
2163 }
2164}
2165
2166proc toggle_or_diff {w x y} {
2167 global file_states file_lists current_diff_path ui_index ui_workdir
2168 global last_clicked selected_paths
2169
2170 set pos [split [$w index @$x,$y] .]
2171 set lno [lindex $pos 0]
2172 set col [lindex $pos 1]
2173 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2174 if {$path eq {}} {
2175 set last_clicked {}
2176 return
2177 }
2178
2179 set last_clicked [list $w $lno]
2180 array unset selected_paths
2181 $ui_index tag remove in_sel 0.0 end
2182 $ui_workdir tag remove in_sel 0.0 end
2183
2184 # Determine the state of the file
2185 if {[info exists file_states($path)]} {
2186 set state [lindex $file_states($path) 0]
2187 } else {
2188 set state {__}
2189 }
2190
2191 # Restage the file, or simply show the diff
2192 if {$col == 0 && $y > 1} {
2193 # Conflicts need special handling
2194 if {[string first {U} $state] >= 0} {
2195 # $w must always be $ui_workdir, but...
2196 if {$w ne $ui_workdir} { set lno {} }
2197 merge_stage_workdir $path $lno
2198 return
2199 }
2200
2201 if {[string index $state 1] eq {O}} {
2202 set mmask {}
2203 } else {
2204 set mmask {[^O]}
2205 }
2206
2207 set after [next_diff_after_action $w $path $lno $mmask]
2208
2209 if {$w eq $ui_index} {
2210 update_indexinfo \
2211 "Unstaging [short_path $path] from commit" \
2212 [list $path] \
2213 [concat $after [list ui_ready]]
2214 } elseif {$w eq $ui_workdir} {
2215 update_index \
2216 "Adding [short_path $path]" \
2217 [list $path] \
2218 [concat $after [list ui_ready]]
2219 }
2220 } else {
2221 show_diff $path $w $lno
2222 }
2223}
2224
2225proc add_one_to_selection {w x y} {
2226 global file_lists last_clicked selected_paths
2227
2228 set lno [lindex [split [$w index @$x,$y] .] 0]
2229 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2230 if {$path eq {}} {
2231 set last_clicked {}
2232 return
2233 }
2234
2235 if {$last_clicked ne {}
2236 && [lindex $last_clicked 0] ne $w} {
2237 array unset selected_paths
2238 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2239 }
2240
2241 set last_clicked [list $w $lno]
2242 if {[catch {set in_sel $selected_paths($path)}]} {
2243 set in_sel 0
2244 }
2245 if {$in_sel} {
2246 unset selected_paths($path)
2247 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2248 } else {
2249 set selected_paths($path) 1
2250 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2251 }
2252}
2253
2254proc add_range_to_selection {w x y} {
2255 global file_lists last_clicked selected_paths
2256
2257 if {[lindex $last_clicked 0] ne $w} {
2258 toggle_or_diff $w $x $y
2259 return
2260 }
2261
2262 set lno [lindex [split [$w index @$x,$y] .] 0]
2263 set lc [lindex $last_clicked 1]
2264 if {$lc < $lno} {
2265 set begin $lc
2266 set end $lno
2267 } else {
2268 set begin $lno
2269 set end $lc
2270 }
2271
2272 foreach path [lrange $file_lists($w) \
2273 [expr {$begin - 1}] \
2274 [expr {$end - 1}]] {
2275 set selected_paths($path) 1
2276 }
2277 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2278}
2279
2280proc show_more_context {} {
2281 global repo_config
2282 if {$repo_config(gui.diffcontext) < 99} {
2283 incr repo_config(gui.diffcontext)
2284 reshow_diff
2285 }
2286}
2287
2288proc show_less_context {} {
2289 global repo_config
2290 if {$repo_config(gui.diffcontext) > 1} {
2291 incr repo_config(gui.diffcontext) -1
2292 reshow_diff
2293 }
2294}
2295
2296######################################################################
2297##
2298## ui construction
2299
2300load_config 0
2301apply_config
2302set ui_comm {}
2303
2304# -- Menu Bar
2305#
2306menu .mbar -tearoff 0
2307if {[is_MacOSX]} {
2308 # -- Apple Menu (Mac OS X only)
2309 #
2310 .mbar add cascade -label Apple -menu .mbar.apple
2311 menu .mbar.apple
2312}
2313.mbar add cascade -label [mc Repository] -menu .mbar.repository
2314.mbar add cascade -label [mc Edit] -menu .mbar.edit
2315if {[is_enabled branch]} {
2316 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2317}
2318if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2319 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2320}
2321if {[is_enabled transport]} {
2322 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2323 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2324}
2325if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2326 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2327}
2328
2329# -- Repository Menu
2330#
2331menu .mbar.repository
2332
2333.mbar.repository add command \
2334 -label [mc "Explore Working Copy"] \
2335 -command {do_explore}
2336.mbar.repository add separator
2337
2338.mbar.repository add command \
2339 -label [mc "Browse Current Branch's Files"] \
2340 -command {browser::new $current_branch}
2341set ui_browse_current [.mbar.repository index last]
2342.mbar.repository add command \
2343 -label [mc "Browse Branch Files..."] \
2344 -command browser_open::dialog
2345.mbar.repository add separator
2346
2347.mbar.repository add command \
2348 -label [mc "Visualize Current Branch's History"] \
2349 -command {do_gitk $current_branch}
2350set ui_visualize_current [.mbar.repository index last]
2351.mbar.repository add command \
2352 -label [mc "Visualize All Branch History"] \
2353 -command {do_gitk --all}
2354.mbar.repository add separator
2355
2356proc current_branch_write {args} {
2357 global current_branch
2358 .mbar.repository entryconf $::ui_browse_current \
2359 -label [mc "Browse %s's Files" $current_branch]
2360 .mbar.repository entryconf $::ui_visualize_current \
2361 -label [mc "Visualize %s's History" $current_branch]
2362}
2363trace add variable current_branch write current_branch_write
2364
2365if {[is_enabled multicommit]} {
2366 .mbar.repository add command -label [mc "Database Statistics"] \
2367 -command do_stats
2368
2369 .mbar.repository add command -label [mc "Compress Database"] \
2370 -command do_gc
2371
2372 .mbar.repository add command -label [mc "Verify Database"] \
2373 -command do_fsck_objects
2374
2375 .mbar.repository add separator
2376
2377 if {[is_Cygwin]} {
2378 .mbar.repository add command \
2379 -label [mc "Create Desktop Icon"] \
2380 -command do_cygwin_shortcut
2381 } elseif {[is_Windows]} {
2382 .mbar.repository add command \
2383 -label [mc "Create Desktop Icon"] \
2384 -command do_windows_shortcut
2385 } elseif {[is_MacOSX]} {
2386 .mbar.repository add command \
2387 -label [mc "Create Desktop Icon"] \
2388 -command do_macosx_app
2389 }
2390}
2391
2392if {[is_MacOSX]} {
2393 proc ::tk::mac::Quit {args} { do_quit }
2394} else {
2395 .mbar.repository add command -label [mc Quit] \
2396 -command do_quit \
2397 -accelerator $M1T-Q
2398}
2399
2400# -- Edit Menu
2401#
2402menu .mbar.edit
2403.mbar.edit add command -label [mc Undo] \
2404 -command {catch {[focus] edit undo}} \
2405 -accelerator $M1T-Z
2406.mbar.edit add command -label [mc Redo] \
2407 -command {catch {[focus] edit redo}} \
2408 -accelerator $M1T-Y
2409.mbar.edit add separator
2410.mbar.edit add command -label [mc Cut] \
2411 -command {catch {tk_textCut [focus]}} \
2412 -accelerator $M1T-X
2413.mbar.edit add command -label [mc Copy] \
2414 -command {catch {tk_textCopy [focus]}} \
2415 -accelerator $M1T-C
2416.mbar.edit add command -label [mc Paste] \
2417 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2418 -accelerator $M1T-V
2419.mbar.edit add command -label [mc Delete] \
2420 -command {catch {[focus] delete sel.first sel.last}} \
2421 -accelerator Del
2422.mbar.edit add separator
2423.mbar.edit add command -label [mc "Select All"] \
2424 -command {catch {[focus] tag add sel 0.0 end}} \
2425 -accelerator $M1T-A
2426
2427# -- Branch Menu
2428#
2429if {[is_enabled branch]} {
2430 menu .mbar.branch
2431
2432 .mbar.branch add command -label [mc "Create..."] \
2433 -command branch_create::dialog \
2434 -accelerator $M1T-N
2435 lappend disable_on_lock [list .mbar.branch entryconf \
2436 [.mbar.branch index last] -state]
2437
2438 .mbar.branch add command -label [mc "Checkout..."] \
2439 -command branch_checkout::dialog \
2440 -accelerator $M1T-O
2441 lappend disable_on_lock [list .mbar.branch entryconf \
2442 [.mbar.branch index last] -state]
2443
2444 .mbar.branch add command -label [mc "Rename..."] \
2445 -command branch_rename::dialog
2446 lappend disable_on_lock [list .mbar.branch entryconf \
2447 [.mbar.branch index last] -state]
2448
2449 .mbar.branch add command -label [mc "Delete..."] \
2450 -command branch_delete::dialog
2451 lappend disable_on_lock [list .mbar.branch entryconf \
2452 [.mbar.branch index last] -state]
2453
2454 .mbar.branch add command -label [mc "Reset..."] \
2455 -command merge::reset_hard
2456 lappend disable_on_lock [list .mbar.branch entryconf \
2457 [.mbar.branch index last] -state]
2458}
2459
2460# -- Commit Menu
2461#
2462proc commit_btn_caption {} {
2463 if {[is_enabled nocommit]} {
2464 return [mc "Done"]
2465 } else {
2466 return [mc Commit@@verb]
2467 }
2468}
2469
2470if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2471 menu .mbar.commit
2472
2473 if {![is_enabled nocommit]} {
2474 .mbar.commit add radiobutton \
2475 -label [mc "New Commit"] \
2476 -command do_select_commit_type \
2477 -variable selected_commit_type \
2478 -value new
2479 lappend disable_on_lock \
2480 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2481
2482 .mbar.commit add radiobutton \
2483 -label [mc "Amend Last Commit"] \
2484 -command do_select_commit_type \
2485 -variable selected_commit_type \
2486 -value amend
2487 lappend disable_on_lock \
2488 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2489
2490 .mbar.commit add separator
2491 }
2492
2493 .mbar.commit add command -label [mc Rescan] \
2494 -command ui_do_rescan \
2495 -accelerator F5
2496 lappend disable_on_lock \
2497 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2498
2499 .mbar.commit add command -label [mc "Stage To Commit"] \
2500 -command do_add_selection \
2501 -accelerator $M1T-T
2502 lappend disable_on_lock \
2503 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2504
2505 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2506 -command do_add_all \
2507 -accelerator $M1T-I
2508 lappend disable_on_lock \
2509 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2510
2511 .mbar.commit add command -label [mc "Unstage From Commit"] \
2512 -command do_unstage_selection
2513 lappend disable_on_lock \
2514 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2515
2516 .mbar.commit add command -label [mc "Revert Changes"] \
2517 -command do_revert_selection
2518 lappend disable_on_lock \
2519 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2520
2521 .mbar.commit add separator
2522
2523 .mbar.commit add command -label [mc "Show Less Context"] \
2524 -command show_less_context \
2525 -accelerator $M1T-\-
2526
2527 .mbar.commit add command -label [mc "Show More Context"] \
2528 -command show_more_context \
2529 -accelerator $M1T-=
2530
2531 .mbar.commit add separator
2532
2533 if {![is_enabled nocommitmsg]} {
2534 .mbar.commit add command -label [mc "Sign Off"] \
2535 -command do_signoff \
2536 -accelerator $M1T-S
2537 }
2538
2539 .mbar.commit add command -label [commit_btn_caption] \
2540 -command do_commit \
2541 -accelerator $M1T-Return
2542 lappend disable_on_lock \
2543 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2544}
2545
2546# -- Merge Menu
2547#
2548if {[is_enabled branch]} {
2549 menu .mbar.merge
2550 .mbar.merge add command -label [mc "Local Merge..."] \
2551 -command merge::dialog \
2552 -accelerator $M1T-M
2553 lappend disable_on_lock \
2554 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2555 .mbar.merge add command -label [mc "Abort Merge..."] \
2556 -command merge::reset_hard
2557 lappend disable_on_lock \
2558 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2559}
2560
2561# -- Transport Menu
2562#
2563if {[is_enabled transport]} {
2564 menu .mbar.remote
2565
2566 .mbar.remote add command \
2567 -label [mc "Add..."] \
2568 -command remote_add::dialog \
2569 -accelerator $M1T-A
2570 .mbar.remote add command \
2571 -label [mc "Push..."] \
2572 -command do_push_anywhere \
2573 -accelerator $M1T-P
2574 .mbar.remote add command \
2575 -label [mc "Delete Branch..."] \
2576 -command remote_branch_delete::dialog
2577}
2578
2579if {[is_MacOSX]} {
2580 proc ::tk::mac::ShowPreferences {} {do_options}
2581} else {
2582 # -- Edit Menu
2583 #
2584 .mbar.edit add separator
2585 .mbar.edit add command -label [mc "Options..."] \
2586 -command do_options
2587}
2588
2589# -- Tools Menu
2590#
2591if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2592 set tools_menubar .mbar.tools
2593 menu $tools_menubar
2594 $tools_menubar add separator
2595 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2596 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2597 set tools_tailcnt 3
2598 if {[array names repo_config guitool.*.cmd] ne {}} {
2599 tools_populate_all
2600 }
2601}
2602
2603# -- Help Menu
2604#
2605.mbar add cascade -label [mc Help] -menu .mbar.help
2606menu .mbar.help
2607
2608if {[is_MacOSX]} {
2609 .mbar.apple add command -label [mc "About %s" [appname]] \
2610 -command do_about
2611 .mbar.apple add separator
2612} else {
2613 .mbar.help add command -label [mc "About %s" [appname]] \
2614 -command do_about
2615}
2616. configure -menu .mbar
2617
2618set doc_path [githtmldir]
2619if {$doc_path ne {}} {
2620 set doc_path [file join $doc_path index.html]
2621
2622 if {[is_Cygwin]} {
2623 set doc_path [exec cygpath --mixed $doc_path]
2624 }
2625}
2626
2627if {[file isfile $doc_path]} {
2628 set doc_url "file:$doc_path"
2629} else {
2630 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2631}
2632
2633proc start_browser {url} {
2634 git "web--browse" $url
2635}
2636
2637.mbar.help add command -label [mc "Online Documentation"] \
2638 -command [list start_browser $doc_url]
2639
2640.mbar.help add command -label [mc "Show SSH Key"] \
2641 -command do_ssh_key
2642
2643unset doc_path doc_url
2644
2645# -- Standard bindings
2646#
2647wm protocol . WM_DELETE_WINDOW do_quit
2648bind all <$M1B-Key-q> do_quit
2649bind all <$M1B-Key-Q> do_quit
2650bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2651bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2652
2653set subcommand_args {}
2654proc usage {} {
2655 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2656 exit 1
2657}
2658
2659proc normalize_relpath {path} {
2660 set elements {}
2661 foreach item [file split $path] {
2662 if {$item eq {.}} continue
2663 if {$item eq {..} && [llength $elements] > 0
2664 && [lindex $elements end] ne {..}} {
2665 set elements [lrange $elements 0 end-1]
2666 continue
2667 }
2668 lappend elements $item
2669 }
2670 return [eval file join $elements]
2671}
2672
2673# -- Not a normal commit type invocation? Do that instead!
2674#
2675switch -- $subcommand {
2676browser -
2677blame {
2678 if {$subcommand eq "blame"} {
2679 set subcommand_args {[--line=<num>] rev? path}
2680 } else {
2681 set subcommand_args {rev? path}
2682 }
2683 if {$argv eq {}} usage
2684 set head {}
2685 set path {}
2686 set jump_spec {}
2687 set is_path 0
2688 foreach a $argv {
2689 if {$is_path || [file exists $_prefix$a]} {
2690 if {$path ne {}} usage
2691 set path [normalize_relpath $_prefix$a]
2692 break
2693 } elseif {$a eq {--}} {
2694 if {$path ne {}} {
2695 if {$head ne {}} usage
2696 set head $path
2697 set path {}
2698 }
2699 set is_path 1
2700 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2701 if {$jump_spec ne {} || $head ne {}} usage
2702 set jump_spec [list $lnum]
2703 } elseif {$head eq {}} {
2704 if {$head ne {}} usage
2705 set head $a
2706 set is_path 1
2707 } else {
2708 usage
2709 }
2710 }
2711 unset is_path
2712
2713 if {$head ne {} && $path eq {}} {
2714 set path [normalize_relpath $_prefix$head]
2715 set head {}
2716 }
2717
2718 if {$head eq {}} {
2719 load_current_branch
2720 } else {
2721 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2722 if {[catch {
2723 set head [git rev-parse --verify $head]
2724 } err]} {
2725 puts stderr $err
2726 exit 1
2727 }
2728 }
2729 set current_branch $head
2730 }
2731
2732 switch -- $subcommand {
2733 browser {
2734 if {$jump_spec ne {}} usage
2735 if {$head eq {}} {
2736 if {$path ne {} && [file isdirectory $path]} {
2737 set head $current_branch
2738 } else {
2739 set head $path
2740 set path {}
2741 }
2742 }
2743 browser::new $head $path
2744 }
2745 blame {
2746 if {$head eq {} && ![file exists $path]} {
2747 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2748 exit 1
2749 }
2750 blame::new $head $path $jump_spec
2751 }
2752 }
2753 return
2754}
2755citool -
2756gui {
2757 if {[llength $argv] != 0} {
2758 puts -nonewline stderr "usage: $argv0"
2759 if {$subcommand ne {gui}
2760 && [file tail $argv0] ne "git-$subcommand"} {
2761 puts -nonewline stderr " $subcommand"
2762 }
2763 puts stderr {}
2764 exit 1
2765 }
2766 # fall through to setup UI for commits
2767}
2768default {
2769 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2770 exit 1
2771}
2772}
2773
2774# -- Branch Control
2775#
2776frame .branch \
2777 -borderwidth 1 \
2778 -relief sunken
2779label .branch.l1 \
2780 -text [mc "Current Branch:"] \
2781 -anchor w \
2782 -justify left
2783label .branch.cb \
2784 -textvariable current_branch \
2785 -anchor w \
2786 -justify left
2787pack .branch.l1 -side left
2788pack .branch.cb -side left -fill x
2789pack .branch -side top -fill x
2790
2791# -- Main Window Layout
2792#
2793panedwindow .vpane -orient horizontal
2794panedwindow .vpane.files -orient vertical
2795.vpane add .vpane.files -sticky nsew -height 100 -width 200
2796pack .vpane -anchor n -side top -fill both -expand 1
2797
2798# -- Index File List
2799#
2800frame .vpane.files.index -height 100 -width 200
2801label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2802 -background lightgreen -foreground black
2803text $ui_index -background white -foreground black \
2804 -borderwidth 0 \
2805 -width 20 -height 10 \
2806 -wrap none \
2807 -cursor $cursor_ptr \
2808 -xscrollcommand {.vpane.files.index.sx set} \
2809 -yscrollcommand {.vpane.files.index.sy set} \
2810 -state disabled
2811scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2812scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2813pack .vpane.files.index.title -side top -fill x
2814pack .vpane.files.index.sx -side bottom -fill x
2815pack .vpane.files.index.sy -side right -fill y
2816pack $ui_index -side left -fill both -expand 1
2817
2818# -- Working Directory File List
2819#
2820frame .vpane.files.workdir -height 100 -width 200
2821label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2822 -background lightsalmon -foreground black
2823text $ui_workdir -background white -foreground black \
2824 -borderwidth 0 \
2825 -width 20 -height 10 \
2826 -wrap none \
2827 -cursor $cursor_ptr \
2828 -xscrollcommand {.vpane.files.workdir.sx set} \
2829 -yscrollcommand {.vpane.files.workdir.sy set} \
2830 -state disabled
2831scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2832scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2833pack .vpane.files.workdir.title -side top -fill x
2834pack .vpane.files.workdir.sx -side bottom -fill x
2835pack .vpane.files.workdir.sy -side right -fill y
2836pack $ui_workdir -side left -fill both -expand 1
2837
2838.vpane.files add .vpane.files.workdir -sticky nsew
2839.vpane.files add .vpane.files.index -sticky nsew
2840
2841foreach i [list $ui_index $ui_workdir] {
2842 rmsel_tag $i
2843 $i tag conf in_diff -background [$i tag cget in_sel -background]
2844}
2845unset i
2846
2847# -- Diff and Commit Area
2848#
2849frame .vpane.lower -height 300 -width 400
2850frame .vpane.lower.commarea
2851frame .vpane.lower.diff -relief sunken -borderwidth 1
2852pack .vpane.lower.diff -fill both -expand 1
2853pack .vpane.lower.commarea -side bottom -fill x
2854.vpane add .vpane.lower -sticky nsew
2855
2856# -- Commit Area Buttons
2857#
2858frame .vpane.lower.commarea.buttons
2859label .vpane.lower.commarea.buttons.l -text {} \
2860 -anchor w \
2861 -justify left
2862pack .vpane.lower.commarea.buttons.l -side top -fill x
2863pack .vpane.lower.commarea.buttons -side left -fill y
2864
2865button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2866 -command ui_do_rescan
2867pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2868lappend disable_on_lock \
2869 {.vpane.lower.commarea.buttons.rescan conf -state}
2870
2871button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2872 -command do_add_all
2873pack .vpane.lower.commarea.buttons.incall -side top -fill x
2874lappend disable_on_lock \
2875 {.vpane.lower.commarea.buttons.incall conf -state}
2876
2877if {![is_enabled nocommitmsg]} {
2878 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2879 -command do_signoff
2880 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2881}
2882
2883button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
2884 -command do_commit
2885pack .vpane.lower.commarea.buttons.commit -side top -fill x
2886lappend disable_on_lock \
2887 {.vpane.lower.commarea.buttons.commit conf -state}
2888
2889if {![is_enabled nocommit]} {
2890 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2891 -command do_push_anywhere
2892 pack .vpane.lower.commarea.buttons.push -side top -fill x
2893}
2894
2895# -- Commit Message Buffer
2896#
2897frame .vpane.lower.commarea.buffer
2898frame .vpane.lower.commarea.buffer.header
2899set ui_comm .vpane.lower.commarea.buffer.t
2900set ui_coml .vpane.lower.commarea.buffer.header.l
2901
2902if {![is_enabled nocommit]} {
2903 radiobutton .vpane.lower.commarea.buffer.header.new \
2904 -text [mc "New Commit"] \
2905 -command do_select_commit_type \
2906 -variable selected_commit_type \
2907 -value new
2908 lappend disable_on_lock \
2909 [list .vpane.lower.commarea.buffer.header.new conf -state]
2910 radiobutton .vpane.lower.commarea.buffer.header.amend \
2911 -text [mc "Amend Last Commit"] \
2912 -command do_select_commit_type \
2913 -variable selected_commit_type \
2914 -value amend
2915 lappend disable_on_lock \
2916 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2917}
2918
2919label $ui_coml \
2920 -anchor w \
2921 -justify left
2922proc trace_commit_type {varname args} {
2923 global ui_coml commit_type
2924 switch -glob -- $commit_type {
2925 initial {set txt [mc "Initial Commit Message:"]}
2926 amend {set txt [mc "Amended Commit Message:"]}
2927 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2928 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2929 merge {set txt [mc "Merge Commit Message:"]}
2930 * {set txt [mc "Commit Message:"]}
2931 }
2932 $ui_coml conf -text $txt
2933}
2934trace add variable commit_type write trace_commit_type
2935pack $ui_coml -side left -fill x
2936
2937if {![is_enabled nocommit]} {
2938 pack .vpane.lower.commarea.buffer.header.amend -side right
2939 pack .vpane.lower.commarea.buffer.header.new -side right
2940}
2941
2942text $ui_comm -background white -foreground black \
2943 -borderwidth 1 \
2944 -undo true \
2945 -maxundo 20 \
2946 -autoseparators true \
2947 -relief sunken \
2948 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
2949 -font font_diff \
2950 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2951scrollbar .vpane.lower.commarea.buffer.sby \
2952 -command [list $ui_comm yview]
2953pack .vpane.lower.commarea.buffer.header -side top -fill x
2954pack .vpane.lower.commarea.buffer.sby -side right -fill y
2955pack $ui_comm -side left -fill y
2956pack .vpane.lower.commarea.buffer -side left -fill y
2957
2958# -- Commit Message Buffer Context Menu
2959#
2960set ctxm .vpane.lower.commarea.buffer.ctxm
2961menu $ctxm -tearoff 0
2962$ctxm add command \
2963 -label [mc Cut] \
2964 -command {tk_textCut $ui_comm}
2965$ctxm add command \
2966 -label [mc Copy] \
2967 -command {tk_textCopy $ui_comm}
2968$ctxm add command \
2969 -label [mc Paste] \
2970 -command {tk_textPaste $ui_comm}
2971$ctxm add command \
2972 -label [mc Delete] \
2973 -command {catch {$ui_comm delete sel.first sel.last}}
2974$ctxm add separator
2975$ctxm add command \
2976 -label [mc "Select All"] \
2977 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2978$ctxm add command \
2979 -label [mc "Copy All"] \
2980 -command {
2981 $ui_comm tag add sel 0.0 end
2982 tk_textCopy $ui_comm
2983 $ui_comm tag remove sel 0.0 end
2984 }
2985$ctxm add separator
2986$ctxm add command \
2987 -label [mc "Sign Off"] \
2988 -command do_signoff
2989set ui_comm_ctxm $ctxm
2990
2991# -- Diff Header
2992#
2993proc trace_current_diff_path {varname args} {
2994 global current_diff_path diff_actions file_states
2995 if {$current_diff_path eq {}} {
2996 set s {}
2997 set f {}
2998 set p {}
2999 set o disabled
3000 } else {
3001 set p $current_diff_path
3002 set s [mapdesc [lindex $file_states($p) 0] $p]
3003 set f [mc "File:"]
3004 set p [escape_path $p]
3005 set o normal
3006 }
3007
3008 .vpane.lower.diff.header.status configure -text $s
3009 .vpane.lower.diff.header.file configure -text $f
3010 .vpane.lower.diff.header.path configure -text $p
3011 foreach w $diff_actions {
3012 uplevel #0 $w $o
3013 }
3014}
3015trace add variable current_diff_path write trace_current_diff_path
3016
3017frame .vpane.lower.diff.header -background gold
3018label .vpane.lower.diff.header.status \
3019 -background gold \
3020 -foreground black \
3021 -width $max_status_desc \
3022 -anchor w \
3023 -justify left
3024label .vpane.lower.diff.header.file \
3025 -background gold \
3026 -foreground black \
3027 -anchor w \
3028 -justify left
3029label .vpane.lower.diff.header.path \
3030 -background gold \
3031 -foreground black \
3032 -anchor w \
3033 -justify left
3034pack .vpane.lower.diff.header.status -side left
3035pack .vpane.lower.diff.header.file -side left
3036pack .vpane.lower.diff.header.path -fill x
3037set ctxm .vpane.lower.diff.header.ctxm
3038menu $ctxm -tearoff 0
3039$ctxm add command \
3040 -label [mc Copy] \
3041 -command {
3042 clipboard clear
3043 clipboard append \
3044 -format STRING \
3045 -type STRING \
3046 -- $current_diff_path
3047 }
3048lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3049bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3050
3051# -- Diff Body
3052#
3053frame .vpane.lower.diff.body
3054set ui_diff .vpane.lower.diff.body.t
3055text $ui_diff -background white -foreground black \
3056 -borderwidth 0 \
3057 -width 80 -height 15 -wrap none \
3058 -font font_diff \
3059 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3060 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3061 -state disabled
3062scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3063 -command [list $ui_diff xview]
3064scrollbar .vpane.lower.diff.body.sby -orient vertical \
3065 -command [list $ui_diff yview]
3066pack .vpane.lower.diff.body.sbx -side bottom -fill x
3067pack .vpane.lower.diff.body.sby -side right -fill y
3068pack $ui_diff -side left -fill both -expand 1
3069pack .vpane.lower.diff.header -side top -fill x
3070pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3071
3072$ui_diff tag conf d_cr -elide true
3073$ui_diff tag conf d_@ -foreground blue -font font_diffbold
3074$ui_diff tag conf d_+ -foreground {#00a000}
3075$ui_diff tag conf d_- -foreground red
3076
3077$ui_diff tag conf d_++ -foreground {#00a000}
3078$ui_diff tag conf d_-- -foreground red
3079$ui_diff tag conf d_+s \
3080 -foreground {#00a000} \
3081 -background {#e2effa}
3082$ui_diff tag conf d_-s \
3083 -foreground red \
3084 -background {#e2effa}
3085$ui_diff tag conf d_s+ \
3086 -foreground {#00a000} \
3087 -background ivory1
3088$ui_diff tag conf d_s- \
3089 -foreground red \
3090 -background ivory1
3091
3092$ui_diff tag conf d<<<<<<< \
3093 -foreground orange \
3094 -font font_diffbold
3095$ui_diff tag conf d======= \
3096 -foreground orange \
3097 -font font_diffbold
3098$ui_diff tag conf d>>>>>>> \
3099 -foreground orange \
3100 -font font_diffbold
3101
3102$ui_diff tag raise sel
3103
3104# -- Diff Body Context Menu
3105#
3106
3107proc create_common_diff_popup {ctxm} {
3108 $ctxm add command \
3109 -label [mc "Show Less Context"] \
3110 -command show_less_context
3111 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3112 $ctxm add command \
3113 -label [mc "Show More Context"] \
3114 -command show_more_context
3115 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3116 $ctxm add separator
3117 $ctxm add command \
3118 -label [mc Refresh] \
3119 -command reshow_diff
3120 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3121 $ctxm add command \
3122 -label [mc Copy] \
3123 -command {tk_textCopy $ui_diff}
3124 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3125 $ctxm add command \
3126 -label [mc "Select All"] \
3127 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3128 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3129 $ctxm add command \
3130 -label [mc "Copy All"] \
3131 -command {
3132 $ui_diff tag add sel 0.0 end
3133 tk_textCopy $ui_diff
3134 $ui_diff tag remove sel 0.0 end
3135 }
3136 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3137 $ctxm add separator
3138 $ctxm add command \
3139 -label [mc "Decrease Font Size"] \
3140 -command {incr_font_size font_diff -1}
3141 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3142 $ctxm add command \
3143 -label [mc "Increase Font Size"] \
3144 -command {incr_font_size font_diff 1}
3145 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3146 $ctxm add separator
3147 set emenu $ctxm.enc
3148 menu $emenu
3149 build_encoding_menu $emenu [list force_diff_encoding]
3150 $ctxm add cascade \
3151 -label [mc "Encoding"] \
3152 -menu $emenu
3153 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3154 $ctxm add separator
3155 $ctxm add command -label [mc "Options..."] \
3156 -command do_options
3157}
3158
3159set ctxm .vpane.lower.diff.body.ctxm
3160menu $ctxm -tearoff 0
3161$ctxm add command \
3162 -label [mc "Apply/Reverse Hunk"] \
3163 -command {apply_hunk $cursorX $cursorY}
3164set ui_diff_applyhunk [$ctxm index last]
3165lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3166$ctxm add command \
3167 -label [mc "Apply/Reverse Line"] \
3168 -command {apply_line $cursorX $cursorY; do_rescan}
3169set ui_diff_applyline [$ctxm index last]
3170lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3171$ctxm add separator
3172create_common_diff_popup $ctxm
3173
3174set ctxmmg .vpane.lower.diff.body.ctxmmg
3175menu $ctxmmg -tearoff 0
3176$ctxmmg add command \
3177 -label [mc "Run Merge Tool"] \
3178 -command {merge_resolve_tool}
3179lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3180$ctxmmg add separator
3181$ctxmmg add command \
3182 -label [mc "Use Remote Version"] \
3183 -command {merge_resolve_one 3}
3184lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3185$ctxmmg add command \
3186 -label [mc "Use Local Version"] \
3187 -command {merge_resolve_one 2}
3188lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3189$ctxmmg add command \
3190 -label [mc "Revert To Base"] \
3191 -command {merge_resolve_one 1}
3192lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3193$ctxmmg add separator
3194create_common_diff_popup $ctxmmg
3195
3196proc popup_diff_menu {ctxm ctxmmg x y X Y} {
3197 global current_diff_path file_states
3198 set ::cursorX $x
3199 set ::cursorY $y
3200 if {[info exists file_states($current_diff_path)]} {
3201 set state [lindex $file_states($current_diff_path) 0]
3202 } else {
3203 set state {__}
3204 }
3205 if {[string first {U} $state] >= 0} {
3206 tk_popup $ctxmmg $X $Y
3207 } else {
3208 if {$::ui_index eq $::current_diff_side} {
3209 set l [mc "Unstage Hunk From Commit"]
3210 set t [mc "Unstage Line From Commit"]
3211 } else {
3212 set l [mc "Stage Hunk For Commit"]
3213 set t [mc "Stage Line For Commit"]
3214 }
3215 if {$::is_3way_diff || $::is_submodule_diff
3216 || $current_diff_path eq {}
3217 || {__} eq $state
3218 || {_O} eq $state
3219 || {_T} eq $state
3220 || {T_} eq $state} {
3221 set s disabled
3222 } else {
3223 set s normal
3224 }
3225 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3226 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3227 tk_popup $ctxm $X $Y
3228 }
3229}
3230bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg %x %y %X %Y]
3231
3232# -- Status Bar
3233#
3234set main_status [::status_bar::new .status]
3235pack .status -anchor w -side bottom -fill x
3236$main_status show [mc "Initializing..."]
3237
3238# -- Load geometry
3239#
3240catch {
3241set gm $repo_config(gui.geometry)
3242wm geometry . [lindex $gm 0]
3243.vpane sash place 0 \
3244 [lindex $gm 1] \
3245 [lindex [.vpane sash coord 0] 1]
3246.vpane.files sash place 0 \
3247 [lindex [.vpane.files sash coord 0] 0] \
3248 [lindex $gm 2]
3249unset gm
3250}
3251
3252# -- Key Bindings
3253#
3254bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3255bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3256bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3257bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3258bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3259bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3260bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3261bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3262bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3263bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3264bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3265bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3266bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3267bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3268bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3269bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3270bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3271bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3272
3273bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3274bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3275bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3276bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3277bind $ui_diff <$M1B-Key-v> {break}
3278bind $ui_diff <$M1B-Key-V> {break}
3279bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3280bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3281bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3282bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3283bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3284bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3285bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3286bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3287bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3288bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3289bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3290bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3291bind $ui_diff <Button-1> {focus %W}
3292
3293if {[is_enabled branch]} {
3294 bind . <$M1B-Key-n> branch_create::dialog
3295 bind . <$M1B-Key-N> branch_create::dialog
3296 bind . <$M1B-Key-o> branch_checkout::dialog
3297 bind . <$M1B-Key-O> branch_checkout::dialog
3298 bind . <$M1B-Key-m> merge::dialog
3299 bind . <$M1B-Key-M> merge::dialog
3300}
3301if {[is_enabled transport]} {
3302 bind . <$M1B-Key-p> do_push_anywhere
3303 bind . <$M1B-Key-P> do_push_anywhere
3304}
3305
3306bind . <Key-F5> ui_do_rescan
3307bind . <$M1B-Key-r> ui_do_rescan
3308bind . <$M1B-Key-R> ui_do_rescan
3309bind . <$M1B-Key-s> do_signoff
3310bind . <$M1B-Key-S> do_signoff
3311bind . <$M1B-Key-t> do_add_selection
3312bind . <$M1B-Key-T> do_add_selection
3313bind . <$M1B-Key-i> do_add_all
3314bind . <$M1B-Key-I> do_add_all
3315bind . <$M1B-Key-minus> {show_less_context;break}
3316bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3317bind . <$M1B-Key-equal> {show_more_context;break}
3318bind . <$M1B-Key-plus> {show_more_context;break}
3319bind . <$M1B-Key-KP_Add> {show_more_context;break}
3320bind . <$M1B-Key-Return> do_commit
3321foreach i [list $ui_index $ui_workdir] {
3322 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3323 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3324 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3325}
3326unset i
3327
3328set file_lists($ui_index) [list]
3329set file_lists($ui_workdir) [list]
3330
3331wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3332focus -force $ui_comm
3333
3334# -- Warn the user about environmental problems. Cygwin's Tcl
3335# does *not* pass its env array onto any processes it spawns.
3336# This means that git processes get none of our environment.
3337#
3338if {[is_Cygwin]} {
3339 set ignored_env 0
3340 set suggest_user {}
3341 set msg [mc "Possible environment issues exist.
3342
3343The following environment variables are probably
3344going to be ignored by any Git subprocess run
3345by %s:
3346
3347" [appname]]
3348 foreach name [array names env] {
3349 switch -regexp -- $name {
3350 {^GIT_INDEX_FILE$} -
3351 {^GIT_OBJECT_DIRECTORY$} -
3352 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3353 {^GIT_DIFF_OPTS$} -
3354 {^GIT_EXTERNAL_DIFF$} -
3355 {^GIT_PAGER$} -
3356 {^GIT_TRACE$} -
3357 {^GIT_CONFIG$} -
3358 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3359 append msg " - $name\n"
3360 incr ignored_env
3361 }
3362 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3363 append msg " - $name\n"
3364 incr ignored_env
3365 set suggest_user $name
3366 }
3367 }
3368 }
3369 if {$ignored_env > 0} {
3370 append msg [mc "
3371This is due to a known issue with the
3372Tcl binary distributed by Cygwin."]
3373
3374 if {$suggest_user ne {}} {
3375 append msg [mc "
3376
3377A good replacement for %s
3378is placing values for the user.name and
3379user.email settings into your personal
3380~/.gitconfig file.
3381" $suggest_user]
3382 }
3383 warn_popup $msg
3384 }
3385 unset ignored_env msg suggest_user name
3386}
3387
3388# -- Only initialize complex UI if we are going to stay running.
3389#
3390if {[is_enabled transport]} {
3391 load_all_remotes
3392
3393 set n [.mbar.remote index end]
3394 populate_remotes_menu
3395 set n [expr {[.mbar.remote index end] - $n}]
3396 if {$n > 0} {
3397 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3398 .mbar.remote insert $n separator
3399 }
3400 unset n
3401}
3402
3403if {[winfo exists $ui_comm]} {
3404 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3405
3406 # -- If both our backup and message files exist use the
3407 # newer of the two files to initialize the buffer.
3408 #
3409 if {$GITGUI_BCK_exists} {
3410 set m [gitdir GITGUI_MSG]
3411 if {[file isfile $m]} {
3412 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3413 catch {file delete [gitdir GITGUI_MSG]}
3414 } else {
3415 $ui_comm delete 0.0 end
3416 $ui_comm edit reset
3417 $ui_comm edit modified false
3418 catch {file delete [gitdir GITGUI_BCK]}
3419 set GITGUI_BCK_exists 0
3420 }
3421 }
3422 unset m
3423 }
3424
3425 proc backup_commit_buffer {} {
3426 global ui_comm GITGUI_BCK_exists
3427
3428 set m [$ui_comm edit modified]
3429 if {$m || $GITGUI_BCK_exists} {
3430 set msg [string trim [$ui_comm get 0.0 end]]
3431 regsub -all -line {[ \r\t]+$} $msg {} msg
3432
3433 if {$msg eq {}} {
3434 if {$GITGUI_BCK_exists} {
3435 catch {file delete [gitdir GITGUI_BCK]}
3436 set GITGUI_BCK_exists 0
3437 }
3438 } elseif {$m} {
3439 catch {
3440 set fd [open [gitdir GITGUI_BCK] w]
3441 puts -nonewline $fd $msg
3442 close $fd
3443 set GITGUI_BCK_exists 1
3444 }
3445 }
3446
3447 $ui_comm edit modified false
3448 }
3449
3450 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3451 }
3452
3453 backup_commit_buffer
3454
3455 # -- If the user has aspell available we can drive it
3456 # in pipe mode to spellcheck the commit message.
3457 #
3458 set spell_cmd [list |]
3459 set spell_dict [get_config gui.spellingdictionary]
3460 lappend spell_cmd aspell
3461 if {$spell_dict ne {}} {
3462 lappend spell_cmd --master=$spell_dict
3463 }
3464 lappend spell_cmd --mode=none
3465 lappend spell_cmd --encoding=utf-8
3466 lappend spell_cmd pipe
3467 if {$spell_dict eq {none}
3468 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3469 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3470 } else {
3471 set ui_comm_spell [spellcheck::init \
3472 $spell_fd \
3473 $ui_comm \
3474 $ui_comm_ctxm \
3475 ]
3476 }
3477 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3478}
3479
3480lock_index begin-read
3481if {![winfo ismapped .]} {
3482 wm deiconify .
3483}
3484after 1 {
3485 if {[is_enabled initialamend]} {
3486 force_amend
3487 } else {
3488 do_rescan
3489 }
3490
3491 if {[is_enabled nocommitmsg]} {
3492 $ui_comm configure -state disabled -background gray
3493 }
3494}
3495if {[is_enabled multicommit]} {
3496 after 1000 hint_gc
3497}
3498if {[is_enabled retcode]} {
3499 bind . <Destroy> {+terminate_me %W}
3500}
3501if {$picked && [is_config_true gui.autoexplore]} {
3502 do_explore
3503}