annotate src/tooltalk.c @ 665:fdefd0186b75

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents 13e3d7ae7155
children 943eaba38521
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 char buf[200];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
170 printing_unreadable_object ("#<tooltalk_message 0x%x>",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
171 p->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 sprintf (buf, "#<tooltalk_message id:0x%lx 0x%x>", (long) (p->m), p->header.uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 write_c_string (buf, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 mark_tooltalk_message, print_tooltalk_message,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 0, 0, 0, 0,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
180 Lisp_Tooltalk_Message);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 make_tooltalk_message (Tt_message m)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 Lisp_Object val;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
186 Lisp_Tooltalk_Message *msg =
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
187 alloc_lcrecord_type (Lisp_Tooltalk_Message, &lrecord_tooltalk_message);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 msg->m = m;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 msg->callback = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 XSETTOOLTALK_MESSAGE (val, msg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 }
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 Tt_message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 unbox_tooltalk_message (Lisp_Object msg)
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 CHECK_TOOLTALK_MESSAGE (msg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 return XTOOLTALK_MESSAGE (msg)->m;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 }
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 DEFUN ("tooltalk-message-p", Ftooltalk_message_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 Return non-nil if OBJECT is a tooltalk message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 (object))
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 return TOOLTALK_MESSAGEP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
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 /* machinery for tooltalk-pattern type */
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 Lisp_Object Qtooltalk_patternp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 struct Lisp_Tooltalk_Pattern
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 struct lcrecord_header header;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 Lisp_Object plist_sym, callback;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 Tt_pattern p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 };
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 mark_tooltalk_pattern (Lisp_Object obj)
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 mark_object (XTOOLTALK_PATTERN (obj)->callback);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 return XTOOLTALK_PATTERN (obj)->plist_sym;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
238 Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 char buf[200];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
243 printing_unreadable_object ("#<tooltalk_pattern 0x%x>",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
244 p->header.uid);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 sprintf (buf, "#<tooltalk_pattern id:0x%lx 0x%x>", (long) (p->p), p->header.uid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 write_c_string (buf, printcharfun);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 }
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 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 mark_tooltalk_pattern, print_tooltalk_pattern,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 0, 0, 0, 0,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
253 Lisp_Tooltalk_Pattern);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 make_tooltalk_pattern (Tt_pattern p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
258 Lisp_Tooltalk_Pattern *pat =
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
259 alloc_lcrecord_type (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 Lisp_Object val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 pat->p = p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 pat->callback = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 XSETTOOLTALK_PATTERN (val, pat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 }
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 static Tt_pattern
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 unbox_tooltalk_pattern (Lisp_Object pattern)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 CHECK_TOOLTALK_PATTERN (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 return XTOOLTALK_PATTERN (pattern)->p;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 DEFUN ("tooltalk-pattern-p", Ftooltalk_pattern_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 Return non-nil if OBJECT is a tooltalk pattern.
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 (object))
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 return TOOLTALK_PATTERNP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 tooltalk_constant_value (Lisp_Object s)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 if (INTP (s))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 return XINT (s);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 else if (SYMBOLP (s))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 return XINT (XSYMBOL (s)->value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 return 0; /* should never occur */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 check_status (Tt_status st)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 if (tt_is_err (st))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
303 {
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 609
diff changeset
304 CIntbyte *err;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
305
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
306 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
307 signal_error (Qtooltalk_error, err, Qunbound);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
308 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 DEFUN ("receive-tooltalk-message", Freceive_tooltalk_message, 0, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 Run tt_message_receive().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 This function is the process handler for the ToolTalk connection process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (ignore1, ignore2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 Tt_message mess = tt_message_receive ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 Lisp_Object message_ = make_tooltalk_message (mess);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 GCPRO1 (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 if (mess != NULL && !NILP (Vtooltalk_unprocessed_message_hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 va_run_hook_with_args (Qtooltalk_unprocessed_message_hook, 1, message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 /* see comment in event-stream.c about this return value. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 return Qzero;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 static Tt_callback_action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 tooltalk_message_callback (Tt_message m, Tt_pattern p)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 Lisp_Object cb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 Lisp_Object message_;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 Lisp_Object pattern;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 #ifdef TT_DEBUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 int i, j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 fprintf (tooltalk_log_file, "message_cb: %d\n", m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 fprintf (tooltalk_log_file, "op: %s (", tt_message_op (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 for (j = tt_message_args_count (m), i = 0; i < j; i++) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 fprintf (tooltalk_log_file, "%s \"%s\"", tt_message_arg_type (m, i),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 tt_message_arg_val (m, i));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 fprintf (tooltalk_log_file, "%s", i == j-1 ? ")" : ", ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 fprintf (tooltalk_log_file, "\n\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 fflush (tooltalk_log_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 VOID_TO_LISP (message_, tt_message_user (m, TOOLTALK_MESSAGE_KEY));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 pattern = make_tooltalk_pattern (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 cb = XTOOLTALK_MESSAGE (message_)->callback;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 GCPRO2 (message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 if (!NILP (Vtooltalk_message_handler_hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 va_run_hook_with_args (Qtooltalk_message_handler_hook, 2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 message_, pattern);
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 if ((SYMBOLP (cb) && EQ (Qt, Ffboundp (cb))) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 (CONSP (cb) && EQ (Qlambda, Fcar (cb)) &&
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 !NILP (Flistp (Fcar (Fcdr (cb))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 call2 (cb, message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 UNGCPRO;
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 tt_message_destroy (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 Fremhash (message_, Vtooltalk_message_gcpro);
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 return TT_CALLBACK_PROCESSED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 static Tt_callback_action
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 tooltalk_pattern_callback (Tt_message m, Tt_pattern p)
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 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 Lisp_Object cb;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 Lisp_Object message_;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 Lisp_Object pattern;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 #ifdef TT_DEBUG
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 int i, j;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 fprintf (tooltalk_log_file, "pattern_cb: %d\n", m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 fprintf (tooltalk_log_file, "op: %s (", tt_message_op (m));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 for (j = tt_message_args_count (m), i = 0; i < j; i++) {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 fprintf (tooltalk_log_file, "%s \"%s\"", tt_message_arg_type (m, i),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 tt_message_arg_val (m, i));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 fprintf (tooltalk_log_file, "%s", i == j-1 ? ")" : ", ");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 fprintf (tooltalk_log_file, "\n\n");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 fflush (tooltalk_log_file);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 message_ = make_tooltalk_message (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 VOID_TO_LISP (pattern, tt_pattern_user (p, TOOLTALK_PATTERN_KEY));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 cb = XTOOLTALK_PATTERN (pattern)->callback;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 GCPRO2 (message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 if (!NILP (Vtooltalk_pattern_handler_hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 va_run_hook_with_args (Qtooltalk_pattern_handler_hook, 2,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 if (SYMBOLP (cb) && EQ (Qt, Ffboundp (cb)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 call2 (cb, message_, pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 tt_message_destroy (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 return TT_CALLBACK_PROCESSED;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 tt_mode_symbol (Tt_mode n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 switch (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 case TT_MODE_UNDEFINED: return Q_TT_MODE_UNDEFINED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 case TT_IN: return Q_TT_IN;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 case TT_OUT: return Q_TT_OUT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 case TT_INOUT: return Q_TT_INOUT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 case TT_MODE_LAST: return Q_TT_MODE_LAST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 default: return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 tt_scope_symbol (Tt_scope n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 switch (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 case TT_SCOPE_NONE: return Q_TT_SCOPE_NONE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 case TT_SESSION: return Q_TT_SESSION;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 case TT_FILE: return Q_TT_FILE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 case TT_BOTH: return Q_TT_BOTH;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 case TT_FILE_IN_SESSION: return Q_TT_FILE_IN_SESSION;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 default: return Qnil;
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 }
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 tt_class_symbol (Tt_class n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 switch (n)
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 case TT_CLASS_UNDEFINED: return Q_TT_CLASS_UNDEFINED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 case TT_NOTICE: return Q_TT_NOTICE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 case TT_REQUEST: return Q_TT_REQUEST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 case TT_CLASS_LAST: return Q_TT_CLASS_LAST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 default: return Qnil;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 * 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
457 * simply not necessary?
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 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 tt_category_symbol (Tt_category n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 switch (n)
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 case TT_CATEGORY_UNDEFINED: return Q_TT_CATEGORY_UNDEFINED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 case TT_OBSERVE: return Q_TT_OBSERVE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 case TT_HANDLE: return Q_TT_HANDLE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 case TT_CATEGORY_LAST: return Q_TT_CATEGORY_LAST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 default: return Qnil;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 tt_address_symbol (Tt_address n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 switch (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 case TT_PROCEDURE: return Q_TT_PROCEDURE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 case TT_OBJECT: return Q_TT_OBJECT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 case TT_HANDLER: return Q_TT_HANDLER;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 case TT_OTYPE: return Q_TT_OTYPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 case TT_ADDRESS_LAST: return Q_TT_ADDRESS_LAST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 default: return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 tt_state_symbol (Tt_state n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 switch (n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 case TT_CREATED: return Q_TT_CREATED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 case TT_SENT: return Q_TT_SENT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 case TT_HANDLED: return Q_TT_HANDLED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 case TT_FAILED: return Q_TT_FAILED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 case TT_QUEUED: return Q_TT_QUEUED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 case TT_STARTED: return Q_TT_STARTED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 case TT_REJECTED: return Q_TT_REJECTED;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 case TT_STATE_LAST: return Q_TT_STATE_LAST;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 default: return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 }
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_build_string (char *s)
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 return build_string (s ? s : "");
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 tt_opnum_string (int n)
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 char buf[32];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 sprintf (buf, "%u", n);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 return build_string (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 }
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 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 tt_message_arg_ival_string (Tt_message m, int n)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 {
603
1c880911c386 [xemacs-hg @ 2001-06-01 08:23:09 by martinb]
martinb
parents: 578
diff changeset
523 char buf[DECIMAL_PRINT_SIZE (long)];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 int value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 check_status (tt_message_arg_ival (m, n, &value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 long_to_string (buf, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 return build_string (buf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 tt_message_arg_bval_vector (Tt_message m, int n)
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 /* !!#### This function has not been Mule-ized */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 609
diff changeset
535 Intbyte *value;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 int len = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 check_status (tt_message_arg_bval (m, n, &value, &len));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 return make_string (value, len);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 DEFUN ("get-tooltalk-message-attribute", Fget_tooltalk_message_attribute,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 2, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 Return the indicated Tooltalk message attribute. Attributes are
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 identified by symbols with the same name (underscores and all) as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 suffix of the Tooltalk tt_message_<attribute> function that extracts the value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 String attribute values are copied, enumerated type values (except disposition)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 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
550 represented by fixnums (small integers), opnum is converted to a string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 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
552 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
553 within the range of Lisp integers.
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 Use the 'plist attribute instead of the C API 'user attribute
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 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
557 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
558 called 'rflag, use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 (get-tooltalk-message-attribute message 'plist 'rflag)
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 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
562 'arg_ival (integers), or 'arg_bval (strings with embedded nulls), attributes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 For example to get the integer value of the third argument:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (get-tooltalk-message-attribute message 'arg_ival 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 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
568 can be retrieved with the 'arg_type attribute; however, Tooltalk doesn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 define any semantics for the string value of 'arg_type. Conventionally
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 "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
571 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
572 value returned by 'arg_bval like a string is fine.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 (message_, attribute, argn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 int n = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 CHECK_SYMBOL (attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 if (EQ (attribute, (Qtt_arg_bval)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 EQ (attribute, (Qtt_arg_ival)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 EQ (attribute, (Qtt_arg_mode)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 EQ (attribute, (Qtt_arg_type)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 EQ (attribute, (Qtt_arg_val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 CHECK_INT (argn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 n = XINT (argn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 }
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 if (!VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 return Qnil;
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_bval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 return tt_message_arg_bval_vector (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_ival))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 return tt_message_arg_ival_string (m, n);
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_mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 return tt_mode_symbol (tt_message_arg_mode (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_arg_type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 return tt_build_string (tt_message_arg_type (m, n));
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_arg_val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 return tt_message_arg_bval_vector (m, n);
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_args_count))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 return make_int (tt_message_args_count (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_address))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 return tt_address_symbol (tt_message_address (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_class))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 return tt_class_symbol (tt_message_class (m));
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_disposition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 return make_int (tt_message_disposition (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_file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 return tt_build_string (tt_message_file (m));
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_gid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 return make_int (tt_message_gid (m));
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_handler))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 return tt_build_string (tt_message_handler (m));
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_handler_ptype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 return tt_build_string (tt_message_handler_ptype (m));
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_object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 return tt_build_string (tt_message_object (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_op))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 return tt_build_string (tt_message_op (m));
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_opnum))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 return tt_opnum_string (tt_message_opnum (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_otype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 return tt_build_string (tt_message_otype (m));
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_scope))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 return tt_scope_symbol (tt_message_scope (m));
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_sender))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 return tt_build_string (tt_message_sender (m));
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_sender_ptype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 return tt_build_string (tt_message_sender_ptype (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_session))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 return tt_build_string (tt_message_session (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_state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 return tt_state_symbol (tt_message_state (m));
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_status))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 return make_int (tt_message_status (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_status_string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 return tt_build_string (tt_message_status_string (m));
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_uid))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 return make_int (tt_message_uid (m));
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_callback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 return XTOOLTALK_MESSAGE (message_)->callback;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 else if (EQ (attribute, Qtt_prop))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 return Fget (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 else if (EQ (attribute, Qtt_plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 return Fcopy_sequence (Fsymbol_plist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 (XTOOLTALK_MESSAGE (message_)->plist_sym));
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 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
679 invalid_constant ("Invalid value for `get-tooltalk-message-attribute'",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 DEFUN ("set-tooltalk-message-attribute", Fset_tooltalk_message_attribute,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 Initialize one Tooltalk message attribute.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 Attribute names and values are the same as for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 `get-tooltalk-message-attribute'. A property list is provided for user
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 data (instead of the 'user message attribute); see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 `get-tooltalk-message-attribute'.
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 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
695 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
696 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
697 changed to TT_HANDLED (or TT_FAILED), so that reply argument values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 can be used.
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 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
701 '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
702 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
703 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 (value, message_, attribute, argn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 int n = 0;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
708 Tt_status (*fun_str) (Tt_message, const char *) = 0;
428
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_SYMBOL (attribute);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
711
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 if (EQ (attribute, (Qtt_arg_bval)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 EQ (attribute, (Qtt_arg_ival)) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 EQ (attribute, (Qtt_arg_val)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 CHECK_INT (argn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 n = XINT (argn);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 if (!VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
723 if (EQ (attribute, Qtt_address))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 tt_message_address_set (m, (Tt_address) tooltalk_constant_value (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 else if (EQ (attribute, Qtt_class))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 tt_message_class_set (m, (Tt_class) 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_disposition))
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_disposition_set (m, ((Tt_disposition)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 tooltalk_constant_value (value)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 else if (EQ (attribute, Qtt_scope))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 }
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
744 else if (EQ (attribute, Qtt_file))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
745 fun_str = tt_message_file_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
746 else if (EQ (attribute, Qtt_handler_ptype))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
747 fun_str = tt_message_handler_ptype_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
748 else if (EQ (attribute, Qtt_handler))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
749 fun_str = tt_message_handler_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
750 else if (EQ (attribute, Qtt_object))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
751 fun_str = tt_message_object_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
752 else if (EQ (attribute, Qtt_op))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
753 fun_str = tt_message_op_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
754 else if (EQ (attribute, Qtt_otype))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
755 fun_str = tt_message_otype_set;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 else if (EQ (attribute, Qtt_sender_ptype))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
757 fun_str = tt_message_sender_ptype_set;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 else if (EQ (attribute, Qtt_session))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
759 fun_str = tt_message_session_set;
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
760 else if (EQ (attribute, Qtt_status_string))
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
761 fun_str = tt_message_status_string_set;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 else if (EQ (attribute, Qtt_arg_bval))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 Extbyte *value_ext;
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 609
diff changeset
765 Bytecount value_ext_len;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 CHECK_STRING (value);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
767 TO_EXTERNAL_FORMAT (LISP_STRING, value,
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
768 ALLOCA, (value_ext, value_ext_len),
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
769 Qnative);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
770 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
771 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 else if (EQ (attribute, Qtt_arg_ival))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 CHECK_INT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 tt_message_arg_ival_set (m, n, XINT (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 else if (EQ (attribute, Qtt_arg_val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
779 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
781 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 tt_message_arg_val_set (m, n, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 else if (EQ (attribute, Qtt_status))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 CHECK_INT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 tt_message_status_set (m, XINT (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 else if (EQ (attribute, Qtt_callback))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 CHECK_SYMBOL (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 XTOOLTALK_MESSAGE (message_)->callback = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 else if (EQ (attribute, Qtt_prop))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 return Fput (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
799 invalid_constant ("Invalid value for `set-tooltalk-message-attribute'",
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 attribute);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
801
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
802 if (fun_str)
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
803 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
804 const char *value_ext;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
805 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
806 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
807 (*fun_str) (m, value_ext);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
808 }
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
809
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 }
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 DEFUN ("return-tooltalk-message", Freturn_tooltalk_message, 1, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 Send a reply to this message. The second argument can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 'reply, 'reject or 'fail; the default is 'reply. Before sending
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 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
817 have been filled in - see set-tooltalk-message-attribute.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 (message_, mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 if (NILP (mode))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 mode = Qtt_reply;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 CHECK_SYMBOL (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 if (!VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 else if (EQ (mode, Qtt_reply))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 tt_message_reply (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 else if (EQ (mode, Qtt_reject))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 tt_message_reject (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 else if (EQ (mode, Qtt_fail))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 tt_message_fail (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 }
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 DEFUN ("create-tooltalk-message", Fcreate_tooltalk_message, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 Create a new tooltalk message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 The messages session attribute is initialized to the default session.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 Other attributes can be initialized with `set-tooltalk-message-attribute'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 `make-tooltalk-message' is the preferred to create and initialize a message.
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 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
847 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
848 calling `make-tooltalk-message'.
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 (no_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 m = tt_message_create ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 Lisp_Object message_ = make_tooltalk_message (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 if (NILP (no_callback))
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 tt_message_callback_add (m, tooltalk_message_callback);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 tt_message_session_set (m, tt_default_session ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 tt_message_user_set (m, TOOLTALK_MESSAGE_KEY, LISP_TO_VOID (message_));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 return message_;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 }
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 DEFUN ("destroy-tooltalk-message", Fdestroy_tooltalk_message, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 Apply tt_message_destroy() to the message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 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
866 a message or pattern callback; the Lisp/Tooltalk callback machinery does
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 this for you.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 (message_))
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 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 if (VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 /* #### Should we call Fremhash() here? It seems that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 a common paradigm is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 (send-tooltalk-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (destroy-tooltalk-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 which would imply that destroying a sent ToolTalk message
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 doesn't actually destroy it; when a response is sent back,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 the callback for the message will still be called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 But then maybe not: Maybe it really does destroy it,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 and the reason for that paradigm is that the author
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 of `send-tooltalk-message' didn't really know what he
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 was talking about when he said that it's a good idea
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 to call `destroy-tooltalk-message' after sending it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 tt_message_destroy (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 DEFUN ("add-tooltalk-message-arg", Fadd_tooltalk_message_arg, 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 Append one new argument to the message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 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
898 and VALUE can be a string or an integer. Tooltalk doesn't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 define any semantics for VTYPE, so only the participants in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 protocol you're using need to agree what types mean (if anything).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 Conventionally "string" is used for strings and "int" for 32 bit integers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 Arguments can initialized by providing a value or with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 `set-tooltalk-message-attribute'. The latter is necessary if you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 want to initialize the argument with a string that can contain
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 embedded nulls (use 'arg_bval).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 (message_, mode, vtype, value))
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 Tt_message m = unbox_tooltalk_message (message_);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 Tt_mode n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 CHECK_STRING (vtype);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 CHECK_TOOLTALK_CONSTANT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
914
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 n = (Tt_mode) tooltalk_constant_value (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 if (!VALID_TOOLTALK_MESSAGEP (m))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
920 const char *vtype_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
922 LISP_STRING_TO_EXTERNAL (vtype, vtype_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 if (NILP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 tt_message_arg_add (m, n, vtype_ext, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 else if (STRINGP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
927 const char *value_ext;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
928 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 tt_message_arg_add (m, n, vtype_ext, value_ext);
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 else if (INTP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 tt_message_iarg_add (m, n, vtype_ext, XINT (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 return Qnil;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 DEFUN ("send-tooltalk-message", Fsend_tooltalk_message, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 Send the message on its way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 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
941 it with `destroy-tooltalk-message'.
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 (message_))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 Tt_message m = unbox_tooltalk_message (message_);
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 if (VALID_TOOLTALK_MESSAGEP (m))
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 tt_message_send (m);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 Fputhash (message_, Qnil, Vtooltalk_message_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 return Qnil;
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 DEFUN ("create-tooltalk-pattern", Fcreate_tooltalk_pattern, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 Create a new Tooltalk pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 Its session attribute is initialized to be the default session.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 Tt_pattern p = tt_pattern_create ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 Lisp_Object pattern = make_tooltalk_pattern (p);
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 tt_pattern_callback_add (p, tooltalk_pattern_callback);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 tt_pattern_session_add (p, tt_default_session ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 tt_pattern_user_set (p, TOOLTALK_PATTERN_KEY, LISP_TO_VOID (pattern));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 return 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
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 DEFUN ("destroy-tooltalk-pattern", Fdestroy_tooltalk_pattern, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 Apply tt_pattern_destroy() to the pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 This effectively unregisters the pattern.
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 (pattern))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 Tt_pattern p = unbox_tooltalk_pattern (pattern);
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 if (VALID_TOOLTALK_PATTERNP (p))
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 tt_pattern_destroy (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 Fremhash (pattern, Vtooltalk_pattern_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989
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 DEFUN ("add-tooltalk-pattern-attribute", Fadd_tooltalk_pattern_attribute, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 Add one value to the indicated pattern attribute.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 All Tooltalk pattern attributes are supported except 'user. The names
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 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
995 less the "tooltalk_pattern_" prefix and the "_add" ...
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 (value, pattern, attribute))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 Tt_pattern p = unbox_tooltalk_pattern (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 CHECK_SYMBOL (attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 if (!VALID_TOOLTALK_PATTERNP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 return Qnil;
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_category))
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_category_set (p, ((Tt_category)
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_address))
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_address_add (p, ((Tt_address)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 tooltalk_constant_value (value)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 else if (EQ (attribute, Qtt_class))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 tt_pattern_class_add (p, (Tt_class) 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_disposition))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 tt_pattern_disposition_add (p, ((Tt_disposition)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 tooltalk_constant_value (value)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 else if (EQ (attribute, Qtt_file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1031 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1033 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 tt_pattern_file_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 else if (EQ (attribute, Qtt_object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1038 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1040 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 tt_pattern_object_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 else if (EQ (attribute, Qtt_op))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1045 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1047 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 tt_pattern_op_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 else if (EQ (attribute, Qtt_otype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1052 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1054 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 tt_pattern_otype_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 else if (EQ (attribute, Qtt_scope))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 tt_pattern_scope_add (p, (Tt_scope) tooltalk_constant_value (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 else if (EQ (attribute, Qtt_sender))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1064 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1066 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 tt_pattern_sender_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 else if (EQ (attribute, Qtt_sender_ptype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1071 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1073 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 tt_pattern_sender_ptype_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 else if (EQ (attribute, Qtt_session))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1078 const char *value_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 CHECK_STRING (value);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1080 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 tt_pattern_session_add (p, value_ext);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083 else if (EQ (attribute, Qtt_state))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 CHECK_TOOLTALK_CONSTANT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 tt_pattern_state_add (p, (Tt_state) tooltalk_constant_value (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 else if (EQ (attribute, Qtt_callback))
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 CHECK_SYMBOL (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 XTOOLTALK_PATTERN (pattern)->callback = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1098 DEFUN ("add-tooltalk-pattern-arg", Fadd_tooltalk_pattern_arg, 3, 4, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1099 Add one fully specified argument to a tooltalk pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1100 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
1101 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
1102 an integer argument (tt_pattern_iarg_add) added otherwise a string argument
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 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
1104 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 (pattern, mode, vtype, value))
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 Tt_pattern p = unbox_tooltalk_pattern (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 Tt_mode n;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 CHECK_STRING (vtype);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 CHECK_TOOLTALK_CONSTANT (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 n = (Tt_mode) tooltalk_constant_value (mode);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1114
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1115 if (!VALID_TOOLTALK_PATTERNP (p))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1119 const char *vtype_ext;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1121 LISP_STRING_TO_EXTERNAL (vtype, vtype_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 if (NILP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 tt_pattern_arg_add (p, n, vtype_ext, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124 else if (STRINGP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1126 const char *value_ext;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1127 LISP_STRING_TO_EXTERNAL (value, value_ext, Qnative);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128 tt_pattern_arg_add (p, n, vtype_ext, value_ext);
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 else if (INTP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1131 tt_pattern_iarg_add (p, n, vtype_ext, XINT (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1132 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1134 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1135 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1138 DEFUN ("register-tooltalk-pattern", Fregister_tooltalk_pattern, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1139 Emacs will begin receiving messages that match this pattern.
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 (pattern))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1143 Tt_pattern p = unbox_tooltalk_pattern (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1144
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1145 if (VALID_TOOLTALK_PATTERNP (p) && tt_pattern_register (p) == TT_OK)
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 Fputhash (pattern, Qnil, Vtooltalk_pattern_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 return Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1149 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1150 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 DEFUN ("unregister-tooltalk-pattern", Funregister_tooltalk_pattern, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 Emacs will stop receiving messages that match this pattern.
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 (pattern))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1160 Tt_pattern p = unbox_tooltalk_pattern (pattern);
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 if (VALID_TOOLTALK_PATTERNP (p))
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 tt_pattern_unregister (p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 Fremhash (pattern, Vtooltalk_pattern_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168 return Qnil;
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
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 DEFUN ("tooltalk-pattern-prop-get", Ftooltalk_pattern_prop_get, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 Return the value of PROPERTY in tooltalk pattern PATTERN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1174 This is the last value set with `tooltalk-pattern-prop-set'.
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 (pattern, property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178 CHECK_TOOLTALK_PATTERN (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 return Fget (XTOOLTALK_PATTERN (pattern)->plist_sym, property, Qnil);
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
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 DEFUN ("tooltalk-pattern-prop-set", Ftooltalk_pattern_prop_set, 3, 3, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 Set the value of PROPERTY to VALUE in tooltalk pattern PATTERN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 It can be retrieved with `tooltalk-pattern-prop-get'.
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 (pattern, property, value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 CHECK_TOOLTALK_PATTERN (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1190 return Fput (XTOOLTALK_PATTERN (pattern)->plist_sym, property, value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1191 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 DEFUN ("tooltalk-pattern-plist-get", Ftooltalk_pattern_plist_get, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195 Return the a list of all the properties currently set in PATTERN.
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 (pattern))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 CHECK_TOOLTALK_PATTERN (pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1201 Fcopy_sequence (Fsymbol_plist (XTOOLTALK_PATTERN (pattern)->plist_sym));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 DEFUN ("tooltalk-default-procid", Ftooltalk_default_procid, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 Return current default process identifier for your process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 char *procid = tt_default_procid ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 return procid ? build_string (procid) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 DEFUN ("tooltalk-default-session", Ftooltalk_default_session, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 Return current default session identifier for the current default procid.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 char *session = tt_default_session ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 return session ? build_string (session) : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1223 init_tooltalk (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1224 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 /* This function can GC */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 char *retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 Lisp_Object lp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 Lisp_Object fil;
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
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1231 /* 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
1232 ttsessions is running on the machine), therefore we save the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 actions and restore them after the call */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1234 #ifdef HAVE_SIGPROCMASK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 struct sigaction ActSIGQUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 struct sigaction ActSIGINT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 struct sigaction ActSIGCHLD;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1239 sigaction (SIGQUIT, NULL, &ActSIGQUIT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240 sigaction (SIGINT, NULL, &ActSIGINT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 sigaction (SIGCHLD, NULL, &ActSIGCHLD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 retval = tt_open ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 #ifdef HAVE_SIGPROCMASK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 sigaction (SIGQUIT, &ActSIGQUIT, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 sigaction (SIGINT, &ActSIGINT, NULL);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 sigaction (SIGCHLD, &ActSIGCHLD, NULL);
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 #endif
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 if (tt_ptr_error (retval) != TT_OK)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 Vtooltalk_fd = make_int (tt_fd ());
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 tt_session_join (tt_default_session ());
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1258
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 lp = connect_to_file_descriptor (build_string ("tooltalk"), Qnil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260 Vtooltalk_fd, Vtooltalk_fd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 if (!NILP (lp))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 /* Don't ask the user for confirmation when exiting Emacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 Fprocess_kill_without_query (lp, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 XSETSUBR (fil, &SFreceive_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266 set_process_filter (lp, fil, 1);
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 tt_close ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1271 Vtooltalk_fd = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1272 return;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 #if defined (SOLARIS2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 /* Apparently the tt_message_send_on_exit() function does not exist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 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
1278 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
1279 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 Tt_message exit_msg = tt_message_create ();
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 tt_message_op_set (exit_msg, "emacs-aborted");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 tt_message_scope_set (exit_msg, TT_SESSION);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284 tt_message_class_set (exit_msg, TT_NOTICE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 tt_message_send_on_exit (exit_msg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286 tt_message_destroy (exit_msg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 #endif
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 DEFUN ("tooltalk-open-connection", Ftooltalk_open_connection, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1292 Opens a connection to the ToolTalk server.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1293 Returns t if successful, nil otherwise.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 if (!NILP (Vtooltalk_fd))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1298 signal_error (Qio_error, "Already connected to ToolTalk", Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1299 if (noninteractive)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1300 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
1301 init_tooltalk ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 return NILP (Vtooltalk_fd) ? Qnil : Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 syms_of_tooltalk (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1309 INIT_LRECORD_IMPLEMENTATION (tooltalk_message);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1310 INIT_LRECORD_IMPLEMENTATION (tooltalk_pattern);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1311
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1312 DEFSYMBOL_MULTIWORD_PREDICATE (Qtooltalk_messagep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 DEFSUBR (Ftooltalk_message_p);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1314 DEFSYMBOL_MULTIWORD_PREDICATE (Qtooltalk_patternp);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 DEFSUBR (Ftooltalk_pattern_p);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1316 DEFSYMBOL (Qtooltalk_message_handler_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1317 DEFSYMBOL (Qtooltalk_pattern_handler_hook);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1318 DEFSYMBOL (Qtooltalk_unprocessed_message_hook);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320 DEFSUBR (Freceive_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 DEFSUBR (Fcreate_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 DEFSUBR (Fdestroy_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1323 DEFSUBR (Fadd_tooltalk_message_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1324 DEFSUBR (Fget_tooltalk_message_attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 DEFSUBR (Fset_tooltalk_message_attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 DEFSUBR (Fsend_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 DEFSUBR (Freturn_tooltalk_message);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 DEFSUBR (Fcreate_tooltalk_pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 DEFSUBR (Fdestroy_tooltalk_pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330 DEFSUBR (Fadd_tooltalk_pattern_attribute);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 DEFSUBR (Fadd_tooltalk_pattern_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 DEFSUBR (Fregister_tooltalk_pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 DEFSUBR (Funregister_tooltalk_pattern);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 DEFSUBR (Ftooltalk_pattern_plist_get);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 DEFSUBR (Ftooltalk_pattern_prop_set);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336 DEFSUBR (Ftooltalk_pattern_prop_get);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 DEFSUBR (Ftooltalk_default_procid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 DEFSUBR (Ftooltalk_default_session);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1339 DEFSUBR (Ftooltalk_open_connection);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1340
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
1341 DEFSYMBOL (Qreceive_tooltalk_message);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1342 defsymbol (&Qtt_address, "address");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1343 defsymbol (&Qtt_args_count, "args_count");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1344 defsymbol (&Qtt_arg_bval, "arg_bval");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1345 defsymbol (&Qtt_arg_ival, "arg_ival");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 defsymbol (&Qtt_arg_mode, "arg_mode");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 defsymbol (&Qtt_arg_type, "arg_type");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348 defsymbol (&Qtt_arg_val, "arg_val");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 defsymbol (&Qtt_class, "class");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 defsymbol (&Qtt_category, "category");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 defsymbol (&Qtt_disposition, "disposition");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1352 defsymbol (&Qtt_file, "file");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 defsymbol (&Qtt_gid, "gid");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 defsymbol (&Qtt_handler, "handler");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1355 defsymbol (&Qtt_handler_ptype, "handler_ptype");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 defsymbol (&Qtt_object, "object");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 defsymbol (&Qtt_op, "op");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358 defsymbol (&Qtt_opnum, "opnum");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 defsymbol (&Qtt_otype, "otype");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 defsymbol (&Qtt_scope, "scope");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 defsymbol (&Qtt_sender, "sender");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1362 defsymbol (&Qtt_sender_ptype, "sender_ptype");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 defsymbol (&Qtt_session, "session");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364 defsymbol (&Qtt_state, "state");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1365 defsymbol (&Qtt_status, "status");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1366 defsymbol (&Qtt_status_string, "status_string");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1367 defsymbol (&Qtt_uid, "uid");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1368 defsymbol (&Qtt_callback, "callback");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 defsymbol (&Qtt_prop, "prop");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 defsymbol (&Qtt_plist, "plist");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1371 defsymbol (&Qtt_reject, "reject");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 defsymbol (&Qtt_reply, "reply");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 defsymbol (&Qtt_fail, "fail");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1375 DEFERROR (Qtooltalk_error, "ToolTalk error", Qio_error);
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 vars_of_tooltalk (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 Fprovide (intern ("tooltalk"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 DEFVAR_LISP ("tooltalk-fd", &Vtooltalk_fd /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 File descriptor returned by tt_initialize; nil if not connected to ToolTalk.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 Vtooltalk_fd = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 DEFVAR_LISP ("tooltalk-message-handler-hook",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 &Vtooltalk_message_handler_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1390 List of functions to be applied to each ToolTalk message reply received.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 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
1392 Functions will be called with two arguments, the message and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 corresponding pattern. This hook will not be called if the request
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394 message was created without a C-level callback function (see
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1395 `tooltalk-unprocessed-message-hook').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 Vtooltalk_message_handler_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 DEFVAR_LISP ("tooltalk-pattern-handler-hook",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 &Vtooltalk_pattern_handler_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1401 List of functions to be applied to each pattern-matching ToolTalk message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 This is all messages except those handled by `tooltalk-message-handler-hook'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403 Functions will be called with two arguments, the message and the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 corresponding pattern.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 Vtooltalk_pattern_handler_hook = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1408 DEFVAR_LISP ("tooltalk-unprocessed-message-hook",
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 &Vtooltalk_unprocessed_message_hook /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 List of functions to be applied to each unprocessed ToolTalk message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 Unprocessed messages are messages that didn't match any patterns.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 Vtooltalk_unprocessed_message_hook = Qnil;
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 Tooltalk_Message_plist_str = build_string ("Tooltalk Message plist");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 Tooltalk_Pattern_plist_str = build_string ("Tooltalk Pattern p plist");
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 staticpro(&Tooltalk_Message_plist_str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 staticpro(&Tooltalk_Pattern_plist_str);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 #define MAKE_CONSTANT(name) do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 defsymbol (&Q_ ## name, #name); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423 Fset (Q_ ## name, make_int (name)); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 } while (0)
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_MODE_UNDEFINED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 MAKE_CONSTANT (TT_IN);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 MAKE_CONSTANT (TT_OUT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 MAKE_CONSTANT (TT_INOUT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 MAKE_CONSTANT (TT_MODE_LAST);
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_SCOPE_NONE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 MAKE_CONSTANT (TT_SESSION);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 MAKE_CONSTANT (TT_FILE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1435 MAKE_CONSTANT (TT_BOTH);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 MAKE_CONSTANT (TT_FILE_IN_SESSION);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 MAKE_CONSTANT (TT_CLASS_UNDEFINED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 MAKE_CONSTANT (TT_NOTICE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 MAKE_CONSTANT (TT_REQUEST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441 MAKE_CONSTANT (TT_CLASS_LAST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1443 MAKE_CONSTANT (TT_CATEGORY_UNDEFINED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 MAKE_CONSTANT (TT_OBSERVE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 MAKE_CONSTANT (TT_HANDLE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1446 MAKE_CONSTANT (TT_CATEGORY_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_PROCEDURE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449 MAKE_CONSTANT (TT_OBJECT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 MAKE_CONSTANT (TT_HANDLER);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 MAKE_CONSTANT (TT_OTYPE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 MAKE_CONSTANT (TT_ADDRESS_LAST);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 MAKE_CONSTANT (TT_CREATED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455 MAKE_CONSTANT (TT_SENT);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 MAKE_CONSTANT (TT_HANDLED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 MAKE_CONSTANT (TT_FAILED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1458 MAKE_CONSTANT (TT_QUEUED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 MAKE_CONSTANT (TT_STARTED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 MAKE_CONSTANT (TT_REJECTED);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 MAKE_CONSTANT (TT_STATE_LAST);
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 MAKE_CONSTANT (TT_DISCARD);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 MAKE_CONSTANT (TT_QUEUE);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 MAKE_CONSTANT (TT_START);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 #undef MAKE_CONSTANT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 staticpro (&Vtooltalk_message_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470 staticpro (&Vtooltalk_pattern_gcpro);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 Vtooltalk_message_gcpro =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473 Vtooltalk_pattern_gcpro =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 }