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.2.3 2010/01/04 21:34:12 patthoyts 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
] ne
"aqua"} {
73 AmpMenuArgs .menubar.
file add command
-label [mc E
&xit
] -command {exit}
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
>>}
84 if {$tcl_platform(platform
) ne
"windows"} {
85 AmpMenuArgs .menubar.edit add command
-label [mc Cl
&ear
] \
86 -command {event generate .
console <<Clear
>>}
88 AmpMenuArgs .menubar.edit add command
-label [mc
&Delete
] \
89 -command {event generate .
console <<Clear
>>} -accel "Del"
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
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
>>}
103 . configure
-menu .menubar
105 # See if we can find a better font than the TkFixedFont
106 catch {font create TkConsoleFont
{*}[font configure TkFixedFont
]}
107 set families
[font families
]
108 switch -exact -- [tk windowingsystem
] {
109 aqua
{ set preferred
{Monaco
10} }
110 win32
{ set preferred
{ProFontWindows
8 Consolas
8} }
111 default { set preferred
{} }
113 foreach {family size
} $preferred {
114 if {[lsearch -exact $families $family] != -1} {
115 font configure TkConsoleFont
-family $family -size $size
120 # Provide the right border for the text widget (platform dependent).
121 ::ttk::style layout ConsoleFrame
{
122 Entry.field
-sticky news
-border 1 -children {
123 ConsoleFrame.padding
-sticky news
126 ::ttk::frame .consoleframe
-style ConsoleFrame
128 set con
[text .
console -yscrollcommand [list .sb
set] -setgrid true
\
129 -borderwidth 0 -highlightthickness 0 -font TkConsoleFont
]
130 if {[tk windowingsystem
] eq
"aqua"} {
131 scrollbar .sb
-command [list $con yview
]
133 ::ttk::scrollbar .sb
-command [list $con yview
]
135 pack .sb
-in .consoleframe
-fill both
-side right
-padx 1 -pady 1
136 pack $con -in .consoleframe
-fill both
-expand 1 -side left
-padx 1 -pady 1
137 pack .consoleframe
-fill both
-expand 1 -side left
141 $con tag configure stderr
-foreground red
142 $con tag configure stdin
-foreground blue
143 $con tag configure prompt
-foreground \#8F4433
144 $con tag configure
proc -foreground \#008800
145 $con tag configure var
-background \#FFC0D0
147 $con tag configure blink
-background \#FFFF00
148 $con tag configure find
-background \#FFFF00
152 # Avoid listing this console in [winfo interps]
153 if {[info command
::send] eq
"::send"} {rename ::send {}}
155 wm protocol . WM_DELETE_WINDOW
{ wm withdraw .
}
156 wm title .
[mc
"Console"]
158 $con mark
set output
[$con index
"end - 1 char"]
159 tk::TextSetCursor $con end
160 $con mark
set promptEnd insert
161 $con mark gravity promptEnd left
163 # A variant of ConsolePrompt to avoid a 'puts' call
165 set temp
[$w index
"end - 1 char"]
166 $w mark
set output end
167 if {![consoleinterp
eval "info exists tcl_prompt1"]} {
168 set string [EvalAttached
$::tk::console::defaultPrompt]
169 $w insert output
$string stdout
171 $w mark
set output
$temp
172 ::tk::TextSetCursor $w end
173 $w mark
set promptEnd insert
174 $w mark gravity promptEnd left
176 if {$tcl_platform(platform
) eq
"windows"} {
177 # Subtle work-around to erase the '% ' that tclMain.c prints out
178 after idle
[subst -nocommand {
179 if {[$con get
1.0 output
] eq
"% "} { $con delete
1.0 output
}
184 # ::tk::ConsoleSource --
186 # Prompts the user for a file to source in the main interpreter.
191 proc ::tk::ConsoleSource {} {
192 set filename [tk_getOpenFile -defaultextension .tcl
-parent .
\
193 -title [mc
"Select a file to source"] \
195 [list [mc
"Tcl Scripts"] .tcl
] \
196 [list [mc
"All Files"] *]]]
197 if {$filename ne
""} {
198 set cmd
[list source $filename]
199 if {[catch {consoleinterp
eval $cmd} result
]} {
200 ConsoleOutput stderr
"$result\n"
205 # ::tk::ConsoleInvoke --
206 # Processes the command line input. If the command is complete it
207 # is evaled in the main interpreter. Otherwise, the continuation
208 # prompt is added and more input may be added.
213 proc ::tk::ConsoleInvoke {args
} {
214 set ranges
[.
console tag ranges input
]
216 if {[llength $ranges]} {
218 while {[lindex $ranges $pos] ne
""} {
219 set start
[lindex $ranges $pos]
220 set end
[lindex $ranges [incr pos
]]
221 append cmd
[.
console get
$start $end]
227 } elseif
{[info complete
$cmd]} {
228 .
console mark
set output end
229 .
console tag delete input
230 set result
[consoleinterp record
$cmd]
237 ConsolePrompt partial
239 .
console yview
-pickplace insert
242 # ::tk::ConsoleHistory --
243 # This procedure implements command line history for the
244 # console. In general is evals the history command in the
245 # main interpreter to obtain the history. The variable
246 # ::tk::HistNum is used to store the current location in the history.
249 # cmd - Which action to take: prev, next, reset.
252 proc ::tk::ConsoleHistory {cmd
} {
259 set cmd
{history event [expr {[history nextid
] -1}]}
261 set cmd
"history event $HistNum"
263 if {[catch {consoleinterp
eval $cmd} cmd
]} {
267 .
console delete promptEnd end
268 .
console insert promptEnd
$cmd {input stdin
}
273 set cmd
{history event [expr {[history nextid
] -1}]}
274 } elseif
{$HistNum > 0} {
278 set cmd
"history event $HistNum"
281 catch {consoleinterp
eval $cmd} cmd
283 .
console delete promptEnd end
284 .
console insert promptEnd
$cmd {input stdin
}
292 # ::tk::ConsolePrompt --
293 # This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2
294 # exists in the main interpreter it will be called to generate the
295 # prompt. Otherwise, a hard coded default prompt is printed.
298 # partial - Flag to specify which prompt to print.
300 proc ::tk::ConsolePrompt {{partial normal
}} {
302 if {$partial eq
"normal"} {
303 set temp
[$w index
"end - 1 char"]
304 $w mark
set output end
305 if {[consoleinterp
eval "info exists tcl_prompt1"]} {
306 consoleinterp
eval "eval \[set tcl_prompt1\]"
308 puts -nonewline [EvalAttached
$::tk::console::defaultPrompt]
311 set temp
[$w index output
]
312 $w mark
set output end
313 if {[consoleinterp
eval "info exists tcl_prompt2"]} {
314 consoleinterp
eval "eval \[set tcl_prompt2\]"
320 $w mark
set output
$temp
321 ::tk::TextSetCursor $w end
322 $w mark
set promptEnd insert
323 $w mark gravity promptEnd left
324 ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
328 # Copy selected text from the console
329 proc ::tk::console::Copy {w
} {
330 if {![catch {set data
[$w get sel.first sel.last
]}]} {
331 clipboard clear
-displayof $w
332 clipboard append -displayof $w $data
335 # Copies selected text. If the selection is within the current active edit
336 # region then it will be cut, if not it is only copied.
337 proc ::tk::console::Cut {w
} {
338 if {![catch {set data
[$w get sel.first sel.last
]}]} {
339 clipboard clear
-displayof $w
340 clipboard append -displayof $w $data
341 if {[$w compare sel.first
>= output
]} {
342 $w delete sel.first sel.last
346 # Paste text from the clipboard
347 proc ::tk::console::Paste {w
} {
349 set clip
[::tk::GetSelection $w CLIPBOARD
]
350 set list [split $clip \n\r]
351 tk::ConsoleInsert $w [lindex $list 0]
352 foreach x
[lrange $list 1 end
] {
353 $w mark
set insert
{end
- 1c
}
354 tk::ConsoleInsert $w "\n"
356 tk::ConsoleInsert $w $x
361 # ::tk::ConsoleBind --
362 # This procedure first ensures that the default bindings for the Text
363 # class have been defined. Then certain bindings are overridden for
369 proc ::tk::ConsoleBind {w
} {
370 bindtags $w [list $w Console PostConsole
[winfo toplevel $w] all
]
372 ## Get all Text bindings into Console
373 foreach ev
[bind Text
] {
374 bind Console
$ev [bind Text
$ev]
376 ## We really didn't want the newline insertion...
377 bind Console
<Control-Key-o
> {}
378 ## ...or any Control-v binding (would block <<Paste>>)
379 bind Console
<Control-Key-v
> {}
381 # For the moment, transpose isn't enabled until the console
382 # gets and overhaul of how it handles input -- hobbs
383 bind Console
<Control-Key-t
> {}
385 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
386 # Otherwise, if a widget binding for one of these is defined, the
387 # <Keypress> class binding will also fire and insert the character
390 bind Console
<Alt-KeyPress
> {# nothing }
391 bind Console
<Meta-KeyPress
> {# nothing}
392 bind Console
<Control-KeyPress
> {# nothing}
395 <<Console_Prev
>> <Key-Up
>
396 <<Console_Next
>> <Key-Down
>
397 <<Console_NextImmediate
>> <Control-Key-n
>
398 <<Console_PrevImmediate
>> <Control-Key-p
>
399 <<Console_PrevSearch
>> <Control-Key-r
>
400 <<Console_NextSearch
>> <Control-Key-s
>
402 <<Console_Expand
>> <Key-Tab
>
403 <<Console_Expand
>> <Key-Escape
>
404 <<Console_ExpandFile
>> <Control-Shift-Key-F
>
405 <<Console_ExpandProc
>> <Control-Shift-Key-P
>
406 <<Console_ExpandVar
>> <Control-Shift-Key-V
>
407 <<Console_Tab
>> <Control-Key-i
>
408 <<Console_Tab
>> <Meta-Key-i
>
409 <<Console_Eval
>> <Key-Return
>
410 <<Console_Eval
>> <Key-KP_Enter
>
412 <<Console_Clear
>> <Control-Key-l
>
413 <<Console_KillLine
>> <Control-Key-k
>
414 <<Console_Transpose
>> <Control-Key-t
>
415 <<Console_ClearLine
>> <Control-Key-u
>
416 <<Console_SaveCommand
>> <Control-Key-z
>
417 <<Console_FontSizeIncr
>> <Control-Key-plus
>
418 <<Console_FontSizeDecr
>> <Control-Key-minus
>
423 if {[tk windowingsystem
] eq
"aqua"} {
425 <<Console_FontSizeIncr
>> <Command-Key-plus
>
426 <<Console_FontSizeDecr
>> <Command-Key-minus
>
432 bind Console
<<Console_Expand
>> {
433 if {[%W compare insert
> promptEnd
]} {
434 ::tk::console::Expand %W
437 bind Console
<<Console_ExpandFile
>> {
438 if {[%W compare insert
> promptEnd
]} {
439 ::tk::console::Expand %W path
442 bind Console
<<Console_ExpandProc
>> {
443 if {[%W compare insert
> promptEnd
]} {
444 ::tk::console::Expand %W
proc
447 bind Console
<<Console_ExpandVar
>> {
448 if {[%W compare insert
> promptEnd
]} {
449 ::tk::console::Expand %W var
452 bind Console
<<Console_Eval
>> {
453 %W mark
set insert
{end
- 1c
}
454 tk::ConsoleInsert %W
"\n"
458 bind Console
<Delete
> {
459 if {{} ne
[%W tag nextrange sel
1.0 end
] \
460 && [%W compare sel.first
>= promptEnd
]} {
461 %W delete sel.first sel.last
462 } elseif
{[%W compare insert
>= promptEnd
]} {
467 bind Console
<BackSpace
> {
468 if {{} ne
[%W tag nextrange sel
1.0 end
] \
469 && [%W compare sel.first
>= promptEnd
]} {
470 %W delete sel.first sel.last
471 } elseif
{[%W compare insert
!= 1.0] && \
472 [%W compare insert
> promptEnd
]} {
477 bind Console
<Control-h
> [bind Console
<BackSpace
>]
479 bind Console
<Home
> {
480 if {[%W compare insert
< promptEnd
]} {
481 tk::TextSetCursor %W
{insert linestart
}
483 tk::TextSetCursor %W promptEnd
486 bind Console
<Control-a
> [bind Console
<Home
>]
488 tk::TextSetCursor %W
{insert lineend
}
490 bind Console
<Control-e
> [bind Console
<End
>]
491 bind Console
<Control-d
> {
492 if {[%W compare insert
< promptEnd
]} {
497 bind Console
<<Console_KillLine
>> {
498 if {[%W compare insert
< promptEnd
]} {
501 if {[%W compare insert
== {insert lineend
}]} {
504 %W delete insert
{insert lineend
}
507 bind Console
<<Console_Clear
>> {
508 ## Clear console display
509 %W delete
1.0 "promptEnd linestart"
511 bind Console
<<Console_ClearLine
>> {
512 ## Clear command line (Unix shell staple)
513 %W delete promptEnd end
515 bind Console
<Meta-d
> {
516 if {[%W compare insert
>= promptEnd
]} {
517 %W delete insert
{insert wordend
}
520 bind Console
<Meta-BackSpace
> {
521 if {[%W compare
{insert
-1c wordstart
} >= promptEnd
]} {
522 %W delete
{insert
-1c wordstart
} insert
525 bind Console
<Meta-d
> {
526 if {[%W compare insert
>= promptEnd
]} {
527 %W delete insert
{insert wordend
}
530 bind Console
<Meta-BackSpace
> {
531 if {[%W compare
{insert
-1c wordstart
} >= promptEnd
]} {
532 %W delete
{insert
-1c wordstart
} insert
535 bind Console
<Meta-Delete
> {
536 if {[%W compare insert
>= promptEnd
]} {
537 %W delete insert
{insert wordend
}
540 bind Console
<<Console_Prev
>> {
541 tk::ConsoleHistory prev
543 bind Console
<<Console_Next
>> {
544 tk::ConsoleHistory next
546 bind Console
<Insert
> {
547 catch {tk::ConsoleInsert %W
[::tk::GetSelection %W PRIMARY
]}
549 bind Console
<KeyPress
> {
550 tk::ConsoleInsert %W
%A
553 eval destroy [winfo child .
]
554 source [file join $tk_library console.tcl
]
556 if {[tk windowingsystem
] eq
"aqua"} {
557 bind Console
<Command-q
> {
561 bind Console
<<Cut
>> { ::tk::console::Cut %W
}
562 bind Console
<<Copy
>> { ::tk::console::Copy %W
}
563 bind Console
<<Paste
>> { ::tk::console::Paste %W
}
565 bind Console
<<Console_FontSizeIncr
>> {
566 set size
[font configure TkConsoleFont
-size]
567 font configure TkConsoleFont
-size [incr size
]
569 bind Console
<<Console_FontSizeDecr
>> {
570 set size
[font configure TkConsoleFont
-size]
571 font configure TkConsoleFont
-size [incr size
-1]
575 ## Bindings for doing special things based on certain keys
577 bind PostConsole
<Key-parenright
> {
578 if {"\\" ne
[%W get insert-2c
]} {
579 ::tk::console::MatchPair %W
\( \) promptEnd
582 bind PostConsole
<Key-bracketright
> {
583 if {"\\" ne
[%W get insert-2c
]} {
584 ::tk::console::MatchPair %W
\[ \] promptEnd
587 bind PostConsole
<Key-braceright
> {
588 if {"\\" ne
[%W get insert-2c
]} {
589 ::tk::console::MatchPair %W
\{ \} promptEnd
592 bind PostConsole
<Key-quotedbl
> {
593 if {"\\" ne
[%W get insert-2c
]} {
594 ::tk::console::MatchQuote %W promptEnd
598 bind PostConsole
<KeyPress
> {
600 ::tk::console::TagProc %W
605 # ::tk::ConsoleInsert --
606 # Insert a string into a text at the point of the insertion cursor.
607 # If there is a selection in the text, and it covers the point of the
608 # insertion cursor, then delete the selection before inserting. Insertion
609 # is restricted to the prompt area.
612 # w - The text window in which to insert the string
613 # s - The string to insert (usually just a single character)
615 proc ::tk::ConsoleInsert {w s
} {
620 if {[$w compare sel.first
<= insert
] \
621 && [$w compare sel.last
>= insert
]} {
622 $w tag remove sel sel.first promptEnd
623 $w delete sel.first sel.last
626 if {[$w compare insert
< promptEnd
]} {
627 $w mark
set insert end
629 $w insert insert
$s {input stdin
}
633 # ::tk::ConsoleOutput --
635 # This routine is called directly by ConsolePutsCmd to cause a string
636 # to be displayed in the console.
639 # dest - The output tag to be used: either "stderr" or "stdout".
640 # string - The string to be displayed.
642 proc ::tk::ConsoleOutput {dest
string} {
644 $w insert output
$string $dest
645 ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
649 # ::tk::ConsoleExit --
651 # This routine is called by ConsoleEventProc when the main window of
652 # the application is destroyed. Don't call exit - that probably already
653 # happened. Just delete our window.
658 proc ::tk::ConsoleExit {} {
662 # ::tk::ConsoleAbout --
664 # This routine displays an About box to show Tcl/Tk version info.
669 proc ::tk::ConsoleAbout {} {
670 tk_messageBox -type ok
-message "[mc {Tcl for Windows}]
672 Tcl $::tcl_patchLevel
676 # ::tk::console::TagProc --
678 # Tags a procedure in the console if it's recognized
679 # This procedure is not perfect. However, making it perfect wastes
680 # too much CPU time...
683 # w - console text widget
685 proc ::tk::console::TagProc w
{
686 if {!$::tk::console::magicKeys} {
689 set exp
"\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
690 set i
[$w search
-backwards -regexp $exp insert-1c promptEnd-1c
]
696 regsub -all "\[\[\\\\\\?\\*\]" [$w get
$i "insert-1c wordend"] {\\\0} c
697 if {[llength [EvalAttached
[list info commands
$c]]]} {
698 $w tag add
proc $i "insert-1c wordend"
700 $w tag remove
proc $i "insert-1c wordend"
702 if {[llength [EvalAttached
[list info vars
$c]]]} {
703 $w tag add var
$i "insert-1c wordend"
705 $w tag remove var
$i "insert-1c wordend"
709 # ::tk::console::MatchPair --
711 # Blinks a matching pair of characters
712 # c2 is assumed to be at the text index 'insert'.
713 # This proc is really loopy and took me an hour to figure out given
714 # all possible combinations with escaping except for escaped \'s.
715 # It doesn't take into account possible commenting... Oh well. If
716 # anyone has something better, I'd like to see/use it. This is really
717 # only efficient for small contexts.
720 # w - console text widget
721 # c1 - first char of pair
722 # c2 - second char of pair
724 # Calls: ::tk::console::Blink
726 proc ::tk::console::MatchPair {w c1 c2
{lim
1.0}} {
727 if {!$::tk::console::magicKeys} {
730 if {{} ne
[set ix
[$w search
-back $c1 insert
$lim]]} {
732 [string match
{\\} [$w get
$ix-1c
]] &&
733 [set ix
[$w search
-back $c1 $ix-1c
$lim]] ne
{}
739 while {[set i0
[$w search
$c2 $i0 $i1]] ne
{}} {
741 if {[string match
{\\} [$w get
$i0-2c
]]} {
750 while {$j && [set ix
[$w search
-back $c1 $ix $lim]] ne
{}} {
751 if {[string match
{\\} [$w get
$ix-1c
]]} {
757 if {[string match
{} $ix]} {
758 set ix
[$w index
$lim]
761 set ix
[$w index
$lim]
763 if {$::tk::console::blinkRange} {
764 Blink
$w $ix [$w index insert
]
766 Blink
$w $ix $ix+1c
[$w index insert-1c
] [$w index insert
]
770 # ::tk::console::MatchQuote --
772 # Blinks between matching quotes.
773 # Blinks just the quote if it's unmatched, otherwise blinks quoted string
774 # The quote to match is assumed to be at the text index 'insert'.
777 # w - console text widget
779 # Calls: ::tk::console::Blink
781 proc ::tk::console::MatchQuote {w
{lim
1.0}} {
782 if {!$::tk::console::magicKeys} {
787 while {[set i
[$w search
-back \" $i $lim]] ne
{}} {
788 if {[string match
{\\} [$w get
$i-1c
]]} {
797 if {$::tk::console::blinkRange} {
798 Blink
$w $i0 [$w index insert
]
800 Blink
$w $i0 $i0+1c
[$w index insert-1c
] [$w index insert
]
803 Blink
$w [$w index insert-1c
] [$w index insert
]
807 # ::tk::console::Blink --
809 # Blinks between n index pairs for a specified duration.
812 # w - console text widget
813 # i1 - start index to blink region
814 # i2 - end index of blink region
815 # dur - duration in usecs to blink for
818 # blinks selected characters in $w
820 proc ::tk::console::Blink {w args
} {
821 eval [list $w tag add blink
] $args
822 after $::tk::console::blinkTime [list $w] tag remove blink
$args
825 # ::tk::console::ConstrainBuffer --
827 # This limits the amount of data in the text widget
828 # Called by Prompt and ConsoleOutput
831 # w - console text widget
832 # size - # of lines to constrain to
835 # may delete data in console widget
837 proc ::tk::console::ConstrainBuffer {w size
} {
838 if {[$w index end
] > $size} {
839 $w delete
1.0 [expr {int
([$w index end
])-$size}].0
843 # ::tk::console::Expand --
846 # ARGS: w - text widget in which to expand str
847 # type - type of expansion (path / proc / variable)
849 # Calls: ::tk::console::Expand(Pathname|Procname|Variable)
851 # Outputs: The string to match is expanded to the longest possible match.
852 # If ::tk::console::showMatches is non-zero and the longest match
853 # equaled the string to expand, then all possible matches are
854 # output to stdout. Triggers bell if no matches are found.
856 # Returns: number of matches found
858 proc ::tk::console::Expand {w
{type
""}} {
859 set exp
"\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
860 set tmp
[$w search
-backwards -regexp $exp insert-1c promptEnd-1c
]
866 if {[$w compare
$tmp >= insert
]} {
869 set str
[$w get
$tmp insert
]
872 set res
[ExpandPathname
$str]
875 set res
[ExpandProcname
$str]
878 set res
[ExpandVariable
$str]
882 foreach t
{Pathname Procname Variable
} {
883 if {![catch {Expand
$t $str} res
] && ($res ne
"")} {
889 set len
[llength $res]
891 set repl
[lindex $res 0]
892 $w delete
$tmp insert
893 $w insert
$tmp $repl {input stdin
}
894 if {($len > 1) && ($::tk::console::showMatches) && ($repl eq
$str)} {
895 puts stdout
[lsort [lreplace $res 0 0]]
903 # ::tk::console::ExpandPathname --
905 # Expand a file pathname based on $str
906 # This is based on UNIX file name conventions
909 # str - partial file pathname to expand
911 # Calls: ::tk::console::ExpandBestMatch
913 # Returns: list containing longest unique match followed by all the
914 # possible further matches
916 proc ::tk::console::ExpandPathname str
{
917 set pwd [EvalAttached
pwd]
918 if {[catch {EvalAttached
[list cd [file dirname
$str]]} err
]} {
919 return -code error $err
921 set dir
[file tail
$str]
922 ## Check to see if it was known to be a directory and keep the trailing
923 ## slash if so (file tail cuts it off)
924 if {[string match
*/ $str]} {
927 if {[catch {lsort [EvalAttached
[list glob $dir*]]} m
]} {
930 if {[llength $m] > 1} {
932 if {[string match windows
$tcl_platform(platform
)]} {
933 ## Windows is screwy because it's case insensitive
934 set tmp
[ExpandBestMatch
[string tolower
$m] \
935 [string tolower
$dir]]
936 ## Don't change case if we haven't changed the word
937 if {[string length
$dir]==[string length
$tmp]} {
941 set tmp
[ExpandBestMatch
$m $dir]
943 if {[string match ?
*/* $str]} {
944 set tmp
[file dirname
$str]/$tmp
945 } elseif
{[string match
/* $str]} {
948 regsub -all { } $tmp {\\ } tmp
949 set match
[linsert $m 0 $tmp]
951 ## This may look goofy, but it handles spaces in path names
953 if {[file isdir
$match]} {
956 if {[string match ?
*/* $str]} {
957 set match
[file dirname
$str]/$match
958 } elseif
{[string match
/* $str]} {
961 regsub -all { } $match {\\ } match
962 ## Why is this one needed and the ones below aren't!!
963 set match
[list $match]
966 EvalAttached
[list cd $pwd]
970 # ::tk::console::ExpandProcname --
972 # Expand a tcl proc name based on $str
975 # str - partial proc name to expand
977 # Calls: ::tk::console::ExpandBestMatch
979 # Returns: list containing longest unique match followed by all the
980 # possible further matches
982 proc ::tk::console::ExpandProcname str
{
983 set match
[EvalAttached
[list info commands
$str*]]
984 if {[llength $match] == 0} {
985 set ns
[EvalAttached
\
986 "namespace children \[namespace current\] [list $str*]"]
987 if {[llength $ns]==1} {
988 set match
[EvalAttached
[list info commands
${ns
}::*]]
993 if {[llength $match] > 1} {
994 regsub -all { } [ExpandBestMatch
$match $str] {\\ } str
995 set match
[linsert $match 0 $str]
997 regsub -all { } $match {\\ } match
1002 # ::tk::console::ExpandVariable --
1004 # Expand a tcl variable name based on $str
1007 # str - partial tcl var name to expand
1009 # Calls: ::tk::console::ExpandBestMatch
1011 # Returns: list containing longest unique match followed by all the
1012 # possible further matches
1014 proc ::tk::console::ExpandVariable str
{
1015 if {[regexp {([^
\(]*)\((.
*)} $str -> ary str
]} {
1016 ## Looks like they're trying to expand an array.
1017 set match
[EvalAttached
[list array names
$ary $str*]]
1018 if {[llength $match] > 1} {
1019 set vars
$ary\([ExpandBestMatch
$match $str]
1020 foreach var
$match {
1021 lappend vars
$ary\($var\)
1024 } elseif
{[llength $match] == 1} {
1025 set match
$ary\($match\)
1027 ## Space transformation avoided for array names.
1029 set match
[EvalAttached
[list info vars
$str*]]
1030 if {[llength $match] > 1} {
1031 regsub -all { } [ExpandBestMatch
$match $str] {\\ } str
1032 set match
[linsert $match 0 $str]
1034 regsub -all { } $match {\\ } match
1040 # ::tk::console::ExpandBestMatch --
1042 # Finds the best unique match in a list of names.
1043 # The extra $e in this argument allows us to limit the innermost loop a little
1044 # further. This improves speed as $l becomes large or $e becomes long.
1047 # l - list to find best unique match in
1048 # e - currently best known unique match
1050 # Returns: longest unique match in the list
1052 proc ::tk::console::ExpandBestMatch {l
{e
{}}} {
1053 set ec
[lindex $l 0]
1054 if {[llength $l]>1} {
1055 set e
[expr {[string length
$e] - 1}]
1056 set ei
[expr {[string length
$ec] - 1}]
1058 while {$ei>=$e && [string first
$ec $l]} {
1059 set ec
[string range
$ec 0 [incr ei
-1]]
1066 # now initialize the console