如何计算tclsh脚本？

Question

特克什是一个包含TCL命令的shell。

TCL uplevel命令计算给定的TCL脚本，但它无法计算tclsh脚本(可以包含bash命令)。

如何获得tclsh脚本的uplevel模拟？

考虑一下这个TCL脚本：

# file main.tcl

proc prompt { } \
{
   puts -nonewline stdout "MyShell > "
   flush stdout
}

proc process { } \
{
   catch { uplevel #0 [gets stdin] } got
   if { $got ne "" } {
       puts stderr $got
       flush stderr
   }
   prompt
}

fileevent stdin readable process

prompt
while { true } { update; after 100 }

这是一种TCL，所以当您键入tclsh main.tcl时，它会显示一个提示MyShell >，它的作用就像您处于交互式tclsh会话中一样。但是，您处于非交互式tclsh会话中，您输入的所有内容都由uplevel命令计算。因此，在这里您不能使用bash命令，就像您可以执行interactive会话那样。您不能从shell中直接打开vim，exec vim也不能工作。

我想要的是使MyShell >表现为交互式tclsh会话。我不能只使用tclsh的原因是在main.tcl的最后一行的循环:我必须有那个循环，所有的事情都必须发生在那个循环中。我还必须在循环的每一次迭代中做一些事情，所以可以使用vwait。

，这里是解决方案。，我没有找到更好的解决方案，然后重写::unknown函数。

# file main.tcl

    proc ::unknown { args } \
    {

        variable ::tcl::UnknownPending
        global auto_noexec auto_noload env tcl_interactive

        global myshell_evaluation
        if { [info exists myshell_evaluation] && $myshell_evaluation } {
            set level #0
        }  else {
            set level 1
        }

        # If the command word has the form "namespace inscope ns cmd"
        # then concatenate its arguments onto the end and evaluate it.

        set cmd [lindex $args 0]
        if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
        #return -code error "You need an {*}"
            set arglist [lrange $args 1 end]
        set ret [catch {uplevel $level ::$cmd $arglist} result opts]
        dict unset opts -errorinfo
        dict incr opts -level
        return -options $opts $result
        }

        catch {set savedErrorInfo $::errorInfo}
        catch {set savedErrorCode $::errorCode}
        set name $cmd
        if {![info exists auto_noload]} {
        #
        # Make sure we're not trying to load the same proc twice.
        #
        if {[info exists UnknownPending($name)]} {
            return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
        }
        set UnknownPending($name) pending;
        set ret [catch {
            auto_load $name [uplevel $level {::namespace current}]
        } msg opts]
        unset UnknownPending($name);
        if {$ret != 0} {
            dict append opts -errorinfo "\n    (autoloading \"$name\")"
            return -options $opts $msg
        }
        if {![array size UnknownPending]} {
            unset UnknownPending
        }
        if {$msg} {
            if {[info exists savedErrorCode]} {
            set ::errorCode $savedErrorCode
            } else {
            unset -nocomplain ::errorCode
            }
            if {[info exists savedErrorInfo]} {
            set ::errorInfo $savedErrorInfo
            } else {
            unset -nocomplain ::errorInfo
            }
            set code [catch {uplevel $level $args} msg opts]
            if {$code ==  1} {
            #
            # Compute stack trace contribution from the [uplevel].
            # Note the dependence on how Tcl_AddErrorInfo, etc. 
            # construct the stack trace.
            #
            set errorInfo [dict get $opts -errorinfo]
            set errorCode [dict get $opts -errorcode]
            set cinfo $args
            if {[string bytelength $cinfo] > 150} {
                set cinfo [string range $cinfo 0 150]
                while {[string bytelength $cinfo] > 150} {
                set cinfo [string range $cinfo 0 end-1]
                }
                append cinfo ...
            }
            append cinfo "\"\n    (\"uplevel\" body line 1)"
            append cinfo "\n    invoked from within"
            append cinfo "\n\"uplevel $level \$args\""
            #
            # Try each possible form of the stack trace
            # and trim the extra contribution from the matching case
            #
            set expect "$msg\n    while executing\n\"$cinfo"
            if {$errorInfo eq $expect} {
                #
                # The stack has only the eval from the expanded command
                # Do not generate any stack trace here.
                #
                dict unset opts -errorinfo
                dict incr opts -level
                return -options $opts $msg
            }
            #
            # Stack trace is nested, trim off just the contribution
            # from the extra "eval" of $args due to the "catch" above.
            #
            set expect "\n    invoked from within\n\"$cinfo"
            set exlen [string length $expect]
            set eilen [string length $errorInfo]
            set i [expr {$eilen - $exlen - 1}]
            set einfo [string range $errorInfo 0 $i]
            #
            # For now verify that $errorInfo consists of what we are about
            # to return plus what we expected to trim off.
            #
            if {$errorInfo ne "$einfo$expect"} {
                error "Tcl bug: unexpected stack trace in \"unknown\"" {}  [list CORE UNKNOWN BADTRACE $einfo $expect $errorInfo]
            }
            return -code error -errorcode $errorCode  -errorinfo $einfo $msg
            } else {
            dict incr opts -level
            return -options $opts $msg
            }
        }
        }

        if { ( [info exists myshell_evaluation] && $myshell_evaluation ) || (([info level] == 1) && ([info script] eq "")  && [info exists tcl_interactive] && $tcl_interactive) } {
        if {![info exists auto_noexec]} {
            set new [auto_execok $name]
            if {$new ne ""} {
            set redir ""
            if {[namespace which -command console] eq ""} {
                set redir ">&@stdout <@stdin"
            }
            uplevel $level [list ::catch  [concat exec $redir $new [lrange $args 1 end]]  ::tcl::UnknownResult ::tcl::UnknownOptions]
            dict incr ::tcl::UnknownOptions -level
            return -options $::tcl::UnknownOptions $::tcl::UnknownResult
            }
        }
        if {$name eq "!!"} {
            set newcmd [history event]
        } elseif {[regexp {^!(.+)$} $name -> event]} {
            set newcmd [history event $event]
        } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name -> old new]} {
            set newcmd [history event -1]
            catch {regsub -all -- $old $newcmd $new newcmd}
        }
        if {[info exists newcmd]} {
            tclLog $newcmd
            history change $newcmd 0
            uplevel $level [list ::catch $newcmd  ::tcl::UnknownResult ::tcl::UnknownOptions]
            dict incr ::tcl::UnknownOptions -level
            return -options $::tcl::UnknownOptions $::tcl::UnknownResult
        }

        set ret [catch {set candidates [info commands $name*]} msg]
        if {$name eq "::"} {
            set name ""
        }
        if {$ret != 0} {
            dict append opts -errorinfo  "\n    (expanding command prefix \"$name\" in unknown)"
            return -options $opts $msg
        }
        # Filter out bogus matches when $name contained
        # a glob-special char [Bug 946952]
        if {$name eq ""} {
            # Handle empty $name separately due to strangeness
            # in [string first] (See RFE 1243354)
            set cmds $candidates
        } else {
            set cmds [list]
            foreach x $candidates {
            if {[string first $name $x] == 0} {
                lappend cmds $x
            }
            }
        }
        if {[llength $cmds] == 1} {
            uplevel $level [list ::catch [lreplace $args 0 0 [lindex $cmds 0]]  ::tcl::UnknownResult ::tcl::UnknownOptions]
            dict incr ::tcl::UnknownOptions -level
            return -options $::tcl::UnknownOptions $::tcl::UnknownResult
        }
        if {[llength $cmds]} {
            return -code error "ambiguous command name \"$name\": [lsort $cmds]"
        }
        }
        return -code error "invalid command name \"$name\""

    }


