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" -- "$@"
11set appvers {@@GITGUI_VERSION@@}
13set copyright [encoding convertfrom utf-8 {
14Copyright © 2006, 2007 Shawn Pearce, et. al.
15This 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.
20This 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.
25You 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######################################################################
31##
32## Tcl/Tk sanity check
33if {[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}
45catch {rename send {}} ; # What an evil concept...
47######################################################################
49##
50## locate our library
51set 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######################################################################
71##
72## enable verbose loading?
73if {![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######################################################################
89##
90## Internationalization (i18n) through msgcat and gettext. See
91## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
92package require msgcat
94proc _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}
102proc 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}
110proc strcat {args} {
112 return [join $args {}]
113}
114::msgcat::mcload $oguimsg
116unset oguimsg
117######################################################################
119##
120## read only globals
121set _appname {Git Gui}
123set _gitdir {}
124set _gitexec {}
125set _githtmldir {}
126set _reponame {}
127set _iscygwin {}
128set _search_path {}
129set _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}
137proc appname {} {
139 global _appname
140 return $_appname
141}
142proc gitdir {args} {
144 global _gitdir
145 if {$args eq {}} {
146 return $_gitdir
147 }
148 return [eval [list file join $_gitdir] $args]
149}
150proc 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}
171proc 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}
193proc reponame {} {
195 return $::_reponame
196}
197proc is_MacOSX {} {
199 if {[tk windowingsystem] eq {aqua}} {
200 return 1
201 }
202 return 0
203}
204proc is_Windows {} {
206 if {$::tcl_platform(platform) eq {windows}} {
207 return 1
208 }
209 return 0
210}
211proc 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}
227proc is_enabled {option} {
229 global enabled_options
230 if {[catch {set on $enabled_options($option)}]} {return 0}
231 return $on
232}
233proc enable_option {option} {
235 global enabled_options
236 set enabled_options($option) 1
237}
238proc disable_option {option} {
240 global enabled_options
241 set enabled_options($option) 0
242}
243######################################################################
245##
246## config
247proc 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}
258proc 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}
269proc 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######################################################################
280##
281## handy utils
282proc _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}
297proc _git_cmd {name} {
299 global _git_cmd_path
300 if {[catch {set v $_git_cmd_path($name)}]} {
302 switch -- $name {
303 version -
304 --version -
305 --exec-path { return [list $::_git $name] }
306 }
307 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 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 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}
346proc _which {what args} {
348 global env _search_exe _search_path
349 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 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
371 set suffix {}
372 } else {
373 set suffix $_search_exe
374 }
375 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}
384proc _lappend_nice {cmd_var} {
386 global _nice
387 upvar $cmd_var cmd
388 if {![info exists _nice]} {
390 set _nice [_which nice]
391 }
392 if {$_nice ne {}} {
393 lappend cmd $_nice
394 }
395}
396proc git {args} {
398 set opt [list]
399 while {1} {
401 switch -- [lindex $args 0] {
402 --nice {
403 _lappend_nice opt
404 }
405 default {
407 break
408 }
409 }
411 set args [lrange $args 1 end]
413 }
414 set cmdp [_git_cmd [lindex $args 0]]
416 set args [lrange $args 1 end]
417 _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}
425proc _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}
451proc git_read {args} {
453 set opt [list]
454 while {1} {
456 switch -- [lindex $args 0] {
457 --nice {
458 _lappend_nice opt
459 }
460 --stderr {
462 lappend args 2>@1
463 }
464 default {
466 break
467 }
468 }
470 set args [lrange $args 1 end]
472 }
473 set cmdp [_git_cmd [lindex $args 0]]
475 set args [lrange $args 1 end]
476 return [_open_stdout_stderr [concat $opt $cmdp $args]]
478}
479proc git_write {args} {
481 set opt [list]
482 while {1} {
484 switch -- [lindex $args 0] {
485 --nice {
486 _lappend_nice opt
487 }
488 default {
490 break
491 }
492 }
494 set args [lrange $args 1 end]
496 }
497 set cmdp [_git_cmd [lindex $args 0]]
499 set args [lrange $args 1 end]
500 _trace_exec [concat $opt $cmdp $args]
502 return [open [concat [list | ] $opt $cmdp $args] w]
503}
504proc githook_read {hook_name args} {
506 set pchook [gitdir hooks $hook_name]
507 lappend args 2>@1
508 # 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 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 if {[file executable $pchook]} {
527 return [_open_stdout_stderr [concat [list $pchook] $args]]
528 }
529 return {}
531}
532proc kill_file_process {fd} {
534 set process [pid $fd]
535 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}
546proc 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}
559proc sq {value} {
561 regsub -all ' $value "'\\''" value
562 return "'$value'"
563}
564proc load_current_branch {} {
566 global current_branch is_detached
567 set fd [open [gitdir HEAD] r]
569 if {[gets $fd ref] < 1} {
570 set ref {}
571 }
572 close $fd
573 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}
589auto_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}
598proc 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}
608set root_exists 0
610bind . <Visibility> {
611 bind . <Visibility> {}
612 set root_exists 1
613}
614if {[is_Windows]} {
616 wm iconbitmap . -default $oguilib/git-gui.ico
617 set ::tk::AlwaysShowSelection 1
618 # 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 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 wm iconphoto . -default gitlogo
644 }
645}
646######################################################################
648##
649## config defaults
650set 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}
659font create font_uiitalic
661font create font_uibold
662font create font_diffbold
663font create font_diffitalic
664foreach 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
674if {[is_Windows] || [is_MacOSX]} {
676 option add *Menu.tearOff 0
677}
678if {[is_MacOSX]} {
680 set M1B M1
681 set M1T Cmd
682} else {
683 set M1B Control
684 set M1T Ctrl
685}
686proc 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}
696proc apply_config {} {
698 global repo_config font_descs
699 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}
725set 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) {}
734set 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]
748# TODO: this option should be added to the git-config documentation
749set default_config(gui.maxfilesdisplayed) 5000
750set font_descs {
751 {fontui font_ui {mc "Main Font"}}
752 {fontdiff font_diff {mc "Diff/Console Font"}}
753}
754######################################################################
756##
757## find git
758set _git [_which git]
760if {$_git eq {}} {
761 catch {wm withdraw .}
762 tk_messageBox \
763 -icon error \
764 -type ok \
765 -title [mc "git-gui: fatal error"] \
766 -message [mc "Cannot find git in PATH."]
767 exit 1
768}
769######################################################################
771##
772## version check
773if {[catch {set _git_version [git --version]} err]} {
775 catch {wm withdraw .}
776 tk_messageBox \
777 -icon error \
778 -type ok \
779 -title [mc "git-gui: fatal error"] \
780 -message "Cannot determine Git version:
781$err
783[appname] requires Git 1.5.0 or later."
785 exit 1
786}
787if {![regsub {^git version } $_git_version {} _git_version]} {
788 catch {wm withdraw .}
789 tk_messageBox \
790 -icon error \
791 -type ok \
792 -title [mc "git-gui: fatal error"] \
793 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
794 exit 1
795}
796set _real_git_version $_git_version
798regsub -- {[\-\.]dirty$} $_git_version {} _git_version
799regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
800regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
801regsub {\.GIT$} $_git_version {} _git_version
802regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
803if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
805 catch {wm withdraw .}
806 if {[tk_messageBox \
807 -icon warning \
808 -type yesno \
809 -default no \
810 -title "[appname]: warning" \
811 -message [mc "Git version cannot be determined.
812%s claims it is version '%s'.
814%s requires at least Git 1.5.0 or later.
816Assume '%s' is version 1.5.0?
818" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
819 set _git_version 1.5.0
820 } else {
821 exit 1
822 }
823}
824unset _real_git_version
825proc git-version {args} {
827 global _git_version
828 switch [llength $args] {
830 0 {
831 return $_git_version
832 }
833 2 {
835 set op [lindex $args 0]
836 set vr [lindex $args 1]
837 set cm [package vcompare $_git_version $vr]
838 return [expr $cm $op 0]
839 }
840 4 {
842 set type [lindex $args 0]
843 set name [lindex $args 1]
844 set parm [lindex $args 2]
845 set body [lindex $args 3]
846 if {($type ne {proc} && $type ne {method})} {
848 error "Invalid arguments to git-version"
849 }
850 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
851 error "Last arm of $type $name must be default"
852 }
853 foreach {op vr cb} [lrange $body 0 end-2] {
855 if {[git-version $op $vr]} {
856 return [uplevel [list $type $name $parm $cb]]
857 }
858 }
859 return [uplevel [list $type $name $parm [lindex $body end]]]
861 }
862 default {
864 error "git-version >= x"
865 }
866 }
868}
869if {[git-version < 1.5]} {
871 catch {wm withdraw .}
872 tk_messageBox \
873 -icon error \
874 -type ok \
875 -title [mc "git-gui: fatal error"] \
876 -message "[appname] requires Git 1.5.0 or later.
877You are using [git-version]:
879[git --version]"
881 exit 1
882}
883######################################################################
885##
886## configure our library
887set idx [file join $oguilib tclIndex]
889if {[catch {set fd [open $idx r]} err]} {
890 catch {wm withdraw .}
891 tk_messageBox \
892 -icon error \
893 -type ok \
894 -title [mc "git-gui: fatal error"] \
895 -message $err
896 exit 1
897}
898if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
899 set idx [list]
900 while {[gets $fd n] >= 0} {
901 if {$n ne {} && ![string match #* $n]} {
902 lappend idx $n
903 }
904 }
905} else {
906 set idx {}
907}
908close $fd
909if {$idx ne {}} {
911 set loaded [list]
912 foreach p $idx {
913 if {[lsearch -exact $loaded $p] >= 0} continue
914 source [file join $oguilib $p]
915 lappend loaded $p
916 }
917 unset loaded p
918} else {
919 set auto_path [concat [list $oguilib] $auto_path]
920}
921unset -nocomplain idx fd
922######################################################################
924##
925## config file parsing
926git-version proc _parse_config {arr_name args} {
928 >= 1.5.3 {
929 upvar $arr_name arr
930 array unset arr
931 set buf {}
932 catch {
933 set fd_rc [eval \
934 [list git_read config] \
935 $args \
936 [list --null --list]]
937 fconfigure $fd_rc -translation binary
938 set buf [read $fd_rc]
939 close $fd_rc
940 }
941 foreach line [split $buf "\0"] {
942 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
943 if {[is_many_config $name]} {
944 lappend arr($name) $value
945 } else {
946 set arr($name) $value
947 }
948 }
949 }
950 }
951 default {
952 upvar $arr_name arr
953 array unset arr
954 catch {
955 set fd_rc [eval [list git_read config --list] $args]
956 while {[gets $fd_rc line] >= 0} {
957 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
958 if {[is_many_config $name]} {
959 lappend arr($name) $value
960 } else {
961 set arr($name) $value
962 }
963 }
964 }
965 close $fd_rc
966 }
967 }
968}
969proc load_config {include_global} {
971 global repo_config global_config system_config default_config
972 if {$include_global} {
974 _parse_config system_config --system
975 _parse_config global_config --global
976 }
977 _parse_config repo_config
978 foreach name [array names default_config] {
980 if {[catch {set v $system_config($name)}]} {
981 set system_config($name) $default_config($name)
982 }
983 }
984 foreach name [array names system_config] {
985 if {[catch {set v $global_config($name)}]} {
986 set global_config($name) $system_config($name)
987 }
988 if {[catch {set v $repo_config($name)}]} {
989 set repo_config($name) $system_config($name)
990 }
991 }
992}
993######################################################################
995##
996## feature option selection
997if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
999 unset _junk
1000} else {
1001 set subcommand gui
1002}
1003if {$subcommand eq {gui.sh}} {
1004 set subcommand gui
1005}
1006if {$subcommand eq {gui} && [llength $argv] > 0} {
1007 set subcommand [lindex $argv 0]
1008 set argv [lrange $argv 1 end]
1009}
1010enable_option multicommit
1012enable_option branch
1013enable_option transport
1014disable_option bare
1015switch -- $subcommand {
1017browser -
1018blame {
1019 enable_option bare
1020 disable_option multicommit
1022 disable_option branch
1023 disable_option transport
1024}
1025citool {
1026 enable_option singlecommit
1027 enable_option retcode
1028 disable_option multicommit
1030 disable_option branch
1031 disable_option transport
1032 while {[llength $argv] > 0} {
1034 set a [lindex $argv 0]
1035 switch -- $a {
1036 --amend {
1037 enable_option initialamend
1038 }
1039 --nocommit {
1040 enable_option nocommit
1041 enable_option nocommitmsg
1042 }
1043 --commitmsg {
1044 disable_option nocommitmsg
1045 }
1046 default {
1047 break
1048 }
1049 }
1050 set argv [lrange $argv 1 end]
1052 }
1053}
1054}
1055######################################################################
1057##
1058## execution environment
1059set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1061# Suggest our implementation of askpass, if none is set
1063if {![info exists env(SSH_ASKPASS)]} {
1064 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1065}
1066######################################################################
1068##
1069## repository setup
1070set picked 0
1072if {[catch {
1073 set _gitdir $env(GIT_DIR)
1074 set _prefix {}
1075 }]
1076 && [catch {
1077 # beware that from the .git dir this sets _gitdir to .
1078 # and _prefix to the empty string
1079 set _gitdir [git rev-parse --git-dir]
1080 set _prefix [git rev-parse --show-prefix]
1081 } err]} {
1082 load_config 1
1083 apply_config
1084 choose_repository::pick
1085 set picked 1
1086}
1087# we expand the _gitdir when it's just a single dot (i.e. when we're being
1089# run from the .git dir itself) lest the routines to find the worktree
1090# get confused
1091if {$_gitdir eq "."} {
1092 set _gitdir [pwd]
1093}
1094if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1096 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1097}
1098if {![file isdirectory $_gitdir]} {
1099 catch {wm withdraw .}
1100 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1101 exit 1
1102}
1103if {$_prefix ne {}} {
1104 regsub -all {[^/]+/} $_prefix ../ cdup
1105 if {[catch {cd $cdup} err]} {
1106 catch {wm withdraw .}
1107 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1108 exit 1
1109 }
1110 unset cdup
1111} elseif {![is_enabled bare]} {
1112 if {[lindex [file split $_gitdir] end] ne {.git}} {
1113 catch {wm withdraw .}
1114 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
1115 exit 1
1116 }
1117 if {[catch {cd [file dirname $_gitdir]} err]} {
1118 catch {wm withdraw .}
1119 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
1120 exit 1
1121 }
1122}
1123set _reponame [file split [file normalize $_gitdir]]
1124if {[lindex $_reponame end] eq {.git}} {
1125 set _reponame [lindex $_reponame end-1]
1126} else {
1127 set _reponame [lindex $_reponame end]
1128}
1129######################################################################
1131##
1132## global init
1133set current_diff_path {}
1135set current_diff_side {}
1136set diff_actions [list]
1137set HEAD {}
1139set PARENT {}
1140set MERGE_HEAD [list]
1141set commit_type {}
1142set empty_tree {}
1143set current_branch {}
1144set is_detached 0
1145set current_diff_path {}
1146set is_3way_diff 0
1147set is_submodule_diff 0
1148set is_conflict_diff 0
1149set selected_commit_type new
1150set diff_empty_count 0
1151set nullid "0000000000000000000000000000000000000000"
1153set nullid2 "0000000000000000000000000000000000000001"
1154######################################################################
1156##
1157## task management
1158set rescan_active 0
1160set diff_active 0
1161set last_clicked {}
1162set disable_on_lock [list]
1164set index_lock_type none
1165proc lock_index {type} {
1167 global index_lock_type disable_on_lock
1168 if {$index_lock_type eq {none}} {
1170 set index_lock_type $type
1171 foreach w $disable_on_lock {
1172 uplevel #0 $w disabled
1173 }
1174 return 1
1175 } elseif {$index_lock_type eq "begin-$type"} {
1176 set index_lock_type $type
1177 return 1
1178 }
1179 return 0
1180}
1181proc unlock_index {} {
1183 global index_lock_type disable_on_lock
1184 set index_lock_type none
1186 foreach w $disable_on_lock {
1187 uplevel #0 $w normal
1188 }
1189}
1190######################################################################
1192##
1193## status
1194proc repository_state {ctvar hdvar mhvar} {
1196 global current_branch
1197 upvar $ctvar ct $hdvar hd $mhvar mh
1198 set mh [list]
1200 load_current_branch
1202 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1203 set hd {}
1204 set ct initial
1205 return
1206 }
1207 set merge_head [gitdir MERGE_HEAD]
1209 if {[file exists $merge_head]} {
1210 set ct merge
1211 set fd_mh [open $merge_head r]
1212 while {[gets $fd_mh line] >= 0} {
1213 lappend mh $line
1214 }
1215 close $fd_mh
1216 return
1217 }
1218 set ct normal
1220}
1221proc PARENT {} {
1223 global PARENT empty_tree
1224 set p [lindex $PARENT 0]
1226 if {$p ne {}} {
1227 return $p
1228 }
1229 if {$empty_tree eq {}} {
1230 set empty_tree [git mktree << {}]
1231 }
1232 return $empty_tree
1233}
1234proc force_amend {} {
1236 global selected_commit_type
1237 global HEAD PARENT MERGE_HEAD commit_type
1238 repository_state newType newHEAD newMERGE_HEAD
1240 set HEAD $newHEAD
1241 set PARENT $newHEAD
1242 set MERGE_HEAD $newMERGE_HEAD
1243 set commit_type $newType
1244 set selected_commit_type amend
1246 do_select_commit_type
1247}
1248proc rescan {after {honor_trustmtime 1}} {
1250 global HEAD PARENT MERGE_HEAD commit_type
1251 global ui_index ui_workdir ui_comm
1252 global rescan_active file_states
1253 global repo_config
1254 if {$rescan_active > 0 || ![lock_index read]} return
1256 repository_state newType newHEAD newMERGE_HEAD
1258 if {[string match amend* $commit_type]
1259 && $newType eq {normal}
1260 && $newHEAD eq $HEAD} {
1261 } else {
1262 set HEAD $newHEAD
1263 set PARENT $newHEAD
1264 set MERGE_HEAD $newMERGE_HEAD
1265 set commit_type $newType
1266 }
1267 array unset file_states
1269 if {!$::GITGUI_BCK_exists &&
1271 (![$ui_comm edit modified]
1272 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1273 if {[string match amend* $commit_type]} {
1274 } elseif {[load_message GITGUI_MSG]} {
1275 } elseif {[run_prepare_commit_msg_hook]} {
1276 } elseif {[load_message MERGE_MSG]} {
1277 } elseif {[load_message SQUASH_MSG]} {
1278 }
1279 $ui_comm edit reset
1280 $ui_comm edit modified false
1281 }
1282 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1284 rescan_stage2 {} $after
1285 } else {
1286 set rescan_active 1
1287 ui_status [mc "Refreshing file status..."]
1288 set fd_rf [git_read update-index \
1289 -q \
1290 --unmerged \
1291 --ignore-missing \
1292 --refresh \
1293 ]
1294 fconfigure $fd_rf -blocking 0 -translation binary
1295 fileevent $fd_rf readable \
1296 [list rescan_stage2 $fd_rf $after]
1297 }
1298}
1299if {[is_Cygwin]} {
1301 set is_git_info_exclude {}
1302 proc have_info_exclude {} {
1303 global is_git_info_exclude
1304 if {$is_git_info_exclude eq {}} {
1306 if {[catch {exec test -f [gitdir info exclude]}]} {
1307 set is_git_info_exclude 0
1308 } else {
1309 set is_git_info_exclude 1
1310 }
1311 }
1312 return $is_git_info_exclude
1313 }
1314} else {
1315 proc have_info_exclude {} {
1316 return [file readable [gitdir info exclude]]
1317 }
1318}
1319proc rescan_stage2 {fd after} {
1321 global rescan_active buf_rdi buf_rdf buf_rlo
1322 if {$fd ne {}} {
1324 read $fd
1325 if {![eof $fd]} return
1326 close $fd
1327 }
1328 set ls_others [list --exclude-per-directory=.gitignore]
1330 if {[have_info_exclude]} {
1331 lappend ls_others "--exclude-from=[gitdir info exclude]"
1332 }
1333 set user_exclude [get_config core.excludesfile]
1334 if {$user_exclude ne {} && [file readable $user_exclude]} {
1335 lappend ls_others "--exclude-from=$user_exclude"
1336 }
1337 set buf_rdi {}
1339 set buf_rdf {}
1340 set buf_rlo {}
1341 set rescan_active 3
1343 ui_status [mc "Scanning for modified files ..."]
1344 set fd_di [git_read diff-index --cached -z [PARENT]]
1345 set fd_df [git_read diff-files -z]
1346 set fd_lo [eval git_read ls-files --others -z $ls_others]
1347 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1349 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1350 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1351 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1352 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1353 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1354}
1355proc load_message {file} {
1357 global ui_comm
1358 set f [gitdir $file]
1360 if {[file isfile $f]} {
1361 if {[catch {set fd [open $f r]}]} {
1362 return 0
1363 }
1364 fconfigure $fd -eofchar {}
1365 set content [string trim [read $fd]]
1366 close $fd
1367 regsub -all -line {[ \r\t]+$} $content {} content
1368 $ui_comm delete 0.0 end
1369 $ui_comm insert end $content
1370 return 1
1371 }
1372 return 0
1373}
1374proc run_prepare_commit_msg_hook {} {
1376 global pch_error
1377 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1379 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1380 # empty file but existant file.
1381 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1383 if {[file isfile [gitdir MERGE_MSG]]} {
1385 set pcm_source "merge"
1386 set fd_mm [open [gitdir MERGE_MSG] r]
1387 puts -nonewline $fd_pcm [read $fd_mm]
1388 close $fd_mm
1389 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1390 set pcm_source "squash"
1391 set fd_sm [open [gitdir SQUASH_MSG] r]
1392 puts -nonewline $fd_pcm [read $fd_sm]
1393 close $fd_sm
1394 } else {
1395 set pcm_source ""
1396 }
1397 close $fd_pcm
1399 set fd_ph [githook_read prepare-commit-msg \
1401 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1402 if {$fd_ph eq {}} {
1403 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1404 return 0;
1405 }
1406 ui_status [mc "Calling prepare-commit-msg hook..."]
1408 set pch_error {}
1409 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1411 fileevent $fd_ph readable \
1412 [list prepare_commit_msg_hook_wait $fd_ph]
1413 return 1;
1415}
1416proc prepare_commit_msg_hook_wait {fd_ph} {
1418 global pch_error
1419 append pch_error [read $fd_ph]
1421 fconfigure $fd_ph -blocking 1
1422 if {[eof $fd_ph]} {
1423 if {[catch {close $fd_ph}]} {
1424 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1425 hook_failed_popup prepare-commit-msg $pch_error
1426 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1427 exit 1
1428 } else {
1429 load_message PREPARE_COMMIT_MSG
1430 }
1431 set pch_error {}
1432 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1433 return
1434 }
1435 fconfigure $fd_ph -blocking 0
1436 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1437}
1438proc read_diff_index {fd after} {
1440 global buf_rdi
1441 append buf_rdi [read $fd]
1443 set c 0
1444 set n [string length $buf_rdi]
1445 while {$c < $n} {
1446 set z1 [string first "\0" $buf_rdi $c]
1447 if {$z1 == -1} break
1448 incr z1
1449 set z2 [string first "\0" $buf_rdi $z1]
1450 if {$z2 == -1} break
1451 incr c
1453 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1454 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1455 merge_state \
1456 [encoding convertfrom $p] \
1457 [lindex $i 4]? \
1458 [list [lindex $i 0] [lindex $i 2]] \
1459 [list]
1460 set c $z2
1461 incr c
1462 }
1463 if {$c < $n} {
1464 set buf_rdi [string range $buf_rdi $c end]
1465 } else {
1466 set buf_rdi {}
1467 }
1468 rescan_done $fd buf_rdi $after
1470}
1471proc read_diff_files {fd after} {
1473 global buf_rdf
1474 append buf_rdf [read $fd]
1476 set c 0
1477 set n [string length $buf_rdf]
1478 while {$c < $n} {
1479 set z1 [string first "\0" $buf_rdf $c]
1480 if {$z1 == -1} break
1481 incr z1
1482 set z2 [string first "\0" $buf_rdf $z1]
1483 if {$z2 == -1} break
1484 incr c
1486 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1487 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1488 merge_state \
1489 [encoding convertfrom $p] \
1490 ?[lindex $i 4] \
1491 [list] \
1492 [list [lindex $i 0] [lindex $i 2]]
1493 set c $z2
1494 incr c
1495 }
1496 if {$c < $n} {
1497 set buf_rdf [string range $buf_rdf $c end]
1498 } else {
1499 set buf_rdf {}
1500 }
1501 rescan_done $fd buf_rdf $after
1503}
1504proc read_ls_others {fd after} {
1506 global buf_rlo
1507 append buf_rlo [read $fd]
1509 set pck [split $buf_rlo "\0"]
1510 set buf_rlo [lindex $pck end]
1511 foreach p [lrange $pck 0 end-1] {
1512 set p [encoding convertfrom $p]
1513 if {[string index $p end] eq {/}} {
1514 set p [string range $p 0 end-1]
1515 }
1516 merge_state $p ?O
1517 }
1518 rescan_done $fd buf_rlo $after
1519}
1520proc rescan_done {fd buf after} {
1522 global rescan_active current_diff_path
1523 global file_states repo_config
1524 upvar $buf to_clear
1525 if {![eof $fd]} return
1527 set to_clear {}
1528 close $fd
1529 if {[incr rescan_active -1] > 0} return
1530 prune_selection
1532 unlock_index
1533 display_all_files
1534 if {$current_diff_path ne {}} { reshow_diff $after }
1535 if {$current_diff_path eq {}} { select_first_diff $after }
1536}
1537proc prune_selection {} {
1539 global file_states selected_paths
1540 foreach path [array names selected_paths] {
1542 if {[catch {set still_here $file_states($path)}]} {
1543 unset selected_paths($path)
1544 }
1545 }
1546}
1547######################################################################
1549##
1550## ui helpers
1551proc mapicon {w state path} {
1553 global all_icons
1554 if {[catch {set r $all_icons($state$w)}]} {
1556 puts "error: no icon for $w state={$state} $path"
1557 return file_plain
1558 }
1559 return $r
1560}
1561proc mapdesc {state path} {
1563 global all_descs
1564 if {[catch {set r $all_descs($state)}]} {
1566 puts "error: no desc for state={$state} $path"
1567 return $state
1568 }
1569 return $r
1570}
1571proc ui_status {msg} {
1573 global main_status
1574 if {[info exists main_status]} {
1575 $main_status show $msg
1576 }
1577}
1578proc ui_ready {{test {}}} {
1580 global main_status
1581 if {[info exists main_status]} {
1582 $main_status show [mc "Ready."] $test
1583 }
1584}
1585proc escape_path {path} {
1587 regsub -all {\\} $path "\\\\" path
1588 regsub -all "\n" $path "\\n" path
1589 return $path
1590}
1591proc short_path {path} {
1593 return [escape_path [lindex [file split $path] end]]
1594}
1595set next_icon_id 0
1597set null_sha1 [string repeat 0 40]
1598proc merge_state {path new_state {head_info {}} {index_info {}}} {
1600 global file_states next_icon_id null_sha1
1601 set s0 [string index $new_state 0]
1603 set s1 [string index $new_state 1]
1604 if {[catch {set info $file_states($path)}]} {
1606 set state __
1607 set icon n[incr next_icon_id]
1608 } else {
1609 set state [lindex $info 0]
1610 set icon [lindex $info 1]
1611 if {$head_info eq {}} {set head_info [lindex $info 2]}
1612 if {$index_info eq {}} {set index_info [lindex $info 3]}
1613 }
1614 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1616 elseif {$s0 eq {_}} {set s0 _}
1617 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1619 elseif {$s1 eq {_}} {set s1 _}
1620 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1622 set head_info [list 0 $null_sha1]
1623 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1624 && $head_info eq {}} {
1625 set head_info $index_info
1626 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1627 set index_info $head_info
1628 set head_info {}
1629 }
1630 set file_states($path) [list $s0$s1 $icon \
1632 $head_info $index_info \
1633 ]
1634 return $state
1635}
1636proc display_file_helper {w path icon_name old_m new_m} {
1638 global file_lists
1639 if {$new_m eq {_}} {
1641 set lno [lsearch -sorted -exact $file_lists($w) $path]
1642 if {$lno >= 0} {
1643 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1644 incr lno
1645 $w conf -state normal
1646 $w delete $lno.0 [expr {$lno + 1}].0
1647 $w conf -state disabled
1648 }
1649 } elseif {$old_m eq {_} && $new_m ne {_}} {
1650 lappend file_lists($w) $path
1651 set file_lists($w) [lsort -unique $file_lists($w)]
1652 set lno [lsearch -sorted -exact $file_lists($w) $path]
1653 incr lno
1654 $w conf -state normal
1655 $w image create $lno.0 \
1656 -align center -padx 5 -pady 1 \
1657 -name $icon_name \
1658 -image [mapicon $w $new_m $path]
1659 $w insert $lno.1 "[escape_path $path]\n"
1660 $w conf -state disabled
1661 } elseif {$old_m ne $new_m} {
1662 $w conf -state normal
1663 $w image conf $icon_name -image [mapicon $w $new_m $path]
1664 $w conf -state disabled
1665 }
1666}
1667proc display_file {path state} {
1669 global file_states selected_paths
1670 global ui_index ui_workdir
1671 set old_m [merge_state $path $state]
1673 set s $file_states($path)
1674 set new_m [lindex $s 0]
1675 set icon_name [lindex $s 1]
1676 set o [string index $old_m 0]
1678 set n [string index $new_m 0]
1679 if {$o eq {U}} {
1680 set o _
1681 }
1682 if {$n eq {U}} {
1683 set n _
1684 }
1685 display_file_helper $ui_index $path $icon_name $o $n
1686 if {[string index $old_m 0] eq {U}} {
1688 set o U
1689 } else {
1690 set o [string index $old_m 1]
1691 }
1692 if {[string index $new_m 0] eq {U}} {
1693 set n U
1694 } else {
1695 set n [string index $new_m 1]
1696 }
1697 display_file_helper $ui_workdir $path $icon_name $o $n
1698 if {$new_m eq {__}} {
1700 unset file_states($path)
1701 catch {unset selected_paths($path)}
1702 }
1703}
1704proc display_all_files_helper {w path icon_name m} {
1706 global file_lists
1707 lappend file_lists($w) $path
1709 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1710 $w image create end \
1711 -align center -padx 5 -pady 1 \
1712 -name $icon_name \
1713 -image [mapicon $w $m $path]
1714 $w insert end "[escape_path $path]\n"
1715}
1716set files_warning 0
1718proc display_all_files {} {
1719 global ui_index ui_workdir
1720 global file_states file_lists
1721 global last_clicked
1722 global files_warning
1723 $ui_index conf -state normal
1725 $ui_workdir conf -state normal
1726 $ui_index delete 0.0 end
1728 $ui_workdir delete 0.0 end
1729 set last_clicked {}
1730 set file_lists($ui_index) [list]
1732 set file_lists($ui_workdir) [list]
1733 set to_display [lsort [array names file_states]]
1735 set display_limit [get_config gui.maxfilesdisplayed]
1736 if {[llength $to_display] > $display_limit} {
1737 if {!$files_warning} {
1738 # do not repeatedly warn:
1739 set files_warning 1
1740 info_popup [mc "Displaying only %s of %s files." \
1741 $display_limit [llength $to_display]]
1742 }
1743 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1744 }
1745 foreach path $to_display {
1746 set s $file_states($path)
1747 set m [lindex $s 0]
1748 set icon_name [lindex $s 1]
1749 set s [string index $m 0]
1751 if {$s ne {U} && $s ne {_}} {
1752 display_all_files_helper $ui_index $path \
1753 $icon_name $s
1754 }
1755 if {[string index $m 0] eq {U}} {
1757 set s U
1758 } else {
1759 set s [string index $m 1]
1760 }
1761 if {$s ne {_}} {
1762 display_all_files_helper $ui_workdir $path \
1763 $icon_name $s
1764 }
1765 }
1766 $ui_index conf -state disabled
1768 $ui_workdir conf -state disabled
1769}
1770######################################################################
1772##
1773## icons
1774set filemask {
1776#define mask_width 14
1777#define mask_height 15
1778static unsigned char mask_bits[] = {
1779 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1780 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1781 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1782}
1783image create bitmap file_plain -background white -foreground black -data {
1785#define plain_width 14
1786#define plain_height 15
1787static unsigned char plain_bits[] = {
1788 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1789 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1790 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1791} -maskdata $filemask
1792image create bitmap file_mod -background white -foreground blue -data {
1794#define mod_width 14
1795#define mod_height 15
1796static unsigned char mod_bits[] = {
1797 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1798 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1799 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1800} -maskdata $filemask
1801image create bitmap file_fulltick -background white -foreground "#007000" -data {
1803#define file_fulltick_width 14
1804#define file_fulltick_height 15
1805static unsigned char file_fulltick_bits[] = {
1806 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1807 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1808 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1809} -maskdata $filemask
1810image create bitmap file_parttick -background white -foreground "#005050" -data {
1812#define parttick_width 14
1813#define parttick_height 15
1814static unsigned char parttick_bits[] = {
1815 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1816 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1817 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1818} -maskdata $filemask
1819image create bitmap file_question -background white -foreground black -data {
1821#define file_question_width 14
1822#define file_question_height 15
1823static unsigned char file_question_bits[] = {
1824 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1825 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1826 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1827} -maskdata $filemask
1828image create bitmap file_removed -background white -foreground red -data {
1830#define file_removed_width 14
1831#define file_removed_height 15
1832static unsigned char file_removed_bits[] = {
1833 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1834 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1835 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1836} -maskdata $filemask
1837image create bitmap file_merge -background white -foreground blue -data {
1839#define file_merge_width 14
1840#define file_merge_height 15
1841static unsigned char file_merge_bits[] = {
1842 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1843 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1844 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1845} -maskdata $filemask
1846image create bitmap file_statechange -background white -foreground green -data {
1848#define file_merge_width 14
1849#define file_merge_height 15
1850static unsigned char file_statechange_bits[] = {
1851 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1852 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1853 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1854} -maskdata $filemask
1855set ui_index .vpane.files.index.list
1857set ui_workdir .vpane.files.workdir.list
1858set all_icons(_$ui_index) file_plain
1860set all_icons(A$ui_index) file_fulltick
1861set all_icons(M$ui_index) file_fulltick
1862set all_icons(D$ui_index) file_removed
1863set all_icons(U$ui_index) file_merge
1864set all_icons(T$ui_index) file_statechange
1865set all_icons(_$ui_workdir) file_plain
1867set all_icons(M$ui_workdir) file_mod
1868set all_icons(D$ui_workdir) file_question
1869set all_icons(U$ui_workdir) file_merge
1870set all_icons(O$ui_workdir) file_plain
1871set all_icons(T$ui_workdir) file_statechange
1872set max_status_desc 0
1874foreach i {
1875 {__ {mc "Unmodified"}}
1876 {_M {mc "Modified, not staged"}}
1878 {M_ {mc "Staged for commit"}}
1879 {MM {mc "Portions staged for commit"}}
1880 {MD {mc "Staged for commit, missing"}}
1881 {_T {mc "File type changed, not staged"}}
1883 {T_ {mc "File type changed, staged"}}
1884 {_O {mc "Untracked, not staged"}}
1886 {A_ {mc "Staged for commit"}}
1887 {AM {mc "Portions staged for commit"}}
1888 {AD {mc "Staged for commit, missing"}}
1889 {_D {mc "Missing"}}
1891 {D_ {mc "Staged for removal"}}
1892 {DO {mc "Staged for removal, still present"}}
1893 {_U {mc "Requires merge resolution"}}
1895 {U_ {mc "Requires merge resolution"}}
1896 {UU {mc "Requires merge resolution"}}
1897 {UM {mc "Requires merge resolution"}}
1898 {UD {mc "Requires merge resolution"}}
1899 {UT {mc "Requires merge resolution"}}
1900 } {
1901 set text [eval [lindex $i 1]]
1902 if {$max_status_desc < [string length $text]} {
1903 set max_status_desc [string length $text]
1904 }
1905 set all_descs([lindex $i 0]) $text
1906}
1907unset i
1908######################################################################
1910##
1911## util
1912proc scrollbar2many {list mode args} {
1914 foreach w $list {eval $w $mode $args}
1915}
1916proc many2scrollbar {list mode sb top bottom} {
1918 $sb set $top $bottom
1919 foreach w $list {$w $mode moveto $top}
1920}
1921proc incr_font_size {font {amt 1}} {
1923 set sz [font configure $font -size]
1924 incr sz $amt
1925 font configure $font -size $sz
1926 font configure ${font}bold -size $sz
1927 font configure ${font}italic -size $sz
1928}
1929######################################################################
1931##
1932## ui commands
1933set starting_gitk_msg [mc "Starting gitk... please wait..."]
1935proc do_gitk {revs} {
1937 # -- Always start gitk through whatever we were loaded with. This
1938 # lets us bypass using shell process on Windows systems.
1939 #
1940 set exe [_which gitk -script]
1941 set cmd [list [info nameofexecutable] $exe]
1942 if {$exe eq {}} {
1943 error_popup [mc "Couldn't find gitk in PATH"]
1944 } else {
1945 global env
1946 if {[info exists env(GIT_DIR)]} {
1948 set old_GIT_DIR $env(GIT_DIR)
1949 } else {
1950 set old_GIT_DIR {}
1951 }
1952 set pwd [pwd]
1954 cd [file dirname [gitdir]]
1955 set env(GIT_DIR) [file tail [gitdir]]
1956 eval exec $cmd $revs "--" "--" &
1958 if {$old_GIT_DIR eq {}} {
1960 unset env(GIT_DIR)
1961 } else {
1962 set env(GIT_DIR) $old_GIT_DIR
1963 }
1964 cd $pwd
1965 ui_status $::starting_gitk_msg
1967 after 10000 {
1968 ui_ready $starting_gitk_msg
1969 }
1970 }
1971}
1972proc do_explore {} {
1974 set explorer {}
1975 if {[is_Cygwin] || [is_Windows]} {
1976 set explorer "explorer.exe"
1977 } elseif {[is_MacOSX]} {
1978 set explorer "open"
1979 } else {
1980 # freedesktop.org-conforming system is our best shot
1981 set explorer "xdg-open"
1982 }
1983 eval exec $explorer [list [file nativename [file dirname [gitdir]]]] &
1984}
1985set is_quitting 0
1987set ret_code 1
1988proc terminate_me {win} {
1990 global ret_code
1991 if {$win ne {.}} return
1992 exit $ret_code
1993}
1994proc do_quit {{rc {1}}} {
1996 global ui_comm is_quitting repo_config commit_type
1997 global GITGUI_BCK_exists GITGUI_BCK_i
1998 global ui_comm_spell
1999 global ret_code
2000 if {$is_quitting} return
2002 set is_quitting 1
2003 if {[winfo exists $ui_comm]} {
2005 # -- Stash our current commit buffer.
2006 #
2007 set save [gitdir GITGUI_MSG]
2008 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2009 file rename -force [gitdir GITGUI_BCK] $save
2010 set GITGUI_BCK_exists 0
2011 } else {
2012 set msg [string trim [$ui_comm get 0.0 end]]
2013 regsub -all -line {[ \r\t]+$} $msg {} msg
2014 if {(![string match amend* $commit_type]
2015 || [$ui_comm edit modified])
2016 && $msg ne {}} {
2017 catch {
2018 set fd [open $save w]
2019 puts -nonewline $fd $msg
2020 close $fd
2021 }
2022 } else {
2023 catch {file delete $save}
2024 }
2025 }
2026 # -- Cancel our spellchecker if its running.
2028 #
2029 if {[info exists ui_comm_spell]} {
2030 $ui_comm_spell stop
2031 }
2032 # -- Remove our editor backup, its not needed.
2034 #
2035 after cancel $GITGUI_BCK_i
2036 if {$GITGUI_BCK_exists} {
2037 catch {file delete [gitdir GITGUI_BCK]}
2038 }
2039 # -- Stash our current window geometry into this repository.
2041 #
2042 set cfg_wmstate [wm state .]
2043 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2044 set rc_wmstate {}
2045 }
2046 if {$cfg_wmstate ne $rc_wmstate} {
2047 catch {git config gui.wmstate $cfg_wmstate}
2048 }
2049 if {$cfg_wmstate eq {zoomed}} {
2050 # on Windows wm geometry will lie about window
2051 # position (but not size) when window is zoomed
2052 # restore the window before querying wm geometry
2053 wm state . normal
2054 }
2055 set cfg_geometry [list]
2056 lappend cfg_geometry [wm geometry .]
2057 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2058 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2059 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2060 set rc_geometry {}
2061 }
2062 if {$cfg_geometry ne $rc_geometry} {
2063 catch {git config gui.geometry $cfg_geometry}
2064 }
2065 }
2066 set ret_code $rc
2068 # Briefly enable send again, working around Tk bug
2070 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2071 tk appname [appname]
2072 destroy .
2074}
2075proc do_rescan {} {
2077 rescan ui_ready
2078}
2079proc ui_do_rescan {} {
2081 rescan {force_first_diff ui_ready}
2082}
2083proc do_commit {} {
2085 commit_tree
2086}
2087proc next_diff {{after {}}} {
2089 global next_diff_p next_diff_w next_diff_i
2090 show_diff $next_diff_p $next_diff_w {} {} $after
2091}
2092proc find_anchor_pos {lst name} {
2094 set lid [lsearch -sorted -exact $lst $name]
2095 if {$lid == -1} {
2097 set lid 0
2098 foreach lname $lst {
2099 if {$lname >= $name} break
2100 incr lid
2101 }
2102 }
2103 return $lid
2105}
2106proc find_file_from {flist idx delta path mmask} {
2108 global file_states
2109 set len [llength $flist]
2111 while {$idx >= 0 && $idx < $len} {
2112 set name [lindex $flist $idx]
2113 if {$name ne $path && [info exists file_states($name)]} {
2115 set state [lindex $file_states($name) 0]
2116 if {$mmask eq {} || [regexp $mmask $state]} {
2118 return $idx
2119 }
2120 }
2121 incr idx $delta
2123 }
2124 return {}
2126}
2127proc find_next_diff {w path {lno {}} {mmask {}}} {
2129 global next_diff_p next_diff_w next_diff_i
2130 global file_lists ui_index ui_workdir
2131 set flist $file_lists($w)
2133 if {$lno eq {}} {
2134 set lno [find_anchor_pos $flist $path]
2135 } else {
2136 incr lno -1
2137 }
2138 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2140 if {$w eq $ui_index} {
2141 set mmask "^$mmask"
2142 } else {
2143 set mmask "$mmask\$"
2144 }
2145 }
2146 set idx [find_file_from $flist $lno 1 $path $mmask]
2148 if {$idx eq {}} {
2149 incr lno -1
2150 set idx [find_file_from $flist $lno -1 $path $mmask]
2151 }
2152 if {$idx ne {}} {
2154 set next_diff_w $w
2155 set next_diff_p [lindex $flist $idx]
2156 set next_diff_i [expr {$idx+1}]
2157 return 1
2158 } else {
2159 return 0
2160 }
2161}
2162proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2164 global current_diff_path
2165 if {$path ne $current_diff_path} {
2167 return {}
2168 } elseif {[find_next_diff $w $path $lno $mmask]} {
2169 return {next_diff;}
2170 } else {
2171 return {reshow_diff;}
2172 }
2173}
2174proc select_first_diff {after} {
2176 global ui_workdir
2177 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2179 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2180 next_diff $after
2181 } else {
2182 uplevel #0 $after
2183 }
2184}
2185proc force_first_diff {after} {
2187 global ui_workdir current_diff_path file_states
2188 if {[info exists file_states($current_diff_path)]} {
2190 set state [lindex $file_states($current_diff_path) 0]
2191 } else {
2192 set state {OO}
2193 }
2194 set reselect 0
2196 if {[string first {U} $state] >= 0} {
2197 # Already a conflict, do nothing
2198 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2199 set reselect 1
2200 } elseif {[string index $state 1] ne {O}} {
2201 # Already a diff & no conflicts, do nothing
2202 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2203 set reselect 1
2204 }
2205 if {$reselect} {
2207 next_diff $after
2208 } else {
2209 uplevel #0 $after
2210 }
2211}
2212proc toggle_or_diff {w x y} {
2214 global file_states file_lists current_diff_path ui_index ui_workdir
2215 global last_clicked selected_paths
2216 set pos [split [$w index @$x,$y] .]
2218 set lno [lindex $pos 0]
2219 set col [lindex $pos 1]
2220 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2221 if {$path eq {}} {
2222 set last_clicked {}
2223 return
2224 }
2225 set last_clicked [list $w $lno]
2227 array unset selected_paths
2228 $ui_index tag remove in_sel 0.0 end
2229 $ui_workdir tag remove in_sel 0.0 end
2230 # Determine the state of the file
2232 if {[info exists file_states($path)]} {
2233 set state [lindex $file_states($path) 0]
2234 } else {
2235 set state {__}
2236 }
2237 # Restage the file, or simply show the diff
2239 if {$col == 0 && $y > 1} {
2240 # Conflicts need special handling
2241 if {[string first {U} $state] >= 0} {
2242 # $w must always be $ui_workdir, but...
2243 if {$w ne $ui_workdir} { set lno {} }
2244 merge_stage_workdir $path $lno
2245 return
2246 }
2247 if {[string index $state 1] eq {O}} {
2249 set mmask {}
2250 } else {
2251 set mmask {[^O]}
2252 }
2253 set after [next_diff_after_action $w $path $lno $mmask]
2255 if {$w eq $ui_index} {
2257 update_indexinfo \
2258 "Unstaging [short_path $path] from commit" \
2259 [list $path] \
2260 [concat $after [list ui_ready]]
2261 } elseif {$w eq $ui_workdir} {
2262 update_index \
2263 "Adding [short_path $path]" \
2264 [list $path] \
2265 [concat $after [list ui_ready]]
2266 }
2267 } else {
2268 show_diff $path $w $lno
2269 }
2270}
2271proc add_one_to_selection {w x y} {
2273 global file_lists last_clicked selected_paths
2274 set lno [lindex [split [$w index @$x,$y] .] 0]
2276 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2277 if {$path eq {}} {
2278 set last_clicked {}
2279 return
2280 }
2281 if {$last_clicked ne {}
2283 && [lindex $last_clicked 0] ne $w} {
2284 array unset selected_paths
2285 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2286 }
2287 set last_clicked [list $w $lno]
2289 if {[catch {set in_sel $selected_paths($path)}]} {
2290 set in_sel 0
2291 }
2292 if {$in_sel} {
2293 unset selected_paths($path)
2294 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2295 } else {
2296 set selected_paths($path) 1
2297 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2298 }
2299}
2300proc add_range_to_selection {w x y} {
2302 global file_lists last_clicked selected_paths
2303 if {[lindex $last_clicked 0] ne $w} {
2305 toggle_or_diff $w $x $y
2306 return
2307 }
2308 set lno [lindex [split [$w index @$x,$y] .] 0]
2310 set lc [lindex $last_clicked 1]
2311 if {$lc < $lno} {
2312 set begin $lc
2313 set end $lno
2314 } else {
2315 set begin $lno
2316 set end $lc
2317 }
2318 foreach path [lrange $file_lists($w) \
2320 [expr {$begin - 1}] \
2321 [expr {$end - 1}]] {
2322 set selected_paths($path) 1
2323 }
2324 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2325}
2326proc show_more_context {} {
2328 global repo_config
2329 if {$repo_config(gui.diffcontext) < 99} {
2330 incr repo_config(gui.diffcontext)
2331 reshow_diff
2332 }
2333}
2334proc show_less_context {} {
2336 global repo_config
2337 if {$repo_config(gui.diffcontext) > 1} {
2338 incr repo_config(gui.diffcontext) -1
2339 reshow_diff
2340 }
2341}
2342######################################################################
2344##
2345## ui construction
2346load_config 0
2348apply_config
2349set ui_comm {}
2350# -- Menu Bar
2352#
2353menu .mbar -tearoff 0
2354if {[is_MacOSX]} {
2355 # -- Apple Menu (Mac OS X only)
2356 #
2357 .mbar add cascade -label Apple -menu .mbar.apple
2358 menu .mbar.apple
2359}
2360.mbar add cascade -label [mc Repository] -menu .mbar.repository
2361.mbar add cascade -label [mc Edit] -menu .mbar.edit
2362if {[is_enabled branch]} {
2363 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2364}
2365if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2366 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2367}
2368if {[is_enabled transport]} {
2369 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2370 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2371}
2372if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2373 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2374}
2375# -- Repository Menu
2377#
2378menu .mbar.repository
2379.mbar.repository add command \
2381 -label [mc "Explore Working Copy"] \
2382 -command {do_explore}
2383.mbar.repository add separator
2384.mbar.repository add command \
2386 -label [mc "Browse Current Branch's Files"] \
2387 -command {browser::new $current_branch}
2388set ui_browse_current [.mbar.repository index last]
2389.mbar.repository add command \
2390 -label [mc "Browse Branch Files..."] \
2391 -command browser_open::dialog
2392.mbar.repository add separator
2393.mbar.repository add command \
2395 -label [mc "Visualize Current Branch's History"] \
2396 -command {do_gitk $current_branch}
2397set ui_visualize_current [.mbar.repository index last]
2398.mbar.repository add command \
2399 -label [mc "Visualize All Branch History"] \
2400 -command {do_gitk --all}
2401.mbar.repository add separator
2402proc current_branch_write {args} {
2404 global current_branch
2405 .mbar.repository entryconf $::ui_browse_current \
2406 -label [mc "Browse %s's Files" $current_branch]
2407 .mbar.repository entryconf $::ui_visualize_current \
2408 -label [mc "Visualize %s's History" $current_branch]
2409}
2410trace add variable current_branch write current_branch_write
2411if {[is_enabled multicommit]} {
2413 .mbar.repository add command -label [mc "Database Statistics"] \
2414 -command do_stats
2415 .mbar.repository add command -label [mc "Compress Database"] \
2417 -command do_gc
2418 .mbar.repository add command -label [mc "Verify Database"] \
2420 -command do_fsck_objects
2421 .mbar.repository add separator
2423 if {[is_Cygwin]} {
2425 .mbar.repository add command \
2426 -label [mc "Create Desktop Icon"] \
2427 -command do_cygwin_shortcut
2428 } elseif {[is_Windows]} {
2429 .mbar.repository add command \
2430 -label [mc "Create Desktop Icon"] \
2431 -command do_windows_shortcut
2432 } elseif {[is_MacOSX]} {
2433 .mbar.repository add command \
2434 -label [mc "Create Desktop Icon"] \
2435 -command do_macosx_app
2436 }
2437}
2438if {[is_MacOSX]} {
2440 proc ::tk::mac::Quit {args} { do_quit }
2441} else {
2442 .mbar.repository add command -label [mc Quit] \
2443 -command do_quit \
2444 -accelerator $M1T-Q
2445}
2446# -- Edit Menu
2448#
2449menu .mbar.edit
2450.mbar.edit add command -label [mc Undo] \
2451 -command {catch {[focus] edit undo}} \
2452 -accelerator $M1T-Z
2453.mbar.edit add command -label [mc Redo] \
2454 -command {catch {[focus] edit redo}} \
2455 -accelerator $M1T-Y
2456.mbar.edit add separator
2457.mbar.edit add command -label [mc Cut] \
2458 -command {catch {tk_textCut [focus]}} \
2459 -accelerator $M1T-X
2460.mbar.edit add command -label [mc Copy] \
2461 -command {catch {tk_textCopy [focus]}} \
2462 -accelerator $M1T-C
2463.mbar.edit add command -label [mc Paste] \
2464 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2465 -accelerator $M1T-V
2466.mbar.edit add command -label [mc Delete] \
2467 -command {catch {[focus] delete sel.first sel.last}} \
2468 -accelerator Del
2469.mbar.edit add separator
2470.mbar.edit add command -label [mc "Select All"] \
2471 -command {catch {[focus] tag add sel 0.0 end}} \
2472 -accelerator $M1T-A
2473# -- Branch Menu
2475#
2476if {[is_enabled branch]} {
2477 menu .mbar.branch
2478 .mbar.branch add command -label [mc "Create..."] \
2480 -command branch_create::dialog \
2481 -accelerator $M1T-N
2482 lappend disable_on_lock [list .mbar.branch entryconf \
2483 [.mbar.branch index last] -state]
2484 .mbar.branch add command -label [mc "Checkout..."] \
2486 -command branch_checkout::dialog \
2487 -accelerator $M1T-O
2488 lappend disable_on_lock [list .mbar.branch entryconf \
2489 [.mbar.branch index last] -state]
2490 .mbar.branch add command -label [mc "Rename..."] \
2492 -command branch_rename::dialog
2493 lappend disable_on_lock [list .mbar.branch entryconf \
2494 [.mbar.branch index last] -state]
2495 .mbar.branch add command -label [mc "Delete..."] \
2497 -command branch_delete::dialog
2498 lappend disable_on_lock [list .mbar.branch entryconf \
2499 [.mbar.branch index last] -state]
2500 .mbar.branch add command -label [mc "Reset..."] \
2502 -command merge::reset_hard
2503 lappend disable_on_lock [list .mbar.branch entryconf \
2504 [.mbar.branch index last] -state]
2505}
2506# -- Commit Menu
2508#
2509proc commit_btn_caption {} {
2510 if {[is_enabled nocommit]} {
2511 return [mc "Done"]
2512 } else {
2513 return [mc Commit@@verb]
2514 }
2515}
2516if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2518 menu .mbar.commit
2519 if {![is_enabled nocommit]} {
2521 .mbar.commit add radiobutton \
2522 -label [mc "New Commit"] \
2523 -command do_select_commit_type \
2524 -variable selected_commit_type \
2525 -value new
2526 lappend disable_on_lock \
2527 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2528 .mbar.commit add radiobutton \
2530 -label [mc "Amend Last Commit"] \
2531 -command do_select_commit_type \
2532 -variable selected_commit_type \
2533 -value amend
2534 lappend disable_on_lock \
2535 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2536 .mbar.commit add separator
2538 }
2539 .mbar.commit add command -label [mc Rescan] \
2541 -command ui_do_rescan \
2542 -accelerator F5
2543 lappend disable_on_lock \
2544 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2545 .mbar.commit add command -label [mc "Stage To Commit"] \
2547 -command do_add_selection \
2548 -accelerator $M1T-T
2549 lappend disable_on_lock \
2550 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2551 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2553 -command do_add_all \
2554 -accelerator $M1T-I
2555 lappend disable_on_lock \
2556 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2557 .mbar.commit add command -label [mc "Unstage From Commit"] \
2559 -command do_unstage_selection \
2560 -accelerator $M1T-U
2561 lappend disable_on_lock \
2562 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2563 .mbar.commit add command -label [mc "Revert Changes"] \
2565 -command do_revert_selection \
2566 -accelerator $M1T-J
2567 lappend disable_on_lock \
2568 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2569 .mbar.commit add separator
2571 .mbar.commit add command -label [mc "Show Less Context"] \
2573 -command show_less_context \
2574 -accelerator $M1T-\-
2575 .mbar.commit add command -label [mc "Show More Context"] \
2577 -command show_more_context \
2578 -accelerator $M1T-=
2579 .mbar.commit add separator
2581 if {![is_enabled nocommitmsg]} {
2583 .mbar.commit add command -label [mc "Sign Off"] \
2584 -command do_signoff \
2585 -accelerator $M1T-S
2586 }
2587 .mbar.commit add command -label [commit_btn_caption] \
2589 -command do_commit \
2590 -accelerator $M1T-Return
2591 lappend disable_on_lock \
2592 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2593}
2594# -- Merge Menu
2596#
2597if {[is_enabled branch]} {
2598 menu .mbar.merge
2599 .mbar.merge add command -label [mc "Local Merge..."] \
2600 -command merge::dialog \
2601 -accelerator $M1T-M
2602 lappend disable_on_lock \
2603 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2604 .mbar.merge add command -label [mc "Abort Merge..."] \
2605 -command merge::reset_hard
2606 lappend disable_on_lock \
2607 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2608}
2609# -- Transport Menu
2611#
2612if {[is_enabled transport]} {
2613 menu .mbar.remote
2614 .mbar.remote add command \
2616 -label [mc "Add..."] \
2617 -command remote_add::dialog \
2618 -accelerator $M1T-A
2619 .mbar.remote add command \
2620 -label [mc "Push..."] \
2621 -command do_push_anywhere \
2622 -accelerator $M1T-P
2623 .mbar.remote add command \
2624 -label [mc "Delete Branch..."] \
2625 -command remote_branch_delete::dialog
2626}
2627if {[is_MacOSX]} {
2629 proc ::tk::mac::ShowPreferences {} {do_options}
2630} else {
2631 # -- Edit Menu
2632 #
2633 .mbar.edit add separator
2634 .mbar.edit add command -label [mc "Options..."] \
2635 -command do_options
2636}
2637# -- Tools Menu
2639#
2640if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2641 set tools_menubar .mbar.tools
2642 menu $tools_menubar
2643 $tools_menubar add separator
2644 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2645 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2646 set tools_tailcnt 3
2647 if {[array names repo_config guitool.*.cmd] ne {}} {
2648 tools_populate_all
2649 }
2650}
2651# -- Help Menu
2653#
2654.mbar add cascade -label [mc Help] -menu .mbar.help
2655menu .mbar.help
2656if {[is_MacOSX]} {
2658 .mbar.apple add command -label [mc "About %s" [appname]] \
2659 -command do_about
2660 .mbar.apple add separator
2661} else {
2662 .mbar.help add command -label [mc "About %s" [appname]] \
2663 -command do_about
2664}
2665. configure -menu .mbar
2666set doc_path [githtmldir]
2668if {$doc_path ne {}} {
2669 set doc_path [file join $doc_path index.html]
2670 if {[is_Cygwin]} {
2672 set doc_path [exec cygpath --mixed $doc_path]
2673 }
2674}
2675if {[file isfile $doc_path]} {
2677 set doc_url "file:$doc_path"
2678} else {
2679 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2680}
2681proc start_browser {url} {
2683 git "web--browse" $url
2684}
2685.mbar.help add command -label [mc "Online Documentation"] \
2687 -command [list start_browser $doc_url]
2688.mbar.help add command -label [mc "Show SSH Key"] \
2690 -command do_ssh_key
2691unset doc_path doc_url
2693# -- Standard bindings
2695#
2696wm protocol . WM_DELETE_WINDOW do_quit
2697bind all <$M1B-Key-q> do_quit
2698bind all <$M1B-Key-Q> do_quit
2699bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2700bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2701set subcommand_args {}
2703proc usage {} {
2704 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2705 exit 1
2706}
2707proc normalize_relpath {path} {
2709 set elements {}
2710 foreach item [file split $path] {
2711 if {$item eq {.}} continue
2712 if {$item eq {..} && [llength $elements] > 0
2713 && [lindex $elements end] ne {..}} {
2714 set elements [lrange $elements 0 end-1]
2715 continue
2716 }
2717 lappend elements $item
2718 }
2719 return [eval file join $elements]
2720}
2721# -- Not a normal commit type invocation? Do that instead!
2723#
2724switch -- $subcommand {
2725browser -
2726blame {
2727 if {$subcommand eq "blame"} {
2728 set subcommand_args {[--line=<num>] rev? path}
2729 } else {
2730 set subcommand_args {rev? path}
2731 }
2732 if {$argv eq {}} usage
2733 set head {}
2734 set path {}
2735 set jump_spec {}
2736 set is_path 0
2737 foreach a $argv {
2738 if {$is_path || [file exists $_prefix$a]} {
2739 if {$path ne {}} usage
2740 set path [normalize_relpath $_prefix$a]
2741 break
2742 } elseif {$a eq {--}} {
2743 if {$path ne {}} {
2744 if {$head ne {}} usage
2745 set head $path
2746 set path {}
2747 }
2748 set is_path 1
2749 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2750 if {$jump_spec ne {} || $head ne {}} usage
2751 set jump_spec [list $lnum]
2752 } elseif {$head eq {}} {
2753 if {$head ne {}} usage
2754 set head $a
2755 set is_path 1
2756 } else {
2757 usage
2758 }
2759 }
2760 unset is_path
2761 if {$head ne {} && $path eq {}} {
2763 set path [normalize_relpath $_prefix$head]
2764 set head {}
2765 }
2766 if {$head eq {}} {
2768 load_current_branch
2769 } else {
2770 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2771 if {[catch {
2772 set head [git rev-parse --verify $head]
2773 } err]} {
2774 puts stderr $err
2775 exit 1
2776 }
2777 }
2778 set current_branch $head
2779 }
2780 switch -- $subcommand {
2782 browser {
2783 if {$jump_spec ne {}} usage
2784 if {$head eq {}} {
2785 if {$path ne {} && [file isdirectory $path]} {
2786 set head $current_branch
2787 } else {
2788 set head $path
2789 set path {}
2790 }
2791 }
2792 browser::new $head $path
2793 }
2794 blame {
2795 if {$head eq {} && ![file exists $path]} {
2796 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2797 exit 1
2798 }
2799 blame::new $head $path $jump_spec
2800 }
2801 }
2802 return
2803}
2804citool -
2805gui {
2806 if {[llength $argv] != 0} {
2807 puts -nonewline stderr "usage: $argv0"
2808 if {$subcommand ne {gui}
2809 && [file tail $argv0] ne "git-$subcommand"} {
2810 puts -nonewline stderr " $subcommand"
2811 }
2812 puts stderr {}
2813 exit 1
2814 }
2815 # fall through to setup UI for commits
2816}
2817default {
2818 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2819 exit 1
2820}
2821}
2822# -- Branch Control
2824#
2825frame .branch \
2826 -borderwidth 1 \
2827 -relief sunken
2828label .branch.l1 \
2829 -text [mc "Current Branch:"] \
2830 -anchor w \
2831 -justify left
2832label .branch.cb \
2833 -textvariable current_branch \
2834 -anchor w \
2835 -justify left
2836pack .branch.l1 -side left
2837pack .branch.cb -side left -fill x
2838pack .branch -side top -fill x
2839# -- Main Window Layout
2841#
2842panedwindow .vpane -orient horizontal
2843panedwindow .vpane.files -orient vertical
2844.vpane add .vpane.files -sticky nsew -height 100 -width 200
2845pack .vpane -anchor n -side top -fill both -expand 1
2846# -- Index File List
2848#
2849frame .vpane.files.index -height 100 -width 200
2850label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2851 -background lightgreen -foreground black
2852text $ui_index -background white -foreground black \
2853 -borderwidth 0 \
2854 -width 20 -height 10 \
2855 -wrap none \
2856 -cursor $cursor_ptr \
2857 -xscrollcommand {.vpane.files.index.sx set} \
2858 -yscrollcommand {.vpane.files.index.sy set} \
2859 -state disabled
2860scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2861scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2862pack .vpane.files.index.title -side top -fill x
2863pack .vpane.files.index.sx -side bottom -fill x
2864pack .vpane.files.index.sy -side right -fill y
2865pack $ui_index -side left -fill both -expand 1
2866# -- Working Directory File List
2868#
2869frame .vpane.files.workdir -height 100 -width 200
2870label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2871 -background lightsalmon -foreground black
2872text $ui_workdir -background white -foreground black \
2873 -borderwidth 0 \
2874 -width 20 -height 10 \
2875 -wrap none \
2876 -cursor $cursor_ptr \
2877 -xscrollcommand {.vpane.files.workdir.sx set} \
2878 -yscrollcommand {.vpane.files.workdir.sy set} \
2879 -state disabled
2880scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2881scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2882pack .vpane.files.workdir.title -side top -fill x
2883pack .vpane.files.workdir.sx -side bottom -fill x
2884pack .vpane.files.workdir.sy -side right -fill y
2885pack $ui_workdir -side left -fill both -expand 1
2886.vpane.files add .vpane.files.workdir -sticky nsew
2888.vpane.files add .vpane.files.index -sticky nsew
2889foreach i [list $ui_index $ui_workdir] {
2891 rmsel_tag $i
2892 $i tag conf in_diff -background [$i tag cget in_sel -background]
2893}
2894unset i
2895# -- Diff and Commit Area
2897#
2898frame .vpane.lower -height 300 -width 400
2899frame .vpane.lower.commarea
2900frame .vpane.lower.diff -relief sunken -borderwidth 1
2901pack .vpane.lower.diff -fill both -expand 1
2902pack .vpane.lower.commarea -side bottom -fill x
2903.vpane add .vpane.lower -sticky nsew
2904# -- Commit Area Buttons
2906#
2907frame .vpane.lower.commarea.buttons
2908label .vpane.lower.commarea.buttons.l -text {} \
2909 -anchor w \
2910 -justify left
2911pack .vpane.lower.commarea.buttons.l -side top -fill x
2912pack .vpane.lower.commarea.buttons -side left -fill y
2913button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2915 -command ui_do_rescan
2916pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2917lappend disable_on_lock \
2918 {.vpane.lower.commarea.buttons.rescan conf -state}
2919button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2921 -command do_add_all
2922pack .vpane.lower.commarea.buttons.incall -side top -fill x
2923lappend disable_on_lock \
2924 {.vpane.lower.commarea.buttons.incall conf -state}
2925if {![is_enabled nocommitmsg]} {
2927 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2928 -command do_signoff
2929 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2930}
2931button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
2933 -command do_commit
2934pack .vpane.lower.commarea.buttons.commit -side top -fill x
2935lappend disable_on_lock \
2936 {.vpane.lower.commarea.buttons.commit conf -state}
2937if {![is_enabled nocommit]} {
2939 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2940 -command do_push_anywhere
2941 pack .vpane.lower.commarea.buttons.push -side top -fill x
2942}
2943# -- Commit Message Buffer
2945#
2946frame .vpane.lower.commarea.buffer
2947frame .vpane.lower.commarea.buffer.header
2948set ui_comm .vpane.lower.commarea.buffer.t
2949set ui_coml .vpane.lower.commarea.buffer.header.l
2950if {![is_enabled nocommit]} {
2952 radiobutton .vpane.lower.commarea.buffer.header.new \
2953 -text [mc "New Commit"] \
2954 -command do_select_commit_type \
2955 -variable selected_commit_type \
2956 -value new
2957 lappend disable_on_lock \
2958 [list .vpane.lower.commarea.buffer.header.new conf -state]
2959 radiobutton .vpane.lower.commarea.buffer.header.amend \
2960 -text [mc "Amend Last Commit"] \
2961 -command do_select_commit_type \
2962 -variable selected_commit_type \
2963 -value amend
2964 lappend disable_on_lock \
2965 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2966}
2967label $ui_coml \
2969 -anchor w \
2970 -justify left
2971proc trace_commit_type {varname args} {
2972 global ui_coml commit_type
2973 switch -glob -- $commit_type {
2974 initial {set txt [mc "Initial Commit Message:"]}
2975 amend {set txt [mc "Amended Commit Message:"]}
2976 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2977 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2978 merge {set txt [mc "Merge Commit Message:"]}
2979 * {set txt [mc "Commit Message:"]}
2980 }
2981 $ui_coml conf -text $txt
2982}
2983trace add variable commit_type write trace_commit_type
2984pack $ui_coml -side left -fill x
2985if {![is_enabled nocommit]} {
2987 pack .vpane.lower.commarea.buffer.header.amend -side right
2988 pack .vpane.lower.commarea.buffer.header.new -side right
2989}
2990text $ui_comm -background white -foreground black \
2992 -borderwidth 1 \
2993 -undo true \
2994 -maxundo 20 \
2995 -autoseparators true \
2996 -relief sunken \
2997 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
2998 -font font_diff \
2999 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3000scrollbar .vpane.lower.commarea.buffer.sby \
3001 -command [list $ui_comm yview]
3002pack .vpane.lower.commarea.buffer.header -side top -fill x
3003pack .vpane.lower.commarea.buffer.sby -side right -fill y
3004pack $ui_comm -side left -fill y
3005pack .vpane.lower.commarea.buffer -side left -fill y
3006# -- Commit Message Buffer Context Menu
3008#
3009set ctxm .vpane.lower.commarea.buffer.ctxm
3010menu $ctxm -tearoff 0
3011$ctxm add command \
3012 -label [mc Cut] \
3013 -command {tk_textCut $ui_comm}
3014$ctxm add command \
3015 -label [mc Copy] \
3016 -command {tk_textCopy $ui_comm}
3017$ctxm add command \
3018 -label [mc Paste] \
3019 -command {tk_textPaste $ui_comm}
3020$ctxm add command \
3021 -label [mc Delete] \
3022 -command {catch {$ui_comm delete sel.first sel.last}}
3023$ctxm add separator
3024$ctxm add command \
3025 -label [mc "Select All"] \
3026 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3027$ctxm add command \
3028 -label [mc "Copy All"] \
3029 -command {
3030 $ui_comm tag add sel 0.0 end
3031 tk_textCopy $ui_comm
3032 $ui_comm tag remove sel 0.0 end
3033 }
3034$ctxm add separator
3035$ctxm add command \
3036 -label [mc "Sign Off"] \
3037 -command do_signoff
3038set ui_comm_ctxm $ctxm
3039# -- Diff Header
3041#
3042proc trace_current_diff_path {varname args} {
3043 global current_diff_path diff_actions file_states
3044 if {$current_diff_path eq {}} {
3045 set s {}
3046 set f {}
3047 set p {}
3048 set o disabled
3049 } else {
3050 set p $current_diff_path
3051 set s [mapdesc [lindex $file_states($p) 0] $p]
3052 set f [mc "File:"]
3053 set p [escape_path $p]
3054 set o normal
3055 }
3056 .vpane.lower.diff.header.status configure -text $s
3058 .vpane.lower.diff.header.file configure -text $f
3059 .vpane.lower.diff.header.path configure -text $p
3060 foreach w $diff_actions {
3061 uplevel #0 $w $o
3062 }
3063}
3064trace add variable current_diff_path write trace_current_diff_path
3065frame .vpane.lower.diff.header -background gold
3067label .vpane.lower.diff.header.status \
3068 -background gold \
3069 -foreground black \
3070 -width $max_status_desc \
3071 -anchor w \
3072 -justify left
3073label .vpane.lower.diff.header.file \
3074 -background gold \
3075 -foreground black \
3076 -anchor w \
3077 -justify left
3078label .vpane.lower.diff.header.path \
3079 -background gold \
3080 -foreground black \
3081 -anchor w \
3082 -justify left
3083pack .vpane.lower.diff.header.status -side left
3084pack .vpane.lower.diff.header.file -side left
3085pack .vpane.lower.diff.header.path -fill x
3086set ctxm .vpane.lower.diff.header.ctxm
3087menu $ctxm -tearoff 0
3088$ctxm add command \
3089 -label [mc Copy] \
3090 -command {
3091 clipboard clear
3092 clipboard append \
3093 -format STRING \
3094 -type STRING \
3095 -- $current_diff_path
3096 }
3097lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3098bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3099# -- Diff Body
3101#
3102frame .vpane.lower.diff.body
3103set ui_diff .vpane.lower.diff.body.t
3104text $ui_diff -background white -foreground black \
3105 -borderwidth 0 \
3106 -width 80 -height 5 -wrap none \
3107 -font font_diff \
3108 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3109 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3110 -state disabled
3111scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3112 -command [list $ui_diff xview]
3113scrollbar .vpane.lower.diff.body.sby -orient vertical \
3114 -command [list $ui_diff yview]
3115pack .vpane.lower.diff.body.sbx -side bottom -fill x
3116pack .vpane.lower.diff.body.sby -side right -fill y
3117pack $ui_diff -side left -fill both -expand 1
3118pack .vpane.lower.diff.header -side top -fill x
3119pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3120$ui_diff tag conf d_cr -elide true
3122$ui_diff tag conf d_@ -foreground blue -font font_diffbold
3123$ui_diff tag conf d_+ -foreground {#00a000}
3124$ui_diff tag conf d_- -foreground red
3125$ui_diff tag conf d_++ -foreground {#00a000}
3127$ui_diff tag conf d_-- -foreground red
3128$ui_diff tag conf d_+s \
3129 -foreground {#00a000} \
3130 -background {#e2effa}
3131$ui_diff tag conf d_-s \
3132 -foreground red \
3133 -background {#e2effa}
3134$ui_diff tag conf d_s+ \
3135 -foreground {#00a000} \
3136 -background ivory1
3137$ui_diff tag conf d_s- \
3138 -foreground red \
3139 -background ivory1
3140$ui_diff tag conf d<<<<<<< \
3142 -foreground orange \
3143 -font font_diffbold
3144$ui_diff tag conf d======= \
3145 -foreground orange \
3146 -font font_diffbold
3147$ui_diff tag conf d>>>>>>> \
3148 -foreground orange \
3149 -font font_diffbold
3150$ui_diff tag raise sel
3152# -- Diff Body Context Menu
3154#
3155proc create_common_diff_popup {ctxm} {
3157 $ctxm add command \
3158 -label [mc "Show Less Context"] \
3159 -command show_less_context
3160 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3161 $ctxm add command \
3162 -label [mc "Show More Context"] \
3163 -command show_more_context
3164 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3165 $ctxm add separator
3166 $ctxm add command \
3167 -label [mc Refresh] \
3168 -command reshow_diff
3169 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3170 $ctxm add command \
3171 -label [mc Copy] \
3172 -command {tk_textCopy $ui_diff}
3173 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3174 $ctxm add command \
3175 -label [mc "Select All"] \
3176 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3177 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3178 $ctxm add command \
3179 -label [mc "Copy All"] \
3180 -command {
3181 $ui_diff tag add sel 0.0 end
3182 tk_textCopy $ui_diff
3183 $ui_diff tag remove sel 0.0 end
3184 }
3185 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3186 $ctxm add separator
3187 $ctxm add command \
3188 -label [mc "Decrease Font Size"] \
3189 -command {incr_font_size font_diff -1}
3190 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3191 $ctxm add command \
3192 -label [mc "Increase Font Size"] \
3193 -command {incr_font_size font_diff 1}
3194 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3195 $ctxm add separator
3196 set emenu $ctxm.enc
3197 menu $emenu
3198 build_encoding_menu $emenu [list force_diff_encoding]
3199 $ctxm add cascade \
3200 -label [mc "Encoding"] \
3201 -menu $emenu
3202 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3203 $ctxm add separator
3204 $ctxm add command -label [mc "Options..."] \
3205 -command do_options
3206}
3207set ctxm .vpane.lower.diff.body.ctxm
3209menu $ctxm -tearoff 0
3210$ctxm add command \
3211 -label [mc "Apply/Reverse Hunk"] \
3212 -command {apply_hunk $cursorX $cursorY}
3213set ui_diff_applyhunk [$ctxm index last]
3214lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3215$ctxm add command \
3216 -label [mc "Apply/Reverse Line"] \
3217 -command {apply_line $cursorX $cursorY; do_rescan}
3218set ui_diff_applyline [$ctxm index last]
3219lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3220$ctxm add separator
3221create_common_diff_popup $ctxm
3222set ctxmmg .vpane.lower.diff.body.ctxmmg
3224menu $ctxmmg -tearoff 0
3225$ctxmmg add command \
3226 -label [mc "Run Merge Tool"] \
3227 -command {merge_resolve_tool}
3228lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3229$ctxmmg add separator
3230$ctxmmg add command \
3231 -label [mc "Use Remote Version"] \
3232 -command {merge_resolve_one 3}
3233lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3234$ctxmmg add command \
3235 -label [mc "Use Local Version"] \
3236 -command {merge_resolve_one 2}
3237lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3238$ctxmmg add command \
3239 -label [mc "Revert To Base"] \
3240 -command {merge_resolve_one 1}
3241lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3242$ctxmmg add separator
3243create_common_diff_popup $ctxmmg
3244proc popup_diff_menu {ctxm ctxmmg x y X Y} {
3246 global current_diff_path file_states
3247 set ::cursorX $x
3248 set ::cursorY $y
3249 if {[info exists file_states($current_diff_path)]} {
3250 set state [lindex $file_states($current_diff_path) 0]
3251 } else {
3252 set state {__}
3253 }
3254 if {[string first {U} $state] >= 0} {
3255 tk_popup $ctxmmg $X $Y
3256 } else {
3257 if {$::ui_index eq $::current_diff_side} {
3258 set l [mc "Unstage Hunk From Commit"]
3259 set t [mc "Unstage Line From Commit"]
3260 } else {
3261 set l [mc "Stage Hunk For Commit"]
3262 set t [mc "Stage Line For Commit"]
3263 }
3264 if {$::is_3way_diff || $::is_submodule_diff
3265 || $current_diff_path eq {}
3266 || {__} eq $state
3267 || {_O} eq $state
3268 || {_T} eq $state
3269 || {T_} eq $state} {
3270 set s disabled
3271 } else {
3272 set s normal
3273 }
3274 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3275 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3276 tk_popup $ctxm $X $Y
3277 }
3278}
3279bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg %x %y %X %Y]
3280# -- Status Bar
3282#
3283set main_status [::status_bar::new .status]
3284pack .status -anchor w -side bottom -fill x
3285$main_status show [mc "Initializing..."]
3286# -- Load geometry
3288#
3289catch {
3290set gm $repo_config(gui.geometry)
3291wm geometry . [lindex $gm 0]
3292.vpane sash place 0 \
3293 [lindex $gm 1] \
3294 [lindex [.vpane sash coord 0] 1]
3295.vpane.files sash place 0 \
3296 [lindex [.vpane.files sash coord 0] 0] \
3297 [lindex $gm 2]
3298unset gm
3299}
3300# -- Load window state
3302#
3303catch {
3304set gws $repo_config(gui.wmstate)
3305wm state . $gws
3306unset gws
3307}
3308# -- Key Bindings
3310#
3311bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3312bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3313bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3314bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3315bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3316bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3317bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3318bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3319bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3320bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3321bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3322bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3323bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3324bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3325bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3326bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3327bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3328bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3329bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3330bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3331bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3332bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3333bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3335bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3336bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3337bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3338bind $ui_diff <$M1B-Key-v> {break}
3339bind $ui_diff <$M1B-Key-V> {break}
3340bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3341bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3342bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3343bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3344bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3345bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3346bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3347bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3348bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3349bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3350bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3351bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3352bind $ui_diff <Button-1> {focus %W}
3353if {[is_enabled branch]} {
3355 bind . <$M1B-Key-n> branch_create::dialog
3356 bind . <$M1B-Key-N> branch_create::dialog
3357 bind . <$M1B-Key-o> branch_checkout::dialog
3358 bind . <$M1B-Key-O> branch_checkout::dialog
3359 bind . <$M1B-Key-m> merge::dialog
3360 bind . <$M1B-Key-M> merge::dialog
3361}
3362if {[is_enabled transport]} {
3363 bind . <$M1B-Key-p> do_push_anywhere
3364 bind . <$M1B-Key-P> do_push_anywhere
3365}
3366bind . <Key-F5> ui_do_rescan
3368bind . <$M1B-Key-r> ui_do_rescan
3369bind . <$M1B-Key-R> ui_do_rescan
3370bind . <$M1B-Key-s> do_signoff
3371bind . <$M1B-Key-S> do_signoff
3372bind . <$M1B-Key-t> do_add_selection
3373bind . <$M1B-Key-T> do_add_selection
3374bind . <$M1B-Key-i> do_add_all
3375bind . <$M1B-Key-I> do_add_all
3376bind . <$M1B-Key-minus> {show_less_context;break}
3377bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3378bind . <$M1B-Key-equal> {show_more_context;break}
3379bind . <$M1B-Key-plus> {show_more_context;break}
3380bind . <$M1B-Key-KP_Add> {show_more_context;break}
3381bind . <$M1B-Key-Return> do_commit
3382foreach i [list $ui_index $ui_workdir] {
3383 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3384 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3385 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3386}
3387unset i
3388set file_lists($ui_index) [list]
3390set file_lists($ui_workdir) [list]
3391wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3393focus -force $ui_comm
3394# -- Warn the user about environmental problems. Cygwin's Tcl
3396# does *not* pass its env array onto any processes it spawns.
3397# This means that git processes get none of our environment.
3398#
3399if {[is_Cygwin]} {
3400 set ignored_env 0
3401 set suggest_user {}
3402 set msg [mc "Possible environment issues exist.
3403The following environment variables are probably
3405going to be ignored by any Git subprocess run
3406by %s:
3407" [appname]]
3409 foreach name [array names env] {
3410 switch -regexp -- $name {
3411 {^GIT_INDEX_FILE$} -
3412 {^GIT_OBJECT_DIRECTORY$} -
3413 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3414 {^GIT_DIFF_OPTS$} -
3415 {^GIT_EXTERNAL_DIFF$} -
3416 {^GIT_PAGER$} -
3417 {^GIT_TRACE$} -
3418 {^GIT_CONFIG$} -
3419 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3420 append msg " - $name\n"
3421 incr ignored_env
3422 }
3423 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3424 append msg " - $name\n"
3425 incr ignored_env
3426 set suggest_user $name
3427 }
3428 }
3429 }
3430 if {$ignored_env > 0} {
3431 append msg [mc "
3432This is due to a known issue with the
3433Tcl binary distributed by Cygwin."]
3434 if {$suggest_user ne {}} {
3436 append msg [mc "
3437A good replacement for %s
3439is placing values for the user.name and
3440user.email settings into your personal
3441~/.gitconfig file.
3442" $suggest_user]
3443 }
3444 warn_popup $msg
3445 }
3446 unset ignored_env msg suggest_user name
3447}
3448# -- Only initialize complex UI if we are going to stay running.
3450#
3451if {[is_enabled transport]} {
3452 load_all_remotes
3453 set n [.mbar.remote index end]
3455 populate_remotes_menu
3456 set n [expr {[.mbar.remote index end] - $n}]
3457 if {$n > 0} {
3458 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3459 .mbar.remote insert $n separator
3460 }
3461 unset n
3462}
3463if {[winfo exists $ui_comm]} {
3465 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3466 # -- If both our backup and message files exist use the
3468 # newer of the two files to initialize the buffer.
3469 #
3470 if {$GITGUI_BCK_exists} {
3471 set m [gitdir GITGUI_MSG]
3472 if {[file isfile $m]} {
3473 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3474 catch {file delete [gitdir GITGUI_MSG]}
3475 } else {
3476 $ui_comm delete 0.0 end
3477 $ui_comm edit reset
3478 $ui_comm edit modified false
3479 catch {file delete [gitdir GITGUI_BCK]}
3480 set GITGUI_BCK_exists 0
3481 }
3482 }
3483 unset m
3484 }
3485 proc backup_commit_buffer {} {
3487 global ui_comm GITGUI_BCK_exists
3488 set m [$ui_comm edit modified]
3490 if {$m || $GITGUI_BCK_exists} {
3491 set msg [string trim [$ui_comm get 0.0 end]]
3492 regsub -all -line {[ \r\t]+$} $msg {} msg
3493 if {$msg eq {}} {
3495 if {$GITGUI_BCK_exists} {
3496 catch {file delete [gitdir GITGUI_BCK]}
3497 set GITGUI_BCK_exists 0
3498 }
3499 } elseif {$m} {
3500 catch {
3501 set fd [open [gitdir GITGUI_BCK] w]
3502 puts -nonewline $fd $msg
3503 close $fd
3504 set GITGUI_BCK_exists 1
3505 }
3506 }
3507 $ui_comm edit modified false
3509 }
3510 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3512 }
3513 backup_commit_buffer
3515 # -- If the user has aspell available we can drive it
3517 # in pipe mode to spellcheck the commit message.
3518 #
3519 set spell_cmd [list |]
3520 set spell_dict [get_config gui.spellingdictionary]
3521 lappend spell_cmd aspell
3522 if {$spell_dict ne {}} {
3523 lappend spell_cmd --master=$spell_dict
3524 }
3525 lappend spell_cmd --mode=none
3526 lappend spell_cmd --encoding=utf-8
3527 lappend spell_cmd pipe
3528 if {$spell_dict eq {none}
3529 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3530 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3531 } else {
3532 set ui_comm_spell [spellcheck::init \
3533 $spell_fd \
3534 $ui_comm \
3535 $ui_comm_ctxm \
3536 ]
3537 }
3538 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3539}
3540lock_index begin-read
3542if {![winfo ismapped .]} {
3543 wm deiconify .
3544}
3545after 1 {
3546 if {[is_enabled initialamend]} {
3547 force_amend
3548 } else {
3549 do_rescan
3550 }
3551 if {[is_enabled nocommitmsg]} {
3553 $ui_comm configure -state disabled -background gray
3554 }
3555}
3556if {[is_enabled multicommit]} {
3557 after 1000 hint_gc
3558}
3559if {[is_enabled retcode]} {
3560 bind . <Destroy> {+terminate_me %W}
3561}
3562if {$picked && [is_config_true gui.autoexplore]} {
3563 do_explore
3564}