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