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