annotate src/tooltalk.c @ 355:182f72e8cd0d r21-1-7

Import from CVS: tag r21-1-7
author cvs
date Mon, 13 Aug 2007 10:56:21 +0200
parents 8429d81ab209
children cc15677e0335
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1 /* Tooltalk support for Emacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
2 Copyright (C) 1993, 1994 Sun Microsystems, Inc.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
3 Copyright (C) 1995 Free Software Foundation, Inc.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
4
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
5 This file is part of XEmacs.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
6
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
10 later version.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
11
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
15 for more details.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
16
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
21
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
22 /* Synched up with: Not in FSF. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
23
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
24 /* Written by John Rose <john.rose@eng.sun.com>.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
25 Heavily modified and cleaned up by Ben Wing <ben.wing@eng.sun.com>. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
26
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
27 #include <config.h>
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
28 #include "lisp.h"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
29
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
30 #include <X11/Xlib.h>
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
31
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
32 #include "buffer.h"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
33 #include "elhash.h"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
34 #include "process.h"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
35 #include "tooltalk.h"
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
36
355
182f72e8cd0d Import from CVS: tag r21-1-7
cvs
parents: 349
diff changeset
37 #include "syssignal.h"
182f72e8cd0d Import from CVS: tag r21-1-7
cvs
parents: 349
diff changeset
38
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
39 Lisp_Object Vtooltalk_fd;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
40
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
41 #ifdef TT_DEBUG
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
42 static FILE *tooltalk_log_file;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
43 #endif
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
44
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
45 static Lisp_Object
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
46 Vtooltalk_message_handler_hook,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
47 Vtooltalk_pattern_handler_hook,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
48 Vtooltalk_unprocessed_message_hook;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
49
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
50 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
51 Qtooltalk_message_handler_hook,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
52 Qtooltalk_pattern_handler_hook,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
53 Qtooltalk_unprocessed_message_hook;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
54
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
55 static Lisp_Object
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
56 Qreceive_tooltalk_message,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
57 Qtt_address,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
58 Qtt_args_count,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
59 Qtt_arg_bval,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
60 Qtt_arg_ival,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
61 Qtt_arg_mode,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
62 Qtt_arg_type,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
63 Qtt_arg_val,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
64 Qtt_class,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
65 Qtt_category,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
66 Qtt_disposition,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
67 Qtt_file,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
68 Qtt_gid,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
69 Qtt_handler,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
70 Qtt_handler_ptype,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
71 Qtt_object,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
72 Qtt_op,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
73 Qtt_opnum,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
74 Qtt_otype,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
75 Qtt_scope,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
76 Qtt_sender,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
77 Qtt_sender_ptype,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
78 Qtt_session,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
79 Qtt_state,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
80 Qtt_status,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
81 Qtt_status_string,
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
82 Qtt_uid,
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
83 Qtt_callback,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
84 Qtt_plist,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
85 Qtt_prop,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
86
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
87 Qtt_reject, /* return-tooltalk-message */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
88 Qtt_reply,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
89 Qtt_fail,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
90
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
91 Q_TT_MODE_UNDEFINED, /* enum Tt_mode */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
92 Q_TT_IN,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
93 Q_TT_OUT,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
94 Q_TT_INOUT,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
95 Q_TT_MODE_LAST,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
96
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
97 Q_TT_SCOPE_NONE, /* enum Tt_scope */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
98 Q_TT_SESSION,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
99 Q_TT_FILE,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
100 Q_TT_BOTH,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
101 Q_TT_FILE_IN_SESSION,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
102
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
103 Q_TT_CLASS_UNDEFINED, /* enum Tt_class */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
104 Q_TT_NOTICE,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
105 Q_TT_REQUEST,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
106 Q_TT_CLASS_LAST,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
107
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
108 Q_TT_CATEGORY_UNDEFINED, /* enum Tt_category */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
109 Q_TT_OBSERVE,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
110 Q_TT_HANDLE,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
111 Q_TT_CATEGORY_LAST,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
112
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
113 Q_TT_PROCEDURE, /* typedef enum Tt_address */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
114 Q_TT_OBJECT,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
115 Q_TT_HANDLER,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
116 Q_TT_OTYPE,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
117 Q_TT_ADDRESS_LAST,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
118
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
119 Q_TT_CREATED, /* enum Tt_state */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
120 Q_TT_SENT,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
121 Q_TT_HANDLED,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
122 Q_TT_FAILED,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
123 Q_TT_QUEUED,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
124 Q_TT_STARTED,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
125 Q_TT_REJECTED,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
126 Q_TT_STATE_LAST,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
127
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
128 Q_TT_DISCARD, /* enum Tt_disposition */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
129 Q_TT_QUEUE,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
130 Q_TT_START;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
131
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
132 static Lisp_Object Tooltalk_Message_plist_str, Tooltalk_Pattern_plist_str;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
133
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
134 Lisp_Object Qtooltalk_error;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
135
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
136 /* Used to GCPRO tooltalk message and pattern objects while
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
137 they're sitting inside of some active tooltalk message or pattern.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
138 There may not be any other pointers to these objects. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
139 Lisp_Object Vtooltalk_message_gcpro, Vtooltalk_pattern_gcpro;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
140
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
141
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
142 /* */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
143 /* machinery for tooltalk-message type */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
144 /* */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
145
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
146 Lisp_Object Qtooltalk_messagep;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
147
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
148 struct Lisp_Tooltalk_Message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
149 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
150 struct lcrecord_header header;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
151 Lisp_Object plist_sym, callback;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
152 Tt_message m;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
153 };
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
154
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
155 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
156 mark_tooltalk_message (Lisp_Object obj, void (*markobj) (Lisp_Object))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
157 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
158 (markobj) (XTOOLTALK_MESSAGE (obj)->callback);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
159 return XTOOLTALK_MESSAGE (obj)->plist_sym;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
160 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
161
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
162 static void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
163 print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
164 int escapeflag)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
165 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
166 struct Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
167
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
168 char buf[200];
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
169
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
170 if (print_readably)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
171 error ("printing unreadable object #<tooltalk_message 0x%x>",
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
172 p->header.uid);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
173
169
15872534500d Import from CVS: tag r20-3b11
cvs
parents: 149
diff changeset
174 sprintf (buf, "#<tooltalk_message id:%p 0x%x>", p->m, p->header.uid);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
175 write_c_string (buf, printcharfun);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
176 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
177
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
178 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message,
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
179 mark_tooltalk_message, print_tooltalk_message,
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
180 0, 0, 0,
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
181 struct Lisp_Tooltalk_Message);
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
182
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
183 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
184 make_tooltalk_message (Tt_message m)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
185 {
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
186 Lisp_Object val;
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
187 struct Lisp_Tooltalk_Message *msg =
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
188 alloc_lcrecord_type (struct Lisp_Tooltalk_Message,
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
189 lrecord_tooltalk_message);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
190
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
191 msg->m = m;
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
192 msg->callback = Qnil;
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
193 msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str);
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
194 XSETTOOLTALK_MESSAGE (val, msg);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
195 return val;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
196 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
197
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
198 Tt_message
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
199 unbox_tooltalk_message (Lisp_Object msg)
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
200 {
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
201 CHECK_TOOLTALK_MESSAGE (msg);
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
202 return XTOOLTALK_MESSAGE (msg)->m;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
203 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
204
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
205 DEFUN ("tooltalk-message-p", Ftooltalk_message_p, 1, 1, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
206 Return non-nil if OBJECT is a tooltalk message.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
207 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
208 (object))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
209 {
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
210 return TOOLTALK_MESSAGEP (object) ? Qt : Qnil;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
211 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
212
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
213
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
214
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
215
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
216 /* */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
217 /* machinery for tooltalk-pattern type */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
218 /* */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
219
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
220 Lisp_Object Qtooltalk_patternp;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
221
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
222 struct Lisp_Tooltalk_Pattern
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
223 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
224 struct lcrecord_header header;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
225 Lisp_Object plist_sym, callback;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
226 Tt_pattern p;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
227 };
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
228
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
229 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
230 mark_tooltalk_pattern (Lisp_Object obj, void (*markobj) (Lisp_Object))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
231 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
232 (markobj) (XTOOLTALK_PATTERN (obj)->callback);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
233 return XTOOLTALK_PATTERN (obj)->plist_sym;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
234 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
235
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
236 static void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
237 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
238 int escapeflag)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
239 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
240 struct Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
241
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
242 char buf[200];
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
243
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
244 if (print_readably)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
245 error ("printing unreadable object #<tooltalk_pattern 0x%x>",
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
246 p->header.uid);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
247
169
15872534500d Import from CVS: tag r20-3b11
cvs
parents: 149
diff changeset
248 sprintf (buf, "#<tooltalk_pattern id:%p 0x%x>", p->p, p->header.uid);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
249 write_c_string (buf, printcharfun);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
250 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
251
272
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
252 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern,
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
253 mark_tooltalk_pattern, print_tooltalk_pattern,
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
254 0, 0, 0,
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
255 struct Lisp_Tooltalk_Pattern);
c5d627a313b1 Import from CVS: tag r21-0b34
cvs
parents: 227
diff changeset
256
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
257 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
258 make_tooltalk_pattern (Tt_pattern p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
259 {
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
260 struct Lisp_Tooltalk_Pattern *pat =
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
261 alloc_lcrecord_type (struct Lisp_Tooltalk_Pattern,
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
262 lrecord_tooltalk_pattern);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
263 Lisp_Object val;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
264
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
265 pat->p = p;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
266 pat->callback = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
267 pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
268
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
269 XSETTOOLTALK_PATTERN (val, pat);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
270 return val;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
271 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
272
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
273 static Tt_pattern
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
274 unbox_tooltalk_pattern (Lisp_Object pattern)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
275 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
276 CHECK_TOOLTALK_PATTERN (pattern);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
277 return XTOOLTALK_PATTERN (pattern)->p;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
278 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
279
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
280 DEFUN ("tooltalk-pattern-p", Ftooltalk_pattern_p, 1, 1, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
281 Return non-nil if OBJECT is a tooltalk pattern.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
282 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
283 (object))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
284 {
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
285 return TOOLTALK_PATTERNP (object) ? Qt : Qnil;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
286 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
287
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
288
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
289
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
290
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
291 static int
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
292 tooltalk_constant_value (Lisp_Object s)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
293 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
294 if (INTP (s))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
295 return XINT (s);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
296 else if (SYMBOLP (s))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
297 return XINT (XSYMBOL (s)->value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
298 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
299 return 0; /* should never occur */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
300 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
301
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
302 static void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
303 check_status (Tt_status st)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
304 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
305 if (tt_is_err (st))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
306 signal_error (Qtooltalk_error,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
307 Fcons (build_string (tt_status_message (st)), Qnil));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
308 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
309
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
310 DEFUN ("receive-tooltalk-message", Freceive_tooltalk_message, 0, 2, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
311 Run tt_message_receive().
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
312 This function is the process handler for the ToolTalk connection process.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
313 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
314 (ignore1, ignore2))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
315 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
316 /* This function can GC */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
317 Tt_message mess = tt_message_receive ();
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
318 Lisp_Object message_ = make_tooltalk_message (mess);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
319 struct gcpro gcpro1;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
320
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
321 GCPRO1 (message_);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
322 if (mess != NULL && !NILP (Vtooltalk_unprocessed_message_hook))
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
323 va_run_hook_with_args (Qtooltalk_unprocessed_message_hook, 1, message_);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
324 UNGCPRO;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
325
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
326 /* see comment in event-stream.c about this return value. */
227
0e522484dd2a Import from CVS: tag r20-5b12
cvs
parents: 185
diff changeset
327 return Qzero;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
328 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
329
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
330 static Tt_callback_action
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
331 tooltalk_message_callback (Tt_message m, Tt_pattern p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
332 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
333 /* This function can GC */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
334 Lisp_Object cb;
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
335 Lisp_Object message_;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
336 Lisp_Object pattern;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
337 struct gcpro gcpro1, gcpro2;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
338
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
339 #ifdef TT_DEBUG
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
340 int i, j;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
341
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
342 fprintf (tooltalk_log_file, "message_cb: %d\n", m);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
343 fprintf (tooltalk_log_file, "op: %s (", tt_message_op (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
344 for (j = tt_message_args_count (m), i = 0; i < j; i++) {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
345 fprintf (tooltalk_log_file, "%s \"%s\"", tt_message_arg_type (m, i),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
346 tt_message_arg_val (m, i));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
347 fprintf (tooltalk_log_file, "%s", i == j-1 ? ")" : ", ");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
348 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
349 fprintf (tooltalk_log_file, "\n\n");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
350 fflush (tooltalk_log_file);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
351 #endif
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
352
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
353 VOID_TO_LISP (message_, tt_message_user (m, TOOLTALK_MESSAGE_KEY));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
354 pattern = make_tooltalk_pattern (p);
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
355 cb = XTOOLTALK_MESSAGE (message_)->callback;
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
356 GCPRO2 (message_, pattern);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
357 if (!NILP (Vtooltalk_message_handler_hook))
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
358 va_run_hook_with_args (Qtooltalk_message_handler_hook, 2,
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
359 message_, pattern);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
360
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
361 if ((SYMBOLP (cb) && EQ (Qt, Ffboundp (cb))) ||
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
362 (CONSP (cb) && EQ (Qlambda, Fcar (cb)) &&
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
363 !NILP (Flistp (Fcar (Fcdr (cb))))))
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
364 call2 (cb, message_, pattern);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
365 UNGCPRO;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
366
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
367 tt_message_destroy (m);
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
368 Fremhash (message_, Vtooltalk_message_gcpro);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
369
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
370 return TT_CALLBACK_PROCESSED;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
371 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
372
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
373 static Tt_callback_action
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
374 tooltalk_pattern_callback (Tt_message m, Tt_pattern p)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
375 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
376 /* This function can GC */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
377 Lisp_Object cb;
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
378 Lisp_Object message_;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
379 Lisp_Object pattern;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
380 struct gcpro gcpro1, gcpro2;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
381
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
382 #ifdef TT_DEBUG
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
383 int i, j;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
384
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
385 fprintf (tooltalk_log_file, "pattern_cb: %d\n", m);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
386 fprintf (tooltalk_log_file, "op: %s (", tt_message_op (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
387 for (j = tt_message_args_count (m), i = 0; i < j; i++) {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
388 fprintf (tooltalk_log_file, "%s \"%s\"", tt_message_arg_type (m, i),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
389 tt_message_arg_val (m, i));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
390 fprintf (tooltalk_log_file, "%s", i == j-1 ? ")" : ", ");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
391 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
392 fprintf (tooltalk_log_file, "\n\n");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
393 fflush (tooltalk_log_file);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
394 #endif
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
395
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
396 message_ = make_tooltalk_message (m);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
397 VOID_TO_LISP (pattern, tt_pattern_user (p, TOOLTALK_PATTERN_KEY));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
398 cb = XTOOLTALK_PATTERN (pattern)->callback;
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
399 GCPRO2 (message_, pattern);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
400 if (!NILP (Vtooltalk_pattern_handler_hook))
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
401 va_run_hook_with_args (Qtooltalk_pattern_handler_hook, 2,
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
402 message_, pattern);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
403
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
404 if (SYMBOLP (cb) && EQ (Qt, Ffboundp (cb)))
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
405 call2 (cb, message_, pattern);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
406 UNGCPRO;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
407
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
408 tt_message_destroy (m);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
409 return TT_CALLBACK_PROCESSED;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
410 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
411
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
412 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
413 tt_mode_symbol (Tt_mode n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
414 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
415 switch (n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
416 {
78
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
417 case TT_MODE_UNDEFINED: return Q_TT_MODE_UNDEFINED;
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
418 case TT_IN: return Q_TT_IN;
78
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
419 case TT_OUT: return Q_TT_OUT;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
420 case TT_INOUT: return Q_TT_INOUT;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
421 case TT_MODE_LAST: return Q_TT_MODE_LAST;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
422 default: return Qnil;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
423 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
424 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
425
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
426 static Lisp_Object
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
427 tt_scope_symbol (Tt_scope n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
428 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
429 switch (n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
430 {
78
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
431 case TT_SCOPE_NONE: return Q_TT_SCOPE_NONE;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
432 case TT_SESSION: return Q_TT_SESSION;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
433 case TT_FILE: return Q_TT_FILE;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
434 case TT_BOTH: return Q_TT_BOTH;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
435 case TT_FILE_IN_SESSION: return Q_TT_FILE_IN_SESSION;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
436 default: return Qnil;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
437 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
438 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
439
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
440
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
441 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
442 tt_class_symbol (Tt_class n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
443 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
444 switch (n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
445 {
78
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
446 case TT_CLASS_UNDEFINED: return Q_TT_CLASS_UNDEFINED;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
447 case TT_NOTICE: return Q_TT_NOTICE;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
448 case TT_REQUEST: return Q_TT_REQUEST;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
449 case TT_CLASS_LAST: return Q_TT_CLASS_LAST;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
450 default: return Qnil;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
451 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
452 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
453
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
454 /*
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
455 * This is not being used. Is that a mistake or is this function
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
456 * simply not necessary?
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
457 */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
458 #if 0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
459 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
460 tt_category_symbol (Tt_category n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
461 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
462 switch (n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
463 {
78
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
464 case TT_CATEGORY_UNDEFINED: return Q_TT_CATEGORY_UNDEFINED;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
465 case TT_OBSERVE: return Q_TT_OBSERVE;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
466 case TT_HANDLE: return Q_TT_HANDLE;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
467 case TT_CATEGORY_LAST: return Q_TT_CATEGORY_LAST;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
468 default: return Qnil;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
469 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
470 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
471 #endif /* 0 */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
472
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
473 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
474 tt_address_symbol (Tt_address n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
475 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
476 switch (n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
477 {
78
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
478 case TT_PROCEDURE: return Q_TT_PROCEDURE;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
479 case TT_OBJECT: return Q_TT_OBJECT;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
480 case TT_HANDLER: return Q_TT_HANDLER;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
481 case TT_OTYPE: return Q_TT_OTYPE;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
482 case TT_ADDRESS_LAST: return Q_TT_ADDRESS_LAST;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
483 default: return Qnil;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
484 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
485 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
486
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
487 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
488 tt_state_symbol (Tt_state n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
489 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
490 switch (n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
491 {
78
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
492 case TT_CREATED: return Q_TT_CREATED;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
493 case TT_SENT: return Q_TT_SENT;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
494 case TT_HANDLED: return Q_TT_HANDLED;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
495 case TT_FAILED: return Q_TT_FAILED;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
496 case TT_QUEUED: return Q_TT_QUEUED;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
497 case TT_STARTED: return Q_TT_STARTED;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
498 case TT_REJECTED: return Q_TT_REJECTED;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
499 case TT_STATE_LAST: return Q_TT_STATE_LAST;
c7528f8e288d Import from CVS: tag r20-0b34
cvs
parents: 70
diff changeset
500 default: return Qnil;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
501 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
502 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
503
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
504 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
505 tt_build_string (char *s)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
506 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
507 return build_string ((s) ? s : "");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
508 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
509
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
510 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
511 tt_opnum_string (int n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
512 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
513 char buf[32];
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
514
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
515 sprintf (buf, "%u", n);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
516 return build_string (buf);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
517 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
518
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
519 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
520 tt_message_arg_ival_string (Tt_message m, int n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
521 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
522 char buf[32];
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
523 int value;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
524
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
525 check_status (tt_message_arg_ival (m, n, &value));
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
526 long_to_string (buf, value);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
527 return build_string (buf);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
528 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
529
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
530 static Lisp_Object
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
531 tt_message_arg_bval_vector (Tt_message m, int n)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
532 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
533 /* !!#### This function has not been Mule-ized */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
534 Bufbyte *value;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
535 int len = 0;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
536
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
537 check_status (tt_message_arg_bval (m, n, &value, &len));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
538
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
539 return make_string (value, len);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
540 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
541
280
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 276
diff changeset
542 DEFUN ("get-tooltalk-message-attribute", Fget_tooltalk_message_attribute,
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 276
diff changeset
543 2, 3, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
544 Return the indicated Tooltalk message attribute. Attributes are
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
545 identified by symbols with the same name (underscores and all) as the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
546 suffix of the Tooltalk tt_message_<attribute> function that extracts the value.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
547 String attribute values are copied, enumerated type values (except disposition)
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
548 are converted to symbols - e.g. TT_HANDLER is 'TT_HANDLER, uid and gid are
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
549 represented by fixnums (small integers), opnum is converted to a string,
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
550 and disposition is converted to a fixnum. We convert opnum (a C int) to a
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
551 string, e.g. 123 => "123" because there's no guarantee that opnums will fit
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
552 within the range of Lisp integers.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
553
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
554 Use the 'plist attribute instead of the C API 'user attribute
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
555 for user defined message data. To retrieve the value of a message property
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
556 specify the indicator for argn. For example to get the value of a property
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
557 called 'rflag, use
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
558 (get-tooltalk-message-attribute message 'plist 'rflag)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
559
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
560 To get the value of a message argument use one of the 'arg_val (strings),
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
561 'arg_ival (integers), or 'arg_bval (strings with embedded nulls), attributes.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
562 For example to get the integer value of the third argument:
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
563
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
564 (get-tooltalk-message-attribute message 'arg_ival 2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
565
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
566 As you can see, argument numbers are zero based. The type of each argument
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
567 can be retrieved with the 'arg_type attribute; however, Tooltalk doesn't
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
568 define any semantics for the string value of 'arg_type. Conventionally
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
569 "string" is used for strings and "int" for 32 bit integers. Note that
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
570 Emacs Lisp stores the lengths of strings explicitly (unlike C) so treating the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
571 value returned by 'arg_bval like a string is fine.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
572 */
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
573 (message_, attribute, argn))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
574 {
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
575 Tt_message m = unbox_tooltalk_message (message_);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
576 int n = 0;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
577
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
578 CHECK_SYMBOL (attribute);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
579 if (EQ (attribute, (Qtt_arg_bval)) ||
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
580 EQ (attribute, (Qtt_arg_ival)) ||
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
581 EQ (attribute, (Qtt_arg_mode)) ||
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
582 EQ (attribute, (Qtt_arg_type)) ||
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
583 EQ (attribute, (Qtt_arg_val)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
584 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
585 CHECK_INT (argn);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
586 n = XINT (argn);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
587 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
588
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
589 if (!VALID_TOOLTALK_MESSAGEP (m))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
590 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
591
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
592 else if (EQ (attribute, Qtt_arg_bval))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
593 return tt_message_arg_bval_vector (m, n);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
594
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
595 else if (EQ (attribute, Qtt_arg_ival))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
596 return tt_message_arg_ival_string (m, n);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
597
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
598 else if (EQ (attribute, Qtt_arg_mode))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
599 return tt_mode_symbol (tt_message_arg_mode (m, n));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
600
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
601 else if (EQ (attribute, Qtt_arg_type))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
602 return tt_build_string (tt_message_arg_type (m, n));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
603
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
604 else if (EQ (attribute, Qtt_arg_val))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
605 return tt_message_arg_bval_vector (m, n);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
606
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
607 else if (EQ (attribute, Qtt_args_count))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
608 return make_int (tt_message_args_count (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
609
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
610 else if (EQ (attribute, Qtt_address))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
611 return tt_address_symbol (tt_message_address (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
612
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
613 else if (EQ (attribute, Qtt_class))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
614 return tt_class_symbol (tt_message_class (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
615
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
616 else if (EQ (attribute, Qtt_disposition))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
617 return make_int (tt_message_disposition (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
618
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
619 else if (EQ (attribute, Qtt_file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
620 return tt_build_string (tt_message_file (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
621
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
622 else if (EQ (attribute, Qtt_gid))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
623 return make_int (tt_message_gid (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
624
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
625 else if (EQ (attribute, Qtt_handler))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
626 return tt_build_string (tt_message_handler (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
627
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
628 else if (EQ (attribute, Qtt_handler_ptype))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
629 return tt_build_string (tt_message_handler_ptype (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
630
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
631 else if (EQ (attribute, Qtt_object))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
632 return tt_build_string (tt_message_object (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
633
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
634 else if (EQ (attribute, Qtt_op))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
635 return tt_build_string (tt_message_op (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
636
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
637 else if (EQ (attribute, Qtt_opnum))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
638 return tt_opnum_string (tt_message_opnum (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
639
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
640 else if (EQ (attribute, Qtt_otype))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
641 return tt_build_string (tt_message_otype (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
642
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
643 else if (EQ (attribute, Qtt_scope))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
644 return tt_scope_symbol (tt_message_scope (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
645
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
646 else if (EQ (attribute, Qtt_sender))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
647 return tt_build_string (tt_message_sender (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
648
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
649 else if (EQ (attribute, Qtt_sender_ptype))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
650 return tt_build_string (tt_message_sender_ptype (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
651
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
652 else if (EQ (attribute, Qtt_session))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
653 return tt_build_string (tt_message_session (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
654
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
655 else if (EQ (attribute, Qtt_state))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
656 return tt_state_symbol (tt_message_state (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
657
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
658 else if (EQ (attribute, Qtt_status))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
659 return make_int (tt_message_status (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
660
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
661 else if (EQ (attribute, Qtt_status_string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
662 return tt_build_string (tt_message_status_string (m));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
663
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
664 else if (EQ (attribute, Qtt_uid))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
665 return make_int (tt_message_uid (m));
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
666
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
667 else if (EQ (attribute, Qtt_callback))
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
668 return XTOOLTALK_MESSAGE (message_)->callback;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
669
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
670 else if (EQ (attribute, Qtt_prop))
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
671 return Fget (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, Qnil);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
672
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
673 else if (EQ (attribute, Qtt_plist))
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
674 return Fcopy_sequence (Fsymbol_plist
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
675 (XTOOLTALK_MESSAGE (message_)->plist_sym));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
676
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
677 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
678 signal_simple_error ("invalid value for `get-tooltalk-message-attribute'",
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
679 attribute);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
680
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
681 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
682 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
683
280
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 276
diff changeset
684 DEFUN ("set-tooltalk-message-attribute", Fset_tooltalk_message_attribute,
7df0dd720c89 Import from CVS: tag r21-0b38
cvs
parents: 276
diff changeset
685 3, 4, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
686 Initialize one Tooltalk message attribute.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
687
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
688 Attribute names and values are the same as for
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
689 `get-tooltalk-message-attribute'. A property list is provided for user
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
690 data (instead of the 'user message attribute); see
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
691 `get-tooltalk-message-attribute'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
692
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
693 The value of callback should be the name of a function of one argument.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
694 It will be applied to the message and matching pattern each time the state of the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
695 message changes. This is usually used to notice when the messages state has
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
696 changed to TT_HANDLED (or TT_FAILED), so that reply argument values
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
697 can be used.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
698
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
699 If one of the argument attributes is specified, 'arg_val, 'arg_ival, or
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
700 'arg_bval then argn must be the number of an already created argument.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
701 New arguments can be added to a message with add-tooltalk-message-arg.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
702 */
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
703 (value, message_, attribute, argn))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
704 {
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
705 Tt_message m = unbox_tooltalk_message (message_);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
706 int n = 0;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
707
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
708 CHECK_SYMBOL (attribute);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
709 if (EQ (attribute, (Qtt_arg_bval)) ||
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
710 EQ (attribute, (Qtt_arg_ival)) ||
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
711 EQ (attribute, (Qtt_arg_val)))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
712 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
713 CHECK_INT (argn);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
714 n = XINT (argn);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
715 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
716
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
717 if (!VALID_TOOLTALK_MESSAGEP (m))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
718 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
719
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
720 else if (EQ (attribute, Qtt_address))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
721 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
722 CHECK_TOOLTALK_CONSTANT (value);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
723 tt_message_address_set (m, (Tt_address) tooltalk_constant_value (value));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
724 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
725 else if (EQ (attribute, Qtt_class))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
726 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
727 CHECK_TOOLTALK_CONSTANT (value);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
728 tt_message_class_set (m, (Tt_class) tooltalk_constant_value (value));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
729 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
730 else if (EQ (attribute, Qtt_disposition))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
731 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
732 CHECK_TOOLTALK_CONSTANT (value);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
733 tt_message_disposition_set (m, ((Tt_disposition)
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
734 tooltalk_constant_value (value)));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
735 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
736 else if (EQ (attribute, Qtt_file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
737 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
738 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
739 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
740 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
741 tt_message_file_set (m, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
742 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
743 else if (EQ (attribute, Qtt_handler_ptype))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
744 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
745 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
746 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
747 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
748 tt_message_handler_ptype_set (m, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
749 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
750 else if (EQ (attribute, Qtt_handler))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
751 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
752 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
753 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
754 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
755 tt_message_handler_set (m, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
756 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
757 else if (EQ (attribute, Qtt_object))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
758 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
759 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
760 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
761 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
762 tt_message_object_set (m, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
763 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
764 else if (EQ (attribute, Qtt_op))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
765 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
766 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
767 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
768 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
769 tt_message_op_set (m, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
770 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
771 else if (EQ (attribute, Qtt_otype))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
772 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
773 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
774 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
775 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
776 tt_message_otype_set (m, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
777 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
778 else if (EQ (attribute, Qtt_scope))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
779 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
780 CHECK_TOOLTALK_CONSTANT (value);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
781 tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
782 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
783 else if (EQ (attribute, Qtt_sender_ptype))
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
784 {
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
785 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
786 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
787 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
788 tt_message_sender_ptype_set (m, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
789 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
790 else if (EQ (attribute, Qtt_session))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
791 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
792 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
793 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
794 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
795 tt_message_session_set (m, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
796 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
797 else if (EQ (attribute, Qtt_arg_bval))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
798 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
799 Extbyte *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
800 Extcount value_ext_len;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
801 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
802 GET_STRING_OS_DATA_ALLOCA (value, value_ext, value_ext_len);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
803 tt_message_arg_bval_set (m, n, value_ext, value_ext_len);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
804 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
805 else if (EQ (attribute, Qtt_arg_ival))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
806 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
807 CHECK_INT (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
808 tt_message_arg_ival_set (m, n, XINT (value));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
809 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
810 else if (EQ (attribute, Qtt_arg_val))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
811 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
812 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
813 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
814 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
815 tt_message_arg_val_set (m, n, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
816 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
817 else if (EQ (attribute, Qtt_status))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
818 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
819 CHECK_INT (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
820 tt_message_status_set (m, XINT (value));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
821 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
822 else if (EQ (attribute, Qtt_status_string))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
823 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
824 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
825 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
826 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
827 tt_message_status_string_set (m, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
828 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
829 else if (EQ (attribute, Qtt_callback))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
830 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
831 CHECK_SYMBOL (value);
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
832 XTOOLTALK_MESSAGE (message_)->callback = value;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
833 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
834 else if (EQ (attribute, Qtt_prop))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
835 {
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
836 return Fput (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, value);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
837 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
838 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
839 signal_simple_error ("invalid value for `set-tooltalk-message-attribute'",
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
840 attribute);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
841 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
842 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
843
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
844 DEFUN ("return-tooltalk-message", Freturn_tooltalk_message, 1, 2, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
845 Send a reply to this message. The second argument can be
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
846 'reply, 'reject or 'fail; the default is 'reply. Before sending
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
847 a reply all message arguments whose mode is TT_INOUT or TT_OUT should
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
848 have been filled in - see set-tooltalk-message-attribute.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
849 */
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
850 (message_, mode))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
851 {
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
852 Tt_message m = unbox_tooltalk_message (message_);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
853
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
854 if (NILP (mode))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
855 mode = Qtt_reply;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
856 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
857 CHECK_SYMBOL (mode);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
858
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
859 if (!VALID_TOOLTALK_MESSAGEP (m))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
860 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
861 else if (EQ (mode, Qtt_reply))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
862 tt_message_reply (m);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
863 else if (EQ (mode, Qtt_reject))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
864 tt_message_reject (m);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
865 else if (EQ (mode, Qtt_fail))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
866 tt_message_fail (m);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
867
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
868 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
869 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
870
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
871 DEFUN ("create-tooltalk-message", Fcreate_tooltalk_message, 0, 1, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
872 Create a new tooltalk message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
873 The messages session attribute is initialized to the default session.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
874 Other attributes can be initialized with `set-tooltalk-message-attribute'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
875 `make-tooltalk-message' is the preferred to create and initialize a message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
876
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
877 Optional arg NO-CALLBACK says don't add a C-level callback at all.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
878 Normally don't do that; just don't specify the Lisp callback when
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
879 calling `make-tooltalk-message'.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
880 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
881 (no_callback))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
882 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
883 Tt_message m = tt_message_create ();
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
884 Lisp_Object message_ = make_tooltalk_message (m);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
885 if (NILP (no_callback))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
886 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
887 tt_message_callback_add (m, tooltalk_message_callback);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
888 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
889 tt_message_session_set (m, tt_default_session ());
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
890 tt_message_user_set (m, TOOLTALK_MESSAGE_KEY, LISP_TO_VOID (message_));
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
891 return message_;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
892 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
893
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
894 DEFUN ("destroy-tooltalk-message", Fdestroy_tooltalk_message, 1, 1, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
895 Apply tt_message_destroy() to the message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
896 It's not necessary to destroy messages after they've been processed by
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
897 a message or pattern callback; the Lisp/Tooltalk callback machinery does
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
898 this for you.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
899 */
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
900 (message_))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
901 {
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
902 Tt_message m = unbox_tooltalk_message (message_);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
903
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
904 if (VALID_TOOLTALK_MESSAGEP (m))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
905 /* #### Should we call Fremhash() here? It seems that
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
906 a common paradigm is
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
907
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
908 (send-tooltalk-message)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
909 (destroy-tooltalk-message)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
910
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
911 which would imply that destroying a sent ToolTalk message
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
912 doesn't actually destroy it; when a response is sent back,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
913 the callback for the message will still be called.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
914
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
915 But then maybe not: Maybe it really does destroy it,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
916 and the reason for that paradigm is that the author
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
917 of `send-tooltalk-message' didn't really know what he
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
918 was talking about when he said that it's a good idea
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
919 to call `destroy-tooltalk-message' after sending it. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
920 tt_message_destroy (m);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
921
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
922 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
923 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
924
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
925
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
926 DEFUN ("add-tooltalk-message-arg", Fadd_tooltalk_message_arg, 3, 4, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
927 Append one new argument to the message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
928 MODE must be one of TT_IN, TT_INOUT, or TT_OUT; VTYPE must be a string;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
929 and VALUE can be a string or an integer. Tooltalk doesn't
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
930 define any semantics for VTYPE, so only the participants in the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
931 protocol you're using need to agree what types mean (if anything).
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
932 Conventionally "string" is used for strings and "int" for 32 bit integers.
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
933 Arguments can initialized by providing a value or with
110
fe104dbd9147 Import from CVS: tag r20-1b7
cvs
parents: 78
diff changeset
934 `set-tooltalk-message-attribute'. The latter is necessary if you
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
935 want to initialize the argument with a string that can contain
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
936 embedded nulls (use 'arg_bval).
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
937 */
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
938 (message_, mode, vtype, value))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
939 {
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
940 Tt_message m = unbox_tooltalk_message (message_);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
941 Tt_mode n;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
942
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
943 CHECK_STRING (vtype);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
944 CHECK_TOOLTALK_CONSTANT (mode);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
945
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
946 n = (Tt_mode) tooltalk_constant_value (mode);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
947
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
948 if (!VALID_TOOLTALK_MESSAGEP (m))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
949 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
950 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
951 CONST char *vtype_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
952
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
953 GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
954 if (NILP (value))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
955 tt_message_arg_add (m, n, vtype_ext, NULL);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
956 else if (STRINGP (value))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
957 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
958 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
959 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
960 tt_message_arg_add (m, n, vtype_ext, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
961 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
962 else if (INTP (value))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
963 tt_message_iarg_add (m, n, vtype_ext, XINT (value));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
964 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
965
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
966 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
967 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
968
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
969 DEFUN ("send-tooltalk-message", Fsend_tooltalk_message, 1, 1, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
970 Send the message on its way.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
971 Once the message has been sent it's almost always a good idea to get rid of
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
972 it with `destroy-tooltalk-message'.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
973 */
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
974 (message_))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
975 {
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
976 Tt_message m = unbox_tooltalk_message (message_);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
977
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
978 if (VALID_TOOLTALK_MESSAGEP (m))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
979 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
980 tt_message_send (m);
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
981 Fputhash (message_, Qnil, Vtooltalk_message_gcpro);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
982 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
983
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
984 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
985 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
986
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
987 DEFUN ("create-tooltalk-pattern", Fcreate_tooltalk_pattern, 0, 0, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
988 Create a new Tooltalk pattern.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
989 Its session attribute is initialized to be the default session.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
990 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
991 ())
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
992 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
993 Tt_pattern p = tt_pattern_create ();
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
994 Lisp_Object pattern = make_tooltalk_pattern (p);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
995
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
996 tt_pattern_callback_add (p, tooltalk_pattern_callback);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
997 tt_pattern_session_add (p, tt_default_session ());
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
998 tt_pattern_user_set (p, TOOLTALK_PATTERN_KEY, LISP_TO_VOID (pattern));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
999
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1000 return pattern;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1001 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1002
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1003
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1004 DEFUN ("destroy-tooltalk-pattern", Fdestroy_tooltalk_pattern, 1, 1, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1005 Apply tt_pattern_destroy() to the pattern.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1006 This effectively unregisters the pattern.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1007 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1008 (pattern))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1009 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1010 Tt_pattern p = unbox_tooltalk_pattern (pattern);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1011
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1012 if (VALID_TOOLTALK_PATTERNP (p))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1013 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1014 tt_pattern_destroy (p);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1015 Fremhash (pattern, Vtooltalk_pattern_gcpro);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1016 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1017
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1018 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1019 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1020
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1021
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1022 DEFUN ("add-tooltalk-pattern-attribute", Fadd_tooltalk_pattern_attribute, 3, 3, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1023 Add one value to the indicated pattern attribute.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1024 All Tooltalk pattern attributes are supported except 'user. The names
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1025 of attributes are the same as the Tooltalk accessors used to set them
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1026 less the "tooltalk_pattern_" prefix and the "_add" ...
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1027 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1028 (value, pattern, attribute))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1029 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1030 Tt_pattern p = unbox_tooltalk_pattern (pattern);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1031
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1032 CHECK_SYMBOL (attribute);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1033
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1034 if (!VALID_TOOLTALK_PATTERNP (p))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1035 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1036
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1037 else if (EQ (attribute, Qtt_category))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1038 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1039 CHECK_TOOLTALK_CONSTANT (value);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1040 tt_pattern_category_set (p, ((Tt_category)
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1041 tooltalk_constant_value (value)));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1042 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1043 else if (EQ (attribute, Qtt_address))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1044 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1045 CHECK_TOOLTALK_CONSTANT (value);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1046 tt_pattern_address_add (p, ((Tt_address)
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1047 tooltalk_constant_value (value)));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1048 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1049 else if (EQ (attribute, Qtt_class))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1050 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1051 CHECK_TOOLTALK_CONSTANT (value);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1052 tt_pattern_class_add (p, (Tt_class) tooltalk_constant_value (value));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1053 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1054 else if (EQ (attribute, Qtt_disposition))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1055 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1056 CHECK_TOOLTALK_CONSTANT (value);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1057 tt_pattern_disposition_add (p, ((Tt_disposition)
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1058 tooltalk_constant_value (value)));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1059 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1060 else if (EQ (attribute, Qtt_file))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1061 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1062 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1063 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1064 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1065 tt_pattern_file_add (p, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1066 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1067 else if (EQ (attribute, Qtt_object))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1068 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1069 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1070 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1071 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1072 tt_pattern_object_add (p, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1073 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1074 else if (EQ (attribute, Qtt_op))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1075 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1076 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1077 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1078 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1079 tt_pattern_op_add (p, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1080 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1081 else if (EQ (attribute, Qtt_otype))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1082 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1083 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1084 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1085 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1086 tt_pattern_otype_add (p, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1087 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1088 else if (EQ (attribute, Qtt_scope))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1089 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1090 CHECK_TOOLTALK_CONSTANT (value);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1091 tt_pattern_scope_add (p, (Tt_scope) tooltalk_constant_value (value));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1092 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1093 else if (EQ (attribute, Qtt_sender))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1094 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1095 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1096 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1097 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1098 tt_pattern_sender_add (p, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1099 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1100 else if (EQ (attribute, Qtt_sender_ptype))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1101 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1102 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1103 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1104 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1105 tt_pattern_sender_ptype_add (p, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1106 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1107 else if (EQ (attribute, Qtt_session))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1108 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1109 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1110 CHECK_STRING (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1111 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1112 tt_pattern_session_add (p, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1113 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1114 else if (EQ (attribute, Qtt_state))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1115 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1116 CHECK_TOOLTALK_CONSTANT (value);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1117 tt_pattern_state_add (p, (Tt_state) tooltalk_constant_value (value));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1118 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1119 else if (EQ (attribute, Qtt_callback))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1120 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1121 CHECK_SYMBOL (value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1122 XTOOLTALK_PATTERN (pattern)->callback = value;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1123 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1124
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1125 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1126 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1127
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1128
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1129 DEFUN ("add-tooltalk-pattern-arg", Fadd_tooltalk_pattern_arg, 3, 4, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1130 Add one fully specified argument to a tooltalk pattern.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1131 Mode must be one of TT_IN, TT_INOUT, or TT_OUT, type must be a string.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1132 Value can be an integer, string or nil. If value is an integer then
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1133 an integer argument (tt_pattern_iarg_add) added otherwise a string argument
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1134 is added. At present there's no way to add a binary data argument.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1135 */
70
131b0175ea99 Import from CVS: tag r20-0b30
cvs
parents: 32
diff changeset
1136 (pattern, mode, vtype, value))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1137 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1138 Tt_pattern p = unbox_tooltalk_pattern (pattern);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1139 Tt_mode n;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1140
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1141 CHECK_STRING (vtype);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1142 CHECK_TOOLTALK_CONSTANT (mode);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1143
2
ac2d302a0011 Import from CVS: tag r19-15b2
cvs
parents: 0
diff changeset
1144 n = (Tt_mode) tooltalk_constant_value (mode);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1145
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1146 if (!VALID_TOOLTALK_PATTERNP (p))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1147 return Qnil;
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1148
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1149 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1150 CONST char *vtype_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1151
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1152 GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1153 if (NILP (value))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1154 tt_pattern_arg_add (p, n, vtype_ext, NULL);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1155 else if (STRINGP (value))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1156 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1157 CONST char *value_ext;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1158 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1159 tt_pattern_arg_add (p, n, vtype_ext, value_ext);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1160 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1161 else if (INTP (value))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1162 tt_pattern_iarg_add (p, n, vtype_ext, XINT (value));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1163 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1164
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1165 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1166 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1167
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1168
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1169 DEFUN ("register-tooltalk-pattern", Fregister_tooltalk_pattern, 1, 1, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1170 Emacs will begin receiving messages that match this pattern.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1171 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1172 (pattern))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1173 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1174 Tt_pattern p = unbox_tooltalk_pattern (pattern);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1175
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1176 if (VALID_TOOLTALK_PATTERNP (p) && tt_pattern_register (p) == TT_OK)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1177 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1178 Fputhash (pattern, Qnil, Vtooltalk_pattern_gcpro);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1179 return Qt;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1180 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1181 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1182 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1183 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1184
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1185
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1186 DEFUN ("unregister-tooltalk-pattern", Funregister_tooltalk_pattern, 1, 1, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1187 Emacs will stop receiving messages that match this pattern.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1188 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1189 (pattern))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1190 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1191 Tt_pattern p = unbox_tooltalk_pattern (pattern);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1192
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1193 if (VALID_TOOLTALK_PATTERNP (p))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1194 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1195 tt_pattern_unregister (p);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1196 Fremhash (pattern, Vtooltalk_pattern_gcpro);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1197 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1198
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1199 return Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1200 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1201
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1202
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1203 DEFUN ("tooltalk-pattern-prop-get", Ftooltalk_pattern_prop_get, 2, 2, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1204 Return the value of PROPERTY in tooltalk pattern PATTERN.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1205 This is the last value set with `tooltalk-pattern-prop-set'.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1206 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1207 (pattern, property))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1208 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1209 CHECK_TOOLTALK_PATTERN (pattern);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1210 return Fget (XTOOLTALK_PATTERN (pattern)->plist_sym, property, Qnil);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1211 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1212
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1213
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1214 DEFUN ("tooltalk-pattern-prop-set", Ftooltalk_pattern_prop_set, 3, 3, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1215 Set the value of PROPERTY to VALUE in tooltalk pattern PATTERN.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1216 It can be retrieved with `tooltalk-pattern-prop-get'.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1217 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1218 (pattern, property, value))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1219 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1220 CHECK_TOOLTALK_PATTERN (pattern);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1221 return Fput (XTOOLTALK_PATTERN (pattern)->plist_sym, property, value);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1222 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1223
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1224
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1225 DEFUN ("tooltalk-pattern-plist-get", Ftooltalk_pattern_plist_get, 1, 1, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1226 Return the a list of all the properties currently set in PATTERN.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1227 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1228 (pattern))
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1229 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1230 CHECK_TOOLTALK_PATTERN (pattern);
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
1231 return
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
1232 Fcopy_sequence (Fsymbol_plist (XTOOLTALK_PATTERN (pattern)->plist_sym));
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1233 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1234
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1235 DEFUN ("tooltalk-default-procid", Ftooltalk_default_procid, 0, 0, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1236 Return current default process identifier for your process.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1237 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1238 ())
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1239 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1240 char *procid = tt_default_procid ();
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1241 return procid ? build_string (procid) : Qnil;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1242 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1243
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1244 DEFUN ("tooltalk-default-session", Ftooltalk_default_session, 0, 0, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1245 Return current default session identifier for the current default procid.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1246 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1247 ())
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1248 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1249 char *session = tt_default_session ();
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1250 return session ? build_string (session) : Qnil;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1251 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1252
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1253 static void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1254 init_tooltalk (void)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1255 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1256 /* This function can GC */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1257 char *retval;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1258 Lisp_Object lp;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1259 Lisp_Object fil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1260
349
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1261
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1262 /* tt_open() messes with our signal handler flags (at least when no
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1263 ttsessions is running on the machine), therefore we save the
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1264 actions and restore them after the call */
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1265 #ifdef HAVE_SIGPROCMASK
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1266 {
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1267 struct sigaction ActSIGQUIT;
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1268 struct sigaction ActSIGINT;
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1269 struct sigaction ActSIGCHLD;
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1270 sigaction (SIGQUIT, NULL, &ActSIGQUIT);
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1271 sigaction (SIGINT, NULL, &ActSIGINT);
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1272 sigaction (SIGCHLD, NULL, &ActSIGCHLD);
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1273 #endif
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1274 retval = tt_open ();
349
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1275 #ifdef HAVE_SIGPROCMASK
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1276 sigaction (SIGQUIT, &ActSIGQUIT, NULL);
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1277 sigaction (SIGINT, &ActSIGINT, NULL);
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1278 sigaction (SIGCHLD, &ActSIGCHLD, NULL);
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1279 }
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1280 #endif
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1281
8429d81ab209 Import from CVS: tag r21-1-4
cvs
parents: 288
diff changeset
1282
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1283 if (tt_ptr_error (retval) != TT_OK)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1284 return;
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1285
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1286 Vtooltalk_fd = make_int (tt_fd ());
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1287
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1288 tt_session_join (tt_default_session ());
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1289
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1290 lp = connect_to_file_descriptor (build_string ("tooltalk"), Qnil,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1291 Vtooltalk_fd, Vtooltalk_fd);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1292 if (!NILP (lp))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1293 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1294 /* Don't ask the user for confirmation when exiting Emacs */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1295 Fprocess_kill_without_query (lp, Qnil);
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1296 XSETSUBR (fil, &SFreceive_tooltalk_message);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1297 set_process_filter (lp, fil, 1);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1298 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1299 else
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1300 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1301 tt_close ();
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1302 Vtooltalk_fd = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1303 return;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1304 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1305
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1306 #if defined (SOLARIS2)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1307 /* Apparently the tt_message_send_on_exit() function does not exist
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1308 under SunOS 4.x or IRIX 5 or various other non-Solaris-2 systems.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1309 No big deal if we don't do the following under those systems. */
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1310 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1311 Tt_message exit_msg = tt_message_create ();
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1312
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1313 tt_message_op_set (exit_msg, "emacs-aborted");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1314 tt_message_scope_set (exit_msg, TT_SESSION);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1315 tt_message_class_set (exit_msg, TT_NOTICE);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1316 tt_message_send_on_exit (exit_msg);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1317 tt_message_destroy (exit_msg);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1318 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1319 #endif
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1320 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1321
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1322 DEFUN ("tooltalk-open-connection", Ftooltalk_open_connection, 0, 0, 0, /*
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1323 Opens a connection to the ToolTalk server.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1324 Returns t if successful, nil otherwise.
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1325 */
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1326 ())
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1327 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1328 if (!NILP (Vtooltalk_fd))
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1329 error ("Already connected to ToolTalk.");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1330 if (noninteractive)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1331 error ("Can't connect to ToolTalk in batch mode.");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1332 init_tooltalk ();
173
8eaf7971accc Import from CVS: tag r20-3b13
cvs
parents: 169
diff changeset
1333 return NILP (Vtooltalk_fd) ? Qnil : Qt;
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1334 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1335
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1336
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1337 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1338 syms_of_tooltalk (void)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1339 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1340 defsymbol (&Qtooltalk_messagep, "tooltalk-message-p");
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1341 DEFSUBR (Ftooltalk_message_p);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1342 defsymbol (&Qtooltalk_patternp, "tooltalk-pattern-p");
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1343 DEFSUBR (Ftooltalk_pattern_p);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1344 defsymbol (&Qtooltalk_message_handler_hook, "tooltalk-message-handler-hook");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1345 defsymbol (&Qtooltalk_pattern_handler_hook, "tooltalk-pattern-handler-hook");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1346 defsymbol (&Qtooltalk_unprocessed_message_hook,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1347 "tooltalk-unprocessed-message-hook");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1348
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1349 DEFSUBR (Freceive_tooltalk_message);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1350 DEFSUBR (Fcreate_tooltalk_message);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1351 DEFSUBR (Fdestroy_tooltalk_message);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1352 DEFSUBR (Fadd_tooltalk_message_arg);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1353 DEFSUBR (Fget_tooltalk_message_attribute);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1354 DEFSUBR (Fset_tooltalk_message_attribute);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1355 DEFSUBR (Fsend_tooltalk_message);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1356 DEFSUBR (Freturn_tooltalk_message);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1357 DEFSUBR (Fcreate_tooltalk_pattern);
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1358 DEFSUBR (Fdestroy_tooltalk_pattern);
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1359 DEFSUBR (Fadd_tooltalk_pattern_attribute);
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1360 DEFSUBR (Fadd_tooltalk_pattern_arg);
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1361 DEFSUBR (Fregister_tooltalk_pattern);
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1362 DEFSUBR (Funregister_tooltalk_pattern);
20
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1363 DEFSUBR (Ftooltalk_pattern_plist_get);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1364 DEFSUBR (Ftooltalk_pattern_prop_set);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1365 DEFSUBR (Ftooltalk_pattern_prop_get);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1366 DEFSUBR (Ftooltalk_default_procid);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1367 DEFSUBR (Ftooltalk_default_session);
859a2309aef8 Import from CVS: tag r19-15b93
cvs
parents: 16
diff changeset
1368 DEFSUBR (Ftooltalk_open_connection);
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1369
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1370 defsymbol (&Qreceive_tooltalk_message, "receive-tooltalk-message");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1371 defsymbol (&Qtt_address, "address");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1372 defsymbol (&Qtt_args_count, "args_count");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1373 defsymbol (&Qtt_arg_bval, "arg_bval");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1374 defsymbol (&Qtt_arg_ival, "arg_ival");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1375 defsymbol (&Qtt_arg_mode, "arg_mode");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1376 defsymbol (&Qtt_arg_type, "arg_type");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1377 defsymbol (&Qtt_arg_val, "arg_val");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1378 defsymbol (&Qtt_class, "class");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1379 defsymbol (&Qtt_category, "category");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1380 defsymbol (&Qtt_disposition, "disposition");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1381 defsymbol (&Qtt_file, "file");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1382 defsymbol (&Qtt_gid, "gid");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1383 defsymbol (&Qtt_handler, "handler");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1384 defsymbol (&Qtt_handler_ptype, "handler_ptype");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1385 defsymbol (&Qtt_object, "object");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1386 defsymbol (&Qtt_op, "op");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1387 defsymbol (&Qtt_opnum, "opnum");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1388 defsymbol (&Qtt_otype, "otype");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1389 defsymbol (&Qtt_scope, "scope");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1390 defsymbol (&Qtt_sender, "sender");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1391 defsymbol (&Qtt_sender_ptype, "sender_ptype");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1392 defsymbol (&Qtt_session, "session");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1393 defsymbol (&Qtt_state, "state");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1394 defsymbol (&Qtt_status, "status");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1395 defsymbol (&Qtt_status_string, "status_string");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1396 defsymbol (&Qtt_uid, "uid");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1397 defsymbol (&Qtt_callback, "callback");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1398 defsymbol (&Qtt_prop, "prop");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1399 defsymbol (&Qtt_plist, "plist");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1400 defsymbol (&Qtt_reject, "reject");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1401 defsymbol (&Qtt_reply, "reply");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1402 defsymbol (&Qtt_fail, "fail");
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1403
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1404 deferror (&Qtooltalk_error, "tooltalk-error", "ToolTalk error", Qio_error);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1405 }
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1406
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1407 void
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1408 vars_of_tooltalk (void)
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1409 {
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1410 Fprovide (intern ("tooltalk"));
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1411
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1412 DEFVAR_LISP ("tooltalk-fd", &Vtooltalk_fd /*
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1413 File descriptor returned by tt_initialize; nil if not connected to ToolTalk.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1414 */ );
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1415 Vtooltalk_fd = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1416
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1417 DEFVAR_LISP ("tooltalk-message-handler-hook",
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1418 &Vtooltalk_message_handler_hook /*
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1419 List of functions to be applied to each ToolTalk message reply received.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1420 This will always occur as a result of our sending a request message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1421 Functions will be called with two arguments, the message and the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1422 corresponding pattern. This hook will not be called if the request
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1423 message was created without a C-level callback function (see
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1424 `tooltalk-unprocessed-message-hook').
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1425 */ );
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1426 Vtooltalk_message_handler_hook = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1427
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1428 DEFVAR_LISP ("tooltalk-pattern-handler-hook",
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1429 &Vtooltalk_pattern_handler_hook /*
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1430 List of functions to be applied to each pattern-matching ToolTalk message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1431 This is all messages except those handled by `tooltalk-message-handler-hook'.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1432 Functions will be called with two arguments, the message and the
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1433 corresponding pattern.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1434 */ );
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1435 Vtooltalk_pattern_handler_hook = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1436
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1437 DEFVAR_LISP ("tooltalk-unprocessed-message-hook",
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1438 &Vtooltalk_unprocessed_message_hook /*
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1439 List of functions to be applied to each unprocessed ToolTalk message.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1440 Unprocessed messages are messages that didn't match any patterns.
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1441 */ );
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1442 Vtooltalk_unprocessed_message_hook = Qnil;
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1443
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1444 Tooltalk_Message_plist_str = build_string ("Tooltalk Message plist");
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1445 Tooltalk_Pattern_plist_str = build_string ("Tooltalk Pattern p plist");
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1446
288
e11d67e05968 Import from CVS: tag r21-0b42
cvs
parents: 280
diff changeset
1447 staticpro(&Tooltalk_Message_plist_str);
e11d67e05968 Import from CVS: tag r21-0b42
cvs
parents: 280
diff changeset
1448 staticpro(&Tooltalk_Pattern_plist_str);
e11d67e05968 Import from CVS: tag r21-0b42
cvs
parents: 280
diff changeset
1449
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1450 #define MAKE_CONSTANT(name) do { \
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1451 defsymbol (&Q_ ## name, #name); \
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1452 Fset (Q_ ## name, make_int (name)); \
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1453 } while (0)
185
3d6bfa290dbd Import from CVS: tag r20-3b19
cvs
parents: 173
diff changeset
1454
0
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1455 MAKE_CONSTANT (TT_MODE_UNDEFINED);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1456 MAKE_CONSTANT (TT_IN);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1457 MAKE_CONSTANT (TT_OUT);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1458 MAKE_CONSTANT (TT_INOUT);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1459 MAKE_CONSTANT (TT_MODE_LAST);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1460
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1461 MAKE_CONSTANT (TT_SCOPE_NONE);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1462 MAKE_CONSTANT (TT_SESSION);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1463 MAKE_CONSTANT (TT_FILE);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1464 MAKE_CONSTANT (TT_BOTH);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1465 MAKE_CONSTANT (TT_FILE_IN_SESSION);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1466
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1467 MAKE_CONSTANT (TT_CLASS_UNDEFINED);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1468 MAKE_CONSTANT (TT_NOTICE);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1469 MAKE_CONSTANT (TT_REQUEST);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1470 MAKE_CONSTANT (TT_CLASS_LAST);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1471
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1472 MAKE_CONSTANT (TT_CATEGORY_UNDEFINED);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1473 MAKE_CONSTANT (TT_OBSERVE);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1474 MAKE_CONSTANT (TT_HANDLE);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1475 MAKE_CONSTANT (TT_CATEGORY_LAST);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1476
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1477 MAKE_CONSTANT (TT_PROCEDURE);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1478 MAKE_CONSTANT (TT_OBJECT);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1479 MAKE_CONSTANT (TT_HANDLER);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1480 MAKE_CONSTANT (TT_OTYPE);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1481 MAKE_CONSTANT (TT_ADDRESS_LAST);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1482
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1483 MAKE_CONSTANT (TT_CREATED);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1484 MAKE_CONSTANT (TT_SENT);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1485 MAKE_CONSTANT (TT_HANDLED);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1486 MAKE_CONSTANT (TT_FAILED);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1487 MAKE_CONSTANT (TT_QUEUED);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1488 MAKE_CONSTANT (TT_STARTED);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1489 MAKE_CONSTANT (TT_REJECTED);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1490 MAKE_CONSTANT (TT_STATE_LAST);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1491
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1492 MAKE_CONSTANT (TT_DISCARD);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1493 MAKE_CONSTANT (TT_QUEUE);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1494 MAKE_CONSTANT (TT_START);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1495
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1496 #undef MAKE_CONSTANT
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1497
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1498 staticpro (&Vtooltalk_message_gcpro);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1499 staticpro (&Vtooltalk_pattern_gcpro);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1500 Vtooltalk_message_gcpro = make_lisp_hashtable (10, HASHTABLE_NONWEAK,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1501 HASHTABLE_EQ);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1502 Vtooltalk_pattern_gcpro = make_lisp_hashtable (10, HASHTABLE_NONWEAK,
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1503 HASHTABLE_EQ);
376386a54a3c Import from CVS: tag r19-14
cvs
parents:
diff changeset
1504 }