Tcl Как определить пространство имен импортера из импортированной подпрограммы - PullRequest
1 голос
/ 26 марта 2012

Я пытаюсь реализовать простую объектно-ориентированную систему в Tcl 8.4.18. Я посмотрел на Itcl, остановки, XOTtcl и т. Д. И не решил, хочу ли я их использовать, особенно если я могу сделать это другим простым способом. Во всяком случае, давайте скажем, у меня есть пространство имен

namespace eval Object {
    namespace export setvar

    proc setvar { model name value } {
        set ${model}::${name} $value
    }
}

и затем я "подкласс", если с другим пространством имен

namespace eval Model {
    namespace import ::Object::*
    variable foo 0
}

Я могу установить переменную следующим образом

Model::setvar Model foo 2
puts $Model::foo

который выводит "2". Однако я хотел бы упростить код, чтобы подпрограмма "setvar" из пространства имен Object могла определить, что она вызывается из пространства имен "Model". Примерно так:

proc setvar { name value } {
    set myspace [namespace current]
    set ${namespace}::${name} $value
}

и затем назовите это как

Model::setvar foo 2

но это не работает, потому что [текущее пространство имен] возвращает ":: Object", а не ":: Model". Согласно документации это связано с тем, что импорт просто ссылается на пространство имен объекта.

Причиной использования подпрограммы setvar является попытка реализовать переопределение переменных, чтобы я мог использовать foo из Model, если он существует, в противном случае получить его из Object.

Есть ли другие способы сделать это? Или мне просто использовать один из других инструментов?

Спасибо

1 Ответ

2 голосов
/ 26 марта 2012

Код, который вы ищете: хитро , но возможно сделать (ключ namespace which):

proc setvar { name value } {
    set cmdnameScript [list namespace which [lindex [info level 0] 0]]
    set myspace [namespace qualifiers [uplevel 1 $cmdnameScript]]]
    set ${myspace}::${name} $value
}

Если вы используете 8.5 (или более позднюю версию), рассмотрите возможность замены этой последней set на:

namespace upvar $myspace $name var
set var $value

Намного легче работать, когда все становится сложным. Если это не удастся, используйте upvar (почти так же легко работать с переносной задней панелью, как Tcl 8.0):

upvar 0 ${myspace}::$name var
set var $value
...