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.37 2007/12/13 15:26:27 dgp Exp $
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>
13 # See the file "license.terms" for information on usage and redistribution
14 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
17 # TODO: history - remember partially written command
19 namespace 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
26 variable inPlugin
[info exists embed_args
]
27 variable defaultPrompt
; # default prompt if tcl_prompt1 isn't used
31 set defaultPrompt
{subst {[history nextid
] % }}
33 set defaultPrompt
{subst {([file tail
[pwd]]) [history nextid
] % }}
37 # simple compat function for tkcon code added for this console
38 interp alias
{} EvalAttached
{} consoleinterp
eval
40 # ::tk::ConsoleInit --
41 # This procedure constructs and configures the console windows.
46 proc ::tk::ConsoleInit {} {
49 if {![consoleinterp
eval {set tcl_interactive
}]} {
53 if {[tk windowingsystem
] eq
"aqua"} {
59 if {[catch {menu .menubar
} err
]} {
62 AmpMenuArgs .menubar add cascade
-label [mc
&File
] -menu .menubar.
file
63 AmpMenuArgs .menubar add cascade
-label [mc
&Edit
] -menu .menubar.edit
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
] eq
"aqua"} {
73 AmpMenuArgs .menubar.
file add command
\
74 -label [mc
&Quit
] -command {exit} -accel "Cmd-Q"
76 AmpMenuArgs .menubar.
file add command
-label [mc E
&xit
] -command {exit}
79 menu .menubar.edit
-tearoff 0
80 AmpMenuArgs .menubar.edit add command
-label [mc Cu
&t
] -accel "$mod+X"\
81 -command {event generate .
console <<Cut
>>}
82 AmpMenuArgs .menubar.edit add command
-label [mc
&Copy
] -accel "$mod+C"\
83 -command {event generate .
console <<Copy
>>}
84 AmpMenuArgs .menubar.edit add command
-label [mc P
&aste
] -accel "$mod+V"\
85 -command {event generate .
console <<Paste
>>}
87 if {$tcl_platform(platform
) ne
"windows"} {
88 AmpMenuArgs .menubar.edit add command
-label [mc Cl
&ear
] \
89 -command {event generate .
console <<Clear
>>}
91 AmpMenuArgs .menubar.edit add command
-label [mc
&Delete
] \
92 -command {event generate .
console <<Clear
>>} -accel "Del"
94 AmpMenuArgs .menubar add cascade
-label [mc
&Help
] -menu .menubar.help
95 menu .menubar.help
-tearoff 0
96 AmpMenuArgs .menubar.help add command
-label [mc
&About...
] \
97 -command tk::ConsoleAbout
100 AmpMenuArgs .menubar.edit add separator
101 AmpMenuArgs .menubar.edit add command
-label [mc
"&Increase Font Size"] \
102 -accel "$mod++" -command {event generate .
console <<Console_FontSizeIncr
>>}
103 AmpMenuArgs .menubar.edit add command
-label [mc
"&Decrease Font Size"] \
104 -accel "$mod+-" -command {event generate .
console <<Console_FontSizeDecr
>>}
106 . configure
-menu .menubar
108 # See if we can find a better font than the TkFixedFont
109 font create TkConsoleFont
{*}[font configure TkFixedFont
]
110 set families
[font families
]
111 switch -exact -- [tk windowingsystem
] {
112 aqua
{ set preferred
{Monaco
10} }
113 win32
{ set preferred
{ProFontWindows
8 Consolas
8} }
114 default { set preferred
{} }
116 foreach {family size
} $preferred {
117 if {[lsearch -exact $families $family] != -1} {
118 font configure TkConsoleFont
-family $family -size $size
123 # Provide the right border for the text widget (platform dependent).
124 ::ttk::style layout ConsoleFrame
{
125 Entry.field
-sticky news
-border 1 -children {
126 ConsoleFrame.padding
-sticky news
129 ::ttk::frame .consoleframe
-style ConsoleFrame
131 set con
[text .
console -yscrollcommand [list .sb
set] -setgrid true
\
132 -borderwidth 0 -highlightthickness 0 -font TkConsoleFont
]
133 if {[tk windowingsystem
] eq
"aqua"} {
134 scrollbar .sb
-command [list $con yview
]
136 ::ttk::scrollbar .sb
-command [list $con yview
]
138 pack .sb
-in .consoleframe
-fill both
-side right
-padx 1 -pady 1
139 pack $con -in .consoleframe
-fill both
-expand 1 -side left
-padx 1 -pady 1
140 pack .consoleframe
-fill both
-expand 1 -side left
144 $con tag configure stderr
-foreground red
145 $con tag configure stdin
-foreground blue
146 $con tag configure prompt
-foreground \#8F4433
147 $con tag configure
proc -foreground \#008800
148 $con tag configure var
-background \#FFC0D0
150 $con tag configure blink
-background \#FFFF00
151 $con tag configure find
-background \#FFFF00
155 # Avoid listing this console in [winfo interps]
156 if {[info command
::send] eq
"::send"} {rename ::send {}}
158 wm protocol . WM_DELETE_WINDOW
{ wm withdraw .
}
159 wm title .
[mc
"Console"]
161 $con mark
set output
[$con index
"end - 1 char"]
162 tk::TextSetCursor $con end
163 $con mark
set promptEnd insert
164 $con mark gravity promptEnd left
166 # A variant of ConsolePrompt to avoid a 'puts' call
168 set temp
[$w index
"end - 1 char"]
169 $w mark
set output end
170 if {![consoleinterp
eval "info exists tcl_prompt1"]} {
171 set string [EvalAttached
$::tk::console::defaultPrompt]
172 $w insert output
$string stdout
174 $w mark
set output
$temp
175 ::tk::TextSetCursor $w end
176 $w mark
set promptEnd insert
177 $w mark gravity promptEnd left
179 if {$tcl_platform(platform
) eq
"windows"} {
180 # Subtle work-around to erase the '% ' that tclMain.c prints out
181 after idle
[subst -nocommand {
182 if {[$con get
1.0 output
] eq
"% "} { $con delete
1.0 output
}
187 # ::tk::ConsoleSource --
189 # Prompts the user for a file to source in the main interpreter.
194 proc ::tk::ConsoleSource {} {
195 set filename [tk_getOpenFile -defaultextension .tcl
-parent .
\
196 -title [mc
"Select a file to source"] \
198 [list [mc
"Tcl Scripts"] .tcl
] \
199 [list [mc
"All Files"] *]]]
200 if {$filename ne
""} {
201 set cmd
[list source $filename]
202 if {[catch {consoleinterp
eval $cmd} result
]} {
203 ConsoleOutput stderr
"$result\n"
208 # ::tk::ConsoleInvoke --
209 # Processes the command line input. If the command is complete it
210 # is evaled in the main interpreter. Otherwise, the continuation
211 # prompt is added and more input may be added.
216 proc ::tk::ConsoleInvoke {args
} {
217 set ranges
[.
console tag ranges input
]
219 if {[llength $ranges]} {
221 while {[lindex $ranges $pos] ne
""} {
222 set start
[lindex $ranges $pos]
223 set end
[lindex $ranges [incr pos
]]
224 append cmd
[.
console get
$start $end]
230 } elseif
{[info complete
$cmd]} {
231 .
console mark
set output end
232 .
console tag delete input
233 set result
[consoleinterp record
$cmd]
240 ConsolePrompt partial
242 .
console yview
-pickplace insert
245 # ::tk::ConsoleHistory --
246 # This procedure implements command line history for the
247 # console. In general is evals the history command in the
248 # main interpreter to obtain the history. The variable
249 # ::tk::HistNum is used to store the current location in the history.
252 # cmd - Which action to take: prev, next, reset.
255 proc ::tk::ConsoleHistory {cmd
} {
262 set cmd
{history event [expr {[history nextid
] -1}]}
264 set cmd
"history event $HistNum"
266 if {[catch {consoleinterp
eval $cmd} cmd
]} {
270 .
console delete promptEnd end
271 .
console insert promptEnd
$cmd {input stdin
}
276 set cmd
{history event [expr {[history nextid
] -1}]}
277 } elseif
{$HistNum > 0} {
281 set cmd
"history event $HistNum"
284 catch {consoleinterp
eval $cmd} cmd
286 .
console delete promptEnd end
287 .
console insert promptEnd
$cmd {input stdin
}
295 # ::tk::ConsolePrompt --
296 # This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2
297 # exists in the main interpreter it will be called to generate the
298 # prompt. Otherwise, a hard coded default prompt is printed.
301 # partial - Flag to specify which prompt to print.
303 proc ::tk::ConsolePrompt {{partial normal
}} {
305 if {$partial eq
"normal"} {
306 set temp
[$w index
"end - 1 char"]
307 $w mark
set output end
308 if {[consoleinterp
eval "info exists tcl_prompt1"]} {
309 consoleinterp
eval "eval \[set tcl_prompt1\]"
311 puts -nonewline [EvalAttached
$::tk::console::defaultPrompt]
314 set temp
[$w index output
]
315 $w mark
set output end
316 if {[consoleinterp
eval "info exists tcl_prompt2"]} {
317 consoleinterp
eval "eval \[set tcl_prompt2\]"
323 $w mark
set output
$temp
324 ::tk::TextSetCursor $w end
325 $w mark
set promptEnd insert
326 $w mark gravity promptEnd left
327 ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
331 # ::tk::ConsoleBind --
332 # This procedure first ensures that the default bindings for the Text
333 # class have been defined. Then certain bindings are overridden for
339 proc ::tk::ConsoleBind {w
} {
340 bindtags $w [list $w Console PostConsole
[winfo toplevel $w] all
]
342 ## Get all Text bindings into Console
343 foreach ev
[bind Text
] {
344 bind Console
$ev [bind Text
$ev]
346 ## We really didn't want the newline insertion...
347 bind Console
<Control-Key-o
> {}
348 ## ...or any Control-v binding (would block <<Paste>>)
349 bind Console
<Control-Key-v
> {}
351 # For the moment, transpose isn't enabled until the console
352 # gets and overhaul of how it handles input -- hobbs
353 bind Console
<Control-Key-t
> {}
355 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
356 # Otherwise, if a widget binding for one of these is defined, the
358 bind Console
<Alt-KeyPress
> {# nothing }
359 bind Console
<Meta-KeyPress
> {# nothing}
360 bind Console
<Control-KeyPress
> {# nothing}
363 <<Console_Prev
>> <Key-Up
>
364 <<Console_Next
>> <Key-Down
>
365 <<Console_NextImmediate
>> <Control-Key-n
>
366 <<Console_PrevImmediate
>> <Control-Key-p
>
367 <<Console_PrevSearch
>> <Control-Key-r
>
368 <<Console_NextSearch
>> <Control-Key-s
>
370 <<Console_Expand
>> <Key-Tab
>
371 <<Console_Expand
>> <Key-Escape
>
372 <<Console_ExpandFile
>> <Control-Shift-Key-F
>
373 <<Console_ExpandProc
>> <Control-Shift-Key-P
>
374 <<Console_ExpandVar
>> <Control-Shift-Key-V
>
375 <<Console_Tab
>> <Control-Key-i
>
376 <<Console_Tab
>> <Meta-Key-i
>
377 <<Console_Eval
>> <Key-Return
>
378 <<Console_Eval
>> <Key-KP_Enter
>
380 <<Console_Clear
>> <Control-Key-l
>
381 <<Console_KillLine
>> <Control-Key-k
>
382 <<Console_Transpose
>> <Control-Key-t
>
383 <<Console_ClearLine
>> <Control-Key-u
>
384 <<Console_SaveCommand
>> <Control-Key-z
>
385 <<Console_FontSizeIncr
>> <Control-Key-plus
>
386 <<Console_FontSizeDecr
>> <Control-Key-minus
>
391 if {[tk windowingsystem
] eq
"aqua"} {
393 <<Console_FontSizeIncr
>> <Command-Key-plus
>
394 <<Console_FontSizeDecr
>> <Command-Key-minus
>
400 bind Console
<<Console_Expand
>> {
401 if {[%W compare insert
> promptEnd
]} {
402 ::tk::console::Expand %W
405 bind Console
<<Console_ExpandFile
>> {
406 if {[%W compare insert
> promptEnd
]} {
407 ::tk::console::Expand %W path
410 bind Console
<<Console_ExpandProc
>> {
411 if {[%W compare insert
> promptEnd
]} {
412 ::tk::console::Expand %W
proc
415 bind Console
<<Console_ExpandVar
>> {
416 if {[%W compare insert
> promptEnd
]} {
417 ::tk::console::Expand %W var
420 bind Console
<<Console_Eval
>> {
421 %W mark
set insert
{end
- 1c
}
422 tk::ConsoleInsert %W
"\n"
426 bind Console
<Delete
> {
427 if {{} ne
[%W tag nextrange sel
1.0 end
] \
428 && [%W compare sel.first
>= promptEnd
]} {
429 %W delete sel.first sel.last
430 } elseif
{[%W compare insert
>= promptEnd
]} {
435 bind Console
<BackSpace
> {
436 if {{} ne
[%W tag nextrange sel
1.0 end
] \
437 && [%W compare sel.first
>= promptEnd
]} {
438 %W delete sel.first sel.last
439 } elseif
{[%W compare insert
!= 1.0] && \
440 [%W compare insert
> promptEnd
]} {
445 bind Console
<Control-h
> [bind Console
<BackSpace
>]
447 bind Console
<Home
> {
448 if {[%W compare insert
< promptEnd
]} {
449 tk::TextSetCursor %W
{insert linestart
}
451 tk::TextSetCursor %W promptEnd
454 bind Console
<Control-a
> [bind Console
<Home
>]
456 tk::TextSetCursor %W
{insert lineend
}
458 bind Console
<Control-e
> [bind Console
<End
>]
459 bind Console
<Control-d
> {
460 if {[%W compare insert
< promptEnd
]} {
465 bind Console
<<Console_KillLine
>> {
466 if {[%W compare insert
< promptEnd
]} {
469 if {[%W compare insert
== {insert lineend
}]} {
472 %W delete insert
{insert lineend
}
475 bind Console
<<Console_Clear
>> {
476 ## Clear console display
477 %W delete
1.0 "promptEnd linestart"
479 bind Console
<<Console_ClearLine
>> {
480 ## Clear command line (Unix shell staple)
481 %W delete promptEnd end
483 bind Console
<Meta-d
> {
484 if {[%W compare insert
>= promptEnd
]} {
485 %W delete insert
{insert wordend
}
488 bind Console
<Meta-BackSpace
> {
489 if {[%W compare
{insert
-1c wordstart
} >= promptEnd
]} {
490 %W delete
{insert
-1c wordstart
} insert
493 bind Console
<Meta-d
> {
494 if {[%W compare insert
>= promptEnd
]} {
495 %W delete insert
{insert wordend
}
498 bind Console
<Meta-BackSpace
> {
499 if {[%W compare
{insert
-1c wordstart
} >= promptEnd
]} {
500 %W delete
{insert
-1c wordstart
} insert
503 bind Console
<Meta-Delete
> {
504 if {[%W compare insert
>= promptEnd
]} {
505 %W delete insert
{insert wordend
}
508 bind Console
<<Console_Prev
>> {
509 tk::ConsoleHistory prev
511 bind Console
<<Console_Next
>> {
512 tk::ConsoleHistory next
514 bind Console
<Insert
> {
515 catch {tk::ConsoleInsert %W
[::tk::GetSelection %W PRIMARY
]}
517 bind Console
<KeyPress
> {
518 tk::ConsoleInsert %W
%A
521 eval destroy [winfo child .
]
522 source [file join $tk_library console.tcl
]
524 if {[tk windowingsystem
] eq
"aqua"} {
525 bind Console
<Command-q
> {
529 bind Console
<<Cut
>> {
530 # Same as the copy event
531 if {![catch {set data
[%W get sel.first sel.last
]}]} {
532 clipboard clear
-displayof %W
533 clipboard append -displayof %W
$data
536 bind Console
<<Copy
>> {
537 if {![catch {set data
[%W get sel.first sel.last
]}]} {
538 clipboard clear
-displayof %W
539 clipboard append -displayof %W
$data
542 bind Console
<<Paste
>> {
544 set clip
[::tk::GetSelection %W CLIPBOARD
]
545 set list [split $clip \n\r]
546 tk::ConsoleInsert %W
[lindex $list 0]
547 foreach x
[lrange $list 1 end
] {
548 %W mark
set insert
{end
- 1c
}
549 tk::ConsoleInsert %W
"\n"
551 tk::ConsoleInsert %W
$x
555 bind Console
<<Console_FontSizeIncr
>> {
556 set size
[font configure TkConsoleFont
-size]
557 font configure TkConsoleFont
-size [incr size
]
559 bind Console
<<Console_FontSizeDecr
>> {
560 set size
[font configure TkConsoleFont
-size]
561 font configure TkConsoleFont
-size [incr size
-1]
565 ## Bindings for doing special things based on certain keys
567 bind PostConsole
<Key-parenright
> {
568 if {"\\" ne
[%W get insert-2c
]} {
569 ::tk::console::MatchPair %W
\( \) promptEnd
572 bind PostConsole
<Key-bracketright
> {
573 if {"\\" ne
[%W get insert-2c
]} {
574 ::tk::console::MatchPair %W
\[ \] promptEnd
577 bind PostConsole
<Key-braceright
> {
578 if {"\\" ne
[%W get insert-2c
]} {
579 ::tk::console::MatchPair %W
\{ \} promptEnd
582 bind PostConsole
<Key-quotedbl
> {
583 if {"\\" ne
[%W get insert-2c
]} {
584 ::tk::console::MatchQuote %W promptEnd
588 bind PostConsole
<KeyPress
> {
590 ::tk::console::TagProc %W
596 # ::tk::ConsoleInsert --
597 # Insert a string into a text at the point of the insertion cursor.
598 # If there is a selection in the text, and it covers the point of the
599 # insertion cursor, then delete the selection before inserting. Insertion
600 # is restricted to the prompt area.
603 # w - The text window in which to insert the string
604 # s - The string to insert (usually just a single character)
606 proc ::tk::ConsoleInsert {w s
} {
611 if {[$w compare sel.first
<= insert
] \
612 && [$w compare sel.last
>= insert
]} {
613 $w tag remove sel sel.first promptEnd
614 $w delete sel.first sel.last
617 if {[$w compare insert
< promptEnd
]} {
618 $w mark
set insert end
620 $w insert insert
$s {input stdin
}
624 # ::tk::ConsoleOutput --
626 # This routine is called directly by ConsolePutsCmd to cause a string
627 # to be displayed in the console.
630 # dest - The output tag to be used: either "stderr" or "stdout".
631 # string - The string to be displayed.
633 proc ::tk::ConsoleOutput {dest
string} {
635 $w insert output
$string $dest
636 ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
640 # ::tk::ConsoleExit --
642 # This routine is called by ConsoleEventProc when the main window of
643 # the application is destroyed. Don't call exit - that probably already
644 # happened. Just delete our window.
649 proc ::tk::ConsoleExit {} {
653 # ::tk::ConsoleAbout --
655 # This routine displays an About box to show Tcl/Tk version info.
660 proc ::tk::ConsoleAbout {} {
661 tk_messageBox -type ok
-message "[mc {Tcl for Windows}]
663 Tcl $::tcl_patchLevel
667 # ::tk::console::TagProc --
669 # Tags a procedure in the console if it's recognized
670 # This procedure is not perfect. However, making it perfect wastes
671 # too much CPU time...
674 # w - console text widget
676 proc ::tk::console::TagProc w
{
677 if {!$::tk::console::magicKeys} {
680 set exp
"\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
681 set i
[$w search
-backwards -regexp $exp insert-1c promptEnd-1c
]
687 regsub -all "\[\[\\\\\\?\\*\]" [$w get
$i "insert-1c wordend"] {\\\0} c
688 if {[llength [EvalAttached
[list info commands
$c]]]} {
689 $w tag add
proc $i "insert-1c wordend"
691 $w tag remove
proc $i "insert-1c wordend"
693 if {[llength [EvalAttached
[list info vars
$c]]]} {
694 $w tag add var
$i "insert-1c wordend"
696 $w tag remove var
$i "insert-1c wordend"
700 # ::tk::console::MatchPair --
702 # Blinks a matching pair of characters
703 # c2 is assumed to be at the text index 'insert'.
704 # This proc is really loopy and took me an hour to figure out given
705 # all possible combinations with escaping except for escaped \'s.
706 # It doesn't take into account possible commenting... Oh well. If
707 # anyone has something better, I'd like to see/use it. This is really
708 # only efficient for small contexts.
711 # w - console text widget
712 # c1 - first char of pair
713 # c2 - second char of pair
715 # Calls: ::tk::console::Blink
717 proc ::tk::console::MatchPair {w c1 c2
{lim
1.0}} {
718 if {!$::tk::console::magicKeys} {
721 if {{} ne
[set ix
[$w search
-back $c1 insert
$lim]]} {
723 [string match
{\\} [$w get
$ix-1c
]] &&
724 [set ix
[$w search
-back $c1 $ix-1c
$lim]] ne
{}
730 while {[set i0
[$w search
$c2 $i0 $i1]] ne
{}} {
732 if {[string match
{\\} [$w get
$i0-2c
]]} {
741 while {$j && [set ix
[$w search
-back $c1 $ix $lim]] ne
{}} {
742 if {[string match
{\\} [$w get
$ix-1c
]]} {
748 if {[string match
{} $ix]} {
749 set ix
[$w index
$lim]
752 set ix
[$w index
$lim]
754 if {$::tk::console::blinkRange} {
755 Blink
$w $ix [$w index insert
]
757 Blink
$w $ix $ix+1c
[$w index insert-1c
] [$w index insert
]
761 # ::tk::console::MatchQuote --
763 # Blinks between matching quotes.
764 # Blinks just the quote if it's unmatched, otherwise blinks quoted string
765 # The quote to match is assumed to be at the text index 'insert'.
768 # w - console text widget
770 # Calls: ::tk::console::Blink
772 proc ::tk::console::MatchQuote {w
{lim
1.0}} {
773 if {!$::tk::console::magicKeys} {
778 while {[set i
[$w search
-back \" $i $lim]] ne
{}} {
779 if {[string match
{\\} [$w get
$i-1c
]]} {
788 if {$::tk::console::blinkRange} {
789 Blink
$w $i0 [$w index insert
]
791 Blink
$w $i0 $i0+1c
[$w index insert-1c
] [$w index insert
]
794 Blink
$w [$w index insert-1c
] [$w index insert
]
798 # ::tk::console::Blink --
800 # Blinks between n index pairs for a specified duration.
803 # w - console text widget
804 # i1 - start index to blink region
805 # i2 - end index of blink region
806 # dur - duration in usecs to blink for
809 # blinks selected characters in $w
811 proc ::tk::console::Blink {w args
} {
812 eval [list $w tag add blink
] $args
813 after $::tk::console::blinkTime [list $w] tag remove blink
$args
816 # ::tk::console::ConstrainBuffer --
818 # This limits the amount of data in the text widget
819 # Called by Prompt and ConsoleOutput
822 # w - console text widget
823 # size - # of lines to constrain to
826 # may delete data in console widget
828 proc ::tk::console::ConstrainBuffer {w size
} {
829 if {[$w index end
] > $size} {
830 $w delete
1.0 [expr {int
([$w index end
])-$size}].0
834 # ::tk::console::Expand --
837 # ARGS: w - text widget in which to expand str
838 # type - type of expansion (path / proc / variable)
840 # Calls: ::tk::console::Expand(Pathname|Procname|Variable)
842 # Outputs: The string to match is expanded to the longest possible match.
843 # If ::tk::console::showMatches is non-zero and the longest match
844 # equaled the string to expand, then all possible matches are
845 # output to stdout. Triggers bell if no matches are found.
847 # Returns: number of matches found
849 proc ::tk::console::Expand {w
{type
""}} {
850 set exp
"\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
851 set tmp
[$w search
-backwards -regexp $exp insert-1c promptEnd-1c
]
857 if {[$w compare
$tmp >= insert
]} {
860 set str
[$w get
$tmp insert
]
863 set res
[ExpandPathname
$str]
866 set res
[ExpandProcname
$str]
869 set res
[ExpandVariable
$str]
873 foreach t
{Pathname Procname Variable
} {
874 if {![catch {Expand
$t $str} res
] && ($res ne
"")} {
880 set len
[llength $res]
882 set repl
[lindex $res 0]
883 $w delete
$tmp insert
884 $w insert
$tmp $repl {input stdin
}
885 if {($len > 1) && ($::tk::console::showMatches) && ($repl eq
$str)} {
886 puts stdout
[lsort [lreplace $res 0 0]]
894 # ::tk::console::ExpandPathname --
896 # Expand a file pathname based on $str
897 # This is based on UNIX file name conventions
900 # str - partial file pathname to expand
902 # Calls: ::tk::console::ExpandBestMatch
904 # Returns: list containing longest unique match followed by all the
905 # possible further matches
907 proc ::tk::console::ExpandPathname str
{
908 set pwd [EvalAttached
pwd]
909 if {[catch {EvalAttached
[list cd [file dirname
$str]]} err
]} {
910 return -code error $err
912 set dir
[file tail
$str]
913 ## Check to see if it was known to be a directory and keep the trailing
914 ## slash if so (file tail cuts it off)
915 if {[string match
*/ $str]} {
918 if {[catch {lsort [EvalAttached
[list glob $dir*]]} m
]} {
921 if {[llength $m] > 1} {
923 if {[string match windows
$tcl_platform(platform
)]} {
924 ## Windows is screwy because it's case insensitive
925 set tmp
[ExpandBestMatch
[string tolower
$m] \
926 [string tolower
$dir]]
927 ## Don't change case if we haven't changed the word
928 if {[string length
$dir]==[string length
$tmp]} {
932 set tmp
[ExpandBestMatch
$m $dir]
934 if {[string match ?
*/* $str]} {
935 set tmp
[file dirname
$str]/$tmp
936 } elseif
{[string match
/* $str]} {
939 regsub -all { } $tmp {\\ } tmp
940 set match
[linsert $m 0 $tmp]
942 ## This may look goofy, but it handles spaces in path names
944 if {[file isdir
$match]} {
947 if {[string match ?
*/* $str]} {
948 set match
[file dirname
$str]/$match
949 } elseif
{[string match
/* $str]} {
952 regsub -all { } $match {\\ } match
953 ## Why is this one needed and the ones below aren't!!
954 set match
[list $match]
957 EvalAttached
[list cd $pwd]
961 # ::tk::console::ExpandProcname --
963 # Expand a tcl proc name based on $str
966 # str - partial proc name to expand
968 # Calls: ::tk::console::ExpandBestMatch
970 # Returns: list containing longest unique match followed by all the
971 # possible further matches
973 proc ::tk::console::ExpandProcname str
{
974 set match
[EvalAttached
[list info commands
$str*]]
975 if {[llength $match] == 0} {
976 set ns
[EvalAttached
\
977 "namespace children \[namespace current\] [list $str*]"]
978 if {[llength $ns]==1} {
979 set match
[EvalAttached
[list info commands
${ns
}::*]]
984 if {[llength $match] > 1} {
985 regsub -all { } [ExpandBestMatch
$match $str] {\\ } str
986 set match
[linsert $match 0 $str]
988 regsub -all { } $match {\\ } match
993 # ::tk::console::ExpandVariable --
995 # Expand a tcl variable name based on $str
998 # str - partial tcl var name to expand
1000 # Calls: ::tk::console::ExpandBestMatch
1002 # Returns: list containing longest unique match followed by all the
1003 # possible further matches
1005 proc ::tk::console::ExpandVariable str
{
1006 if {[regexp {([^
\(]*)\((.
*)} $str -> ary str
]} {
1007 ## Looks like they're trying to expand an array.
1008 set match
[EvalAttached
[list array names
$ary $str*]]
1009 if {[llength $match] > 1} {
1010 set vars
$ary\([ExpandBestMatch
$match $str]
1011 foreach var
$match {
1012 lappend vars
$ary\($var\)
1015 } elseif
{[llength $match] == 1} {
1016 set match
$ary\($match\)
1018 ## Space transformation avoided for array names.
1020 set match
[EvalAttached
[list info vars
$str*]]
1021 if {[llength $match] > 1} {
1022 regsub -all { } [ExpandBestMatch
$match $str] {\\ } str
1023 set match
[linsert $match 0 $str]
1025 regsub -all { } $match {\\ } match
1031 # ::tk::console::ExpandBestMatch --
1033 # Finds the best unique match in a list of names.
1034 # The extra $e in this argument allows us to limit the innermost loop a little
1035 # further. This improves speed as $l becomes large or $e becomes long.
1038 # l - list to find best unique match in
1039 # e - currently best known unique match
1041 # Returns: longest unique match in the list
1043 proc ::tk::console::ExpandBestMatch {l
{e
{}}} {
1044 set ec
[lindex $l 0]
1045 if {[llength $l]>1} {
1046 set e
[expr {[string length
$e] - 1}]
1047 set ei
[expr {[string length
$ec] - 1}]
1049 while {$ei>=$e && [string first
$ec $l]} {
1050 set ec
[string range
$ec 0 [incr ei
-1]]
1057 # now initialize the console