4.3BSD - /usr/src/new/emacs/src/syntax.c

   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: }

Defined functions

Defined variables

Defined struct's