proc prompt { } \
{
    puts -nonewline stdout "MyShell > "
    flush stdout
}

proc process { } \
{
    global myshell_evaluation
    set myshell_evaluation true
    catch { uplevel #0 [gets stdin] } got
    set myshell_evaluation false
    if { $got ne "" } {
        puts stderr $got
        flush stderr
    }
    prompt
}

fileevent stdin readable process 

prompt
while { true } { update; after 100 }

其思想是修改::unknown函数，以便将MyShell计算作为tclsh交互式会话的计算来处理。

这是一个丑陋的解决方案，因为我正在修复::unknown函数的代码，这些代码可以针对不同的系统和不同版本的tcl。

是否有解决这些问题的办法？

Answer 1

我认为，最简单的答案是使用您正在使用的方法；重写unknown命令。具体来说，其中有一行检查以确保当前上下文是

• 没有在脚本中运行
• 交互式的
• 在最高层

如果你替换了这一行：

if {([info level] == 1) && ([info script] eq "") && [info exists tcl_interactive] && $tcl_interactive} {

只需要检查水平的东西

if ([info level] == 1} {

你应该得到你想要的。

Answer 2

uplevel不仅计算脚本，而且在执行脚本的实例的调用方的堆栈上下文中计算它。这是一个非常高级的命令，当您定义自己的执行控制结构时，应该使用它，并且OFC是特定于TCL的--我发现自己无法想象tclsh等效项应该如何工作。

如果您只想计算另一个脚本，则正确的TCL命令将是eval。如果另一个脚本是tclsh，为什么不打开另一个tclsh呢？

Answer 3

瓦甘，你确实有正确的解决办法。使用：：未知是tclsh本身如何提供您正在谈论的交互式shell功能(调用外部二进制文件等)。您已经解除了相同的代码，并将其包含在您的MyShell中。

但是，如果我理解你对这是一个“丑陋的解决方案”的担忧，你宁愿不重置：：未知？

在这种情况下，为什么不直接将您想要的附加功能附加到预先存在的：：未知的主体的末尾(或者将其放在前面-您选择)

如果您在Tcl‘’ers wiki上搜索“让未知知道”，您会看到一个简单的proc，它演示了这一点。它将新代码添加到现有的：：未知代码中，因此您可以在执行过程中继续添加额外的“回退代码”。

(抱歉，如果我误解了你为什么觉得你的解决方案“丑陋”)