Mercurial > hg > xemacs-beta

comparison src/tooltalk.c @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 0e522484dd2a
children 6330739388db
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
26 26
27 #include <config.h> 27 #include <config.h>
28 #include "lisp.h" 28 #include "lisp.h"
29 29
30 #include <X11/Xlib.h> 30 #include <X11/Xlib.h>
31 #include TT_C_H_PATH
32 31
33 #include "buffer.h" 32 #include "buffer.h"
34 #include "elhash.h" 33 #include "elhash.h"
35 #include "process.h" 34 #include "process.h"
36 #include "tooltalk.h" 35 #include "tooltalk.h"
149 struct lcrecord_header header; 148 struct lcrecord_header header;
150 Lisp_Object plist_sym, callback; 149 Lisp_Object plist_sym, callback;
151 Tt_message m; 150 Tt_message m;
152 }; 151 };
153 152
154 static Lisp_Object mark_tooltalk_message (Lisp_Object, void (*) (Lisp_Object)); 153 static Lisp_Object
155 static void print_tooltalk_message (Lisp_Object, Lisp_Object, int); 154 mark_tooltalk_message (Lisp_Object obj, void (*markobj) (Lisp_Object))
155 {
156 (markobj) (XTOOLTALK_MESSAGE (obj)->callback);
157 return XTOOLTALK_MESSAGE (obj)->plist_sym;
158 }
159
160 static void
161 print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun,
162 int escapeflag)
163 {
164 struct Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj);
165
166 char buf[200];
167
168 if (print_readably)
169 error ("printing unreadable object #<tooltalk_message 0x%x>",
170 p->header.uid);
171
172 sprintf (buf, "#<tooltalk_message id:%p 0x%x>", p->m, p->header.uid);
173 write_c_string (buf, printcharfun);
174 }
175
156 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message, 176 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message,
157 mark_tooltalk_message, print_tooltalk_message, 177 mark_tooltalk_message, print_tooltalk_message,
158 0, 0, 0, 178 0, 0, 0,
159 struct Lisp_Tooltalk_Message); 179 struct Lisp_Tooltalk_Message);
160 180
161 static Lisp_Object
162 mark_tooltalk_message (Lisp_Object obj, void (*markobj) (Lisp_Object))
163 {
164 (markobj) (XTOOLTALK_MESSAGE (obj)->callback);
165 return XTOOLTALK_MESSAGE (obj)->plist_sym;
166 }
167
168 static void
169 print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun,
170 int escapeflag)
171 {
172 struct Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj);
173
174 char buf[200];
175
176 if (print_readably)
177 error ("printing unreadable object #<tooltalk_message 0x%x>",
178 p->header.uid);
179
180 sprintf (buf, "#<tooltalk_message id:%p 0x%x>", p->m, p->header.uid);
181 write_c_string (buf, printcharfun);
182 }
183
184 static Lisp_Object 181 static Lisp_Object
185 make_tooltalk_message (Tt_message m) 182 make_tooltalk_message (Tt_message m)
186 { 183 {
184 Lisp_Object val;
187 struct Lisp_Tooltalk_Message *msg = 185 struct Lisp_Tooltalk_Message *msg =
188 alloc_lcrecord_type (struct Lisp_Tooltalk_Message, 186 alloc_lcrecord_type (struct Lisp_Tooltalk_Message,
189 lrecord_tooltalk_message); 187 lrecord_tooltalk_message);
190 Lisp_Object val;
191 188
192 msg->m = m; 189 msg->m = m;
193 msg->callback = Qnil; 190 msg->callback = Qnil;
194 msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str); 191 msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str);
195 XSETTOOLTALK_MESSAGE (val, msg); 192 XSETTOOLTALK_MESSAGE (val, msg);
225 struct lcrecord_header header; 222 struct lcrecord_header header;
226 Lisp_Object plist_sym, callback; 223 Lisp_Object plist_sym, callback;
227 Tt_pattern p; 224 Tt_pattern p;
228 }; 225 };
229 226
230 static Lisp_Object mark_tooltalk_pattern (Lisp_Object, void (*) (Lisp_Object)); 227 static Lisp_Object
231 static void print_tooltalk_pattern (Lisp_Object, Lisp_Object, int); 228 mark_tooltalk_pattern (Lisp_Object obj, void (*markobj) (Lisp_Object))
229 {
230 (markobj) (XTOOLTALK_PATTERN (obj)->callback);
231 return XTOOLTALK_PATTERN (obj)->plist_sym;
232 }
233
234 static void
235 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun,
236 int escapeflag)
237 {
238 struct Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj);
239
240 char buf[200];
241
242 if (print_readably)
243 error ("printing unreadable object #<tooltalk_pattern 0x%x>",
244 p->header.uid);
245
246 sprintf (buf, "#<tooltalk_pattern id:%p 0x%x>", p->p, p->header.uid);
247 write_c_string (buf, printcharfun);
248 }
249
232 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern, 250 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern,
233 mark_tooltalk_pattern, print_tooltalk_pattern, 251 mark_tooltalk_pattern, print_tooltalk_pattern,
234 0, 0, 0, 252 0, 0, 0,
235 struct Lisp_Tooltalk_Pattern); 253 struct Lisp_Tooltalk_Pattern);
236 254
237 static Lisp_Object
238 mark_tooltalk_pattern (Lisp_Object obj, void (*markobj) (Lisp_Object))
239 {
240 (markobj) (XTOOLTALK_PATTERN (obj)->callback);
241 return XTOOLTALK_PATTERN (obj)->plist_sym;
242 }
243
244 static void
245 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun,
246 int escapeflag)
247 {
248 struct Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj);
249
250 char buf[200];
251
252 if (print_readably)
253 error ("printing unreadable object #<tooltalk_pattern 0x%x>",
254 p->header.uid);
255
256 sprintf (buf, "#<tooltalk_pattern id:%p 0x%x>", p->p, p->header.uid);
257 write_c_string (buf, printcharfun);
258 }
259
260 static Lisp_Object 255 static Lisp_Object
261 make_tooltalk_pattern (Tt_pattern p) 256 make_tooltalk_pattern (Tt_pattern p)
262 { 257 {
263 struct Lisp_Tooltalk_Pattern *pat = 258 struct Lisp_Tooltalk_Pattern *pat =
264 alloc_lcrecord_type (struct Lisp_Tooltalk_Pattern, 259 alloc_lcrecord_type (struct Lisp_Tooltalk_Pattern,