1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Date: Wed Dec 16 17:40:58 1992
;;; File: tooltalk-macros.el
;;; Title: Useful macros for ToolTalk/elisp interface
;;; SCCS: @(#)tooltalk-macros.el 1.5 21 Jan 1993 19:09:24
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro destructuring-bind-tooltalk-message (variables
args-count
message
&rest body)
"
arglist: (variables args-count message &rest body)
Binds VARIABLES to the ARG_VALs and ARG_IVALs of MESSAGE,
starting from N = 0, and executes BODY in that context.
Binds actual number of message args to ARGS-COUNT.
VARIABLES is a list of local variables to bind.
Each item in VARIABLES is either nil, a symbol, or a list of the form:
(symbol type)
If the item is nil, the nth ARG_VAL or ARG_IVAL of MESSAGE is skipped.
If the item is a symbol, the nth ARG_VAL of MESSAGE is bound.
If the item is a list
If type = \"int\" the nth ARG_IVAL of MESSAGE is bound,
otherwise the nth ARG_VAL of MESSAGE is bound.
If there are more items than actual arguments in MESSAGE, the extra
items are bound to nil.
For example,
(destructuring-bind-tooltalk-message (a (b \"int\") nil d) foo msg
x y z)
expands to
(let* ((foo (get-tooltalk-message-attribute msg 'args_count))
(a (if (< 0 foo)
(get-tooltalk-message-attribute msg 'arg_val 0)))
(b (if (< 1 foo)
(get-tooltalk-message-attribute msg 'arg_val 1)))
(d (if (< 3 foo)
(get-tooltalk-message-attribute msg 'arg_val 3))))
x y z)
See GET-TOOLTALK-MESSAGE-ATTRIBUTE for more information.
"
(let* ((var-list variables)
(nargs args-count)
(msg message)
(n -1)
var-item
var
type
request
bindings)
(setq bindings (cons
(list nargs
(list
'get-tooltalk-message-attribute
msg
''args_count))
bindings))
(while var-list
(setq var-item (car var-list)
var-list (cdr var-list))
(if (eq 'nil var-item)
(setq n (1+ n))
(progn
(if (listp var-item)
(setq var (car var-item)
type (car (cdr var-item)))
(setq var var-item
type "string"))
(setq n (1+ n))
(setq request (list
'get-tooltalk-message-attribute
msg
(if (equal "int" type)
''arg_ival
''arg_val)
n))
(setq bindings (cons
(list var
(list 'if
(list '< n nargs)
request))
bindings)))))
(nconc (list 'let* (nreverse bindings)) body)))
|
