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