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