summaryrefslogtreecommitdiffstats
path: root/generic/tclOOScript.tcl
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2018-09-08 12:52:06 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2018-09-08 12:52:06 (GMT)
commit0d73b8a7c0c6e90b6c3ed7fcde7b69916b23bedd (patch)
treeb34e93b062e415da30654cadb67c57ffb11791f5 /generic/tclOOScript.tcl
parent4b7caf2e4a373d2616cc7d4f3d05566bd1588b6d (diff)
downloadtcl-0d73b8a7c0c6e90b6c3ed7fcde7b69916b23bedd.zip
tcl-0d73b8a7c0c6e90b6c3ed7fcde7b69916b23bedd.tar.gz
tcl-0d73b8a7c0c6e90b6c3ed7fcde7b69916b23bedd.tar.bz2
Implementation of TIP 516
Diffstat (limited to 'generic/tclOOScript.tcl')
-rw-r--r--generic/tclOOScript.tcl39
1 files changed, 36 insertions, 3 deletions
diff --git a/generic/tclOOScript.tcl b/generic/tclOOScript.tcl
index d3706ce..30af82a 100644
--- a/generic/tclOOScript.tcl
+++ b/generic/tclOOScript.tcl
@@ -276,6 +276,20 @@
# ------------------------------------------------------------------
#
+ # Slot Resolve --
+ #
+ # Helper that lets a slot convert a list of arguments of a
+ # particular type to their canonical forms. Defaults to doing
+ # nothing (suitable for simple strings).
+ #
+ # ------------------------------------------------------------------
+
+ method Resolve list {
+ return $list
+ }
+
+ # ------------------------------------------------------------------
+ #
# Slot -set, -append, -clear, --default-operation --
#
# Standard public slot operations. If a slot can't figure out
@@ -283,12 +297,31 @@
#
# ------------------------------------------------------------------
- method -set args {tailcall my Set $args}
+ method -set args {
+ set args [uplevel 1 [list [namespace which my] Resolve $args]]
+ tailcall my Set $args
+ }
method -append args {
- set current [uplevel 1 [list [namespace which my] Get]]
+ set my [namespace which my]
+ set args [uplevel 1 [list $my Resolve $args]]
+ set current [uplevel 1 [list $my Get]]
tailcall my Set [list {*}$current {*}$args]
}
method -clear {} {tailcall my Set {}}
+ method -prepend args {
+ set my [namespace which my]
+ set args [uplevel 1 [list $my Resolve $args]]
+ set current [uplevel 1 [list $my Get]]
+ tailcall my Set [list {*}$args {*}$current]
+ }
+ method -remove args {
+ set my [namespace which my]
+ set args [uplevel 1 [list $my Resolve $args]]
+ set current [uplevel 1 [list $my Get]]
+ tailcall my Set [lmap val $current {
+ if {$val in $args} continue else {set val}
+ }]
+ }
# Default handling
forward --default-operation my -append
@@ -303,7 +336,7 @@
}
# Set up what is exported and what isn't
- export -set -append -clear
+ export -set -append -clear -prepend -remove
unexport unknown destroy
}