![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to syntax.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Apple XNU] / GNUtools / emacs / src|
Return to syntax.c CVS log | Up to [Apple XNU] / GNUtools / emacs / src |
1.1 root 1: /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
2: Copyright (C) 1985, 1987, 1990 Free Software Foundation, Inc.
3:
4: This file is part of GNU Emacs.
5:
6: GNU Emacs is free software; you can redistribute it and/or modify
7: it under the terms of the GNU General Public License as published by
8: the Free Software Foundation; either version 1, or (at your option)
9: any later version.
10:
11: GNU Emacs is distributed in the hope that it will be useful,
12: but WITHOUT ANY WARRANTY; without even the implied warranty of
13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: GNU General Public License for more details.
15:
16: You should have received a copy of the GNU General Public License
17: along with GNU Emacs; see the file COPYING. If not, write to
18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19:
20:
21: #include "config.h"
22: #include <ctype.h>
23: #include "lisp.h"
24: #include "commands.h"
25: #include "buffer.h"
26: #include "syntax.h"
27:
28: Lisp_Object Qsyntax_table_p;
29:
30: DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0,
31: "Return t if ARG is a syntax table.\n\
32: Any vector of 256 elements will do.")
33: (obj)
34: Lisp_Object obj;
35: {
36: if (XTYPE (obj) == Lisp_Vector && XVECTOR (obj)->size == 0400)
37: return Qt;
38: return Qnil;
39: }
40:
41: Lisp_Object
42: check_syntax_table (obj)
43: Lisp_Object obj;
44: {
45: register Lisp_Object tem;
46: while (tem = Fsyntax_table_p (obj),
47: NULL (tem))
48: obj = wrong_type_argument (Qsyntax_table_p, obj, 0);
49: return obj;
50: }
51:
52:
53: DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0,
54: "Return the current syntax table.\n\
55: This is the one specified by the current buffer.")
56: ()
57: {
58: return current_buffer->syntax_table;
59: }
60:
61: DEFUN ("standard-syntax-table", Fstandard_syntax_table,
62: Sstandard_syntax_table, 0, 0, 0,
63: "Return the standard syntax table.\n\
64: This is the one used for new buffers.")
65: ()
66: {
67: return Vstandard_syntax_table;
68: }
69:
70: DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0,
71: "Construct a new syntax table and return it.\n\
72: It is a copy of the TABLE, which defaults to the standard syntax table.")
73: (table)
74: Lisp_Object table;
75: {
76: Lisp_Object size, val;
77: XFASTINT (size) = 0400;
78: XFASTINT (val) = 0;
79: val = Fmake_vector (size, val);
80: if (!NULL (table))
81: table = check_syntax_table (table);
82: else if (NULL (Vstandard_syntax_table))
83: /* Can only be null during initialization */
84: return val;
85: else table = Vstandard_syntax_table;
86:
87: bcopy (XVECTOR (table)->contents,
88: XVECTOR (val)->contents, 0400 * sizeof (Lisp_Object));
89: return val;
90: }
91:
92: DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0,
93: "Select a new syntax table for the current buffer.\n\
94: One argument, a syntax table.")
95: (table)
96: Lisp_Object table;
97: {
98: table = check_syntax_table (table);
99: current_buffer->syntax_table = table;
100: /* Indicate that this buffer now has a specified syntax table. */
101: current_buffer->local_var_flags |= buffer_local_flags.syntax_table;
102: return table;
103: }
104:
105: /* Convert a letter which signifies a syntax code
106: into the code it signifies.
107: This is used by modify-syntax-entry, and other things. */
108:
109: unsigned char syntax_spec_code[0400] =
110: { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
111: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
112: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
113: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
114: (char) Swhitespace, 0377, (char) Sstring, 0377,
115: (char) Smath, 0377, 0377, (char) Squote,
116: (char) Sopen, (char) Sclose, 0377, 0377,
117: 0377, (char) Swhitespace, (char) Spunct, (char) Scharquote,
118: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
119: 0377, 0377, 0377, 0377,
120: (char) Scomment, 0377, (char) Sendcomment, 0377,
121: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* @, A, ... */
122: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
123: 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
124: 0377, 0377, 0377, 0377, (char) Sescape, 0377, 0377, (char) Ssymbol,
125: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, /* `, a, ... */
126: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
127: 0377, 0377, 0377, 0377, 0377, 0377, 0377, (char) Sword,
128: 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377
129: };
130:
131: /* Indexed by syntax code, give the letter that describes it. */
132:
133: char syntax_code_spec[13] =
134: {
135: ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>'
136: };
137:
138: DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0,
139: "Return the syntax code of CHAR, described by a character.\n\
140: For example, if CHAR is a word constituent, ?w is returned.\n\
141: The characters that correspond to various syntax codes\n\
142: are listed in the documentation of modify-syntax-entry.")
143: (ch)
144: Lisp_Object ch;
145: {
146: CHECK_NUMBER (ch, 0);
147: return make_number (syntax_code_spec[(int) SYNTAX (0xFF & XINT (ch))]);
148: }
149:
150: /* This comment supplies the doc string for modify-syntax-entry,
151: for make-docfile to see. We cannot put this in the real DEFUN
152: due to limits in the Unix cpp.
153:
154: DEFUN ("modify-syntax-entry", foo, bar, 0, 0, 0,
155: "Set syntax for character CHAR according to string S.\n\
156: The syntax is changed only for table TABLE, which defaults to\n\
157: the current buffer's syntax table.\n\
158: The first character of S should be one of the following:\n\
159: Space or - whitespace syntax. w word constituent.\n\
160: _ symbol constituent. . punctuation.\n\
161: ( open-parenthesis. ) close-parenthesis.\n\
162: \" string quote. \\ escape character.\n\
163: $ paired delimiter. ' expression prefix operator.\n\
164: < comment starter. > comment ender.\n\
165: / character quote.\n\
166: Only single-character comment start and end sequences are represented thus.\n\
167: Two-character sequences are represented as described below.\n\
168: The second character of S is the matching parenthesis,\n\
169: used only if the first character is ( or ).\n\
170: Any additional characters are flags.\n\
171: Defined flags are the characters 1, 2, 3 and 4.\n\
172: 1 means C is the start of a two-char comment start sequence.\n\
173: 2 means C is the second character of such a sequence.\n\
174: 3 means C is the start of a two-char comment end sequence.\n\
175: 4 means C is the second character of such a sequence.")
176:
177: */
178:
179: DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3,
180: /* I really don't know why this is interactive
181: help-form should at least be made useful whilst reading the second arg
182: */
183: "cSet syntax for character: \nsSet syntax for %s to: ",
184: 0 /* See immediately above */)
185: (c, newentry, syntax_table)
186: Lisp_Object c, newentry, syntax_table;
187: {
188: register unsigned char *p, match;
189: register enum syntaxcode code;
190: Lisp_Object val;
191:
192: CHECK_NUMBER (c, 0);
193: CHECK_STRING (newentry, 1);
194: if (NULL (syntax_table))
195: syntax_table = current_buffer->syntax_table;
196: else
197: syntax_table = check_syntax_table (syntax_table);
198:
199: p = XSTRING (newentry)->data;
200: code = (enum syntaxcode) syntax_spec_code[*p++];
201: if (((int) code & 0377) == 0377)
202: error ("invalid syntax description letter: %c", c);
203:
204: match = *p;
205: if (match) p++;
206: if (match == ' ') match = 0;
207:
208: XFASTINT (val) = (match << 8) + (int) code;
209: while (*p)
210: switch (*p++)
211: {
212: case '1':
213: XFASTINT (val) |= 1 << 16;
214: break;
215:
216: case '2':
217: XFASTINT (val) |= 1 << 17;
218: break;
219:
220: case '3':
221: XFASTINT (val) |= 1 << 18;
222: break;
223:
224: case '4':
225: XFASTINT (val) |= 1 << 19;
226: break;
227: }
228:
229: XVECTOR (syntax_table)->contents[0xFF & XINT (c)] = val;
230:
231: return Qnil;
232: }
233:
234: /* Dump syntax table to buffer in human-readable format */
235:
236: describe_syntax (value)
237: Lisp_Object value;
238: {
239: register enum syntaxcode code;
240: char desc, match, start1, start2, end1, end2;
241: char str[2];
242:
243: Findent_to (make_number (16), make_number (1));
244:
245: if (XTYPE (value) != Lisp_Int)
246: {
247: InsStr ("invalid");
248: return;
249: }
250:
251: code = (enum syntaxcode) (XINT (value) & 0377);
252: match = (XINT (value) >> 8) & 0377;
253: start1 = (XINT (value) >> 16) & 1;
254: start2 = (XINT (value) >> 17) & 1;
255: end1 = (XINT (value) >> 18) & 1;
256: end2 = (XINT (value) >> 19) & 1;
257:
258: if ((int) code < 0 || (int) code >= (int) Smax)
259: {
260: InsStr ("invalid");
261: return;
262: }
263: desc = syntax_code_spec[(int) code];
264:
265: str[0] = desc, str[1] = 0;
266: insert (str, 1);
267:
268: str[0] = match ? match : ' ';
269: insert (str, 1);
270:
271:
272: if (start1)
273: insert ("1", 1);
274: if (start2)
275: insert ("2", 1);
276:
277: if (end1)
278: insert ("3", 1);
279: if (end2)
280: insert ("4", 1);
281:
282: InsStr ("\twhich means: ");
283:
284: #ifdef SWITCH_ENUM_BUG
285: switch ((int) code)
286: #else
287: switch (code)
288: #endif
289: {
290: case Swhitespace:
291: InsStr ("whitespace"); break;
292: case Spunct:
293: InsStr ("punctuation"); break;
294: case Sword:
295: InsStr ("word"); break;
296: case Ssymbol:
297: InsStr ("symbol"); break;
298: case Sopen:
299: InsStr ("open"); break;
300: case Sclose:
301: InsStr ("close"); break;
302: case Squote:
303: InsStr ("quote"); break;
304: case Sstring:
305: InsStr ("string"); break;
306: case Smath:
307: InsStr ("math"); break;
308: case Sescape:
309: InsStr ("escape"); break;
310: case Scharquote:
311: InsStr ("charquote"); break;
312: case Scomment:
313: InsStr ("comment"); break;
314: case Sendcomment:
315: InsStr ("endcomment"); break;
316: default:
317: InsStr ("invalid");
318: return;
319: }
320:
321: if (match)
322: {
323: InsStr (", matches ");
324:
325: str[0] = match, str[1] = 0;
326: insert (str, 1);
327: }
328:
329: if (start1)
330: InsStr (",\n\t is the first character of a comment-start sequence");
331: if (start2)
332: InsStr (",\n\t is the second character of a comment-start sequence");
333:
334: if (end1)
335: InsStr (",\n\t is the first character of a comment-end sequence");
336: if (end2)
337: InsStr (",\n\t is the second character of a comment-end sequence");
338:
339: InsStr ("\n");
340: }
341:
342: Lisp_Object
343: describe_syntax_1 (vector)
344: Lisp_Object vector;
345: {
346: struct buffer *old = current_buffer;
347: set_buffer_internal (XBUFFER (Vstandard_output));
348: describe_vector (vector, Qnil, describe_syntax, 0, Qnil);
349: set_buffer_internal (old);
350: return Qnil;
351: }
352:
353: DEFUN ("describe-syntax", Fdescribe_syntax, Sdescribe_syntax, 0, 0, "",
354: "Describe the syntax specifications in the syntax table.\n\
355: The descriptions are inserted in a buffer, which is selected so you can see it.")
356: ()
357: {
358: internal_with_output_to_temp_buffer
359: ("*Help*", describe_syntax_1, current_buffer->syntax_table);
360:
361: return Qnil;
362: }
363:
364: /* Return the position across `count' words from `from'.
365: If that many words cannot be found before the end of the buffer, return 0.
366: `count' negative means scan backward and stop at word beginning. */
367:
368: scan_words (from, count)
369: register int from, count;
370: {
371: register int beg = BEGV;
372: register int end = ZV;
373:
374: immediate_quit = 1;
375: QUIT;
376:
377: while (count > 0)
378: {
379: while (1)
380: {
381: if (from == end)
382: {
383: immediate_quit = 0;
384: return 0;
385: }
386: if (SYNTAX(FETCH_CHAR (from)) == Sword)
387: break;
388: from++;
389: }
390: while (1)
391: {
392: if (from == end) break;
393: if (SYNTAX(FETCH_CHAR (from)) != Sword)
394: break;
395: from++;
396: }
397: count--;
398: }
399: while (count < 0)
400: {
401: while (1)
402: {
403: if (from == beg)
404: {
405: immediate_quit = 0;
406: return 0;
407: }
408: if (SYNTAX(FETCH_CHAR (from - 1)) == Sword)
409: break;
410: from--;
411: }
412: while (1)
413: {
414: if (from == beg) break;
415: if (SYNTAX(FETCH_CHAR (from - 1)) != Sword)
416: break;
417: from--;
418: }
419: count++;
420: }
421:
422: immediate_quit = 0;
423:
424: return from;
425: }
426:
427: DEFUN ("forward-word", Fforward_word, Sforward_word, 1, 1, "p",
428: "Move point forward ARG words (backward if ARG is negative).\n\
429: Normally returns t.\n\
430: If an edge of the buffer is reached, point is left there\n\
431: and nil is returned.")
432: (count)
433: Lisp_Object count;
434: {
435: int val;
436: CHECK_NUMBER (count, 0);
437:
438: if (!(val = scan_words (point, XINT (count))))
439: {
440: SET_PT (XINT (count) > 0 ? ZV : BEGV);
441: return Qnil;
442: }
443: SET_PT (val);
444: return Qt;
445: }
446:
447: int parse_sexp_ignore_comments;
448:
449: Lisp_Object
450: scan_lists (from, count, depth, sexpflag)
451: register int from;
452: int count, depth, sexpflag;
453: {
454: Lisp_Object val;
455: register int stop;
456: register int c;
457: char stringterm;
458: int quoted;
459: int mathexit = 0;
460: register enum syntaxcode code;
461: int min_depth = depth; /* Err out if depth gets less than this. */
462:
463: if (depth > 0) min_depth = 0;
464:
465: immediate_quit = 1;
466: QUIT;
467:
468: while (count > 0)
469: {
470: stop = ZV;
471: while (from < stop)
472: {
473: c = FETCH_CHAR (from);
474: code = SYNTAX(c);
475: from++;
476: if (from < stop && SYNTAX_COMSTART_FIRST (c)
477: && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from))
478: && parse_sexp_ignore_comments)
479: code = Scomment, from++;
480:
481: #ifdef SWITCH_ENUM_BUG
482: switch ((int) code)
483: #else
484: switch (code)
485: #endif
486: {
487: case Sescape:
488: case Scharquote:
489: if (from == stop) goto lose;
490: from++;
491: /* treat following character as a word constituent */
492: case Sword:
493: case Ssymbol:
494: if (depth || !sexpflag) break;
495: /* This word counts as a sexp; return at end of it. */
496: while (from < stop)
497: {
498: #ifdef SWITCH_ENUM_BUG
499: switch ((int) SYNTAX(FETCH_CHAR (from)))
500: #else
501: switch (SYNTAX(FETCH_CHAR (from)))
502: #endif
503: {
504: case Scharquote:
505: case Sescape:
506: from++;
507: if (from == stop) goto lose;
508: break;
509: case Sword:
510: case Ssymbol:
511: case Squote:
512: break;
513: default:
514: goto done;
515: }
516: from++;
517: }
518: goto done;
519:
520: case Scomment:
521: if (!parse_sexp_ignore_comments) break;
522: while (1)
523: {
524: if (from == stop) goto done;
525: if (SYNTAX (c = FETCH_CHAR (from)) == Sendcomment)
526: break;
527: from++;
528: if (from < stop && SYNTAX_COMEND_FIRST (c)
529: && SYNTAX_COMEND_SECOND (FETCH_CHAR (from)))
530: { from++; break; }
531: }
532: break;
533:
534: case Smath:
535: if (!sexpflag)
536: break;
537: if (from != stop && c == FETCH_CHAR (from))
538: from++;
539: if (mathexit)
540: {
541: mathexit = 0;
542: goto close1;
543: }
544: mathexit = 1;
545:
546: case Sopen:
547: if (!++depth) goto done;
548: break;
549:
550: case Sclose:
551: close1:
552: if (!--depth) goto done;
553: if (depth < min_depth)
554: error ("Containing expression ends prematurely");
555: break;
556:
557: case Sstring:
558: stringterm = FETCH_CHAR (from - 1);
559: while (1)
560: {
561: if (from >= stop) goto lose;
562: if (FETCH_CHAR (from) == stringterm) break;
563: #ifdef SWITCH_ENUM_BUG
564: switch ((int) SYNTAX(FETCH_CHAR (from)))
565: #else
566: switch (SYNTAX(FETCH_CHAR (from)))
567: #endif
568: {
569: case Scharquote:
570: case Sescape:
571: from++;
572: }
573: from++;
574: }
575: from++;
576: if (!depth && sexpflag) goto done;
577: break;
578: }
579: }
580:
581: /* Reached end of buffer. Error if within object, return nil if between */
582: if (depth) goto lose;
583:
584: immediate_quit = 0;
585: return Qnil;
586:
587: /* End of object reached */
588: done:
589: count--;
590: }
591:
592: while (count < 0)
593: {
594: stop = BEGV;
595: while (from > stop)
596: {
597: from--;
598: if (quoted = char_quoted (from))
599: from--;
600: c = FETCH_CHAR (from);
601: code = SYNTAX (c);
602: if (from > stop && SYNTAX_COMEND_SECOND (c)
603: && SYNTAX_COMEND_FIRST (FETCH_CHAR (from - 1))
604: && !char_quoted (from - 1)
605: && parse_sexp_ignore_comments)
606: code = Sendcomment, from--;
607:
608: #ifdef SWITCH_ENUM_BUG
609: switch ((int) (quoted ? Sword : code))
610: #else
611: switch (quoted ? Sword : code)
612: #endif
613: {
614: case Sword:
615: case Ssymbol:
616: if (depth || !sexpflag) break;
617: /* This word counts as a sexp; count object finished after passing it. */
618: while (from > stop)
619: {
620: if (quoted = char_quoted (from - 1))
621: from--;
622: if (! (quoted || SYNTAX(FETCH_CHAR (from - 1)) == Sword ||
623: SYNTAX(FETCH_CHAR (from - 1)) == Ssymbol ||
624: SYNTAX(FETCH_CHAR (from - 1)) == Squote))
625: goto done2;
626: from--;
627: }
628: goto done2;
629:
630: case Smath:
631: if (!sexpflag)
632: break;
633: if (from != stop && c == FETCH_CHAR (from - 1))
634: from--;
635: if (mathexit)
636: {
637: mathexit = 0;
638: goto open2;
639: }
640: mathexit = 1;
641:
642: case Sclose:
643: if (!++depth) goto done2;
644: break;
645:
646: case Sopen:
647: open2:
648: if (!--depth) goto done2;
649: if (depth < min_depth)
650: error ("Containing expression ends prematurely");
651: break;
652:
653: case Sendcomment:
654: if (!parse_sexp_ignore_comments) break;
655: if (from != stop) from--;
656: while (1)
657: {
658: if (SYNTAX (c = FETCH_CHAR (from)) == Scomment)
659: break;
660: if (from == stop) goto done;
661: from--;
662: if (SYNTAX_COMSTART_SECOND (c)
663: && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from))
664: && !char_quoted (from))
665: break;
666: }
667: break;
668:
669: case Sstring:
670: stringterm = FETCH_CHAR (from);
671: while (1)
672: {
673: if (from == stop) goto lose;
674: if (!char_quoted (from - 1)
675: && stringterm == FETCH_CHAR (from - 1))
676: break;
677: from--;
678: }
679: from--;
680: if (!depth && sexpflag) goto done2;
681: break;
682: }
683: }
684:
685: /* Reached start of buffer. Error if within object, return nil if between */
686: if (depth) goto lose;
687:
688: immediate_quit = 0;
689: return Qnil;
690:
691: done2:
692: count++;
693: }
694:
695:
696: immediate_quit = 0;
697: XFASTINT (val) = from;
698: return val;
699:
700: lose:
701: error ("Unbalanced parentheses");
702: /* NOTREACHED */
703: }
704:
705: char_quoted (pos)
706: register int pos;
707: {
708: register enum syntaxcode code;
709: register int beg = BEGV;
710: register int quoted = 0;
711:
712: while (pos > beg &&
713: ((code = SYNTAX (FETCH_CHAR (pos - 1))) == Scharquote
714: || code == Sescape))
715: pos--, quoted = !quoted;
716: return quoted;
717: }
718:
719: DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
720: "Scan from character number FROM by COUNT lists.\n\
721: Returns the character number of the position thus found.\n\
722: \n\
723: If DEPTH is nonzero, paren depth begins counting from that value,\n\
724: only places where the depth in parentheses becomes zero\n\
725: are candidates for stopping; COUNT such places are counted.\n\
726: Thus, a positive value for DEPTH means go out levels.\n\
727: \n\
728: Comments are ignored if parse-sexp-ignore-comments is non-nil.\n\
729: \n\
730: If the beginning or end of (the visible part of) the buffer is reached\n\
731: and the depth is wrong, an error is signaled.\n\
732: If the depth is right but the count is not used up, nil is returned.")
733: (from, count, depth)
734: Lisp_Object from, count, depth;
735: {
736: CHECK_NUMBER (from, 0);
737: CHECK_NUMBER (count, 1);
738: CHECK_NUMBER (depth, 2);
739:
740: return scan_lists (XINT (from), XINT (count), XINT (depth), 0);
741: }
742:
743: DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0,
744: "Scan from character number FROM by COUNT balanced expressions.\n\
745: Returns the character number of the position thus found.\n\
746: \n\
747: Comments are ignored if parse-sexp-ignore-comments is non-nil.\n\
748: \n\
749: If the beginning or end of (the visible part of) the buffer is reached\n\
750: in the middle of a parenthetical grouping, an error is signaled.\n\
751: If the beginning or end is reached between groupings but before count is used up,\n\
752: nil is returned.")
753: (from, count)
754: Lisp_Object from, count;
755: {
756: CHECK_NUMBER (from, 0);
757: CHECK_NUMBER (count, 1);
758:
759: return scan_lists (XINT (from), XINT (count), 0, 1);
760: }
761:
762: DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars,
763: 0, 0, 0,
764: "Move point backward over any number of chars with syntax \"prefix\".")
765: ()
766: {
767: int beg = BEGV;
768: int pos = point;
769:
770: while (pos > beg && !char_quoted (pos - 1) && SYNTAX (FETCH_CHAR (pos - 1)) == Squote)
771: pos--;
772:
773: SET_PT (pos);
774:
775: return Qnil;
776: }
777:
778: struct lisp_parse_state
779: {
780: int depth; /* Depth at end of parsing */
781: int instring; /* -1 if not within string, else desired terminator. */
782: int incomment; /* Nonzero if within a comment at end of parsing */
783: int quoted; /* Nonzero if just after an escape char at end of parsing */
784: int thislevelstart; /* Char number of most recent start-of-expression at current level */
785: int prevlevelstart; /* Char number of start of containing expression */
786: int location; /* Char number at which parsing stopped. */
787: int mindepth; /* Minimum depth seen while scanning. */
788: };
789:
790: /* Parse forward from FROM to END,
791: assuming that FROM is the start of a function,
792: and return a description of the state of the parse at END. */
793:
794: struct lisp_parse_state val_scan_sexps_forward;
795:
796: struct lisp_parse_state *
797: scan_sexps_forward (from, end, targetdepth, stopbefore, oldstate)
798: register int from;
799: int end, targetdepth, stopbefore;
800: Lisp_Object oldstate;
801: {
802: struct lisp_parse_state state;
803:
804: register enum syntaxcode code;
805: struct level { int last, prev; };
806: struct level levelstart[100];
807: register struct level *curlevel = levelstart;
808: struct level *endlevel = levelstart + 100;
809: char prev;
810: register int depth; /* Paren depth of current scanning location.
811: level - levelstart equals this except
812: when the depth becomes negative. */
813: int mindepth; /* Lowest DEPTH value seen. */
814: int start_quoted = 0; /* Nonzero means starting after a char quote */
815: Lisp_Object tem;
816:
817: immediate_quit = 1;
818: QUIT;
819:
820: if (NULL (oldstate))
821: {
822: depth = 0;
823: state.instring = -1;
824: state.incomment = 0;
825: }
826: else
827: {
828: tem = Fcar (oldstate);
829: if (!NULL (tem))
830: depth = XINT (tem);
831: else
832: depth = 0;
833:
834: oldstate = Fcdr (oldstate);
835: oldstate = Fcdr (oldstate);
836: oldstate = Fcdr (oldstate);
837: tem = Fcar (oldstate);
838: state.instring = !NULL (tem) ? XINT (tem) : -1;
839:
840: oldstate = Fcdr (oldstate);
841: tem = Fcar (oldstate);
842: state.incomment = !NULL (tem);
843:
844: oldstate = Fcdr (oldstate);
845: tem = Fcar (oldstate);
846: start_quoted = !NULL (tem);
847: }
848: state.quoted = 0;
849: mindepth = depth;
850:
851: curlevel->prev = -1;
852: curlevel->last = -1;
853:
854: /* Enter the loop at a place appropriate for initial state. */
855:
856: if (state.incomment) goto startincomment;
857: if (state.instring >= 0)
858: {
859: if (start_quoted) goto startquotedinstring;
860: goto startinstring;
861: }
862: if (start_quoted) goto startquoted;
863:
864: while (from < end)
865: {
866: code = SYNTAX(FETCH_CHAR (from));
867: from++;
868: if (from < end && SYNTAX_COMSTART_FIRST (FETCH_CHAR (from - 1))
869: && SYNTAX_COMSTART_SECOND (FETCH_CHAR (from)))
870: code = Scomment, from++;
871: #ifdef SWITCH_ENUM_BUG
872: switch ((int) code)
873: #else
874: switch (code)
875: #endif
876: {
877: case Sescape:
878: case Scharquote:
879: if (stopbefore) goto stop; /* this arg means stop at sexp start */
880: curlevel->last = from - 1;
881: startquoted:
882: if (from == end) goto endquoted;
883: from++;
884: goto symstarted;
885: /* treat following character as a word constituent */
886: case Sword:
887: case Ssymbol:
888: if (stopbefore) goto stop; /* this arg means stop at sexp start */
889: curlevel->last = from - 1;
890: symstarted:
891: while (from < end)
892: {
893: #ifdef SWITCH_ENUM_BUG
894: switch ((int) SYNTAX(FETCH_CHAR (from)))
895: #else
896: switch (SYNTAX(FETCH_CHAR (from)))
897: #endif
898: {
899: case Scharquote:
900: case Sescape:
901: from++;
902: if (from == end) goto endquoted;
903: break;
904: case Sword:
905: case Ssymbol:
906: case Squote:
907: break;
908: default:
909: goto symdone;
910: }
911: from++;
912: }
913: symdone:
914: curlevel->prev = curlevel->last;
915: break;
916:
917: case Scomment:
918: state.incomment = 1;
919: startincomment:
920: while (1)
921: {
922: if (from == end) goto done;
923: if (SYNTAX (prev = FETCH_CHAR (from)) == Sendcomment)
924: break;
925: from++;
926: if (from < end && SYNTAX_COMEND_FIRST (prev)
927: && SYNTAX_COMEND_SECOND (FETCH_CHAR (from)))
928: { from++; break; }
929: }
930: state.incomment = 0;
931: break;
932:
933: case Sopen:
934: if (stopbefore) goto stop; /* this arg means stop at sexp start */
935: depth++;
936: /* curlevel++->last ran into compiler bug on Apollo */
937: curlevel->last = from - 1;
938: if (++curlevel == endlevel)
939: error ("Nesting too deep for parser");
940: curlevel->prev = -1;
941: curlevel->last = -1;
942: if (!--targetdepth) goto done;
943: break;
944:
945: case Sclose:
946: depth--;
947: if (depth < mindepth)
948: mindepth = depth;
949: if (curlevel != levelstart)
950: curlevel--;
951: curlevel->prev = curlevel->last;
952: if (!++targetdepth) goto done;
953: break;
954:
955: case Sstring:
956: if (stopbefore) goto stop; /* this arg means stop at sexp start */
957: curlevel->last = from - 1;
958: state.instring = FETCH_CHAR (from - 1);
959: startinstring:
960: while (1)
961: {
962: if (from >= end) goto done;
963: if (FETCH_CHAR (from) == state.instring) break;
964: #ifdef SWITCH_ENUM_BUG
965: switch ((int) SYNTAX(FETCH_CHAR (from)))
966: #else
967: switch (SYNTAX(FETCH_CHAR (from)))
968: #endif
969: {
970: case Scharquote:
971: case Sescape:
972: from++;
973: startquotedinstring:
974: if (from >= end) goto endquoted;
975: }
976: from++;
977: }
978: state.instring = -1;
979: curlevel->prev = curlevel->last;
980: from++;
981: break;
982:
983: case Smath:
984: break;
985: }
986: }
987: goto done;
988:
989: stop: /* Here if stopping before start of sexp. */
990: from--; /* We have just fetched the char that starts it; */
991: goto done; /* but return the position before it. */
992:
993: endquoted:
994: state.quoted = 1;
995: done:
996: state.depth = depth;
997: state.mindepth = mindepth;
998: state.thislevelstart = curlevel->prev;
999: state.prevlevelstart
1000: = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
1001: state.location = from;
1002: immediate_quit = 0;
1003:
1004: val_scan_sexps_forward = state;
1005: return &val_scan_sexps_forward;
1006: }
1007:
1008: /* This comment supplies the doc string for parse-partial-sexp,
1009: for make-docfile to see. We cannot put this in the real DEFUN
1010: due to limits in the Unix cpp.
1011:
1012: DEFUN ("parse-partial-sexp", Ffoo, Sfoo, 0, 0, 0,
1013: "Parse Lisp syntax starting at FROM until TO; return status of parse at TO.\n\
1014: Parsing stops at TO or when certain criteria are met;\n\
1015: point is set to where parsing stops.\n\
1016: If fifth arg STATE is omitted or nil,\n\
1017: parsing assumes that FROM is the beginning of a function.\n\
1018: Value is a list of seven elements describing final state of parsing:\n\
1019: 1. depth in parens.\n\
1020: 2. character address of start of innermost containing list; nil if none.\n\
1021: 3. character address of start of last complete sexp terminated.\n\
1022: 4. non-nil if inside a string.\n\
1023: (it is the character that will terminate the string.)\n\
1024: 5. t if inside a comment.\n\
1025: 6. t if following a quote character.\n\
1026: 7. the minimum paren-depth encountered during this scan.\n\
1027: If third arg TARGETDEPTH is non-nil, parsing stops if the depth\n\
1028: in parentheses becomes equal to TARGETDEPTH.\n\
1029: Fourth arg STOPBEFORE non-nil means stop when come to\n\
1030: any character that starts a sexp.\n\
1031: Fifth arg STATE is a seven-list like what this function returns.\n\
1032: It is used to initialize the state of the parse.")
1033:
1034: */
1035:
1036: DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 5, 0,
1037: 0 /* See immediately above */)
1038: (from, to, targetdepth, stopbefore, oldstate)
1039: Lisp_Object from, to, targetdepth, stopbefore, oldstate;
1040: {
1041: struct lisp_parse_state state;
1042: int target;
1043:
1044: if (!NULL (targetdepth))
1045: {
1046: CHECK_NUMBER (targetdepth, 3);
1047: target = XINT (targetdepth);
1048: }
1049: else
1050: target = -100000; /* We won't reach this depth */
1051:
1052: validate_region (&from, &to);
1053: state = *scan_sexps_forward (XINT (from), XINT (to),
1054: target, !NULL (stopbefore), oldstate);
1055:
1056: SET_PT (state.location);
1057:
1058: return Fcons (make_number (state.depth),
1059: Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart),
1060: Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart),
1061: Fcons (state.instring >= 0 ? make_number (state.instring) : Qnil,
1062: Fcons (state.incomment ? Qt : Qnil,
1063: Fcons (state.quoted ? Qt : Qnil,
1064: Fcons (make_number (state.mindepth), Qnil)))))));
1065: }
1066:
1067: init_syntax_once ()
1068: {
1069: register int i;
1070: register struct Lisp_Vector *v;
1071:
1072: /* Set this now, so first buffer creation can refer to it. */
1073: /* Make it nil before calling copy-syntax-table
1074: so that copy-syntax-table will know not to try to copy from garbage */
1075: Vstandard_syntax_table = Qnil;
1076: Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
1077:
1078: v = XVECTOR (Vstandard_syntax_table);
1079:
1080: for (i = 'a'; i <= 'z'; i++)
1081: XFASTINT (v->contents[i]) = (int) Sword;
1082: for (i = 'A'; i <= 'Z'; i++)
1083: XFASTINT (v->contents[i]) = (int) Sword;
1084: for (i = '0'; i <= '9'; i++)
1085: XFASTINT (v->contents[i]) = (int) Sword;
1086: XFASTINT (v->contents['$']) = (int) Sword;
1087: XFASTINT (v->contents['%']) = (int) Sword;
1088:
1089: XFASTINT (v->contents['(']) = (int) Sopen + (')' << 8);
1090: XFASTINT (v->contents[')']) = (int) Sclose + ('(' << 8);
1091: XFASTINT (v->contents['[']) = (int) Sopen + (']' << 8);
1092: XFASTINT (v->contents[']']) = (int) Sclose + ('[' << 8);
1093: XFASTINT (v->contents['{']) = (int) Sopen + ('}' << 8);
1094: XFASTINT (v->contents['}']) = (int) Sclose + ('{' << 8);
1095: XFASTINT (v->contents['"']) = (int) Sstring;
1096: XFASTINT (v->contents['\\']) = (int) Sescape;
1097:
1098: for (i = 0; i < 10; i++)
1099: XFASTINT (v->contents["_-+*/&|<>="[i]]) = (int) Ssymbol;
1100:
1101: for (i = 0; i < 12; i++)
1102: XFASTINT (v->contents[".,;:?!#@~^'`"[i]]) = (int) Spunct;
1103: }
1104:
1105: syms_of_syntax ()
1106: {
1107: Qsyntax_table_p = intern ("syntax-table-p");
1108: staticpro (&Qsyntax_table_p);
1109:
1110: DEFVAR_BOOL ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments,
1111: "Non-nil means forward-sexp, etc., should treat comments as whitespace.\n\
1112: Non-nil works only when the comment terminator is something like *\/,\n\
1113: and appears only when it ends a comment.\n\
1114: If comments are terminated by newlines,\n\
1115: you must make this variable nil.");
1116:
1117: defsubr (&Ssyntax_table_p);
1118: defsubr (&Ssyntax_table);
1119: defsubr (&Sstandard_syntax_table);
1120: defsubr (&Scopy_syntax_table);
1121: defsubr (&Sset_syntax_table);
1122: defsubr (&Schar_syntax);
1123: defsubr (&Smodify_syntax_entry);
1124: defsubr (&Sdescribe_syntax);
1125:
1126: defsubr (&Sforward_word);
1127:
1128: defsubr (&Sscan_lists);
1129: defsubr (&Sscan_sexps);
1130: defsubr (&Sbackward_prefix_chars);
1131: defsubr (&Sparse_partial_sexp);
1132: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.