Mercurial > hg > xemacs-beta
annotate src/tooltalk.c @ 4952:19a72041c5ed
Mule-izing, various fixes related to char * arguments
-------------------- ChangeLog entries follow: --------------------
modules/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c:
* postgresql/postgresql.c (CHECK_LIVE_CONNECTION):
* postgresql/postgresql.c (print_pgresult):
* postgresql/postgresql.c (Fpq_conn_defaults):
* postgresql/postgresql.c (Fpq_connectdb):
* postgresql/postgresql.c (Fpq_connect_start):
* postgresql/postgresql.c (Fpq_result_status):
* postgresql/postgresql.c (Fpq_res_status):
Mule-ize large parts of it.
2010-01-26 Ben Wing <ben@xemacs.org>
* ldap/eldap.c (print_ldap):
* ldap/eldap.c (allocate_ldap):
Use write_ascstring().
src/ChangeLog addition:
2010-01-26 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (build_ascstring):
* alloc.c (build_msg_cistring):
* alloc.c (staticpro_1):
* alloc.c (staticpro_name):
* alloc.c (staticpro_nodump_1):
* alloc.c (staticpro_nodump_name):
* alloc.c (unstaticpro_nodump_1):
* alloc.c (mcpro_1):
* alloc.c (mcpro_name):
* alloc.c (object_memory_usage_stats):
* alloc.c (common_init_alloc_early):
* alloc.c (init_alloc_once_early):
* buffer.c (print_buffer):
* buffer.c (vars_of_buffer):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.c (init_initial_directory):
* bytecode.c (invalid_byte_code):
* bytecode.c (print_compiled_function):
* bytecode.c (mark_compiled_function):
* chartab.c (print_table_entry):
* chartab.c (print_char_table):
* config.h.in:
* console-gtk.c:
* console-gtk.c (gtk_device_to_console_connection):
* console-gtk.c (gtk_semi_canonicalize_console_connection):
* console-gtk.c (gtk_canonicalize_console_connection):
* console-gtk.c (gtk_semi_canonicalize_device_connection):
* console-gtk.c (gtk_canonicalize_device_connection):
* console-stream.c (stream_init_frame_1):
* console-stream.c (vars_of_console_stream):
* console-stream.c (init_console_stream):
* console-x.c (x_semi_canonicalize_console_connection):
* console-x.c (x_semi_canonicalize_device_connection):
* console-x.c (x_canonicalize_device_connection):
* console-x.h:
* data.c (eq_with_ebola_notice):
* data.c (Fsubr_interactive):
* data.c (Fnumber_to_string):
* data.c (digit_to_number):
* device-gtk.c (gtk_init_device):
* device-msw.c (print_devmode):
* device-x.c (x_event_name):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-msw.c (handle_file_dialog_box):
* dialog-msw.c (vars_of_dialog_mswindows):
* doc.c (weird_doc):
* doc.c (Fsnarf_documentation):
* doc.c (vars_of_doc):
* dumper.c (pdump):
* dynarr.c:
* dynarr.c (Dynarr_realloc):
* editfns.c (Fuser_real_login_name):
* editfns.c (get_home_directory):
* elhash.c (print_hash_table_data):
* elhash.c (print_hash_table):
* emacs.c (main_1):
* emacs.c (vars_of_emacs):
* emodules.c:
* emodules.c (_emodules_list):
* emodules.c (Fload_module):
* emodules.c (Funload_module):
* emodules.c (Flist_modules):
* emodules.c (find_make_module):
* emodules.c (attempt_module_delete):
* emodules.c (emodules_load):
* emodules.c (emodules_doc_subr):
* emodules.c (emodules_doc_sym):
* emodules.c (syms_of_module):
* emodules.c (vars_of_module):
* emodules.h:
* eval.c (print_subr):
* eval.c (signal_call_debugger):
* eval.c (build_error_data):
* eval.c (signal_error):
* eval.c (maybe_signal_error):
* eval.c (signal_continuable_error):
* eval.c (maybe_signal_continuable_error):
* eval.c (signal_error_2):
* eval.c (maybe_signal_error_2):
* eval.c (signal_continuable_error_2):
* eval.c (maybe_signal_continuable_error_2):
* eval.c (signal_ferror):
* eval.c (maybe_signal_ferror):
* eval.c (signal_continuable_ferror):
* eval.c (maybe_signal_continuable_ferror):
* eval.c (signal_ferror_with_frob):
* eval.c (maybe_signal_ferror_with_frob):
* eval.c (signal_continuable_ferror_with_frob):
* eval.c (maybe_signal_continuable_ferror_with_frob):
* eval.c (syntax_error):
* eval.c (syntax_error_2):
* eval.c (maybe_syntax_error):
* eval.c (sferror):
* eval.c (sferror_2):
* eval.c (maybe_sferror):
* eval.c (invalid_argument):
* eval.c (invalid_argument_2):
* eval.c (maybe_invalid_argument):
* eval.c (invalid_constant):
* eval.c (invalid_constant_2):
* eval.c (maybe_invalid_constant):
* eval.c (invalid_operation):
* eval.c (invalid_operation_2):
* eval.c (maybe_invalid_operation):
* eval.c (invalid_change):
* eval.c (invalid_change_2):
* eval.c (maybe_invalid_change):
* eval.c (invalid_state):
* eval.c (invalid_state_2):
* eval.c (maybe_invalid_state):
* eval.c (wtaerror):
* eval.c (stack_overflow):
* eval.c (out_of_memory):
* eval.c (print_multiple_value):
* eval.c (issue_call_trapping_problems_warning):
* eval.c (backtrace_specials):
* eval.c (backtrace_unevalled_args):
* eval.c (Fbacktrace):
* eval.c (warn_when_safe):
* event-Xt.c (modwarn):
* event-Xt.c (modbarf):
* event-Xt.c (check_modifier):
* event-Xt.c (store_modifier):
* event-Xt.c (emacs_Xt_format_magic_event):
* event-Xt.c (describe_event):
* event-gtk.c (dragndrop_data_received):
* event-gtk.c (store_modifier):
* event-gtk.c (gtk_reset_modifier_mapping):
* event-msw.c (dde_eval_string):
* event-msw.c (Fdde_alloc_advise_item):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (FROB):
* event-msw.c (emacs_mswindows_format_magic_event):
* event-stream.c (external_debugging_print_event):
* event-stream.c (execute_help_form):
* event-stream.c (vars_of_event_stream):
* events.c (print_event_1):
* events.c (print_event):
* events.c (event_equal):
* extents.c (print_extent_1):
* extents.c (print_extent):
* extents.c (vars_of_extents):
* faces.c (print_face):
* faces.c (complex_vars_of_faces):
* file-coding.c:
* file-coding.c (print_coding_system):
* file-coding.c (print_coding_system_in_print_method):
* file-coding.c (default_query_method):
* file-coding.c (find_coding_system):
* file-coding.c (make_coding_system_1):
* file-coding.c (chain_print):
* file-coding.c (undecided_print):
* file-coding.c (gzip_print):
* file-coding.c (vars_of_file_coding):
* file-coding.c (complex_vars_of_file_coding):
* fileio.c:
* fileio.c (report_file_type_error):
* fileio.c (report_error_with_errno):
* fileio.c (report_file_error):
* fileio.c (barf_or_query_if_file_exists):
* fileio.c (vars_of_fileio):
* floatfns.c (matherr):
* fns.c (print_bit_vector):
* fns.c (Fmapconcat):
* fns.c (add_suffix_to_symbol):
* fns.c (add_prefix_to_symbol):
* frame-gtk.c:
* frame-gtk.c (Fgtk_window_id):
* frame-x.c (def):
* frame-x.c (x_cde_transfer_callback):
* frame.c:
* frame.c (Fmake_frame):
* gc.c (show_gc_cursor_and_message):
* gc.c (vars_of_gc):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate):
* glyphs-gtk.c (gtk_print_image_instance):
* glyphs-msw.c (mswindows_print_image_instance):
* glyphs-x.c (x_print_image_instance):
* glyphs-x.c (update_widget_face):
* glyphs.c (make_string_from_file):
* glyphs.c (print_image_instance):
* glyphs.c (signal_image_error):
* glyphs.c (signal_image_error_2):
* glyphs.c (signal_double_image_error):
* glyphs.c (signal_double_image_error_2):
* glyphs.c (xbm_mask_file_munging):
* glyphs.c (pixmap_to_lisp_data):
* glyphs.h:
* gui.c (gui_item_display_flush_left):
* hpplay.c (player_error_internal):
* hpplay.c (myHandler):
* intl-win32.c:
* intl-win32.c (langcode_to_lang):
* intl-win32.c (sublangcode_to_lang):
* intl-win32.c (Fmswindows_get_locale_info):
* intl-win32.c (lcid_to_locale_mule_or_no):
* intl-win32.c (mswindows_multibyte_to_unicode_print):
* intl-win32.c (complex_vars_of_intl_win32):
* keymap.c:
* keymap.c (print_keymap):
* keymap.c (ensure_meta_prefix_char_keymapp):
* keymap.c (Fkey_description):
* keymap.c (Ftext_char_description):
* lisp.h:
* lisp.h (struct):
* lisp.h (DECLARE_INLINE_HEADER):
* lread.c (Fload_internal):
* lread.c (locate_file):
* lread.c (read_escape):
* lread.c (read_raw_string):
* lread.c (read1):
* lread.c (read_list):
* lread.c (read_compiled_function):
* lread.c (init_lread):
* lrecord.h:
* marker.c (print_marker):
* marker.c (marker_equal):
* menubar-msw.c (displayable_menu_item):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar.c (vars_of_menubar):
* minibuf.c (reinit_complex_vars_of_minibuf):
* minibuf.c (complex_vars_of_minibuf):
* mule-charset.c (Fmake_charset):
* mule-charset.c (complex_vars_of_mule_charset):
* mule-coding.c (iso2022_print):
* mule-coding.c (fixed_width_query):
* number.c (bignum_print):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-msw.c:
* objects-msw.c (mswindows_color_to_string):
* objects-msw.c (mswindows_color_list):
* objects-tty.c:
* objects-tty.c (tty_font_list):
* objects-tty.c (tty_find_charset_font):
* objects-xlike-inc.c (xft_find_charset_font):
* objects-xlike-inc.c (endif):
* print.c:
* print.c (write_istring):
* print.c (write_ascstring):
* print.c (Fterpri):
* print.c (Fprint):
* print.c (print_error_message):
* print.c (print_vector_internal):
* print.c (print_cons):
* print.c (print_string):
* print.c (printing_unreadable_object):
* print.c (print_internal):
* print.c (print_float):
* print.c (print_symbol):
* process-nt.c (mswindows_report_winsock_error):
* process-nt.c (nt_canonicalize_host_name):
* process-unix.c (unix_canonicalize_host_name):
* process.c (print_process):
* process.c (report_process_error):
* process.c (report_network_error):
* process.c (make_process_internal):
* process.c (Fstart_process_internal):
* process.c (status_message):
* process.c (putenv_internal):
* process.c (vars_of_process):
* process.h:
* profile.c (vars_of_profile):
* rangetab.c (print_range_table):
* realpath.c (vars_of_realpath):
* redisplay.c (vars_of_redisplay):
* search.c (wordify):
* search.c (Freplace_match):
* sheap.c (sheap_adjust_h):
* sound.c (report_sound_error):
* sound.c (Fplay_sound_file):
* specifier.c (print_specifier):
* symbols.c (Fsubr_name):
* symbols.c (do_symval_forwarding):
* symbols.c (set_default_buffer_slot_variable):
* symbols.c (set_default_console_slot_variable):
* symbols.c (store_symval_forwarding):
* symbols.c (default_value):
* symbols.c (defsymbol_massage_name_1):
* symbols.c (defsymbol_massage_name_nodump):
* symbols.c (defsymbol_massage_name):
* symbols.c (defsymbol_massage_multiword_predicate_nodump):
* symbols.c (defsymbol_massage_multiword_predicate):
* symbols.c (defsymbol_nodump):
* symbols.c (defsymbol):
* symbols.c (defkeyword):
* symbols.c (defkeyword_massage_name):
* symbols.c (check_module_subr):
* symbols.c (deferror_1):
* symbols.c (deferror):
* symbols.c (deferror_massage_name):
* symbols.c (deferror_massage_name_and_message):
* symbols.c (defvar_magic):
* symeval.h:
* symeval.h (DEFVAR_SYMVAL_FWD):
* sysdep.c:
* sysdep.c (init_system_name):
* sysdll.c:
* sysdll.c (MAYBE_PREPEND_UNDERSCORE):
* sysdll.c (dll_function):
* sysdll.c (dll_variable):
* sysdll.c (dll_error):
* sysdll.c (dll_open):
* sysdll.c (dll_close):
* sysdll.c (image_for_address):
* sysdll.c (my_find_image):
* sysdll.c (search_linked_libs):
* sysdll.h:
* sysfile.h:
* sysfile.h (DEFAULT_DIRECTORY_FALLBACK):
* syswindows.h:
* tests.c (DFC_CHECK_LENGTH):
* tests.c (DFC_CHECK_CONTENT):
* tests.c (Ftest_hash_tables):
* text.c (vars_of_text):
* text.h:
* tooltalk.c (tt_opnum_string):
* tooltalk.c (tt_message_arg_ival_string):
* tooltalk.c (Ftooltalk_default_procid):
* tooltalk.c (Ftooltalk_default_session):
* tooltalk.c (init_tooltalk):
* tooltalk.c (vars_of_tooltalk):
* ui-gtk.c (Fdll_load):
* ui-gtk.c (type_to_marshaller_type):
* ui-gtk.c (Fgtk_import_function_internal):
* ui-gtk.c (emacs_gtk_object_printer):
* ui-gtk.c (emacs_gtk_boxed_printer):
* unicode.c (unicode_to_ichar):
* unicode.c (unicode_print):
* unicode.c (unicode_query):
* unicode.c (vars_of_unicode):
* unicode.c (complex_vars_of_unicode):
* win32.c:
* win32.c (mswindows_report_process_error):
* window.c (print_window):
* xemacs.def.in.in:
BASIC IDEA: Further fixing up uses of char * and CIbyte *
to reflect their actual semantics; Mule-izing some code;
redoing of the not-yet-working code to handle message translation.
Clean up code to handle message-translation (not yet working).
Create separate versions of build_msg_string() for working with
Ibyte *, CIbyte *, and Ascbyte * arguments. Assert that Ascbyte *
arguments are pure-ASCII. Make build_msg_string() be the same
as build_msg_ascstring(). Create same three versions of GETTEXT()
and DEFER_GETTEXT(). Also create build_defer_string() and
variants for the equivalent of DEFER_GETTEXT() when building a
string. Remove old CGETTEXT(). Clean up code where GETTEXT(),
DEFER_GETTEXT(), build_msg_string(), etc. was being called and
introduce some new calls to build_msg_string(), etc. Remove
GETTEXT() from calls to weird_doc() -- we assume that the
message snarfer knows about weird_doc(). Remove uses of
DEFER_GETTEXT() from error messages in sysdep.c and instead use
special comments /* @@@begin-snarf@@@ */ and /* @@@end-snarf@@@ */
that the message snarfer presumably knows about.
Create build_ascstring() and use it in many instances in place
of build_string(). The purpose of having Ascbyte * variants is
to make the code more self-documenting in terms of what sort of
semantics is expected for char * strings. In fact in the process
of looking for uses of build_string(), much improperly Mule-ized
was discovered.
Mule-ize a lot of code as described in previous paragraph,
e.g. in sysdep.c.
Make the error functions take Ascbyte * strings and fix up a
couple of places where non-pure-ASCII strings were being passed in
(file-coding.c, mule-coding.c, unicode.c). (It's debatable whether
we really need to make the error functions work this way. It
helps catch places where code is written in a way that message
translation won't work, but we may well never implement message
translation.)
Make staticpro() and friends take Ascbyte * strings instead of
raw char * strings. Create a const_Ascbyte_ptr dynarr type
to describe what's held by staticpro_names[] and friends,
create pdump descriptions for const_Ascbyte_ptr dynarrs, and
use them in place of specially-crafted staticpro descriptions.
Mule-ize certain other functions (e.g. x_event_name) by correcting
raw use of char * to Ascbyte *, Rawbyte * or another such type,
and raw use of char[] buffers to another type (usually Ascbyte[]).
Change many uses of write_c_string() to write_msg_string(),
write_ascstring(), etc.
Mule-ize emodules.c, emodules.h, sysdll.h.
Fix some un-Mule-ized code in intl-win32.c.
A comment in event-Xt.c and the limitations of the message
snarfer (make-msgfile or whatever) is presumably incorrect --
it should be smart enough to handle function calls spread over
more than one line. Clean up code in event-Xt.c that was
written awkwardly for this reason.
In config.h.in, instead of NEED_ERROR_CHECK_TYPES_INLINES,
create a more general XEMACS_DEFS_NEEDS_INLINE_DECLS to
indicate when inlined functions need to be declared in
xemacs.defs.in.in, and make use of it in xemacs.defs.in.in.
We need to do this because postgresql.c now calls qxestrdup(),
which is an inline function.
Make nconc2() and other such functions MODULE_API and put
them in xemacs.defs.in.in since postgresql.c now uses them.
Clean up indentation in lread.c and a few other places.
In text.h, document ASSERT_ASCTEXT_ASCII() and
ASSERT_ASCTEXT_ASCII_LEN(), group together the stand-in
encodings and add some more for DLL symbols, function and
variable names, etc.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Tue, 26 Jan 2010 23:22:30 -0600 |
| parents | a98ca4640147 |
| children | 304aebb79cd3 |
| rev | line source |
|---|---|
| 428 | 1 /* Tooltalk support for Emacs. |
| 2 Copyright (C) 1993, 1994 Sun Microsystems, Inc. | |
| 3 Copyright (C) 1995 Free Software Foundation, Inc. | |
| 853 | 4 Copyright (C) 2002 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: Not in FSF. */ | |
| 24 | |
| 25 /* Written by John Rose <john.rose@eng.sun.com>. | |
| 26 Heavily modified and cleaned up by Ben Wing <ben@xemacs.org>. */ | |
| 27 | |
| 28 #include <config.h> | |
| 29 #include "lisp.h" | |
| 30 | |
| 31 #include <X11/Xlib.h> | |
| 32 | |
| 33 #include "buffer.h" | |
| 34 #include "elhash.h" | |
| 35 #include "process.h" | |
| 36 #include "tooltalk.h" | |
| 442 | 37 #include "syssignal.h" |
| 428 | 38 |
| 39 Lisp_Object Vtooltalk_fd; | |
| 40 | |
| 41 #ifdef TT_DEBUG | |
| 42 static FILE *tooltalk_log_file; | |
| 43 #endif | |
| 44 | |
| 45 static Lisp_Object | |
| 46 Vtooltalk_message_handler_hook, | |
| 47 Vtooltalk_pattern_handler_hook, | |
| 48 Vtooltalk_unprocessed_message_hook; | |
| 49 | |
| 50 static Lisp_Object | |
| 51 Qtooltalk_message_handler_hook, | |
| 52 Qtooltalk_pattern_handler_hook, | |
| 53 Qtooltalk_unprocessed_message_hook; | |
| 54 | |
| 55 static Lisp_Object | |
| 56 Qreceive_tooltalk_message, | |
| 57 Qtt_address, | |
| 58 Qtt_args_count, | |
| 59 Qtt_arg_bval, | |
| 60 Qtt_arg_ival, | |
| 61 Qtt_arg_mode, | |
| 62 Qtt_arg_type, | |
| 63 Qtt_arg_val, | |
| 64 Qtt_class, | |
| 65 Qtt_category, | |
| 66 Qtt_disposition, | |
| 67 Qtt_file, | |
| 68 Qtt_gid, | |
| 69 Qtt_handler, | |
| 70 Qtt_handler_ptype, | |
| 71 Qtt_object, | |
| 72 Qtt_op, | |
| 73 Qtt_opnum, | |
| 74 Qtt_otype, | |
| 75 Qtt_scope, | |
| 76 Qtt_sender, | |
| 77 Qtt_sender_ptype, | |
| 78 Qtt_session, | |
| 79 Qtt_state, | |
| 80 Qtt_status, | |
| 81 Qtt_status_string, | |
| 82 Qtt_uid, | |
| 83 Qtt_callback, | |
| 84 Qtt_plist, | |
| 85 Qtt_prop, | |
| 86 | |
| 87 Qtt_reject, /* return-tooltalk-message */ | |
| 88 Qtt_reply, | |
| 89 Qtt_fail, | |
| 90 | |
| 91 Q_TT_MODE_UNDEFINED, /* enum Tt_mode */ | |
| 92 Q_TT_IN, | |
| 93 Q_TT_OUT, | |
| 94 Q_TT_INOUT, | |
| 95 Q_TT_MODE_LAST, | |
| 96 | |
| 97 Q_TT_SCOPE_NONE, /* enum Tt_scope */ | |
| 98 Q_TT_SESSION, | |
| 99 Q_TT_FILE, | |
| 100 Q_TT_BOTH, | |
| 101 Q_TT_FILE_IN_SESSION, | |
| 102 | |
| 103 Q_TT_CLASS_UNDEFINED, /* enum Tt_class */ | |
| 104 Q_TT_NOTICE, | |
| 105 Q_TT_REQUEST, | |
| 106 Q_TT_CLASS_LAST, | |
| 107 | |
| 108 Q_TT_CATEGORY_UNDEFINED, /* enum Tt_category */ | |
| 109 Q_TT_OBSERVE, | |
| 110 Q_TT_HANDLE, | |
| 111 Q_TT_CATEGORY_LAST, | |
| 112 | |
| 113 Q_TT_PROCEDURE, /* typedef enum Tt_address */ | |
| 114 Q_TT_OBJECT, | |
| 115 Q_TT_HANDLER, | |
| 116 Q_TT_OTYPE, | |
| 117 Q_TT_ADDRESS_LAST, | |
| 118 | |
| 119 Q_TT_CREATED, /* enum Tt_state */ | |
| 120 Q_TT_SENT, | |
| 121 Q_TT_HANDLED, | |
| 122 Q_TT_FAILED, | |
| 123 Q_TT_QUEUED, | |
| 124 Q_TT_STARTED, | |
| 125 Q_TT_REJECTED, | |
| 126 Q_TT_STATE_LAST, | |
| 127 | |
| 128 Q_TT_DISCARD, /* enum Tt_disposition */ | |
| 129 Q_TT_QUEUE, | |
| 130 Q_TT_START; | |
| 131 | |
| 132 static Lisp_Object Tooltalk_Message_plist_str, Tooltalk_Pattern_plist_str; | |
| 133 | |
| 134 Lisp_Object Qtooltalk_error; | |
| 135 | |
| 136 /* Used to GCPRO tooltalk message and pattern objects while | |
| 137 they're sitting inside of some active tooltalk message or pattern. | |
| 138 There may not be any other pointers to these objects. */ | |
| 139 Lisp_Object Vtooltalk_message_gcpro, Vtooltalk_pattern_gcpro; | |
| 140 | |
| 141 | |
| 142 /* */ | |
| 143 /* machinery for tooltalk-message type */ | |
| 144 /* */ | |
| 145 | |
| 146 Lisp_Object Qtooltalk_messagep; | |
| 147 | |
| 148 struct Lisp_Tooltalk_Message | |
| 149 { | |
| 3017 | 150 struct LCRECORD_HEADER header; |
| 428 | 151 Lisp_Object plist_sym, callback; |
| 152 Tt_message m; | |
| 153 }; | |
| 154 | |
| 1204 | 155 static const struct memory_description tooltalk_message_description [] = { |
| 934 | 156 { XD_LISP_OBJECT, offsetof (struct Lisp_Tooltalk_Message, callback) }, |
| 157 { XD_LISP_OBJECT, offsetof (struct Lisp_Tooltalk_Message, plist_sym) }, | |
| 158 { XD_END } | |
| 159 }; | |
| 160 | |
| 428 | 161 static Lisp_Object |
| 162 mark_tooltalk_message (Lisp_Object obj) | |
| 163 { | |
| 164 mark_object (XTOOLTALK_MESSAGE (obj)->callback); | |
| 165 return XTOOLTALK_MESSAGE (obj)->plist_sym; | |
| 166 } | |
| 167 | |
| 168 static void | |
| 169 print_tooltalk_message (Lisp_Object obj, Lisp_Object printcharfun, | |
| 2286 | 170 int UNUSED (escapeflag)) |
| 428 | 171 { |
| 440 | 172 Lisp_Tooltalk_Message *p = XTOOLTALK_MESSAGE (obj); |
| 428 | 173 |
| 174 if (print_readably) | |
| 4846 | 175 printing_unreadable_lcrecord (obj, 0); |
| 428 | 176 |
| 4846 | 177 write_fmt_string (printcharfun, "#<tooltalk-message id:0x%lx 0x%x>", |
| 800 | 178 (long) (p->m), p->header.uid); |
| 428 | 179 } |
| 180 | |
| 934 | 181 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-message", tooltalk_message, |
| 960 | 182 0, /*dumpable-flag*/ |
| 934 | 183 mark_tooltalk_message, print_tooltalk_message, |
| 184 0, 0, 0, | |
| 185 tooltalk_message_description, | |
| 186 Lisp_Tooltalk_Message); | |
| 428 | 187 |
| 188 static Lisp_Object | |
| 189 make_tooltalk_message (Tt_message m) | |
| 190 { | |
| 191 Lisp_Object val; | |
| 440 | 192 Lisp_Tooltalk_Message *msg = |
| 3017 | 193 ALLOC_LCRECORD_TYPE (Lisp_Tooltalk_Message, &lrecord_tooltalk_message); |
| 428 | 194 |
| 195 msg->m = m; | |
| 196 msg->callback = Qnil; | |
| 197 msg->plist_sym = Fmake_symbol (Tooltalk_Message_plist_str); | |
| 793 | 198 return wrap_tooltalk_message (msg); |
| 428 | 199 } |
| 200 | |
| 201 Tt_message | |
| 202 unbox_tooltalk_message (Lisp_Object msg) | |
| 203 { | |
| 204 CHECK_TOOLTALK_MESSAGE (msg); | |
| 205 return XTOOLTALK_MESSAGE (msg)->m; | |
| 206 } | |
| 207 | |
| 208 DEFUN ("tooltalk-message-p", Ftooltalk_message_p, 1, 1, 0, /* | |
| 209 Return non-nil if OBJECT is a tooltalk message. | |
| 210 */ | |
| 211 (object)) | |
| 212 { | |
| 213 return TOOLTALK_MESSAGEP (object) ? Qt : Qnil; | |
| 214 } | |
| 215 | |
| 216 | |
| 217 | |
| 218 | |
| 219 /* */ | |
| 220 /* machinery for tooltalk-pattern type */ | |
| 221 /* */ | |
| 222 | |
| 223 Lisp_Object Qtooltalk_patternp; | |
| 224 | |
| 225 struct Lisp_Tooltalk_Pattern | |
| 226 { | |
| 3017 | 227 struct LCRECORD_HEADER header; |
| 428 | 228 Lisp_Object plist_sym, callback; |
| 229 Tt_pattern p; | |
| 230 }; | |
| 231 | |
| 1204 | 232 static const struct memory_description tooltalk_pattern_description [] = { |
| 934 | 233 { XD_LISP_OBJECT, offsetof (struct Lisp_Tooltalk_Pattern, callback) }, |
| 234 { XD_LISP_OBJECT, offsetof (struct Lisp_Tooltalk_Pattern, plist_sym) }, | |
| 235 { XD_END } | |
| 236 }; | |
| 237 | |
| 428 | 238 static Lisp_Object |
| 239 mark_tooltalk_pattern (Lisp_Object obj) | |
| 240 { | |
| 241 mark_object (XTOOLTALK_PATTERN (obj)->callback); | |
| 242 return XTOOLTALK_PATTERN (obj)->plist_sym; | |
| 243 } | |
| 244 | |
| 245 static void | |
| 246 print_tooltalk_pattern (Lisp_Object obj, Lisp_Object printcharfun, | |
| 2286 | 247 int UNUSED (escapeflag)) |
| 428 | 248 { |
| 440 | 249 Lisp_Tooltalk_Pattern *p = XTOOLTALK_PATTERN (obj); |
| 428 | 250 |
| 251 if (print_readably) | |
| 4846 | 252 printing_unreadable_lcrecord (obj, 0); |
| 428 | 253 |
| 4846 | 254 write_fmt_string (printcharfun, "#<tooltalk-pattern id:0x%lx 0x%x>", |
| 800 | 255 (long) (p->p), p->header.uid); |
| 428 | 256 } |
| 257 | |
| 934 | 258 DEFINE_LRECORD_IMPLEMENTATION ("tooltalk-pattern", tooltalk_pattern, |
| 960 | 259 0, /*dumpable-flag*/ |
| 934 | 260 mark_tooltalk_pattern, print_tooltalk_pattern, |
| 261 0, 0, 0, | |
| 262 tooltalk_pattern_description, | |
| 263 Lisp_Tooltalk_Pattern); | |
| 428 | 264 |
| 265 static Lisp_Object | |
| 266 make_tooltalk_pattern (Tt_pattern p) | |
| 267 { | |
| 440 | 268 Lisp_Tooltalk_Pattern *pat = |
| 3017 | 269 ALLOC_LCRECORD_TYPE (Lisp_Tooltalk_Pattern, &lrecord_tooltalk_pattern); |
| 428 | 270 Lisp_Object val; |
| 271 | |
| 272 pat->p = p; | |
| 273 pat->callback = Qnil; | |
| 274 pat->plist_sym = Fmake_symbol (Tooltalk_Pattern_plist_str); | |
| 275 | |
| 793 | 276 return wrap_tooltalk_pattern (pat); |
| 428 | 277 } |
| 278 | |
| 279 static Tt_pattern | |
| 280 unbox_tooltalk_pattern (Lisp_Object pattern) | |
| 281 { | |
| 282 CHECK_TOOLTALK_PATTERN (pattern); | |
| 283 return XTOOLTALK_PATTERN (pattern)->p; | |
| 284 } | |
| 285 | |
| 286 DEFUN ("tooltalk-pattern-p", Ftooltalk_pattern_p, 1, 1, 0, /* | |
| 287 Return non-nil if OBJECT is a tooltalk pattern. | |
| 288 */ | |
| 289 (object)) | |
| 290 { | |
| 291 return TOOLTALK_PATTERNP (object) ? Qt : Qnil; | |
| 292 } | |
| 293 | |
| 294 | |
| 295 | |
| 296 | |
| 297 static int | |
| 298 tooltalk_constant_value (Lisp_Object s) | |
| 299 { | |
| 300 if (INTP (s)) | |
| 301 return XINT (s); | |
| 302 else if (SYMBOLP (s)) | |
| 303 return XINT (XSYMBOL (s)->value); | |
| 304 else | |
| 305 return 0; /* should never occur */ | |
| 306 } | |
| 307 | |
| 308 static void | |
| 309 check_status (Tt_status st) | |
| 310 { | |
| 311 if (tt_is_err (st)) | |
| 563 | 312 { |
| 867 | 313 CIbyte *err; |
| 563 | 314 |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
315 EXTERNAL_TO_C_STRING (tt_status_message (st), err, Qtooltalk_encoding); |
| 563 | 316 signal_error (Qtooltalk_error, err, Qunbound); |
| 317 } | |
| 428 | 318 } |
| 319 | |
| 320 DEFUN ("receive-tooltalk-message", Freceive_tooltalk_message, 0, 2, 0, /* | |
| 321 Run tt_message_receive(). | |
| 322 This function is the process handler for the ToolTalk connection process. | |
| 323 */ | |
| 2286 | 324 (UNUSED (ignore1), UNUSED (ignore2))) |
| 428 | 325 { |
| 326 /* This function can GC */ | |
| 327 Tt_message mess = tt_message_receive (); | |
| 328 Lisp_Object message_ = make_tooltalk_message (mess); | |
| 329 struct gcpro gcpro1; | |
| 330 | |
| 331 GCPRO1 (message_); | |
| 332 if (mess != NULL && !NILP (Vtooltalk_unprocessed_message_hook)) | |
| 333 va_run_hook_with_args (Qtooltalk_unprocessed_message_hook, 1, message_); | |
| 334 UNGCPRO; | |
| 335 | |
| 336 /* see comment in event-stream.c about this return value. */ | |
| 337 return Qzero; | |
| 338 } | |
| 339 | |
| 340 static Tt_callback_action | |
| 341 tooltalk_message_callback (Tt_message m, Tt_pattern p) | |
| 342 { | |
| 343 /* This function can GC */ | |
| 344 Lisp_Object cb; | |
| 345 Lisp_Object message_; | |
| 346 Lisp_Object pattern; | |
| 347 struct gcpro gcpro1, gcpro2; | |
| 348 | |
| 349 #ifdef TT_DEBUG | |
| 350 int i, j; | |
| 351 | |
| 352 fprintf (tooltalk_log_file, "message_cb: %d\n", m); | |
| 353 fprintf (tooltalk_log_file, "op: %s (", tt_message_op (m)); | |
| 354 for (j = tt_message_args_count (m), i = 0; i < j; i++) { | |
| 355 fprintf (tooltalk_log_file, "%s \"%s\"", tt_message_arg_type (m, i), | |
| 356 tt_message_arg_val (m, i)); | |
| 357 fprintf (tooltalk_log_file, "%s", i == j-1 ? ")" : ", "); | |
| 358 } | |
| 359 fprintf (tooltalk_log_file, "\n\n"); | |
| 360 fflush (tooltalk_log_file); | |
| 361 #endif | |
| 362 | |
| 826 | 363 message_ = VOID_TO_LISP (tt_message_user (m, TOOLTALK_MESSAGE_KEY)); |
| 428 | 364 pattern = make_tooltalk_pattern (p); |
| 365 cb = XTOOLTALK_MESSAGE (message_)->callback; | |
| 366 GCPRO2 (message_, pattern); | |
| 367 if (!NILP (Vtooltalk_message_handler_hook)) | |
| 368 va_run_hook_with_args (Qtooltalk_message_handler_hook, 2, | |
| 369 message_, pattern); | |
| 370 | |
| 371 if ((SYMBOLP (cb) && EQ (Qt, Ffboundp (cb))) || | |
| 372 (CONSP (cb) && EQ (Qlambda, Fcar (cb)) && | |
| 373 !NILP (Flistp (Fcar (Fcdr (cb)))))) | |
| 374 call2 (cb, message_, pattern); | |
| 375 UNGCPRO; | |
| 376 | |
| 377 tt_message_destroy (m); | |
| 378 Fremhash (message_, Vtooltalk_message_gcpro); | |
| 379 | |
| 380 return TT_CALLBACK_PROCESSED; | |
| 381 } | |
| 382 | |
| 383 static Tt_callback_action | |
| 384 tooltalk_pattern_callback (Tt_message m, Tt_pattern p) | |
| 385 { | |
| 386 /* This function can GC */ | |
| 387 Lisp_Object cb; | |
| 388 Lisp_Object message_; | |
| 389 Lisp_Object pattern; | |
| 390 struct gcpro gcpro1, gcpro2; | |
| 391 | |
| 392 #ifdef TT_DEBUG | |
| 393 int i, j; | |
| 394 | |
| 395 fprintf (tooltalk_log_file, "pattern_cb: %d\n", m); | |
| 396 fprintf (tooltalk_log_file, "op: %s (", tt_message_op (m)); | |
| 397 for (j = tt_message_args_count (m), i = 0; i < j; i++) { | |
| 398 fprintf (tooltalk_log_file, "%s \"%s\"", tt_message_arg_type (m, i), | |
| 399 tt_message_arg_val (m, i)); | |
| 400 fprintf (tooltalk_log_file, "%s", i == j-1 ? ")" : ", "); | |
| 401 } | |
| 402 fprintf (tooltalk_log_file, "\n\n"); | |
| 403 fflush (tooltalk_log_file); | |
| 404 #endif | |
| 405 | |
| 406 message_ = make_tooltalk_message (m); | |
| 826 | 407 pattern = VOID_TO_LISP (tt_pattern_user (p, TOOLTALK_PATTERN_KEY)); |
| 428 | 408 cb = XTOOLTALK_PATTERN (pattern)->callback; |
| 409 GCPRO2 (message_, pattern); | |
| 410 if (!NILP (Vtooltalk_pattern_handler_hook)) | |
| 411 va_run_hook_with_args (Qtooltalk_pattern_handler_hook, 2, | |
| 412 message_, pattern); | |
| 413 | |
| 414 if (SYMBOLP (cb) && EQ (Qt, Ffboundp (cb))) | |
| 415 call2 (cb, message_, pattern); | |
| 416 UNGCPRO; | |
| 417 | |
| 418 tt_message_destroy (m); | |
| 419 return TT_CALLBACK_PROCESSED; | |
| 420 } | |
| 421 | |
| 422 static Lisp_Object | |
| 423 tt_mode_symbol (Tt_mode n) | |
| 424 { | |
| 425 switch (n) | |
| 426 { | |
| 427 case TT_MODE_UNDEFINED: return Q_TT_MODE_UNDEFINED; | |
| 428 case TT_IN: return Q_TT_IN; | |
| 429 case TT_OUT: return Q_TT_OUT; | |
| 430 case TT_INOUT: return Q_TT_INOUT; | |
| 431 case TT_MODE_LAST: return Q_TT_MODE_LAST; | |
| 432 default: return Qnil; | |
| 433 } | |
| 434 } | |
| 435 | |
| 436 static Lisp_Object | |
| 437 tt_scope_symbol (Tt_scope n) | |
| 438 { | |
| 439 switch (n) | |
| 440 { | |
| 441 case TT_SCOPE_NONE: return Q_TT_SCOPE_NONE; | |
| 442 case TT_SESSION: return Q_TT_SESSION; | |
| 443 case TT_FILE: return Q_TT_FILE; | |
| 444 case TT_BOTH: return Q_TT_BOTH; | |
| 445 case TT_FILE_IN_SESSION: return Q_TT_FILE_IN_SESSION; | |
| 446 default: return Qnil; | |
| 447 } | |
| 448 } | |
| 449 | |
| 450 | |
| 451 static Lisp_Object | |
| 452 tt_class_symbol (Tt_class n) | |
| 453 { | |
| 454 switch (n) | |
| 455 { | |
| 456 case TT_CLASS_UNDEFINED: return Q_TT_CLASS_UNDEFINED; | |
| 457 case TT_NOTICE: return Q_TT_NOTICE; | |
| 458 case TT_REQUEST: return Q_TT_REQUEST; | |
| 459 case TT_CLASS_LAST: return Q_TT_CLASS_LAST; | |
| 460 default: return Qnil; | |
| 461 } | |
| 462 } | |
| 463 | |
| 464 /* | |
| 465 * This is not being used. Is that a mistake or is this function | |
| 466 * simply not necessary? | |
| 467 */ | |
| 468 #if 0 | |
| 469 static Lisp_Object | |
| 470 tt_category_symbol (Tt_category n) | |
| 471 { | |
| 472 switch (n) | |
| 473 { | |
| 474 case TT_CATEGORY_UNDEFINED: return Q_TT_CATEGORY_UNDEFINED; | |
| 475 case TT_OBSERVE: return Q_TT_OBSERVE; | |
| 476 case TT_HANDLE: return Q_TT_HANDLE; | |
| 477 case TT_CATEGORY_LAST: return Q_TT_CATEGORY_LAST; | |
| 478 default: return Qnil; | |
| 479 } | |
| 480 } | |
| 481 #endif /* 0 */ | |
| 482 | |
| 483 static Lisp_Object | |
| 484 tt_address_symbol (Tt_address n) | |
| 485 { | |
| 486 switch (n) | |
| 487 { | |
| 488 case TT_PROCEDURE: return Q_TT_PROCEDURE; | |
| 489 case TT_OBJECT: return Q_TT_OBJECT; | |
| 490 case TT_HANDLER: return Q_TT_HANDLER; | |
| 491 case TT_OTYPE: return Q_TT_OTYPE; | |
| 492 case TT_ADDRESS_LAST: return Q_TT_ADDRESS_LAST; | |
| 493 default: return Qnil; | |
| 494 } | |
| 495 } | |
| 496 | |
| 497 static Lisp_Object | |
| 498 tt_state_symbol (Tt_state n) | |
| 499 { | |
| 500 switch (n) | |
| 501 { | |
| 502 case TT_CREATED: return Q_TT_CREATED; | |
| 503 case TT_SENT: return Q_TT_SENT; | |
| 504 case TT_HANDLED: return Q_TT_HANDLED; | |
| 505 case TT_FAILED: return Q_TT_FAILED; | |
| 506 case TT_QUEUED: return Q_TT_QUEUED; | |
| 507 case TT_STARTED: return Q_TT_STARTED; | |
| 508 case TT_REJECTED: return Q_TT_REJECTED; | |
| 509 case TT_STATE_LAST: return Q_TT_STATE_LAST; | |
| 510 default: return Qnil; | |
| 511 } | |
| 512 } | |
| 513 | |
| 514 static Lisp_Object | |
| 771 | 515 tt_build_c_string (char *s) |
| 428 | 516 { |
| 517 return build_string (s ? s : ""); | |
| 518 } | |
| 519 | |
| 520 static Lisp_Object | |
| 521 tt_opnum_string (int n) | |
| 522 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
523 Ascbyte buf[32]; |
| 428 | 524 |
| 525 sprintf (buf, "%u", n); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
526 return build_ascstring (buf); |
| 428 | 527 } |
| 528 | |
| 529 static Lisp_Object | |
| 530 tt_message_arg_ival_string (Tt_message m, int n) | |
| 531 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
532 Ascbyte buf[DECIMAL_PRINT_SIZE (long)]; |
| 428 | 533 int value; |
| 534 | |
| 535 check_status (tt_message_arg_ival (m, n, &value)); | |
| 536 long_to_string (buf, value); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
537 return build_ascstring (buf); |
| 428 | 538 } |
| 539 | |
| 540 static Lisp_Object | |
| 541 tt_message_arg_bval_vector (Tt_message m, int n) | |
| 542 { | |
| 543 /* !!#### This function has not been Mule-ized */ | |
| 867 | 544 Ibyte *value; |
| 428 | 545 int len = 0; |
| 546 | |
| 547 check_status (tt_message_arg_bval (m, n, &value, &len)); | |
| 548 | |
| 549 return make_string (value, len); | |
| 550 } | |
| 551 | |
| 552 DEFUN ("get-tooltalk-message-attribute", Fget_tooltalk_message_attribute, | |
| 553 2, 3, 0, /* | |
| 554 Return the indicated Tooltalk message attribute. Attributes are | |
| 555 identified by symbols with the same name (underscores and all) as the | |
| 556 suffix of the Tooltalk tt_message_<attribute> function that extracts the value. | |
| 557 String attribute values are copied, enumerated type values (except disposition) | |
| 3025 | 558 are converted to symbols - e.g. TT_HANDLER is `TT_HANDLER', uid and gid are |
| 428 | 559 represented by fixnums (small integers), opnum is converted to a string, |
| 560 and disposition is converted to a fixnum. We convert opnum (a C int) to a | |
| 561 string, e.g. 123 => "123" because there's no guarantee that opnums will fit | |
| 562 within the range of Lisp integers. | |
| 563 | |
| 3025 | 564 Use the `plist' attribute instead of the C API `user' attribute |
| 428 | 565 for user defined message data. To retrieve the value of a message property |
| 566 specify the indicator for argn. For example to get the value of a property | |
| 3025 | 567 called `rflag', use |
| 428 | 568 (get-tooltalk-message-attribute message 'plist 'rflag) |
| 569 | |
| 3025 | 570 To get the value of a message argument use one of the `arg_val' (strings), |
| 571 `arg_ival' (integers), or `arg_bval' (strings with embedded nulls), attributes. | |
| 428 | 572 For example to get the integer value of the third argument: |
| 573 | |
| 574 (get-tooltalk-message-attribute message 'arg_ival 2) | |
| 575 | |
| 576 As you can see, argument numbers are zero based. The type of each argument | |
| 3025 | 577 can be retrieved with the `arg_type' attribute; however, Tooltalk doesn't |
| 578 define any semantics for the string value of `arg_type'. Conventionally | |
| 428 | 579 "string" is used for strings and "int" for 32 bit integers. Note that |
| 580 Emacs Lisp stores the lengths of strings explicitly (unlike C) so treating the | |
| 3025 | 581 value returned by `arg_bval' like a string is fine. |
| 428 | 582 */ |
| 583 (message_, attribute, argn)) | |
| 584 { | |
| 585 Tt_message m = unbox_tooltalk_message (message_); | |
| 586 int n = 0; | |
| 587 | |
| 588 CHECK_SYMBOL (attribute); | |
| 589 if (EQ (attribute, (Qtt_arg_bval)) || | |
| 590 EQ (attribute, (Qtt_arg_ival)) || | |
| 591 EQ (attribute, (Qtt_arg_mode)) || | |
| 592 EQ (attribute, (Qtt_arg_type)) || | |
| 593 EQ (attribute, (Qtt_arg_val))) | |
| 594 { | |
| 595 CHECK_INT (argn); | |
| 596 n = XINT (argn); | |
| 597 } | |
| 598 | |
| 599 if (!VALID_TOOLTALK_MESSAGEP (m)) | |
| 600 return Qnil; | |
| 601 | |
| 602 else if (EQ (attribute, Qtt_arg_bval)) | |
| 603 return tt_message_arg_bval_vector (m, n); | |
| 604 | |
| 605 else if (EQ (attribute, Qtt_arg_ival)) | |
| 606 return tt_message_arg_ival_string (m, n); | |
| 607 | |
| 608 else if (EQ (attribute, Qtt_arg_mode)) | |
| 609 return tt_mode_symbol (tt_message_arg_mode (m, n)); | |
| 610 | |
| 611 else if (EQ (attribute, Qtt_arg_type)) | |
| 771 | 612 return tt_build_c_string (tt_message_arg_type (m, n)); |
| 428 | 613 |
| 614 else if (EQ (attribute, Qtt_arg_val)) | |
| 615 return tt_message_arg_bval_vector (m, n); | |
| 616 | |
| 617 else if (EQ (attribute, Qtt_args_count)) | |
| 618 return make_int (tt_message_args_count (m)); | |
| 619 | |
| 620 else if (EQ (attribute, Qtt_address)) | |
| 621 return tt_address_symbol (tt_message_address (m)); | |
| 622 | |
| 623 else if (EQ (attribute, Qtt_class)) | |
| 624 return tt_class_symbol (tt_message_class (m)); | |
| 625 | |
| 626 else if (EQ (attribute, Qtt_disposition)) | |
| 627 return make_int (tt_message_disposition (m)); | |
| 628 | |
| 629 else if (EQ (attribute, Qtt_file)) | |
| 771 | 630 return tt_build_c_string (tt_message_file (m)); |
| 428 | 631 |
| 632 else if (EQ (attribute, Qtt_gid)) | |
| 633 return make_int (tt_message_gid (m)); | |
| 634 | |
| 635 else if (EQ (attribute, Qtt_handler)) | |
| 771 | 636 return tt_build_c_string (tt_message_handler (m)); |
| 428 | 637 |
| 638 else if (EQ (attribute, Qtt_handler_ptype)) | |
| 771 | 639 return tt_build_c_string (tt_message_handler_ptype (m)); |
| 428 | 640 |
| 641 else if (EQ (attribute, Qtt_object)) | |
| 771 | 642 return tt_build_c_string (tt_message_object (m)); |
| 428 | 643 |
| 644 else if (EQ (attribute, Qtt_op)) | |
| 771 | 645 return tt_build_c_string (tt_message_op (m)); |
| 428 | 646 |
| 647 else if (EQ (attribute, Qtt_opnum)) | |
| 648 return tt_opnum_string (tt_message_opnum (m)); | |
| 649 | |
| 650 else if (EQ (attribute, Qtt_otype)) | |
| 771 | 651 return tt_build_c_string (tt_message_otype (m)); |
| 428 | 652 |
| 653 else if (EQ (attribute, Qtt_scope)) | |
| 654 return tt_scope_symbol (tt_message_scope (m)); | |
| 655 | |
| 656 else if (EQ (attribute, Qtt_sender)) | |
| 771 | 657 return tt_build_c_string (tt_message_sender (m)); |
| 428 | 658 |
| 659 else if (EQ (attribute, Qtt_sender_ptype)) | |
| 771 | 660 return tt_build_c_string (tt_message_sender_ptype (m)); |
| 428 | 661 |
| 662 else if (EQ (attribute, Qtt_session)) | |
| 771 | 663 return tt_build_c_string (tt_message_session (m)); |
| 428 | 664 |
| 665 else if (EQ (attribute, Qtt_state)) | |
| 666 return tt_state_symbol (tt_message_state (m)); | |
| 667 | |
| 668 else if (EQ (attribute, Qtt_status)) | |
| 669 return make_int (tt_message_status (m)); | |
| 670 | |
| 671 else if (EQ (attribute, Qtt_status_string)) | |
| 771 | 672 return tt_build_c_string (tt_message_status_string (m)); |
| 428 | 673 |
| 674 else if (EQ (attribute, Qtt_uid)) | |
| 675 return make_int (tt_message_uid (m)); | |
| 676 | |
| 677 else if (EQ (attribute, Qtt_callback)) | |
| 678 return XTOOLTALK_MESSAGE (message_)->callback; | |
| 679 | |
| 680 else if (EQ (attribute, Qtt_prop)) | |
| 681 return Fget (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, Qnil); | |
| 682 | |
| 683 else if (EQ (attribute, Qtt_plist)) | |
| 684 return Fcopy_sequence (Fsymbol_plist | |
| 685 (XTOOLTALK_MESSAGE (message_)->plist_sym)); | |
| 686 | |
| 687 else | |
| 563 | 688 invalid_constant ("Invalid value for `get-tooltalk-message-attribute'", |
| 428 | 689 attribute); |
| 690 | |
| 691 return Qnil; | |
| 692 } | |
| 693 | |
| 694 DEFUN ("set-tooltalk-message-attribute", Fset_tooltalk_message_attribute, | |
| 695 3, 4, 0, /* | |
| 696 Initialize one Tooltalk message attribute. | |
| 697 | |
| 698 Attribute names and values are the same as for | |
| 699 `get-tooltalk-message-attribute'. A property list is provided for user | |
| 3025 | 700 data (instead of the `user' message attribute); see |
| 428 | 701 `get-tooltalk-message-attribute'. |
| 702 | |
| 703 The value of callback should be the name of a function of one argument. | |
| 704 It will be applied to the message and matching pattern each time the state of the | |
| 705 message changes. This is usually used to notice when the messages state has | |
| 706 changed to TT_HANDLED (or TT_FAILED), so that reply argument values | |
| 707 can be used. | |
| 708 | |
| 3025 | 709 If one of the argument attributes is specified, `arg_val', `arg_ival', or |
| 710 `arg_bval' then argn must be the number of an already created argument. | |
| 428 | 711 New arguments can be added to a message with add-tooltalk-message-arg. |
| 712 */ | |
| 713 (value, message_, attribute, argn)) | |
| 714 { | |
| 715 Tt_message m = unbox_tooltalk_message (message_); | |
| 716 int n = 0; | |
| 440 | 717 Tt_status (*fun_str) (Tt_message, const char *) = 0; |
| 428 | 718 |
| 719 CHECK_SYMBOL (attribute); | |
| 440 | 720 |
| 428 | 721 if (EQ (attribute, (Qtt_arg_bval)) || |
| 722 EQ (attribute, (Qtt_arg_ival)) || | |
| 723 EQ (attribute, (Qtt_arg_val))) | |
| 724 { | |
| 725 CHECK_INT (argn); | |
| 726 n = XINT (argn); | |
| 727 } | |
| 728 | |
| 729 if (!VALID_TOOLTALK_MESSAGEP (m)) | |
| 730 return Qnil; | |
| 731 | |
| 440 | 732 if (EQ (attribute, Qtt_address)) |
| 428 | 733 { |
| 734 CHECK_TOOLTALK_CONSTANT (value); | |
| 735 tt_message_address_set (m, (Tt_address) tooltalk_constant_value (value)); | |
| 736 } | |
| 737 else if (EQ (attribute, Qtt_class)) | |
| 738 { | |
| 739 CHECK_TOOLTALK_CONSTANT (value); | |
| 740 tt_message_class_set (m, (Tt_class) tooltalk_constant_value (value)); | |
| 741 } | |
| 742 else if (EQ (attribute, Qtt_disposition)) | |
| 743 { | |
| 744 CHECK_TOOLTALK_CONSTANT (value); | |
| 745 tt_message_disposition_set (m, ((Tt_disposition) | |
| 746 tooltalk_constant_value (value))); | |
| 747 } | |
| 748 else if (EQ (attribute, Qtt_scope)) | |
| 749 { | |
| 750 CHECK_TOOLTALK_CONSTANT (value); | |
| 751 tt_message_scope_set (m, (Tt_scope) tooltalk_constant_value (value)); | |
| 752 } | |
| 440 | 753 else if (EQ (attribute, Qtt_file)) |
| 754 fun_str = tt_message_file_set; | |
| 755 else if (EQ (attribute, Qtt_handler_ptype)) | |
| 756 fun_str = tt_message_handler_ptype_set; | |
| 757 else if (EQ (attribute, Qtt_handler)) | |
| 758 fun_str = tt_message_handler_set; | |
| 759 else if (EQ (attribute, Qtt_object)) | |
| 760 fun_str = tt_message_object_set; | |
| 761 else if (EQ (attribute, Qtt_op)) | |
| 762 fun_str = tt_message_op_set; | |
| 763 else if (EQ (attribute, Qtt_otype)) | |
| 764 fun_str = tt_message_otype_set; | |
| 428 | 765 else if (EQ (attribute, Qtt_sender_ptype)) |
| 440 | 766 fun_str = tt_message_sender_ptype_set; |
| 428 | 767 else if (EQ (attribute, Qtt_session)) |
| 440 | 768 fun_str = tt_message_session_set; |
| 769 else if (EQ (attribute, Qtt_status_string)) | |
| 770 fun_str = tt_message_status_string_set; | |
| 428 | 771 else if (EQ (attribute, Qtt_arg_bval)) |
| 772 { | |
| 773 Extbyte *value_ext; | |
| 665 | 774 Bytecount value_ext_len; |
| 428 | 775 CHECK_STRING (value); |
| 440 | 776 TO_EXTERNAL_FORMAT (LISP_STRING, value, |
| 777 ALLOCA, (value_ext, value_ext_len), | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
778 Qtooltalk_encoding); |
| 444 | 779 tt_message_arg_bval_set (m, n, (unsigned char *) value_ext, value_ext_len); |
| 428 | 780 } |
| 781 else if (EQ (attribute, Qtt_arg_ival)) | |
| 782 { | |
| 783 CHECK_INT (value); | |
| 784 tt_message_arg_ival_set (m, n, XINT (value)); | |
| 785 } | |
| 786 else if (EQ (attribute, Qtt_arg_val)) | |
| 787 { | |
| 442 | 788 const char *value_ext; |
| 428 | 789 CHECK_STRING (value); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
790 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 428 | 791 tt_message_arg_val_set (m, n, value_ext); |
| 792 } | |
| 793 else if (EQ (attribute, Qtt_status)) | |
| 794 { | |
| 795 CHECK_INT (value); | |
| 796 tt_message_status_set (m, XINT (value)); | |
| 797 } | |
| 798 else if (EQ (attribute, Qtt_callback)) | |
| 799 { | |
| 800 CHECK_SYMBOL (value); | |
| 801 XTOOLTALK_MESSAGE (message_)->callback = value; | |
| 802 } | |
| 803 else if (EQ (attribute, Qtt_prop)) | |
| 804 { | |
| 805 return Fput (XTOOLTALK_MESSAGE (message_)->plist_sym, argn, value); | |
| 806 } | |
| 807 else | |
| 563 | 808 invalid_constant ("Invalid value for `set-tooltalk-message-attribute'", |
| 428 | 809 attribute); |
| 440 | 810 |
| 811 if (fun_str) | |
| 812 { | |
| 442 | 813 const char *value_ext; |
| 440 | 814 CHECK_STRING (value); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
815 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 440 | 816 (*fun_str) (m, value_ext); |
| 817 } | |
| 818 | |
| 428 | 819 return Qnil; |
| 820 } | |
| 821 | |
| 822 DEFUN ("return-tooltalk-message", Freturn_tooltalk_message, 1, 2, 0, /* | |
| 823 Send a reply to this message. The second argument can be | |
| 3025 | 824 `reply', `reject' or `fail'; the default is `reply'. Before sending |
| 428 | 825 a reply all message arguments whose mode is TT_INOUT or TT_OUT should |
| 826 have been filled in - see set-tooltalk-message-attribute. | |
| 827 */ | |
| 828 (message_, mode)) | |
| 829 { | |
| 830 Tt_message m = unbox_tooltalk_message (message_); | |
| 831 | |
| 832 if (NILP (mode)) | |
| 833 mode = Qtt_reply; | |
| 834 else | |
| 835 CHECK_SYMBOL (mode); | |
| 836 | |
| 837 if (!VALID_TOOLTALK_MESSAGEP (m)) | |
| 838 return Qnil; | |
| 839 else if (EQ (mode, Qtt_reply)) | |
| 840 tt_message_reply (m); | |
| 841 else if (EQ (mode, Qtt_reject)) | |
| 842 tt_message_reject (m); | |
| 843 else if (EQ (mode, Qtt_fail)) | |
| 844 tt_message_fail (m); | |
| 845 | |
| 846 return Qnil; | |
| 847 } | |
| 848 | |
| 849 DEFUN ("create-tooltalk-message", Fcreate_tooltalk_message, 0, 1, 0, /* | |
| 850 Create a new tooltalk message. | |
| 851 The messages session attribute is initialized to the default session. | |
| 852 Other attributes can be initialized with `set-tooltalk-message-attribute'. | |
| 853 `make-tooltalk-message' is the preferred to create and initialize a message. | |
| 854 | |
| 855 Optional arg NO-CALLBACK says don't add a C-level callback at all. | |
| 856 Normally don't do that; just don't specify the Lisp callback when | |
| 857 calling `make-tooltalk-message'. | |
| 858 */ | |
| 859 (no_callback)) | |
| 860 { | |
| 861 Tt_message m = tt_message_create (); | |
| 862 Lisp_Object message_ = make_tooltalk_message (m); | |
| 863 if (NILP (no_callback)) | |
| 864 { | |
| 865 tt_message_callback_add (m, tooltalk_message_callback); | |
| 866 } | |
| 867 tt_message_session_set (m, tt_default_session ()); | |
| 868 tt_message_user_set (m, TOOLTALK_MESSAGE_KEY, LISP_TO_VOID (message_)); | |
| 869 return message_; | |
| 870 } | |
| 871 | |
| 872 DEFUN ("destroy-tooltalk-message", Fdestroy_tooltalk_message, 1, 1, 0, /* | |
| 873 Apply tt_message_destroy() to the message. | |
| 874 It's not necessary to destroy messages after they've been processed by | |
| 875 a message or pattern callback; the Lisp/Tooltalk callback machinery does | |
| 876 this for you. | |
| 877 */ | |
| 878 (message_)) | |
| 879 { | |
| 880 Tt_message m = unbox_tooltalk_message (message_); | |
| 881 | |
| 882 if (VALID_TOOLTALK_MESSAGEP (m)) | |
| 883 /* #### Should we call Fremhash() here? It seems that | |
| 884 a common paradigm is | |
| 885 | |
| 886 (send-tooltalk-message) | |
| 887 (destroy-tooltalk-message) | |
| 888 | |
| 889 which would imply that destroying a sent ToolTalk message | |
| 890 doesn't actually destroy it; when a response is sent back, | |
| 891 the callback for the message will still be called. | |
| 892 | |
| 893 But then maybe not: Maybe it really does destroy it, | |
| 894 and the reason for that paradigm is that the author | |
| 895 of `send-tooltalk-message' didn't really know what he | |
| 896 was talking about when he said that it's a good idea | |
| 897 to call `destroy-tooltalk-message' after sending it. */ | |
| 898 tt_message_destroy (m); | |
| 899 | |
| 900 return Qnil; | |
| 901 } | |
| 902 | |
| 903 | |
| 904 DEFUN ("add-tooltalk-message-arg", Fadd_tooltalk_message_arg, 3, 4, 0, /* | |
| 905 Append one new argument to the message. | |
| 906 MODE must be one of TT_IN, TT_INOUT, or TT_OUT; VTYPE must be a string; | |
| 907 and VALUE can be a string or an integer. Tooltalk doesn't | |
| 908 define any semantics for VTYPE, so only the participants in the | |
| 909 protocol you're using need to agree what types mean (if anything). | |
| 910 Conventionally "string" is used for strings and "int" for 32 bit integers. | |
| 911 Arguments can initialized by providing a value or with | |
| 912 `set-tooltalk-message-attribute'. The latter is necessary if you | |
| 913 want to initialize the argument with a string that can contain | |
| 3025 | 914 embedded nulls (use `arg_bval'). |
| 428 | 915 */ |
| 916 (message_, mode, vtype, value)) | |
| 917 { | |
| 918 Tt_message m = unbox_tooltalk_message (message_); | |
| 919 Tt_mode n; | |
| 920 | |
| 921 CHECK_STRING (vtype); | |
| 922 CHECK_TOOLTALK_CONSTANT (mode); | |
| 923 | |
| 924 n = (Tt_mode) tooltalk_constant_value (mode); | |
| 925 | |
| 926 if (!VALID_TOOLTALK_MESSAGEP (m)) | |
| 927 return Qnil; | |
| 928 { | |
| 442 | 929 const char *vtype_ext; |
| 428 | 930 |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
931 LISP_STRING_TO_EXTERNAL (vtype, vtype_ext, Qtooltalk_encoding); |
| 428 | 932 if (NILP (value)) |
| 933 tt_message_arg_add (m, n, vtype_ext, NULL); | |
| 934 else if (STRINGP (value)) | |
| 935 { | |
| 442 | 936 const char *value_ext; |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
937 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 428 | 938 tt_message_arg_add (m, n, vtype_ext, value_ext); |
| 939 } | |
| 940 else if (INTP (value)) | |
| 941 tt_message_iarg_add (m, n, vtype_ext, XINT (value)); | |
| 942 } | |
| 943 | |
| 944 return Qnil; | |
| 945 } | |
| 946 | |
| 947 DEFUN ("send-tooltalk-message", Fsend_tooltalk_message, 1, 1, 0, /* | |
| 948 Send the message on its way. | |
| 949 Once the message has been sent it's almost always a good idea to get rid of | |
| 950 it with `destroy-tooltalk-message'. | |
| 951 */ | |
| 952 (message_)) | |
| 953 { | |
| 954 Tt_message m = unbox_tooltalk_message (message_); | |
| 955 | |
| 956 if (VALID_TOOLTALK_MESSAGEP (m)) | |
| 957 { | |
| 958 tt_message_send (m); | |
| 959 Fputhash (message_, Qnil, Vtooltalk_message_gcpro); | |
| 960 } | |
| 961 | |
| 962 return Qnil; | |
| 963 } | |
| 964 | |
| 965 DEFUN ("create-tooltalk-pattern", Fcreate_tooltalk_pattern, 0, 0, 0, /* | |
| 966 Create a new Tooltalk pattern. | |
| 967 Its session attribute is initialized to be the default session. | |
| 968 */ | |
| 969 ()) | |
| 970 { | |
| 971 Tt_pattern p = tt_pattern_create (); | |
| 972 Lisp_Object pattern = make_tooltalk_pattern (p); | |
| 973 | |
| 974 tt_pattern_callback_add (p, tooltalk_pattern_callback); | |
| 975 tt_pattern_session_add (p, tt_default_session ()); | |
| 976 tt_pattern_user_set (p, TOOLTALK_PATTERN_KEY, LISP_TO_VOID (pattern)); | |
| 977 | |
| 978 return pattern; | |
| 979 } | |
| 980 | |
| 981 | |
| 982 DEFUN ("destroy-tooltalk-pattern", Fdestroy_tooltalk_pattern, 1, 1, 0, /* | |
| 983 Apply tt_pattern_destroy() to the pattern. | |
| 984 This effectively unregisters the pattern. | |
| 985 */ | |
| 986 (pattern)) | |
| 987 { | |
| 988 Tt_pattern p = unbox_tooltalk_pattern (pattern); | |
| 989 | |
| 990 if (VALID_TOOLTALK_PATTERNP (p)) | |
| 991 { | |
| 992 tt_pattern_destroy (p); | |
| 993 Fremhash (pattern, Vtooltalk_pattern_gcpro); | |
| 994 } | |
| 995 | |
| 996 return Qnil; | |
| 997 } | |
| 998 | |
| 999 | |
| 1000 DEFUN ("add-tooltalk-pattern-attribute", Fadd_tooltalk_pattern_attribute, 3, 3, 0, /* | |
| 1001 Add one value to the indicated pattern attribute. | |
| 3025 | 1002 All Tooltalk pattern attributes are supported except `user'. The names |
| 428 | 1003 of attributes are the same as the Tooltalk accessors used to set them |
| 1004 less the "tooltalk_pattern_" prefix and the "_add" ... | |
| 1005 */ | |
| 1006 (value, pattern, attribute)) | |
| 1007 { | |
| 1008 Tt_pattern p = unbox_tooltalk_pattern (pattern); | |
| 1009 | |
| 1010 CHECK_SYMBOL (attribute); | |
| 1011 | |
| 1012 if (!VALID_TOOLTALK_PATTERNP (p)) | |
| 1013 return Qnil; | |
| 1014 | |
| 1015 else if (EQ (attribute, Qtt_category)) | |
| 1016 { | |
| 1017 CHECK_TOOLTALK_CONSTANT (value); | |
| 1018 tt_pattern_category_set (p, ((Tt_category) | |
| 1019 tooltalk_constant_value (value))); | |
| 1020 } | |
| 1021 else if (EQ (attribute, Qtt_address)) | |
| 1022 { | |
| 1023 CHECK_TOOLTALK_CONSTANT (value); | |
| 1024 tt_pattern_address_add (p, ((Tt_address) | |
| 1025 tooltalk_constant_value (value))); | |
| 1026 } | |
| 1027 else if (EQ (attribute, Qtt_class)) | |
| 1028 { | |
| 1029 CHECK_TOOLTALK_CONSTANT (value); | |
| 1030 tt_pattern_class_add (p, (Tt_class) tooltalk_constant_value (value)); | |
| 1031 } | |
| 1032 else if (EQ (attribute, Qtt_disposition)) | |
| 1033 { | |
| 1034 CHECK_TOOLTALK_CONSTANT (value); | |
| 1035 tt_pattern_disposition_add (p, ((Tt_disposition) | |
| 1036 tooltalk_constant_value (value))); | |
| 1037 } | |
| 1038 else if (EQ (attribute, Qtt_file)) | |
| 1039 { | |
| 442 | 1040 const char *value_ext; |
| 428 | 1041 CHECK_STRING (value); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1042 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 428 | 1043 tt_pattern_file_add (p, value_ext); |
| 1044 } | |
| 1045 else if (EQ (attribute, Qtt_object)) | |
| 1046 { | |
| 442 | 1047 const char *value_ext; |
| 428 | 1048 CHECK_STRING (value); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1049 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 428 | 1050 tt_pattern_object_add (p, value_ext); |
| 1051 } | |
| 1052 else if (EQ (attribute, Qtt_op)) | |
| 1053 { | |
| 442 | 1054 const char *value_ext; |
| 428 | 1055 CHECK_STRING (value); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1056 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 428 | 1057 tt_pattern_op_add (p, value_ext); |
| 1058 } | |
| 1059 else if (EQ (attribute, Qtt_otype)) | |
| 1060 { | |
| 442 | 1061 const char *value_ext; |
| 428 | 1062 CHECK_STRING (value); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1063 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 428 | 1064 tt_pattern_otype_add (p, value_ext); |
| 1065 } | |
| 1066 else if (EQ (attribute, Qtt_scope)) | |
| 1067 { | |
| 1068 CHECK_TOOLTALK_CONSTANT (value); | |
| 1069 tt_pattern_scope_add (p, (Tt_scope) tooltalk_constant_value (value)); | |
| 1070 } | |
| 1071 else if (EQ (attribute, Qtt_sender)) | |
| 1072 { | |
| 442 | 1073 const char *value_ext; |
| 428 | 1074 CHECK_STRING (value); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1075 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 428 | 1076 tt_pattern_sender_add (p, value_ext); |
| 1077 } | |
| 1078 else if (EQ (attribute, Qtt_sender_ptype)) | |
| 1079 { | |
| 442 | 1080 const char *value_ext; |
| 428 | 1081 CHECK_STRING (value); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1082 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 428 | 1083 tt_pattern_sender_ptype_add (p, value_ext); |
| 1084 } | |
| 1085 else if (EQ (attribute, Qtt_session)) | |
| 1086 { | |
| 442 | 1087 const char *value_ext; |
| 428 | 1088 CHECK_STRING (value); |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1089 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 428 | 1090 tt_pattern_session_add (p, value_ext); |
| 1091 } | |
| 1092 else if (EQ (attribute, Qtt_state)) | |
| 1093 { | |
| 1094 CHECK_TOOLTALK_CONSTANT (value); | |
| 1095 tt_pattern_state_add (p, (Tt_state) tooltalk_constant_value (value)); | |
| 1096 } | |
| 1097 else if (EQ (attribute, Qtt_callback)) | |
| 1098 { | |
| 1099 CHECK_SYMBOL (value); | |
| 1100 XTOOLTALK_PATTERN (pattern)->callback = value; | |
| 1101 } | |
| 1102 | |
| 1103 return Qnil; | |
| 1104 } | |
| 1105 | |
| 1106 | |
| 1107 DEFUN ("add-tooltalk-pattern-arg", Fadd_tooltalk_pattern_arg, 3, 4, 0, /* | |
| 1108 Add one fully specified argument to a tooltalk pattern. | |
| 1109 Mode must be one of TT_IN, TT_INOUT, or TT_OUT, type must be a string. | |
| 1110 Value can be an integer, string or nil. If value is an integer then | |
| 1111 an integer argument (tt_pattern_iarg_add) added otherwise a string argument | |
| 1112 is added. At present there's no way to add a binary data argument. | |
| 1113 */ | |
| 1114 (pattern, mode, vtype, value)) | |
| 1115 { | |
| 1116 Tt_pattern p = unbox_tooltalk_pattern (pattern); | |
| 1117 Tt_mode n; | |
| 1118 | |
| 1119 CHECK_STRING (vtype); | |
| 1120 CHECK_TOOLTALK_CONSTANT (mode); | |
| 1121 | |
| 1122 n = (Tt_mode) tooltalk_constant_value (mode); | |
| 1123 | |
| 1124 if (!VALID_TOOLTALK_PATTERNP (p)) | |
| 1125 return Qnil; | |
| 1126 | |
| 1127 { | |
| 442 | 1128 const char *vtype_ext; |
| 428 | 1129 |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1130 LISP_STRING_TO_EXTERNAL (vtype, vtype_ext, Qtooltalk_encoding); |
| 428 | 1131 if (NILP (value)) |
| 1132 tt_pattern_arg_add (p, n, vtype_ext, NULL); | |
| 1133 else if (STRINGP (value)) | |
| 1134 { | |
| 442 | 1135 const char *value_ext; |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1136 LISP_STRING_TO_EXTERNAL (value, value_ext, Qtooltalk_encoding); |
| 428 | 1137 tt_pattern_arg_add (p, n, vtype_ext, value_ext); |
| 1138 } | |
| 1139 else if (INTP (value)) | |
| 1140 tt_pattern_iarg_add (p, n, vtype_ext, XINT (value)); | |
| 1141 } | |
| 1142 | |
| 1143 return Qnil; | |
| 1144 } | |
| 1145 | |
| 1146 | |
| 1147 DEFUN ("register-tooltalk-pattern", Fregister_tooltalk_pattern, 1, 1, 0, /* | |
| 1148 Emacs will begin receiving messages that match this pattern. | |
| 1149 */ | |
| 1150 (pattern)) | |
| 1151 { | |
| 1152 Tt_pattern p = unbox_tooltalk_pattern (pattern); | |
| 1153 | |
| 1154 if (VALID_TOOLTALK_PATTERNP (p) && tt_pattern_register (p) == TT_OK) | |
| 1155 { | |
| 1156 Fputhash (pattern, Qnil, Vtooltalk_pattern_gcpro); | |
| 1157 return Qt; | |
| 1158 } | |
| 1159 else | |
| 1160 return Qnil; | |
| 1161 } | |
| 1162 | |
| 1163 | |
| 1164 DEFUN ("unregister-tooltalk-pattern", Funregister_tooltalk_pattern, 1, 1, 0, /* | |
| 1165 Emacs will stop receiving messages that match this pattern. | |
| 1166 */ | |
| 1167 (pattern)) | |
| 1168 { | |
| 1169 Tt_pattern p = unbox_tooltalk_pattern (pattern); | |
| 1170 | |
| 1171 if (VALID_TOOLTALK_PATTERNP (p)) | |
| 1172 { | |
| 1173 tt_pattern_unregister (p); | |
| 1174 Fremhash (pattern, Vtooltalk_pattern_gcpro); | |
| 1175 } | |
| 1176 | |
| 1177 return Qnil; | |
| 1178 } | |
| 1179 | |
| 1180 | |
| 1181 DEFUN ("tooltalk-pattern-prop-get", Ftooltalk_pattern_prop_get, 2, 2, 0, /* | |
| 1182 Return the value of PROPERTY in tooltalk pattern PATTERN. | |
| 1183 This is the last value set with `tooltalk-pattern-prop-set'. | |
| 1184 */ | |
| 1185 (pattern, property)) | |
| 1186 { | |
| 1187 CHECK_TOOLTALK_PATTERN (pattern); | |
| 1188 return Fget (XTOOLTALK_PATTERN (pattern)->plist_sym, property, Qnil); | |
| 1189 } | |
| 1190 | |
| 1191 | |
| 1192 DEFUN ("tooltalk-pattern-prop-set", Ftooltalk_pattern_prop_set, 3, 3, 0, /* | |
| 1193 Set the value of PROPERTY to VALUE in tooltalk pattern PATTERN. | |
| 1194 It can be retrieved with `tooltalk-pattern-prop-get'. | |
| 1195 */ | |
| 1196 (pattern, property, value)) | |
| 1197 { | |
| 1198 CHECK_TOOLTALK_PATTERN (pattern); | |
| 1199 return Fput (XTOOLTALK_PATTERN (pattern)->plist_sym, property, value); | |
| 1200 } | |
| 1201 | |
| 1202 | |
| 1203 DEFUN ("tooltalk-pattern-plist-get", Ftooltalk_pattern_plist_get, 1, 1, 0, /* | |
| 1204 Return the a list of all the properties currently set in PATTERN. | |
| 1205 */ | |
| 1206 (pattern)) | |
| 1207 { | |
| 1208 CHECK_TOOLTALK_PATTERN (pattern); | |
| 1209 return | |
| 1210 Fcopy_sequence (Fsymbol_plist (XTOOLTALK_PATTERN (pattern)->plist_sym)); | |
| 1211 } | |
| 1212 | |
| 1213 DEFUN ("tooltalk-default-procid", Ftooltalk_default_procid, 0, 0, 0, /* | |
| 1214 Return current default process identifier for your process. | |
| 1215 */ | |
| 1216 ()) | |
| 1217 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1218 Extbyte *procid = tt_default_procid (); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1219 return procid ? build_ext_string (procid, Qtooltalk_encoding) : Qnil; |
| 428 | 1220 } |
| 1221 | |
| 1222 DEFUN ("tooltalk-default-session", Ftooltalk_default_session, 0, 0, 0, /* | |
| 1223 Return current default session identifier for the current default procid. | |
| 1224 */ | |
| 1225 ()) | |
| 1226 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1227 Extbyte *session = tt_default_session (); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1228 return session ? build_ext_string (session, Qtooltalk_encoding) : Qnil; |
| 428 | 1229 } |
| 1230 | |
| 1231 static void | |
| 1232 init_tooltalk (void) | |
| 1233 { | |
| 1234 /* This function can GC */ | |
| 1235 char *retval; | |
| 1236 Lisp_Object lp; | |
| 1237 Lisp_Object fil; | |
| 1238 | |
| 1239 | |
| 440 | 1240 /* tt_open() messes with our signal handler flags (at least when no |
| 1241 ttsessions is running on the machine), therefore we save the | |
| 428 | 1242 actions and restore them after the call */ |
| 1243 #ifdef HAVE_SIGPROCMASK | |
| 1244 { | |
| 1245 struct sigaction ActSIGQUIT; | |
| 1246 struct sigaction ActSIGINT; | |
| 1247 struct sigaction ActSIGCHLD; | |
| 1248 sigaction (SIGQUIT, NULL, &ActSIGQUIT); | |
| 1249 sigaction (SIGINT, NULL, &ActSIGINT); | |
| 1250 sigaction (SIGCHLD, NULL, &ActSIGCHLD); | |
| 1251 #endif | |
| 1252 retval = tt_open (); | |
| 1253 #ifdef HAVE_SIGPROCMASK | |
| 1254 sigaction (SIGQUIT, &ActSIGQUIT, NULL); | |
| 1255 sigaction (SIGINT, &ActSIGINT, NULL); | |
| 1256 sigaction (SIGCHLD, &ActSIGCHLD, NULL); | |
| 1257 } | |
| 1258 #endif | |
| 1259 | |
| 1260 | |
| 1261 if (tt_ptr_error (retval) != TT_OK) | |
| 1262 return; | |
| 1263 | |
| 1264 Vtooltalk_fd = make_int (tt_fd ()); | |
| 1265 | |
| 1266 tt_session_join (tt_default_session ()); | |
| 1267 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1268 lp = connect_to_file_descriptor (build_ascstring ("tooltalk"), Qnil, |
| 428 | 1269 Vtooltalk_fd, Vtooltalk_fd); |
| 1270 if (!NILP (lp)) | |
| 1271 { | |
| 1272 /* Don't ask the user for confirmation when exiting Emacs */ | |
| 1273 Fprocess_kill_without_query (lp, Qnil); | |
| 2834 | 1274 fil = GET_DEFUN_LISP_OBJECT (Freceive_tooltalk_message); |
| 853 | 1275 set_process_filter (lp, fil, 1, 0); |
| 428 | 1276 } |
| 1277 else | |
| 1278 { | |
| 1279 tt_close (); | |
| 1280 Vtooltalk_fd = Qnil; | |
| 1281 return; | |
| 1282 } | |
| 1283 | |
| 1284 #if defined (SOLARIS2) | |
| 1285 /* Apparently the tt_message_send_on_exit() function does not exist | |
| 1286 under SunOS 4.x or IRIX 5 or various other non-Solaris-2 systems. | |
| 1287 No big deal if we don't do the following under those systems. */ | |
| 1288 { | |
| 1289 Tt_message exit_msg = tt_message_create (); | |
| 1290 | |
| 1291 tt_message_op_set (exit_msg, "emacs-aborted"); | |
| 1292 tt_message_scope_set (exit_msg, TT_SESSION); | |
| 1293 tt_message_class_set (exit_msg, TT_NOTICE); | |
| 1294 tt_message_send_on_exit (exit_msg); | |
| 1295 tt_message_destroy (exit_msg); | |
| 1296 } | |
| 1297 #endif | |
| 1298 } | |
| 1299 | |
| 1300 DEFUN ("tooltalk-open-connection", Ftooltalk_open_connection, 0, 0, 0, /* | |
| 1301 Opens a connection to the ToolTalk server. | |
| 1302 Returns t if successful, nil otherwise. | |
| 1303 */ | |
| 1304 ()) | |
| 1305 { | |
| 1306 if (!NILP (Vtooltalk_fd)) | |
| 563 | 1307 signal_error (Qio_error, "Already connected to ToolTalk", Qunbound); |
| 428 | 1308 if (noninteractive) |
| 563 | 1309 signal_error (Qio_error, "Can't connect to ToolTalk in batch mode", Qunbound); |
| 428 | 1310 init_tooltalk (); |
| 1311 return NILP (Vtooltalk_fd) ? Qnil : Qt; | |
| 1312 } | |
| 1313 | |
| 1314 | |
| 1315 void | |
| 1316 syms_of_tooltalk (void) | |
| 1317 { | |
| 442 | 1318 INIT_LRECORD_IMPLEMENTATION (tooltalk_message); |
| 1319 INIT_LRECORD_IMPLEMENTATION (tooltalk_pattern); | |
| 1320 | |
| 563 | 1321 DEFSYMBOL_MULTIWORD_PREDICATE (Qtooltalk_messagep); |
| 428 | 1322 DEFSUBR (Ftooltalk_message_p); |
| 563 | 1323 DEFSYMBOL_MULTIWORD_PREDICATE (Qtooltalk_patternp); |
| 428 | 1324 DEFSUBR (Ftooltalk_pattern_p); |
| 563 | 1325 DEFSYMBOL (Qtooltalk_message_handler_hook); |
| 1326 DEFSYMBOL (Qtooltalk_pattern_handler_hook); | |
| 1327 DEFSYMBOL (Qtooltalk_unprocessed_message_hook); | |
| 428 | 1328 |
| 1329 DEFSUBR (Freceive_tooltalk_message); | |
| 1330 DEFSUBR (Fcreate_tooltalk_message); | |
| 1331 DEFSUBR (Fdestroy_tooltalk_message); | |
| 1332 DEFSUBR (Fadd_tooltalk_message_arg); | |
| 1333 DEFSUBR (Fget_tooltalk_message_attribute); | |
| 1334 DEFSUBR (Fset_tooltalk_message_attribute); | |
| 1335 DEFSUBR (Fsend_tooltalk_message); | |
| 1336 DEFSUBR (Freturn_tooltalk_message); | |
| 1337 DEFSUBR (Fcreate_tooltalk_pattern); | |
| 1338 DEFSUBR (Fdestroy_tooltalk_pattern); | |
| 1339 DEFSUBR (Fadd_tooltalk_pattern_attribute); | |
| 1340 DEFSUBR (Fadd_tooltalk_pattern_arg); | |
| 1341 DEFSUBR (Fregister_tooltalk_pattern); | |
| 1342 DEFSUBR (Funregister_tooltalk_pattern); | |
| 1343 DEFSUBR (Ftooltalk_pattern_plist_get); | |
| 1344 DEFSUBR (Ftooltalk_pattern_prop_set); | |
| 1345 DEFSUBR (Ftooltalk_pattern_prop_get); | |
| 1346 DEFSUBR (Ftooltalk_default_procid); | |
| 1347 DEFSUBR (Ftooltalk_default_session); | |
| 1348 DEFSUBR (Ftooltalk_open_connection); | |
| 1349 | |
| 563 | 1350 DEFSYMBOL (Qreceive_tooltalk_message); |
| 428 | 1351 defsymbol (&Qtt_address, "address"); |
| 1352 defsymbol (&Qtt_args_count, "args_count"); | |
| 1353 defsymbol (&Qtt_arg_bval, "arg_bval"); | |
| 1354 defsymbol (&Qtt_arg_ival, "arg_ival"); | |
| 1355 defsymbol (&Qtt_arg_mode, "arg_mode"); | |
| 1356 defsymbol (&Qtt_arg_type, "arg_type"); | |
| 1357 defsymbol (&Qtt_arg_val, "arg_val"); | |
| 1358 defsymbol (&Qtt_class, "class"); | |
| 1359 defsymbol (&Qtt_category, "category"); | |
| 1360 defsymbol (&Qtt_disposition, "disposition"); | |
| 1361 defsymbol (&Qtt_file, "file"); | |
| 1362 defsymbol (&Qtt_gid, "gid"); | |
| 1363 defsymbol (&Qtt_handler, "handler"); | |
| 1364 defsymbol (&Qtt_handler_ptype, "handler_ptype"); | |
| 1365 defsymbol (&Qtt_object, "object"); | |
| 1366 defsymbol (&Qtt_op, "op"); | |
| 1367 defsymbol (&Qtt_opnum, "opnum"); | |
| 1368 defsymbol (&Qtt_otype, "otype"); | |
| 1369 defsymbol (&Qtt_scope, "scope"); | |
| 1370 defsymbol (&Qtt_sender, "sender"); | |
| 1371 defsymbol (&Qtt_sender_ptype, "sender_ptype"); | |
| 1372 defsymbol (&Qtt_session, "session"); | |
| 1373 defsymbol (&Qtt_state, "state"); | |
| 1374 defsymbol (&Qtt_status, "status"); | |
| 1375 defsymbol (&Qtt_status_string, "status_string"); | |
| 1376 defsymbol (&Qtt_uid, "uid"); | |
| 1377 defsymbol (&Qtt_callback, "callback"); | |
| 1378 defsymbol (&Qtt_prop, "prop"); | |
| 1379 defsymbol (&Qtt_plist, "plist"); | |
| 1380 defsymbol (&Qtt_reject, "reject"); | |
| 1381 defsymbol (&Qtt_reply, "reply"); | |
| 1382 defsymbol (&Qtt_fail, "fail"); | |
| 1383 | |
| 442 | 1384 DEFERROR (Qtooltalk_error, "ToolTalk error", Qio_error); |
| 428 | 1385 } |
| 1386 | |
| 1387 void | |
| 1388 vars_of_tooltalk (void) | |
| 1389 { | |
| 1390 Fprovide (intern ("tooltalk")); | |
| 1391 | |
| 1392 DEFVAR_LISP ("tooltalk-fd", &Vtooltalk_fd /* | |
| 1393 File descriptor returned by tt_initialize; nil if not connected to ToolTalk. | |
| 1394 */ ); | |
| 1395 Vtooltalk_fd = Qnil; | |
| 1396 | |
| 1397 DEFVAR_LISP ("tooltalk-message-handler-hook", | |
| 1398 &Vtooltalk_message_handler_hook /* | |
| 1399 List of functions to be applied to each ToolTalk message reply received. | |
| 1400 This will always occur as a result of our sending a request message. | |
| 1401 Functions will be called with two arguments, the message and the | |
| 1402 corresponding pattern. This hook will not be called if the request | |
| 1403 message was created without a C-level callback function (see | |
| 1404 `tooltalk-unprocessed-message-hook'). | |
| 1405 */ ); | |
| 1406 Vtooltalk_message_handler_hook = Qnil; | |
| 1407 | |
| 1408 DEFVAR_LISP ("tooltalk-pattern-handler-hook", | |
| 1409 &Vtooltalk_pattern_handler_hook /* | |
| 1410 List of functions to be applied to each pattern-matching ToolTalk message. | |
| 1411 This is all messages except those handled by `tooltalk-message-handler-hook'. | |
| 1412 Functions will be called with two arguments, the message and the | |
| 1413 corresponding pattern. | |
| 1414 */ ); | |
| 1415 Vtooltalk_pattern_handler_hook = Qnil; | |
| 1416 | |
| 1417 DEFVAR_LISP ("tooltalk-unprocessed-message-hook", | |
| 1418 &Vtooltalk_unprocessed_message_hook /* | |
| 1419 List of functions to be applied to each unprocessed ToolTalk message. | |
| 1420 Unprocessed messages are messages that didn't match any patterns. | |
| 1421 */ ); | |
| 1422 Vtooltalk_unprocessed_message_hook = Qnil; | |
| 1423 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1424 Tooltalk_Message_plist_str = build_defer_string ("Tooltalk Message plist"); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1425 Tooltalk_Pattern_plist_str = build_defer_string ("Tooltalk Pattern plist"); |
| 428 | 1426 |
| 1427 staticpro(&Tooltalk_Message_plist_str); | |
| 1428 staticpro(&Tooltalk_Pattern_plist_str); | |
| 1429 | |
| 1430 #define MAKE_CONSTANT(name) do { \ | |
| 1431 defsymbol (&Q_ ## name, #name); \ | |
| 1432 Fset (Q_ ## name, make_int (name)); \ | |
| 1433 } while (0) | |
| 1434 | |
| 1435 MAKE_CONSTANT (TT_MODE_UNDEFINED); | |
| 1436 MAKE_CONSTANT (TT_IN); | |
| 1437 MAKE_CONSTANT (TT_OUT); | |
| 1438 MAKE_CONSTANT (TT_INOUT); | |
| 1439 MAKE_CONSTANT (TT_MODE_LAST); | |
| 1440 | |
| 1441 MAKE_CONSTANT (TT_SCOPE_NONE); | |
| 1442 MAKE_CONSTANT (TT_SESSION); | |
| 1443 MAKE_CONSTANT (TT_FILE); | |
| 1444 MAKE_CONSTANT (TT_BOTH); | |
| 1445 MAKE_CONSTANT (TT_FILE_IN_SESSION); | |
| 1446 | |
| 1447 MAKE_CONSTANT (TT_CLASS_UNDEFINED); | |
| 1448 MAKE_CONSTANT (TT_NOTICE); | |
| 1449 MAKE_CONSTANT (TT_REQUEST); | |
| 1450 MAKE_CONSTANT (TT_CLASS_LAST); | |
| 1451 | |
| 1452 MAKE_CONSTANT (TT_CATEGORY_UNDEFINED); | |
| 1453 MAKE_CONSTANT (TT_OBSERVE); | |
| 1454 MAKE_CONSTANT (TT_HANDLE); | |
| 1455 MAKE_CONSTANT (TT_CATEGORY_LAST); | |
| 1456 | |
| 1457 MAKE_CONSTANT (TT_PROCEDURE); | |
| 1458 MAKE_CONSTANT (TT_OBJECT); | |
| 1459 MAKE_CONSTANT (TT_HANDLER); | |
| 1460 MAKE_CONSTANT (TT_OTYPE); | |
| 1461 MAKE_CONSTANT (TT_ADDRESS_LAST); | |
| 1462 | |
| 1463 MAKE_CONSTANT (TT_CREATED); | |
| 1464 MAKE_CONSTANT (TT_SENT); | |
| 1465 MAKE_CONSTANT (TT_HANDLED); | |
| 1466 MAKE_CONSTANT (TT_FAILED); | |
| 1467 MAKE_CONSTANT (TT_QUEUED); | |
| 1468 MAKE_CONSTANT (TT_STARTED); | |
| 1469 MAKE_CONSTANT (TT_REJECTED); | |
| 1470 MAKE_CONSTANT (TT_STATE_LAST); | |
| 1471 | |
| 1472 MAKE_CONSTANT (TT_DISCARD); | |
| 1473 MAKE_CONSTANT (TT_QUEUE); | |
| 1474 MAKE_CONSTANT (TT_START); | |
| 1475 | |
| 1476 #undef MAKE_CONSTANT | |
| 1477 | |
| 1478 staticpro (&Vtooltalk_message_gcpro); | |
| 1479 staticpro (&Vtooltalk_pattern_gcpro); | |
| 1480 Vtooltalk_message_gcpro = | |
| 1481 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 1482 Vtooltalk_pattern_gcpro = | |
| 1483 make_lisp_hash_table (10, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 1484 } |