Mercurial > hg > xemacs-beta
annotate src/syntax.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 | 6c6d78781d59 |
| rev | line source |
|---|---|
| 428 | 1 /* XEmacs routines to deal with syntax tables; also word and list parsing. |
| 2 Copyright (C) 1985-1994 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 1296 | 4 Copyright (C) 2001, 2002, 2003 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
| 8 XEmacs is free software; you can redistribute it and/or modify it | |
| 9 under the terms of the GNU General Public License as published by the | |
| 10 Free Software Foundation; either version 2, or (at your option) any | |
| 11 later version. | |
| 12 | |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 19 along with XEmacs; see the file COPYING. If not, write to | |
| 20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 21 Boston, MA 02111-1307, USA. */ | |
| 22 | |
| 23 /* Synched up with: FSF 19.28. */ | |
| 24 | |
| 25 /* This file has been Mule-ized. */ | |
| 26 | |
| 27 #include <config.h> | |
| 28 #include "lisp.h" | |
| 29 | |
| 30 #include "buffer.h" | |
| 31 #include "syntax.h" | |
| 460 | 32 #include "extents.h" |
| 428 | 33 |
| 460 | 34 #define ST_COMMENT_STYLE 0x101 |
| 35 #define ST_STRING_STYLE 0x102 | |
| 36 | |
| 37 Lisp_Object Qsyntax_table; | |
| 38 int lookup_syntax_properties; | |
| 39 | |
| 428 | 40 Lisp_Object Qsyntax_table_p; |
| 41 | |
| 42 int words_include_escapes; | |
| 43 | |
| 44 int parse_sexp_ignore_comments; | |
| 45 | |
| 46 /* The following two variables are provided to tell additional information | |
| 47 to the regex routines. We do it this way rather than change the | |
| 48 arguments to re_search_2() in an attempt to maintain some call | |
| 49 compatibility with other versions of the regex code. */ | |
| 50 | |
| 51 /* Tell the regex routines not to QUIT. Normally there is a QUIT | |
| 52 each iteration in re_search_2(). */ | |
| 53 int no_quit_in_re_search; | |
| 54 | |
| 826 | 55 /* The standard syntax table is stored where it will automatically |
| 56 be used in all new buffers. */ | |
| 428 | 57 Lisp_Object Vstandard_syntax_table; |
| 58 | |
| 59 Lisp_Object Vsyntax_designator_chars_string; | |
| 60 | |
| 826 | 61 Lisp_Object Vtemp_table_for_use_updating_syntax_tables; |
| 62 | |
| 1296 | 63 /* A value that is guaranteed not be in a syntax table. */ |
| 64 Lisp_Object Vbogus_syntax_table_value; | |
| 65 | |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
66 Lisp_Object Qscan_error; |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
67 |
| 826 | 68 static void syntax_cache_table_was_changed (struct buffer *buf); |
| 69 | |
| 428 | 70 /* This is the internal form of the parse state used in parse-partial-sexp. */ |
| 71 | |
| 72 struct lisp_parse_state | |
| 73 { | |
| 74 int depth; /* Depth at end of parsing */ | |
| 867 | 75 Ichar instring; /* -1 if not within string, else desired terminator */ |
| 428 | 76 int incomment; /* Nonzero if within a comment at end of parsing */ |
| 460 | 77 int comstyle; /* comment style a=0, or b=1, or ST_COMMENT_STYLE */ |
| 428 | 78 int quoted; /* Nonzero if just after an escape char at end of |
| 79 parsing */ | |
| 665 | 80 Charbpos thislevelstart;/* Char number of most recent start-of-expression |
| 428 | 81 at current level */ |
| 665 | 82 Charbpos prevlevelstart;/* Char number of start of containing expression */ |
| 83 Charbpos location; /* Char number at which parsing stopped */ | |
| 428 | 84 int mindepth; /* Minimum depth seen while scanning */ |
| 826 | 85 Charbpos comstr_start;/* Position just after last comment/string starter */ |
| 86 Lisp_Object levelstarts;/* Char numbers of starts-of-expression | |
| 87 of levels (starting from outermost). */ | |
| 428 | 88 }; |
| 89 | |
| 90 /* These variables are a cache for finding the start of a defun. | |
| 91 find_start_pos is the place for which the defun start was found. | |
| 92 find_start_value is the defun start position found for it. | |
| 93 find_start_buffer is the buffer it was found in. | |
| 94 find_start_begv is the BEGV value when it was found. | |
| 95 find_start_modiff is the value of MODIFF when it was found. */ | |
| 96 | |
| 665 | 97 static Charbpos find_start_pos; |
| 98 static Charbpos find_start_value; | |
| 428 | 99 static struct buffer *find_start_buffer; |
| 665 | 100 static Charbpos find_start_begv; |
| 428 | 101 static int find_start_modiff; |
| 102 | |
| 103 /* Find a defun-start that is the last one before POS (or nearly the last). | |
| 104 We record what we find, so that another call in the same area | |
| 105 can return the same value right away. */ | |
| 106 | |
| 665 | 107 static Charbpos |
| 108 find_defun_start (struct buffer *buf, Charbpos pos) | |
| 428 | 109 { |
| 665 | 110 Charbpos tem; |
| 826 | 111 struct syntax_cache *scache; |
| 112 | |
| 428 | 113 /* Use previous finding, if it's valid and applies to this inquiry. */ |
| 114 if (buf == find_start_buffer | |
| 115 /* Reuse the defun-start even if POS is a little farther on. | |
| 116 POS might be in the next defun, but that's ok. | |
| 117 Our value may not be the best possible, but will still be usable. */ | |
| 118 && pos <= find_start_pos + 1000 | |
| 119 && pos >= find_start_value | |
| 120 && BUF_BEGV (buf) == find_start_begv | |
| 121 && BUF_MODIFF (buf) == find_start_modiff) | |
| 122 return find_start_value; | |
| 123 | |
| 124 /* Back up to start of line. */ | |
| 125 tem = find_next_newline (buf, pos, -1); | |
| 126 | |
| 826 | 127 scache = setup_buffer_syntax_cache (buf, tem, 1); |
| 428 | 128 while (tem > BUF_BEGV (buf)) |
| 129 { | |
| 826 | 130 UPDATE_SYNTAX_CACHE_BACKWARD (scache, tem); |
| 460 | 131 |
| 428 | 132 /* Open-paren at start of line means we found our defun-start. */ |
| 826 | 133 if (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, tem)) == Sopen) |
| 428 | 134 break; |
| 135 /* Move to beg of previous line. */ | |
| 136 tem = find_next_newline (buf, tem, -2); | |
| 137 } | |
| 138 | |
| 139 /* Record what we found, for the next try. */ | |
| 140 find_start_value = tem; | |
| 141 find_start_buffer = buf; | |
| 142 find_start_modiff = BUF_MODIFF (buf); | |
| 143 find_start_begv = BUF_BEGV (buf); | |
| 144 find_start_pos = pos; | |
| 145 | |
| 146 return find_start_value; | |
| 147 } | |
| 148 | |
| 149 DEFUN ("syntax-table-p", Fsyntax_table_p, 1, 1, 0, /* | |
| 444 | 150 Return t if OBJECT is a syntax table. |
| 428 | 151 */ |
| 444 | 152 (object)) |
| 428 | 153 { |
| 444 | 154 return (CHAR_TABLEP (object) |
| 155 && XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_SYNTAX) | |
| 428 | 156 ? Qt : Qnil; |
| 157 } | |
| 158 | |
| 159 static Lisp_Object | |
| 160 check_syntax_table (Lisp_Object obj, Lisp_Object default_) | |
| 161 { | |
| 162 if (NILP (obj)) | |
| 163 obj = default_; | |
| 164 while (NILP (Fsyntax_table_p (obj))) | |
| 165 obj = wrong_type_argument (Qsyntax_table_p, obj); | |
| 166 return obj; | |
| 167 } | |
| 168 | |
| 169 DEFUN ("syntax-table", Fsyntax_table, 0, 1, 0, /* | |
| 170 Return the current syntax table. | |
| 171 This is the one specified by the current buffer, or by BUFFER if it | |
| 172 is non-nil. | |
| 173 */ | |
| 174 (buffer)) | |
| 175 { | |
| 176 return decode_buffer (buffer, 0)->syntax_table; | |
| 177 } | |
| 178 | |
| 826 | 179 #ifdef DEBUG_XEMACS |
| 180 | |
| 181 DEFUN ("mirror-syntax-table", Fmirror_syntax_table, 0, 1, 0, /* | |
| 182 Return the current mirror syntax table, for debugging purposes. | |
| 183 This is the one specified by the current buffer, or by BUFFER if it | |
| 184 is non-nil. | |
| 185 */ | |
| 186 (buffer)) | |
| 187 { | |
| 188 return decode_buffer (buffer, 0)->mirror_syntax_table; | |
| 189 } | |
| 190 | |
| 191 DEFUN ("syntax-cache-info", Fsyntax_cache_info, 0, 1, 0, /* | |
| 192 Return info about the syntax cache in BUFFER. | |
| 193 BUFFER defaults to the current buffer if nil. | |
| 194 */ | |
| 195 (buffer)) | |
| 196 { | |
| 197 struct buffer *buf = decode_buffer (buffer, 0); | |
| 198 struct syntax_cache *cache = buf->syntax_cache; | |
| 199 return list4 (cache->start, cache->end, make_int (cache->prev_change), | |
| 200 make_int (cache->next_change)); | |
| 201 } | |
| 202 | |
| 203 #endif /* DEBUG_XEMACS */ | |
| 204 | |
| 428 | 205 DEFUN ("standard-syntax-table", Fstandard_syntax_table, 0, 0, 0, /* |
| 206 Return the standard syntax table. | |
| 207 This is the one used for new buffers. | |
| 208 */ | |
| 209 ()) | |
| 210 { | |
| 211 return Vstandard_syntax_table; | |
| 212 } | |
| 213 | |
| 214 DEFUN ("copy-syntax-table", Fcopy_syntax_table, 0, 1, 0, /* | |
| 444 | 215 Return a new syntax table which is a copy of SYNTAX-TABLE. |
| 216 SYNTAX-TABLE defaults to the standard syntax table. | |
| 428 | 217 */ |
| 444 | 218 (syntax_table)) |
| 428 | 219 { |
| 220 if (NILP (Vstandard_syntax_table)) | |
| 221 return Fmake_char_table (Qsyntax); | |
| 222 | |
| 444 | 223 syntax_table = check_syntax_table (syntax_table, Vstandard_syntax_table); |
| 224 return Fcopy_char_table (syntax_table); | |
| 428 | 225 } |
| 226 | |
| 227 DEFUN ("set-syntax-table", Fset_syntax_table, 1, 2, 0, /* | |
| 444 | 228 Select SYNTAX-TABLE as the new syntax table for BUFFER. |
| 428 | 229 BUFFER defaults to the current buffer if omitted. |
| 230 */ | |
| 444 | 231 (syntax_table, buffer)) |
| 428 | 232 { |
| 233 struct buffer *buf = decode_buffer (buffer, 0); | |
| 444 | 234 syntax_table = check_syntax_table (syntax_table, Qnil); |
| 235 buf->syntax_table = syntax_table; | |
| 236 buf->mirror_syntax_table = XCHAR_TABLE (syntax_table)->mirror_table; | |
| 826 | 237 syntax_cache_table_was_changed (buf); |
| 428 | 238 /* Indicate that this buffer now has a specified syntax table. */ |
| 239 buf->local_var_flags |= XINT (buffer_local_flags.syntax_table); | |
| 444 | 240 return syntax_table; |
| 428 | 241 } |
| 3252 | 242 |
| 243 | |
| 428 | 244 |
| 3252 | 245 /* |
| 246 * Syntax caching | |
| 247 */ | |
| 248 | |
| 249 /* syntax_cache object implementation */ | |
| 250 | |
| 251 static const struct memory_description syntax_cache_description_1 [] = { | |
| 252 { XD_LISP_OBJECT, offsetof (struct syntax_cache, object) }, | |
| 253 { XD_LISP_OBJECT, offsetof (struct syntax_cache, buffer) }, | |
| 254 { XD_LISP_OBJECT, offsetof (struct syntax_cache, syntax_table) }, | |
| 255 { XD_LISP_OBJECT, offsetof (struct syntax_cache, mirror_table) }, | |
| 256 { XD_LISP_OBJECT, offsetof (struct syntax_cache, start) }, | |
| 257 { XD_LISP_OBJECT, offsetof (struct syntax_cache, end) }, | |
| 258 { XD_END } | |
| 259 }; | |
| 260 | |
| 261 #ifdef NEW_GC | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
262 DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT ("syntax-cache", syntax_cache, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
263 0, syntax_cache_description_1, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
264 Lisp_Syntax_Cache); |
| 3252 | 265 #else /* not NEW_GC */ |
| 266 | |
| 267 const struct sized_memory_description syntax_cache_description = { | |
| 268 sizeof (struct syntax_cache), | |
| 269 syntax_cache_description_1 | |
| 270 }; | |
| 271 #endif /* not NEW_GC */ | |
| 272 | |
| 273 /* static syntax cache utilities */ | |
| 274 | |
| 275 static void | |
| 276 syntax_cache_table_was_changed (struct buffer *buf) | |
| 277 { | |
| 278 struct syntax_cache *cache = buf->syntax_cache; | |
| 279 if (cache->no_syntax_table_prop) | |
| 280 { | |
| 281 cache->syntax_table = | |
| 282 BUFFER_SYNTAX_TABLE (buf); | |
| 283 cache->mirror_table = | |
| 284 BUFFER_MIRROR_SYNTAX_TABLE (buf); | |
| 285 } | |
| 286 } | |
| 287 | |
| 288 static void | |
| 289 reset_buffer_syntax_cache_range (struct syntax_cache *cache, | |
| 290 Lisp_Object buffer, int infinite) | |
| 291 { | |
| 292 Fset_marker (cache->start, make_int (1), buffer); | |
| 293 Fset_marker (cache->end, make_int (1), buffer); | |
| 294 Fset_marker_insertion_type (cache->start, Qt); | |
| 295 Fset_marker_insertion_type (cache->end, Qnil); | |
| 296 /* #### Should we "cache->no_syntax_table_prop = 1;" here? */ | |
| 297 /* #### Cf comment on INFINITE in init_syntax_cache. -- sjt */ | |
| 298 if (infinite) | |
| 299 { | |
| 300 cache->prev_change = EMACS_INT_MIN; | |
| 301 cache->next_change = EMACS_INT_MAX; | |
| 302 } | |
| 303 else | |
| 304 { | |
| 305 cache->prev_change = -1; | |
| 306 cache->next_change = -1; | |
| 307 } | |
| 308 } | |
| 826 | 309 |
| 310 static void | |
| 311 init_syntax_cache (struct syntax_cache *cache, Lisp_Object object, | |
| 312 struct buffer *buffer, int infinite) | |
| 313 { | |
| 314 xzero (*cache); | |
| 315 cache->object = object; | |
| 316 cache->buffer = buffer; | |
| 317 cache->no_syntax_table_prop = 1; | |
| 1296 | 318 cache->syntax_table = |
| 319 BUFFER_SYNTAX_TABLE (cache->buffer); | |
| 320 cache->mirror_table = | |
| 826 | 321 BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); |
| 322 cache->start = Qnil; | |
| 323 cache->end = Qnil; | |
| 3250 | 324 /* #### I'm not sure what INFINITE is for, but it's apparently needed by |
| 325 setup_syntax_cache(). It looks like it's supposed to guarantee that | |
| 326 the test for POS outside of cache-valid range will never succeed, so | |
| 327 that update_syntax_cache won't get called, but it's hard to be sure. | |
| 328 Cf reset_buffer_syntax_cache_range. -- sjt */ | |
| 826 | 329 if (infinite) |
| 330 { | |
| 331 cache->prev_change = EMACS_INT_MIN; | |
| 332 cache->next_change = EMACS_INT_MAX; | |
| 333 } | |
| 334 else | |
| 335 { | |
| 336 cache->prev_change = -1; | |
| 337 cache->next_change = -1; | |
| 338 } | |
| 339 } | |
| 340 | |
| 3252 | 341 /* external syntax cache API */ |
| 342 | |
| 3250 | 343 /* #### This function and associated logic still needs work, and especially |
| 344 documentation. */ | |
| 345 struct syntax_cache * /* return CACHE or the cache of OBJECT */ | |
| 346 setup_syntax_cache (struct syntax_cache *cache, /* syntax cache, may be NULL | |
| 347 if OBJECT is a buffer */ | |
| 348 Lisp_Object object, /* the object (if any) cache | |
| 349 is associated with */ | |
| 350 struct buffer *buffer, /* the buffer to use as source | |
| 351 of the syntax table */ | |
| 352 Charxpos from, /* initial position of cache */ | |
| 353 int count) /* direction? see code */ | |
| 826 | 354 { |
| 3250 | 355 /* If OBJECT is a buffer, use its cache. Initialize cache. Make it valid |
| 356 for the whole buffer if the syntax-table property is not being respected. | |
| 357 Else if OBJECT is not a buffer, initialize the cache passed in CACHE. | |
| 358 If the syntax-table property is being respected, update the cache. */ | |
| 826 | 359 if (BUFFERP (object)) |
| 3250 | 360 { |
| 361 cache = XBUFFER (object)->syntax_cache; | |
| 362 if (!lookup_syntax_properties) | |
| 363 reset_buffer_syntax_cache_range (cache, object, 1); | |
| 364 } | |
| 365 else | |
| 826 | 366 init_syntax_cache (cache, object, buffer, 0); |
| 367 if (lookup_syntax_properties) | |
| 368 { | |
| 369 if (count <= 0) | |
| 370 { | |
| 371 from--; | |
| 2167 | 372 from = buffer_or_string_clip_to_accessible_char (cache->object, |
| 826 | 373 from); |
| 374 } | |
| 375 if (!(from >= cache->prev_change && from < cache->next_change)) | |
| 376 update_syntax_cache (cache, from, count); | |
| 377 } | |
| 1296 | 378 #ifdef NOT_WORTH_THE_EFFORT |
| 379 update_mirror_syntax_if_dirty (cache->mirror_table); | |
| 380 #endif /* NOT_WORTH_THE_EFFORT */ | |
| 826 | 381 return cache; |
| 382 } | |
| 383 | |
| 384 struct syntax_cache * | |
| 385 setup_buffer_syntax_cache (struct buffer *buffer, Charxpos from, int count) | |
| 386 { | |
| 387 return setup_syntax_cache (NULL, wrap_buffer (buffer), buffer, from, count); | |
| 388 } | |
| 389 | |
| 460 | 390 /* |
| 391 Update syntax_cache to an appropriate setting for position POS | |
| 392 | |
| 393 The sign of COUNT gives the relative position of POS wrt the | |
| 394 previously valid interval. (not currently used) | |
| 395 | |
| 396 `syntax_cache.*_change' are the next and previous positions at | |
| 397 which syntax_code and c_s_t will need to be recalculated. | |
| 398 | |
| 3025 | 399 #### Currently this code uses `get-char-property', which will |
| 460 | 400 return the "last smallest" extent at a given position. In cases |
| 401 where overlapping extents are defined, this code will simply use | |
| 402 whatever is returned by get-char-property. | |
| 403 | |
| 404 It might be worth it at some point to merge provided syntax tables | |
| 826 | 405 outward to the current buffer (#### rewrite in English please?!). */ |
| 460 | 406 |
| 407 void | |
| 2286 | 408 update_syntax_cache (struct syntax_cache *cache, Charxpos cpos, |
| 409 int UNUSED (count)) | |
| 460 | 410 { |
| 411 Lisp_Object tmp_table; | |
| 826 | 412 Bytexpos pos; |
| 413 Bytexpos lim; | |
| 414 Bytexpos next, prev; | |
| 415 int at_begin = 0, at_end = 0; | |
| 460 | 416 |
| 826 | 417 if (NILP (cache->object)) |
| 418 return; | |
| 419 | |
| 420 pos = buffer_or_string_charxpos_to_bytexpos (cache->object, cpos); | |
| 421 | |
| 422 tmp_table = get_char_property (pos, Qsyntax_table, cache->object, | |
| 423 EXTENT_AT_AFTER, 0); | |
| 2506 | 424 lim = next_previous_single_property_change (pos, Qsyntax_table, |
| 425 cache->object, -1, 1, 0); | |
| 826 | 426 if (lim < 0) |
| 460 | 427 { |
| 826 | 428 next = buffer_or_string_absolute_end_byte (cache->object); |
| 429 at_begin = 1; | |
| 460 | 430 } |
| 826 | 431 else |
| 432 next = lim; | |
| 460 | 433 |
| 826 | 434 if (pos < buffer_or_string_absolute_end_byte (cache->object)) |
| 435 pos = next_bytexpos (cache->object, pos); | |
| 2506 | 436 lim = next_previous_single_property_change (pos, Qsyntax_table, |
| 437 cache->object, -1, 0, 0); | |
| 826 | 438 if (lim < 0) |
| 460 | 439 { |
| 826 | 440 prev = buffer_or_string_absolute_begin_byte (cache->object); |
| 441 at_end = 1; | |
| 460 | 442 } |
| 443 else | |
| 826 | 444 prev = lim; |
| 460 | 445 |
| 826 | 446 cache->prev_change = |
| 447 buffer_or_string_bytexpos_to_charxpos (cache->object, prev); | |
| 448 cache->next_change = | |
| 449 buffer_or_string_bytexpos_to_charxpos (cache->object, next); | |
| 460 | 450 |
| 826 | 451 if (BUFFERP (cache->object)) |
| 452 { | |
| 453 /* If we are at the beginning or end of buffer, check to see if there's | |
| 454 a zero-length `syntax-table' extent there (highly unlikely); if not, | |
| 455 then we can safely make the end closed, so it will take in newly | |
| 456 inserted text. (If such an extent is inserted, we will be informed | |
| 3250 | 457 through signal_syntax_cache_extent_changed().) */ |
| 826 | 458 Fset_marker (cache->start, make_int (cache->prev_change), cache->object); |
| 459 Fset_marker_insertion_type | |
| 460 (cache->start, | |
| 461 at_begin && NILP (extent_at (prev, cache->object, Qsyntax_table, | |
| 462 NULL, EXTENT_AT_AT, 0)) | |
| 463 ? Qnil : Qt); | |
| 464 Fset_marker (cache->end, make_int (cache->next_change), cache->object); | |
| 465 Fset_marker_insertion_type | |
| 466 (cache->end, | |
| 467 at_end && NILP (extent_at (next, cache->object, Qsyntax_table, | |
| 468 NULL, EXTENT_AT_AT, 0)) | |
| 469 ? Qt : Qnil); | |
| 470 } | |
| 471 | |
| 472 if (!NILP (Fsyntax_table_p (tmp_table))) | |
| 473 { | |
| 474 cache->use_code = 0; | |
| 1296 | 475 cache->syntax_table = tmp_table; |
| 476 cache->mirror_table = XCHAR_TABLE (tmp_table)->mirror_table; | |
| 826 | 477 cache->no_syntax_table_prop = 0; |
| 1296 | 478 #ifdef NOT_WORTH_THE_EFFORT |
| 479 update_mirror_syntax_if_dirty (cache->mirror_table); | |
| 480 #endif /* NOT_WORTH_THE_EFFORT */ | |
| 826 | 481 } |
| 482 else if (CONSP (tmp_table) && INTP (XCAR (tmp_table))) | |
| 483 { | |
| 484 cache->use_code = 1; | |
| 485 cache->syntax_code = XINT (XCAR (tmp_table)); | |
| 486 cache->no_syntax_table_prop = 0; | |
| 487 } | |
| 488 else | |
| 489 { | |
| 490 cache->use_code = 0; | |
| 491 cache->no_syntax_table_prop = 1; | |
| 1296 | 492 cache->syntax_table = BUFFER_SYNTAX_TABLE (cache->buffer); |
| 493 cache->mirror_table = BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); | |
| 494 #ifdef NOT_WORTH_THE_EFFORT | |
| 495 update_mirror_syntax_if_dirty (cache->mirror_table); | |
| 496 #endif /* NOT_WORTH_THE_EFFORT */ | |
| 460 | 497 } |
| 498 } | |
| 3252 | 499 |
| 500 /* buffer-specific APIs used in buffer.c | |
| 501 #### This is really unclean; | |
| 502 the syntax cache should just be a LISP object */ | |
| 503 | |
| 504 void | |
| 505 mark_buffer_syntax_cache (struct buffer *buf) | |
| 506 { | |
| 507 struct syntax_cache *cache = buf->syntax_cache; | |
| 508 if (!cache) /* Vbuffer_defaults and such don't have caches */ | |
| 509 return; | |
| 510 mark_object (cache->object); | |
| 511 if (cache->buffer) | |
| 512 mark_object (wrap_buffer (cache->buffer)); | |
| 513 mark_object (cache->syntax_table); | |
| 514 mark_object (cache->mirror_table); | |
| 515 mark_object (cache->start); | |
| 516 mark_object (cache->end); | |
| 517 } | |
| 518 | |
| 519 void | |
| 520 init_buffer_syntax_cache (struct buffer *buf) | |
| 521 { | |
| 522 struct syntax_cache *cache; | |
| 523 #ifdef NEW_GC | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5126
diff
changeset
|
524 buf->syntax_cache = XSYNTAX_CACHE (ALLOC_NORMAL_LISP_OBJECT (syntax_cache)); |
| 3252 | 525 #else /* not NEW_GC */ |
| 526 buf->syntax_cache = xnew_and_zero (struct syntax_cache); | |
| 527 #endif /* not NEW_GC */ | |
| 528 cache = buf->syntax_cache; | |
| 529 cache->object = wrap_buffer (buf); | |
| 530 cache->buffer = buf; | |
| 531 cache->no_syntax_table_prop = 1; | |
| 532 cache->syntax_table = BUFFER_SYNTAX_TABLE (cache->buffer); | |
| 533 cache->mirror_table = BUFFER_MIRROR_SYNTAX_TABLE (cache->buffer); | |
| 534 cache->start = Fmake_marker (); | |
| 535 cache->end = Fmake_marker (); | |
| 536 reset_buffer_syntax_cache_range (cache, cache->object, 0); | |
| 537 } | |
| 538 | |
| 539 /* finalize the syntax cache for BUF */ | |
| 540 | |
| 541 void | |
|
4710
3a87551bfeb5
Fixes for a number of minor warnings issued by gcc. See xemacs-patches message
Jerry James <james@xemacs.org>
parents:
4653
diff
changeset
|
542 uninit_buffer_syntax_cache (struct buffer *UNUSED_IF_NEW_GC (buf)) |
| 3252 | 543 { |
| 4141 | 544 #ifndef NEW_GC |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4912
diff
changeset
|
545 xfree (buf->syntax_cache); |
| 3252 | 546 buf->syntax_cache = 0; |
| 4141 | 547 #endif /* not NEW_GC */ |
| 3252 | 548 } |
| 549 | |
| 550 /* extent-specific APIs used in extents.c and insdel.c */ | |
| 551 | |
| 552 /* The syntax-table property on the range covered by EXTENT may be changing, | |
| 553 either because EXTENT has a syntax-table property and is being attached | |
| 554 or detached (this includes having its endpoints changed), or because | |
| 555 the value of EXTENT's syntax-table property is changing. */ | |
| 556 | |
| 557 void | |
| 558 signal_syntax_cache_extent_changed (EXTENT extent) | |
| 559 { | |
| 560 Lisp_Object buffer = Fextent_object (wrap_extent (extent)); | |
| 561 if (BUFFERP (buffer)) | |
| 562 { | |
| 563 /* This was getting called with the buffer's start and end null, eg in | |
| 564 cperl mode, which triggers an assert in byte_marker_position. Cf | |
| 565 thread rooted at <yxz7j7xzk97.fsf@gimli.holgi.priv> on xemacs-beta. | |
| 566 <yxzfymklb6p.fsf@gimli.holgi.priv> has a recipe, but you also need | |
| 567 to delete or type SPC to get the crash. | |
| 568 #### Delete this comment when setup_syntax_cache is made sane. */ | |
| 569 struct syntax_cache *cache = XBUFFER (buffer)->syntax_cache; | |
| 570 /* #### would this be slower or less accurate in character terms? */ | |
| 571 Bytexpos start = extent_endpoint_byte (extent, 0); | |
| 572 Bytexpos end = extent_endpoint_byte (extent, 1); | |
| 573 Bytexpos start2 = byte_marker_position (cache->start); | |
| 574 Bytexpos end2 = byte_marker_position (cache->end); | |
| 575 /* If the extent is entirely before or entirely after the cache | |
| 576 range, it doesn't overlap. Otherwise, invalidate the range. */ | |
| 577 if (!(end < start2 || start > end2)) | |
| 578 reset_buffer_syntax_cache_range (cache, buffer, 0); | |
| 579 } | |
| 580 } | |
| 581 | |
| 582 /* Extents have been adjusted for insertion or deletion, so we need to | |
| 583 refetch the start and end position of the extent */ | |
| 584 void | |
| 585 signal_syntax_cache_extent_adjust (struct buffer *buf) | |
| 586 { | |
| 587 struct syntax_cache *cache = buf->syntax_cache; | |
| 588 /* If the cache was invalid before, leave it that way. We only want | |
| 589 to update the limits of validity when they were actually valid. */ | |
| 590 if (cache->prev_change < 0) | |
| 591 return; | |
| 592 cache->prev_change = marker_position (cache->start); | |
| 593 cache->next_change = marker_position (cache->end); | |
| 594 } | |
| 595 | |
| 596 | |
| 460 | 597 |
| 428 | 598 /* Convert a letter which signifies a syntax code |
| 599 into the code it signifies. | |
| 600 This is used by modify-syntax-entry, and other things. */ | |
| 601 | |
| 442 | 602 const unsigned char syntax_spec_code[0400] = |
| 428 | 603 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, |
| 604 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 605 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 606 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 607 (char) Swhitespace, 0377, (char) Sstring, 0377, | |
| 608 (char) Smath, 0377, 0377, (char) Squote, | |
| 609 (char) Sopen, (char) Sclose, 0377, 0377, | |
| 610 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote, | |
| 611 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 612 0377, 0377, 0377, 0377, | |
| 613 (char) Scomment, 0377, (char) Sendcomment, 0377, | |
| 614 (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */ | |
| 615 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 616 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword, | |
| 617 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol, | |
| 618 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */ | |
| 619 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, | |
| 620 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword, | |
| 460 | 621 0377, 0377, 0377, 0377, (char) Sstring_fence, 0377, 0377, 0377 |
| 428 | 622 }; |
| 623 | |
| 460 | 624 const unsigned char syntax_code_spec[] = " .w_()'\"$\\/<>@!|"; |
| 428 | 625 |
| 626 DEFUN ("syntax-designator-chars", Fsyntax_designator_chars, 0, 0, 0, /* | |
| 627 Return a string of the recognized syntax designator chars. | |
| 628 The chars are ordered by their internal syntax codes, which are | |
| 629 numbered starting at 0. | |
| 630 */ | |
| 631 ()) | |
| 632 { | |
| 633 return Vsyntax_designator_chars_string; | |
| 634 } | |
| 635 | |
| 636 DEFUN ("char-syntax", Fchar_syntax, 1, 2, 0, /* | |
| 444 | 637 Return the syntax code of CHARACTER, described by a character. |
| 638 For example, if CHARACTER is a word constituent, | |
| 639 the character `?w' is returned. | |
| 428 | 640 The characters that correspond to various syntax codes |
| 641 are listed in the documentation of `modify-syntax-entry'. | |
| 444 | 642 Optional second argument SYNTAX-TABLE defaults to the current buffer's |
| 428 | 643 syntax table. |
| 644 */ | |
| 444 | 645 (character, syntax_table)) |
| 428 | 646 { |
| 826 | 647 Lisp_Object mirrortab; |
| 428 | 648 |
| 444 | 649 if (NILP (character)) |
| 428 | 650 { |
| 444 | 651 character = make_char ('\000'); |
| 428 | 652 } |
| 444 | 653 CHECK_CHAR_COERCE_INT (character); |
| 826 | 654 syntax_table = check_syntax_table (syntax_table, |
| 655 current_buffer->syntax_table); | |
| 656 mirrortab = XCHAR_TABLE (syntax_table)->mirror_table; | |
| 657 return make_char (syntax_code_spec[(int) SYNTAX (mirrortab, | |
| 658 XCHAR (character))]); | |
| 428 | 659 } |
| 660 | |
| 661 #ifdef MULE | |
| 662 | |
| 663 enum syntaxcode | |
| 2286 | 664 charset_syntax (struct buffer *UNUSED (buf), Lisp_Object UNUSED (charset), |
| 665 int *multi_p_out) | |
| 428 | 666 { |
| 667 *multi_p_out = 1; | |
| 826 | 668 /* !!#### get this right */ |
| 3152 | 669 return Sword; |
| 428 | 670 } |
| 671 | |
| 672 #endif | |
| 673 | |
| 674 Lisp_Object | |
| 867 | 675 syntax_match (Lisp_Object syntax_table, Ichar ch) |
| 428 | 676 { |
| 826 | 677 Lisp_Object code = get_char_table (ch, syntax_table); |
| 428 | 678 Lisp_Object code2 = code; |
| 679 | |
| 680 if (CONSP (code)) | |
| 681 code2 = XCAR (code); | |
| 682 if (SYNTAX_FROM_CODE (XINT (code2)) == Sinherit) | |
| 826 | 683 code = get_char_table (ch, Vstandard_syntax_table); |
| 428 | 684 |
| 685 return CONSP (code) ? XCDR (code) : Qnil; | |
| 686 } | |
| 687 | |
| 688 DEFUN ("matching-paren", Fmatching_paren, 1, 2, 0, /* | |
| 444 | 689 Return the matching parenthesis of CHARACTER, or nil if none. |
| 690 Optional second argument SYNTAX-TABLE defaults to the current buffer's | |
| 428 | 691 syntax table. |
| 692 */ | |
| 444 | 693 (character, syntax_table)) |
| 428 | 694 { |
| 826 | 695 Lisp_Object mirrortab; |
| 1315 | 696 enum syntaxcode code; |
| 428 | 697 |
| 444 | 698 CHECK_CHAR_COERCE_INT (character); |
| 826 | 699 syntax_table = check_syntax_table (syntax_table, |
| 700 current_buffer->syntax_table); | |
| 701 mirrortab = XCHAR_TABLE (syntax_table)->mirror_table; | |
| 444 | 702 code = SYNTAX (mirrortab, XCHAR (character)); |
| 428 | 703 if (code == Sopen || code == Sclose || code == Sstring) |
| 444 | 704 return syntax_match (syntax_table, XCHAR (character)); |
| 428 | 705 return Qnil; |
| 706 } | |
| 707 | |
| 708 | |
| 709 | |
| 710 #ifdef MULE | |
| 711 /* Return 1 if there is a word boundary between two word-constituent | |
| 712 characters C1 and C2 if they appear in this order, else return 0. | |
| 713 There is no word boundary between two word-constituent ASCII | |
| 714 characters. */ | |
| 715 #define WORD_BOUNDARY_P(c1, c2) \ | |
| 867 | 716 (!(ichar_ascii_p (c1) && ichar_ascii_p (c2)) \ |
| 428 | 717 && word_boundary_p (c1, c2)) |
| 718 #endif | |
| 719 | |
| 720 /* Return the position across COUNT words from FROM. | |
| 721 If that many words cannot be found before the end of the buffer, return 0. | |
| 722 COUNT negative means scan backward and stop at word beginning. */ | |
| 723 | |
| 665 | 724 Charbpos |
| 725 scan_words (struct buffer *buf, Charbpos from, int count) | |
| 428 | 726 { |
| 665 | 727 Charbpos limit = count > 0 ? BUF_ZV (buf) : BUF_BEGV (buf); |
| 867 | 728 Ichar ch0, ch1; |
| 428 | 729 enum syntaxcode code; |
| 826 | 730 struct syntax_cache *scache = setup_buffer_syntax_cache (buf, from, count); |
| 460 | 731 |
| 428 | 732 /* #### is it really worth it to hand expand both cases? JV */ |
| 733 while (count > 0) | |
| 734 { | |
| 735 QUIT; | |
| 736 | |
| 737 while (1) | |
| 738 { | |
| 739 if (from == limit) | |
| 740 return 0; | |
| 741 | |
| 826 | 742 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 743 ch0 = BUF_FETCH_CHAR (buf, from); |
| 826 | 744 code = SYNTAX_FROM_CACHE (scache, ch0); |
| 428 | 745 |
| 442 | 746 from++; |
| 428 | 747 if (words_include_escapes |
| 748 && (code == Sescape || code == Scharquote)) | |
| 749 break; | |
| 750 if (code == Sword) | |
| 751 break; | |
| 752 } | |
| 753 | |
| 754 QUIT; | |
| 755 | |
| 756 while (from != limit) | |
| 757 { | |
| 826 | 758 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 759 ch1 = BUF_FETCH_CHAR (buf, from); |
| 826 | 760 code = SYNTAX_FROM_CACHE (scache, ch1); |
| 428 | 761 if (!(words_include_escapes |
| 762 && (code == Sescape || code == Scharquote))) | |
| 763 if (code != Sword | |
| 764 #ifdef MULE | |
| 765 || WORD_BOUNDARY_P (ch0, ch1) | |
| 434 | 766 #endif |
| 428 | 767 ) |
| 768 break; | |
| 769 #ifdef MULE | |
| 770 ch0 = ch1; | |
| 434 | 771 #endif |
| 428 | 772 from++; |
| 773 } | |
| 774 count--; | |
| 775 } | |
| 776 | |
| 777 while (count < 0) | |
| 778 { | |
| 779 QUIT; | |
| 780 | |
| 781 while (1) | |
| 782 { | |
| 783 if (from == limit) | |
| 784 return 0; | |
| 785 | |
| 826 | 786 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 428 | 787 ch1 = BUF_FETCH_CHAR (buf, from - 1); |
| 826 | 788 code = SYNTAX_FROM_CACHE (scache, ch1); |
| 460 | 789 from--; |
| 442 | 790 |
| 428 | 791 if (words_include_escapes |
| 792 && (code == Sescape || code == Scharquote)) | |
| 793 break; | |
| 794 if (code == Sword) | |
| 795 break; | |
| 796 } | |
| 797 | |
| 798 QUIT; | |
| 799 | |
| 800 while (from != limit) | |
| 801 { | |
| 826 | 802 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 428 | 803 ch0 = BUF_FETCH_CHAR (buf, from - 1); |
| 826 | 804 code = SYNTAX_FROM_CACHE (scache, ch0); |
| 460 | 805 |
| 428 | 806 if (!(words_include_escapes |
| 807 && (code == Sescape || code == Scharquote))) | |
| 808 if (code != Sword | |
| 809 #ifdef MULE | |
| 810 || WORD_BOUNDARY_P (ch0, ch1) | |
| 811 #endif | |
| 812 ) | |
| 813 break; | |
| 814 #ifdef MULE | |
| 815 ch1 = ch0; | |
| 816 #endif | |
| 817 from--; | |
| 818 } | |
| 819 count++; | |
| 820 } | |
| 821 | |
| 822 return from; | |
| 823 } | |
| 824 | |
| 446 | 825 DEFUN ("forward-word", Fforward_word, 0, 2, "_p", /* |
| 428 | 826 Move point forward COUNT words (backward if COUNT is negative). |
| 446 | 827 Normally t is returned, but if an edge of the buffer is reached, |
| 828 point is left there and nil is returned. | |
| 428 | 829 |
| 462 | 830 The characters that are moved over may be added to the current selection |
| 831 \(i.e. active region) if the Shift key is held down, a motion key is used | |
| 832 to invoke this command, and `shifted-motion-keys-select-region' is t; see | |
| 833 the documentation for this variable for more details. | |
| 834 | |
| 446 | 835 COUNT defaults to 1, and BUFFER defaults to the current buffer. |
| 428 | 836 */ |
| 837 (count, buffer)) | |
| 838 { | |
| 665 | 839 Charbpos val; |
| 428 | 840 struct buffer *buf = decode_buffer (buffer, 0); |
| 446 | 841 EMACS_INT n; |
| 842 | |
| 843 if (NILP (count)) | |
| 844 n = 1; | |
| 845 else | |
| 846 { | |
| 847 CHECK_INT (count); | |
| 848 n = XINT (count); | |
| 849 } | |
| 428 | 850 |
| 446 | 851 val = scan_words (buf, BUF_PT (buf), n); |
| 852 if (val) | |
| 428 | 853 { |
| 446 | 854 BUF_SET_PT (buf, val); |
| 855 return Qt; | |
| 856 } | |
| 857 else | |
| 858 { | |
| 859 BUF_SET_PT (buf, n > 0 ? BUF_ZV (buf) : BUF_BEGV (buf)); | |
| 428 | 860 return Qnil; |
| 861 } | |
| 862 } | |
| 863 | |
| 864 static void scan_sexps_forward (struct buffer *buf, | |
| 865 struct lisp_parse_state *, | |
| 665 | 866 Charbpos from, Charbpos end, |
| 428 | 867 int targetdepth, int stopbefore, |
| 868 Lisp_Object oldstate, | |
| 869 int commentstop); | |
| 870 | |
| 871 static int | |
| 665 | 872 find_start_of_comment (struct buffer *buf, Charbpos from, Charbpos stop, |
| 460 | 873 int comstyle) |
| 428 | 874 { |
| 867 | 875 Ichar c; |
| 428 | 876 enum syntaxcode code; |
| 877 | |
| 878 /* Look back, counting the parity of string-quotes, | |
| 879 and recording the comment-starters seen. | |
| 880 When we reach a safe place, assume that's not in a string; | |
| 881 then step the main scan to the earliest comment-starter seen | |
| 882 an even number of string quotes away from the safe place. | |
| 883 | |
| 884 OFROM[I] is position of the earliest comment-starter seen | |
| 885 which is I+2X quotes from the comment-end. | |
| 886 PARITY is current parity of quotes from the comment end. */ | |
| 887 int parity = 0; | |
| 867 | 888 Ichar my_stringend = 0; |
| 428 | 889 int string_lossage = 0; |
| 665 | 890 Charbpos comment_end = from; |
| 891 Charbpos comstart_pos = 0; | |
| 428 | 892 int comstart_parity = 0; |
| 893 int styles_match_p = 0; | |
| 460 | 894 /* mask to match comment styles against; for ST_COMMENT_STYLE, this |
| 895 will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */ | |
| 896 int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A; | |
| 826 | 897 struct syntax_cache *scache = buf->syntax_cache; |
| 428 | 898 |
| 899 /* At beginning of range to scan, we're outside of strings; | |
| 900 that determines quote parity to the comment-end. */ | |
| 901 while (from != stop) | |
| 902 { | |
| 460 | 903 int syncode; |
| 904 | |
| 428 | 905 /* Move back and examine a character. */ |
| 906 from--; | |
| 826 | 907 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 428 | 908 |
| 909 c = BUF_FETCH_CHAR (buf, from); | |
| 826 | 910 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 911 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 912 |
| 913 /* is this a 1-char comment end sequence? if so, try | |
| 914 to see if style matches previously extracted mask */ | |
| 915 if (code == Sendcomment) | |
| 916 { | |
| 917 styles_match_p = | |
| 460 | 918 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask; |
| 428 | 919 } |
| 920 | |
| 921 /* or are we looking at a 1-char comment start sequence | |
| 922 of the style matching mask? */ | |
| 460 | 923 else if (code == Scomment) |
| 428 | 924 { |
| 460 | 925 styles_match_p = |
| 926 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) & mask; | |
| 428 | 927 } |
| 928 | |
| 460 | 929 /* otherwise, is this a 2-char comment end or start sequence? */ |
| 930 else if (from > stop) | |
| 931 do | |
| 932 { | |
| 933 /* 2-char comment end sequence? */ | |
| 934 if (SYNTAX_CODE_END_SECOND_P (syncode)) | |
| 935 { | |
| 936 int prev_syncode; | |
| 826 | 937 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 460 | 938 prev_syncode = |
| 1315 | 939 SYNTAX_CODE_FROM_CACHE (scache, |
| 940 BUF_FETCH_CHAR (buf, from - 1)); | |
| 460 | 941 |
| 942 if (SYNTAX_CODES_END_P (prev_syncode, syncode)) | |
| 943 { | |
| 944 code = Sendcomment; | |
| 945 styles_match_p = | |
| 826 | 946 SYNTAX_CODES_COMMENT_MASK_END (prev_syncode, |
| 947 syncode) & mask; | |
| 460 | 948 from--; |
| 826 | 949 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 460 | 950 c = BUF_FETCH_CHAR (buf, from); |
| 951 | |
| 952 /* Found a comment-end sequence, so skip past the | |
| 953 check for a comment-start */ | |
| 954 break; | |
| 955 } | |
| 956 } | |
| 957 | |
| 958 /* 2-char comment start sequence? */ | |
| 959 if (SYNTAX_CODE_START_SECOND_P (syncode)) | |
| 960 { | |
| 961 int prev_syncode; | |
| 826 | 962 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 460 | 963 prev_syncode = |
| 1315 | 964 SYNTAX_CODE_FROM_CACHE (scache, |
| 965 BUF_FETCH_CHAR (buf, from - 1)); | |
| 460 | 966 |
| 967 if (SYNTAX_CODES_START_P (prev_syncode, syncode)) | |
| 968 { | |
| 969 code = Scomment; | |
| 970 styles_match_p = | |
| 826 | 971 SYNTAX_CODES_COMMENT_MASK_START (prev_syncode, |
| 972 syncode) & mask; | |
| 460 | 973 from--; |
| 826 | 974 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 460 | 975 c = BUF_FETCH_CHAR (buf, from); |
| 976 } | |
| 977 } | |
| 978 } while (0); | |
| 428 | 979 |
| 980 /* Ignore escaped characters. */ | |
| 981 if (char_quoted (buf, from)) | |
| 982 continue; | |
| 983 | |
| 984 /* Track parity of quotes. */ | |
| 985 if (code == Sstring) | |
| 986 { | |
| 987 parity ^= 1; | |
| 988 if (my_stringend == 0) | |
| 989 my_stringend = c; | |
| 990 /* If we have two kinds of string delimiters. | |
| 991 There's no way to grok this scanning backwards. */ | |
| 992 else if (my_stringend != c) | |
| 993 string_lossage = 1; | |
| 994 } | |
| 995 | |
| 460 | 996 if (code == Sstring_fence || code == Scomment_fence) |
| 997 { | |
| 998 parity ^= 1; | |
| 999 if (my_stringend == 0) | |
| 1000 my_stringend = | |
| 1001 code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE; | |
| 1002 /* If we have two kinds of string delimiters. | |
| 1003 There's no way to grok this scanning backwards. */ | |
| 1004 else if (my_stringend != (code == Sstring_fence | |
| 1005 ? ST_STRING_STYLE : ST_COMMENT_STYLE)) | |
| 1006 string_lossage = 1; | |
| 1007 } | |
| 1008 | |
| 428 | 1009 /* Record comment-starters according to that |
| 1010 quote-parity to the comment-end. */ | |
| 1011 if (code == Scomment && styles_match_p) | |
| 1012 { | |
| 1013 comstart_parity = parity; | |
| 1014 comstart_pos = from; | |
| 1015 } | |
| 1016 | |
| 1017 /* If we find another earlier comment-ender, | |
| 1018 any comment-starts earlier than that don't count | |
| 1019 (because they go with the earlier comment-ender). */ | |
| 1020 if (code == Sendcomment && styles_match_p) | |
| 1021 break; | |
| 1022 | |
| 1023 /* Assume a defun-start point is outside of strings. */ | |
| 1024 if (code == Sopen | |
| 1025 && (from == stop || BUF_FETCH_CHAR (buf, from - 1) == '\n')) | |
| 1026 break; | |
| 1027 } | |
| 1028 | |
| 1029 if (comstart_pos == 0) | |
| 1030 from = comment_end; | |
| 1031 /* If the earliest comment starter | |
| 1032 is followed by uniform paired string quotes or none, | |
| 1033 we know it can't be inside a string | |
| 1034 since if it were then the comment ender would be inside one. | |
| 1035 So it does start a comment. Skip back to it. */ | |
| 1036 else if (comstart_parity == 0 && !string_lossage) | |
| 1037 from = comstart_pos; | |
| 1038 else | |
| 1039 { | |
| 1040 /* We had two kinds of string delimiters mixed up | |
| 1041 together. Decode this going forwards. | |
| 1042 Scan fwd from the previous comment ender | |
| 1043 to the one in question; this records where we | |
| 1044 last passed a comment starter. */ | |
| 1045 | |
| 1046 struct lisp_parse_state state; | |
| 1047 scan_sexps_forward (buf, &state, find_defun_start (buf, comment_end), | |
| 1048 comment_end - 1, -10000, 0, Qnil, 0); | |
| 1049 if (state.incomment) | |
| 460 | 1050 from = state.comstr_start; |
| 428 | 1051 else |
| 1052 /* We can't grok this as a comment; scan it normally. */ | |
| 1053 from = comment_end; | |
| 826 | 1054 UPDATE_SYNTAX_CACHE_FORWARD (scache, from - 1); |
| 428 | 1055 } |
| 1056 return from; | |
| 1057 } | |
| 1058 | |
| 665 | 1059 static Charbpos |
| 826 | 1060 find_end_of_comment (struct buffer *buf, Charbpos from, Charbpos stop, |
| 1061 int comstyle) | |
| 428 | 1062 { |
| 1063 int c; | |
| 460 | 1064 int prev_code; |
| 1065 /* mask to match comment styles against; for ST_COMMENT_STYLE, this | |
| 1066 will get set to SYNTAX_COMMENT_STYLE_B, but never get checked */ | |
| 1067 int mask = comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A; | |
| 826 | 1068 struct syntax_cache *scache = buf->syntax_cache; |
| 428 | 1069 |
| 460 | 1070 /* This is only called by functions which have already set up the |
| 1071 syntax_cache and are keeping it up-to-date */ | |
| 428 | 1072 while (1) |
| 1073 { | |
| 1074 if (from == stop) | |
| 1075 { | |
| 1076 return -1; | |
| 1077 } | |
| 460 | 1078 |
| 826 | 1079 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1080 c = BUF_FETCH_CHAR (buf, from); |
| 460 | 1081 |
| 1082 /* Test for generic comments */ | |
| 1083 if (comstyle == ST_COMMENT_STYLE) | |
| 1084 { | |
| 826 | 1085 if (SYNTAX_FROM_CACHE (scache, c) == Scomment_fence) |
| 460 | 1086 { |
| 1087 from++; | |
| 826 | 1088 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1089 break; |
| 1090 } | |
| 1091 from++; | |
| 1092 continue; /* No need to test other comment styles in a | |
| 1093 generic comment */ | |
| 1094 } | |
| 1095 else | |
| 1096 | |
| 826 | 1097 if (SYNTAX_FROM_CACHE (scache, c) == Sendcomment |
| 460 | 1098 && SYNTAX_CODE_MATCHES_1CHAR_P |
| 826 | 1099 (SYNTAX_CODE_FROM_CACHE (scache, c), mask)) |
| 428 | 1100 /* we have encountered a comment end of the same style |
| 1101 as the comment sequence which began this comment | |
| 1102 section */ | |
| 460 | 1103 { |
| 1104 from++; | |
| 826 | 1105 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1106 break; |
| 1107 } | |
| 428 | 1108 |
| 826 | 1109 prev_code = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 428 | 1110 from++; |
| 826 | 1111 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1112 if (from < stop |
| 460 | 1113 && SYNTAX_CODES_MATCH_END_P |
| 1114 (prev_code, | |
| 826 | 1115 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)), |
| 460 | 1116 mask) |
| 1117 | |
| 1118 ) | |
| 428 | 1119 /* we have encountered a comment end of the same style |
| 1120 as the comment sequence which began this comment | |
| 1121 section */ | |
| 460 | 1122 { |
| 1123 from++; | |
| 826 | 1124 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1125 break; |
| 1126 } | |
| 428 | 1127 } |
| 1128 return from; | |
| 1129 } | |
| 1130 | |
| 1131 | |
| 1132 /* #### between FSF 19.23 and 19.28 there are some changes to the logic | |
| 1133 in this function (and minor changes to find_start_of_comment(), | |
| 1134 above, which is part of Fforward_comment() in FSF). Attempts to port | |
| 1135 that logic made this function break, so I'm leaving it out. If anyone | |
| 1136 ever complains about this function not working properly, take a look | |
| 1137 at those changes. --ben */ | |
| 1138 | |
| 446 | 1139 DEFUN ("forward-comment", Fforward_comment, 0, 2, 0, /* |
| 444 | 1140 Move forward across up to COUNT comments, or backwards if COUNT is negative. |
| 428 | 1141 Stop scanning if we find something other than a comment or whitespace. |
| 1142 Set point to where scanning stops. | |
| 444 | 1143 If COUNT comments are found as expected, with nothing except whitespace |
| 428 | 1144 between them, return t; otherwise return nil. |
| 1145 Point is set in either case. | |
| 446 | 1146 COUNT defaults to 1, and BUFFER defaults to the current buffer. |
| 428 | 1147 */ |
| 444 | 1148 (count, buffer)) |
| 428 | 1149 { |
| 665 | 1150 Charbpos from; |
| 1151 Charbpos stop; | |
| 867 | 1152 Ichar c; |
| 428 | 1153 enum syntaxcode code; |
| 460 | 1154 int syncode; |
| 444 | 1155 EMACS_INT n; |
| 428 | 1156 struct buffer *buf = decode_buffer (buffer, 0); |
| 826 | 1157 struct syntax_cache *scache; |
| 1158 | |
| 446 | 1159 if (NILP (count)) |
| 1160 n = 1; | |
| 1161 else | |
| 1162 { | |
| 1163 CHECK_INT (count); | |
| 1164 n = XINT (count); | |
| 1165 } | |
| 428 | 1166 |
| 1167 from = BUF_PT (buf); | |
| 1168 | |
| 826 | 1169 scache = setup_buffer_syntax_cache (buf, from, n); |
| 444 | 1170 while (n > 0) |
| 428 | 1171 { |
| 1172 QUIT; | |
| 1173 | |
| 1174 stop = BUF_ZV (buf); | |
| 1175 while (from < stop) | |
| 1176 { | |
| 460 | 1177 int comstyle = 0; /* mask for finding matching comment style */ |
| 428 | 1178 |
| 1179 if (char_quoted (buf, from)) | |
| 1180 { | |
| 1181 from++; | |
| 1182 continue; | |
| 1183 } | |
| 1184 | |
| 826 | 1185 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1186 c = BUF_FETCH_CHAR (buf, from); |
| 826 | 1187 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1188 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 1189 |
| 1190 if (code == Scomment) | |
| 1191 { | |
| 1192 /* we have encountered a single character comment start | |
| 1193 sequence, and we are ignoring all text inside comments. | |
| 1194 we must record the comment style this character begins | |
| 1195 so that later, only a comment end of the same style actually | |
| 1196 ends the comment section */ | |
| 460 | 1197 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) |
| 1198 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1199 } |
| 1200 | |
| 460 | 1201 else if (code == Scomment_fence) |
| 1202 { | |
| 1203 from++; | |
| 1204 code = Scomment; | |
| 1205 comstyle = ST_COMMENT_STYLE; | |
| 1206 } | |
| 1207 | |
| 428 | 1208 else if (from < stop |
| 460 | 1209 && SYNTAX_CODE_START_FIRST_P (syncode)) |
| 428 | 1210 { |
| 460 | 1211 int next_syncode; |
| 826 | 1212 UPDATE_SYNTAX_CACHE_FORWARD (scache, from + 1); |
| 460 | 1213 next_syncode = |
| 826 | 1214 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from + 1)); |
| 460 | 1215 |
| 1216 if (SYNTAX_CODES_START_P (syncode, next_syncode)) | |
| 1217 { | |
| 1218 /* we have encountered a 2char comment start sequence and we | |
| 1219 are ignoring all text inside comments. we must record | |
| 1220 the comment style this sequence begins so that later, | |
| 1221 only a comment end of the same style actually ends | |
| 1222 the comment section */ | |
| 1223 code = Scomment; | |
| 1224 comstyle = | |
| 1225 SYNTAX_CODES_COMMENT_MASK_START (syncode, next_syncode) | |
| 1226 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 1227 from++; | |
| 1228 } | |
| 428 | 1229 } |
| 1230 | |
| 1231 if (code == Scomment) | |
| 1232 { | |
| 826 | 1233 Charbpos newfrom = find_end_of_comment (buf, from, stop, |
| 1234 comstyle); | |
| 428 | 1235 if (newfrom < 0) |
| 1236 { | |
| 1237 /* we stopped because from==stop */ | |
| 1238 BUF_SET_PT (buf, stop); | |
| 1239 return Qnil; | |
| 1240 } | |
| 1241 from = newfrom; | |
| 1242 | |
| 1243 /* We have skipped one comment. */ | |
| 1244 break; | |
| 1245 } | |
| 1246 else if (code != Swhitespace | |
| 1247 && code != Sendcomment | |
| 1248 && code != Scomment ) | |
| 1249 { | |
| 1250 BUF_SET_PT (buf, from); | |
| 1251 return Qnil; | |
| 1252 } | |
| 1253 from++; | |
| 1254 } | |
| 1255 | |
| 1256 /* End of comment reached */ | |
| 444 | 1257 n--; |
| 428 | 1258 } |
| 1259 | |
| 444 | 1260 while (n < 0) |
| 428 | 1261 { |
| 1262 QUIT; | |
| 1263 | |
| 1264 stop = BUF_BEGV (buf); | |
| 1265 while (from > stop) | |
| 1266 { | |
| 460 | 1267 int comstyle = 0; /* mask for finding matching comment style */ |
| 428 | 1268 |
| 1269 from--; | |
| 1270 if (char_quoted (buf, from)) | |
| 1271 { | |
| 1272 from--; | |
| 1273 continue; | |
| 1274 } | |
| 1275 | |
| 1276 c = BUF_FETCH_CHAR (buf, from); | |
| 826 | 1277 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1278 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 1279 |
| 1280 if (code == Sendcomment) | |
| 1281 { | |
| 1282 /* we have found a single char end comment. we must record | |
| 1283 the comment style encountered so that later, we can match | |
| 1284 only the proper comment begin sequence of the same style */ | |
| 460 | 1285 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) |
| 1286 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 1287 } | |
| 1288 | |
| 1289 else if (code == Scomment_fence) | |
| 1290 { | |
| 1291 code = Sendcomment; | |
| 1292 comstyle = ST_COMMENT_STYLE; | |
| 428 | 1293 } |
| 1294 | |
| 1295 else if (from > stop | |
| 460 | 1296 && SYNTAX_CODE_END_SECOND_P (syncode)) |
| 428 | 1297 { |
| 460 | 1298 int prev_syncode; |
| 826 | 1299 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 460 | 1300 prev_syncode = |
| 826 | 1301 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); |
| 460 | 1302 if (SYNTAX_CODES_END_P (prev_syncode, syncode)) |
| 1303 { | |
| 1304 /* We must record the comment style encountered so that | |
| 1305 later, we can match only the proper comment begin | |
| 1306 sequence of the same style. */ | |
| 1307 code = Sendcomment; | |
| 1308 comstyle = SYNTAX_CODES_COMMENT_MASK_END | |
| 1309 (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 1310 from--; | |
| 1311 } | |
| 428 | 1312 } |
| 1313 | |
| 1314 if (code == Sendcomment) | |
| 1315 { | |
| 460 | 1316 from = find_start_of_comment (buf, from, stop, comstyle); |
| 428 | 1317 break; |
| 1318 } | |
| 1319 | |
| 1320 else if (code != Swhitespace | |
| 460 | 1321 && code != Scomment |
| 1322 && code != Sendcomment) | |
| 428 | 1323 { |
| 1324 BUF_SET_PT (buf, from + 1); | |
| 1325 return Qnil; | |
| 1326 } | |
| 1327 } | |
| 1328 | |
| 444 | 1329 n++; |
| 428 | 1330 } |
| 1331 | |
| 1332 BUF_SET_PT (buf, from); | |
| 1333 return Qt; | |
| 1334 } | |
| 1335 | |
| 1336 | |
| 1337 Lisp_Object | |
| 665 | 1338 scan_lists (struct buffer *buf, Charbpos from, int count, int depth, |
| 444 | 1339 int sexpflag, int noerror) |
| 428 | 1340 { |
| 665 | 1341 Charbpos stop; |
| 867 | 1342 Ichar c; |
| 428 | 1343 int quoted; |
| 1344 int mathexit = 0; | |
| 1345 enum syntaxcode code; | |
| 460 | 1346 int syncode; |
| 428 | 1347 int min_depth = depth; /* Err out if depth gets less than this. */ |
| 826 | 1348 struct syntax_cache *scache; |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1349 Charbpos last_good = from; |
| 826 | 1350 |
| 428 | 1351 if (depth > 0) min_depth = 0; |
| 1352 | |
| 826 | 1353 scache = setup_buffer_syntax_cache (buf, from, count); |
| 428 | 1354 while (count > 0) |
| 1355 { | |
| 1356 QUIT; | |
| 1357 | |
| 1358 stop = BUF_ZV (buf); | |
| 1359 while (from < stop) | |
| 1360 { | |
| 460 | 1361 int comstyle = 0; /* mask for finding matching comment style */ |
| 428 | 1362 |
| 826 | 1363 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1364 c = BUF_FETCH_CHAR (buf, from); |
| 826 | 1365 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1366 code = SYNTAX_FROM_CODE (syncode); | |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1367 if (depth == min_depth) |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1368 last_good = from; |
| 428 | 1369 from++; |
| 1370 | |
| 1371 /* a 1-char comment start sequence */ | |
| 1372 if (code == Scomment && parse_sexp_ignore_comments) | |
| 1373 { | |
| 460 | 1374 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) == |
| 1375 SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1376 } |
| 1377 | |
| 1378 /* else, a 2-char comment start sequence? */ | |
| 1379 else if (from < stop | |
| 460 | 1380 && SYNTAX_CODE_START_FIRST_P (syncode) |
| 428 | 1381 && parse_sexp_ignore_comments) |
| 1382 { | |
| 460 | 1383 int next_syncode; |
| 826 | 1384 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1385 next_syncode = |
| 826 | 1386 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)); |
| 460 | 1387 |
| 1388 if (SYNTAX_CODES_START_P (syncode, next_syncode)) | |
| 1389 { | |
| 826 | 1390 /* we have encountered a comment start sequence and we |
| 1391 are ignoring all text inside comments. we must record | |
| 1392 the comment style this sequence begins so that later, | |
| 1393 only a comment end of the same style actually ends | |
| 1394 the comment section */ | |
| 1395 code = Scomment; | |
| 460 | 1396 comstyle = SYNTAX_CODES_COMMENT_MASK_START |
| 1397 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 826 | 1398 from++; |
| 1399 } | |
| 428 | 1400 } |
| 826 | 1401 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1402 |
| 460 | 1403 if (SYNTAX_CODE_PREFIX (syncode)) |
| 428 | 1404 continue; |
| 1405 | |
| 1406 switch (code) | |
| 1407 { | |
| 1408 case Sescape: | |
| 1409 case Scharquote: | |
| 1410 if (from == stop) goto lose; | |
| 1411 from++; | |
| 1412 /* treat following character as a word constituent */ | |
| 1413 case Sword: | |
| 1414 case Ssymbol: | |
| 1415 if (depth || !sexpflag) break; | |
| 1416 /* This word counts as a sexp; return at end of it. */ | |
| 1417 while (from < stop) | |
| 1418 { | |
| 826 | 1419 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 1420 switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from))) | |
| 428 | 1421 { |
| 1422 case Scharquote: | |
| 1423 case Sescape: | |
| 1424 from++; | |
| 1425 if (from == stop) goto lose; | |
| 1426 break; | |
| 1427 case Sword: | |
| 1428 case Ssymbol: | |
| 1429 case Squote: | |
| 1430 break; | |
| 1431 default: | |
| 1432 goto done; | |
| 1433 } | |
| 1434 from++; | |
| 1435 } | |
| 1436 goto done; | |
| 1437 | |
| 460 | 1438 case Scomment_fence: |
| 1439 comstyle = ST_COMMENT_STYLE; | |
| 428 | 1440 case Scomment: |
| 1441 if (!parse_sexp_ignore_comments) | |
| 1442 break; | |
| 826 | 1443 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 1444 { |
| 665 | 1445 Charbpos newfrom = |
| 460 | 1446 find_end_of_comment (buf, from, stop, comstyle); |
| 428 | 1447 if (newfrom < 0) |
| 1448 { | |
| 1449 /* we stopped because from == stop in search forward */ | |
| 1450 from = stop; | |
| 1451 if (depth == 0) | |
| 1452 goto done; | |
| 1453 goto lose; | |
| 1454 } | |
| 1455 from = newfrom; | |
| 1456 } | |
| 1457 break; | |
| 1458 | |
| 1459 case Smath: | |
| 1460 if (!sexpflag) | |
| 1461 break; | |
| 1462 if (from != stop && c == BUF_FETCH_CHAR (buf, from)) | |
| 1463 from++; | |
| 1464 if (mathexit) | |
| 1465 { | |
| 1466 mathexit = 0; | |
| 1467 goto close1; | |
| 1468 } | |
| 1469 mathexit = 1; | |
| 1470 | |
| 1471 case Sopen: | |
| 1472 if (!++depth) goto done; | |
| 1473 break; | |
| 1474 | |
| 1475 case Sclose: | |
| 1476 close1: | |
| 1477 if (!--depth) goto done; | |
| 1478 if (depth < min_depth) | |
| 1479 { | |
| 444 | 1480 if (noerror) |
| 428 | 1481 return Qnil; |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1482 signal_error_2 (Qscan_error, |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1483 "Containing expression ends prematurely", |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1484 make_int (last_good), make_int (from)); |
| 428 | 1485 } |
| 1486 break; | |
| 1487 | |
| 460 | 1488 case Sstring_fence: |
| 428 | 1489 case Sstring: |
| 1490 { | |
| 867 | 1491 Ichar stringterm; |
| 460 | 1492 |
| 1493 if (code != Sstring_fence) | |
| 1494 { | |
| 826 | 1495 /* XEmacs change: call syntax_match on character */ |
| 867 | 1496 Ichar ch = BUF_FETCH_CHAR (buf, from - 1); |
| 460 | 1497 Lisp_Object stermobj = |
| 1296 | 1498 syntax_match (scache->syntax_table, ch); |
| 428 | 1499 |
| 1500 if (CHARP (stermobj)) | |
| 1501 stringterm = XCHAR (stermobj); | |
| 1502 else | |
| 1503 stringterm = ch; | |
| 460 | 1504 } |
| 1505 else | |
| 1506 stringterm = '\0'; /* avoid compiler warnings */ | |
| 428 | 1507 |
| 1508 while (1) | |
| 1509 { | |
| 1510 if (from >= stop) | |
| 1511 goto lose; | |
| 826 | 1512 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1513 c = BUF_FETCH_CHAR (buf, from); |
| 1514 if (code == Sstring | |
| 1515 ? c == stringterm | |
| 826 | 1516 : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence) |
| 428 | 1517 break; |
| 460 | 1518 |
| 826 | 1519 switch (SYNTAX_FROM_CACHE (scache, c)) |
| 428 | 1520 { |
| 1521 case Scharquote: | |
| 1522 case Sescape: | |
| 1523 from++; | |
| 1524 break; | |
| 1525 default: | |
| 1526 break; | |
| 1527 } | |
| 1528 from++; | |
| 1529 } | |
| 1530 from++; | |
| 1531 if (!depth && sexpflag) goto done; | |
| 1532 break; | |
| 1533 } | |
| 1534 | |
| 1535 default: | |
| 1536 break; | |
| 1537 } | |
| 1538 } | |
| 1539 | |
| 1540 /* Reached end of buffer. Error if within object, | |
| 1541 return nil if between */ | |
| 1542 if (depth) goto lose; | |
| 1543 | |
| 1544 return Qnil; | |
| 1545 | |
| 1546 /* End of object reached */ | |
| 1547 done: | |
| 1548 count--; | |
| 1549 } | |
| 1550 | |
| 1551 while (count < 0) | |
| 1552 { | |
| 1553 QUIT; | |
| 1554 | |
| 1555 stop = BUF_BEGV (buf); | |
| 1556 while (from > stop) | |
| 1557 { | |
| 460 | 1558 int comstyle = 0; /* mask for finding matching comment style */ |
| 428 | 1559 |
| 1560 from--; | |
| 826 | 1561 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 428 | 1562 quoted = char_quoted (buf, from); |
| 1563 if (quoted) | |
| 460 | 1564 { |
| 428 | 1565 from--; |
| 826 | 1566 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 460 | 1567 } |
| 428 | 1568 |
| 1569 c = BUF_FETCH_CHAR (buf, from); | |
| 826 | 1570 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1571 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 1572 |
| 1573 if (code == Sendcomment && parse_sexp_ignore_comments) | |
| 1574 { | |
| 1575 /* we have found a single char end comment. we must record | |
| 1576 the comment style encountered so that later, we can match | |
| 1577 only the proper comment begin sequence of the same style */ | |
| 460 | 1578 comstyle = SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) |
| 1579 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1580 } |
| 1581 | |
| 1582 else if (from > stop | |
| 460 | 1583 && SYNTAX_CODE_END_SECOND_P (syncode) |
| 428 | 1584 && !char_quoted (buf, from - 1) |
| 1585 && parse_sexp_ignore_comments) | |
| 1586 { | |
| 460 | 1587 int prev_syncode; |
| 826 | 1588 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 1589 prev_syncode = | |
| 1590 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from - 1)); | |
| 460 | 1591 |
| 1592 if (SYNTAX_CODES_END_P (prev_syncode, syncode)) | |
| 1593 { | |
| 428 | 1594 /* we must record the comment style encountered so that |
| 1595 later, we can match only the proper comment begin | |
| 1596 sequence of the same style */ | |
| 1597 code = Sendcomment; | |
| 460 | 1598 comstyle = SYNTAX_CODES_COMMENT_MASK_END |
| 1599 (prev_syncode, syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 428 | 1600 from--; |
| 1601 } | |
| 460 | 1602 } |
| 428 | 1603 |
| 460 | 1604 if (SYNTAX_CODE_PREFIX (syncode)) |
| 428 | 1605 continue; |
| 1606 | |
| 434 | 1607 switch (quoted ? Sword : code) |
| 428 | 1608 { |
| 1609 case Sword: | |
| 1610 case Ssymbol: | |
| 1611 if (depth || !sexpflag) break; | |
| 1612 /* This word counts as a sexp; count object finished after | |
| 1613 passing it. */ | |
| 1614 while (from > stop) | |
| 1615 { | |
| 826 | 1616 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from); |
| 428 | 1617 quoted = char_quoted (buf, from - 1); |
| 1618 | |
| 1619 if (quoted) | |
| 1620 from--; | |
| 1621 if (! (quoted | |
| 1622 || (syncode = | |
| 826 | 1623 SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, |
| 1624 from - 1))) | |
| 428 | 1625 == Sword |
| 1626 || syncode == Ssymbol | |
| 1627 || syncode == Squote)) | |
| 1628 goto done2; | |
| 1629 from--; | |
| 1630 } | |
| 1631 goto done2; | |
| 1632 | |
| 1633 case Smath: | |
| 1634 if (!sexpflag) | |
| 1635 break; | |
| 1636 if (from != stop && c == BUF_FETCH_CHAR (buf, from - 1)) | |
| 1637 from--; | |
| 1638 if (mathexit) | |
| 1639 { | |
| 1640 mathexit = 0; | |
| 1641 goto open2; | |
| 1642 } | |
| 1643 mathexit = 1; | |
| 1644 | |
| 1645 case Sclose: | |
| 1646 if (!++depth) goto done2; | |
| 1647 break; | |
| 1648 | |
| 1649 case Sopen: | |
| 1650 open2: | |
| 1651 if (!--depth) goto done2; | |
| 1652 if (depth < min_depth) | |
| 1653 { | |
| 444 | 1654 if (noerror) |
| 428 | 1655 return Qnil; |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1656 signal_error_2 (Qscan_error, |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1657 "Containing expression ends prematurely", |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1658 make_int (last_good), make_int (from)); |
| 428 | 1659 } |
| 1660 break; | |
| 1661 | |
| 460 | 1662 case Scomment_fence: |
| 1663 comstyle = ST_COMMENT_STYLE; | |
| 428 | 1664 case Sendcomment: |
| 1665 if (parse_sexp_ignore_comments) | |
| 460 | 1666 from = find_start_of_comment (buf, from, stop, comstyle); |
| 428 | 1667 break; |
| 1668 | |
| 460 | 1669 case Sstring_fence: |
| 428 | 1670 case Sstring: |
| 1671 { | |
| 867 | 1672 Ichar stringterm; |
| 460 | 1673 |
| 1674 if (code != Sstring_fence) | |
| 1675 { | |
| 428 | 1676 /* XEmacs change: call syntax_match() on character */ |
| 867 | 1677 Ichar ch = BUF_FETCH_CHAR (buf, from); |
| 460 | 1678 Lisp_Object stermobj = |
| 1296 | 1679 syntax_match (scache->syntax_table, ch); |
| 428 | 1680 |
| 1681 if (CHARP (stermobj)) | |
| 1682 stringterm = XCHAR (stermobj); | |
| 1683 else | |
| 1684 stringterm = ch; | |
| 460 | 1685 } |
| 1686 else | |
| 1687 stringterm = '\0'; /* avoid compiler warnings */ | |
| 428 | 1688 |
| 1689 while (1) | |
| 1690 { | |
| 1691 if (from == stop) goto lose; | |
| 460 | 1692 |
| 826 | 1693 UPDATE_SYNTAX_CACHE_BACKWARD (scache, from - 1); |
| 460 | 1694 c = BUF_FETCH_CHAR (buf, from - 1); |
| 1695 | |
| 1696 if ((code == Sstring | |
| 1697 ? c == stringterm | |
| 826 | 1698 : SYNTAX_FROM_CACHE (scache, c) == Sstring_fence) |
| 460 | 1699 && !char_quoted (buf, from - 1)) |
| 1700 { | |
| 428 | 1701 break; |
| 460 | 1702 } |
| 1703 | |
| 428 | 1704 from--; |
| 1705 } | |
| 1706 from--; | |
| 1707 if (!depth && sexpflag) goto done2; | |
| 1708 break; | |
| 1709 } | |
| 1710 } | |
| 1711 } | |
| 1712 | |
| 1713 /* Reached start of buffer. Error if within object, | |
| 1714 return nil if between */ | |
| 1715 if (depth) goto lose; | |
| 1716 | |
| 1717 return Qnil; | |
| 1718 | |
| 1719 done2: | |
| 1720 count++; | |
| 1721 } | |
| 1722 | |
| 1723 | |
| 1724 return (make_int (from)); | |
| 1725 | |
| 1726 lose: | |
| 444 | 1727 if (!noerror) |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1728 signal_error_2 (Qscan_error, "Unbalanced parentheses", |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1729 make_int (last_good), make_int (from)); |
| 428 | 1730 return Qnil; |
| 1731 } | |
| 1732 | |
| 1733 int | |
| 665 | 1734 char_quoted (struct buffer *buf, Charbpos pos) |
| 428 | 1735 { |
| 1736 enum syntaxcode code; | |
| 665 | 1737 Charbpos beg = BUF_BEGV (buf); |
| 428 | 1738 int quoted = 0; |
| 665 | 1739 Charbpos startpos = pos; |
| 826 | 1740 struct syntax_cache *scache = buf->syntax_cache; |
| 460 | 1741 |
| 1742 while (pos > beg) | |
| 1743 { | |
| 826 | 1744 UPDATE_SYNTAX_CACHE_BACKWARD (scache, pos - 1); |
| 1745 code = SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, pos - 1)); | |
| 428 | 1746 |
| 460 | 1747 if (code != Scharquote && code != Sescape) |
| 1748 break; | |
| 1749 pos--; | |
| 1750 quoted = !quoted; | |
| 1751 } | |
| 1752 | |
| 826 | 1753 UPDATE_SYNTAX_CACHE (scache, startpos); |
| 428 | 1754 return quoted; |
| 1755 } | |
| 1756 | |
| 1757 DEFUN ("scan-lists", Fscan_lists, 3, 5, 0, /* | |
| 1758 Scan from character number FROM by COUNT lists. | |
| 1759 Returns the character number of the position thus found. | |
| 1760 | |
| 1761 If DEPTH is nonzero, paren depth begins counting from that value, | |
| 1762 only places where the depth in parentheses becomes zero | |
| 1763 are candidates for stopping; COUNT such places are counted. | |
| 1764 Thus, a positive value for DEPTH means go out levels. | |
| 1765 | |
| 1766 Comments are ignored if `parse-sexp-ignore-comments' is non-nil. | |
| 1767 | |
| 1768 If the beginning or end of (the accessible part of) the buffer is reached | |
| 1769 and the depth is wrong, an error is signaled. | |
| 1770 If the depth is right but the count is not used up, nil is returned. | |
| 1771 | |
| 1772 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead | |
| 1773 of in the current buffer. | |
| 1774 | |
| 1775 If optional arg NOERROR is non-nil, scan-lists will return nil instead of | |
| 1776 signalling an error. | |
| 1777 */ | |
| 444 | 1778 (from, count, depth, buffer, noerror)) |
| 428 | 1779 { |
| 1780 struct buffer *buf; | |
| 1781 | |
| 1782 CHECK_INT (from); | |
| 1783 CHECK_INT (count); | |
| 1784 CHECK_INT (depth); | |
| 1785 buf = decode_buffer (buffer, 0); | |
| 1786 | |
| 1787 return scan_lists (buf, XINT (from), XINT (count), XINT (depth), 0, | |
| 444 | 1788 !NILP (noerror)); |
| 428 | 1789 } |
| 1790 | |
| 1791 DEFUN ("scan-sexps", Fscan_sexps, 2, 4, 0, /* | |
| 1792 Scan from character number FROM by COUNT balanced expressions. | |
| 1793 If COUNT is negative, scan backwards. | |
| 1794 Returns the character number of the position thus found. | |
| 1795 | |
| 1796 Comments are ignored if `parse-sexp-ignore-comments' is non-nil. | |
| 1797 | |
| 1798 If the beginning or end of (the accessible part of) the buffer is reached | |
| 1799 in the middle of a parenthetical grouping, an error is signaled. | |
| 1800 If the beginning or end is reached between groupings | |
| 1801 but before count is used up, nil is returned. | |
| 1802 | |
| 1803 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead | |
| 1804 of in the current buffer. | |
| 1805 | |
| 1806 If optional arg NOERROR is non-nil, scan-sexps will return nil instead of | |
| 1807 signalling an error. | |
| 1808 */ | |
| 444 | 1809 (from, count, buffer, noerror)) |
| 428 | 1810 { |
| 1811 struct buffer *buf = decode_buffer (buffer, 0); | |
| 1812 CHECK_INT (from); | |
| 1813 CHECK_INT (count); | |
| 1814 | |
| 444 | 1815 return scan_lists (buf, XINT (from), XINT (count), 0, 1, !NILP (noerror)); |
| 428 | 1816 } |
| 1817 | |
| 1818 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, 0, 1, 0, /* | |
| 1819 Move point backward over any number of chars with prefix syntax. | |
| 1820 This includes chars with "quote" or "prefix" syntax (' or p). | |
| 1821 | |
| 1822 Optional arg BUFFER defaults to the current buffer. | |
| 1823 */ | |
| 1824 (buffer)) | |
| 1825 { | |
| 1826 struct buffer *buf = decode_buffer (buffer, 0); | |
| 665 | 1827 Charbpos beg = BUF_BEGV (buf); |
| 1828 Charbpos pos = BUF_PT (buf); | |
| 867 | 1829 Ichar c = '\0'; /* initialize to avoid compiler warnings */ |
| 826 | 1830 struct syntax_cache *scache; |
| 1831 | |
| 1832 scache = setup_buffer_syntax_cache (buf, pos, -1); | |
| 428 | 1833 |
| 1834 while (pos > beg && !char_quoted (buf, pos - 1) | |
| 460 | 1835 /* Previous statement updates syntax table. */ |
| 826 | 1836 && (SYNTAX_FROM_CACHE (scache, c = BUF_FETCH_CHAR (buf, pos - 1)) == Squote |
| 1837 || SYNTAX_CODE_PREFIX (SYNTAX_CODE_FROM_CACHE (scache, c)))) | |
| 428 | 1838 pos--; |
| 1839 | |
| 1840 BUF_SET_PT (buf, pos); | |
| 1841 | |
| 1842 return Qnil; | |
| 1843 } | |
| 1844 | |
| 1845 /* Parse forward from FROM to END, | |
| 1846 assuming that FROM has state OLDSTATE (nil means FROM is start of function), | |
| 1847 and return a description of the state of the parse at END. | |
| 1848 If STOPBEFORE is nonzero, stop at the start of an atom. | |
| 1849 If COMMENTSTOP is nonzero, stop at the start of a comment. */ | |
| 1850 | |
| 1851 static void | |
| 1852 scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr, | |
| 665 | 1853 Charbpos from, Charbpos end, |
| 428 | 1854 int targetdepth, int stopbefore, |
| 1855 Lisp_Object oldstate, | |
| 1856 int commentstop) | |
| 1857 { | |
| 1858 struct lisp_parse_state state; | |
| 1859 | |
| 1860 enum syntaxcode code; | |
| 1861 struct level { int last, prev; }; | |
| 1862 struct level levelstart[100]; | |
| 1863 struct level *curlevel = levelstart; | |
| 1864 struct level *endlevel = levelstart + 100; | |
| 1865 int depth; /* Paren depth of current scanning location. | |
| 1866 level - levelstart equals this except | |
| 1867 when the depth becomes negative. */ | |
| 1868 int mindepth; /* Lowest DEPTH value seen. */ | |
| 1869 int start_quoted = 0; /* Nonzero means starting after a char quote */ | |
| 460 | 1870 int boundary_stop = commentstop == -1; |
| 428 | 1871 Lisp_Object tem; |
| 826 | 1872 struct syntax_cache *scache; |
| 1873 | |
| 1874 scache = setup_buffer_syntax_cache (buf, from, 1); | |
| 428 | 1875 if (NILP (oldstate)) |
| 1876 { | |
| 1877 depth = 0; | |
| 1878 state.instring = -1; | |
| 1879 state.incomment = 0; | |
| 1880 state.comstyle = 0; /* comment style a by default */ | |
| 460 | 1881 state.comstr_start = -1; /* no comment/string seen. */ |
| 428 | 1882 } |
| 1883 else | |
| 1884 { | |
| 1885 tem = Fcar (oldstate); /* elt 0, depth */ | |
| 1886 if (!NILP (tem)) | |
| 1887 depth = XINT (tem); | |
| 1888 else | |
| 1889 depth = 0; | |
| 1890 | |
| 1891 oldstate = Fcdr (oldstate); | |
| 1892 oldstate = Fcdr (oldstate); | |
| 1893 oldstate = Fcdr (oldstate); | |
| 1894 tem = Fcar (oldstate); /* elt 3, instring */ | |
| 460 | 1895 state.instring = ( !NILP (tem) |
| 1896 ? ( INTP (tem) ? XINT (tem) : ST_STRING_STYLE) | |
| 1897 : -1); | |
| 428 | 1898 |
| 460 | 1899 oldstate = Fcdr (oldstate); |
| 1900 tem = Fcar (oldstate); /* elt 4, incomment */ | |
| 428 | 1901 state.incomment = !NILP (tem); |
| 1902 | |
| 1903 oldstate = Fcdr (oldstate); | |
| 1904 tem = Fcar (oldstate); /* elt 5, follows-quote */ | |
| 1905 start_quoted = !NILP (tem); | |
| 1906 | |
| 1907 /* if the eighth element of the list is nil, we are in comment style | |
| 3025 | 1908 a; if it is t, we are in comment style b; if it is `syntax-table', |
| 460 | 1909 we are in a generic comment */ |
| 428 | 1910 oldstate = Fcdr (oldstate); |
| 1911 oldstate = Fcdr (oldstate); | |
| 460 | 1912 tem = Fcar (oldstate); /* elt 7, comment style a/b/fence */ |
| 1913 state.comstyle = NILP (tem) ? 0 : ( EQ (tem, Qsyntax_table) | |
| 1914 ? ST_COMMENT_STYLE : 1 ); | |
| 1915 | |
| 1916 oldstate = Fcdr (oldstate); /* elt 8, start of last comment/string */ | |
| 1917 tem = Fcar (oldstate); | |
| 1918 state.comstr_start = NILP (tem) ? -1 : XINT (tem); | |
| 1919 | |
| 1920 /* elt 9, char numbers of starts-of-expression of levels | |
| 1921 (starting from outermost). */ | |
| 1922 oldstate = Fcdr (oldstate); | |
| 1923 tem = Fcar (oldstate); /* elt 9, intermediate data for | |
| 1924 continuation of parsing (subject | |
| 1925 to change). */ | |
| 1926 while (!NILP (tem)) /* >= second enclosing sexps. */ | |
| 1927 { | |
| 1928 curlevel->last = XINT (Fcar (tem)); | |
| 1929 if (++curlevel == endlevel) | |
| 826 | 1930 stack_overflow ("Nesting too deep for parser", |
| 1931 make_int (curlevel - levelstart)); | |
| 460 | 1932 curlevel->prev = -1; |
| 1933 curlevel->last = -1; | |
| 1934 tem = Fcdr (tem); | |
| 1935 } | |
| 428 | 1936 } |
| 1937 state.quoted = 0; | |
| 1938 mindepth = depth; | |
| 1939 | |
| 1940 curlevel->prev = -1; | |
| 1941 curlevel->last = -1; | |
| 1942 | |
| 1943 /* Enter the loop at a place appropriate for initial state. */ | |
| 1944 | |
| 1945 if (state.incomment) goto startincomment; | |
| 1946 if (state.instring >= 0) | |
| 1947 { | |
| 1948 if (start_quoted) goto startquotedinstring; | |
| 1949 goto startinstring; | |
| 1950 } | |
| 1951 if (start_quoted) goto startquoted; | |
| 1952 | |
| 1953 while (from < end) | |
| 1954 { | |
| 867 | 1955 Ichar c; |
| 460 | 1956 int syncode; |
| 1957 | |
| 428 | 1958 QUIT; |
| 1959 | |
| 826 | 1960 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1961 c = BUF_FETCH_CHAR (buf, from); |
| 826 | 1962 syncode = SYNTAX_CODE_FROM_CACHE (scache, c); |
| 1963 code = SYNTAX_FROM_CODE (syncode); | |
| 428 | 1964 from++; |
| 1965 | |
| 1966 /* record the comment style we have entered so that only the | |
| 1967 comment-ender sequence (or single char) of the same style | |
| 1968 actually terminates the comment section. */ | |
| 460 | 1969 if (code == Scomment) |
| 1970 { | |
| 1971 state.comstyle = | |
| 1972 SYNTAX_CODE_COMMENT_1CHAR_MASK (syncode) | |
| 1973 == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 1974 state.comstr_start = from - 1; | |
| 1975 } | |
| 1976 | |
| 1977 /* a generic comment delimiter? */ | |
| 1978 else if (code == Scomment_fence) | |
| 1979 { | |
| 1980 state.comstyle = ST_COMMENT_STYLE; | |
| 1981 state.comstr_start = from - 1; | |
| 1982 code = Scomment; | |
| 428 | 1983 } |
| 1984 | |
| 1985 else if (from < end && | |
| 460 | 1986 SYNTAX_CODE_START_FIRST_P (syncode)) |
| 428 | 1987 { |
| 460 | 1988 int next_syncode; |
| 826 | 1989 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 1990 next_syncode = |
| 826 | 1991 SYNTAX_CODE_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from)); |
| 460 | 1992 |
| 1993 if (SYNTAX_CODES_START_P (syncode, next_syncode)) | |
| 1994 { | |
| 428 | 1995 code = Scomment; |
| 460 | 1996 state.comstyle = SYNTAX_CODES_COMMENT_MASK_START |
| 1997 (syncode, next_syncode) == SYNTAX_COMMENT_STYLE_A ? 0 : 1; | |
| 1998 state.comstr_start = from - 1; | |
| 428 | 1999 from++; |
| 826 | 2000 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 2001 } |
| 428 | 2002 } |
| 2003 | |
| 460 | 2004 if (SYNTAX_CODE_PREFIX (syncode)) |
| 428 | 2005 continue; |
| 2006 switch (code) | |
| 2007 { | |
| 2008 case Sescape: | |
| 2009 case Scharquote: | |
| 2010 if (stopbefore) goto stop; /* this arg means stop at sexp start */ | |
| 2011 curlevel->last = from - 1; | |
| 2012 startquoted: | |
| 2013 if (from == end) goto endquoted; | |
| 2014 from++; | |
| 2015 goto symstarted; | |
| 2016 /* treat following character as a word constituent */ | |
| 2017 case Sword: | |
| 2018 case Ssymbol: | |
| 2019 if (stopbefore) goto stop; /* this arg means stop at sexp start */ | |
| 2020 curlevel->last = from - 1; | |
| 2021 symstarted: | |
| 2022 while (from < end) | |
| 2023 { | |
| 826 | 2024 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 2025 switch (SYNTAX_FROM_CACHE (scache, BUF_FETCH_CHAR (buf, from))) | |
| 428 | 2026 { |
| 2027 case Scharquote: | |
| 2028 case Sescape: | |
| 2029 from++; | |
| 2030 if (from == end) goto endquoted; | |
| 2031 break; | |
| 2032 case Sword: | |
| 2033 case Ssymbol: | |
| 2034 case Squote: | |
| 2035 break; | |
| 2036 default: | |
| 2037 goto symdone; | |
| 2038 } | |
| 2039 from++; | |
| 2040 } | |
| 2041 symdone: | |
| 2042 curlevel->prev = curlevel->last; | |
| 2043 break; | |
| 2044 | |
| 2045 case Scomment: | |
| 2046 state.incomment = 1; | |
| 460 | 2047 if (commentstop || boundary_stop) goto done; |
| 428 | 2048 startincomment: |
| 460 | 2049 if (commentstop == 1) |
| 428 | 2050 goto done; |
| 826 | 2051 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 428 | 2052 { |
| 826 | 2053 Charbpos newfrom = find_end_of_comment (buf, from, end, |
| 2054 state.comstyle); | |
| 428 | 2055 if (newfrom < 0) |
| 2056 { | |
| 2057 /* we terminated search because from == end */ | |
| 2058 from = end; | |
| 2059 goto done; | |
| 2060 } | |
| 2061 from = newfrom; | |
| 2062 } | |
| 2063 state.incomment = 0; | |
| 2064 state.comstyle = 0; /* reset the comment style */ | |
| 460 | 2065 if (boundary_stop) goto done; |
| 428 | 2066 break; |
| 2067 | |
| 2068 case Sopen: | |
| 2069 if (stopbefore) goto stop; /* this arg means stop at sexp start */ | |
| 2070 depth++; | |
| 2071 curlevel->last = from - 1; | |
| 2072 if (++curlevel == endlevel) | |
| 826 | 2073 stack_overflow ("Nesting too deep for parser", |
| 2074 make_int (curlevel - levelstart)); | |
| 428 | 2075 curlevel->prev = -1; |
| 2076 curlevel->last = -1; | |
| 2077 if (targetdepth == depth) goto done; | |
| 2078 break; | |
| 2079 | |
| 2080 case Sclose: | |
| 2081 depth--; | |
| 2082 if (depth < mindepth) | |
| 2083 mindepth = depth; | |
| 2084 if (curlevel != levelstart) | |
| 2085 curlevel--; | |
| 2086 curlevel->prev = curlevel->last; | |
| 2087 if (targetdepth == depth) goto done; | |
| 2088 break; | |
| 2089 | |
| 2090 case Sstring: | |
| 460 | 2091 case Sstring_fence: |
| 2092 state.comstr_start = from - 1; | |
| 428 | 2093 if (stopbefore) goto stop; /* this arg means stop at sexp start */ |
| 2094 curlevel->last = from - 1; | |
| 460 | 2095 if (code == Sstring_fence) |
| 428 | 2096 { |
| 460 | 2097 state.instring = ST_STRING_STYLE; |
| 2098 } | |
| 2099 else | |
| 2100 { | |
| 2101 /* XEmacs change: call syntax_match() on character */ | |
| 867 | 2102 Ichar ch = BUF_FETCH_CHAR (buf, from - 1); |
| 460 | 2103 Lisp_Object stermobj = |
| 1296 | 2104 syntax_match (scache->syntax_table, ch); |
| 428 | 2105 |
| 2106 if (CHARP (stermobj)) | |
| 2107 state.instring = XCHAR (stermobj); | |
| 2108 else | |
| 2109 state.instring = ch; | |
| 2110 } | |
| 460 | 2111 if (boundary_stop) goto done; |
| 428 | 2112 startinstring: |
| 2113 while (1) | |
| 2114 { | |
| 460 | 2115 enum syntaxcode temp_code; |
| 2116 | |
| 428 | 2117 if (from >= end) goto done; |
| 460 | 2118 |
| 826 | 2119 UPDATE_SYNTAX_CACHE_FORWARD (scache, from); |
| 460 | 2120 c = BUF_FETCH_CHAR (buf, from); |
| 826 | 2121 temp_code = SYNTAX_FROM_CACHE (scache, c); |
| 460 | 2122 |
| 2123 if ( | |
| 2124 state.instring != ST_STRING_STYLE && | |
| 2125 temp_code == Sstring && | |
| 2126 c == state.instring) break; | |
| 2127 | |
| 2128 switch (temp_code) | |
| 428 | 2129 { |
| 460 | 2130 case Sstring_fence: |
| 2131 if (state.instring == ST_STRING_STYLE) | |
| 2132 goto string_end; | |
| 2133 break; | |
| 428 | 2134 case Scharquote: |
| 2135 case Sescape: | |
| 2136 { | |
| 2137 from++; | |
| 2138 startquotedinstring: | |
| 2139 if (from >= end) goto endquoted; | |
| 2140 break; | |
| 2141 } | |
| 2142 default: | |
| 2143 break; | |
| 2144 } | |
| 2145 from++; | |
| 2146 } | |
| 460 | 2147 string_end: |
| 428 | 2148 state.instring = -1; |
| 2149 curlevel->prev = curlevel->last; | |
| 2150 from++; | |
| 460 | 2151 if (boundary_stop) goto done; |
| 428 | 2152 break; |
| 2153 | |
| 2154 case Smath: | |
| 2155 break; | |
| 2156 | |
| 2157 case Swhitespace: | |
| 2158 case Spunct: | |
| 2159 case Squote: | |
| 2160 case Sendcomment: | |
| 460 | 2161 case Scomment_fence: |
| 428 | 2162 case Sinherit: |
| 2163 case Smax: | |
| 2164 break; | |
| 2165 } | |
| 2166 } | |
| 2167 goto done; | |
| 2168 | |
| 2169 stop: /* Here if stopping before start of sexp. */ | |
| 2170 from--; /* We have just fetched the char that starts it; */ | |
| 2171 goto done; /* but return the position before it. */ | |
| 2172 | |
| 2173 endquoted: | |
| 2174 state.quoted = 1; | |
| 2175 done: | |
| 2176 state.depth = depth; | |
| 2177 state.mindepth = mindepth; | |
| 2178 state.thislevelstart = curlevel->prev; | |
| 2179 state.prevlevelstart | |
| 2180 = (curlevel == levelstart) ? -1 : (curlevel - 1)->last; | |
| 2181 state.location = from; | |
| 460 | 2182 state.levelstarts = Qnil; |
| 2183 while (--curlevel >= levelstart) | |
| 2184 state.levelstarts = Fcons (make_int (curlevel->last), | |
| 2185 state.levelstarts); | |
| 428 | 2186 |
| 2187 *stateptr = state; | |
| 2188 } | |
| 2189 | |
| 2190 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, 2, 7, 0, /* | |
| 2191 Parse Lisp syntax starting at FROM until TO; return status of parse at TO. | |
| 2192 Parsing stops at TO or when certain criteria are met; | |
| 2193 point is set to where parsing stops. | |
| 444 | 2194 If fifth arg OLDSTATE is omitted or nil, |
| 428 | 2195 parsing assumes that FROM is the beginning of a function. |
| 460 | 2196 Value is a list of nine elements describing final state of parsing: |
| 428 | 2197 0. depth in parens. |
| 2198 1. character address of start of innermost containing list; nil if none. | |
| 2199 2. character address of start of last complete sexp terminated. | |
| 2200 3. non-nil if inside a string. | |
| 460 | 2201 (It is the character that will terminate the string, |
| 2202 or t if the string should be terminated by an explicit | |
| 2203 `syntax-table' property.) | |
| 428 | 2204 4. t if inside a comment. |
| 2205 5. t if following a quote character. | |
| 2206 6. the minimum paren-depth encountered during this scan. | |
| 460 | 2207 7. nil if in comment style a, or not in a comment; t if in comment style b; |
| 2208 `syntax-table' if given by an explicit `syntax-table' property. | |
| 2209 8. character address of start of last comment or string; nil if none. | |
| 2210 9. Intermediate data for continuation of parsing (subject to change). | |
| 428 | 2211 If third arg TARGETDEPTH is non-nil, parsing stops if the depth |
| 2212 in parentheses becomes equal to TARGETDEPTH. | |
| 2213 Fourth arg STOPBEFORE non-nil means stop when come to | |
| 2214 any character that starts a sexp. | |
| 460 | 2215 Fifth arg OLDSTATE is a nine-element list like what this function returns. |
| 428 | 2216 It is used to initialize the state of the parse. Its second and third |
| 2217 elements are ignored. | |
| 460 | 2218 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. If it |
| 2219 is `syntax-table', stop after the start of a comment or a string, or after | |
| 2220 the end of a comment or string. | |
| 826 | 2221 Seventh arg BUFFER specifies the buffer to do the parsing in, and defaults |
| 2222 to the current buffer. | |
| 428 | 2223 */ |
| 2224 (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer)) | |
| 2225 { | |
| 2226 struct lisp_parse_state state; | |
| 2227 int target; | |
| 665 | 2228 Charbpos start, end; |
| 428 | 2229 struct buffer *buf = decode_buffer (buffer, 0); |
| 2230 Lisp_Object val; | |
| 2231 | |
| 2232 if (!NILP (targetdepth)) | |
| 2233 { | |
| 2234 CHECK_INT (targetdepth); | |
| 2235 target = XINT (targetdepth); | |
| 2236 } | |
| 2237 else | |
| 2238 target = -100000; /* We won't reach this depth */ | |
| 2239 | |
| 2240 get_buffer_range_char (buf, from, to, &start, &end, 0); | |
| 2241 scan_sexps_forward (buf, &state, start, end, | |
| 2242 target, !NILP (stopbefore), oldstate, | |
| 460 | 2243 (NILP (commentstop) |
| 2244 ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1))); | |
| 428 | 2245 BUF_SET_PT (buf, state.location); |
| 2246 | |
| 2247 /* reverse order */ | |
| 2248 val = Qnil; | |
| 460 | 2249 val = Fcons (state.levelstarts, val); |
| 2250 val = Fcons ((state.incomment || (state.instring >= 0)) | |
| 2251 ? make_int (state.comstr_start) : Qnil, val); | |
| 2252 val = Fcons (state.comstyle ? (state.comstyle == ST_COMMENT_STYLE | |
| 2253 ? Qsyntax_table : Qt) : Qnil, val); | |
| 428 | 2254 val = Fcons (make_int (state.mindepth), val); |
| 2255 val = Fcons (state.quoted ? Qt : Qnil, val); | |
| 2256 val = Fcons (state.incomment ? Qt : Qnil, val); | |
| 460 | 2257 val = Fcons (state.instring < 0 |
| 2258 ? Qnil | |
| 2259 : (state.instring == ST_STRING_STYLE | |
| 2260 ? Qt : make_int (state.instring)), val); | |
| 826 | 2261 val = Fcons (state.thislevelstart < 0 ? Qnil : |
| 2262 make_int (state.thislevelstart), val); | |
| 2263 val = Fcons (state.prevlevelstart < 0 ? Qnil : | |
| 2264 make_int (state.prevlevelstart), val); | |
| 428 | 2265 val = Fcons (make_int (state.depth), val); |
| 2266 | |
| 2267 return val; | |
| 2268 } | |
| 2269 | |
| 2270 | |
| 2271 /* Updating of the mirror syntax table. | |
| 2272 | |
| 1296 | 2273 Each syntax table has a corresponding mirror table in it. Whenever we |
| 2274 make a change to a syntax table, we set a dirty flag. When accessing a | |
| 2275 value from the mirror table and the table is dirty, we call | |
| 2276 update_syntax_table() to clean it up. | |
| 428 | 2277 |
| 2278 #### We really only need to map over the changed range. | |
| 2279 | |
| 2280 If we change the standard syntax table, we need to map over | |
| 2281 all tables because any of them could be inheriting from the | |
| 2282 standard syntax table. | |
| 2283 | |
| 2284 When `set-syntax-table' is called, we set the buffer's mirror | |
| 2285 syntax table as well. | |
| 2286 */ | |
| 2287 | |
| 826 | 2288 static int |
| 2286 | 2289 copy_to_mirrortab (struct chartab_range *range, Lisp_Object UNUSED (table), |
| 826 | 2290 Lisp_Object val, void *arg) |
| 428 | 2291 { |
| 5013 | 2292 Lisp_Object mirrortab = GET_LISP_FROM_VOID (arg); |
| 428 | 2293 |
| 2294 if (CONSP (val)) | |
| 2295 val = XCAR (val); | |
| 826 | 2296 if (SYNTAX_FROM_CODE (XINT (val)) != Sinherit) |
| 2297 put_char_table (mirrortab, range, val); | |
| 2298 return 0; | |
| 2299 } | |
| 2300 | |
| 2301 static int | |
| 2286 | 2302 copy_if_not_already_present (struct chartab_range *range, |
| 2303 Lisp_Object UNUSED (table), | |
| 826 | 2304 Lisp_Object val, void *arg) |
| 2305 { | |
| 5013 | 2306 Lisp_Object mirrortab = GET_LISP_FROM_VOID (arg); |
| 826 | 2307 if (CONSP (val)) |
| 2308 val = XCAR (val); | |
| 2309 if (SYNTAX_FROM_CODE (XINT (val)) != Sinherit) | |
| 2310 { | |
| 2311 Lisp_Object existing = | |
| 1296 | 2312 updating_mirror_get_range_char_table (range, mirrortab, |
| 2313 Vbogus_syntax_table_value); | |
| 826 | 2314 if (NILP (existing)) |
| 2315 /* nothing at all */ | |
| 1296 | 2316 put_char_table (mirrortab, range, val); |
| 2317 else if (!EQ (existing, Vbogus_syntax_table_value)) | |
| 826 | 2318 /* full */ |
| 2319 ; | |
| 2320 else | |
| 2321 { | |
| 2322 Freset_char_table (Vtemp_table_for_use_updating_syntax_tables); | |
| 2323 copy_char_table_range | |
| 1296 | 2324 (mirrortab, Vtemp_table_for_use_updating_syntax_tables, range); |
| 2325 put_char_table (mirrortab, range, val); | |
| 826 | 2326 copy_char_table_range |
| 1296 | 2327 (Vtemp_table_for_use_updating_syntax_tables, mirrortab, range); |
| 826 | 2328 } |
| 428 | 2329 } |
| 826 | 2330 |
| 428 | 2331 return 0; |
| 2332 } | |
| 2333 | |
| 2334 static void | |
| 826 | 2335 update_just_this_syntax_table (Lisp_Object table) |
| 428 | 2336 { |
| 2337 struct chartab_range range; | |
| 826 | 2338 Lisp_Object mirrortab = XCHAR_TABLE (table)->mirror_table; |
| 2339 | |
| 1296 | 2340 assert (!XCHAR_TABLE (table)->mirror_table_p); |
| 826 | 2341 range.type = CHARTAB_RANGE_ALL; |
| 2342 Freset_char_table (mirrortab); | |
| 1296 | 2343 |
| 826 | 2344 /* First, copy the tables values other than inherit into the mirror |
| 2345 table. Then, for tables other than the standard syntax table, map | |
| 2346 over the standard table, copying values into the mirror table only if | |
| 2347 entries don't already exist in that table. (The copying step requires | |
| 2348 another mapping.) | |
| 2349 */ | |
| 428 | 2350 |
| 5013 | 2351 map_char_table (table, &range, copy_to_mirrortab, STORE_LISP_IN_VOID (mirrortab)); |
| 826 | 2352 /* second clause catches bootstrapping problems when initializing the |
| 2353 standard syntax table */ | |
| 2354 if (!EQ (table, Vstandard_syntax_table) && !NILP (Vstandard_syntax_table)) | |
| 1296 | 2355 map_char_table (Vstandard_syntax_table, &range, |
| 5013 | 2356 copy_if_not_already_present, STORE_LISP_IN_VOID (mirrortab)); |
| 3152 | 2357 /* The resetting made the default be Qnil. Put it back to Sword. */ |
| 2358 set_char_table_default (mirrortab, make_int (Sword)); | |
| 1296 | 2359 XCHAR_TABLE (mirrortab)->dirty = 0; |
| 428 | 2360 } |
| 2361 | |
| 2362 /* Called from chartab.c when a change is made to a syntax table. | |
| 2363 If this is the standard syntax table, we need to recompute | |
| 2364 *all* syntax tables (yuck). Otherwise we just recompute this | |
| 2365 one. */ | |
| 2366 | |
| 2367 void | |
| 826 | 2368 update_syntax_table (Lisp_Object table) |
| 428 | 2369 { |
| 1296 | 2370 Lisp_Object nonmirror = XCHAR_TABLE (table)->mirror_table; |
| 2371 assert (XCHAR_TABLE (table)->mirror_table_p); | |
| 2372 if (EQ (nonmirror, Vstandard_syntax_table)) | |
| 428 | 2373 { |
| 2374 Lisp_Object syntab; | |
| 2375 | |
| 2376 for (syntab = Vall_syntax_tables; !NILP (syntab); | |
| 2377 syntab = XCHAR_TABLE (syntab)->next_table) | |
| 826 | 2378 update_just_this_syntax_table (syntab); |
| 428 | 2379 } |
| 2380 else | |
| 1296 | 2381 update_just_this_syntax_table (nonmirror); |
| 428 | 2382 } |
| 2383 | |
| 2384 | |
| 2385 /************************************************************************/ | |
| 2386 /* initialization */ | |
| 2387 /************************************************************************/ | |
| 2388 | |
| 2389 void | |
| 2390 syms_of_syntax (void) | |
| 2391 { | |
| 3092 | 2392 #ifdef NEW_GC |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
2393 INIT_LISP_OBJECT (syntax_cache); |
| 3092 | 2394 #endif /* NEW_GC */ |
| 563 | 2395 DEFSYMBOL (Qsyntax_table_p); |
| 2396 DEFSYMBOL (Qsyntax_table); | |
| 428 | 2397 |
| 2398 DEFSUBR (Fsyntax_table_p); | |
| 2399 DEFSUBR (Fsyntax_table); | |
| 826 | 2400 #ifdef DEBUG_XEMACS |
| 2401 DEFSUBR (Fmirror_syntax_table); | |
| 2402 DEFSUBR (Fsyntax_cache_info); | |
| 2403 #endif /* DEBUG_XEMACS */ | |
| 428 | 2404 DEFSUBR (Fstandard_syntax_table); |
| 2405 DEFSUBR (Fcopy_syntax_table); | |
| 2406 DEFSUBR (Fset_syntax_table); | |
| 2407 DEFSUBR (Fsyntax_designator_chars); | |
| 2408 DEFSUBR (Fchar_syntax); | |
| 2409 DEFSUBR (Fmatching_paren); | |
| 2410 /* DEFSUBR (Fmodify_syntax_entry); now in Lisp. */ | |
| 2411 /* DEFSUBR (Fdescribe_syntax); now in Lisp. */ | |
| 2412 | |
| 2413 DEFSUBR (Fforward_word); | |
| 2414 | |
| 2415 DEFSUBR (Fforward_comment); | |
| 2416 DEFSUBR (Fscan_lists); | |
| 2417 DEFSUBR (Fscan_sexps); | |
| 2418 DEFSUBR (Fbackward_prefix_chars); | |
| 2419 DEFSUBR (Fparse_partial_sexp); | |
|
4912
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
2420 |
|
e99033b7e05c
use more specific `scan-error' in scan-lists to be GNU compatible
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
2421 DEFERROR_STANDARD (Qscan_error, Qsyntax_error); |
| 428 | 2422 } |
| 2423 | |
| 2424 void | |
| 2425 vars_of_syntax (void) | |
| 2426 { | |
| 2427 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments /* | |
| 2428 Non-nil means `forward-sexp', etc., should treat comments as whitespace. | |
| 2429 */ ); | |
| 434 | 2430 parse_sexp_ignore_comments = 0; |
| 428 | 2431 |
| 460 | 2432 DEFVAR_BOOL ("lookup-syntax-properties", &lookup_syntax_properties /* |
| 826 | 2433 Non-nil means `forward-sexp', etc., respect the `syntax-table' property. |
| 2434 This property can be placed on buffers or strings and can be used to explicitly | |
| 2435 specify the syntax table to be used for looking up the syntax of the chars | |
| 2436 having this property, or to directly specify the syntax of the chars. | |
| 2437 | |
| 460 | 2438 The value of this property should be either a syntax table, or a cons |
| 2439 of the form (SYNTAXCODE . MATCHCHAR), SYNTAXCODE being the numeric | |
| 2440 syntax code, MATCHCHAR being nil or the character to match (which is | |
| 826 | 2441 relevant only when the syntax code is open/close-type). |
| 460 | 2442 */ ); |
| 2443 lookup_syntax_properties = 1; | |
| 2444 | |
| 428 | 2445 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes /* |
| 2446 Non-nil means `forward-word', etc., should treat escape chars part of words. | |
| 2447 */ ); | |
| 434 | 2448 words_include_escapes = 0; |
| 428 | 2449 |
| 2450 no_quit_in_re_search = 0; | |
| 1296 | 2451 |
| 2452 Vbogus_syntax_table_value = make_float (0.0); | |
| 2453 staticpro (&Vbogus_syntax_table_value); | |
| 428 | 2454 } |
| 2455 | |
| 2456 static void | |
| 3540 | 2457 define_standard_syntax (const UExtbyte *p, enum syntaxcode syn) |
| 428 | 2458 { |
| 2459 for (; *p; p++) | |
| 2460 Fput_char_table (make_char (*p), make_int (syn), Vstandard_syntax_table); | |
| 2461 } | |
| 2462 | |
| 2463 void | |
| 2464 complex_vars_of_syntax (void) | |
| 2465 { | |
| 867 | 2466 Ichar i; |
| 3540 | 2467 const UExtbyte *p; /* Latin-1, not internal format. */ |
| 2468 | |
| 2469 #define SET_RANGE_SYNTAX(start, end, syntax) \ | |
| 2470 do { \ | |
| 2471 for (i = start; i <= end; i++) \ | |
| 2472 Fput_char_table(make_char(i), make_int(syntax), \ | |
| 2473 Vstandard_syntax_table); \ | |
| 2474 } while (0) | |
| 2475 | |
| 2476 /* Set this now, so first buffer creation can refer to it. | |
| 2477 | |
| 2478 Make it nil before calling copy-syntax-table so that copy-syntax-table | |
| 2479 will know not to try to copy from garbage */ | |
| 428 | 2480 Vstandard_syntax_table = Qnil; |
| 2481 Vstandard_syntax_table = Fcopy_syntax_table (Qnil); | |
| 2482 staticpro (&Vstandard_syntax_table); | |
| 2483 | |
| 826 | 2484 Vtemp_table_for_use_updating_syntax_tables = Fmake_char_table (Qgeneric); |
| 2485 staticpro (&Vtemp_table_for_use_updating_syntax_tables); | |
| 2486 | |
| 428 | 2487 Vsyntax_designator_chars_string = make_string_nocopy (syntax_code_spec, |
| 2488 Smax); | |
| 2489 staticpro (&Vsyntax_designator_chars_string); | |
| 2490 | |
| 3540 | 2491 /* Default character syntax is word. */ |
| 3152 | 2492 set_char_table_default (Vstandard_syntax_table, make_int (Sword)); |
| 428 | 2493 |
| 3540 | 2494 /* Control 0; treat as punctuation */ |
| 2495 SET_RANGE_SYNTAX(0, 32, Spunct); | |
| 428 | 2496 |
| 3544 | 2497 /* The whitespace--overwriting some of the above changes. |
| 2498 | |
| 2499 String literals are const char *s, not const unsigned char *s. */ | |
|
4653
25e5e5346d31
?\012 is whitespace, as it always should have been, thank you Karl Kleinpaste.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4141
diff
changeset
|
2500 define_standard_syntax((const UExtbyte *)" \t\015\014\012", Swhitespace); |
| 3540 | 2501 |
| 2502 /* DEL plus Control 1 */ | |
| 2503 SET_RANGE_SYNTAX(127, 159, Spunct); | |
| 2504 | |
| 3544 | 2505 define_standard_syntax ((const UExtbyte *)"\"", Sstring); |
| 2506 define_standard_syntax ((const UExtbyte *)"\\", Sescape); | |
| 2507 define_standard_syntax ((const UExtbyte *)"_-+*/&|<>=", Ssymbol); | |
| 2508 define_standard_syntax ((const UExtbyte *)".,;:?!#@~^'`", Spunct); | |
| 428 | 2509 |
| 3544 | 2510 for (p = (const UExtbyte *)"()[]{}"; *p; p+=2) |
| 428 | 2511 { |
| 2512 Fput_char_table (make_char (p[0]), | |
| 2513 Fcons (make_int (Sopen), make_char (p[1])), | |
| 2514 Vstandard_syntax_table); | |
| 2515 Fput_char_table (make_char (p[1]), | |
| 2516 Fcons (make_int (Sclose), make_char (p[0])), | |
| 2517 Vstandard_syntax_table); | |
| 2518 } | |
| 3540 | 2519 |
| 2520 /* Latin 1 "symbols." This contrasts with the FSF, where they're word | |
| 2521 constituents. */ | |
| 2522 SET_RANGE_SYNTAX(0240, 0277, Ssymbol); | |
| 2523 | |
| 2524 /* The guillemets. These are not parentheses, in contrast to what the old | |
| 2525 code did. */ | |
| 3569 | 2526 define_standard_syntax((const UExtbyte *)"\253\273", Spunct); |
| 3540 | 2527 |
| 2528 /* The inverted exclamation mark, and the multiplication and division | |
| 2529 signs. */ | |
| 3544 | 2530 define_standard_syntax((const UExtbyte *)"\241\327\367", Spunct); |
| 3540 | 2531 |
| 2532 #undef SET_RANGE_SYNTAX | |
| 428 | 2533 } |