e3473a81a6b63bfb7b9cd1907ad384957235bbf4
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 set _gitdir [git rev-parse --git-dir]
1078 set _prefix [git rev-parse --show-prefix]
1079 } err]} {
1080 load_config 1
1081 apply_config
1082 choose_repository::pick
1083 set picked 1
1084}
1085if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1086 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1087}
1088if {![file isdirectory $_gitdir]} {
1089 catch {wm withdraw .}
1090 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1091 exit 1
1092}
1093if {$_prefix ne {}} {
1094 regsub -all {[^/]+/} $_prefix ../ cdup
1095 if {[catch {cd $cdup} err]} {
1096 catch {wm withdraw .}
1097 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1098 exit 1
1099 }
1100 unset cdup
1101} elseif {![is_enabled bare]} {
1102 if {[lindex [file split $_gitdir] end] ne {.git}} {
1103 catch {wm withdraw .}
1104 error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
1105 exit 1
1106 }
1107 if {[catch {cd [file dirname $_gitdir]} err]} {
1108 catch {wm withdraw .}
1109 error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
1110 exit 1
1111 }
1112}
1113set _reponame [file split [file normalize $_gitdir]]
1114if {[lindex $_reponame end] eq {.git}} {
1115 set _reponame [lindex $_reponame end-1]
1116} else {
1117 set _reponame [lindex $_reponame end]
1118}
1119######################################################################
1121##
1122## global init
1123set current_diff_path {}
1125set current_diff_side {}
1126set diff_actions [list]
1127set HEAD {}
1129set PARENT {}
1130set MERGE_HEAD [list]
1131set commit_type {}
1132set empty_tree {}
1133set current_branch {}
1134set is_detached 0
1135set current_diff_path {}
1136set is_3way_diff 0
1137set is_submodule_diff 0
1138set is_conflict_diff 0
1139set selected_commit_type new
1140set diff_empty_count 0
1141set nullid "0000000000000000000000000000000000000000"
1143set nullid2 "0000000000000000000000000000000000000001"
1144######################################################################
1146##
1147## task management
1148set rescan_active 0
1150set diff_active 0
1151set last_clicked {}
1152set disable_on_lock [list]
1154set index_lock_type none
1155proc lock_index {type} {
1157 global index_lock_type disable_on_lock
1158 if {$index_lock_type eq {none}} {
1160 set index_lock_type $type
1161 foreach w $disable_on_lock {
1162 uplevel #0 $w disabled
1163 }
1164 return 1
1165 } elseif {$index_lock_type eq "begin-$type"} {
1166 set index_lock_type $type
1167 return 1
1168 }
1169 return 0
1170}
1171proc unlock_index {} {
1173 global index_lock_type disable_on_lock
1174 set index_lock_type none
1176 foreach w $disable_on_lock {
1177 uplevel #0 $w normal
1178 }
1179}
1180######################################################################
1182##
1183## status
1184proc repository_state {ctvar hdvar mhvar} {
1186 global current_branch
1187 upvar $ctvar ct $hdvar hd $mhvar mh
1188 set mh [list]
1190 load_current_branch
1192 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1193 set hd {}
1194 set ct initial
1195 return
1196 }
1197 set merge_head [gitdir MERGE_HEAD]
1199 if {[file exists $merge_head]} {
1200 set ct merge
1201 set fd_mh [open $merge_head r]
1202 while {[gets $fd_mh line] >= 0} {
1203 lappend mh $line
1204 }
1205 close $fd_mh
1206 return
1207 }
1208 set ct normal
1210}
1211proc PARENT {} {
1213 global PARENT empty_tree
1214 set p [lindex $PARENT 0]
1216 if {$p ne {}} {
1217 return $p
1218 }
1219 if {$empty_tree eq {}} {
1220 set empty_tree [git mktree << {}]
1221 }
1222 return $empty_tree
1223}
1224proc force_amend {} {
1226 global selected_commit_type
1227 global HEAD PARENT MERGE_HEAD commit_type
1228 repository_state newType newHEAD newMERGE_HEAD
1230 set HEAD $newHEAD
1231 set PARENT $newHEAD
1232 set MERGE_HEAD $newMERGE_HEAD
1233 set commit_type $newType
1234 set selected_commit_type amend
1236 do_select_commit_type
1237}
1238proc rescan {after {honor_trustmtime 1}} {
1240 global HEAD PARENT MERGE_HEAD commit_type
1241 global ui_index ui_workdir ui_comm
1242 global rescan_active file_states
1243 global repo_config
1244 if {$rescan_active > 0 || ![lock_index read]} return
1246 repository_state newType newHEAD newMERGE_HEAD
1248 if {[string match amend* $commit_type]
1249 && $newType eq {normal}
1250 && $newHEAD eq $HEAD} {
1251 } else {
1252 set HEAD $newHEAD
1253 set PARENT $newHEAD
1254 set MERGE_HEAD $newMERGE_HEAD
1255 set commit_type $newType
1256 }
1257 array unset file_states
1259 if {!$::GITGUI_BCK_exists &&
1261 (![$ui_comm edit modified]
1262 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1263 if {[string match amend* $commit_type]} {
1264 } elseif {[load_message GITGUI_MSG]} {
1265 } elseif {[run_prepare_commit_msg_hook]} {
1266 } elseif {[load_message MERGE_MSG]} {
1267 } elseif {[load_message SQUASH_MSG]} {
1268 }
1269 $ui_comm edit reset
1270 $ui_comm edit modified false
1271 }
1272 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1274 rescan_stage2 {} $after
1275 } else {
1276 set rescan_active 1
1277 ui_status [mc "Refreshing file status..."]
1278 set fd_rf [git_read update-index \
1279 -q \
1280 --unmerged \
1281 --ignore-missing \
1282 --refresh \
1283 ]
1284 fconfigure $fd_rf -blocking 0 -translation binary
1285 fileevent $fd_rf readable \
1286 [list rescan_stage2 $fd_rf $after]
1287 }
1288}
1289if {[is_Cygwin]} {
1291 set is_git_info_exclude {}
1292 proc have_info_exclude {} {
1293 global is_git_info_exclude
1294 if {$is_git_info_exclude eq {}} {
1296 if {[catch {exec test -f [gitdir info exclude]}]} {
1297 set is_git_info_exclude 0
1298 } else {
1299 set is_git_info_exclude 1
1300 }
1301 }
1302 return $is_git_info_exclude
1303 }
1304} else {
1305 proc have_info_exclude {} {
1306 return [file readable [gitdir info exclude]]
1307 }
1308}
1309proc rescan_stage2 {fd after} {
1311 global rescan_active buf_rdi buf_rdf buf_rlo
1312 if {$fd ne {}} {
1314 read $fd
1315 if {![eof $fd]} return
1316 close $fd
1317 }
1318 set ls_others [list --exclude-per-directory=.gitignore]
1320 if {[have_info_exclude]} {
1321 lappend ls_others "--exclude-from=[gitdir info exclude]"
1322 }
1323 set user_exclude [get_config core.excludesfile]
1324 if {$user_exclude ne {} && [file readable $user_exclude]} {
1325 lappend ls_others "--exclude-from=$user_exclude"
1326 }
1327 set buf_rdi {}
1329 set buf_rdf {}
1330 set buf_rlo {}
1331 set rescan_active 3
1333 ui_status [mc "Scanning for modified files ..."]
1334 set fd_di [git_read diff-index --cached -z [PARENT]]
1335 set fd_df [git_read diff-files -z]
1336 set fd_lo [eval git_read ls-files --others -z $ls_others]
1337 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1339 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1340 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1341 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1342 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1343 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1344}
1345proc load_message {file} {
1347 global ui_comm
1348 set f [gitdir $file]
1350 if {[file isfile $f]} {
1351 if {[catch {set fd [open $f r]}]} {
1352 return 0
1353 }
1354 fconfigure $fd -eofchar {}
1355 set content [string trim [read $fd]]
1356 close $fd
1357 regsub -all -line {[ \r\t]+$} $content {} content
1358 $ui_comm delete 0.0 end
1359 $ui_comm insert end $content
1360 return 1
1361 }
1362 return 0
1363}
1364proc run_prepare_commit_msg_hook {} {
1366 global pch_error
1367 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1369 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1370 # empty file but existant file.
1371 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1373 if {[file isfile [gitdir MERGE_MSG]]} {
1375 set pcm_source "merge"
1376 set fd_mm [open [gitdir MERGE_MSG] r]
1377 puts -nonewline $fd_pcm [read $fd_mm]
1378 close $fd_mm
1379 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1380 set pcm_source "squash"
1381 set fd_sm [open [gitdir SQUASH_MSG] r]
1382 puts -nonewline $fd_pcm [read $fd_sm]
1383 close $fd_sm
1384 } else {
1385 set pcm_source ""
1386 }
1387 close $fd_pcm
1389 set fd_ph [githook_read prepare-commit-msg \
1391 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1392 if {$fd_ph eq {}} {
1393 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1394 return 0;
1395 }
1396 ui_status [mc "Calling prepare-commit-msg hook..."]
1398 set pch_error {}
1399 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1401 fileevent $fd_ph readable \
1402 [list prepare_commit_msg_hook_wait $fd_ph]
1403 return 1;
1405}
1406proc prepare_commit_msg_hook_wait {fd_ph} {
1408 global pch_error
1409 append pch_error [read $fd_ph]
1411 fconfigure $fd_ph -blocking 1
1412 if {[eof $fd_ph]} {
1413 if {[catch {close $fd_ph}]} {
1414 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1415 hook_failed_popup prepare-commit-msg $pch_error
1416 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1417 exit 1
1418 } else {
1419 load_message PREPARE_COMMIT_MSG
1420 }
1421 set pch_error {}
1422 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1423 return
1424 }
1425 fconfigure $fd_ph -blocking 0
1426 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1427}
1428proc read_diff_index {fd after} {
1430 global buf_rdi
1431 append buf_rdi [read $fd]
1433 set c 0
1434 set n [string length $buf_rdi]
1435 while {$c < $n} {
1436 set z1 [string first "\0" $buf_rdi $c]
1437 if {$z1 == -1} break
1438 incr z1
1439 set z2 [string first "\0" $buf_rdi $z1]
1440 if {$z2 == -1} break
1441 incr c
1443 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1444 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1445 merge_state \
1446 [encoding convertfrom $p] \
1447 [lindex $i 4]? \
1448 [list [lindex $i 0] [lindex $i 2]] \
1449 [list]
1450 set c $z2
1451 incr c
1452 }
1453 if {$c < $n} {
1454 set buf_rdi [string range $buf_rdi $c end]
1455 } else {
1456 set buf_rdi {}
1457 }
1458 rescan_done $fd buf_rdi $after
1460}
1461proc read_diff_files {fd after} {
1463 global buf_rdf
1464 append buf_rdf [read $fd]
1466 set c 0
1467 set n [string length $buf_rdf]
1468 while {$c < $n} {
1469 set z1 [string first "\0" $buf_rdf $c]
1470 if {$z1 == -1} break
1471 incr z1
1472 set z2 [string first "\0" $buf_rdf $z1]
1473 if {$z2 == -1} break
1474 incr c
1476 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1477 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1478 merge_state \
1479 [encoding convertfrom $p] \
1480 ?[lindex $i 4] \
1481 [list] \
1482 [list [lindex $i 0] [lindex $i 2]]
1483 set c $z2
1484 incr c
1485 }
1486 if {$c < $n} {
1487 set buf_rdf [string range $buf_rdf $c end]
1488 } else {
1489 set buf_rdf {}
1490 }
1491 rescan_done $fd buf_rdf $after
1493}
1494proc read_ls_others {fd after} {
1496 global buf_rlo
1497 append buf_rlo [read $fd]
1499 set pck [split $buf_rlo "\0"]
1500 set buf_rlo [lindex $pck end]
1501 foreach p [lrange $pck 0 end-1] {
1502 set p [encoding convertfrom $p]
1503 if {[string index $p end] eq {/}} {
1504 set p [string range $p 0 end-1]
1505 }
1506 merge_state $p ?O
1507 }
1508 rescan_done $fd buf_rlo $after
1509}
1510proc rescan_done {fd buf after} {
1512 global rescan_active current_diff_path
1513 global file_states repo_config
1514 upvar $buf to_clear
1515 if {![eof $fd]} return
1517 set to_clear {}
1518 close $fd
1519 if {[incr rescan_active -1] > 0} return
1520 prune_selection
1522 unlock_index
1523 display_all_files
1524 if {$current_diff_path ne {}} { reshow_diff $after }
1525 if {$current_diff_path eq {}} { select_first_diff $after }
1526}
1527proc prune_selection {} {
1529 global file_states selected_paths
1530 foreach path [array names selected_paths] {
1532 if {[catch {set still_here $file_states($path)}]} {
1533 unset selected_paths($path)
1534 }
1535 }
1536}
1537######################################################################
1539##
1540## ui helpers
1541proc mapicon {w state path} {
1543 global all_icons
1544 if {[catch {set r $all_icons($state$w)}]} {
1546 puts "error: no icon for $w state={$state} $path"
1547 return file_plain
1548 }
1549 return $r
1550}
1551proc mapdesc {state path} {
1553 global all_descs
1554 if {[catch {set r $all_descs($state)}]} {
1556 puts "error: no desc for state={$state} $path"
1557 return $state
1558 }
1559 return $r
1560}
1561proc ui_status {msg} {
1563 global main_status
1564 if {[info exists main_status]} {
1565 $main_status show $msg
1566 }
1567}
1568proc ui_ready {{test {}}} {
1570 global main_status
1571 if {[info exists main_status]} {
1572 $main_status show [mc "Ready."] $test
1573 }
1574}
1575proc escape_path {path} {
1577 regsub -all {\\} $path "\\\\" path
1578 regsub -all "\n" $path "\\n" path
1579 return $path
1580}
1581proc short_path {path} {
1583 return [escape_path [lindex [file split $path] end]]
1584}
1585set next_icon_id 0
1587set null_sha1 [string repeat 0 40]
1588proc merge_state {path new_state {head_info {}} {index_info {}}} {
1590 global file_states next_icon_id null_sha1
1591 set s0 [string index $new_state 0]
1593 set s1 [string index $new_state 1]
1594 if {[catch {set info $file_states($path)}]} {
1596 set state __
1597 set icon n[incr next_icon_id]
1598 } else {
1599 set state [lindex $info 0]
1600 set icon [lindex $info 1]
1601 if {$head_info eq {}} {set head_info [lindex $info 2]}
1602 if {$index_info eq {}} {set index_info [lindex $info 3]}
1603 }
1604 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1606 elseif {$s0 eq {_}} {set s0 _}
1607 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1609 elseif {$s1 eq {_}} {set s1 _}
1610 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1612 set head_info [list 0 $null_sha1]
1613 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1614 && $head_info eq {}} {
1615 set head_info $index_info
1616 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1617 set index_info $head_info
1618 set head_info {}
1619 }
1620 set file_states($path) [list $s0$s1 $icon \
1622 $head_info $index_info \
1623 ]
1624 return $state
1625}
1626proc display_file_helper {w path icon_name old_m new_m} {
1628 global file_lists
1629 if {$new_m eq {_}} {
1631 set lno [lsearch -sorted -exact $file_lists($w) $path]
1632 if {$lno >= 0} {
1633 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1634 incr lno
1635 $w conf -state normal
1636 $w delete $lno.0 [expr {$lno + 1}].0
1637 $w conf -state disabled
1638 }
1639 } elseif {$old_m eq {_} && $new_m ne {_}} {
1640 lappend file_lists($w) $path
1641 set file_lists($w) [lsort -unique $file_lists($w)]
1642 set lno [lsearch -sorted -exact $file_lists($w) $path]
1643 incr lno
1644 $w conf -state normal
1645 $w image create $lno.0 \
1646 -align center -padx 5 -pady 1 \
1647 -name $icon_name \
1648 -image [mapicon $w $new_m $path]
1649 $w insert $lno.1 "[escape_path $path]\n"
1650 $w conf -state disabled
1651 } elseif {$old_m ne $new_m} {
1652 $w conf -state normal
1653 $w image conf $icon_name -image [mapicon $w $new_m $path]
1654 $w conf -state disabled
1655 }
1656}
1657proc display_file {path state} {
1659 global file_states selected_paths
1660 global ui_index ui_workdir
1661 set old_m [merge_state $path $state]
1663 set s $file_states($path)
1664 set new_m [lindex $s 0]
1665 set icon_name [lindex $s 1]
1666 set o [string index $old_m 0]
1668 set n [string index $new_m 0]
1669 if {$o eq {U}} {
1670 set o _
1671 }
1672 if {$n eq {U}} {
1673 set n _
1674 }
1675 display_file_helper $ui_index $path $icon_name $o $n
1676 if {[string index $old_m 0] eq {U}} {
1678 set o U
1679 } else {
1680 set o [string index $old_m 1]
1681 }
1682 if {[string index $new_m 0] eq {U}} {
1683 set n U
1684 } else {
1685 set n [string index $new_m 1]
1686 }
1687 display_file_helper $ui_workdir $path $icon_name $o $n
1688 if {$new_m eq {__}} {
1690 unset file_states($path)
1691 catch {unset selected_paths($path)}
1692 }
1693}
1694proc display_all_files_helper {w path icon_name m} {
1696 global file_lists
1697 lappend file_lists($w) $path
1699 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1700 $w image create end \
1701 -align center -padx 5 -pady 1 \
1702 -name $icon_name \
1703 -image [mapicon $w $m $path]
1704 $w insert end "[escape_path $path]\n"
1705}
1706set files_warning 0
1708proc display_all_files {} {
1709 global ui_index ui_workdir
1710 global file_states file_lists
1711 global last_clicked
1712 global files_warning
1713 $ui_index conf -state normal
1715 $ui_workdir conf -state normal
1716 $ui_index delete 0.0 end
1718 $ui_workdir delete 0.0 end
1719 set last_clicked {}
1720 set file_lists($ui_index) [list]
1722 set file_lists($ui_workdir) [list]
1723 set to_display [lsort [array names file_states]]
1725 set display_limit [get_config gui.maxfilesdisplayed]
1726 if {[llength $to_display] > $display_limit} {
1727 if {!$files_warning} {
1728 # do not repeatedly warn:
1729 set files_warning 1
1730 info_popup [mc "Displaying only %s of %s files." \
1731 $display_limit [llength $to_display]]
1732 }
1733 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1734 }
1735 foreach path $to_display {
1736 set s $file_states($path)
1737 set m [lindex $s 0]
1738 set icon_name [lindex $s 1]
1739 set s [string index $m 0]
1741 if {$s ne {U} && $s ne {_}} {
1742 display_all_files_helper $ui_index $path \
1743 $icon_name $s
1744 }
1745 if {[string index $m 0] eq {U}} {
1747 set s U
1748 } else {
1749 set s [string index $m 1]
1750 }
1751 if {$s ne {_}} {
1752 display_all_files_helper $ui_workdir $path \
1753 $icon_name $s
1754 }
1755 }
1756 $ui_index conf -state disabled
1758 $ui_workdir conf -state disabled
1759}
1760######################################################################
1762##
1763## icons
1764set filemask {
1766#define mask_width 14
1767#define mask_height 15
1768static unsigned char mask_bits[] = {
1769 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1770 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1771 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1772}
1773image create bitmap file_plain -background white -foreground black -data {
1775#define plain_width 14
1776#define plain_height 15
1777static unsigned char plain_bits[] = {
1778 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1779 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1780 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1781} -maskdata $filemask
1782image create bitmap file_mod -background white -foreground blue -data {
1784#define mod_width 14
1785#define mod_height 15
1786static unsigned char mod_bits[] = {
1787 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1788 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1789 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1790} -maskdata $filemask
1791image create bitmap file_fulltick -background white -foreground "#007000" -data {
1793#define file_fulltick_width 14
1794#define file_fulltick_height 15
1795static unsigned char file_fulltick_bits[] = {
1796 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1797 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1798 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1799} -maskdata $filemask
1800image create bitmap file_parttick -background white -foreground "#005050" -data {
1802#define parttick_width 14
1803#define parttick_height 15
1804static unsigned char parttick_bits[] = {
1805 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1806 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1807 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1808} -maskdata $filemask
1809image create bitmap file_question -background white -foreground black -data {
1811#define file_question_width 14
1812#define file_question_height 15
1813static unsigned char file_question_bits[] = {
1814 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1815 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1816 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1817} -maskdata $filemask
1818image create bitmap file_removed -background white -foreground red -data {
1820#define file_removed_width 14
1821#define file_removed_height 15
1822static unsigned char file_removed_bits[] = {
1823 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1824 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1825 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1826} -maskdata $filemask
1827image create bitmap file_merge -background white -foreground blue -data {
1829#define file_merge_width 14
1830#define file_merge_height 15
1831static unsigned char file_merge_bits[] = {
1832 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1833 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1834 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1835} -maskdata $filemask
1836image create bitmap file_statechange -background white -foreground green -data {
1838#define file_merge_width 14
1839#define file_merge_height 15
1840static unsigned char file_statechange_bits[] = {
1841 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1842 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1843 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1844} -maskdata $filemask
1845set ui_index .vpane.files.index.list
1847set ui_workdir .vpane.files.workdir.list
1848set all_icons(_$ui_index) file_plain
1850set all_icons(A$ui_index) file_fulltick
1851set all_icons(M$ui_index) file_fulltick
1852set all_icons(D$ui_index) file_removed
1853set all_icons(U$ui_index) file_merge
1854set all_icons(T$ui_index) file_statechange
1855set all_icons(_$ui_workdir) file_plain
1857set all_icons(M$ui_workdir) file_mod
1858set all_icons(D$ui_workdir) file_question
1859set all_icons(U$ui_workdir) file_merge
1860set all_icons(O$ui_workdir) file_plain
1861set all_icons(T$ui_workdir) file_statechange
1862set max_status_desc 0
1864foreach i {
1865 {__ {mc "Unmodified"}}
1866 {_M {mc "Modified, not staged"}}
1868 {M_ {mc "Staged for commit"}}
1869 {MM {mc "Portions staged for commit"}}
1870 {MD {mc "Staged for commit, missing"}}
1871 {_T {mc "File type changed, not staged"}}
1873 {T_ {mc "File type changed, staged"}}
1874 {_O {mc "Untracked, not staged"}}
1876 {A_ {mc "Staged for commit"}}
1877 {AM {mc "Portions staged for commit"}}
1878 {AD {mc "Staged for commit, missing"}}
1879 {_D {mc "Missing"}}
1881 {D_ {mc "Staged for removal"}}
1882 {DO {mc "Staged for removal, still present"}}
1883 {_U {mc "Requires merge resolution"}}
1885 {U_ {mc "Requires merge resolution"}}
1886 {UU {mc "Requires merge resolution"}}
1887 {UM {mc "Requires merge resolution"}}
1888 {UD {mc "Requires merge resolution"}}
1889 {UT {mc "Requires merge resolution"}}
1890 } {
1891 set text [eval [lindex $i 1]]
1892 if {$max_status_desc < [string length $text]} {
1893 set max_status_desc [string length $text]
1894 }
1895 set all_descs([lindex $i 0]) $text
1896}
1897unset i
1898######################################################################
1900##
1901## util
1902proc scrollbar2many {list mode args} {
1904 foreach w $list {eval $w $mode $args}
1905}
1906proc many2scrollbar {list mode sb top bottom} {
1908 $sb set $top $bottom
1909 foreach w $list {$w $mode moveto $top}
1910}
1911proc incr_font_size {font {amt 1}} {
1913 set sz [font configure $font -size]
1914 incr sz $amt
1915 font configure $font -size $sz
1916 font configure ${font}bold -size $sz
1917 font configure ${font}italic -size $sz
1918}
1919######################################################################
1921##
1922## ui commands
1923set starting_gitk_msg [mc "Starting gitk... please wait..."]
1925proc do_gitk {revs} {
1927 # -- Always start gitk through whatever we were loaded with. This
1928 # lets us bypass using shell process on Windows systems.
1929 #
1930 set exe [_which gitk -script]
1931 set cmd [list [info nameofexecutable] $exe]
1932 if {$exe eq {}} {
1933 error_popup [mc "Couldn't find gitk in PATH"]
1934 } else {
1935 global env
1936 if {[info exists env(GIT_DIR)]} {
1938 set old_GIT_DIR $env(GIT_DIR)
1939 } else {
1940 set old_GIT_DIR {}
1941 }
1942 set pwd [pwd]
1944 cd [file dirname [gitdir]]
1945 set env(GIT_DIR) [file tail [gitdir]]
1946 eval exec $cmd $revs "--" "--" &
1948 if {$old_GIT_DIR eq {}} {
1950 unset env(GIT_DIR)
1951 } else {
1952 set env(GIT_DIR) $old_GIT_DIR
1953 }
1954 cd $pwd
1955 ui_status $::starting_gitk_msg
1957 after 10000 {
1958 ui_ready $starting_gitk_msg
1959 }
1960 }
1961}
1962proc do_explore {} {
1964 set explorer {}
1965 if {[is_Cygwin] || [is_Windows]} {
1966 set explorer "explorer.exe"
1967 } elseif {[is_MacOSX]} {
1968 set explorer "open"
1969 } else {
1970 # freedesktop.org-conforming system is our best shot
1971 set explorer "xdg-open"
1972 }
1973 eval exec $explorer [list [file nativename [file dirname [gitdir]]]] &
1974}
1975set is_quitting 0
1977set ret_code 1
1978proc terminate_me {win} {
1980 global ret_code
1981 if {$win ne {.}} return
1982 exit $ret_code
1983}
1984proc do_quit {{rc {1}}} {
1986 global ui_comm is_quitting repo_config commit_type
1987 global GITGUI_BCK_exists GITGUI_BCK_i
1988 global ui_comm_spell
1989 global ret_code
1990 if {$is_quitting} return
1992 set is_quitting 1
1993 if {[winfo exists $ui_comm]} {
1995 # -- Stash our current commit buffer.
1996 #
1997 set save [gitdir GITGUI_MSG]
1998 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1999 file rename -force [gitdir GITGUI_BCK] $save
2000 set GITGUI_BCK_exists 0
2001 } else {
2002 set msg [string trim [$ui_comm get 0.0 end]]
2003 regsub -all -line {[ \r\t]+$} $msg {} msg
2004 if {(![string match amend* $commit_type]
2005 || [$ui_comm edit modified])
2006 && $msg ne {}} {
2007 catch {
2008 set fd [open $save w]
2009 puts -nonewline $fd $msg
2010 close $fd
2011 }
2012 } else {
2013 catch {file delete $save}
2014 }
2015 }
2016 # -- Cancel our spellchecker if its running.
2018 #
2019 if {[info exists ui_comm_spell]} {
2020 $ui_comm_spell stop
2021 }
2022 # -- Remove our editor backup, its not needed.
2024 #
2025 after cancel $GITGUI_BCK_i
2026 if {$GITGUI_BCK_exists} {
2027 catch {file delete [gitdir GITGUI_BCK]}
2028 }
2029 # -- Stash our current window geometry into this repository.
2031 #
2032 set cfg_wmstate [wm state .]
2033 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2034 set rc_wmstate {}
2035 }
2036 if {$cfg_wmstate ne $rc_wmstate} {
2037 catch {git config gui.wmstate $cfg_wmstate}
2038 }
2039 if {$cfg_wmstate eq {zoomed}} {
2040 # on Windows wm geometry will lie about window
2041 # position (but not size) when window is zoomed
2042 # restore the window before querying wm geometry
2043 wm state . normal
2044 }
2045 set cfg_geometry [list]
2046 lappend cfg_geometry [wm geometry .]
2047 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2048 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2049 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2050 set rc_geometry {}
2051 }
2052 if {$cfg_geometry ne $rc_geometry} {
2053 catch {git config gui.geometry $cfg_geometry}
2054 }
2055 }
2056 set ret_code $rc
2058 # Briefly enable send again, working around Tk bug
2060 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2061 tk appname [appname]
2062 destroy .
2064}
2065proc do_rescan {} {
2067 rescan ui_ready
2068}
2069proc ui_do_rescan {} {
2071 rescan {force_first_diff ui_ready}
2072}
2073proc do_commit {} {
2075 commit_tree
2076}
2077proc next_diff {{after {}}} {
2079 global next_diff_p next_diff_w next_diff_i
2080 show_diff $next_diff_p $next_diff_w {} {} $after
2081}
2082proc find_anchor_pos {lst name} {
2084 set lid [lsearch -sorted -exact $lst $name]
2085 if {$lid == -1} {
2087 set lid 0
2088 foreach lname $lst {
2089 if {$lname >= $name} break
2090 incr lid
2091 }
2092 }
2093 return $lid
2095}
2096proc find_file_from {flist idx delta path mmask} {
2098 global file_states
2099 set len [llength $flist]
2101 while {$idx >= 0 && $idx < $len} {
2102 set name [lindex $flist $idx]
2103 if {$name ne $path && [info exists file_states($name)]} {
2105 set state [lindex $file_states($name) 0]
2106 if {$mmask eq {} || [regexp $mmask $state]} {
2108 return $idx
2109 }
2110 }
2111 incr idx $delta
2113 }
2114 return {}
2116}
2117proc find_next_diff {w path {lno {}} {mmask {}}} {
2119 global next_diff_p next_diff_w next_diff_i
2120 global file_lists ui_index ui_workdir
2121 set flist $file_lists($w)
2123 if {$lno eq {}} {
2124 set lno [find_anchor_pos $flist $path]
2125 } else {
2126 incr lno -1
2127 }
2128 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2130 if {$w eq $ui_index} {
2131 set mmask "^$mmask"
2132 } else {
2133 set mmask "$mmask\$"
2134 }
2135 }
2136 set idx [find_file_from $flist $lno 1 $path $mmask]
2138 if {$idx eq {}} {
2139 incr lno -1
2140 set idx [find_file_from $flist $lno -1 $path $mmask]
2141 }
2142 if {$idx ne {}} {
2144 set next_diff_w $w
2145 set next_diff_p [lindex $flist $idx]
2146 set next_diff_i [expr {$idx+1}]
2147 return 1
2148 } else {
2149 return 0
2150 }
2151}
2152proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2154 global current_diff_path
2155 if {$path ne $current_diff_path} {
2157 return {}
2158 } elseif {[find_next_diff $w $path $lno $mmask]} {
2159 return {next_diff;}
2160 } else {
2161 return {reshow_diff;}
2162 }
2163}
2164proc select_first_diff {after} {
2166 global ui_workdir
2167 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2169 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2170 next_diff $after
2171 } else {
2172 uplevel #0 $after
2173 }
2174}
2175proc force_first_diff {after} {
2177 global ui_workdir current_diff_path file_states
2178 if {[info exists file_states($current_diff_path)]} {
2180 set state [lindex $file_states($current_diff_path) 0]
2181 } else {
2182 set state {OO}
2183 }
2184 set reselect 0
2186 if {[string first {U} $state] >= 0} {
2187 # Already a conflict, do nothing
2188 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2189 set reselect 1
2190 } elseif {[string index $state 1] ne {O}} {
2191 # Already a diff & no conflicts, do nothing
2192 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2193 set reselect 1
2194 }
2195 if {$reselect} {
2197 next_diff $after
2198 } else {
2199 uplevel #0 $after
2200 }
2201}
2202proc toggle_or_diff {w x y} {
2204 global file_states file_lists current_diff_path ui_index ui_workdir
2205 global last_clicked selected_paths
2206 set pos [split [$w index @$x,$y] .]
2208 set lno [lindex $pos 0]
2209 set col [lindex $pos 1]
2210 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2211 if {$path eq {}} {
2212 set last_clicked {}
2213 return
2214 }
2215 set last_clicked [list $w $lno]
2217 array unset selected_paths
2218 $ui_index tag remove in_sel 0.0 end
2219 $ui_workdir tag remove in_sel 0.0 end
2220 # Determine the state of the file
2222 if {[info exists file_states($path)]} {
2223 set state [lindex $file_states($path) 0]
2224 } else {
2225 set state {__}
2226 }
2227 # Restage the file, or simply show the diff
2229 if {$col == 0 && $y > 1} {
2230 # Conflicts need special handling
2231 if {[string first {U} $state] >= 0} {
2232 # $w must always be $ui_workdir, but...
2233 if {$w ne $ui_workdir} { set lno {} }
2234 merge_stage_workdir $path $lno
2235 return
2236 }
2237 if {[string index $state 1] eq {O}} {
2239 set mmask {}
2240 } else {
2241 set mmask {[^O]}
2242 }
2243 set after [next_diff_after_action $w $path $lno $mmask]
2245 if {$w eq $ui_index} {
2247 update_indexinfo \
2248 "Unstaging [short_path $path] from commit" \
2249 [list $path] \
2250 [concat $after [list ui_ready]]
2251 } elseif {$w eq $ui_workdir} {
2252 update_index \
2253 "Adding [short_path $path]" \
2254 [list $path] \
2255 [concat $after [list ui_ready]]
2256 }
2257 } else {
2258 show_diff $path $w $lno
2259 }
2260}
2261proc add_one_to_selection {w x y} {
2263 global file_lists last_clicked selected_paths
2264 set lno [lindex [split [$w index @$x,$y] .] 0]
2266 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2267 if {$path eq {}} {
2268 set last_clicked {}
2269 return
2270 }
2271 if {$last_clicked ne {}
2273 && [lindex $last_clicked 0] ne $w} {
2274 array unset selected_paths
2275 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2276 }
2277 set last_clicked [list $w $lno]
2279 if {[catch {set in_sel $selected_paths($path)}]} {
2280 set in_sel 0
2281 }
2282 if {$in_sel} {
2283 unset selected_paths($path)
2284 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2285 } else {
2286 set selected_paths($path) 1
2287 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2288 }
2289}
2290proc add_range_to_selection {w x y} {
2292 global file_lists last_clicked selected_paths
2293 if {[lindex $last_clicked 0] ne $w} {
2295 toggle_or_diff $w $x $y
2296 return
2297 }
2298 set lno [lindex [split [$w index @$x,$y] .] 0]
2300 set lc [lindex $last_clicked 1]
2301 if {$lc < $lno} {
2302 set begin $lc
2303 set end $lno
2304 } else {
2305 set begin $lno
2306 set end $lc
2307 }
2308 foreach path [lrange $file_lists($w) \
2310 [expr {$begin - 1}] \
2311 [expr {$end - 1}]] {
2312 set selected_paths($path) 1
2313 }
2314 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2315}
2316proc show_more_context {} {
2318 global repo_config
2319 if {$repo_config(gui.diffcontext) < 99} {
2320 incr repo_config(gui.diffcontext)
2321 reshow_diff
2322 }
2323}
2324proc show_less_context {} {
2326 global repo_config
2327 if {$repo_config(gui.diffcontext) > 1} {
2328 incr repo_config(gui.diffcontext) -1
2329 reshow_diff
2330 }
2331}
2332######################################################################
2334##
2335## ui construction
2336load_config 0
2338apply_config
2339set ui_comm {}
2340# -- Menu Bar
2342#
2343menu .mbar -tearoff 0
2344if {[is_MacOSX]} {
2345 # -- Apple Menu (Mac OS X only)
2346 #
2347 .mbar add cascade -label Apple -menu .mbar.apple
2348 menu .mbar.apple
2349}
2350.mbar add cascade -label [mc Repository] -menu .mbar.repository
2351.mbar add cascade -label [mc Edit] -menu .mbar.edit
2352if {[is_enabled branch]} {
2353 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2354}
2355if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2356 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2357}
2358if {[is_enabled transport]} {
2359 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2360 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2361}
2362if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2363 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2364}
2365# -- Repository Menu
2367#
2368menu .mbar.repository
2369.mbar.repository add command \
2371 -label [mc "Explore Working Copy"] \
2372 -command {do_explore}
2373.mbar.repository add separator
2374.mbar.repository add command \
2376 -label [mc "Browse Current Branch's Files"] \
2377 -command {browser::new $current_branch}
2378set ui_browse_current [.mbar.repository index last]
2379.mbar.repository add command \
2380 -label [mc "Browse Branch Files..."] \
2381 -command browser_open::dialog
2382.mbar.repository add separator
2383.mbar.repository add command \
2385 -label [mc "Visualize Current Branch's History"] \
2386 -command {do_gitk $current_branch}
2387set ui_visualize_current [.mbar.repository index last]
2388.mbar.repository add command \
2389 -label [mc "Visualize All Branch History"] \
2390 -command {do_gitk --all}
2391.mbar.repository add separator
2392proc current_branch_write {args} {
2394 global current_branch
2395 .mbar.repository entryconf $::ui_browse_current \
2396 -label [mc "Browse %s's Files" $current_branch]
2397 .mbar.repository entryconf $::ui_visualize_current \
2398 -label [mc "Visualize %s's History" $current_branch]
2399}
2400trace add variable current_branch write current_branch_write
2401if {[is_enabled multicommit]} {
2403 .mbar.repository add command -label [mc "Database Statistics"] \
2404 -command do_stats
2405 .mbar.repository add command -label [mc "Compress Database"] \
2407 -command do_gc
2408 .mbar.repository add command -label [mc "Verify Database"] \
2410 -command do_fsck_objects
2411 .mbar.repository add separator
2413 if {[is_Cygwin]} {
2415 .mbar.repository add command \
2416 -label [mc "Create Desktop Icon"] \
2417 -command do_cygwin_shortcut
2418 } elseif {[is_Windows]} {
2419 .mbar.repository add command \
2420 -label [mc "Create Desktop Icon"] \
2421 -command do_windows_shortcut
2422 } elseif {[is_MacOSX]} {
2423 .mbar.repository add command \
2424 -label [mc "Create Desktop Icon"] \
2425 -command do_macosx_app
2426 }
2427}
2428if {[is_MacOSX]} {
2430 proc ::tk::mac::Quit {args} { do_quit }
2431} else {
2432 .mbar.repository add command -label [mc Quit] \
2433 -command do_quit \
2434 -accelerator $M1T-Q
2435}
2436# -- Edit Menu
2438#
2439menu .mbar.edit
2440.mbar.edit add command -label [mc Undo] \
2441 -command {catch {[focus] edit undo}} \
2442 -accelerator $M1T-Z
2443.mbar.edit add command -label [mc Redo] \
2444 -command {catch {[focus] edit redo}} \
2445 -accelerator $M1T-Y
2446.mbar.edit add separator
2447.mbar.edit add command -label [mc Cut] \
2448 -command {catch {tk_textCut [focus]}} \
2449 -accelerator $M1T-X
2450.mbar.edit add command -label [mc Copy] \
2451 -command {catch {tk_textCopy [focus]}} \
2452 -accelerator $M1T-C
2453.mbar.edit add command -label [mc Paste] \
2454 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2455 -accelerator $M1T-V
2456.mbar.edit add command -label [mc Delete] \
2457 -command {catch {[focus] delete sel.first sel.last}} \
2458 -accelerator Del
2459.mbar.edit add separator
2460.mbar.edit add command -label [mc "Select All"] \
2461 -command {catch {[focus] tag add sel 0.0 end}} \
2462 -accelerator $M1T-A
2463# -- Branch Menu
2465#
2466if {[is_enabled branch]} {
2467 menu .mbar.branch
2468 .mbar.branch add command -label [mc "Create..."] \
2470 -command branch_create::dialog \
2471 -accelerator $M1T-N
2472 lappend disable_on_lock [list .mbar.branch entryconf \
2473 [.mbar.branch index last] -state]
2474 .mbar.branch add command -label [mc "Checkout..."] \
2476 -command branch_checkout::dialog \
2477 -accelerator $M1T-O
2478 lappend disable_on_lock [list .mbar.branch entryconf \
2479 [.mbar.branch index last] -state]
2480 .mbar.branch add command -label [mc "Rename..."] \
2482 -command branch_rename::dialog
2483 lappend disable_on_lock [list .mbar.branch entryconf \
2484 [.mbar.branch index last] -state]
2485 .mbar.branch add command -label [mc "Delete..."] \
2487 -command branch_delete::dialog
2488 lappend disable_on_lock [list .mbar.branch entryconf \
2489 [.mbar.branch index last] -state]
2490 .mbar.branch add command -label [mc "Reset..."] \
2492 -command merge::reset_hard
2493 lappend disable_on_lock [list .mbar.branch entryconf \
2494 [.mbar.branch index last] -state]
2495}
2496# -- Commit Menu
2498#
2499proc commit_btn_caption {} {
2500 if {[is_enabled nocommit]} {
2501 return [mc "Done"]
2502 } else {
2503 return [mc Commit@@verb]
2504 }
2505}
2506if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2508 menu .mbar.commit
2509 if {![is_enabled nocommit]} {
2511 .mbar.commit add radiobutton \
2512 -label [mc "New Commit"] \
2513 -command do_select_commit_type \
2514 -variable selected_commit_type \
2515 -value new
2516 lappend disable_on_lock \
2517 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2518 .mbar.commit add radiobutton \
2520 -label [mc "Amend Last Commit"] \
2521 -command do_select_commit_type \
2522 -variable selected_commit_type \
2523 -value amend
2524 lappend disable_on_lock \
2525 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2526 .mbar.commit add separator
2528 }
2529 .mbar.commit add command -label [mc Rescan] \
2531 -command ui_do_rescan \
2532 -accelerator F5
2533 lappend disable_on_lock \
2534 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2535 .mbar.commit add command -label [mc "Stage To Commit"] \
2537 -command do_add_selection \
2538 -accelerator $M1T-T
2539 lappend disable_on_lock \
2540 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2541 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2543 -command do_add_all \
2544 -accelerator $M1T-I
2545 lappend disable_on_lock \
2546 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2547 .mbar.commit add command -label [mc "Unstage From Commit"] \
2549 -command do_unstage_selection \
2550 -accelerator $M1T-U
2551 lappend disable_on_lock \
2552 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2553 .mbar.commit add command -label [mc "Revert Changes"] \
2555 -command do_revert_selection \
2556 -accelerator $M1T-J
2557 lappend disable_on_lock \
2558 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2559 .mbar.commit add separator
2561 .mbar.commit add command -label [mc "Show Less Context"] \
2563 -command show_less_context \
2564 -accelerator $M1T-\-
2565 .mbar.commit add command -label [mc "Show More Context"] \
2567 -command show_more_context \
2568 -accelerator $M1T-=
2569 .mbar.commit add separator
2571 if {![is_enabled nocommitmsg]} {
2573 .mbar.commit add command -label [mc "Sign Off"] \
2574 -command do_signoff \
2575 -accelerator $M1T-S
2576 }
2577 .mbar.commit add command -label [commit_btn_caption] \
2579 -command do_commit \
2580 -accelerator $M1T-Return
2581 lappend disable_on_lock \
2582 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2583}
2584# -- Merge Menu
2586#
2587if {[is_enabled branch]} {
2588 menu .mbar.merge
2589 .mbar.merge add command -label [mc "Local Merge..."] \
2590 -command merge::dialog \
2591 -accelerator $M1T-M
2592 lappend disable_on_lock \
2593 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2594 .mbar.merge add command -label [mc "Abort Merge..."] \
2595 -command merge::reset_hard
2596 lappend disable_on_lock \
2597 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2598}
2599# -- Transport Menu
2601#
2602if {[is_enabled transport]} {
2603 menu .mbar.remote
2604 .mbar.remote add command \
2606 -label [mc "Add..."] \
2607 -command remote_add::dialog \
2608 -accelerator $M1T-A
2609 .mbar.remote add command \
2610 -label [mc "Push..."] \
2611 -command do_push_anywhere \
2612 -accelerator $M1T-P
2613 .mbar.remote add command \
2614 -label [mc "Delete Branch..."] \
2615 -command remote_branch_delete::dialog
2616}
2617if {[is_MacOSX]} {
2619 proc ::tk::mac::ShowPreferences {} {do_options}
2620} else {
2621 # -- Edit Menu
2622 #
2623 .mbar.edit add separator
2624 .mbar.edit add command -label [mc "Options..."] \
2625 -command do_options
2626}
2627# -- Tools Menu
2629#
2630if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2631 set tools_menubar .mbar.tools
2632 menu $tools_menubar
2633 $tools_menubar add separator
2634 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2635 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2636 set tools_tailcnt 3
2637 if {[array names repo_config guitool.*.cmd] ne {}} {
2638 tools_populate_all
2639 }
2640}
2641# -- Help Menu
2643#
2644.mbar add cascade -label [mc Help] -menu .mbar.help
2645menu .mbar.help
2646if {[is_MacOSX]} {
2648 .mbar.apple add command -label [mc "About %s" [appname]] \
2649 -command do_about
2650 .mbar.apple add separator
2651} else {
2652 .mbar.help add command -label [mc "About %s" [appname]] \
2653 -command do_about
2654}
2655. configure -menu .mbar
2656set doc_path [githtmldir]
2658if {$doc_path ne {}} {
2659 set doc_path [file join $doc_path index.html]
2660 if {[is_Cygwin]} {
2662 set doc_path [exec cygpath --mixed $doc_path]
2663 }
2664}
2665if {[file isfile $doc_path]} {
2667 set doc_url "file:$doc_path"
2668} else {
2669 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2670}
2671proc start_browser {url} {
2673 git "web--browse" $url
2674}
2675.mbar.help add command -label [mc "Online Documentation"] \
2677 -command [list start_browser $doc_url]
2678.mbar.help add command -label [mc "Show SSH Key"] \
2680 -command do_ssh_key
2681unset doc_path doc_url
2683# -- Standard bindings
2685#
2686wm protocol . WM_DELETE_WINDOW do_quit
2687bind all <$M1B-Key-q> do_quit
2688bind all <$M1B-Key-Q> do_quit
2689bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2690bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2691set subcommand_args {}
2693proc usage {} {
2694 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2695 exit 1
2696}
2697proc normalize_relpath {path} {
2699 set elements {}
2700 foreach item [file split $path] {
2701 if {$item eq {.}} continue
2702 if {$item eq {..} && [llength $elements] > 0
2703 && [lindex $elements end] ne {..}} {
2704 set elements [lrange $elements 0 end-1]
2705 continue
2706 }
2707 lappend elements $item
2708 }
2709 return [eval file join $elements]
2710}
2711# -- Not a normal commit type invocation? Do that instead!
2713#
2714switch -- $subcommand {
2715browser -
2716blame {
2717 if {$subcommand eq "blame"} {
2718 set subcommand_args {[--line=<num>] rev? path}
2719 } else {
2720 set subcommand_args {rev? path}
2721 }
2722 if {$argv eq {}} usage
2723 set head {}
2724 set path {}
2725 set jump_spec {}
2726 set is_path 0
2727 foreach a $argv {
2728 if {$is_path || [file exists $_prefix$a]} {
2729 if {$path ne {}} usage
2730 set path [normalize_relpath $_prefix$a]
2731 break
2732 } elseif {$a eq {--}} {
2733 if {$path ne {}} {
2734 if {$head ne {}} usage
2735 set head $path
2736 set path {}
2737 }
2738 set is_path 1
2739 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2740 if {$jump_spec ne {} || $head ne {}} usage
2741 set jump_spec [list $lnum]
2742 } elseif {$head eq {}} {
2743 if {$head ne {}} usage
2744 set head $a
2745 set is_path 1
2746 } else {
2747 usage
2748 }
2749 }
2750 unset is_path
2751 if {$head ne {} && $path eq {}} {
2753 set path [normalize_relpath $_prefix$head]
2754 set head {}
2755 }
2756 if {$head eq {}} {
2758 load_current_branch
2759 } else {
2760 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2761 if {[catch {
2762 set head [git rev-parse --verify $head]
2763 } err]} {
2764 puts stderr $err
2765 exit 1
2766 }
2767 }
2768 set current_branch $head
2769 }
2770 switch -- $subcommand {
2772 browser {
2773 if {$jump_spec ne {}} usage
2774 if {$head eq {}} {
2775 if {$path ne {} && [file isdirectory $path]} {
2776 set head $current_branch
2777 } else {
2778 set head $path
2779 set path {}
2780 }
2781 }
2782 browser::new $head $path
2783 }
2784 blame {
2785 if {$head eq {} && ![file exists $path]} {
2786 puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2787 exit 1
2788 }
2789 blame::new $head $path $jump_spec
2790 }
2791 }
2792 return
2793}
2794citool -
2795gui {
2796 if {[llength $argv] != 0} {
2797 puts -nonewline stderr "usage: $argv0"
2798 if {$subcommand ne {gui}
2799 && [file tail $argv0] ne "git-$subcommand"} {
2800 puts -nonewline stderr " $subcommand"
2801 }
2802 puts stderr {}
2803 exit 1
2804 }
2805 # fall through to setup UI for commits
2806}
2807default {
2808 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2809 exit 1
2810}
2811}
2812# -- Branch Control
2814#
2815frame .branch \
2816 -borderwidth 1 \
2817 -relief sunken
2818label .branch.l1 \
2819 -text [mc "Current Branch:"] \
2820 -anchor w \
2821 -justify left
2822label .branch.cb \
2823 -textvariable current_branch \
2824 -anchor w \
2825 -justify left
2826pack .branch.l1 -side left
2827pack .branch.cb -side left -fill x
2828pack .branch -side top -fill x
2829# -- Main Window Layout
2831#
2832panedwindow .vpane -orient horizontal
2833panedwindow .vpane.files -orient vertical
2834.vpane add .vpane.files -sticky nsew -height 100 -width 200
2835pack .vpane -anchor n -side top -fill both -expand 1
2836# -- Index File List
2838#
2839frame .vpane.files.index -height 100 -width 200
2840label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2841 -background lightgreen -foreground black
2842text $ui_index -background white -foreground black \
2843 -borderwidth 0 \
2844 -width 20 -height 10 \
2845 -wrap none \
2846 -cursor $cursor_ptr \
2847 -xscrollcommand {.vpane.files.index.sx set} \
2848 -yscrollcommand {.vpane.files.index.sy set} \
2849 -state disabled
2850scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2851scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2852pack .vpane.files.index.title -side top -fill x
2853pack .vpane.files.index.sx -side bottom -fill x
2854pack .vpane.files.index.sy -side right -fill y
2855pack $ui_index -side left -fill both -expand 1
2856# -- Working Directory File List
2858#
2859frame .vpane.files.workdir -height 100 -width 200
2860label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2861 -background lightsalmon -foreground black
2862text $ui_workdir -background white -foreground black \
2863 -borderwidth 0 \
2864 -width 20 -height 10 \
2865 -wrap none \
2866 -cursor $cursor_ptr \
2867 -xscrollcommand {.vpane.files.workdir.sx set} \
2868 -yscrollcommand {.vpane.files.workdir.sy set} \
2869 -state disabled
2870scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2871scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2872pack .vpane.files.workdir.title -side top -fill x
2873pack .vpane.files.workdir.sx -side bottom -fill x
2874pack .vpane.files.workdir.sy -side right -fill y
2875pack $ui_workdir -side left -fill both -expand 1
2876.vpane.files add .vpane.files.workdir -sticky nsew
2878.vpane.files add .vpane.files.index -sticky nsew
2879foreach i [list $ui_index $ui_workdir] {
2881 rmsel_tag $i
2882 $i tag conf in_diff -background [$i tag cget in_sel -background]
2883}
2884unset i
2885# -- Diff and Commit Area
2887#
2888frame .vpane.lower -height 300 -width 400
2889frame .vpane.lower.commarea
2890frame .vpane.lower.diff -relief sunken -borderwidth 1
2891pack .vpane.lower.diff -fill both -expand 1
2892pack .vpane.lower.commarea -side bottom -fill x
2893.vpane add .vpane.lower -sticky nsew
2894# -- Commit Area Buttons
2896#
2897frame .vpane.lower.commarea.buttons
2898label .vpane.lower.commarea.buttons.l -text {} \
2899 -anchor w \
2900 -justify left
2901pack .vpane.lower.commarea.buttons.l -side top -fill x
2902pack .vpane.lower.commarea.buttons -side left -fill y
2903button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2905 -command ui_do_rescan
2906pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2907lappend disable_on_lock \
2908 {.vpane.lower.commarea.buttons.rescan conf -state}
2909button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2911 -command do_add_all
2912pack .vpane.lower.commarea.buttons.incall -side top -fill x
2913lappend disable_on_lock \
2914 {.vpane.lower.commarea.buttons.incall conf -state}
2915if {![is_enabled nocommitmsg]} {
2917 button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2918 -command do_signoff
2919 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2920}
2921button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
2923 -command do_commit
2924pack .vpane.lower.commarea.buttons.commit -side top -fill x
2925lappend disable_on_lock \
2926 {.vpane.lower.commarea.buttons.commit conf -state}
2927if {![is_enabled nocommit]} {
2929 button .vpane.lower.commarea.buttons.push -text [mc Push] \
2930 -command do_push_anywhere
2931 pack .vpane.lower.commarea.buttons.push -side top -fill x
2932}
2933# -- Commit Message Buffer
2935#
2936frame .vpane.lower.commarea.buffer
2937frame .vpane.lower.commarea.buffer.header
2938set ui_comm .vpane.lower.commarea.buffer.t
2939set ui_coml .vpane.lower.commarea.buffer.header.l
2940if {![is_enabled nocommit]} {
2942 radiobutton .vpane.lower.commarea.buffer.header.new \
2943 -text [mc "New Commit"] \
2944 -command do_select_commit_type \
2945 -variable selected_commit_type \
2946 -value new
2947 lappend disable_on_lock \
2948 [list .vpane.lower.commarea.buffer.header.new conf -state]
2949 radiobutton .vpane.lower.commarea.buffer.header.amend \
2950 -text [mc "Amend Last Commit"] \
2951 -command do_select_commit_type \
2952 -variable selected_commit_type \
2953 -value amend
2954 lappend disable_on_lock \
2955 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2956}
2957label $ui_coml \
2959 -anchor w \
2960 -justify left
2961proc trace_commit_type {varname args} {
2962 global ui_coml commit_type
2963 switch -glob -- $commit_type {
2964 initial {set txt [mc "Initial Commit Message:"]}
2965 amend {set txt [mc "Amended Commit Message:"]}
2966 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2967 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
2968 merge {set txt [mc "Merge Commit Message:"]}
2969 * {set txt [mc "Commit Message:"]}
2970 }
2971 $ui_coml conf -text $txt
2972}
2973trace add variable commit_type write trace_commit_type
2974pack $ui_coml -side left -fill x
2975if {![is_enabled nocommit]} {
2977 pack .vpane.lower.commarea.buffer.header.amend -side right
2978 pack .vpane.lower.commarea.buffer.header.new -side right
2979}
2980text $ui_comm -background white -foreground black \
2982 -borderwidth 1 \
2983 -undo true \
2984 -maxundo 20 \
2985 -autoseparators true \
2986 -relief sunken \
2987 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
2988 -font font_diff \
2989 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2990scrollbar .vpane.lower.commarea.buffer.sby \
2991 -command [list $ui_comm yview]
2992pack .vpane.lower.commarea.buffer.header -side top -fill x
2993pack .vpane.lower.commarea.buffer.sby -side right -fill y
2994pack $ui_comm -side left -fill y
2995pack .vpane.lower.commarea.buffer -side left -fill y
2996# -- Commit Message Buffer Context Menu
2998#
2999set ctxm .vpane.lower.commarea.buffer.ctxm
3000menu $ctxm -tearoff 0
3001$ctxm add command \
3002 -label [mc Cut] \
3003 -command {tk_textCut $ui_comm}
3004$ctxm add command \
3005 -label [mc Copy] \
3006 -command {tk_textCopy $ui_comm}
3007$ctxm add command \
3008 -label [mc Paste] \
3009 -command {tk_textPaste $ui_comm}
3010$ctxm add command \
3011 -label [mc Delete] \
3012 -command {catch {$ui_comm delete sel.first sel.last}}
3013$ctxm add separator
3014$ctxm add command \
3015 -label [mc "Select All"] \
3016 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3017$ctxm add command \
3018 -label [mc "Copy All"] \
3019 -command {
3020 $ui_comm tag add sel 0.0 end
3021 tk_textCopy $ui_comm
3022 $ui_comm tag remove sel 0.0 end
3023 }
3024$ctxm add separator
3025$ctxm add command \
3026 -label [mc "Sign Off"] \
3027 -command do_signoff
3028set ui_comm_ctxm $ctxm
3029# -- Diff Header
3031#
3032proc trace_current_diff_path {varname args} {
3033 global current_diff_path diff_actions file_states
3034 if {$current_diff_path eq {}} {
3035 set s {}
3036 set f {}
3037 set p {}
3038 set o disabled
3039 } else {
3040 set p $current_diff_path
3041 set s [mapdesc [lindex $file_states($p) 0] $p]
3042 set f [mc "File:"]
3043 set p [escape_path $p]
3044 set o normal
3045 }
3046 .vpane.lower.diff.header.status configure -text $s
3048 .vpane.lower.diff.header.file configure -text $f
3049 .vpane.lower.diff.header.path configure -text $p
3050 foreach w $diff_actions {
3051 uplevel #0 $w $o
3052 }
3053}
3054trace add variable current_diff_path write trace_current_diff_path
3055frame .vpane.lower.diff.header -background gold
3057label .vpane.lower.diff.header.status \
3058 -background gold \
3059 -foreground black \
3060 -width $max_status_desc \
3061 -anchor w \
3062 -justify left
3063label .vpane.lower.diff.header.file \
3064 -background gold \
3065 -foreground black \
3066 -anchor w \
3067 -justify left
3068label .vpane.lower.diff.header.path \
3069 -background gold \
3070 -foreground black \
3071 -anchor w \
3072 -justify left
3073pack .vpane.lower.diff.header.status -side left
3074pack .vpane.lower.diff.header.file -side left
3075pack .vpane.lower.diff.header.path -fill x
3076set ctxm .vpane.lower.diff.header.ctxm
3077menu $ctxm -tearoff 0
3078$ctxm add command \
3079 -label [mc Copy] \
3080 -command {
3081 clipboard clear
3082 clipboard append \
3083 -format STRING \
3084 -type STRING \
3085 -- $current_diff_path
3086 }
3087lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3088bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3089# -- Diff Body
3091#
3092frame .vpane.lower.diff.body
3093set ui_diff .vpane.lower.diff.body.t
3094text $ui_diff -background white -foreground black \
3095 -borderwidth 0 \
3096 -width 80 -height 5 -wrap none \
3097 -font font_diff \
3098 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3099 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3100 -state disabled
3101scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3102 -command [list $ui_diff xview]
3103scrollbar .vpane.lower.diff.body.sby -orient vertical \
3104 -command [list $ui_diff yview]
3105pack .vpane.lower.diff.body.sbx -side bottom -fill x
3106pack .vpane.lower.diff.body.sby -side right -fill y
3107pack $ui_diff -side left -fill both -expand 1
3108pack .vpane.lower.diff.header -side top -fill x
3109pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3110$ui_diff tag conf d_cr -elide true
3112$ui_diff tag conf d_@ -foreground blue -font font_diffbold
3113$ui_diff tag conf d_+ -foreground {#00a000}
3114$ui_diff tag conf d_- -foreground red
3115$ui_diff tag conf d_++ -foreground {#00a000}
3117$ui_diff tag conf d_-- -foreground red
3118$ui_diff tag conf d_+s \
3119 -foreground {#00a000} \
3120 -background {#e2effa}
3121$ui_diff tag conf d_-s \
3122 -foreground red \
3123 -background {#e2effa}
3124$ui_diff tag conf d_s+ \
3125 -foreground {#00a000} \
3126 -background ivory1
3127$ui_diff tag conf d_s- \
3128 -foreground red \
3129 -background ivory1
3130$ui_diff tag conf d<<<<<<< \
3132 -foreground orange \
3133 -font font_diffbold
3134$ui_diff tag conf d======= \
3135 -foreground orange \
3136 -font font_diffbold
3137$ui_diff tag conf d>>>>>>> \
3138 -foreground orange \
3139 -font font_diffbold
3140$ui_diff tag raise sel
3142# -- Diff Body Context Menu
3144#
3145proc create_common_diff_popup {ctxm} {
3147 $ctxm add command \
3148 -label [mc "Show Less Context"] \
3149 -command show_less_context
3150 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3151 $ctxm add command \
3152 -label [mc "Show More Context"] \
3153 -command show_more_context
3154 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3155 $ctxm add separator
3156 $ctxm add command \
3157 -label [mc Refresh] \
3158 -command reshow_diff
3159 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3160 $ctxm add command \
3161 -label [mc Copy] \
3162 -command {tk_textCopy $ui_diff}
3163 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3164 $ctxm add command \
3165 -label [mc "Select All"] \
3166 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3167 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3168 $ctxm add command \
3169 -label [mc "Copy All"] \
3170 -command {
3171 $ui_diff tag add sel 0.0 end
3172 tk_textCopy $ui_diff
3173 $ui_diff tag remove sel 0.0 end
3174 }
3175 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3176 $ctxm add separator
3177 $ctxm add command \
3178 -label [mc "Decrease Font Size"] \
3179 -command {incr_font_size font_diff -1}
3180 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3181 $ctxm add command \
3182 -label [mc "Increase Font Size"] \
3183 -command {incr_font_size font_diff 1}
3184 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3185 $ctxm add separator
3186 set emenu $ctxm.enc
3187 menu $emenu
3188 build_encoding_menu $emenu [list force_diff_encoding]
3189 $ctxm add cascade \
3190 -label [mc "Encoding"] \
3191 -menu $emenu
3192 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3193 $ctxm add separator
3194 $ctxm add command -label [mc "Options..."] \
3195 -command do_options
3196}
3197set ctxm .vpane.lower.diff.body.ctxm
3199menu $ctxm -tearoff 0
3200$ctxm add command \
3201 -label [mc "Apply/Reverse Hunk"] \
3202 -command {apply_hunk $cursorX $cursorY}
3203set ui_diff_applyhunk [$ctxm index last]
3204lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3205$ctxm add command \
3206 -label [mc "Apply/Reverse Line"] \
3207 -command {apply_line $cursorX $cursorY; do_rescan}
3208set ui_diff_applyline [$ctxm index last]
3209lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3210$ctxm add separator
3211create_common_diff_popup $ctxm
3212set ctxmmg .vpane.lower.diff.body.ctxmmg
3214menu $ctxmmg -tearoff 0
3215$ctxmmg add command \
3216 -label [mc "Run Merge Tool"] \
3217 -command {merge_resolve_tool}
3218lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3219$ctxmmg add separator
3220$ctxmmg add command \
3221 -label [mc "Use Remote Version"] \
3222 -command {merge_resolve_one 3}
3223lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3224$ctxmmg add command \
3225 -label [mc "Use Local Version"] \
3226 -command {merge_resolve_one 2}
3227lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3228$ctxmmg add command \
3229 -label [mc "Revert To Base"] \
3230 -command {merge_resolve_one 1}
3231lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3232$ctxmmg add separator
3233create_common_diff_popup $ctxmmg
3234proc popup_diff_menu {ctxm ctxmmg x y X Y} {
3236 global current_diff_path file_states
3237 set ::cursorX $x
3238 set ::cursorY $y
3239 if {[info exists file_states($current_diff_path)]} {
3240 set state [lindex $file_states($current_diff_path) 0]
3241 } else {
3242 set state {__}
3243 }
3244 if {[string first {U} $state] >= 0} {
3245 tk_popup $ctxmmg $X $Y
3246 } else {
3247 if {$::ui_index eq $::current_diff_side} {
3248 set l [mc "Unstage Hunk From Commit"]
3249 set t [mc "Unstage Line From Commit"]
3250 } else {
3251 set l [mc "Stage Hunk For Commit"]
3252 set t [mc "Stage Line For Commit"]
3253 }
3254 if {$::is_3way_diff || $::is_submodule_diff
3255 || $current_diff_path eq {}
3256 || {__} eq $state
3257 || {_O} eq $state
3258 || {_T} eq $state
3259 || {T_} eq $state} {
3260 set s disabled
3261 } else {
3262 set s normal
3263 }
3264 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3265 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3266 tk_popup $ctxm $X $Y
3267 }
3268}
3269bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg %x %y %X %Y]
3270# -- Status Bar
3272#
3273set main_status [::status_bar::new .status]
3274pack .status -anchor w -side bottom -fill x
3275$main_status show [mc "Initializing..."]
3276# -- Load geometry
3278#
3279catch {
3280set gm $repo_config(gui.geometry)
3281wm geometry . [lindex $gm 0]
3282.vpane sash place 0 \
3283 [lindex $gm 1] \
3284 [lindex [.vpane sash coord 0] 1]
3285.vpane.files sash place 0 \
3286 [lindex [.vpane.files sash coord 0] 0] \
3287 [lindex $gm 2]
3288unset gm
3289}
3290# -- Load window state
3292#
3293catch {
3294set gws $repo_config(gui.wmstate)
3295wm state . $gws
3296unset gws
3297}
3298# -- Key Bindings
3300#
3301bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3302bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3303bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3304bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3305bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3306bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3307bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3308bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3309bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3310bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3311bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3312bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3313bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3314bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3315bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3316bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3317bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3318bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3319bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3320bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3321bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3322bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3323bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3325bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3326bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3327bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3328bind $ui_diff <$M1B-Key-v> {break}
3329bind $ui_diff <$M1B-Key-V> {break}
3330bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3331bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3332bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3333bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3334bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3335bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3336bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
3337bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
3338bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
3339bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
3340bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3341bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
3342bind $ui_diff <Button-1> {focus %W}
3343if {[is_enabled branch]} {
3345 bind . <$M1B-Key-n> branch_create::dialog
3346 bind . <$M1B-Key-N> branch_create::dialog
3347 bind . <$M1B-Key-o> branch_checkout::dialog
3348 bind . <$M1B-Key-O> branch_checkout::dialog
3349 bind . <$M1B-Key-m> merge::dialog
3350 bind . <$M1B-Key-M> merge::dialog
3351}
3352if {[is_enabled transport]} {
3353 bind . <$M1B-Key-p> do_push_anywhere
3354 bind . <$M1B-Key-P> do_push_anywhere
3355}
3356bind . <Key-F5> ui_do_rescan
3358bind . <$M1B-Key-r> ui_do_rescan
3359bind . <$M1B-Key-R> ui_do_rescan
3360bind . <$M1B-Key-s> do_signoff
3361bind . <$M1B-Key-S> do_signoff
3362bind . <$M1B-Key-t> do_add_selection
3363bind . <$M1B-Key-T> do_add_selection
3364bind . <$M1B-Key-i> do_add_all
3365bind . <$M1B-Key-I> do_add_all
3366bind . <$M1B-Key-minus> {show_less_context;break}
3367bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
3368bind . <$M1B-Key-equal> {show_more_context;break}
3369bind . <$M1B-Key-plus> {show_more_context;break}
3370bind . <$M1B-Key-KP_Add> {show_more_context;break}
3371bind . <$M1B-Key-Return> do_commit
3372foreach i [list $ui_index $ui_workdir] {
3373 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3374 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3375 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3376}
3377unset i
3378set file_lists($ui_index) [list]
3380set file_lists($ui_workdir) [list]
3381wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
3383focus -force $ui_comm
3384# -- Warn the user about environmental problems. Cygwin's Tcl
3386# does *not* pass its env array onto any processes it spawns.
3387# This means that git processes get none of our environment.
3388#
3389if {[is_Cygwin]} {
3390 set ignored_env 0
3391 set suggest_user {}
3392 set msg [mc "Possible environment issues exist.
3393The following environment variables are probably
3395going to be ignored by any Git subprocess run
3396by %s:
3397" [appname]]
3399 foreach name [array names env] {
3400 switch -regexp -- $name {
3401 {^GIT_INDEX_FILE$} -
3402 {^GIT_OBJECT_DIRECTORY$} -
3403 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3404 {^GIT_DIFF_OPTS$} -
3405 {^GIT_EXTERNAL_DIFF$} -
3406 {^GIT_PAGER$} -
3407 {^GIT_TRACE$} -
3408 {^GIT_CONFIG$} -
3409 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3410 append msg " - $name\n"
3411 incr ignored_env
3412 }
3413 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3414 append msg " - $name\n"
3415 incr ignored_env
3416 set suggest_user $name
3417 }
3418 }
3419 }
3420 if {$ignored_env > 0} {
3421 append msg [mc "
3422This is due to a known issue with the
3423Tcl binary distributed by Cygwin."]
3424 if {$suggest_user ne {}} {
3426 append msg [mc "
3427A good replacement for %s
3429is placing values for the user.name and
3430user.email settings into your personal
3431~/.gitconfig file.
3432" $suggest_user]
3433 }
3434 warn_popup $msg
3435 }
3436 unset ignored_env msg suggest_user name
3437}
3438# -- Only initialize complex UI if we are going to stay running.
3440#
3441if {[is_enabled transport]} {
3442 load_all_remotes
3443 set n [.mbar.remote index end]
3445 populate_remotes_menu
3446 set n [expr {[.mbar.remote index end] - $n}]
3447 if {$n > 0} {
3448 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3449 .mbar.remote insert $n separator
3450 }
3451 unset n
3452}
3453if {[winfo exists $ui_comm]} {
3455 set GITGUI_BCK_exists [load_message GITGUI_BCK]
3456 # -- If both our backup and message files exist use the
3458 # newer of the two files to initialize the buffer.
3459 #
3460 if {$GITGUI_BCK_exists} {
3461 set m [gitdir GITGUI_MSG]
3462 if {[file isfile $m]} {
3463 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3464 catch {file delete [gitdir GITGUI_MSG]}
3465 } else {
3466 $ui_comm delete 0.0 end
3467 $ui_comm edit reset
3468 $ui_comm edit modified false
3469 catch {file delete [gitdir GITGUI_BCK]}
3470 set GITGUI_BCK_exists 0
3471 }
3472 }
3473 unset m
3474 }
3475 proc backup_commit_buffer {} {
3477 global ui_comm GITGUI_BCK_exists
3478 set m [$ui_comm edit modified]
3480 if {$m || $GITGUI_BCK_exists} {
3481 set msg [string trim [$ui_comm get 0.0 end]]
3482 regsub -all -line {[ \r\t]+$} $msg {} msg
3483 if {$msg eq {}} {
3485 if {$GITGUI_BCK_exists} {
3486 catch {file delete [gitdir GITGUI_BCK]}
3487 set GITGUI_BCK_exists 0
3488 }
3489 } elseif {$m} {
3490 catch {
3491 set fd [open [gitdir GITGUI_BCK] w]
3492 puts -nonewline $fd $msg
3493 close $fd
3494 set GITGUI_BCK_exists 1
3495 }
3496 }
3497 $ui_comm edit modified false
3499 }
3500 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3502 }
3503 backup_commit_buffer
3505 # -- If the user has aspell available we can drive it
3507 # in pipe mode to spellcheck the commit message.
3508 #
3509 set spell_cmd [list |]
3510 set spell_dict [get_config gui.spellingdictionary]
3511 lappend spell_cmd aspell
3512 if {$spell_dict ne {}} {
3513 lappend spell_cmd --master=$spell_dict
3514 }
3515 lappend spell_cmd --mode=none
3516 lappend spell_cmd --encoding=utf-8
3517 lappend spell_cmd pipe
3518 if {$spell_dict eq {none}
3519 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3520 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3521 } else {
3522 set ui_comm_spell [spellcheck::init \
3523 $spell_fd \
3524 $ui_comm \
3525 $ui_comm_ctxm \
3526 ]
3527 }
3528 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3529}
3530lock_index begin-read
3532if {![winfo ismapped .]} {
3533 wm deiconify .
3534}
3535after 1 {
3536 if {[is_enabled initialamend]} {
3537 force_amend
3538 } else {
3539 do_rescan
3540 }
3541 if {[is_enabled nocommitmsg]} {
3543 $ui_comm configure -state disabled -background gray
3544 }
3545}
3546if {[is_enabled multicommit]} {
3547 after 1000 hint_gc
3548}
3549if {[is_enabled retcode]} {
3550 bind . <Destroy> {+terminate_me %W}
3551}
3552if {$picked && [is_config_true gui.autoexplore]} {
3553 do_explore
3554}