Mercurial > hg > xemacs-beta

comparison src/tooltalk.c @ 440:8de8e3f6228a r21-2-28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 3ecd8885ac67
children abe6d1db359e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
159 159
160 static void 160 static void
161 print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun, 161 print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun,
162 int escapeflag) 162 int escapeflag)
163 { 163 {
164 struct Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj); 164 Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj);
165 165
166 char buf[200]; 166 char buf[200];
167 167
168 if (print_readably) 168 if (print_readably)
169 error ("printing unreadable object #<tooltalk_message 0x%x>", 169 error ("printing unreadable object #<tooltalk_message 0x%x>",
174 } 174 }
175 175
176 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message, 176 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message,
177 mark_tooltalk_message, print_tooltalk_message, 177 mark_tooltalk_message, print_tooltalk_message,
178 0, 0, 0, 0, 178 0, 0, 0, 0,
179 struct Lisp_Tooltalk_Message); 179 Lisp_Tooltalk_Message);
180 180
181 static Lisp_Object 181 static Lisp_Object
182 make_tooltalk_message (Tt_message m) 182 make_tooltalk_message (Tt_message m)
183 { 183 {
184 Lisp_Object val; 184 Lisp_Object val;
185 struct Lisp_Tooltalk_Message *msg = 185 Lisp_Tooltalk_Message *msg =
186 alloc_lcrecord_type (struct Lisp_Tooltalk_Message, 186 alloc_lcrecord_type (Lisp_Tooltalk_Message, &lrecord_tooltalk_message);
187 &lrecord_tooltalk_message);
188 187
189 msg->m = m; 188 msg->m = m;
190 msg->callback = Qnil; 189 msg->callback = Qnil;
191 msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str); 190 msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str);
192 XSETTOOLTALK_MESSAGE (val, msg); 191 XSETTOOLTALK_MESSAGE (val, msg);
233 232
234 static void 233 static void
235 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun, 234 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun,
236 int escapeflag) 235 int escapeflag)
237 { 236 {
238 struct Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj); 237 Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj);
239 238
240 char buf[200]; 239 char buf[200];
241 240
242 if (print_readably) 241 if (print_readably)
243 error ("printing unreadable object #<tooltalk_pattern 0x%x>", 242 error ("printing unreadable object #<tooltalk_pattern 0x%x>",
248 } 247 }
249 248
250 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern, 249 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern,
251 mark_tooltalk_pattern, print_tooltalk_pattern, 250 mark_tooltalk_pattern, print_tooltalk_pattern,
252 0, 0, 0, 0, 251 0, 0, 0, 0,
253 struct Lisp_Tooltalk_Pattern); 252 Lisp_Tooltalk_Pattern);
254 253
255 static Lisp_Object 254 static Lisp_Object
256 make_tooltalk_pattern (Tt_pattern p) 255 make_tooltalk_pattern (Tt_pattern p)
257 { 256 {
258 struct Lisp_Tooltalk_Pattern *pat = 257 Lisp_Tooltalk_Pattern *pat =
259 alloc_lcrecord_type (struct Lisp_Tooltalk_Pattern, 258 alloc_lcrecord_type (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern);
260 &lrecord_tooltalk_pattern);
261 Lisp_Object val; 259 Lisp_Object val;
262 260
263 pat->p = p; 261 pat->p = p;
264 pat->callback = Qnil; 262 pat->callback = Qnil;
265 pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str); 263 pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str);
700 */ 698 */
701 (value, message_, attribute, argn)) 699 (value, message_, attribute, argn))
702 { 700 {
703 Tt_message m = unbox_tooltalk_message (message_); 701 Tt_message m = unbox_tooltalk_message (message_);
704 int n = 0; 702 int n = 0;
703 Tt_status (*fun_str) (Tt_message, const char *) = 0;
705 704
706 CHECK_SYMBOL (attribute); 705 CHECK_SYMBOL (attribute);
706
707 if (EQ (attribute, (Qtt_arg_bval)) || 707 if (EQ (attribute, (Qtt_arg_bval)) ||
708 EQ (attribute, (Qtt_arg_ival)) || 708 EQ (attribute, (Qtt_arg_ival)) ||
709 EQ (attribute, (Qtt_arg_val))) 709 EQ (attribute, (Qtt_arg_val)))
710 { 710 {
711 CHECK_INT (argn); 711 CHECK_INT (argn);
713 } 713 }
714 714
715 if (!VALID_TOOLTALK_MESSAGEP (m)) 715 if (!VALID_TOOLTALK_MESSAGEP (m))
716 return Qnil; 716 return Qnil;
717 717
718 else if (EQ (attribute, Qtt_address)) 718 if (EQ (attribute, Qtt_address))
719 { 719 {
720 CHECK_TOOLTALK_CONSTANT (value); 720 CHECK_TOOLTALK_CONSTANT (value);
721 tt_message_address_set (m, (Tt_address) tooltalk_constant_value (value)); 721 tt_message_address_set (m, (Tt_address) tooltalk_constant_value (value));
722 } 722 }
723 else if (EQ (attribute, Qtt_class)) 723 else if (EQ (attribute, Qtt_class))
729 { 729 {
730 CHECK_TOOLTALK_CONSTANT (value); 730 CHECK_TOOLTALK_CONSTANT (value);
731 tt_message_disposition_set (m, ((Tt_disposition) 731 tt_message_disposition_set (m, ((Tt_disposition)
732 tooltalk_constant_value (value))); 732 tooltalk_constant_value (value)));
733 } 733 }
734 else if (EQ (attribute, Qtt_file))
735 {
736 CONST char *value_ext;
737 CHECK_STRING (value);
738 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
739 tt_message_file_set (m, value_ext);
740 }
741 else if (EQ (attribute, Qtt_handler_ptype))
742 {
743 CONST char *value_ext;
744 CHECK_STRING (value);
745 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
746 tt_message_handler_ptype_set (m, value_ext);
747 }
748 else if (EQ (attribute, Qtt_handler))
749 {
750 CONST char *value_ext;
751 CHECK_STRING (value);
752 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
753 tt_message_handler_set (m, value_ext);
754 }
755 else if (EQ (attribute, Qtt_object))
756 {
757 CONST char *value_ext;
758 CHECK_STRING (value);
759 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
760 tt_message_object_set (m, value_ext);
761 }
762 else if (EQ (attribute, Qtt_op))
763 {
764 CONST char *value_ext;
765 CHECK_STRING (value);
766 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
767 tt_message_op_set (m, value_ext);
768 }
769 else if (EQ (attribute, Qtt_otype))
770 {
771 CONST char *value_ext;
772 CHECK_STRING (value);
773 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
774 tt_message_otype_set (m, value_ext);
775 }
776 else if (EQ (attribute, Qtt_scope)) 734 else if (EQ (attribute, Qtt_scope))
777 { 735 {
778 CHECK_TOOLTALK_CONSTANT (value); 736 CHECK_TOOLTALK_CONSTANT (value);
779 tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value)); 737 tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value));
780 } 738 }
739 else if (EQ (attribute, Qtt_file))
740 fun_str = tt_message_file_set;
741 else if (EQ (attribute, Qtt_handler_ptype))
742 fun_str = tt_message_handler_ptype_set;
743 else if (EQ (attribute, Qtt_handler))
744 fun_str = tt_message_handler_set;
745 else if (EQ (attribute, Qtt_object))
746 fun_str = tt_message_object_set;
747 else if (EQ (attribute, Qtt_op))
748 fun_str = tt_message_op_set;
749 else if (EQ (attribute, Qtt_otype))
750 fun_str = tt_message_otype_set;
781 else if (EQ (attribute, Qtt_sender_ptype)) 751 else if (EQ (attribute, Qtt_sender_ptype))
782 { 752 fun_str = tt_message_sender_ptype_set;
783 CONST char *value_ext;
784 CHECK_STRING (value);
785 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
786 tt_message_sender_ptype_set (m, value_ext);
787 }
788 else if (EQ (attribute, Qtt_session)) 753 else if (EQ (attribute, Qtt_session))
789 { 754 fun_str = tt_message_session_set;
790 CONST char *value_ext; 755 else if (EQ (attribute, Qtt_status_string))
791 CHECK_STRING (value); 756 fun_str = tt_message_status_string_set;
792 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
793 tt_message_session_set (m, value_ext);
794 }
795 else if (EQ (attribute, Qtt_arg_bval)) 757 else if (EQ (attribute, Qtt_arg_bval))
796 { 758 {
797 Extbyte *value_ext; 759 Extbyte *value_ext;
798 Extcount value_ext_len; 760 Extcount value_ext_len;
799 CHECK_STRING (value); 761 CHECK_STRING (value);
800 GET_STRING_OS_DATA_ALLOCA (value, value_ext, value_ext_len); 762 TO_EXTERNAL_FORMAT (LISP_STRING, value,
763 ALLOCA, (value_ext, value_ext_len),
764 Qnative);
801 tt_message_arg_bval_set (m, n, value_ext, value_ext_len); 765 tt_message_arg_bval_set (m, n, value_ext, value_ext_len);
802 } 766 }
803 else if (EQ (attribute, Qtt_arg_ival)) 767 else if (EQ (attribute, Qtt_arg_ival))
804 { 768 {
805 CHECK_INT (value); 769 CHECK_INT (value);
807 } 771 }
808 else if (EQ (attribute, Qtt_arg_val)) 772 else if (EQ (attribute, Qtt_arg_val))
809 { 773 {
810 CONST char *value_ext; 774 CONST char *value_ext;
811 CHECK_STRING (value); 775 CHECK_STRING (value);
812 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); 776 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
813 tt_message_arg_val_set (m, n, value_ext); 777 tt_message_arg_val_set (m, n, value_ext);
814 } 778 }
815 else if (EQ (attribute, Qtt_status)) 779 else if (EQ (attribute, Qtt_status))
816 { 780 {
817 CHECK_INT (value); 781 CHECK_INT (value);
818 tt_message_status_set (m, XINT (value)); 782 tt_message_status_set (m, XINT (value));
819 }
820 else if (EQ (attribute, Qtt_status_string))
821 {
822 CONST char *value_ext;
823 CHECK_STRING (value);
824 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext);
825 tt_message_status_string_set (m, value_ext);
826 } 783 }
827 else if (EQ (attribute, Qtt_callback)) 784 else if (EQ (attribute, Qtt_callback))
828 { 785 {
829 CHECK_SYMBOL (value); 786 CHECK_SYMBOL (value);
830 XTOOLTALK_MESSAGE (message_)->callback = value; 787 XTOOLTALK_MESSAGE (message_)->callback = value;
834 return Fput (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, value); 791 return Fput (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, value);
835 } 792 }
836 else 793 else
837 signal_simple_error ("Invalid value for `set-tooltalk-message-attribute'", 794 signal_simple_error ("Invalid value for `set-tooltalk-message-attribute'",
838 attribute); 795 attribute);
796
797 if (fun_str)
798 {
799 CONST char *value_ext;
800 CHECK_STRING (value);
801 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
802 (*fun_str) (m, value_ext);
803 }
804
839 return Qnil; 805 return Qnil;
840 } 806 }
841 807
842 DEFUN ("return-tooltalk-message", Freturn_tooltalk_message, 1, 2, 0, /* 808 DEFUN ("return-tooltalk-message", Freturn_tooltalk_message, 1, 2, 0, /*
843 Send a reply to this message. The second argument can be 809 Send a reply to this message. The second argument can be
946 if (!VALID_TOOLTALK_MESSAGEP (m)) 912 if (!VALID_TOOLTALK_MESSAGEP (m))
947 return Qnil; 913 return Qnil;
948 { 914 {
949 CONST char *vtype_ext; 915 CONST char *vtype_ext;
950 916
951 GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext); 917 TO_EXTERNAL_FORMAT (LISP_STRING, vtype, C_STRING_ALLOCA, vtype_ext, Qnative);
952 if (NILP (value)) 918 if (NILP (value))
953 tt_message_arg_add (m, n, vtype_ext, NULL); 919 tt_message_arg_add (m, n, vtype_ext, NULL);
954 else if (STRINGP (value)) 920 else if (STRINGP (value))
955 { 921 {
956 CONST char *value_ext; 922 CONST char *value_ext;
957 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); 923 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
958 tt_message_arg_add (m, n, vtype_ext, value_ext); 924 tt_message_arg_add (m, n, vtype_ext, value_ext);
959 } 925 }
960 else if (INTP (value)) 926 else if (INTP (value))
961 tt_message_iarg_add (m, n, vtype_ext, XINT (value)); 927 tt_message_iarg_add (m, n, vtype_ext, XINT (value));
962 } 928 }
1057 } 1023 }
1058 else if (EQ (attribute, Qtt_file)) 1024 else if (EQ (attribute, Qtt_file))
1059 { 1025 {
1060 CONST char *value_ext; 1026 CONST char *value_ext;
1061 CHECK_STRING (value); 1027 CHECK_STRING (value);
1062 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); 1028 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
1063 tt_pattern_file_add (p, value_ext); 1029 tt_pattern_file_add (p, value_ext);
1064 } 1030 }
1065 else if (EQ (attribute, Qtt_object)) 1031 else if (EQ (attribute, Qtt_object))
1066 { 1032 {
1067 CONST char *value_ext; 1033 CONST char *value_ext;
1068 CHECK_STRING (value); 1034 CHECK_STRING (value);
1069 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); 1035 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
1070 tt_pattern_object_add (p, value_ext); 1036 tt_pattern_object_add (p, value_ext);
1071 } 1037 }
1072 else if (EQ (attribute, Qtt_op)) 1038 else if (EQ (attribute, Qtt_op))
1073 { 1039 {
1074 CONST char *value_ext; 1040 CONST char *value_ext;
1075 CHECK_STRING (value); 1041 CHECK_STRING (value);
1076 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); 1042 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
1077 tt_pattern_op_add (p, value_ext); 1043 tt_pattern_op_add (p, value_ext);
1078 } 1044 }
1079 else if (EQ (attribute, Qtt_otype)) 1045 else if (EQ (attribute, Qtt_otype))
1080 { 1046 {
1081 CONST char *value_ext; 1047 CONST char *value_ext;
1082 CHECK_STRING (value); 1048 CHECK_STRING (value);
1083 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); 1049 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
1084 tt_pattern_otype_add (p, value_ext); 1050 tt_pattern_otype_add (p, value_ext);
1085 } 1051 }
1086 else if (EQ (attribute, Qtt_scope)) 1052 else if (EQ (attribute, Qtt_scope))
1087 { 1053 {
1088 CHECK_TOOLTALK_CONSTANT (value); 1054 CHECK_TOOLTALK_CONSTANT (value);
1090 } 1056 }
1091 else if (EQ (attribute, Qtt_sender)) 1057 else if (EQ (attribute, Qtt_sender))
1092 { 1058 {
1093 CONST char *value_ext; 1059 CONST char *value_ext;
1094 CHECK_STRING (value); 1060 CHECK_STRING (value);
1095 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); 1061 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
1096 tt_pattern_sender_add (p, value_ext); 1062 tt_pattern_sender_add (p, value_ext);
1097 } 1063 }
1098 else if (EQ (attribute, Qtt_sender_ptype)) 1064 else if (EQ (attribute, Qtt_sender_ptype))
1099 { 1065 {
1100 CONST char *value_ext; 1066 CONST char *value_ext;
1101 CHECK_STRING (value); 1067 CHECK_STRING (value);
1102 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); 1068 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
1103 tt_pattern_sender_ptype_add (p, value_ext); 1069 tt_pattern_sender_ptype_add (p, value_ext);
1104 } 1070 }
1105 else if (EQ (attribute, Qtt_session)) 1071 else if (EQ (attribute, Qtt_session))
1106 { 1072 {
1107 CONST char *value_ext; 1073 CONST char *value_ext;
1108 CHECK_STRING (value); 1074 CHECK_STRING (value);
1109 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); 1075 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
1110 tt_pattern_session_add (p, value_ext); 1076 tt_pattern_session_add (p, value_ext);
1111 } 1077 }
1112 else if (EQ (attribute, Qtt_state)) 1078 else if (EQ (attribute, Qtt_state))
1113 { 1079 {
1114 CHECK_TOOLTALK_CONSTANT (value); 1080 CHECK_TOOLTALK_CONSTANT (value);
1145 return Qnil; 1111 return Qnil;
1146 1112
1147 { 1113 {
1148 CONST char *vtype_ext; 1114 CONST char *vtype_ext;
1149 1115
1150 GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext); 1116 TO_EXTERNAL_FORMAT (LISP_STRING, vtype, C_STRING_ALLOCA, vtype_ext, Qnative);
1151 if (NILP (value)) 1117 if (NILP (value))
1152 tt_pattern_arg_add (p, n, vtype_ext, NULL); 1118 tt_pattern_arg_add (p, n, vtype_ext, NULL);
1153 else if (STRINGP (value)) 1119 else if (STRINGP (value))
1154 { 1120 {
1155 CONST char *value_ext; 1121 CONST char *value_ext;
1156 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); 1122 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative);
1157 tt_pattern_arg_add (p, n, vtype_ext, value_ext); 1123 tt_pattern_arg_add (p, n, vtype_ext, value_ext);
1158 } 1124 }
1159 else if (INTP (value)) 1125 else if (INTP (value))
1160 tt_pattern_iarg_add (p, n, vtype_ext, XINT (value)); 1126 tt_pattern_iarg_add (p, n, vtype_ext, XINT (value));
1161 } 1127 }
1255 char *retval; 1221 char *retval;
1256 Lisp_Object lp; 1222 Lisp_Object lp;
1257 Lisp_Object fil; 1223 Lisp_Object fil;
1258 1224
1259 1225
1260 /* tt_open() messes with our signal handler flags (at least when no 1226 /* tt_open() messes with our signal handler flags (at least when no
1261 ttsessions is running on the machine), therefore we save the 1227 ttsessions is running on the machine), therefore we save the
1262 actions and restore them after the call */ 1228 actions and restore them after the call */
1263 #ifdef HAVE_SIGPROCMASK 1229 #ifdef HAVE_SIGPROCMASK
1264 { 1230 {
1265 struct sigaction ActSIGQUIT; 1231 struct sigaction ActSIGQUIT;
1266 struct sigaction ActSIGINT; 1232 struct sigaction ActSIGINT;