Mercurial > hg > xemacs-beta
comparison src/tooltalk.c @ 412:697ef44129c6 r21-2-14
Import from CVS: tag r21-2-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:20:41 +0200 |
parents | a86b2b5e0111 |
children | 41dbb7a9d5f2 |
comparison
equal
deleted
inserted
replaced
411:12e008d41344 | 412:697ef44129c6 |
---|---|
20 Boston, MA 02111-1307, USA. */ | 20 Boston, MA 02111-1307, USA. */ |
21 | 21 |
22 /* Synched up with: Not in FSF. */ | 22 /* Synched up with: Not in FSF. */ |
23 | 23 |
24 /* Written by John Rose <john.rose@eng.sun.com>. | 24 /* Written by John Rose <john.rose@eng.sun.com>. |
25 Heavily modified and cleaned up by Ben Wing <ben@xemacs.org>. */ | 25 Heavily modified and cleaned up by Ben Wing <ben.wing@eng.sun.com>. */ |
26 | 26 |
27 #include <config.h> | 27 #include <config.h> |
28 #include "lisp.h" | 28 #include "lisp.h" |
29 | 29 |
30 #include <X11/Xlib.h> | 30 #include <X11/Xlib.h> |
149 Lisp_Object plist_sym, callback; | 149 Lisp_Object plist_sym, callback; |
150 Tt_message m; | 150 Tt_message m; |
151 }; | 151 }; |
152 | 152 |
153 static Lisp_Object | 153 static Lisp_Object |
154 mark_tooltalk_message (Lisp_Object obj) | 154 mark_tooltalk_message (Lisp_Object obj, void (*markobj) (Lisp_Object)) |
155 { | 155 { |
156 mark_object (XTOOLTALK_MESSAGE (obj)->callback); | 156 markobj (XTOOLTALK_MESSAGE (obj)->callback); |
157 return XTOOLTALK_MESSAGE (obj)->plist_sym; | 157 return XTOOLTALK_MESSAGE (obj)->plist_sym; |
158 } | 158 } |
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 Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj); | 164 struct 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>", |
173 write_c_string (buf, printcharfun); | 173 write_c_string (buf, printcharfun); |
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, |
179 Lisp_Tooltalk_Message); | 179 struct 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 Lisp_Tooltalk_Message *msg = | 185 struct Lisp_Tooltalk_Message *msg = |
186 alloc_lcrecord_type (Lisp_Tooltalk_Message, &lrecord_tooltalk_message); | 186 alloc_lcrecord_type (struct Lisp_Tooltalk_Message, |
187 &lrecord_tooltalk_message); | |
187 | 188 |
188 msg->m = m; | 189 msg->m = m; |
189 msg->callback = Qnil; | 190 msg->callback = Qnil; |
190 msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str); | 191 msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str); |
191 XSETTOOLTALK_MESSAGE (val, msg); | 192 XSETTOOLTALK_MESSAGE (val, msg); |
222 Lisp_Object plist_sym, callback; | 223 Lisp_Object plist_sym, callback; |
223 Tt_pattern p; | 224 Tt_pattern p; |
224 }; | 225 }; |
225 | 226 |
226 static Lisp_Object | 227 static Lisp_Object |
227 mark_tooltalk_pattern (Lisp_Object obj) | 228 mark_tooltalk_pattern (Lisp_Object obj, void (*markobj) (Lisp_Object)) |
228 { | 229 { |
229 mark_object (XTOOLTALK_PATTERN (obj)->callback); | 230 markobj (XTOOLTALK_PATTERN (obj)->callback); |
230 return XTOOLTALK_PATTERN (obj)->plist_sym; | 231 return XTOOLTALK_PATTERN (obj)->plist_sym; |
231 } | 232 } |
232 | 233 |
233 static void | 234 static void |
234 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun, | 235 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun, |
235 int escapeflag) | 236 int escapeflag) |
236 { | 237 { |
237 Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj); | 238 struct Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj); |
238 | 239 |
239 char buf[200]; | 240 char buf[200]; |
240 | 241 |
241 if (print_readably) | 242 if (print_readably) |
242 error ("printing unreadable object #<tooltalk_pattern 0x%x>", | 243 error ("printing unreadable object #<tooltalk_pattern 0x%x>", |
246 write_c_string (buf, printcharfun); | 247 write_c_string (buf, printcharfun); |
247 } | 248 } |
248 | 249 |
249 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern, | 250 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern, |
250 mark_tooltalk_pattern, print_tooltalk_pattern, | 251 mark_tooltalk_pattern, print_tooltalk_pattern, |
251 0, 0, 0, 0, | 252 0, 0, 0, |
252 Lisp_Tooltalk_Pattern); | 253 struct Lisp_Tooltalk_Pattern); |
253 | 254 |
254 static Lisp_Object | 255 static Lisp_Object |
255 make_tooltalk_pattern (Tt_pattern p) | 256 make_tooltalk_pattern (Tt_pattern p) |
256 { | 257 { |
257 Lisp_Tooltalk_Pattern *pat = | 258 struct Lisp_Tooltalk_Pattern *pat = |
258 alloc_lcrecord_type (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern); | 259 alloc_lcrecord_type (struct Lisp_Tooltalk_Pattern, |
260 &lrecord_tooltalk_pattern); | |
259 Lisp_Object val; | 261 Lisp_Object val; |
260 | 262 |
261 pat->p = p; | 263 pat->p = p; |
262 pat->callback = Qnil; | 264 pat->callback = Qnil; |
263 pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str); | 265 pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str); |
498 } | 500 } |
499 | 501 |
500 static Lisp_Object | 502 static Lisp_Object |
501 tt_build_string (char *s) | 503 tt_build_string (char *s) |
502 { | 504 { |
503 return build_string (s ? s : ""); | 505 return build_string ((s) ? s : ""); |
504 } | 506 } |
505 | 507 |
506 static Lisp_Object | 508 static Lisp_Object |
507 tt_opnum_string (int n) | 509 tt_opnum_string (int n) |
508 { | 510 { |
698 */ | 700 */ |
699 (value, message_, attribute, argn)) | 701 (value, message_, attribute, argn)) |
700 { | 702 { |
701 Tt_message m = unbox_tooltalk_message (message_); | 703 Tt_message m = unbox_tooltalk_message (message_); |
702 int n = 0; | 704 int n = 0; |
703 Tt_status (*fun_str) (Tt_message, const char *) = 0; | |
704 | 705 |
705 CHECK_SYMBOL (attribute); | 706 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 if (EQ (attribute, Qtt_address)) | 718 else 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 } | |
734 else if (EQ (attribute, Qtt_scope)) | 776 else if (EQ (attribute, Qtt_scope)) |
735 { | 777 { |
736 CHECK_TOOLTALK_CONSTANT (value); | 778 CHECK_TOOLTALK_CONSTANT (value); |
737 tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value)); | 779 tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value)); |
738 } | 780 } |
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; | |
751 else if (EQ (attribute, Qtt_sender_ptype)) | 781 else if (EQ (attribute, Qtt_sender_ptype)) |
752 fun_str = tt_message_sender_ptype_set; | 782 { |
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 } | |
753 else if (EQ (attribute, Qtt_session)) | 788 else if (EQ (attribute, Qtt_session)) |
754 fun_str = tt_message_session_set; | 789 { |
755 else if (EQ (attribute, Qtt_status_string)) | 790 CONST char *value_ext; |
756 fun_str = tt_message_status_string_set; | 791 CHECK_STRING (value); |
792 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); | |
793 tt_message_session_set (m, value_ext); | |
794 } | |
757 else if (EQ (attribute, Qtt_arg_bval)) | 795 else if (EQ (attribute, Qtt_arg_bval)) |
758 { | 796 { |
759 Extbyte *value_ext; | 797 Extbyte *value_ext; |
760 Extcount value_ext_len; | 798 Extcount value_ext_len; |
761 CHECK_STRING (value); | 799 CHECK_STRING (value); |
762 TO_EXTERNAL_FORMAT (LISP_STRING, value, | 800 GET_STRING_OS_DATA_ALLOCA (value, value_ext, value_ext_len); |
763 ALLOCA, (value_ext, value_ext_len), | |
764 Qnative); | |
765 tt_message_arg_bval_set (m, n, value_ext, value_ext_len); | 801 tt_message_arg_bval_set (m, n, value_ext, value_ext_len); |
766 } | 802 } |
767 else if (EQ (attribute, Qtt_arg_ival)) | 803 else if (EQ (attribute, Qtt_arg_ival)) |
768 { | 804 { |
769 CHECK_INT (value); | 805 CHECK_INT (value); |
770 tt_message_arg_ival_set (m, n, XINT (value)); | 806 tt_message_arg_ival_set (m, n, XINT (value)); |
771 } | 807 } |
772 else if (EQ (attribute, Qtt_arg_val)) | 808 else if (EQ (attribute, Qtt_arg_val)) |
773 { | 809 { |
774 const char *value_ext; | 810 CONST char *value_ext; |
775 CHECK_STRING (value); | 811 CHECK_STRING (value); |
776 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); | 812 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); |
777 tt_message_arg_val_set (m, n, value_ext); | 813 tt_message_arg_val_set (m, n, value_ext); |
778 } | 814 } |
779 else if (EQ (attribute, Qtt_status)) | 815 else if (EQ (attribute, Qtt_status)) |
780 { | 816 { |
781 CHECK_INT (value); | 817 CHECK_INT (value); |
782 tt_message_status_set (m, XINT (value)); | 818 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); | |
783 } | 826 } |
784 else if (EQ (attribute, Qtt_callback)) | 827 else if (EQ (attribute, Qtt_callback)) |
785 { | 828 { |
786 CHECK_SYMBOL (value); | 829 CHECK_SYMBOL (value); |
787 XTOOLTALK_MESSAGE (message_)->callback = value; | 830 XTOOLTALK_MESSAGE (message_)->callback = value; |
791 return Fput (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, value); | 834 return Fput (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, value); |
792 } | 835 } |
793 else | 836 else |
794 signal_simple_error ("Invalid value for `set-tooltalk-message-attribute'", | 837 signal_simple_error ("Invalid value for `set-tooltalk-message-attribute'", |
795 attribute); | 838 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 | |
805 return Qnil; | 839 return Qnil; |
806 } | 840 } |
807 | 841 |
808 DEFUN ("return-tooltalk-message", Freturn_tooltalk_message, 1, 2, 0, /* | 842 DEFUN ("return-tooltalk-message", Freturn_tooltalk_message, 1, 2, 0, /* |
809 Send a reply to this message. The second argument can be | 843 Send a reply to this message. The second argument can be |
910 n = (Tt_mode) tooltalk_constant_value (mode); | 944 n = (Tt_mode) tooltalk_constant_value (mode); |
911 | 945 |
912 if (!VALID_TOOLTALK_MESSAGEP (m)) | 946 if (!VALID_TOOLTALK_MESSAGEP (m)) |
913 return Qnil; | 947 return Qnil; |
914 { | 948 { |
915 const char *vtype_ext; | 949 CONST char *vtype_ext; |
916 | 950 |
917 TO_EXTERNAL_FORMAT (LISP_STRING, vtype, C_STRING_ALLOCA, vtype_ext, Qnative); | 951 GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext); |
918 if (NILP (value)) | 952 if (NILP (value)) |
919 tt_message_arg_add (m, n, vtype_ext, NULL); | 953 tt_message_arg_add (m, n, vtype_ext, NULL); |
920 else if (STRINGP (value)) | 954 else if (STRINGP (value)) |
921 { | 955 { |
922 const char *value_ext; | 956 CONST char *value_ext; |
923 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); | 957 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); |
924 tt_message_arg_add (m, n, vtype_ext, value_ext); | 958 tt_message_arg_add (m, n, vtype_ext, value_ext); |
925 } | 959 } |
926 else if (INTP (value)) | 960 else if (INTP (value)) |
927 tt_message_iarg_add (m, n, vtype_ext, XINT (value)); | 961 tt_message_iarg_add (m, n, vtype_ext, XINT (value)); |
928 } | 962 } |
1021 tt_pattern_disposition_add (p, ((Tt_disposition) | 1055 tt_pattern_disposition_add (p, ((Tt_disposition) |
1022 tooltalk_constant_value (value))); | 1056 tooltalk_constant_value (value))); |
1023 } | 1057 } |
1024 else if (EQ (attribute, Qtt_file)) | 1058 else if (EQ (attribute, Qtt_file)) |
1025 { | 1059 { |
1026 const char *value_ext; | 1060 CONST char *value_ext; |
1027 CHECK_STRING (value); | 1061 CHECK_STRING (value); |
1028 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); | 1062 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); |
1029 tt_pattern_file_add (p, value_ext); | 1063 tt_pattern_file_add (p, value_ext); |
1030 } | 1064 } |
1031 else if (EQ (attribute, Qtt_object)) | 1065 else if (EQ (attribute, Qtt_object)) |
1032 { | 1066 { |
1033 const char *value_ext; | 1067 CONST char *value_ext; |
1034 CHECK_STRING (value); | 1068 CHECK_STRING (value); |
1035 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); | 1069 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); |
1036 tt_pattern_object_add (p, value_ext); | 1070 tt_pattern_object_add (p, value_ext); |
1037 } | 1071 } |
1038 else if (EQ (attribute, Qtt_op)) | 1072 else if (EQ (attribute, Qtt_op)) |
1039 { | 1073 { |
1040 const char *value_ext; | 1074 CONST char *value_ext; |
1041 CHECK_STRING (value); | 1075 CHECK_STRING (value); |
1042 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); | 1076 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); |
1043 tt_pattern_op_add (p, value_ext); | 1077 tt_pattern_op_add (p, value_ext); |
1044 } | 1078 } |
1045 else if (EQ (attribute, Qtt_otype)) | 1079 else if (EQ (attribute, Qtt_otype)) |
1046 { | 1080 { |
1047 const char *value_ext; | 1081 CONST char *value_ext; |
1048 CHECK_STRING (value); | 1082 CHECK_STRING (value); |
1049 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); | 1083 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); |
1050 tt_pattern_otype_add (p, value_ext); | 1084 tt_pattern_otype_add (p, value_ext); |
1051 } | 1085 } |
1052 else if (EQ (attribute, Qtt_scope)) | 1086 else if (EQ (attribute, Qtt_scope)) |
1053 { | 1087 { |
1054 CHECK_TOOLTALK_CONSTANT (value); | 1088 CHECK_TOOLTALK_CONSTANT (value); |
1055 tt_pattern_scope_add (p, (Tt_scope) tooltalk_constant_value (value)); | 1089 tt_pattern_scope_add (p, (Tt_scope) tooltalk_constant_value (value)); |
1056 } | 1090 } |
1057 else if (EQ (attribute, Qtt_sender)) | 1091 else if (EQ (attribute, Qtt_sender)) |
1058 { | 1092 { |
1059 const char *value_ext; | 1093 CONST char *value_ext; |
1060 CHECK_STRING (value); | 1094 CHECK_STRING (value); |
1061 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); | 1095 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); |
1062 tt_pattern_sender_add (p, value_ext); | 1096 tt_pattern_sender_add (p, value_ext); |
1063 } | 1097 } |
1064 else if (EQ (attribute, Qtt_sender_ptype)) | 1098 else if (EQ (attribute, Qtt_sender_ptype)) |
1065 { | 1099 { |
1066 const char *value_ext; | 1100 CONST char *value_ext; |
1067 CHECK_STRING (value); | 1101 CHECK_STRING (value); |
1068 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); | 1102 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); |
1069 tt_pattern_sender_ptype_add (p, value_ext); | 1103 tt_pattern_sender_ptype_add (p, value_ext); |
1070 } | 1104 } |
1071 else if (EQ (attribute, Qtt_session)) | 1105 else if (EQ (attribute, Qtt_session)) |
1072 { | 1106 { |
1073 const char *value_ext; | 1107 CONST char *value_ext; |
1074 CHECK_STRING (value); | 1108 CHECK_STRING (value); |
1075 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); | 1109 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); |
1076 tt_pattern_session_add (p, value_ext); | 1110 tt_pattern_session_add (p, value_ext); |
1077 } | 1111 } |
1078 else if (EQ (attribute, Qtt_state)) | 1112 else if (EQ (attribute, Qtt_state)) |
1079 { | 1113 { |
1080 CHECK_TOOLTALK_CONSTANT (value); | 1114 CHECK_TOOLTALK_CONSTANT (value); |
1109 | 1143 |
1110 if (!VALID_TOOLTALK_PATTERNP (p)) | 1144 if (!VALID_TOOLTALK_PATTERNP (p)) |
1111 return Qnil; | 1145 return Qnil; |
1112 | 1146 |
1113 { | 1147 { |
1114 const char *vtype_ext; | 1148 CONST char *vtype_ext; |
1115 | 1149 |
1116 TO_EXTERNAL_FORMAT (LISP_STRING, vtype, C_STRING_ALLOCA, vtype_ext, Qnative); | 1150 GET_C_STRING_OS_DATA_ALLOCA (vtype, vtype_ext); |
1117 if (NILP (value)) | 1151 if (NILP (value)) |
1118 tt_pattern_arg_add (p, n, vtype_ext, NULL); | 1152 tt_pattern_arg_add (p, n, vtype_ext, NULL); |
1119 else if (STRINGP (value)) | 1153 else if (STRINGP (value)) |
1120 { | 1154 { |
1121 const char *value_ext; | 1155 CONST char *value_ext; |
1122 TO_EXTERNAL_FORMAT (LISP_STRING, value, C_STRING_ALLOCA, value_ext, Qnative); | 1156 GET_C_STRING_OS_DATA_ALLOCA (value, value_ext); |
1123 tt_pattern_arg_add (p, n, vtype_ext, value_ext); | 1157 tt_pattern_arg_add (p, n, vtype_ext, value_ext); |
1124 } | 1158 } |
1125 else if (INTP (value)) | 1159 else if (INTP (value)) |
1126 tt_pattern_iarg_add (p, n, vtype_ext, XINT (value)); | 1160 tt_pattern_iarg_add (p, n, vtype_ext, XINT (value)); |
1127 } | 1161 } |
1220 /* This function can GC */ | 1254 /* This function can GC */ |
1221 char *retval; | 1255 char *retval; |
1222 Lisp_Object lp; | 1256 Lisp_Object lp; |
1223 Lisp_Object fil; | 1257 Lisp_Object fil; |
1224 | 1258 |
1225 | |
1226 /* tt_open() messes with our signal handler flags (at least when no | |
1227 ttsessions is running on the machine), therefore we save the | |
1228 actions and restore them after the call */ | |
1229 #ifdef HAVE_SIGPROCMASK | |
1230 { | |
1231 struct sigaction ActSIGQUIT; | |
1232 struct sigaction ActSIGINT; | |
1233 struct sigaction ActSIGCHLD; | |
1234 sigaction (SIGQUIT, NULL, &ActSIGQUIT); | |
1235 sigaction (SIGINT, NULL, &ActSIGINT); | |
1236 sigaction (SIGCHLD, NULL, &ActSIGCHLD); | |
1237 #endif | |
1238 retval = tt_open (); | 1259 retval = tt_open (); |
1239 #ifdef HAVE_SIGPROCMASK | |
1240 sigaction (SIGQUIT, &ActSIGQUIT, NULL); | |
1241 sigaction (SIGINT, &ActSIGINT, NULL); | |
1242 sigaction (SIGCHLD, &ActSIGCHLD, NULL); | |
1243 } | |
1244 #endif | |
1245 | |
1246 | |
1247 if (tt_ptr_error (retval) != TT_OK) | 1260 if (tt_ptr_error (retval) != TT_OK) |
1248 return; | 1261 return; |
1249 | 1262 |
1250 Vtooltalk_fd = make_int (tt_fd ()); | 1263 Vtooltalk_fd = make_int (tt_fd ()); |
1251 | 1264 |
1299 | 1312 |
1300 | 1313 |
1301 void | 1314 void |
1302 syms_of_tooltalk (void) | 1315 syms_of_tooltalk (void) |
1303 { | 1316 { |
1304 INIT_LRECORD_IMPLEMENTATION (tooltalk_message); | |
1305 INIT_LRECORD_IMPLEMENTATION (tooltalk_pattern); | |
1306 | |
1307 defsymbol (&Qtooltalk_messagep, "tooltalk-message-p"); | 1317 defsymbol (&Qtooltalk_messagep, "tooltalk-message-p"); |
1308 DEFSUBR (Ftooltalk_message_p); | 1318 DEFSUBR (Ftooltalk_message_p); |
1309 defsymbol (&Qtooltalk_patternp, "tooltalk-pattern-p"); | 1319 defsymbol (&Qtooltalk_patternp, "tooltalk-pattern-p"); |
1310 DEFSUBR (Ftooltalk_pattern_p); | 1320 DEFSUBR (Ftooltalk_pattern_p); |
1311 defsymbol (&Qtooltalk_message_handler_hook, "tooltalk-message-handler-hook"); | 1321 defsymbol (&Qtooltalk_message_handler_hook, "tooltalk-message-handler-hook"); |