annotate src/tooltalk.c @ 853:2b6fa2618f76

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