xemacs-beta: src/tooltalk.c comparison

comparison src/tooltalk.c @ 185:3d6bfa290dbd r20-3b19

Import from CVS: tag r20-3b19

author	cvs
date	Mon, 13 Aug 2007 09:55:28 +0200
parents	8eaf7971accc
children	0e522484dd2a

comparison

equal deleted inserted replaced

-:bcd2674570bf
+:3d6bfa290dbd
 #ifdef TT_DEBUG
 static FILE *tooltalk_log_file;
 #endif
 static Lisp_Object
 Vtooltalk_message_handler_hook,
 Vtooltalk_pattern_handler_hook,
 Vtooltalk_unprocessed_message_hook;
 static Lisp_Object
 Qtooltalk_message_handler_hook,
 Qtooltalk_pattern_handler_hook,
 Qtooltalk_unprocessed_message_hook;
 static Lisp_Object
 Qreceive_tooltalk_message,
 Qtt_address,
 Qtt_args_count,
 Qtt_arg_bval,
 Qtt_arg_ival,
 Qtt_sender_ptype,
 Qtt_session,
 Qtt_state,
 Qtt_status,
 Qtt_status_string,
 Qtt_uid,
 Qtt_callback,
 Qtt_plist,
 Qtt_prop,
 Qtt_reject,                /* return-tooltalk-message */
 };
 static Lisp_Object mark_tooltalk_message (Lisp_Object, void (*) (Lisp_Object));
 static void print_tooltalk_message (Lisp_Object, Lisp_Object, int);
 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message,
 mark_tooltalk_message, print_tooltalk_message,
 0, 0, 0,
 			       struct Lisp_Tooltalk_Message);
 static Lisp_Object
 mark_tooltalk_message (Lisp_Object obj, void (*markobj) (Lisp_Object))
 static void
 print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun,
 			int escapeflag)
 {
 struct Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj);
 char buf[200];
 if (print_readably)
 error ("printing unreadable object #<tooltalk_message 0x%x>",
 	   p->header.uid);
 }
 static Lisp_Object
 make_tooltalk_message (Tt_message m)
 {
-struct Lisp_Tooltalk_Message *message_
+struct Lisp_Tooltalk_Message *msg =
-= alloc_lcrecord (sizeof (struct Lisp_Tooltalk_Message),
+alloc_lcrecord_type (struct Lisp_Tooltalk_Message,
-		      lrecord_tooltalk_message);
+			 lrecord_tooltalk_message);
 Lisp_Object val;
-message_->m = m;
+msg->m = m;
-message_->callback = Qnil;
+msg->callback = Qnil;
-message_->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str);
+msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str);
-XSETTOOLTALK_MESSAGE (val, message_);
+XSETTOOLTALK_MESSAGE (val, msg);
 return val;
 }
 Tt_message
