Mercurial > hg > xemacs-beta
annotate src/file-coding.c @ 5127:a9c41067dd88 ben-lisp-object
more cleanups, terminology clarification, lots of doc work
-------------------- ChangeLog entries follow: --------------------
man/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* internals/internals.texi (Introduction to Allocation):
* internals/internals.texi (Integers and Characters):
* internals/internals.texi (Allocation from Frob Blocks):
* internals/internals.texi (lrecords):
* internals/internals.texi (Low-level allocation):
Rewrite section on allocation of Lisp objects to reflect the new
reality. Remove references to nonexistent XSETINT and XSETCHAR.
modules/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* postgresql/postgresql.c (allocate_pgconn):
* postgresql/postgresql.c (allocate_pgresult):
* postgresql/postgresql.h (struct Lisp_PGconn):
* postgresql/postgresql.h (struct Lisp_PGresult):
* ldap/eldap.c (allocate_ldap):
* ldap/eldap.h (struct Lisp_LDAP):
Same changes as in src/ dir. See large log there in ChangeLog,
but basically:
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
../hlo/src/ChangeLog addition:
2010-03-05 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (old_alloc_sized_lcrecord):
* alloc.c (very_old_free_lcrecord):
* alloc.c (copy_lisp_object):
* alloc.c (zero_sized_lisp_object):
* alloc.c (zero_nonsized_lisp_object):
* alloc.c (lisp_object_storage_size):
* alloc.c (free_normal_lisp_object):
* alloc.c (FREE_FIXED_TYPE_WHEN_NOT_IN_GC):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (Fcons):
* alloc.c (noseeum_cons):
* alloc.c (make_float):
* alloc.c (make_bignum):
* alloc.c (make_bignum_bg):
* alloc.c (make_ratio):
* alloc.c (make_ratio_bg):
* alloc.c (make_ratio_rt):
* alloc.c (make_bigfloat):
* alloc.c (make_bigfloat_bf):
* alloc.c (size_vector):
* alloc.c (make_compiled_function):
* alloc.c (Fmake_symbol):
* alloc.c (allocate_extent):
* alloc.c (allocate_event):
* alloc.c (make_key_data):
* alloc.c (make_button_data):
* alloc.c (make_motion_data):
* alloc.c (make_process_data):
* alloc.c (make_timeout_data):
* alloc.c (make_magic_data):
* alloc.c (make_magic_eval_data):
* alloc.c (make_eval_data):
* alloc.c (make_misc_user_data):
* alloc.c (Fmake_marker):
* alloc.c (noseeum_make_marker):
* alloc.c (size_string_direct_data):
* alloc.c (make_uninit_string):
* alloc.c (make_string_nocopy):
* alloc.c (mark_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* alloc.c (malloced_storage_size):
* buffer.c (allocate_buffer):
* buffer.c (compute_buffer_usage):
* buffer.c (DEFVAR_BUFFER_LOCAL_1):
* buffer.c (nuke_all_buffer_slots):
* buffer.c (common_init_complex_vars_of_buffer):
* buffer.h (struct buffer_text):
* buffer.h (struct buffer):
* bytecode.c:
* bytecode.c (make_compiled_function_args):
* bytecode.c (size_compiled_function_args):
* bytecode.h (struct compiled_function_args):
* casetab.c (allocate_case_table):
* casetab.h (struct Lisp_Case_Table):
* charset.h (struct Lisp_Charset):
* chartab.c (fill_char_table):
* chartab.c (Fmake_char_table):
* chartab.c (make_char_table_entry):
* chartab.c (copy_char_table_entry):
* chartab.c (Fcopy_char_table):
* chartab.c (put_char_table):
* chartab.h (struct Lisp_Char_Table_Entry):
* chartab.h (struct Lisp_Char_Table):
* console-gtk-impl.h (struct gtk_device):
* console-gtk-impl.h (struct gtk_frame):
* console-impl.h (struct console):
* console-msw-impl.h (struct Lisp_Devmode):
* console-msw-impl.h (struct mswindows_device):
* console-msw-impl.h (struct msprinter_device):
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (struct mswindows_dialog_id):
* console-stream-impl.h (struct stream_console):
* console-stream.c (stream_init_console):
* console-tty-impl.h (struct tty_console):
* console-tty-impl.h (struct tty_device):
* console-tty.c (allocate_tty_console_struct):
* console-x-impl.h (struct x_device):
* console-x-impl.h (struct x_frame):
* console.c (allocate_console):
* console.c (nuke_all_console_slots):
* console.c (DEFVAR_CONSOLE_LOCAL_1):
* console.c (common_init_complex_vars_of_console):
* data.c (make_weak_list):
* data.c (make_weak_box):
* data.c (make_ephemeron):
* database.c:
* database.c (struct Lisp_Database):
* database.c (allocate_database):
* database.c (finalize_database):
* device-gtk.c (allocate_gtk_device_struct):
* device-impl.h (struct device):
* device-msw.c:
* device-msw.c (mswindows_init_device):
* device-msw.c (msprinter_init_device):
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device-tty.c (allocate_tty_device_struct):
* device-x.c (allocate_x_device_struct):
* device.c:
* device.c (nuke_all_device_slots):
* device.c (allocate_device):
* dialog-msw.c (handle_question_dialog_box):
* elhash.c:
* elhash.c (struct Lisp_Hash_Table):
* elhash.c (finalize_hash_table):
* elhash.c (make_general_lisp_hash_table):
* elhash.c (Fcopy_hash_table):
* elhash.h (htentry):
* emacs.c (main_1):
* eval.c:
* eval.c (size_multiple_value):
* event-stream.c (finalize_command_builder):
* event-stream.c (allocate_command_builder):
* event-stream.c (free_command_builder):
* event-stream.c (event_stream_generate_wakeup):
* event-stream.c (event_stream_resignal_wakeup):
* event-stream.c (event_stream_disable_wakeup):
* event-stream.c (event_stream_wakeup_pending_p):
* events.h (struct Lisp_Timeout):
* events.h (struct command_builder):
* extents-impl.h:
* extents-impl.h (struct extent_auxiliary):
* extents-impl.h (struct extent_info):
* extents-impl.h (set_extent_no_chase_aux_field):
* extents-impl.h (set_extent_no_chase_normal_field):
* extents.c:
* extents.c (gap_array_marker):
* extents.c (gap_array):
* extents.c (extent_list_marker):
* extents.c (extent_list):
* extents.c (stack_of_extents):
* extents.c (gap_array_make_marker):
* extents.c (extent_list_make_marker):
* extents.c (allocate_extent_list):
* extents.c (SLOT):
* extents.c (mark_extent_auxiliary):
* extents.c (allocate_extent_auxiliary):
* extents.c (attach_extent_auxiliary):
* extents.c (size_gap_array):
* extents.c (finalize_extent_info):
* extents.c (allocate_extent_info):
* extents.c (uninit_buffer_extents):
* extents.c (allocate_soe):
* extents.c (copy_extent):
* extents.c (vars_of_extents):
* extents.h:
* faces.c (allocate_face):
* faces.h (struct Lisp_Face):
* faces.h (struct face_cachel):
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.c (sizeof_coding_system):
* file-coding.c (Fcopy_coding_system):
* file-coding.h (struct Lisp_Coding_System):
* file-coding.h (MARKED_SLOT):
* fns.c (size_bit_vector):
* font-mgr.c:
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (print_fc_pattern):
* font-mgr.c (Ffc_pattern_p):
* font-mgr.c (Ffc_pattern_create):
* font-mgr.c (Ffc_name_parse):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* font-mgr.c (Ffc_pattern_add):
* font-mgr.c (Ffc_pattern_del):
* font-mgr.c (Ffc_pattern_get):
* font-mgr.c (fc_config_create_using):
* font-mgr.c (fc_strlist_to_lisp_using):
* font-mgr.c (fontset_to_list):
* font-mgr.c (Ffc_config_p):
* font-mgr.c (Ffc_config_up_to_date):
* font-mgr.c (Ffc_config_build_fonts):
* font-mgr.c (Ffc_config_get_cache):
* font-mgr.c (Ffc_config_get_fonts):
* font-mgr.c (Ffc_config_set_current):
* font-mgr.c (Ffc_config_get_blanks):
* font-mgr.c (Ffc_config_get_rescan_interval):
* font-mgr.c (Ffc_config_set_rescan_interval):
* font-mgr.c (Ffc_config_app_font_add_file):
* font-mgr.c (Ffc_config_app_font_add_dir):
* font-mgr.c (Ffc_config_app_font_clear):
* font-mgr.c (size):
* font-mgr.c (Ffc_config_substitute):
* font-mgr.c (Ffc_font_render_prepare):
* font-mgr.c (Ffc_font_match):
* font-mgr.c (Ffc_font_sort):
* font-mgr.c (finalize_fc_config):
* font-mgr.c (print_fc_config):
* font-mgr.h:
* font-mgr.h (struct fc_pattern):
* font-mgr.h (XFC_PATTERN):
* font-mgr.h (struct fc_config):
* font-mgr.h (XFC_CONFIG):
* frame-gtk.c (allocate_gtk_frame_struct):
* frame-impl.h (struct frame):
* frame-msw.c (mswindows_init_frame_1):
* frame-x.c (allocate_x_frame_struct):
* frame.c (nuke_all_frame_slots):
* frame.c (allocate_frame_core):
* gc.c:
* gc.c (GC_CHECK_NOT_FREE):
* glyphs.c (finalize_image_instance):
* glyphs.c (allocate_image_instance):
* glyphs.c (Fcolorize_image_instance):
* glyphs.c (allocate_glyph):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* glyphs.c (register_ignored_expose):
* glyphs.h (struct Lisp_Image_Instance):
* glyphs.h (struct Lisp_Glyph):
* glyphs.h (struct glyph_cachel):
* glyphs.h (struct expose_ignore):
* gui.c (allocate_gui_item):
* gui.h (struct Lisp_Gui_Item):
* keymap.c (struct Lisp_Keymap):
* keymap.c (make_keymap):
* lisp.h:
* lisp.h (struct Lisp_String_Direct_Data):
* lisp.h (struct Lisp_String_Indirect_Data):
* lisp.h (struct Lisp_Vector):
* lisp.h (struct Lisp_Bit_Vector):
* lisp.h (DECLARE_INLINE_LISP_BIT_VECTOR):
* lisp.h (struct weak_box):
* lisp.h (struct ephemeron):
* lisp.h (struct weak_list):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (struct lcrecord_list):
* lstream.c (finalize_lstream):
* lstream.c (sizeof_lstream):
* lstream.c (Lstream_new):
* lstream.c (Lstream_delete):
* lstream.h (struct lstream):
* marker.c:
* marker.c (finalize_marker):
* marker.c (compute_buffer_marker_usage):
* mule-charset.c:
* mule-charset.c (make_charset):
* mule-charset.c (compute_charset_usage):
* objects-impl.h (struct Lisp_Color_Instance):
* objects-impl.h (struct Lisp_Font_Instance):
* objects-tty-impl.h (struct tty_color_instance_data):
* objects-tty-impl.h (struct tty_font_instance_data):
* objects-tty.c (tty_initialize_color_instance):
* objects-tty.c (tty_initialize_font_instance):
* objects.c (finalize_color_instance):
* objects.c (Fmake_color_instance):
* objects.c (finalize_font_instance):
* objects.c (Fmake_font_instance):
* objects.c (reinit_vars_of_objects):
* opaque.c:
* opaque.c (sizeof_opaque):
* opaque.c (make_opaque_ptr):
* opaque.c (free_opaque_ptr):
* opaque.h:
* opaque.h (Lisp_Opaque):
* opaque.h (Lisp_Opaque_Ptr):
* print.c (printing_unreadable_lcrecord):
* print.c (external_object_printer):
* print.c (debug_p4):
* process.c (finalize_process):
* process.c (make_process_internal):
* procimpl.h (struct Lisp_Process):
* rangetab.c (Fmake_range_table):
* rangetab.c (Fcopy_range_table):
* rangetab.h (struct Lisp_Range_Table):
* scrollbar.c:
* scrollbar.c (create_scrollbar_instance):
* scrollbar.c (compute_scrollbar_instance_usage):
* scrollbar.h (struct scrollbar_instance):
* specifier.c (finalize_specifier):
* specifier.c (sizeof_specifier):
* specifier.c (set_specifier_caching):
* specifier.h (struct Lisp_Specifier):
* specifier.h (struct specifier_caching):
* symeval.h:
* symeval.h (SYMBOL_VALUE_MAGIC_P):
* symeval.h (DEFVAR_SYMVAL_FWD):
* symsinit.h:
* syntax.c (init_buffer_syntax_cache):
* syntax.h (struct syntax_cache):
* toolbar.c:
* toolbar.c (allocate_toolbar_button):
* toolbar.c (update_toolbar_button):
* toolbar.h (struct toolbar_button):
* tooltalk.c (struct Lisp_Tooltalk_Message):
* tooltalk.c (make_tooltalk_message):
* tooltalk.c (struct Lisp_Tooltalk_Pattern):
* tooltalk.c (make_tooltalk_pattern):
* ui-gtk.c:
* ui-gtk.c (allocate_ffi_data):
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_object_data):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* ui-gtk.h:
* window-impl.h (struct window):
* window-impl.h (struct window_mirror):
* window.c (finalize_window):
* window.c (allocate_window):
* window.c (new_window_mirror):
* window.c (mark_window_as_deleted):
* window.c (make_dummy_parent):
* window.c (compute_window_mirror_usage):
* window.c (compute_window_usage):
Overall point of this change and previous ones in this repository:
(1) Introduce new, clearer terminology: everything other than int
or char is a "record" object, which comes in two types: "normal
objects" and "frob-block objects". Fix up all places that
referred to frob-block objects as "simple", "basic", etc.
(2) Provide an advertised interface for doing operations on Lisp
objects, including creating new types, that is clean and
consistent in its naming, uses the above-referenced terms and
avoids referencing "lrecords", "old lcrecords", etc., which should
hide under the surface.
(3) Make the size_in_bytes and finalizer methods take a
Lisp_Object rather than a void * for consistency with other methods.
(4) Separate finalizer method into finalizer and disksaver, so
that normal finalize methods don't have to worry about disksaving.
Other specifics:
(1) Renaming:
LISP_OBJECT_HEADER -> NORMAL_LISP_OBJECT_HEADER
ALLOC_LISP_OBJECT -> ALLOC_NORMAL_LISP_OBJECT
implementation->basic_p -> implementation->frob_block_p
ALLOCATE_FIXED_TYPE_AND_SET_IMPL -> ALLOC_FROB_BLOCK_LISP_OBJECT
*FCCONFIG*, wrap_fcconfig -> *FC_CONFIG*, wrap_fc_config
*FCPATTERN*, wrap_fcpattern -> *FC_PATTERN*, wrap_fc_pattern
(the last two changes make the naming of these macros consistent
with the naming of all other macros, since the objects are named
fc-config and fc-pattern with a hyphen)
(2) Lots of documentation fixes in lrecord.h.
(3) Eliminate macros for copying, freeing, zeroing objects, getting
their storage size. Instead, new functions:
zero_sized_lisp_object()
zero_nonsized_lisp_object()
lisp_object_storage_size()
free_normal_lisp_object()
(copy_lisp_object() already exists)
LISP_OBJECT_FROB_BLOCK_P() (actually a macro)
Eliminated:
free_lrecord()
zero_lrecord()
copy_lrecord()
copy_sized_lrecord()
old_copy_lcrecord()
old_copy_sized_lcrecord()
old_zero_lcrecord()
old_zero_sized_lcrecord()
LISP_OBJECT_STORAGE_SIZE()
COPY_SIZED_LISP_OBJECT()
COPY_SIZED_LCRECORD()
COPY_LISP_OBJECT()
ZERO_LISP_OBJECT()
FREE_LISP_OBJECT()
(4) Catch the remaining places where lrecord stuff was used directly
and use the advertised interface, e.g. alloc_sized_lrecord() ->
ALLOC_SIZED_LISP_OBJECT().
(5) Make certain statically-declared pseudo-objects
(buffer_local_flags, console_local_flags) have their lheader
initialized correctly, so things like copy_lisp_object() can work
on them. Make extent_auxiliary_defaults a proper heap object
Vextent_auxiliary_defaults, and make extent auxiliaries dumpable
so that this object can be dumped. allocate_extent_auxiliary()
now just creates the object, and attach_extent_auxiliary()
creates an extent auxiliary and attaches to an extent, like the
old allocate_extent_auxiliary().
(6) Create EXTENT_AUXILIARY_SLOTS macro, similar to the foo-slots.h
files but in a macro instead of a file. The purpose is to avoid
duplication when iterating over all the slots in an extent auxiliary.
Use it.
(7) In lstream.c, don't zero out object after allocation because
allocation routines take care of this.
(8) In marker.c, fix a mistake in computing marker overhead.
(9) In print.c, clean up printing_unreadable_lcrecord(),
external_object_printer() to avoid lots of ifdef NEW_GC's.
(10) Separate toolbar-button allocation into a separate
allocate_toolbar_button() function for use in the example code
in lrecord.h.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Fri, 05 Mar 2010 04:08:17 -0600 |
| parents | 2a462149bd6a |
| children | 7be849cb8828 |
| rev | line source |
|---|---|
| 771 | 1 /* Text encoding conversion functions; coding-system object. |
| 2 #### rename me to coding-system.c or coding.c | |
| 428 | 3 Copyright (C) 1991, 1995 Free Software Foundation, Inc. |
| 4 Copyright (C) 1995 Sun Microsystems, Inc. | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
5 Copyright (C) 2000, 2001, 2002, 2003, 2005, 2010 Ben Wing. |
| 428 | 6 |
| 7 This file is part of XEmacs. | |
| 8 | |
| 9 XEmacs is free software; you can redistribute it and/or modify it | |
| 10 under the terms of the GNU General Public License as published by the | |
| 11 Free Software Foundation; either version 2, or (at your option) any | |
| 12 later version. | |
| 13 | |
| 14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 17 for more details. | |
| 18 | |
| 19 You should have received a copy of the GNU General Public License | |
| 20 along with XEmacs; see the file COPYING. If not, write to | |
| 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 22 Boston, MA 02111-1307, USA. */ | |
| 23 | |
| 771 | 24 /* Synched up with: Not in FSF. */ |
| 25 | |
| 26 /* Authorship: | |
| 27 | |
| 28 Current primary author: Ben Wing <ben@xemacs.org> | |
| 29 | |
| 30 Rewritten by Ben Wing <ben@xemacs.org>, based originally on coding.c | |
| 31 from Mule 2.? but probably does not share one line of code with that | |
| 32 original source. Rewriting work started around Dec. 1994. or Jan. 1995. | |
| 33 Proceeded in earnest till Nov. 1995. | |
| 34 | |
| 35 Around Feb. 17, 1998, Andy Piper renamed what was then mule-coding.c to | |
| 36 file-coding.c, with the intention of using it to do end-of-line conversion | |
| 37 on non-MULE machines (specifically, on Windows machines). He separated | |
| 38 out the MULE stuff from non-MULE using ifdef's, and searched throughout | |
| 39 the rest of the source tree looking for coding-system-related code that | |
| 40 was ifdef MULE but should be ifdef HAVE_CODING_SYSTEMS. | |
| 41 | |
| 42 Sept. 4 - 8, 1998, Tomohiko Morioka added the UCS_4 and UTF_8 coding system | |
| 43 types, providing a primitive means of decoding and encoding externally- | |
| 44 formatted Unicode/UCS_4 and Unicode/UTF_8 data. | |
| 45 | |
| 46 January 25, 2000, Martin Buchholz redid and fleshed out the coding | |
| 47 system alias handling that was first added in prototype form by | |
| 48 Hrjove Niksic, April 15, 1999. | |
| 49 | |
| 50 April to May 2000, Ben Wing: More major reorganization. Adding features | |
| 51 needed for MS Windows (multibyte, unicode, unicode-to-multibyte), the | |
| 52 "chain" coding system for chaining two together, and doing a lot of | |
| 53 reorganization in preparation for properly abstracting out the different | |
| 54 coding system types. | |
| 55 | |
| 56 June 2001, Ben Wing: Added Unicode support. Eliminated previous | |
| 57 junky Unicode translation support. | |
| 58 | |
| 59 August 2001, Ben Wing: Moved Unicode support to unicode.c. Finished | |
| 60 abstracting everything except detection, which is hard to abstract (see | |
| 61 just below). | |
| 62 | |
| 63 September 2001, Ben Wing: Moved Mule code to mule-coding.c, Windows code | |
| 64 to intl-win32.c. Lots more rewriting; very little code is untouched | |
| 65 from before April 2000. Abstracted the detection code, added multiple | |
| 66 levels of likelihood to increase the reliability of the algorithm. | |
| 67 | |
| 68 October 2001, Ben Wing: HAVE_CODING_SYSTEMS is always now defined. | |
| 69 Removed the conditionals. | |
| 70 */ | |
| 71 | |
| 428 | 72 #include <config.h> |
| 73 #include "lisp.h" | |
| 74 | |
| 75 #include "buffer.h" | |
| 76 #include "elhash.h" | |
| 77 #include "insdel.h" | |
| 78 #include "lstream.h" | |
| 440 | 79 #include "opaque.h" |
| 771 | 80 #include "file-coding.h" |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
81 #include "extents.h" |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
82 #include "rangetab.h" |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
83 #include "chartab.h" |
| 771 | 84 |
| 85 #ifdef HAVE_ZLIB | |
| 86 #include "zlib.h" | |
| 428 | 87 #endif |
| 88 | |
| 89 Lisp_Object Vkeyboard_coding_system; | |
| 90 Lisp_Object Vterminal_coding_system; | |
| 91 Lisp_Object Vcoding_system_for_read; | |
| 92 Lisp_Object Vcoding_system_for_write; | |
| 93 Lisp_Object Vfile_name_coding_system; | |
| 94 | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
95 Lisp_Object Qaliases, Qcharset_skip_chars_string; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
96 |
| 771 | 97 #ifdef DEBUG_XEMACS |
| 98 Lisp_Object Vdebug_coding_detection; | |
| 440 | 99 #endif |
| 771 | 100 |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
101 #ifdef MULE |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
102 extern Lisp_Object Vcharset_ascii, Vcharset_control_1, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
103 Vcharset_latin_iso8859_1; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
104 #endif |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
105 |
| 771 | 106 typedef struct coding_system_type_entry |
| 107 { | |
| 108 struct coding_system_methods *meths; | |
| 109 } coding_system_type_entry; | |
| 110 | |
| 111 typedef struct | |
| 112 { | |
| 113 Dynarr_declare (coding_system_type_entry); | |
| 114 } coding_system_type_entry_dynarr; | |
| 115 | |
| 116 static coding_system_type_entry_dynarr *the_coding_system_type_entry_dynarr; | |
| 117 | |
| 1204 | 118 static const struct memory_description cste_description_1[] = { |
| 2551 | 119 { XD_BLOCK_PTR, offsetof (coding_system_type_entry, meths), 1, |
| 120 { &coding_system_methods_description } }, | |
| 771 | 121 { XD_END } |
| 122 }; | |
| 123 | |
| 1204 | 124 static const struct sized_memory_description cste_description = { |
| 771 | 125 sizeof (coding_system_type_entry), |
| 126 cste_description_1 | |
| 127 }; | |
| 128 | |
| 1204 | 129 static const struct memory_description csted_description_1[] = { |
| 771 | 130 XD_DYNARR_DESC (coding_system_type_entry_dynarr, &cste_description), |
| 428 | 131 { XD_END } |
| 132 }; | |
| 133 | |
| 1204 | 134 static const struct sized_memory_description csted_description = { |
| 771 | 135 sizeof (coding_system_type_entry_dynarr), |
| 136 csted_description_1 | |
| 137 }; | |
| 138 | |
| 139 static Lisp_Object Vcoding_system_type_list; | |
| 140 | |
| 141 /* Coding system currently associated with each coding category. */ | |
| 142 Lisp_Object coding_category_system[MAX_DETECTOR_CATEGORIES]; | |
| 143 | |
| 144 /* Table of all coding categories in decreasing order of priority. | |
| 145 This describes a permutation of the possible coding categories. */ | |
| 146 int coding_category_by_priority[MAX_DETECTOR_CATEGORIES]; | |
| 147 | |
| 148 /* Value used with to give a unique name to nameless coding systems */ | |
| 149 int coding_system_tick; | |
| 150 | |
| 151 int coding_detector_count; | |
| 152 int coding_detector_category_count; | |
| 153 | |
| 154 detector_dynarr *all_coding_detectors; | |
| 155 | |
| 1204 | 156 static const struct memory_description struct_detector_category_description_1[] |
| 771 | 157 = |
| 158 { | |
| 159 { XD_LISP_OBJECT, offsetof (struct detector_category, sym) }, | |
| 160 { XD_END } | |
| 161 }; | |
| 162 | |
| 1204 | 163 static const struct sized_memory_description struct_detector_category_description = |
| 771 | 164 { |
| 165 sizeof (struct detector_category), | |
| 166 struct_detector_category_description_1 | |
| 428 | 167 }; |
| 168 | |
| 1204 | 169 static const struct memory_description detector_category_dynarr_description_1[] = |
| 771 | 170 { |
| 171 XD_DYNARR_DESC (detector_category_dynarr, | |
| 172 &struct_detector_category_description), | |
| 173 { XD_END } | |
| 174 }; | |
| 175 | |
| 1204 | 176 static const struct sized_memory_description detector_category_dynarr_description = { |
| 771 | 177 sizeof (detector_category_dynarr), |
| 178 detector_category_dynarr_description_1 | |
| 179 }; | |
| 180 | |
| 1204 | 181 static const struct memory_description struct_detector_description_1[] |
| 771 | 182 = |
| 183 { | |
| 2367 | 184 { XD_BLOCK_PTR, offsetof (struct detector, cats), 1, |
| 2551 | 185 { &detector_category_dynarr_description } }, |
| 771 | 186 { XD_END } |
| 187 }; | |
| 188 | |
| 1204 | 189 static const struct sized_memory_description struct_detector_description = |
| 771 | 190 { |
| 191 sizeof (struct detector), | |
| 192 struct_detector_description_1 | |
| 193 }; | |
| 194 | |
| 1204 | 195 static const struct memory_description detector_dynarr_description_1[] = |
| 771 | 196 { |
| 197 XD_DYNARR_DESC (detector_dynarr, &struct_detector_description), | |
| 198 { XD_END } | |
| 199 }; | |
| 200 | |
| 1204 | 201 static const struct sized_memory_description detector_dynarr_description = { |
| 771 | 202 sizeof (detector_dynarr), |
| 203 detector_dynarr_description_1 | |
| 204 }; | |
| 428 | 205 |
| 206 Lisp_Object Qcoding_systemp; | |
| 207 | |
| 771 | 208 Lisp_Object Qraw_text; |
| 428 | 209 |
| 210 Lisp_Object Qmnemonic, Qeol_type; | |
| 211 Lisp_Object Qcr, Qcrlf, Qlf; | |
| 212 Lisp_Object Qeol_cr, Qeol_crlf, Qeol_lf; | |
| 213 Lisp_Object Qpost_read_conversion; | |
| 214 Lisp_Object Qpre_write_conversion; | |
| 215 | |
| 771 | 216 Lisp_Object Qtranslation_table_for_decode; |
| 217 Lisp_Object Qtranslation_table_for_encode; | |
| 218 Lisp_Object Qsafe_chars; | |
| 219 Lisp_Object Qsafe_charsets; | |
| 220 Lisp_Object Qmime_charset; | |
| 221 Lisp_Object Qvalid_codes; | |
| 222 | |
| 223 Lisp_Object Qno_conversion; | |
| 224 Lisp_Object Qconvert_eol; | |
| 440 | 225 Lisp_Object Qescape_quoted; |
| 771 | 226 Lisp_Object Qencode, Qdecode; |
| 227 | |
| 228 Lisp_Object Qconvert_eol_lf, Qconvert_eol_cr, Qconvert_eol_crlf; | |
| 229 Lisp_Object Qconvert_eol_autodetect; | |
| 230 | |
| 231 Lisp_Object Qnear_certainty, Qquite_probable, Qsomewhat_likely; | |
| 1494 | 232 Lisp_Object Qslightly_likely; |
| 771 | 233 Lisp_Object Qas_likely_as_unlikely, Qsomewhat_unlikely, Qquite_improbable; |
| 234 Lisp_Object Qnearly_impossible; | |
| 235 | |
| 236 Lisp_Object Qdo_eol, Qdo_coding; | |
| 237 | |
| 238 Lisp_Object Qcanonicalize_after_coding; | |
| 239 | |
| 1347 | 240 Lisp_Object QScoding_system_cookie; |
| 241 | |
| 4303 | 242 Lisp_Object Qposix_charset_to_coding_system_hash; |
| 243 | |
| 771 | 244 /* This is used to convert autodetected coding systems into existing |
| 245 systems. For example, the chain undecided->convert-eol-autodetect may | |
| 246 have its separate parts detected as mswindows-multibyte and | |
| 247 convert-eol-crlf, and the result needs to be mapped to | |
| 248 mswindows-multibyte-dos. */ | |
| 249 /* #### It's not clear we need this whole chain-canonicalize mechanism | |
| 250 any more. */ | |
| 251 static Lisp_Object Vchain_canonicalize_hash_table; | |
| 252 | |
| 253 #ifdef HAVE_ZLIB | |
| 254 Lisp_Object Qgzip; | |
| 428 | 255 #endif |
| 771 | 256 |
| 2297 | 257 /* Maps symbols (coding system names) to either coding system objects or |
| 258 (for aliases) other names. */ | |
| 771 | 259 static Lisp_Object Vcoding_system_hash_table; |
| 428 | 260 |
| 261 int enable_multibyte_characters; | |
| 262 | |
| 263 EXFUN (Fcopy_coding_system, 2); | |
| 264 | |
| 265 | |
| 266 /************************************************************************/ | |
| 771 | 267 /* Coding system object methods */ |
| 428 | 268 /************************************************************************/ |
| 269 | |
| 270 static Lisp_Object | |
| 271 mark_coding_system (Lisp_Object obj) | |
| 272 { | |
| 273 Lisp_Coding_System *codesys = XCODING_SYSTEM (obj); | |
| 274 | |
| 1204 | 275 #define MARKED_SLOT(x) mark_object (codesys->x); |
| 276 #include "coding-system-slots.h" | |
| 771 | 277 |
| 278 MAYBE_CODESYSMETH (codesys, mark, (obj)); | |
| 428 | 279 |
| 1204 | 280 return Qnil; |
| 428 | 281 } |
| 282 | |
| 283 static void | |
| 771 | 284 print_coding_system_properties (Lisp_Object obj, Lisp_Object printcharfun) |
| 285 { | |
| 286 Lisp_Coding_System *c = XCODING_SYSTEM (obj); | |
| 287 print_internal (c->methods->type, printcharfun, 1); | |
| 288 MAYBE_CODESYSMETH (c, print, (obj, printcharfun, 1)); | |
| 289 if (CODING_SYSTEM_EOL_TYPE (c) != EOL_AUTODETECT) | |
| 290 write_fmt_string_lisp (printcharfun, " eol-type=%s", | |
| 291 1, Fcoding_system_property (obj, Qeol_type)); | |
| 292 } | |
| 293 | |
| 294 static void | |
| 428 | 295 print_coding_system (Lisp_Object obj, Lisp_Object printcharfun, |
| 2286 | 296 int UNUSED (escapeflag)) |
| 428 | 297 { |
| 298 Lisp_Coding_System *c = XCODING_SYSTEM (obj); | |
| 299 if (print_readably) | |
| 4846 | 300 printing_unreadable_lcrecord (obj, 0); |
| 771 | 301 |
| 302 write_fmt_string_lisp (printcharfun, "#<coding-system %s ", 1, c->name); | |
| 303 print_coding_system_properties (obj, printcharfun); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
304 write_ascstring (printcharfun, ">"); |
| 428 | 305 } |
| 306 | |
| 771 | 307 /* Print an abbreviated version of a coding system (but still containing |
| 308 all the information), for use within a coding system print method. */ | |
| 309 | |
| 310 static void | |
| 311 print_coding_system_in_print_method (Lisp_Object cs, Lisp_Object printcharfun, | |
| 2286 | 312 int UNUSED (escapeflag)) |
| 771 | 313 { |
| 800 | 314 write_fmt_string_lisp (printcharfun, "%s[", 1, XCODING_SYSTEM_NAME (cs)); |
| 771 | 315 print_coding_system_properties (cs, printcharfun); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
316 write_ascstring (printcharfun, "]"); |
| 771 | 317 } |
| 318 | |
| 3263 | 319 #ifndef NEW_GC |
| 428 | 320 static void |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
321 finalize_coding_system (Lisp_Object obj) |
| 428 | 322 { |
| 323 /* Since coding systems never go away, this function is not | |
| 324 necessary. But it would be necessary if we changed things | |
| 325 so that coding systems could go away. */ | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
326 MAYBE_XCODESYSMETH (obj, finalize, (obj)); |
| 771 | 327 } |
| 3263 | 328 #endif /* not NEW_GC */ |
| 771 | 329 |
| 330 static Bytecount | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
331 sizeof_coding_system (Lisp_Object obj) |
| 771 | 332 { |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
333 const Lisp_Coding_System *p = XCODING_SYSTEM (obj); |
| 771 | 334 return offsetof (Lisp_Coding_System, data) + p->methods->extra_data_size; |
| 428 | 335 } |
| 336 | |
| 1204 | 337 static const struct memory_description coding_system_methods_description_1[] |
| 771 | 338 = { |
| 339 { XD_LISP_OBJECT, | |
| 340 offsetof (struct coding_system_methods, type) }, | |
| 341 { XD_LISP_OBJECT, | |
| 342 offsetof (struct coding_system_methods, predicate_symbol) }, | |
| 343 { XD_END } | |
| 344 }; | |
| 345 | |
| 1204 | 346 const struct sized_memory_description coding_system_methods_description = { |
| 771 | 347 sizeof (struct coding_system_methods), |
| 348 coding_system_methods_description_1 | |
| 349 }; | |
| 350 | |
| 1204 | 351 static const struct sized_memory_description coding_system_extra_description_map[] = |
| 352 { | |
| 353 { offsetof (Lisp_Coding_System, methods) }, | |
| 354 { offsetof (struct coding_system_methods, extra_description) }, | |
| 355 { -1 }, | |
| 771 | 356 }; |
| 357 | |
| 1204 | 358 static const struct memory_description coding_system_description[] = |
| 428 | 359 { |
| 2367 | 360 { XD_BLOCK_PTR, offsetof (Lisp_Coding_System, methods), 1, |
| 2551 | 361 { &coding_system_methods_description } }, |
| 1204 | 362 #define MARKED_SLOT(x) { XD_LISP_OBJECT, offsetof (Lisp_Coding_System, x) }, |
| 363 #define MARKED_SLOT_ARRAY(slot, size) \ | |
| 364 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Coding_System, slot), size }, | |
| 365 #include "coding-system-slots.h" | |
| 2367 | 366 { XD_BLOCK_ARRAY, offsetof (Lisp_Coding_System, data), 1, |
| 2551 | 367 { coding_system_extra_description_map } }, |
| 1204 | 368 { XD_END } |
| 771 | 369 }; |
| 370 | |
| 1204 | 371 static const struct memory_description coding_system_empty_extra_description_1[] = |
| 372 { | |
| 373 { XD_END } | |
| 374 }; | |
| 375 | |
| 376 const struct sized_memory_description coding_system_empty_extra_description = { | |
| 377 0, coding_system_empty_extra_description_1 | |
| 378 }; | |
| 379 | |
| 3263 | 380 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
381 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("coding-system", coding_system, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
382 mark_coding_system, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
383 print_coding_system, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
384 0, 0, 0, coding_system_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
385 sizeof_coding_system, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
386 Lisp_Coding_System); |
| 3263 | 387 #else /* not NEW_GC */ |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
388 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("coding-system", coding_system, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
389 mark_coding_system, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
390 print_coding_system, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
391 finalize_coding_system, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
392 0, 0, coding_system_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
393 sizeof_coding_system, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
394 Lisp_Coding_System); |
| 3263 | 395 #endif /* not NEW_GC */ |
| 771 | 396 |
| 397 /************************************************************************/ | |
| 398 /* Creating coding systems */ | |
| 399 /************************************************************************/ | |
| 400 | |
| 401 static struct coding_system_methods * | |
| 402 decode_coding_system_type (Lisp_Object type, Error_Behavior errb) | |
| 428 | 403 { |
| 771 | 404 int i; |
| 405 | |
| 406 for (i = 0; i < Dynarr_length (the_coding_system_type_entry_dynarr); i++) | |
| 428 | 407 { |
| 771 | 408 if (EQ (type, |
| 409 Dynarr_at (the_coding_system_type_entry_dynarr, i).meths->type)) | |
| 410 return Dynarr_at (the_coding_system_type_entry_dynarr, i).meths; | |
| 428 | 411 } |
| 771 | 412 |
| 413 maybe_invalid_constant ("Invalid coding system type", type, | |
| 414 Qcoding_system, errb); | |
| 415 | |
| 416 return 0; | |
| 428 | 417 } |
| 418 | |
| 771 | 419 static int |
| 420 valid_coding_system_type_p (Lisp_Object type) | |
| 428 | 421 { |
| 771 | 422 return decode_coding_system_type (type, ERROR_ME_NOT) != 0; |
| 423 } | |
| 424 | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
425 #ifdef MULE |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
426 static Lisp_Object Vdefault_query_coding_region_chartab_cache; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
427 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
428 /* Non-static because it's used in INITIALIZE_CODING_SYSTEM_TYPE_WITH_DATA. */ |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
429 Lisp_Object |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
430 default_query_method (Lisp_Object codesys, struct buffer *buf, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
431 Charbpos end, int flags) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
432 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
433 Charbpos pos = BUF_PT (buf), fail_range_start, fail_range_end; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
434 Charbpos pos_byte = BYTE_BUF_PT (buf); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
435 Lisp_Object safe_charsets = XCODING_SYSTEM_SAFE_CHARSETS (codesys); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
436 Lisp_Object safe_chars = XCODING_SYSTEM_SAFE_CHARS (codesys), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
437 result = Qnil; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
438 enum query_coding_failure_reasons failed_reason, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
439 previous_failed_reason = query_coding_succeeded; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
440 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
441 /* safe-charsets of t means the coding system can encode everything. */ |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
442 if (EQ (Qnil, safe_chars)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
443 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
444 if (EQ (Qt, safe_charsets)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
445 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
446 return Qnil; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
447 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
448 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
449 /* If we've no information on what characters the coding system can |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
450 encode, give up. */ |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
451 if (EQ (Qnil, safe_charsets) && EQ (Qnil, safe_chars)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
452 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
453 return Qunbound; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
454 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
455 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
456 safe_chars = Fgethash (safe_charsets, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
457 Vdefault_query_coding_region_chartab_cache, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
458 Qnil); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
459 if (NILP (safe_chars)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
460 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
461 safe_chars = Fmake_char_table (Qgeneric); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
462 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
463 EXTERNAL_LIST_LOOP_2 (safe_charset, safe_charsets) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
464 Fput_char_table (safe_charset, Qt, safe_chars); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
465 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
466 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
467 Fputhash (safe_charsets, safe_chars, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
468 Vdefault_query_coding_region_chartab_cache); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
469 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
470 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
471 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
472 if (flags & QUERY_METHOD_HIGHLIGHT && |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
473 /* If we're being called really early, live without highlights getting |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
474 cleared properly: */ |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
475 !(UNBOUNDP (XSYMBOL (Qquery_coding_clear_highlights)->function))) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
476 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
477 /* It's okay to call Lisp here, the only non-stack object we may have |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
478 allocated up to this point is safe_chars, and that's |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
479 reachable from its entry in |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
480 Vdefault_query_coding_region_chartab_cache */ |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
481 call3 (Qquery_coding_clear_highlights, make_int (pos), make_int (end), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
482 wrap_buffer (buf)); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
483 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
484 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
485 while (pos < end) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
486 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
487 Ichar ch = BYTE_BUF_FETCH_CHAR (buf, pos_byte); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
488 if (!EQ (Qnil, get_char_table (ch, safe_chars))) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
489 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
490 pos++; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
491 INC_BYTEBPOS (buf, pos_byte); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
492 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
493 else |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
494 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
495 fail_range_start = pos; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
496 while ((pos < end) && |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
497 (EQ (Qnil, get_char_table (ch, safe_chars)) |
|
4839
5f1c6ca4d05e
fix bad change to default_query_method, rewrite conditional for more correctness
Ben Wing <ben@xemacs.org>
parents:
4830
diff
changeset
|
498 && (failed_reason = query_coding_unencodable, |
|
5f1c6ca4d05e
fix bad change to default_query_method, rewrite conditional for more correctness
Ben Wing <ben@xemacs.org>
parents:
4830
diff
changeset
|
499 (previous_failed_reason == query_coding_succeeded |
|
5f1c6ca4d05e
fix bad change to default_query_method, rewrite conditional for more correctness
Ben Wing <ben@xemacs.org>
parents:
4830
diff
changeset
|
500 || previous_failed_reason == failed_reason)))) |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
501 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
502 pos++; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
503 INC_BYTEBPOS (buf, pos_byte); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
504 ch = BYTE_BUF_FETCH_CHAR (buf, pos_byte); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
505 previous_failed_reason = failed_reason; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
506 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
507 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
508 if (fail_range_start == pos) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
509 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
510 /* The character can actually be encoded; move on. */ |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
511 pos++; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
512 INC_BYTEBPOS (buf, pos_byte); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
513 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
514 else |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
515 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
516 assert (previous_failed_reason == query_coding_unencodable); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
517 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
518 if (flags & QUERY_METHOD_ERRORP) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
519 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
520 signal_error_2 |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
521 (Qtext_conversion_error, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
522 "Cannot encode using coding system", |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
523 make_string_from_buffer (buf, fail_range_start, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
524 pos - fail_range_start), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
525 XCODING_SYSTEM_NAME (codesys)); |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
526 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
527 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
528 if (NILP (result)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
529 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
530 result = Fmake_range_table (Qstart_closed_end_open); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
531 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
532 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
533 fail_range_end = pos; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
534 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
535 Fput_range_table (make_int (fail_range_start), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
536 make_int (fail_range_end), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
537 Qunencodable, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
538 result); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
539 previous_failed_reason = query_coding_succeeded; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
540 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
541 if (flags & QUERY_METHOD_HIGHLIGHT) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
542 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
543 Lisp_Object extent |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
544 = Fmake_extent (make_int (fail_range_start), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
545 make_int (fail_range_end), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
546 wrap_buffer (buf)); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
547 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
548 Fset_extent_priority |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
549 (extent, make_int (2 + mouse_highlight_priority)); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
550 Fset_extent_face (extent, Qquery_coding_warning_face); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
551 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
552 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
553 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
554 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
555 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
556 return result; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
557 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
558 #else |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
559 Lisp_Object |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
560 default_query_method (Lisp_Object UNUSED (codesys), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
561 struct buffer * UNUSED (buf), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
562 Charbpos UNUSED (end), int UNUSED (flags)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
563 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
564 return Qnil; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
565 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
566 #endif /* defined MULE */ |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
567 |
| 771 | 568 DEFUN ("valid-coding-system-type-p", Fvalid_coding_system_type_p, 1, 1, 0, /* |
| 569 Given a CODING-SYSTEM-TYPE, return non-nil if it is valid. | |
| 570 Valid types depend on how XEmacs was compiled but may include | |
| 3025 | 571 `undecided', `chain', `integer', `ccl', `iso2022', `big5', `shift-jis', |
| 572 `utf-16', `ucs-4', `utf-8', etc. | |
| 771 | 573 */ |
| 574 (coding_system_type)) | |
| 575 { | |
| 576 return valid_coding_system_type_p (coding_system_type) ? Qt : Qnil; | |
| 577 } | |
| 578 | |
| 579 DEFUN ("coding-system-type-list", Fcoding_system_type_list, 0, 0, 0, /* | |
| 580 Return a list of valid coding system types. | |
| 581 */ | |
| 582 ()) | |
| 583 { | |
| 584 return Fcopy_sequence (Vcoding_system_type_list); | |
| 585 } | |
| 586 | |
| 587 void | |
| 588 add_entry_to_coding_system_type_list (struct coding_system_methods *meths) | |
| 589 { | |
| 590 struct coding_system_type_entry entry; | |
| 591 | |
| 592 entry.meths = meths; | |
| 593 Dynarr_add (the_coding_system_type_entry_dynarr, entry); | |
| 594 Vcoding_system_type_list = Fcons (meths->type, Vcoding_system_type_list); | |
| 428 | 595 } |
| 596 | |
| 597 DEFUN ("coding-system-p", Fcoding_system_p, 1, 1, 0, /* | |
| 598 Return t if OBJECT is a coding system. | |
| 599 A coding system is an object that defines how text containing multiple | |
| 600 character sets is encoded into a stream of (typically 8-bit) bytes. | |
| 601 The coding system is used to decode the stream into a series of | |
| 602 characters (which may be from multiple charsets) when the text is read | |
| 603 from a file or process, and is used to encode the text back into the | |
| 604 same format when it is written out to a file or process. | |
| 605 | |
| 606 For example, many ISO2022-compliant coding systems (such as Compound | |
| 607 Text, which is used for inter-client data under the X Window System) | |
| 608 use escape sequences to switch between different charsets -- Japanese | |
| 609 Kanji, for example, is invoked with "ESC $ ( B"; ASCII is invoked | |
| 610 with "ESC ( B"; and Cyrillic is invoked with "ESC - L". See | |
| 611 `make-coding-system' for more information. | |
| 612 | |
| 613 Coding systems are normally identified using a symbol, and the | |
| 614 symbol is accepted in place of the actual coding system object whenever | |
| 615 a coding system is called for. (This is similar to how faces work.) | |
| 616 */ | |
| 617 (object)) | |
| 618 { | |
| 619 return CODING_SYSTEMP (object) ? Qt : Qnil; | |
| 620 } | |
| 621 | |
| 4303 | 622 static Lisp_Object |
| 623 find_coding_system (Lisp_Object coding_system_or_name, | |
| 624 int do_autoloads) | |
| 625 { | |
| 626 Lisp_Object lookup; | |
| 627 | |
| 628 if (NILP (coding_system_or_name)) | |
| 629 coding_system_or_name = Qbinary; | |
| 630 else if (CODING_SYSTEMP (coding_system_or_name)) | |
| 631 return coding_system_or_name; | |
| 632 else | |
| 633 CHECK_SYMBOL (coding_system_or_name); | |
| 634 | |
| 635 while (1) | |
| 636 { | |
| 637 lookup = | |
| 638 Fgethash (coding_system_or_name, Vcoding_system_hash_table, Qnil); | |
| 639 | |
| 640 if (CONSP (lookup) && do_autoloads) | |
| 641 { | |
| 642 struct gcpro gcpro1; | |
| 643 int length; | |
| 644 DECLARE_EISTRING (desired_base); | |
| 645 DECLARE_EISTRING (warning_info); | |
| 646 | |
| 647 eicpy_lstr (desired_base, XSYMBOL_NAME (coding_system_or_name)); | |
| 648 | |
| 649 /* Work out the name of the base coding system. */ | |
| 650 length = eilen (desired_base); | |
| 651 if (length > (int)(sizeof ("-unix") - 1)) | |
| 652 { | |
| 653 if (0 == qxestrcmp ((UAscbyte *)"-unix", (eidata (desired_base)) | |
| 654 + (length - (sizeof ("-unix") - 1)))) | |
| 655 { | |
| 656 eidel (desired_base, length - (sizeof ("-unix") - 1), | |
| 657 -1, 5, 5); | |
| 658 } | |
| 659 } | |
| 660 else if (length > (int)(sizeof ("-dos") - 1)) | |
| 661 { | |
| 662 if ((0 == qxestrcmp ((UAscbyte *)"-dos", (eidata (desired_base)) | |
| 663 + (length - (sizeof ("-dos") - 1)))) || | |
| 664 (0 == qxestrcmp ((UAscbyte *)"-mac", (eidata (desired_base)) | |
| 665 + (length - (sizeof ("-mac") - 1))))) | |
| 666 { | |
| 667 eidel (desired_base, length - (sizeof ("-dos") - 1), -1, | |
| 668 4, 4); | |
| 669 } | |
| 670 } | |
| 671 | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
672 coding_system_or_name = intern_istring (eidata (desired_base)); |
| 4303 | 673 |
| 674 /* Remove this coding system and its subsidiary coding | |
| 675 systems from the hash, to avoid calling this code recursively. */ | |
| 676 Fremhash (coding_system_or_name, Vcoding_system_hash_table); | |
| 677 Fremhash (add_suffix_to_symbol(coding_system_or_name, "-unix"), | |
| 678 Vcoding_system_hash_table); | |
| 679 Fremhash (add_suffix_to_symbol(coding_system_or_name, "-dos"), | |
| 680 Vcoding_system_hash_table); | |
| 681 Fremhash (add_suffix_to_symbol(coding_system_or_name, "-mac"), | |
| 682 Vcoding_system_hash_table); | |
| 683 | |
| 684 eicpy_ascii (warning_info, "Error autoloading coding system "); | |
| 685 eicat_lstr (warning_info, XSYMBOL_NAME (coding_system_or_name)); | |
| 686 | |
| 687 /* Keep around the form so it doesn't disappear from under | |
| 688 #'eval's feet. */ | |
| 689 GCPRO1 (lookup); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
690 call1_trapping_problems ((const CIbyte *) eidata (warning_info), |
| 4303 | 691 Qeval, lookup, 0); |
| 692 UNGCPRO; | |
| 693 | |
| 694 lookup = | |
| 695 Fgethash (coding_system_or_name, Vcoding_system_hash_table, Qnil); | |
| 696 } | |
| 697 | |
| 698 if (CODING_SYSTEMP (lookup) || NILP (lookup)) | |
| 699 return lookup; | |
| 700 | |
| 701 coding_system_or_name = lookup; | |
| 702 } | |
| 703 } | |
| 704 | |
| 428 | 705 DEFUN ("find-coding-system", Ffind_coding_system, 1, 1, 0, /* |
| 706 Retrieve the coding system of the given name. | |
| 707 | |
| 708 If CODING-SYSTEM-OR-NAME is a coding-system object, it is simply | |
| 709 returned. Otherwise, CODING-SYSTEM-OR-NAME should be a symbol. | |
| 710 If there is no such coding system, nil is returned. Otherwise the | |
| 711 associated coding system object is returned. | |
| 712 */ | |
| 713 (coding_system_or_name)) | |
| 714 { | |
| 4303 | 715 return find_coding_system(coding_system_or_name, 1); |
| 716 } | |
| 717 | |
| 718 DEFUN ("autoload-coding-system", Fautoload_coding_system, 2, 2, 0, /* | |
| 719 Define SYMBOL as a coding-system that is loaded on demand. | |
| 720 | |
| 721 FORM is a form to evaluate to define the coding-system. | |
| 722 */ | |
| 723 (symbol, form)) | |
| 724 { | |
| 725 Lisp_Object lookup; | |
| 726 | |
| 727 CHECK_SYMBOL (symbol); | |
| 728 CHECK_CONS (form); | |
| 729 | |
| 730 lookup = find_coding_system (symbol, 0); | |
| 731 | |
| 732 if (!NILP (lookup) && | |
| 733 /* Allow autoloads to be redefined. */ | |
| 734 !CONSP (lookup)) | |
| 440 | 735 { |
| 4303 | 736 invalid_operation ("Cannot redefine existing coding system", |
| 737 symbol); | |
| 440 | 738 } |
| 4303 | 739 |
| 740 Fputhash (symbol, form, Vcoding_system_hash_table); | |
| 741 Fputhash (add_suffix_to_symbol(symbol, "-unix"), form, | |
| 742 Vcoding_system_hash_table); | |
| 743 Fputhash (add_suffix_to_symbol(symbol, "-dos"), form, | |
| 744 Vcoding_system_hash_table); | |
| 745 Fputhash (add_suffix_to_symbol(symbol, "-mac"), form, | |
| 746 Vcoding_system_hash_table); | |
| 747 | |
| 748 /* Tell the POSIX locale infrastructure about this coding system (though | |
| 749 unfortunately it'll be too late for the startup locale sniffing. */ | |
| 750 if (!UNBOUNDP (Qposix_charset_to_coding_system_hash)) | |
| 751 { | |
| 752 Lisp_Object val = Fsymbol_value (Qposix_charset_to_coding_system_hash); | |
| 753 DECLARE_EISTRING (minimal_name); | |
| 754 Ibyte *full_name; | |
| 755 int len = XSTRING_LENGTH (XSYMBOL_NAME (symbol)), i; | |
| 756 | |
| 757 if (!NILP (val)) | |
| 758 { | |
| 759 full_name = XSTRING_DATA (XSYMBOL_NAME (symbol)); | |
| 760 for (i = 0; i < len; ++i) | |
| 761 { | |
| 762 if (full_name[i] >= '0' && full_name[i] <= '9') | |
| 763 { | |
| 764 eicat_ch (minimal_name, full_name[i]); | |
| 765 } | |
| 766 else if (full_name[i] >= 'a' && full_name[i] <= 'z') | |
| 767 { | |
| 768 eicat_ch (minimal_name, full_name[i]); | |
| 769 } | |
| 770 else if (full_name[i] >= 'A' && full_name[i] <= 'Z') | |
| 771 { | |
| 772 eicat_ch (minimal_name, full_name[i] + | |
| 773 ('a' - 'A')); | |
| 774 } | |
| 775 } | |
| 776 | |
| 777 if (eilen (minimal_name)) | |
| 778 { | |
| 779 CHECK_HASH_TABLE (val); | |
| 780 Fputhash (eimake_string(minimal_name), symbol, val); | |
| 781 } | |
| 782 } | |
| 783 } | |
| 784 | |
| 785 return Qt; | |
| 428 | 786 } |
| 787 | |
| 788 DEFUN ("get-coding-system", Fget_coding_system, 1, 1, 0, /* | |
| 789 Retrieve the coding system of the given name. | |
| 790 Same as `find-coding-system' except that if there is no such | |
| 791 coding system, an error is signaled instead of returning nil. | |
| 792 */ | |
| 793 (name)) | |
| 794 { | |
| 795 Lisp_Object coding_system = Ffind_coding_system (name); | |
| 796 | |
| 797 if (NILP (coding_system)) | |
| 563 | 798 invalid_argument ("No such coding system", name); |
| 428 | 799 return coding_system; |
| 800 } | |
| 801 | |
| 771 | 802 int |
| 803 coding_system_is_binary (Lisp_Object coding_system) | |
| 804 { | |
| 805 Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system); | |
| 806 return | |
| 807 (EQ (CODING_SYSTEM_TYPE (cs), Qno_conversion) && | |
| 808 CODING_SYSTEM_EOL_TYPE (cs) == EOL_LF && | |
| 809 EQ (CODING_SYSTEM_POST_READ_CONVERSION (cs), Qnil) && | |
| 810 EQ (CODING_SYSTEM_PRE_WRITE_CONVERSION (cs), Qnil)); | |
| 811 } | |
| 812 | |
| 813 static Lisp_Object | |
| 814 coding_system_real_canonical (Lisp_Object cs) | |
| 815 { | |
| 816 if (!NILP (XCODING_SYSTEM_CANONICAL (cs))) | |
| 817 return XCODING_SYSTEM_CANONICAL (cs); | |
| 818 return cs; | |
| 819 } | |
| 820 | |
| 821 /* Return true if coding system is of the "standard" type that decodes | |
| 822 bytes into characters (suitable for decoding a text file). */ | |
| 823 int | |
| 824 coding_system_is_for_text_file (Lisp_Object coding_system) | |
| 825 { | |
| 826 return (XCODESYSMETH_OR_GIVEN | |
| 827 (coding_system, conversion_end_type, | |
| 828 (coding_system_real_canonical (coding_system)), | |
| 829 DECODES_BYTE_TO_CHARACTER) == | |
| 830 DECODES_BYTE_TO_CHARACTER); | |
| 831 } | |
| 832 | |
| 833 static int | |
| 834 decoding_source_sink_type_is_char (Lisp_Object cs, enum source_or_sink sex) | |
| 835 { | |
| 836 enum source_sink_type type = | |
| 837 XCODESYSMETH_OR_GIVEN (cs, conversion_end_type, | |
| 838 (coding_system_real_canonical (cs)), | |
| 839 DECODES_BYTE_TO_CHARACTER); | |
| 840 if (sex == CODING_SOURCE) | |
| 841 return (type == DECODES_CHARACTER_TO_CHARACTER || | |
| 842 type == DECODES_CHARACTER_TO_BYTE); | |
| 843 else | |
| 844 return (type == DECODES_CHARACTER_TO_CHARACTER || | |
| 845 type == DECODES_BYTE_TO_CHARACTER); | |
| 846 } | |
| 847 | |
| 848 static int | |
| 849 encoding_source_sink_type_is_char (Lisp_Object cs, enum source_or_sink sex) | |
| 850 { | |
| 851 return decoding_source_sink_type_is_char (cs, | |
| 852 /* Sex change */ | |
| 853 sex == CODING_SOURCE ? | |
| 854 CODING_SINK : CODING_SOURCE); | |
| 855 } | |
| 856 | |
| 857 /* Like Ffind_coding_system() but check that the coding system is of the | |
| 858 "standard" type that decodes bytes into characters (suitable for | |
| 859 decoding a text file), and if not, returns an appropriate wrapper that | |
| 860 does. Also, if EOL_WRAP is non-zero, check whether this coding system | |
| 861 wants EOL auto-detection, and if so, wrap with a convert-eol coding | |
| 862 system to do this. */ | |
| 863 | |
| 864 Lisp_Object | |
| 865 find_coding_system_for_text_file (Lisp_Object name, int eol_wrap) | |
| 866 { | |
| 867 Lisp_Object coding_system = Ffind_coding_system (name); | |
| 868 Lisp_Object wrapper = coding_system; | |
| 869 | |
| 870 if (NILP (coding_system)) | |
| 871 return Qnil; | |
| 872 if (!coding_system_is_for_text_file (coding_system)) | |
| 873 { | |
| 874 wrapper = XCODING_SYSTEM_TEXT_FILE_WRAPPER (coding_system); | |
| 875 if (NILP (wrapper)) | |
| 876 { | |
| 877 Lisp_Object chain; | |
| 878 if (!decoding_source_sink_type_is_char (coding_system, CODING_SINK)) | |
| 879 chain = list2 (coding_system, Qbinary); | |
| 880 else | |
| 881 chain = list1 (coding_system); | |
| 882 if (decoding_source_sink_type_is_char (coding_system, CODING_SOURCE)) | |
| 883 chain = Fcons (Qbinary, chain); | |
| 884 wrapper = | |
| 885 make_internal_coding_system | |
| 886 (coding_system, | |
| 887 "internal-text-file-wrapper", | |
| 888 Qchain, | |
| 889 Qunbound, list4 (Qchain, chain, | |
| 890 Qcanonicalize_after_coding, coding_system)); | |
| 891 XCODING_SYSTEM_TEXT_FILE_WRAPPER (coding_system) = wrapper; | |
| 892 } | |
| 893 } | |
| 894 | |
| 895 if (!eol_wrap || XCODING_SYSTEM_EOL_TYPE (coding_system) != EOL_AUTODETECT) | |
| 896 return wrapper; | |
| 897 | |
| 898 coding_system = wrapper; | |
| 899 wrapper = XCODING_SYSTEM_AUTO_EOL_WRAPPER (coding_system); | |
| 900 if (!NILP (wrapper)) | |
| 901 return wrapper; | |
| 902 wrapper = | |
| 903 make_internal_coding_system | |
| 904 (coding_system, | |
| 905 "internal-auto-eol-wrapper", | |
| 906 Qundecided, Qunbound, | |
| 907 list4 (Qcoding_system, coding_system, | |
| 908 Qdo_eol, Qt)); | |
| 909 XCODING_SYSTEM_AUTO_EOL_WRAPPER (coding_system) = wrapper; | |
| 910 return wrapper; | |
| 911 } | |
| 912 | |
| 913 /* Like Fget_coding_system() but verify that the coding system is of the | |
| 914 "standard" type that decodes bytes into characters (suitable for | |
| 915 decoding a text file), and if not, returns an appropriate wrapper that | |
| 916 does. Also, if EOL_WRAP is non-zero, check whether this coding system | |
| 917 wants EOL auto-detection, and if so, wrap with a convert-eol coding | |
| 918 system to do this. */ | |
| 919 | |
| 920 Lisp_Object | |
| 921 get_coding_system_for_text_file (Lisp_Object name, int eol_wrap) | |
| 922 { | |
| 923 Lisp_Object coding_system = find_coding_system_for_text_file (name, | |
| 924 eol_wrap); | |
| 925 if (NILP (coding_system)) | |
| 926 invalid_argument ("No such coding system", name); | |
| 927 return coding_system; | |
| 928 } | |
| 929 | |
| 930 /* We store the coding systems in hash tables with the names as the | |
| 931 key and the actual coding system object as the value. Occasionally | |
| 932 we need to use them in a list format. These routines provide us | |
| 933 with that. */ | |
| 428 | 934 struct coding_system_list_closure |
| 935 { | |
| 936 Lisp_Object *coding_system_list; | |
| 771 | 937 int normal; |
| 938 int internal; | |
| 428 | 939 }; |
| 940 | |
| 941 static int | |
| 4303 | 942 add_coding_system_to_list_mapper (Lisp_Object key, Lisp_Object value, |
| 428 | 943 void *coding_system_list_closure) |
| 944 { | |
| 945 /* This function can GC */ | |
| 946 struct coding_system_list_closure *cscl = | |
| 947 (struct coding_system_list_closure *) coding_system_list_closure; | |
| 948 Lisp_Object *coding_system_list = cscl->coding_system_list; | |
| 949 | |
| 771 | 950 /* We can't just use VALUE because KEY might be an alias, and we need |
| 4303 | 951 the real coding system object. |
| 952 | |
| 953 Autoloaded coding systems have conses for their values, and can't be | |
| 954 internal coding systems, or coding system aliases. */ | |
| 955 if (CONSP (value) || | |
| 956 (XCODING_SYSTEM (Ffind_coding_system (key))->internal_p ? | |
| 957 cscl->internal : cscl->normal)) | |
| 771 | 958 *coding_system_list = Fcons (key, *coding_system_list); |
| 428 | 959 return 0; |
| 960 } | |
| 961 | |
| 2297 | 962 /* #### should we specify a conventional for "all coding systems"? */ |
| 771 | 963 DEFUN ("coding-system-list", Fcoding_system_list, 0, 1, 0, /* |
| 428 | 964 Return a list of the names of all defined coding systems. |
| 771 | 965 If INTERNAL is nil, only the normal (non-internal) coding systems are |
| 966 included. (Internal coding systems are created for various internal | |
| 967 purposes, such as implementing EOL types of CRLF and CR; generally, you do | |
| 968 not want to see these.) If it is t, only the internal coding systems are | |
| 969 included. If it is any other non-nil value both normal and internal are | |
| 970 included. | |
| 428 | 971 */ |
| 771 | 972 (internal)) |
| 428 | 973 { |
| 974 Lisp_Object coding_system_list = Qnil; | |
| 975 struct gcpro gcpro1; | |
| 976 struct coding_system_list_closure coding_system_list_closure; | |
| 977 | |
| 978 GCPRO1 (coding_system_list); | |
| 979 coding_system_list_closure.coding_system_list = &coding_system_list; | |
| 771 | 980 coding_system_list_closure.normal = !EQ (internal, Qt); |
| 981 coding_system_list_closure.internal = !NILP (internal); | |
| 428 | 982 elisp_maphash (add_coding_system_to_list_mapper, Vcoding_system_hash_table, |
| 983 &coding_system_list_closure); | |
| 984 UNGCPRO; | |
| 985 | |
| 986 return coding_system_list; | |
| 987 } | |
| 988 | |
| 989 DEFUN ("coding-system-name", Fcoding_system_name, 1, 1, 0, /* | |
| 990 Return the name of the given coding system. | |
| 991 */ | |
| 992 (coding_system)) | |
| 993 { | |
| 994 coding_system = Fget_coding_system (coding_system); | |
| 995 return XCODING_SYSTEM_NAME (coding_system); | |
| 996 } | |
| 997 | |
| 998 static Lisp_Coding_System * | |
| 771 | 999 allocate_coding_system (struct coding_system_methods *codesys_meths, |
| 1000 Bytecount data_size, | |
| 1001 Lisp_Object name) | |
| 428 | 1002 { |
| 771 | 1003 Bytecount total_size = offsetof (Lisp_Coding_System, data) + data_size; |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1004 Lisp_Object obj = ALLOC_SIZED_LISP_OBJECT (total_size, coding_system); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1005 Lisp_Coding_System *codesys = XCODING_SYSTEM (obj); |
| 1204 | 1006 |
| 771 | 1007 codesys->methods = codesys_meths; |
| 1204 | 1008 #define MARKED_SLOT(x) codesys->x = Qnil; |
| 1009 #include "coding-system-slots.h" | |
| 1010 | |
| 771 | 1011 CODING_SYSTEM_EOL_TYPE (codesys) = EOL_LF; |
| 1012 CODING_SYSTEM_NAME (codesys) = name; | |
| 1013 | |
| 1014 MAYBE_CODESYSMETH (codesys, init, (wrap_coding_system (codesys))); | |
| 428 | 1015 |
| 1016 return codesys; | |
| 1017 } | |
| 1018 | |
| 771 | 1019 static enum eol_type |
| 1020 symbol_to_eol_type (Lisp_Object symbol) | |
| 1021 { | |
| 1022 CHECK_SYMBOL (symbol); | |
| 1023 if (NILP (symbol)) return EOL_AUTODETECT; | |
| 1024 if (EQ (symbol, Qlf)) return EOL_LF; | |
| 1025 if (EQ (symbol, Qcrlf)) return EOL_CRLF; | |
| 1026 if (EQ (symbol, Qcr)) return EOL_CR; | |
| 1027 | |
| 1028 invalid_constant ("Unrecognized eol type", symbol); | |
| 1204 | 1029 RETURN_NOT_REACHED (EOL_AUTODETECT); |
| 771 | 1030 } |
| 1031 | |
| 1032 static Lisp_Object | |
| 1033 eol_type_to_symbol (enum eol_type type) | |
| 1034 { | |
| 1035 switch (type) | |
| 1036 { | |
| 2500 | 1037 default: ABORT (); |
| 771 | 1038 case EOL_LF: return Qlf; |
| 1039 case EOL_CRLF: return Qcrlf; | |
| 1040 case EOL_CR: return Qcr; | |
| 1041 case EOL_AUTODETECT: return Qnil; | |
| 1042 } | |
| 1043 } | |
| 1044 | |
| 1045 struct subsidiary_type | |
| 1046 { | |
|
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
1047 const Ascbyte *extension; |
|
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
1048 const Ascbyte *mnemonic_ext; |
| 771 | 1049 enum eol_type eol; |
| 1050 }; | |
| 1051 | |
| 1052 static struct subsidiary_type coding_subsidiary_list[] = | |
| 1053 { { "-unix", "", EOL_LF }, | |
| 1054 { "-dos", ":T", EOL_CRLF }, | |
| 1055 { "-mac", ":t", EOL_CR } }; | |
| 1056 | |
| 1057 /* kludge */ | |
| 428 | 1058 static void |
| 771 | 1059 setup_eol_coding_systems (Lisp_Object codesys) |
| 428 | 1060 { |
| 793 | 1061 int len = XSTRING_LENGTH (XSYMBOL (XCODING_SYSTEM_NAME (codesys))->name); |
| 2367 | 1062 Ibyte *codesys_name = alloca_ibytes (len + 7); |
| 771 | 1063 int mlen = -1; |
| 867 | 1064 Ibyte *codesys_mnemonic = 0; |
| 771 | 1065 Lisp_Object codesys_name_sym, sub_codesys; |
| 1066 int i; | |
| 1067 | |
| 1068 memcpy (codesys_name, | |
| 793 | 1069 XSTRING_DATA (XSYMBOL (XCODING_SYSTEM_NAME (codesys))->name), len); |
| 771 | 1070 |
| 1071 if (STRINGP (XCODING_SYSTEM_MNEMONIC (codesys))) | |
| 428 | 1072 { |
| 771 | 1073 mlen = XSTRING_LENGTH (XCODING_SYSTEM_MNEMONIC (codesys)); |
| 2367 | 1074 codesys_mnemonic = alloca_ibytes (mlen + 7); |
| 771 | 1075 memcpy (codesys_mnemonic, |
| 1076 XSTRING_DATA (XCODING_SYSTEM_MNEMONIC (codesys)), mlen); | |
| 1077 } | |
| 1078 | |
| 1079 /* Create three "subsidiary" coding systems, decoding data encoded using | |
| 1080 each of the three EOL types. We do this for each subsidiary by | |
| 1081 copying the original coding system, setting the EOL type | |
| 1082 appropriately, and setting the CANONICAL member of the new coding | |
| 1083 system to be a chain consisting of the original coding system followed | |
| 1084 by a convert-eol coding system to do the EOL decoding. For EOL type | |
| 1085 LF, however, we don't need any decoding, so we skip creating a | |
| 1086 CANONICAL. | |
| 1087 | |
| 1088 If the original coding system is not a text-type coding system | |
| 1089 (decodes byte->char), we need to coerce it to one by the appropriate | |
| 1090 wrapping in CANONICAL. */ | |
| 1091 | |
| 1092 for (i = 0; i < countof (coding_subsidiary_list); i++) | |
| 1093 { | |
|
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
1094 const Ascbyte *extension = coding_subsidiary_list[i].extension; |
|
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
1095 const Ascbyte *mnemonic_ext = coding_subsidiary_list[i].mnemonic_ext; |
| 771 | 1096 enum eol_type eol = coding_subsidiary_list[i].eol; |
| 1097 | |
| 2367 | 1098 qxestrcpy_ascii (codesys_name + len, extension); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1099 codesys_name_sym = intern_istring (codesys_name); |
| 771 | 1100 if (mlen != -1) |
| 2367 | 1101 qxestrcpy_ascii (codesys_mnemonic + mlen, mnemonic_ext); |
| 771 | 1102 |
| 1103 sub_codesys = Fcopy_coding_system (codesys, codesys_name_sym); | |
| 1104 if (mlen != -1) | |
| 1105 XCODING_SYSTEM_MNEMONIC (sub_codesys) = | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1106 build_istring (codesys_mnemonic); |
| 771 | 1107 |
| 1108 if (eol != EOL_LF) | |
| 1109 { | |
| 1110 Lisp_Object chain = list2 (get_coding_system_for_text_file | |
| 1111 (codesys, 0), | |
| 1112 eol == EOL_CR ? Qconvert_eol_cr : | |
| 1113 Qconvert_eol_crlf); | |
| 1114 Lisp_Object canon = | |
| 1115 make_internal_coding_system | |
| 1116 (sub_codesys, "internal-subsidiary-eol-wrapper", | |
| 1117 Qchain, Qunbound, | |
| 1118 mlen != -1 ? | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1119 list6 (Qmnemonic, build_istring (codesys_mnemonic), |
| 771 | 1120 Qchain, chain, |
| 1121 Qcanonicalize_after_coding, sub_codesys) : | |
| 1122 list4 (Qchain, chain, | |
| 1123 Qcanonicalize_after_coding, sub_codesys)); | |
| 1124 XCODING_SYSTEM_CANONICAL (sub_codesys) = canon; | |
| 1125 } | |
| 1126 XCODING_SYSTEM_EOL_TYPE (sub_codesys) = eol; | |
| 1127 XCODING_SYSTEM_SUBSIDIARY_PARENT (sub_codesys) = codesys; | |
| 1128 XCODING_SYSTEM (codesys)->eol[eol] = sub_codesys; | |
| 428 | 1129 } |
| 1130 } | |
| 1131 | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1132 DEFUN ("coding-system-canonical-name-p", Fcoding_system_canonical_name_p, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1133 1, 1, 0, /* |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1134 Return t if OBJECT names a coding system, and is not a coding system alias. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1135 */ |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1136 (object)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1137 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1138 return CODING_SYSTEMP (Fgethash (object, Vcoding_system_hash_table, Qnil)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1139 ? Qt : Qnil; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1140 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1141 |
| 771 | 1142 /* Basic function to create new coding systems. For `make-coding-system', |
| 1143 NAME-OR-EXISTING is the NAME argument, PREFIX is null, and TYPE, | |
| 1144 DESCRIPTION, and PROPS are the same. All created coding systems are put | |
| 1145 in a hash table indexed by NAME. | |
| 1146 | |
| 1147 If PREFIX is a string, NAME-OR-EXISTING should specify an existing | |
| 1148 coding system (or nil), and an internal coding system will be created. | |
| 1149 The name of the coding system will be constructed by combining PREFIX | |
| 1150 with the name of the existing coding system (if given), and a number | |
| 1151 will be appended to insure uniqueness. In such a case, if Qunbound is | |
| 1152 given for DESCRIPTION, the description gets created based on the | |
| 1153 generated name. Also, if no mnemonic is given in the properties list, a | |
| 1154 mnemonic is created based on the generated name. | |
| 1155 | |
| 1156 For internal coding systems, the coding system is marked as internal | |
| 1157 (see `coding-system-list'), and no subsidiaries will be created or | |
| 1158 eol-wrapping will happen. Otherwise: | |
| 1159 | |
| 1160 -- if the eol-type property is `lf' or t, the coding system is merely | |
| 1161 created and returned. (For t, the coding system will be wrapped with | |
| 1162 an EOL autodetector when it's used to read a file.) | |
| 1163 | |
| 1164 -- if eol-type is `crlf' or `cr', after the coding system object is | |
| 1165 created, it will be wrapped in a chain with the appropriate | |
| 1166 convert-eol coding system (either `convert-eol-crlf' or | |
| 1167 `convert-eol-cr'), so that CRLF->LF or CR->LF conversion is done at | |
| 1168 decoding time, and the opposite at encoding time. The resulting | |
| 1169 chain becomes the CANONICAL field of the coding system object. | |
| 1170 | |
| 1171 -- if eol-type is nil or omitted, "subsidiaries" are generated: Three | |
| 1172 coding systems where the original coding system (before wrapping with | |
| 1173 convert-eol-autodetect) is either unwrapped or wrapped with | |
| 1174 convert-eol-crlf or convert-eol-cr, respectively, so that coding systems | |
| 1175 to handle LF, CRLF, and CR end-of-line indicators are created. (This | |
| 1176 crazy crap is based on existing behavior in other Mule versions, | |
| 1177 including FSF Emacs.) | |
| 1178 */ | |
| 428 | 1179 |
| 1180 static Lisp_Object | |
|
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
1181 make_coding_system_1 (Lisp_Object name_or_existing, const Ascbyte *prefix, |
| 771 | 1182 Lisp_Object type, Lisp_Object description, |
| 1183 Lisp_Object props) | |
| 428 | 1184 { |
| 771 | 1185 Lisp_Coding_System *cs; |
| 1186 int need_to_setup_eol_systems = 1; | |
| 1187 enum eol_type eol_wrapper = EOL_AUTODETECT; | |
| 1188 struct coding_system_methods *meths; | |
| 1189 Lisp_Object csobj; | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1190 Lisp_Object defmnem = Qnil, aliases = Qnil; |
| 771 | 1191 |
| 1192 if (NILP (type)) | |
| 1193 type = Qundecided; | |
| 1194 meths = decode_coding_system_type (type, ERROR_ME); | |
| 1195 | |
| 1196 if (prefix) | |
| 428 | 1197 { |
| 867 | 1198 Ibyte *newname = |
| 771 | 1199 emacs_sprintf_malloc (NULL, "%s-%s-%d", |
| 1200 prefix, | |
| 867 | 1201 NILP (name_or_existing) ? (Ibyte *) "nil" : |
| 771 | 1202 XSTRING_DATA (Fsymbol_name (XCODING_SYSTEM_NAME |
| 1203 (name_or_existing))), | |
| 1204 ++coding_system_tick); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1205 name_or_existing = intern_istring (newname); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
1206 xfree (newname); |
| 771 | 1207 |
| 1208 if (UNBOUNDP (description)) | |
| 1209 { | |
| 1210 newname = | |
| 1211 emacs_sprintf_malloc | |
| 1212 (NULL, "For Internal Use (%s)", | |
| 1213 XSTRING_DATA (Fsymbol_name (name_or_existing))); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1214 description = build_istring (newname); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
1215 xfree (newname); |
| 771 | 1216 } |
| 1217 | |
| 1218 newname = emacs_sprintf_malloc (NULL, "Int%d", coding_system_tick); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1219 defmnem = build_istring (newname); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
1220 xfree (newname); |
| 428 | 1221 } |
| 771 | 1222 else |
| 1223 CHECK_SYMBOL (name_or_existing); | |
| 1224 | |
| 4303 | 1225 /* See is there an entry for name_or_existing in the defined coding system |
| 1226 hash table. */ | |
| 1227 csobj = find_coding_system (name_or_existing, 0); | |
| 1228 /* Error if it's there and not an autoload form. */ | |
| 1229 if (!NILP (csobj) && !CONSP (csobj)) | |
| 771 | 1230 invalid_operation ("Cannot redefine existing coding system", |
| 4303 | 1231 name_or_existing); |
| 771 | 1232 |
| 1233 cs = allocate_coding_system (meths, meths->extra_data_size, | |
| 1234 name_or_existing); | |
| 793 | 1235 csobj = wrap_coding_system (cs); |
| 771 | 1236 |
| 1237 cs->internal_p = !!prefix; | |
| 1238 | |
| 1239 if (NILP (description)) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1240 description = build_ascstring (""); |
| 771 | 1241 else |
| 1242 CHECK_STRING (description); | |
| 1243 CODING_SYSTEM_DESCRIPTION (cs) = description; | |
| 1244 | |
| 1245 if (!NILP (defmnem)) | |
| 1246 CODING_SYSTEM_MNEMONIC (cs) = defmnem; | |
| 1247 | |
| 1248 { | |
| 1249 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, props) | |
| 1250 { | |
| 1251 int recognized = 1; | |
| 1252 | |
| 1253 if (EQ (key, Qmnemonic)) | |
| 1254 { | |
| 1255 if (!NILP (value)) | |
| 1256 CHECK_STRING (value); | |
| 1257 CODING_SYSTEM_MNEMONIC (cs) = value; | |
| 1258 } | |
| 1259 | |
| 1260 else if (EQ (key, Qdocumentation)) | |
| 1261 { | |
| 1262 if (!NILP (value)) | |
| 1263 CHECK_STRING (value); | |
| 1264 CODING_SYSTEM_DOCUMENTATION (cs) = value; | |
| 1265 } | |
| 1266 | |
| 1267 else if (EQ (key, Qeol_type)) | |
| 1268 { | |
| 1269 need_to_setup_eol_systems = NILP (value); | |
| 1270 if (EQ (value, Qt)) | |
| 1271 value = Qnil; | |
| 1272 eol_wrapper = symbol_to_eol_type (value); | |
| 1273 } | |
| 1274 | |
| 1275 else if (EQ (key, Qpost_read_conversion)) | |
| 1276 CODING_SYSTEM_POST_READ_CONVERSION (cs) = value; | |
| 1277 else if (EQ (key, Qpre_write_conversion)) | |
| 1278 CODING_SYSTEM_PRE_WRITE_CONVERSION (cs) = value; | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1279 else if (EQ (key, Qaliases)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1280 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1281 EXTERNAL_LIST_LOOP_2 (alias, value) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1282 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1283 CHECK_SYMBOL (alias); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1284 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1285 if (!NILP (Fcoding_system_canonical_name_p (alias))) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1286 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1287 invalid_change ("Symbol is the canonical name of a " |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1288 "coding system and cannot be redefined", |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1289 alias); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1290 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1291 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1292 aliases = value; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1293 } |
| 771 | 1294 /* FSF compatibility */ |
| 1295 else if (EQ (key, Qtranslation_table_for_decode)) | |
| 1296 ; | |
| 1297 else if (EQ (key, Qtranslation_table_for_encode)) | |
| 1298 ; | |
| 1299 else if (EQ (key, Qsafe_chars)) | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1300 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1301 CHECK_CHAR_TABLE (value); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1302 CODING_SYSTEM_SAFE_CHARS (cs) = value; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1303 } |
| 771 | 1304 else if (EQ (key, Qsafe_charsets)) |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1305 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1306 if (!EQ (Qt, value) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1307 /* Would be nice to actually do this check, but there are |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1308 some order conflicts with japanese.el and |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1309 mule-coding.el */ |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1310 && 0) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1311 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1312 #ifdef MULE |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1313 EXTERNAL_LIST_LOOP_2 (safe_charset, value) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1314 CHECK_CHARSET (Ffind_charset (safe_charset)); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1315 #endif |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1316 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1317 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1318 CODING_SYSTEM_SAFE_CHARSETS (cs) = value; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1319 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1320 else if (EQ (key, Qcategory)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1321 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1322 Fput (name_or_existing, intern ("coding-system-property"), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1323 Fplist_put (Fget (name_or_existing, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1324 intern ("coding-system-property"), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1325 Qnil), |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1326 Qcategory, value)); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1327 } |
| 771 | 1328 else if (EQ (key, Qmime_charset)) |
| 1329 ; | |
| 1330 else if (EQ (key, Qvalid_codes)) | |
| 1331 ; | |
| 1332 else | |
| 1333 recognized = CODESYSMETH_OR_GIVEN (cs, putprop, | |
| 1334 (csobj, key, value), 0); | |
| 1335 | |
| 1336 if (!recognized) | |
| 1337 invalid_constant ("Unrecognized property", key); | |
| 1338 } | |
| 1339 } | |
| 1340 | |
| 1341 { | |
| 1342 XCODING_SYSTEM_CANONICAL (csobj) = | |
| 1343 CODESYSMETH_OR_GIVEN (cs, canonicalize, (csobj), Qnil); | |
| 1344 XCODING_SYSTEM_EOL_TYPE (csobj) = EOL_AUTODETECT; /* for copy-coding-system | |
| 1345 below */ | |
| 1346 | |
| 4303 | 1347 Fputhash (name_or_existing, csobj, Vcoding_system_hash_table); |
| 1348 | |
| 771 | 1349 if (need_to_setup_eol_systems && !cs->internal_p) |
| 1350 setup_eol_coding_systems (csobj); | |
| 1351 else if (eol_wrapper == EOL_CR || eol_wrapper == EOL_CRLF) | |
| 1352 { | |
| 1353 /* If a specific eol-type (other than LF) was specified, we handle | |
| 1354 this by converting the coding system into a chain that wraps the | |
| 1355 coding system along with a convert-eol system after it, in | |
| 1356 exactly that same switcheroo fashion that the normal | |
| 1357 canonicalize method works -- BUT we will run into a problem if | |
| 1358 we do it the obvious way, because when `chain' creates its | |
| 1359 substreams, the substream containing the coding system we're | |
| 1360 creating will have canonicalization expansion done on it, | |
| 1361 leading to infinite recursion. So we have to generate a new, | |
| 1362 internal coding system with the previous value of CANONICAL. */ | |
| 867 | 1363 Ibyte *newname = |
| 771 | 1364 emacs_sprintf_malloc |
| 1365 (NULL, "internal-eol-copy-%s-%d", | |
| 1366 XSTRING_DATA (Fsymbol_name (name_or_existing)), | |
| 1367 ++coding_system_tick); | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1368 Lisp_Object newnamesym = intern_istring (newname); |
| 771 | 1369 Lisp_Object copied = Fcopy_coding_system (csobj, newnamesym); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
1370 xfree (newname); |
| 771 | 1371 |
| 1372 XCODING_SYSTEM_CANONICAL (csobj) = | |
| 1373 make_internal_coding_system | |
| 1374 (csobj, | |
| 1375 "internal-eol-wrapper", | |
| 1376 Qchain, Qunbound, | |
| 1377 list4 (Qchain, | |
| 1378 list2 (copied, | |
| 1379 eol_wrapper == EOL_CR ? | |
| 1380 Qconvert_eol_cr : | |
| 1381 Qconvert_eol_crlf), | |
| 1382 Qcanonicalize_after_coding, | |
| 1383 csobj)); | |
| 1384 } | |
| 1385 XCODING_SYSTEM_EOL_TYPE (csobj) = eol_wrapper; | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1386 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1387 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1388 EXTERNAL_LIST_LOOP_2 (alias, aliases) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1389 Fdefine_coding_system_alias (alias, csobj); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1390 } |
| 771 | 1391 } |
| 1392 | |
| 1393 return csobj; | |
| 428 | 1394 } |
| 1395 | |
| 771 | 1396 Lisp_Object |
|
4528
726060ee587c
First draft of g++ 4.3 warning removal patch. Builds. *Needs ChangeLogs.*
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4522
diff
changeset
|
1397 make_internal_coding_system (Lisp_Object existing, const Ascbyte *prefix, |
| 771 | 1398 Lisp_Object type, Lisp_Object description, |
| 1399 Lisp_Object props) | |
| 1400 { | |
| 1401 return make_coding_system_1 (existing, prefix, type, description, props); | |
| 1402 } | |
| 428 | 1403 |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1404 DEFUN ("make-coding-system-internal", Fmake_coding_system_internal, 2, 4, 0, /* |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1405 See `make-coding-system'. This does much of the work of that function. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1406 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1407 Without Mule support, it does all the work of that function, and an alias |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1408 exists, mapping `make-coding-system' to |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1409 `make-coding-system-internal'. You'll need a non-Mule XEmacs to read the |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1410 complete docstring. Or you can just read it in make-coding-system.el; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1411 something like the following should work: |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1412 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
1413 \\[find-function-other-window] find-file RET \\[find-file] mule/make-coding-system.el RET |
| 771 | 1414 |
| 428 | 1415 */ |
| 771 | 1416 (name, type, description, props)) |
| 428 | 1417 { |
| 771 | 1418 return make_coding_system_1 (name, 0, type, description, props); |
| 428 | 1419 } |
| 1420 | |
| 1421 DEFUN ("copy-coding-system", Fcopy_coding_system, 2, 2, 0, /* | |
| 1422 Copy OLD-CODING-SYSTEM to NEW-NAME. | |
| 1423 If NEW-NAME does not name an existing coding system, a new one will | |
| 1424 be created. | |
| 771 | 1425 If you are using this function to create an alias, think again: |
| 1426 Use `define-coding-system-alias' instead. | |
| 428 | 1427 */ |
| 1428 (old_coding_system, new_name)) | |
| 1429 { | |
| 1430 Lisp_Object new_coding_system; | |
| 1431 old_coding_system = Fget_coding_system (old_coding_system); | |
| 771 | 1432 new_coding_system = |
| 4303 | 1433 UNBOUNDP (new_name) ? Qnil : find_coding_system (new_name, 0); |
| 428 | 1434 if (NILP (new_coding_system)) |
| 1435 { | |
| 793 | 1436 new_coding_system = |
| 1437 wrap_coding_system | |
| 1438 (allocate_coding_system | |
| 1439 (XCODING_SYSTEM (old_coding_system)->methods, | |
| 1440 XCODING_SYSTEM (old_coding_system)->methods->extra_data_size, | |
| 1441 new_name)); | |
| 771 | 1442 if (!UNBOUNDP (new_name)) |
| 1443 Fputhash (new_name, new_coding_system, Vcoding_system_hash_table); | |
| 428 | 1444 } |
| 771 | 1445 else if (XCODING_SYSTEM (old_coding_system)->methods != |
| 1446 XCODING_SYSTEM (new_coding_system)->methods) | |
| 1447 invalid_operation_2 ("Coding systems not same type", | |
| 1448 old_coding_system, new_coding_system); | |
| 428 | 1449 |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
1450 copy_lisp_object (new_coding_system, old_coding_system); |
|
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
1451 XCODING_SYSTEM (new_coding_system)->name = new_name; |
| 428 | 1452 return new_coding_system; |
| 1453 } | |
| 1454 | |
| 2297 | 1455 /* #### Shouldn't this really be a find/get pair? */ |
| 1456 | |
| 440 | 1457 DEFUN ("coding-system-alias-p", Fcoding_system_alias_p, 1, 1, 0, /* |
| 1458 Return t if OBJECT is a coding system alias. | |
| 1459 All coding system aliases are created by `define-coding-system-alias'. | |
| 1460 */ | |
| 1461 (object)) | |
| 428 | 1462 { |
| 440 | 1463 return SYMBOLP (Fgethash (object, Vcoding_system_hash_table, Qzero)) |
| 1464 ? Qt : Qnil; | |
| 1465 } | |
| 1466 | |
| 1467 DEFUN ("coding-system-aliasee", Fcoding_system_aliasee, 1, 1, 0, /* | |
| 1468 Return the coding-system symbol for which symbol ALIAS is an alias. | |
| 1469 */ | |
| 1470 (alias)) | |
| 1471 { | |
| 1472 Lisp_Object aliasee = Fgethash (alias, Vcoding_system_hash_table, Qnil); | |
| 1473 if (SYMBOLP (aliasee)) | |
| 1474 return aliasee; | |
| 1475 else | |
| 563 | 1476 invalid_argument ("Symbol is not a coding system alias", alias); |
| 1204 | 1477 RETURN_NOT_REACHED (Qnil); |
| 440 | 1478 } |
| 1479 | |
| 1480 /* A maphash function, for removing dangling coding system aliases. */ | |
| 1481 static int | |
| 2286 | 1482 dangling_coding_system_alias_p (Lisp_Object UNUSED (alias), |
| 440 | 1483 Lisp_Object aliasee, |
| 1484 void *dangling_aliases) | |
| 1485 { | |
| 1486 if (SYMBOLP (aliasee) | |
| 1487 && NILP (Fgethash (aliasee, Vcoding_system_hash_table, Qnil))) | |
| 428 | 1488 { |
| 440 | 1489 (*(int *) dangling_aliases)++; |
| 1490 return 1; | |
| 428 | 1491 } |
| 440 | 1492 else |
| 1493 return 0; | |
| 1494 } | |
| 1495 | |
| 1496 DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias, 2, 2, 0, /* | |
| 1497 Define symbol ALIAS as an alias for coding system ALIASEE. | |
| 1498 | |
| 1499 You can use this function to redefine an alias that has already been defined, | |
| 1500 but you cannot redefine a name which is the canonical name for a coding system. | |
| 1501 \(a canonical name of a coding system is what is returned when you call | |
| 1502 `coding-system-name' on a coding system). | |
| 1503 | |
| 1504 ALIASEE itself can be an alias, which allows you to define nested aliases. | |
| 1505 | |
| 1506 You are forbidden, however, from creating alias loops or `dangling' aliases. | |
| 1507 These will be detected, and an error will be signaled if you attempt to do so. | |
| 1508 | |
| 1509 If ALIASEE is nil, then ALIAS will simply be undefined. | |
| 1510 | |
| 1511 See also `coding-system-alias-p', `coding-system-aliasee', | |
| 1512 and `coding-system-canonical-name-p'. | |
| 1513 */ | |
| 1514 (alias, aliasee)) | |
| 1515 { | |
| 2286 | 1516 Lisp_Object probe; |
| 440 | 1517 |
| 1518 CHECK_SYMBOL (alias); | |
| 1519 | |
| 1520 if (!NILP (Fcoding_system_canonical_name_p (alias))) | |
| 563 | 1521 invalid_change |
| 440 | 1522 ("Symbol is the canonical name of a coding system and cannot be redefined", |
| 1523 alias); | |
| 1524 | |
| 1525 if (NILP (aliasee)) | |
| 1526 { | |
| 771 | 1527 Lisp_Object subsidiary_unix = add_suffix_to_symbol (alias, "-unix"); |
| 1528 Lisp_Object subsidiary_dos = add_suffix_to_symbol (alias, "-dos"); | |
| 1529 Lisp_Object subsidiary_mac = add_suffix_to_symbol (alias, "-mac"); | |
| 440 | 1530 |
| 1531 Fremhash (alias, Vcoding_system_hash_table); | |
| 1532 | |
| 1533 /* Undefine subsidiary aliases, | |
| 1534 presumably created by a previous call to this function */ | |
| 1535 if (! NILP (Fcoding_system_alias_p (subsidiary_unix)) && | |
| 1536 ! NILP (Fcoding_system_alias_p (subsidiary_dos)) && | |
| 1537 ! NILP (Fcoding_system_alias_p (subsidiary_mac))) | |
| 1538 { | |
| 1539 Fdefine_coding_system_alias (subsidiary_unix, Qnil); | |
| 1540 Fdefine_coding_system_alias (subsidiary_dos, Qnil); | |
| 1541 Fdefine_coding_system_alias (subsidiary_mac, Qnil); | |
| 1542 } | |
| 1543 | |
| 1544 /* Undefine dangling coding system aliases. */ | |
| 1545 { | |
| 1546 int dangling_aliases; | |
| 1547 | |
| 1548 do { | |
| 1549 dangling_aliases = 0; | |
| 1550 elisp_map_remhash (dangling_coding_system_alias_p, | |
| 1551 Vcoding_system_hash_table, | |
| 1552 &dangling_aliases); | |
| 1553 } while (dangling_aliases > 0); | |
| 1554 } | |
| 1555 | |
| 1556 return Qnil; | |
| 1557 } | |
| 1558 | |
| 1559 if (CODING_SYSTEMP (aliasee)) | |
| 1560 aliasee = XCODING_SYSTEM_NAME (aliasee); | |
| 1561 | |
| 1562 /* Checks that aliasee names a coding-system */ | |
| 2286 | 1563 (void) Fget_coding_system (aliasee); |
| 440 | 1564 |
| 1565 /* Check for coding system alias loops */ | |
| 1566 if (EQ (alias, aliasee)) | |
| 563 | 1567 alias_loop: invalid_operation_2 |
| 440 | 1568 ("Attempt to create a coding system alias loop", alias, aliasee); |
| 1569 | |
| 1570 for (probe = aliasee; | |
| 1571 SYMBOLP (probe); | |
| 1572 probe = Fgethash (probe, Vcoding_system_hash_table, Qzero)) | |
| 1573 { | |
| 1574 if (EQ (probe, alias)) | |
| 1575 goto alias_loop; | |
| 1576 } | |
| 1577 | |
| 1578 Fputhash (alias, aliasee, Vcoding_system_hash_table); | |
| 1579 | |
| 1580 /* Set up aliases for subsidiaries. | |
| 2297 | 1581 #### There must be a better way to handle subsidiary coding systems. |
| 1582 Inquiring Minds Want To Know: shouldn't they always be chains? */ | |
| 440 | 1583 { |
| 1584 static const char *suffixes[] = { "-unix", "-dos", "-mac" }; | |
| 1585 int i; | |
| 1586 for (i = 0; i < countof (suffixes); i++) | |
| 1587 { | |
| 1588 Lisp_Object alias_subsidiary = | |
| 771 | 1589 add_suffix_to_symbol (alias, suffixes[i]); |
| 440 | 1590 Lisp_Object aliasee_subsidiary = |
| 771 | 1591 add_suffix_to_symbol (aliasee, suffixes[i]); |
| 440 | 1592 |
| 1593 if (! NILP (Ffind_coding_system (aliasee_subsidiary))) | |
| 1594 Fdefine_coding_system_alias (alias_subsidiary, aliasee_subsidiary); | |
| 1595 } | |
| 1596 } | |
| 428 | 1597 /* FSF return value is a vector of [ALIAS-unix ALIAS-dos ALIAS-mac], |
| 1598 but it doesn't look intentional, so I'd rather return something | |
| 1599 meaningful or nothing at all. */ | |
| 1600 return Qnil; | |
| 1601 } | |
| 1602 | |
| 1603 static Lisp_Object | |
| 771 | 1604 subsidiary_coding_system (Lisp_Object coding_system, enum eol_type type) |
| 428 | 1605 { |
| 1606 Lisp_Coding_System *cs = XCODING_SYSTEM (coding_system); | |
| 1607 Lisp_Object new_coding_system; | |
| 1608 | |
| 1609 switch (type) | |
| 1610 { | |
| 1611 case EOL_AUTODETECT: return coding_system; | |
| 1612 case EOL_LF: new_coding_system = CODING_SYSTEM_EOL_LF (cs); break; | |
| 1613 case EOL_CR: new_coding_system = CODING_SYSTEM_EOL_CR (cs); break; | |
| 1614 case EOL_CRLF: new_coding_system = CODING_SYSTEM_EOL_CRLF (cs); break; | |
| 2500 | 1615 default: ABORT (); return Qnil; |
| 428 | 1616 } |
| 1617 | |
| 1618 return NILP (new_coding_system) ? coding_system : new_coding_system; | |
| 1619 } | |
| 1620 | |
| 1621 DEFUN ("subsidiary-coding-system", Fsubsidiary_coding_system, 2, 2, 0, /* | |
| 1622 Return the subsidiary coding system of CODING-SYSTEM with eol type EOL-TYPE. | |
| 771 | 1623 The logically opposite operation is `coding-system-base'. |
| 428 | 1624 */ |
| 1625 (coding_system, eol_type)) | |
| 1626 { | |
| 771 | 1627 coding_system = get_coding_system_for_text_file (coding_system, 0); |
| 428 | 1628 |
| 1629 return subsidiary_coding_system (coding_system, | |
| 1630 symbol_to_eol_type (eol_type)); | |
| 1631 } | |
| 1632 | |
| 771 | 1633 DEFUN ("coding-system-base", Fcoding_system_base, |
| 1634 1, 1, 0, /* | |
| 1635 Return the base coding system of CODING-SYSTEM. | |
| 1636 If CODING-SYSTEM is a subsidiary, this returns its parent; otherwise, it | |
| 1637 returns CODING-SYSTEM. | |
| 1638 The logically opposite operation is `subsidiary-coding-system'. | |
| 1639 */ | |
| 1640 (coding_system)) | |
| 1641 { | |
| 1642 Lisp_Object base; | |
| 1643 | |
| 1644 coding_system = Fget_coding_system (coding_system); | |
| 1645 if (EQ (XCODING_SYSTEM_NAME (coding_system), Qbinary)) | |
| 1646 return Fget_coding_system (Qraw_text); /* hack! */ | |
| 1647 base = XCODING_SYSTEM_SUBSIDIARY_PARENT (coding_system); | |
| 1648 if (!NILP (base)) | |
| 1649 return base; | |
| 1650 return coding_system; | |
| 1651 } | |
| 1652 | |
| 1653 DEFUN ("coding-system-used-for-io", Fcoding_system_used_for_io, | |
| 1654 1, 1, 0, /* | |
| 1655 Return the coding system actually used for I/O. | |
| 1656 In some cases (e.g. when a particular EOL type is specified) this won't be | |
| 2297 | 1657 the coding system itself. This can be useful when trying to determine |
| 1658 precisely how data was decoded. | |
| 771 | 1659 */ |
| 1660 (coding_system)) | |
| 1661 { | |
| 1662 Lisp_Object canon; | |
| 1663 | |
| 1664 coding_system = Fget_coding_system (coding_system); | |
| 1665 canon = XCODING_SYSTEM_CANONICAL (coding_system); | |
| 1666 if (!NILP (canon)) | |
| 1667 return canon; | |
| 1668 return coding_system; | |
| 1669 } | |
| 1670 | |
| 428 | 1671 |
| 1672 /************************************************************************/ | |
| 1673 /* Coding system accessors */ | |
| 1674 /************************************************************************/ | |
| 1675 | |
| 771 | 1676 DEFUN ("coding-system-description", Fcoding_system_description, 1, 1, 0, /* |
| 1677 Return the description for CODING-SYSTEM. | |
| 1678 The `description' of a coding system is a short English phrase giving the | |
| 1679 name rendered according to English punctuation rules, plus possibly some | |
| 1680 explanatory text (typically in the form of a parenthetical phrase). The | |
| 1681 description is intended to be short enough that it can appear as a menu item, | |
| 1682 and clear enough to be recognizable even to someone who is assumed to have | |
| 1683 some basic familiarity with different encodings but may not know all the | |
| 1684 technical names; thus, for `cn-gb-2312' is described as "Chinese EUC" and | |
| 1685 `hz-gb-2312' is described as "Hz/ZW (Chinese)", where the actual name of | |
| 1686 the encoding is given, followed by a note that this is a Chinese encoding, | |
| 1687 because the great majority of people encountering this would have no idea | |
| 1688 what it is, and giving the language indicates whether the encoding should | |
| 1689 just be ignored or (conceivably) investigated more thoroughly. | |
| 428 | 1690 */ |
| 1691 (coding_system)) | |
| 1692 { | |
| 1693 coding_system = Fget_coding_system (coding_system); | |
| 771 | 1694 return XCODING_SYSTEM_DESCRIPTION (coding_system); |
| 428 | 1695 } |
| 1696 | |
| 1697 DEFUN ("coding-system-type", Fcoding_system_type, 1, 1, 0, /* | |
| 1698 Return the type of CODING-SYSTEM. | |
| 1699 */ | |
| 1700 (coding_system)) | |
| 1701 { | |
| 771 | 1702 coding_system = Fget_coding_system (coding_system); |
| 1703 return XCODING_SYSTEM_TYPE (coding_system); | |
| 428 | 1704 } |
| 1705 | |
| 1706 DEFUN ("coding-system-property", Fcoding_system_property, 2, 2, 0, /* | |
| 1707 Return the PROP property of CODING-SYSTEM. | |
| 1708 */ | |
| 1709 (coding_system, prop)) | |
| 1710 { | |
| 1711 coding_system = Fget_coding_system (coding_system); | |
| 1712 CHECK_SYMBOL (prop); | |
| 1713 | |
| 1714 if (EQ (prop, Qname)) | |
| 1715 return XCODING_SYSTEM_NAME (coding_system); | |
| 1716 else if (EQ (prop, Qtype)) | |
| 1717 return Fcoding_system_type (coding_system); | |
| 771 | 1718 else if (EQ (prop, Qdescription)) |
| 1719 return XCODING_SYSTEM_DESCRIPTION (coding_system); | |
| 428 | 1720 else if (EQ (prop, Qmnemonic)) |
| 1721 return XCODING_SYSTEM_MNEMONIC (coding_system); | |
| 771 | 1722 else if (EQ (prop, Qdocumentation)) |
| 1723 return XCODING_SYSTEM_DOCUMENTATION (coding_system); | |
| 428 | 1724 else if (EQ (prop, Qeol_type)) |
| 771 | 1725 return eol_type_to_symbol (XCODING_SYSTEM_EOL_TYPE |
| 1726 (coding_system)); | |
| 428 | 1727 else if (EQ (prop, Qeol_lf)) |
| 1728 return XCODING_SYSTEM_EOL_LF (coding_system); | |
| 1729 else if (EQ (prop, Qeol_crlf)) | |
| 1730 return XCODING_SYSTEM_EOL_CRLF (coding_system); | |
| 1731 else if (EQ (prop, Qeol_cr)) | |
| 1732 return XCODING_SYSTEM_EOL_CR (coding_system); | |
| 1733 else if (EQ (prop, Qpost_read_conversion)) | |
| 1734 return XCODING_SYSTEM_POST_READ_CONVERSION (coding_system); | |
| 1735 else if (EQ (prop, Qpre_write_conversion)) | |
| 1736 return XCODING_SYSTEM_PRE_WRITE_CONVERSION (coding_system); | |
|
4568
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4303
diff
changeset
|
1737 else if (EQ (prop, Qsafe_charsets)) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4303
diff
changeset
|
1738 return XCODING_SYSTEM_SAFE_CHARSETS (coding_system); |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4303
diff
changeset
|
1739 else if (EQ (prop, Qsafe_chars)) |
|
1d74a1d115ee
Add #'query-coding-region tests; do the work necessary to get them running.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4303
diff
changeset
|
1740 return XCODING_SYSTEM_SAFE_CHARS (coding_system); |
| 771 | 1741 else |
| 1742 { | |
| 1743 Lisp_Object value = CODESYSMETH_OR_GIVEN (XCODING_SYSTEM (coding_system), | |
| 1744 getprop, | |
| 1745 (coding_system, prop), | |
| 1746 Qunbound); | |
| 1747 if (UNBOUNDP (value)) | |
| 1748 invalid_constant ("Unrecognized property", prop); | |
| 1749 return value; | |
| 1750 } | |
| 1751 } | |
| 1752 | |
| 1753 | |
| 1754 /************************************************************************/ | |
| 1755 /* Coding stream functions */ | |
| 1756 /************************************************************************/ | |
| 1757 | |
| 1758 /* A coding stream is a stream used for encoding or decoding text. The | |
| 1759 coding-stream object keeps track of the actual coding system, the stream | |
| 1760 that is at the other end, and data that needs to be persistent across | |
| 1761 the lifetime of the stream. */ | |
| 1762 | |
| 1204 | 1763 extern const struct sized_memory_description chain_coding_stream_description; |
| 1764 extern const struct sized_memory_description undecided_coding_stream_description; | |
| 1765 | |
| 1766 static const struct memory_description coding_stream_data_description_1 []= { | |
| 2551 | 1767 { XD_BLOCK_PTR, chain_coding_system, 1, |
| 1768 { &chain_coding_stream_description } }, | |
| 1769 { XD_BLOCK_PTR, undecided_coding_system, 1, | |
| 1770 { &undecided_coding_stream_description } }, | |
| 1204 | 1771 { XD_END } |
| 1772 }; | |
| 1773 | |
| 1774 static const struct sized_memory_description coding_stream_data_description = { | |
| 1775 sizeof (void *), coding_stream_data_description_1 | |
| 1776 }; | |
| 1777 | |
| 1778 static const struct memory_description coding_lstream_description[] = { | |
| 1779 { XD_INT, offsetof (struct coding_stream, type) }, | |
| 1780 { XD_LISP_OBJECT, offsetof (struct coding_stream, orig_codesys) }, | |
| 1781 { XD_LISP_OBJECT, offsetof (struct coding_stream, codesys) }, | |
| 1782 { XD_LISP_OBJECT, offsetof (struct coding_stream, other_end) }, | |
| 1783 { XD_UNION, offsetof (struct coding_stream, data), | |
| 2551 | 1784 XD_INDIRECT (0, 0), { &coding_stream_data_description } }, |
| 1204 | 1785 { XD_END } |
| 1786 }; | |
| 1787 | |
| 1788 DEFINE_LSTREAM_IMPLEMENTATION_WITH_DATA ("coding", coding); | |
| 771 | 1789 |
| 1790 /* Encoding and decoding are parallel operations, so we create just one | |
| 1791 stream for both. "Decoding" may involve the extra step of autodetection | |
| 1792 of the data format, but that's only because of the conventional | |
| 1793 definition of decoding as converting from external- to | |
| 1794 internal-formatted data. | |
| 1795 | |
| 2297 | 1796 [[ REWRITE ME! ]] |
| 1797 | |
| 771 | 1798 #### We really need to abstract out the concept of "data formats" and |
| 1799 define "converters" that convert from and to specified formats, | |
| 1800 eliminating the idea of decoding and encoding. When specifying a | |
| 1801 conversion process, we need to give the data formats themselves, not the | |
| 1802 conversion processes -- e.g. a coding system called "Unicode->multibyte" | |
| 1803 converts in both directions, and we could auto-detect the format of data | |
| 1804 at either end. */ | |
| 1805 | |
| 1806 static Bytecount | |
| 1807 coding_reader (Lstream *stream, unsigned char *data, Bytecount size) | |
| 1808 { | |
| 1809 unsigned char *orig_data = data; | |
| 1810 Bytecount read_size; | |
| 1811 int error_occurred = 0; | |
| 1812 struct coding_stream *str = CODING_STREAM_DATA (stream); | |
| 1813 | |
| 1814 /* We need to interface to coding_{de,en}code_1(), which expects to take | |
| 1815 some amount of data and store the result into a Dynarr. We have | |
| 1816 coding_{de,en}code_1() store into c->runoff, and take data from there | |
| 1817 as necessary. */ | |
| 1818 | |
| 1819 /* We loop until we have enough data, reading chunks from the other | |
| 1820 end and converting it. */ | |
| 1821 while (1) | |
| 1822 { | |
| 1823 /* Take data from convert_to if we can. Make sure to take at | |
| 1824 most SIZE bytes, and delete the data from convert_to. */ | |
| 1825 if (Dynarr_length (str->convert_to) > 0) | |
| 1826 { | |
| 1827 Bytecount chunk = | |
| 1828 min (size, (Bytecount) Dynarr_length (str->convert_to)); | |
| 4967 | 1829 memcpy (data, Dynarr_begin (str->convert_to), chunk); |
| 771 | 1830 Dynarr_delete_many (str->convert_to, 0, chunk); |
| 1831 data += chunk; | |
| 1832 size -= chunk; | |
| 1833 } | |
| 1834 | |
| 1835 if (size == 0) | |
| 1836 break; /* No more room for data */ | |
| 1837 | |
| 1838 if (str->eof) | |
| 1839 break; | |
| 1840 | |
| 1841 { | |
| 1842 /* Exhausted convert_to, so get some more. Read into convert_from, | |
| 1843 after existing "rejected" data from the last conversion. */ | |
| 1844 Bytecount rejected = Dynarr_length (str->convert_from); | |
| 1845 /* #### 1024 is arbitrary; we really need to separate 0 from EOF, | |
| 1846 and when we get 0, keep taking more data until we don't get 0 -- | |
| 1847 we don't know how much data the conversion routine might need | |
| 2297 | 1848 before it can generate any data of its own (eg, bzip2). */ |
| 814 | 1849 Bytecount readmore = |
| 1850 str->one_byte_at_a_time ? (Bytecount) 1 : | |
| 1851 max (size, (Bytecount) 1024); | |
| 771 | 1852 |
| 1853 Dynarr_add_many (str->convert_from, 0, readmore); | |
| 1854 read_size = Lstream_read (str->other_end, | |
| 1855 Dynarr_atp (str->convert_from, rejected), | |
| 1856 readmore); | |
| 1857 /* Trim size down to how much we actually got */ | |
| 5038 | 1858 Dynarr_set_lengthr (str->convert_from, rejected + max (0, read_size)); |
| 771 | 1859 } |
| 1860 | |
| 1861 if (read_size < 0) /* LSTREAM_ERROR */ | |
| 1862 { | |
| 1863 error_occurred = 1; | |
| 1864 break; | |
| 1865 } | |
| 1866 if (read_size == 0) /* LSTREAM_EOF */ | |
| 1867 /* There might be some more end data produced in the translation, | |
| 1868 so we set a flag and call the conversion method once more to | |
| 1869 output any final stuff it may be holding, any "go back to a sane | |
| 1870 state" escape sequences, etc. The conversion method is free to | |
| 1871 look at this flag, and we use it above to stop looping. */ | |
| 1872 str->eof = 1; | |
| 1873 { | |
| 1874 Bytecount processed; | |
| 1875 Bytecount to_process = Dynarr_length (str->convert_from); | |
| 1876 | |
| 1877 /* Convert the data, and save any rejected data in convert_from */ | |
| 1878 processed = | |
| 1879 XCODESYSMETH (str->codesys, convert, | |
| 4967 | 1880 (str, Dynarr_begin (str->convert_from), |
| 771 | 1881 str->convert_to, to_process)); |
| 1882 if (processed < 0) | |
| 1883 { | |
| 1884 error_occurred = 1; | |
| 1885 break; | |
| 1886 } | |
| 1887 assert (processed <= to_process); | |
| 1888 if (processed < to_process) | |
| 4967 | 1889 memmove (Dynarr_begin (str->convert_from), |
| 771 | 1890 Dynarr_atp (str->convert_from, processed), |
| 1891 to_process - processed); | |
| 5038 | 1892 Dynarr_set_lengthr (str->convert_from, to_process - processed); |
| 771 | 1893 } |
| 1894 } | |
| 1895 | |
| 1896 if (data - orig_data == 0) | |
| 1897 return error_occurred ? -1 : 0; | |
| 1898 else | |
| 1899 return data - orig_data; | |
| 1900 } | |
| 1901 | |
| 1902 static Bytecount | |
| 1903 coding_writer (Lstream *stream, const unsigned char *data, Bytecount size) | |
| 1904 { | |
| 1905 struct coding_stream *str = CODING_STREAM_DATA (stream); | |
| 1906 | |
| 1907 /* Convert all our data into convert_to, and then attempt to write | |
| 1908 it all out to the other end. */ | |
| 1909 Dynarr_reset (str->convert_to); | |
| 1910 size = XCODESYSMETH (str->codesys, convert, | |
| 1911 (str, data, str->convert_to, size)); | |
| 4967 | 1912 if (Lstream_write (str->other_end, Dynarr_begin (str->convert_to), |
| 771 | 1913 Dynarr_length (str->convert_to)) < 0) |
| 1914 return -1; | |
| 1915 else | |
| 1916 /* The return value indicates how much of the incoming data was | |
| 1917 processed, not how many bytes were written. */ | |
| 1918 return size; | |
| 1919 } | |
| 1920 | |
| 1921 static int | |
| 1922 encode_decode_source_sink_type_is_char (Lisp_Object cs, | |
| 1923 enum source_or_sink sex, | |
| 1924 enum encode_decode direction) | |
| 1925 { | |
| 1926 return (direction == CODING_DECODE ? | |
| 1927 decoding_source_sink_type_is_char (cs, sex) : | |
| 1928 encoding_source_sink_type_is_char (cs, sex)); | |
| 1929 } | |
| 1930 | |
| 1931 /* Ensure that the convert methods only get full characters sent to them to | |
| 1932 convert if the source of that conversion is characters; and that no such | |
| 1933 full-character checking happens when the source is bytes. Keep in mind | |
| 1934 that (1) the conversion_end_type return values take the perspective of | |
| 1935 encoding; (2) the source for decoding is the same as the sink for | |
| 1936 encoding; (3) when writing, the data is given to us, and we set our own | |
| 1937 stream to be character mode or not; (4) when reading, the data comes | |
| 1938 from the other_end stream, and we set that one to be character mode or | |
| 1939 not. This is consistent with the comment above the prototype for | |
| 1940 Lstream_set_character_mode(), which lays out rules for who is allowed to | |
| 1941 modify the character type mode on a stream. | |
| 1942 | |
| 814 | 1943 If we're a read stream, we're always setting character mode on the |
| 1944 source, but we also set it on ourselves consistent with the flag that | |
| 1945 can disable this (see again the comment above | |
| 1946 Lstream_set_character_mode()). | |
| 1947 */ | |
| 771 | 1948 |
| 1949 static void | |
| 1950 set_coding_character_mode (Lstream *stream) | |
| 1951 { | |
| 1952 struct coding_stream *str = CODING_STREAM_DATA (stream); | |
| 1953 Lstream *stream_to_set = | |
| 1954 stream->flags & LSTREAM_FL_WRITE ? stream : str->other_end; | |
| 1955 if (encode_decode_source_sink_type_is_char | |
| 1956 (str->codesys, CODING_SOURCE, str->direction)) | |
| 1957 Lstream_set_character_mode (stream_to_set); | |
| 1958 else | |
| 1959 Lstream_unset_character_mode (stream_to_set); | |
| 814 | 1960 if (str->set_char_mode_on_us_when_reading && |
| 1961 (stream->flags & LSTREAM_FL_READ)) | |
| 1962 { | |
| 1963 if (encode_decode_source_sink_type_is_char | |
| 1964 (str->codesys, CODING_SINK, str->direction)) | |
| 1965 Lstream_set_character_mode (stream); | |
| 1966 else | |
| 1967 Lstream_unset_character_mode (stream); | |
| 1968 } | |
| 771 | 1969 } |
| 1970 | |
| 1971 static Lisp_Object | |
| 1972 coding_marker (Lisp_Object stream) | |
| 1973 { | |
| 1974 struct coding_stream *str = CODING_STREAM_DATA (XLSTREAM (stream)); | |
| 1975 | |
| 1976 mark_object (str->orig_codesys); | |
| 1977 mark_object (str->codesys); | |
| 1978 MAYBE_XCODESYSMETH (str->codesys, mark_coding_stream, (str)); | |
| 1979 return wrap_lstream (str->other_end); | |
| 1980 } | |
| 1981 | |
| 1982 static int | |
| 1983 coding_rewinder (Lstream *stream) | |
| 1984 { | |
| 1985 struct coding_stream *str = CODING_STREAM_DATA (stream); | |
| 1986 MAYBE_XCODESYSMETH (str->codesys, rewind_coding_stream, (str)); | |
| 1987 | |
| 1988 str->ch = 0; | |
| 1989 Dynarr_reset (str->convert_to); | |
| 1990 Dynarr_reset (str->convert_from); | |
| 1991 return Lstream_rewind (str->other_end); | |
| 1992 } | |
| 1993 | |
| 1994 static int | |
| 1995 coding_seekable_p (Lstream *stream) | |
| 1996 { | |
| 1997 struct coding_stream *str = CODING_STREAM_DATA (stream); | |
| 1998 return Lstream_seekable_p (str->other_end); | |
| 1999 } | |
| 2000 | |
| 2001 static int | |
| 2002 coding_flusher (Lstream *stream) | |
| 2003 { | |
| 2004 struct coding_stream *str = CODING_STREAM_DATA (stream); | |
| 2005 return Lstream_flush (str->other_end); | |
| 2006 } | |
| 2007 | |
| 2008 static int | |
| 2009 coding_closer (Lstream *stream) | |
| 2010 { | |
| 2011 struct coding_stream *str = CODING_STREAM_DATA (stream); | |
| 2012 if (stream->flags & LSTREAM_FL_WRITE) | |
| 2013 { | |
| 2014 str->eof = 1; | |
| 2015 coding_writer (stream, 0, 0); | |
| 2016 str->eof = 0; | |
| 2017 } | |
| 2018 /* It's safe to free the runoff dynarrs now because they are used only | |
| 2019 during conversion. We need to keep the type-specific data around, | |
| 2020 though, because of canonicalize_after_coding. */ | |
| 2021 if (str->convert_to) | |
| 2022 { | |
| 2023 Dynarr_free (str->convert_to); | |
| 2024 str->convert_to = 0; | |
| 2025 } | |
| 2026 if (str->convert_from) | |
| 428 | 2027 { |
| 771 | 2028 Dynarr_free (str->convert_from); |
| 2029 str->convert_from = 0; | |
| 2030 } | |
| 2031 | |
| 800 | 2032 if (str->no_close_other) |
| 2033 return Lstream_flush (str->other_end); | |
| 2034 else | |
| 2035 return Lstream_close (str->other_end); | |
| 771 | 2036 } |
| 2037 | |
| 2038 static void | |
| 2039 coding_finalizer (Lstream *stream) | |
| 2040 { | |
| 2041 struct coding_stream *str = CODING_STREAM_DATA (stream); | |
| 2042 | |
| 2043 assert (!str->finalized); | |
| 2044 MAYBE_XCODESYSMETH (str->codesys, finalize_coding_stream, (str)); | |
| 2045 if (str->data) | |
| 2046 { | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
2047 xfree (str->data); |
| 771 | 2048 str->data = 0; |
| 2049 } | |
| 2050 str->finalized = 1; | |
| 2051 } | |
| 2052 | |
| 2053 static Lisp_Object | |
| 2054 coding_stream_canonicalize_after_coding (Lstream *stream) | |
| 2055 { | |
| 2056 struct coding_stream *str = CODING_STREAM_DATA (stream); | |
| 2057 | |
| 2058 return XCODESYSMETH_OR_GIVEN (str->codesys, canonicalize_after_coding, | |
| 2059 (str), str->codesys); | |
| 2060 } | |
| 2061 | |
| 2062 Lisp_Object | |
| 2063 coding_stream_detected_coding_system (Lstream *stream) | |
| 2064 { | |
| 2065 Lisp_Object codesys = | |
| 2066 coding_stream_canonicalize_after_coding (stream); | |
| 2067 if (NILP (codesys)) | |
| 2068 return Fget_coding_system (Qidentity); | |
| 2069 return codesys; | |
| 2070 } | |
| 2071 | |
| 2072 Lisp_Object | |
| 2073 coding_stream_coding_system (Lstream *stream) | |
| 2074 { | |
| 2075 return CODING_STREAM_DATA (stream)->codesys; | |
| 2076 } | |
| 2077 | |
| 2078 /* Change the coding system associated with a stream. */ | |
| 2079 | |
| 2080 void | |
| 2081 set_coding_stream_coding_system (Lstream *lstr, Lisp_Object codesys) | |
| 2082 { | |
| 2083 struct coding_stream *str = CODING_STREAM_DATA (lstr); | |
| 2084 if (EQ (str->orig_codesys, codesys)) | |
| 2085 return; | |
| 2086 /* We do the equivalent of closing the stream, destroying it, and | |
| 2087 reinitializing it. This includes flushing out the data and signalling | |
| 2088 EOF, if we're a writing stream; we also replace the type-specific data | |
| 2089 with the data appropriate for the new coding system. */ | |
| 2090 if (!NILP (str->codesys)) | |
| 2091 { | |
| 2092 if (lstr->flags & LSTREAM_FL_WRITE) | |
| 2093 { | |
| 2094 Lstream_flush (lstr); | |
| 2095 str->eof = 1; | |
| 2096 coding_writer (lstr, 0, 0); | |
| 2097 str->eof = 0; | |
| 2098 } | |
| 2099 MAYBE_XCODESYSMETH (str->codesys, finalize_coding_stream, (str)); | |
| 2100 } | |
| 2101 str->orig_codesys = codesys; | |
| 2102 str->codesys = coding_system_real_canonical (codesys); | |
| 2103 | |
| 2104 if (str->data) | |
| 2105 { | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
2106 xfree (str->data); |
| 771 | 2107 str->data = 0; |
| 428 | 2108 } |
| 771 | 2109 if (XCODING_SYSTEM_METHODS (str->codesys)->coding_data_size) |
| 1204 | 2110 { |
| 2111 str->data = | |
| 2112 xmalloc_and_zero (XCODING_SYSTEM_METHODS (str->codesys)-> | |
| 2113 coding_data_size); | |
| 2114 str->type = XCODING_SYSTEM_METHODS (str->codesys)->enumtype; | |
| 2115 } | |
| 771 | 2116 MAYBE_XCODESYSMETH (str->codesys, init_coding_stream, (str)); |
| 2117 /* The new coding system may have different ideas regarding whether its | |
| 2118 ends are characters or bytes. */ | |
| 2119 set_coding_character_mode (lstr); | |
| 2120 } | |
| 2121 | |
| 2122 /* WARNING WARNING WARNING WARNING!!!!! If you open up a coding | |
| 2123 stream for writing, no automatic code detection will be performed. | |
| 2124 The reason for this is that automatic code detection requires a | |
| 2125 seekable input. Things will also fail if you open a coding | |
| 2126 stream for reading using a non-fully-specified coding system and | |
| 2127 a non-seekable input stream. */ | |
| 2128 | |
| 2129 static Lisp_Object | |
| 2130 make_coding_stream_1 (Lstream *stream, Lisp_Object codesys, | |
| 800 | 2131 const char *mode, enum encode_decode direction, |
| 802 | 2132 int flags) |
| 771 | 2133 { |
| 2134 Lstream *lstr = Lstream_new (lstream_coding, mode); | |
| 2135 struct coding_stream *str = CODING_STREAM_DATA (lstr); | |
| 2136 | |
| 2137 codesys = Fget_coding_system (codesys); | |
| 2138 xzero (*str); | |
| 2139 str->codesys = Qnil; | |
| 2140 str->orig_codesys = Qnil; | |
| 2141 str->us = lstr; | |
| 2142 str->other_end = stream; | |
| 2143 str->convert_to = Dynarr_new (unsigned_char); | |
| 2144 str->convert_from = Dynarr_new (unsigned_char); | |
| 2145 str->direction = direction; | |
| 814 | 2146 if (flags & LSTREAM_FL_NO_CLOSE_OTHER) |
| 802 | 2147 str->no_close_other = 1; |
| 814 | 2148 if (flags & LSTREAM_FL_READ_ONE_BYTE_AT_A_TIME) |
| 802 | 2149 str->one_byte_at_a_time = 1; |
| 814 | 2150 if (!(flags & LSTREAM_FL_NO_INIT_CHAR_MODE_WHEN_READING)) |
| 2151 str->set_char_mode_on_us_when_reading = 1; | |
| 802 | 2152 |
| 771 | 2153 set_coding_stream_coding_system (lstr, codesys); |
| 793 | 2154 return wrap_lstream (lstr); |
| 771 | 2155 } |
| 2156 | |
| 814 | 2157 /* FLAGS: |
| 2158 | |
| 2159 LSTREAM_FL_NO_CLOSE_OTHER | |
| 2160 Don't close STREAM (the stream at the other end) when this stream is | |
| 2161 closed. | |
| 2162 | |
| 2163 LSTREAM_FL_READ_ONE_BYTE_AT_A_TIME | |
| 2164 When reading from STREAM, read and process one byte at a time rather | |
| 2165 than in large chunks. This is for reading from TTY's, so we don't | |
| 2166 block. #### We should instead create a non-blocking filedesc stream | |
| 2167 that emulates the behavior as necessary using select(), when the | |
| 2168 fcntls don't work. (As seems to be the case on Cygwin.) | |
| 2169 | |
| 2170 LSTREAM_FL_NO_INIT_CHAR_MODE_WHEN_READING | |
| 2171 When reading from STREAM, read and process one byte at a time rather | |
| 2172 than in large chunks. This is for reading from TTY's, so we don't | |
| 2173 block. #### We should instead create a non-blocking filedesc stream | |
| 2174 that emulates the behavior as necessary using select(), when the | |
| 2175 fcntls don't work. (As seems to be the case on Cygwin.) | |
| 2176 */ | |
| 771 | 2177 Lisp_Object |
| 2178 make_coding_input_stream (Lstream *stream, Lisp_Object codesys, | |
| 802 | 2179 enum encode_decode direction, int flags) |
| 771 | 2180 { |
| 800 | 2181 return make_coding_stream_1 (stream, codesys, "r", direction, |
| 802 | 2182 flags); |
| 771 | 2183 } |
| 2184 | |
| 814 | 2185 /* FLAGS: |
| 2186 | |
| 2187 LSTREAM_FL_NO_CLOSE_OTHER | |
| 2188 Don't close STREAM (the stream at the other end) when this stream is | |
| 2189 closed. | |
| 2190 */ | |
| 771 | 2191 Lisp_Object |
| 2192 make_coding_output_stream (Lstream *stream, Lisp_Object codesys, | |
| 802 | 2193 enum encode_decode direction, int flags) |
| 771 | 2194 { |
| 800 | 2195 return make_coding_stream_1 (stream, codesys, "w", direction, |
| 802 | 2196 flags); |
| 771 | 2197 } |
| 2198 | |
| 2199 static Lisp_Object | |
| 2200 encode_decode_coding_region (Lisp_Object start, Lisp_Object end, | |
| 2201 Lisp_Object coding_system, Lisp_Object buffer, | |
| 2202 enum encode_decode direction) | |
| 2203 { | |
| 2204 Charbpos b, e; | |
| 2205 struct buffer *buf = decode_buffer (buffer, 0); | |
| 2206 Lisp_Object instream = Qnil, to_outstream = Qnil, outstream = Qnil; | |
| 2207 Lisp_Object from_outstream = Qnil, auto_outstream = Qnil; | |
| 2208 Lisp_Object lb_outstream = Qnil; | |
| 2209 Lisp_Object next; | |
| 2210 Lstream *istr, *ostr; | |
| 2211 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; | |
| 2212 struct gcpro ngcpro1; | |
| 2213 int source_char, sink_char; | |
| 2214 | |
| 2215 get_buffer_range_char (buf, start, end, &b, &e, 0); | |
| 2216 barf_if_buffer_read_only (buf, b, e); | |
| 2217 | |
| 2218 GCPRO5 (instream, to_outstream, outstream, from_outstream, lb_outstream); | |
| 2219 NGCPRO1 (auto_outstream); | |
| 2220 | |
| 2221 coding_system = Fget_coding_system (coding_system); | |
| 2222 source_char = encode_decode_source_sink_type_is_char (coding_system, | |
| 2223 CODING_SOURCE, | |
| 2224 direction); | |
| 2225 sink_char = encode_decode_source_sink_type_is_char (coding_system, | |
| 2226 CODING_SINK, | |
| 2227 direction); | |
| 2228 | |
| 2229 /* Order is IN <---> [TO] -> OUT -> [FROM] -> [AUTODETECT-EOL] -> LB */ | |
| 2230 instream = make_lisp_buffer_input_stream (buf, b, e, 0); | |
| 2231 next = lb_outstream = make_lisp_buffer_output_stream (buf, b, 0); | |
| 2232 | |
| 2233 if (direction == CODING_DECODE && | |
| 2234 XCODING_SYSTEM_EOL_TYPE (coding_system) == EOL_AUTODETECT) | |
| 2235 next = auto_outstream = | |
| 2236 make_coding_output_stream | |
| 800 | 2237 (XLSTREAM (next), Fget_coding_system (Qconvert_eol_autodetect), |
| 2238 CODING_DECODE, 0); | |
| 771 | 2239 |
| 2240 if (!sink_char) | |
| 2241 next = from_outstream = | |
| 800 | 2242 make_coding_output_stream (XLSTREAM (next), Qbinary, CODING_DECODE, 0); |
| 771 | 2243 outstream = make_coding_output_stream (XLSTREAM (next), coding_system, |
| 800 | 2244 direction, 0); |
| 771 | 2245 if (!source_char) |
| 428 | 2246 { |
| 771 | 2247 to_outstream = |
| 2248 make_coding_output_stream (XLSTREAM (outstream), | |
| 800 | 2249 Qbinary, CODING_ENCODE, 0); |
| 771 | 2250 ostr = XLSTREAM (to_outstream); |
| 2251 } | |
| 2252 else | |
| 2253 ostr = XLSTREAM (outstream); | |
| 2254 istr = XLSTREAM (instream); | |
| 2255 | |
| 2256 /* The chain of streams looks like this: | |
| 2257 | |
| 2297 | 2258 [BUFFER] <----- (( read from/send to loop )) |
| 771 | 2259 ------> [CHAR->BYTE i.e. ENCODE AS BINARY if source is |
| 2260 in bytes] | |
| 2261 ------> [ENCODE/DECODE AS SPECIFIED] | |
| 2262 ------> [BYTE->CHAR i.e. DECODE AS BINARY | |
| 2263 if sink is in bytes] | |
| 2264 ------> [AUTODETECT EOL if | |
| 2265 we're decoding and | |
| 2266 coding system calls | |
| 2267 for this] | |
| 2268 ------> [BUFFER] | |
| 2269 */ | |
| 2367 | 2270 |
| 2271 /* #### See comment | |
| 2272 | |
| 2273 EFFICIENCY OF CODING CONVERSION WITH MULTIPLE COPIES/CHAINS | |
| 2274 | |
| 2275 in text.c. | |
| 2276 */ | |
| 2277 | |
| 771 | 2278 while (1) |
| 2279 { | |
| 2280 char tempbuf[1024]; /* some random amount */ | |
| 2281 Charbpos newpos, even_newer_pos; | |
| 2282 Charbpos oldpos = lisp_buffer_stream_startpos (istr); | |
| 2283 Bytecount size_in_bytes = | |
| 2284 Lstream_read (istr, tempbuf, sizeof (tempbuf)); | |
| 2285 | |
| 2286 if (!size_in_bytes) | |
| 2287 break; | |
| 2288 newpos = lisp_buffer_stream_startpos (istr); | |
| 2289 Lstream_write (ostr, tempbuf, size_in_bytes); | |
| 2290 even_newer_pos = lisp_buffer_stream_startpos (istr); | |
| 2291 buffer_delete_range (buf, even_newer_pos - (newpos - oldpos), | |
| 2292 even_newer_pos, 0); | |
| 428 | 2293 } |
| 771 | 2294 |
| 2295 { | |
| 2296 Charcount retlen = | |
| 2297 lisp_buffer_stream_startpos (XLSTREAM (instream)) - b; | |
| 2298 Lstream_close (istr); | |
| 2299 Lstream_close (ostr); | |
| 2300 NUNGCPRO; | |
| 2301 UNGCPRO; | |
| 2302 Lstream_delete (istr); | |
| 2303 if (!NILP (from_outstream)) | |
| 2304 Lstream_delete (XLSTREAM (from_outstream)); | |
| 2305 Lstream_delete (XLSTREAM (outstream)); | |
| 2306 if (!NILP (to_outstream)) | |
| 2307 Lstream_delete (XLSTREAM (to_outstream)); | |
| 2308 if (!NILP (auto_outstream)) | |
| 2309 Lstream_delete (XLSTREAM (auto_outstream)); | |
| 2310 Lstream_delete (XLSTREAM (lb_outstream)); | |
| 2311 return make_int (retlen); | |
| 2312 } | |
| 2313 } | |
| 2314 | |
| 3302 | 2315 DEFUN ("decode-coding-region", Fdecode_coding_region, 3, 4, |
| 2316 "*r\nzDecode from coding system: \ni", /* | |
| 771 | 2317 Decode the text between START and END which is encoded in CODING-SYSTEM. |
| 2318 This is useful if you've read in encoded text from a file without decoding | |
| 2319 it (e.g. you read in a JIS-formatted file but used the `binary' or | |
| 2320 `no-conversion' coding system, so that it shows up as "^[$B!<!+^[(B"). | |
| 2321 Return length of decoded text. | |
| 3302 | 2322 BUFFER defaults to the current buffer if unspecified, and when interactive. |
| 771 | 2323 */ |
| 2324 (start, end, coding_system, buffer)) | |
| 2325 { | |
| 2326 return encode_decode_coding_region (start, end, coding_system, buffer, | |
| 2327 CODING_DECODE); | |
| 2328 } | |
| 2329 | |
| 3302 | 2330 DEFUN ("encode-coding-region", Fencode_coding_region, 3, 4, |
| 2331 "*r\nzEncode to coding system: \ni", /* | |
| 771 | 2332 Encode the text between START and END using CODING-SYSTEM. |
| 2333 This will, for example, convert Japanese characters into stuff such as | |
| 3302 | 2334 "^[$B!<!+^[(B" if you use the JIS encoding. Return length of encoded text. |
| 2335 BUFFER defaults to the current buffer if unspecified, and when interactive. | |
| 771 | 2336 */ |
| 2337 (start, end, coding_system, buffer)) | |
| 2338 { | |
| 2339 return encode_decode_coding_region (start, end, coding_system, buffer, | |
| 2340 CODING_ENCODE); | |
| 428 | 2341 } |
| 2342 | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2343 DEFUN ("query-coding-region", Fquery_coding_region, 3, 7, 0, /* |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2344 Work out whether CODING-SYSTEM can losslessly encode a region. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2345 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2346 START and END are the beginning and end of the region to check. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2347 CODING-SYSTEM is the coding system to try. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2348 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2349 Optional argument BUFFER is the buffer to check, and defaults to the current |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2350 buffer. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2351 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2352 IGNORE-INVALID-SEQUENCESP, also an optional argument, says to treat XEmacs |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2353 characters which have an unambiguous encoded representation, despite being |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2354 undefined in what they represent, as encodable. These chiefly arise with |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2355 variable-length encodings like UTF-8 and UTF-16, where an invalid sequence |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2356 is passed through to XEmacs as a sequence of characters with a defined |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2357 correspondence to the octets on disk, but no non-error semantics; see the |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2358 `invalid-sequence-coding-system' argument to `set-language-info'. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2359 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2360 They can also arise with fixed-length encodings like ISO 8859-7, where |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2361 certain octets on disk have undefined values, and treating them as |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2362 corresponding to the ISO 8859-1 characters with the same numerical values |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2363 may lead to data that is not understood by other applications. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2364 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2365 Optional argument ERRORP says to signal a `text-conversion-error' if some |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2366 character in the region cannot be encoded, and defaults to nil. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2367 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2368 Optional argument HIGHLIGHT says to display unencodable characters in the |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2369 region using `query-coding-warning-face'. It defaults to nil. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2370 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2371 This function can return multiple values; the intention is that callers use |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2372 `multiple-value-bind' or the related CL multiple value functions to deal |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2373 with it. The first result is `t' if the region can be encoded using |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2374 CODING-SYSTEM, or `nil' if not. If the region cannot be encoded using |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2375 CODING-SYSTEM, the second result is a range table describing the positions |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2376 of the unencodable characters. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2377 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2378 Ranges that describe characters that would be ignored were |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2379 IGNORE-INVALID-SEQUENCESP non-nil map to the symbol `invalid-sequence'; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2380 other ranges map to the symbol `unencodable'. If IGNORE-INVALID-SEQUENCESP |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2381 is non-nil, all ranges will map to the symbol `unencodable'. See |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2382 `make-range-table' for more details of range tables. |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2383 */ |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2384 (start, end, coding_system, buffer, ignore_invalid_sequencesp, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2385 errorp, highlight)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2386 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2387 Charbpos b, e; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2388 struct buffer *buf = decode_buffer (buffer, 1); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2389 Lisp_Object result; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2390 int flags = 0, speccount = specpdl_depth (); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2391 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2392 coding_system = Fget_coding_system (coding_system); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2393 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2394 get_buffer_range_char (buf, start, end, &b, &e, 0); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2395 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2396 if (buf != current_buffer) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2397 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2398 record_unwind_protect (save_current_buffer_restore, Fcurrent_buffer ()); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2399 set_buffer_internal (buf); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2400 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2401 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2402 record_unwind_protect (save_excursion_restore, save_excursion_save ()); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2403 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2404 BUF_SET_PT (buf, b); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2405 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2406 if (!NILP (ignore_invalid_sequencesp)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2407 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2408 flags |= QUERY_METHOD_IGNORE_INVALID_SEQUENCES; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2409 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2410 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2411 if (!NILP (errorp)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2412 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2413 flags |= QUERY_METHOD_ERRORP; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2414 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2415 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2416 if (!NILP (highlight)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2417 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2418 flags |= QUERY_METHOD_HIGHLIGHT; |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2419 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2420 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2421 result = XCODESYSMETH_OR_GIVEN (coding_system, query, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2422 (coding_system, buf, e, flags), Qunbound); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2423 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2424 if (UNBOUNDP (result)) |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2425 { |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2426 signal_error (Qtext_conversion_error, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2427 "Coding system doesn't say what it can encode", |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2428 XCODING_SYSTEM_NAME (coding_system)); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2429 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2430 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2431 result = (NILP (result)) ? Qt : values2 (Qnil, result); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2432 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2433 return unbind_to_1 (speccount, result); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2434 } |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2435 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
2436 |
| 428 | 2437 |
| 2438 /************************************************************************/ | |
| 771 | 2439 /* Chain methods */ |
| 428 | 2440 /************************************************************************/ |
| 2441 | |
| 771 | 2442 /* #### Need a way to create "opposite-direction" coding systems. */ |
| 2443 | |
| 2444 /* Chain two or more coding systems together to make a combination coding | |
| 2445 system. */ | |
| 2446 | |
| 2447 struct chain_coding_system | |
| 2448 { | |
| 2449 /* List of coding systems, in decode order */ | |
| 2450 Lisp_Object *chain; | |
| 2451 /* Number of coding systems in list */ | |
| 2452 int count; | |
| 2453 /* Coding system to return as a result of canonicalize-after-coding */ | |
| 2454 Lisp_Object canonicalize_after_coding; | |
| 2455 }; | |
| 2456 | |
| 2457 struct chain_coding_stream | |
| 2458 { | |
| 2459 int initted; | |
| 2460 /* Lstreams for chain coding system */ | |
| 2461 Lisp_Object *lstreams; | |
| 2462 int lstream_count; | |
| 2463 }; | |
| 2464 | |
| 1204 | 2465 static const struct memory_description chain_coding_system_description[] = { |
| 2466 { XD_INT, offsetof (struct chain_coding_system, count) }, | |
| 2367 | 2467 { XD_BLOCK_PTR, offsetof (struct chain_coding_system, chain), |
| 2551 | 2468 XD_INDIRECT (0, 0), { &lisp_object_description } }, |
| 1204 | 2469 { XD_LISP_OBJECT, offsetof (struct chain_coding_system, |
| 2470 canonicalize_after_coding) }, | |
| 771 | 2471 { XD_END } |
| 2472 }; | |
| 2473 | |
| 1204 | 2474 static const struct memory_description chain_coding_stream_description_1 [] = { |
| 2475 { XD_INT, offsetof (struct chain_coding_stream, lstream_count) }, | |
| 2367 | 2476 { XD_BLOCK_PTR, offsetof (struct chain_coding_stream, lstreams), |
| 2551 | 2477 XD_INDIRECT (0, 0), { &lisp_object_description } }, |
| 771 | 2478 { XD_END } |
| 2479 }; | |
| 2480 | |
| 1204 | 2481 const struct sized_memory_description chain_coding_stream_description = { |
| 2482 sizeof (struct chain_coding_stream), chain_coding_stream_description_1 | |
| 2483 }; | |
| 2484 | |
| 2485 DEFINE_CODING_SYSTEM_TYPE_WITH_DATA (chain); | |
| 2486 | |
| 771 | 2487 static Lisp_Object |
| 2488 chain_canonicalize (Lisp_Object codesys) | |
| 2489 { | |
| 2490 /* We make use of the fact that this method is called at init time, after | |
| 2491 properties have been parsed. init_method is called too early. */ | |
| 2492 /* #### It's not clear we need this whole chain-canonicalize mechanism | |
| 2493 any more. */ | |
| 2494 Lisp_Object chain = Flist (XCODING_SYSTEM_CHAIN_COUNT (codesys), | |
| 2495 XCODING_SYSTEM_CHAIN_CHAIN (codesys)); | |
| 2496 chain = Fcons (XCODING_SYSTEM_PRE_WRITE_CONVERSION (codesys), | |
| 2497 Fcons (XCODING_SYSTEM_POST_READ_CONVERSION (codesys), | |
| 2498 chain)); | |
| 2499 Fputhash (chain, codesys, Vchain_canonicalize_hash_table); | |
| 2500 return codesys; | |
| 2501 } | |
| 2502 | |
| 2503 static Lisp_Object | |
| 2504 chain_canonicalize_after_coding (struct coding_stream *str) | |
| 2505 { | |
| 2506 Lisp_Object cac = | |
| 2507 XCODING_SYSTEM_CHAIN_CANONICALIZE_AFTER_CODING (str->codesys); | |
| 2508 if (!NILP (cac)) | |
| 2509 return cac; | |
| 2510 return str->codesys; | |
| 2511 #if 0 | |
| 2512 struct chain_coding_stream *data = CODING_STREAM_TYPE_DATA (str, chain); | |
| 2513 Lisp_Object us = str->codesys, codesys; | |
| 2514 int i; | |
| 2515 Lisp_Object chain; | |
| 2516 Lisp_Object tail; | |
| 2517 int changed = 0; | |
| 2518 | |
| 2519 /* #### It's not clear we need this whole chain-canonicalize mechanism | |
| 2520 any more. */ | |
| 2521 if (str->direction == CODING_ENCODE || !data->initted) | |
| 2522 return us; | |
| 2523 | |
| 2524 chain = Flist (XCODING_SYSTEM_CHAIN_COUNT (us), | |
| 2525 XCODING_SYSTEM_CHAIN_CHAIN (us)); | |
| 2526 | |
| 2527 tail = chain; | |
| 2528 for (i = 0; i < XCODING_SYSTEM_CHAIN_COUNT (us); i++) | |
| 2529 { | |
| 2530 codesys = (coding_stream_canonicalize_after_coding | |
| 2531 (XLSTREAM (data->lstreams[i]))); | |
| 2532 if (!EQ (codesys, XCAR (tail))) | |
| 2533 changed = 1; | |
| 2534 XCAR (tail) = codesys; | |
| 2535 tail = XCDR (tail); | |
| 2536 } | |
| 2537 | |
| 2538 if (!changed) | |
| 2539 return us; | |
| 2540 | |
| 2541 chain = delq_no_quit (Qnil, chain); | |
| 2542 | |
| 2543 if (NILP (XCODING_SYSTEM_PRE_WRITE_CONVERSION (us)) && | |
| 2544 NILP (XCODING_SYSTEM_POST_READ_CONVERSION (us))) | |
| 2545 { | |
| 2546 if (NILP (chain)) | |
| 2547 return Qnil; | |
| 2548 if (NILP (XCDR (chain))) | |
| 2549 return XCAR (chain); | |
| 2550 } | |
| 2551 | |
| 2552 codesys = Fgethash (Fcons (XCODING_SYSTEM_PRE_WRITE_CONVERSION (us), | |
| 2553 Fcons (XCODING_SYSTEM_POST_READ_CONVERSION (us), | |
| 2554 chain)), Vchain_canonicalize_hash_table, | |
| 2555 Qnil); | |
| 2556 if (!NILP (codesys)) | |
| 2557 return codesys; | |
| 2558 return make_internal_coding_system | |
| 2559 (us, "internal-chain-canonicalizer-wrapper", | |
| 2560 Qchain, Qunbound, list2 (Qchain, chain)); | |
| 2561 #endif /* 0 */ | |
| 2562 } | |
| 2563 | |
| 2564 static void | |
| 2565 chain_init (Lisp_Object codesys) | |
| 2566 { | |
| 2567 XCODING_SYSTEM_CHAIN_CANONICALIZE_AFTER_CODING (codesys) = Qnil; | |
| 2568 } | |
| 2569 | |
| 2570 static void | |
| 2571 chain_mark (Lisp_Object codesys) | |
| 2572 { | |
| 2573 int i; | |
| 2574 | |
| 2575 for (i = 0; i < XCODING_SYSTEM_CHAIN_COUNT (codesys); i++) | |
| 2576 mark_object (XCODING_SYSTEM_CHAIN_CHAIN (codesys)[i]); | |
| 2577 mark_object (XCODING_SYSTEM_CHAIN_CANONICALIZE_AFTER_CODING (codesys)); | |
| 2578 } | |
| 2579 | |
| 2580 static void | |
| 2581 chain_mark_coding_stream_1 (struct chain_coding_stream *data) | |
| 2582 { | |
| 2583 int i; | |
| 2584 | |
| 2585 for (i = 0; i < data->lstream_count; i++) | |
| 2586 mark_object (data->lstreams[i]); | |
| 2587 } | |
| 2588 | |
| 2589 static void | |
| 2590 chain_mark_coding_stream (struct coding_stream *str) | |
| 2591 { | |
| 2592 chain_mark_coding_stream_1 (CODING_STREAM_TYPE_DATA (str, chain)); | |
| 2593 } | |
| 2594 | |
| 2595 static void | |
| 2596 chain_print (Lisp_Object cs, Lisp_Object printcharfun, int escapeflag) | |
| 2597 { | |
| 2598 int i; | |
| 2599 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2600 write_ascstring (printcharfun, "("); |
| 771 | 2601 for (i = 0; i < XCODING_SYSTEM_CHAIN_COUNT (cs); i++) |
| 2602 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2603 write_ascstring (printcharfun, i == 0 ? "" : "->"); |
| 771 | 2604 print_coding_system_in_print_method (XCODING_SYSTEM_CHAIN_CHAIN (cs)[i], |
| 2605 printcharfun, escapeflag); | |
| 2606 } | |
| 2607 { | |
| 2608 Lisp_Object cac = XCODING_SYSTEM_CHAIN_CANONICALIZE_AFTER_CODING (cs); | |
| 2609 if (!NILP (cac)) | |
| 2610 { | |
| 2611 if (i > 0) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2612 write_ascstring (printcharfun, " "); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2613 write_ascstring (printcharfun, "canonicalize-after-coding="); |
| 771 | 2614 print_coding_system_in_print_method (cac, printcharfun, escapeflag); |
| 2615 } | |
| 2616 } | |
| 2617 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
2618 write_ascstring (printcharfun, ")"); |
| 771 | 2619 } |
| 2620 | |
| 2621 static void | |
| 2622 chain_rewind_coding_stream_1 (struct chain_coding_stream *data) | |
| 2623 { | |
| 2624 /* Each will rewind the next; there is always at least one stream (the | |
| 2625 dynarr stream at the end) if we're initted */ | |
| 2626 if (data->initted) | |
| 2627 Lstream_rewind (XLSTREAM (data->lstreams[0])); | |
| 2628 } | |
| 2629 | |
| 2630 static void | |
| 2631 chain_rewind_coding_stream (struct coding_stream *str) | |
| 2632 { | |
| 2633 chain_rewind_coding_stream_1 (CODING_STREAM_TYPE_DATA (str, chain)); | |
| 2634 } | |
| 2635 | |
| 2636 static void | |
| 2637 chain_init_coding_streams_1 (struct chain_coding_stream *data, | |
| 2638 unsigned_char_dynarr *dst, | |
| 2639 int ncodesys, Lisp_Object *codesys, | |
| 2640 enum encode_decode direction) | |
| 2641 { | |
| 2642 int i; | |
| 2643 Lisp_Object lstream_out; | |
| 2644 | |
| 2645 data->lstream_count = ncodesys + 1; | |
| 2646 data->lstreams = xnew_array (Lisp_Object, data->lstream_count); | |
| 2647 | |
| 2648 lstream_out = make_dynarr_output_stream (dst); | |
| 2649 Lstream_set_buffering (XLSTREAM (lstream_out), LSTREAM_UNBUFFERED, 0); | |
| 2650 data->lstreams[data->lstream_count - 1] = lstream_out; | |
| 2651 | |
| 2652 for (i = ncodesys - 1; i >= 0; i--) | |
| 2653 { | |
| 2654 data->lstreams[i] = | |
| 2655 make_coding_output_stream | |
| 2656 (XLSTREAM (lstream_out), | |
| 2657 codesys[direction == CODING_ENCODE ? ncodesys - (i + 1) : i], | |
| 800 | 2658 direction, 0); |
| 771 | 2659 lstream_out = data->lstreams[i]; |
| 2660 Lstream_set_buffering (XLSTREAM (lstream_out), LSTREAM_UNBUFFERED, | |
| 2661 0); | |
| 2662 } | |
| 2663 data->initted = 1; | |
| 2664 } | |
| 2665 | |
| 2666 static Bytecount | |
| 2667 chain_convert (struct coding_stream *str, const UExtbyte *src, | |
| 2668 unsigned_char_dynarr *dst, Bytecount n) | |
| 2669 { | |
| 2670 struct chain_coding_stream *data = CODING_STREAM_TYPE_DATA (str, chain); | |
| 2671 | |
| 2672 if (str->eof) | |
| 2673 { | |
| 2674 /* Each will close the next; there is always at least one stream (the | |
| 2675 dynarr stream at the end) if we're initted. We need to close now | |
| 2676 because more data may be generated. */ | |
| 2677 if (data->initted) | |
| 2678 Lstream_close (XLSTREAM (data->lstreams[0])); | |
| 2679 return n; | |
| 2680 } | |
| 2681 | |
| 2682 if (!data->initted) | |
| 2683 chain_init_coding_streams_1 | |
| 2684 (data, dst, XCODING_SYSTEM_CHAIN_COUNT (str->codesys), | |
| 2685 XCODING_SYSTEM_CHAIN_CHAIN (str->codesys), str->direction); | |
| 2686 | |
| 2687 if (Lstream_write (XLSTREAM (data->lstreams[0]), src, n) < 0) | |
| 2688 return -1; | |
| 2689 return n; | |
| 2690 } | |
| 2691 | |
| 2692 static void | |
| 2693 chain_finalize_coding_stream_1 (struct chain_coding_stream *data) | |
| 2694 { | |
| 2695 if (data->lstreams) | |
| 2696 { | |
| 2297 | 2697 /* During GC, these objects are unmarked, and are about to be freed. |
| 2698 We do NOT want them on the free list, and that will cause lots of | |
| 2699 nastiness including crashes. Just let them be freed normally. */ | |
| 771 | 2700 if (!gc_in_progress) |
| 2701 { | |
| 2702 int i; | |
| 2297 | 2703 /* Order of deletion is important here! Delete from the head of |
| 2704 the chain and work your way towards the tail. In general, | |
| 2705 when you delete an object, there should be *NO* pointers to it | |
| 2706 anywhere. Deleting back-to-front would be a problem because | |
| 2707 there are pointers going forward. If there were pointers in | |
| 2708 both directions, you'd have to disconnect the pointers to a | |
| 2709 particular object before deleting it. */ | |
| 771 | 2710 for (i = 0; i < data->lstream_count; i++) |
| 2711 Lstream_delete (XLSTREAM ((data->lstreams)[i])); | |
| 2712 } | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
2713 xfree (data->lstreams); |
| 771 | 2714 } |
| 2715 } | |
| 2716 | |
| 2717 static void | |
| 2718 chain_finalize_coding_stream (struct coding_stream *str) | |
| 2719 { | |
| 2720 chain_finalize_coding_stream_1 (CODING_STREAM_TYPE_DATA (str, chain)); | |
| 2721 } | |
| 2722 | |
| 2723 static void | |
| 2724 chain_finalize (Lisp_Object c) | |
| 2725 { | |
| 2726 if (XCODING_SYSTEM_CHAIN_CHAIN (c)) | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
2727 xfree (XCODING_SYSTEM_CHAIN_CHAIN (c)); |
| 771 | 2728 } |
| 2729 | |
| 428 | 2730 static int |
| 771 | 2731 chain_putprop (Lisp_Object codesys, Lisp_Object key, Lisp_Object value) |
| 2732 { | |
| 2733 if (EQ (key, Qchain)) | |
| 2734 { | |
| 2735 Lisp_Object *cslist; | |
| 2736 int count = 0; | |
| 2737 int i; | |
| 2738 | |
| 2367 | 2739 { |
| 2740 EXTERNAL_LIST_LOOP_2 (elt, value) | |
| 2741 { | |
| 2742 Fget_coding_system (elt); | |
| 2743 count++; | |
| 2744 } | |
| 2745 } | |
| 771 | 2746 |
| 2747 cslist = xnew_array (Lisp_Object, count); | |
| 2748 XCODING_SYSTEM_CHAIN_CHAIN (codesys) = cslist; | |
| 2749 | |
| 2750 count = 0; | |
| 2367 | 2751 { |
| 2752 EXTERNAL_LIST_LOOP_2 (elt, value) | |
| 2753 { | |
| 2754 cslist[count] = Fget_coding_system (elt); | |
| 2755 count++; | |
| 2756 } | |
| 2757 } | |
| 771 | 2758 |
| 2759 XCODING_SYSTEM_CHAIN_COUNT (codesys) = count; | |
| 2760 | |
| 2761 for (i = 0; i < count - 1; i++) | |
| 2762 { | |
| 2763 if (decoding_source_sink_type_is_char (cslist[i], CODING_SINK) != | |
| 2764 decoding_source_sink_type_is_char (cslist[i + 1], CODING_SOURCE)) | |
| 2765 invalid_argument_2 ("Sink of first must match source of second", | |
| 2766 cslist[i], cslist[i + 1]); | |
| 2767 } | |
| 2768 } | |
| 2769 else if (EQ (key, Qcanonicalize_after_coding)) | |
| 2770 XCODING_SYSTEM_CHAIN_CANONICALIZE_AFTER_CODING (codesys) = | |
| 2771 Fget_coding_system (value); | |
| 2772 else | |
| 2773 return 0; | |
| 2774 return 1; | |
| 2775 } | |
| 2776 | |
| 2777 static Lisp_Object | |
| 2778 chain_getprop (Lisp_Object coding_system, Lisp_Object prop) | |
| 2779 { | |
| 2780 if (EQ (prop, Qchain)) | |
| 2781 { | |
| 2782 Lisp_Object result = Qnil; | |
| 2783 int i; | |
| 2784 | |
| 2785 for (i = 0; i < XCODING_SYSTEM_CHAIN_COUNT (coding_system); i++) | |
| 2786 result = Fcons (XCODING_SYSTEM_CHAIN_CHAIN (coding_system)[i], | |
| 2787 result); | |
| 2788 | |
| 2789 return Fnreverse (result); | |
| 2790 } | |
| 2791 else if (EQ (prop, Qcanonicalize_after_coding)) | |
| 2792 return XCODING_SYSTEM_CHAIN_CANONICALIZE_AFTER_CODING (coding_system); | |
| 2793 else | |
| 2794 return Qunbound; | |
| 2795 } | |
| 2796 | |
| 2797 static enum source_sink_type | |
| 2798 chain_conversion_end_type (Lisp_Object codesys) | |
| 2799 { | |
| 2800 Lisp_Object *cslist = XCODING_SYSTEM_CHAIN_CHAIN (codesys); | |
| 2801 int n = XCODING_SYSTEM_CHAIN_COUNT (codesys); | |
| 2802 int charp_source, charp_sink; | |
| 2803 | |
| 2804 if (n == 0) | |
| 2805 return DECODES_BYTE_TO_BYTE; /* arbitrary */ | |
| 2806 charp_source = decoding_source_sink_type_is_char (cslist[0], CODING_SOURCE); | |
| 2807 charp_sink = decoding_source_sink_type_is_char (cslist[n - 1], CODING_SINK); | |
| 2808 | |
| 2809 switch (charp_source * 2 + charp_sink) | |
| 2810 { | |
| 2811 case 0: return DECODES_BYTE_TO_BYTE; | |
| 2812 case 1: return DECODES_BYTE_TO_CHARACTER; | |
| 2813 case 2: return DECODES_CHARACTER_TO_BYTE; | |
| 2814 case 3: return DECODES_CHARACTER_TO_CHARACTER; | |
| 2815 } | |
| 2816 | |
| 2500 | 2817 ABORT (); |
| 771 | 2818 return DECODES_BYTE_TO_BYTE; |
| 2819 } | |
| 2820 | |
| 2821 | |
| 2822 /************************************************************************/ | |
| 2823 /* No-conversion methods */ | |
| 2824 /************************************************************************/ | |
| 2825 | |
| 2826 /* "No conversion"; used for binary files. We use quotes because there | |
| 2827 really is some conversion being applied (it does byte<->char | |
| 2828 conversion), but it appears to the user as if the text is read in | |
| 2297 | 2829 without conversion. |
| 2830 | |
| 2831 #### Shouldn't we _call_ it that, then? And while we're at it, | |
| 2832 separate it into "to_internal" and "to_external"? */ | |
| 771 | 2833 DEFINE_CODING_SYSTEM_TYPE (no_conversion); |
| 2834 | |
| 2835 /* This is used when reading in "binary" files -- i.e. files that may | |
| 2836 contain all 256 possible byte values and that are not to be | |
| 2837 interpreted as being in any particular encoding. */ | |
| 2838 static Bytecount | |
| 2839 no_conversion_convert (struct coding_stream *str, | |
| 2840 const UExtbyte *src, | |
| 2841 unsigned_char_dynarr *dst, Bytecount n) | |
| 2842 { | |
| 2843 UExtbyte c; | |
| 2844 unsigned int ch = str->ch; | |
| 2845 Bytecount orign = n; | |
| 2846 | |
| 2847 if (str->direction == CODING_DECODE) | |
| 2848 { | |
| 2849 while (n--) | |
| 2850 { | |
| 2851 c = *src++; | |
| 2852 | |
| 2853 DECODE_ADD_BINARY_CHAR (c, dst); | |
| 2854 } | |
| 2855 | |
| 2856 if (str->eof) | |
| 2857 DECODE_OUTPUT_PARTIAL_CHAR (ch, dst); | |
| 2858 } | |
| 2859 else | |
| 2860 { | |
| 2861 | |
| 2862 while (n--) | |
| 2863 { | |
| 2864 c = *src++; | |
| 826 | 2865 if (byte_ascii_p (c)) |
| 771 | 2866 { |
| 2867 assert (ch == 0); | |
| 2868 Dynarr_add (dst, c); | |
| 2869 } | |
| 2870 #ifdef MULE | |
| 867 | 2871 else if (ibyte_leading_byte_p (c)) |
| 771 | 2872 { |
| 2873 assert (ch == 0); | |
| 2874 if (c == LEADING_BYTE_LATIN_ISO8859_1 || | |
| 2875 c == LEADING_BYTE_CONTROL_1) | |
| 2876 ch = c; | |
| 2877 else | |
| 2297 | 2878 /* #### This is just plain unacceptable. */ |
| 771 | 2879 Dynarr_add (dst, '~'); /* untranslatable character */ |
| 2880 } | |
| 2881 else | |
| 2882 { | |
| 2883 if (ch == LEADING_BYTE_LATIN_ISO8859_1) | |
| 2884 Dynarr_add (dst, c); | |
| 2885 else if (ch == LEADING_BYTE_CONTROL_1) | |
| 2886 { | |
| 2887 assert (c < 0xC0); | |
| 2888 Dynarr_add (dst, c - 0x20); | |
| 2889 } | |
| 2890 /* else it should be the second or third byte of an | |
| 2891 untranslatable character, so ignore it */ | |
| 2892 ch = 0; | |
| 2893 } | |
| 2894 #endif /* MULE */ | |
| 2895 | |
| 2896 } | |
| 2897 } | |
| 2898 | |
| 2899 str->ch = ch; | |
| 2900 return orign; | |
| 2901 } | |
| 2902 | |
| 2903 DEFINE_DETECTOR (no_conversion); | |
| 2904 DEFINE_DETECTOR_CATEGORY (no_conversion, no_conversion); | |
| 2905 | |
| 2906 struct no_conversion_detector | |
| 2907 { | |
| 2908 int dummy; | |
| 2909 }; | |
| 2910 | |
| 2911 static void | |
| 2286 | 2912 no_conversion_detect (struct detection_state *st, const UExtbyte *UNUSED (src), |
| 2913 Bytecount UNUSED (n)) | |
| 771 | 2914 { |
| 2915 /* Hack until we get better handling of this stuff! */ | |
| 2916 DET_RESULT (st, no_conversion) = DET_SLIGHTLY_LIKELY; | |
| 2917 } | |
| 2918 | |
| 2919 | |
| 2920 /************************************************************************/ | |
| 2921 /* Convert-eol methods */ | |
| 2922 /************************************************************************/ | |
| 2923 | |
| 2924 /* This is used to handle end-of-line (EOL) differences. It is | |
| 2819 | 2925 character-to-character, and works (when encoding) *BEFORE* sending data to |
| 2926 the main encoding routine -- thus, that routine must handle different EOL | |
| 2927 types itself if it does line-oriented type processing. This is unavoidable | |
| 2928 because we don't know whether the output of the main encoding routine is | |
| 2929 ASCII compatible (UTF-16 is definitely not, for example). [[ sjt sez this | |
| 2930 is bogus. There should be _no_ EOL processing (or processing of any kind) | |
| 2931 after conversion to external. ]] | |
| 771 | 2932 |
| 793 | 2933 There is one parameter: `subtype', either `cr', `lf', `crlf', or nil. |
| 771 | 2934 */ |
| 2935 | |
| 2936 struct convert_eol_coding_system | |
| 2937 { | |
| 2938 enum eol_type subtype; | |
| 2132 | 2939 int dummy; /* On some architectures (eg ia64) the portable dumper can |
| 2940 produce unaligned access errors without this field. Probably | |
| 2941 because the combined structure of this structure and | |
| 2942 Lisp_Coding_System is not properly aligned. */ | |
| 771 | 2943 }; |
| 2944 | |
| 2945 #define CODING_SYSTEM_CONVERT_EOL_SUBTYPE(codesys) \ | |
| 2946 (CODING_SYSTEM_TYPE_DATA (codesys, convert_eol)->subtype) | |
| 2947 #define XCODING_SYSTEM_CONVERT_EOL_SUBTYPE(codesys) \ | |
| 2948 (XCODING_SYSTEM_TYPE_DATA (codesys, convert_eol)->subtype) | |
| 2949 | |
| 2950 struct convert_eol_coding_stream | |
| 2951 { | |
| 2952 enum eol_type actual; | |
| 2953 }; | |
| 2954 | |
| 1204 | 2955 static const struct memory_description |
| 771 | 2956 convert_eol_coding_system_description[] = { |
| 2957 { XD_END } | |
| 2958 }; | |
| 2959 | |
| 1204 | 2960 DEFINE_CODING_SYSTEM_TYPE_WITH_DATA (convert_eol); |
| 2961 | |
| 771 | 2962 static void |
| 2286 | 2963 convert_eol_print (Lisp_Object cs, Lisp_Object printcharfun, |
| 2964 int UNUSED (escapeflag)) | |
| 771 | 2965 { |
| 2966 struct convert_eol_coding_system *data = | |
| 2967 XCODING_SYSTEM_TYPE_DATA (cs, convert_eol); | |
| 2968 | |
| 2969 write_fmt_string (printcharfun, "(%s)", | |
| 2970 data->subtype == EOL_LF ? "lf" : | |
| 2971 data->subtype == EOL_CRLF ? "crlf" : | |
| 2972 data->subtype == EOL_CR ? "cr" : | |
| 793 | 2973 data->subtype == EOL_AUTODETECT ? "nil" : |
| 2500 | 2974 (ABORT(), "")); |
| 771 | 2975 } |
| 2976 | |
| 2977 static enum source_sink_type | |
| 2286 | 2978 convert_eol_conversion_end_type (Lisp_Object UNUSED (codesys)) |
| 771 | 2979 { |
| 2980 return DECODES_CHARACTER_TO_CHARACTER; | |
| 2981 } | |
| 2982 | |
| 2983 static int | |
| 2984 convert_eol_putprop (Lisp_Object codesys, | |
| 2985 Lisp_Object key, | |
| 2986 Lisp_Object value) | |
| 2987 { | |
| 2988 struct convert_eol_coding_system *data = | |
| 2989 XCODING_SYSTEM_TYPE_DATA (codesys, convert_eol); | |
| 2990 | |
| 2991 if (EQ (key, Qsubtype)) | |
| 2992 { | |
| 2993 if (EQ (value, Qlf) /* || EQ (value, Qunix) */) | |
| 2994 data->subtype = EOL_LF; | |
| 2995 else if (EQ (value, Qcrlf) /* || EQ (value, Qdos) */) | |
| 2996 data->subtype = EOL_CRLF; | |
| 2997 else if (EQ (value, Qcr) /* || EQ (value, Qmac) */) | |
| 2998 data->subtype = EOL_CR; | |
| 793 | 2999 else if (EQ (value, Qnil)) |
| 771 | 3000 data->subtype = EOL_AUTODETECT; |
| 3001 else invalid_constant ("Unrecognized eol type", value); | |
| 3002 } | |
| 3003 else | |
| 3004 return 0; | |
| 3005 return 1; | |
| 3006 } | |
| 3007 | |
| 3008 static Lisp_Object | |
| 3009 convert_eol_getprop (Lisp_Object coding_system, Lisp_Object prop) | |
| 3010 { | |
| 3011 struct convert_eol_coding_system *data = | |
| 3012 XCODING_SYSTEM_TYPE_DATA (coding_system, convert_eol); | |
| 3013 | |
| 3014 if (EQ (prop, Qsubtype)) | |
| 3015 { | |
| 3016 switch (data->subtype) | |
| 3017 { | |
| 3018 case EOL_LF: return Qlf; | |
| 3019 case EOL_CRLF: return Qcrlf; | |
| 3020 case EOL_CR: return Qcr; | |
| 793 | 3021 case EOL_AUTODETECT: return Qnil; |
| 2500 | 3022 default: ABORT (); |
| 771 | 3023 } |
| 3024 } | |
| 3025 | |
| 3026 return Qunbound; | |
| 3027 } | |
| 3028 | |
| 3029 static void | |
| 3030 convert_eol_init_coding_stream (struct coding_stream *str) | |
| 3031 { | |
| 3032 struct convert_eol_coding_stream *data = | |
| 3033 CODING_STREAM_TYPE_DATA (str, convert_eol); | |
| 3034 data->actual = XCODING_SYSTEM_CONVERT_EOL_SUBTYPE (str->codesys); | |
| 3035 } | |
| 3036 | |
| 3037 static Bytecount | |
| 867 | 3038 convert_eol_convert (struct coding_stream *str, const Ibyte *src, |
| 771 | 3039 unsigned_char_dynarr *dst, Bytecount n) |
| 3040 { | |
| 3041 if (str->direction == CODING_DECODE) | |
| 3042 { | |
| 3043 struct convert_eol_coding_stream *data = | |
| 3044 CODING_STREAM_TYPE_DATA (str, convert_eol); | |
| 3045 | |
| 3046 if (data->actual == EOL_AUTODETECT) | |
| 3047 { | |
| 3048 Bytecount n2 = n; | |
| 867 | 3049 const Ibyte *src2 = src; |
| 771 | 3050 |
| 3051 for (; n2; n2--) | |
| 3052 { | |
| 867 | 3053 Ibyte c = *src2++; |
| 771 | 3054 if (c == '\n') |
| 3055 { | |
| 3056 data->actual = EOL_LF; | |
| 3057 break; | |
| 3058 } | |
| 3059 else if (c == '\r') | |
| 3060 { | |
| 3061 if (n2 == 1) | |
| 3062 { | |
| 3063 /* If we're seeing a '\r' at the end of the data, then | |
| 3064 reject the '\r' right now so it doesn't become an | |
| 3065 issue in the code below -- unless we're at the end of | |
| 3066 the stream, in which case we can't do that (because | |
| 3067 then the '\r' will never get written out), and in any | |
| 3068 case we should be recognizing it at EOL_CR format. */ | |
| 3069 if (str->eof) | |
| 3070 data->actual = EOL_CR; | |
| 3071 else | |
| 3072 n--; | |
| 3073 break; | |
| 3074 } | |
| 3075 else if (*src2 == '\n') | |
| 3076 data->actual = EOL_CRLF; | |
| 3077 else | |
| 3078 data->actual = EOL_CR; | |
| 3079 break; | |
| 3080 } | |
| 3081 } | |
| 3082 } | |
| 3083 | |
| 3084 /* str->eof is set, the caller reached EOF on the other end and has | |
| 3085 no new data to give us. The only data we get is the data we | |
| 3086 rejected from last time. */ | |
| 3087 if (data->actual == EOL_LF || data->actual == EOL_AUTODETECT || | |
| 3088 (str->eof)) | |
| 3089 Dynarr_add_many (dst, src, n); | |
| 3090 else | |
| 3091 { | |
| 867 | 3092 const Ibyte *end = src + n; |
| 771 | 3093 while (1) |
| 3094 { | |
| 3095 /* Find the next section with no \r and add it. */ | |
| 867 | 3096 const Ibyte *runstart = src; |
| 3097 src = (Ibyte *) memchr (src, '\r', end - src); | |
| 771 | 3098 if (!src) |
| 3099 src = end; | |
| 3100 Dynarr_add_many (dst, runstart, src - runstart); | |
| 3101 /* Stop if at end ... */ | |
| 3102 if (src == end) | |
| 3103 break; | |
| 3104 /* ... else, translate as necessary. */ | |
| 3105 src++; | |
| 3106 if (data->actual == EOL_CR) | |
| 3107 Dynarr_add (dst, '\n'); | |
| 3108 /* We need to be careful here with CRLF. If we see a CR at the | |
| 3109 end of the data, we don't know if it's part of a CRLF, so we | |
| 3110 reject it. Otherwise: If it's part of a CRLF, eat it and | |
| 3111 loop; the following LF gets added next time around. If it's | |
| 3112 not part of a CRLF, add the CR and loop. The following | |
| 3113 character will be processed in the next loop iteration. This | |
| 3114 correctly handles a sequence like CR+CR+LF. */ | |
| 3115 else if (src == end) | |
| 3116 return n - 1; /* reject the CR at the end; we'll get it again | |
| 3117 next time the convert method is called */ | |
| 3118 else if (*src != '\n') | |
| 3119 Dynarr_add (dst, '\r'); | |
| 3120 } | |
| 3121 } | |
| 3122 | |
| 3123 return n; | |
| 3124 } | |
| 3125 else | |
| 3126 { | |
| 3127 enum eol_type subtype = | |
| 3128 XCODING_SYSTEM_CONVERT_EOL_SUBTYPE (str->codesys); | |
| 867 | 3129 const Ibyte *end = src + n; |
| 771 | 3130 |
| 3131 /* We try to be relatively efficient here. */ | |
| 3132 if (subtype == EOL_LF) | |
| 3133 Dynarr_add_many (dst, src, n); | |
| 3134 else | |
| 3135 { | |
| 3136 while (1) | |
| 3137 { | |
| 3138 /* Find the next section with no \n and add it. */ | |
| 867 | 3139 const Ibyte *runstart = src; |
| 3140 src = (Ibyte *) memchr (src, '\n', end - src); | |
| 771 | 3141 if (!src) |
| 3142 src = end; | |
| 3143 Dynarr_add_many (dst, runstart, src - runstart); | |
| 3144 /* Stop if at end ... */ | |
| 3145 if (src == end) | |
| 3146 break; | |
| 3147 /* ... else, skip over \n and add its translation. */ | |
| 3148 src++; | |
| 3149 Dynarr_add (dst, '\r'); | |
| 3150 if (subtype == EOL_CRLF) | |
| 3151 Dynarr_add (dst, '\n'); | |
| 3152 } | |
| 3153 } | |
| 3154 | |
| 3155 return n; | |
| 3156 } | |
| 3157 } | |
| 3158 | |
| 3159 static Lisp_Object | |
| 3160 convert_eol_canonicalize_after_coding (struct coding_stream *str) | |
| 3161 { | |
| 3162 struct convert_eol_coding_stream *data = | |
| 3163 CODING_STREAM_TYPE_DATA (str, convert_eol); | |
| 3164 | |
| 3165 if (str->direction == CODING_ENCODE) | |
| 3166 return str->codesys; | |
| 3167 | |
| 3168 switch (data->actual) | |
| 3169 { | |
| 3170 case EOL_LF: return Fget_coding_system (Qconvert_eol_lf); | |
| 3171 case EOL_CRLF: return Fget_coding_system (Qconvert_eol_crlf); | |
| 3172 case EOL_CR: return Fget_coding_system (Qconvert_eol_cr); | |
| 3173 case EOL_AUTODETECT: return str->codesys; | |
| 2500 | 3174 default: ABORT (); return Qnil; |
| 771 | 3175 } |
| 3176 } | |
| 3177 | |
| 3178 | |
| 3179 /************************************************************************/ | |
| 3180 /* Undecided methods */ | |
| 3181 /************************************************************************/ | |
| 3182 | |
| 3183 /* Do autodetection. We can autodetect the EOL type only, the coding | |
| 3184 system only, or both. We only do autodetection when decoding; when | |
| 3185 encoding, we just pass the data through. | |
| 3186 | |
| 3187 When doing just EOL detection, a coding system can be specified; if so, | |
| 3188 we will decode this data through the coding system before doing EOL | |
| 3189 detection. The reason for specifying this is so that | |
| 3190 canonicalize-after-coding works: We will canonicalize the specified | |
| 3191 coding system into the appropriate EOL type. When doing both coding and | |
| 3192 EOL detection, we do similar canonicalization, and also catch situations | |
| 3193 where the EOL type is overspecified, i.e. the detected coding system | |
| 3194 specifies an EOL type, and either switch to the equivalent | |
| 3195 non-EOL-processing coding system (if possible), or terminate EOL | |
| 3196 detection and use the specified EOL type. This prevents data from being | |
| 3197 EOL-processed twice. | |
| 3198 */ | |
| 3199 | |
| 3200 struct undecided_coding_system | |
| 3201 { | |
| 3202 int do_eol, do_coding; | |
| 3203 Lisp_Object cs; | |
| 3204 }; | |
| 3205 | |
| 3206 struct undecided_coding_stream | |
| 3207 { | |
| 3208 Lisp_Object actual; | |
| 3209 /* Either 2 or 3 lstreams here; see undecided_convert */ | |
| 3210 struct chain_coding_stream c; | |
| 3211 | |
| 3212 struct detection_state *st; | |
| 3213 }; | |
| 3214 | |
| 1204 | 3215 static const struct memory_description undecided_coding_system_description[] = { |
| 3216 { XD_LISP_OBJECT, offsetof (struct undecided_coding_system, cs) }, | |
| 771 | 3217 { XD_END } |
| 3218 }; | |
| 3219 | |
| 1204 | 3220 static const struct memory_description undecided_coding_stream_description_1 [] = { |
| 3221 { XD_LISP_OBJECT, offsetof (struct undecided_coding_stream, actual) }, | |
| 2367 | 3222 { XD_BLOCK_ARRAY, offsetof (struct undecided_coding_stream, c), |
| 2551 | 3223 1, { &chain_coding_stream_description } }, |
| 1204 | 3224 { XD_END } |
| 3225 }; | |
| 3226 | |
| 3227 const struct sized_memory_description undecided_coding_stream_description = { | |
| 3228 sizeof (struct undecided_coding_stream), undecided_coding_stream_description_1 | |
| 3229 }; | |
| 3230 | |
| 3231 DEFINE_CODING_SYSTEM_TYPE_WITH_DATA (undecided); | |
| 3232 | |
| 771 | 3233 static void |
| 3234 undecided_init (Lisp_Object codesys) | |
| 3235 { | |
| 3236 struct undecided_coding_system *data = | |
| 3237 XCODING_SYSTEM_TYPE_DATA (codesys, undecided); | |
| 3238 | |
| 3239 data->cs = Qnil; | |
| 3240 } | |
| 3241 | |
| 3242 static void | |
| 3243 undecided_mark (Lisp_Object codesys) | |
| 3244 { | |
| 3245 struct undecided_coding_system *data = | |
| 3246 XCODING_SYSTEM_TYPE_DATA (codesys, undecided); | |
| 3247 | |
| 3248 mark_object (data->cs); | |
| 3249 } | |
| 3250 | |
| 3251 static void | |
| 3252 undecided_print (Lisp_Object cs, Lisp_Object printcharfun, int escapeflag) | |
| 3253 { | |
| 3254 struct undecided_coding_system *data = | |
| 3255 XCODING_SYSTEM_TYPE_DATA (cs, undecided); | |
| 3256 int need_space = 0; | |
| 3257 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3258 write_ascstring (printcharfun, "("); |
| 771 | 3259 if (data->do_eol) |
| 3260 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3261 write_ascstring (printcharfun, "do-eol"); |
| 771 | 3262 need_space = 1; |
| 3263 } | |
| 3264 if (data->do_coding) | |
| 3265 { | |
| 3266 if (need_space) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3267 write_ascstring (printcharfun, " "); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3268 write_ascstring (printcharfun, "do-coding"); |
| 771 | 3269 need_space = 1; |
| 3270 } | |
| 3271 if (!NILP (data->cs)) | |
| 3272 { | |
| 3273 if (need_space) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3274 write_ascstring (printcharfun, " "); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3275 write_ascstring (printcharfun, "coding-system="); |
| 771 | 3276 print_coding_system_in_print_method (data->cs, printcharfun, escapeflag); |
| 3277 } | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3278 write_ascstring (printcharfun, ")"); |
| 771 | 3279 } |
| 3280 | |
| 3281 static void | |
| 3282 undecided_mark_coding_stream (struct coding_stream *str) | |
| 3283 { | |
| 1204 | 3284 mark_object (CODING_STREAM_TYPE_DATA (str, undecided)->actual); |
| 771 | 3285 chain_mark_coding_stream_1 (&CODING_STREAM_TYPE_DATA (str, undecided)->c); |
| 3286 } | |
| 3287 | |
| 3288 static int | |
| 3289 undecided_putprop (Lisp_Object codesys, Lisp_Object key, Lisp_Object value) | |
| 3290 { | |
| 3291 struct undecided_coding_system *data = | |
| 3292 XCODING_SYSTEM_TYPE_DATA (codesys, undecided); | |
| 3293 | |
| 3294 if (EQ (key, Qdo_eol)) | |
| 3295 data->do_eol = 1; | |
| 3296 else if (EQ (key, Qdo_coding)) | |
| 3297 data->do_coding = 1; | |
| 3298 else if (EQ (key, Qcoding_system)) | |
| 3299 data->cs = get_coding_system_for_text_file (value, 0); | |
| 3300 else | |
| 3301 return 0; | |
| 3302 return 1; | |
| 3303 } | |
| 3304 | |
| 3305 static Lisp_Object | |
| 3306 undecided_getprop (Lisp_Object codesys, Lisp_Object prop) | |
| 3307 { | |
| 3308 struct undecided_coding_system *data = | |
| 3309 XCODING_SYSTEM_TYPE_DATA (codesys, undecided); | |
| 3310 | |
| 3311 if (EQ (prop, Qdo_eol)) | |
| 3312 return data->do_eol ? Qt : Qnil; | |
| 3313 if (EQ (prop, Qdo_coding)) | |
| 3314 return data->do_coding ? Qt : Qnil; | |
| 3315 if (EQ (prop, Qcoding_system)) | |
| 3316 return data->cs; | |
| 3317 return Qunbound; | |
| 3318 } | |
| 3319 | |
| 3320 static struct detection_state * | |
| 3321 allocate_detection_state (void) | |
| 3322 { | |
| 3323 int i; | |
| 3324 Bytecount size = MAX_ALIGN_SIZE (sizeof (struct detection_state)); | |
| 3325 struct detection_state *block; | |
| 3326 | |
| 3327 for (i = 0; i < coding_detector_count; i++) | |
| 3328 size += MAX_ALIGN_SIZE (Dynarr_at (all_coding_detectors, i).data_size); | |
| 3329 | |
| 3330 block = (struct detection_state *) xmalloc_and_zero (size); | |
| 3331 | |
| 3332 size = MAX_ALIGN_SIZE (sizeof (struct detection_state)); | |
| 3333 for (i = 0; i < coding_detector_count; i++) | |
| 3334 { | |
| 3335 block->data_offset[i] = size; | |
| 3336 size += MAX_ALIGN_SIZE (Dynarr_at (all_coding_detectors, i).data_size); | |
| 3337 } | |
| 3338 | |
| 3339 return block; | |
| 3340 } | |
| 3341 | |
| 3342 static void | |
| 3343 free_detection_state (struct detection_state *st) | |
| 3344 { | |
| 3345 int i; | |
| 3346 | |
| 3347 for (i = 0; i < coding_detector_count; i++) | |
| 3348 { | |
| 3349 if (Dynarr_at (all_coding_detectors, i).finalize_detection_state_method) | |
| 3350 Dynarr_at (all_coding_detectors, i).finalize_detection_state_method | |
| 3351 (st); | |
| 3352 } | |
| 3353 | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4967
diff
changeset
|
3354 xfree (st); |
| 771 | 3355 } |
| 3356 | |
| 3357 static int | |
| 3358 coding_category_symbol_to_id (Lisp_Object symbol) | |
| 428 | 3359 { |
| 3360 int i; | |
| 3361 | |
| 3362 CHECK_SYMBOL (symbol); | |
| 771 | 3363 for (i = 0; i < coding_detector_count; i++) |
| 3364 { | |
| 3365 detector_category_dynarr *cats = | |
| 3366 Dynarr_at (all_coding_detectors, i).cats; | |
| 3367 int j; | |
| 3368 | |
| 3369 for (j = 0; j < Dynarr_length (cats); j++) | |
| 3370 if (EQ (Dynarr_at (cats, j).sym, symbol)) | |
| 3371 return Dynarr_at (cats, j).id; | |
| 3372 } | |
| 3373 | |
| 563 | 3374 invalid_constant ("Unrecognized coding category", symbol); |
| 1204 | 3375 RETURN_NOT_REACHED (0); |
| 428 | 3376 } |
| 3377 | |
| 771 | 3378 static Lisp_Object |
| 3379 coding_category_id_to_symbol (int id) | |
| 428 | 3380 { |
| 3381 int i; | |
| 771 | 3382 |
| 3383 for (i = 0; i < coding_detector_count; i++) | |
| 3384 { | |
| 3385 detector_category_dynarr *cats = | |
| 3386 Dynarr_at (all_coding_detectors, i).cats; | |
| 3387 int j; | |
| 3388 | |
| 3389 for (j = 0; j < Dynarr_length (cats); j++) | |
| 3390 if (id == Dynarr_at (cats, j).id) | |
| 3391 return Dynarr_at (cats, j).sym; | |
| 3392 } | |
| 3393 | |
| 2500 | 3394 ABORT (); |
| 771 | 3395 return Qnil; /* (usually) not reached */ |
| 428 | 3396 } |
| 3397 | |
| 771 | 3398 static Lisp_Object |
| 3399 detection_result_number_to_symbol (enum detection_result result) | |
| 428 | 3400 { |
| 1494 | 3401 /* let compiler warn if not all enumerators are handled */ |
| 3402 switch (result) { | |
| 3403 #define FROB(sym, num) case num: return (sym) | |
| 771 | 3404 FROB (Qnear_certainty, DET_NEAR_CERTAINTY); |
| 3405 FROB (Qquite_probable, DET_QUITE_PROBABLE); | |
| 3406 FROB (Qsomewhat_likely, DET_SOMEWHAT_LIKELY); | |
| 1494 | 3407 FROB (Qslightly_likely, DET_SLIGHTLY_LIKELY); |
| 771 | 3408 FROB (Qas_likely_as_unlikely, DET_AS_LIKELY_AS_UNLIKELY); |
| 3409 FROB (Qsomewhat_unlikely, DET_SOMEWHAT_UNLIKELY); | |
| 3410 FROB (Qquite_improbable, DET_QUITE_IMPROBABLE); | |
| 3411 FROB (Qnearly_impossible, DET_NEARLY_IMPOSSIBLE); | |
| 3412 #undef FROB | |
| 1494 | 3413 } |
| 771 | 3414 |
| 2500 | 3415 ABORT (); |
| 771 | 3416 return Qnil; /* (usually) not reached */ |
| 3417 } | |
| 3418 | |
| 778 | 3419 #if 0 /* not used */ |
| 771 | 3420 static enum detection_result |
| 3421 detection_result_symbol_to_number (Lisp_Object symbol) | |
| 3422 { | |
| 1494 | 3423 /* using switch here would be bad style, and doesn't help */ |
| 771 | 3424 #define FROB(sym, num) if (EQ (symbol, sym)) return (num) |
| 3425 FROB (Qnear_certainty, DET_NEAR_CERTAINTY); | |
| 3426 FROB (Qquite_probable, DET_QUITE_PROBABLE); | |
| 3427 FROB (Qsomewhat_likely, DET_SOMEWHAT_LIKELY); | |
| 1494 | 3428 FROB (Qslightly_likely, DET_SLIGHTLY_LIKELY); |
| 771 | 3429 FROB (Qas_likely_as_unlikely, DET_AS_LIKELY_AS_UNLIKELY); |
| 3430 FROB (Qsomewhat_unlikely, DET_SOMEWHAT_UNLIKELY); | |
| 3431 FROB (Qquite_improbable, DET_QUITE_IMPROBABLE); | |
| 3432 FROB (Qnearly_impossible, DET_NEARLY_IMPOSSIBLE); | |
| 3433 #undef FROB | |
| 3434 | |
| 3435 invalid_constant ("Unrecognized detection result", symbol); | |
| 3436 return ((enum detection_result) 0); /* not reached */ | |
| 3437 } | |
| 778 | 3438 #endif /* 0 */ |
| 771 | 3439 |
| 3440 /* Set all detection results for a given detector to a specified value. */ | |
| 3441 void | |
| 3442 set_detection_results (struct detection_state *st, int detector, int given) | |
| 3443 { | |
| 3444 detector_category_dynarr *cats = | |
| 3445 Dynarr_at (all_coding_detectors, detector).cats; | |
| 3446 int i; | |
| 3447 | |
| 3448 for (i = 0; i < Dynarr_length (cats); i++) | |
| 3449 st->categories[Dynarr_at (cats, i).id] = given; | |
| 3450 } | |
| 428 | 3451 |
| 3452 static int | |
| 3453 acceptable_control_char_p (int c) | |
| 3454 { | |
| 3455 switch (c) | |
| 3456 { | |
| 3457 /* Allow and ignore control characters that you might | |
| 3458 reasonably see in a text file */ | |
| 3459 case '\r': | |
| 3460 case '\n': | |
| 3461 case '\t': | |
| 3462 case 7: /* bell */ | |
| 3463 case 8: /* backspace */ | |
| 3464 case 11: /* vertical tab */ | |
| 3465 case 12: /* form feed */ | |
| 3466 case 26: /* MS-DOS C-z junk */ | |
| 3467 case 31: /* '^_' -- for info */ | |
| 3468 return 1; | |
| 3469 default: | |
| 3470 return 0; | |
| 3471 } | |
| 3472 } | |
| 3473 | |
| 771 | 3474 #ifdef DEBUG_XEMACS |
| 3475 | |
| 3476 static UExtbyte | |
| 3477 hex_digit_to_char (int digit) | |
| 428 | 3478 { |
| 771 | 3479 if (digit < 10) |
| 3480 return digit + '0'; | |
| 3481 else | |
| 3482 return digit - 10 + 'A'; | |
| 428 | 3483 } |
| 3484 | |
| 771 | 3485 static void |
| 3486 output_bytes_in_ascii_and_hex (const UExtbyte *src, Bytecount n) | |
| 428 | 3487 { |
| 3425 | 3488 Extbyte *ascii = alloca_array (Extbyte, n + 1); |
| 3489 Extbyte *hex = alloca_array (Extbyte, 3 * n + 1); | |
| 771 | 3490 int i; |
| 3413 | 3491 DECLARE_EISTRING (eistr_ascii); |
| 3492 DECLARE_EISTRING (eistr_hex); | |
| 771 | 3493 |
| 3494 for (i = 0; i < n; i++) | |
| 428 | 3495 { |
| 3425 | 3496 Extbyte c = src[i]; |
| 771 | 3497 if (c < 0x20) |
| 3498 ascii[i] = '.'; | |
| 428 | 3499 else |
| 771 | 3500 ascii[i] = c; |
| 3501 hex[3 * i] = hex_digit_to_char (c >> 4); | |
| 3502 hex[3 * i + 1] = hex_digit_to_char (c & 0xF); | |
| 3503 hex[3 * i + 2] = ' '; | |
| 428 | 3504 } |
| 771 | 3505 ascii[i] = '\0'; |
| 3506 hex[3 * i - 1] = '\0'; | |
| 3413 | 3507 |
| 3508 eicpy_ext(eistr_hex, hex, Qbinary); | |
| 3509 eicpy_ext(eistr_ascii, ascii, Qbinary); | |
| 3510 | |
| 3425 | 3511 stderr_out ("%s %s", eidata(eistr_ascii), eidata(eistr_hex)); |
| 428 | 3512 } |
| 3513 | |
| 771 | 3514 #endif /* DEBUG_XEMACS */ |
| 3515 | |
| 3516 /* Attempt to determine the encoding of the given text. Before calling | |
| 3517 this function for the first time, you must zero out the detection state. | |
| 428 | 3518 |
| 3519 Returns: | |
| 3520 | |
| 771 | 3521 0 == keep going |
| 3522 1 == stop | |
| 428 | 3523 */ |
| 3524 | |
| 3525 static int | |
| 771 | 3526 detect_coding_type (struct detection_state *st, const UExtbyte *src, |
| 3527 Bytecount n) | |
| 428 | 3528 { |
| 771 | 3529 Bytecount n2 = n; |
| 3530 const UExtbyte *src2 = src; | |
| 3531 int i; | |
| 3532 | |
| 3533 #ifdef DEBUG_XEMACS | |
| 3534 if (!NILP (Vdebug_coding_detection)) | |
| 3535 { | |
| 3536 int bytes = min (16, n); | |
| 3537 stderr_out ("detect_coding_type: processing %ld bytes\n", n); | |
| 3538 stderr_out ("First %d: ", bytes); | |
| 3539 output_bytes_in_ascii_and_hex (src, bytes); | |
| 3540 stderr_out ("\nLast %d: ", bytes); | |
| 3541 output_bytes_in_ascii_and_hex (src + n - bytes, bytes); | |
| 3542 stderr_out ("\n"); | |
| 3543 } | |
| 3544 #endif /* DEBUG_XEMACS */ | |
| 428 | 3545 if (!st->seen_non_ascii) |
| 3546 { | |
| 771 | 3547 for (; n2; n2--, src2++) |
| 428 | 3548 { |
| 771 | 3549 UExtbyte c = *src2; |
| 428 | 3550 if ((c < 0x20 && !acceptable_control_char_p (c)) || c >= 0x80) |
| 3551 { | |
| 3552 st->seen_non_ascii = 1; | |
| 3553 break; | |
| 3554 } | |
| 3555 } | |
| 3556 } | |
| 3557 | |
| 771 | 3558 for (i = 0; i < coding_detector_count; i++) |
| 3559 Dynarr_at (all_coding_detectors, i).detect_method (st, src, n); | |
| 3560 | |
| 3561 st->bytes_seen += n; | |
| 3562 | |
| 3563 #ifdef DEBUG_XEMACS | |
| 3564 if (!NILP (Vdebug_coding_detection)) | |
| 3565 { | |
| 3566 stderr_out ("seen_non_ascii: %d\n", st->seen_non_ascii); | |
| 1494 | 3567 if (coding_detector_category_count <= 0) |
| 3568 stderr_out ("found %d detector categories\n", | |
| 3569 coding_detector_category_count); | |
| 771 | 3570 for (i = 0; i < coding_detector_category_count; i++) |
| 3571 stderr_out_lisp | |
| 3572 ("%s: %s\n", | |
| 3573 2, | |
| 3574 coding_category_id_to_symbol (i), | |
| 3575 detection_result_number_to_symbol ((enum detection_result) | |
| 3576 st->categories[i])); | |
| 3577 } | |
| 3578 #endif /* DEBUG_XEMACS */ | |
| 3579 | |
| 3580 { | |
| 3581 int not_unlikely = 0; | |
| 3582 int retval; | |
| 3583 | |
| 3584 for (i = 0; i < coding_detector_category_count; i++) | |
| 3585 if (st->categories[i] >= 0) | |
| 3586 not_unlikely++; | |
| 3587 | |
| 3588 retval = (not_unlikely <= 1 | |
| 3589 #if 0 /* this is bogus */ | |
| 3590 || st->bytes_seen >= MAX_BYTES_PROCESSED_FOR_DETECTION | |
| 428 | 3591 #endif |
| 771 | 3592 ); |
| 3593 | |
| 3594 #ifdef DEBUG_XEMACS | |
| 3595 if (!NILP (Vdebug_coding_detection)) | |
| 3596 stderr_out ("detect_coding_type: returning %d (%s)\n", | |
| 3597 retval, retval ? "stop" : "keep going"); | |
| 3598 #endif /* DEBUG_XEMACS */ | |
| 3599 | |
| 3600 return retval; | |
| 428 | 3601 } |
| 3602 } | |
| 3603 | |
| 3604 static Lisp_Object | |
| 771 | 3605 detected_coding_system (struct detection_state *st) |
| 428 | 3606 { |
| 771 | 3607 int i; |
| 3608 int even = 1; | |
| 3609 | |
| 3610 if (st->seen_non_ascii) | |
| 3611 { | |
| 3612 for (i = 0; i < coding_detector_category_count; i++) | |
| 3613 if (st->categories[i] != DET_AS_LIKELY_AS_UNLIKELY) | |
| 3614 { | |
| 3615 even = 0; | |
| 3616 break; | |
| 3617 } | |
| 3618 } | |
| 3619 | |
| 3620 /* #### Here we are ignoring the results of detection when it's all | |
| 3621 ASCII. This is obviously a bad thing. But we need to fix up the | |
| 3622 existing detection methods somewhat before we can switch. */ | |
| 3623 if (even) | |
| 428 | 3624 { |
| 3625 /* If the file was entirely or basically ASCII, use the | |
| 3626 default value of `buffer-file-coding-system'. */ | |
| 3627 Lisp_Object retval = | |
| 3628 XBUFFER (Vbuffer_defaults)->buffer_file_coding_system; | |
| 3629 if (!NILP (retval)) | |
| 3630 { | |
| 771 | 3631 retval = find_coding_system_for_text_file (retval, 0); |
| 428 | 3632 if (NILP (retval)) |
| 3633 { | |
| 3634 warn_when_safe | |
| 3635 (Qbad_variable, Qwarning, | |
| 3636 "Invalid `default-buffer-file-coding-system', set to nil"); | |
| 3637 XBUFFER (Vbuffer_defaults)->buffer_file_coding_system = Qnil; | |
| 3638 } | |
| 3639 } | |
| 3640 if (NILP (retval)) | |
| 4100 | 3641 retval = Fget_coding_system (Qbinary); |
| 428 | 3642 return retval; |
| 3643 } | |
| 3644 else | |
| 3645 { | |
| 771 | 3646 int likelihood; |
| 3647 Lisp_Object retval = Qnil; | |
| 3648 | |
| 3649 /* Look through the coding categories first by likelihood and then by | |
| 3650 priority and find the first one that is allowed. */ | |
| 3651 | |
| 3652 for (likelihood = DET_HIGHEST; likelihood >= DET_LOWEST; likelihood--) | |
| 428 | 3653 { |
| 771 | 3654 for (i = 0; i < coding_detector_category_count; i++) |
| 3655 { | |
| 3656 int cat = coding_category_by_priority[i]; | |
| 3657 if (st->categories[cat] == likelihood && | |
| 3658 !NILP (coding_category_system[cat])) | |
| 3659 { | |
| 3660 retval = (get_coding_system_for_text_file | |
| 3661 (coding_category_system[cat], 0)); | |
| 3662 if (likelihood < DET_AS_LIKELY_AS_UNLIKELY) | |
| 3663 warn_when_safe_lispobj | |
| 3664 (intern ("detection"), | |
| 793 | 3665 Qwarning, |
| 771 | 3666 emacs_sprintf_string_lisp |
| 3667 ( | |
| 3668 "Detected coding %s is unlikely to be correct (likelihood == `%s')", | |
| 3669 Qnil, 2, XCODING_SYSTEM_NAME (retval), | |
| 3670 detection_result_number_to_symbol | |
| 3671 ((enum detection_result) likelihood))); | |
| 3672 return retval; | |
| 3673 } | |
| 3674 } | |
| 428 | 3675 } |
| 771 | 3676 |
| 3677 return Fget_coding_system (Qraw_text); | |
| 428 | 3678 } |
| 3679 } | |
| 3680 | |
| 1347 | 3681 /* Look for a coding system in the string (skipping over leading |
| 3682 blanks). If found, return it, otherwise nil. */ | |
| 3683 | |
| 3684 static Lisp_Object | |
| 2531 | 3685 snarf_coding_system (const UExtbyte *p, Bytecount len) |
| 1347 | 3686 { |
| 3687 Bytecount n; | |
| 2531 | 3688 UExtbyte *name; |
| 1347 | 3689 |
| 3690 while (*p == ' ' || *p == '\t') p++, len--; | |
| 3691 len = min (len, 1000); | |
| 3692 name = alloca_ibytes (len + 1); | |
| 3693 memcpy (name, p, len); | |
| 3694 name[len] = '\0'; | |
| 3695 | |
| 3696 /* Get coding system name */ | |
| 3697 /* Characters valid in a MIME charset name (rfc 1521), | |
| 3698 and in a Lisp symbol name. */ | |
| 3699 n = qxestrspn (name, | |
| 3700 "ABCDEFGHIJKLMNOPQRSTUVWXYZ" | |
| 3701 "abcdefghijklmnopqrstuvwxyz" | |
| 3702 "0123456789" | |
| 3703 "!$%&*+-.^_{|}~"); | |
| 3704 if (n > 0) | |
| 3705 { | |
| 3706 name[n] = '\0'; | |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3707 /* This call to intern_istring() is OK because we already verified that |
| 2531 | 3708 there are only ASCII characters in the string */ |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
3709 return find_coding_system_for_text_file (intern_istring ((Ibyte *) name), 0); |
| 1347 | 3710 } |
| 3711 | |
| 3712 return Qnil; | |
| 3713 } | |
| 3714 | |
| 428 | 3715 /* Given a seekable read stream and potential coding system and EOL type |
| 3716 as specified, do any autodetection that is called for. If the | |
| 3717 coding system and/or EOL type are not `autodetect', they will be left | |
| 3718 alone; but this function will never return an autodetect coding system | |
| 3719 or EOL type. | |
| 3720 | |
| 3721 This function does not automatically fetch subsidiary coding systems; | |
| 3722 that should be unnecessary with the explicit eol-type argument. */ | |
| 3723 | |
| 3724 #define LENGTH(string_constant) (sizeof (string_constant) - 1) | |
| 3725 | |
| 771 | 3726 static Lisp_Object |
| 3727 unwind_free_detection_state (Lisp_Object opaque) | |
| 3728 { | |
| 3729 struct detection_state *st = | |
| 3730 (struct detection_state *) get_opaque_ptr (opaque); | |
| 3731 free_detection_state (st); | |
| 3732 free_opaque_ptr (opaque); | |
| 3733 return Qnil; | |
| 3734 } | |
| 3735 | |
| 1347 | 3736 /* #### This duplicates code in `find-coding-system-magic-cookie-in-file' |
| 3737 in files.el. Look into combining them. */ | |
| 3738 | |
| 771 | 3739 static Lisp_Object |
| 3740 look_for_coding_system_magic_cookie (const UExtbyte *data, Bytecount len) | |
| 428 | 3741 { |
| 771 | 3742 const UExtbyte *p; |
| 3743 const UExtbyte *scan_end; | |
| 2531 | 3744 Bytecount cookie_len; |
| 771 | 3745 |
| 3746 /* Look for initial "-*-"; mode line prefix */ | |
| 3747 for (p = data, | |
| 3748 scan_end = data + len - LENGTH ("-*-coding:?-*-"); | |
| 3749 p <= scan_end | |
| 3750 && *p != '\n' | |
| 3751 && *p != '\r'; | |
| 3752 p++) | |
| 3753 if (*p == '-' && *(p+1) == '*' && *(p+2) == '-') | |
| 3754 { | |
| 3755 const UExtbyte *local_vars_beg = p + 3; | |
| 3756 /* Look for final "-*-"; mode line suffix */ | |
| 3757 for (p = local_vars_beg, | |
| 3758 scan_end = data + len - LENGTH ("-*-"); | |
| 3759 p <= scan_end | |
| 428 | 3760 && *p != '\n' |
| 3761 && *p != '\r'; | |
| 771 | 3762 p++) |
| 3763 if (*p == '-' && *(p+1) == '*' && *(p+2) == '-') | |
| 3764 { | |
| 3765 const UExtbyte *suffix = p; | |
| 3766 /* Look for "coding:" */ | |
| 3767 for (p = local_vars_beg, | |
| 3768 scan_end = suffix - LENGTH ("coding:?"); | |
| 3769 p <= scan_end; | |
| 3770 p++) | |
| 3771 if (memcmp ("coding:", p, LENGTH ("coding:")) == 0 | |
| 3772 && (p == local_vars_beg | |
| 3773 || (*(p-1) == ' ' || | |
| 3774 *(p-1) == '\t' || | |
| 3775 *(p-1) == ';'))) | |
| 3776 { | |
| 3777 p += LENGTH ("coding:"); | |
| 1347 | 3778 return snarf_coding_system (p, suffix - p); |
| 771 | 3779 break; |
| 3780 } | |
| 3781 break; | |
| 3782 } | |
| 3783 break; | |
| 3784 } | |
| 3785 | |
| 2531 | 3786 /* Look for ;;;###coding system */ |
| 3787 | |
| 3788 cookie_len = LENGTH (";;;###coding system: "); | |
| 3789 | |
| 3790 for (p = data, | |
| 3791 scan_end = data + len - cookie_len; | |
| 3792 p <= scan_end; | |
| 3793 p++) | |
| 1347 | 3794 { |
| 2531 | 3795 if (*p == ';' && !memcmp (p, ";;;###coding system: ", cookie_len)) |
| 3796 { | |
| 3797 const UExtbyte *suffix; | |
| 3798 | |
| 3799 p += cookie_len; | |
| 3800 suffix = p; | |
| 3801 while (suffix < scan_end && !isspace (*suffix)) | |
| 3802 suffix++; | |
| 3803 return snarf_coding_system (p, suffix - p); | |
| 3804 } | |
| 1347 | 3805 } |
| 3806 | |
| 3807 return Qnil; | |
| 771 | 3808 } |
| 3809 | |
| 3810 static Lisp_Object | |
| 3811 determine_real_coding_system (Lstream *stream) | |
| 3812 { | |
| 3813 struct detection_state *st = allocate_detection_state (); | |
| 3814 int depth = record_unwind_protect (unwind_free_detection_state, | |
| 3815 make_opaque_ptr (st)); | |
| 3816 UExtbyte buf[4096]; | |
| 3817 Bytecount nread = Lstream_read (stream, buf, sizeof (buf)); | |
| 3818 Lisp_Object coding_system = look_for_coding_system_magic_cookie (buf, nread); | |
| 3819 | |
| 3820 if (NILP (coding_system)) | |
| 3821 { | |
| 3822 while (1) | |
| 3823 { | |
| 3824 if (detect_coding_type (st, buf, nread)) | |
| 428 | 3825 break; |
| 771 | 3826 nread = Lstream_read (stream, buf, sizeof (buf)); |
| 3827 if (nread == 0) | |
| 3828 break; | |
| 428 | 3829 } |
| 771 | 3830 |
| 3831 coding_system = detected_coding_system (st); | |
| 428 | 3832 } |
| 3833 | |
| 3834 Lstream_rewind (stream); | |
| 771 | 3835 |
| 3836 unbind_to (depth); | |
| 3837 return coding_system; | |
| 3838 } | |
| 3839 | |
| 3840 static void | |
| 3841 undecided_init_coding_stream (struct coding_stream *str) | |
| 3842 { | |
| 3843 struct undecided_coding_stream *data = | |
| 3844 CODING_STREAM_TYPE_DATA (str, undecided); | |
| 3845 struct undecided_coding_system *csdata = | |
| 3846 XCODING_SYSTEM_TYPE_DATA (str->codesys, undecided); | |
| 3847 | |
| 3848 data->actual = Qnil; | |
| 3849 | |
| 3850 if (str->direction == CODING_DECODE) | |
| 3851 { | |
| 3852 Lstream *lst = str->other_end; | |
| 3853 | |
| 3854 if ((lst->flags & LSTREAM_FL_READ) && | |
| 3855 Lstream_seekable_p (lst) && | |
| 3856 csdata->do_coding) | |
| 3857 /* We can determine the coding system now. */ | |
| 3858 data->actual = determine_real_coding_system (lst); | |
| 3859 } | |
| 1494 | 3860 |
| 3861 #ifdef DEBUG_XEMACS | |
| 3862 if (!NILP (Vdebug_coding_detection)) | |
| 3863 stderr_out_lisp ("detected coding system: %s\n", 1, data->actual); | |
| 3864 #endif /* DEBUG_XEMACS */ | |
| 771 | 3865 } |
| 3866 | |
| 3867 static void | |
| 3868 undecided_rewind_coding_stream (struct coding_stream *str) | |
| 3869 { | |
| 3870 chain_rewind_coding_stream_1 (&CODING_STREAM_TYPE_DATA (str, undecided)->c); | |
| 3871 } | |
| 3872 | |
| 3873 static void | |
| 3874 undecided_finalize_coding_stream (struct coding_stream *str) | |
| 3875 { | |
| 3876 struct undecided_coding_stream *data = | |
| 3877 CODING_STREAM_TYPE_DATA (str, undecided); | |
| 3878 | |
| 3879 chain_finalize_coding_stream_1 | |
| 3880 (&CODING_STREAM_TYPE_DATA (str, undecided)->c); | |
| 3881 if (data->st) | |
| 3882 free_detection_state (data->st); | |
| 3883 } | |
| 3884 | |
| 3885 static Lisp_Object | |
| 3886 undecided_canonicalize (Lisp_Object codesys) | |
| 3887 { | |
| 3888 struct undecided_coding_system *csdata = | |
| 3889 XCODING_SYSTEM_TYPE_DATA (codesys, undecided); | |
| 3890 if (!csdata->do_eol && !csdata->do_coding) | |
| 3891 return NILP (csdata->cs) ? Fget_coding_system (Qbinary) : csdata->cs; | |
| 3892 if (csdata->do_eol && !csdata->do_coding && NILP (csdata->cs)) | |
| 3893 return Fget_coding_system (Qconvert_eol_autodetect); | |
| 3894 return codesys; | |
| 3895 } | |
| 3896 | |
| 3897 static Bytecount | |
| 3898 undecided_convert (struct coding_stream *str, const UExtbyte *src, | |
| 3899 unsigned_char_dynarr *dst, Bytecount n) | |
| 3900 { | |
| 3901 int first_time = 0; | |
| 3902 | |
| 3903 if (str->direction == CODING_DECODE) | |
| 3904 { | |
| 3905 /* At this point, we have only the following possibilities: | |
| 3906 | |
| 3907 do_eol && do_coding | |
| 3908 do_coding only | |
| 3909 do_eol only and a coding system was specified | |
| 3910 | |
| 3911 Other possibilities are removed during undecided_canonicalize. | |
| 3912 | |
| 3913 Therefore, our substreams are either | |
| 3914 | |
| 3915 lstream_coding -> lstream_dynarr, or | |
| 3916 lstream_coding -> lstream_eol -> lstream_dynarr. | |
| 3917 */ | |
| 3918 struct undecided_coding_system *csdata = | |
| 3919 XCODING_SYSTEM_TYPE_DATA (str->codesys, undecided); | |
| 3920 struct undecided_coding_stream *data = | |
| 3921 CODING_STREAM_TYPE_DATA (str, undecided); | |
| 3922 | |
| 3923 if (str->eof) | |
| 3924 { | |
| 3925 /* Each will close the next. We need to close now because more | |
| 3926 data may be generated. */ | |
| 3927 if (data->c.initted) | |
| 3928 Lstream_close (XLSTREAM (data->c.lstreams[0])); | |
| 3929 return n; | |
| 3930 } | |
| 3931 | |
| 3932 if (!data->c.initted) | |
| 3933 { | |
| 3934 data->c.lstream_count = csdata->do_eol ? 3 : 2; | |
| 3935 data->c.lstreams = xnew_array (Lisp_Object, data->c.lstream_count); | |
| 3936 | |
| 3937 data->c.lstreams[data->c.lstream_count - 1] = | |
| 3938 make_dynarr_output_stream (dst); | |
| 3939 Lstream_set_buffering | |
| 3940 (XLSTREAM (data->c.lstreams[data->c.lstream_count - 1]), | |
| 3941 LSTREAM_UNBUFFERED, 0); | |
| 3942 if (csdata->do_eol) | |
| 3943 { | |
| 3944 data->c.lstreams[1] = | |
| 3945 make_coding_output_stream | |
| 3946 (XLSTREAM (data->c.lstreams[data->c.lstream_count - 1]), | |
| 3947 Fget_coding_system (Qconvert_eol_autodetect), | |
| 800 | 3948 CODING_DECODE, 0); |
| 771 | 3949 Lstream_set_buffering |
| 3950 (XLSTREAM (data->c.lstreams[1]), | |
| 3951 LSTREAM_UNBUFFERED, 0); | |
| 3952 } | |
| 3953 | |
| 3954 data->c.lstreams[0] = | |
| 3955 make_coding_output_stream | |
| 3956 (XLSTREAM (data->c.lstreams[1]), | |
| 3957 /* Substitute binary if we need to detect the encoding */ | |
| 3958 csdata->do_coding ? Qbinary : csdata->cs, | |
| 800 | 3959 CODING_DECODE, 0); |
| 771 | 3960 Lstream_set_buffering (XLSTREAM (data->c.lstreams[0]), |
| 3961 LSTREAM_UNBUFFERED, 0); | |
| 3962 | |
| 3963 first_time = 1; | |
| 3964 data->c.initted = 1; | |
| 3965 } | |
| 3966 | |
| 3967 /* If necessary, do encoding-detection now. We do this when we're a | |
| 3968 writing stream or a non-seekable reading stream, meaning that we | |
| 3969 can't just process the whole input, rewind, and start over. */ | |
| 3970 | |
| 3971 if (csdata->do_coding) | |
| 3972 { | |
| 3973 int actual_was_nil = NILP (data->actual); | |
| 3974 if (NILP (data->actual)) | |
| 3975 { | |
| 3976 if (!data->st) | |
| 3977 data->st = allocate_detection_state (); | |
| 3978 if (first_time) | |
| 3979 /* #### This is cheesy. What we really ought to do is buffer | |
| 3980 up a certain minimum amount of data to get a better result. | |
| 3981 */ | |
| 3982 data->actual = look_for_coding_system_magic_cookie (src, n); | |
| 3983 if (NILP (data->actual)) | |
| 3984 { | |
| 3985 /* #### This is cheesy. What we really ought to do is buffer | |
| 3986 up a certain minimum amount of data so as to get a less | |
| 3987 random result when doing subprocess detection. */ | |
| 3988 detect_coding_type (data->st, src, n); | |
| 3989 data->actual = detected_coding_system (data->st); | |
| 4100 | 3990 /* kludge to prevent infinite recursion */ |
| 3991 if (XCODING_SYSTEM(data->actual)->methods->enumtype == undecided_coding_system) | |
| 3992 data->actual = Fget_coding_system (Qbinary); | |
| 771 | 3993 } |
| 3994 } | |
| 3995 /* We need to set the detected coding system if we actually have | |
| 3996 such a coding system but didn't before. That is the case | |
| 3997 either when we just detected it in the previous code or when | |
| 3998 it was detected during undecided_init_coding_stream(). We | |
| 3999 can check for that using first_time. */ | |
| 4000 if (!NILP (data->actual) && (actual_was_nil || first_time)) | |
| 4001 { | |
| 4002 /* If the detected coding system doesn't allow for EOL | |
| 4003 autodetection, try to get the equivalent that does; | |
| 4004 otherwise, disable EOL detection (overriding whatever | |
| 4005 may already have been detected). */ | |
| 4006 if (XCODING_SYSTEM_EOL_TYPE (data->actual) != EOL_AUTODETECT) | |
| 4007 { | |
| 4008 if (!NILP (XCODING_SYSTEM_SUBSIDIARY_PARENT (data->actual))) | |
| 4009 data->actual = | |
| 4010 XCODING_SYSTEM_SUBSIDIARY_PARENT (data->actual); | |
| 4011 else if (data->c.lstream_count == 3) | |
| 4012 set_coding_stream_coding_system | |
| 4013 (XLSTREAM (data->c.lstreams[1]), | |
| 4014 Fget_coding_system (Qidentity)); | |
| 4015 } | |
| 4016 set_coding_stream_coding_system | |
| 4017 (XLSTREAM (data->c.lstreams[0]), data->actual); | |
| 4018 } | |
| 4019 } | |
| 4020 | |
| 4021 if (Lstream_write (XLSTREAM (data->c.lstreams[0]), src, n) < 0) | |
| 4022 return -1; | |
| 4023 return n; | |
| 4024 } | |
| 4025 else | |
| 4026 return no_conversion_convert (str, src, dst, n); | |
| 4027 } | |
| 4028 | |
| 4029 static Lisp_Object | |
| 4030 undecided_canonicalize_after_coding (struct coding_stream *str) | |
| 4031 { | |
| 4032 struct undecided_coding_stream *data = | |
| 4033 CODING_STREAM_TYPE_DATA (str, undecided); | |
| 4034 Lisp_Object ret, eolret; | |
| 4035 | |
| 4036 if (str->direction == CODING_ENCODE) | |
| 4037 return str->codesys; | |
| 4038 | |
| 4039 if (!data->c.initted) | |
|
4647
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4569
diff
changeset
|
4040 return str->codesys; |
| 771 | 4041 |
| 4042 ret = coding_stream_canonicalize_after_coding | |
| 4043 (XLSTREAM (data->c.lstreams[0])); | |
| 4044 if (NILP (ret)) | |
|
4647
e4ed58cb0e5b
Fix bugs with #'find-file, 0-length files, & coding-system-for-read specified.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4569
diff
changeset
|
4045 ret = str->codesys; |
| 771 | 4046 if (XCODING_SYSTEM_EOL_TYPE (ret) != EOL_AUTODETECT) |
| 4047 return ret; | |
| 4048 eolret = coding_stream_canonicalize_after_coding | |
| 4049 (XLSTREAM (data->c.lstreams[1])); | |
| 4050 if (!EQ (XCODING_SYSTEM_TYPE (eolret), Qconvert_eol)) | |
| 4051 return ret; | |
| 4052 return | |
| 4053 Fsubsidiary_coding_system (ret, Fcoding_system_property (eolret, | |
| 4054 Qsubtype)); | |
| 4055 } | |
| 4056 | |
| 4057 | |
| 4058 /************************************************************************/ | |
| 4059 /* Lisp interface: Coding category functions and detection */ | |
| 4060 /************************************************************************/ | |
| 4061 | |
| 4062 DEFUN ("coding-category-list", Fcoding_category_list, 0, 0, 0, /* | |
| 4063 Return a list of all recognized coding categories. | |
| 4064 */ | |
| 4065 ()) | |
| 4066 { | |
| 4067 int i; | |
| 4068 Lisp_Object list = Qnil; | |
| 4069 | |
| 4070 for (i = 0; i < coding_detector_count; i++) | |
| 4071 { | |
| 4072 detector_category_dynarr *cats = | |
| 4073 Dynarr_at (all_coding_detectors, i).cats; | |
| 4074 int j; | |
| 4075 | |
| 4076 for (j = 0; j < Dynarr_length (cats); j++) | |
| 4077 list = Fcons (Dynarr_at (cats, j).sym, list); | |
| 4078 } | |
| 4079 | |
| 4080 return Fnreverse (list); | |
| 4081 } | |
| 4082 | |
| 4083 DEFUN ("set-coding-priority-list", Fset_coding_priority_list, 1, 1, 0, /* | |
| 4084 Change the priority order of the coding categories. | |
| 4085 LIST should be list of coding categories, in descending order of | |
| 4086 priority. Unspecified coding categories will be lower in priority | |
| 4087 than all specified ones, in the same relative order they were in | |
| 4088 previously. | |
| 4089 */ | |
| 4090 (list)) | |
| 4091 { | |
| 4092 int *category_to_priority = | |
| 4093 alloca_array (int, coding_detector_category_count); | |
| 4094 int i, j; | |
| 4095 | |
| 4096 /* First generate a list that maps coding categories to priorities. */ | |
| 4097 | |
| 4098 for (i = 0; i < coding_detector_category_count; i++) | |
| 4099 category_to_priority[i] = -1; | |
| 4100 | |
| 4101 /* Highest priority comes from the specified list. */ | |
| 4102 i = 0; | |
| 2367 | 4103 { |
| 4104 EXTERNAL_LIST_LOOP_2 (elt, list) | |
| 4105 { | |
| 4106 int cat = coding_category_symbol_to_id (elt); | |
| 4107 | |
| 4108 if (category_to_priority[cat] >= 0) | |
| 4109 sferror ("Duplicate coding category in list", elt); | |
| 4110 category_to_priority[cat] = i++; | |
| 4111 } | |
| 4112 } | |
| 771 | 4113 |
| 4114 /* Now go through the existing categories by priority to retrieve | |
| 4115 the categories not yet specified and preserve their priority | |
| 4116 order. */ | |
| 4117 for (j = 0; j < coding_detector_category_count; j++) | |
| 4118 { | |
| 4119 int cat = coding_category_by_priority[j]; | |
| 4120 if (category_to_priority[cat] < 0) | |
| 4121 category_to_priority[cat] = i++; | |
| 4122 } | |
| 4123 | |
| 4124 /* Now we need to construct the inverse of the mapping we just | |
| 4125 constructed. */ | |
| 4126 | |
| 4127 for (i = 0; i < coding_detector_category_count; i++) | |
| 4128 coding_category_by_priority[category_to_priority[i]] = i; | |
| 4129 | |
| 4130 /* Phew! That was confusing. */ | |
| 4131 return Qnil; | |
| 4132 } | |
| 4133 | |
| 4134 DEFUN ("coding-priority-list", Fcoding_priority_list, 0, 0, 0, /* | |
| 4135 Return a list of coding categories in descending order of priority. | |
| 4136 */ | |
| 4137 ()) | |
| 4138 { | |
| 4139 int i; | |
| 4140 Lisp_Object list = Qnil; | |
| 4141 | |
| 4142 for (i = 0; i < coding_detector_category_count; i++) | |
| 4143 list = | |
| 4144 Fcons (coding_category_id_to_symbol (coding_category_by_priority[i]), | |
| 4145 list); | |
| 4146 return Fnreverse (list); | |
| 4147 } | |
| 4148 | |
| 4149 DEFUN ("set-coding-category-system", Fset_coding_category_system, 2, 2, 0, /* | |
| 4150 Change the coding system associated with a coding category. | |
| 4151 */ | |
| 4152 (coding_category, coding_system)) | |
| 4153 { | |
| 4154 coding_category_system[coding_category_symbol_to_id (coding_category)] = | |
| 4155 Fget_coding_system (coding_system); | |
| 4156 return Qnil; | |
| 4157 } | |
| 4158 | |
| 4159 DEFUN ("coding-category-system", Fcoding_category_system, 1, 1, 0, /* | |
| 4160 Return the coding system associated with a coding category. | |
| 4161 */ | |
| 4162 (coding_category)) | |
| 4163 { | |
| 4164 Lisp_Object sys = | |
| 4165 coding_category_system[coding_category_symbol_to_id (coding_category)]; | |
| 4166 | |
| 4167 if (!NILP (sys)) | |
| 4168 return XCODING_SYSTEM_NAME (sys); | |
| 4169 return Qnil; | |
| 4170 } | |
| 4171 | |
| 800 | 4172 /* Detect the encoding of STREAM. Assumes stream is at the begnning and will |
| 4173 read through to the end of STREAM, leaving it there but open. */ | |
| 4174 | |
| 771 | 4175 Lisp_Object |
| 4176 detect_coding_stream (Lisp_Object stream) | |
| 4177 { | |
| 4178 Lisp_Object val = Qnil; | |
| 4179 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 4180 UExtbyte random_buffer[65536]; | |
| 4181 Lisp_Object binary_instream = | |
| 4182 make_coding_input_stream | |
| 4183 (XLSTREAM (stream), Qbinary, | |
| 814 | 4184 CODING_ENCODE, LSTREAM_FL_NO_CLOSE_OTHER); |
| 771 | 4185 Lisp_Object decstream = |
| 4186 make_coding_input_stream | |
| 4187 (XLSTREAM (binary_instream), | |
| 800 | 4188 Qundecided, CODING_DECODE, 0); |
| 771 | 4189 Lstream *decstr = XLSTREAM (decstream); |
| 4190 | |
| 4191 GCPRO3 (decstream, stream, binary_instream); | |
| 4192 /* Read and discard all data; detection happens as a side effect of this, | |
| 4193 and we examine what was detected afterwards. */ | |
| 4194 while (Lstream_read (decstr, random_buffer, sizeof (random_buffer)) > 0) | |
| 4195 ; | |
| 4196 | |
| 4197 val = coding_stream_detected_coding_system (decstr); | |
| 4198 Lstream_close (decstr); | |
| 4199 Lstream_delete (decstr); | |
| 4200 Lstream_delete (XLSTREAM (binary_instream)); | |
| 4201 UNGCPRO; | |
| 4202 return val; | |
| 428 | 4203 } |
| 4204 | |
| 4205 DEFUN ("detect-coding-region", Fdetect_coding_region, 2, 3, 0, /* | |
| 4206 Detect coding system of the text in the region between START and END. | |
| 444 | 4207 Return a list of possible coding systems ordered by priority. |
| 3025 | 4208 If only ASCII characters are found, return `undecided' or one of |
| 428 | 4209 its subsidiary coding systems according to a detected end-of-line |
| 4210 type. Optional arg BUFFER defaults to the current buffer. | |
| 4211 */ | |
| 4212 (start, end, buffer)) | |
| 4213 { | |
| 4214 Lisp_Object val = Qnil; | |
| 4215 struct buffer *buf = decode_buffer (buffer, 0); | |
| 665 | 4216 Charbpos b, e; |
| 771 | 4217 Lisp_Object lb_instream; |
| 428 | 4218 |
| 4219 get_buffer_range_char (buf, start, end, &b, &e, 0); | |
| 4220 lb_instream = make_lisp_buffer_input_stream (buf, b, e, 0); | |
| 771 | 4221 |
| 4222 val = detect_coding_stream (lb_instream); | |
| 4223 Lstream_delete (XLSTREAM (lb_instream)); | |
| 428 | 4224 return val; |
| 4225 } | |
| 4226 | |
| 4227 | |
| 771 | 4228 |
| 4229 #ifdef DEBUG_XEMACS | |
| 4230 | |
| 428 | 4231 /************************************************************************/ |
| 771 | 4232 /* Internal methods */ |
| 4233 /************************************************************************/ | |
| 4234 | |
| 4235 /* Raw (internally-formatted) data. */ | |
| 4236 DEFINE_CODING_SYSTEM_TYPE (internal); | |
| 428 | 4237 |
| 665 | 4238 static Bytecount |
| 2286 | 4239 internal_convert (struct coding_stream *UNUSED (str), const UExtbyte *src, |
| 771 | 4240 unsigned_char_dynarr *dst, Bytecount n) |
| 4241 { | |
| 4242 Bytecount orign = n; | |
| 4243 Dynarr_add_many (dst, src, n); | |
| 4244 return orign; | |
| 4245 } | |
| 4246 | |
| 4247 #endif /* DEBUG_XEMACS */ | |
| 4248 | |
| 4249 | |
| 4250 | |
| 4251 #ifdef HAVE_ZLIB | |
| 4252 | |
| 4253 /************************************************************************/ | |
| 4254 /* Gzip methods */ | |
| 4255 /************************************************************************/ | |
| 4256 | |
| 4257 struct gzip_coding_system | |
| 428 | 4258 { |
| 771 | 4259 int level; /* 0 through 9, or -1 for default */ |
| 4260 }; | |
| 4261 | |
| 4262 #define CODING_SYSTEM_GZIP_LEVEL(codesys) \ | |
| 4263 (CODING_SYSTEM_TYPE_DATA (codesys, gzip)->level) | |
| 4264 #define XCODING_SYSTEM_GZIP_LEVEL(codesys) \ | |
| 4265 (XCODING_SYSTEM_TYPE_DATA (codesys, gzip)->level) | |
| 4266 | |
| 4267 struct gzip_coding_stream | |
| 428 | 4268 { |
| 771 | 4269 z_stream stream; |
| 4270 int stream_initted; | |
| 4271 int reached_eof; /* #### this should be handled by the caller, once we | |
| 4272 return LSTREAM_EOF */ | |
| 4273 }; | |
| 4274 | |
| 1204 | 4275 static const struct memory_description |
| 771 | 4276 gzip_coding_system_description[] = { |
| 4277 { XD_END } | |
| 4278 }; | |
| 4279 | |
| 1204 | 4280 DEFINE_CODING_SYSTEM_TYPE_WITH_DATA (gzip); |
| 4281 | |
| 771 | 4282 enum source_sink_type |
| 4283 gzip_conversion_end_type (Lisp_Object codesys) | |
| 4284 { | |
| 4285 return DECODES_BYTE_TO_BYTE; | |
| 428 | 4286 } |
| 4287 | |
| 4288 static void | |
| 771 | 4289 gzip_init (Lisp_Object codesys) |
| 4290 { | |
| 4291 struct gzip_coding_system *data = XCODING_SYSTEM_TYPE_DATA (codesys, gzip); | |
| 4292 data->level = -1; | |
| 4293 } | |
| 4294 | |
| 4295 static void | |
| 4296 gzip_print (Lisp_Object cs, Lisp_Object printcharfun, int escapeflag) | |
| 428 | 4297 { |
| 771 | 4298 struct gzip_coding_system *data = XCODING_SYSTEM_TYPE_DATA (cs, gzip); |
| 4299 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4300 write_ascstring (printcharfun, "("); |
| 771 | 4301 if (data->level == -1) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4302 write_ascstring (printcharfun, "default"); |
| 771 | 4303 else |
| 4304 print_internal (make_int (data->level), printcharfun, 0); | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4305 write_ascstring (printcharfun, ")"); |
| 428 | 4306 } |
| 4307 | |
| 4308 static int | |
| 771 | 4309 gzip_putprop (Lisp_Object codesys, Lisp_Object key, Lisp_Object value) |
| 428 | 4310 { |
| 771 | 4311 struct gzip_coding_system *data = XCODING_SYSTEM_TYPE_DATA (codesys, gzip); |
| 4312 | |
| 4313 if (EQ (key, Qlevel)) | |
| 428 | 4314 { |
| 771 | 4315 if (EQ (value, Qdefault)) |
| 4316 data->level = -1; | |
| 4317 else | |
| 428 | 4318 { |
| 771 | 4319 CHECK_INT (value); |
| 4320 check_int_range (XINT (value), 0, 9); | |
| 4321 data->level = XINT (value); | |
| 428 | 4322 } |
| 4323 } | |
| 4324 else | |
| 771 | 4325 return 0; |
| 4326 return 1; | |
| 428 | 4327 } |
| 4328 | |
| 4329 static Lisp_Object | |
| 771 | 4330 gzip_getprop (Lisp_Object coding_system, Lisp_Object prop) |
| 428 | 4331 { |
| 771 | 4332 struct gzip_coding_system *data = |
| 4333 XCODING_SYSTEM_TYPE_DATA (coding_system, gzip); | |
| 4334 | |
| 4335 if (EQ (prop, Qlevel)) | |
| 428 | 4336 { |
| 771 | 4337 if (data->level == -1) |
| 4338 return Qdefault; | |
| 4339 return make_int (data->level); | |
| 428 | 4340 } |
| 771 | 4341 |
| 4342 return Qunbound; | |
| 428 | 4343 } |
| 4344 | |
| 4345 static void | |
| 771 | 4346 gzip_init_coding_stream (struct coding_stream *str) |
| 428 | 4347 { |
| 771 | 4348 struct gzip_coding_stream *data = CODING_STREAM_TYPE_DATA (str, gzip); |
| 4349 if (data->stream_initted) | |
| 428 | 4350 { |
| 771 | 4351 if (str->direction == CODING_DECODE) |
| 4352 inflateEnd (&data->stream); | |
| 4353 else | |
| 4354 deflateEnd (&data->stream); | |
| 4355 data->stream_initted = 0; | |
| 428 | 4356 } |
| 771 | 4357 data->reached_eof = 0; |
| 428 | 4358 } |
| 4359 | |
| 4360 static void | |
| 771 | 4361 gzip_rewind_coding_stream (struct coding_stream *str) |
| 428 | 4362 { |
| 771 | 4363 gzip_init_coding_stream (str); |
| 428 | 4364 } |
| 4365 | |
| 771 | 4366 static Bytecount |
| 4367 gzip_convert (struct coding_stream *str, | |
| 4368 const UExtbyte *src, | |
| 4369 unsigned_char_dynarr *dst, Bytecount n) | |
| 428 | 4370 { |
| 771 | 4371 struct gzip_coding_stream *data = CODING_STREAM_TYPE_DATA (str, gzip); |
| 4372 int zerr; | |
| 4373 if (str->direction == CODING_DECODE) | |
| 428 | 4374 { |
| 771 | 4375 if (data->reached_eof) |
| 4376 return n; /* eat the data */ | |
| 4377 | |
| 4378 if (!data->stream_initted) | |
| 428 | 4379 { |
| 771 | 4380 xzero (data->stream); |
| 4381 if (inflateInit (&data->stream) != Z_OK) | |
| 4382 return LSTREAM_ERROR; | |
| 4383 data->stream_initted = 1; | |
| 428 | 4384 } |
| 771 | 4385 |
| 4386 data->stream.next_in = (Bytef *) src; | |
| 4387 data->stream.avail_in = n; | |
| 4388 | |
| 4389 /* Normally we stop when we've fed all data to the decompressor; but | |
| 4390 if we're at the end of the input, and the decompressor hasn't | |
| 4391 reported EOF, we need to keep going, as there might be more output | |
| 4392 to generate. Z_OK from the decompressor means input was processed | |
| 4393 or output was generated; if neither, we break out of the loop. | |
| 4394 Other return values are: | |
| 4395 | |
| 4396 Z_STREAM_END EOF from decompressor | |
| 4397 Z_DATA_ERROR Corrupted data | |
| 4398 Z_BUF_ERROR No progress possible (this should happen if | |
| 4399 we try to feed it an incomplete file) | |
| 4400 Z_MEM_ERROR Out of memory | |
| 4401 Z_STREAM_ERROR (should never happen) | |
| 4402 Z_NEED_DICT (#### when will this happen?) | |
| 4403 */ | |
| 4404 while (data->stream.avail_in > 0 || str->eof) | |
| 4405 { | |
| 4406 /* Reserve an output buffer of the same size as the input buffer; | |
| 4407 if that's not enough, we keep reserving the same size. */ | |
| 4408 Bytecount reserved = n; | |
| 4409 Dynarr_add_many (dst, 0, reserved); | |
| 4410 /* Careful here! Don't retrieve the pointer until after | |
| 4411 reserving the space, or it might be bogus */ | |
| 4412 data->stream.next_out = | |
| 4413 Dynarr_atp (dst, Dynarr_length (dst) - reserved); | |
| 4414 data->stream.avail_out = reserved; | |
| 4415 zerr = inflate (&data->stream, Z_NO_FLUSH); | |
| 4416 /* Lop off the unused portion */ | |
| 5038 | 4417 Dynarr_set_lengthr (dst, Dynarr_length (dst) - data->stream.avail_out); |
| 771 | 4418 if (zerr != Z_OK) |
| 4419 break; | |
| 4420 } | |
| 4421 | |
| 4422 if (zerr == Z_STREAM_END) | |
| 4423 data->reached_eof = 1; | |
| 4424 | |
| 4425 if ((Bytecount) data->stream.avail_in < n) | |
| 4426 return n - data->stream.avail_in; | |
| 4427 | |
| 4428 if (zerr == Z_OK || zerr == Z_STREAM_END) | |
| 4429 return 0; | |
| 4430 | |
| 4431 return LSTREAM_ERROR; | |
| 428 | 4432 } |
| 4433 else | |
| 4434 { | |
| 771 | 4435 if (!data->stream_initted) |
| 4436 { | |
| 4437 int level = XCODING_SYSTEM_GZIP_LEVEL (str->codesys); | |
| 4438 xzero (data->stream); | |
| 4439 if (deflateInit (&data->stream, | |
| 4440 level == -1 ? Z_DEFAULT_COMPRESSION : level) != | |
| 4441 Z_OK) | |
| 4442 return LSTREAM_ERROR; | |
| 4443 data->stream_initted = 1; | |
| 428 | 4444 } |
| 771 | 4445 |
| 4446 data->stream.next_in = (Bytef *) src; | |
| 4447 data->stream.avail_in = n; | |
| 4448 | |
| 4449 /* Normally we stop when we've fed all data to the compressor; but if | |
| 4450 we're at the end of the input, and the compressor hasn't reported | |
| 4451 EOF, we need to keep going, as there might be more output to | |
| 4452 generate. (To signal EOF on our end, we set the FLUSH parameter | |
| 4453 to Z_FINISH; when all data is output, Z_STREAM_END will be | |
| 4454 returned.) Z_OK from the compressor means input was processed or | |
| 4455 output was generated; if neither, we break out of the loop. Other | |
| 4456 return values are: | |
| 4457 | |
| 4458 Z_STREAM_END EOF from compressor | |
| 4459 Z_BUF_ERROR No progress possible (should never happen) | |
| 4460 Z_STREAM_ERROR (should never happen) | |
| 4461 */ | |
| 4462 while (data->stream.avail_in > 0 || str->eof) | |
| 4463 { | |
| 4464 /* Reserve an output buffer of the same size as the input buffer; | |
| 4465 if that's not enough, we keep reserving the same size. */ | |
| 4466 Bytecount reserved = n; | |
| 4467 Dynarr_add_many (dst, 0, reserved); | |
| 4468 /* Careful here! Don't retrieve the pointer until after | |
| 4469 reserving the space, or it might be bogus */ | |
| 4470 data->stream.next_out = | |
| 4471 Dynarr_atp (dst, Dynarr_length (dst) - reserved); | |
| 4472 data->stream.avail_out = reserved; | |
| 4473 zerr = | |
| 4474 deflate (&data->stream, | |
| 4475 str->eof ? Z_FINISH : Z_NO_FLUSH); | |
| 4476 /* Lop off the unused portion */ | |
| 5038 | 4477 Dynarr_set_lengthr (dst, Dynarr_length (dst) - data->stream.avail_out); |
| 771 | 4478 if (zerr != Z_OK) |
| 4479 break; | |
| 4480 } | |
| 4481 | |
| 4482 if ((Bytecount) data->stream.avail_in < n) | |
| 4483 return n - data->stream.avail_in; | |
| 4484 | |
| 4485 if (zerr == Z_OK || zerr == Z_STREAM_END) | |
| 4486 return 0; | |
| 4487 | |
| 4488 return LSTREAM_ERROR; | |
| 428 | 4489 } |
| 4490 } | |
| 4491 | |
| 771 | 4492 #endif /* HAVE_ZLIB */ |
| 428 | 4493 |
| 4494 | |
| 4495 /************************************************************************/ | |
| 4496 /* Initialization */ | |
| 4497 /************************************************************************/ | |
| 4498 | |
| 4499 void | |
| 4500 syms_of_file_coding (void) | |
| 4501 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
4502 INIT_LISP_OBJECT (coding_system); |
| 442 | 4503 |
| 771 | 4504 DEFSUBR (Fvalid_coding_system_type_p); |
| 4505 DEFSUBR (Fcoding_system_type_list); | |
| 428 | 4506 DEFSUBR (Fcoding_system_p); |
| 4303 | 4507 DEFSUBR (Fautoload_coding_system); |
| 428 | 4508 DEFSUBR (Ffind_coding_system); |
| 4509 DEFSUBR (Fget_coding_system); | |
| 4510 DEFSUBR (Fcoding_system_list); | |
| 4511 DEFSUBR (Fcoding_system_name); | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4512 DEFSUBR (Fmake_coding_system_internal); |
| 428 | 4513 DEFSUBR (Fcopy_coding_system); |
| 440 | 4514 DEFSUBR (Fcoding_system_canonical_name_p); |
| 4515 DEFSUBR (Fcoding_system_alias_p); | |
| 4516 DEFSUBR (Fcoding_system_aliasee); | |
| 428 | 4517 DEFSUBR (Fdefine_coding_system_alias); |
| 4518 DEFSUBR (Fsubsidiary_coding_system); | |
| 771 | 4519 DEFSUBR (Fcoding_system_base); |
| 4520 DEFSUBR (Fcoding_system_used_for_io); | |
| 428 | 4521 |
| 4522 DEFSUBR (Fcoding_system_type); | |
| 771 | 4523 DEFSUBR (Fcoding_system_description); |
| 428 | 4524 DEFSUBR (Fcoding_system_property); |
| 4525 | |
| 4526 DEFSUBR (Fcoding_category_list); | |
| 4527 DEFSUBR (Fset_coding_priority_list); | |
| 4528 DEFSUBR (Fcoding_priority_list); | |
| 4529 DEFSUBR (Fset_coding_category_system); | |
| 4530 DEFSUBR (Fcoding_category_system); | |
| 4531 | |
| 4532 DEFSUBR (Fdetect_coding_region); | |
| 4533 DEFSUBR (Fdecode_coding_region); | |
| 4534 DEFSUBR (Fencode_coding_region); | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4535 DEFSUBR (Fquery_coding_region); |
| 563 | 4536 DEFSYMBOL_MULTIWORD_PREDICATE (Qcoding_systemp); |
| 4537 DEFSYMBOL (Qno_conversion); | |
| 771 | 4538 DEFSYMBOL (Qconvert_eol); |
| 4539 DEFSYMBOL (Qconvert_eol_autodetect); | |
| 4540 DEFSYMBOL (Qconvert_eol_lf); | |
| 4541 DEFSYMBOL (Qconvert_eol_cr); | |
| 4542 DEFSYMBOL (Qconvert_eol_crlf); | |
| 563 | 4543 DEFSYMBOL (Qraw_text); |
| 771 | 4544 |
| 563 | 4545 DEFSYMBOL (Qmnemonic); |
| 4546 DEFSYMBOL (Qeol_type); | |
| 4547 DEFSYMBOL (Qpost_read_conversion); | |
| 4548 DEFSYMBOL (Qpre_write_conversion); | |
| 4549 | |
| 771 | 4550 DEFSYMBOL (Qtranslation_table_for_decode); |
| 4551 DEFSYMBOL (Qtranslation_table_for_encode); | |
| 4552 DEFSYMBOL (Qsafe_chars); | |
| 4553 DEFSYMBOL (Qsafe_charsets); | |
| 4554 DEFSYMBOL (Qmime_charset); | |
| 4555 DEFSYMBOL (Qvalid_codes); | |
| 4556 | |
| 563 | 4557 DEFSYMBOL (Qcr); |
| 4558 DEFSYMBOL (Qlf); | |
| 4559 DEFSYMBOL (Qcrlf); | |
| 4560 DEFSYMBOL (Qeol_cr); | |
| 4561 DEFSYMBOL (Qeol_lf); | |
| 4562 DEFSYMBOL (Qeol_crlf); | |
| 4563 DEFSYMBOL (Qencode); | |
| 4564 DEFSYMBOL (Qdecode); | |
| 428 | 4565 |
| 771 | 4566 DEFSYMBOL (Qnear_certainty); |
| 4567 DEFSYMBOL (Qquite_probable); | |
| 4568 DEFSYMBOL (Qsomewhat_likely); | |
| 1494 | 4569 DEFSYMBOL (Qslightly_likely); |
| 771 | 4570 DEFSYMBOL (Qas_likely_as_unlikely); |
| 4571 DEFSYMBOL (Qsomewhat_unlikely); | |
| 4572 DEFSYMBOL (Qquite_improbable); | |
| 4573 DEFSYMBOL (Qnearly_impossible); | |
| 4574 | |
| 4575 DEFSYMBOL (Qdo_eol); | |
| 4576 DEFSYMBOL (Qdo_coding); | |
| 4577 | |
| 4578 DEFSYMBOL (Qcanonicalize_after_coding); | |
| 4579 | |
| 4303 | 4580 DEFSYMBOL (Qposix_charset_to_coding_system_hash); |
| 4581 | |
| 771 | 4582 DEFSYMBOL (Qescape_quoted); |
| 4583 | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4584 DEFSYMBOL (Qquery_coding_warning_face); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4585 DEFSYMBOL (Qaliases); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4586 DEFSYMBOL (Qcharset_skip_chars_string); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4587 |
| 771 | 4588 #ifdef HAVE_ZLIB |
| 4589 DEFSYMBOL (Qgzip); | |
| 4590 #endif | |
| 4591 | |
| 428 | 4592 } |
| 4593 | |
| 4594 void | |
| 4595 lstream_type_create_file_coding (void) | |
| 4596 { | |
| 771 | 4597 LSTREAM_HAS_METHOD (coding, reader); |
| 4598 LSTREAM_HAS_METHOD (coding, writer); | |
| 4599 LSTREAM_HAS_METHOD (coding, rewinder); | |
| 4600 LSTREAM_HAS_METHOD (coding, seekable_p); | |
| 4601 LSTREAM_HAS_METHOD (coding, marker); | |
| 4602 LSTREAM_HAS_METHOD (coding, flusher); | |
| 4603 LSTREAM_HAS_METHOD (coding, closer); | |
| 4604 LSTREAM_HAS_METHOD (coding, finalizer); | |
| 4605 } | |
| 4606 | |
| 4607 void | |
| 4608 coding_system_type_create (void) | |
| 4609 { | |
| 4610 int i; | |
| 4611 | |
| 4612 staticpro (&Vcoding_system_hash_table); | |
| 4613 Vcoding_system_hash_table = | |
| 4614 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 4615 | |
| 4616 the_coding_system_type_entry_dynarr = Dynarr_new (coding_system_type_entry); | |
| 2367 | 4617 dump_add_root_block_ptr (&the_coding_system_type_entry_dynarr, |
| 771 | 4618 &csted_description); |
| 4619 | |
| 4620 Vcoding_system_type_list = Qnil; | |
| 4621 staticpro (&Vcoding_system_type_list); | |
| 4622 | |
| 4623 /* Initialize to something reasonable ... */ | |
| 4624 for (i = 0; i < MAX_DETECTOR_CATEGORIES; i++) | |
| 4625 { | |
| 4626 coding_category_system[i] = Qnil; | |
| 1204 | 4627 dump_add_root_lisp_object (&coding_category_system[i]); |
| 771 | 4628 coding_category_by_priority[i] = i; |
| 4629 } | |
| 4630 | |
| 4631 dump_add_opaque (coding_category_by_priority, | |
| 4632 sizeof (coding_category_by_priority)); | |
| 4633 | |
| 4634 all_coding_detectors = Dynarr_new2 (detector_dynarr, struct detector); | |
| 2367 | 4635 dump_add_root_block_ptr (&all_coding_detectors, |
| 771 | 4636 &detector_dynarr_description); |
| 4637 | |
| 4638 dump_add_opaque_int (&coding_system_tick); | |
| 4639 dump_add_opaque_int (&coding_detector_count); | |
| 4640 dump_add_opaque_int (&coding_detector_category_count); | |
| 4641 | |
| 4642 INITIALIZE_CODING_SYSTEM_TYPE (no_conversion, | |
| 4643 "no-conversion-coding-system-p"); | |
| 4644 CODING_SYSTEM_HAS_METHOD (no_conversion, convert); | |
| 4645 | |
| 4646 INITIALIZE_DETECTOR (no_conversion); | |
| 4647 DETECTOR_HAS_METHOD (no_conversion, detect); | |
| 4648 INITIALIZE_DETECTOR_CATEGORY (no_conversion, no_conversion); | |
| 4649 | |
| 4650 INITIALIZE_CODING_SYSTEM_TYPE_WITH_DATA (convert_eol, | |
| 4651 "convert-eol-coding-system-p"); | |
| 4652 CODING_SYSTEM_HAS_METHOD (convert_eol, print); | |
| 4653 CODING_SYSTEM_HAS_METHOD (convert_eol, convert); | |
| 4654 CODING_SYSTEM_HAS_METHOD (convert_eol, getprop); | |
| 4655 CODING_SYSTEM_HAS_METHOD (convert_eol, putprop); | |
| 4656 CODING_SYSTEM_HAS_METHOD (convert_eol, conversion_end_type); | |
| 4657 CODING_SYSTEM_HAS_METHOD (convert_eol, canonicalize_after_coding); | |
| 4658 CODING_SYSTEM_HAS_METHOD (convert_eol, init_coding_stream); | |
| 4659 | |
| 4660 INITIALIZE_CODING_SYSTEM_TYPE_WITH_DATA (undecided, | |
| 4661 "undecided-coding-system-p"); | |
| 4662 CODING_SYSTEM_HAS_METHOD (undecided, init); | |
| 4663 CODING_SYSTEM_HAS_METHOD (undecided, mark); | |
| 4664 CODING_SYSTEM_HAS_METHOD (undecided, print); | |
| 4665 CODING_SYSTEM_HAS_METHOD (undecided, convert); | |
| 4666 CODING_SYSTEM_HAS_METHOD (undecided, putprop); | |
| 4667 CODING_SYSTEM_HAS_METHOD (undecided, getprop); | |
| 4668 CODING_SYSTEM_HAS_METHOD (undecided, init_coding_stream); | |
| 4669 CODING_SYSTEM_HAS_METHOD (undecided, rewind_coding_stream); | |
| 4670 CODING_SYSTEM_HAS_METHOD (undecided, finalize_coding_stream); | |
| 4671 CODING_SYSTEM_HAS_METHOD (undecided, mark_coding_stream); | |
| 4672 CODING_SYSTEM_HAS_METHOD (undecided, canonicalize); | |
| 4673 CODING_SYSTEM_HAS_METHOD (undecided, canonicalize_after_coding); | |
| 4674 | |
| 4675 INITIALIZE_CODING_SYSTEM_TYPE_WITH_DATA (chain, "chain-coding-system-p"); | |
| 4676 | |
| 4677 CODING_SYSTEM_HAS_METHOD (chain, print); | |
| 4678 CODING_SYSTEM_HAS_METHOD (chain, canonicalize); | |
| 4679 CODING_SYSTEM_HAS_METHOD (chain, init); | |
| 4680 CODING_SYSTEM_HAS_METHOD (chain, mark); | |
| 4681 CODING_SYSTEM_HAS_METHOD (chain, mark_coding_stream); | |
| 4682 CODING_SYSTEM_HAS_METHOD (chain, convert); | |
| 4683 CODING_SYSTEM_HAS_METHOD (chain, rewind_coding_stream); | |
| 4684 CODING_SYSTEM_HAS_METHOD (chain, finalize_coding_stream); | |
| 4685 CODING_SYSTEM_HAS_METHOD (chain, finalize); | |
| 4686 CODING_SYSTEM_HAS_METHOD (chain, putprop); | |
| 4687 CODING_SYSTEM_HAS_METHOD (chain, getprop); | |
| 4688 CODING_SYSTEM_HAS_METHOD (chain, conversion_end_type); | |
| 4689 CODING_SYSTEM_HAS_METHOD (chain, canonicalize_after_coding); | |
| 4690 | |
| 4691 #ifdef DEBUG_XEMACS | |
| 4692 INITIALIZE_CODING_SYSTEM_TYPE (internal, "internal-coding-system-p"); | |
| 4693 CODING_SYSTEM_HAS_METHOD (internal, convert); | |
| 4694 #endif | |
| 4695 | |
| 4696 #ifdef HAVE_ZLIB | |
| 4697 INITIALIZE_CODING_SYSTEM_TYPE_WITH_DATA (gzip, "gzip-coding-system-p"); | |
| 4698 CODING_SYSTEM_HAS_METHOD (gzip, conversion_end_type); | |
| 4699 CODING_SYSTEM_HAS_METHOD (gzip, convert); | |
| 4700 CODING_SYSTEM_HAS_METHOD (gzip, init); | |
| 4701 CODING_SYSTEM_HAS_METHOD (gzip, print); | |
| 4702 CODING_SYSTEM_HAS_METHOD (gzip, init_coding_stream); | |
| 4703 CODING_SYSTEM_HAS_METHOD (gzip, rewind_coding_stream); | |
| 4704 CODING_SYSTEM_HAS_METHOD (gzip, putprop); | |
| 4705 CODING_SYSTEM_HAS_METHOD (gzip, getprop); | |
| 4706 #endif | |
| 4707 } | |
| 4708 | |
| 4709 void | |
| 4710 reinit_coding_system_type_create (void) | |
| 4711 { | |
| 4712 REINITIALIZE_CODING_SYSTEM_TYPE (no_conversion); | |
| 4713 REINITIALIZE_CODING_SYSTEM_TYPE (convert_eol); | |
| 4714 REINITIALIZE_CODING_SYSTEM_TYPE (undecided); | |
| 4715 REINITIALIZE_CODING_SYSTEM_TYPE (chain); | |
| 4716 #if 0 | |
| 4717 REINITIALIZE_CODING_SYSTEM_TYPE (text_file_wrapper); | |
| 4718 #endif /* 0 */ | |
| 4719 #ifdef DEBUG_XEMACS | |
| 4720 REINITIALIZE_CODING_SYSTEM_TYPE (internal); | |
| 4721 #endif | |
| 4722 #ifdef HAVE_ZLIB | |
| 4723 REINITIALIZE_CODING_SYSTEM_TYPE (gzip); | |
| 4724 #endif | |
| 4725 } | |
| 4726 | |
| 4727 void | |
| 4728 reinit_vars_of_file_coding (void) | |
| 4729 { | |
| 428 | 4730 } |
| 4731 | |
| 4732 void | |
| 4733 vars_of_file_coding (void) | |
| 4734 { | |
| 771 | 4735 /* We always have file-coding support */ |
| 428 | 4736 Fprovide (intern ("file-coding")); |
| 4737 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4738 QScoding_system_cookie = build_ascstring (";;;###coding system: "); |
| 1347 | 4739 staticpro (&QScoding_system_cookie); |
| 4740 | |
| 1242 | 4741 #ifdef HAVE_DEFAULT_EOL_DETECTION |
| 2297 | 4742 /* #### Find a more appropriate place for this comment. |
| 4743 WARNING: The existing categories are intimately tied to the function | |
| 1242 | 4744 `coding-system-category' in coding.el. If you change a category, or |
| 4745 change the layout of any coding system associated with a category, you | |
| 4746 need to check that function and make sure it's written properly. */ | |
| 4747 | |
| 4748 Fprovide (intern ("unix-default-eol-detection")); | |
| 4749 #endif | |
| 4750 | |
| 428 | 4751 DEFVAR_LISP ("keyboard-coding-system", &Vkeyboard_coding_system /* |
| 3142 | 4752 Default coding system used for TTY and X11 keyboard input. |
| 4753 Under X11, used only to interpet the character for a key event when that | |
| 4754 event has a KeySym of NoSymbol but does have an associated string keysym, | |
| 4755 something that's seen with input methods. | |
| 4756 | |
| 4757 If you need to set these things to different coding systems, call the | |
| 4758 function `set-console-tty-coding-system' for the TTY and use this variable | |
| 4759 for X11. | |
| 428 | 4760 */ ); |
| 4761 Vkeyboard_coding_system = Qnil; | |
| 4762 | |
| 4763 DEFVAR_LISP ("terminal-coding-system", &Vterminal_coding_system /* | |
| 4764 Coding system used for TTY display output. | |
| 4765 Not used under a windowing system. | |
| 4766 */ ); | |
| 4767 Vterminal_coding_system = Qnil; | |
| 4768 | |
| 4769 DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read /* | |
| 440 | 4770 Overriding coding system used when reading from a file or process. |
| 4771 You should bind this variable with `let', but do not set it globally. | |
| 4772 If this is non-nil, it specifies the coding system that will be used | |
| 4773 to decode input on read operations, such as from a file or process. | |
| 4774 It overrides `buffer-file-coding-system-for-read', | |
| 428 | 4775 `insert-file-contents-pre-hook', etc. Use those variables instead of |
| 440 | 4776 this one for permanent changes to the environment. */ ); |
| 428 | 4777 Vcoding_system_for_read = Qnil; |
| 4778 | |
| 4779 DEFVAR_LISP ("coding-system-for-write", | |
| 4780 &Vcoding_system_for_write /* | |
| 440 | 4781 Overriding coding system used when writing to a file or process. |
| 4782 You should bind this variable with `let', but do not set it globally. | |
| 4783 If this is non-nil, it specifies the coding system that will be used | |
| 4784 to encode output for write operations, such as to a file or process. | |
| 4785 It overrides `buffer-file-coding-system', `write-region-pre-hook', etc. | |
| 4786 Use those variables instead of this one for permanent changes to the | |
| 4787 environment. */ ); | |
| 428 | 4788 Vcoding_system_for_write = Qnil; |
| 4789 | |
| 4790 DEFVAR_LISP ("file-name-coding-system", &Vfile_name_coding_system /* | |
| 4791 Coding system used to convert pathnames when accessing files. | |
| 4792 */ ); | |
| 4793 Vfile_name_coding_system = Qnil; | |
| 4794 | |
| 4795 DEFVAR_BOOL ("enable-multibyte-characters", &enable_multibyte_characters /* | |
| 771 | 4796 Setting this has no effect. It is purely for FSF compatibility. |
| 428 | 4797 */ ); |
| 4798 enable_multibyte_characters = 1; | |
| 771 | 4799 |
| 4800 Vchain_canonicalize_hash_table = | |
| 4801 make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); | |
| 4802 staticpro (&Vchain_canonicalize_hash_table); | |
| 4803 | |
| 4804 #ifdef DEBUG_XEMACS | |
| 4805 DEFVAR_LISP ("debug-coding-detection", &Vdebug_coding_detection /* | |
| 4806 If non-nil, display debug information about detection operations in progress. | |
| 4807 Information is displayed on stderr. | |
| 4808 */ ); | |
| 4809 Vdebug_coding_detection = Qnil; | |
| 4810 #endif | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4811 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4812 #ifdef MULE |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4813 Vdefault_query_coding_region_chartab_cache |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4814 = make_lisp_hash_table (25, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4815 staticpro (&Vdefault_query_coding_region_chartab_cache); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4816 #endif |
| 428 | 4817 } |
| 4818 | |
| 2297 | 4819 /* #### reformat this for consistent appearance? */ |
| 4820 | |
| 428 | 4821 void |
| 4822 complex_vars_of_file_coding (void) | |
| 4823 { | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4824 Fmake_coding_system_internal |
| 771 | 4825 (Qconvert_eol_cr, Qconvert_eol, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4826 build_defer_string ("Convert CR to LF"), |
| 771 | 4827 nconc2 (list6 (Qdocumentation, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4828 build_defer_string ( |
| 771 | 4829 "Converts CR (used to mark the end of a line on Macintosh systems) to LF\n" |
| 4830 "(used internally and under Unix to mark the end of a line)."), | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4831 Qmnemonic, build_ascstring ("CR->LF"), |
| 771 | 4832 Qsubtype, Qcr), |
| 4833 /* VERY IMPORTANT! Tell make-coding-system not to generate | |
| 4834 subsidiaries -- it needs the coding systems we're creating | |
| 4835 to do so! */ | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4836 list4 (Qeol_type, Qlf, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4837 Qsafe_charsets, Qt))); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4838 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4839 Fmake_coding_system_internal |
| 771 | 4840 (Qconvert_eol_lf, Qconvert_eol, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4841 build_defer_string ("Convert LF to LF (do nothing)"), |
| 771 | 4842 nconc2 (list6 (Qdocumentation, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4843 build_defer_string ( |
| 771 | 4844 "Do nothing."), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4845 Qmnemonic, build_ascstring ("LF->LF"), |
| 771 | 4846 Qsubtype, Qlf), |
| 4847 /* VERY IMPORTANT! Tell make-coding-system not to generate | |
| 4848 subsidiaries -- it needs the coding systems we're creating | |
| 4849 to do so! */ | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4850 list4 (Qeol_type, Qlf, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4851 Qsafe_charsets, Qt))); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4852 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4853 Fmake_coding_system_internal |
| 771 | 4854 (Qconvert_eol_crlf, Qconvert_eol, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4855 build_defer_string ("Convert CRLF to LF"), |
| 771 | 4856 nconc2 (list6 (Qdocumentation, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4857 build_defer_string ( |
| 771 | 4858 "Converts CR+LF (used to mark the end of a line on Macintosh systems) to LF\n" |
| 4859 "(used internally and under Unix to mark the end of a line)."), | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4860 Qmnemonic, build_ascstring ("CRLF->LF"), |
| 771 | 4861 Qsubtype, Qcrlf), |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4862 |
| 771 | 4863 /* VERY IMPORTANT! Tell make-coding-system not to generate |
| 4864 subsidiaries -- it needs the coding systems we're creating | |
| 4865 to do so! */ | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4866 list4 (Qeol_type, Qlf, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4867 Qsafe_charsets, Qt))); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4868 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4869 Fmake_coding_system_internal |
| 771 | 4870 (Qconvert_eol_autodetect, Qconvert_eol, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4871 build_defer_string ("Autodetect EOL type"), |
| 771 | 4872 nconc2 (list6 (Qdocumentation, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4873 build_defer_string ( |
| 771 | 4874 "Autodetect the end-of-line type."), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4875 Qmnemonic, build_ascstring ("Auto-EOL"), |
| 793 | 4876 Qsubtype, Qnil), |
| 771 | 4877 /* VERY IMPORTANT! Tell make-coding-system not to generate |
| 4878 subsidiaries -- it needs the coding systems we're creating | |
| 4879 to do so! */ | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4880 list4 (Qeol_type, Qlf, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4881 Qsafe_charsets, Qt))); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4882 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4883 Fmake_coding_system_internal |
| 771 | 4884 (Qundecided, Qundecided, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4885 build_defer_string ("Undecided (auto-detect)"), |
| 771 | 4886 nconc2 (list4 (Qdocumentation, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4887 build_defer_string |
| 771 | 4888 ("Automatically detects the correct encoding."), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4889 Qmnemonic, build_ascstring ("Auto")), |
| 771 | 4890 list6 (Qdo_eol, Qt, Qdo_coding, Qt, |
| 4891 /* We do EOL detection ourselves so we don't need to be | |
| 4892 wrapped in an EOL detector. (It doesn't actually hurt, | |
| 4893 though, I don't think.) */ | |
| 4894 Qeol_type, Qlf))); | |
| 4895 | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4896 Fmake_coding_system_internal |
| 771 | 4897 (intern ("undecided-dos"), Qundecided, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4898 build_defer_string ("Undecided (auto-detect) (CRLF)"), |
| 771 | 4899 nconc2 (list4 (Qdocumentation, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4900 build_defer_string |
| 771 | 4901 ("Automatically detects the correct encoding; EOL type of CRLF forced."), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4902 Qmnemonic, build_ascstring ("Auto")), |
| 771 | 4903 list4 (Qdo_coding, Qt, |
| 4904 Qeol_type, Qcrlf))); | |
| 4905 | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4906 Fmake_coding_system_internal |
| 771 | 4907 (intern ("undecided-unix"), Qundecided, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4908 build_defer_string ("Undecided (auto-detect) (LF)"), |
| 771 | 4909 nconc2 (list4 (Qdocumentation, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4910 build_defer_string |
| 771 | 4911 ("Automatically detects the correct encoding; EOL type of LF forced."), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4912 Qmnemonic, build_ascstring ("Auto")), |
| 771 | 4913 list4 (Qdo_coding, Qt, |
| 4914 Qeol_type, Qlf))); | |
| 4915 | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4916 Fmake_coding_system_internal |
| 771 | 4917 (intern ("undecided-mac"), Qundecided, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4918 build_defer_string ("Undecided (auto-detect) (CR)"), |
| 771 | 4919 nconc2 (list4 (Qdocumentation, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4920 build_defer_string |
| 771 | 4921 ("Automatically detects the correct encoding; EOL type of CR forced."), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4922 Qmnemonic, build_ascstring ("Auto")), |
| 771 | 4923 list4 (Qdo_coding, Qt, |
| 4924 Qeol_type, Qcr))); | |
| 4925 | |
| 428 | 4926 /* Need to create this here or we're really screwed. */ |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4927 Fmake_coding_system_internal |
| 428 | 4928 (Qraw_text, Qno_conversion, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4929 build_defer_string ("Raw Text"), |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4930 nconc2 (list4 (Qdocumentation, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4931 build_defer_string ("Raw text converts only line-break " |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4932 "codes, and acts otherwise like " |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4933 "`binary'."), |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4934 Qmnemonic, build_ascstring ("Raw")), |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4935 #ifdef MULE |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4936 list2 (Qsafe_charsets, list3 (Vcharset_ascii, Vcharset_control_1, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4937 Vcharset_latin_iso8859_1)))); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4938 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4939 #else |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4940 Qnil)); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4941 #endif |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4942 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4943 Fmake_coding_system_internal |
| 428 | 4944 (Qbinary, Qno_conversion, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4945 build_defer_string ("Binary"), |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4946 nconc2 (list6 (Qdocumentation, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4947 build_defer_string ( |
| 771 | 4948 "This coding system is as close as it comes to doing no conversion.\n" |
| 4949 "On input, each byte is converted directly into the character\n" | |
| 4950 "with the corresponding code -- i.e. from the `ascii', `control-1',\n" | |
| 4951 "or `latin-1' character sets. On output, these characters are\n" | |
| 4952 "converted back to the corresponding bytes, and other characters\n" | |
| 4953 "are converted to the default character, i.e. `~'."), | |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4954 Qeol_type, Qlf, |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
4955 Qmnemonic, build_ascstring ("Binary")), |
|
4690
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4956 #ifdef MULE |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4957 list2 (Qsafe_charsets, list3 (Vcharset_ascii, Vcharset_control_1, |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4958 Vcharset_latin_iso8859_1)))); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4959 |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4960 #else |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4961 Qnil)); |
|
257b468bf2ca
Move the #'query-coding-region implementation to C.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4647
diff
changeset
|
4962 #endif |
| 428 | 4963 |
| 771 | 4964 /* Formerly aliased to raw-text! Completely bogus and not even the same |
| 4965 as FSF Emacs. */ | |
| 4966 Fdefine_coding_system_alias (Qno_conversion, Qbinary); | |
| 4967 Fdefine_coding_system_alias (intern ("no-conversion-unix"), | |
| 4968 intern ("raw-text-unix")); | |
| 4969 Fdefine_coding_system_alias (intern ("no-conversion-dos"), | |
| 4970 intern ("raw-text-dos")); | |
| 4971 Fdefine_coding_system_alias (intern ("no-conversion-mac"), | |
| 4972 intern ("raw-text-mac")); | |
| 4973 | |
| 1318 | 4974 /* These three below will get their defaults set correctly |
| 4975 in code-init.el. We init them now so we can handle stuff at dump | |
| 771 | 4976 time before we get to code-init.el. */ |
| 1318 | 4977 Fdefine_coding_system_alias (Qnative, Qbinary); |
| 440 | 4978 Fdefine_coding_system_alias (Qterminal, Qbinary); |
| 4979 Fdefine_coding_system_alias (Qkeyboard, Qbinary); | |
| 4980 | |
| 1318 | 4981 Fdefine_coding_system_alias (Qfile_name, Qnative); |
| 771 | 4982 Fdefine_coding_system_alias (Qidentity, Qconvert_eol_lf); |
| 4983 | |
| 428 | 4984 /* Need this for bootstrapping */ |
| 771 | 4985 coding_category_system[detector_category_no_conversion] = |
| 428 | 4986 Fget_coding_system (Qraw_text); |
| 4987 } |