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