annotate src/tooltalk.c @ 826:6728e641994e

[xemacs-hg @ 2002-05-05 11:30:15 by ben] syntax cache, 8-bit-format, lots of code cleanup README.packages: Update info about --package-path. i.c: Create an inheritable event and pass it on to XEmacs, so that ^C can be handled properly. Intercept ^C and signal the event. "Stop Build" in VC++ now works. bytecomp-runtime.el: Doc string changes. compat.el: Some attempts to redo this to make it truly useful and fix the "multiple versions interacting with each other" problem. Not yet done. Currently doesn't work. files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code. xemacs.mak: Split up CFLAGS into a version without flags specifying the C library. The problem seems to be that minitar depends on zlib, which depends specifically on libc.lib, not on any of the other C libraries. Unless you compile with libc.lib, you get errors -- specifically, no _errno in the other libraries, which must make it something other than an int. (#### But this doesn't seem to obtain in XEmacs, which also uses zlib, and can be linked with any of the C libraries. Maybe zlib is used differently and doesn't need errno, or maybe XEmacs provides an int errno; ... I don't understand. Makefile.in.in: Fix so that packages are around when testing. abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch. -- FUNCTIONALITY CHANGES: add partial support for 8-bit-fixed, 16-bit-fixed, and 32-bit-fixed formats. not quite done yet. (in particular, needs functions to actually convert the buffer.) NOTE: lots of changes to regex.c here. also, many new *_fmt() inline funs that take an Internal_Format argument. redo syntax cache code. make the cache per-buffer; keep the cache valid across calls to functions that use it. also keep it valid across insertions/deletions and extent changes, as much as is possible. eliminate the junky regex-reentrancy code by passing in the relevant lisp info to the regex routines as local vars. add general mechanism in extents code for signalling extent changes. fix numerous problems with the case-table implementation; yoshiki never properly transferred many algorithms from old-style to new-style case tables. redo char tables to support a default argument, so that mapping only occurs over changed args. change many chartab functions to accept Lisp_Object instead of Lisp_Char_Table *. comment out the code in font-lock.c by default, because font-lock.el no longer uses it. we should consider eliminating it entirely. Don't output bell as ^G in console-stream when not a TTY. add -mswindows-termination-handle to interface with i.c, so we can properly kill a build. add more error-checking to buffer/string macros. add some additional buffer_or_string_() funs. -- INTERFACE CHANGES AFFECTING MORE CODE: switch the arguments of write_c_string and friends to be consistent with write_fmt_string, which must have printcharfun first. change BI_* macros to BYTE_* for increased clarity; similarly for bi_* local vars. change VOID_TO_LISP to be a one-argument function. eliminate no-longer-needed CVOID_TO_LISP. -- char/string macro changes: rename MAKE_CHAR() to make_emchar() for slightly less confusion with make_char(). (The former generates an Emchar, the latter a Lisp object. Conceivably we should rename make_char() -> wrap_char() and similarly for make_int(), make_float().) Similar changes for other *CHAR* macros -- we now consistently use names with `emchar' whenever we are working with Emchars. Any remaining name with just `char' always refers to a Lisp object. rename macros with XSTRING_* to string_* except for those that reference actual fields in the Lisp_String object, following conventions used elsewhere. rename set_string_{data,length} macros (the only ones to work with a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_* to make the difference clear. try to be consistent about caps vs. lowercase in macro/inline-fun names for chars and such, which wasn't the case before. we now reserve caps either for XFOO_ macros that reference object fields (e.g. XSTRING_DATA) or for things that have non-function semantics, e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an arg (any arg) more than once. otherwise, use lowercase. here is a summary of most of the macros/inline funs changed by all of the above changes: BYTE_*_P -> byte_*_p XSTRING_BYTE -> string_byte set_string_data/length -> set_lispstringp_data/length XSTRING_CHAR_LENGTH -> string_char_length XSTRING_CHAR -> string_emchar INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p charptr_copy_char -> charptr_copy_emchar LEADING_BYTE_* -> leading_byte_* CHAR_* -> EMCHAR_* *_CHAR_* -> *_EMCHAR_* *_CHAR -> *_EMCHAR CHARSET_BY_ -> charset_by_* BYTE_SHIFT_JIS* -> byte_shift_jis* BYTE_BIG5* -> byte_big5* REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte char_to_unicode -> emchar_to_unicode valid_char_p -> valid_emchar_p Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality). -- INTERFACE CHANGES AFFECTING LESS CODE: use DECLARE_INLINE_HEADER in various places. remove '#ifdef emacs' from XEmacs-only files. eliminate CHAR_TABLE_VALUE(), which duplicated the functionality of get_char_table(). add BUFFER_TEXT_LOOP to simplify iterations over buffer text. define typedefs for signed and unsigned types of fixed sizes (INT_32_BIT, UINT_32_BIT, etc.). create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE; fix code to use it. add charptr_emchar_len to return the text length of the character pointed to by a ptr; use it in place of charcount_to_bytecount(..., 1). add emchar_len to return the text length of a given character. add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount and Charbpos/Charcount, in code (particularly, the extents code and redisplay code) that works with either kind of index. rename redisplay struct params with names such as `charbpos' to e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos. eliminate xxDEFUN in place of DEFUN; no longer necessary with changes awhile back to doc.c. split up big ugly combined list of EXFUNs in lisp.h on a file-by-file basis, since other prototypes are similarly split. rewrite some "*_UNSAFE" macros as inline funs and eliminate the _UNSAFE suffix. move most string code from lisp.h to text.h; the string code and text.h code is now intertwined in such a fashion that they need to be in the same place and partially interleaved. (you can't create forward references for inline funs) automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in batch mode. Fix up some problems in lisp-tests/symbol-tests that were causing spurious failures.
author ben
date Sun, 05 May 2002 11:33:57 +0000
parents a5954632b187
children 2b6fa2618f76
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.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 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
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 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
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Written by John Rose <john.rose@eng.sun.com>.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 Heavily modified and cleaned up by Ben Wing <ben@xemacs.org>. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 #include <X11/Xlib.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include "elhash.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #include "process.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 #include "tooltalk.h"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
36 #include "syssignal.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 Lisp_Object Vtooltalk_fd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 #ifdef TT_DEBUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 static FILE *tooltalk_log_file;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 Vtooltalk_message_handler_hook,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 Vtooltalk_pattern_handler_hook,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 Vtooltalk_unprocessed_message_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 Qtooltalk_message_handler_hook,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 Qtooltalk_pattern_handler_hook,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 Qtooltalk_unprocessed_message_hook;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 Qreceive_tooltalk_message,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 Qtt_address,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Qtt_args_count,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 Qtt_arg_bval,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 Qtt_arg_ival,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 Qtt_arg_mode,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 Qtt_arg_type,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 Qtt_arg_val,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Qtt_class,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 Qtt_category,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 Qtt_disposition,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 Qtt_file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Qtt_gid,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 Qtt_handler,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 Qtt_handler_ptype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Qtt_object,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 Qtt_op,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 Qtt_opnum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 Qtt_otype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 Qtt_scope,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 Qtt_sender,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 Qtt_sender_ptype,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 Qtt_session,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 Qtt_state,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 Qtt_status,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 Qtt_status_string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 Qtt_uid,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 Qtt_callback,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 Qtt_plist,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 Qtt_prop,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 Qtt_reject, /* return-tooltalk-message */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 Qtt_reply,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 Qtt_fail,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 Q_TT_MODE_UNDEFINED, /* enum Tt_mode */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 Q_TT_IN,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 Q_TT_OUT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 Q_TT_INOUT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 Q_TT_MODE_LAST,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 Q_TT_SCOPE_NONE, /* enum Tt_scope */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 Q_TT_SESSION,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 Q_TT_FILE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 Q_TT_BOTH,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Q_TT_FILE_IN_SESSION,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 Q_TT_CLASS_UNDEFINED, /* enum Tt_class */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 Q_TT_NOTICE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 Q_TT_REQUEST,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 Q_TT_CLASS_LAST,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 Q_TT_CATEGORY_UNDEFINED, /* enum Tt_category */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 Q_TT_OBSERVE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 Q_TT_HANDLE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 Q_TT_CATEGORY_LAST,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 Q_TT_PROCEDURE, /* typedef enum Tt_address */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 Q_TT_OBJECT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 Q_TT_HANDLER,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 Q_TT_OTYPE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 Q_TT_ADDRESS_LAST,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 Q_TT_CREATED, /* enum Tt_state */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 Q_TT_SENT,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 Q_TT_HANDLED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 Q_TT_FAILED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 Q_TT_QUEUED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Q_TT_STARTED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 Q_TT_REJECTED,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 Q_TT_STATE_LAST,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 Q_TT_DISCARD, /* enum Tt_disposition */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 Q_TT_QUEUE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 Q_TT_START;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 static Lisp_Object Tooltalk_Message_plist_str, Tooltalk_Pattern_plist_str;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 Lisp_Object Qtooltalk_error;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 /* Used to GCPRO tooltalk message and pattern objects while
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 they're sitting inside of some active tooltalk message or pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 There may not be any other pointers to these objects. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 Lisp_Object Vtooltalk_message_gcpro, Vtooltalk_pattern_gcpro;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
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 /* machinery for tooltalk-message type */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 /* */
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 Lisp_Object Qtooltalk_messagep;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 struct Lisp_Tooltalk_Message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 struct lcrecord_header header;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 Lisp_Object plist_sym, callback;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 Tt_message m;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 };
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 mark_tooltalk_message (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 mark_object (XTOOLTALK_MESSAGE (obj)->callback);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 return XTOOLTALK_MESSAGE (obj)->plist_sym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
165 Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
168 printing_unreadable_object ("#<tooltalk_message 0x%x>",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
169 p->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
171 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
172 (long) (p->m), p->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 }
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 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 mark_tooltalk_message, print_tooltalk_message,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 0, 0, 0, 0,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
178 Lisp_Tooltalk_Message);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 make_tooltalk_message (Tt_message m)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 Lisp_Object val;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
184 Lisp_Tooltalk_Message *msg =
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
185 alloc_lcrecord_type (Lisp_Tooltalk_Message, &lrecord_tooltalk_message);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 msg->m = m;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 msg->callback = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 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
190 return wrap_tooltalk_message (msg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 }
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 Tt_message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 unbox_tooltalk_message (Lisp_Object msg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 CHECK_TOOLTALK_MESSAGE (msg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 return XTOOLTALK_MESSAGE (msg)->m;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 }
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 DEFUN ("tooltalk-message-p", Ftooltalk_message_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 Return non-nil if OBJECT is a tooltalk message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 return TOOLTALK_MESSAGEP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 }
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 /* machinery for tooltalk-pattern type */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 /* */
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 Lisp_Object Qtooltalk_patternp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 struct Lisp_Tooltalk_Pattern
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 struct lcrecord_header header;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 Lisp_Object plist_sym, callback;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 Tt_pattern p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 };
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 mark_tooltalk_pattern (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 mark_object (XTOOLTALK_PATTERN (obj)->callback);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 return XTOOLTALK_PATTERN (obj)->plist_sym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
235 Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
238 printing_unreadable_object ("#<tooltalk_pattern 0x%x>",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
239 p->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
241 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
242 (long) (p->p), p->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 }
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 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 mark_tooltalk_pattern, print_tooltalk_pattern,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 0, 0, 0, 0,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
248 Lisp_Tooltalk_Pattern);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 make_tooltalk_pattern (Tt_pattern p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
253 Lisp_Tooltalk_Pattern *pat =
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
254 alloc_lcrecord_type (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 pat->p = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 pat->callback = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
261 return wrap_tooltalk_pattern (pat);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 }
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 static Tt_pattern
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 unbox_tooltalk_pattern (Lisp_Object pattern)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 CHECK_TOOLTALK_PATTERN (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 return XTOOLTALK_PATTERN (pattern)->p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 }
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 DEFUN ("tooltalk-pattern-p", Ftooltalk_pattern_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 Return non-nil if OBJECT is a tooltalk pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 return TOOLTALK_PATTERNP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 }
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 tooltalk_constant_value (Lisp_Object s)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 if (INTP (s))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 return XINT (s);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 else if (SYMBOLP (s))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 return XINT (XSYMBOL (s)->value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 return 0; /* should never occur */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 check_status (Tt_status st)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 if (tt_is_err (st))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
297 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 609
diff changeset
298 CIntbyte *err;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
299
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
300 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
301 signal_error (Qtooltalk_error, err, Qunbound);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
302 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 }
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 DEFUN ("receive-tooltalk-message", Freceive_tooltalk_message, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 Run tt_message_receive().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 This function is the process handler for the ToolTalk connection process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 (ignore1, ignore2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 Tt_message mess = tt_message_receive ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 Lisp_Object message_ = make_tooltalk_message (mess);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 GCPRO1 (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 if (mess != NULL && !NILP (Vtooltalk_unprocessed_message_hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 va_run_hook_with_args (Qtooltalk_unprocessed_message_hook, 1, message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 /* see comment in event-stream.c about this return value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 }
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 static Tt_callback_action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 tooltalk_message_callback (Tt_message m, Tt_pattern p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 Lisp_Object cb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 Lisp_Object message_;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 Lisp_Object pattern;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 #ifdef TT_DEBUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 int i, j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 fprintf (tooltalk_log_file, "message_cb: %d\n", m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 fprintf (tooltalk_log_file, "op: %s (", tt_message_op (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 for (j = tt_message_args_count (m), i = 0; i < j; i++) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 fprintf (tooltalk_log_file, "%s \"%s\"", tt_message_arg_type (m, i),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 tt_message_arg_val (m, i));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 fprintf (tooltalk_log_file, "%s", i == j-1 ? ")" : ", ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 fprintf (tooltalk_log_file, "\n\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 fflush (tooltalk_log_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
348 message_ = VOID_TO_LISP (tt_message_user (m, TOOLTALK_MESSAGE_KEY));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 pattern = make_tooltalk_pattern (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 cb = XTOOLTALK_MESSAGE (message_)->callback;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 GCPRO2 (message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 if (!NILP (Vtooltalk_message_handler_hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 va_run_hook_with_args (Qtooltalk_message_handler_hook, 2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 if ((SYMBOLP (cb) && EQ (Qt, Ffboundp (cb))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (CONSP (cb) && EQ (Qlambda, Fcar (cb)) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 !NILP (Flistp (Fcar (Fcdr (cb))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 call2 (cb, message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 tt_message_destroy (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 Fremhash (message_, Vtooltalk_message_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 return TT_CALLBACK_PROCESSED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 }
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 static Tt_callback_action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 tooltalk_pattern_callback (Tt_message m, Tt_pattern p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 Lisp_Object cb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 Lisp_Object message_;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 Lisp_Object pattern;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 #ifdef TT_DEBUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 int i, j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 fprintf (tooltalk_log_file, "pattern_cb: %d\n", m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 fprintf (tooltalk_log_file, "op: %s (", tt_message_op (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 for (j = tt_message_args_count (m), i = 0; i < j; i++) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 fprintf (tooltalk_log_file, "%s \"%s\"", tt_message_arg_type (m, i),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 tt_message_arg_val (m, i));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 fprintf (tooltalk_log_file, "%s", i == j-1 ? ")" : ", ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 fprintf (tooltalk_log_file, "\n\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 fflush (tooltalk_log_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 message_ = make_tooltalk_message (m);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
392 pattern = VOID_TO_LISP (tt_pattern_user (p, TOOLTALK_PATTERN_KEY));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 cb = XTOOLTALK_PATTERN (pattern)->callback;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 GCPRO2 (message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 if (!NILP (Vtooltalk_pattern_handler_hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 va_run_hook_with_args (Qtooltalk_pattern_handler_hook, 2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 if (SYMBOLP (cb) && EQ (Qt, Ffboundp (cb)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 call2 (cb, message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 tt_message_destroy (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 return TT_CALLBACK_PROCESSED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 tt_mode_symbol (Tt_mode n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 switch (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 case TT_MODE_UNDEFINED: return Q_TT_MODE_UNDEFINED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 case TT_IN: return Q_TT_IN;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 case TT_OUT: return Q_TT_OUT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 case TT_INOUT: return Q_TT_INOUT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 case TT_MODE_LAST: return Q_TT_MODE_LAST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 default: return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 tt_scope_symbol (Tt_scope n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 switch (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 case TT_SCOPE_NONE: return Q_TT_SCOPE_NONE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 case TT_SESSION: return Q_TT_SESSION;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 case TT_FILE: return Q_TT_FILE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 case TT_BOTH: return Q_TT_BOTH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 case TT_FILE_IN_SESSION: return Q_TT_FILE_IN_SESSION;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 default: return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 tt_class_symbol (Tt_class n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 switch (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 case TT_CLASS_UNDEFINED: return Q_TT_CLASS_UNDEFINED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 case TT_NOTICE: return Q_TT_NOTICE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 case TT_REQUEST: return Q_TT_REQUEST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 case TT_CLASS_LAST: return Q_TT_CLASS_LAST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 default: return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 }
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 * 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
451 * simply not necessary?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 tt_category_symbol (Tt_category n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 switch (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 case TT_CATEGORY_UNDEFINED: return Q_TT_CATEGORY_UNDEFINED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 case TT_OBSERVE: return Q_TT_OBSERVE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 case TT_HANDLE: return Q_TT_HANDLE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 case TT_CATEGORY_LAST: return Q_TT_CATEGORY_LAST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 default: return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 }
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 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 tt_address_symbol (Tt_address n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 switch (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 case TT_PROCEDURE: return Q_TT_PROCEDURE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 case TT_OBJECT: return Q_TT_OBJECT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 case TT_HANDLER: return Q_TT_HANDLER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 case TT_OTYPE: return Q_TT_OTYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 case TT_ADDRESS_LAST: return Q_TT_ADDRESS_LAST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 default: return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 tt_state_symbol (Tt_state n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 switch (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 case TT_CREATED: return Q_TT_CREATED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 case TT_SENT: return Q_TT_SENT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 case TT_HANDLED: return Q_TT_HANDLED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 case TT_FAILED: return Q_TT_FAILED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 case TT_QUEUED: return Q_TT_QUEUED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 case TT_STARTED: return Q_TT_STARTED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 case TT_REJECTED: return Q_TT_REJECTED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 case TT_STATE_LAST: return Q_TT_STATE_LAST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 default: return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 }
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 static Lisp_Object
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
500 tt_build_c_string (char *s)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 return build_string (s ? s : "");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 tt_opnum_string (int n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 char buf[32];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 sprintf (buf, "%u", n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 return build_string (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 tt_message_arg_ival_string (Tt_message m, int n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 {
603
1c880911c386 [xemacs-hg @ 2001-06-01 08:23:09 by martinb]
martinb
parents: 578
diff changeset
517 char buf[DECIMAL_PRINT_SIZE (long)];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 int value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 check_status (tt_message_arg_ival (m, n, &value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 long_to_string (buf, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 return build_string (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 tt_message_arg_bval_vector (Tt_message m, int n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 /* !!#### This function has not been Mule-ized */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 609
diff changeset
529 Intbyte *value;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 int len = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 check_status (tt_message_arg_bval (m, n, &value, &len));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 return make_string (value, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 }
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 DEFUN ("get-tooltalk-message-attribute", Fget_tooltalk_message_attribute,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 Return the indicated Tooltalk message attribute. Attributes are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 identified by symbols with the same name (underscores and all) as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 suffix of the Tooltalk tt_message_<attribute> function that extracts the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 String attribute values are copied, enumerated type values (except disposition)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 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
544 represented by fixnums (small integers), opnum is converted to a string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 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
546 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
547 within the range of Lisp integers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 Use the 'plist attribute instead of the C API 'user attribute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 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
551 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
552 called 'rflag, use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 (get-tooltalk-message-attribute message 'plist 'rflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 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
556 'arg_ival (integers), or 'arg_bval (strings with embedded nulls), attributes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 For example to get the integer value of the third argument:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (get-tooltalk-message-attribute message 'arg_ival 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 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
562 can be retrieved with the 'arg_type attribute; however, Tooltalk doesn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 define any semantics for the string value of 'arg_type. Conventionally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 "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
565 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
566 value returned by 'arg_bval like a string is fine.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (message_, attribute, argn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 int n = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 CHECK_SYMBOL (attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 if (EQ (attribute, (Qtt_arg_bval)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 EQ (attribute, (Qtt_arg_ival)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 EQ (attribute, (Qtt_arg_mode)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 EQ (attribute, (Qtt_arg_type)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 EQ (attribute, (Qtt_arg_val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 CHECK_INT (argn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 n = XINT (argn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 }
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 if (!VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 else if (EQ (attribute, Qtt_arg_bval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 return tt_message_arg_bval_vector (m, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 else if (EQ (attribute, Qtt_arg_ival))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 return tt_message_arg_ival_string (m, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 else if (EQ (attribute, Qtt_arg_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 return tt_mode_symbol (tt_message_arg_mode (m, n));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 else if (EQ (attribute, Qtt_arg_type))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
597 return tt_build_c_string (tt_message_arg_type (m, n));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 else if (EQ (attribute, Qtt_arg_val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 return tt_message_arg_bval_vector (m, n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 else if (EQ (attribute, Qtt_args_count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 return make_int (tt_message_args_count (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 else if (EQ (attribute, Qtt_address))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 return tt_address_symbol (tt_message_address (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 else if (EQ (attribute, Qtt_class))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 return tt_class_symbol (tt_message_class (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 else if (EQ (attribute, Qtt_disposition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 return make_int (tt_message_disposition (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 else if (EQ (attribute, Qtt_file))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
615 return tt_build_c_string (tt_message_file (m));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 else if (EQ (attribute, Qtt_gid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 return make_int (tt_message_gid (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 else if (EQ (attribute, Qtt_handler))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
621 return tt_build_c_string (tt_message_handler (m));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 else if (EQ (attribute, Qtt_handler_ptype))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
624 return tt_build_c_string (tt_message_handler_ptype (m));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 else if (EQ (attribute, Qtt_object))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
627 return tt_build_c_string (tt_message_object (m));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 else if (EQ (attribute, Qtt_op))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
630 return tt_build_c_string (tt_message_op (m));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 else if (EQ (attribute, Qtt_opnum))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 return tt_opnum_string (tt_message_opnum (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 else if (EQ (attribute, Qtt_otype))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
636 return tt_build_c_string (tt_message_otype (m));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 else if (EQ (attribute, Qtt_scope))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 return tt_scope_symbol (tt_message_scope (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 else if (EQ (attribute, Qtt_sender))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
642 return tt_build_c_string (tt_message_sender (m));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 else if (EQ (attribute, Qtt_sender_ptype))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
645 return tt_build_c_string (tt_message_sender_ptype (m));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 else if (EQ (attribute, Qtt_session))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
648 return tt_build_c_string (tt_message_session (m));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 else if (EQ (attribute, Qtt_state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 return tt_state_symbol (tt_message_state (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 else if (EQ (attribute, Qtt_status))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 return make_int (tt_message_status (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 else if (EQ (attribute, Qtt_status_string))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
657 return tt_build_c_string (tt_message_status_string (m));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 else if (EQ (attribute, Qtt_uid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 return make_int (tt_message_uid (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 else if (EQ (attribute, Qtt_callback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 return XTOOLTALK_MESSAGE (message_)->callback;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 else if (EQ (attribute, Qtt_prop))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 return Fget (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 else if (EQ (attribute, Qtt_plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 return Fcopy_sequence (Fsymbol_plist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 (XTOOLTALK_MESSAGE (message_)->plist_sym));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
673 invalid_constant ("Invalid value for `get-tooltalk-message-attribute'",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 }
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 DEFUN ("set-tooltalk-message-attribute", Fset_tooltalk_message_attribute,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 Initialize one Tooltalk message attribute.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 Attribute names and values are the same as for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 `get-tooltalk-message-attribute'. A property list is provided for user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 data (instead of the 'user message attribute); see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 `get-tooltalk-message-attribute'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 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
689 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
690 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
691 changed to TT_HANDLED (or TT_FAILED), so that reply argument values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 can be used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 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
695 '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
696 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
697 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (value, message_, attribute, argn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 int n = 0;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
702 Tt_status (*fun_str) (Tt_message, const char *) = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 CHECK_SYMBOL (attribute);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
705
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 if (EQ (attribute, (Qtt_arg_bval)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 EQ (attribute, (Qtt_arg_ival)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 EQ (attribute, (Qtt_arg_val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 CHECK_INT (argn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 n = XINT (argn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 }
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 if (!VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
717 if (EQ (attribute, Qtt_address))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 tt_message_address_set (m, (Tt_address) tooltalk_constant_value (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 else if (EQ (attribute, Qtt_class))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 tt_message_class_set (m, (Tt_class) tooltalk_constant_value (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 else if (EQ (attribute, Qtt_disposition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 tt_message_disposition_set (m, ((Tt_disposition)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 tooltalk_constant_value (value)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 else if (EQ (attribute, Qtt_scope))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
738 else if (EQ (attribute, Qtt_file))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
739 fun_str = tt_message_file_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
740 else if (EQ (attribute, Qtt_handler_ptype))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
741 fun_str = tt_message_handler_ptype_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
742 else if (EQ (attribute, Qtt_handler))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
743 fun_str = tt_message_handler_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
744 else if (EQ (attribute, Qtt_object))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
745 fun_str = tt_message_object_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
746 else if (EQ (attribute, Qtt_op))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
747 fun_str = tt_message_op_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
748 else if (EQ (attribute, Qtt_otype))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
749 fun_str = tt_message_otype_set;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 else if (EQ (attribute, Qtt_sender_ptype))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
751 fun_str = tt_message_sender_ptype_set;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 else if (EQ (attribute, Qtt_session))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
753 fun_str = tt_message_session_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
754 else if (EQ (attribute, Qtt_status_string))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
755 fun_str = tt_message_status_string_set;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 else if (EQ (attribute, Qtt_arg_bval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 Extbyte *value_ext;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 609
diff changeset
759 Bytecount value_ext_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 CHECK_STRING (value);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
761 TO_EXTERNAL_FORMAT (LISP_STRING, value,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
762 ALLOCA, (value_ext, value_ext_len),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
763 Qnative);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
764 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
765 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 else if (EQ (attribute, Qtt_arg_ival))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 CHECK_INT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 tt_message_arg_ival_set (m, n, XINT (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 else if (EQ (attribute, Qtt_arg_val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
773 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
775 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 tt_message_arg_val_set (m, n, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 else if (EQ (attribute, Qtt_status))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 CHECK_INT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 tt_message_status_set (m, XINT (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 else if (EQ (attribute, Qtt_callback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 CHECK_SYMBOL (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 XTOOLTALK_MESSAGE (message_)->callback = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 else if (EQ (attribute, Qtt_prop))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 return Fput (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
793 invalid_constant ("Invalid value for `set-tooltalk-message-attribute'",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 attribute);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
795
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
796 if (fun_str)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
797 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
798 const char *value_ext;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
799 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
800 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
801 (*fun_str) (m, value_ext);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
802 }
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
803
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 }
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 DEFUN ("return-tooltalk-message", Freturn_tooltalk_message, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 Send a reply to this message. The second argument can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 'reply, 'reject or 'fail; the default is 'reply. Before sending
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 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
811 have been filled in - see set-tooltalk-message-attribute.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 (message_, mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 if (NILP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 mode = Qtt_reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 CHECK_SYMBOL (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 if (!VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 else if (EQ (mode, Qtt_reply))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 tt_message_reply (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 else if (EQ (mode, Qtt_reject))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 tt_message_reject (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 else if (EQ (mode, Qtt_fail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 tt_message_fail (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 }
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 DEFUN ("create-tooltalk-message", Fcreate_tooltalk_message, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 Create a new tooltalk message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 The messages session attribute is initialized to the default session.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 Other attributes can be initialized with `set-tooltalk-message-attribute'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 `make-tooltalk-message' is the preferred to create and initialize a message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 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
841 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
842 calling `make-tooltalk-message'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 (no_callback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 Tt_message m = tt_message_create ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 Lisp_Object message_ = make_tooltalk_message (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 if (NILP (no_callback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 tt_message_callback_add (m, tooltalk_message_callback);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 tt_message_session_set (m, tt_default_session ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 tt_message_user_set (m, TOOLTALK_MESSAGE_KEY, LISP_TO_VOID (message_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 return message_;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 }
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 DEFUN ("destroy-tooltalk-message", Fdestroy_tooltalk_message, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 Apply tt_message_destroy() to the message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 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
860 a message or pattern callback; the Lisp/Tooltalk callback machinery does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 this for you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 (message_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 if (VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 /* #### Should we call Fremhash() here? It seems that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 a common paradigm is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 (send-tooltalk-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 (destroy-tooltalk-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 which would imply that destroying a sent ToolTalk message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 doesn't actually destroy it; when a response is sent back,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 the callback for the message will still be called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 But then maybe not: Maybe it really does destroy it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 and the reason for that paradigm is that the author
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 of `send-tooltalk-message' didn't really know what he
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 was talking about when he said that it's a good idea
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 to call `destroy-tooltalk-message' after sending it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 tt_message_destroy (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 }
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 DEFUN ("add-tooltalk-message-arg", Fadd_tooltalk_message_arg, 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 Append one new argument to the message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 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
892 and VALUE can be a string or an integer. Tooltalk doesn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 define any semantics for VTYPE, so only the participants in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 protocol you're using need to agree what types mean (if anything).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 Conventionally "string" is used for strings and "int" for 32 bit integers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 Arguments can initialized by providing a value or with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 `set-tooltalk-message-attribute'. The latter is necessary if you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 want to initialize the argument with a string that can contain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 embedded nulls (use 'arg_bval).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 (message_, mode, vtype, value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 Tt_mode n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 CHECK_STRING (vtype);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 CHECK_TOOLTALK_CONSTANT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 n = (Tt_mode) tooltalk_constant_value (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 if (!VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
914 const char *vtype_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
916 LISP_STRING_TO_EXTERNAL (vtype, vtype_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 if (NILP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 tt_message_arg_add (m, n, vtype_ext, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 else if (STRINGP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
921 const char *value_ext;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
922 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 tt_message_arg_add (m, n, vtype_ext, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 else if (INTP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 tt_message_iarg_add (m, n, vtype_ext, XINT (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 }
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 }
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 DEFUN ("send-tooltalk-message", Fsend_tooltalk_message, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 Send the message on its way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 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
935 it with `destroy-tooltalk-message'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 (message_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 if (VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 tt_message_send (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 Fputhash (message_, Qnil, Vtooltalk_message_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 }
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 }
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 DEFUN ("create-tooltalk-pattern", Fcreate_tooltalk_pattern, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 Create a new Tooltalk pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 Its session attribute is initialized to be the default session.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 */
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 Tt_pattern p = tt_pattern_create ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 Lisp_Object pattern = make_tooltalk_pattern (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 tt_pattern_callback_add (p, tooltalk_pattern_callback);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 tt_pattern_session_add (p, tt_default_session ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 tt_pattern_user_set (p, TOOLTALK_PATTERN_KEY, LISP_TO_VOID (pattern));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 return pattern;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 }
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 DEFUN ("destroy-tooltalk-pattern", Fdestroy_tooltalk_pattern, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 Apply tt_pattern_destroy() to the pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 This effectively unregisters the pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 (pattern))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 Tt_pattern p = unbox_tooltalk_pattern (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 if (VALID_TOOLTALK_PATTERNP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 tt_pattern_destroy (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 Fremhash (pattern, Vtooltalk_pattern_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 }
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 }
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 DEFUN ("add-tooltalk-pattern-attribute", Fadd_tooltalk_pattern_attribute, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 Add one value to the indicated pattern attribute.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 All Tooltalk pattern attributes are supported except 'user. The names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 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
989 less the "tooltalk_pattern_" prefix and the "_add" ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 (value, pattern, attribute))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 Tt_pattern p = unbox_tooltalk_pattern (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 CHECK_SYMBOL (attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 if (!VALID_TOOLTALK_PATTERNP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 else if (EQ (attribute, Qtt_category))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 tt_pattern_category_set (p, ((Tt_category)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 tooltalk_constant_value (value)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 else if (EQ (attribute, Qtt_address))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 tt_pattern_address_add (p, ((Tt_address)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 tooltalk_constant_value (value)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 else if (EQ (attribute, Qtt_class))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 tt_pattern_class_add (p, (Tt_class) tooltalk_constant_value (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 else if (EQ (attribute, Qtt_disposition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 tt_pattern_disposition_add (p, ((Tt_disposition)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 tooltalk_constant_value (value)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 else if (EQ (attribute, Qtt_file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1025 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1027 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 tt_pattern_file_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 else if (EQ (attribute, Qtt_object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1032 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1034 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 tt_pattern_object_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 else if (EQ (attribute, Qtt_op))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1039 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1041 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 tt_pattern_op_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 else if (EQ (attribute, Qtt_otype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1046 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1048 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 tt_pattern_otype_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 else if (EQ (attribute, Qtt_scope))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 tt_pattern_scope_add (p, (Tt_scope) tooltalk_constant_value (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 else if (EQ (attribute, Qtt_sender))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1058 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1060 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 tt_pattern_sender_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 else if (EQ (attribute, Qtt_sender_ptype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1065 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1067 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 tt_pattern_sender_ptype_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 else if (EQ (attribute, Qtt_session))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1072 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1074 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 tt_pattern_session_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 else if (EQ (attribute, Qtt_state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 tt_pattern_state_add (p, (Tt_state) tooltalk_constant_value (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 else if (EQ (attribute, Qtt_callback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 CHECK_SYMBOL (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 XTOOLTALK_PATTERN (pattern)->callback = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 }
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089 }
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 DEFUN ("add-tooltalk-pattern-arg", Fadd_tooltalk_pattern_arg, 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 Add one fully specified argument to a tooltalk pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 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
1095 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
1096 an integer argument (tt_pattern_iarg_add) added otherwise a string argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 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
1098 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 (pattern, mode, vtype, value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1101 Tt_pattern p = unbox_tooltalk_pattern (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 Tt_mode n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 CHECK_STRING (vtype);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 CHECK_TOOLTALK_CONSTANT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 n = (Tt_mode) tooltalk_constant_value (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 if (!VALID_TOOLTALK_PATTERNP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1113 const char *vtype_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1115 LISP_STRING_TO_EXTERNAL (vtype, vtype_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 if (NILP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 tt_pattern_arg_add (p, n, vtype_ext, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 else if (STRINGP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1119 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1120 const char *value_ext;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1121 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 tt_pattern_arg_add (p, n, vtype_ext, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 else if (INTP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 tt_pattern_iarg_add (p, n, vtype_ext, XINT (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1126 }
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 }
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 DEFUN ("register-tooltalk-pattern", Fregister_tooltalk_pattern, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 Emacs will begin receiving messages that match this pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 (pattern))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 Tt_pattern p = unbox_tooltalk_pattern (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 if (VALID_TOOLTALK_PATTERNP (p) && tt_pattern_register (p) == TT_OK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 Fputhash (pattern, Qnil, Vtooltalk_pattern_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146 }
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 DEFUN ("unregister-tooltalk-pattern", Funregister_tooltalk_pattern, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 Emacs will stop receiving messages that match this pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 (pattern))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 Tt_pattern p = unbox_tooltalk_pattern (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 if (VALID_TOOLTALK_PATTERNP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1158 tt_pattern_unregister (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 Fremhash (pattern, Vtooltalk_pattern_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 }
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 }
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 DEFUN ("tooltalk-pattern-prop-get", Ftooltalk_pattern_prop_get, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 Return the value of PROPERTY in tooltalk pattern PATTERN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 This is the last value set with `tooltalk-pattern-prop-set'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 (pattern, property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 CHECK_TOOLTALK_PATTERN (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 return Fget (XTOOLTALK_PATTERN (pattern)->plist_sym, property, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 }
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 DEFUN ("tooltalk-pattern-prop-set", Ftooltalk_pattern_prop_set, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 Set the value of PROPERTY to VALUE in tooltalk pattern PATTERN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 It can be retrieved with `tooltalk-pattern-prop-get'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 (pattern, property, value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 CHECK_TOOLTALK_PATTERN (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 return Fput (XTOOLTALK_PATTERN (pattern)->plist_sym, property, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 }
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 DEFUN ("tooltalk-pattern-plist-get", Ftooltalk_pattern_plist_get, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 Return the a list of all the properties currently set in PATTERN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 (pattern))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 CHECK_TOOLTALK_PATTERN (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 Fcopy_sequence (Fsymbol_plist (XTOOLTALK_PATTERN (pattern)->plist_sym));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1196 }
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 DEFUN ("tooltalk-default-procid", Ftooltalk_default_procid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 Return current default process identifier for your process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 */
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 char *procid = tt_default_procid ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 return procid ? build_string (procid) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 }
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 DEFUN ("tooltalk-default-session", Ftooltalk_default_session, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 Return current default session identifier for the current default procid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 */
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 char *session = tt_default_session ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 return session ? build_string (session) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 init_tooltalk (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 char *retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 Lisp_Object lp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 Lisp_Object fil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1225 /* 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
1226 ttsessions is running on the machine), therefore we save the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 actions and restore them after the call */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 #ifdef HAVE_SIGPROCMASK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 struct sigaction ActSIGQUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 struct sigaction ActSIGINT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1232 struct sigaction ActSIGCHLD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 sigaction (SIGQUIT, NULL, &ActSIGQUIT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 sigaction (SIGINT, NULL, &ActSIGINT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 sigaction (SIGCHLD, NULL, &ActSIGCHLD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 retval = tt_open ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 #ifdef HAVE_SIGPROCMASK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 sigaction (SIGQUIT, &ActSIGQUIT, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 sigaction (SIGINT, &ActSIGINT, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 sigaction (SIGCHLD, &ActSIGCHLD, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244
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 if (tt_ptr_error (retval) != TT_OK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 Vtooltalk_fd = make_int (tt_fd ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 tt_session_join (tt_default_session ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 lp = connect_to_file_descriptor (build_string ("tooltalk"), Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 Vtooltalk_fd, Vtooltalk_fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 if (!NILP (lp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 /* Don't ask the user for confirmation when exiting Emacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258 Fprocess_kill_without_query (lp, Qnil);
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
1259 fil = wrap_subr (&SFreceive_tooltalk_message);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 set_process_filter (lp, fil, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 tt_close ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 Vtooltalk_fd = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267 }
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 #if defined (SOLARIS2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 /* Apparently the tt_message_send_on_exit() function does not exist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 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
1272 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
1273 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 Tt_message exit_msg = tt_message_create ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 tt_message_op_set (exit_msg, "emacs-aborted");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 tt_message_scope_set (exit_msg, TT_SESSION);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1278 tt_message_class_set (exit_msg, TT_NOTICE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 tt_message_send_on_exit (exit_msg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 tt_message_destroy (exit_msg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 }
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 DEFUN ("tooltalk-open-connection", Ftooltalk_open_connection, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 Opens a connection to the ToolTalk server.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 Returns t if successful, nil otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 */
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 if (!NILP (Vtooltalk_fd))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1292 signal_error (Qio_error, "Already connected to ToolTalk", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 if (noninteractive)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1294 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
1295 init_tooltalk ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 return NILP (Vtooltalk_fd) ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 syms_of_tooltalk (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1303 INIT_LRECORD_IMPLEMENTATION (tooltalk_message);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1304 INIT_LRECORD_IMPLEMENTATION (tooltalk_pattern);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1305
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1306 DEFSYMBOL_MULTIWORD_PREDICATE (Qtooltalk_messagep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 DEFSUBR (Ftooltalk_message_p);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1308 DEFSYMBOL_MULTIWORD_PREDICATE (Qtooltalk_patternp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 DEFSUBR (Ftooltalk_pattern_p);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1310 DEFSYMBOL (Qtooltalk_message_handler_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1311 DEFSYMBOL (Qtooltalk_pattern_handler_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1312 DEFSYMBOL (Qtooltalk_unprocessed_message_hook);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 DEFSUBR (Freceive_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 DEFSUBR (Fcreate_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 DEFSUBR (Fdestroy_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 DEFSUBR (Fadd_tooltalk_message_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 DEFSUBR (Fget_tooltalk_message_attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 DEFSUBR (Fset_tooltalk_message_attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 DEFSUBR (Fsend_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 DEFSUBR (Freturn_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 DEFSUBR (Fcreate_tooltalk_pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 DEFSUBR (Fdestroy_tooltalk_pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 DEFSUBR (Fadd_tooltalk_pattern_attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 DEFSUBR (Fadd_tooltalk_pattern_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 DEFSUBR (Fregister_tooltalk_pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 DEFSUBR (Funregister_tooltalk_pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 DEFSUBR (Ftooltalk_pattern_plist_get);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 DEFSUBR (Ftooltalk_pattern_prop_set);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 DEFSUBR (Ftooltalk_pattern_prop_get);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 DEFSUBR (Ftooltalk_default_procid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 DEFSUBR (Ftooltalk_default_session);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 DEFSUBR (Ftooltalk_open_connection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1335 DEFSYMBOL (Qreceive_tooltalk_message);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 defsymbol (&Qtt_address, "address");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 defsymbol (&Qtt_args_count, "args_count");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 defsymbol (&Qtt_arg_bval, "arg_bval");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 defsymbol (&Qtt_arg_ival, "arg_ival");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340 defsymbol (&Qtt_arg_mode, "arg_mode");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1341 defsymbol (&Qtt_arg_type, "arg_type");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 defsymbol (&Qtt_arg_val, "arg_val");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 defsymbol (&Qtt_class, "class");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 defsymbol (&Qtt_category, "category");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 defsymbol (&Qtt_disposition, "disposition");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 defsymbol (&Qtt_file, "file");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 defsymbol (&Qtt_gid, "gid");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 defsymbol (&Qtt_handler, "handler");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 defsymbol (&Qtt_handler_ptype, "handler_ptype");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 defsymbol (&Qtt_object, "object");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 defsymbol (&Qtt_op, "op");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 defsymbol (&Qtt_opnum, "opnum");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 defsymbol (&Qtt_otype, "otype");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 defsymbol (&Qtt_scope, "scope");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 defsymbol (&Qtt_sender, "sender");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 defsymbol (&Qtt_sender_ptype, "sender_ptype");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 defsymbol (&Qtt_session, "session");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 defsymbol (&Qtt_state, "state");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 defsymbol (&Qtt_status, "status");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 defsymbol (&Qtt_status_string, "status_string");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 defsymbol (&Qtt_uid, "uid");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 defsymbol (&Qtt_callback, "callback");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 defsymbol (&Qtt_prop, "prop");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 defsymbol (&Qtt_plist, "plist");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 defsymbol (&Qtt_reject, "reject");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 defsymbol (&Qtt_reply, "reply");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 defsymbol (&Qtt_fail, "fail");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1369 DEFERROR (Qtooltalk_error, "ToolTalk error", Qio_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 }
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 vars_of_tooltalk (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 Fprovide (intern ("tooltalk"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 DEFVAR_LISP ("tooltalk-fd", &Vtooltalk_fd /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 File descriptor returned by tt_initialize; nil if not connected to ToolTalk.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 Vtooltalk_fd = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 DEFVAR_LISP ("tooltalk-message-handler-hook",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 &Vtooltalk_message_handler_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 List of functions to be applied to each ToolTalk message reply received.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 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
1386 Functions will be called with two arguments, the message and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387 corresponding pattern. This hook will not be called if the request
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 message was created without a C-level callback function (see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 `tooltalk-unprocessed-message-hook').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 Vtooltalk_message_handler_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 DEFVAR_LISP ("tooltalk-pattern-handler-hook",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 &Vtooltalk_pattern_handler_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 List of functions to be applied to each pattern-matching ToolTalk message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 This is all messages except those handled by `tooltalk-message-handler-hook'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 Functions will be called with two arguments, the message and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 corresponding pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 Vtooltalk_pattern_handler_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 DEFVAR_LISP ("tooltalk-unprocessed-message-hook",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 &Vtooltalk_unprocessed_message_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 List of functions to be applied to each unprocessed ToolTalk message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 Unprocessed messages are messages that didn't match any patterns.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 Vtooltalk_unprocessed_message_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1409 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
1410 Tooltalk_Pattern_plist_str = build_msg_string ("Tooltalk Pattern plist");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 staticpro(&Tooltalk_Message_plist_str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 staticpro(&Tooltalk_Pattern_plist_str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 #define MAKE_CONSTANT(name) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 defsymbol (&Q_ ## name, #name); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 Fset (Q_ ## name, make_int (name)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 MAKE_CONSTANT (TT_MODE_UNDEFINED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 MAKE_CONSTANT (TT_IN);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 MAKE_CONSTANT (TT_OUT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 MAKE_CONSTANT (TT_INOUT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 MAKE_CONSTANT (TT_MODE_LAST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 MAKE_CONSTANT (TT_SCOPE_NONE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 MAKE_CONSTANT (TT_SESSION);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 MAKE_CONSTANT (TT_FILE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 MAKE_CONSTANT (TT_BOTH);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 MAKE_CONSTANT (TT_FILE_IN_SESSION);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432 MAKE_CONSTANT (TT_CLASS_UNDEFINED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 MAKE_CONSTANT (TT_NOTICE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 MAKE_CONSTANT (TT_REQUEST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 MAKE_CONSTANT (TT_CLASS_LAST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 MAKE_CONSTANT (TT_CATEGORY_UNDEFINED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 MAKE_CONSTANT (TT_OBSERVE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 MAKE_CONSTANT (TT_HANDLE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 MAKE_CONSTANT (TT_CATEGORY_LAST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442 MAKE_CONSTANT (TT_PROCEDURE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 MAKE_CONSTANT (TT_OBJECT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 MAKE_CONSTANT (TT_HANDLER);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 MAKE_CONSTANT (TT_OTYPE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 MAKE_CONSTANT (TT_ADDRESS_LAST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 MAKE_CONSTANT (TT_CREATED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 MAKE_CONSTANT (TT_SENT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 MAKE_CONSTANT (TT_HANDLED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 MAKE_CONSTANT (TT_FAILED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 MAKE_CONSTANT (TT_QUEUED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 MAKE_CONSTANT (TT_STARTED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 MAKE_CONSTANT (TT_REJECTED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 MAKE_CONSTANT (TT_STATE_LAST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 MAKE_CONSTANT (TT_DISCARD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 MAKE_CONSTANT (TT_QUEUE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 MAKE_CONSTANT (TT_START);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 #undef MAKE_CONSTANT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1463 staticpro (&Vtooltalk_message_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 staticpro (&Vtooltalk_pattern_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 Vtooltalk_message_gcpro =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 Vtooltalk_pattern_gcpro =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 }