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