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
7 # RCS: @(#) $Id: console.tcl,v 1.22 2003/02/21 03:34:29 das Exp $
9 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
10 # Copyright (c) 1998-2000 Ajuba Solutions.
12 # See the file "license.terms" for information on usage and redistribution
13 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16 # TODO: history - remember partially written command
18 namespace eval ::tk::console {
19 variable blinkTime 500 ; # msecs to blink braced range for
20 variable blinkRange 1 ; # enable blinking of the entire braced range
21 variable magicKeys 1 ; # enable brace matching and proc/var recognition
22 variable maxLines 600 ; # maximum # of lines buffered in console
23 variable showMatches 1 ; # show multiple expand matches
25 variable inPlugin [info exists embed_args]
26 variable defaultPrompt ; # default prompt if tcl_prompt1 isn't used
30 set defaultPrompt {subst {[history nextid] % }}
32 set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}
36 # simple compat function for tkcon code added for this console
37 interp alias {} EvalAttached {} consoleinterp eval
39 # ::tk::ConsoleInit --
40 # This procedure constructs and configures the console windows.
45 proc ::tk::ConsoleInit {} {
48 if {![consoleinterp eval {set tcl_interactive}]} {
52 if {[string equal $tcl_platform(platform) "macintosh"]
53 || [string equal [tk windowingsystem] "aqua"]} {
59 if {[catch {menu .menubar} err]} { bgerror "INIT: $err" }
60 .menubar add cascade -label File -menu .menubar.file -underline 0
61 .menubar add cascade -label Edit -menu .menubar.edit -underline 0
63 menu .menubar.file -tearoff 0
64 .menubar.file add command -label [mc "Source..."] \
65 -underline 0 -command tk::ConsoleSource
66 .menubar.file add command -label [mc "Hide Console"] \
67 -underline 0 -command {wm withdraw .}
68 .menubar.file add command -label [mc "Clear Console"] \
69 -underline 0 -command {.console delete 1.0 "promptEnd linestart"}
70 if {[string equal $tcl_platform(platform) "macintosh"]
71 || [string equal [tk windowingsystem] "aqua"]} {
72 .menubar.file add command -label [mc "Quit"] \
73 -command exit -accel Cmd-Q
75 .menubar.file add command -label [mc "Exit"] \
76 -underline 1 -command exit
79 menu .menubar.edit -tearoff 0
80 .menubar.edit add command -label [mc "Cut"] -underline 2 \
81 -command { event generate .console <<Cut>> } -accel "$mod+X"
82 .menubar.edit add command -label [mc "Copy"] -underline 0 \
83 -command { event generate .console <<Copy>> } -accel "$mod+C"
84 .menubar.edit add command -label [mc "Paste"] -underline 1 \
85 -command { event generate .console <<Paste>> } -accel "$mod+V"
87 if {[string compare $tcl_platform(platform) "windows"]} {
88 .menubar.edit add command -label [mc "Clear"] -underline 2 \
89 -command { event generate .console <<Clear>> }
91 .menubar.edit add command -label [mc "Delete"] -underline 0 \
92 -command { event generate .console <<Clear>> } -accel "Del"
94 .menubar add cascade -label Help -menu .menubar.help -underline 0
95 menu .menubar.help -tearoff 0
96 .menubar.help add command -label [mc "About..."] \
97 -underline 0 -command tk::ConsoleAbout
100 . configure -menu .menubar
102 set con [text .console -yscrollcommand [list .sb set] -setgrid true]
103 scrollbar .sb -command [list $con yview]
104 pack .sb -side right -fill both
105 pack $con -fill both -expand 1 -side left
106 switch -exact $tcl_platform(platform) {
108 $con configure -font {Monaco 9 normal} -highlightthickness 0
111 $con configure -font systemfixed
114 if {[string equal [tk windowingsystem] "aqua"]} {
115 $con configure -font {Monaco 9 normal} -highlightthickness 0
122 $con tag configure stderr -foreground red
123 $con tag configure stdin -foreground blue
124 $con tag configure prompt -foreground \#8F4433
125 $con tag configure proc -foreground \#008800
126 $con tag configure var -background \#FFC0D0
128 $con tag configure blink -background \#FFFF00
129 $con tag configure find -background \#FFFF00
133 wm protocol . WM_DELETE_WINDOW { wm withdraw . }
134 wm title . [mc "Console"]
136 $con mark set output [$con index "end - 1 char"]
137 tk::TextSetCursor $con end
138 $con mark set promptEnd insert
139 $con mark gravity promptEnd left
142 # ::tk::ConsoleSource --
144 # Prompts the user for a file to source in the main interpreter.
149 proc ::tk::ConsoleSource {} {
150 set filename [tk_getOpenFile -defaultextension .tcl -parent . \
151 -title [mc "Select a file to source"] \
153 [list [mc "Tcl Scripts"] .tcl] \
154 [list [mc "All Files"] *]]]
155 if {[string compare $filename ""]} {
156 set cmd [list source $filename]
157 if {[catch {consoleinterp eval $cmd} result]} {
158 ConsoleOutput stderr "$result\n"
163 # ::tk::ConsoleInvoke --
164 # Processes the command line input. If the command is complete it
165 # is evaled in the main interpreter. Otherwise, the continuation
166 # prompt is added and more input may be added.
171 proc ::tk::ConsoleInvoke {args} {
172 set ranges [.console tag ranges input]
174 if {[llength $ranges]} {
176 while {[string compare [lindex $ranges $pos] ""]} {
177 set start [lindex $ranges $pos]
178 set end [lindex $ranges [incr pos]]
179 append cmd [.console get $start $end]
183 if {[string equal $cmd ""]} {
185 } elseif {[info complete $cmd]} {
186 .console mark set output end
187 .console tag delete input
188 set result [consoleinterp record $cmd]
189 if {[string compare $result ""]} {
195 ConsolePrompt partial
197 .console yview -pickplace insert
200 # ::tk::ConsoleHistory --
201 # This procedure implements command line history for the
202 # console. In general is evals the history command in the
203 # main interpreter to obtain the history. The variable
204 # ::tk::HistNum is used to store the current location in the history.
207 # cmd - Which action to take: prev, next, reset.
210 proc ::tk::ConsoleHistory {cmd} {
217 set cmd {history event [expr {[history nextid] -1}]}
219 set cmd "history event $HistNum"
221 if {[catch {consoleinterp eval $cmd} cmd]} {
225 .console delete promptEnd end
226 .console insert promptEnd $cmd {input stdin}
231 set cmd {history event [expr {[history nextid] -1}]}
232 } elseif {$HistNum > 0} {
236 set cmd "history event $HistNum"
238 if {[string compare $cmd ""]} {
239 catch {consoleinterp eval $cmd} cmd
241 .console delete promptEnd end
242 .console insert promptEnd $cmd {input stdin}
250 # ::tk::ConsolePrompt --
251 # This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2
252 # exists in the main interpreter it will be called to generate the
253 # prompt. Otherwise, a hard coded default prompt is printed.
256 # partial - Flag to specify which prompt to print.
258 proc ::tk::ConsolePrompt {{partial normal}} {
260 if {[string equal $partial "normal"]} {
261 set temp [$w index "end - 1 char"]
262 $w mark set output end
263 if {[consoleinterp eval "info exists tcl_prompt1"]} {
264 consoleinterp eval "eval \[set tcl_prompt1\]"
266 puts -nonewline [EvalAttached $::tk::console::defaultPrompt]
269 set temp [$w index output]
270 $w mark set output end
271 if {[consoleinterp eval "info exists tcl_prompt2"]} {
272 consoleinterp eval "eval \[set tcl_prompt2\]"
278 $w mark set output $temp
279 ::tk::TextSetCursor $w end
280 $w mark set promptEnd insert
281 $w mark gravity promptEnd left
282 ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
286 # ::tk::ConsoleBind --
287 # This procedure first ensures that the default bindings for the Text
288 # class have been defined. Then certain bindings are overridden for
294 proc ::tk::ConsoleBind {w} {
295 bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]
297 ## Get all Text bindings into Console
298 foreach ev [bind Text] { bind Console $ev [bind Text $ev] }
299 ## We really didn't want the newline insertion...
300 bind Console <Control-Key-o> {}
301 ## ...or any Control-v binding (would block <<Paste>>)
302 bind Console <Control-Key-v> {}
304 # For the moment, transpose isn't enabled until the console
305 # gets and overhaul of how it handles input -- hobbs
306 bind Console <Control-Key-t> {}
308 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
309 # Otherwise, if a widget binding for one of these is defined, the
311 bind Console <Alt-KeyPress> {# nothing }
312 bind Console <Meta-KeyPress> {# nothing}
313 bind Console <Control-KeyPress> {# nothing}
316 <<Console_Prev>> <Key-Up>
317 <<Console_Next>> <Key-Down>
318 <<Console_NextImmediate>> <Control-Key-n>
319 <<Console_PrevImmediate>> <Control-Key-p>
320 <<Console_PrevSearch>> <Control-Key-r>
321 <<Console_NextSearch>> <Control-Key-s>
323 <<Console_Expand>> <Key-Tab>
324 <<Console_Expand>> <Key-Escape>
325 <<Console_ExpandFile>> <Control-Shift-Key-F>
326 <<Console_ExpandProc>> <Control-Shift-Key-P>
327 <<Console_ExpandVar>> <Control-Shift-Key-V>
328 <<Console_Tab>> <Control-Key-i>
329 <<Console_Tab>> <Meta-Key-i>
330 <<Console_Eval>> <Key-Return>
331 <<Console_Eval>> <Key-KP_Enter>
333 <<Console_Clear>> <Control-Key-l>
334 <<Console_KillLine>> <Control-Key-k>
335 <<Console_Transpose>> <Control-Key-t>
336 <<Console_ClearLine>> <Control-Key-u>
337 <<Console_SaveCommand>> <Control-Key-z>
343 bind Console <<Console_Expand>> {
344 if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}
346 bind Console <<Console_ExpandFile>> {
347 if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}
349 bind Console <<Console_ExpandProc>> {
350 if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}
352 bind Console <<Console_ExpandVar>> {
353 if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}
355 bind Console <<Console_Eval>> {
356 %W mark set insert {end - 1c}
357 tk::ConsoleInsert %W "\n"
361 bind Console <Delete> {
362 if {[string compare {} [%W tag nextrange sel 1.0 end]] \
363 && [%W compare sel.first >= promptEnd]} {
364 %W delete sel.first sel.last
365 } elseif {[%W compare insert >= promptEnd]} {
370 bind Console <BackSpace> {
371 if {[string compare {} [%W tag nextrange sel 1.0 end]] \
372 && [%W compare sel.first >= promptEnd]} {
373 %W delete sel.first sel.last
374 } elseif {[%W compare insert != 1.0] && \
375 [%W compare insert > promptEnd]} {
380 bind Console <Control-h> [bind Console <BackSpace>]
382 bind Console <Home> {
383 if {[%W compare insert < promptEnd]} {
384 tk::TextSetCursor %W {insert linestart}
386 tk::TextSetCursor %W promptEnd
389 bind Console <Control-a> [bind Console <Home>]
391 tk::TextSetCursor %W {insert lineend}
393 bind Console <Control-e> [bind Console <End>]
394 bind Console <Control-d> {
395 if {[%W compare insert < promptEnd]} break
398 bind Console <<Console_KillLine>> {
399 if {[%W compare insert < promptEnd]} break
400 if {[%W compare insert == {insert lineend}]} {
403 %W delete insert {insert lineend}
406 bind Console <<Console_Clear>> {
407 ## Clear console display
408 %W delete 1.0 "promptEnd linestart"
410 bind Console <<Console_ClearLine>> {
411 ## Clear command line (Unix shell staple)
412 %W delete promptEnd end
414 bind Console <Meta-d> {
415 if {[%W compare insert >= promptEnd]} {
416 %W delete insert {insert wordend}
419 bind Console <Meta-BackSpace> {
420 if {[%W compare {insert -1c wordstart} >= promptEnd]} {
421 %W delete {insert -1c wordstart} insert
424 bind Console <Meta-d> {
425 if {[%W compare insert >= promptEnd]} {
426 %W delete insert {insert wordend}
429 bind Console <Meta-BackSpace> {
430 if {[%W compare {insert -1c wordstart} >= promptEnd]} {
431 %W delete {insert -1c wordstart} insert
434 bind Console <Meta-Delete> {
435 if {[%W compare insert >= promptEnd]} {
436 %W delete insert {insert wordend}
439 bind Console <<Console_Prev>> {
440 tk::ConsoleHistory prev
442 bind Console <<Console_Next>> {
443 tk::ConsoleHistory next
445 bind Console <Insert> {
446 catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
448 bind Console <KeyPress> {
449 tk::ConsoleInsert %W %A
452 eval destroy [winfo child .]
453 if {[string equal $tcl_platform(platform) "macintosh"]} {
454 if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console}
456 source [file join $tk_library console.tcl]
459 if {[string equal $::tcl_platform(platform) "macintosh"]
460 || [string equal [tk windowingsystem] "aqua"]} {
461 bind Console <Command-q> {
465 bind Console <<Cut>> {
466 # Same as the copy event
467 if {![catch {set data [%W get sel.first sel.last]}]} {
468 clipboard clear -displayof %W
469 clipboard append -displayof %W $data
472 bind Console <<Copy>> {
473 if {![catch {set data [%W get sel.first sel.last]}]} {
474 clipboard clear -displayof %W
475 clipboard append -displayof %W $data
478 bind Console <<Paste>> {
480 set clip [::tk::GetSelection %W CLIPBOARD]
481 set list [split $clip \n\r]
482 tk::ConsoleInsert %W [lindex $list 0]
483 foreach x [lrange $list 1 end] {
484 %W mark set insert {end - 1c}
485 tk::ConsoleInsert %W "\n"
487 tk::ConsoleInsert %W $x
493 ## Bindings for doing special things based on certain keys
495 bind PostConsole <Key-parenright> {
496 if {[string compare \\ [%W get insert-2c]]} {
497 ::tk::console::MatchPair %W \( \) promptEnd
500 bind PostConsole <Key-bracketright> {
501 if {[string compare \\ [%W get insert-2c]]} {
502 ::tk::console::MatchPair %W \[ \] promptEnd
505 bind PostConsole <Key-braceright> {
506 if {[string compare \\ [%W get insert-2c]]} {
507 ::tk::console::MatchPair %W \{ \} promptEnd
510 bind PostConsole <Key-quotedbl> {
511 if {[string compare \\ [%W get insert-2c]]} {
512 ::tk::console::MatchQuote %W promptEnd
516 bind PostConsole <KeyPress> {
518 ::tk::console::TagProc %W
524 # ::tk::ConsoleInsert --
525 # Insert a string into a text at the point of the insertion cursor.
526 # If there is a selection in the text, and it covers the point of the
527 # insertion cursor, then delete the selection before inserting. Insertion
528 # is restricted to the prompt area.
531 # w - The text window in which to insert the string
532 # s - The string to insert (usually just a single character)
534 proc ::tk::ConsoleInsert {w s} {
535 if {[string equal $s ""]} {
539 if {[$w compare sel.first <= insert]
540 && [$w compare sel.last >= insert]} {
541 $w tag remove sel sel.first promptEnd
542 $w delete sel.first sel.last
545 if {[$w compare insert < promptEnd]} {
546 $w mark set insert end
548 $w insert insert $s {input stdin}
552 # ::tk::ConsoleOutput --
554 # This routine is called directly by ConsolePutsCmd to cause a string
555 # to be displayed in the console.
558 # dest - The output tag to be used: either "stderr" or "stdout".
559 # string - The string to be displayed.
561 proc ::tk::ConsoleOutput {dest string} {
563 $w insert output $string $dest
564 ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
568 # ::tk::ConsoleExit --
570 # This routine is called by ConsoleEventProc when the main window of
571 # the application is destroyed. Don't call exit - that probably already
572 # happened. Just delete our window.
577 proc ::tk::ConsoleExit {} {
581 # ::tk::ConsoleAbout --
583 # This routine displays an About box to show Tcl/Tk version info.
588 proc ::tk::ConsoleAbout {} {
589 tk_messageBox -type ok -message "[mc {Tcl for Windows}]
591 Tcl $::tcl_patchLevel
595 # ::tk::console::TagProc --
597 # Tags a procedure in the console if it's recognized
598 # This procedure is not perfect. However, making it perfect wastes
599 # too much CPU time...
602 # w - console text widget
604 proc ::tk::console::TagProc w {
605 if {!$::tk::console::magicKeys} { return }
606 set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
607 set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
608 if {$i == ""} {set i promptEnd} else {append i +2c}
609 regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c
610 if {[llength [EvalAttached [list info commands $c]]]} {
611 $w tag add proc $i "insert-1c wordend"
613 $w tag remove proc $i "insert-1c wordend"
615 if {[llength [EvalAttached [list info vars $c]]]} {
616 $w tag add var $i "insert-1c wordend"
618 $w tag remove var $i "insert-1c wordend"
622 # ::tk::console::MatchPair --
624 # Blinks a matching pair of characters
625 # c2 is assumed to be at the text index 'insert'.
626 # This proc is really loopy and took me an hour to figure out given
627 # all possible combinations with escaping except for escaped \'s.
628 # It doesn't take into account possible commenting... Oh well. If
629 # anyone has something better, I'd like to see/use it. This is really
630 # only efficient for small contexts.
633 # w - console text widget
634 # c1 - first char of pair
635 # c2 - second char of pair
637 # Calls: ::tk::console::Blink
639 proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
640 if {!$::tk::console::magicKeys} { return }
641 if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} {
643 [string match {\\} [$w get $ix-1c]] &&
644 [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]]
647 while {[string compare {} $ix]} {
650 while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} {
652 if {[string match {\\} [$w get $i0-2c]]} continue
657 while {$j && [string compare {} \
658 [set ix [$w search -back $c1 $ix $lim]]]} {
659 if {[string match {\\} [$w get $ix-1c]]} continue
663 if {[string match {} $ix]} { set ix [$w index $lim] }
664 } else { set ix [$w index $lim] }
665 if {$::tk::console::blinkRange} {
666 Blink $w $ix [$w index insert]
668 Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert]
672 # ::tk::console::MatchQuote --
674 # Blinks between matching quotes.
675 # Blinks just the quote if it's unmatched, otherwise blinks quoted string
676 # The quote to match is assumed to be at the text index 'insert'.
679 # w - console text widget
681 # Calls: ::tk::console::Blink
683 proc ::tk::console::MatchQuote {w {lim 1.0}} {
684 if {!$::tk::console::magicKeys} { return }
687 while {[string compare [set i [$w search -back \" $i $lim]] {}]} {
688 if {[string match {\\} [$w get $i-1c]]} continue
693 if {$::tk::console::blinkRange} {
694 Blink $w $i0 [$w index insert]
696 Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert]
699 Blink $w [$w index insert-1c] [$w index insert]
703 # ::tk::console::Blink --
705 # Blinks between n index pairs for a specified duration.
708 # w - console text widget
709 # i1 - start index to blink region
710 # i2 - end index of blink region
711 # dur - duration in usecs to blink for
714 # blinks selected characters in $w
716 proc ::tk::console::Blink {w args} {
717 eval [list $w tag add blink] $args
718 after $::tk::console::blinkTime [list $w] tag remove blink $args
721 # ::tk::console::ConstrainBuffer --
723 # This limits the amount of data in the text widget
724 # Called by Prompt and ConsoleOutput
727 # w - console text widget
728 # size - # of lines to constrain to
731 # may delete data in console widget
733 proc ::tk::console::ConstrainBuffer {w size} {
734 if {[$w index end] > $size} {
735 $w delete 1.0 [expr {int([$w index end])-$size}].0
739 # ::tk::console::Expand --
742 # ARGS: w - text widget in which to expand str
743 # type - type of expansion (path / proc / variable)
745 # Calls: ::tk::console::Expand(Pathname|Procname|Variable)
747 # Outputs: The string to match is expanded to the longest possible match.
748 # If ::tk::console::showMatches is non-zero and the longest match
749 # equaled the string to expand, then all possible matches are
750 # output to stdout. Triggers bell if no matches are found.
752 # Returns: number of matches found
754 proc ::tk::console::Expand {w {type ""}} {
755 set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
756 set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
757 if {$tmp == ""} {set tmp promptEnd} else {append tmp +2c}
758 if {[$w compare $tmp >= insert]} { return }
759 set str [$w get $tmp insert]
761 path* { set res [ExpandPathname $str] }
762 proc* { set res [ExpandProcname $str] }
763 var* { set res [ExpandVariable $str] }
766 foreach t {Pathname Procname Variable} {
767 if {![catch {Expand$t $str} res] && ($res != "")} { break }
771 set len [llength $res]
773 set repl [lindex $res 0]
774 $w delete $tmp insert
775 $w insert $tmp $repl {input stdin}
776 if {($len > 1) && $::tk::console::showMatches \
777 && [string equal $repl $str]} {
778 puts stdout [lsort [lreplace $res 0 0]]
784 # ::tk::console::ExpandPathname --
786 # Expand a file pathname based on $str
787 # This is based on UNIX file name conventions
790 # str - partial file pathname to expand
792 # Calls: ::tk::console::ExpandBestMatch
794 # Returns: list containing longest unique match followed by all the
795 # possible further matches
797 proc ::tk::console::ExpandPathname str {
798 set pwd [EvalAttached pwd]
799 if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {
800 return -code error $err
802 set dir [file tail $str]
803 ## Check to see if it was known to be a directory and keep the trailing
804 ## slash if so (file tail cuts it off)
805 if {[string match */ $str]} { append dir / }
806 if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
809 if {[llength $m] > 1} {
811 if {[string match windows $tcl_platform(platform)]} {
812 ## Windows is screwy because it's case insensitive
813 set tmp [ExpandBestMatch [string tolower $m] \
814 [string tolower $dir]]
815 ## Don't change case if we haven't changed the word
816 if {[string length $dir]==[string length $tmp]} {
820 set tmp [ExpandBestMatch $m $dir]
822 if {[string match ?*/* $str]} {
823 set tmp [file dirname $str]/$tmp
824 } elseif {[string match /* $str]} {
827 regsub -all { } $tmp {\\ } tmp
828 set match [linsert $m 0 $tmp]
830 ## This may look goofy, but it handles spaces in path names
832 if {[file isdir $match]} {append match /}
833 if {[string match ?*/* $str]} {
834 set match [file dirname $str]/$match
835 } elseif {[string match /* $str]} {
838 regsub -all { } $match {\\ } match
839 ## Why is this one needed and the ones below aren't!!
840 set match [list $match]
843 EvalAttached [list cd $pwd]
847 # ::tk::console::ExpandProcname --
849 # Expand a tcl proc name based on $str
852 # str - partial proc name to expand
854 # Calls: ::tk::console::ExpandBestMatch
856 # Returns: list containing longest unique match followed by all the
857 # possible further matches
859 proc ::tk::console::ExpandProcname str {
860 set match [EvalAttached [list info commands $str*]]
861 if {[llength $match] == 0} {
862 set ns [EvalAttached \
863 "namespace children \[namespace current\] [list $str*]"]
864 if {[llength $ns]==1} {
865 set match [EvalAttached [list info commands ${ns}::*]]
870 if {[llength $match] > 1} {
871 regsub -all { } [ExpandBestMatch $match $str] {\\ } str
872 set match [linsert $match 0 $str]
874 regsub -all { } $match {\\ } match
879 # ::tk::console::ExpandVariable --
881 # Expand a tcl variable name based on $str
884 # str - partial tcl var name to expand
886 # Calls: ::tk::console::ExpandBestMatch
888 # Returns: list containing longest unique match followed by all the
889 # possible further matches
891 proc ::tk::console::ExpandVariable str {
892 if {[regexp {([^\(]*)\((.*)} $str junk ary str]} {
893 ## Looks like they're trying to expand an array.
894 set match [EvalAttached [list array names $ary $str*]]
895 if {[llength $match] > 1} {
896 set vars $ary\([ExpandBestMatch $match $str]
897 foreach var $match {lappend vars $ary\($var\)}
899 } else {set match $ary\($match\)}
900 ## Space transformation avoided for array names.
902 set match [EvalAttached [list info vars $str*]]
903 if {[llength $match] > 1} {
904 regsub -all { } [ExpandBestMatch $match $str] {\\ } str
905 set match [linsert $match 0 $str]
907 regsub -all { } $match {\\ } match
913 # ::tk::console::ExpandBestMatch --
915 # Finds the best unique match in a list of names.
916 # The extra $e in this argument allows us to limit the innermost loop a little
917 # further. This improves speed as $l becomes large or $e becomes long.
920 # l - list to find best unique match in
921 # e - currently best known unique match
923 # Returns: longest unique match in the list
925 proc ::tk::console::ExpandBestMatch {l {e {}}} {
927 if {[llength $l]>1} {
928 set e [string length $e]; incr e -1
929 set ei [string length $ec]; incr ei -1
931 while {$ei>=$e && [string first $ec $l]} {
932 set ec [string range $ec 0 [incr ei -1]]
939 # now initialize the console