Mercurial > hg > xemacs-beta
annotate src/casetab.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 | b5df3737028a |
| children | f965e31a35f0 |
| rev | line source |
|---|---|
| 428 | 1 /* XEmacs routines to deal with case tables. |
| 2 Copyright (C) 1987, 1992, 1993, 1994 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 793 | 4 Copyright (C) 2002 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 771 | 23 /* Synched up with: FSF 19.28. Between FSF 19.28 and 19.30, casetab.c |
| 428 | 24 was rewritten to use junky FSF char tables. Meanwhile I rewrote it |
| 771 | 25 to use more logical char tables. --ben */ |
| 428 | 26 |
| 826 | 27 /* Written by Howard Gayle. */ |
| 428 | 28 |
| 29 /* Modified for Mule by Ben Wing. */ | |
| 30 | |
| 826 | 31 /* The four tables in a case table are downcase, upcase, canon, and eqv. |
| 32 Each is a char-table. Their workings are rather non-obvious. | |
| 33 | |
| 34 (1) `downcase' is the only obvious table: Map a character to its | |
| 35 lowercase equivalent. | |
| 771 | 36 |
| 826 | 37 (2) `upcase' does *NOT* map a character to its uppercase equivalent, |
| 38 despite its name. Rather, it maps lowercase characters to their | |
| 39 uppercase equivalent, and uppercase characters to *ANYTHING BUT* their | |
| 40 uppercase equivalent (currently, their lowercase equivalent), and | |
| 41 characters without case to themselves. It is used to determine if a | |
| 42 character "has no case" (no uppercase or lowercase mapping). #### This | |
| 43 is way bogus. Just use the obvious implementation of uppercase mapping | |
| 44 and of NOCASE_P. | |
| 446 | 45 |
| 826 | 46 (3) `canon' maps each character to a "canonical" lowercase, such that if |
| 47 two different uppercase characters map to the same lowercase character, | |
| 48 or vice versa, both characters will have the same entry in the canon | |
| 49 table. | |
| 446 | 50 |
|
4407
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
51 (4) `eqv' lists the "equivalence classes" defined by `canon'. Imagine |
| 826 | 52 that all characters are divided into groups having the same `canon' |
|
4407
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
53 entry; these groups are called "equivalence classes" and `eqv' lists them |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
54 by linking the characters in each equivalence class together in a |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
55 circular list. That is, to find out all all the members of a given char's |
| 4890 | 56 equivalence class, you need something like the following code: |
| 826 | 57 |
|
4407
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
58 (let* ((char ?i) |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
59 (original-char char) |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
60 (standard-case-eqv (case-table-eqv (standard-case-table)))) |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
61 (loop |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
62 with res = (list char) |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
63 until (eq (setq char (get-char-table char standard-case-eqv)) |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
64 original-char) |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
65 do (push char res) |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
66 finally return res)) |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
67 |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
68 (Where #'case-table-eqv doesn't yet exist, and probably never will, given |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
69 that the C code needs to keep it in a consistent state so Lisp can't mess |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
70 around with it.) |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
71 |
|
4ee73bbe4f8e
Always use boyer_moore in ASCII or Latin-1 buffers with ASCII search strings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3017
diff
changeset
|
72 `canon' is used when doing case-insensitive comparisons. `eqv' is |
| 826 | 73 used in the Boyer-Moore search code. |
| 74 */ | |
| 428 | 75 |
| 76 #include <config.h> | |
| 77 #include "lisp.h" | |
| 78 #include "buffer.h" | |
| 79 #include "opaque.h" | |
| 446 | 80 #include "chartab.h" |
| 81 #include "casetab.h" | |
| 428 | 82 |
| 446 | 83 Lisp_Object Qcase_tablep, Qdowncase, Qupcase; |
| 84 Lisp_Object Vstandard_case_table; | |
| 428 | 85 |
| 446 | 86 Lisp_Object case_table_char (Lisp_Object ch, Lisp_Object table); |
| 428 | 87 |
| 826 | 88 #define STRING256_P(obj) ((STRINGP (obj) && string_char_length (obj) == 256)) |
| 446 | 89 |
| 90 static Lisp_Object | |
| 91 mark_case_table (Lisp_Object obj) | |
| 92 { | |
| 93 Lisp_Case_Table *ct = XCASE_TABLE (obj); | |
| 94 | |
| 95 mark_object (CASE_TABLE_DOWNCASE (ct)); | |
| 96 mark_object (CASE_TABLE_UPCASE (ct)); | |
| 97 mark_object (CASE_TABLE_CANON (ct)); | |
| 98 mark_object (CASE_TABLE_EQV (ct)); | |
| 99 return Qnil; | |
| 100 } | |
| 101 | |
| 102 static void | |
| 2286 | 103 print_case_table (Lisp_Object obj, Lisp_Object printcharfun, |
| 104 int UNUSED (escapeflag)) | |
| 446 | 105 { |
| 106 Lisp_Case_Table *ct = XCASE_TABLE (obj); | |
| 107 if (print_readably) | |
| 4846 | 108 printing_unreadable_lcrecord (obj, 0); |
| 826 | 109 write_fmt_string_lisp |
| 110 (printcharfun, "#<case-table downcase=%s upcase=%s canon=%s eqv=%s ", 4, | |
| 111 CASE_TABLE_DOWNCASE (ct), CASE_TABLE_UPCASE (ct), | |
| 112 CASE_TABLE_CANON (ct), CASE_TABLE_EQV (ct)); | |
| 113 write_fmt_string (printcharfun, "0x%x>", ct->header.uid); | |
| 446 | 114 } |
| 115 | |
| 1204 | 116 static const struct memory_description case_table_description [] = { |
| 446 | 117 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, downcase_table) }, |
| 118 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, upcase_table) }, | |
| 119 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_canon_table) }, | |
| 120 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_eqv_table) }, | |
| 121 { XD_END } | |
| 122 }; | |
| 123 | |
| 934 | 124 |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
125 DEFINE_DUMPABLE_LISP_OBJECT ("case-table", case_table, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
126 mark_case_table, print_case_table, 0, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
127 0, 0, case_table_description, Lisp_Case_Table); |
| 446 | 128 |
| 129 static Lisp_Object | |
| 826 | 130 allocate_case_table (int init_tables) |
| 446 | 131 { |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
132 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (case_table); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
133 Lisp_Case_Table *ct = XCASE_TABLE (obj); |
| 446 | 134 |
| 826 | 135 if (init_tables) |
| 136 { | |
| 137 SET_CASE_TABLE_DOWNCASE (ct, MAKE_TRT_TABLE ()); | |
| 138 SET_CASE_TABLE_UPCASE (ct, MAKE_TRT_TABLE ()); | |
| 139 SET_CASE_TABLE_CANON (ct, MAKE_TRT_TABLE ()); | |
| 140 SET_CASE_TABLE_EQV (ct, MAKE_TRT_TABLE ()); | |
| 141 } | |
| 142 else | |
| 143 { | |
| 144 SET_CASE_TABLE_DOWNCASE (ct, Qnil); | |
| 145 SET_CASE_TABLE_UPCASE (ct, Qnil); | |
| 146 SET_CASE_TABLE_CANON (ct, Qnil); | |
| 147 SET_CASE_TABLE_EQV (ct, Qnil); | |
| 148 } | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
149 return obj; |
| 826 | 150 } |
| 446 | 151 |
| 826 | 152 DEFUN ("make-case-table", Fmake_case_table, 0, 0, 0, /* |
| 153 Create a new, empty case table. | |
| 154 */ | |
| 155 ()) | |
| 156 { | |
| 157 return allocate_case_table (1); | |
| 446 | 158 } |
| 428 | 159 |
| 160 DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /* | |
| 444 | 161 Return t if OBJECT is a case table. |
| 428 | 162 See `set-case-table' for more information on these data structures. |
| 163 */ | |
| 444 | 164 (object)) |
| 428 | 165 { |
| 446 | 166 if (CASE_TABLEP (object)) |
| 167 return Qt; | |
| 168 else | |
| 169 { | |
| 170 Lisp_Object down, up, canon, eqv; | |
| 171 if (!CONSP (object)) | |
| 172 return Qnil; | |
| 173 down = XCAR (object); object = XCDR (object); | |
| 174 if (!CONSP (object)) | |
| 175 return Qnil; | |
| 176 up = XCAR (object); object = XCDR (object); | |
| 177 if (!CONSP (object)) | |
| 178 return Qnil; | |
| 179 canon = XCAR (object); object = XCDR (object); | |
| 180 if (!CONSP (object)) | |
| 181 return Qnil; | |
| 182 eqv = XCAR (object); | |
| 428 | 183 |
| 446 | 184 return ((STRING256_P (down) |
| 185 && (NILP (up) || STRING256_P (up)) | |
| 186 && ((NILP (canon) && NILP (eqv)) | |
| 187 || STRING256_P (canon)) | |
| 188 && (NILP (eqv) || STRING256_P (eqv))) | |
| 189 ? Qt : Qnil); | |
| 190 | |
| 191 } | |
| 428 | 192 } |
| 193 | |
| 194 static Lisp_Object | |
| 444 | 195 check_case_table (Lisp_Object object) |
| 428 | 196 { |
| 446 | 197 /* This function can GC */ |
| 444 | 198 while (NILP (Fcase_table_p (object))) |
| 199 object = wrong_type_argument (Qcase_tablep, object); | |
| 200 return object; | |
| 428 | 201 } |
| 202 | |
| 446 | 203 Lisp_Object |
| 204 case_table_char (Lisp_Object ch, Lisp_Object table) | |
| 205 { | |
| 206 Lisp_Object ct_char; | |
| 826 | 207 ct_char = get_char_table (XCHAR (ch), table); |
| 446 | 208 if (NILP (ct_char)) |
| 209 return ch; | |
| 210 else | |
| 211 return ct_char; | |
| 212 } | |
| 213 | |
| 214 DEFUN ("get-case-table", Fget_case_table, 3, 3, 0, /* | |
| 215 Return CHAR-CASE version of CHARACTER in CASE-TABLE. | |
| 216 | |
| 826 | 217 CHAR-CASE is either `downcase' or `upcase'. |
| 446 | 218 */ |
| 219 (char_case, character, case_table)) | |
| 220 { | |
| 221 CHECK_CHAR (character); | |
| 222 CHECK_CASE_TABLE (case_table); | |
| 223 if (EQ (char_case, Qdowncase)) | |
| 224 return case_table_char (character, XCASE_TABLE_DOWNCASE (case_table)); | |
| 225 else if (EQ (char_case, Qupcase)) | |
| 226 return case_table_char (character, XCASE_TABLE_UPCASE (case_table)); | |
| 227 else | |
| 563 | 228 invalid_constant ("Char case must be downcase or upcase", char_case); |
| 446 | 229 |
| 230 return Qnil; /* Not reached. */ | |
| 231 } | |
| 232 | |
| 233 DEFUN ("put-case-table", Fput_case_table, 4, 4, 0, /* | |
| 234 Set CHAR-CASE version of CHARACTER to be VALUE in CASE-TABLE. | |
| 235 | |
| 826 | 236 CHAR-CASE is either `downcase' or `upcase'. |
| 446 | 237 See also `put-case-table-pair'. |
| 238 */ | |
| 239 (char_case, character, value, case_table)) | |
| 240 { | |
| 241 CHECK_CHAR (character); | |
| 242 CHECK_CHAR (value); | |
| 243 | |
| 244 if (EQ (char_case, Qdowncase)) | |
| 245 { | |
| 246 Fput_char_table (character, value, XCASE_TABLE_DOWNCASE (case_table)); | |
| 826 | 247 /* This one is not at all intuitive. See comment at top of file. */ |
| 446 | 248 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table)); |
| 249 } | |
| 250 else if (EQ (char_case, Qupcase)) | |
| 251 { | |
| 252 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table)); | |
| 826 | 253 Fput_char_table (character, character, |
| 254 XCASE_TABLE_DOWNCASE (case_table)); | |
| 446 | 255 } |
| 256 else | |
| 826 | 257 invalid_constant ("CHAR-CASE must be downcase or upcase", char_case); |
| 446 | 258 |
| 826 | 259 XCASE_TABLE (case_table)->dirty = 1; |
| 446 | 260 return Qnil; |
| 261 } | |
| 262 | |
| 263 DEFUN ("put-case-table-pair", Fput_case_table_pair, 3, 3, 0, /* | |
| 264 Make UC and LC a pair of inter-case-converting letters in CASE-TABLE. | |
| 265 UC is an uppercase character and LC is a downcase character. | |
| 266 */ | |
| 267 (uc, lc, case_table)) | |
| 268 { | |
| 269 CHECK_CHAR (uc); | |
| 270 CHECK_CHAR (lc); | |
| 271 CHECK_CASE_TABLE (case_table); | |
| 272 | |
| 273 Fput_char_table (lc, lc, XCASE_TABLE_DOWNCASE (case_table)); | |
| 274 Fput_char_table (uc, lc, XCASE_TABLE_UPCASE (case_table)); | |
| 275 Fput_char_table (uc, lc, XCASE_TABLE_DOWNCASE (case_table)); | |
| 276 Fput_char_table (lc, uc, XCASE_TABLE_UPCASE (case_table)); | |
| 277 | |
| 826 | 278 XCASE_TABLE (case_table)->dirty = 1; |
| 446 | 279 return Qnil; |
| 280 } | |
| 281 | |
| 282 DEFUN ("copy-case-table", Fcopy_case_table, 1, 1, 0, /* | |
| 283 Return a new case table which is a copy of CASE-TABLE | |
| 284 */ | |
| 285 (case_table)) | |
| 286 { | |
| 287 Lisp_Object new_obj; | |
| 288 CHECK_CASE_TABLE (case_table); | |
| 289 | |
| 826 | 290 new_obj = allocate_case_table (0); |
| 446 | 291 XSET_CASE_TABLE_DOWNCASE |
| 292 (new_obj, Fcopy_char_table (XCASE_TABLE_DOWNCASE (case_table))); | |
| 293 XSET_CASE_TABLE_UPCASE | |
| 294 (new_obj, Fcopy_char_table (XCASE_TABLE_UPCASE (case_table))); | |
| 295 XSET_CASE_TABLE_CANON | |
| 296 (new_obj, Fcopy_char_table (XCASE_TABLE_CANON (case_table))); | |
| 297 XSET_CASE_TABLE_EQV | |
| 298 (new_obj, Fcopy_char_table (XCASE_TABLE_EQV (case_table))); | |
| 299 return new_obj; | |
| 300 } | |
| 301 | |
| 826 | 302 static int |
| 303 compute_canon_mapper (struct chartab_range *range, | |
| 2286 | 304 Lisp_Object UNUSED (table), Lisp_Object val, void *arg) |
| 826 | 305 { |
| 5013 | 306 Lisp_Object casetab = GET_LISP_FROM_VOID (arg); |
| 826 | 307 if (range->type == CHARTAB_RANGE_CHAR) |
| 308 SET_TRT_TABLE_OF (XCASE_TABLE_CANON (casetab), range->ch, | |
| 309 TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (casetab), | |
| 310 TRT_TABLE_OF (XCASE_TABLE_UPCASE (casetab), | |
| 311 XCHAR (val)))); | |
| 312 | |
| 313 return 0; | |
| 314 } | |
| 315 | |
| 316 static int | |
| 317 initialize_identity_mapper (struct chartab_range *range, | |
| 2286 | 318 Lisp_Object UNUSED (table), |
| 319 Lisp_Object UNUSED (val), void *arg) | |
| 826 | 320 { |
| 5013 | 321 Lisp_Object trt = GET_LISP_FROM_VOID (arg); |
| 826 | 322 if (range->type == CHARTAB_RANGE_CHAR) |
| 323 SET_TRT_TABLE_OF (trt, range->ch, range->ch); | |
| 324 | |
| 325 return 0; | |
| 326 } | |
| 327 | |
| 328 static int | |
| 329 compute_up_or_eqv_mapper (struct chartab_range *range, | |
| 2286 | 330 Lisp_Object UNUSED (table), |
| 331 Lisp_Object val, void *arg) | |
| 826 | 332 { |
| 5013 | 333 Lisp_Object inverse = GET_LISP_FROM_VOID (arg); |
| 867 | 334 Ichar toch = XCHAR (val); |
| 826 | 335 |
| 336 if (range->type == CHARTAB_RANGE_CHAR && range->ch != toch) | |
| 337 { | |
| 867 | 338 Ichar c = TRT_TABLE_OF (inverse, toch); |
| 826 | 339 SET_TRT_TABLE_OF (inverse, toch, range->ch); |
| 340 SET_TRT_TABLE_OF (inverse, range->ch, c); | |
| 341 } | |
| 342 | |
| 343 return 0; | |
| 344 } | |
| 345 | |
| 346 /* Recomputing the canonical and equivalency tables from scratch is a | |
| 347 lengthy process, and doing them incrementally is extremely difficult or | |
| 348 perhaps impossible -- and certainly not worth it. To avoid lots of | |
| 349 excessive recomputation when lots of stuff is incrementally added, we | |
| 350 just store a dirty flag and then recompute when a value from the canon | |
| 351 or eqv tables is actually needed. */ | |
| 352 | |
| 353 void | |
| 354 recompute_case_table (Lisp_Object casetab) | |
| 355 { | |
| 356 struct chartab_range range; | |
| 357 | |
| 358 range.type = CHARTAB_RANGE_ALL; | |
| 359 /* Turn off dirty flag first so we don't get infinite recursion when | |
| 360 retrieving the values below! */ | |
| 361 XCASE_TABLE (casetab)->dirty = 0; | |
| 362 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, | |
| 5013 | 363 compute_canon_mapper, STORE_LISP_IN_VOID (casetab)); |
| 826 | 364 map_char_table (XCASE_TABLE_CANON (casetab), &range, |
| 365 initialize_identity_mapper, | |
| 5013 | 366 STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab))); |
| 826 | 367 map_char_table (XCASE_TABLE_CANON (casetab), &range, |
| 368 compute_up_or_eqv_mapper, | |
| 5013 | 369 STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab))); |
| 826 | 370 } |
| 371 | |
| 428 | 372 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /* |
| 373 Return the case table of BUFFER, which defaults to the current buffer. | |
| 374 */ | |
| 375 (buffer)) | |
| 376 { | |
| 377 struct buffer *buf = decode_buffer (buffer, 0); | |
| 378 | |
| 446 | 379 return buf->case_table; |
| 428 | 380 } |
| 381 | |
| 382 DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /* | |
| 383 Return the standard case table. | |
| 384 This is the one used for new buffers. | |
| 385 */ | |
| 386 ()) | |
| 387 { | |
| 446 | 388 return Vstandard_case_table; |
| 428 | 389 } |
| 390 | |
| 826 | 391 static void |
| 392 convert_old_style_syntax_string (Lisp_Object table, Lisp_Object string) | |
| 393 { | |
| 867 | 394 Ichar i; |
| 826 | 395 |
| 396 for (i = 0; i < 256; i++) | |
| 867 | 397 SET_TRT_TABLE_OF (table, i, string_ichar (string, i)); |
| 826 | 398 } |
| 399 | |
| 400 static Lisp_Object | |
| 401 set_case_table (Lisp_Object table, int standard) | |
| 402 { | |
| 403 /* This function can GC */ | |
| 404 struct buffer *buf = | |
| 405 standard ? XBUFFER (Vbuffer_defaults) : current_buffer; | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4890
diff
changeset
|
406 Lisp_Object casetab; |
| 826 | 407 |
| 408 check_case_table (table); | |
| 409 | |
| 410 if (CASE_TABLEP (table)) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4890
diff
changeset
|
411 casetab = table; |
| 826 | 412 else |
| 413 { | |
| 414 /* For backward compatibility. */ | |
| 415 Lisp_Object down, up, canon, eqv, tail = table; | |
| 416 struct chartab_range range; | |
| 417 | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4890
diff
changeset
|
418 casetab = Fmake_case_table (); |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4890
diff
changeset
|
419 |
| 826 | 420 range.type = CHARTAB_RANGE_ALL; |
| 421 | |
| 422 Freset_char_table (XCASE_TABLE_DOWNCASE (casetab)); | |
| 423 Freset_char_table (XCASE_TABLE_UPCASE (casetab)); | |
| 424 Freset_char_table (XCASE_TABLE_CANON (casetab)); | |
| 425 Freset_char_table (XCASE_TABLE_EQV (casetab)); | |
| 426 | |
| 427 down = XCAR (tail); tail = XCDR (tail); | |
| 428 up = XCAR (tail); tail = XCDR (tail); | |
| 429 canon = XCAR (tail); tail = XCDR (tail); | |
| 430 eqv = XCAR (tail); | |
| 431 | |
| 432 convert_old_style_syntax_string (XCASE_TABLE_DOWNCASE (casetab), down); | |
| 433 | |
| 434 if (NILP (up)) | |
| 435 { | |
| 436 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, | |
| 437 initialize_identity_mapper, | |
| 5013 | 438 STORE_LISP_IN_VOID (XCASE_TABLE_UPCASE (casetab))); |
| 826 | 439 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, |
| 440 compute_up_or_eqv_mapper, | |
| 5013 | 441 STORE_LISP_IN_VOID (XCASE_TABLE_UPCASE (casetab))); |
| 826 | 442 } |
| 443 else | |
| 444 convert_old_style_syntax_string (XCASE_TABLE_UPCASE (casetab), up); | |
| 445 | |
| 446 if (NILP (canon)) | |
| 447 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range, | |
| 5013 | 448 compute_canon_mapper, STORE_LISP_IN_VOID (casetab)); |
| 826 | 449 else |
| 450 convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), canon); | |
| 451 | |
| 452 if (NILP (eqv)) | |
| 453 { | |
| 454 map_char_table (XCASE_TABLE_CANON (casetab), &range, | |
| 455 initialize_identity_mapper, | |
| 5013 | 456 STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab))); |
| 826 | 457 map_char_table (XCASE_TABLE_CANON (casetab), &range, |
| 458 compute_up_or_eqv_mapper, | |
| 5013 | 459 STORE_LISP_IN_VOID (XCASE_TABLE_EQV (casetab))); |
| 826 | 460 } |
| 461 else | |
| 462 convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), eqv); | |
| 463 } | |
| 464 | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4890
diff
changeset
|
465 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4890
diff
changeset
|
466 if (standard) |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4890
diff
changeset
|
467 Vstandard_case_table = casetab; |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4890
diff
changeset
|
468 |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4890
diff
changeset
|
469 buf->case_table = casetab; |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4890
diff
changeset
|
470 |
| 826 | 471 return buf->case_table; |
| 472 } | |
| 428 | 473 |
| 474 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /* | |
| 444 | 475 Select CASE-TABLE as the new case table for the current buffer. |
| 446 | 476 A case table is a case-table object or list |
| 477 (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES) | |
| 428 | 478 where each element is either nil or a string of length 256. |
| 446 | 479 The latter is provided for backward-compatibility. |
| 428 | 480 DOWNCASE maps each character to its lower-case equivalent. |
| 481 UPCASE maps each character to its upper-case equivalent; | |
| 482 if lower and upper case characters are in 1-1 correspondence, | |
| 483 you may use nil and the upcase table will be deduced from DOWNCASE. | |
| 484 CANONICALIZE maps each character to a canonical equivalent; | |
| 485 any two characters that are related by case-conversion have the same | |
| 486 canonical equivalent character; it may be nil, in which case it is | |
| 487 deduced from DOWNCASE and UPCASE. | |
| 488 EQUIVALENCES is a map that cyclicly permutes each equivalence class | |
| 489 (of characters with the same canonical equivalent); it may be nil, | |
| 490 in which case it is deduced from CANONICALIZE. | |
| 491 | |
| 446 | 492 See also `get-case-table', `put-case-table' and `put-case-table-pair'. |
| 428 | 493 */ |
| 444 | 494 (case_table)) |
| 428 | 495 { |
| 446 | 496 /* This function can GC */ |
| 444 | 497 return set_case_table (case_table, 0); |
| 428 | 498 } |
| 499 | |
| 500 DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /* | |
| 444 | 501 Select CASE-TABLE as the new standard case table for new buffers. |
| 428 | 502 See `set-case-table' for more info on case tables. |
| 503 */ | |
| 444 | 504 (case_table)) |
| 428 | 505 { |
| 446 | 506 /* This function can GC */ |
| 444 | 507 return set_case_table (case_table, 1); |
| 428 | 508 } |
| 509 | |
| 510 | |
| 511 void | |
| 512 syms_of_casetab (void) | |
| 513 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
514 INIT_LISP_OBJECT (case_table); |
| 446 | 515 |
| 563 | 516 DEFSYMBOL_MULTIWORD_PREDICATE (Qcase_tablep); |
| 517 DEFSYMBOL (Qdowncase); | |
| 518 DEFSYMBOL (Qupcase); | |
| 428 | 519 |
| 826 | 520 DEFSUBR (Fmake_case_table); |
| 428 | 521 DEFSUBR (Fcase_table_p); |
| 446 | 522 DEFSUBR (Fget_case_table); |
| 523 DEFSUBR (Fput_case_table); | |
| 524 DEFSUBR (Fput_case_table_pair); | |
| 428 | 525 DEFSUBR (Fcurrent_case_table); |
| 526 DEFSUBR (Fstandard_case_table); | |
| 446 | 527 DEFSUBR (Fcopy_case_table); |
| 428 | 528 DEFSUBR (Fset_case_table); |
| 529 DEFSUBR (Fset_standard_case_table); | |
| 530 } | |
| 531 | |
| 532 void | |
| 533 complex_vars_of_casetab (void) | |
| 534 { | |
| 867 | 535 REGISTER Ichar i; |
| 428 | 536 |
| 446 | 537 staticpro (&Vstandard_case_table); |
| 428 | 538 |
| 826 | 539 Vstandard_case_table = allocate_case_table (1); |
| 428 | 540 |
| 541 for (i = 0; i < 256; i++) | |
| 542 { | |
| 543 unsigned char lowered = tolower (i); | |
| 544 | |
| 826 | 545 SET_TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (Vstandard_case_table), i, |
| 546 lowered); | |
| 428 | 547 } |
| 548 | |
| 549 for (i = 0; i < 256; i++) | |
| 550 { | |
| 551 unsigned char flipped = (isupper (i) ? tolower (i) | |
| 552 : (islower (i) ? toupper (i) : i)); | |
| 553 | |
| 826 | 554 SET_TRT_TABLE_OF (XCASE_TABLE_UPCASE (Vstandard_case_table), i, |
| 555 flipped); | |
| 428 | 556 } |
| 826 | 557 |
| 558 recompute_case_table (Vstandard_case_table); | |
| 428 | 559 } |