diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2018-09-27 07:22:42 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2018-09-27 07:22:42 (GMT) |
| commit | efa79f01e6397ee0ba17d04a6433e47569db79c6 (patch) | |
| tree | 63a4bc0a84705100b04124e660e8fa3b87d1f8a5 /generic/tclOOScript.h | |
| parent | 9f745ab1cdb74cb094d577d0b4f91dbd842ec5ef (diff) | |
| parent | 90e3bdc291f94c2e3ff1c4e5b0edb6e203966147 (diff) | |
| download | tcl-efa79f01e6397ee0ba17d04a6433e47569db79c6.zip tcl-efa79f01e6397ee0ba17d04a6433e47569db79c6.tar.gz tcl-efa79f01e6397ee0ba17d04a6433e47569db79c6.tar.bz2 | |
Implementation of TIP 516: More OO Slot Operations
Diffstat (limited to 'generic/tclOOScript.h')
| -rw-r--r-- | generic/tclOOScript.h | 29 |
1 files changed, 26 insertions, 3 deletions
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h index e63bd86..2213ce3 100644 --- a/generic/tclOOScript.h +++ b/generic/tclOOScript.h @@ -147,12 +147,35 @@ static const char *tclOOSetupScript = "\t\tmethod Set list {\n" "\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n" "\t\t}\n" -"\t\tmethod -set args {tailcall my Set $args}\n" +"\t\tmethod Resolve list {\n" +"\t\t\treturn $list\n" +"\t\t}\n" +"\t\tmethod -set args {\n" +"\t\t\tset my [namespace which my]\n" +"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n" +"\t\t\ttailcall my Set $args\n" +"\t\t}\n" "\t\tmethod -append args {\n" -"\t\t\tset current [uplevel 1 [list [namespace which my] Get]]\n" +"\t\t\tset my [namespace which my]\n" +"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n" +"\t\t\tset current [uplevel 1 [list $my Get]]\n" "\t\t\ttailcall my Set [list {*}$current {*}$args]\n" "\t\t}\n" "\t\tmethod -clear {} {tailcall my Set {}}\n" +"\t\tmethod -prepend args {\n" +"\t\t\tset my [namespace which my]\n" +"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n" +"\t\t\tset current [uplevel 1 [list $my Get]]\n" +"\t\t\ttailcall my Set [list {*}$args {*}$current]\n" +"\t\t}\n" +"\t\tmethod -remove args {\n" +"\t\t\tset my [namespace which my]\n" +"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n" +"\t\t\tset current [uplevel 1 [list $my Get]]\n" +"\t\t\ttailcall my Set [lmap val $current {\n" +"\t\t\t\tif {$val in $args} continue else {set val}\n" +"\t\t\t}]\n" +"\t\t}\n" "\t\tforward --default-operation my -append\n" "\t\tmethod unknown {args} {\n" "\t\t\tset def --default-operation\n" @@ -163,7 +186,7 @@ static const char *tclOOSetupScript = "\t\t\t}\n" "\t\t\tnext {*}$args\n" "\t\t}\n" -"\t\texport -set -append -clear\n" +"\t\texport -set -append -clear -prepend -remove\n" "\t\tunexport unknown destroy\n" "\t}\n" "\tobjdefine define::superclass forward --default-operation my -set\n" |