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