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