![[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] / 43BSD / contrib / emacs / src|
Return to syntax.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / emacs / src |
1.1 root 1: /* GNU Emacs routines to deal with syntax tables; also word and list parsing.
2: Copyright (C) 1985 Richard M. Stallman.
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 (XINT (ch))]);
151: }
152:
153: DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3,
154: /* I really don't know why this is interactive
155: help-form should at least be made useful whilst reading the second arg
156: */
157: "cSet syntax for character: \nsSet syntax for %s to: ",
158: 0 /* See auxdoc.c */)
159: (c, newentry, syntax_table)
160: Lisp_Object c, newentry, syntax_table;
161: {
162: register unsigned char *p, match;
163: register enum syntaxcode code;
164: Lisp_Object val;
165:
166: CHECK_NUMBER (c, 0);
167: CHECK_STRING (newentry, 1);
168: if (NULL (syntax_table))
169: XSET (syntax_table, Lisp_Vector, bf_cur->syntax_table_v);
170: else syntax_table = check_syntax_table (syntax_table);
171:
172: p = XSTRING (newentry)->data;
173: code = (enum syntaxcode) syntax_spec_code[*p++];
174: if (((int) code & 0377) == 0377)
175: error ("invalid syntax description letter: %c", c);
176:
177: match = *p;
178: if (match) p++;
179: if (match == ' ') match = 0;
180:
181: XFASTINT (val) = (match << 8) + (int) code;
182: while (*p)
183: switch (*p++)
184: {
185: case '1':
186: XFASTINT (val) |= 1 << 16;
187: break;
188:
189: case '2':
190: XFASTINT (val) |= 1 << 17;
191: break;
192:
193: case '3':
194: XFASTINT (val) |= 1 << 18;
195: break;
196:
197: case '4':
198: XFASTINT (val) |= 1 << 19;
199: break;
200: }
201:
202: XVECTOR (syntax_table)->contents[XINT (c)] = val;
203:
204: return Qnil;
205: }
206:
207: /* Dump syntax table to buffer in human-readable format */
208:
209: describe_syntax (value)
210: Lisp_Object value;
211: {
212: register enum syntaxcode code;
213: char desc, match, start1, start2, end1, end2;
214: char str[2];
215:
216: if (XTYPE (value) != Lisp_Int)
217: {
218: InsStr ("invalid");
219: return;
220: }
221:
222: code = (enum syntaxcode) (XINT (value) & 0377);
223: match = (XINT (value) >> 8) & 0377;
224: start1 = (XINT (value) >> 16) & 1;
225: start2 = (XINT (value) >> 17) & 1;
226: end1 = (XINT (value) >> 18) & 1;
227: end2 = (XINT (value) >> 19) & 1;
228:
229: if ((int) code < 0 || (int) code >= (int) Smax)
230: {
231: InsStr ("invalid");
232: return;
233: }
234: desc = syntax_code_spec[(int) code];
235:
236: str[0] = desc, str[1] = 0;
237: InsCStr (str, 1);
238:
239: str[0] = match ? match : ' ';
240: InsCStr (str, 1);
241:
242:
243: if (start1)
244: InsCStr ("1", 1);
245: if (start2)
246: InsCStr ("2", 1);
247:
248: if (end1)
249: InsCStr ("3", 1);
250: if (end2)
251: InsCStr ("4", 1);
252:
253: InsStr ("\twhich means: ");
254:
255: #ifdef SWITCH_ENUM_BUG
256: switch ((int) code)
257: #else
258: switch (code)
259: #endif
260: {
261: case Swhitespace:
262: InsStr ("whitespace"); break;
263: case Spunct:
264: InsStr ("punctuation"); break;
265: case Sword:
266: InsStr ("word"); break;
267: case Ssymbol:
268: InsStr ("symbol"); break;
269: case Sopen:
270: InsStr ("open"); break;
271: case Sclose:
272: InsStr ("close"); break;
273: case Squote:
274: InsStr ("quote"); break;
275: case Sstring:
276: InsStr ("string"); break;
277: case Smath:
278: InsStr ("math"); break;
279: case Sescape:
280: InsStr ("escape"); break;
281: case Scharquote:
282: InsStr ("charquote"); break;
283: case Scomment:
284: InsStr ("comment"); break;
285: case Sendcomment:
286: InsStr ("endcomment"); break;
287: default:
288: InsStr ("invalid");
289: return;
290: }
291:
292: if (match)
293: {
294: InsStr (", matches ");
295:
296: str[0] = match, str[1] = 0;
297: InsCStr (str, 1);
298: }
299:
300: if (start1)
301: InsStr (",\n\t is the first character of a comment-start sequence");
302: if (start2)
303: InsStr (",\n\t is the second character of a comment-start sequence");
304:
305: if (end1)
306: InsStr (",\n\t is the first character of a comment-end sequence");
307: if (end2)
308: InsStr (",\n\t is the second character of a comment-end sequence");
309: }
310:
311: Lisp_Object
312: describe_syntax_1 (vector)
313: Lisp_Object vector;
314: {
315: struct buffer *old = bf_cur;
316: SetBfp (XBUFFER (Vstandard_output));
317: describe_vector (vector, Qnil, describe_syntax, 0);
318: SetBfp (old);
319: return Qnil;
320: }
321:
322: DEFUN ("describe-syntax", Fdescribe_syntax, Sdescribe_syntax, 0, 0, "",
323: "Describe the syntax specifications in the syntax table.\n\
324: The descriptions are inserted in a buffer, which is selected so you can see it.")
325: ()
326: {
327: register Lisp_Object vector;
328:
329: XSET (vector, Lisp_Vector, bf_cur->syntax_table_v);
330: internal_with_output_to_temp_buffer
331: ("*Help*", describe_syntax_1, vector);
332:
333: return Qnil;
334: }
335:
336: /* Return the position across `count' words from `from'.
337: If that many words cannot be found before the end of the buffer, return 0.
338: `count' negative means scan backward and stop at word beginning. */
339:
340: scan_words (from, count)
341: register int from, count;
342: {
343: register int beg = FirstCharacter;
344: register int end = NumCharacters + 1;
345:
346: immediate_quit = 1;
347: QUIT;
348:
349: while (count > 0)
350: {
351: while (1)
352: {
353: if (from == end)
354: {
355: immediate_quit = 0;
356: return 0;
357: }
358: if (SYNTAX(CharAt (from)) == Sword)
359: break;
360: from++;
361: }
362: while (1)
363: {
364: if (from == end) break;
365: if (SYNTAX(CharAt (from)) != Sword)
366: break;
367: from++;
368: }
369: count--;
370: }
371: while (count < 0)
372: {
373: while (1)
374: {
375: if (from == beg)
376: {
377: immediate_quit = 0;
378: return 0;
379: }
380: if (SYNTAX(CharAt (from - 1)) == Sword)
381: break;
382: from--;
383: }
384: while (1)
385: {
386: if (from == beg) break;
387: if (SYNTAX(CharAt (from - 1)) != Sword)
388: break;
389: from--;
390: }
391: count++;
392: }
393:
394: immediate_quit = 0;
395:
396: return from;
397: }
398:
399: DEFUN ("forward-word", Fforward_word, Sforward_word, 1, 1, "p",
400: "Move point forward ARG words (backward if ARG is negative).\n\
401: Normally returns t.\n\
402: If an edge of the buffer is reached, point is left there\n\
403: and nil is returned.")
404: (count)
405: Lisp_Object count;
406: {
407: int val;
408: CHECK_NUMBER (count, 0);
409:
410: if (!(val = scan_words (point, XINT (count))))
411: {
412: SetPoint (XINT (count) > 0 ? NumCharacters + 1 : FirstCharacter);
413: return Qnil;
414: }
415: SetPoint (val);
416: return Qt;
417: }
418:
419: int parse_sexp_ignore_comments;
420:
421: Lisp_Object
422: scan_lists (from, count, depth, sexpflag)
423: register int from;
424: int count, depth, sexpflag;
425: {
426: Lisp_Object val;
427: register int stop;
428: register int c;
429: char stringterm;
430: int quoted;
431: int mathexit = 0;
432: register enum syntaxcode code;
433: int min_depth = depth; /* Err out if depth gets less than this. */
434:
435: if (depth > 0) min_depth = 0;
436:
437: immediate_quit = 1;
438: QUIT;
439:
440: while (count > 0)
441: {
442: stop = NumCharacters + 1;
443: while (from < stop)
444: {
445: c = CharAt (from);
446: code = SYNTAX(c);
447: from++;
448: if (from < stop && SYNTAX_COMSTART_FIRST (c)
449: && SYNTAX_COMSTART_SECOND (CharAt (from))
450: && parse_sexp_ignore_comments)
451: code = Scomment, from++;
452:
453: #ifdef SWITCH_ENUM_BUG
454: switch ((int) code)
455: #else
456: switch (code)
457: #endif
458: {
459: case Sescape:
460: case Scharquote:
461: if (from == stop) goto lose;
462: from++;
463: /* treat following character as a word constituent */
464: case Sword:
465: case Ssymbol:
466: if (depth || !sexpflag) break;
467: /* This word counts as a sexp; return at end of it. */
468: while (from < stop)
469: {
470: #ifdef SWITCH_ENUM_BUG
471: switch ((int) SYNTAX(CharAt (from)))
472: #else
473: switch (SYNTAX(CharAt (from)))
474: #endif
475: {
476: case Scharquote:
477: case Sescape:
478: from++;
479: if (from == stop) goto lose;
480: break;
481: case Sword:
482: case Ssymbol:
483: break;
484: default:
485: goto done;
486: }
487: from++;
488: }
489: goto done;
490:
491: case Scomment:
492: if (!parse_sexp_ignore_comments) break;
493: while (1)
494: {
495: if (from == stop) goto done;
496: if (SYNTAX (c = CharAt (from)) == Sendcomment)
497: break;
498: from++;
499: if (from < stop && SYNTAX_COMEND_FIRST (c)
500: && SYNTAX_COMEND_SECOND (CharAt (from)))
501: { from++; break; }
502: }
503: break;
504:
505: case Smath:
506: if (!sexpflag)
507: break;
508: if (from != stop && c == CharAt (from))
509: from++;
510: if (mathexit) goto close1;
511: mathexit = 1;
512:
513: case Sopen:
514: if (!++depth) goto done;
515: break;
516:
517: case Sclose:
518: close1:
519: if (!--depth) goto done;
520: if (depth < min_depth)
521: error ("Containing expression ends prematurely");
522: break;
523:
524: case Sstring:
525: stringterm = CharAt (from - 1);
526: while (1)
527: {
528: if (from >= stop) goto lose;
529: if (CharAt (from) == stringterm) break;
530: #ifdef SWITCH_ENUM_BUG
531: switch ((int) SYNTAX(CharAt (from)))
532: #else
533: switch (SYNTAX(CharAt (from)))
534: #endif
535: {
536: case Scharquote:
537: case Sescape:
538: from++;
539: }
540: from++;
541: }
542: from++;
543: if (!depth && sexpflag) goto done;
544: break;
545: }
546: }
547:
548: /* Reached end of buffer. Error if within object, return nil if between */
549: if (depth) goto lose;
550:
551: immediate_quit = 0;
552: return Qnil;
553:
554: /* End of object reached */
555: done:
556: count--;
557: }
558:
559: while (count < 0)
560: {
561: stop = FirstCharacter;
562: while (from > stop)
563: {
564: from--;
565: if (quoted = char_quoted (from))
566: from--;
567: c = CharAt (from);
568: code = SYNTAX (c);
569: if (from > stop && SYNTAX_COMEND_SECOND (c)
570: && SYNTAX_COMEND_FIRST (CharAt (from - 1))
571: && !char_quoted (from - 1)
572: && parse_sexp_ignore_comments)
573: code = Sendcomment, from--;
574:
575: #ifdef SWITCH_ENUM_BUG
576: switch ((int) (quoted ? Sword : code))
577: #else
578: switch (quoted ? Sword : code)
579: #endif
580: {
581: case Sword:
582: case Ssymbol:
583: if (depth || !sexpflag) break;
584: /* This word counts as a sexp; count object finished after passing it. */
585: while (from > stop)
586: {
587: if (quoted = char_quoted (from - 1))
588: from--;
589: if (! (quoted || SYNTAX(CharAt (from - 1)) == Sword ||
590: SYNTAX(CharAt (from - 1)) == Ssymbol))
591: goto done2;
592: from--;
593: }
594: goto done2;
595:
596: case Smath:
597: if (!sexpflag)
598: break;
599: if (from != stop && c == CharAt (from - 1))
600: from--;
601: if (mathexit) goto open2;
602: mathexit = 1;
603:
604: case Sclose:
605: if (!++depth) goto done2;
606: break;
607:
608: case Sopen:
609: open2:
610: if (!--depth) goto done2;
611: if (depth < min_depth)
612: error ("Containing expression ends prematurely");
613: break;
614:
615: case Sendcomment:
616: if (!parse_sexp_ignore_comments) break;
617: if (from != stop) from--;
618: while (1)
619: {
620: if (SYNTAX (c = CharAt (from)) == Scomment)
621: break;
622: if (from == stop) goto done;
623: from--;
624: if (SYNTAX_COMSTART_SECOND (c)
625: && SYNTAX_COMSTART_FIRST (CharAt (from))
626: && !char_quoted (from))
627: break;
628: }
629: break;
630:
631: case Sstring:
632: stringterm = CharAt (from);
633: while (1)
634: {
635: if (from == stop) goto lose;
636: if (!char_quoted (from - 1)
637: && stringterm == CharAt (from - 1))
638: break;
639: from--;
640: }
641: from--;
642: if (!depth && sexpflag) goto done2;
643: break;
644: }
645: }
646:
647: /* Reached start of buffer. Error if within object, return nil if between */
648: if (depth) goto lose;
649:
650: immediate_quit = 0;
651: return Qnil;
652:
653: done2:
654: count++;
655: }
656:
657:
658: immediate_quit = 0;
659: XFASTINT (val) = from;
660: return val;
661:
662: lose:
663: error ("Unbalanced parentheses");
664: /* NOTREACHED */
665: }
666:
667: char_quoted (pos)
668: register int pos;
669: {
670: register enum syntaxcode code;
671: register int beg = FirstCharacter;
672: register int quoted = 0;
673:
674: while (pos > beg &&
675: ((code = SYNTAX (CharAt (pos - 1))) == Scharquote
676: || code == Sescape))
677: pos--, quoted = !quoted;
678: return quoted;
679: }
680:
681: DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
682: "Scan from character number FROM by COUNT lists.\n\
683: Returns the character number of the position thus found.\n\
684: \n\
685: If DEPTH is nonzero, paren depth begins counting from that value,\n\
686: only places where the depth in parentheses becomes zero\n\
687: are candidates for stopping; COUNT such places are counted.\n\
688: Thus, a positive value for DEPTH means go out levels.\n\
689: \n\
690: Comments are ignored if parse-sexp-ignore-comments is non-nil.\n\
691: \n\
692: If the beginning or end of (the visible part of) the buffer is reached\n\
693: and the depth is wrong, an error is signaled.\n\
694: If the depth is right but the count is not used up, nil is returned.")
695: (from, count, depth)
696: Lisp_Object from, count, depth;
697: {
698: CHECK_NUMBER (from, 0);
699: CHECK_NUMBER (count, 1);
700: CHECK_NUMBER (depth, 2);
701:
702: return scan_lists (XINT (from), XINT (count), XINT (depth), 0);
703: }
704:
705: DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0,
706: "Scan from character number FROM by COUNT balanced expressions.\n\
707: Returns the character number of the position thus found.\n\
708: \n\
709: Comments are ignored if parse-sexp-ignore-comments is non-nil.\n\
710: \n\
711: If the beginning or end of (the visible part of) the buffer is reached\n\
712: in the middle of a parenthetical grouping, an error is signaled.\n\
713: If the beginning or end is reached between groupings but before count is used up,\n\
714: nil is returned.")
715: (from, count)
716: Lisp_Object from, count;
717: {
718: CHECK_NUMBER (from, 0);
719: CHECK_NUMBER (count, 1);
720:
721: return scan_lists (XINT (from), XINT (count), 0, 1);
722: }
723:
724: DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars,
725: 0, 0, 0,
726: "Move point backward over any number of chars with syntax \"prefix\".")
727: ()
728: {
729: int beg = FirstCharacter;
730: int pos = point;
731:
732: while (pos > beg && !char_quoted (pos - 1) && SYNTAX (CharAt (pos - 1)) == Squote)
733: pos--;
734:
735: SetPoint (pos);
736:
737: return Qnil;
738: }
739:
740: struct lisp_parse_state
741: {
742: int depth; /* Depth at end of parsing */
743: int instring; /* -1 if not within string, else desired terminator. */
744: int incomment; /* Nonzero if within a comment at end of parsing */
745: int quoted; /* Nonzero if just after an escape char at end of parsing */
746: int thislevelstart; /* Char number of most recent start-of-expression at current level */
747: int prevlevelstart; /* Char number of start of containing expression */
748: int location; /* Char number at which parsing stopped. */
749: };
750:
751: /* Parse forward from `from' to `end', assuming that `from'
752: is the start of a function, and return a description of the state of the parse at `end'. */
753:
754: struct lisp_parse_state val_scan_sexps_forward;
755:
756: struct lisp_parse_state *
757: scan_sexps_forward (from, end, targetdepth, stopbefore, oldstate)
758: register int from;
759: int end, targetdepth, stopbefore;
760: Lisp_Object oldstate;
761: {
762: struct lisp_parse_state state;
763:
764: register enum syntaxcode code;
765: struct level { int last, prev; };
766: struct level levelstart[100];
767: register struct level *curlevel = levelstart;
768: struct level *endlevel = levelstart + 100;
769: char prev;
770: register int depth; /* Paren depth of current scanning location.
771: level - levelstart equals this except
772: when the depth becomes negative. */
773: int start_quoted = 0; /* Nonzero means starting after a char quote */
774: Lisp_Object tem;
775:
776: immediate_quit = 1;
777: QUIT;
778:
779: if (NULL (oldstate))
780: {
781: depth = 0;
782: state.instring = -1;
783: state.incomment = 0;
784: }
785: else
786: {
787: tem = Fcar (oldstate);
788: if (!NULL (tem))
789: depth = XINT (tem);
790: else
791: depth = 0;
792:
793: oldstate = Fcdr (oldstate);
794: oldstate = Fcdr (oldstate);
795: oldstate = Fcdr (oldstate);
796: tem = Fcar (oldstate);
797: state.instring = !NULL (tem) ? XINT (tem) : -1;
798:
799: oldstate = Fcdr (oldstate);
800: tem = Fcar (oldstate);
801: state.incomment = !NULL (tem);
802:
803: oldstate = Fcdr (oldstate);
804: tem = Fcar (oldstate);
805: start_quoted = !NULL (tem);
806: }
807: state.quoted = 0;
808:
809: curlevel->prev = -1;
810:
811: /* Enter the loop at a place appropriate for initial state. */
812:
813: if (state.incomment) goto startincomment;
814: if (state.instring >= 0)
815: {
816: if (start_quoted) goto startquotedinstring;
817: goto startinstring;
818: }
819: if (start_quoted) goto startquoted;
820:
821: while (from < end)
822: {
823: code = SYNTAX(CharAt (from));
824: from++;
825: if (from < end && SYNTAX_COMSTART_FIRST (CharAt (from - 1))
826: && SYNTAX_COMSTART_SECOND (CharAt (from)))
827: code = Scomment, from++;
828: #ifdef SWITCH_ENUM_BUG
829: switch ((int) code)
830: #else
831: switch (code)
832: #endif
833: {
834: case Sescape:
835: case Scharquote:
836: if (stopbefore) goto stop; /* this arg means stop at sexp start */
837: curlevel->last = from - 1;
838: startquoted:
839: if (from == end) goto endquoted;
840: from++;
841: goto symstarted;
842: /* treat following character as a word constituent */
843: case Sword:
844: case Ssymbol:
845: if (stopbefore) goto stop; /* this arg means stop at sexp start */
846: curlevel->last = from - 1;
847: symstarted:
848: while (from < end)
849: {
850: #ifdef SWITCH_ENUM_BUG
851: switch ((int) SYNTAX(CharAt (from)))
852: #else
853: switch (SYNTAX(CharAt (from)))
854: #endif
855: {
856: case Scharquote:
857: case Sescape:
858: from++;
859: if (from == end) goto endquoted;
860: break;
861: case Sword:
862: case Ssymbol:
863: break;
864: default:
865: goto symdone;
866: }
867: from++;
868: }
869: symdone:
870: curlevel->prev = curlevel->last;
871: break;
872:
873: case Scomment:
874: state.incomment = 1;
875: startincomment:
876: while (1)
877: {
878: if (from == end) goto done;
879: if (SYNTAX (prev = CharAt (from)) == Sendcomment)
880: break;
881: from++;
882: if (from < end && SYNTAX_COMEND_FIRST (prev)
883: && SYNTAX_COMEND_SECOND (CharAt (from)))
884: { from++; break; }
885: }
886: state.incomment = 0;
887: break;
888:
889: case Sopen:
890: if (stopbefore) goto stop; /* this arg means stop at sexp start */
891: depth++;
892: /* curlevel++->last ran into compiler bug on Apollo */
893: curlevel->last = from - 1;
894: if (++curlevel == endlevel)
895: error ("Nesting too deep for parser");
896: curlevel->prev = -1;
897: curlevel->last = -1;
898: if (!--targetdepth) goto done;
899: break;
900:
901: case Sclose:
902: depth--;
903: if (curlevel != levelstart)
904: curlevel--;
905: curlevel->prev = curlevel->last;
906: if (!++targetdepth) goto done;
907: break;
908:
909: case Sstring:
910: if (stopbefore) goto stop; /* this arg means stop at sexp start */
911: curlevel->last = from - 1;
912: state.instring = CharAt (from - 1);
913: startinstring:
914: while (1)
915: {
916: if (from >= end) goto done;
917: if (CharAt (from) == state.instring) break;
918: #ifdef SWITCH_ENUM_BUG
919: switch ((int) SYNTAX(CharAt (from)))
920: #else
921: switch (SYNTAX(CharAt (from)))
922: #endif
923: {
924: case Scharquote:
925: case Sescape:
926: from++;
927: startquotedinstring:
928: if (from >= end) goto endquoted;
929: }
930: from++;
931: }
932: state.instring = -1;
933: curlevel->prev = curlevel->last;
934: from++;
935: break;
936:
937: case Smath:
938: break;
939: }
940: }
941: goto done;
942:
943: stop: /* Here if stopping before start of sexp. */
944: from--; /* We have just fetched the char that starts it; */
945: goto done; /* but return the position before it. */
946:
947: endquoted:
948: state.quoted = 1;
949: done:
950: state.depth = depth;
951: state.thislevelstart = curlevel->prev;
952: state.prevlevelstart
953: = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
954: state.location = from;
955: immediate_quit = 0;
956:
957: val_scan_sexps_forward = state;
958: return &val_scan_sexps_forward;
959: }
960:
961: DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 5, 0,
962: 0 /* See auxdoc.c */)
963: (from, to, targetdepth, stopbefore, oldstate)
964: Lisp_Object from, to, targetdepth, stopbefore, oldstate;
965: {
966: struct lisp_parse_state state;
967: int target;
968:
969: if (!NULL (targetdepth))
970: {
971: CHECK_NUMBER (targetdepth, 3);
972: target = XINT (targetdepth);
973: }
974: else
975: target = -100000; /* We won't reach this depth */
976:
977: validate_region (&from, &to);
978: state = *scan_sexps_forward (XINT (from), XINT (to),
979: target, !NULL (stopbefore), oldstate);
980:
981: SetPoint (state.location);
982:
983: return Fcons (make_number (state.depth),
984: Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart),
985: Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart),
986: Fcons (state.instring >= 0 ? make_number (state.instring) : Qnil,
987: Fcons (state.incomment ? Qt : Qnil,
988: Fcons (state.quoted ? Qt : Qnil, Qnil))))));
989: }
990:
991: init_syntax_once ()
992: {
993: register int i;
994: register struct Lisp_Vector *v;
995:
996: /* Set this now, so first buffer creation can refer to it. */
997: /* Make it nil before calling copy-syntax-table
998: so that copy-syntax-table will know not to try to copy from garbage */
999: Vstandard_syntax_table = Qnil;
1000: Vstandard_syntax_table = Fcopy_syntax_table (Qnil);
1001:
1002: v = XVECTOR (Vstandard_syntax_table);
1003:
1004: for (i = 'a'; i <= 'z'; i++)
1005: XFASTINT (v->contents[i]) = (int) Sword;
1006: for (i = 'A'; i <= 'Z'; i++)
1007: XFASTINT (v->contents[i]) = (int) Sword;
1008: for (i = '0'; i <= '9'; i++)
1009: XFASTINT (v->contents[i]) = (int) Sword;
1010: XFASTINT (v->contents['$']) = (int) Sword;
1011: XFASTINT (v->contents['%']) = (int) Sword;
1012:
1013: XFASTINT (v->contents['(']) = (int) Sopen + (')' << 8);
1014: XFASTINT (v->contents[')']) = (int) Sclose + ('(' << 8);
1015: XFASTINT (v->contents['[']) = (int) Sopen + (']' << 8);
1016: XFASTINT (v->contents[']']) = (int) Sclose + ('[' << 8);
1017: XFASTINT (v->contents['{']) = (int) Sopen + ('}' << 8);
1018: XFASTINT (v->contents['}']) = (int) Sclose + ('{' << 8);
1019: XFASTINT (v->contents['"']) = (int) Sstring;
1020: XFASTINT (v->contents['\\']) = (int) Sescape;
1021:
1022: for (i = 0; i < 10; i++)
1023: XFASTINT (v->contents["_-+*/&|<>="[i]]) = (int) Ssymbol;
1024:
1025: for (i = 0; i < 12; i++)
1026: XFASTINT (v->contents[".,;:?!#@~^'`"[i]]) = (int) Spunct;
1027: }
1028:
1029: syms_of_syntax ()
1030: {
1031: Qsyntax_table_p = intern ("syntax-table-p");
1032: staticpro (&Qsyntax_table_p);
1033:
1034: /* Mustn't let user clobber this!
1035: DefLispVar ("standard-syntax-table", &Vstandard_syntax_table,
1036: "The syntax table used by buffers that don't specify another.");
1037: */
1038: staticpro (&Vstandard_syntax_table);
1039:
1040: DefBoolVar ("parse-sexp-ignore-comments", &parse_sexp_ignore_comments,
1041: "Non-nil means forward-sexp, etc., should treat comments as whitespace.\n\
1042: Non-nil works only when the comment terminator is something like *\/,\n\
1043: and appears only when it ends a comment.\n\
1044: If comments are terminated by newlines,\n\
1045: you must make this variable nil.");
1046:
1047: defsubr (&Ssyntax_table_p);
1048: defsubr (&Ssyntax_table);
1049: defsubr (&Sstandard_syntax_table);
1050: defsubr (&Scopy_syntax_table);
1051: defsubr (&Sset_syntax_table);
1052: defsubr (&Schar_syntax);
1053: defsubr (&Smodify_syntax_entry);
1054: defsubr (&Sdescribe_syntax);
1055:
1056: defsubr (&Sforward_word);
1057:
1058: defsubr (&Sscan_lists);
1059: defsubr (&Sscan_sexps);
1060: defsubr (&Sbackward_prefix_chars);
1061: defsubr (&Sparse_partial_sexp);
1062: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.