0
|
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.
|
|
4
|
|
5 This file is part of XEmacs.
|
|
6
|
|
7 XEmacs is free software; you can redistribute it and/or modify it
|
|
8 under the terms of the GNU General Public License as published by the
|
|
9 Free Software Foundation; either version 2, or (at your option) any
|
|
10 later version.
|
|
11
|
|
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
|
|
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
|
15 for more details.
|
|
16
|
|
17 You should have received a copy of the GNU General Public License
|
|
18 along with XEmacs; see the file COPYING. If not, write to
|
|
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
20 Boston, MA 02111-1307, USA. */
|
|
21
|
|
22 /* Synched up with: FSF 19.28. */
|
|
23
|
|
24 #include <config.h>
|
|
25 #include "lisp.h"
|
|
26
|
|
27 #include "buffer.h"
|
|
28 #include "commands.h"
|
|
29 #include "insdel.h"
|
|
30 #include "syntax.h"
|
|
31
|
|
32 Lisp_Object Qsyntax_table_p;
|
|
33
|
|
34 int words_include_escapes;
|
|
35
|
|
36 int parse_sexp_ignore_comments;
|
|
37
|
|
38 /* The following two variables are provided to tell additional information
|
|
39 to the regex routines. We do it this way rather than change the
|
|
40 arguments to re_search_2() in an attempt to maintain some call
|
|
41 compatibility with other versions of the regex code. */
|
|
42
|
|
43 /* Tell the regex routines not to QUIT. Normally there is a QUIT
|
|
44 each iteration in re_search_2(). */
|
|
45 int no_quit_in_re_search;
|
|
46
|
|
47 /* Tell the regex routines which buffer to access for SYNTAX() lookups
|
|
48 and the like. */
|
|
49 struct buffer *regex_emacs_buffer;
|
|
50
|
|
51 Lisp_Object Vstandard_syntax_table;
|
|
52
|
|
53 Lisp_Object Vsyntax_designator_chars_string;
|
|
54
|
|
55 /* This is the internal form of the parse state used in parse-partial-sexp. */
|
|
56
|
|
57 struct lisp_parse_state
|
2
|
58 {
|
|
59 int depth; /* Depth at end of parsing */
|
|
60 Emchar instring; /* -1 if not within string, else desired terminator */
|
|
61 int incomment; /* Nonzero if within a comment at end of parsing */
|
|
62 int comstyle; /* comment style a=0, or b=1 */
|
|
63 int quoted; /* Nonzero if just after an escape char at end of
|
0
|
64 parsing */
|
2
|
65 Bufpos thislevelstart;/* Char number of most recent start-of-expression
|
|
66 at current level */
|
|
67 Bufpos prevlevelstart;/* Char number of start of containing expression */
|
|
68 Bufpos location; /* Char number at which parsing stopped */
|
|
69 int mindepth; /* Minimum depth seen while scanning */
|
|
70 Bufpos comstart; /* Position just after last comment starter */
|
|
71 };
|
0
|
72
|
|
73 /* These variables are a cache for finding the start of a defun.
|
2
|
74 find_start_pos is the place for which the defun start was found.
|
|
75 find_start_value is the defun start position found for it.
|
0
|
76 find_start_buffer is the buffer it was found in.
|
2
|
77 find_start_begv is the BEGV value when it was found.
|
0
|
78 find_start_modiff is the value of MODIFF when it was found. */
|
|
79
|
|
80 static Bufpos find_start_pos;
|
|
81 static Bufpos find_start_value;
|
|
82 static struct buffer *find_start_buffer;
|
|
83 static Bufpos find_start_begv;
|
|
84 static int find_start_modiff;
|
|
85
|
|
86 /* Find a defun-start that is the last one before POS (or nearly the last).
|
|
87 We record what we find, so that another call in the same area
|
|
88 can return the same value right away. */
|
|
89
|
|
90 static Bufpos
|
|
91 find_defun_start (struct buffer *buf, Bufpos pos)
|
|
92 {
|
|
93 Bufpos tem;
|
20
|
94 Lisp_Object syntaxtab = buf->syntax_table;
|
0
|
95
|
|
96 /* Use previous finding, if it's valid and applies to this inquiry. */
|
|
97 if (buf == find_start_buffer
|
|
98 /* Reuse the defun-start even if POS is a little farther on.
|
|
99 POS might be in the next defun, but that's ok.
|
|
100 Our value may not be the best possible, but will still be usable. */
|
|
101 && pos <= find_start_pos + 1000
|
|
102 && pos >= find_start_value
|
|
103 && BUF_BEGV (buf) == find_start_begv
|
|
104 && BUF_MODIFF (buf) == find_start_modiff)
|
|
105 return find_start_value;
|
|
106
|
|
107 /* Back up to start of line. */
|
|
108 tem = find_next_newline (buf, pos, -1);
|
|
109
|
|
110 while (tem > BUF_BEGV (buf))
|
|
111 {
|
|
112 /* Open-paren at start of line means we found our defun-start. */
|
20
|
113 if (SYNTAX (syntaxtab, BUF_FETCH_CHAR (buf, tem)) == Sopen)
|
0
|
114 break;
|
|
115 /* Move to beg of previous line. */
|
|
116 tem = find_next_newline (buf, tem, -2);
|
|
117 }
|
|
118
|
|
119 /* Record what we found, for the next try. */
|
2
|
120 find_start_value = tem;
|
0
|
121 find_start_buffer = buf;
|
|
122 find_start_modiff = BUF_MODIFF (buf);
|
2
|
123 find_start_begv = BUF_BEGV (buf);
|
|
124 find_start_pos = pos;
|
0
|
125
|
|
126 return find_start_value;
|
|
127 }
|
|
128
|
20
|
129 DEFUN ("syntax-table-p", Fsyntax_table_p, 1, 1, 0, /*
|
0
|
130 Return t if ARG is a syntax table.
|
|
131 Any vector of 256 elements will do.
|
20
|
132 */
|
|
133 (obj))
|
0
|
134 {
|
|
135 if (VECTORP (obj) && vector_length (XVECTOR (obj)) == 0400)
|
|
136 return Qt;
|
|
137 return Qnil;
|
|
138 }
|
|
139
|
|
140 static Lisp_Object
|
|
141 check_syntax_table (Lisp_Object obj, Lisp_Object def)
|
|
142 {
|
|
143 if (NILP (obj))
|
|
144 obj = def;
|
|
145 while (NILP (Fsyntax_table_p (obj)))
|
|
146 obj = wrong_type_argument (Qsyntax_table_p, obj);
|
|
147 return (obj);
|
|
148 }
|
|
149
|
20
|
150 DEFUN ("syntax-table", Fsyntax_table, 0, 1, 0, /*
|
0
|
151 Return the current syntax table.
|
|
152 This is the one specified by the current buffer, or by BUFFER if it
|
|
153 is non-nil.
|
20
|
154 */
|
|
155 (buffer))
|
0
|
156 {
|
|
157 return decode_buffer (buffer, 0)->syntax_table;
|
|
158 }
|
|
159
|
20
|
160 DEFUN ("standard-syntax-table", Fstandard_syntax_table, 0, 0, 0, /*
|
0
|
161 Return the standard syntax table.
|
|
162 This is the one used for new buffers.
|
20
|
163 */
|
|
164 ())
|
0
|
165 {
|
|
166 return Vstandard_syntax_table;
|
|
167 }
|
|
168
|
20
|
169 DEFUN ("copy-syntax-table", Fcopy_syntax_table, 0, 1, 0, /*
|
0
|
170 Construct a new syntax table and return it.
|
|
171 It is a copy of the TABLE, which defaults to the standard syntax table.
|
20
|
172 */
|
|
173 (table))
|
0
|
174 {
|
|
175 if (NILP (Vstandard_syntax_table))
|
|
176 /* Can only be null during initialization */
|
|
177 return make_vector (0400, Qzero);
|
|
178
|
|
179 table = check_syntax_table (table, Vstandard_syntax_table);
|
|
180 return Fcopy_sequence (table);
|
|
181 }
|
|
182
|
20
|
183 DEFUN ("set-syntax-table", Fset_syntax_table, 1, 2, 0, /*
|
0
|
184 Select a new syntax table for BUFFER.
|
|
185 One argument, a syntax table.
|
|
186 BUFFER defaults to the current buffer if omitted.
|
20
|
187 */
|
|
188 (table, buffer))
|
0
|
189 {
|
|
190 struct buffer *buf = decode_buffer (buffer, 0);
|
|
191 table = check_syntax_table (table, Qnil);
|
|
192 buf->syntax_table = table;
|
|
193 /* Indicate that this buffer now has a specified syntax table. */
|
|
194 buf->local_var_flags |= XINT (buffer_local_flags.syntax_table);
|
|
195 return table;
|
|
196 }
|
|
197
|
|
198 /* Convert a letter which signifies a syntax code
|
2
|
199 into the code it signifies.
|
|
200 This is used by modify-syntax-entry, and other things. */
|
0
|
201
|
|
202 CONST unsigned char syntax_spec_code[0400] =
|
|
203 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
|
|
204 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
|
|
205 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
|
|
206 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
|
|
207 (char) Swhitespace, 0377, (char) Sstring, 0377,
|
|
208 (char) Smath, 0377, 0377, (char) Squote,
|
|
209 (char) Sopen, (char) Sclose, 0377, 0377,
|
|
210 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
|
|
211 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
|
|
212 0377, 0377, 0377, 0377,
|
|
213 (char) Scomment, 0377, (char) Sendcomment, 0377,
|
|
214 (char) Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A ... */
|
|
215 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
|
|
216 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
|
|
217 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
|
|
218 0377, 0377, 0377, 0377, 0377, Sextword, 0377, 0377, /* `, a, ... */
|
|
219 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
|
|
220 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
|
|
221 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377
|
|
222 };
|
|
223
|
|
224 CONST unsigned char syntax_code_spec[] =
|
|
225 {
|
|
226 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
|
|
227 'e', '\0'
|
|
228 };
|
|
229
|
20
|
230 DEFUN ("syntax-designator-chars", Fsyntax_designator_chars, 0, 0, 0, /*
|
0
|
231 Return a string of the recognized syntax designator chars.
|
|
232 The chars are ordered by their internal syntax codes, which are
|
|
233 numbered starting at 0.
|
20
|
234 */
|
|
235 ())
|
0
|
236 {
|
|
237 return Vsyntax_designator_chars_string;
|
|
238 }
|
|
239
|
20
|
240 DEFUN ("char-syntax", Fchar_syntax, 1, 2, 0, /*
|
0
|
241 Return the syntax code of CHAR, described by a character.
|
|
242 For example, if CHAR is a word constituent, the character `?w' is returned.
|
|
243 The characters that correspond to various syntax codes
|
|
244 are listed in the documentation of `modify-syntax-entry'.
|
|
245 Optional second argument TABLE defaults to the current buffer's
|
|
246 syntax table.
|
20
|
247 */
|
|
248 (ch, table))
|
0
|
249 {
|
|
250 CHECK_CHAR_COERCE_INT (ch);
|
|
251 table = check_syntax_table (table, current_buffer->syntax_table);
|
|
252
|
|
253 return make_int (syntax_code_spec[(int) SYNTAX (table, XINT (ch))]);
|
|
254 }
|
|
255
|
|
256
|
|
257 Lisp_Object
|
|
258 syntax_match (Lisp_Object table, Emchar ch)
|
|
259 {
|
|
260 unsigned char stringterm = ((SYNTAX_CODE (table, ch) >> 8) & 0377);
|
|
261
|
|
262 if (stringterm == 0)
|
|
263 return Qnil;
|
|
264 else
|
|
265 return make_char (stringterm);
|
|
266 }
|
|
267
|
20
|
268 DEFUN ("matching-paren", Fmatching_paren, 1, 2, 0, /*
|
0
|
269 Return the matching parenthesis of CHAR, or nil if none.
|
|
270 Optional second argument TABLE defaults to the current buffer's
|
|
271 syntax table.
|
20
|
272 */
|
|
273 (ch, table))
|
0
|
274 {
|
|
275 int code;
|
|
276 CHECK_CHAR_COERCE_INT (ch);
|
|
277
|
|
278 table = check_syntax_table (table, current_buffer->syntax_table);
|
|
279 code = SYNTAX (table, XCHAR (ch));
|
|
280 if (code == Sopen || code == Sclose || code == Sstring)
|
|
281 return syntax_match (table, XCHAR (ch));
|
|
282 return Qnil;
|
|
283 }
|
|
284
|
|
285
|
|
286 /* Return the position across COUNT words from FROM.
|
|
287 If that many words cannot be found before the end of the buffer, return 0.
|
|
288 COUNT negative means scan backward and stop at word beginning. */
|
|
289
|
|
290 Bufpos
|
|
291 scan_words (struct buffer *buf, Bufpos from, int count)
|
|
292 {
|
|
293 Bufpos beg = BUF_BEGV (buf);
|
|
294 Bufpos end = BUF_ZV (buf);
|
|
295 enum syntaxcode code;
|
|
296 Lisp_Object table = buf->syntax_table;
|
|
297
|
|
298 while (count > 0)
|
|
299 {
|
|
300 QUIT;
|
|
301
|
|
302 while (1)
|
|
303 {
|
|
304 Emchar ch;
|
|
305 if (from == end)
|
|
306 {
|
|
307 return 0;
|
|
308 }
|
|
309 ch = BUF_FETCH_CHAR (buf, from);
|
|
310 code = SYNTAX_UNSAFE (table, ch);
|
|
311 if (words_include_escapes
|
|
312 && (code == Sescape || code == Scharquote))
|
|
313 break;
|
|
314 if (code == Sword || code == Sextword)
|
|
315 break;
|
|
316 from++;
|
|
317 }
|
|
318
|
|
319 QUIT;
|
|
320
|
|
321 while (1)
|
|
322 {
|
|
323 Emchar ch;
|
|
324 if (from == end) break;
|
|
325 ch = BUF_FETCH_CHAR (buf, from);
|
|
326 code = SYNTAX_UNSAFE (table, ch);
|
|
327 if (!(words_include_escapes
|
|
328 && (code == Sescape || code == Scharquote)))
|
|
329 if (code != Sword && code != Sextword)
|
|
330 break;
|
|
331 from++;
|
|
332 }
|
|
333
|
|
334 count--;
|
|
335 }
|
|
336 while (count < 0)
|
|
337 {
|
|
338 QUIT;
|
|
339
|
|
340 while (1)
|
|
341 {
|
|
342 Emchar ch;
|
|
343 if (from == beg)
|
|
344 {
|
|
345 return 0;
|
|
346 }
|
|
347 ch = BUF_FETCH_CHAR (buf, from - 1);
|
|
348 code = SYNTAX_UNSAFE (table, ch);
|
|
349 if (words_include_escapes
|
|
350 && (code == Sescape || code == Scharquote))
|
|
351 break;
|
|
352 if (code == Sword || code == Sextword)
|
|
353 break;
|
|
354 from--;
|
|
355 }
|
|
356
|
|
357 QUIT;
|
|
358
|
|
359 while (1)
|
|
360 {
|
|
361 Emchar ch;
|
|
362 if (from == beg) break;
|
|
363 ch = BUF_FETCH_CHAR (buf, from - 1);
|
|
364 code = SYNTAX_UNSAFE (table, ch);
|
|
365 if (!(words_include_escapes
|
|
366 && (code == Sescape || code == Scharquote)))
|
|
367 if (code != Sword && code != Sextword)
|
|
368 break;
|
|
369 from--;
|
|
370 }
|
|
371 count++;
|
|
372 }
|
|
373
|
|
374 return from;
|
|
375 }
|
|
376
|
20
|
377 DEFUN ("forward-word", Fforward_word, 1, 2, "_p", /*
|
0
|
378 Move point forward ARG words (backward if ARG is negative).
|
|
379 Normally returns t.
|
|
380 If an edge of the buffer is reached, point is left there
|
|
381 and nil is returned.
|
20
|
382 */
|
|
383 (count, buffer))
|
0
|
384 {
|
|
385 Bufpos val;
|
|
386 struct buffer *buf = decode_buffer (buffer, 0);
|
|
387 CHECK_INT (count);
|
|
388
|
|
389 if (!(val = scan_words (buf, BUF_PT (buf), XINT (count))))
|
|
390 {
|
|
391 BUF_SET_PT (buf, XINT (count) > 0 ? BUF_ZV (buf) : BUF_BEGV (buf));
|
|
392 return Qnil;
|
|
393 }
|
|
394 BUF_SET_PT (buf, val);
|
|
395 return Qt;
|
|
396 }
|
|
397
|
|
398 static void scan_sexps_forward (struct buffer *buf,
|
|
399 struct lisp_parse_state *,
|
|
400 Bufpos from, Bufpos end,
|
|
401 int targetdepth, int stopbefore,
|
|
402 Lisp_Object oldstate,
|
|
403 int commentstop);
|
|
404
|
|
405 static int
|
|
406 find_start_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int mask)
|
|
407 {
|
|
408 Emchar c;
|
|
409 enum syntaxcode code;
|
|
410 Lisp_Object table = buf->syntax_table;
|
|
411
|
|
412 /* Look back, counting the parity of string-quotes,
|
|
413 and recording the comment-starters seen.
|
|
414 When we reach a safe place, assume that's not in a string;
|
|
415 then step the main scan to the earliest comment-starter seen
|
|
416 an even number of string quotes away from the safe place.
|
|
417
|
|
418 OFROM[I] is position of the earliest comment-starter seen
|
|
419 which is I+2X quotes from the comment-end.
|
|
420 PARITY is current parity of quotes from the comment end. */
|
|
421 int parity = 0;
|
|
422 Emchar my_stringend = 0;
|
|
423 int string_lossage = 0;
|
|
424 Bufpos comment_end = from;
|
|
425 Bufpos comstart_pos = 0;
|
|
426 int comstart_parity = 0;
|
|
427 int styles_match_p = 0;
|
|
428
|
|
429 /* At beginning of range to scan, we're outside of strings;
|
|
430 that determines quote parity to the comment-end. */
|
|
431 while (from != stop)
|
|
432 {
|
|
433 /* Move back and examine a character. */
|
|
434 from--;
|
|
435
|
|
436 c = BUF_FETCH_CHAR (buf, from);
|
|
437 code = SYNTAX_UNSAFE (table, c);
|
|
438
|
|
439 /* is this a 1-char comment end sequence? if so, try
|
|
440 to see if style matches previously extracted mask */
|
|
441 if (code == Sendcomment)
|
|
442 {
|
|
443 styles_match_p = SYNTAX_STYLES_MATCH_1CHAR_P (table, c, mask);
|
|
444 }
|
|
445
|
|
446 /* otherwise, is this a 2-char comment end sequence? */
|
|
447 else if (from >= stop
|
|
448 && SYNTAX_END_P (table, c, BUF_FETCH_CHAR (buf, from+1)))
|
|
449 {
|
|
450 code = Sendcomment;
|
|
451 styles_match_p =
|
|
452 SYNTAX_STYLES_MATCH_END_P (table, c,
|
|
453 BUF_FETCH_CHAR (buf, from+1),
|
|
454 mask);
|
|
455 }
|
|
456
|
|
457 /* or are we looking at a 1-char comment start sequence
|
|
458 of the style matching mask? */
|
|
459 else if (code == Scomment
|
|
460 && SYNTAX_STYLES_MATCH_1CHAR_P (table, c, mask))
|
|
461 {
|
|
462 styles_match_p = 1;
|
|
463 }
|
|
464
|
|
465 /* or possibly, a 2-char comment start sequence */
|
|
466 else if (from >= stop
|
|
467 && SYNTAX_STYLES_MATCH_START_P (table, c,
|
|
468 BUF_FETCH_CHAR (buf, from+1),
|
|
469 mask))
|
|
470 {
|
|
471 code = Scomment;
|
|
472 styles_match_p = 1;
|
|
473 }
|
|
474
|
|
475 /* Ignore escaped characters. */
|
|
476 if (char_quoted (buf, from))
|
|
477 continue;
|
|
478
|
|
479 /* Track parity of quotes. */
|
|
480 if (code == Sstring)
|
|
481 {
|
|
482 parity ^= 1;
|
|
483 if (my_stringend == 0)
|
|
484 my_stringend = c;
|
|
485 /* If we have two kinds of string delimiters.
|
|
486 There's no way to grok this scanning backwards. */
|
|
487 else if (my_stringend != c)
|
|
488 string_lossage = 1;
|
|
489 }
|
|
490
|
|
491 /* Record comment-starters according to that
|
|
492 quote-parity to the comment-end. */
|
|
493 if (code == Scomment && styles_match_p)
|
|
494 {
|
|
495 comstart_parity = parity;
|
|
496 comstart_pos = from;
|
|
497 }
|
|
498
|
|
499 /* If we find another earlier comment-ender,
|
|
500 any comment-starts earlier than that don't count
|
|
501 (because they go with the earlier comment-ender). */
|
|
502 if (code == Sendcomment && styles_match_p)
|
|
503 break;
|
|
504
|
|
505 /* Assume a defun-start point is outside of strings. */
|
|
506 if (code == Sopen
|
|
507 && (from == stop || BUF_FETCH_CHAR (buf, from - 1) == '\n'))
|
|
508 break;
|
|
509 }
|
|
510
|
|
511 if (comstart_pos == 0)
|
|
512 from = comment_end;
|
|
513 /* If the earliest comment starter
|
|
514 is followed by uniform paired string quotes or none,
|
|
515 we know it can't be inside a string
|
|
516 since if it were then the comment ender would be inside one.
|
|
517 So it does start a comment. Skip back to it. */
|
|
518 else if (comstart_parity == 0 && !string_lossage)
|
|
519 from = comstart_pos;
|
|
520 else
|
|
521 {
|
|
522 /* We had two kinds of string delimiters mixed up
|
|
523 together. Decode this going forwards.
|
|
524 Scan fwd from the previous comment ender
|
|
525 to the one in question; this records where we
|
|
526 last passed a comment starter. */
|
|
527
|
|
528 struct lisp_parse_state state;
|
|
529 scan_sexps_forward (buf, &state, find_defun_start (buf, comment_end),
|
|
530 comment_end - 1, -10000, 0, Qnil, 0);
|
|
531 if (state.incomment)
|
|
532 from = state.comstart;
|
|
533 else
|
|
534 /* We can't grok this as a comment; scan it normally. */
|
|
535 from = comment_end;
|
|
536 }
|
|
537 return from;
|
|
538 }
|
|
539
|
|
540 static Bufpos
|
|
541 find_end_of_comment (struct buffer *buf, Bufpos from, Bufpos stop, int mask)
|
|
542 {
|
|
543 int c;
|
|
544 Lisp_Object table = buf->syntax_table;
|
|
545
|
|
546 while (1)
|
|
547 {
|
|
548 if (from == stop)
|
|
549 {
|
|
550 return -1;
|
|
551 }
|
|
552 c = BUF_FETCH_CHAR (buf, from);
|
|
553 if (SYNTAX_UNSAFE (table, c) == Sendcomment
|
|
554 && SYNTAX_STYLES_MATCH_1CHAR_P (table, c, mask))
|
|
555 /* we have encountered a comment end of the same style
|
|
556 as the comment sequence which began this comment
|
|
557 section */
|
|
558 break;
|
|
559
|
|
560 from++;
|
|
561 if (from < stop
|
|
562 && SYNTAX_STYLES_MATCH_END_P (table, c,
|
|
563 BUF_FETCH_CHAR (buf, from), mask))
|
|
564 /* we have encountered a comment end of the same style
|
|
565 as the comment sequence which began this comment
|
|
566 section */
|
|
567 { from++; break; }
|
|
568 }
|
|
569 return from;
|
|
570 }
|
|
571
|
|
572
|
|
573 /* #### between FSF 19.23 and 19.28 there are some changes to the logic
|
|
574 in this function (and minor changes to find_start_of_comment(),
|
|
575 above, which is part of Fforward_comment() in FSF). Attempts to port
|
|
576 that logic made this function break, so I'm leaving it out. If anyone
|
|
577 ever complains about this function not working properly, take a look
|
|
578 at those changes. --ben */
|
|
579
|
20
|
580 DEFUN ("forward-comment", Fforward_comment, 1, 2, 0, /*
|
0
|
581 Move forward across up to N comments. If N is negative, move backward.
|
|
582 Stop scanning if we find something other than a comment or whitespace.
|
|
583 Set point to where scanning stops.
|
|
584 If N comments are found as expected, with nothing except whitespace
|
|
585 between them, return t; otherwise return nil.
|
|
586 Point is set in either case.
|
|
587 Optional argument BUFFER defaults to the current buffer.
|
20
|
588 */
|
|
589 (n, buffer))
|
0
|
590 {
|
|
591 Bufpos from;
|
|
592 Bufpos stop;
|
|
593 Emchar c;
|
|
594 enum syntaxcode code;
|
|
595 int count;
|
|
596 struct buffer *buf = decode_buffer (buffer, 0);
|
|
597 Lisp_Object table = buf->syntax_table;
|
|
598
|
|
599 CHECK_INT (n);
|
|
600 count = XINT (n);
|
|
601
|
|
602 from = BUF_PT (buf);
|
|
603
|
|
604 while (count > 0)
|
|
605 {
|
|
606 QUIT;
|
|
607
|
|
608 stop = BUF_ZV (buf);
|
|
609 while (from < stop)
|
|
610 {
|
|
611 int mask = 0; /* mask for finding matching comment style */
|
|
612
|
|
613 if (char_quoted (buf, from))
|
|
614 {
|
|
615 from++;
|
|
616 continue;
|
|
617 }
|
|
618
|
|
619 c = BUF_FETCH_CHAR (buf, from);
|
|
620 code = SYNTAX (table, c);
|
|
621
|
|
622 if (code == Scomment)
|
|
623 {
|
|
624 /* we have encountered a single character comment start
|
|
625 sequence, and we are ignoring all text inside comments.
|
|
626 we must record the comment style this character begins
|
|
627 so that later, only a comment end of the same style actually
|
|
628 ends the comment section */
|
|
629 mask = SYNTAX_COMMENT_1CHAR_MASK (table, c);
|
|
630 }
|
|
631
|
|
632 else if (from < stop
|
|
633 && SYNTAX_START_P (table, c, BUF_FETCH_CHAR (buf, from+1)))
|
|
634 {
|
|
635 /* we have encountered a 2char comment start sequence and we
|
|
636 are ignoring all text inside comments. we must record
|
|
637 the comment style this sequence begins so that later,
|
|
638 only a comment end of the same style actually ends
|
|
639 the comment section */
|
|
640 code = Scomment;
|
|
641 mask = SYNTAX_COMMENT_MASK_START (table, c,
|
|
642 BUF_FETCH_CHAR (buf, from+1));
|
|
643 from++;
|
|
644 }
|
|
645
|
|
646 if (code == Scomment)
|
|
647 {
|
|
648 Bufpos newfrom;
|
|
649
|
|
650 newfrom = find_end_of_comment (buf, from, stop, mask);
|
|
651 if (newfrom < 0)
|
|
652 {
|
|
653 /* we stopped because from==stop */
|
|
654 BUF_SET_PT (buf, stop);
|
|
655 return Qnil;
|
|
656 }
|
|
657 from = newfrom;
|
|
658
|
|
659 /* We have skipped one comment. */
|
|
660 break;
|
|
661 }
|
|
662 else if (code != Swhitespace
|
|
663 && code != Sendcomment
|
|
664 && code != Scomment )
|
|
665 {
|
|
666 BUF_SET_PT (buf, from);
|
|
667 return Qnil;
|
|
668 }
|
|
669 from++;
|
|
670 }
|
|
671
|
|
672 /* End of comment reached */
|
|
673 count--;
|
|
674 }
|
|
675
|
|
676 while (count < 0)
|
|
677 {
|
|
678 QUIT;
|
|
679
|
|
680 stop = BUF_BEGV (buf);
|
|
681 while (from > stop)
|
|
682 {
|
|
683 int mask = 0; /* mask for finding matching comment style */
|
|
684
|
|
685 from--;
|
|
686 if (char_quoted (buf, from))
|
|
687 {
|
|
688 from--;
|
|
689 continue;
|
|
690 }
|
|
691
|
|
692 c = BUF_FETCH_CHAR (buf, from);
|
|
693 code = SYNTAX (table, c);
|
|
694
|
|
695 if (code == Sendcomment)
|
|
696 {
|
|
697 /* we have found a single char end comment. we must record
|
|
698 the comment style encountered so that later, we can match
|
|
699 only the proper comment begin sequence of the same style */
|
|
700 mask = SYNTAX_COMMENT_1CHAR_MASK (table, c);
|
|
701 }
|
|
702
|
|
703 else if (from > stop
|
|
704 && SYNTAX_END_P (table, BUF_FETCH_CHAR (buf, from - 1), c)
|
|
705 && !char_quoted (buf, from - 1))
|
|
706 {
|
|
707 /* We must record the comment style encountered so that
|
|
708 later, we can match only the proper comment begin
|
|
709 sequence of the same style. */
|
|
710 code = Sendcomment;
|
|
711 mask = SYNTAX_COMMENT_MASK_END (table,
|
|
712 BUF_FETCH_CHAR (buf, from - 1),
|
|
713 c);
|
|
714 from--;
|
|
715 }
|
|
716
|
|
717 if (code == Sendcomment)
|
|
718 {
|
|
719 from = find_start_of_comment (buf, from, stop, mask);
|
|
720 break;
|
|
721 }
|
|
722
|
|
723 else if (code != Swhitespace
|
|
724 && SYNTAX (table, c) != Scomment
|
|
725 && SYNTAX (table, c) != Sendcomment)
|
|
726 {
|
|
727 BUF_SET_PT (buf, from + 1);
|
|
728 return Qnil;
|
|
729 }
|
|
730 }
|
|
731
|
|
732 count++;
|
|
733 }
|
|
734
|
|
735 BUF_SET_PT (buf, from);
|
|
736 return Qt;
|
|
737 }
|
|
738
|
|
739
|
|
740 Lisp_Object
|
|
741 scan_lists (struct buffer *buf, Bufpos from, int count, int depth,
|
|
742 int sexpflag, int no_error)
|
|
743 {
|
|
744 Bufpos stop;
|
|
745 Emchar c;
|
|
746 int quoted;
|
|
747 int mathexit = 0;
|
|
748 enum syntaxcode code;
|
|
749 int min_depth = depth; /* Err out if depth gets less than this. */
|
|
750 Lisp_Object table = buf->syntax_table;
|
|
751
|
|
752 if (depth > 0) min_depth = 0;
|
|
753
|
|
754 while (count > 0)
|
|
755 {
|
|
756 QUIT;
|
|
757
|
|
758 stop = BUF_ZV (buf);
|
|
759 while (from < stop)
|
|
760 {
|
|
761 int mask = 0; /* mask for finding matching comment style */
|
|
762
|
|
763 c = BUF_FETCH_CHAR (buf, from);
|
|
764 code = SYNTAX_UNSAFE (table, c);
|
|
765 from++;
|
|
766
|
|
767 /* a 1-char comment start sequence */
|
|
768 if (code == Scomment && parse_sexp_ignore_comments)
|
|
769 {
|
|
770 mask = SYNTAX_COMMENT_1CHAR_MASK (table, c);
|
|
771 }
|
|
772
|
|
773 /* else, a 2-char comment start sequence? */
|
|
774 else if (from < stop
|
|
775 && SYNTAX_START_P (table, c, BUF_FETCH_CHAR (buf, from))
|
|
776 && parse_sexp_ignore_comments)
|
|
777 {
|
|
778 /* we have encountered a comment start sequence and we
|
|
779 are ignoring all text inside comments. we must record
|
|
780 the comment style this sequence begins so that later,
|
|
781 only a comment end of the same style actually ends
|
|
782 the comment section */
|
|
783 code = Scomment;
|
|
784 mask = SYNTAX_COMMENT_MASK_START (table, c,
|
|
785 BUF_FETCH_CHAR (buf, from));
|
|
786 from++;
|
|
787 }
|
|
788
|
|
789 if (SYNTAX_PREFIX_UNSAFE (table, c))
|
|
790 continue;
|
|
791
|
|
792 switch (code)
|
|
793 {
|
|
794 case Sescape:
|
|
795 case Scharquote:
|
|
796 if (from == stop) goto lose;
|
|
797 from++;
|
|
798 /* treat following character as a word constituent */
|
|
799 case Sword:
|
|
800 case Sextword:
|
|
801 case Ssymbol:
|
|
802 if (depth || !sexpflag) break;
|
|
803 /* This word counts as a sexp; return at end of it. */
|
|
804 while (from < stop)
|
|
805 {
|
|
806 switch (SYNTAX (table, BUF_FETCH_CHAR (buf, from)))
|
|
807 {
|
|
808 case Scharquote:
|
|
809 case Sescape:
|
|
810 from++;
|
|
811 if (from == stop) goto lose;
|
|
812 break;
|
|
813 case Sword:
|
|
814 case Sextword:
|
|
815 case Ssymbol:
|
|
816 case Squote:
|
|
817 break;
|
|
818 default:
|
|
819 goto done;
|
|
820 }
|
|
821 from++;
|
|
822 }
|
|
823 goto done;
|
|
824
|
|
825 case Scomment:
|
|
826 if (!parse_sexp_ignore_comments)
|
|
827 break;
|
|
828 {
|
|
829 Bufpos newfrom = find_end_of_comment (buf, from, stop, mask);
|
|
830 if (newfrom < 0)
|
|
831 {
|
|
832 /* we stopped because from == stop in search forward */
|
|
833 from = stop;
|
|
834 if (depth == 0)
|
|
835 goto done;
|
|
836 goto lose;
|
|
837 }
|
|
838 from = newfrom;
|
|
839 }
|
|
840 break;
|
|
841
|
|
842 case Smath:
|
|
843 if (!sexpflag)
|
|
844 break;
|
|
845 if (from != stop && c == BUF_FETCH_CHAR (buf, from))
|
|
846 from++;
|
|
847 if (mathexit)
|
|
848 {
|
|
849 mathexit = 0;
|
|
850 goto close1;
|
|
851 }
|
|
852 mathexit = 1;
|
|
853
|
|
854 case Sopen:
|
|
855 if (!++depth) goto done;
|
|
856 break;
|
|
857
|
|
858 case Sclose:
|
|
859 close1:
|
|
860 if (!--depth) goto done;
|
|
861 if (depth < min_depth)
|
|
862 {
|
|
863 if (no_error)
|
|
864 return Qnil;
|
|
865 error ("Containing expression ends prematurely");
|
|
866 }
|
|
867 break;
|
|
868
|
|
869 case Sstring:
|
|
870 {
|
|
871 /* XEmacs change: call syntax_match on character */
|
|
872 Emchar ch = BUF_FETCH_CHAR (buf, from - 1);
|
|
873 Lisp_Object stermobj = syntax_match (table, ch);
|
|
874 Emchar stringterm;
|
|
875
|
|
876 if (CHARP (stermobj))
|
|
877 stringterm = XCHAR (stermobj);
|
|
878 else
|
|
879 stringterm = ch;
|
|
880
|
|
881 while (1)
|
|
882 {
|
|
883 if (from >= stop)
|
|
884 goto lose;
|
|
885 if (BUF_FETCH_CHAR (buf, from) == stringterm)
|
|
886 break;
|
|
887 switch (SYNTAX (table, BUF_FETCH_CHAR (buf, from)))
|
|
888 {
|
|
889 case Scharquote:
|
|
890 case Sescape:
|
|
891 from++;
|
|
892 break;
|
|
893 default:
|
|
894 break;
|
|
895 }
|
|
896 from++;
|
|
897 }
|
|
898 from++;
|
|
899 if (!depth && sexpflag) goto done;
|
|
900 break;
|
|
901 }
|
|
902
|
|
903 default:
|
|
904 break;
|
|
905 }
|
|
906 }
|
|
907
|
|
908 /* Reached end of buffer. Error if within object,
|
|
909 return nil if between */
|
|
910 if (depth) goto lose;
|
|
911
|
|
912 return Qnil;
|
|
913
|
|
914 /* End of object reached */
|
|
915 done:
|
|
916 count--;
|
|
917 }
|
|
918
|
|
919 while (count < 0)
|
|
920 {
|
|
921 QUIT;
|
|
922
|
|
923 stop = BUF_BEGV (buf);
|
|
924 while (from > stop)
|
|
925 {
|
|
926 int mask = 0; /* mask for finding matching comment style */
|
|
927
|
|
928 from--;
|
|
929 quoted = char_quoted (buf, from);
|
|
930 if (quoted)
|
|
931 from--;
|
|
932
|
|
933 c = BUF_FETCH_CHAR (buf, from);
|
|
934 code = SYNTAX_UNSAFE (table, c);
|
|
935
|
|
936 if (code == Sendcomment && parse_sexp_ignore_comments)
|
|
937 {
|
|
938 /* we have found a single char end comment. we must record
|
|
939 the comment style encountered so that later, we can match
|
|
940 only the proper comment begin sequence of the same style */
|
|
941 mask = SYNTAX_COMMENT_1CHAR_MASK (table, c);
|
|
942 }
|
|
943
|
|
944 else if (from > stop
|
|
945 && SYNTAX_END_P (table, BUF_FETCH_CHAR (buf, from-1), c)
|
|
946 && !char_quoted (buf, from - 1)
|
|
947 && parse_sexp_ignore_comments)
|
|
948 {
|
|
949 /* we must record the comment style encountered so that
|
|
950 later, we can match only the proper comment begin
|
|
951 sequence of the same style */
|
|
952 code = Sendcomment;
|
|
953 mask = SYNTAX_COMMENT_MASK_END (table,
|
|
954 BUF_FETCH_CHAR (buf, from - 1),
|
|
955 c);
|
|
956 from--;
|
|
957 }
|
|
958
|
|
959 if (SYNTAX_PREFIX_UNSAFE (table, c))
|
|
960 continue;
|
|
961
|
|
962 switch (((quoted) ? Sword : code))
|
|
963 {
|
|
964 case Sword:
|
|
965 case Sextword:
|
|
966 case Ssymbol:
|
|
967 if (depth || !sexpflag) break;
|
|
968 /* This word counts as a sexp; count object finished after
|
|
969 passing it. */
|
|
970 while (from > stop)
|
|
971 {
|
|
972 enum syntaxcode syncode;
|
|
973 quoted = char_quoted (buf, from - 1);
|
|
974
|
|
975 if (quoted)
|
|
976 from--;
|
|
977 if (! (quoted
|
|
978 || (syncode =
|
|
979 SYNTAX (table, BUF_FETCH_CHAR (buf, from - 1)))
|
|
980 == Sword
|
|
981 || syncode == Sextword
|
|
982 || syncode == Ssymbol
|
|
983 || syncode == Squote))
|
|
984 goto done2;
|
|
985 from--;
|
|
986 }
|
|
987 goto done2;
|
|
988
|
|
989 case Smath:
|
|
990 if (!sexpflag)
|
|
991 break;
|
|
992 if (from != stop && c == BUF_FETCH_CHAR (buf, from - 1))
|
|
993 from--;
|
|
994 if (mathexit)
|
|
995 {
|
|
996 mathexit = 0;
|
|
997 goto open2;
|
|
998 }
|
|
999 mathexit = 1;
|
|
1000
|
|
1001 case Sclose:
|
|
1002 if (!++depth) goto done2;
|
|
1003 break;
|
|
1004
|
|
1005 case Sopen:
|
|
1006 open2:
|
|
1007 if (!--depth) goto done2;
|
|
1008 if (depth < min_depth)
|
|
1009 {
|
|
1010 if (no_error)
|
|
1011 return Qnil;
|
|
1012 error ("Containing expression ends prematurely");
|
|
1013 }
|
|
1014 break;
|
|
1015
|
|
1016 case Sendcomment:
|
|
1017 if (parse_sexp_ignore_comments)
|
|
1018 from = find_start_of_comment (buf, from, stop, mask);
|
|
1019 break;
|
|
1020
|
|
1021 case Sstring:
|
|
1022 {
|
|
1023 /* XEmacs change: call syntax_match() on character */
|
|
1024 Emchar ch = BUF_FETCH_CHAR (buf, from);
|
|
1025 Lisp_Object stermobj = syntax_match (table, ch);
|
|
1026 Emchar stringterm;
|
|
1027
|
|
1028 if (CHARP (stermobj))
|
|
1029 stringterm = XCHAR (stermobj);
|
|
1030 else
|
|
1031 stringterm = ch;
|
|
1032
|
|
1033 while (1)
|
|
1034 {
|
|
1035 if (from == stop) goto lose;
|
|
1036 if (!char_quoted (buf, from - 1)
|
|
1037 && stringterm == BUF_FETCH_CHAR (buf, from - 1))
|
|
1038 break;
|
|
1039 from--;
|
|
1040 }
|
|
1041 from--;
|
|
1042 if (!depth && sexpflag) goto done2;
|
|
1043 break;
|
|
1044 }
|
|
1045 }
|
|
1046 }
|
|
1047
|
|
1048 /* Reached start of buffer. Error if within object,
|
|
1049 return nil if between */
|
|
1050 if (depth) goto lose;
|
|
1051
|
|
1052 return Qnil;
|
|
1053
|
|
1054 done2:
|
|
1055 count++;
|
|
1056 }
|
|
1057
|
|
1058
|
|
1059 return (make_int (from));
|
|
1060
|
|
1061 lose:
|
|
1062 if (!no_error)
|
|
1063 error ("Unbalanced parentheses");
|
|
1064 return Qnil;
|
|
1065 }
|
|
1066
|
|
1067 int
|
|
1068 char_quoted (struct buffer *buf, Bufpos pos)
|
|
1069 {
|
|
1070 enum syntaxcode code;
|
|
1071 Bufpos beg = BUF_BEGV (buf);
|
|
1072 int quoted = 0;
|
|
1073 Lisp_Object table = buf->syntax_table;
|
|
1074
|
|
1075 while (pos > beg
|
|
1076 && ((code = SYNTAX (table, BUF_FETCH_CHAR (buf, pos - 1)))
|
|
1077 == Scharquote
|
|
1078 || code == Sescape))
|
|
1079 pos--, quoted = !quoted;
|
|
1080 return quoted;
|
|
1081 }
|
|
1082
|
20
|
1083 DEFUN ("scan-lists", Fscan_lists, 3, 5, 0, /*
|
0
|
1084 Scan from character number FROM by COUNT lists.
|
|
1085 Returns the character number of the position thus found.
|
|
1086
|
|
1087 If DEPTH is nonzero, paren depth begins counting from that value,
|
|
1088 only places where the depth in parentheses becomes zero
|
|
1089 are candidates for stopping; COUNT such places are counted.
|
|
1090 Thus, a positive value for DEPTH means go out levels.
|
|
1091
|
|
1092 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
|
|
1093
|
|
1094 If the beginning or end of (the accessible part of) the buffer is reached
|
|
1095 and the depth is wrong, an error is signaled.
|
|
1096 If the depth is right but the count is not used up, nil is returned.
|
|
1097
|
|
1098 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
|
|
1099 of in the current buffer.
|
|
1100
|
|
1101 If optional arg NOERROR is non-nil, scan-lists will return nil instead of
|
|
1102 signalling an error.
|
20
|
1103 */
|
|
1104 (from, count, depth, buffer, no_error))
|
0
|
1105 {
|
|
1106 struct buffer *buf;
|
|
1107
|
|
1108 CHECK_INT (from);
|
|
1109 CHECK_INT (count);
|
|
1110 CHECK_INT (depth);
|
|
1111 buf = decode_buffer (buffer, 0);
|
|
1112
|
|
1113 return scan_lists (buf, XINT (from), XINT (count), XINT (depth), 0,
|
|
1114 !NILP (no_error));
|
|
1115 }
|
|
1116
|
20
|
1117 DEFUN ("scan-sexps", Fscan_sexps, 2, 4, 0, /*
|
0
|
1118 Scan from character number FROM by COUNT balanced expressions.
|
|
1119 If COUNT is negative, scan backwards.
|
|
1120 Returns the character number of the position thus found.
|
|
1121
|
|
1122 Comments are ignored if `parse-sexp-ignore-comments' is non-nil.
|
|
1123
|
|
1124 If the beginning or end of (the accessible part of) the buffer is reached
|
|
1125 in the middle of a parenthetical grouping, an error is signaled.
|
|
1126 If the beginning or end is reached between groupings
|
|
1127 but before count is used up, nil is returned.
|
|
1128
|
|
1129 If optional arg BUFFER is non-nil, scanning occurs in that buffer instead
|
|
1130 of in the current buffer.
|
|
1131
|
|
1132 If optional arg NOERROR is non-nil, scan-sexps will return nil instead of
|
|
1133 signalling an error.
|
20
|
1134 */
|
|
1135 (from, count, buffer, no_error))
|
0
|
1136 {
|
|
1137 struct buffer *buf = decode_buffer (buffer, 0);
|
|
1138 CHECK_INT (from);
|
|
1139 CHECK_INT (count);
|
|
1140
|
|
1141 return scan_lists (buf, XINT (from), XINT (count), 0, 1, !NILP (no_error));
|
|
1142 }
|
|
1143
|
20
|
1144 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, 0, 1, 0, /*
|
0
|
1145 Move point backward over any number of chars with prefix syntax.
|
|
1146 This includes chars with \"quote\" or \"prefix\" syntax (' or p).
|
|
1147
|
|
1148 Optional arg BUFFER defaults to the current buffer.
|
20
|
1149 */
|
|
1150 (buffer))
|
0
|
1151 {
|
|
1152 struct buffer *buf = decode_buffer (buffer, 0);
|
|
1153 Bufpos beg = BUF_BEGV (buf);
|
|
1154 Bufpos pos = BUF_PT (buf);
|
|
1155 Lisp_Object table = buf->syntax_table;
|
|
1156
|
|
1157 while (pos > beg && !char_quoted (buf, pos - 1)
|
|
1158 && (SYNTAX (table, BUF_FETCH_CHAR (buf, pos - 1)) == Squote
|
|
1159 || SYNTAX_PREFIX (table, BUF_FETCH_CHAR (buf, pos - 1))))
|
|
1160 pos--;
|
|
1161
|
|
1162 BUF_SET_PT (buf, pos);
|
|
1163
|
|
1164 return Qnil;
|
|
1165 }
|
|
1166
|
|
1167 /* Parse forward from FROM to END,
|
|
1168 assuming that FROM has state OLDSTATE (nil means FROM is start of function),
|
|
1169 and return a description of the state of the parse at END.
|
|
1170 If STOPBEFORE is nonzero, stop at the start of an atom.
|
|
1171 If COMMENTSTOP is nonzero, stop at the start of a comment. */
|
|
1172
|
|
1173 static void
|
|
1174 scan_sexps_forward (struct buffer *buf, struct lisp_parse_state *stateptr,
|
|
1175 Bufpos from, Bufpos end,
|
|
1176 int targetdepth, int stopbefore,
|
|
1177 Lisp_Object oldstate,
|
|
1178 int commentstop)
|
|
1179 {
|
|
1180 struct lisp_parse_state state;
|
|
1181
|
|
1182 enum syntaxcode code;
|
|
1183 struct level { int last, prev; };
|
|
1184 struct level levelstart[100];
|
|
1185 struct level *curlevel = levelstart;
|
|
1186 struct level *endlevel = levelstart + 100;
|
|
1187 int depth; /* Paren depth of current scanning location.
|
|
1188 level - levelstart equals this except
|
|
1189 when the depth becomes negative. */
|
|
1190 int mindepth; /* Lowest DEPTH value seen. */
|
|
1191 int start_quoted = 0; /* Nonzero means starting after a char quote */
|
|
1192 Lisp_Object table = buf->syntax_table;
|
|
1193 Lisp_Object tem;
|
|
1194 int mask; /* comment mask */
|
|
1195
|
|
1196 if (NILP (oldstate))
|
|
1197 {
|
|
1198 depth = 0;
|
|
1199 state.instring = -1;
|
|
1200 state.incomment = 0;
|
|
1201 state.comstyle = 0; /* comment style a by default */
|
|
1202 mask = SYNTAX_COMMENT_STYLE_A;
|
|
1203 }
|
|
1204 else
|
|
1205 {
|
|
1206 tem = Fcar (oldstate); /* elt 0, depth */
|
|
1207 if (!NILP (tem))
|
|
1208 depth = XINT (tem);
|
|
1209 else
|
|
1210 depth = 0;
|
|
1211
|
|
1212 oldstate = Fcdr (oldstate);
|
|
1213 oldstate = Fcdr (oldstate);
|
|
1214 oldstate = Fcdr (oldstate);
|
|
1215 tem = Fcar (oldstate); /* elt 3, instring */
|
|
1216 state.instring = !NILP (tem) ? XINT (tem) : -1;
|
|
1217
|
|
1218 oldstate = Fcdr (oldstate); /* elt 4, incomment */
|
|
1219 tem = Fcar (oldstate);
|
|
1220 state.incomment = !NILP (tem);
|
|
1221
|
|
1222 oldstate = Fcdr (oldstate);
|
|
1223 tem = Fcar (oldstate); /* elt 5, follows-quote */
|
|
1224 start_quoted = !NILP (tem);
|
|
1225
|
|
1226 /* if the eighth element of the list is nil, we are in comment style
|
|
1227 a. if it is non-nil, we are in comment style b */
|
|
1228 oldstate = Fcdr (oldstate);
|
|
1229 oldstate = Fcdr (oldstate);
|
|
1230 oldstate = Fcdr (oldstate);
|
|
1231 tem = Fcar (oldstate); /* elt 8, comment style a */
|
|
1232 state.comstyle = !NILP (tem);
|
|
1233 mask = state.comstyle ? SYNTAX_COMMENT_STYLE_B : SYNTAX_COMMENT_STYLE_A;
|
|
1234 }
|
|
1235 state.quoted = 0;
|
|
1236 mindepth = depth;
|
|
1237
|
|
1238 curlevel->prev = -1;
|
|
1239 curlevel->last = -1;
|
|
1240
|
|
1241 /* Enter the loop at a place appropriate for initial state. */
|
|
1242
|
|
1243 if (state.incomment) goto startincomment;
|
|
1244 if (state.instring >= 0)
|
|
1245 {
|
|
1246 if (start_quoted) goto startquotedinstring;
|
|
1247 goto startinstring;
|
|
1248 }
|
|
1249 if (start_quoted) goto startquoted;
|
|
1250
|
|
1251 while (from < end)
|
|
1252 {
|
|
1253 QUIT;
|
|
1254
|
|
1255 code = SYNTAX (table, BUF_FETCH_CHAR (buf, from));
|
|
1256 from++;
|
|
1257
|
|
1258 if (code == Scomment)
|
|
1259 {
|
|
1260 /* record the comment style we have entered so that only the
|
|
1261 comment-ender sequence (or single char) of the same style
|
|
1262 actually terminates the comment section. */
|
|
1263 mask = SYNTAX_COMMENT_1CHAR_MASK (table,
|
|
1264 BUF_FETCH_CHAR (buf, from-1));
|
|
1265 state.comstyle = (mask == SYNTAX_COMMENT_STYLE_B);
|
|
1266 state.comstart = from - 1;
|
|
1267 }
|
|
1268
|
|
1269 else if (from < end &&
|
|
1270 SYNTAX_START_P (table, BUF_FETCH_CHAR (buf, from-1),
|
|
1271 BUF_FETCH_CHAR (buf, from)))
|
|
1272 {
|
|
1273 /* Record the comment style we have entered so that only
|
|
1274 the comment-end sequence of the same style actually
|
|
1275 terminates the comment section. */
|
|
1276 code = Scomment;
|
|
1277 mask = SYNTAX_COMMENT_MASK_START (table,
|
|
1278 BUF_FETCH_CHAR (buf, from-1),
|
|
1279 BUF_FETCH_CHAR (buf, from));
|
|
1280 state.comstyle = (mask == SYNTAX_COMMENT_STYLE_B);
|
|
1281 state.comstart = from-1;
|
|
1282 from++;
|
|
1283 }
|
|
1284
|
|
1285 if (SYNTAX_PREFIX (table, BUF_FETCH_CHAR (buf, from - 1)))
|
|
1286 continue;
|
|
1287 switch (code)
|
|
1288 {
|
|
1289 case Sescape:
|
|
1290 case Scharquote:
|
|
1291 if (stopbefore) goto stop; /* this arg means stop at sexp start */
|
|
1292 curlevel->last = from - 1;
|
|
1293 startquoted:
|
|
1294 if (from == end) goto endquoted;
|
|
1295 from++;
|
|
1296 goto symstarted;
|
|
1297 /* treat following character as a word constituent */
|
|
1298 case Sword:
|
|
1299 case Sextword:
|
|
1300 case Ssymbol:
|
|
1301 if (stopbefore) goto stop; /* this arg means stop at sexp start */
|
|
1302 curlevel->last = from - 1;
|
|
1303 symstarted:
|
|
1304 while (from < end)
|
|
1305 {
|
|
1306 switch (SYNTAX (table, BUF_FETCH_CHAR (buf, from)))
|
|
1307 {
|
|
1308 case Scharquote:
|
|
1309 case Sescape:
|
|
1310 from++;
|
|
1311 if (from == end) goto endquoted;
|
|
1312 break;
|
|
1313 case Sword:
|
|
1314 case Sextword:
|
|
1315 case Ssymbol:
|
|
1316 case Squote:
|
|
1317 break;
|
|
1318 default:
|
|
1319 goto symdone;
|
|
1320 }
|
|
1321 from++;
|
|
1322 }
|
|
1323 symdone:
|
|
1324 curlevel->prev = curlevel->last;
|
|
1325 break;
|
|
1326
|
|
1327 case Scomment:
|
|
1328 state.incomment = 1;
|
|
1329 startincomment:
|
|
1330 if (commentstop)
|
|
1331 goto done;
|
|
1332 {
|
|
1333 Bufpos newfrom = find_end_of_comment (buf, from, end, mask);
|
|
1334 if (newfrom < 0)
|
|
1335 {
|
|
1336 /* we terminated search because from == end */
|
|
1337 from = end;
|
|
1338 goto done;
|
|
1339 }
|
|
1340 from = newfrom;
|
|
1341 }
|
|
1342 state.incomment = 0;
|
|
1343 state.comstyle = 0; /* reset the comment style */
|
|
1344 mask = 0;
|
|
1345 break;
|
|
1346
|
|
1347 case Sopen:
|
|
1348 if (stopbefore) goto stop; /* this arg means stop at sexp start */
|
|
1349 depth++;
|
|
1350 /* curlevel++->last ran into compiler bug on Apollo */
|
|
1351 curlevel->last = from - 1;
|
|
1352 if (++curlevel == endlevel)
|
|
1353 error ("Nesting too deep for parser");
|
|
1354 curlevel->prev = -1;
|
|
1355 curlevel->last = -1;
|
16
|
1356 if (targetdepth == depth) goto done;
|
0
|
1357 break;
|
|
1358
|
|
1359 case Sclose:
|
|
1360 depth--;
|
|
1361 if (depth < mindepth)
|
|
1362 mindepth = depth;
|
|
1363 if (curlevel != levelstart)
|
|
1364 curlevel--;
|
|
1365 curlevel->prev = curlevel->last;
|
16
|
1366 if (targetdepth == depth) goto done;
|
0
|
1367 break;
|
|
1368
|
|
1369 case Sstring:
|
|
1370 {
|
|
1371 Emchar ch;
|
|
1372 if (stopbefore) goto stop; /* this arg means stop at sexp start */
|
|
1373 curlevel->last = from - 1;
|
|
1374 /* XEmacs change: call syntax_match() on character */
|
|
1375 ch = BUF_FETCH_CHAR (buf, from - 1);
|
|
1376 {
|
|
1377 Lisp_Object stermobj = syntax_match (table, ch);
|
|
1378
|
|
1379 if (CHARP (stermobj))
|
|
1380 state.instring = XCHAR (stermobj);
|
|
1381 else
|
|
1382 state.instring = ch;
|
|
1383 }
|
|
1384 }
|
|
1385 startinstring:
|
|
1386 while (1)
|
|
1387 {
|
|
1388 if (from >= end) goto done;
|
|
1389 if (BUF_FETCH_CHAR (buf, from) == state.instring) break;
|
|
1390 switch (SYNTAX (table, BUF_FETCH_CHAR (buf, from)))
|
|
1391 {
|
|
1392 case Scharquote:
|
|
1393 case Sescape:
|
|
1394 {
|
|
1395 from++;
|
|
1396 startquotedinstring:
|
|
1397 if (from >= end) goto endquoted;
|
|
1398 break;
|
|
1399 }
|
|
1400 default:
|
|
1401 break;
|
|
1402 }
|
|
1403 from++;
|
|
1404 }
|
|
1405 state.instring = -1;
|
|
1406 curlevel->prev = curlevel->last;
|
|
1407 from++;
|
|
1408 break;
|
|
1409
|
|
1410 case Smath:
|
|
1411 break;
|
|
1412
|
|
1413 case Swhitespace:
|
|
1414 case Spunct:
|
|
1415 case Squote:
|
|
1416 case Sendcomment:
|
|
1417 case Sinherit:
|
|
1418 case Smax:
|
|
1419 break;
|
|
1420 }
|
|
1421 }
|
|
1422 goto done;
|
|
1423
|
|
1424 stop: /* Here if stopping before start of sexp. */
|
|
1425 from--; /* We have just fetched the char that starts it; */
|
|
1426 goto done; /* but return the position before it. */
|
|
1427
|
|
1428 endquoted:
|
|
1429 state.quoted = 1;
|
|
1430 done:
|
|
1431 state.depth = depth;
|
|
1432 state.mindepth = mindepth;
|
|
1433 state.thislevelstart = curlevel->prev;
|
|
1434 state.prevlevelstart
|
|
1435 = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
|
|
1436 state.location = from;
|
|
1437
|
|
1438 *stateptr = state;
|
|
1439 }
|
|
1440
|
20
|
1441 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, 2, 7, 0, /*
|
0
|
1442 Parse Lisp syntax starting at FROM until TO; return status of parse at TO.
|
|
1443 Parsing stops at TO or when certain criteria are met;
|
|
1444 point is set to where parsing stops.
|
|
1445 If fifth arg STATE is omitted or nil,
|
|
1446 parsing assumes that FROM is the beginning of a function.
|
|
1447 Value is a list of eight elements describing final state of parsing:
|
|
1448 0. depth in parens.
|
|
1449 1. character address of start of innermost containing list; nil if none.
|
|
1450 2. character address of start of last complete sexp terminated.
|
|
1451 3. non-nil if inside a string.
|
|
1452 (It is the character that will terminate the string.)
|
|
1453 4. t if inside a comment.
|
|
1454 5. t if following a quote character.
|
|
1455 6. the minimum paren-depth encountered during this scan.
|
|
1456 7. nil if in comment style a, or not in a comment; t if in comment style b
|
|
1457 If third arg TARGETDEPTH is non-nil, parsing stops if the depth
|
|
1458 in parentheses becomes equal to TARGETDEPTH.
|
|
1459 Fourth arg STOPBEFORE non-nil means stop when come to
|
|
1460 any character that starts a sexp.
|
|
1461 Fifth arg STATE is an eight-element list like what this function returns.
|
|
1462 It is used to initialize the state of the parse. Its second and third
|
|
1463 elements are ignored.
|
|
1464 Sixth arg COMMENTSTOP non-nil means stop at the start of a comment.
|
20
|
1465 */
|
|
1466 (from, to, targetdepth, stopbefore, oldstate, commentstop, buffer))
|
0
|
1467 {
|
|
1468 struct lisp_parse_state state;
|
|
1469 int target;
|
|
1470 Bufpos start, end;
|
|
1471 struct buffer *buf = decode_buffer (buffer, 0);
|
|
1472
|
|
1473 if (!NILP (targetdepth))
|
|
1474 {
|
|
1475 CHECK_INT (targetdepth);
|
|
1476 target = XINT (targetdepth);
|
|
1477 }
|
|
1478 else
|
|
1479 target = -100000; /* We won't reach this depth */
|
|
1480
|
|
1481 get_buffer_range_char (buf, from, to, &start, &end, 0);
|
|
1482 scan_sexps_forward (buf, &state, start, end,
|
|
1483 target, !NILP (stopbefore), oldstate,
|
|
1484 !NILP (commentstop));
|
|
1485
|
|
1486 BUF_SET_PT (buf, state.location);
|
|
1487
|
|
1488 {
|
|
1489 /*
|
|
1490 * This junk is necessary because of a bug in SparcWorks cc 2.0.1. It
|
|
1491 * doesn't handle functions as arguments to other functions very well.
|
|
1492 */
|
|
1493 Lisp_Object retval[8];
|
|
1494
|
|
1495 retval[0] = make_int (state.depth);
|
|
1496 retval[1] = ((state.prevlevelstart < 0) ? Qnil :
|
|
1497 make_int (state.prevlevelstart));
|
|
1498 retval[2] = ((state.thislevelstart < 0) ? Qnil :
|
|
1499 make_int (state.thislevelstart));
|
|
1500 retval[3] = ((state.instring >= 0) ? make_int (state.instring) : Qnil);
|
|
1501 retval[4] = ((state.incomment) ? Qt : Qnil);
|
|
1502 retval[5] = ((state.quoted) ? Qt : Qnil);
|
|
1503 retval[6] = make_int (state.mindepth);
|
|
1504 retval[7] = ((state.comstyle) ? Qt : Qnil);
|
|
1505
|
|
1506 return (Flist (8, retval));
|
|
1507 }
|
|
1508 }
|
|
1509
|
|
1510
|
|
1511 /************************************************************************/
|
|
1512 /* initialization */
|
|
1513 /************************************************************************/
|
|
1514
|
|
1515 void
|
|
1516 syms_of_syntax (void)
|
|
1517 {
|
|
1518 defsymbol (&Qsyntax_table_p, "syntax-table-p");
|
|
1519
|
20
|
1520 DEFSUBR (Fsyntax_table_p);
|
|
1521 DEFSUBR (Fsyntax_table);
|
|
1522 DEFSUBR (Fstandard_syntax_table);
|
|
1523 DEFSUBR (Fcopy_syntax_table);
|
|
1524 DEFSUBR (Fset_syntax_table);
|
|
1525 DEFSUBR (Fsyntax_designator_chars);
|
|
1526 DEFSUBR (Fchar_syntax);
|
|
1527 DEFSUBR (Fmatching_paren);
|
|
1528 /* DEFSUBR (Fmodify_syntax_entry); now in Lisp. */
|
|
1529 /* DEFSUBR (Fdescribe_syntax); now in Lisp. */
|
0
|
1530
|
20
|
1531 DEFSUBR (Fforward_word);
|
0
|
1532
|
20
|
1533 DEFSUBR (Fforward_comment);
|
|
1534 DEFSUBR (Fscan_lists);
|
|
1535 DEFSUBR (Fscan_sexps);
|
|
1536 DEFSUBR (Fbackward_prefix_chars);
|
|
1537 DEFSUBR (Fparse_partial_sexp);
|
0
|
1538 }
|
|
1539
|
|
1540 void
|
|
1541 vars_of_syntax (void)
|
|
1542 {
|
|
1543 DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments /*
|
|
1544 Non-nil means `forward-sexp', etc., should treat comments as whitespace.
|
|
1545 */ );
|
|
1546
|
|
1547 words_include_escapes = 0;
|
|
1548 DEFVAR_BOOL ("words-include-escapes", &words_include_escapes /*
|
|
1549 Non-nil means `forward-word', etc., should treat escape chars part of words.
|
|
1550 */ );
|
|
1551
|
|
1552 no_quit_in_re_search = 0;
|
|
1553 }
|
|
1554
|
|
1555 void
|
|
1556 complex_vars_of_syntax (void)
|
|
1557 {
|
|
1558 struct Lisp_Vector *v;
|
|
1559 int i;
|
|
1560
|
|
1561 /* Set this now, so first buffer creation can refer to it. */
|
|
1562 /* Make it nil before calling copy-syntax-table
|
|
1563 so that copy-syntax-table will know not to try to copy from garbage */
|
|
1564 Vstandard_syntax_table = Qnil;
|
|
1565 Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
|
|
1566 staticpro (&Vstandard_syntax_table);
|
|
1567
|
|
1568 Vsyntax_designator_chars_string = make_pure_string (syntax_code_spec,
|
|
1569 Smax, Qnil, 1);
|
|
1570 staticpro (&Vsyntax_designator_chars_string);
|
|
1571
|
|
1572 v = XVECTOR (Vstandard_syntax_table);
|
|
1573
|
|
1574 for (i = 'a'; i <= 'z'; i++)
|
|
1575 v->contents[i] = make_int ((int) Sword);
|
|
1576 for (i = 'A'; i <= 'Z'; i++)
|
|
1577 v->contents[i] = make_int ((int) Sword);
|
|
1578 for (i = '0'; i <= '9'; i++)
|
|
1579 v->contents[i] = make_int ((int) Sword);
|
|
1580 v->contents['$'] = make_int ((int) Sword);
|
|
1581 v->contents['%'] = make_int ((int) Sword);
|
|
1582
|
|
1583 v->contents['('] = make_int ((int) Sopen + (')' << 8));
|
|
1584 v->contents[')'] = make_int ((int) Sclose + ('(' << 8));
|
|
1585 v->contents['['] = make_int ((int) Sopen + (']' << 8));
|
|
1586 v->contents[']'] = make_int ((int) Sclose + ('[' << 8));
|
|
1587 v->contents['{'] = make_int ((int) Sopen + ('}' << 8));
|
|
1588 v->contents['}'] = make_int ((int) Sclose + ('{' << 8));
|
|
1589 v->contents['"'] = make_int ((int) Sstring);
|
|
1590 v->contents['\\'] = make_int ((int) Sescape);
|
|
1591
|
|
1592 {
|
|
1593 CONST char *p;
|
|
1594
|
|
1595 for (p = "_-+*/&|<>="; *p; p++)
|
|
1596 v->contents[(int) *p] = make_int ((int) Ssymbol);
|
|
1597
|
|
1598 for (p = ".,;:?!#@~^'`"; *p; p++)
|
|
1599 v->contents[(int) *p] = make_int ((int) Spunct);
|
|
1600 }
|
|
1601 }
|