From 49aaf3077153a6457179ecd0b6f3e8757b7cfe0e Mon Sep 17 00:00:00 2001 From: Jeff Hobbs Date: Mon, 28 May 2001 08:47:12 +0000 Subject: [PATCH] * docs/start.html: added note about ::tkcon::OPT(gets) var. * docs/tkcon.html: improved docs for tkcon *get* methods. * tkcon.tcl: reinstituted override of gets by default to use the tkcon console based gets. --- ChangeLog | 5 ++++ docs/start.html | 8 +++++ docs/tkcon.html | 48 +++++++++++++++++++----------- tkcon.tcl | 77 +++++++++++++++++++++++++++++++++---------------- 4 files changed, 96 insertions(+), 42 deletions(-) diff --git a/ChangeLog b/ChangeLog index c3a189f..98ac99d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,10 @@ 2001-05-28 Jeff Hobbs + * docs/start.html: added note about ::tkcon::OPT(gets) var. + * docs/tkcon.html: improved docs for tkcon *get* methods. + * tkcon.tcl: reinstituted override of gets by default to use the + tkcon console based gets. + * tkcon.tcl (dump): corrected outputting local vars with dump. Added RCS info to PRIV array and About box. (tkcon congets) corrected congets to set the limit and insert diff --git a/docs/start.html b/docs/start.html index 2302179..9a55fd0 100755 --- a/docs/start.html +++ b/docs/start.html @@ -236,6 +236,14 @@ the interpreter to reappear. Otherwise TkCon will prompt you.
Font to use for tkcon text widgets (also specified with -font). Defaults to the system default, or a fixed width equivalent. +
::tkcon::OPT(gets) +
Controls whether tkcon will overload the gets command to work with +tkcon. The valid values are: congets (the default), which +will redirect stdin requests to the tkcon window; +gets, which will pop up a dialog to get input; and {} (empty +string) which tells tkcon not to overload gets. This value must be set at +startup to alter tkcon's behavior. +
::tkcon::OPT(history)
The size of the history list to keep. Defaults to 48. diff --git a/docs/tkcon.html b/docs/tkcon.html index 0f00250..377d65a 100755 --- a/docs/tkcon.html +++ b/docs/tkcon.html @@ -61,7 +61,7 @@ This provides lots of useful control over a console:
tkcon attach interpreter -
Attaches TkCon to the named interpreter. The name must be that +
Attaches tkcon to the named interpreter. The name must be that returned by [tk appname] or a valid path to a slave interpreter. It's best to use this via the Console->Attach Console menu. @@ -72,17 +72,26 @@ The text widget will automatically delete leading lines once this number has been exceeded (read: this is the scroll buffer size).
tkcon bgerror ?msg errorInfo? -
Does bgerror stuff in the TkCon master interpreter. +
Does bgerror stuff in the tkcon master interpreter.
tkcon close or tkcon destroy -
Destroys this TkCon widget. +
Destroys this tkcon widget. + +
tkcon congets +
Behaves like the traditional Tcl gets, but instead of +using stdin, it uses the tkcon console window. By default, +tkcon replaces the standard gets with this command. This behavior can be +controlled by altering the ::tkcon::OPT(gets) parameter at +startup. This should not be called directly - instead rely on the +overloaded gets, which has support for the optional varName +parameter.
tkcon console args -
Passes the args to the TkCon text widget (the console). +
Passes the args to the tkcon text widget (the console).
tkcon error
Pops up a dialog that gives the user a full trace of the last error -received in the TkCon console. +received in the tkcon console.
tkcon find string ?-case TCL_BOOLEAN -regexp TCL_BOOLEAN? @@ -92,20 +101,25 @@ is empty, it clears any previous highlighting.
tkcon font ?fontname?
Sets or returns the font used by tkcon text widgets. -
tkcon gets ?varname? -
Behaves like the traditional Tcl gets, but uses the -TkCon console instead of stdin. +
tkcon gets +
Behaves like the traditional Tcl gets, but instead of +needing stdin, it pops a dialog box up for the user. The +overloaded gets has support for the optional varName parameter. + +
tkcon getcommand +
A variation of the congets method that requires a +full command to be input before returning.
tkcon hide -
Withdraw the TkCon display from the screen (make sure you have +
Withdraw the tkcon display from the screen (make sure you have a way to get it back).
tkcon history ?-newline? -
Displays the TkCon history in sourceable form. If -newline is +
Displays the tkcon history in sourceable form. If -newline is specified, it separates each command by an extra newline.
tkcon iconify -
Iconifies the TkCon display. +
Iconifies the tkcon display.
tkcon load filename
Sources named file into the slave interpreter. If no filename is @@ -113,7 +127,7 @@ given, it will attempt to call tk_getOpenFile to pop up the file select box.
tkcon main ?arg arg ...? -
Passes the args to the main TkCon interpreter to be evaluated and +
Passes the args to the main tkcon interpreter to be evaluated and returns the result.
tkcon master args @@ -121,7 +135,7 @@ returns the result. returns the result.
tkcon new -
Creates a new TkCon widget. +
Creates a new tkcon widget.
tkcon save ?filename ?type??
Saves the console buffer to the given filename. If no filename is @@ -139,20 +153,20 @@ what portion of the text you want to save.
Like set, but uses lappend on the variable.
tkcon show or tkcon deiconify -
Redisplays TkCon on the screen. +
Redisplays tkcon on the screen.
tkcon slave ?slavename ?arg arg ...?? -
If called with no args, it returns the name of all the TkCon +
If called with no args, it returns the name of all the tkcon interpreters. Otherwise given an interp name it passes the args to the named interpreter to be evaluated and returns the result. If no args are passed, then it returns the [tk appname] of that interpreter.
tkcon title ?title? -
Sets or returns the title for TkCon. +
Sets or returns the title for tkcon.
tkcon version -
Returns of version of TkCon. +
Returns of version of tkcon.
diff --git a/tkcon.tcl b/tkcon.tcl index 6c8768a..0d44e48 100755 --- a/tkcon.tcl +++ b/tkcon.tcl @@ -124,6 +124,7 @@ proc ::tkcon::Init {} { slaveexit close subhistory 1 gc-delay 60000 + gets {congets} exec slave } @@ -149,7 +150,7 @@ proc ::tkcon::Init {} { slavealias { edit more less tkcon } slaveprocs { alias clear dir dump echo idebug lremove - tkcon_puts observe observe_var unalias which what + tkcon_puts tkcon_gets observe observe_var unalias which what } version 2.1+ RCS {RCS: @(#) $Id$} @@ -288,9 +289,9 @@ proc ::tkcon::Init {} { if {![catch {rename ::puts ::tkcon_tcl_puts}]} { interp alias {} ::puts {} ::tkcon_puts } - #if {![catch {rename ::gets ::tkcon_tcl_gets}]} { - #interp alias {} ::gets {} ::tkcon_gets - #} + if {($OPT(gets) != "") && ![catch {rename ::gets ::tkcon_tcl_gets}]} { + interp alias {} ::gets {} ::tkcon_gets + } EvalSlave history keep $OPT(history) if {[info exists MainInit]} { @@ -386,15 +387,18 @@ proc ::tkcon::InitSlave {slave args} { } $slave alias exit exit interp eval $slave { - catch {rename ::puts ::tkcon_tcl_puts} - #catch {rename ::gets ::tkcon_tcl_gets} + # Do package require before changing around puts/gets catch {package require bogus-package-name} + catch {rename ::puts ::tkcon_tcl_puts} } foreach cmd $PRIV(slaveprocs) { $slave eval [dump proc $cmd] } foreach cmd $PRIV(slavealias) { $slave alias $cmd $cmd } interp alias $slave ::ls $slave ::dir -full interp alias $slave ::puts $slave ::tkcon_puts - #interp alias $slave ::gets $slave ::tkcon_gets + if {$OPT(gets) != ""} { + interp eval $slave { catch {rename ::gets ::tkcon_tcl_gets} } + interp alias $slave ::gets $slave ::tkcon_gets + } if {[info exists argv0]} {interp eval $slave [list set argv0 $argv0]} interp eval $slave set tcl_interactive $tcl_interactive \; \ set argc [llength $args] \; \ @@ -435,10 +439,7 @@ proc ::tkcon::InitInterp {name type} { set oldname $PRIV(namesp) catch { Attach $name $type - EvalAttached { - catch {rename ::puts ::tkcon_tcl_puts} - #catch {rename ::gets ::tkcon_tcl_gets} - } + EvalAttached { catch {rename ::puts ::tkcon_tcl_puts} } foreach cmd $PRIV(slaveprocs) { EvalAttached [dump proc $cmd] } switch -exact $type { slave { @@ -459,9 +460,14 @@ proc ::tkcon::InitInterp {name type} { if {[catch {interp alias {} ::puts {} ::tkcon_puts}]} { catch {rename ::tkcon_puts ::puts} } - #if {[catch {interp alias {} ::gets {} ::tkcon_gets}]} { - #catch {rename ::tkcon_gets ::gets} - #} + } + if {$OPT(gets) != ""} { + EvalAttached { + catch {rename ::gets ::tkcon_tcl_gets} + if {[catch {interp alias {} ::gets {} ::tkcon_gets}]} { + catch {rename ::tkcon_gets ::gets} + } + } } return } {err} @@ -2451,8 +2457,31 @@ proc tkcon {cmd args} { $::tkcon::OPT(buffer) } congets { - ## 'congets' a replacement for [gets stdin varname] + ## 'congets' a replacement for [gets stdin] + # Use the 'gets' alias of 'tkcon_gets' command instead of + # calling the *get* methods directly for best compatability + if {[llength $args]} { + return -code error "wrong # args: must be \"tkcon congets\"" + } + set old [bind TkConsole <>] + bind TkConsole <> { set ::tkcon::PRIV(wait) 0 } + set w $::tkcon::PRIV(console) + # Make sure to move the limit to get the right data + $w mark set insert end + $w mark set limit insert + $w see end + vwait ::tkcon::PRIV(wait) + set line [::tkcon::CmdGet $w] + $w insert end \n + bind TkConsole <> $old + return $line + } + getc* { + ## 'getcommand' a replacement for [gets stdin] ## This forces a complete command to be input though + if {[llength $args]} { + return -code error "wrong # args: must be \"tkcon getcommand\"" + } set old [bind TkConsole <>] bind TkConsole <> { set ::tkcon::PRIV(wait) 0 } set w $::tkcon::PRIV(console) @@ -2470,15 +2499,9 @@ proc tkcon {cmd args} { $w see end } bind TkConsole <> $old - if {![llength $args]} { - return $line - } else { - upvar 1 [lindex $args 0] data - set data $line - return [string length $line] - } + return $line } - get* { + get - gets { ## 'gets' - a replacement for [gets stdin] ## This pops up a text widget to be used for stdin (local grabbed) if {[llength $args]} { @@ -2743,7 +2766,9 @@ proc tkcon_gets args { if {[string compare stdin [lindex $args 0]]} { return [uplevel 1 tkcon_tcl_gets $args] } - set data [tkcon gets] + set gtype [tkcon set ::tkcon::OPT(gets)] + if {$gtype == ""} { set gtype congets } + set data [tkcon $gtype] if {$len == 2} { upvar 1 [lindex $args 1] var set var $data @@ -3205,9 +3230,11 @@ proc idebug {opt args} { while 1 { set err {} if {$tkcon} { + # tkcon's overload of gets is advanced enough to not need + # this, but we get a little better control this way. tkcon evalSlave set level $level tkcon prompt - set line [tkcon congets] + set line [tkcon getcommand] tkcon console mark set output end } else { puts -nonewline stderr "(level \#$level) debug > " -- 2.23.0