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