-unbox_tooltalk_message (Lisp_Object message_)
+unbox_tooltalk_message (Lisp_Object msg)
 {
-CHECK_TOOLTALK_MESSAGE (message_);
+CHECK_TOOLTALK_MESSAGE (msg);
-return XTOOLTALK_MESSAGE (message_)->m;
+return XTOOLTALK_MESSAGE (msg)->m;
 }
 DEFUN ("tooltalk-message-p", Ftooltalk_message_p, 1, 1, 0, /*
 Return non-nil if OBJECT is a tooltalk message.
 */
 };
 static Lisp_Object mark_tooltalk_pattern (Lisp_Object, void (*) (Lisp_Object));
 static void print_tooltalk_pattern (Lisp_Object, Lisp_Object, int);
 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern,
 mark_tooltalk_pattern, print_tooltalk_pattern,
 0, 0, 0,
 			       struct Lisp_Tooltalk_Pattern);
 static Lisp_Object
 mark_tooltalk_pattern (Lisp_Object obj, void (*markobj) (Lisp_Object))
 static void
 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun,
 			int escapeflag)
 {
 struct Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj);
 char buf[200];
 if (print_readably)
 error ("printing unreadable object #<tooltalk_pattern 0x%x>",
 	   p->header.uid);
 }
 static Lisp_Object
 make_tooltalk_pattern (Tt_pattern p)
 {
-struct Lisp_Tooltalk_Pattern *pat
+struct Lisp_Tooltalk_Pattern *pat =
-= alloc_lcrecord (sizeof (struct Lisp_Tooltalk_Pattern),
+alloc_lcrecord_type (struct Lisp_Tooltalk_Pattern,
-		      lrecord_tooltalk_pattern);
+			 lrecord_tooltalk_pattern);
 Lisp_Object val;
 pat->p = p;
 pat->callback = Qnil;
 pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str);
 XSETTOOLTALK_PATTERN (val, pat);
 return val;
 }
 static Tt_pattern
 }
 static int
 tooltalk_constant_value (Lisp_Object s)
 {
 if (INTP (s))
 return XINT (s);
 else if (SYMBOLP (s))
 tt_mode_symbol (Tt_mode n)
 {
 switch (n)
 {
 case TT_MODE_UNDEFINED:	return Q_TT_MODE_UNDEFINED;
 case TT_IN:			return Q_TT_IN;
 case TT_OUT:		return Q_TT_OUT;
 case TT_INOUT:		return Q_TT_INOUT;
 case TT_MODE_LAST:		return Q_TT_MODE_LAST;
 default:			return Qnil;
 }
 }
 static Lisp_Object
 tt_scope_symbol (Tt_scope n)
 {
 switch (n)
 {
 case TT_SCOPE_NONE:		return Q_TT_SCOPE_NONE;
 Fget_tooltalk_message_attribute, 2, 3, 0, /*
 Return the indicated Tooltalk message attribute.  Attributes are
 identified by symbols with the same name (underscores and all) as the
 suffix of the Tooltalk tt_message_<attribute> function that extracts the value.
 String attribute values are copied, enumerated type values (except disposition)
 are converted to symbols - e.g. TT_HANDLER is 'TT_HANDLER, uid and gid are
 represented by fixnums (small integers), opnum is converted to a string,
 and disposition is converted to a fixnum.  We convert opnum (a C int) to a
-string, e.g. 123 => \"123\" because there's no guarantee that opnums will fit
+string, e.g. 123 => "123" because there's no guarantee that opnums will fit
 within the range of Lisp integers.
 Use the 'plist attribute instead of the C API 'user attribute
 for user defined message data.  To retrieve the value of a message property
 specify the indicator for argn.  For example to get the value of a property
 (get-tooltalk-message-attribute message 'arg_ival 2)
 As you can see, argument numbers are zero based.  The type of each argument
 can be retrieved with the 'arg_type attribute; however, Tooltalk doesn't
 define any semantics for the string value of 'arg_type.  Conventionally
-\"string\" is used for strings and \"int\" for 32 bit integers.  Note that
+"string" is used for strings and "int" for 32 bit integers.  Note that
 Emacs Lisp stores the lengths of strings explicitly (unlike C) so treating the
 value returned by 'arg_bval like a string is fine.
 */
 (message_, attribute, argn))
 {
 Tt_message m = unbox_tooltalk_message (message_);
 int n = 0;
 CHECK_SYMBOL (attribute);
 if (EQ (attribute, (Qtt_arg_bval))  ||
 EQ (attribute, (Qtt_arg_ival))  ||
 EQ (attribute, (Qtt_arg_mode))  ||
 EQ (attribute, (Qtt_arg_type))  ||
 EQ (attribute, (Qtt_arg_val)))
 {
 CHECK_INT (argn);
 n = XINT (argn);
 }
 else if (EQ (attribute, Qtt_status_string))
 return tt_build_string (tt_message_status_string (m));
 else if (EQ (attribute, Qtt_uid))
 return make_int (tt_message_uid (m));
 else if (EQ (attribute, Qtt_callback))
 return XTOOLTALK_MESSAGE (message_)->callback;
 else if (EQ (attribute, Qtt_prop))
 return Fget (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, Qnil);
 {
 Tt_message m = unbox_tooltalk_message (message_);
 int n = 0;
 CHECK_SYMBOL (attribute);
 if (EQ (attribute, (Qtt_arg_bval))  ||
 EQ (attribute, (Qtt_arg_ival))  ||
 EQ (attribute, (Qtt_arg_val)))
 {
 CHECK_INT (argn);
 n = XINT (argn);
 }
 return Qnil;
 else if (EQ (attribute, Qtt_address))
 {
 CHECK_TOOLTALK_CONSTANT (value);
-tt_message_address_set (m, tooltalk_constant_value (value));
+tt_message_address_set (m, (Tt_address) tooltalk_constant_value (value));
 }
 else if (EQ (attribute, Qtt_class))
 {
 CHECK_TOOLTALK_CONSTANT (value);
-tt_message_class_set (m, tooltalk_constant_value (value));
+tt_message_class_set (m, (Tt_class) tooltalk_constant_value (value));
 }
 else if (EQ (attribute, Qtt_disposition))
 {
 CHECK_TOOLTALK_CONSTANT (value);
-tt_message_disposition_set (m, tooltalk_constant_value (value));
+tt_message_disposition_set (m, ((Tt_disposition)
+				      tooltalk_constant_value (value)));
 }
 else if (EQ (attribute, Qtt_file))
 {
 CONST char *value_ext;
 CHECK_STRING (value);
 tt_message_otype_set (m, value_ext);
 }
 else if (EQ (attribute, Qtt_scope))
 {
 CHECK_TOOLTALK_CONSTANT (value);
-tt_message_scope_set (m, tooltalk_constant_value (value));
+tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value));
 }
 else if (EQ (attribute, Qtt_sender_ptype))
 {
 CONST char *value_ext;
 CHECK_STRING (value);
 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
 tt_message_sender_ptype_set (m, value_ext);
 }
 Append one new argument to the message.
 MODE must be one of TT_IN, TT_INOUT, or TT_OUT; VTYPE must be a string;
 and VALUE can be a string or an integer.   Tooltalk doesn't
 define any semantics for VTYPE, so only the participants in the
 protocol you're using need to agree what types mean (if anything).
-Conventionally \"string\" is used for strings and \"int\" for 32 bit integers.
+Conventionally "string" is used for strings and "int" for 32 bit integers.
 Arguments can initialized by providing a value or with
 `set-tooltalk-message-attribute'.  The latter is necessary if you
 want to initialize the argument with a string that can contain
 embedded nulls (use 'arg_bval).
 */
 DEFUN ("add-tooltalk-pattern-attribute", Fadd_tooltalk_pattern_attribute, 3, 3, 0, /*
 Add one value to the indicated pattern attribute.
 All Tooltalk pattern attributes are supported except 'user.  The names
 of attributes are the same as the Tooltalk accessors used to set them
-less the \"tooltalk_pattern_\" prefix and the \"_add\" ...
+less the "tooltalk_pattern_" prefix and the "_add" ...
 */
 (value, pattern, attribute))
 {
 Tt_pattern p = unbox_tooltalk_pattern (pattern);
 return Qnil;
 else if (EQ (attribute, Qtt_category))
 {
 CHECK_TOOLTALK_CONSTANT (value);
-tt_pattern_category_set (p, tooltalk_constant_value (value));
+tt_pattern_category_set (p, ((Tt_category)
+				   tooltalk_constant_value (value)));
 }
 else if (EQ (attribute, Qtt_address))
 {
 CHECK_TOOLTALK_CONSTANT (value);
-tt_pattern_address_add (p, tooltalk_constant_value (value));
+tt_pattern_address_add (p, ((Tt_address)
+				  tooltalk_constant_value (value)));
 }
 else if (EQ (attribute, Qtt_class))
 {
 CHECK_TOOLTALK_CONSTANT (value);
-tt_pattern_class_add (p, tooltalk_constant_value (value));
+tt_pattern_class_add (p, (Tt_class) tooltalk_constant_value (value));
 }
 else if (EQ (attribute, Qtt_disposition))
 {
 CHECK_TOOLTALK_CONSTANT (value);
-tt_pattern_disposition_add (p, tooltalk_constant_value (value));
+tt_pattern_disposition_add (p, ((Tt_disposition)
+				      tooltalk_constant_value (value)));
 }
 else if (EQ (attribute, Qtt_file))
 {
 CONST char *value_ext;
 CHECK_STRING (value);
 tt_pattern_otype_add (p, value_ext);
 }
 else if (EQ (attribute, Qtt_scope))
 {
 CHECK_TOOLTALK_CONSTANT (value);
-tt_pattern_scope_add (p, tooltalk_constant_value (value));
+tt_pattern_scope_add (p, (Tt_scope) tooltalk_constant_value (value));
 }
 else if (EQ (attribute, Qtt_sender))
 {
 CONST char *value_ext;
 CHECK_STRING (value);
 tt_pattern_session_add (p, value_ext);
 }
 else if (EQ (attribute, Qtt_state))
 {
 CHECK_TOOLTALK_CONSTANT (value);
-tt_pattern_state_add (p, tooltalk_constant_value (value));
+tt_pattern_state_add (p, (Tt_state) tooltalk_constant_value (value));
 }
 else if (EQ (attribute, Qtt_callback))
 {
 CHECK_SYMBOL (value);
 XTOOLTALK_PATTERN (pattern)->callback = value;
 n = (Tt_mode) tooltalk_constant_value (mode);
 if (!VALID_TOOLTALK_PATTERNP (p))
 return Qnil;
 {
 CONST char *vtype_ext;
 GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext);
 if (NILP (value))
 Return current default process identifier for your process.
 */
 ())
 {
 char *procid = tt_default_procid ();
-if (!procid)
+return procid ? build_string (procid) : Qnil;
-return Qnil;
-return build_string (procid);
 }
 DEFUN ("tooltalk-default-session", Ftooltalk_default_session, 0, 0, 0, /*
 Return current default session identifier for the current default procid.
 */
 ())
 {
 char *session = tt_default_session ();
-if (!session)
+return session ? build_string (session) : Qnil;
-return Qnil;
-return build_string (session);
 }
 static void
 init_tooltalk (void)
 {
 Lisp_Object fil;
 retval = tt_open ();
 if (tt_ptr_error (retval) != TT_OK)
 return;
 Vtooltalk_fd = make_int (tt_fd ());
 tt_session_join (tt_default_session ());
 lp = connect_to_file_descriptor (build_string ("tooltalk"), Qnil,
 /* Apparently the tt_message_send_on_exit() function does not exist
 under SunOS 4.x or IRIX 5 or various other non-Solaris-2 systems.
 No big deal if we don't do the following under those systems. */
 {
 Tt_message exit_msg = tt_message_create ();
 tt_message_op_set (exit_msg, "emacs-aborted");
 tt_message_scope_set (exit_msg, TT_SESSION);
 tt_message_class_set (exit_msg, TT_NOTICE);
 tt_message_send_on_exit (exit_msg);
 tt_message_destroy (exit_msg);
 DEFSUBR (Fget_tooltalk_message_attribute);
 DEFSUBR (Fset_tooltalk_message_attribute);
 DEFSUBR (Fsend_tooltalk_message);
 DEFSUBR (Freturn_tooltalk_message);
 DEFSUBR (Fcreate_tooltalk_pattern);
 DEFSUBR (Fdestroy_tooltalk_pattern);
 DEFSUBR (Fadd_tooltalk_pattern_attribute);
 DEFSUBR (Fadd_tooltalk_pattern_arg);
 DEFSUBR (Fregister_tooltalk_pattern);
 DEFSUBR (Funregister_tooltalk_pattern);
 DEFSUBR (Ftooltalk_pattern_plist_get);
 DEFSUBR (Ftooltalk_pattern_prop_set);
 DEFSUBR (Ftooltalk_pattern_prop_get);
 DEFSUBR (Ftooltalk_default_procid);
 DEFSUBR (Ftooltalk_default_session);
 DEFVAR_LISP ("tooltalk-fd", &Vtooltalk_fd /*
 File descriptor returned by tt_initialize; nil if not connected to ToolTalk.
 */ );
 Vtooltalk_fd = Qnil;
 DEFVAR_LISP ("tooltalk-message-handler-hook",
 	      &Vtooltalk_message_handler_hook /*
 List of functions to be applied to each ToolTalk message reply received.
 This will always occur as a result of our sending a request message.
 Functions will be called with two arguments, the message and the
 corresponding pattern.  This hook will not be called if the request
 message was created without a C-level callback function (see
 `tooltalk-unprocessed-message-hook').
 */ );
 Vtooltalk_message_handler_hook = Qnil;
 DEFVAR_LISP ("tooltalk-pattern-handler-hook",
 	      &Vtooltalk_pattern_handler_hook /*
 List of functions to be applied to each pattern-matching ToolTalk message.
 This is all messages except those handled by `tooltalk-message-handler-hook'.
 Functions will be called with two arguments, the message and the
 corresponding pattern.
 Unprocessed messages are messages that didn't match any patterns.
 */ );
 Vtooltalk_unprocessed_message_hook = Qnil;
 Tooltalk_Message_plist_str = build_string ("Tooltalk Message plist");
-Tooltalk_Pattern_plist_str = build_string ("Tooltalk Pattern plist");
+Tooltalk_Pattern_plist_str = build_string ("Tooltalk Pattern p plist");
 #define MAKE_CONSTANT(name) do { \
 defsymbol (&Q_ ## name, #name); \
 Fset (Q_ ## name, make_int (name)); \
 } while (0)
 MAKE_CONSTANT (TT_MODE_UNDEFINED);
 MAKE_CONSTANT (TT_IN);
 MAKE_CONSTANT (TT_OUT);
 MAKE_CONSTANT (TT_INOUT);
 MAKE_CONSTANT (TT_MODE_LAST);

Mercurial > hg > xemacs-beta

comparison src/tooltalk.c @ 185:3d6bfa290dbd r20-3b19