|
0
|
1 ;;; -*- Mode: Emacs-Lisp -*-
|
|
|
2 ;;;
|
|
|
3 ;;; Emacs Tooltalk Utility Functions
|
|
|
4 ;;;
|
|
|
5 ;;; @(#)tooltalk-util.el 1.7 93/12/07
|
|
|
6
|
|
|
7
|
|
|
8 (defun initialize-tooltalk-message-arg (msg n mode value vtype)
|
|
|
9 "Initialize the Nth tooltalk message argument of MSG.
|
|
|
10 A new argument is created if necessary. No attempt to distinguish
|
|
|
11 between strings that contain binary data and ordinary strings is made;
|
|
|
12 all non integer argument values are converted to a string (if not a
|
|
|
13 string already) and loaded with tt_message_arg_val_set().
|
|
|
14 Applications that need to put binary data into a ToolTalk message
|
|
|
15 argument should initialize the argument with:
|
|
|
16
|
|
|
17 (set-tooltalk-message-attribute bin-string msg 'arg_bval arg-n)"
|
|
|
18 (let ((n-args-needed
|
|
|
19 (- (1+ n) (get-tooltalk-message-attribute msg 'args_count))))
|
|
|
20 (while (> n-args-needed 0)
|
|
|
21 (add-tooltalk-message-arg msg mode vtype)
|
|
|
22 (setq n-args-needed (1- n-args-needed))))
|
|
|
23
|
|
|
24 (cond
|
|
|
25 ((integerp value)
|
|
|
26 (set-tooltalk-message-attribute value msg 'arg_ival n))
|
|
|
27 ((stringp value)
|
|
|
28 (set-tooltalk-message-attribute value msg 'arg_val n))
|
|
|
29 (t
|
|
|
30 (error "The value specified for msg %s argument %d, %s, must be a string or an integer"
|
|
|
31 (prin1-to-string msg)
|
|
|
32 n
|
|
|
33 (prin1-to-string value)))))
|
|
|
34
|
|
|
35
|
|
|
36
|
|
|
37 (defconst tooltalk-arg-mode-ids
|
|
|
38 (list 'TT_IN 'TT_OUT 'TT_INOUT TT_IN TT_OUT TT_INOUT))
|
|
|
39
|
|
|
40 (defun initialize-tooltalk-message/pattern-args (initfn msg args)
|
|
|
41 "Apply INITFN to each the position mode value and type of
|
|
|
42 each argument in the list. The value of INITFN should be either
|
|
|
43 'initialize-tooltalk-message-arg or 'initialize-tooltalk-pattern-arg.
|
|
|
44 See `make-tooltalk-message' for a description of how arguments are specified.
|
|
|
45 We distinguish the short form for arguments, e.g. \"just-a-value\",
|
|
|
46 from the long form by checking to see if the argument is a list whose
|
|
|
47 car is one of the ToolTalk mode values like TT_INOUT."
|
|
|
48 (let ((n 0))
|
|
|
49 (while args
|
|
|
50 (let* ((arg (car args))
|
|
|
51 (long-form
|
|
|
52 (and (consp arg)
|
|
|
53 (member (car arg) tooltalk-arg-mode-ids)))
|
|
|
54 (mode
|
|
|
55 (if long-form (car arg) TT_IN))
|
|
|
56 (value
|
|
|
57 (cond
|
|
|
58 ((not long-form) arg)
|
|
|
59 ((cdr arg) (car (cdr arg)))
|
|
|
60 (t "")))
|
|
|
61 (type
|
|
|
62 (cond
|
|
|
63 ((and long-form
|
|
|
64 (cdr (cdr arg))
|
|
|
65 (stringp (car (cdr (cdr arg)))))
|
|
|
66 (car (cdr (cdr arg))))
|
|
|
67 ((integerp value) "int")
|
|
|
68 (t "string"))))
|
|
|
69 (funcall initfn msg n mode value type))
|
|
|
70 (setq args (cdr args))
|
|
|
71 (setq n (1+ n)))))
|
|
|
72
|
|
|
73
|
|
|
74 (defun initialize-tooltalk-message-attributes (msg attributes)
|
|
|
75 "Initialize the tooltalk message attributes. The value of
|
|
|
76 attributes must be a property list in the same form as for
|
|
|
77 make-tooltalk-message. This function can be used to reset
|
|
108
|
78 an existing message or to initialize a new one. See
|
|
0
|
79 initialize-tooltalk-message-args for a description of how
|
|
|
80 arguments are initialized."
|
|
|
81 (let ((args attributes)
|
|
|
82 (initfn 'initialize-tooltalk-message-arg))
|
|
|
83 (while (and args (cdr args))
|
|
|
84 (let ((indicator (car args))
|
|
|
85 (value (car (cdr args))))
|
|
|
86 (if (eq indicator 'args)
|
|
|
87 (initialize-tooltalk-message/pattern-args initfn msg value)
|
|
|
88 (set-tooltalk-message-attribute value msg indicator)))
|
|
|
89 (setq args (cdr (cdr args))))))
|
|
|
90
|
|
|
91
|
|
|
92 (defun make-tooltalk-message (attributes &optional no-callback)
|
|
|
93 "Create a tooltalk message and initialize its attributes.
|
|
|
94 The value of attributes must be a list of alternating keyword/values,
|
|
|
95 where keywords are symbols that name valid message attributes.
|
|
|
96 For example:
|
|
|
97
|
|
|
98 (make-tooltalk-message
|
|
|
99 '(class TT_NOTICE
|
|
|
100 scope TT_SESSION
|
|
|
101 address TT_PROCEDURE
|
|
|
102 op \"do-something\"
|
|
|
103 args (\"arg1\" 12345 (TT_INOUT \"arg3\" \"string\"))))
|
|
|
104
|
|
|
105 Values must always be strings, integers, or symbols that
|
|
|
106 represent Tooltalk constants. Attribute names are the same as
|
|
|
107 those supported by set-tooltalk-message-attribute, plus 'args.
|
|
|
108
|
|
|
109 The value of args should be a list of message arguments where
|
|
|
110 each message argument has the following form:
|
|
|
111
|
|
|
112 (mode [value [type]]) or just value
|
|
|
113
|
|
|
114 Where mode is one of TT_IN, TT_OUT, TT_INOUT and type is a string.
|
|
|
115 If type isn't specified then \"int\" is used if the value is a
|
|
|
116 number otherwise \"string\" is used. If only a value is specified
|
|
|
117 then mode defaults to TT_IN. If mode is TT_OUT then value and
|
|
|
118 type don't need to be specified. You can find out more about the
|
|
|
119 semantics and uses of ToolTalk message arguments in chapter 4 of the
|
|
|
120 Tooltalk Programmer's Guide.
|
|
|
121
|
|
|
122 The no-callback arg is a hack to prevent the registration of the
|
|
|
123 C-level callback. This hack is needed by the current SPARCworks
|
|
108
|
124 tool startup mechanism. Yucko."
|
|
0
|
125 (let ((msg (create-tooltalk-message no-callback)))
|
|
|
126 (initialize-tooltalk-message-attributes msg attributes)
|
|
|
127 msg))
|
|
|
128
|
|
|
129
|
|
|
130 (defun describe-tooltalk-message (msg &optional stream)
|
|
|
131 "Print tooltalk message MSG's attributes and arguments to STREAM.
|
|
|
132 This is often useful for debugging."
|
|
|
133 (let ((attrs
|
|
|
134 '(address
|
|
|
135 class
|
|
|
136 disposition
|
|
|
137 file
|
|
|
138 gid
|
|
|
139 handler
|
|
|
140 handler_ptype
|
|
|
141 object
|
|
|
142 op
|
|
|
143 opnum
|
|
|
144 otype
|
|
|
145 scope
|
|
|
146 sender
|
|
|
147 sender_ptype
|
|
|
148 session
|
|
|
149 state
|
|
|
150 status
|
|
|
151 status_string
|
|
|
152 uid
|
|
|
153 callback)))
|
|
|
154 (terpri stream)
|
|
|
155 (while attrs
|
|
|
156 (princ (car attrs) stream)
|
|
|
157 (princ " " stream)
|
|
|
158 (prin1 (get-tooltalk-message-attribute msg (car attrs)) stream)
|
|
|
159 (terpri stream)
|
|
|
160 (setq attrs (cdr attrs))))
|
|
|
161
|
|
|
162 (let ((n (get-tooltalk-message-attribute msg 'args_count))
|
|
|
163 (i 0))
|
|
|
164 (while (< i n)
|
|
|
165 (princ "Argument " stream)
|
|
|
166 (princ i stream)
|
|
|
167 (princ " " stream)
|
|
|
168 (let ((type (get-tooltalk-message-attribute msg 'arg_type i)))
|
|
|
169 (princ
|
|
|
170 (prin1-to-string
|
|
|
171 (list
|
|
|
172 (get-tooltalk-message-attribute msg 'arg_mode i)
|
|
|
173 (if (equal type "int")
|
|
|
174 (get-tooltalk-message-attribute msg 'arg_ival i)
|
|
|
175 (get-tooltalk-message-attribute msg 'arg_val i))
|
|
|
176 type))
|
|
|
177 stream))
|
|
|
178 (terpri stream)
|
|
|
179 (setq i (1+ i)))))
|
|
|
180
|
|
|
181
|
|
|
182 (defun initialize-tooltalk-pattern-arg (pat n mode value vtype)
|
|
|
183 "Add one argument to tooltalk pattern PAT.
|
|
|
184 No support for specifying pattern arguments whose value is a vector
|
|
|
185 of binary data is provided."
|
|
|
186 (let ((converted-value
|
|
|
187 (if (or (integerp value) (stringp value))
|
|
|
188 value
|
|
|
189 (prin1-to-string value))))
|
|
|
190 (add-tooltalk-pattern-arg pat mode vtype converted-value)))
|
|
|
191
|
|
|
192
|
|
|
193 (defun initialize-tooltalk-pattern-attributes (pat attributes)
|
|
|
194 "Initialize tooltalk pattern PAT's attributes.
|
|
|
195 ATTRIBUTES must be a property list in the same form as for
|
|
|
196 `make-tooltalk-pattern'. The value of each attribute (except 'category)
|
|
|
197 can either be a single value or a list of values. If a list of
|
|
|
198 values is provided then the pattern will match messages with
|
|
|
199 a corresponding attribute that matches any member of the list.
|
|
|
200
|
|
|
201 This function can be used to add attribute values to an existing
|
|
108
|
202 pattern or to initialize a new one. See
|
|
0
|
203 `initialize-tooltalk-message/pattern-args' for a description of how
|
|
|
204 arguments are initialized."
|
|
|
205 (let ((args attributes)
|
|
|
206 (initfn 'initialize-tooltalk-pattern-arg))
|
|
|
207 (while (and args (cdr args))
|
|
|
208 (let ((indicator (car args))
|
|
|
209 (value (car (cdr args))))
|
|
|
210 (cond
|
|
|
211 ((eq indicator 'args)
|
|
|
212 (initialize-tooltalk-message/pattern-args initfn pat value))
|
|
|
213 ((eq indicator 'plist)
|
|
|
214 (let ((values value))
|
|
|
215 (while values
|
|
|
216 (let ((prop (car values))
|
|
|
217 (propval (car (cdr values))))
|
|
|
218 (tooltalk-pattern-prop-set pat prop propval))
|
|
|
219 (setq values (cdr (cdr values))))))
|
|
|
220 ((consp value)
|
|
|
221 (let ((values value))
|
|
|
222 (while values
|
|
|
223 (add-tooltalk-pattern-attribute (car values) pat indicator)
|
|
|
224 (setq values (cdr values)))))
|
|
|
225 (t
|
|
|
226 (add-tooltalk-pattern-attribute value pat indicator))))
|
|
|
227 (setq args (cdr (cdr args))))))
|
|
|
228
|
|
|
229
|
|
|
230
|
|
|
231 (defun make-tooltalk-pattern (attributes)
|
|
|
232 "Create a tooltalk pattern and initialize its attributes.
|
|
|
233 The value of attributes must be a list of alternating keyword/values,
|
|
|
234 where keywords are symbols that name valid pattern attributes
|
|
|
235 or lists of valid attributes. For example:
|
|
|
236
|
|
|
237 (make-tooltalk-pattern
|
|
|
238 '(category TT_OBSERVE
|
|
|
239 scope TT_SESSION
|
|
|
240 op (\"operation1\" \"operation2\")
|
|
|
241 args (\"arg1\" 12345 (TT_INOUT \"arg3\" \"string\"))))
|
|
|
242
|
|
|
243
|
|
|
244 Values must always be strings, integers, or symbols that
|
|
|
245 represent Tooltalk constants or lists of same. When a list
|
|
|
246 of values is provided all of the list elements are added to
|
|
|
247 the attribute. In the example above, messages whose op
|
|
|
248 attribute is \"operation1\" or \"operation2\" would match the pattern.
|
|
|
249
|
|
|
250 The value of args should be a list of pattern arguments where
|
|
|
251 each pattern argument has the following form:
|
|
|
252
|
|
|
253 (mode [value [type]]) or just value
|
|
|
254
|
|
|
255 Where mode is one of TT_IN, TT_OUT, TT_INOUT and type is a string.
|
|
|
256 If type isn't specified then \"int\" is used if the value is a
|
|
|
257 number otherwise \"string\" is used. If only a value is specified
|
|
|
258 then mode defaults to TT_IN. If mode is TT_OUT then value and type
|
|
|
259 don't need to be specified. You can find out more about the semantics
|
|
|
260 and uses of ToolTalk pattern arguments in chapter 3 of the Tooltalk
|
|
|
261 Programmers Guide.
|
|
|
262 "
|
|
|
263 (let ((pat (create-tooltalk-pattern)))
|
|
|
264 (initialize-tooltalk-pattern-attributes pat attributes)
|
|
|
265 pat))
|
|
|
266
|
|
|
267
|
|
|
268
|
