?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
git-gui: git env proxy feature
[git-gui/bertw.git] / git-gui.sh
blob6f585177562ecdae3148cc68e4f5be7a2f4bf312
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 wish8.5 "$argv0" -- "$@"
11
12 set appvers {@@GITGUI_VERSION@@}
13 set copyright [string map [list (c) \u00a9] {
14 Copyright (c) 2006-2010 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.5} err]
35 || [catch {package require Tk 8.5} err]
36 } {
37 catch {wm withdraw .}
38 tk_messageBox \
39 -icon error \
40 -type ok \
41 -title "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 if {[tk windowingsystem] eq "win32"} { console show }
87 }
88
89 ######################################################################
90 ##
91 ## Internationalization (i18n) through msgcat and gettext. See
92 ## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
93
94 package require msgcat
95
96 # Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
97 if {[tk windowingsystem] eq "win32"
98 && [package vcompare [package provide msgcat] 1.4.4] < 0
99 } then {
100 proc _mc_update_locale {} {
101 set key {HKEY_CURRENT_USER\Control Panel\Desktop}
102 if {![catch {
103 package require registry
104 set uilocale [registry get $key "PreferredUILanguages"]
105 msgcat::ConvertLocale [string map {- _} [lindex $uilocale 0]]
106 } uilocale]} {
107 if {[string length $uilocale] > 0} {
108 msgcat::mclocale $uilocale
109 }
110 }
111 }
112 _mc_update_locale
113 }
114
115 proc _mc_trim {fmt} {
116 set cmk [string first @@ $fmt]
117 if {$cmk > 0} {
118 return [string range $fmt 0 [expr {$cmk - 1}]]
119 }
120 return $fmt
121 }
122
123 proc mc {en_fmt args} {
124 set fmt [_mc_trim [::msgcat::mc $en_fmt]]
125 if {[catch {set msg [eval [list format $fmt] $args]} err]} {
126 set msg [eval [list format [_mc_trim $en_fmt]] $args]
127 }
128 return $msg
129 }
130
131 proc strcat {args} {
132 return [join $args {}]
133 }
134
135 ::msgcat::mcload $oguimsg
136 unset oguimsg
137
138 ######################################################################
139 ##
140 ## On Mac, bring the current Wish process window to front
141
142 if {[tk windowingsystem] eq "aqua"} {
143 catch {
144 exec osascript -e [format {
145 tell application "System Events"
146 set frontmost of processes whose unix id is %d to true
147 end tell
148 } [pid]]
149 }
150 }
151
152 ######################################################################
153 ##
154 ## read only globals
155
156 set _appname {Git Gui}
157 set _gitdir {}
158 set _gitworktree {}
159 set _isbare {}
160 set _gitexec {}
161 set _githtmldir {}
162 set _reponame {}
163 set _iscygwin {}
164 set _search_path {}
165 set _shellpath {@@SHELL_PATH@@}
166
167 set _trace [lsearch -exact $argv --trace]
168 if {$_trace >= 0} {
169 set argv [lreplace $argv $_trace $_trace]
170 set _trace 1
171 if {[tk windowingsystem] eq "win32"} { console show }
172 } else {
173 set _trace 0
174 }
175
176 # variable for the last merged branch (useful for a default when deleting
177 # branches).
178 set _last_merged_branch {}
179
180 proc shellpath {} {
181 global _shellpath env
182 if {[string match @@* $_shellpath]} {
183 if {[info exists env(SHELL)]} {
184 return $env(SHELL)
185 } else {
186 return /bin/sh
187 }
188 }
189 return $_shellpath
190 }
191
192 proc appname {} {
193 global _appname
194 return $_appname
195 }
196
197 proc gitdir {args} {
198 if {$args eq {}} {
199 return $::GIT_DIR
200 }
201 return [eval [list file join $::GIT_DIR] $args]
202 }
203
204 proc gitexec {args} {
205 global _gitexec
206 if {$_gitexec eq {}} {
207 if {[catch {set _gitexec [git --exec-path]} err]} {
208 error "Git not installed?\n\n$err"
209 }
210 if {[is_Cygwin]} {
211 set _gitexec [exec cygpath \
212 --windows \
213 --absolute \
214 $_gitexec]
215 } else {
216 set _gitexec [file normalize $_gitexec]
217 }
218 }
219 if {$args eq {}} {
220 return $_gitexec
221 }
222 return [eval [list file join $_gitexec] $args]
223 }
224
225 proc githtmldir {args} {
226 global _githtmldir
227 if {$_githtmldir eq {}} {
228 if {[catch {set _githtmldir [git --html-path]}]} {
229 # Git not installed or option not yet supported
230 return {}
231 }
232 if {[is_Cygwin]} {
233 set _githtmldir [exec cygpath \
234 --windows \
235 --absolute \
236 $_githtmldir]
237 } else {
238 set _githtmldir [file normalize $_githtmldir]
239 }
240 }
241 if {$args eq {}} {
242 return $_githtmldir
243 }
244 return [eval [list file join $_githtmldir] $args]
245 }
246
247 proc reponame {} {
248 return $::_reponame
249 }
250
251 proc is_MacOSX {} {
252 if {[tk windowingsystem] eq {aqua}} {
253 return 1
254 }
255 return 0
256 }
257
258 proc is_Windows {} {
259 if {$::tcl_platform(platform) eq {windows}} {
260 return 1
261 }
262 return 0
263 }
264
265 proc is_Cygwin {} {
266 global _iscygwin
267 if {$_iscygwin eq {}} {
268 if {$::tcl_platform(platform) eq {windows}} {
269 if {[catch {set p [exec cygpath --windir]} err]} {
270 set _iscygwin 0
271 } else {
272 set _iscygwin 1
273 }
274 } else {
275 set _iscygwin 0
276 }
277 }
278 return $_iscygwin
279 }
280
281 proc is_enabled {option} {
282 global enabled_options
283 if {[catch {set on $enabled_options($option)}]} {return 0}
284 return $on
285 }
286
287 proc enable_option {option} {
288 global enabled_options
289 set enabled_options($option) 1
290 }
291
292 proc disable_option {option} {
293 global enabled_options
294 set enabled_options($option) 0
295 }
296
297 ######################################################################
298 ##
299 ## config
300
301 proc is_many_config {name} {
302 switch -glob -- $name {
303 gui.recentrepo -
304 remote.*.fetch -
305 remote.*.push
306 {return 1}
307 *
308 {return 0}
309 }
310 }
311
312 proc is_config_true {name} {
313 global repo_config
314 if {[catch {set v $repo_config($name)}]} {
315 return 0
316 }
317 set v [string tolower $v]
318 if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
319 return 1
320 } else {
321 return 0
322 }
323 }
324
325 proc is_config_false {name} {
326 global repo_config
327 if {[catch {set v $repo_config($name)}]} {
328 return 0
329 }
330 set v [string tolower $v]
331 if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
332 return 1
333 } else {
334 return 0
335 }
336 }
337
338 proc get_config {name} {
339 global repo_config
340 if {[catch {set v $repo_config($name)}]} {
341 return {}
342 } else {
343 return $v
344 }
345 }
346
347 proc is_bare {} {
348 global _isbare
349 global _gitdir
350 global _gitworktree
351
352 if {$_isbare eq {}} {
353 if {[catch {
354 set _bare [git rev-parse --is-bare-repository]
355 switch -- $_bare {
356 true { set _isbare 1 }
357 false { set _isbare 0}
358 default { throw }
359 }
360 }]} {
361 if {[is_config_true core.bare]
362 || ($_gitworktree eq {}
363 && [lindex [file split $_gitdir] end] ne {.git})} {
364 set _isbare 1
365 } else {
366 set _isbare 0
367 }
368 }
369 }
370 return $_isbare
371 }
372
373 ######################################################################
374 ##
375 ## handy utils
376
377 proc _trace_exec {cmd} {
378 if {!$::_trace} return
379 set d {}
380 foreach v $cmd {
381 if {$d ne {}} {
382 append d { }
383 }
384 if {[regexp {[ \t\r\n'"$?*]} $v]} {
385 set v [sq $v]
386 }
387 append d $v
388 }
389 puts stderr $d
390 }
391
392 #'" fix poor old emacs font-lock mode
393
394 proc _git_cmd {name} {
395 global _git_cmd_path
396
397 if {[catch {set v $_git_cmd_path($name)}]} {
398 switch -- $name {
399 version -
400 --version -
401 --exec-path { return [list $::_git $name] }
402 }
403
404 set p [gitexec git-$name$::_search_exe]
405 if {[file exists $p]} {
406 set v [list $p]
407 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
408 # Try to determine what sort of magic will make
409 # git-$name go and do its thing, because native
410 # Tcl on Windows doesn't know it.
411 #
412 set p [gitexec git-$name]
413 set f [open $p r]
414 set s [gets $f]
415 close $f
416
417 switch -glob -- [lindex $s 0] {
418 #!*sh { set i sh }
419 #!*perl { set i perl }
420 #!*python { set i python }
421 default { error "git-$name is not supported: $s" }
422 }
423
424 upvar #0 _$i interp
425 if {![info exists interp]} {
426 set interp [_which $i]
427 }
428 if {$interp eq {}} {
429 error "git-$name requires $i (not in PATH)"
430 }
431 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
432 } else {
433 # Assume it is builtin to git somehow and we
434 # aren't actually able to see a file for it.
435 #
436 set v [list $::_git $name]
437 }
438 set _git_cmd_path($name) $v
439 }
440 return $v
441 }
442
443 proc _which {what args} {
444 global env _search_exe _search_path
445
446 if {$_search_path eq {}} {
447 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
448 set _search_path [split [exec cygpath \
449 --windows \
450 --path \
451 --absolute \
452 $env(PATH)] {;}]
453 set _search_exe .exe
454 } elseif {[is_Windows]} {
455 set gitguidir [file dirname [info script]]
456 regsub -all ";" $gitguidir "\\;" gitguidir
457 set env(PATH) "$gitguidir;$env(PATH)"
458 set _search_path [split $env(PATH) {;}]
459 set _search_exe .exe
460 } else {
461 set _search_path [split $env(PATH) :]
462 set _search_exe {}
463 }
464 }
465
466 if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
467 set suffix {}
468 } else {
469 set suffix $_search_exe
470 }
471
472 foreach p $_search_path {
473 set p [file join $p $what$suffix]
474 if {[file exists $p]} {
475 return [file normalize $p]
476 }
477 }
478 return {}
479 }
480
481 # Test a file for a hashbang to identify executable scripts on Windows.
482 proc is_shellscript {filename} {
483 if {![file exists $filename]} {return 0}
484 set f [open $filename r]
485 fconfigure $f -encoding binary
486 set magic [read $f 2]
487 close $f
488 return [expr {$magic eq "#!"}]
489 }
490
491 # Run a command connected via pipes on stdout.
492 # This is for use with textconv filters and uses sh -c "..." to allow it to
493 # contain a command with arguments. On windows we must check for shell
494 # scripts specifically otherwise just call the filter command.
495 proc open_cmd_pipe {cmd path} {
496 global env
497 if {![file executable [shellpath]]} {
498 set exe [auto_execok [lindex $cmd 0]]
499 if {[is_shellscript [lindex $exe 0]]} {
500 set run [linsert [auto_execok sh] end -c "$cmd \"\$0\"" $path]
501 } else {
502 set run [concat $exe [lrange $cmd 1 end] $path]
503 }
504 } else {
505 set run [list [shellpath] -c "$cmd \"\$0\"" $path]
506 }
507 return [open |$run r]
508 }
509
510 proc _lappend_nice {cmd_var} {
511 global _nice
512 upvar $cmd_var cmd
513
514 if {![info exists _nice]} {
515 set _nice [_which nice]
516 if {[catch {exec $_nice git version}]} {
517 set _nice {}
518 } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
519 set _nice {}
520 }
521 }
522 if {$_nice ne {}} {
523 lappend cmd $_nice
524 }
525 }
526
527 proc git {args} {
528 set opt [list]
529
530 while {1} {
531 switch -- [lindex $args 0] {
532 --nice {
533 _lappend_nice opt
534 }
535
536 default {
537 break
538 }
539
540 }
541
542 set args [lrange $args 1 end]
543 }
544
545 set cmdp [_git_cmd [lindex $args 0]]
546 set args [lrange $args 1 end]
547
548 _trace_exec [concat $opt $cmdp $args]
549 set result [eval exec $opt $cmdp $args]
550 if {$::_trace} {
551 puts stderr "< $result"
552 }
553 return $result
554 }
555
556 proc _open_stdout_stderr {cmd} {
557 _trace_exec $cmd
558 if {[catch {
559 set fd [open [concat [list | ] $cmd] r]
560 } err]} {
561 if { [lindex $cmd end] eq {2>@1}
562 && $err eq {can not find channel named "1"}
563 } {
564 # Older versions of Tcl 8.4 don't have this 2>@1 IO
565 # redirect operator. Fallback to |& cat for those.
566 # The command was not actually started, so its safe
567 # to try to start it a second time.
568 #
569 set fd [open [concat \
570 [list | ] \
571 [lrange $cmd 0 end-1] \
572 [list |& cat] \
573 ] r]
574 } else {
575 error $err
576 }
577 }
578 fconfigure $fd -eofchar {}
579 return $fd
580 }
581
582 proc git_read {args} {
583 set opt [list]
584
585 while {1} {
586 switch -- [lindex $args 0] {
587 --nice {
588 _lappend_nice opt
589 }
590
591 --stderr {
592 lappend args 2>@1
593 }
594
595 default {
596 break
597 }
598
599 }
600
601 set args [lrange $args 1 end]
602 }
603
604 set cmdp [_git_cmd [lindex $args 0]]
605 set args [lrange $args 1 end]
606
607 return [_open_stdout_stderr [concat $opt $cmdp $args]]
608 }
609
610 proc git_write {args} {
611 set opt [list]
612
613 while {1} {
614 switch -- [lindex $args 0] {
615 --nice {
616 _lappend_nice opt
617 }
618
619 default {
620 break
621 }
622
623 }
624
625 set args [lrange $args 1 end]
626 }
627
628 set cmdp [_git_cmd [lindex $args 0]]
629 set args [lrange $args 1 end]
630
631 _trace_exec [concat $opt $cmdp $args]
632 return [open [concat [list | ] $opt $cmdp $args] w]
633 }
634
635 proc githook_read {hook_name args} {
636 set pchook [gitdir hooks $hook_name]
637 lappend args 2>@1
638
639 # On Windows [file executable] might lie so we need to ask
640 # the shell if the hook is executable. Yes that's annoying.
641 #
642 if {[is_Windows]} {
643 upvar #0 _sh interp
644 if {![info exists interp]} {
645 set interp [_which sh]
646 }
647 if {$interp eq {}} {
648 error "hook execution requires sh (not in PATH)"
649 }
650
651 set scr {if test -x "$1";then exec "$@";fi}
652 set sh_c [list $interp -c $scr $interp $pchook]
653 return [_open_stdout_stderr [concat $sh_c $args]]
654 }
655
656 if {[file executable $pchook]} {
657 return [_open_stdout_stderr [concat [list $pchook] $args]]
658 }
659
660 return {}
661 }
662
663 proc kill_file_process {fd} {
664 set process [pid $fd]
665
666 catch {
667 if {[is_Windows]} {
668 # Use a Cygwin-specific flag to allow killing
669 # native Windows processes
670 exec kill -f $process
671 } else {
672 exec kill $process
673 }
674 }
675 }
676
677 proc gitattr {path attr default} {
678 if {[catch {set r [git check-attr $attr -- $path]}]} {
679 set r unspecified
680 } else {
681 set r [join [lrange [split $r :] 2 end] :]
682 regsub {^ } $r {} r
683 }
684 if {$r eq {unspecified}} {
685 return $default
686 }
687 return $r
688 }
689
690 proc sq {value} {
691 regsub -all ' $value "'\\''" value
692 return "'$value'"
693 }
694
695 proc load_current_branch {} {
696 global current_branch is_detached
697
698 set fd [open [gitdir HEAD] r]
699 if {[gets $fd ref] < 1} {
700 set ref {}
701 }
702 close $fd
703
704 set pfx {ref: refs/heads/}
705 set len [string length $pfx]
706 if {[string equal -length $len $pfx $ref]} {
707 # We're on a branch. It might not exist. But
708 # HEAD looks good enough to be a branch.
709 #
710 set current_branch [string range $ref $len end]
711 set is_detached 0
712 } else {
713 # Assume this is a detached head.
714 #
715 set current_branch HEAD
716 set is_detached 1
717 }
718 }
719
720 auto_load tk_optionMenu
721 rename tk_optionMenu real__tkOptionMenu
722 proc tk_optionMenu {w varName args} {
723 set m [eval real__tkOptionMenu $w $varName $args]
724 $m configure -font font_ui
725 $w configure -font font_ui
726 return $m
727 }
728
729 proc rmsel_tag {text} {
730 $text tag conf sel \
731 -background [$text cget -background] \
732 -foreground [$text cget -foreground] \
733 -borderwidth 0
734 $text tag conf in_sel -background lightgray
735 bind $text <Motion> break
736 return $text
737 }
738
739 wm withdraw .
740 set root_exists 0
741 bind . <Visibility> {
742 bind . <Visibility> {}
743 set root_exists 1
744 }
745
746 if {[is_Windows]} {
747 wm iconbitmap . -default $oguilib/git-gui.ico
748 set ::tk::AlwaysShowSelection 1
749 bind . <Control-F2> {console show}
750
751 # Spoof an X11 display for SSH
752 if {![info exists env(DISPLAY)]} {
753 set env(DISPLAY) :9999
754 }
755 } else {
756 catch {
757 image create photo gitlogo -width 16 -height 16
758
759 gitlogo put #33CC33 -to 7 0 9 2
760 gitlogo put #33CC33 -to 4 2 12 4
761 gitlogo put #33CC33 -to 7 4 9 6
762 gitlogo put #CC3333 -to 4 6 12 8
763 gitlogo put gray26 -to 4 9 6 10
764 gitlogo put gray26 -to 3 10 6 12
765 gitlogo put gray26 -to 8 9 13 11
766 gitlogo put gray26 -to 8 11 10 12
767 gitlogo put gray26 -to 11 11 13 14
768 gitlogo put gray26 -to 3 12 5 14
769 gitlogo put gray26 -to 5 13
770 gitlogo put gray26 -to 10 13
771 gitlogo put gray26 -to 4 14 12 15
772 gitlogo put gray26 -to 5 15 11 16
773 gitlogo redither
774
775 image create photo gitlogo32 -width 32 -height 32
776 gitlogo32 copy gitlogo -zoom 2 2
777
778 wm iconphoto . -default gitlogo gitlogo32
779 }
780 }
781
782 ######################################################################
783 ##
784 ## config defaults
785
786 set cursor_ptr arrow
787 font create font_ui
788 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
789 eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
790 eval [linsert [font actual TkFixedFont] 0 font create font_diff]
791 } else {
792 font create font_diff -family Courier -size 10
793 catch {
794 label .dummy
795 eval font configure font_ui [font actual [.dummy cget -font]]
796 destroy .dummy
797 }
798 }
799
800 font create font_uiitalic
801 font create font_uibold
802 font create font_diffbold
803 font create font_diffitalic
804
805 foreach class {Button Checkbutton Entry Label
806 Labelframe Listbox Message
807 Radiobutton Spinbox Text} {
808 option add *$class.font font_ui
809 }
810 if {![is_MacOSX]} {
811 option add *Menu.font font_ui
812 option add *Entry.borderWidth 1 startupFile
813 option add *Entry.relief sunken startupFile
814 option add *RadioButton.anchor w startupFile
815 }
816 unset class
817
818 if {[is_Windows] || [is_MacOSX]} {
819 option add *Menu.tearOff 0
820 }
821
822 if {[is_MacOSX]} {
823 set M1B M1
824 set M1T Cmd
825 } else {
826 set M1B Control
827 set M1T Ctrl
828 }
829
830 proc bind_button3 {w cmd} {
831 bind $w <Any-Button-3> $cmd
832 if {[is_MacOSX]} {
833 # Mac OS X sends Button-2 on right click through three-button mouse,
834 # or through trackpad right-clicking (two-finger touch + click).
835 bind $w <Any-Button-2> $cmd
836 bind $w <Control-Button-1> $cmd
837 }
838 }
839
840 proc apply_config {} {
841 global repo_config font_descs
842
843 foreach option $font_descs {
844 set name [lindex $option 0]
845 set font [lindex $option 1]
846 if {[catch {
847 set need_weight 1
848 foreach {cn cv} $repo_config(gui.$name) {
849 if {$cn eq {-weight}} {
850 set need_weight 0
851 }
852 font configure $font $cn $cv
853 }
854 if {$need_weight} {
855 font configure $font -weight normal
856 }
857 } err]} {
858 error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
859 }
860 foreach {cn cv} [font configure $font] {
861 font configure ${font}bold $cn $cv
862 font configure ${font}italic $cn $cv
863 }
864 font configure ${font}bold -weight bold
865 font configure ${font}italic -slant italic
866 }
867
868 global use_ttk NS
869 set use_ttk 0
870 set NS {}
871 if {$repo_config(gui.usettk)} {
872 set use_ttk [package vsatisfies [package provide Tk] 8.5]
873 if {$use_ttk} {
874 set NS ttk
875 bind [winfo class .] <<ThemeChanged>> [list InitTheme]
876 pave_toplevel .
877 }
878 }
879 }
880
881 set default_config(branch.autosetupmerge) true
882 set default_config(merge.tool) {}
883 set default_config(mergetool.keepbackup) true
884 set default_config(merge.diffstat) true
885 set default_config(merge.summary) false
886 set default_config(merge.verbosity) 2
887 set default_config(user.name) {}
888 set default_config(user.email) {}
889
890 set default_config(gui.encoding) [encoding system]
891 set default_config(gui.matchtrackingbranch) false
892 set default_config(gui.textconv) true
893 set default_config(gui.pruneduringfetch) false
894 set default_config(gui.trustmtime) false
895 set default_config(gui.fastcopyblame) false
896 set default_config(gui.maxrecentrepo) 10
897 set default_config(gui.copyblamethreshold) 40
898 set default_config(gui.blamehistoryctx) 7
899 set default_config(gui.diffcontext) 5
900 set default_config(gui.diffopts) {}
901 set default_config(gui.commitmsgwidth) 75
902 set default_config(gui.newbranchtemplate) {}
903 set default_config(gui.spellingdictionary) {}
904 set default_config(gui.fontui) [font configure font_ui]
905 set default_config(gui.fontdiff) [font configure font_diff]
906 # TODO: this option should be added to the git-config documentation
907 set default_config(gui.maxfilesdisplayed) 5000
908 set default_config(gui.usettk) 1
909 set default_config(gui.warndetachedcommit) 1
910 set font_descs {
911 {fontui font_ui {mc "Main Font"}}
912 {fontdiff font_diff {mc "Diff/Console Font"}}
913 }
914 set default_config(gui.stageuntracked) ask
915 set default_config(gui.displayuntracked) true
916
917 ######################################################################
918 ##
919 ## find git
920
921 set _git [_which git]
922 if {$_git eq {}} {
923 catch {wm withdraw .}
924 tk_messageBox \
925 -icon error \
926 -type ok \
927 -title [mc "git-gui: fatal error"] \
928 -message [mc "Cannot find git in PATH."]
929 exit 1
930 }
931
932 ######################################################################
933 ##
934 ## version check
935
936 if {[catch {set _git_version [git --version]} err]} {
937 catch {wm withdraw .}
938 tk_messageBox \
939 -icon error \
940 -type ok \
941 -title [mc "git-gui: fatal error"] \
942 -message "Cannot determine Git version:
943
944 $err
945
946 [appname] requires Git 1.5.0 or later."
947 exit 1
948 }
949 if {![regsub {^git version } $_git_version {} _git_version]} {
950 catch {wm withdraw .}
951 tk_messageBox \
952 -icon error \
953 -type ok \
954 -title [mc "git-gui: fatal error"] \
955 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
956 exit 1
957 }
958
959 proc get_trimmed_version {s} {
960 set r {}
961 foreach x [split $s -._] {
962 if {[string is integer -strict $x]} {
963 lappend r $x
964 } else {
965 break
966 }
967 }
968 return [join $r .]
969 }
970 set _real_git_version $_git_version
971 set _git_version [get_trimmed_version $_git_version]
972
973 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
974 catch {wm withdraw .}
975 if {[tk_messageBox \
976 -icon warning \
977 -type yesno \
978 -default no \
979 -title "[appname]: warning" \
980 -message [mc "Git version cannot be determined.
981
982 %s claims it is version '%s'.
983
984 %s requires at least Git 1.5.0 or later.
985
986 Assume '%s' is version 1.5.0?
987 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
988 set _git_version 1.5.0
989 } else {
990 exit 1
991 }
992 }
993 unset _real_git_version
994
995 proc git-version {args} {
996 global _git_version
997
998 switch [llength $args] {
999 0 {
1000 return $_git_version
1001 }
1002
1003 2 {
1004 set op [lindex $args 0]
1005 set vr [lindex $args 1]
1006 set cm [package vcompare $_git_version $vr]
1007 return [expr $cm $op 0]
1008 }
1009
1010 4 {
1011 set type [lindex $args 0]
1012 set name [lindex $args 1]
1013 set parm [lindex $args 2]
1014 set body [lindex $args 3]
1015
1016 if {($type ne {proc} && $type ne {method})} {
1017 error "Invalid arguments to git-version"
1018 }
1019 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
1020 error "Last arm of $type $name must be default"
1021 }
1022
1023 foreach {op vr cb} [lrange $body 0 end-2] {
1024 if {[git-version $op $vr]} {
1025 return [uplevel [list $type $name $parm $cb]]
1026 }
1027 }
1028
1029 return [uplevel [list $type $name $parm [lindex $body end]]]
1030 }
1031
1032 default {
1033 error "git-version >= x"
1034 }
1035
1036 }
1037 }
1038
1039 if {[git-version < 1.5]} {
1040 catch {wm withdraw .}
1041 tk_messageBox \
1042 -icon error \
1043 -type ok \
1044 -title [mc "git-gui: fatal error"] \
1045 -message "[appname] requires Git 1.5.0 or later.
1046
1047 You are using [git-version]:
1048
1049 [git --version]"
1050 exit 1
1051 }
1052
1053 ######################################################################
1054 ##
1055 ## configure our library
1056
1057 set idx [file join $oguilib tclIndex]
1058 if {[catch {set fd [open $idx r]} err]} {
1059 catch {wm withdraw .}
1060 tk_messageBox \
1061 -icon error \
1062 -type ok \
1063 -title [mc "git-gui: fatal error"] \
1064 -message $err
1065 exit 1
1066 }
1067 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1068 set idx [list]
1069 while {[gets $fd n] >= 0} {
1070 if {$n ne {} && ![string match #* $n]} {
1071 lappend idx $n
1072 }
1073 }
1074 } else {
1075 set idx {}
1076 }
1077 close $fd
1078
1079 if {$idx ne {}} {
1080 set loaded [list]
1081 foreach p $idx {
1082 if {[lsearch -exact $loaded $p] >= 0} continue
1083 source [file join $oguilib $p]
1084 lappend loaded $p
1085 }
1086 unset loaded p
1087 } else {
1088 set auto_path [concat [list $oguilib] $auto_path]
1089 }
1090 unset -nocomplain idx fd
1091
1092 ######################################################################
1093 ##
1094 ## config file parsing
1095
1096 git-version proc _parse_config {arr_name args} {
1097 >= 1.5.3 {
1098 upvar $arr_name arr
1099 array unset arr
1100 set buf {}
1101 catch {
1102 set fd_rc [eval \
1103 [list git_read config] \
1104 $args \
1105 [list --null --list]]
1106 fconfigure $fd_rc -translation binary
1107 set buf [read $fd_rc]
1108 close $fd_rc
1109 }
1110 foreach line [split $buf "\0"] {
1111 if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1112 if {[is_many_config $name]} {
1113 lappend arr($name) $value
1114 } else {
1115 set arr($name) $value
1116 }
1117 } elseif {[regexp {^([^\n]+)$} $line line name]} {
1118 # no value given, but interpreting them as
1119 # boolean will be handled as true
1120 set arr($name) {}
1121 }
1122 }
1123 }
1124 default {
1125 upvar $arr_name arr
1126 array unset arr
1127 catch {
1128 set fd_rc [eval [list git_read config --list] $args]
1129 while {[gets $fd_rc line] >= 0} {
1130 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1131 if {[is_many_config $name]} {
1132 lappend arr($name) $value
1133 } else {
1134 set arr($name) $value
1135 }
1136 } elseif {[regexp {^([^=]+)$} $line line name]} {
1137 # no value given, but interpreting them as
1138 # boolean will be handled as true
1139 set arr($name) {}
1140 }
1141 }
1142 close $fd_rc
1143 }
1144 }
1145 }
1146
1147 proc load_config {include_global} {
1148 global repo_config global_config system_config default_config
1149
1150 if {$include_global} {
1151 _parse_config system_config --system
1152 _parse_config global_config --global
1153 }
1154 _parse_config repo_config
1155
1156 foreach name [array names default_config] {
1157 if {[catch {set v $system_config($name)}]} {
1158 set system_config($name) $default_config($name)
1159 }
1160 }
1161 foreach name [array names system_config] {
1162 if {[catch {set v $global_config($name)}]} {
1163 set global_config($name) $system_config($name)
1164 }
1165 if {[catch {set v $repo_config($name)}]} {
1166 set repo_config($name) $system_config($name)
1167 }
1168 }
1169 }
1170
1171 ######################################################################
1172 ##
1173 ## feature option selection
1174
1175 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1176 unset _junk
1177 } else {
1178 set subcommand gui
1179 }
1180 if {$subcommand eq {gui.sh}} {
1181 set subcommand gui
1182 }
1183 if {$subcommand eq {gui} && [llength $argv] > 0} {
1184 set subcommand [lindex $argv 0]
1185 set argv [lrange $argv 1 end]
1186 }
1187
1188 enable_option multicommit
1189 enable_option branch
1190 enable_option transport
1191 disable_option bare
1192
1193 switch -- $subcommand {
1194 browser -
1195 blame -
1196 grep {
1197 enable_option bare
1198
1199 disable_option multicommit
1200 disable_option branch
1201 disable_option transport
1202 }
1203 citool {
1204 enable_option singlecommit
1205 enable_option retcode
1206
1207 disable_option multicommit
1208 disable_option branch
1209 disable_option transport
1210
1211 while {[llength $argv] > 0} {
1212 set a [lindex $argv 0]
1213 switch -- $a {
1214 --amend {
1215 enable_option initialamend
1216 }
1217 --nocommit {
1218 enable_option nocommit
1219 enable_option nocommitmsg
1220 }
1221 --commitmsg {
1222 disable_option nocommitmsg
1223 }
1224 default {
1225 break
1226 }
1227 }
1228
1229 set argv [lrange $argv 1 end]
1230 }
1231 }
1232 }
1233
1234 ######################################################################
1235 ##
1236 ## execution environment
1237
1238 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1239
1240 # Suggest our implementation of askpass, if none is set
1241 if {![info exists env(SSH_ASKPASS)]} {
1242 set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1243 }
1244
1245 ######################################################################
1246 ##
1247 ## repository setup
1248
1249 set picked 0
1250 if {[catch {
1251 set _gitdir $env(GIT_DIR)
1252 set _prefix {}
1253 }]
1254 && [catch {
1255 # beware that from the .git dir this sets _gitdir to .
1256 # and _prefix to the empty string
1257 set _gitdir [git rev-parse --git-dir]
1258 set _prefix [git rev-parse --show-prefix]
1259 } err]} {
1260 load_config 1
1261 apply_config
1262 choose_repository::pick
1263 set picked 1
1264 }
1265
1266 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1267 # run from the .git dir itself) lest the routines to find the worktree
1268 # get confused
1269 if {$_gitdir eq "."} {
1270 set _gitdir [pwd]
1271 }
1272
1273 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1274 catch {set _gitdir [exec cygpath --windows $_gitdir]}
1275 }
1276 if {![file isdirectory $_gitdir]} {
1277 catch {wm withdraw .}
1278 error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1279 exit 1
1280 }
1281
1282 # _gitdir exists, so try loading the config
1283 load_config 0
1284 apply_config
1285
1286 # v1.7.0 introduced --show-toplevel to return the canonical work-tree
1287 if {[package vsatisfies $_git_version 1.7.0]} {
1288 if { [is_Cygwin] } {
1289 catch {set _gitworktree [exec cygpath --windows [git rev-parse --show-toplevel]]}
1290 } else {
1291 set _gitworktree [git rev-parse --show-toplevel]
1292 }
1293 } else {
1294 # try to set work tree from environment, core.worktree or use
1295 # cdup to obtain a relative path to the top of the worktree. If
1296 # run from the top, the ./ prefix ensures normalize expands pwd.
1297 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1298 set _gitworktree [get_config core.worktree]
1299 if {$_gitworktree eq ""} {
1300 set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1301 }
1302 }
1303 }
1304
1305 if {$_prefix ne {}} {
1306 if {$_gitworktree eq {}} {
1307 regsub -all {[^/]+/} $_prefix ../ cdup
1308 } else {
1309 set cdup $_gitworktree
1310 }
1311 if {[catch {cd $cdup} err]} {
1312 catch {wm withdraw .}
1313 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1314 exit 1
1315 }
1316 set _gitworktree [pwd]
1317 unset cdup
1318 } elseif {![is_enabled bare]} {
1319 if {[is_bare]} {
1320 catch {wm withdraw .}
1321 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1322 exit 1
1323 }
1324 if {$_gitworktree eq {}} {
1325 set _gitworktree [file dirname $_gitdir]
1326 }
1327 if {[catch {cd $_gitworktree} err]} {
1328 catch {wm withdraw .}
1329 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1330 exit 1
1331 }
1332 set _gitworktree [pwd]
1333 }
1334 set _reponame [file split [file normalize $_gitdir]]
1335 if {[lindex $_reponame end] eq {.git}} {
1336 set _reponame [lindex $_reponame end-1]
1337 } else {
1338 set _reponame [lindex $_reponame end]
1339 }
1340
1341 proc git_env_proxy {var_name index_name op} {
1342 upvar $var_name var
1343 # strip leading ::
1344 set var_name [string range $var_name 2 end]
1345 if {$op eq "write"} {
1346 set ::env($var_name) $var
1347 } elseif {$op eq "unset"} {
1348 unset ::env($var_name)
1349 }
1350 }
1351
1352 proc git_reset_env {} {
1353 set ::GIT_DIR $::_gitdir
1354 set ::GIT_WORK_TREE $::_gitworktree
1355 set ::GIT_INDEX_FILE $::_gitindex
1356 }
1357
1358 proc git_clear_env {} {
1359 unset ::GIT_DIR
1360 unset ::GIT_WORK_TREE
1361 unset ::GIT_INDEX_FILE
1362 }
1363
1364 set _gitdir [file normalize $_gitdir]
1365 set GIT_DIR $_gitdir
1366 trace add variable GIT_DIR [list write unset] git_env_proxy
1367
1368 set _gitworktree [file normalize $_gitworktree]
1369 set GIT_WORK_TREE $_gitworktree
1370 trace add variable GIT_WORK_TREE [list write unset] git_env_proxy
1371
1372 if {[info exists env(GIT_INDEX_FILE)]} {
1373 set _gitindex $env(GIT_INDEX_FILE)
1374 } else {
1375 set _gitindex [gitdir index]
1376 }
1377 set GIT_INDEX_FILE $_gitindex
1378 trace add variable GIT_INDEX_FILE [list write unset] git_env_proxy
1379
1380 git_reset_env
1381
1382 catch { unset env(GIT_EDITOR_F_NBLOCK) }
1383 catch { unset env(GIT_EDITOR_F_POSITION) }
1384
1385 ######################################################################
1386 ##
1387 ## global init
1388
1389 set current_diff_path {}
1390 set current_diff_side {}
1391 set diff_actions [list]
1392
1393 set HEAD {}
1394 set PARENT {}
1395 set MERGE_HEAD [list]
1396 set commit_type {}
1397 set empty_tree {}
1398 set current_branch {}
1399 set is_detached 0
1400 set current_diff_path {}
1401 set is_3way_diff 0
1402 set is_submodule_diff 0
1403 set is_conflict_diff 0
1404 set selected_commit_type new
1405 set diff_empty_count 0
1406 set diff_show_line_numbers 1
1407 set diff_lno_column_width 0
1408 set is_other_diff 0
1409
1410 set nullid "0000000000000000000000000000000000000000"
1411 set nullid2 "0000000000000000000000000000000000000001"
1412
1413
1414 ######################################################################
1415 ##
1416 ## task management
1417
1418 set rescan_active 0
1419 set diff_active 0
1420 set last_clicked {}
1421
1422 set disable_on_lock [list]
1423 set index_lock_type none
1424
1425 proc lock_index {type} {
1426 global index_lock_type disable_on_lock
1427
1428 if {$index_lock_type eq {none}} {
1429 set index_lock_type $type
1430 foreach w $disable_on_lock {
1431 uplevel #0 $w disabled
1432 }
1433 return 1
1434 } elseif {$index_lock_type eq "begin-$type"} {
1435 set index_lock_type $type
1436 return 1
1437 }
1438 return 0
1439 }
1440
1441 proc unlock_index {} {
1442 global index_lock_type disable_on_lock
1443
1444 set index_lock_type none
1445 foreach w $disable_on_lock {
1446 uplevel #0 $w normal
1447 }
1448 }
1449
1450 ######################################################################
1451 ##
1452 ## status
1453
1454 proc repository_state {ctvar hdvar mhvar} {
1455 global current_branch
1456 upvar $ctvar ct $hdvar hd $mhvar mh
1457
1458 set mh [list]
1459
1460 load_current_branch
1461 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1462 set hd {}
1463 set ct initial
1464 return
1465 }
1466
1467 set merge_head [gitdir MERGE_HEAD]
1468 if {[file exists $merge_head]} {
1469 set ct merge
1470 set fd_mh [open $merge_head r]
1471 while {[gets $fd_mh line] >= 0} {
1472 lappend mh $line
1473 }
1474 close $fd_mh
1475 return
1476 }
1477
1478 set ct normal
1479 }
1480
1481 proc PARENT {} {
1482 global PARENT empty_tree
1483
1484 set p [lindex $PARENT 0]
1485 if {$p ne {}} {
1486 return $p
1487 }
1488 if {$empty_tree eq {}} {
1489 set empty_tree [git mktree << {}]
1490 }
1491 return $empty_tree
1492 }
1493
1494 proc force_amend {} {
1495 global selected_commit_type
1496 global HEAD PARENT MERGE_HEAD commit_type
1497
1498 repository_state newType newHEAD newMERGE_HEAD
1499 set HEAD $newHEAD
1500 set PARENT $newHEAD
1501 set MERGE_HEAD $newMERGE_HEAD
1502 set commit_type $newType
1503
1504 set selected_commit_type amend
1505 do_select_commit_type
1506 }
1507
1508 proc rescan {after {honor_trustmtime 1}} {
1509 global HEAD PARENT MERGE_HEAD commit_type
1510 global ui_index ui_workdir ui_comm
1511 global rescan_active file_states
1512 global repo_config
1513
1514 if {$rescan_active > 0 || ![lock_index read]} return
1515
1516 repository_state newType newHEAD newMERGE_HEAD
1517 if {[string match amend* $commit_type]
1518 && $newType eq {normal}
1519 && $newHEAD eq $HEAD} {
1520 } else {
1521 set HEAD $newHEAD
1522 set PARENT $newHEAD
1523 set MERGE_HEAD $newMERGE_HEAD
1524 set commit_type $newType
1525 }
1526
1527 array unset file_states
1528
1529 if {!$::GITGUI_BCK_exists &&
1530 (![$ui_comm edit modified]
1531 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1532 if {[string match amend* $commit_type]} {
1533 } elseif {[load_message GITGUI_MSG utf-8]} {
1534 } elseif {[run_prepare_commit_msg_hook]} {
1535 } elseif {[load_message MERGE_MSG]} {
1536 } elseif {[load_message SQUASH_MSG]} {
1537 }
1538 $ui_comm edit reset
1539 $ui_comm edit modified false
1540 }
1541
1542 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1543 rescan_stage2 {} $after
1544 } else {
1545 set rescan_active 1
1546 ui_status [mc "Refreshing file status..."]
1547 set fd_rf [git_read update-index \
1548 -q \
1549 --unmerged \
1550 --ignore-missing \
1551 --refresh \
1552 ]
1553 fconfigure $fd_rf -blocking 0 -translation binary
1554 fileevent $fd_rf readable \
1555 [list rescan_stage2 $fd_rf $after]
1556 }
1557 }
1558
1559 if {[is_Cygwin]} {
1560 set is_git_info_exclude {}
1561 proc have_info_exclude {} {
1562 global is_git_info_exclude
1563
1564 if {$is_git_info_exclude eq {}} {
1565 if {[catch {exec test -f [gitdir info exclude]}]} {
1566 set is_git_info_exclude 0
1567 } else {
1568 set is_git_info_exclude 1
1569 }
1570 }
1571 return $is_git_info_exclude
1572 }
1573 } else {
1574 proc have_info_exclude {} {
1575 return [file readable [gitdir info exclude]]
1576 }
1577 }
1578
1579 proc rescan_stage2 {fd after} {
1580 global rescan_active buf_rdi buf_rdf buf_rlo
1581
1582 if {$fd ne {}} {
1583 read $fd
1584 if {![eof $fd]} return
1585 close $fd
1586 }
1587
1588 if {[package vsatisfies $::_git_version 1.6.3]} {
1589 set ls_others [list --exclude-standard]
1590 } else {
1591 set ls_others [list --exclude-per-directory=.gitignore]
1592 if {[have_info_exclude]} {
1593 lappend ls_others "--exclude-from=[gitdir info exclude]"
1594 }
1595 set user_exclude [get_config core.excludesfile]
1596 if {$user_exclude ne {} && [file readable $user_exclude]} {
1597 lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1598 }
1599 }
1600
1601 set buf_rdi {}
1602 set buf_rdf {}
1603 set buf_rlo {}
1604
1605 set rescan_active 2
1606 ui_status [mc "Scanning for modified files ..."]
1607 set fd_di [git_read diff-index --cached -z [PARENT]]
1608 set fd_df [git_read diff-files -z]
1609
1610 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1611 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1612
1613 fileevent $fd_di readable [list read_diff_index $fd_di $after]
1614 fileevent $fd_df readable [list read_diff_files $fd_df $after]
1615
1616 if {[is_config_true gui.displayuntracked]} {
1617 set fd_lo [eval git_read ls-files --others -z $ls_others]
1618 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1619 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1620 incr rescan_active
1621 }
1622 }
1623
1624 proc load_message {file {encoding {}}} {
1625 global ui_comm
1626
1627 set f [gitdir $file]
1628 if {[file isfile $f]} {
1629 if {[catch {set fd [open $f r]}]} {
1630 return 0
1631 }
1632 fconfigure $fd -eofchar {}
1633 if {$encoding ne {}} {
1634 fconfigure $fd -encoding $encoding
1635 }
1636 set content [string trim [read $fd]]
1637 close $fd
1638 regsub -all -line {[ \r\t]+$} $content {} content
1639 $ui_comm delete 0.0 end
1640 $ui_comm insert end $content
1641 return 1
1642 }
1643 return 0
1644 }
1645
1646 proc run_prepare_commit_msg_hook {} {
1647 global pch_error
1648
1649 # prepare-commit-msg requires PREPARE_COMMIT_MSG exist. From git-gui
1650 # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1651 # empty file but existent file.
1652
1653 set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1654
1655 if {[file isfile [gitdir MERGE_MSG]]} {
1656 set pcm_source "merge"
1657 set fd_mm [open [gitdir MERGE_MSG] r]
1658 puts -nonewline $fd_pcm [read $fd_mm]
1659 close $fd_mm
1660 } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1661 set pcm_source "squash"
1662 set fd_sm [open [gitdir SQUASH_MSG] r]
1663 puts -nonewline $fd_pcm [read $fd_sm]
1664 close $fd_sm
1665 } else {
1666 set pcm_source ""
1667 }
1668
1669 close $fd_pcm
1670
1671 set fd_ph [githook_read prepare-commit-msg \
1672 [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1673 if {$fd_ph eq {}} {
1674 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1675 return 0;
1676 }
1677
1678 ui_status [mc "Calling prepare-commit-msg hook..."]
1679 set pch_error {}
1680
1681 fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1682 fileevent $fd_ph readable \
1683 [list prepare_commit_msg_hook_wait $fd_ph]
1684
1685 return 1;
1686 }
1687
1688 proc prepare_commit_msg_hook_wait {fd_ph} {
1689 global pch_error
1690
1691 append pch_error [read $fd_ph]
1692 fconfigure $fd_ph -blocking 1
1693 if {[eof $fd_ph]} {
1694 if {[catch {close $fd_ph}]} {
1695 ui_status [mc "Commit declined by prepare-commit-msg hook."]
1696 hook_failed_popup prepare-commit-msg $pch_error
1697 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1698 exit 1
1699 } else {
1700 load_message PREPARE_COMMIT_MSG
1701 }
1702 set pch_error {}
1703 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1704 return
1705 }
1706 fconfigure $fd_ph -blocking 0
1707 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1708 }
1709
1710 proc read_diff_index {fd after} {
1711 global buf_rdi
1712
1713 append buf_rdi [read $fd]
1714 set c 0
1715 set n [string length $buf_rdi]
1716 while {$c < $n} {
1717 set z1 [string first "\0" $buf_rdi $c]
1718 if {$z1 == -1} break
1719 incr z1
1720 set z2 [string first "\0" $buf_rdi $z1]
1721 if {$z2 == -1} break
1722
1723 incr c
1724 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1725 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1726 merge_state \
1727 [encoding convertfrom $p] \
1728 [lindex $i 4]? \
1729 [list [lindex $i 0] [lindex $i 2]] \
1730 [list]
1731 set c $z2
1732 incr c
1733 }
1734 if {$c < $n} {
1735 set buf_rdi [string range $buf_rdi $c end]
1736 } else {
1737 set buf_rdi {}
1738 }
1739
1740 rescan_done $fd buf_rdi $after
1741 }
1742
1743 proc read_diff_files {fd after} {
1744 global buf_rdf
1745
1746 append buf_rdf [read $fd]
1747 set c 0
1748 set n [string length $buf_rdf]
1749 while {$c < $n} {
1750 set z1 [string first "\0" $buf_rdf $c]
1751 if {$z1 == -1} break
1752 incr z1
1753 set z2 [string first "\0" $buf_rdf $z1]
1754 if {$z2 == -1} break
1755
1756 incr c
1757 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1758 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1759 merge_state \
1760 [encoding convertfrom $p] \
1761 ?[lindex $i 4] \
1762 [list] \
1763 [list [lindex $i 0] [lindex $i 2]]
1764 set c $z2
1765 incr c
1766 }
1767 if {$c < $n} {
1768 set buf_rdf [string range $buf_rdf $c end]
1769 } else {
1770 set buf_rdf {}
1771 }
1772
1773 rescan_done $fd buf_rdf $after
1774 }
1775
1776 proc read_ls_others {fd after} {
1777 global buf_rlo
1778
1779 append buf_rlo [read $fd]
1780 set pck [split $buf_rlo "\0"]
1781 set buf_rlo [lindex $pck end]
1782 foreach p [lrange $pck 0 end-1] {
1783 set p [encoding convertfrom $p]
1784 if {[string index $p end] eq {/}} {
1785 set p [string range $p 0 end-1]
1786 }
1787 merge_state $p ?O
1788 }
1789 rescan_done $fd buf_rlo $after
1790 }
1791
1792 proc rescan_done {fd buf after} {
1793 global rescan_active current_diff_path
1794 global file_states repo_config
1795 upvar $buf to_clear
1796
1797 if {![eof $fd]} return
1798 set to_clear {}
1799 close $fd
1800 if {[incr rescan_active -1] > 0} return
1801
1802 prune_selection
1803 unlock_index
1804 display_all_files
1805 if {$current_diff_path ne {}} { reshow_diff $after }
1806 if {$current_diff_path eq {}} { select_first_diff $after }
1807 }
1808
1809 proc prune_selection {} {
1810 global file_states selected_paths
1811
1812 foreach path [array names selected_paths] {
1813 if {[catch {set still_here $file_states($path)}]} {
1814 unset selected_paths($path)
1815 }
1816 }
1817 }
1818
1819 ######################################################################
1820 ##
1821 ## ui helpers
1822
1823 proc mapicon {w state path} {
1824 global all_icons
1825
1826 if {[catch {set r $all_icons($state$w)}]} {
1827 puts "error: no icon for $w state={$state} $path"
1828 return file_plain
1829 }
1830 return $r
1831 }
1832
1833 proc mapdesc {state path} {
1834 global all_descs
1835
1836 if {[catch {set r $all_descs($state)}]} {
1837 puts "error: no desc for state={$state} $path"
1838 return $state
1839 }
1840 return $r
1841 }
1842
1843 proc ui_status {msg} {
1844 global main_status
1845 if {[info exists main_status]} {
1846 $main_status show $msg
1847 }
1848 }
1849
1850 proc ui_ready {{test {}}} {
1851 global main_status
1852 if {[info exists main_status]} {
1853 $main_status show [mc "Ready."] $test
1854 }
1855 }
1856
1857 proc escape_path {path} {
1858 regsub -all {\\} $path "\\\\" path
1859 regsub -all "\n" $path "\\n" path
1860 return $path
1861 }
1862
1863 proc short_path {path} {
1864 return [escape_path [lindex [file split $path] end]]
1865 }
1866
1867 set next_icon_id 0
1868 set null_sha1 [string repeat 0 40]
1869
1870 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1871 global file_states next_icon_id null_sha1
1872
1873 set s0 [string index $new_state 0]
1874 set s1 [string index $new_state 1]
1875
1876 if {[catch {set info $file_states($path)}]} {
1877 set state __
1878 set icon n[incr next_icon_id]
1879 } else {
1880 set state [lindex $info 0]
1881 set icon [lindex $info 1]
1882 if {$head_info eq {}} {set head_info [lindex $info 2]}
1883 if {$index_info eq {}} {set index_info [lindex $info 3]}
1884 }
1885
1886 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1887 elseif {$s0 eq {_}} {set s0 _}
1888
1889 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1890 elseif {$s1 eq {_}} {set s1 _}
1891
1892 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1893 set head_info [list 0 $null_sha1]
1894 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1895 && $head_info eq {}} {
1896 set head_info $index_info
1897 } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1898 set index_info $head_info
1899 set head_info {}
1900 }
1901
1902 set file_states($path) [list $s0$s1 $icon \
1903 $head_info $index_info \
1904 ]
1905 return $state
1906 }
1907
1908 proc display_file_helper {w path icon_name old_m new_m} {
1909 global file_lists
1910
1911 if {$new_m eq {_}} {
1912 set lno [lsearch -sorted -exact $file_lists($w) $path]
1913 if {$lno >= 0} {
1914 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1915 incr lno
1916 $w conf -state normal
1917 $w delete $lno.0 [expr {$lno + 1}].0
1918 $w conf -state disabled
1919 }
1920 } elseif {$old_m eq {_} && $new_m ne {_}} {
1921 lappend file_lists($w) $path
1922 set file_lists($w) [lsort -unique $file_lists($w)]
1923 set lno [lsearch -sorted -exact $file_lists($w) $path]
1924 incr lno
1925 $w conf -state normal
1926 $w image create $lno.0 \
1927 -align center -padx 5 -pady 1 \
1928 -name $icon_name \
1929 -image [mapicon $w $new_m $path]
1930 $w insert $lno.1 "[escape_path $path]\n"
1931 $w conf -state disabled
1932 } elseif {$old_m ne $new_m} {
1933 $w conf -state normal
1934 $w image conf $icon_name -image [mapicon $w $new_m $path]
1935 $w conf -state disabled
1936 }
1937 }
1938
1939 proc display_file {path state} {
1940 global file_states selected_paths
1941 global ui_index ui_workdir
1942
1943 set old_m [merge_state $path $state]
1944 set s $file_states($path)
1945 set new_m [lindex $s 0]
1946 set icon_name [lindex $s 1]
1947
1948 set o [string index $old_m 0]
1949 set n [string index $new_m 0]
1950 if {$o eq {U}} {
1951 set o _
1952 }
1953 if {$n eq {U}} {
1954 set n _
1955 }
1956 display_file_helper $ui_index $path $icon_name $o $n
1957
1958 if {[string index $old_m 0] eq {U}} {
1959 set o U
1960 } else {
1961 set o [string index $old_m 1]
1962 }
1963 if {[string index $new_m 0] eq {U}} {
1964 set n U
1965 } else {
1966 set n [string index $new_m 1]
1967 }
1968 display_file_helper $ui_workdir $path $icon_name $o $n
1969
1970 if {$new_m eq {__}} {
1971 unset file_states($path)
1972 catch {unset selected_paths($path)}
1973 }
1974 }
1975
1976 proc display_all_files_helper {w path icon_name m} {
1977 global file_lists
1978
1979 lappend file_lists($w) $path
1980 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1981 $w image create end \
1982 -align center -padx 5 -pady 1 \
1983 -name $icon_name \
1984 -image [mapicon $w $m $path]
1985 $w insert end "[escape_path $path]\n"
1986 }
1987
1988 set files_warning 0
1989 proc display_all_files {} {
1990 global ui_index ui_workdir
1991 global file_states file_lists
1992 global last_clicked
1993 global files_warning
1994
1995 $ui_index conf -state normal
1996 $ui_workdir conf -state normal
1997
1998 $ui_index delete 0.0 end
1999 $ui_workdir delete 0.0 end
2000 set last_clicked {}
2001
2002 set file_lists($ui_index) [list]
2003 set file_lists($ui_workdir) [list]
2004
2005 set to_display [lsort [array names file_states]]
2006 set display_limit [get_config gui.maxfilesdisplayed]
2007 if {[llength $to_display] > $display_limit} {
2008 if {!$files_warning} {
2009 # do not repeatedly warn:
2010 set files_warning 1
2011 info_popup [mc "Displaying only %s of %s files." \
2012 $display_limit [llength $to_display]]
2013 }
2014 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
2015 }
2016 foreach path $to_display {
2017 set s $file_states($path)
2018 set m [lindex $s 0]
2019 set icon_name [lindex $s 1]
2020
2021 set s [string index $m 0]
2022 if {$s ne {U} && $s ne {_}} {
2023 display_all_files_helper $ui_index $path \
2024 $icon_name $s
2025 }
2026
2027 if {[string index $m 0] eq {U}} {
2028 set s U
2029 } else {
2030 set s [string index $m 1]
2031 }
2032 if {$s ne {_}} {
2033 display_all_files_helper $ui_workdir $path \
2034 $icon_name $s
2035 }
2036 }
2037
2038 $ui_index conf -state disabled
2039 $ui_workdir conf -state disabled
2040 }
2041
2042 ######################################################################
2043 ##
2044 ## icons
2045
2046 set filemask {
2047 #define mask_width 14
2048 #define mask_height 15
2049 static unsigned char mask_bits[] = {
2050 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2051 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2052 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2053 }
2054
2055 image create bitmap file_plain -background white -foreground black -data {
2056 #define plain_width 14
2057 #define plain_height 15
2058 static unsigned char plain_bits[] = {
2059 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2060 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2061 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2062 } -maskdata $filemask
2063
2064 image create bitmap file_mod -background white -foreground blue -data {
2065 #define mod_width 14
2066 #define mod_height 15
2067 static unsigned char mod_bits[] = {
2068 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2069 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2070 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2071 } -maskdata $filemask
2072
2073 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2074 #define file_fulltick_width 14
2075 #define file_fulltick_height 15
2076 static unsigned char file_fulltick_bits[] = {
2077 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2078 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2079 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2080 } -maskdata $filemask
2081
2082 image create bitmap file_question -background white -foreground black -data {
2083 #define file_question_width 14
2084 #define file_question_height 15
2085 static unsigned char file_question_bits[] = {
2086 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2087 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2088 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2089 } -maskdata $filemask
2090
2091 image create bitmap file_removed -background white -foreground red -data {
2092 #define file_removed_width 14
2093 #define file_removed_height 15
2094 static unsigned char file_removed_bits[] = {
2095 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2096 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2097 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2098 } -maskdata $filemask
2099
2100 image create bitmap file_merge -background white -foreground blue -data {
2101 #define file_merge_width 14
2102 #define file_merge_height 15
2103 static unsigned char file_merge_bits[] = {
2104 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2105 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2106 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2107 } -maskdata $filemask
2108
2109 image create bitmap file_statechange -background white -foreground green -data {
2110 #define file_statechange_width 14
2111 #define file_statechange_height 15
2112 static unsigned char file_statechange_bits[] = {
2113 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2114 0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2115 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2116 } -maskdata $filemask
2117
2118 image create photo tab_close -data {R0lGODlhDgAOAMZaAFJSUlNTUlNTU1RUVFVVVVVWVVZWVllZWVpaWVpaWlpbWltbWltbW1xcW1xcXFxdXF1dXF1dXV1eXV5eXV5eXl9fXV9fXl9fX19gXmBgYGBhX2NjY2RlY2VlZWVmZGZmZmZnZWZoZWhpZ2hqaGtramttamxtbG1ubG5vbW9wbnBxb3FycHJzcXJzcnN1cnR1c3V1dHV2dHZ4dXd5dnt8enx+e4GCgIGDgYeIhoeJh4mKiIuLi42NjY+PjZCQkJGRkZKSkpSUlJWVlZeXl5mZmZubm5ycnJ2dnZ6enqCgoKKioqioqLOzs8XFxcbGxsfHx8vLy83NzdDQ0NHR0dLS0tbW1tnZ2d3d3d7e3t/f3////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////yH5BAEKAH8ALAAAAAAOAA4AAAeZgH+CWYKFf1eGf1QdQoY/H1WFURIrEUGCQBUtFFJ/VgkpOjkRP0ENODokG1h/SQclMjcPBzYzIwRMhUcGISw1NC4hA0uJRAQgKCogA0aJfzwMMR4eMQ47iT4HLyIYEyIwCD2FQQcmHBABAg8cJweNUxQKGgsCSEoA8ggUU39PGQUEhggqMsCAhSeFnFzwYSgIhSaJoDiTKCgQADs=}
2119
2120 set ui_index .vpane.files.index.list
2121 set ui_workdir .vpane.files.workdir.list
2122
2123 set all_icons(_$ui_index) file_plain
2124 set all_icons(A$ui_index) file_plain
2125 set all_icons(M$ui_index) file_fulltick
2126 set all_icons(D$ui_index) file_removed
2127 set all_icons(U$ui_index) file_merge
2128 set all_icons(T$ui_index) file_statechange
2129
2130 set all_icons(_$ui_workdir) file_plain
2131 set all_icons(M$ui_workdir) file_mod
2132 set all_icons(D$ui_workdir) file_question
2133 set all_icons(U$ui_workdir) file_merge
2134 set all_icons(O$ui_workdir) file_plain
2135 set all_icons(T$ui_workdir) file_statechange
2136
2137 foreach i {
2138 {__ {mc "Unmodified"}}
2139
2140 {_M {mc "Modified, not staged"}}
2141 {M_ {mc "Staged for commit"}}
2142 {MM {mc "Portions staged for commit"}}
2143 {MD {mc "Staged for commit, missing"}}
2144
2145 {_T {mc "File type changed, not staged"}}
2146 {MT {mc "File type changed, old type staged for commit"}}
2147 {AT {mc "File type changed, old type staged for commit"}}
2148 {T_ {mc "File type changed, staged"}}
2149 {TM {mc "File type change staged, modification not staged"}}
2150 {TD {mc "File type change staged, file missing"}}
2151
2152 {_O {mc "Untracked, not staged"}}
2153 {A_ {mc "Staged for commit"}}
2154 {AM {mc "Portions staged for commit"}}
2155 {AD {mc "Staged for commit, missing"}}
2156
2157 {_D {mc "Missing"}}
2158 {D_ {mc "Staged for removal"}}
2159 {DO {mc "Staged for removal, still present"}}
2160
2161 {_U {mc "Requires merge resolution"}}
2162 {U_ {mc "Requires merge resolution"}}
2163 {UU {mc "Requires merge resolution"}}
2164 {UM {mc "Requires merge resolution"}}
2165 {UD {mc "Requires merge resolution"}}
2166 {UT {mc "Requires merge resolution"}}
2167 } {
2168 set all_descs([lindex $i 0]) [eval [lindex $i 1]]
2169 }
2170 unset i
2171
2172 ######################################################################
2173 ##
2174 ## util
2175
2176 proc scrollbar2many {list mode args} {
2177 foreach w $list {eval $w $mode $args}
2178 }
2179
2180 proc many2scrollbar {list mode sb top bottom} {
2181 $sb set $top $bottom
2182 foreach w $list {$w $mode moveto $top}
2183 }
2184
2185 # delegates mouse selection actions from gutter columns to the main text
2186 # widget
2187 # use delegator_bind, if you need to bind more actions
2188 proc delegate_sel_to {w from} {
2189 set bind_list [list \
2190 <Button-1> \
2191 <B1-Motion> \
2192 <Double-Button-1> \
2193 <Triple-Button-1> \
2194 <Shift-Button-1> \
2195 <Double-Shift-Button-1> \
2196 <Triple-Shift-Button-1> \
2197 ]
2198
2199 foreach seq $bind_list {
2200 set script [bind Text $seq]
2201 set new_script [string map [list %W $w %x 0 word line] $script]
2202 foreach f $from {
2203 bind $f $seq "$new_script; focus $w; break"
2204 }
2205 }
2206 }
2207
2208 # use this for binding any of the mouse actions from a delegator
2209 # see bind_list in delegate_sel_to
2210 proc delegator_bind {tag seq script} {
2211 bind $tag $seq "$script; [bind $tag $seq]"
2212 }
2213
2214 proc incr_font_size {font {amt 1}} {
2215 set sz [font configure $font -size]
2216 incr sz $amt
2217 font configure $font -size $sz
2218 font configure ${font}bold -size $sz
2219 font configure ${font}italic -size $sz
2220 }
2221
2222 ######################################################################
2223 ##
2224 ## ui commands
2225
2226 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2227
2228 proc do_gitk {revs {is_submodule false}} {
2229 global current_diff_path file_states current_diff_side ui_index
2230
2231 # -- Always start gitk through whatever we were loaded with. This
2232 # lets us bypass using shell process on Windows systems.
2233 #
2234 set exe [_which gitk -script]
2235 set cmd [list [info nameofexecutable] $exe]
2236 if {$exe eq {}} {
2237 error_popup [mc "Couldn't find gitk in PATH"]
2238 } else {
2239 global env
2240
2241 set pwd [pwd]
2242
2243 if {!$is_submodule} {
2244 if {![is_bare]} {
2245 cd $::GIT_WORK_TREE
2246 }
2247 } else {
2248 cd $current_diff_path
2249 if {$revs eq {--}} {
2250 set s $file_states($current_diff_path)
2251 set old_sha1 {}
2252 set new_sha1 {}
2253 switch -glob -- [lindex $s 0] {
2254 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2255 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2256 MM {
2257 if {$current_diff_side eq $ui_index} {
2258 set old_sha1 [lindex [lindex $s 2] 1]
2259 set new_sha1 [lindex [lindex $s 3] 1]
2260 } else {
2261 set old_sha1 [lindex [lindex $s 3] 1]
2262 }
2263 }
2264 }
2265 set revs $old_sha1...$new_sha1
2266 }
2267 # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2268 # we've been using for the main repository, so unset them.
2269 # TODO we could make life easier (start up faster?) for gitk
2270 # by setting these to the appropriate values to allow gitk
2271 # to skip the heuristics to find their proper value
2272 git_clear_env
2273 }
2274 eval exec $cmd $revs "--" "--" &
2275
2276 git_reset_env
2277 cd $pwd
2278
2279 ui_status $::starting_gitk_msg
2280 after 10000 {
2281 ui_ready $starting_gitk_msg
2282 }
2283 }
2284 }
2285
2286 proc do_git_gui {} {
2287 global current_diff_path
2288
2289 # -- Always start git gui through whatever we were loaded with. This
2290 # lets us bypass using shell process on Windows systems.
2291 #
2292 set exe [list [_which git]]
2293 if {$exe eq {}} {
2294 error_popup [mc "Couldn't find git gui in PATH"]
2295 } else {
2296 # see note in do_gitk about unsetting these vars when
2297 # running tools in a submodule
2298 git_clear_env
2299
2300 set pwd [pwd]
2301 cd $current_diff_path
2302
2303 eval exec $exe gui &
2304
2305 cd $pwd
2306 git_reset_env
2307
2308 ui_status $::starting_gitk_msg
2309 after 10000 {
2310 ui_ready $starting_gitk_msg
2311 }
2312 }
2313 }
2314
2315 proc do_explore {} {
2316 global _gitworktree
2317 set explorer {}
2318 if {[is_Cygwin] || [is_Windows]} {
2319 set explorer "explorer.exe"
2320 } elseif {[is_MacOSX]} {
2321 set explorer "open"
2322 } else {
2323 # freedesktop.org-conforming system is our best shot
2324 set explorer "xdg-open"
2325 }
2326 eval exec $explorer [list [file nativename $_gitworktree]] &
2327 }
2328
2329 set is_quitting 0
2330 set ret_code 1
2331
2332 proc terminate_me {win} {
2333 global ret_code
2334 if {$win ne {.}} return
2335 exit $ret_code
2336 }
2337
2338 proc do_quit {{rc {1}}} {
2339 global ui_comm is_quitting repo_config commit_type
2340 global GITGUI_BCK_exists GITGUI_BCK_i
2341 global ui_comm_spell
2342 global ret_code use_ttk
2343
2344 if {$is_quitting} return
2345 set is_quitting 1
2346
2347 if {[winfo exists $ui_comm]} {
2348 # -- Stash our current commit buffer.
2349 #
2350 set save [gitdir GITGUI_MSG]
2351 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2352 file rename -force [gitdir GITGUI_BCK] $save
2353 set GITGUI_BCK_exists 0
2354 } else {
2355 set msg [string trim [$ui_comm get 0.0 end]]
2356 regsub -all -line {[ \r\t]+$} $msg {} msg
2357 if {(![string match amend* $commit_type]
2358 || [$ui_comm edit modified])
2359 && $msg ne {}} {
2360 catch {
2361 set fd [open $save w]
2362 fconfigure $fd -encoding utf-8
2363 puts -nonewline $fd $msg
2364 close $fd
2365 }
2366 } else {
2367 catch {file delete $save}
2368 }
2369 }
2370
2371 # -- Cancel our spellchecker if its running.
2372 #
2373 if {[info exists ui_comm_spell]} {
2374 $ui_comm_spell stop
2375 }
2376
2377 # -- Remove our editor backup, its not needed.
2378 #
2379 after cancel $GITGUI_BCK_i
2380 if {$GITGUI_BCK_exists} {
2381 catch {file delete [gitdir GITGUI_BCK]}
2382 }
2383
2384 # -- Stash our current window geometry into this repository.
2385 #
2386 set cfg_wmstate [wm state .]
2387 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2388 set rc_wmstate {}
2389 }
2390 if {$cfg_wmstate ne $rc_wmstate} {
2391 catch {git config gui.wmstate $cfg_wmstate}
2392 }
2393 if {$cfg_wmstate eq {zoomed}} {
2394 # on Windows wm geometry will lie about window
2395 # position (but not size) when window is zoomed
2396 # restore the window before querying wm geometry
2397 wm state . normal
2398 }
2399 set cfg_geometry [list]
2400 lappend cfg_geometry [wm geometry .]
2401 if {$use_ttk} {
2402 lappend cfg_geometry [.vpane sashpos 0]
2403 lappend cfg_geometry [.vpane.files sashpos 0]
2404 } else {
2405 lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2406 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2407 }
2408 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2409 set rc_geometry {}
2410 }
2411 if {$cfg_geometry ne $rc_geometry} {
2412 catch {git config gui.geometry $cfg_geometry}
2413 }
2414 }
2415
2416 set ret_code $rc
2417
2418 # Briefly enable send again, working around Tk bug
2419 # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2420 tk appname [appname]
2421
2422 destroy .
2423 }
2424
2425 proc do_rescan {} {
2426 rescan ui_ready
2427 $::browser_tab reload
2428 $::grep_tab grep
2429 }
2430
2431 proc ui_do_rescan {} {
2432 rescan {force_first_diff ui_ready}
2433 $::browser_tab reload
2434 $::grep_tab grep
2435 }
2436
2437 proc do_commit {} {
2438 commit_tree
2439 $::browser_tab reload
2440 $::grep_tab grep
2441 }
2442
2443 proc next_diff {{after {}}} {
2444 global next_diff_p next_diff_w next_diff_i
2445 show_diff $next_diff_p $next_diff_w {} {} $after
2446 }
2447
2448 proc find_anchor_pos {lst name} {
2449 set lid [lsearch -sorted -exact $lst $name]
2450
2451 if {$lid == -1} {
2452 set lid 0
2453 foreach lname $lst {
2454 if {$lname >= $name} break
2455 incr lid
2456 }
2457 }
2458
2459 return $lid
2460 }
2461
2462 proc find_file_from {flist idx delta path mmask} {
2463 global file_states
2464
2465 set len [llength $flist]
2466 while {$idx >= 0 && $idx < $len} {
2467 set name [lindex $flist $idx]
2468
2469 if {$name ne $path && [info exists file_states($name)]} {
2470 set state [lindex $file_states($name) 0]
2471
2472 if {$mmask eq {} || [regexp $mmask $state]} {
2473 return $idx
2474 }
2475 }
2476
2477 incr idx $delta
2478 }
2479
2480 return {}
2481 }
2482
2483 proc find_next_diff {w path {lno {}} {mmask {}}} {
2484 global next_diff_p next_diff_w next_diff_i
2485 global file_lists ui_index ui_workdir
2486
2487 set flist $file_lists($w)
2488 if {$lno eq {}} {
2489 set lno [find_anchor_pos $flist $path]
2490 } else {
2491 incr lno -1
2492 }
2493
2494 if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2495 if {$w eq $ui_index} {
2496 set mmask "^$mmask"
2497 } else {
2498 set mmask "$mmask\$"
2499 }
2500 }
2501
2502 set idx [find_file_from $flist $lno 1 $path $mmask]
2503 if {$idx eq {}} {
2504 incr lno -1
2505 set idx [find_file_from $flist $lno -1 $path $mmask]
2506 }
2507
2508 if {$idx ne {}} {
2509 set next_diff_w $w
2510 set next_diff_p [lindex $flist $idx]
2511 set next_diff_i [expr {$idx+1}]
2512 return 1
2513 } else {
2514 return 0
2515 }
2516 }
2517
2518 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2519 global current_diff_path
2520
2521 if {$path ne $current_diff_path} {
2522 return {}
2523 } elseif {[find_next_diff $w $path $lno $mmask]} {
2524 return {next_diff;}
2525 } else {
2526 return {reshow_diff;}
2527 }
2528 }
2529
2530 proc select_first_diff {after} {
2531 global ui_workdir
2532
2533 if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2534 [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2535 next_diff $after
2536 } else {
2537 uplevel #0 $after
2538 }
2539 }
2540
2541 proc force_first_diff {after} {
2542 global ui_workdir current_diff_path file_states
2543
2544 if {[info exists file_states($current_diff_path)]} {
2545 set state [lindex $file_states($current_diff_path) 0]
2546 } else {
2547 set state {OO}
2548 }
2549
2550 set reselect 0
2551 if {[string first {U} $state] >= 0} {
2552 # Already a conflict, do nothing
2553 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2554 set reselect 1
2555 } elseif {[string index $state 1] ne {O}} {
2556 # Already a diff & no conflicts, do nothing
2557 } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2558 set reselect 1
2559 }
2560
2561 if {$reselect} {
2562 next_diff $after
2563 } else {
2564 uplevel #0 $after
2565 }
2566 }
2567
2568 # opens file in editor
2569 proc open_in_git_editor {path {lno 0} {edit_index 0}} {
2570 global env
2571
2572 if {$edit_index} {
2573 if {[catch {
2574 set fd [git_read ls-files -s --error-unmatch -- $path]
2575 fconfigure $fd -translation binary -encoding binary
2576 set info [split [gets $fd] " \t"]
2577 close $fd
2578 set mode [lindex $info 0]
2579 set sha1 [lindex $info 1]
2580 set stage [lindex $info 2]
2581 if {$mode != 100644 && $mode != 100755} {
2582 return -code error "Path is not a regular file: $mode"
2583 }
2584 if {$stage != 0} {
2585 return -code error "Path is in unmerged state."
2586 }
2587 set tmp_path "[file rootname $path].[string range $sha1 0 11][file extension $path]"
2588 if {[file exists $tmp_path]} {
2589 return -code error "Path is currently edited."
2590 }
2591 set fd [git_read checkout-index --temp -- $path]
2592 fconfigure $fd -translation binary -encoding binary
2593 set info [split [gets $fd] " \t"]
2594 close $fd
2595 set git_tmp_path [lindex $info 0]
2596 file rename $git_tmp_path $tmp_path
2597 unset git_tmp_path
2598 if {$mode == 100644} {
2599 file attributes $tmp_path -permissions 0600
2600 } else {
2601 file attributes $tmp_path -permissions 0700
2602 }
2603 set orig_path $path
2604 set path $tmp_path
2605 unset tmp_path
2606 } err]} {
2607 if {[info exists tmp_path]} {
2608 file delete $tmp_path
2609 }
2610 if {[info exists git_tmp_path]} {
2611 file delete $git_tmp_path
2612 }
2613 tk_messageBox \
2614 -icon error \
2615 -type ok \
2616 -title {git-gui: Can't edit path from index} \
2617 -message $err
2618 return
2619 }
2620 }
2621
2622 catch { unset env(ARGS) }
2623 catch { unset env(REVISION) }
2624
2625 if {!$edit_index} {
2626 set env(GIT_EDITOR_F_NBLOCK) 1
2627 }
2628 if {$lno != 0} {
2629 set env(GIT_EDITOR_F_POSITION) $lno
2630 }
2631
2632 if {[catch {exec [shellpath] -c "[git var GIT_EDITOR] [sq $path]"} err]} {
2633 tk_messageBox \
2634 -icon error \
2635 -type ok \
2636 -title {git-gui: Can't start GIT_EDITOR} \
2637 -message $err
2638 }
2639
2640 catch { unset env(GIT_EDITOR_F_NBLOCK) }
2641 catch { unset env(GIT_EDITOR_F_POSITION) }
2642
2643 if {$edit_index} {
2644 if {[catch {
2645 set new_mode [file attributes $path -permissions]
2646 switch -glob $new_mode {
2647 ??6?? {
2648 set new_mode 100644
2649 }
2650 ??7?? {
2651 set new_mode 100755
2652 }
2653 * {
2654 return -code error "Invalid mode of edited file."
2655 }
2656 }
2657 set fd [git_read hash-object -w --path=[encoding convertto $orig_path] -- [encoding convertto $path]]
2658 fconfigure $fd -translation binary -encoding binary
2659 set new_sha1 [gets $fd]
2660 close $fd
2661 file delete $path
2662 set fd [git_write update-index -z --index-info]
2663 puts -nonewline $fd "$new_mode $new_sha1\t[encoding convertto $orig_path]\0"
2664 close $fd
2665 } err]} {
2666 file delete $path
2667 tk_messageBox \
2668 -icon error \
2669 -type ok \
2670 -title {git-gui: Can't edit path from index} \
2671 -message $err
2672 return
2673 }
2674 do_rescan
2675 }
2676 }
2677
2678 proc get_best_diff_lno {w lno} {
2679 set fwi [$w search -elide -regexp {^\d+$} $lno.0 end]
2680 if {$fwi eq {}} {
2681 set fwi end
2682 }
2683 set bwi [$w search -elide -backwards -regexp {^\d+$} $lno.0 1.0]
2684 if {$bwi eq {}} {
2685 set bwi 1.0
2686 }
2687 set fwl [$w count -lines $lno.0 $fwi]
2688 set bwl [$w count -lines $bwi $lno.0]
2689 if {$fwl <= $bwl} {
2690 set lno [$w get "$fwi linestart" "$fwi lineend"]
2691 } else {
2692 set lno [$w get "$bwi linestart" "$bwi lineend"]
2693 }
2694
2695 if {$lno eq {}} {
2696 set lno 0
2697 }
2698
2699 return $lno
2700 }
2701
2702 proc open_from_file_list {w x y {edit_index 0}} {
2703 global ui_diff ui_diff_blnos
2704 global file_lists current_diff_path
2705
2706 set pos [split [$w index @$x,$y] .]
2707 set lno [lindex $pos 0]
2708 set col [lindex $pos 1]
2709 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2710 if {$path eq {}} {
2711 return
2712 }
2713
2714 set lno 0
2715 if {$path eq $current_diff_path} {
2716 # calculate the line number which is visible in the middle
2717 set height [$ui_diff count -ypixels 1.0 end]
2718 set ypos [$ui_diff yview]
2719 set yposm [expr {([lindex $ypos 1] + [lindex $ypos 0]) / 2}]
2720 set mpixel [expr {$height * $yposm}]
2721 set ytop [expr {[lindex $ypos 0] * $height}]
2722 set rmpixel [expr {round($mpixel - $ytop)}]
2723 set lno [$ui_diff index "@0,$rmpixel linestart"]
2724 set lno [lindex [split $lno .] 0]
2725
2726 set lno [get_best_diff_lno $ui_diff_blnos $lno]
2727 }
2728
2729 open_in_git_editor $path $lno $edit_index
2730 }
2731
2732 proc open_from_diff_view {x y {edit_index 0}} {
2733 global ui_diff ui_diff_blnos
2734 global file_lists current_diff_path
2735
2736 if {$current_diff_path eq {}} {
2737 return
2738 }
2739
2740 set lno [$ui_diff index "@0,$y linestart"]
2741 set lno [lindex [split $lno .] 0]
2742 set lno [get_best_diff_lno $ui_diff_blnos $lno]
2743
2744 open_in_git_editor $current_diff_path $lno $edit_index
2745 }
2746
2747 proc blame_from_file_list {w x y} {
2748 global ui_diff ui_diff_blnos
2749 global file_lists current_diff_path
2750
2751 set pos [split [$w index @$x,$y] .]
2752 set lno [lindex $pos 0]
2753 set col [lindex $pos 1]
2754 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2755 if {$path eq {}} {
2756 return
2757 }
2758
2759 set lno 0
2760 if {$path eq $current_diff_path} {
2761 # calculate the line number which is visible in the middle
2762 set height [$ui_diff count -ypixels 1.0 end]
2763 set ypos [$ui_diff yview]
2764 set yposm [expr {([lindex $ypos 1] + [lindex $ypos 0]) / 2}]
2765 set mpixel [expr {$height * $yposm}]
2766 set ytop [expr {[lindex $ypos 0] * $height}]
2767 set rmpixel [expr {round($mpixel - $ytop)}]
2768 set lno [$ui_diff index "@0,$rmpixel linestart"]
2769 set lno [lindex [split $lno .] 0]
2770
2771 set lno [get_best_diff_lno $ui_diff_blnos $lno]
2772 }
2773
2774 blame_path_in_tab $path $lno
2775 }
2776
2777 set ::blame_seq 0
2778 proc blame_path_in_tab {path {lno {}}} {
2779 global NS main_status
2780
2781 set new_blame_tab .nb.blame[incr ::blame_seq]
2782 ${NS}::frame $new_blame_tab
2783 set blame_tab [::blame::embed $new_blame_tab $main_status "" $path $lno]
2784 .nb add $new_blame_tab -text "[lindex [file split $path] end]" -image tab_close -compound right
2785 .nb select $new_blame_tab
2786 focus $new_blame_tab
2787 }
2788
2789 proc popup_files_ctxm {m w x y X Y} {
2790 global file_lists popup_path
2791
2792 set ::cursorX $x
2793 set ::cursorY $y
2794
2795 set pos [split [$w index @$x,$y] .]
2796 set lno [lindex $pos 0]
2797 set col [lindex $pos 1]
2798 set popup_path [lindex $file_lists($w) [expr {$lno - 1}]]
2799 if {$popup_path eq {}} {
2800 return
2801 }
2802 tk_popup $m $X $Y
2803 }
2804
2805 proc toggle_or_diff {w x y} {
2806 global file_states file_lists current_diff_path ui_index ui_workdir
2807 global last_clicked selected_paths
2808
2809 set pos [split [$w index @$x,$y] .]
2810 set lno [lindex $pos 0]
2811 set col [lindex $pos 1]
2812 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2813 if {$path eq {}} {
2814 set last_clicked {}
2815 return
2816 }
2817
2818 set last_clicked [list $w $lno]
2819 array unset selected_paths
2820 $ui_index tag remove in_sel 0.0 end
2821 $ui_workdir tag remove in_sel 0.0 end
2822
2823 # Determine the state of the file
2824 if {[info exists file_states($path)]} {
2825 set state [lindex $file_states($path) 0]
2826 } else {
2827 set state {__}
2828 }
2829
2830 # Restage the file, or simply show the diff
2831 if {$col == 0 && $y > 1} {
2832 # Conflicts need special handling
2833 if {[string first {U} $state] >= 0} {
2834 # $w must always be $ui_workdir, but...
2835 if {$w ne $ui_workdir} { set lno {} }
2836 merge_stage_workdir $path $lno
2837 return
2838 }
2839
2840 if {[string index $state 1] eq {O}} {
2841 set mmask {}
2842 } else {
2843 set mmask {[^O]}
2844 }
2845
2846 set after [next_diff_after_action $w $path $lno $mmask]
2847
2848 if {$w eq $ui_index} {
2849 update_indexinfo \
2850 "Unstaging [short_path $path] from commit" \
2851 [list $path] \
2852 [concat $after [list ui_ready]]
2853 } elseif {$w eq $ui_workdir} {
2854 update_index \
2855 "Adding [short_path $path]" \
2856 [list $path] \
2857 [concat $after [list ui_ready]]
2858 }
2859 } else {
2860 show_diff $path $w $lno
2861 }
2862 }
2863
2864 proc add_one_to_selection {w x y} {
2865 global file_lists last_clicked selected_paths
2866
2867 set lno [lindex [split [$w index @$x,$y] .] 0]
2868 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2869 if {$path eq {}} {
2870 set last_clicked {}
2871 return
2872 }
2873
2874 if {$last_clicked ne {}
2875 && [lindex $last_clicked 0] ne $w} {
2876 array unset selected_paths
2877 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2878 }
2879
2880 set last_clicked [list $w $lno]
2881 if {[catch {set in_sel $selected_paths($path)}]} {
2882 set in_sel 0
2883 }
2884 if {$in_sel} {
2885 unset selected_paths($path)
2886 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2887 } else {
2888 set selected_paths($path) 1
2889 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2890 }
2891 }
2892
2893 proc add_range_to_selection {w x y} {
2894 global file_lists last_clicked selected_paths
2895
2896 if {[lindex $last_clicked 0] ne $w} {
2897 toggle_or_diff $w $x $y
2898 return
2899 }
2900
2901 set lno [lindex [split [$w index @$x,$y] .] 0]
2902 set lc [lindex $last_clicked 1]
2903 if {$lc < $lno} {
2904 set begin $lc
2905 set end $lno
2906 } else {
2907 set begin $lno
2908 set end $lc
2909 }
2910
2911 foreach path [lrange $file_lists($w) \
2912 [expr {$begin - 1}] \
2913 [expr {$end - 1}]] {
2914 set selected_paths($path) 1
2915 }
2916 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2917 }
2918
2919 proc show_more_context {} {
2920 global repo_config
2921 if {$repo_config(gui.diffcontext) < 99} {
2922 incr repo_config(gui.diffcontext)
2923 reshow_diff
2924 }
2925 }
2926
2927 proc show_less_context {} {
2928 global repo_config
2929 if {$repo_config(gui.diffcontext) > 1} {
2930 incr repo_config(gui.diffcontext) -1
2931 reshow_diff
2932 }
2933 }
2934
2935 ######################################################################
2936 ##
2937 ## ui construction
2938
2939 set ui_comm {}
2940
2941 # -- Menu Bar
2942 #
2943 menu .mbar -tearoff 0
2944 if {[is_MacOSX]} {
2945 # -- Apple Menu (Mac OS X only)
2946 #
2947 .mbar add cascade -label Apple -menu .mbar.apple
2948 menu .mbar.apple
2949 }
2950 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2951 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2952 if {[is_enabled branch]} {
2953 .mbar add cascade -label [mc Branch] -menu .mbar.branch
2954 }
2955 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2956 .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2957 }
2958 if {[is_enabled transport]} {
2959 .mbar add cascade -label [mc Merge] -menu .mbar.merge
2960 .mbar add cascade -label [mc Remote] -menu .mbar.remote
2961 }
2962 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2963 .mbar add cascade -label [mc Tools] -menu .mbar.tools
2964 }
2965
2966 # -- Repository Menu
2967 #
2968 menu .mbar.repository
2969
2970 if {![is_bare]} {
2971 .mbar.repository add command \
2972 -label [mc "Explore Working Copy"] \
2973 -command {do_explore}
2974 }
2975
2976 if {[is_Windows]} {
2977 .mbar.repository add command \
2978 -label [mc "Git Bash"] \
2979 -command {eval exec [auto_execok start] \
2980 [list "Git Bash" bash --login -l &]}
2981 }
2982
2983 if {[is_Windows] || ![is_bare]} {
2984 .mbar.repository add separator
2985 }
2986
2987 .mbar.repository add command \
2988 -label [mc "Browse Current Branch's Files"] \
2989 -command {browser::new $current_branch}
2990 set ui_browse_current [.mbar.repository index last]
2991 .mbar.repository add command \
2992 -label [mc "Browse Branch Files..."] \
2993 -command browser_open::dialog
2994 .mbar.repository add separator
2995
2996 .mbar.repository add command \
2997 -label [mc "Visualize Current Branch's History"] \
2998 -command {do_gitk $current_branch}
2999 set ui_visualize_current [.mbar.repository index last]
3000 .mbar.repository add command \
3001 -label [mc "Visualize All Branch History"] \
3002 -command {do_gitk --all}
3003 .mbar.repository add separator
3004
3005 proc current_branch_write {args} {
3006 global current_branch
3007 .mbar.repository entryconf $::ui_browse_current \
3008 -label [mc "Browse %s's Files" $current_branch]
3009 .mbar.repository entryconf $::ui_visualize_current \
3010 -label [mc "Visualize %s's History" $current_branch]
3011 }
3012 trace add variable current_branch write current_branch_write
3013
3014 if {[is_enabled multicommit]} {
3015 .mbar.repository add command -label [mc "Database Statistics"] \
3016 -command do_stats
3017
3018 .mbar.repository add command -label [mc "Compress Database"] \
3019 -command do_gc
3020
3021 .mbar.repository add command -label [mc "Verify Database"] \
3022 -command do_fsck_objects
3023
3024 .mbar.repository add separator
3025
3026 if {[is_Cygwin]} {
3027 .mbar.repository add command \
3028 -label [mc "Create Desktop Icon"] \
3029 -command do_cygwin_shortcut
3030 } elseif {[is_Windows]} {
3031 .mbar.repository add command \
3032 -label [mc "Create Desktop Icon"] \
3033 -command do_windows_shortcut
3034 } elseif {[is_MacOSX]} {
3035 .mbar.repository add command \
3036 -label [mc "Create Desktop Icon"] \
3037 -command do_macosx_app
3038 }
3039 }
3040
3041 if {[is_MacOSX]} {
3042 proc ::tk::mac::Quit {args} { do_quit }
3043 } else {
3044 .mbar.repository add command -label [mc Quit] \
3045 -command do_quit \
3046 -accelerator $M1T-Q
3047 }
3048
3049 # -- Edit Menu
3050 #
3051 menu .mbar.edit
3052 .mbar.edit add command -label [mc Undo] \
3053 -command {catch {[focus] edit undo}} \
3054 -accelerator $M1T-Z
3055 .mbar.edit add command -label [mc Redo] \
3056 -command {catch {[focus] edit redo}} \
3057 -accelerator $M1T-Y
3058 .mbar.edit add separator
3059 .mbar.edit add command -label [mc Cut] \
3060 -command {catch {tk_textCut [focus]}} \
3061 -accelerator $M1T-X
3062 .mbar.edit add command -label [mc Copy] \
3063 -command {catch {tk_textCopy [focus]}} \
3064 -accelerator $M1T-C
3065 .mbar.edit add command -label [mc Paste] \
3066 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3067 -accelerator $M1T-V
3068 .mbar.edit add command -label [mc Delete] \
3069 -command {catch {[focus] delete sel.first sel.last}} \
3070 -accelerator Del
3071 .mbar.edit add separator
3072 .mbar.edit add command -label [mc "Select All"] \
3073 -command {catch {[focus] tag add sel 0.0 end}} \
3074 -accelerator $M1T-A
3075
3076 # -- Branch Menu
3077 #
3078 if {[is_enabled branch]} {
3079 menu .mbar.branch
3080
3081 .mbar.branch add command -label [mc "Create..."] \
3082 -command branch_create::dialog \
3083 -accelerator $M1T-N
3084 lappend disable_on_lock [list .mbar.branch entryconf \
3085 [.mbar.branch index last] -state]
3086
3087 .mbar.branch add command -label [mc "Checkout..."] \
3088 -command branch_checkout::dialog \
3089 -accelerator $M1T-O
3090 lappend disable_on_lock [list .mbar.branch entryconf \
3091 [.mbar.branch index last] -state]
3092
3093 .mbar.branch add command -label [mc "Rename..."] \
3094 -command branch_rename::dialog
3095 lappend disable_on_lock [list .mbar.branch entryconf \
3096 [.mbar.branch index last] -state]
3097
3098 .mbar.branch add command -label [mc "Delete..."] \
3099 -command branch_delete::dialog
3100 lappend disable_on_lock [list .mbar.branch entryconf \
3101 [.mbar.branch index last] -state]
3102
3103 .mbar.branch add command -label [mc "Reset..."] \
3104 -command merge::reset_hard
3105 lappend disable_on_lock [list .mbar.branch entryconf \
3106 [.mbar.branch index last] -state]
3107 }
3108
3109 # -- Commit Menu
3110 #
3111 proc commit_btn_caption {} {
3112 if {[is_enabled nocommit]} {
3113 return [mc "Done"]
3114 } else {
3115 return [mc Commit@@verb]
3116 }
3117 }
3118
3119 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
3120 menu .mbar.commit
3121
3122 if {![is_enabled nocommit]} {
3123 .mbar.commit add radiobutton \
3124 -label [mc "New Commit"] \
3125 -command do_select_commit_type \
3126 -variable selected_commit_type \
3127 -value new
3128 lappend disable_on_lock \
3129 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3130
3131 .mbar.commit add radiobutton \
3132 -label [mc "Amend Last Commit"] \
3133 -command do_select_commit_type \
3134 -variable selected_commit_type \
3135 -value amend
3136 lappend disable_on_lock \
3137 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3138
3139 .mbar.commit add separator
3140 }
3141
3142 .mbar.commit add command -label [mc Rescan] \
3143 -command ui_do_rescan \
3144 -accelerator $M1T-R
3145 lappend disable_on_lock \
3146 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3147
3148 .mbar.commit add command -label [mc "Stage To Commit"] \
3149 -command do_add_selection \
3150 -accelerator $M1T-T
3151 lappend disable_on_lock \
3152 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3153
3154 .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
3155 -command do_add_all \
3156 -accelerator $M1T-I
3157 lappend disable_on_lock \
3158 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3159
3160 .mbar.commit add command -label [mc "Unstage From Commit"] \
3161 -command do_unstage_selection \
3162 -accelerator $M1T-U
3163 lappend disable_on_lock \
3164 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3165
3166 .mbar.commit add command -label [mc "Revert Changes"] \
3167 -command do_revert_selection \
3168 -accelerator $M1T-J
3169 lappend disable_on_lock \
3170 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3171
3172 .mbar.commit add separator
3173
3174 .mbar.commit add command -label [mc "Show Less Context"] \
3175 -command show_less_context \
3176 -accelerator $M1T-\-
3177
3178 .mbar.commit add command -label [mc "Show More Context"] \
3179 -command show_more_context \
3180 -accelerator $M1T-=
3181
3182 .mbar.commit add checkbutton -label [mc "Show Line Numbers"] \
3183 -command update_show_line_numbers \
3184 -variable diff_show_line_numbers
3185
3186 .mbar.commit add separator
3187
3188 if {![is_enabled nocommitmsg]} {
3189 .mbar.commit add command -label [mc "Sign Off"] \
3190 -command do_signoff \
3191 -accelerator $M1T-S
3192 }
3193
3194 .mbar.commit add command -label [commit_btn_caption] \
3195 -command do_commit \
3196 -accelerator $M1T-Return
3197 lappend disable_on_lock \
3198 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3199 }
3200
3201 # -- Merge Menu
3202 #
3203 if {[is_enabled branch]} {
3204 menu .mbar.merge
3205 .mbar.merge add command -label [mc "Local Merge..."] \
3206 -command merge::dialog \
3207 -accelerator $M1T-M
3208 lappend disable_on_lock \
3209 [list .mbar.merge entryconf [.mbar.merge index last] -state]
3210 .mbar.merge add command -label [mc "Abort Merge..."] \
3211 -command merge::reset_hard
3212 lappend disable_on_lock \
3213 [list .mbar.merge entryconf [.mbar.merge index last] -state]
3214 }
3215
3216 # -- Transport Menu
3217 #
3218 if {[is_enabled transport]} {
3219 menu .mbar.remote
3220
3221 .mbar.remote add command \
3222 -label [mc "Add..."] \
3223 -command remote_add::dialog \
3224 -accelerator $M1T-A
3225 .mbar.remote add command \
3226 -label [mc "Push..."] \
3227 -command do_push_anywhere \
3228 -accelerator $M1T-P
3229 .mbar.remote add command \
3230 -label [mc "Delete Branch..."] \
3231 -command remote_branch_delete::dialog
3232 }
3233
3234 if {[is_MacOSX]} {
3235 proc ::tk::mac::ShowPreferences {} {do_options}
3236 } else {
3237 # -- Edit Menu
3238 #
3239 .mbar.edit add separator
3240 .mbar.edit add command -label [mc "Options..."] \
3241 -command do_options
3242 }
3243
3244 # -- Tools Menu
3245 #
3246 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
3247 set tools_menubar .mbar.tools
3248 menu $tools_menubar
3249 $tools_menubar add separator
3250 $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
3251 $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
3252 if {[array names repo_config guitool.*.cmd] ne {}} {
3253 tools_populate_all 3
3254 }
3255 }
3256
3257 # -- Help Menu
3258 #
3259 .mbar add cascade -label [mc Help] -menu .mbar.help
3260 menu .mbar.help
3261
3262 if {[is_MacOSX]} {
3263 .mbar.apple add command -label [mc "About %s" [appname]] \
3264 -command do_about
3265 .mbar.apple add separator
3266 } else {
3267 .mbar.help add command -label [mc "About %s" [appname]] \
3268 -command do_about
3269 }
3270 . configure -menu .mbar
3271
3272 set doc_path [githtmldir]
3273 if {$doc_path ne {}} {
3274 set doc_path [file join $doc_path index.html]
3275
3276 if {[is_Cygwin]} {
3277 set doc_path [exec cygpath --mixed $doc_path]
3278 }
3279 }
3280
3281 if {[file isfile $doc_path]} {
3282 set doc_url "file:$doc_path"
3283 } else {
3284 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
3285 }
3286
3287 proc start_browser {url} {
3288 git "web--browse" $url
3289 }
3290
3291 .mbar.help add command -label [mc "Online Documentation"] \
3292 -command [list start_browser $doc_url]
3293
3294 .mbar.help add command -label [mc "Show SSH Key"] \
3295 -command do_ssh_key
3296
3297 unset doc_path doc_url
3298
3299 # -- Standard bindings
3300 #
3301 wm protocol . WM_DELETE_WINDOW do_quit
3302 bind all <$M1B-Key-q> do_quit
3303 bind all <$M1B-Key-Q> do_quit
3304 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3305 bind all <$M1B-Key-W> {close_blame_tab}
3306
3307 set subcommand_args {}
3308 proc usage {} {
3309 set s "usage: $::argv0 $::subcommand $::subcommand_args"
3310 if {[tk windowingsystem] eq "win32"} {
3311 wm withdraw .
3312 tk_messageBox -icon info -message $s \
3313 -title [mc "Usage"]
3314 } else {
3315 puts stderr $s
3316 }
3317 exit 1
3318 }
3319
3320 proc normalize_relpath {path} {
3321 set elements {}
3322 foreach item [file split $path] {
3323 if {$item eq {.}} continue
3324 if {$item eq {..} && [llength $elements] > 0
3325 && [lindex $elements end] ne {..}} {
3326 set elements [lrange $elements 0 end-1]
3327 continue
3328 }
3329 lappend elements $item
3330 }
3331 return [eval file join $elements]
3332 }
3333
3334 # -- Not a normal commit type invocation? Do that instead!
3335 #
3336 switch -- $subcommand {
3337 browser -
3338 blame {
3339 if {$subcommand eq "blame"} {
3340 set subcommand_args {[--line=<num>] rev? path}
3341 } else {
3342 set subcommand_args {rev? path}
3343 }
3344 if {$argv eq {}} usage
3345 set head {}
3346 set path {}
3347 set jump_spec {}
3348 set is_path 0
3349 foreach a $argv {
3350 set p [file join $_prefix $a]
3351
3352 if {$is_path || [file exists $p]} {
3353 if {$path ne {}} usage
3354 set path [normalize_relpath $p]
3355 break
3356 } elseif {$a eq {--}} {
3357 if {$path ne {}} {
3358 if {$head ne {}} usage
3359 set head $path
3360 set path {}
3361 }
3362 set is_path 1
3363 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3364 if {$jump_spec ne {} || $head ne {}} usage
3365 set jump_spec [list $lnum]
3366 } elseif {$head eq {}} {
3367 if {$head ne {}} usage
3368 set head $a
3369 set is_path 1
3370 } else {
3371 usage
3372 }
3373 }
3374 unset is_path
3375
3376 if {$head ne {} && $path eq {}} {
3377 if {[string index $head 0] eq {/}} {
3378 set path [normalize_relpath $head]
3379 set head {}
3380 } else {
3381 set path [normalize_relpath $_prefix$head]
3382 set head {}
3383 }
3384 }
3385
3386 if {$head eq {}} {
3387 load_current_branch
3388 } else {
3389 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3390 if {[catch {
3391 set head [git rev-parse --verify $head]
3392 } err]} {
3393 if {[tk windowingsystem] eq "win32"} {
3394 tk_messageBox -icon error -title [mc Error] -message $err
3395 } else {
3396 puts stderr $err
3397 }
3398 exit 1
3399 }
3400 }
3401 set current_branch $head
3402 }
3403
3404 wm deiconify .
3405 switch -- $subcommand {
3406 browser {
3407 if {$jump_spec ne {}} usage
3408 if {$head eq {}} {
3409 if {$path ne {} && [file isdirectory $path]} {
3410 set head $current_branch
3411 } else {
3412 set head $path
3413 set path {}
3414 }
3415 }
3416 browser::new $head $path
3417 }
3418 blame {
3419 if {$head eq {} && ![file exists $path]} {
3420 catch {wm withdraw .}
3421 tk_messageBox \
3422 -icon error \
3423 -type ok \
3424 -title [mc "git-gui: fatal error"] \
3425 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3426 exit 1
3427 }
3428 blame::new $head $path $jump_spec
3429 }
3430 }
3431 return
3432 }
3433 grep {
3434 wm deiconify .
3435 ::grep::new {*}$argv
3436 return
3437 }
3438 citool -
3439 gui {
3440 if {[llength $argv] != 0} {
3441 usage
3442 }
3443 # fall through to setup UI for commits
3444 }
3445 default {
3446 set err "usage: $argv0 \[{blame|browser|citool|grep}\]"
3447 if {[tk windowingsystem] eq "win32"} {
3448 wm withdraw .
3449 tk_messageBox -icon error -message $err \
3450 -title [mc "Usage"]
3451 } else {
3452 puts stderr $err
3453 }
3454 exit 1
3455 }
3456 }
3457
3458 # -- Branch Control
3459 #
3460 ${NS}::frame .branch
3461 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3462 ${NS}::label .branch.l1 \
3463 -text [mc "Current Branch:"] \
3464 -anchor w \
3465 -justify left
3466 ${NS}::label .branch.cb \
3467 -textvariable current_branch \
3468 -anchor w \
3469 -justify left
3470 pack .branch.l1 -side left
3471 pack .branch.cb -side left -fill x
3472 pack .branch -side top -fill x
3473
3474 # -- Main Window Layout
3475 #
3476 ${NS}::notebook .nb
3477 pack .nb -anchor n -side top -fill both -expand 1
3478
3479 proc select_next_tab {which} {
3480 set tabs [.nb tabs]
3481 set n_tabs [llength $tabs]
3482 set current [.nb select]
3483 set next [lsearch -exact $tabs $current]
3484 set next [expr $next + $which]
3485 if {$next eq $n_tabs} {
3486 set next 0
3487 } elseif {$next eq -1} {
3488 set next [expr $n_tabs - 1]
3489 }
3490 set next [lindex $tabs $next]
3491 .nb select $next
3492 focus $next
3493 }
3494
3495 proc close_blame_tab {} {
3496 set c [.nb select]
3497 if {[string match {.nb.blame*} $c]} {
3498 .nb forget $c
3499 }
3500 }
3501
3502 bind all <$M1B-Prior> "select_next_tab -1; break"
3503 bind all <$M1B-Next> "select_next_tab 1; break"
3504
3505 # -- Commit tab
3506 #
3507 ${NS}::panedwindow .vpane -orient horizontal
3508 .nb add .vpane -text [mc Commit@@verb]
3509
3510 ${NS}::panedwindow .vpane.files -orient vertical
3511 if {$use_ttk} {
3512 .vpane add .vpane.files -weight 0
3513 } else {
3514 .vpane add .vpane.files -sticky nsew -height 100 -width 200
3515 }
3516
3517
3518 # -- Index File List
3519 #
3520 ${NS}::frame .vpane.files.index -height 100 -width 200
3521 tlabel .vpane.files.index.title \
3522 -text [mc "Staged Changes (Will Commit)"] \
3523 -background lightgreen -foreground black
3524 text $ui_index -background white -foreground black \
3525 -borderwidth 0 \
3526 -width 20 -height 10 \
3527 -wrap none \
3528 -cursor $cursor_ptr \
3529 -xscrollcommand {.vpane.files.index.sx set} \
3530 -yscrollcommand {.vpane.files.index.sy set} \
3531 -state disabled
3532 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3533 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3534 pack .vpane.files.index.title -side top -fill x
3535 pack .vpane.files.index.sx -side bottom -fill x
3536 pack .vpane.files.index.sy -side right -fill y
3537 pack $ui_index -side left -fill both -expand 1
3538
3539 # -- Working Directory File List
3540 #
3541 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3542 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3543 -background lightsalmon -foreground black
3544 text $ui_workdir -background white -foreground black \
3545 -borderwidth 0 \
3546 -width 20 -height 10 \
3547 -wrap none \
3548 -cursor $cursor_ptr \
3549 -xscrollcommand {.vpane.files.workdir.sx set} \
3550 -yscrollcommand {.vpane.files.workdir.sy set} \
3551 -state disabled
3552 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3553 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3554 pack .vpane.files.workdir.title -side top -fill x
3555 pack .vpane.files.workdir.sx -side bottom -fill x
3556 pack .vpane.files.workdir.sy -side right -fill y
3557 pack $ui_workdir -side left -fill both -expand 1
3558
3559 if {$use_ttk} {
3560 .vpane.files add .vpane.files.workdir -weight 1
3561 .vpane.files add .vpane.files.index -weight 1
3562 } else {
3563 .vpane.files add .vpane.files.workdir -sticky news
3564 .vpane.files add .vpane.files.index -sticky news
3565 }
3566
3567 foreach i [list $ui_index $ui_workdir] {
3568 rmsel_tag $i
3569 $i tag conf in_diff -background [$i tag cget in_sel -background]
3570 #$i tag conf in_diff -underline 1
3571 #$i tag conf in_sel -background {#c6e2ff} -font font_diffitalic
3572 $i tag conf in_sel -background [$i cget -background] -underline 1
3573 }
3574 unset i
3575
3576 set files_ctxm .vpane.files.ctxm
3577 menu $files_ctxm -tearoff 0
3578 $files_ctxm add separator
3579 $files_ctxm add command \
3580 -label [mc "Open in Editor"] \
3581 -command {open_from_file_list $current_diff_side $cursorX $cursorY}
3582 $files_ctxm add command \
3583 -label [mc "Stage All Changed"] \
3584 -command do_add_all
3585 $files_ctxm add command \
3586 -label [mc "Stage Selected"] \
3587 -command do_add_selection
3588 $files_ctxm add command \
3589 -label [mc "Blame in new Tab"] \
3590 -command {blame_from_file_list $current_diff_side $cursorX $cursorY}
3591 if {[array names repo_config guitool.*.cmd] ne {}} {
3592 files_tools_populate_all 5 popup_path
3593 }
3594
3595
3596 # -- Diff and Commit Area
3597 #
3598 if {$have_tk85} {
3599 ${NS}::panedwindow .vpane.lower -orient vertical
3600 ${NS}::frame .vpane.lower.commarea
3601 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1 -height 500
3602 .vpane.lower add .vpane.lower.diff
3603 .vpane.lower add .vpane.lower.commarea
3604 .vpane add .vpane.lower
3605 if {$use_ttk} {
3606 .vpane.lower pane .vpane.lower.diff -weight 1
3607 .vpane.lower pane .vpane.lower.commarea -weight 0
3608 } else {
3609 .vpane.lower paneconfigure .vpane.lower.diff -stretch always
3610 .vpane.lower paneconfigure .vpane.lower.commarea -stretch never
3611 }
3612 } else {
3613 frame .vpane.lower -height 300 -width 400
3614 frame .vpane.lower.commarea
3615 frame .vpane.lower.diff -relief sunken -borderwidth 1
3616 pack .vpane.lower.diff -fill both -expand 1
3617 pack .vpane.lower.commarea -side bottom -fill x
3618 .vpane add .vpane.lower
3619 .vpane paneconfigure .vpane.lower -sticky nsew
3620 }
3621
3622 # -- Commit Area Buttons
3623 #
3624 ${NS}::frame .vpane.lower.commarea.buttons
3625 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3626 -anchor w \
3627 -justify left
3628 pack .vpane.lower.commarea.buttons.l -side top -fill x
3629 pack .vpane.lower.commarea.buttons -side left -fill y
3630
3631 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3632 -command ui_do_rescan
3633 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3634 lappend disable_on_lock \
3635 {.vpane.lower.commarea.buttons.rescan conf -state}
3636
3637 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3638 -command do_add_all
3639 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3640 lappend disable_on_lock \
3641 {.vpane.lower.commarea.buttons.incall conf -state}
3642
3643 if {![is_enabled nocommitmsg]} {
3644 ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3645 -command do_signoff
3646 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3647 }
3648
3649 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3650 -command do_commit
3651 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3652 lappend disable_on_lock \
3653 {.vpane.lower.commarea.buttons.commit conf -state}
3654
3655 if {![is_enabled nocommit]} {
3656 ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3657 -command do_push_anywhere
3658 pack .vpane.lower.commarea.buttons.push -side top -fill x
3659 }
3660
3661 # -- Commit Message Buffer
3662 #
3663 ${NS}::frame .vpane.lower.commarea.buffer
3664 ${NS}::frame .vpane.lower.commarea.buffer.header
3665 set ui_comm .vpane.lower.commarea.buffer.t
3666 set ui_coml .vpane.lower.commarea.buffer.header.l
3667
3668 proc ignore_yscrollcommand {top bottom} {}
3669
3670 proc update_show_line_numbers {} {
3671 global ui_diff_alnos ui_diff_blnos ui_diff_clnos
3672 global diff_show_line_numbers is_3way_diff is_other_diff
3673 global ui_diff ui_diff_columns ui_diff_columns_to_scroll
3674
3675 # remember current sscroll position
3676 set current_pos [.vpane.lower.diff.body.sby get]
3677
3678 # remove all line number columns
3679 grid remove $ui_diff_alnos $ui_diff_blnos $ui_diff_clnos
3680 set ui_diff_columns_to_scroll [list $ui_diff]
3681 foreach i $ui_diff_columns {
3682 $i conf -yscrollcommand {}
3683 }
3684
3685 if {$diff_show_line_numbers} {
3686 if {!$is_other_diff} {
3687 grid configure $ui_diff_alnos
3688 lappend ui_diff_columns_to_scroll $ui_diff_alnos
3689 }
3690 grid configure $ui_diff_blnos
3691 lappend ui_diff_columns_to_scroll $ui_diff_blnos
3692 if {$is_3way_diff} {
3693 grid configure $ui_diff_clnos
3694 lappend ui_diff_columns_to_scroll $ui_diff_clnos
3695 }
3696 }
3697
3698 foreach i $ui_diff_columns_to_scroll {
3699 $i conf -yscrollcommand \
3700 "[list many2scrollbar $ui_diff_columns_to_scroll yview .vpane.lower.diff.body.sby]"
3701 }
3702 .vpane.lower.diff.body.sby conf \
3703 -command [list scrollbar2many $ui_diff_columns_to_scroll yview]
3704
3705 # restore current scroll position
3706 many2scrollbar $ui_diff_columns_to_scroll yview .vpane.lower.diff.body.sby [lindex $current_pos 0] [lindex $current_pos 1]
3707 }
3708
3709 if {![is_enabled nocommit]} {
3710 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3711 -text [mc "New Commit"] \
3712 -command do_select_commit_type \
3713 -variable selected_commit_type \
3714 -value new
3715 lappend disable_on_lock \
3716 [list .vpane.lower.commarea.buffer.header.new conf -state]
3717 ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3718 -text [mc "Amend Last Commit"] \
3719 -command do_select_commit_type \
3720 -variable selected_commit_type \
3721 -value amend
3722 lappend disable_on_lock \
3723 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3724 }
3725
3726 ${NS}::label $ui_coml \
3727 -anchor w \
3728 -justify left
3729 proc trace_commit_type {varname args} {
3730 global ui_coml commit_type
3731 switch -glob -- $commit_type {
3732 initial {set txt [mc "Initial Commit Message:"]}
3733 amend {set txt [mc "Amended Commit Message:"]}
3734 amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3735 amend-merge {set txt [mc "Amended Merge Commit Message:"]}
3736 merge {set txt [mc "Merge Commit Message:"]}
3737 * {set txt [mc "Commit Message:"]}
3738 }
3739 $ui_coml conf -text $txt
3740 }
3741 trace add variable commit_type write trace_commit_type
3742 pack $ui_coml -side left -fill x
3743
3744 if {![is_enabled nocommit]} {
3745 pack .vpane.lower.commarea.buffer.header.amend -side right
3746 pack .vpane.lower.commarea.buffer.header.new -side right
3747 }
3748
3749 text $ui_comm -background white -foreground black \
3750 -borderwidth 1 \
3751 -undo true \
3752 -maxundo 20 \
3753 -autoseparators true \
3754 -relief sunken \
3755 -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3756 -font font_diff \
3757 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3758 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3759 -command [list $ui_comm yview]
3760 pack .vpane.lower.commarea.buffer.header -side top -fill x
3761 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3762 pack $ui_comm -side left -fill y
3763 pack .vpane.lower.commarea.buffer -side left -fill y
3764
3765 # -- Commit Message Buffer Context Menu
3766 #
3767 set ui_comm_ctxm .vpane.lower.commarea.buffer.ctxm
3768 menu $ui_comm_ctxm -tearoff 0
3769 $ui_comm_ctxm add command \
3770 -label [mc Cut] \
3771 -command {tk_textCut $ui_comm}
3772 $ui_comm_ctxm add command \
3773 -label [mc Copy] \
3774 -command {tk_textCopy $ui_comm}
3775 $ui_comm_ctxm add command \
3776 -label [mc Paste] \
3777 -command {tk_textPaste $ui_comm}
3778 $ui_comm_ctxm add command \
3779 -label [mc Delete] \
3780 -command {catch {$ui_comm delete sel.first sel.last}}
3781 $ui_comm_ctxm add separator
3782 $ui_comm_ctxm add command \
3783 -label [mc "Select All"] \
3784 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3785 $ui_comm_ctxm add command \
3786 -label [mc "Copy All"] \
3787 -command {
3788 $ui_comm tag add sel 0.0 end
3789 tk_textCopy $ui_comm
3790 $ui_comm tag remove sel 0.0 end
3791 }
3792 $ui_comm_ctxm add separator
3793 $ui_comm_ctxm add command \
3794 -label [mc "Sign Off"] \
3795 -command do_signoff
3796
3797 # -- Diff Header
3798 #
3799 proc trace_current_diff_path {varname args} {
3800 global current_diff_path diff_actions file_states
3801 if {$current_diff_path eq {}} {
3802 set s {}
3803 set f {}
3804 set p {}
3805 set o disabled
3806 } else {
3807 set p $current_diff_path
3808 set s [mapdesc [lindex $file_states($p) 0] $p]
3809 set f [mc "File:"]
3810 set p [escape_path $p]
3811 set o normal
3812 }
3813
3814 .vpane.lower.diff.header.status configure -text $s
3815 .vpane.lower.diff.header.file configure -text $f
3816 .vpane.lower.diff.header.path configure -text $p
3817 foreach w $diff_actions {
3818 uplevel #0 $w $o
3819 }
3820 }
3821 trace add variable current_diff_path write trace_current_diff_path
3822
3823 gold_frame .vpane.lower.diff.header
3824 tlabel .vpane.lower.diff.header.status \
3825 -background gold \
3826 -foreground black \
3827 -anchor w \
3828 -justify left
3829 tlabel .vpane.lower.diff.header.file \
3830 -background gold \
3831 -foreground black \
3832 -anchor w \
3833 -justify left
3834 tlabel .vpane.lower.diff.header.path \
3835 -background gold \
3836 -foreground black \
3837 -anchor w \
3838 -justify left
3839 pack .vpane.lower.diff.header.status -side left
3840 pack .vpane.lower.diff.header.path -side right -fill x
3841 pack .vpane.lower.diff.header.file -side right
3842 set hctxm .vpane.lower.diff.header.ctxm
3843 menu $hctxm -tearoff 0
3844 $hctxm add command \
3845 -label [mc Copy] \
3846 -command {
3847 clipboard clear
3848 clipboard append \
3849 -format STRING \
3850 -type STRING \
3851 -- $current_diff_path
3852 }
3853 lappend diff_actions [list $hctxm entryconf [$hctxm index last] -state]
3854 bind_button3 .vpane.lower.diff.header.path "tk_popup $hctxm %X %Y"
3855
3856 # -- Diff Body
3857 #
3858 ${NS}::frame .vpane.lower.diff.body
3859 set ui_diff .vpane.lower.diff.body.t
3860 # for 3way merges
3861 set ui_diff_clnos .vpane.lower.diff.body.c
3862 # - lines
3863 set ui_diff_alnos .vpane.lower.diff.body.a
3864 # + lines
3865 set ui_diff_blnos .vpane.lower.diff.body.b
3866
3867 set ui_diff_lno_col_width 2
3868
3869 text $ui_diff_alnos \
3870 -takefocus 0 \
3871 -highlightthickness 0 \
3872 -padx 0 -pady 0 \
3873 -background grey90 \
3874 -foreground black \
3875 -borderwidth 0 \
3876 -width [expr $ui_diff_lno_col_width + 2] \
3877 -height 5 \
3878 -wrap none \
3879 -font font_diff \
3880 -state disabled
3881 $ui_diff_alnos tag conf linenumber -justify right -rmargin 5
3882 $ui_diff_alnos tag conf red -foreground red
3883 $ui_diff_alnos tag conf green -foreground green4
3884
3885 text $ui_diff_blnos \
3886 -takefocus 0 \
3887 -highlightthickness 0 \
3888 -padx 0 -pady 0 \
3889 -background grey95 \
3890 -foreground black \
3891 -borderwidth 0 \
3892 -width [expr $ui_diff_lno_col_width + 2] \
3893 -height 5 \
3894 -wrap none \
3895 -font font_diff \
3896 -state disabled
3897 $ui_diff_blnos tag conf linenumber -justify right -rmargin 5
3898 $ui_diff_blnos tag conf red -foreground red
3899 $ui_diff_blnos tag conf green -foreground green4
3900 $ui_diff_blnos tag conf hide -elide 1
3901
3902 text $ui_diff_clnos \
3903 -takefocus 0 \
3904 -highlightthickness 0 \
3905 -padx 0 -pady 0 \
3906 -background grey90 \
3907 -foreground black \
3908 -borderwidth 0 \
3909 -width [expr $ui_diff_lno_col_width + 2] \
3910 -height 5 \
3911 -wrap none \
3912 -font font_diff \
3913 -state disabled
3914 $ui_diff_clnos tag conf linenumber -justify right -rmargin 5
3915 $ui_diff_clnos tag conf red -foreground red
3916 $ui_diff_clnos tag conf green -foreground green4
3917
3918 delegate_sel_to $ui_diff [list $ui_diff_alnos $ui_diff_blnos $ui_diff_clnos]
3919
3920 text $ui_diff \
3921 -highlightthickness 0 \
3922 -padx 0 -pady 0 \
3923 -background white \
3924 -foreground black \
3925 -borderwidth 0 \
3926 -width 80 -height 5 \
3927 -wrap none \
3928 -font font_diff \
3929 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3930 -state disabled
3931 catch {$ui_diff configure -tabstyle wordprocessor}
3932
3933 set ui_diff_columns [list $ui_diff_alnos $ui_diff_blnos $ui_diff $ui_diff_clnos]
3934 set ui_diff_line_columns [list $ui_diff_alnos $ui_diff_blnos $ui_diff_clnos]
3935 set ui_diff_columns_to_scroll $ui_diff_columns
3936
3937 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3938 -command [list $ui_diff xview]
3939 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3940 -command [list scrollbar2many $ui_diff_columns_to_scroll yview]
3941
3942 grid $ui_diff_alnos $ui_diff_blnos $ui_diff_clnos $ui_diff .vpane.lower.diff.body.sby -sticky nsew
3943 grid conf .vpane.lower.diff.body.sbx \
3944 -column 0 \
3945 -sticky we \
3946 -columnspan 5
3947 grid columnconfigure .vpane.lower.diff.body \
3948 3 \
3949 -weight 1
3950 grid rowconfigure .vpane.lower.diff.body \
3951 0 \
3952 -weight 1
3953
3954 update_show_line_numbers
3955
3956 pack .vpane.lower.diff.header -side top -fill x
3957 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3958
3959
3960 foreach {n c} {0 black 1 red 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3961 $ui_diff tag configure clr4$n -background $c
3962 $ui_diff tag configure clri4$n -foreground $c
3963 $ui_diff tag configure clr3$n -foreground $c
3964 $ui_diff tag configure clri3$n -background $c
3965 }
3966 $ui_diff tag configure clr1 -font font_diffbold
3967 $ui_diff tag configure clr4 -underline 1
3968
3969 $ui_diff tag conf d_info -foreground blue -font font_diffbold
3970
3971 $ui_diff tag conf d_cr -elide true
3972 $ui_diff tag conf d_@ -font font_diffbold
3973 $ui_diff tag conf d_+ -foreground green4
3974 $ui_diff tag conf d_- -foreground red
3975
3976 $ui_diff tag conf d_++ -foreground green4
3977 $ui_diff tag conf d_-- -foreground red
3978 $ui_diff tag conf d_+s \
3979 -foreground green4 \
3980 -background {#e2effa}
3981 $ui_diff tag conf d_-s \
3982 -foreground red \
3983 -background {#e2effa}
3984 $ui_diff tag conf d_s+ \
3985 -foreground green4 \
3986 -background ivory1
3987 $ui_diff tag conf d_s- \
3988 -foreground red \
3989 -background ivory1
3990
3991 $ui_diff tag conf d< \
3992 -foreground orange \
3993 -font font_diffbold
3994 $ui_diff tag conf d| \
3995 -foreground orange \
3996 -font font_diffbold
3997 $ui_diff tag conf d= \
3998 -foreground orange \
3999 -font font_diffbold
4000 $ui_diff tag conf d> \
4001 -foreground orange \
4002 -font font_diffbold
4003
4004 foreach i $ui_diff_columns {
4005 $i tag raise sel
4006 }
4007
4008 # -- Diff Body Context Menu
4009 #
4010
4011 proc create_common_diff_popup {ctxm} {
4012 $ctxm add command \
4013 -label [mc Refresh] \
4014 -command reshow_diff
4015 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4016 $ctxm add command \
4017 -label [mc Copy] \
4018 -command {tk_textCopy $ui_diff}
4019 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4020 $ctxm add command \
4021 -label [mc "Select All"] \
4022 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4023 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4024 $ctxm add command \
4025 -label [mc "Copy All"] \
4026 -command {
4027 $ui_diff tag add sel 0.0 end
4028 tk_textCopy $ui_diff
4029 $ui_diff tag remove sel 0.0 end
4030 }
4031 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4032 $ctxm add separator
4033 $ctxm add command \
4034 -label [mc "Decrease Font Size"] \
4035 -command {incr_font_size font_diff -1}
4036 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4037 $ctxm add command \
4038 -label [mc "Increase Font Size"] \
4039 -command {incr_font_size font_diff 1}
4040 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4041 $ctxm add separator
4042 set emenu $ctxm.enc
4043 menu $emenu
4044 build_encoding_menu $emenu [list force_diff_encoding]
4045 $ctxm add cascade \
4046 -label [mc "Encoding"] \
4047 -menu $emenu
4048 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4049 $ctxm add separator
4050 $ctxm add command -label [mc "Options..."] \
4051 -command do_options
4052 }
4053
4054 set ctxmw .vpane.lower.diff.body.ctxmw
4055 menu $ctxmw -tearoff 0
4056 $ctxmw add command \
4057 -label [mc "Apply/Reverse Hunk"] \
4058 -command {apply_hunk $cursorX $cursorY}
4059 set ui_diff_applyhunk [$ctxmw index last]
4060 lappend diff_actions [list $ctxmw entryconf $ui_diff_applyhunk -state]
4061 $ctxmw add command \
4062 -label [mc "Apply/Reverse Line"] \
4063 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
4064 set ui_diff_applyline [$ctxmw index last]
4065 lappend diff_actions [list $ctxmw entryconf $ui_diff_applyline -state]
4066 $ctxmw add separator
4067 $ctxmw add command \
4068 -label [mc "Revert Hunk"] \
4069 -command {apply_hunk $cursorX $cursorY 1}
4070 lappend diff_actions [list $ctxmw entryconf $ui_diff_applyhunk -state]
4071 $ctxmw add command \
4072 -label [mc "Revert Line"] \
4073 -command {apply_range_or_line $cursorX $cursorY 1; do_rescan}
4074 set ui_diff_revertline [$ctxmw index last]
4075 lappend diff_actions [list $ctxmw entryconf $ui_diff_applyline -state]
4076 $ctxmw add separator
4077 $ctxmw add command \
4078 -label [mc "Open in Editor"] \
4079 -command {open_from_diff_view $cursorX $cursorY}
4080 lappend diff_actions [list $ctxmw entryconf [$ctxmw index last] -state]
4081 $ctxmw add command \
4082 -label [mc "Show Less Context"] \
4083 -command show_less_context
4084 lappend diff_actions [list $ctxmw entryconf [$ctxmw index last] -state]
4085 $ctxmw add command \
4086 -label [mc "Show More Context"] \
4087 -command show_more_context
4088 lappend diff_actions [list $ctxmw entryconf [$ctxmw index last] -state]
4089 $ctxmw add checkbutton \
4090 -label [mc "Show Line Numbers"] \
4091 -command update_show_line_numbers \
4092 -variable diff_show_line_numbers
4093 $ctxmw add separator
4094 create_common_diff_popup $ctxmw
4095
4096 set ctxmi .vpane.lower.diff.body.ctxmi
4097 menu $ctxmi -tearoff 0
4098 $ctxmi add command \
4099 -label [mc "Apply/Reverse Hunk"] \
4100 -command {apply_hunk $cursorX $cursorY}
4101 lappend diff_actions [list $ctxmi entryconf $ui_diff_applyhunk -state]
4102 $ctxmi add command \
4103 -label [mc "Apply/Reverse Line"] \
4104 -command {apply_range_or_line $cursorX $cursorY; do_rescan}
4105 lappend diff_actions [list $ctxmi entryconf $ui_diff_applyline -state]
4106 $ctxmi add separator
4107 $ctxmi add command \
4108 -label [mc "Open in Editor"] \
4109 -command {open_from_diff_view $cursorX $cursorY}
4110 lappend diff_actions [list $ctxmi entryconf [$ctxmi index last] -state]
4111 $ctxmi add command \
4112 -label [mc "Open Staged Content in Editor"] \
4113 -command {open_from_diff_view $cursorX $cursorY 1}
4114 lappend diff_actions [list $ctxmi entryconf [$ctxmi index last] -state]
4115 $ctxmi add command \
4116 -label [mc "Show Less Context"] \
4117 -command show_less_context
4118 lappend diff_actions [list $ctxmi entryconf [$ctxmi index last] -state]
4119 $ctxmi add command \
4120 -label [mc "Show More Context"] \
4121 -command show_more_context
4122 lappend diff_actions [list $ctxmi entryconf [$ctxmi index last] -state]
4123 $ctxmi add checkbutton \
4124 -label [mc "Show Line Numbers"] \
4125 -command update_show_line_numbers \
4126 -variable diff_show_line_numbers
4127 $ctxmi add separator
4128 create_common_diff_popup $ctxmi
4129
4130 set ctxmmg .vpane.lower.diff.body.ctxmmg
4131 menu $ctxmmg -tearoff 0
4132 $ctxmmg add command \
4133 -label [mc "Run Merge Tool"] \
4134 -command {merge_resolve_tool}
4135 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4136 $ctxmmg add separator
4137 $ctxmmg add command \
4138 -label [mc "Use Remote Version"] \
4139 -command {merge_resolve_one 3}
4140 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4141 $ctxmmg add command \
4142 -label [mc "Use Local Version"] \
4143 -command {merge_resolve_one 2}
4144 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4145 $ctxmmg add command \
4146 -label [mc "Revert To Base"] \
4147 -command {merge_resolve_one 1}
4148 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4149 $ctxmmg add separator
4150 $ctxmmg add command \
4151 -label [mc "Open in Editor"] \
4152 -command {open_from_diff_view $cursorX $cursorY}
4153 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4154 $ctxmmg add command \
4155 -label [mc "Show Less Context"] \
4156 -command show_less_context
4157 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4158 $ctxmmg add command \
4159 -label [mc "Show More Context"] \
4160 -command show_more_context
4161 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
4162 $ctxmmg add checkbutton \
4163 -label [mc "Show Line Numbers"] \
4164 -command update_show_line_numbers \
4165 -variable diff_show_line_numbers
4166 $ctxmmg add separator
4167 create_common_diff_popup $ctxmmg
4168
4169 set ctxmsm .vpane.lower.diff.body.ctxmsm
4170 menu $ctxmsm -tearoff 0
4171 $ctxmsm add command \
4172 -label [mc "Visualize These Changes In The Submodule"] \
4173 -command {do_gitk -- true}
4174 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
4175 $ctxmsm add command \
4176 -label [mc "Visualize Current Branch History In The Submodule"] \
4177 -command {do_gitk {} true}
4178 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
4179 $ctxmsm add command \
4180 -label [mc "Visualize All Branch History In The Submodule"] \
4181 -command {do_gitk --all true}
4182 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
4183 $ctxmsm add separator
4184 $ctxmsm add command \
4185 -label [mc "Start git gui In The Submodule"] \
4186 -command {do_git_gui}
4187 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
4188 $ctxmsm add separator
4189 create_common_diff_popup $ctxmsm
4190
4191 proc has_textconv {path} {
4192 if {[is_config_false gui.textconv]} {
4193 return 0
4194 }
4195 set filter [gitattr $path diff set]
4196 set textconv [get_config [join [list diff $filter textconv] .]]
4197 if {$filter ne {set} && $textconv ne {}} {
4198 return 1
4199 } else {
4200 return 0
4201 }
4202 }
4203
4204 proc popup_diff_menu {ctxmw ctxmi ctxmmg ctxmsm x y X Y} {
4205 global current_diff_path file_states
4206 set ::cursorX $x
4207 set ::cursorY $y
4208 if {[info exists file_states($current_diff_path)]} {
4209 set state [lindex $file_states($current_diff_path) 0]
4210 } else {
4211 set state {__}
4212 }
4213 if {[string first {U} $state] >= 0} {
4214 tk_popup $ctxmmg $X $Y
4215 } elseif {$::is_submodule_diff} {
4216 tk_popup $ctxmsm $X $Y
4217 } else {
4218 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
4219 if {$::ui_index eq $::current_diff_side} {
4220 set ctxm $ctxmi
4221 set l [mc "Unstage Hunk From Commit"]
4222 if {$has_range} {
4223 set t [mc "Unstage Lines From Commit"]
4224 } else {
4225 set t [mc "Unstage Line From Commit"]
4226 }
4227 } else {
4228 set ctxm $ctxmw
4229 set l [mc "Stage Hunk For Commit"]
4230 if {$has_range} {
4231 set t [mc "Stage Lines For Commit"]
4232 set r [mc "Revert Lines"]
4233 } else {
4234 set t [mc "Stage Line For Commit"]
4235 set r [mc "Revert Line"]
4236 }
4237 }
4238 if {$::is_3way_diff
4239 || $current_diff_path eq {}
4240 || {__} eq $state
4241 || {_O} eq $state
4242 || [string match {?T} $state]
4243 || [string match {T?} $state]
4244 || [has_textconv $current_diff_path]} {
4245 set s disabled
4246 } else {
4247 set s normal
4248 }
4249 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
4250 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
4251 if {$::ui_workdir eq $::current_diff_side} {
4252 $ctxm entryconf $::ui_diff_revertline -state $s -label $r
4253 }
4254 tk_popup $ctxm $X $Y
4255 }
4256 }
4257 bind_button3 $ui_diff [list popup_diff_menu $ctxmw $ctxmi $ctxmmg $ctxmsm %x %y %X %Y]
4258
4259 foreach i $ui_diff_columns {
4260 bind $i <ButtonRelease-2> {open_from_diff_view %x %y}
4261 bind $i <Shift-ButtonRelease-2> {open_from_diff_view %x %y 1}
4262 }
4263
4264 # -- Grep Tab
4265 #
4266 ${NS}::frame .nb.grep
4267 set ::grep_tab [::grep::embed .nb.grep]
4268 $::grep_tab link_vpane .vpane
4269 $::grep_tab reorder_bindtags
4270 .nb add .nb.grep -text [mc "Grep"]
4271 $::grep_tab grep
4272
4273 foreach i [list all $ui_diff] {
4274 bind $i <$M1B-Key-h> {
4275 .nb select .nb.grep
4276 focus .nb.grep
4277 $::grep_tab grep_from_selection
4278 }
4279 bind $i <$M1B-Key-H> {
4280 .nb select .nb.grep
4281 focus .nb.grep
4282 $::grep_tab grep_from_selection
4283 }
4284 }
4285
4286 # -- Browser Tab
4287 #
4288 ${NS}::frame .nb.browser
4289 set ::browser_tab [::full_browser::embed .nb.browser]
4290 $::browser_tab reorder_bindtags
4291 .nb add .nb.browser -text [mc "Browse"]
4292
4293 # -- Status Bar
4294 #
4295 set main_status [::status_bar::new .status]
4296 pack .status -anchor s -side bottom -fill x -before .nb
4297 $main_status show [mc "Initializing..."]
4298
4299 # -- Load geometry
4300 #
4301 proc on_ttk_pane_mapped {w pane pos} {
4302 bind $w <Map> {}
4303 after 0 [list after idle [list $w sashpos $pane $pos]]
4304 }
4305 proc on_tk_pane_mapped {w pane x y} {
4306 bind $w <Map> {}
4307 after 0 [list after idle [list $w sash place $pane $x $y]]
4308 }
4309 proc on_application_mapped {} {
4310 global repo_config use_ttk
4311 bind . <Map> {}
4312 set gm $repo_config(gui.geometry)
4313 if {$use_ttk} {
4314 bind .vpane <Map> \
4315 [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
4316 bind .vpane.files <Map> \
4317 [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
4318 } else {
4319 bind .vpane <Map> \
4320 [list on_tk_pane_mapped %W 0 \
4321 [lindex $gm 1] \
4322 [lindex [.vpane sash coord 0] 1]]
4323 bind .vpane.files <Map> \
4324 [list on_tk_pane_mapped %W 0 \
4325 [lindex [.vpane.files sash coord 0] 0] \
4326 [lindex $gm 2]]
4327 }
4328 wm geometry . [lindex $gm 0]
4329 }
4330 if {[info exists repo_config(gui.geometry)]} {
4331 bind . <Map> [list on_application_mapped]
4332 wm geometry . [lindex $repo_config(gui.geometry) 0]
4333 }
4334
4335 # -- Load window state
4336 #
4337 if {[info exists repo_config(gui.wmstate)]} {
4338 catch {wm state . $repo_config(gui.wmstate)}
4339 }
4340
4341 # -- Key Bindings
4342 #
4343 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4344 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
4345 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
4346 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
4347 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
4348 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
4349 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
4350 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4351 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4352 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4353 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4354 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4355 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4356 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4357 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4358 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4359 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4360 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
4361 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
4362 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
4363 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
4364 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
4365
4366 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4367 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4368 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4369 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4370 bind $ui_diff <$M1B-Key-v> {break}
4371 bind $ui_diff <$M1B-Key-V> {break}
4372 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4373 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4374 bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
4375 bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
4376 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
4377 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
4378 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
4379 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
4380 bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
4381 bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
4382 bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
4383 bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
4384 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
4385 bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
4386 bind $ui_diff <Button-1> {focus %W}
4387
4388 if {[is_enabled branch]} {
4389 bind . <$M1B-Key-n> branch_create::dialog
4390 bind . <$M1B-Key-N> branch_create::dialog
4391 bind . <$M1B-Key-o> branch_checkout::dialog
4392 bind . <$M1B-Key-O> branch_checkout::dialog
4393 bind . <$M1B-Key-m> merge::dialog
4394 bind . <$M1B-Key-M> merge::dialog
4395 }
4396 if {[is_enabled transport]} {
4397 bind . <$M1B-Key-p> do_push_anywhere
4398 bind . <$M1B-Key-P> do_push_anywhere
4399 }
4400
4401 bind . <Key-F5> ui_do_rescan
4402 bind . <$M1B-Key-r> ui_do_rescan
4403 bind . <$M1B-Key-R> ui_do_rescan
4404 bind . <$M1B-Key-s> do_signoff
4405 bind . <$M1B-Key-S> do_signoff
4406 bind . <$M1B-Key-t> do_add_selection
4407 bind . <$M1B-Key-T> do_add_selection
4408 bind . <$M1B-Key-u> do_unstage_selection
4409 bind . <$M1B-Key-U> do_unstage_selection
4410 bind . <$M1B-Key-j> do_revert_selection
4411 bind . <$M1B-Key-J> do_revert_selection
4412 bind . <$M1B-Key-i> do_add_all
4413 bind . <$M1B-Key-I> do_add_all
4414 bind . <$M1B-Key-minus> {show_less_context;break}
4415 bind . <$M1B-Key-KP_Subtract> {show_less_context;break}
4416 bind . <$M1B-Key-equal> {show_more_context;break}
4417 bind . <$M1B-Key-plus> {show_more_context;break}
4418 bind . <$M1B-Key-KP_Add> {show_more_context;break}
4419 bind . <$M1B-Key-Return> do_commit
4420 foreach i [list $ui_index $ui_workdir] {
4421 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
4422 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
4423 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4424
4425 bind $i <ButtonRelease-2> "open_from_file_list $i %x %y; break"
4426 bind $i <Shift-ButtonRelease-2> "open_from_file_list $i %x %y 1; break"
4427
4428 bind $i <$M1B-ButtonRelease-2> "blame_from_file_list $i %x %y; break"
4429 }
4430
4431 if {[$files_ctxm index end] == 1} {
4432 # remove the separator, when we don't have user specified file tools
4433 $files_ctxm delete 0
4434 }
4435 bind_button3 $ui_index "popup_files_ctxm $files_ctxm $ui_index %x %y %X %Y; break"
4436 bind_button3 $ui_workdir "popup_files_ctxm $files_ctxm $ui_workdir %x %y %X %Y; break"
4437
4438 unset i
4439
4440 set file_lists($ui_index) [list]
4441 set file_lists($ui_workdir) [list]
4442
4443 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
4444 focus -force $ui_comm
4445
4446 # -- Warn the user about environmental problems. Cygwin's Tcl
4447 # does *not* pass its env array onto any processes it spawns.
4448 # This means that git processes get none of our environment.
4449 #
4450 if {[is_Cygwin]} {
4451 set ignored_env 0
4452 set suggest_user {}
4453 set msg [mc "Possible environment issues exist.
4454
4455 The following environment variables are probably
4456 going to be ignored by any Git subprocess run
4457 by %s:
4458
4459 " [appname]]
4460 foreach name [array names env] {
4461 switch -regexp -- $name {
4462 {^GIT_INDEX_FILE$} -
4463 {^GIT_OBJECT_DIRECTORY$} -
4464 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4465 {^GIT_DIFF_OPTS$} -
4466 {^GIT_EXTERNAL_DIFF$} -
4467 {^GIT_PAGER$} -
4468 {^GIT_TRACE$} -
4469 {^GIT_CONFIG$} -
4470 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4471 append msg " - $name\n"
4472 incr ignored_env
4473 }
4474 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4475 append msg " - $name\n"
4476 incr ignored_env
4477 set suggest_user $name
4478 }
4479 }
4480 }
4481 if {$ignored_env > 0} {
4482 append msg [mc "
4483 This is due to a known issue with the
4484 Tcl binary distributed by Cygwin."]
4485
4486 if {$suggest_user ne {}} {
4487 append msg [mc "
4488
4489 A good replacement for %s
4490 is placing values for the user.name and
4491 user.email settings into your personal
4492 ~/.gitconfig file.
4493 " $suggest_user]
4494 }
4495 warn_popup $msg
4496 }
4497 unset ignored_env msg suggest_user name
4498 }
4499
4500 # -- Only initialize complex UI if we are going to stay running.
4501 #
4502 if {[is_enabled transport]} {
4503 load_all_remotes
4504
4505 set n [.mbar.remote index end]
4506 populate_remotes_menu
4507 set n [expr {[.mbar.remote index end] - $n}]
4508 if {$n > 0} {
4509 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
4510 .mbar.remote insert $n separator
4511 }
4512 unset n
4513 }
4514
4515 if {[winfo exists $ui_comm]} {
4516 set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
4517
4518 # -- If both our backup and message files exist use the
4519 # newer of the two files to initialize the buffer.
4520 #
4521 if {$GITGUI_BCK_exists} {
4522 set m [gitdir GITGUI_MSG]
4523 if {[file isfile $m]} {
4524 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
4525 catch {file delete [gitdir GITGUI_MSG]}
4526 } else {
4527 $ui_comm delete 0.0 end
4528 $ui_comm edit reset
4529 $ui_comm edit modified false
4530 catch {file delete [gitdir GITGUI_BCK]}
4531 set GITGUI_BCK_exists 0
4532 }
4533 }
4534 unset m
4535 }
4536
4537 proc backup_commit_buffer {} {
4538 global ui_comm GITGUI_BCK_exists
4539
4540 set m [$ui_comm edit modified]
4541 if {$m || $GITGUI_BCK_exists} {
4542 set msg [string trim [$ui_comm get 0.0 end]]
4543 regsub -all -line {[ \r\t]+$} $msg {} msg
4544
4545 if {$msg eq {}} {
4546 if {$GITGUI_BCK_exists} {
4547 catch {file delete [gitdir GITGUI_BCK]}
4548 set GITGUI_BCK_exists 0
4549 }
4550 } elseif {$m} {
4551 catch {
4552 set fd [open [gitdir GITGUI_BCK] w]
4553 fconfigure $fd -encoding utf-8
4554 puts -nonewline $fd $msg
4555 close $fd
4556 set GITGUI_BCK_exists 1
4557 }
4558 }
4559
4560 $ui_comm edit modified false
4561 }
4562
4563 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
4564 }
4565
4566 backup_commit_buffer
4567
4568 # -- If the user has aspell available we can drive it
4569 # in pipe mode to spellcheck the commit message.
4570 #
4571 set spell_cmd [list |]
4572 set spell_dict [get_config gui.spellingdictionary]
4573 lappend spell_cmd aspell
4574 if {$spell_dict ne {}} {
4575 lappend spell_cmd --master=$spell_dict
4576 }
4577 lappend spell_cmd --mode=none
4578 lappend spell_cmd --encoding=utf-8
4579 lappend spell_cmd pipe
4580 if {$spell_dict eq {none}
4581 || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
4582 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
4583 } else {
4584 set ui_comm_spell [spellcheck::init \
4585 $spell_fd \
4586 $ui_comm \
4587 $ui_comm_ctxm \
4588 ]
4589 }
4590 unset -nocomplain spell_cmd spell_fd spell_err spell_dict
4591 }
4592
4593 lock_index begin-read
4594 if {![winfo ismapped .]} {
4595 wm deiconify .
4596 }
4597 after 1 {
4598 if {[is_enabled initialamend]} {
4599 force_amend
4600 } else {
4601 do_rescan
4602 }
4603
4604 if {[is_enabled nocommitmsg]} {
4605 $ui_comm configure -state disabled -background gray
4606 }
4607 }
4608 if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
4609 after 1000 hint_gc
4610 }
4611 if {[is_enabled retcode]} {
4612 bind . <Destroy> {+terminate_me %W}
4613 }
4614 if {$picked && [is_config_true gui.autoexplore]} {
4615 do_explore
4616 }
4617
4618 # Local variables:
4619 # mode: tcl
4620 # indent-tabs-mode: t
4621 # tab-width: 4
4622 # End: