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 # Copyright (c) 1995-1997 Sun Microsystems, Inc.
8 # Copyright (c) 1998-2000 Ajuba Solutions.
9 # Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
11 # See the file "license.terms" for information on usage and redistribution
12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 # TODO: history - remember partially written command
17 namespace eval ::tk::console {
18 variable blinkTime
500 ; # msecs to blink braced range for
19 variable blinkRange
1 ; # enable blinking of the entire braced range
20 variable magicKeys
1 ; # enable brace matching and proc/var recognition
21 variable maxLines
600 ; # maximum # of lines buffered in console
22 variable showMatches
1 ; # show multiple expand matches
24 variable inPlugin
[info exists embed_args
]
25 variable defaultPrompt
; # default prompt if tcl_prompt1 isn't used
29 set defaultPrompt
{subst {[history nextid
] % }}
31 set defaultPrompt
{subst {([file tail
[pwd]]) [history nextid
] % }}
35 # simple compat function for tkcon code added for this console
36 interp alias
{} EvalAttached
{} consoleinterp
eval
38 # ::tk::ConsoleInit --
39 # This procedure constructs and configures the console windows.
44 proc ::tk::ConsoleInit {} {
47 if {![consoleinterp
eval {set tcl_interactive
}]} {
51 if {[tk windowingsystem
] eq
"aqua"} {
57 if {[catch {menu .menubar
} err
]} {
60 AmpMenuArgs .menubar add cascade
-label [mc
&File
] -menu .menubar.
file
61 AmpMenuArgs .menubar add cascade
-label [mc
&Edit
] -menu .menubar.edit
63 menu .menubar.
file -tearoff 0
64 AmpMenuArgs .menubar.
file add command
-label [mc
"&Source..."] \
65 -command {tk::ConsoleSource}
66 AmpMenuArgs .menubar.
file add command
-label [mc
"&Hide Console"] \
67 -command {wm withdraw .
}
68 AmpMenuArgs .menubar.
file add command
-label [mc
"&Clear Console"] \
69 -command {.
console delete
1.0 "promptEnd linestart"}
70 if {[tk windowingsystem
] ne
"aqua"} {
71 AmpMenuArgs .menubar.
file add command
-label [mc E
&xit
] -command {exit}
74 menu .menubar.edit
-tearoff 0
75 AmpMenuArgs .menubar.edit add command
-label [mc Cu
&t
] -accel "$mod+X"\
76 -command {event generate .
console <<Cut
>>}
77 AmpMenuArgs .menubar.edit add command
-label [mc
&Copy
] -accel "$mod+C"\
78 -command {event generate .
console <<Copy
>>}
79 AmpMenuArgs .menubar.edit add command
-label [mc P
&aste
] -accel "$mod+V"\
80 -command {event generate .
console <<Paste
>>}
82 if {$tcl_platform(platform
) ne
"windows"} {
83 AmpMenuArgs .menubar.edit add command
-label [mc Cl
&ear
] \
84 -command {event generate .
console <<Clear
>>}
86 AmpMenuArgs .menubar.edit add command
-label [mc
&Delete
] \
87 -command {event generate .
console <<Clear
>>} -accel "Del"
89 AmpMenuArgs .menubar add cascade
-label [mc
&Help
] -menu .menubar.help
90 menu .menubar.help
-tearoff 0
91 AmpMenuArgs .menubar.help add command
-label [mc
&About...
] \
92 -command tk::ConsoleAbout
95 AmpMenuArgs .menubar.edit add separator
96 AmpMenuArgs .menubar.edit add command
-label [mc
"&Increase Font Size"] \
97 -accel "$mod++" -command {event generate .
console <<Console_FontSizeIncr
>>}
98 AmpMenuArgs .menubar.edit add command
-label [mc
"&Decrease Font Size"] \
99 -accel "$mod+-" -command {event generate .
console <<Console_FontSizeDecr
>>}
101 . configure
-menu .menubar
103 # See if we can find a better font than the TkFixedFont
104 catch {font create TkConsoleFont
{*}[font configure TkFixedFont
]}
105 set families
[font families
]
106 switch -exact -- [tk windowingsystem
] {
107 aqua
{ set preferred
{Monaco
10} }
108 win32
{ set preferred
{ProFontWindows
8 Consolas
8} }
109 default { set preferred
{} }
111 foreach {family size
} $preferred {
112 if {[lsearch -exact $families $family] != -1} {
113 font configure TkConsoleFont
-family $family -size $size
118 # Provide the right border for the text widget (platform dependent).
119 ::ttk::style layout ConsoleFrame
{
120 Entry.field
-sticky news
-border 1 -children {
121 ConsoleFrame.padding
-sticky news
124 ::ttk::frame .consoleframe
-style ConsoleFrame
126 set con
[text .
console -yscrollcommand [list .sb
set] -setgrid true
\
127 -borderwidth 0 -highlightthickness 0 -font TkConsoleFont
]
128 if {[tk windowingsystem
] eq
"aqua"} {
129 scrollbar .sb
-command [list $con yview
]
131 ::ttk::scrollbar .sb
-command [list $con yview
]
133 pack .sb
-in .consoleframe
-fill both
-side right
-padx 1 -pady 1
134 pack $con -in .consoleframe
-fill both
-expand 1 -side left
-padx 1 -pady 1
135 pack .consoleframe
-fill both
-expand 1 -side left
139 $con tag configure stderr
-foreground red
140 $con tag configure stdin
-foreground blue
141 $con tag configure prompt
-foreground \#8F4433
142 $con tag configure
proc -foreground \#008800
143 $con tag configure var
-background \#FFC0D0
145 $con tag configure blink
-background \#FFFF00
146 $con tag configure find
-background \#FFFF00
150 # Avoid listing this console in [winfo interps]
151 if {[info command
::send] eq
"::send"} {rename ::send {}}
153 wm protocol . WM_DELETE_WINDOW
{ wm withdraw .
}
154 wm title .
[mc
"Console"]
156 $con mark
set output
[$con index
"end - 1 char"]
157 tk::TextSetCursor $con end
158 $con mark
set promptEnd insert
159 $con mark gravity promptEnd left
161 # A variant of ConsolePrompt to avoid a 'puts' call
163 set temp
[$w index
"end - 1 char"]
164 $w mark
set output end
165 if {![consoleinterp
eval "info exists tcl_prompt1"]} {
166 set string [EvalAttached
$::tk::console::defaultPrompt]
167 $w insert output
$string stdout
169 $w mark
set output
$temp
170 ::tk::TextSetCursor $w end
171 $w mark
set promptEnd insert
172 $w mark gravity promptEnd left
174 if {$tcl_platform(platform
) eq
"windows"} {
175 # Subtle work-around to erase the '% ' that tclMain.c prints out
176 after idle
[subst -nocommand {
177 if {[$con get
1.0 output
] eq
"% "} { $con delete
1.0 output
}
182 # ::tk::ConsoleSource --
184 # Prompts the user for a file to source in the main interpreter.
189 proc ::tk::ConsoleSource {} {
190 set filename [tk_getOpenFile -defaultextension .tcl
-parent .
\
191 -title [mc
"Select a file to source"] \
193 [list [mc
"Tcl Scripts"] .tcl
] \
194 [list [mc
"All Files"] *]]]
195 if {$filename ne
""} {
196 set cmd
[list source $filename]
197 if {[catch {consoleinterp
eval $cmd} result
]} {
198 ConsoleOutput stderr
"$result\n"
203 # ::tk::ConsoleInvoke --
204 # Processes the command line input. If the command is complete it
205 # is evaled in the main interpreter. Otherwise, the continuation
206 # prompt is added and more input may be added.
211 proc ::tk::ConsoleInvoke {args
} {
212 set ranges
[.
console tag ranges input
]
214 if {[llength $ranges]} {
216 while {[lindex $ranges $pos] ne
""} {
217 set start
[lindex $ranges $pos]
218 set end
[lindex $ranges [incr pos
]]
219 append cmd
[.
console get
$start $end]
225 } elseif
{[info complete
$cmd]} {
226 .
console mark
set output end
227 .
console tag delete input
228 set result
[consoleinterp record
$cmd]
235 ConsolePrompt partial
237 .
console yview
-pickplace insert
240 # ::tk::ConsoleHistory --
241 # This procedure implements command line history for the
242 # console. In general is evals the history command in the
243 # main interpreter to obtain the history. The variable
244 # ::tk::HistNum is used to store the current location in the history.
247 # cmd - Which action to take: prev, next, reset.
250 proc ::tk::ConsoleHistory {cmd
} {
257 set cmd
{history event [expr {[history nextid
] -1}]}
259 set cmd
"history event $HistNum"
261 if {[catch {consoleinterp
eval $cmd} cmd
]} {
265 .
console delete promptEnd end
266 .
console insert promptEnd
$cmd {input stdin
}
271 set cmd
{history event [expr {[history nextid
] -1}]}
272 } elseif
{$HistNum > 0} {
276 set cmd
"history event $HistNum"
279 catch {consoleinterp
eval $cmd} cmd
281 .
console delete promptEnd end
282 .
console insert promptEnd
$cmd {input stdin
}
290 # ::tk::ConsolePrompt --
291 # This procedure draws the prompt. If tcl_prompt1 or tcl_prompt2
292 # exists in the main interpreter it will be called to generate the
293 # prompt. Otherwise, a hard coded default prompt is printed.
296 # partial - Flag to specify which prompt to print.
298 proc ::tk::ConsolePrompt {{partial normal
}} {
300 if {$partial eq
"normal"} {
301 set temp
[$w index
"end - 1 char"]
302 $w mark
set output end
303 if {[consoleinterp
eval "info exists tcl_prompt1"]} {
304 consoleinterp
eval "eval \[set tcl_prompt1\]"
306 puts -nonewline [EvalAttached
$::tk::console::defaultPrompt]
309 set temp
[$w index output
]
310 $w mark
set output end
311 if {[consoleinterp
eval "info exists tcl_prompt2"]} {
312 consoleinterp
eval "eval \[set tcl_prompt2\]"
318 $w mark
set output
$temp
319 ::tk::TextSetCursor $w end
320 $w mark
set promptEnd insert
321 $w mark gravity promptEnd left
322 ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
326 # Copy selected text from the console
327 proc ::tk::console::Copy {w
} {
328 if {![catch {set data
[$w get sel.first sel.last
]}]} {
329 clipboard clear
-displayof $w
330 clipboard append -displayof $w $data
333 # Copies selected text. If the selection is within the current active edit
334 # region then it will be cut, if not it is only copied.
335 proc ::tk::console::Cut {w
} {
336 if {![catch {set data
[$w get sel.first sel.last
]}]} {
337 clipboard clear
-displayof $w
338 clipboard append -displayof $w $data
339 if {[$w compare sel.first
>= output
]} {
340 $w delete sel.first sel.last
344 # Paste text from the clipboard
345 proc ::tk::console::Paste {w
} {
347 set clip
[::tk::GetSelection $w CLIPBOARD
]
348 set list [split $clip \n\r]
349 tk::ConsoleInsert $w [lindex $list 0]
350 foreach x
[lrange $list 1 end
] {
351 $w mark
set insert
{end
- 1c
}
352 tk::ConsoleInsert $w "\n"
354 tk::ConsoleInsert $w $x
359 # ::tk::ConsoleBind --
360 # This procedure first ensures that the default bindings for the Text
361 # class have been defined. Then certain bindings are overridden for
367 proc ::tk::ConsoleBind {w
} {
368 bindtags $w [list $w Console PostConsole
[winfo toplevel $w] all
]
370 ## Get all Text bindings into Console
371 foreach ev
[bind Text
] {
372 bind Console
$ev [bind Text
$ev]
374 ## We really didn't want the newline insertion...
375 bind Console
<Control-Key-o
> {}
376 ## ...or any Control-v binding (would block <<Paste>>)
377 bind Console
<Control-Key-v
> {}
379 # For the moment, transpose isn't enabled until the console
380 # gets and overhaul of how it handles input -- hobbs
381 bind Console
<Control-Key-t
> {}
383 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
384 # Otherwise, if a widget binding for one of these is defined, the
385 # <Keypress> class binding will also fire and insert the character
388 bind Console
<Alt-KeyPress
> {# nothing }
389 bind Console
<Meta-KeyPress
> {# nothing}
390 bind Console
<Control-KeyPress
> {# nothing}
393 <<Console_Prev
>> <Key-Up
>
394 <<Console_Next
>> <Key-Down
>
395 <<Console_NextImmediate
>> <Control-Key-n
>
396 <<Console_PrevImmediate
>> <Control-Key-p
>
397 <<Console_PrevSearch
>> <Control-Key-r
>
398 <<Console_NextSearch
>> <Control-Key-s
>
400 <<Console_Expand
>> <Key-Tab
>
401 <<Console_Expand
>> <Key-Escape
>
402 <<Console_ExpandFile
>> <Control-Shift-Key-F
>
403 <<Console_ExpandProc
>> <Control-Shift-Key-P
>
404 <<Console_ExpandVar
>> <Control-Shift-Key-V
>
405 <<Console_Tab
>> <Control-Key-i
>
406 <<Console_Tab
>> <Meta-Key-i
>
407 <<Console_Eval
>> <Key-Return
>
408 <<Console_Eval
>> <Key-KP_Enter
>
410 <<Console_Clear
>> <Control-Key-l
>
411 <<Console_KillLine
>> <Control-Key-k
>
412 <<Console_Transpose
>> <Control-Key-t
>
413 <<Console_ClearLine
>> <Control-Key-u
>
414 <<Console_SaveCommand
>> <Control-Key-z
>
415 <<Console_FontSizeIncr
>> <Control-Key-plus
>
416 <<Console_FontSizeDecr
>> <Control-Key-minus
>
421 if {[tk windowingsystem
] eq
"aqua"} {
423 <<Console_FontSizeIncr
>> <Command-Key-plus
>
424 <<Console_FontSizeDecr
>> <Command-Key-minus
>
430 bind Console
<<Console_Expand
>> {
431 if {[%W compare insert
> promptEnd
]} {
432 ::tk::console::Expand %W
435 bind Console
<<Console_ExpandFile
>> {
436 if {[%W compare insert
> promptEnd
]} {
437 ::tk::console::Expand %W path
440 bind Console
<<Console_ExpandProc
>> {
441 if {[%W compare insert
> promptEnd
]} {
442 ::tk::console::Expand %W
proc
445 bind Console
<<Console_ExpandVar
>> {
446 if {[%W compare insert
> promptEnd
]} {
447 ::tk::console::Expand %W var
450 bind Console
<<Console_Eval
>> {
451 %W mark
set insert
{end
- 1c
}
452 tk::ConsoleInsert %W
"\n"
456 bind Console
<Delete
> {
457 if {{} ne
[%W tag nextrange sel
1.0 end
] \
458 && [%W compare sel.first
>= promptEnd
]} {
459 %W delete sel.first sel.last
460 } elseif
{[%W compare insert
>= promptEnd
]} {
465 bind Console
<BackSpace
> {
466 if {{} ne
[%W tag nextrange sel
1.0 end
] \
467 && [%W compare sel.first
>= promptEnd
]} {
468 %W delete sel.first sel.last
469 } elseif
{[%W compare insert
!= 1.0] && \
470 [%W compare insert
> promptEnd
]} {
475 bind Console
<Control-h
> [bind Console
<BackSpace
>]
477 bind Console
<Home
> {
478 if {[%W compare insert
< promptEnd
]} {
479 tk::TextSetCursor %W
{insert linestart
}
481 tk::TextSetCursor %W promptEnd
484 bind Console
<Control-a
> [bind Console
<Home
>]
486 tk::TextSetCursor %W
{insert lineend
}
488 bind Console
<Control-e
> [bind Console
<End
>]
489 bind Console
<Control-d
> {
490 if {[%W compare insert
< promptEnd
]} {
495 bind Console
<<Console_KillLine
>> {
496 if {[%W compare insert
< promptEnd
]} {
499 if {[%W compare insert
== {insert lineend
}]} {
502 %W delete insert
{insert lineend
}
505 bind Console
<<Console_Clear
>> {
506 ## Clear console display
507 %W delete
1.0 "promptEnd linestart"
509 bind Console
<<Console_ClearLine
>> {
510 ## Clear command line (Unix shell staple)
511 %W delete promptEnd end
513 bind Console
<Meta-d
> {
514 if {[%W compare insert
>= promptEnd
]} {
515 %W delete insert
{insert wordend
}
518 bind Console
<Meta-BackSpace
> {
519 if {[%W compare
{insert
-1c wordstart
} >= promptEnd
]} {
520 %W delete
{insert
-1c wordstart
} insert
523 bind Console
<Meta-d
> {
524 if {[%W compare insert
>= promptEnd
]} {
525 %W delete insert
{insert wordend
}
528 bind Console
<Meta-BackSpace
> {
529 if {[%W compare
{insert
-1c wordstart
} >= promptEnd
]} {
530 %W delete
{insert
-1c wordstart
} insert
533 bind Console
<Meta-Delete
> {
534 if {[%W compare insert
>= promptEnd
]} {
535 %W delete insert
{insert wordend
}
538 bind Console
<<Console_Prev
>> {
539 tk::ConsoleHistory prev
541 bind Console
<<Console_Next
>> {
542 tk::ConsoleHistory next
544 bind Console
<Insert
> {
545 catch {tk::ConsoleInsert %W
[::tk::GetSelection %W PRIMARY
]}
547 bind Console
<KeyPress
> {
548 tk::ConsoleInsert %W
%A
551 eval destroy [winfo child .
]
552 source [file join $tk_library console.tcl
]
554 if {[tk windowingsystem
] eq
"aqua"} {
555 bind Console
<Command-q
> {
559 bind Console
<<Cut
>> { ::tk::console::Cut %W
}
560 bind Console
<<Copy
>> { ::tk::console::Copy %W
}
561 bind Console
<<Paste
>> { ::tk::console::Paste %W
}
563 bind Console
<<Console_FontSizeIncr
>> {
564 set size
[font configure TkConsoleFont
-size]
565 font configure TkConsoleFont
-size [incr size
]
567 bind Console
<<Console_FontSizeDecr
>> {
568 set size
[font configure TkConsoleFont
-size]
569 font configure TkConsoleFont
-size [incr size
-1]
573 ## Bindings for doing special things based on certain keys
575 bind PostConsole
<Key-parenright
> {
576 if {"\\" ne
[%W get insert-2c
]} {
577 ::tk::console::MatchPair %W
\( \) promptEnd
580 bind PostConsole
<Key-bracketright
> {
581 if {"\\" ne
[%W get insert-2c
]} {
582 ::tk::console::MatchPair %W
\[ \] promptEnd
585 bind PostConsole
<Key-braceright
> {
586 if {"\\" ne
[%W get insert-2c
]} {
587 ::tk::console::MatchPair %W
\{ \} promptEnd
590 bind PostConsole
<Key-quotedbl
> {
591 if {"\\" ne
[%W get insert-2c
]} {
592 ::tk::console::MatchQuote %W promptEnd
596 bind PostConsole
<KeyPress
> {
598 ::tk::console::TagProc %W
603 # ::tk::ConsoleInsert --
604 # Insert a string into a text at the point of the insertion cursor.
605 # If there is a selection in the text, and it covers the point of the
606 # insertion cursor, then delete the selection before inserting. Insertion
607 # is restricted to the prompt area.
610 # w - The text window in which to insert the string
611 # s - The string to insert (usually just a single character)
613 proc ::tk::ConsoleInsert {w s
} {
618 if {[$w compare sel.first
<= insert
] \
619 && [$w compare sel.last
>= insert
]} {
620 $w tag remove sel sel.first promptEnd
621 $w delete sel.first sel.last
624 if {[$w compare insert
< promptEnd
]} {
625 $w mark
set insert end
627 $w insert insert
$s {input stdin
}
631 # ::tk::ConsoleOutput --
633 # This routine is called directly by ConsolePutsCmd to cause a string
634 # to be displayed in the console.
637 # dest - The output tag to be used: either "stderr" or "stdout".
638 # string - The string to be displayed.
640 proc ::tk::ConsoleOutput {dest
string} {
642 $w insert output
$string $dest
643 ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
647 # ::tk::ConsoleExit --
649 # This routine is called by ConsoleEventProc when the main window of
650 # the application is destroyed. Don't call exit - that probably already
651 # happened. Just delete our window.
656 proc ::tk::ConsoleExit {} {
660 # ::tk::ConsoleAbout --
662 # This routine displays an About box to show Tcl/Tk version info.
667 proc ::tk::ConsoleAbout {} {
668 tk_messageBox -type ok
-message "[mc {Tcl for Windows}]
670 Tcl $::tcl_patchLevel
674 # ::tk::console::TagProc --
676 # Tags a procedure in the console if it's recognized
677 # This procedure is not perfect. However, making it perfect wastes
678 # too much CPU time...
681 # w - console text widget
683 proc ::tk::console::TagProc w
{
684 if {!$::tk::console::magicKeys} {
687 set exp
"\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
688 set i
[$w search
-backwards -regexp $exp insert-1c promptEnd-1c
]
694 regsub -all "\[\[\\\\\\?\\*\]" [$w get
$i "insert-1c wordend"] {\\\0} c
695 if {[llength [EvalAttached
[list info commands
$c]]]} {
696 $w tag add
proc $i "insert-1c wordend"
698 $w tag remove
proc $i "insert-1c wordend"
700 if {[llength [EvalAttached
[list info vars
$c]]]} {
701 $w tag add var
$i "insert-1c wordend"
703 $w tag remove var
$i "insert-1c wordend"
707 # ::tk::console::MatchPair --
709 # Blinks a matching pair of characters
710 # c2 is assumed to be at the text index 'insert'.
711 # This proc is really loopy and took me an hour to figure out given
712 # all possible combinations with escaping except for escaped \'s.
713 # It doesn't take into account possible commenting... Oh well. If
714 # anyone has something better, I'd like to see/use it. This is really
715 # only efficient for small contexts.
718 # w - console text widget
719 # c1 - first char of pair
720 # c2 - second char of pair
722 # Calls: ::tk::console::Blink
724 proc ::tk::console::MatchPair {w c1 c2
{lim
1.0}} {
725 if {!$::tk::console::magicKeys} {
728 if {{} ne
[set ix
[$w search
-back $c1 insert
$lim]]} {
730 [string match
{\\} [$w get
$ix-1c
]] &&
731 [set ix
[$w search
-back $c1 $ix-1c
$lim]] ne
{}
737 while {[set i0
[$w search
$c2 $i0 $i1]] ne
{}} {
739 if {[string match
{\\} [$w get
$i0-2c
]]} {
748 while {$j && [set ix
[$w search
-back $c1 $ix $lim]] ne
{}} {
749 if {[string match
{\\} [$w get
$ix-1c
]]} {
755 if {[string match
{} $ix]} {
756 set ix
[$w index
$lim]
759 set ix
[$w index
$lim]
761 if {$::tk::console::blinkRange} {
762 Blink
$w $ix [$w index insert
]
764 Blink
$w $ix $ix+1c
[$w index insert-1c
] [$w index insert
]
768 # ::tk::console::MatchQuote --
770 # Blinks between matching quotes.
771 # Blinks just the quote if it's unmatched, otherwise blinks quoted string
772 # The quote to match is assumed to be at the text index 'insert'.
775 # w - console text widget
777 # Calls: ::tk::console::Blink
779 proc ::tk::console::MatchQuote {w
{lim
1.0}} {
780 if {!$::tk::console::magicKeys} {
785 while {[set i
[$w search
-back \" $i $lim]] ne
{}} {
786 if {[string match
{\\} [$w get
$i-1c
]]} {
795 if {$::tk::console::blinkRange} {
796 Blink
$w $i0 [$w index insert
]
798 Blink
$w $i0 $i0+1c
[$w index insert-1c
] [$w index insert
]
801 Blink
$w [$w index insert-1c
] [$w index insert
]
805 # ::tk::console::Blink --
807 # Blinks between n index pairs for a specified duration.
810 # w - console text widget
811 # i1 - start index to blink region
812 # i2 - end index of blink region
813 # dur - duration in usecs to blink for
816 # blinks selected characters in $w
818 proc ::tk::console::Blink {w args
} {
819 eval [list $w tag add blink
] $args
820 after $::tk::console::blinkTime [list $w] tag remove blink
$args
823 # ::tk::console::ConstrainBuffer --
825 # This limits the amount of data in the text widget
826 # Called by Prompt and ConsoleOutput
829 # w - console text widget
830 # size - # of lines to constrain to
833 # may delete data in console widget
835 proc ::tk::console::ConstrainBuffer {w size
} {
836 if {[$w index end
] > $size} {
837 $w delete
1.0 [expr {int
([$w index end
])-$size}].0
841 # ::tk::console::Expand --
844 # ARGS: w - text widget in which to expand str
845 # type - type of expansion (path / proc / variable)
847 # Calls: ::tk::console::Expand(Pathname|Procname|Variable)
849 # Outputs: The string to match is expanded to the longest possible match.
850 # If ::tk::console::showMatches is non-zero and the longest match
851 # equaled the string to expand, then all possible matches are
852 # output to stdout. Triggers bell if no matches are found.
854 # Returns: number of matches found
856 proc ::tk::console::Expand {w
{type
""}} {
857 set exp
"\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
858 set tmp
[$w search
-backwards -regexp $exp insert-1c promptEnd-1c
]
864 if {[$w compare
$tmp >= insert
]} {
867 set str
[$w get
$tmp insert
]
870 set res
[ExpandPathname
$str]
873 set res
[ExpandProcname
$str]
876 set res
[ExpandVariable
$str]
880 foreach t
{Pathname Procname Variable
} {
881 if {![catch {Expand
$t $str} res
] && ($res ne
"")} {
887 set len
[llength $res]
889 set repl
[lindex $res 0]
890 $w delete
$tmp insert
891 $w insert
$tmp $repl {input stdin
}
892 if {($len > 1) && ($::tk::console::showMatches) && ($repl eq
$str)} {
893 puts stdout
[lsort [lreplace $res 0 0]]
901 # ::tk::console::ExpandPathname --
903 # Expand a file pathname based on $str
904 # This is based on UNIX file name conventions
907 # str - partial file pathname to expand
909 # Calls: ::tk::console::ExpandBestMatch
911 # Returns: list containing longest unique match followed by all the
912 # possible further matches
914 proc ::tk::console::ExpandPathname str
{
915 set pwd [EvalAttached
pwd]
916 if {[catch {EvalAttached
[list cd [file dirname
$str]]} err
]} {
917 return -code error $err
919 set dir
[file tail
$str]
920 ## Check to see if it was known to be a directory and keep the trailing
921 ## slash if so (file tail cuts it off)
922 if {[string match
*/ $str]} {
925 if {[catch {lsort [EvalAttached
[list glob $dir*]]} m
]} {
928 if {[llength $m] > 1} {
930 if {[string match windows
$tcl_platform(platform
)]} {
931 ## Windows is screwy because it's case insensitive
932 set tmp
[ExpandBestMatch
[string tolower
$m] \
933 [string tolower
$dir]]
934 ## Don't change case if we haven't changed the word
935 if {[string length
$dir]==[string length
$tmp]} {
939 set tmp
[ExpandBestMatch
$m $dir]
941 if {[string match ?
*/* $str]} {
942 set tmp
[file dirname
$str]/$tmp
943 } elseif
{[string match
/* $str]} {
946 regsub -all { } $tmp {\\ } tmp
947 set match
[linsert $m 0 $tmp]
949 ## This may look goofy, but it handles spaces in path names
951 if {[file isdir
$match]} {
954 if {[string match ?
*/* $str]} {
955 set match
[file dirname
$str]/$match
956 } elseif
{[string match
/* $str]} {
959 regsub -all { } $match {\\ } match
960 ## Why is this one needed and the ones below aren't!!
961 set match
[list $match]
964 EvalAttached
[list cd $pwd]
968 # ::tk::console::ExpandProcname --
970 # Expand a tcl proc name based on $str
973 # str - partial proc name to expand
975 # Calls: ::tk::console::ExpandBestMatch
977 # Returns: list containing longest unique match followed by all the
978 # possible further matches
980 proc ::tk::console::ExpandProcname str
{
981 set match
[EvalAttached
[list info commands
$str*]]
982 if {[llength $match] == 0} {
983 set ns
[EvalAttached
\
984 "namespace children \[namespace current\] [list $str*]"]
985 if {[llength $ns]==1} {
986 set match
[EvalAttached
[list info commands
${ns
}::*]]
991 if {[llength $match] > 1} {
992 regsub -all { } [ExpandBestMatch
$match $str] {\\ } str
993 set match
[linsert $match 0 $str]
995 regsub -all { } $match {\\ } match
1000 # ::tk::console::ExpandVariable --
1002 # Expand a tcl variable name based on $str
1005 # str - partial tcl var name to expand
1007 # Calls: ::tk::console::ExpandBestMatch
1009 # Returns: list containing longest unique match followed by all the
1010 # possible further matches
1012 proc ::tk::console::ExpandVariable str
{
1013 if {[regexp {([^
\(]*)\((.
*)} $str -> ary str
]} {
1014 ## Looks like they're trying to expand an array.
1015 set match
[EvalAttached
[list array names
$ary $str*]]
1016 if {[llength $match] > 1} {
1017 set vars
$ary\([ExpandBestMatch
$match $str]
1018 foreach var
$match {
1019 lappend vars
$ary\($var\)
1022 } elseif
{[llength $match] == 1} {
1023 set match
$ary\($match\)
1025 ## Space transformation avoided for array names.
1027 set match
[EvalAttached
[list info vars
$str*]]
1028 if {[llength $match] > 1} {
1029 regsub -all { } [ExpandBestMatch
$match $str] {\\ } str
1030 set match
[linsert $match 0 $str]
1032 regsub -all { } $match {\\ } match
1038 # ::tk::console::ExpandBestMatch --
1040 # Finds the best unique match in a list of names.
1041 # The extra $e in this argument allows us to limit the innermost loop a little
1042 # further. This improves speed as $l becomes large or $e becomes long.
1045 # l - list to find best unique match in
1046 # e - currently best known unique match
1048 # Returns: longest unique match in the list
1050 proc ::tk::console::ExpandBestMatch {l
{e
{}}} {
1051 set ec
[lindex $l 0]
1052 if {[llength $l]>1} {
1053 set e
[expr {[string length
$e] - 1}]
1054 set ei
[expr {[string length
$ec] - 1}]
1056 while {$ei>=$e && [string first
$ec $l]} {
1057 set ec
[string range
$ec 0 [incr ei
-1]]
1064 # now initialize the console