1# console.tcl --
2#
3# This code constructs the console window for an application.  It
4# can be used by non-unix systems that do not have built-in support
5# for shells.
6#
7# RCS: @(#) $Id$
8#
9# Copyright (c) 1995-1997 Sun Microsystems, Inc.
10# Copyright (c) 1998-2000 Ajuba Solutions.
11# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
12#
13# See the file "license.terms" for information on usage and redistribution
14# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15#
16
17# TODO: history - remember partially written command
18
19namespace eval ::tk::console {
20    variable blinkTime   500 ; # msecs to blink braced range for
21    variable blinkRange  1   ; # enable blinking of the entire braced range
22    variable magicKeys   1   ; # enable brace matching and proc/var recognition
23    variable maxLines    600 ; # maximum # of lines buffered in console
24    variable showMatches 1   ; # show multiple expand matches
25
26    variable inPlugin [info exists embed_args]
27    variable defaultPrompt   ; # default prompt if tcl_prompt1 isn't used
28
29
30    if {$inPlugin} {
31	set defaultPrompt {subst {[history nextid] % }}
32    } else {
33	set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}
34    }
35}
36
37# simple compat function for tkcon code added for this console
38interp alias {} EvalAttached {} consoleinterp eval
39
40# ::tk::ConsoleInit --
41# This procedure constructs and configures the console windows.
42#
43# Arguments:
44# 	None.
45
46proc ::tk::ConsoleInit {} {
47    global tcl_platform
48
49    if {![consoleinterp eval {set tcl_interactive}]} {
50	wm withdraw .
51    }
52
53    if {[tk windowingsystem] eq "aqua"} {
54	set mod "Cmd"
55    } else {
56	set mod "Ctrl"
57    }
58
59    if {[catch {menu .menubar} err]} {
60	bgerror "INIT: $err"
61    }
62    AmpMenuArgs .menubar add cascade -label [mc &File] -menu .menubar.file
63    AmpMenuArgs .menubar add cascade -label [mc &Edit] -menu .menubar.edit
64
65    menu .menubar.file -tearoff 0
66    AmpMenuArgs .menubar.file add command -label [mc "&Source..."] \
67	    -command {tk::ConsoleSource}
68    AmpMenuArgs .menubar.file add command -label [mc "&Hide Console"] \
69	    -command {wm withdraw .}
70    AmpMenuArgs .menubar.file add command -label [mc "&Clear Console"] \
71	    -command {.console delete 1.0 "promptEnd linestart"}
72    if {[tk windowingsystem] ne "aqua"} {
73	AmpMenuArgs .menubar.file add command -label [mc E&xit] -command {exit}
74    }
75
76    menu .menubar.edit -tearoff 0
77    AmpMenuArgs	.menubar.edit add command -label [mc Cu&t]   -accel "$mod+X"\
78	    -command {event generate .console <<Cut>>}
79    AmpMenuArgs	.menubar.edit add command -label [mc &Copy]  -accel "$mod+C"\
80	    -command {event generate .console <<Copy>>}
81    AmpMenuArgs	.menubar.edit add command -label [mc P&aste] -accel "$mod+V"\
82	    -command {event generate .console <<Paste>>}
83
84    if {$tcl_platform(platform) ne "windows"} {
85	AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \
86		-command {event generate .console <<Clear>>}
87    } else {
88	AmpMenuArgs .menubar.edit add command -label [mc &Delete] \
89		-command {event generate .console <<Clear>>} -accel "Del"
90
91	AmpMenuArgs .menubar add cascade -label [mc &Help] -menu .menubar.help
92	menu .menubar.help -tearoff 0
93	AmpMenuArgs .menubar.help add command -label [mc &About...] \
94		-command tk::ConsoleAbout
95    }
96
97    AmpMenuArgs .menubar.edit add separator
98    AmpMenuArgs .menubar.edit add command -label [mc "&Increase Font Size"] \
99        -accel "$mod++" -command {event generate .console <<Console_FontSizeIncr>>}
100    AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \
101        -accel "$mod+-" -command {event generate .console <<Console_FontSizeDecr>>}
102
103    if {[tk windowingsystem] eq "aqua"} {
104	.menubar add cascade -label [mc Window] -menu [menu .menubar.window]
105	.menubar add cascade -label [mc Help] -menu [menu .menubar.help]
106    }
107
108    . configure -menu .menubar
109
110    # See if we can find a better font than the TkFixedFont
111    catch {font create TkConsoleFont {*}[font configure TkFixedFont]}
112    set families [font families]
113    switch -exact -- [tk windowingsystem] {
114        aqua { set preferred {Monaco 10} }
115        win32 { set preferred {ProFontWindows 8 Consolas 8} }
116        default { set preferred {} }
117    }
118    foreach {family size} $preferred {
119        if {[lsearch -exact $families $family] != -1} {
120            font configure TkConsoleFont -family $family -size $size
121            break
122        }
123    }
124
125    # Provide the right border for the text widget (platform dependent).
126    ::ttk::style layout ConsoleFrame {
127        Entry.field -sticky news -border 1 -children {
128            ConsoleFrame.padding -sticky news
129        }
130    }
131    ::ttk::frame .consoleframe -style ConsoleFrame
132
133    set con [text .console -yscrollcommand [list .sb set] -setgrid true \
134                 -borderwidth 0 -highlightthickness 0 -font TkConsoleFont]
135    if {[tk windowingsystem] eq "aqua"} {
136        scrollbar .sb -command [list $con yview]
137    } else {
138        ::ttk::scrollbar .sb -command [list $con yview]
139    }
140    pack .sb  -in .consoleframe -fill both -side right -padx 1 -pady 1
141    pack $con -in .consoleframe -fill both -expand 1 -side left -padx 1 -pady 1
142    pack .consoleframe -fill both -expand 1 -side left
143
144    ConsoleBind $con
145
146    $con tag configure stderr	-foreground red
147    $con tag configure stdin	-foreground blue
148    $con tag configure prompt	-foreground \#8F4433
149    $con tag configure proc	-foreground \#008800
150    $con tag configure var	-background \#FFC0D0
151    $con tag raise sel
152    $con tag configure blink	-background \#FFFF00
153    $con tag configure find	-background \#FFFF00
154
155    focus $con
156
157    # Avoid listing this console in [winfo interps]
158    if {[info command ::send] eq "::send"} {rename ::send {}}
159
160    wm protocol . WM_DELETE_WINDOW { wm withdraw . }
161    wm title . [mc "Console"]
162    flush stdout
163    $con mark set output [$con index "end - 1 char"]
164    tk::TextSetCursor $con end
165    $con mark set promptEnd insert
166    $con mark gravity promptEnd left
167
168    # A variant of ConsolePrompt to avoid a 'puts' call
169    set w $con
170    set temp [$w index "end - 1 char"]
171    $w mark set output end
172    if {![consoleinterp eval "info exists tcl_prompt1"]} {
173	set string [EvalAttached $::tk::console::defaultPrompt]
174	$w insert output $string stdout
175    }
176    $w mark set output $temp
177    ::tk::TextSetCursor $w end
178    $w mark set promptEnd insert
179    $w mark gravity promptEnd left
180
181    if {$tcl_platform(platform) eq "windows"} {
182	# Subtle work-around to erase the '% ' that tclMain.c prints out
183	after idle [subst -nocommand {
184	    if {[$con get 1.0 output] eq "% "} { $con delete 1.0 output }
185	}]
186    }
187}
188
189# ::tk::ConsoleSource --
190#
191# Prompts the user for a file to source in the main interpreter.
192#
193# Arguments:
194# None.
195
196proc ::tk::ConsoleSource {} {
197    set filename [tk_getOpenFile -defaultextension .tcl -parent . \
198	    -title [mc "Select a file to source"] \
199	    -filetypes [list \
200	    [list [mc "Tcl Scripts"] .tcl] \
201	    [list [mc "All Files"] *]]]
202    if {$filename ne ""} {
203    	set cmd [list source $filename]
204	if {[catch {consoleinterp eval $cmd} result]} {
205	    ConsoleOutput stderr "$result\n"
206	}
207    }
208}
209
210# ::tk::ConsoleInvoke --
211# Processes the command line input.  If the command is complete it
212# is evaled in the main interpreter.  Otherwise, the continuation
213# prompt is added and more input may be added.
214#
215# Arguments:
216# None.
217
218proc ::tk::ConsoleInvoke {args} {
219    set ranges [.console tag ranges input]
220    set cmd ""
221    if {[llength $ranges]} {
222	set pos 0
223	while {[lindex $ranges $pos] ne ""} {
224	    set start [lindex $ranges $pos]
225	    set end [lindex $ranges [incr pos]]
226	    append cmd [.console get $start $end]
227	    incr pos
228	}
229    }
230    if {$cmd eq ""} {
231	ConsolePrompt
232    } elseif {[info complete $cmd]} {
233	.console mark set output end
234	.console tag delete input
235	set result [consoleinterp record $cmd]
236	if {$result ne ""} {
237	    puts $result
238	}
239	ConsoleHistory reset
240	ConsolePrompt
241    } else {
242	ConsolePrompt partial
243    }
244    .console yview -pickplace insert
245}
246
247# ::tk::ConsoleHistory --
248# This procedure implements command line history for the
249# console.  In general is evals the history command in the
250# main interpreter to obtain the history.  The variable
251# ::tk::HistNum is used to store the current location in the history.
252#
253# Arguments:
254# cmd -	Which action to take: prev, next, reset.
255
256set ::tk::HistNum 1
257proc ::tk::ConsoleHistory {cmd} {
258    variable HistNum
259
260    switch $cmd {
261    	prev {
262	    incr HistNum -1
263	    if {$HistNum == 0} {
264		set cmd {history event [expr {[history nextid] -1}]}
265	    } else {
266		set cmd "history event $HistNum"
267	    }
268    	    if {[catch {consoleinterp eval $cmd} cmd]} {
269    	    	incr HistNum
270    	    	return
271    	    }
272	    .console delete promptEnd end
273    	    .console insert promptEnd $cmd {input stdin}
274    	}
275    	next {
276	    incr HistNum
277	    if {$HistNum == 0} {
278		set cmd {history event [expr {[history nextid] -1}]}
279	    } elseif {$HistNum > 0} {
280		set cmd ""
281		set HistNum 1
282	    } else {
283		set cmd "history event $HistNum"
284	    }
285	    if {$cmd ne ""} {
286		catch {consoleinterp eval $cmd} cmd
287	    }
288	    .console delete promptEnd end
289	    .console insert promptEnd $cmd {input stdin}
290    	}
291    	reset {
292    	    set HistNum 1
293    	}
294    }
295}
296
297# ::tk::ConsolePrompt --
298# This procedure draws the prompt.  If tcl_prompt1 or tcl_prompt2
299# exists in the main interpreter it will be called to generate the
300# prompt.  Otherwise, a hard coded default prompt is printed.
301#
302# Arguments:
303# partial -	Flag to specify which prompt to print.
304
305proc ::tk::ConsolePrompt {{partial normal}} {
306    set w .console
307    if {$partial eq "normal"} {
308	set temp [$w index "end - 1 char"]
309	$w mark set output end
310    	if {[consoleinterp eval "info exists tcl_prompt1"]} {
311    	    consoleinterp eval "eval \[set tcl_prompt1\]"
312    	} else {
313    	    puts -nonewline [EvalAttached $::tk::console::defaultPrompt]
314    	}
315    } else {
316	set temp [$w index output]
317	$w mark set output end
318    	if {[consoleinterp eval "info exists tcl_prompt2"]} {
319    	    consoleinterp eval "eval \[set tcl_prompt2\]"
320    	} else {
321	    puts -nonewline "> "
322    	}
323    }
324    flush stdout
325    $w mark set output $temp
326    ::tk::TextSetCursor $w end
327    $w mark set promptEnd insert
328    $w mark gravity promptEnd left
329    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
330    $w see end
331}
332
333# Copy selected text from the console
334proc ::tk::console::Copy {w} {
335    if {![catch {set data [$w get sel.first sel.last]}]} {
336        clipboard clear -displayof $w
337        clipboard append -displayof $w $data
338    }
339}
340# Copies selected text. If the selection is within the current active edit
341# region then it will be cut, if not it is only copied.
342proc ::tk::console::Cut {w} {
343    if {![catch {set data [$w get sel.first sel.last]}]} {
344        clipboard clear -displayof $w
345        clipboard append -displayof $w $data
346        if {[$w compare sel.first >= output]} {
347            $w delete sel.first sel.last
348	}
349    }
350}
351# Paste text from the clipboard
352proc ::tk::console::Paste {w} {
353    catch {
354        set clip [::tk::GetSelection $w CLIPBOARD]
355        set list [split $clip \n\r]
356        tk::ConsoleInsert $w [lindex $list 0]
357        foreach x [lrange $list 1 end] {
358            $w mark set insert {end - 1c}
359            tk::ConsoleInsert $w "\n"
360            tk::ConsoleInvoke
361            tk::ConsoleInsert $w $x
362        }
363    }
364}
365
366# ::tk::ConsoleBind --
367# This procedure first ensures that the default bindings for the Text
368# class have been defined.  Then certain bindings are overridden for
369# the class.
370#
371# Arguments:
372# None.
373
374proc ::tk::ConsoleBind {w} {
375    bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]
376
377    ## Get all Text bindings into Console
378    foreach ev [bind Text] {
379	bind Console $ev [bind Text $ev]
380    }
381    ## We really didn't want the newline insertion...
382    bind Console <Control-Key-o> {}
383    ## ...or any Control-v binding (would block <<Paste>>)
384    bind Console <Control-Key-v> {}
385
386    # For the moment, transpose isn't enabled until the console
387    # gets and overhaul of how it handles input -- hobbs
388    bind Console <Control-Key-t> {}
389
390    # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
391    # Otherwise, if a widget binding for one of these is defined, the
392    # <Keypress> class binding will also fire and insert the character
393    # which is wrong.
394
395    bind Console <Alt-KeyPress> {# nothing }
396    bind Console <Meta-KeyPress> {# nothing}
397    bind Console <Control-KeyPress> {# nothing}
398
399    foreach {ev key} {
400	<<Console_Prev>>		<Key-Up>
401	<<Console_Next>>		<Key-Down>
402	<<Console_NextImmediate>>	<Control-Key-n>
403	<<Console_PrevImmediate>>	<Control-Key-p>
404	<<Console_PrevSearch>>		<Control-Key-r>
405	<<Console_NextSearch>>		<Control-Key-s>
406
407	<<Console_Expand>>		<Key-Tab>
408	<<Console_Expand>>		<Key-Escape>
409	<<Console_ExpandFile>>		<Control-Shift-Key-F>
410	<<Console_ExpandProc>>		<Control-Shift-Key-P>
411	<<Console_ExpandVar>>		<Control-Shift-Key-V>
412	<<Console_Tab>>			<Control-Key-i>
413	<<Console_Tab>>			<Meta-Key-i>
414	<<Console_Eval>>		<Key-Return>
415	<<Console_Eval>>		<Key-KP_Enter>
416
417	<<Console_Clear>>		<Control-Key-l>
418	<<Console_KillLine>>		<Control-Key-k>
419	<<Console_Transpose>>		<Control-Key-t>
420	<<Console_ClearLine>>		<Control-Key-u>
421	<<Console_SaveCommand>>		<Control-Key-z>
422        <<Console_FontSizeIncr>>	<Control-Key-plus>
423        <<Console_FontSizeDecr>>	<Control-Key-minus>
424    } {
425	event add $ev $key
426	bind Console $key {}
427    }
428    if {[tk windowingsystem] eq "aqua"} {
429	foreach {ev key} {
430	    <<Console_FontSizeIncr>>	<Command-Key-plus>
431	    <<Console_FontSizeDecr>>	<Command-Key-minus>
432	} {
433	    event add $ev $key
434	    bind Console $key {}
435	}
436    }
437    bind Console <<Console_Expand>> {
438	if {[%W compare insert > promptEnd]} {
439	    ::tk::console::Expand %W
440	}
441    }
442    bind Console <<Console_ExpandFile>> {
443	if {[%W compare insert > promptEnd]} {
444	    ::tk::console::Expand %W path
445	}
446    }
447    bind Console <<Console_ExpandProc>> {
448	if {[%W compare insert > promptEnd]} {
449	    ::tk::console::Expand %W proc
450	}
451    }
452    bind Console <<Console_ExpandVar>> {
453	if {[%W compare insert > promptEnd]} {
454	    ::tk::console::Expand %W var
455	}
456    }
457    bind Console <<Console_Eval>> {
458	%W mark set insert {end - 1c}
459	tk::ConsoleInsert %W "\n"
460	tk::ConsoleInvoke
461	break
462    }
463    bind Console <Delete> {
464	if {{} ne [%W tag nextrange sel 1.0 end] \
465		&& [%W compare sel.first >= promptEnd]} {
466	    %W delete sel.first sel.last
467	} elseif {[%W compare insert >= promptEnd]} {
468	    %W delete insert
469	    %W see insert
470	}
471    }
472    bind Console <BackSpace> {
473	if {{} ne [%W tag nextrange sel 1.0 end] \
474		&& [%W compare sel.first >= promptEnd]} {
475	    %W delete sel.first sel.last
476	} elseif {[%W compare insert != 1.0] && \
477		[%W compare insert > promptEnd]} {
478	    %W delete insert-1c
479	    %W see insert
480	}
481    }
482    bind Console <Control-h> [bind Console <BackSpace>]
483
484    bind Console <Home> {
485	if {[%W compare insert < promptEnd]} {
486	    tk::TextSetCursor %W {insert linestart}
487	} else {
488	    tk::TextSetCursor %W promptEnd
489	}
490    }
491    bind Console <Control-a> [bind Console <Home>]
492    bind Console <End> {
493	tk::TextSetCursor %W {insert lineend}
494    }
495    bind Console <Control-e> [bind Console <End>]
496    bind Console <Control-d> {
497	if {[%W compare insert < promptEnd]} {
498	    break
499	}
500	%W delete insert
501    }
502    bind Console <<Console_KillLine>> {
503	if {[%W compare insert < promptEnd]} {
504	    break
505	}
506	if {[%W compare insert == {insert lineend}]} {
507	    %W delete insert
508	} else {
509	    %W delete insert {insert lineend}
510	}
511    }
512    bind Console <<Console_Clear>> {
513	## Clear console display
514	%W delete 1.0 "promptEnd linestart"
515    }
516    bind Console <<Console_ClearLine>> {
517	## Clear command line (Unix shell staple)
518	%W delete promptEnd end
519    }
520    bind Console <Meta-d> {
521	if {[%W compare insert >= promptEnd]} {
522	    %W delete insert {insert wordend}
523	}
524    }
525    bind Console <Meta-BackSpace> {
526	if {[%W compare {insert -1c wordstart} >= promptEnd]} {
527	    %W delete {insert -1c wordstart} insert
528	}
529    }
530    bind Console <Meta-d> {
531	if {[%W compare insert >= promptEnd]} {
532	    %W delete insert {insert wordend}
533	}
534    }
535    bind Console <Meta-BackSpace> {
536	if {[%W compare {insert -1c wordstart} >= promptEnd]} {
537	    %W delete {insert -1c wordstart} insert
538	}
539    }
540    bind Console <Meta-Delete> {
541	if {[%W compare insert >= promptEnd]} {
542	    %W delete insert {insert wordend}
543	}
544    }
545    bind Console <<Console_Prev>> {
546	tk::ConsoleHistory prev
547    }
548    bind Console <<Console_Next>> {
549	tk::ConsoleHistory next
550    }
551    bind Console <Insert> {
552	catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
553    }
554    bind Console <KeyPress> {
555	tk::ConsoleInsert %W %A
556    }
557    bind Console <F9> {
558	eval destroy [winfo child .]
559	source [file join $tk_library console.tcl]
560    }
561    if {[tk windowingsystem] eq "aqua"} {
562	bind Console <Command-q> {
563	    exit
564	}
565    }
566    bind Console <<Cut>> { ::tk::console::Cut %W }
567    bind Console <<Copy>> { ::tk::console::Copy %W }
568    bind Console <<Paste>> { ::tk::console::Paste %W }
569
570    bind Console <<Console_FontSizeIncr>> {
571        set size [font configure TkConsoleFont -size]
572        font configure TkConsoleFont -size [incr size]
573    }
574    bind Console <<Console_FontSizeDecr>> {
575        set size [font configure TkConsoleFont -size]
576        font configure TkConsoleFont -size [incr size -1]
577    }
578
579    ##
580    ## Bindings for doing special things based on certain keys
581    ##
582    bind PostConsole <Key-parenright> {
583	if {"\\" ne [%W get insert-2c]} {
584	    ::tk::console::MatchPair %W \( \) promptEnd
585	}
586    }
587    bind PostConsole <Key-bracketright> {
588	if {"\\" ne [%W get insert-2c]} {
589	    ::tk::console::MatchPair %W \[ \] promptEnd
590	}
591    }
592    bind PostConsole <Key-braceright> {
593	if {"\\" ne [%W get insert-2c]} {
594	    ::tk::console::MatchPair %W \{ \} promptEnd
595	}
596    }
597    bind PostConsole <Key-quotedbl> {
598	if {"\\" ne [%W get insert-2c]} {
599	    ::tk::console::MatchQuote %W promptEnd
600	}
601    }
602
603    bind PostConsole <KeyPress> {
604	if {"%A" ne ""} {
605	    ::tk::console::TagProc %W
606	}
607    }
608}
609
610# ::tk::ConsoleInsert --
611# Insert a string into a text at the point of the insertion cursor.
612# If there is a selection in the text, and it covers the point of the
613# insertion cursor, then delete the selection before inserting.  Insertion
614# is restricted to the prompt area.
615#
616# Arguments:
617# w -		The text window in which to insert the string
618# s -		The string to insert (usually just a single character)
619
620proc ::tk::ConsoleInsert {w s} {
621    if {$s eq ""} {
622	return
623    }
624    catch {
625	if {[$w compare sel.first <= insert] \
626		&& [$w compare sel.last >= insert]} {
627	    $w tag remove sel sel.first promptEnd
628	    $w delete sel.first sel.last
629	}
630    }
631    if {[$w compare insert < promptEnd]} {
632	$w mark set insert end
633    }
634    $w insert insert $s {input stdin}
635    $w see insert
636}
637
638# ::tk::ConsoleOutput --
639#
640# This routine is called directly by ConsolePutsCmd to cause a string
641# to be displayed in the console.
642#
643# Arguments:
644# dest -	The output tag to be used: either "stderr" or "stdout".
645# string -	The string to be displayed.
646
647proc ::tk::ConsoleOutput {dest string} {
648    set w .console
649    $w insert output $string $dest
650    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
651    $w see insert
652}
653
654# ::tk::ConsoleExit --
655#
656# This routine is called by ConsoleEventProc when the main window of
657# the application is destroyed.  Don't call exit - that probably already
658# happened.  Just delete our window.
659#
660# Arguments:
661# None.
662
663proc ::tk::ConsoleExit {} {
664    destroy .
665}
666
667# ::tk::ConsoleAbout --
668#
669# This routine displays an About box to show Tcl/Tk version info.
670#
671# Arguments:
672# None.
673
674proc ::tk::ConsoleAbout {} {
675    tk_messageBox -type ok -message "[mc {Tcl for Windows}]
676
677Tcl $::tcl_patchLevel
678Tk $::tk_patchLevel"
679}
680
681# ::tk::console::TagProc --
682#
683# Tags a procedure in the console if it's recognized
684# This procedure is not perfect.  However, making it perfect wastes
685# too much CPU time...
686#
687# Arguments:
688#	w	- console text widget
689
690proc ::tk::console::TagProc w {
691    if {!$::tk::console::magicKeys} {
692	return
693    }
694    set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
695    set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
696    if {$i eq ""} {
697	set i promptEnd
698    } else {
699	append i +2c
700    }
701    regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c
702    if {[llength [EvalAttached [list info commands $c]]]} {
703	$w tag add proc $i "insert-1c wordend"
704    } else {
705	$w tag remove proc $i "insert-1c wordend"
706    }
707    if {[llength [EvalAttached [list info vars $c]]]} {
708	$w tag add var $i "insert-1c wordend"
709    } else {
710	$w tag remove var $i "insert-1c wordend"
711    }
712}
713
714# ::tk::console::MatchPair --
715#
716# Blinks a matching pair of characters
717# c2 is assumed to be at the text index 'insert'.
718# This proc is really loopy and took me an hour to figure out given
719# all possible combinations with escaping except for escaped \'s.
720# It doesn't take into account possible commenting... Oh well.  If
721# anyone has something better, I'd like to see/use it.  This is really
722# only efficient for small contexts.
723#
724# Arguments:
725#	w	- console text widget
726# 	c1	- first char of pair
727# 	c2	- second char of pair
728#
729# Calls:	::tk::console::Blink
730
731proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
732    if {!$::tk::console::magicKeys} {
733	return
734    }
735    if {{} ne [set ix [$w search -back $c1 insert $lim]]} {
736	while {
737	    [string match {\\} [$w get $ix-1c]] &&
738	    [set ix [$w search -back $c1 $ix-1c $lim]] ne {}
739	} {}
740	set i1 insert-1c
741	while {$ix ne {}} {
742	    set i0 $ix
743	    set j 0
744	    while {[set i0 [$w search $c2 $i0 $i1]] ne {}} {
745		append i0 +1c
746		if {[string match {\\} [$w get $i0-2c]]} {
747		    continue
748		}
749		incr j
750	    }
751	    if {!$j} {
752		break
753	    }
754	    set i1 $ix
755	    while {$j && [set ix [$w search -back $c1 $ix $lim]] ne {}} {
756		if {[string match {\\} [$w get $ix-1c]]} {
757		    continue
758		}
759		incr j -1
760	    }
761	}
762	if {[string match {} $ix]} {
763	    set ix [$w index $lim]
764	}
765    } else {
766	set ix [$w index $lim]
767    }
768    if {$::tk::console::blinkRange} {
769	Blink $w $ix [$w index insert]
770    } else {
771	Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert]
772    }
773}
774
775# ::tk::console::MatchQuote --
776#
777# Blinks between matching quotes.
778# Blinks just the quote if it's unmatched, otherwise blinks quoted string
779# The quote to match is assumed to be at the text index 'insert'.
780#
781# Arguments:
782#	w	- console text widget
783#
784# Calls:	::tk::console::Blink
785
786proc ::tk::console::MatchQuote {w {lim 1.0}} {
787    if {!$::tk::console::magicKeys} {
788	return
789    }
790    set i insert-1c
791    set j 0
792    while {[set i [$w search -back \" $i $lim]] ne {}} {
793	if {[string match {\\} [$w get $i-1c]]} {
794	    continue
795	}
796	if {!$j} {
797	    set i0 $i
798	}
799	incr j
800    }
801    if {$j&1} {
802	if {$::tk::console::blinkRange} {
803	    Blink $w $i0 [$w index insert]
804	} else {
805	    Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert]
806	}
807    } else {
808	Blink $w [$w index insert-1c] [$w index insert]
809    }
810}
811
812# ::tk::console::Blink --
813#
814# Blinks between n index pairs for a specified duration.
815#
816# Arguments:
817#	w	- console text widget
818# 	i1	- start index to blink region
819# 	i2	- end index of blink region
820# 	dur	- duration in usecs to blink for
821#
822# Outputs:
823#	blinks selected characters in $w
824
825proc ::tk::console::Blink {w args} {
826    eval [list $w tag add blink] $args
827    after $::tk::console::blinkTime [list $w] tag remove blink $args
828}
829
830# ::tk::console::ConstrainBuffer --
831#
832# This limits the amount of data in the text widget
833# Called by Prompt and ConsoleOutput
834#
835# Arguments:
836#	w	- console text widget
837#	size	- # of lines to constrain to
838#
839# Outputs:
840#	may delete data in console widget
841
842proc ::tk::console::ConstrainBuffer {w size} {
843    if {[$w index end] > $size} {
844	$w delete 1.0 [expr {int([$w index end])-$size}].0
845    }
846}
847
848# ::tk::console::Expand --
849#
850# Arguments:
851# ARGS:	w	- text widget in which to expand str
852# 	type	- type of expansion (path / proc / variable)
853#
854# Calls:	::tk::console::Expand(Pathname|Procname|Variable)
855#
856# Outputs:	The string to match is expanded to the longest possible match.
857#		If ::tk::console::showMatches is non-zero and the longest match
858#		equaled the string to expand, then all possible matches are
859#		output to stdout.  Triggers bell if no matches are found.
860#
861# Returns:	number of matches found
862
863proc ::tk::console::Expand {w {type ""}} {
864    set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
865    set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
866    if {$tmp eq ""} {
867	set tmp promptEnd
868    } else {
869	append tmp +2c
870    }
871    if {[$w compare $tmp >= insert]} {
872	return
873    }
874    set str [$w get $tmp insert]
875    switch -glob $type {
876	path* {
877	    set res [ExpandPathname $str]
878	}
879	proc* {
880	    set res [ExpandProcname $str]
881	}
882	var* {
883	    set res [ExpandVariable $str]
884	}
885	default {
886	    set res {}
887	    foreach t {Pathname Procname Variable} {
888		if {![catch {Expand$t $str} res] && ($res ne "")} {
889		    break
890		}
891	    }
892	}
893    }
894    set len [llength $res]
895    if {$len} {
896	set repl [lindex $res 0]
897	$w delete $tmp insert
898	$w insert $tmp $repl {input stdin}
899	if {($len > 1) && ($::tk::console::showMatches) && ($repl eq $str)} {
900	    puts stdout [lsort [lreplace $res 0 0]]
901	}
902    } else {
903	bell
904    }
905    return [incr len -1]
906}
907
908# ::tk::console::ExpandPathname --
909#
910# Expand a file pathname based on $str
911# This is based on UNIX file name conventions
912#
913# Arguments:
914#	str	- partial file pathname to expand
915#
916# Calls:	::tk::console::ExpandBestMatch
917#
918# Returns:	list containing longest unique match followed by all the
919#		possible further matches
920
921proc ::tk::console::ExpandPathname str {
922    set pwd [EvalAttached pwd]
923    if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {
924	return -code error $err
925    }
926    set dir [file tail $str]
927    ## Check to see if it was known to be a directory and keep the trailing
928    ## slash if so (file tail cuts it off)
929    if {[string match */ $str]} {
930	append dir /
931    }
932    if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
933	set match {}
934    } else {
935	if {[llength $m] > 1} {
936	    global tcl_platform
937	    if {[string match windows $tcl_platform(platform)]} {
938		## Windows is screwy because it's case insensitive
939		set tmp [ExpandBestMatch [string tolower $m] \
940			[string tolower $dir]]
941		## Don't change case if we haven't changed the word
942		if {[string length $dir]==[string length $tmp]} {
943		    set tmp $dir
944		}
945	    } else {
946		set tmp [ExpandBestMatch $m $dir]
947	    }
948	    if {[string match ?*/* $str]} {
949		set tmp [file dirname $str]/$tmp
950	    } elseif {[string match /* $str]} {
951		set tmp /$tmp
952	    }
953	    regsub -all { } $tmp {\\ } tmp
954	    set match [linsert $m 0 $tmp]
955	} else {
956	    ## This may look goofy, but it handles spaces in path names
957	    eval append match $m
958	    if {[file isdir $match]} {
959		append match /
960	    }
961	    if {[string match ?*/* $str]} {
962		set match [file dirname $str]/$match
963	    } elseif {[string match /* $str]} {
964		set match /$match
965	    }
966	    regsub -all { } $match {\\ } match
967	    ## Why is this one needed and the ones below aren't!!
968	    set match [list $match]
969	}
970    }
971    EvalAttached [list cd $pwd]
972    return $match
973}
974
975# ::tk::console::ExpandProcname --
976#
977# Expand a tcl proc name based on $str
978#
979# Arguments:
980#	str	- partial proc name to expand
981#
982# Calls:	::tk::console::ExpandBestMatch
983#
984# Returns:	list containing longest unique match followed by all the
985#		possible further matches
986
987proc ::tk::console::ExpandProcname str {
988    set match [EvalAttached [list info commands $str*]]
989    if {[llength $match] == 0} {
990	set ns [EvalAttached \
991		"namespace children \[namespace current\] [list $str*]"]
992	if {[llength $ns]==1} {
993	    set match [EvalAttached [list info commands ${ns}::*]]
994	} else {
995	    set match $ns
996	}
997    }
998    if {[llength $match] > 1} {
999	regsub -all { } [ExpandBestMatch $match $str] {\\ } str
1000	set match [linsert $match 0 $str]
1001    } else {
1002	regsub -all { } $match {\\ } match
1003    }
1004    return $match
1005}
1006
1007# ::tk::console::ExpandVariable --
1008#
1009# Expand a tcl variable name based on $str
1010#
1011# Arguments:
1012#	str	- partial tcl var name to expand
1013#
1014# Calls:	::tk::console::ExpandBestMatch
1015#
1016# Returns:	list containing longest unique match followed by all the
1017#		possible further matches
1018
1019proc ::tk::console::ExpandVariable str {
1020    if {[regexp {([^\(]*)\((.*)} $str -> ary str]} {
1021	## Looks like they're trying to expand an array.
1022	set match [EvalAttached [list array names $ary $str*]]
1023	if {[llength $match] > 1} {
1024	    set vars $ary\([ExpandBestMatch $match $str]
1025	    foreach var $match {
1026		lappend vars $ary\($var\)
1027	    }
1028	    return $vars
1029	} elseif {[llength $match] == 1} {
1030	    set match $ary\($match\)
1031	}
1032	## Space transformation avoided for array names.
1033    } else {
1034	set match [EvalAttached [list info vars $str*]]
1035	if {[llength $match] > 1} {
1036	    regsub -all { } [ExpandBestMatch $match $str] {\\ } str
1037	    set match [linsert $match 0 $str]
1038	} else {
1039	    regsub -all { } $match {\\ } match
1040	}
1041    }
1042    return $match
1043}
1044
1045# ::tk::console::ExpandBestMatch --
1046#
1047# Finds the best unique match in a list of names.
1048# The extra $e in this argument allows us to limit the innermost loop a little
1049# further.  This improves speed as $l becomes large or $e becomes long.
1050#
1051# Arguments:
1052#	l	- list to find best unique match in
1053# 	e	- currently best known unique match
1054#
1055# Returns:	longest unique match in the list
1056
1057proc ::tk::console::ExpandBestMatch {l {e {}}} {
1058    set ec [lindex $l 0]
1059    if {[llength $l]>1} {
1060	set e [expr {[string length $e] - 1}]
1061	set ei [expr {[string length $ec] - 1}]
1062	foreach l $l {
1063	    while {$ei>=$e && [string first $ec $l]} {
1064		set ec [string range $ec 0 [incr ei -1]]
1065	    }
1066	}
1067    }
1068    return $ec
1069}
1070
1071# now initialize the console
1072::tk::ConsoleInit
1073