1# interp.tcl 2# Some utility commands for creation of delegation methods. 3# (Delegation of methods to a remote interpreter via a comm 4# handle). 5# 6# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> 7# 8# See the file "license.terms" for information on usage and redistribution 9# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 10# 11# RCS: @(#) $Id: deleg_method.tcl,v 1.2 2006/09/01 19:58:21 andreas_kupries Exp $ 12 13package require Tcl 8.3 14package require snit 15 16# ### ### ### ######### ######### ######### 17## Requisites 18 19namespace eval ::interp::delegate {} 20 21# ### ### ### ######### ######### ######### 22## Public API 23 24snit::macro ::interp::delegate::method {args} { 25 # syntax: ?-async? name arguments comm id 26 27 set async 0 28 while {[string match -* [set opt [lindex $args 0]]]} { 29 switch -exact -- $opt { 30 -async {set async 1 ; set args [lrange $args 1 end]} 31 default { 32 return -code error "unknown option \"$opt\", expected -async" 33 } 34 } 35 } 36 if {[llength $args] != 4} { 37 return -code error "wrong # args" 38 } 39 foreach {name arguments comm rid} $args break 40 41 if {![llength $arguments]} { 42 set delegate "[list $name]" 43 } elseif {[string equal args [lindex $arguments end]]} { 44 if {[llength $arguments] == 1} { 45 set delegate "\[linsert \$args 0 [list $name]\]" 46 } else { 47 set delegate "\[linsert \$args 0 [list $name] \$[join [lrange $arguments 0 end-1] " \$"]\]" 48 } 49 } else { 50 set delegate "\[list [list $name] \$[join $arguments " \$"]\]" 51 } 52 53 set body "" 54 append body [list $comm] " " "send " 55 if {$async} {append body "-async "} 56 append body [list $rid] " " $delegate 57 58 ::method $name $arguments $body 59} 60 61# ### ### ### ######### ######### ######### 62## Ready to go 63 64package provide interp::delegate::method 0.2 65