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