Как оценить скрипт tclsh?

Question

Как оценить скрипт tclsh?

tclsh - это оболочка, содержащая команды TCL.

TCL uplevel Команда оценивает данный сценарий TCL, но не может оценить сценарий tclsh (который может содержать команды bash).

Как я могу получить аналог uplevel для сценария tclsh?

Рассмотрим этот скрипт 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, как вы можете сделать это в интерактивном сеансе tclsh. Например, вы не можете открыть 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.

Есть ли решение, которое обходит эти проблемы?

1

bash shell tcl eval uplevel

Источник

user371239 04 янв '12 в 21:05

4 ответа

Решение

uplevel не только оценивает скрипт, но и оценивает его в контексте стека вызывающей стороны экземпляра, в котором он выполняется. Это довольно продвинутая команда, которая должна использоваться, когда вы определяете свои собственные структуры управления выполнением, а OFC специфичен для TCL - я не могу представить, как должен работать эквивалент tclsh.

Если вы просто хотите оценить другой скрипт, правильная команда TCL будет eval. Если этот другой скрипт - tclsh, почему бы вам просто не открыть другой tclsh?

1

Источник

user1121831 04 янв '12 в 21:13

Вместо изменения unknown proc, я предлагаю вам внести изменения, чтобы оценить выражение

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

к истине.

info level: называть свои вещи с uplevel #0 $code
info script: вызов info script {} установить его в пустое значение
tcl_interactive, Просто: set ::tcl_interactive 1

так твой код будет

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
set tcl_interactive 1
info script {}
prompt
vwait forever

0

Источник

user845414 27 апр '13 в 11:21

Ваган, у тебя есть правильное решение. Использование:: unknown - это то, как сам tclsh обеспечивает функционал интерактивной оболочки, о котором вы говорите (вызов внешних двоичных файлов и т. Д.). И вы подняли тот же код и включили его в свой MyShell.

Но, если я понимаю ваши опасения по поводу того, что это "уродливое решение", вы бы не сбросили: unknown?

В таком случае, почему бы просто не добавить дополнительную функциональность, которую вы хотите, в конец существующего тела:: unknown (или добавить его - вы выбираете)

Если вы поищете в вики Tcl'ers слово "сообщите неизвестному", вы увидите простой процесс, демонстрирующий это. Он добавляет новый код к существующему:: unknown, так что вы можете продолжать добавлять дополнительный "резервный код" по мере продвижения.

(извиняюсь, если я неправильно понял, почему вы считаете, что ваше решение "безобразно")

0

Источник

user938633 26 апр '13 в 11:27

Другие вопросы по тегам bash shell tcl eval uplevel

user26816 05 янв '12 в 14:01 2012-01-05 14:01 · Accepted Answer · 2012-01-05 14:01

Я думаю, что самый простой ответ - использовать подход, который вы используете; переписать unknown команда. В частности, есть строка, которая проверяет, чтобы убедиться, что текущий контекст

Не запускается в скрипте
интерактивный
На верхнем уровне

Если вы замените эту строку:

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

с чем-то, что просто проверяет уровень

if ([info level] == 1} {

Вы должны получить то, что вы хотите.