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