X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Ftooltalk.c;h=c3359e032195c077245f91c2cf0d661227bea93b;hp=260ab20d40621e58a990f102f4142068ebb4e844;hb=3e447015251ce6dcde843cbed10d9033d5538622;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910 diff --git a/src/tooltalk.c b/src/tooltalk.c index 260ab20..c3359e0 100644 --- a/src/tooltalk.c +++ b/src/tooltalk.c @@ -22,7 +22,7 @@ Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ /* Written by John Rose . - Heavily modified and cleaned up by Ben Wing . */ + Heavily modified and cleaned up by Ben Wing . */ #include #include "lisp.h" @@ -151,9 +151,9 @@ struct Lisp_Tooltalk_Message }; static Lisp_Object -mark_tooltalk_message (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_tooltalk_message (Lisp_Object obj) { - (markobj) (XTOOLTALK_MESSAGE (obj)->callback); + mark_object (XTOOLTALK_MESSAGE (obj)->callback); return XTOOLTALK_MESSAGE (obj)->plist_sym; } @@ -161,7 +161,7 @@ static void print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj); + Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj); char buf[200]; @@ -169,22 +169,21 @@ print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun, error ("printing unreadable object #", p->header.uid); - sprintf (buf, "#", p->m, p->header.uid); + sprintf (buf, "#", (long) (p->m), p->header.uid); write_c_string (buf, printcharfun); } DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message, mark_tooltalk_message, print_tooltalk_message, - 0, 0, 0, - struct Lisp_Tooltalk_Message); + 0, 0, 0, 0, + Lisp_Tooltalk_Message); static Lisp_Object make_tooltalk_message (Tt_message m) { Lisp_Object val; - struct Lisp_Tooltalk_Message *msg = - alloc_lcrecord_type (struct Lisp_Tooltalk_Message, - lrecord_tooltalk_message); + Lisp_Tooltalk_Message *msg = + alloc_lcrecord_type (Lisp_Tooltalk_Message, &lrecord_tooltalk_message); msg->m = m; msg->callback = Qnil; @@ -225,9 +224,9 @@ struct Lisp_Tooltalk_Pattern }; static Lisp_Object -mark_tooltalk_pattern (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_tooltalk_pattern (Lisp_Object obj) { - (markobj) (XTOOLTALK_PATTERN (obj)->callback); + mark_object (XTOOLTALK_PATTERN (obj)->callback); return XTOOLTALK_PATTERN (obj)->plist_sym; } @@ -235,7 +234,7 @@ static void print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { - struct Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj); + Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj); char buf[200]; @@ -243,21 +242,20 @@ print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun, error ("printing unreadable object #", p->header.uid); - sprintf (buf, "#", p->p, p->header.uid); + sprintf (buf, "#", (long) (p->p), p->header.uid); write_c_string (buf, printcharfun); } DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern, mark_tooltalk_pattern, print_tooltalk_pattern, - 0, 0, 0, - struct Lisp_Tooltalk_Pattern); + 0, 0, 0, 0, + Lisp_Tooltalk_Pattern); static Lisp_Object make_tooltalk_pattern (Tt_pattern p) { - struct Lisp_Tooltalk_Pattern *pat = - alloc_lcrecord_type (struct Lisp_Tooltalk_Pattern, - lrecord_tooltalk_pattern); + Lisp_Tooltalk_Pattern *pat = + alloc_lcrecord_type (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern); Lisp_Object val; pat->p = p; @@ -502,7 +500,7 @@ tt_state_symbol (Tt_state n) static Lisp_Object tt_build_string (char *s) { - return build_string ((s) ? s : ""); + return build_string (s ? s : ""); } static Lisp_Object @@ -673,7 +671,7 @@ value returned by 'arg_bval like a string is fine. (XTOOLTALK_MESSAGE (message_)->plist_sym)); else - signal_simple_error ("invalid value for `get-tooltalk-message-attribute'", + signal_simple_error ("Invalid value for `get-tooltalk-message-attribute'", attribute); return Qnil; @@ -702,8 +700,10 @@ New arguments can be added to a message with add-tooltalk-message-arg. { Tt_message m = unbox_tooltalk_message (message_); int n = 0; + Tt_status (*fun_str) (Tt_message, const char *) = 0; CHECK_SYMBOL (attribute); + if (EQ (attribute, (Qtt_arg_bval)) || EQ (attribute, (Qtt_arg_ival)) || EQ (attribute, (Qtt_arg_val))) @@ -715,7 +715,7 @@ New arguments can be added to a message with add-tooltalk-message-arg. if (!VALID_TOOLTALK_MESSAGEP (m)) return Qnil; - else if (EQ (attribute, Qtt_address)) + if (EQ (attribute, Qtt_address)) { CHECK_TOOLTALK_CONSTANT (value); tt_message_address_set (m, (Tt_address) tooltalk_constant_value (value)); @@ -731,73 +731,37 @@ New arguments can be added to a message with add-tooltalk-message-arg. tt_message_disposition_set (m, ((Tt_disposition) tooltalk_constant_value (value))); } - else if (EQ (attribute, Qtt_file)) + else if (EQ (attribute, Qtt_scope)) { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_file_set (m, value_ext); + CHECK_TOOLTALK_CONSTANT (value); + tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value)); } + else if (EQ (attribute, Qtt_file)) + fun_str = tt_message_file_set; else if (EQ (attribute, Qtt_handler_ptype)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_handler_ptype_set (m, value_ext); - } + fun_str = tt_message_handler_ptype_set; else if (EQ (attribute, Qtt_handler)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_handler_set (m, value_ext); - } + fun_str = tt_message_handler_set; else if (EQ (attribute, Qtt_object)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_object_set (m, value_ext); - } + fun_str = tt_message_object_set; else if (EQ (attribute, Qtt_op)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_op_set (m, value_ext); - } + fun_str = tt_message_op_set; else if (EQ (attribute, Qtt_otype)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_otype_set (m, value_ext); - } - else if (EQ (attribute, Qtt_scope)) - { - CHECK_TOOLTALK_CONSTANT (value); - tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value)); - } + fun_str = tt_message_otype_set; 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); - } + fun_str = tt_message_sender_ptype_set; else if (EQ (attribute, Qtt_session)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_session_set (m, value_ext); - } + fun_str = tt_message_session_set; + else if (EQ (attribute, Qtt_status_string)) + fun_str = tt_message_status_string_set; else if (EQ (attribute, Qtt_arg_bval)) { Extbyte *value_ext; Extcount value_ext_len; CHECK_STRING (value); - GET_STRING_OS_DATA_ALLOCA (value, value_ext, value_ext_len); + TO_EXTERNAL_FORMAT (LISP_STRING, value, + ALLOCA, (value_ext, value_ext_len), + Qnative); tt_message_arg_bval_set (m, n, value_ext, value_ext_len); } else if (EQ (attribute, Qtt_arg_ival)) @@ -807,9 +771,9 @@ New arguments can be added to a message with add-tooltalk-message-arg. } else if (EQ (attribute, Qtt_arg_val)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_message_arg_val_set (m, n, value_ext); } else if (EQ (attribute, Qtt_status)) @@ -817,13 +781,6 @@ New arguments can be added to a message with add-tooltalk-message-arg. CHECK_INT (value); tt_message_status_set (m, XINT (value)); } - else if (EQ (attribute, Qtt_status_string)) - { - CONST char *value_ext; - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); - tt_message_status_string_set (m, value_ext); - } else if (EQ (attribute, Qtt_callback)) { CHECK_SYMBOL (value); @@ -834,8 +791,17 @@ New arguments can be added to a message with add-tooltalk-message-arg. return Fput (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, value); } else - signal_simple_error ("invalid value for `set-tooltalk-message-attribute'", + signal_simple_error ("Invalid value for `set-tooltalk-message-attribute'", attribute); + + if (fun_str) + { + const char *value_ext; + CHECK_STRING (value); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); + (*fun_str) (m, value_ext); + } + return Qnil; } @@ -946,15 +912,15 @@ embedded nulls (use 'arg_bval). if (!VALID_TOOLTALK_MESSAGEP (m)) return Qnil; { - CONST char *vtype_ext; + const char *vtype_ext; - GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, vtype, C_STRING_ALLOCA, vtype_ext, Qnative); if (NILP (value)) tt_message_arg_add (m, n, vtype_ext, NULL); else if (STRINGP (value)) { - CONST char *value_ext; - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + const char *value_ext; + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_message_arg_add (m, n, vtype_ext, value_ext); } else if (INTP (value)) @@ -1057,30 +1023,30 @@ less the "tooltalk_pattern_" prefix and the "_add" ... } else if (EQ (attribute, Qtt_file)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_file_add (p, value_ext); } else if (EQ (attribute, Qtt_object)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_object_add (p, value_ext); } else if (EQ (attribute, Qtt_op)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_op_add (p, value_ext); } else if (EQ (attribute, Qtt_otype)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_otype_add (p, value_ext); } else if (EQ (attribute, Qtt_scope)) @@ -1090,23 +1056,23 @@ less the "tooltalk_pattern_" prefix and the "_add" ... } else if (EQ (attribute, Qtt_sender)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_sender_add (p, value_ext); } else if (EQ (attribute, Qtt_sender_ptype)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_sender_ptype_add (p, value_ext); } else if (EQ (attribute, Qtt_session)) { - CONST char *value_ext; + const char *value_ext; CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_session_add (p, value_ext); } else if (EQ (attribute, Qtt_state)) @@ -1145,15 +1111,15 @@ is added. At present there's no way to add a binary data argument. return Qnil; { - CONST char *vtype_ext; + const char *vtype_ext; - GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext); + TO_EXTERNAL_FORMAT (LISP_STRING, vtype, C_STRING_ALLOCA, vtype_ext, Qnative); if (NILP (value)) tt_pattern_arg_add (p, n, vtype_ext, NULL); else if (STRINGP (value)) { - CONST char *value_ext; - GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); + const char *value_ext; + TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); tt_pattern_arg_add (p, n, vtype_ext, value_ext); } else if (INTP (value)) @@ -1256,7 +1222,28 @@ init_tooltalk (void) Lisp_Object lp; Lisp_Object fil; + + /* tt_open() messes with our signal handler flags (at least when no + ttsessions is running on the machine), therefore we save the + actions and restore them after the call */ +#ifdef HAVE_SIGPROCMASK + { + struct sigaction ActSIGQUIT; + struct sigaction ActSIGINT; + struct sigaction ActSIGCHLD; + sigaction (SIGQUIT, NULL, &ActSIGQUIT); + sigaction (SIGINT, NULL, &ActSIGINT); + sigaction (SIGCHLD, NULL, &ActSIGCHLD); +#endif retval = tt_open (); +#ifdef HAVE_SIGPROCMASK + sigaction (SIGQUIT, &ActSIGQUIT, NULL); + sigaction (SIGINT, &ActSIGINT, NULL); + sigaction (SIGCHLD, &ActSIGCHLD, NULL); + } +#endif + + if (tt_ptr_error (retval) != TT_OK) return; @@ -1474,8 +1461,8 @@ Unprocessed messages are messages that didn't match any patterns. staticpro (&Vtooltalk_message_gcpro); staticpro (&Vtooltalk_pattern_gcpro); - Vtooltalk_message_gcpro = make_lisp_hashtable (10, HASHTABLE_NONWEAK, - HASHTABLE_EQ); - Vtooltalk_pattern_gcpro = make_lisp_hashtable (10, HASHTABLE_NONWEAK, - HASHTABLE_EQ); + Vtooltalk_message_gcpro = + make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); + Vtooltalk_pattern_gcpro = + make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); }