This source file includes following definitions.
- SYNTAX_FLAGS_COMSTART_FIRST
- SYNTAX_FLAGS_COMSTART_SECOND
- SYNTAX_FLAGS_COMEND_FIRST
- SYNTAX_FLAGS_COMEND_SECOND
- SYNTAX_FLAGS_COMSTARTEND_FIRST
- SYNTAX_FLAGS_PREFIX
- SYNTAX_FLAGS_COMMENT_STYLEB
- SYNTAX_FLAGS_COMMENT_STYLEC
- SYNTAX_FLAGS_COMMENT_STYLEC2
- SYNTAX_FLAGS_COMMENT_NESTED
- SYNTAX_FLAGS_COMMENT_STYLE
- SYNTAX_COMEND_FIRST
- bset_syntax_table
- syntax_prefix_flag_p
- SET_RAW_SYNTAX_ENTRY
- SET_RAW_SYNTAX_ENTRY_RANGE
- SYNTAX_MATCH
- SETUP_SYNTAX_TABLE
- RE_SETUP_SYNTAX_TABLE_FOR_OBJECT
- update_syntax_table
- parse_sexp_propertize
- update_syntax_table_forward
- char_quoted
- dec_bytepos
- find_defun_start
- prev_char_comend_first
- back_comment
- DEFUN
- check_syntax_table
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- scan_words
- DEFUN
- skip_chars
- skip_syntaxes
- in_classes
- forw_comment
- DEFUN
- syntax_multibyte
- scan_lists
- DEFUN
- in_2char_comment_start
- scan_sexps_forward
- internalize_parse_state
- init_syntax_once
- syms_of_syntax
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 #include <config.h>
21
22 #include "lisp.h"
23 #include "dispextern.h"
24 #include "character.h"
25 #include "buffer.h"
26 #include "regex-emacs.h"
27 #include "syntax.h"
28 #include "intervals.h"
29 #include "category.h"
30
31
32 #define SYNTAX(c) syntax_property (c, 1)
33 #define SYNTAX_ENTRY(c) syntax_property_entry (c, 1)
34 #define SYNTAX_WITH_FLAGS(c) syntax_property_with_flags (c, 1)
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61 static bool
62 SYNTAX_FLAGS_COMSTART_FIRST (int flags)
63 {
64 return (flags >> 16) & 1;
65 }
66 static bool
67 SYNTAX_FLAGS_COMSTART_SECOND (int flags)
68 {
69 return (flags >> 17) & 1;
70 }
71 static bool
72 SYNTAX_FLAGS_COMEND_FIRST (int flags)
73 {
74 return (flags >> 18) & 1;
75 }
76 static bool
77 SYNTAX_FLAGS_COMEND_SECOND (int flags)
78 {
79 return (flags >> 19) & 1;
80 }
81 static bool
82 SYNTAX_FLAGS_COMSTARTEND_FIRST (int flags)
83 {
84 return (flags & 0x50000) != 0;
85 }
86 static bool
87 SYNTAX_FLAGS_PREFIX (int flags)
88 {
89 return (flags >> 20) & 1;
90 }
91 static bool
92 SYNTAX_FLAGS_COMMENT_STYLEB (int flags)
93 {
94 return (flags >> 21) & 1;
95 }
96 static bool
97 SYNTAX_FLAGS_COMMENT_STYLEC (int flags)
98 {
99 return (flags >> 23) & 1;
100 }
101 static int
102 SYNTAX_FLAGS_COMMENT_STYLEC2 (int flags)
103 {
104 return (flags >> 22) & 2;
105 }
106 static bool
107 SYNTAX_FLAGS_COMMENT_NESTED (int flags)
108 {
109 return (flags >> 22) & 1;
110 }
111
112
113
114 static int
115 SYNTAX_FLAGS_COMMENT_STYLE (int flags, int other_flags)
116 {
117 return (SYNTAX_FLAGS_COMMENT_STYLEB (flags)
118 | SYNTAX_FLAGS_COMMENT_STYLEC2 (flags)
119 | SYNTAX_FLAGS_COMMENT_STYLEC2 (other_flags));
120 }
121
122
123
124 static bool
125 SYNTAX_COMEND_FIRST (int c)
126 {
127 return SYNTAX_FLAGS_COMEND_FIRST (SYNTAX_WITH_FLAGS (c));
128 }
129
130
131
132
133
134 enum
135 {
136 ST_COMMENT_STYLE = 256 + 1,
137 ST_STRING_STYLE = 256 + 2
138 };
139
140
141
142 struct lisp_parse_state
143 {
144 EMACS_INT depth;
145 int instring;
146 EMACS_INT incomment;
147 int comstyle;
148 bool quoted;
149 EMACS_INT mindepth;
150
151 ptrdiff_t thislevelstart;
152
153 ptrdiff_t prevlevelstart;
154 ptrdiff_t location;
155 ptrdiff_t location_byte;
156 ptrdiff_t comstr_start;
157 Lisp_Object levelstarts;
158
159 int prev_syntax;
160
161
162
163 };
164
165
166
167
168
169
170
171
172
173 static ptrdiff_t find_start_pos;
174 static ptrdiff_t find_start_value;
175 static ptrdiff_t find_start_value_byte;
176 static struct buffer *find_start_buffer;
177 static ptrdiff_t find_start_begv;
178 static modiff_count find_start_modiff;
179
180
181 static Lisp_Object skip_chars (bool, Lisp_Object, Lisp_Object);
182 static Lisp_Object skip_syntaxes (bool, Lisp_Object, Lisp_Object);
183 static Lisp_Object scan_lists (EMACS_INT, EMACS_INT, EMACS_INT, bool);
184 static void scan_sexps_forward (struct lisp_parse_state *,
185 ptrdiff_t, ptrdiff_t, ptrdiff_t, EMACS_INT,
186 bool, int);
187 static void internalize_parse_state (Lisp_Object, struct lisp_parse_state *);
188 static bool in_classes (int c, int num_classes, const unsigned char *classes);
189 static void parse_sexp_propertize (ptrdiff_t charpos);
190
191
192 static void
193 bset_syntax_table (struct buffer *b, Lisp_Object val)
194 {
195 b->syntax_table_ = val;
196 }
197
198
199 bool
200 syntax_prefix_flag_p (int c)
201 {
202 return SYNTAX_FLAGS_PREFIX (SYNTAX_WITH_FLAGS (c));
203 }
204
205 struct gl_state_s gl_state;
206
207 enum { INTERVALS_AT_ONCE = 10 };
208
209
210
211
212 static void
213 SET_RAW_SYNTAX_ENTRY (Lisp_Object table, int c, Lisp_Object val)
214 {
215 CHAR_TABLE_SET (table, c, val);
216 }
217
218
219
220
221 static void
222 SET_RAW_SYNTAX_ENTRY_RANGE (Lisp_Object table, Lisp_Object range,
223 Lisp_Object val)
224 {
225 Fset_char_table_range (table, range, val);
226 }
227
228
229
230
231 static Lisp_Object
232 SYNTAX_MATCH (int c)
233 {
234 Lisp_Object ent = SYNTAX_ENTRY (c);
235 return CONSP (ent) ? XCDR (ent) : Qnil;
236 }
237
238
239
240
241
242
243
244
245
246 static void
247 SETUP_SYNTAX_TABLE (ptrdiff_t from, ptrdiff_t count)
248 {
249 SETUP_BUFFER_SYNTAX_TABLE ();
250 gl_state.b_property = BEGV;
251 gl_state.e_property = ZV + 1;
252 gl_state.object = Qnil;
253 if (parse_sexp_lookup_properties)
254 {
255 if (count > 0)
256 update_syntax_table_forward (from, true, Qnil);
257 else if (from > BEGV)
258 {
259 update_syntax_table (from - 1, count, true, Qnil);
260 parse_sexp_propertize (from - 1);
261 }
262 }
263 }
264
265
266
267
268
269
270 void
271 RE_SETUP_SYNTAX_TABLE_FOR_OBJECT (Lisp_Object object,
272 ptrdiff_t frombyte)
273 {
274 SETUP_BUFFER_SYNTAX_TABLE ();
275 gl_state.object = object;
276 if (BUFFERP (gl_state.object))
277 {
278 struct buffer *buf = XBUFFER (gl_state.object);
279 gl_state.b_property = BEG;
280 gl_state.e_property = BUF_ZV (buf);
281 }
282 else if (NILP (gl_state.object))
283 {
284 gl_state.b_property = BEG;
285 gl_state.e_property = ZV;
286 }
287 else if (EQ (gl_state.object, Qt))
288 {
289 gl_state.b_property = 0;
290 gl_state.e_property = PTRDIFF_MAX;
291 }
292 else
293 {
294 gl_state.b_property = 0;
295 gl_state.e_property = 1 + SCHARS (gl_state.object);
296 }
297 if (parse_sexp_lookup_properties)
298 update_syntax_table (RE_SYNTAX_TABLE_BYTE_TO_CHAR (frombyte),
299 1, 1, gl_state.object);
300 }
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315 void
316 update_syntax_table (ptrdiff_t charpos, EMACS_INT count, bool init,
317 Lisp_Object object)
318 {
319 Lisp_Object tmp_table;
320 int cnt = 0;
321 bool invalidate = true;
322 INTERVAL i;
323
324 if (init)
325 {
326 gl_state.old_prop = Qnil;
327 gl_state.start = gl_state.b_property;
328 gl_state.stop = gl_state.e_property;
329 i = interval_of (charpos, object);
330 gl_state.backward_i = gl_state.forward_i = i;
331 invalidate = false;
332 if (!i)
333 return;
334 i = gl_state.forward_i;
335 gl_state.b_property = i->position;
336 gl_state.e_property = INTERVAL_LAST_POS (i);
337 }
338 else
339 {
340 i = count > 0 ? gl_state.forward_i : gl_state.backward_i;
341
342
343
344 if (!i)
345 error ("Error in syntax_table logic for to-the-end intervals");
346 else if (charpos < i->position)
347 {
348 if (count > 0)
349 error ("Error in syntax_table logic for intervals <-");
350
351 i = update_interval (i, charpos);
352 if (INTERVAL_LAST_POS (i) != gl_state.b_property)
353 {
354 invalidate = false;
355 gl_state.forward_i = i;
356 gl_state.e_property = INTERVAL_LAST_POS (i);
357 }
358 }
359 else if (charpos >= INTERVAL_LAST_POS (i))
360 {
361 if (count < 0)
362 error ("Error in syntax_table logic for intervals ->");
363
364 i = update_interval (i, charpos);
365 if (i->position != gl_state.e_property)
366 {
367 invalidate = false;
368 gl_state.backward_i = i;
369 gl_state.b_property = i->position;
370 }
371 }
372 }
373
374 tmp_table = textget (i->plist, Qsyntax_table);
375
376 if (invalidate)
377 invalidate = !EQ (tmp_table, gl_state.old_prop);
378
379 if (invalidate)
380 {
381
382 if (count > 0)
383 {
384 gl_state.backward_i = i;
385 gl_state.b_property = i->position;
386 }
387 else
388 {
389 gl_state.forward_i = i;
390 gl_state.e_property = INTERVAL_LAST_POS (i);
391 }
392 }
393
394 if (!EQ (tmp_table, gl_state.old_prop))
395 {
396 gl_state.current_syntax_table = tmp_table;
397 gl_state.old_prop = tmp_table;
398 if (EQ (Fsyntax_table_p (tmp_table), Qt))
399 {
400 gl_state.use_global = 0;
401 }
402 else if (CONSP (tmp_table))
403 {
404 gl_state.use_global = 1;
405 gl_state.global_code = tmp_table;
406 }
407 else
408 {
409 gl_state.use_global = 0;
410 gl_state.current_syntax_table = BVAR (current_buffer, syntax_table);
411 }
412 }
413
414 while (i)
415 {
416 if (cnt && !EQ (tmp_table, textget (i->plist, Qsyntax_table)))
417 {
418 if (count > 0)
419 {
420 gl_state.e_property = i->position;
421 gl_state.forward_i = i;
422 }
423 else
424 {
425 gl_state.b_property
426 = i->position + LENGTH (i);
427 gl_state.backward_i = i;
428 }
429 return;
430 }
431 else if (cnt == INTERVALS_AT_ONCE)
432 {
433 if (count > 0)
434 {
435 gl_state.e_property
436 = i->position + LENGTH (i)
437
438
439
440 + (next_interval (i) ? 0 : 1);
441 gl_state.forward_i = i;
442 }
443 else
444 {
445 gl_state.b_property = i->position;
446 gl_state.backward_i = i;
447 }
448 return;
449 }
450 cnt++;
451 i = count > 0 ? next_interval (i) : previous_interval (i);
452 }
453 eassert (i == NULL);
454 if (count > 0)
455 {
456 gl_state.e_property = gl_state.stop;
457 gl_state.forward_i = i;
458 }
459 else
460 gl_state.b_property = gl_state.start;
461 }
462
463 static void
464 parse_sexp_propertize (ptrdiff_t charpos)
465 {
466 EMACS_INT zv = ZV;
467 if (syntax_propertize__done <= charpos
468 && syntax_propertize__done < zv)
469 {
470 modiff_count modiffs = CHARS_MODIFF;
471 safe_call1 (Qinternal__syntax_propertize,
472 make_fixnum (min (zv, 1 + charpos)));
473 if (modiffs != CHARS_MODIFF)
474 error ("internal--syntax-propertize modified the buffer!");
475 if (syntax_propertize__done <= charpos
476 && syntax_propertize__done < zv)
477 error ("internal--syntax-propertize did not move"
478 " syntax-propertize--done");
479 SETUP_SYNTAX_TABLE (charpos, 1);
480 }
481 else if (gl_state.e_property > syntax_propertize__done)
482 {
483 gl_state.e_property = syntax_propertize__done;
484 gl_state.e_property_truncated = true;
485 }
486 else if (gl_state.e_property_truncated
487 && gl_state.e_property < syntax_propertize__done)
488 {
489
490
491 gl_state.e_property_truncated = false;
492 update_syntax_table_forward (charpos, false, Qnil);
493 }
494 }
495
496 void
497 update_syntax_table_forward (ptrdiff_t charpos, bool init,
498 Lisp_Object object)
499 {
500 if (gl_state.e_property_truncated)
501 {
502 eassert (NILP (object));
503 eassert (charpos >= gl_state.e_property);
504 parse_sexp_propertize (charpos);
505 }
506 else
507 {
508 update_syntax_table (charpos, 1, init, object);
509 if (NILP (object) && gl_state.e_property > syntax_propertize__done)
510 parse_sexp_propertize (charpos);
511 }
512 }
513
514
515
516
517
518 static bool
519 char_quoted (ptrdiff_t charpos, ptrdiff_t bytepos)
520 {
521 enum syntaxcode code;
522 ptrdiff_t beg = BEGV;
523 bool quoted = 0;
524 ptrdiff_t orig = charpos;
525
526 while (charpos > beg)
527 {
528 int c;
529 dec_both (&charpos, &bytepos);
530
531 UPDATE_SYNTAX_TABLE_BACKWARD (charpos);
532 c = FETCH_CHAR_AS_MULTIBYTE (bytepos);
533 code = SYNTAX (c);
534 if (! (code == Scharquote || code == Sescape))
535 break;
536
537 quoted = !quoted;
538 }
539
540 UPDATE_SYNTAX_TABLE (orig);
541 return quoted;
542 }
543
544
545
546
547 static ptrdiff_t
548 dec_bytepos (ptrdiff_t bytepos)
549 {
550 return (bytepos
551 - (!NILP (BVAR (current_buffer, enable_multibyte_characters))
552 ? prev_char_len (bytepos) : 1));
553 }
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569 static ptrdiff_t
570 find_defun_start (ptrdiff_t pos, ptrdiff_t pos_byte)
571 {
572 ptrdiff_t opoint = PT, opoint_byte = PT_BYTE;
573
574
575 if (current_buffer == find_start_buffer
576
577
578
579 && pos <= find_start_pos + 1000
580 && pos >= find_start_value
581 && BEGV == find_start_begv
582 && MODIFF == find_start_modiff)
583 return find_start_value;
584
585 if (!NILP (Vcomment_use_syntax_ppss))
586 {
587 modiff_count modiffs = CHARS_MODIFF;
588 Lisp_Object ppss = call1 (Qsyntax_ppss, make_fixnum (pos));
589 if (modiffs != CHARS_MODIFF)
590 error ("syntax-ppss modified the buffer!");
591 TEMP_SET_PT_BOTH (opoint, opoint_byte);
592 Lisp_Object boc = Fnth (make_fixnum (8), ppss);
593 if (FIXNUMP (boc))
594 {
595 find_start_value = XFIXNUM (boc);
596 find_start_value_byte = CHAR_TO_BYTE (find_start_value);
597 }
598 else
599 {
600 find_start_value = pos;
601 find_start_value_byte = pos_byte;
602 }
603 goto found;
604 }
605 if (!open_paren_in_column_0_is_defun_start)
606 {
607 find_start_value = BEGV;
608 find_start_value_byte = BEGV_BYTE;
609 goto found;
610 }
611
612
613 scan_newline (pos, pos_byte, BEGV, BEGV_BYTE, -1, 1);
614
615
616
617
618 SETUP_BUFFER_SYNTAX_TABLE ();
619 while (PT > BEGV)
620 {
621
622
623 int c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE);
624 if (SYNTAX (c) == Sopen)
625 {
626 SETUP_SYNTAX_TABLE (PT + 1, -1);
627 c = FETCH_CHAR_AS_MULTIBYTE (PT_BYTE);
628 if (SYNTAX (c) == Sopen)
629 break;
630
631 SETUP_BUFFER_SYNTAX_TABLE ();
632 }
633
634 scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -2, 1);
635 }
636
637
638 find_start_value = PT;
639 find_start_value_byte = PT_BYTE;
640 TEMP_SET_PT_BOTH (opoint, opoint_byte);
641
642 found:
643 find_start_buffer = current_buffer;
644 find_start_modiff = MODIFF;
645 find_start_begv = BEGV;
646 find_start_pos = pos;
647
648 return find_start_value;
649 }
650
651
652
653 static bool
654 prev_char_comend_first (ptrdiff_t pos, ptrdiff_t pos_byte)
655 {
656 int c;
657 bool val;
658
659 dec_both (&pos, &pos_byte);
660 UPDATE_SYNTAX_TABLE_BACKWARD (pos);
661 c = FETCH_CHAR (pos_byte);
662 val = SYNTAX_COMEND_FIRST (c);
663 UPDATE_SYNTAX_TABLE_FORWARD (pos + 1);
664 return val;
665 }
666
667
668
669
670
671
672
673
674
675
676
677
678
679 static bool
680 back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
681 bool comnested, int comstyle, ptrdiff_t *charpos_ptr,
682 ptrdiff_t *bytepos_ptr)
683 {
684
685
686
687
688
689
690
691
692
693 int string_style = -1;
694 bool string_lossage = 0;
695
696
697
698
699
700 bool comment_lossage = 0;
701 ptrdiff_t comment_end = from;
702 ptrdiff_t comment_end_byte = from_byte;
703 ptrdiff_t comstart_pos = 0;
704 ptrdiff_t comstart_byte;
705
706
707 ptrdiff_t defun_start = 0;
708 ptrdiff_t defun_start_byte = 0;
709 enum syntaxcode code;
710 ptrdiff_t nesting = 1;
711 int c;
712 int syntax = 0;
713 unsigned short int quit_count = 0;
714
715
716
717
718
719
720
721 while (from != stop)
722 {
723 rarely_quit (++quit_count);
724
725 ptrdiff_t temp_byte;
726 int prev_syntax;
727 bool com2start, com2end, comstart;
728
729
730 dec_both (&from, &from_byte);
731 UPDATE_SYNTAX_TABLE_BACKWARD (from);
732
733 prev_syntax = syntax;
734 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
735 syntax = SYNTAX_WITH_FLAGS (c);
736 code = SYNTAX (c);
737
738
739 com2start = (SYNTAX_FLAGS_COMSTART_FIRST (syntax)
740 && SYNTAX_FLAGS_COMSTART_SECOND (prev_syntax)
741 && (comstyle
742 == SYNTAX_FLAGS_COMMENT_STYLE (prev_syntax, syntax))
743 && (SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax)
744 || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested);
745 com2end = (SYNTAX_FLAGS_COMEND_FIRST (syntax)
746 && SYNTAX_FLAGS_COMEND_SECOND (prev_syntax));
747 comstart = (com2start || code == Scomment);
748
749
750
751
752
753
754
755
756
757
758
759
760
761 if (from > stop && (com2end || comstart))
762 {
763 ptrdiff_t next = from, next_byte = from_byte;
764 int next_c, next_syntax;
765 dec_both (&next, &next_byte);
766 UPDATE_SYNTAX_TABLE_BACKWARD (next);
767 next_c = FETCH_CHAR_AS_MULTIBYTE (next_byte);
768 next_syntax = SYNTAX_WITH_FLAGS (next_c);
769 if (((comstart || comnested)
770 && SYNTAX_FLAGS_COMEND_SECOND (syntax)
771 && SYNTAX_FLAGS_COMEND_FIRST (next_syntax))
772 || ((com2end || comnested)
773 && SYNTAX_FLAGS_COMSTART_SECOND (syntax)
774 && (comstyle
775 == SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_syntax))
776 && SYNTAX_FLAGS_COMSTART_FIRST (next_syntax)))
777 goto lossage;
778
779 }
780
781 if (com2start && comstart_pos == 0)
782
783
784
785
786 com2end = 0;
787
788
789 if (com2end)
790 code = Sendcomment;
791 else if (com2start)
792 code = Scomment;
793
794 else if (code == Scomment
795 && (comstyle != SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0)
796 || SYNTAX_FLAGS_COMMENT_NESTED (syntax) != comnested))
797 continue;
798
799
800
801 if ((comment_end_can_be_escaped || code != Sendcomment)
802 && char_quoted (from, from_byte))
803 continue;
804
805 switch (code)
806 {
807 case Sstring_fence:
808 case Scomment_fence:
809 c = (code == Sstring_fence ? ST_STRING_STYLE : ST_COMMENT_STYLE);
810 FALLTHROUGH;
811 case Sstring:
812
813 if (string_style == -1)
814
815 string_style = c;
816 else if (string_style == c)
817
818 string_style = -1;
819 else
820
821
822 string_lossage = 1;
823 break;
824
825 case Scomment:
826
827 if (string_style != -1 || comment_lossage || string_lossage)
828
829
830 goto lossage;
831
832 if (!comnested)
833 {
834
835 comstart_pos = from;
836 comstart_byte = from_byte;
837 }
838 else if (--nesting <= 0)
839
840
841
842
843
844 goto done;
845 break;
846
847 case Sendcomment:
848 if (SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == comstyle
849 && ((com2end && SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax))
850 || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested)
851
852 {
853 if (comnested)
854 nesting++;
855 else
856
857
858 from = stop;
859 }
860 else if (comstart_pos != 0 || c != '\n')
861
862
863
864
865
866
867
868 comment_lossage = 1;
869 break;
870
871 case Sopen:
872
873 if (open_paren_in_column_0_is_defun_start
874 && NILP (Vcomment_use_syntax_ppss)
875 && (from == stop
876 || (temp_byte = dec_bytepos (from_byte),
877 FETCH_CHAR (temp_byte) == '\n')))
878 {
879 defun_start = from;
880 defun_start_byte = from_byte;
881 from = stop;
882 }
883 break;
884
885 default:
886 break;
887 }
888 }
889
890 if (comstart_pos == 0)
891 {
892 from = comment_end;
893 from_byte = comment_end_byte;
894 UPDATE_SYNTAX_TABLE_FORWARD (comment_end);
895 }
896
897
898 else if (1)
899 {
900 from = comstart_pos;
901 from_byte = comstart_byte;
902 UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
903 }
904 else lossage:
905 {
906 struct lisp_parse_state state;
907 bool adjusted = true;
908
909
910
911
912
913
914 if (defun_start == 0)
915 {
916 defun_start = find_defun_start (comment_end, comment_end_byte);
917 defun_start_byte = find_start_value_byte;
918 adjusted = (defun_start > BEGV);
919 }
920 do
921 {
922 internalize_parse_state (Qnil, &state);
923 scan_sexps_forward (&state,
924 defun_start, defun_start_byte,
925 comment_end, TYPE_MINIMUM (EMACS_INT),
926 0, 0);
927 defun_start = comment_end;
928 if (!adjusted)
929 {
930 adjusted = true;
931 find_start_value
932 = CONSP (state.levelstarts) ? XFIXNUM (XCAR (state.levelstarts))
933 : state.thislevelstart >= 0 ? state.thislevelstart
934 : find_start_value;
935 find_start_value_byte = CHAR_TO_BYTE (find_start_value);
936 }
937
938 if (state.incomment == (comnested ? 1 : -1)
939 && state.comstyle == comstyle)
940 from = state.comstr_start;
941 else
942 {
943 from = comment_end;
944 if (state.incomment)
945
946
947
948 {
949
950 defun_start = state.comstr_start + 2;
951 defun_start_byte = CHAR_TO_BYTE (defun_start);
952 }
953 }
954 rarely_quit (++quit_count);
955 }
956 while (defun_start < comment_end);
957
958 from_byte = CHAR_TO_BYTE (from);
959 UPDATE_SYNTAX_TABLE_FORWARD (from - 1);
960 }
961
962 done:
963 *charpos_ptr = from;
964 *bytepos_ptr = from_byte;
965
966 return from != comment_end;
967 }
968
969 DEFUN ("syntax-table-p", Fsyntax_table_p, Ssyntax_table_p, 1, 1, 0,
970 doc:
971 )
972 (Lisp_Object object)
973 {
974 if (CHAR_TABLE_P (object)
975 && EQ (XCHAR_TABLE (object)->purpose, Qsyntax_table))
976 return Qt;
977 return Qnil;
978 }
979
980 static void
981 check_syntax_table (Lisp_Object obj)
982 {
983 CHECK_TYPE (CHAR_TABLE_P (obj) && EQ (XCHAR_TABLE (obj)->purpose, Qsyntax_table),
984 Qsyntax_table_p, obj);
985 }
986
987 DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0,
988 doc:
989 )
990 (void)
991 {
992 return BVAR (current_buffer, syntax_table);
993 }
994
995 DEFUN ("standard-syntax-table", Fstandard_syntax_table,
996 Sstandard_syntax_table, 0, 0, 0,
997 doc:
998 )
999 (void)
1000 {
1001 return Vstandard_syntax_table;
1002 }
1003
1004 DEFUN ("copy-syntax-table", Fcopy_syntax_table, Scopy_syntax_table, 0, 1, 0,
1005 doc:
1006 )
1007 (Lisp_Object table)
1008 {
1009 Lisp_Object copy;
1010
1011 if (!NILP (table))
1012 check_syntax_table (table);
1013 else
1014 table = Vstandard_syntax_table;
1015
1016 copy = Fcopy_sequence (table);
1017
1018
1019
1020 set_char_table_defalt (copy, Qnil);
1021
1022
1023
1024
1025 if (NILP (XCHAR_TABLE (copy)->parent))
1026 Fset_char_table_parent (copy, Vstandard_syntax_table);
1027 return copy;
1028 }
1029
1030 DEFUN ("set-syntax-table", Fset_syntax_table, Sset_syntax_table, 1, 1, 0,
1031 doc:
1032 )
1033 (Lisp_Object table)
1034 {
1035 int idx;
1036 check_syntax_table (table);
1037 bset_syntax_table (current_buffer, table);
1038
1039 idx = PER_BUFFER_VAR_IDX (syntax_table);
1040 SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
1041 return table;
1042 }
1043
1044
1045
1046
1047
1048 unsigned char const syntax_spec_code[0400] =
1049 { 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
1050 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
1051 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
1052 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
1053 Swhitespace, Scomment_fence, Sstring, 0377, Smath, 0377, 0377, Squote,
1054 Sopen, Sclose, 0377, 0377, 0377, Swhitespace, Spunct, Scharquote,
1055 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
1056 0377, 0377, 0377, 0377, Scomment, 0377, Sendcomment, 0377,
1057 Sinherit, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
1058 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
1059 0377, 0377, 0377, 0377, 0377, 0377, 0377, Sword,
1060 0377, 0377, 0377, 0377, Sescape, 0377, 0377, Ssymbol,
1061 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
1062 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377,
1063 0377, 0377, 0377, 0377, 0377, 0377, 0377, Sword,
1064 0377, 0377, 0377, 0377, Sstring_fence, 0377, 0377, 0377
1065 };
1066
1067
1068
1069 static char const syntax_code_spec[16] =
1070 {
1071 ' ', '.', 'w', '_', '(', ')', '\'', '\"', '$', '\\', '/', '<', '>', '@',
1072 '!', '|'
1073 };
1074
1075
1076
1077
1078
1079
1080 static Lisp_Object Vsyntax_code_object;
1081
1082
1083 DEFUN ("char-syntax", Fchar_syntax, Schar_syntax, 1, 1, 0,
1084 doc:
1085
1086
1087
1088
1089
1090
1091
1092
1093 )
1094 (Lisp_Object character)
1095 {
1096 CHECK_CHARACTER (character);
1097 int char_int = XFIXNAT (character);
1098 SETUP_BUFFER_SYNTAX_TABLE ();
1099 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1100 char_int = make_char_multibyte (char_int);
1101 return make_fixnum (syntax_code_spec[SYNTAX (char_int)]);
1102 }
1103
1104 DEFUN ("syntax-class-to-char", Fsyntax_class_to_char,
1105 Ssyntax_class_to_char, 1, 1, 0,
1106 doc:
1107
1108 )
1109 (Lisp_Object syntax)
1110 {
1111 int syn;
1112 CHECK_FIXNUM (syntax);
1113 syn = XFIXNUM (syntax);
1114
1115 if (syn < 0 || syn >= sizeof syntax_code_spec)
1116 args_out_of_range (make_fixnum (sizeof syntax_code_spec - 1),
1117 syntax);
1118 return make_fixnum (syntax_code_spec[syn]);
1119 }
1120
1121 DEFUN ("matching-paren", Fmatching_paren, Smatching_paren, 1, 1, 0,
1122 doc: )
1123 (Lisp_Object character)
1124 {
1125 int char_int;
1126 enum syntaxcode code;
1127 CHECK_CHARACTER (character);
1128 char_int = XFIXNUM (character);
1129 SETUP_BUFFER_SYNTAX_TABLE ();
1130 code = SYNTAX (char_int);
1131 if (code == Sopen || code == Sclose)
1132 return SYNTAX_MATCH (char_int);
1133 return Qnil;
1134 }
1135
1136 DEFUN ("string-to-syntax", Fstring_to_syntax, Sstring_to_syntax, 1, 1, 0,
1137 doc:
1138
1139
1140
1141 )
1142 (Lisp_Object string)
1143 {
1144 const unsigned char *p;
1145 int val;
1146 Lisp_Object match;
1147
1148 CHECK_STRING (string);
1149
1150 p = SDATA (string);
1151 val = syntax_spec_code[*p++];
1152 if (val == 0377)
1153 error ("Invalid syntax description letter: %c", p[-1]);
1154
1155 if (val == Sinherit)
1156 return Qnil;
1157
1158 if (*p)
1159 {
1160 int len, character = string_char_and_length (p, &len);
1161 XSETINT (match, character);
1162 if (XFIXNAT (match) == ' ')
1163 match = Qnil;
1164 p += len;
1165 }
1166 else
1167 match = Qnil;
1168
1169 while (*p)
1170 switch (*p++)
1171 {
1172 case '1':
1173 val |= 1 << 16;
1174 break;
1175
1176 case '2':
1177 val |= 1 << 17;
1178 break;
1179
1180 case '3':
1181 val |= 1 << 18;
1182 break;
1183
1184 case '4':
1185 val |= 1 << 19;
1186 break;
1187
1188 case 'p':
1189 val |= 1 << 20;
1190 break;
1191
1192 case 'b':
1193 val |= 1 << 21;
1194 break;
1195
1196 case 'n':
1197 val |= 1 << 22;
1198 break;
1199
1200 case 'c':
1201 val |= 1 << 23;
1202 break;
1203 }
1204
1205 if (val < ASIZE (Vsyntax_code_object) && NILP (match))
1206 return AREF (Vsyntax_code_object, val);
1207 else
1208
1209 return Fcons (make_fixnum (val), match);
1210 }
1211
1212
1213
1214 DEFUN ("modify-syntax-entry", Fmodify_syntax_entry, Smodify_syntax_entry, 2, 3,
1215 "cSet syntax for character: \nsSet syntax for %s to: ",
1216 doc:
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254 )
1255 (Lisp_Object c, Lisp_Object newentry, Lisp_Object syntax_table)
1256 {
1257 if (CONSP (c))
1258 {
1259 CHECK_CHARACTER_CAR (c);
1260 CHECK_CHARACTER_CDR (c);
1261 }
1262 else
1263 CHECK_CHARACTER (c);
1264
1265 if (NILP (syntax_table))
1266 syntax_table = BVAR (current_buffer, syntax_table);
1267 else
1268 check_syntax_table (syntax_table);
1269
1270 newentry = Fstring_to_syntax (newentry);
1271 if (CONSP (c))
1272 SET_RAW_SYNTAX_ENTRY_RANGE (syntax_table, c, newentry);
1273 else
1274 SET_RAW_SYNTAX_ENTRY (syntax_table, XFIXNUM (c), newentry);
1275
1276
1277
1278 clear_regexp_cache ();
1279
1280 return Qnil;
1281 }
1282
1283
1284
1285 DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value,
1286 Sinternal_describe_syntax_value, 1, 1, 0,
1287 doc: )
1288 (Lisp_Object syntax)
1289 {
1290 int code, syntax_code;
1291 bool start1, start2, end1, end2, prefix, comstyleb, comstylec, comnested;
1292 char str[2];
1293 Lisp_Object first, match_lisp, value = syntax;
1294
1295 if (NILP (value))
1296 {
1297 insert_string ("default");
1298 return syntax;
1299 }
1300
1301 if (CHAR_TABLE_P (value))
1302 {
1303 insert_string ("deeper char-table ...");
1304 return syntax;
1305 }
1306
1307 if (!CONSP (value))
1308 {
1309 insert_string ("invalid");
1310 return syntax;
1311 }
1312
1313 first = XCAR (value);
1314 match_lisp = XCDR (value);
1315
1316 if (!FIXNUMP (first) || !(NILP (match_lisp) || CHARACTERP (match_lisp)))
1317 {
1318 insert_string ("invalid");
1319 return syntax;
1320 }
1321
1322 syntax_code = XFIXNUM (first) & INT_MAX;
1323 code = syntax_code & 0377;
1324 start1 = SYNTAX_FLAGS_COMSTART_FIRST (syntax_code);
1325 start2 = SYNTAX_FLAGS_COMSTART_SECOND (syntax_code);
1326 end1 = SYNTAX_FLAGS_COMEND_FIRST (syntax_code);
1327 end2 = SYNTAX_FLAGS_COMEND_SECOND (syntax_code);
1328 prefix = SYNTAX_FLAGS_PREFIX (syntax_code);
1329 comstyleb = SYNTAX_FLAGS_COMMENT_STYLEB (syntax_code);
1330 comstylec = SYNTAX_FLAGS_COMMENT_STYLEC (syntax_code);
1331 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax_code);
1332
1333 if (Smax <= code)
1334 {
1335 insert_string ("invalid");
1336 return syntax;
1337 }
1338
1339 str[0] = syntax_code_spec[code], str[1] = 0;
1340 insert (str, 1);
1341
1342 if (NILP (match_lisp))
1343 insert (" ", 1);
1344 else
1345 insert_char (XFIXNUM (match_lisp));
1346
1347 if (start1)
1348 insert ("1", 1);
1349 if (start2)
1350 insert ("2", 1);
1351
1352 if (end1)
1353 insert ("3", 1);
1354 if (end2)
1355 insert ("4", 1);
1356
1357 if (prefix)
1358 insert ("p", 1);
1359 if (comstyleb)
1360 insert ("b", 1);
1361 if (comstylec)
1362 insert ("c", 1);
1363 if (comnested)
1364 insert ("n", 1);
1365
1366 insert_string ("\twhich means: ");
1367
1368 switch (code)
1369 {
1370 case Swhitespace:
1371 insert_string ("whitespace"); break;
1372 case Spunct:
1373 insert_string ("punctuation"); break;
1374 case Sword:
1375 insert_string ("word"); break;
1376 case Ssymbol:
1377 insert_string ("symbol"); break;
1378 case Sopen:
1379 insert_string ("open"); break;
1380 case Sclose:
1381 insert_string ("close"); break;
1382 case Squote:
1383 insert_string ("prefix"); break;
1384 case Sstring:
1385 insert_string ("string"); break;
1386 case Smath:
1387 insert_string ("math"); break;
1388 case Sescape:
1389 insert_string ("escape"); break;
1390 case Scharquote:
1391 insert_string ("charquote"); break;
1392 case Scomment:
1393 insert_string ("comment"); break;
1394 case Sendcomment:
1395 insert_string ("endcomment"); break;
1396 case Sinherit:
1397 insert_string ("inherit"); break;
1398 case Scomment_fence:
1399 insert_string ("comment fence"); break;
1400 case Sstring_fence:
1401 insert_string ("string fence"); break;
1402 default:
1403 insert_string ("invalid");
1404 return syntax;
1405 }
1406
1407 if (!NILP (match_lisp))
1408 {
1409 insert_string (", matches ");
1410 insert_char (XFIXNUM (match_lisp));
1411 }
1412
1413 if (start1)
1414 insert_string (",\n\t is the first character of a comment-start sequence");
1415 if (start2)
1416 insert_string (",\n\t is the second character of a comment-start sequence");
1417
1418 if (end1)
1419 insert_string (",\n\t is the first character of a comment-end sequence");
1420 if (end2)
1421 insert_string (",\n\t is the second character of a comment-end sequence");
1422 if (comstyleb)
1423 insert_string (" (comment style b)");
1424 if (comstylec)
1425 insert_string (" (comment style c)");
1426 if (comnested)
1427 insert_string (" (nestable)");
1428
1429 if (prefix)
1430 {
1431 AUTO_STRING (prefixdoc,
1432 ",\n\t is a prefix character for `backward-prefix-chars'");
1433 insert1 (call1 (Qsubstitute_command_keys, prefixdoc));
1434 }
1435
1436 return syntax;
1437 }
1438
1439
1440
1441
1442
1443 ptrdiff_t
1444 scan_words (ptrdiff_t from, EMACS_INT count)
1445 {
1446 ptrdiff_t beg = BEGV;
1447 ptrdiff_t end = ZV;
1448 ptrdiff_t from_byte = CHAR_TO_BYTE (from);
1449 enum syntaxcode code;
1450 int ch0, ch1;
1451 Lisp_Object func, pos;
1452
1453 SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count, PTRDIFF_MAX));
1454
1455 while (count > 0)
1456 {
1457 while (true)
1458 {
1459 if (from == end)
1460 return 0;
1461 UPDATE_SYNTAX_TABLE_FORWARD (from);
1462 ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
1463 code = SYNTAX (ch0);
1464 inc_both (&from, &from_byte);
1465 if (words_include_escapes
1466 && (code == Sescape || code == Scharquote))
1467 break;
1468 if (code == Sword)
1469 break;
1470 rarely_quit (from);
1471 }
1472
1473
1474 func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch0);
1475 if (! NILP (Ffboundp (func)))
1476 {
1477 pos = call2 (func, make_fixnum (from - 1), make_fixnum (end));
1478 if (FIXNUMP (pos) && from < XFIXNUM (pos) && XFIXNUM (pos) <= ZV)
1479 {
1480 from = XFIXNUM (pos);
1481 from_byte = CHAR_TO_BYTE (from);
1482 }
1483 }
1484 else
1485 {
1486 while (1)
1487 {
1488 if (from == end) break;
1489 UPDATE_SYNTAX_TABLE_FORWARD (from);
1490 ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
1491 code = SYNTAX (ch1);
1492 if ((code != Sword
1493 && (! words_include_escapes
1494 || (code != Sescape && code != Scharquote)))
1495 || word_boundary_p (ch0, ch1))
1496 break;
1497 inc_both (&from, &from_byte);
1498 ch0 = ch1;
1499 rarely_quit (from);
1500 }
1501 }
1502 count--;
1503 }
1504 while (count < 0)
1505 {
1506 while (true)
1507 {
1508 if (from == beg)
1509 return 0;
1510 dec_both (&from, &from_byte);
1511 UPDATE_SYNTAX_TABLE_BACKWARD (from);
1512 ch1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
1513 code = SYNTAX (ch1);
1514 if (words_include_escapes
1515 && (code == Sescape || code == Scharquote))
1516 break;
1517 if (code == Sword)
1518 break;
1519 rarely_quit (from);
1520 }
1521
1522
1523 func = CHAR_TABLE_REF (Vfind_word_boundary_function_table, ch1);
1524 if (! NILP (Ffboundp (func)))
1525 {
1526 pos = call2 (func, make_fixnum (from), make_fixnum (beg));
1527 if (FIXNUMP (pos) && BEGV <= XFIXNUM (pos) && XFIXNUM (pos) < from)
1528 {
1529 from = XFIXNUM (pos);
1530 from_byte = CHAR_TO_BYTE (from);
1531 }
1532 }
1533 else
1534 {
1535 while (1)
1536 {
1537 if (from == beg)
1538 break;
1539 dec_both (&from, &from_byte);
1540 UPDATE_SYNTAX_TABLE_BACKWARD (from);
1541 ch0 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
1542 code = SYNTAX (ch0);
1543 if ((code != Sword
1544 && (! words_include_escapes
1545 || (code != Sescape && code != Scharquote)))
1546 || word_boundary_p (ch0, ch1))
1547 {
1548 inc_both (&from, &from_byte);
1549 break;
1550 }
1551 ch1 = ch0;
1552 rarely_quit (from);
1553 }
1554 }
1555 count++;
1556 }
1557
1558 return from;
1559 }
1560
1561 DEFUN ("forward-word", Fforward_word, Sforward_word, 0, 1, "^p",
1562 doc:
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574 )
1575 (Lisp_Object arg)
1576 {
1577 Lisp_Object tmp;
1578 ptrdiff_t orig_val, val;
1579
1580 if (NILP (arg))
1581 XSETFASTINT (arg, 1);
1582 else
1583 CHECK_FIXNUM (arg);
1584
1585 val = orig_val = scan_words (PT, XFIXNUM (arg));
1586 if (! orig_val)
1587 val = XFIXNUM (arg) > 0 ? ZV : BEGV;
1588
1589
1590 tmp = Fconstrain_to_field (make_fixnum (val), make_fixnum (PT),
1591 Qnil, Qnil, Qnil);
1592 val = XFIXNAT (tmp);
1593
1594 SET_PT (val);
1595 return val == orig_val ? Qt : Qnil;
1596 }
1597
1598 DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
1599 doc:
1600
1601
1602
1603
1604
1605
1606
1607 )
1608 (Lisp_Object string, Lisp_Object lim)
1609 {
1610 return skip_chars (1, string, lim);
1611 }
1612
1613 DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
1614 doc:
1615
1616 )
1617 (Lisp_Object string, Lisp_Object lim)
1618 {
1619 return skip_chars (0, string, lim);
1620 }
1621
1622 DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0,
1623 doc:
1624
1625
1626
1627 )
1628 (Lisp_Object syntax, Lisp_Object lim)
1629 {
1630 return skip_syntaxes (1, syntax, lim);
1631 }
1632
1633 DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0,
1634 doc:
1635
1636
1637
1638
1639 )
1640 (Lisp_Object syntax, Lisp_Object lim)
1641 {
1642 return skip_syntaxes (0, syntax, lim);
1643 }
1644
1645 static Lisp_Object
1646 skip_chars (bool forwardp, Lisp_Object string, Lisp_Object lim)
1647 {
1648 int c;
1649 char fastmap[0400];
1650
1651 int *char_ranges UNINIT;
1652 int n_char_ranges = 0;
1653 bool negate = 0;
1654 ptrdiff_t i, i_byte;
1655
1656
1657 bool multibyte;
1658
1659 bool string_multibyte;
1660 ptrdiff_t size_byte;
1661 const unsigned char *str;
1662 int len;
1663 USE_SAFE_ALLOCA;
1664
1665 CHECK_STRING (string);
1666
1667 if (NILP (lim))
1668 XSETINT (lim, forwardp ? ZV : BEGV);
1669 else
1670 CHECK_FIXNUM_COERCE_MARKER (lim);
1671
1672
1673 if (XFIXNUM (lim) > ZV)
1674 XSETFASTINT (lim, ZV);
1675 if (XFIXNUM (lim) < BEGV)
1676 XSETFASTINT (lim, BEGV);
1677
1678 multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters))
1679 && (XFIXNUM (lim) - PT != CHAR_TO_BYTE (XFIXNUM (lim)) - PT_BYTE));
1680 string_multibyte = SBYTES (string) > SCHARS (string);
1681
1682 memset (fastmap, 0, sizeof fastmap);
1683
1684 str = SDATA (string);
1685 size_byte = SBYTES (string);
1686
1687 i_byte = 0;
1688 if (i_byte < size_byte
1689 && SREF (string, 0) == '^')
1690 {
1691 negate = 1; i_byte++;
1692 }
1693
1694
1695
1696
1697
1698
1699
1700 int nclasses = 0;
1701 unsigned char classes[RECC_NUM_CLASSES];
1702 if (! string_multibyte)
1703 {
1704 bool string_has_eight_bit = 0;
1705
1706
1707 while (i_byte < size_byte)
1708 {
1709 const unsigned char *ch = str + i_byte;
1710 re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte);
1711 if (cc == 0)
1712 error ("Invalid ISO C character class");
1713 if (cc != -1)
1714 {
1715 if (!(nclasses && memchr (classes, cc, nclasses)))
1716 classes[nclasses++] = cc;
1717 i_byte = ch - str;
1718 continue;
1719 }
1720
1721 c = str[i_byte++];
1722
1723 if (c == '\\')
1724 {
1725 if (i_byte == size_byte)
1726 break;
1727
1728 c = str[i_byte++];
1729 }
1730
1731
1732 if (i_byte + 1 < size_byte
1733 && str[i_byte] == '-')
1734 {
1735 int c2;
1736
1737
1738 i_byte++;
1739
1740
1741 c2 = str[i_byte++];
1742 if (c2 == '\\'
1743 && i_byte < size_byte)
1744 c2 = str[i_byte++];
1745
1746 if (c <= c2)
1747 {
1748 int lim2 = c2 + 1;
1749 while (c < lim2)
1750 fastmap[c++] = 1;
1751 if (! ASCII_CHAR_P (c2))
1752 string_has_eight_bit = 1;
1753 }
1754 }
1755 else
1756 {
1757 fastmap[c] = 1;
1758 if (! ASCII_CHAR_P (c))
1759 string_has_eight_bit = 1;
1760 }
1761 }
1762
1763
1764
1765
1766 if (multibyte && string_has_eight_bit)
1767 {
1768 char *p1;
1769 char himap[0200 + 1];
1770 memcpy (himap, fastmap + 0200, 0200);
1771 himap[0200] = 0;
1772 memset (fastmap + 0200, 0, 0200);
1773 SAFE_NALLOCA (char_ranges, 2, 128);
1774 i = 0;
1775
1776 while ((p1 = memchr (himap + i, 1, 0200 - i)))
1777 {
1778
1779
1780
1781 int c2, leading_code;
1782 i = p1 - himap;
1783 c = BYTE8_TO_CHAR (i + 0200);
1784 i += strlen (p1);
1785 c2 = BYTE8_TO_CHAR (i + 0200 - 1);
1786
1787 char_ranges[n_char_ranges++] = c;
1788 char_ranges[n_char_ranges++] = c2;
1789 leading_code = CHAR_LEADING_CODE (c);
1790 memset (fastmap + leading_code, 1,
1791 CHAR_LEADING_CODE (c2) - leading_code + 1);
1792 }
1793 }
1794 }
1795 else
1796 {
1797 SAFE_NALLOCA (char_ranges, 2, SCHARS (string));
1798
1799 while (i_byte < size_byte)
1800 {
1801 int leading_code = str[i_byte];
1802
1803 const unsigned char *ch = str + i_byte;
1804 re_wctype_t cc = re_wctype_parse (&ch, size_byte - i_byte);
1805 if (cc == 0)
1806 error ("Invalid ISO C character class");
1807 if (cc != -1)
1808 {
1809 if (!(nclasses && memchr (classes, cc, nclasses)))
1810 classes[nclasses++] = cc;
1811 i_byte = ch - str;
1812 continue;
1813 }
1814
1815 if (leading_code== '\\')
1816 {
1817 if (++i_byte == size_byte)
1818 break;
1819
1820 leading_code = str[i_byte];
1821 }
1822 c = string_char_and_length (str + i_byte, &len);
1823 i_byte += len;
1824
1825
1826
1827
1828 if (i_byte + 1 < size_byte
1829 && str[i_byte] == '-')
1830 {
1831 int c2, leading_code2;
1832
1833
1834 i_byte++;
1835
1836
1837 leading_code2 = str[i_byte];
1838 c2 = string_char_and_length (str + i_byte, &len);
1839 i_byte += len;
1840
1841 if (c2 == '\\'
1842 && i_byte < size_byte)
1843 {
1844 leading_code2 = str[i_byte];
1845 c2 = string_char_and_length (str + i_byte, &len);
1846 i_byte += len;
1847 }
1848
1849 if (c > c2)
1850 continue;
1851 if (ASCII_CHAR_P (c))
1852 {
1853 while (c <= c2 && c < 0x80)
1854 fastmap[c++] = 1;
1855 leading_code = CHAR_LEADING_CODE (c);
1856 }
1857 if (! ASCII_CHAR_P (c))
1858 {
1859 int lim2 = leading_code2 + 1;
1860 while (leading_code < lim2)
1861 fastmap[leading_code++] = 1;
1862 if (c <= c2)
1863 {
1864 char_ranges[n_char_ranges++] = c;
1865 char_ranges[n_char_ranges++] = c2;
1866 }
1867 }
1868 }
1869 else
1870 {
1871 if (ASCII_CHAR_P (c))
1872 fastmap[c] = 1;
1873 else
1874 {
1875 fastmap[leading_code] = 1;
1876 char_ranges[n_char_ranges++] = c;
1877 char_ranges[n_char_ranges++] = c;
1878 }
1879 }
1880 }
1881
1882
1883
1884
1885
1886 if (! multibyte && n_char_ranges > 0)
1887 {
1888 memset (fastmap + 0200, 0, 0200);
1889 for (i = 0; i < n_char_ranges; i += 2)
1890 {
1891 int c1 = char_ranges[i];
1892 int lim2 = char_ranges[i + 1] + 1;
1893
1894 for (; c1 < lim2; c1++)
1895 {
1896 int b = CHAR_TO_BYTE_SAFE (c1);
1897 if (b >= 0)
1898 fastmap[b] = 1;
1899 }
1900 }
1901 }
1902 }
1903
1904
1905 if (negate)
1906 {
1907 if (! multibyte)
1908 for (i = 0; i < sizeof fastmap; i++)
1909 fastmap[i] ^= 1;
1910 else
1911 {
1912 for (i = 0; i < 0200; i++)
1913 fastmap[i] ^= 1;
1914
1915 for (; i < sizeof fastmap; i++)
1916 fastmap[i] = 1;
1917 }
1918 }
1919
1920 {
1921 ptrdiff_t start_point = PT;
1922 ptrdiff_t pos = PT;
1923 ptrdiff_t pos_byte = PT_BYTE;
1924 unsigned char *p = PT_ADDR, *endp, *stop;
1925
1926 if (forwardp)
1927 {
1928 endp = (XFIXNUM (lim) == GPT) ? GPT_ADDR : CHAR_POS_ADDR (XFIXNUM (lim));
1929 stop = (pos < GPT && GPT < XFIXNUM (lim)) ? GPT_ADDR : endp;
1930 }
1931 else
1932 {
1933 endp = CHAR_POS_ADDR (XFIXNUM (lim));
1934 stop = (pos >= GPT && GPT > XFIXNUM (lim)) ? GAP_END_ADDR : endp;
1935 }
1936
1937
1938
1939
1940
1941
1942 SETUP_BUFFER_SYNTAX_TABLE ();
1943 if (forwardp)
1944 {
1945 if (multibyte)
1946 while (1)
1947 {
1948 int nbytes;
1949
1950 if (p >= stop)
1951 {
1952 if (p >= endp)
1953 break;
1954 p = GAP_END_ADDR;
1955 stop = endp;
1956 }
1957 c = string_char_and_length (p, &nbytes);
1958 if (nclasses && in_classes (c, nclasses, classes))
1959 {
1960 if (negate)
1961 break;
1962 else
1963 goto fwd_ok;
1964 }
1965
1966 if (! fastmap[*p])
1967 break;
1968 if (! ASCII_CHAR_P (c))
1969 {
1970
1971
1972
1973
1974
1975
1976
1977
1978 for (i = 0; i < n_char_ranges; i += 2)
1979 if (c >= char_ranges[i] && c <= char_ranges[i + 1])
1980 break;
1981 if (!(negate ^ (i < n_char_ranges)))
1982 break;
1983 }
1984 fwd_ok:
1985 p += nbytes, pos++, pos_byte += nbytes;
1986 rarely_quit (pos);
1987 }
1988 else
1989 while (true)
1990 {
1991 if (p >= stop)
1992 {
1993 if (p >= endp)
1994 break;
1995 p = GAP_END_ADDR;
1996 stop = endp;
1997 }
1998
1999 if (nclasses && in_classes (*p, nclasses, classes))
2000 {
2001 if (negate)
2002 break;
2003 else
2004 goto fwd_unibyte_ok;
2005 }
2006
2007 if (!fastmap[*p])
2008 break;
2009 fwd_unibyte_ok:
2010 p++, pos++, pos_byte++;
2011 rarely_quit (pos);
2012 }
2013 }
2014 else
2015 {
2016 if (multibyte)
2017 while (true)
2018 {
2019 if (p <= stop)
2020 {
2021 if (p <= endp)
2022 break;
2023 p = GPT_ADDR;
2024 stop = endp;
2025 }
2026 unsigned char *prev_p = p;
2027 do
2028 p--;
2029 while (stop <= p && ! CHAR_HEAD_P (*p));
2030
2031 c = STRING_CHAR (p);
2032
2033 if (nclasses && in_classes (c, nclasses, classes))
2034 {
2035 if (negate)
2036 break;
2037 else
2038 goto back_ok;
2039 }
2040
2041 if (! fastmap[*p])
2042 break;
2043 if (! ASCII_CHAR_P (c))
2044 {
2045
2046 for (i = 0; i < n_char_ranges; i += 2)
2047 if (c >= char_ranges[i] && c <= char_ranges[i + 1])
2048 break;
2049 if (!(negate ^ (i < n_char_ranges)))
2050 break;
2051 }
2052 back_ok:
2053 pos--, pos_byte -= prev_p - p;
2054 rarely_quit (pos);
2055 }
2056 else
2057 while (true)
2058 {
2059 if (p <= stop)
2060 {
2061 if (p <= endp)
2062 break;
2063 p = GPT_ADDR;
2064 stop = endp;
2065 }
2066
2067 if (nclasses && in_classes (p[-1], nclasses, classes))
2068 {
2069 if (negate)
2070 break;
2071 else
2072 goto back_unibyte_ok;
2073 }
2074
2075 if (!fastmap[p[-1]])
2076 break;
2077 back_unibyte_ok:
2078 p--, pos--, pos_byte--;
2079 rarely_quit (pos);
2080 }
2081 }
2082
2083 SET_PT_BOTH (pos, pos_byte);
2084
2085 SAFE_FREE ();
2086 return make_fixnum (PT - start_point);
2087 }
2088 }
2089
2090
2091 static Lisp_Object
2092 skip_syntaxes (bool forwardp, Lisp_Object string, Lisp_Object lim)
2093 {
2094 int c;
2095 unsigned char fastmap[0400];
2096 bool negate = 0;
2097 ptrdiff_t i, i_byte;
2098 bool multibyte;
2099 ptrdiff_t size_byte;
2100 unsigned char *str;
2101
2102 CHECK_STRING (string);
2103
2104 if (NILP (lim))
2105 XSETINT (lim, forwardp ? ZV : BEGV);
2106 else
2107 CHECK_FIXNUM_COERCE_MARKER (lim);
2108
2109
2110 if (XFIXNUM (lim) > ZV)
2111 XSETFASTINT (lim, ZV);
2112 if (XFIXNUM (lim) < BEGV)
2113 XSETFASTINT (lim, BEGV);
2114
2115 if (forwardp ? (PT >= XFIXNAT (lim)) : (PT <= XFIXNAT (lim)))
2116 return make_fixnum (0);
2117
2118 multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters))
2119 && (XFIXNUM (lim) - PT != CHAR_TO_BYTE (XFIXNUM (lim)) - PT_BYTE));
2120
2121 memset (fastmap, 0, sizeof fastmap);
2122
2123 if (SBYTES (string) > SCHARS (string))
2124
2125
2126 string = string_make_unibyte (string);
2127
2128 str = SDATA (string);
2129 size_byte = SBYTES (string);
2130
2131 i_byte = 0;
2132 if (i_byte < size_byte
2133 && SREF (string, 0) == '^')
2134 {
2135 negate = 1; i_byte++;
2136 }
2137
2138
2139
2140 while (i_byte < size_byte)
2141 {
2142 c = str[i_byte++];
2143 fastmap[syntax_spec_code[c]] = 1;
2144 }
2145
2146
2147 if (negate)
2148 for (i = 0; i < sizeof fastmap; i++)
2149 fastmap[i] ^= 1;
2150
2151 {
2152 ptrdiff_t start_point = PT;
2153 ptrdiff_t pos = PT;
2154 ptrdiff_t pos_byte = PT_BYTE;
2155 unsigned char *p, *endp, *stop;
2156
2157 SETUP_SYNTAX_TABLE (pos, forwardp ? 1 : -1);
2158
2159 if (forwardp)
2160 {
2161 while (true)
2162 {
2163 p = BYTE_POS_ADDR (pos_byte);
2164 endp = XFIXNUM (lim) == GPT ? GPT_ADDR : CHAR_POS_ADDR (XFIXNUM (lim));
2165 stop = pos < GPT && GPT < XFIXNUM (lim) ? GPT_ADDR : endp;
2166
2167 do
2168 {
2169 int nbytes;
2170
2171 if (p >= stop)
2172 {
2173 if (p >= endp)
2174 goto done;
2175 p = GAP_END_ADDR;
2176 stop = endp;
2177 }
2178 if (multibyte)
2179 c = string_char_and_length (p, &nbytes);
2180 else
2181 c = *p, nbytes = 1;
2182 if (! fastmap[SYNTAX (c)])
2183 goto done;
2184 p += nbytes, pos++, pos_byte += nbytes;
2185 rarely_quit (pos);
2186 }
2187 while (!parse_sexp_lookup_properties
2188 || pos < gl_state.e_property);
2189
2190 update_syntax_table_forward (pos, false, gl_state.object);
2191 }
2192 }
2193 else
2194 {
2195 p = BYTE_POS_ADDR (pos_byte);
2196 endp = CHAR_POS_ADDR (XFIXNUM (lim));
2197 stop = pos >= GPT && GPT > XFIXNUM (lim) ? GAP_END_ADDR : endp;
2198
2199 if (multibyte)
2200 {
2201 while (true)
2202 {
2203 if (p <= stop)
2204 {
2205 if (p <= endp)
2206 break;
2207 p = GPT_ADDR;
2208 stop = endp;
2209 }
2210 UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
2211
2212 unsigned char *prev_p = p;
2213 do
2214 p--;
2215 while (stop <= p && ! CHAR_HEAD_P (*p));
2216
2217 c = STRING_CHAR (p);
2218 if (! fastmap[SYNTAX (c)])
2219 break;
2220 pos--, pos_byte -= prev_p - p;
2221 rarely_quit (pos);
2222 }
2223 }
2224 else
2225 {
2226 while (true)
2227 {
2228 if (p <= stop)
2229 {
2230 if (p <= endp)
2231 break;
2232 p = GPT_ADDR;
2233 stop = endp;
2234 }
2235 UPDATE_SYNTAX_TABLE_BACKWARD (pos - 1);
2236 if (! fastmap[SYNTAX (p[-1])])
2237 break;
2238 p--, pos--, pos_byte--;
2239 rarely_quit (pos);
2240 }
2241 }
2242 }
2243
2244 done:
2245 SET_PT_BOTH (pos, pos_byte);
2246
2247 return make_fixnum (PT - start_point);
2248 }
2249 }
2250
2251
2252
2253
2254 static bool
2255 in_classes (int c, int nclasses, const unsigned char *classes)
2256 {
2257 for (int i = 0; i < nclasses; i++)
2258 if (re_iswctype (c, classes[i]))
2259 return true;
2260 return false;
2261 }
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291 static bool
2292 forw_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop,
2293 EMACS_INT nesting, int style, int prev_syntax,
2294 ptrdiff_t *charpos_ptr, ptrdiff_t *bytepos_ptr,
2295 EMACS_INT *incomment_ptr, int *last_syntax_ptr)
2296 {
2297 unsigned short int quit_count = 0;
2298 int c, c1;
2299 enum syntaxcode code;
2300 int syntax, other_syntax;
2301
2302 if (nesting <= 0) nesting = -1;
2303
2304
2305
2306 syntax = prev_syntax;
2307 code = syntax & 0xff;
2308 if (syntax != 0 && from < stop) goto forw_incomment;
2309
2310 while (1)
2311 {
2312 if (from == stop)
2313 {
2314 *incomment_ptr = nesting;
2315 *charpos_ptr = from;
2316 *bytepos_ptr = from_byte;
2317 *last_syntax_ptr =
2318 (code == Sescape || code == Scharquote
2319 || SYNTAX_FLAGS_COMEND_FIRST (syntax)
2320 || (nesting > 0
2321 && SYNTAX_FLAGS_COMSTART_FIRST (syntax)))
2322 ? syntax : Smax ;
2323 return 0;
2324 }
2325 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2326 prev_syntax = syntax;
2327 syntax = SYNTAX_WITH_FLAGS (c);
2328 code = syntax & 0xff;
2329 if (code == Sendcomment
2330 && SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style
2331 && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ?
2332 (nesting > 0 && --nesting == 0) : nesting < 0)
2333 && !(comment_end_can_be_escaped
2334 && ((prev_syntax & 0xff) == Sescape
2335 || (prev_syntax & 0xff) == Scharquote)))
2336
2337
2338
2339 break;
2340 if (code == Scomment_fence
2341 && style == ST_COMMENT_STYLE)
2342
2343
2344
2345 break;
2346 if (nesting > 0
2347 && code == Scomment
2348 && SYNTAX_FLAGS_COMMENT_NESTED (syntax)
2349 && SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style)
2350
2351
2352 nesting++;
2353 if (comment_end_can_be_escaped
2354 && (code == Sescape || code == Scharquote))
2355 {
2356 inc_both (&from, &from_byte);
2357 UPDATE_SYNTAX_TABLE_FORWARD (from);
2358 if (from == stop) continue;
2359 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2360 prev_syntax = syntax;
2361 syntax = Smax;
2362 code = syntax;
2363 }
2364 inc_both (&from, &from_byte);
2365 UPDATE_SYNTAX_TABLE_FORWARD (from);
2366
2367 forw_incomment:
2368 if (from < stop && SYNTAX_FLAGS_COMEND_FIRST (syntax)
2369 && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
2370 other_syntax = SYNTAX_WITH_FLAGS (c1),
2371 SYNTAX_FLAGS_COMEND_SECOND (other_syntax))
2372 && SYNTAX_FLAGS_COMMENT_STYLE (syntax, other_syntax) == style
2373 && ((SYNTAX_FLAGS_COMMENT_NESTED (syntax) ||
2374 SYNTAX_FLAGS_COMMENT_NESTED (other_syntax))
2375 ? nesting > 0 : nesting < 0))
2376 {
2377 syntax = Smax;
2378
2379 if (--nesting <= 0)
2380
2381
2382 break;
2383 else
2384 {
2385 inc_both (&from, &from_byte);
2386 UPDATE_SYNTAX_TABLE_FORWARD (from);
2387 }
2388 }
2389 if (nesting > 0
2390 && from < stop
2391 && SYNTAX_FLAGS_COMSTART_FIRST (syntax)
2392 && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
2393 other_syntax = SYNTAX_WITH_FLAGS (c1),
2394 SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax) == style
2395 && SYNTAX_FLAGS_COMSTART_SECOND (other_syntax))
2396 && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ||
2397 SYNTAX_FLAGS_COMMENT_NESTED (other_syntax)))
2398
2399
2400 {
2401 syntax = Smax;
2402 inc_both (&from, &from_byte);
2403 UPDATE_SYNTAX_TABLE_FORWARD (from);
2404 nesting++;
2405 }
2406
2407 rarely_quit (++quit_count);
2408 }
2409 *charpos_ptr = from;
2410 *bytepos_ptr = from_byte;
2411 *last_syntax_ptr = Smax;
2412
2413 return 1;
2414 }
2415
2416 DEFUN ("forward-comment", Fforward_comment, Sforward_comment, 1, 1, 0,
2417 doc:
2418
2419
2420
2421
2422 )
2423 (Lisp_Object count)
2424 {
2425 ptrdiff_t from, from_byte, stop;
2426 int c, c1;
2427 enum syntaxcode code;
2428 int comstyle = 0;
2429 bool comnested = 0;
2430 bool found;
2431 EMACS_INT count1;
2432 ptrdiff_t out_charpos, out_bytepos;
2433 EMACS_INT dummy;
2434 int dummy2;
2435 unsigned short int quit_count = 0;
2436
2437 CHECK_FIXNUM (count);
2438 count1 = XFIXNUM (count);
2439 stop = count1 > 0 ? ZV : BEGV;
2440
2441 from = PT;
2442 from_byte = PT_BYTE;
2443
2444 SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count1, PTRDIFF_MAX));
2445 while (count1 > 0)
2446 {
2447 do
2448 {
2449 bool comstart_first;
2450 int syntax, other_syntax;
2451
2452 if (from == stop)
2453 {
2454 SET_PT_BOTH (from, from_byte);
2455 return Qnil;
2456 }
2457 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2458 syntax = SYNTAX_WITH_FLAGS (c);
2459 code = SYNTAX (c);
2460 comstart_first = SYNTAX_FLAGS_COMSTART_FIRST (syntax);
2461 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
2462 comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0);
2463 inc_both (&from, &from_byte);
2464 UPDATE_SYNTAX_TABLE_FORWARD (from);
2465 if (from < stop && comstart_first
2466 && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
2467 other_syntax = SYNTAX_WITH_FLAGS (c1),
2468 SYNTAX_FLAGS_COMSTART_SECOND (other_syntax)))
2469 {
2470
2471
2472
2473
2474
2475 code = Scomment;
2476 comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax);
2477 comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax);
2478 inc_both (&from, &from_byte);
2479 UPDATE_SYNTAX_TABLE_FORWARD (from);
2480 }
2481 rarely_quit (++quit_count);
2482 }
2483 while (code == Swhitespace || (code == Sendcomment && c == '\n'));
2484
2485 if (code == Scomment_fence)
2486 comstyle = ST_COMMENT_STYLE;
2487 else if (code != Scomment)
2488 {
2489 dec_both (&from, &from_byte);
2490 SET_PT_BOTH (from, from_byte);
2491 return Qnil;
2492 }
2493
2494 found = forw_comment (from, from_byte, stop, comnested, comstyle, 0,
2495 &out_charpos, &out_bytepos, &dummy, &dummy2);
2496 from = out_charpos; from_byte = out_bytepos;
2497 if (!found)
2498 {
2499 SET_PT_BOTH (from, from_byte);
2500 return Qnil;
2501 }
2502 inc_both (&from, &from_byte);
2503 UPDATE_SYNTAX_TABLE_FORWARD (from);
2504
2505 count1--;
2506 }
2507
2508 while (count1 < 0)
2509 {
2510 while (true)
2511 {
2512 if (from <= stop)
2513 {
2514 SET_PT_BOTH (BEGV, BEGV_BYTE);
2515 return Qnil;
2516 }
2517
2518 dec_both (&from, &from_byte);
2519
2520 bool quoted = char_quoted (from, from_byte);
2521 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2522 int syntax = SYNTAX_WITH_FLAGS (c);
2523 code = SYNTAX (c);
2524 comstyle = 0;
2525 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
2526 if (code == Sendcomment)
2527 comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0);
2528 if (from > stop && SYNTAX_FLAGS_COMEND_SECOND (syntax)
2529 && prev_char_comend_first (from, from_byte)
2530 && !char_quoted (from - 1, dec_bytepos (from_byte)))
2531 {
2532 int other_syntax;
2533
2534
2535
2536 dec_both (&from, &from_byte);
2537 code = Sendcomment;
2538
2539
2540 c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2541 other_syntax = SYNTAX_WITH_FLAGS (c1);
2542 comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax);
2543 comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax);
2544 }
2545
2546 if (code == Scomment_fence)
2547 {
2548
2549 bool fence_found = 0;
2550 ptrdiff_t ini = from, ini_byte = from_byte;
2551
2552 if (from > stop)
2553 {
2554 while (1)
2555 {
2556 dec_both (&from, &from_byte);
2557 UPDATE_SYNTAX_TABLE_BACKWARD (from);
2558 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2559 if (SYNTAX (c) == Scomment_fence
2560 && !char_quoted (from, from_byte))
2561 {
2562 fence_found = 1;
2563 break;
2564 }
2565 else if (from == stop)
2566 break;
2567 rarely_quit (++quit_count);
2568 }
2569 }
2570 if (fence_found == 0)
2571 {
2572 from = ini;
2573 from_byte = ini_byte;
2574 goto leave;
2575 }
2576 else
2577
2578 break;
2579 }
2580 else if (code == Sendcomment)
2581 {
2582 found = (!quoted || !comment_end_can_be_escaped)
2583 && back_comment (from, from_byte, stop, comnested, comstyle,
2584 &out_charpos, &out_bytepos);
2585 if (!found)
2586 {
2587 if (c == '\n')
2588
2589
2590
2591 ;
2592 else
2593 {
2594
2595
2596 if (SYNTAX (c) != code)
2597
2598 inc_both (&from, &from_byte);
2599 goto leave;
2600 }
2601 }
2602 else
2603 {
2604
2605 from = out_charpos, from_byte = out_bytepos;
2606 break;
2607 }
2608 }
2609 else if (code != Swhitespace || quoted)
2610 {
2611 leave:
2612 inc_both (&from, &from_byte);
2613 SET_PT_BOTH (from, from_byte);
2614 return Qnil;
2615 }
2616
2617 rarely_quit (++quit_count);
2618 }
2619
2620 count1++;
2621 }
2622
2623 SET_PT_BOTH (from, from_byte);
2624 return Qt;
2625 }
2626
2627
2628
2629
2630 static enum syntaxcode
2631 syntax_multibyte (int c, bool multibyte_symbol_p)
2632 {
2633 return ASCII_CHAR_P (c) || !multibyte_symbol_p ? SYNTAX (c) : Ssymbol;
2634 }
2635
2636 static Lisp_Object
2637 scan_lists (EMACS_INT from0, EMACS_INT count, EMACS_INT depth, bool sexpflag)
2638 {
2639 Lisp_Object val;
2640 ptrdiff_t stop = count > 0 ? ZV : BEGV;
2641 int c, c1;
2642 int stringterm;
2643 bool quoted;
2644 bool mathexit = 0;
2645 enum syntaxcode code;
2646 EMACS_INT min_depth = depth;
2647 int comstyle = 0;
2648 bool comnested = 0;
2649 ptrdiff_t temp_pos;
2650 EMACS_INT last_good = from0;
2651 bool found;
2652 ptrdiff_t from_byte;
2653 ptrdiff_t out_bytepos, out_charpos;
2654 EMACS_INT dummy;
2655 int dummy2;
2656 bool multibyte_symbol_p = sexpflag && multibyte_syntax_as_symbol;
2657 unsigned short int quit_count = 0;
2658
2659 if (depth > 0) min_depth = 0;
2660
2661 ptrdiff_t from = clip_to_bounds (BEGV, from0, ZV);
2662
2663 from_byte = CHAR_TO_BYTE (from);
2664
2665 maybe_quit ();
2666
2667 SETUP_SYNTAX_TABLE (from, clip_to_bounds (PTRDIFF_MIN, count, PTRDIFF_MAX));
2668 while (count > 0)
2669 {
2670 while (from < stop)
2671 {
2672 rarely_quit (++quit_count);
2673 bool comstart_first, prefix;
2674 int syntax, other_syntax;
2675 UPDATE_SYNTAX_TABLE_FORWARD (from);
2676 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2677 syntax = SYNTAX_WITH_FLAGS (c);
2678 code = syntax_multibyte (c, multibyte_symbol_p);
2679 comstart_first = SYNTAX_FLAGS_COMSTART_FIRST (syntax);
2680 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
2681 comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0);
2682 prefix = SYNTAX_FLAGS_PREFIX (syntax);
2683 if (depth == min_depth)
2684 last_good = from;
2685 inc_both (&from, &from_byte);
2686 UPDATE_SYNTAX_TABLE_FORWARD (from);
2687 if (from < stop && comstart_first
2688 && (c = FETCH_CHAR_AS_MULTIBYTE (from_byte),
2689 other_syntax = SYNTAX_WITH_FLAGS (c),
2690 SYNTAX_FLAGS_COMSTART_SECOND (other_syntax))
2691 && parse_sexp_ignore_comments)
2692 {
2693
2694
2695
2696
2697
2698 code = Scomment;
2699 comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax);
2700 comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax);
2701 inc_both (&from, &from_byte);
2702 UPDATE_SYNTAX_TABLE_FORWARD (from);
2703 }
2704
2705 if (prefix)
2706 continue;
2707
2708 switch (code)
2709 {
2710 case Sescape:
2711 case Scharquote:
2712 if (from == stop)
2713 goto lose;
2714 inc_both (&from, &from_byte);
2715
2716 FALLTHROUGH;
2717 case Sword:
2718 case Ssymbol:
2719 if (depth || !sexpflag) break;
2720
2721 while (from < stop)
2722 {
2723 UPDATE_SYNTAX_TABLE_FORWARD (from);
2724
2725 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2726 switch (syntax_multibyte (c, multibyte_symbol_p))
2727 {
2728 case Scharquote:
2729 case Sescape:
2730 inc_both (&from, &from_byte);
2731 if (from == stop)
2732 goto lose;
2733 break;
2734 case Sword:
2735 case Ssymbol:
2736 case Squote:
2737 break;
2738 default:
2739 goto done;
2740 }
2741 inc_both (&from, &from_byte);
2742 rarely_quit (++quit_count);
2743 }
2744 goto done;
2745
2746 case Scomment_fence:
2747 comstyle = ST_COMMENT_STYLE;
2748 FALLTHROUGH;
2749 case Scomment:
2750 if (!parse_sexp_ignore_comments) break;
2751 UPDATE_SYNTAX_TABLE_FORWARD (from);
2752 found = forw_comment (from, from_byte, stop,
2753 comnested, comstyle, 0,
2754 &out_charpos, &out_bytepos, &dummy,
2755 &dummy2);
2756 from = out_charpos, from_byte = out_bytepos;
2757 if (!found)
2758 {
2759 if (depth == 0)
2760 goto done;
2761 goto lose;
2762 }
2763 inc_both (&from, &from_byte);
2764 UPDATE_SYNTAX_TABLE_FORWARD (from);
2765 break;
2766
2767 case Smath:
2768 if (!sexpflag)
2769 break;
2770 if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (from_byte))
2771 {
2772 inc_both (&from, &from_byte);
2773 }
2774 if (mathexit)
2775 {
2776 mathexit = 0;
2777 goto close1;
2778 }
2779 mathexit = 1;
2780 FALLTHROUGH;
2781 case Sopen:
2782 if (!++depth) goto done;
2783 break;
2784
2785 case Sclose:
2786 close1:
2787 if (!--depth) goto done;
2788 if (depth < min_depth)
2789 xsignal3 (Qscan_error,
2790 build_string ("Containing expression ends prematurely"),
2791 make_fixnum (last_good), make_fixnum (from));
2792 break;
2793
2794 case Sstring:
2795 case Sstring_fence:
2796 temp_pos = dec_bytepos (from_byte);
2797 stringterm = FETCH_CHAR_AS_MULTIBYTE (temp_pos);
2798 while (1)
2799 {
2800 enum syntaxcode c_code;
2801 if (from >= stop)
2802 goto lose;
2803 UPDATE_SYNTAX_TABLE_FORWARD (from);
2804 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2805 c_code = syntax_multibyte (c, multibyte_symbol_p);
2806 if (code == Sstring
2807 ? c == stringterm && c_code == Sstring
2808 : c_code == Sstring_fence)
2809 break;
2810
2811 if (c_code == Scharquote || c_code == Sescape)
2812 inc_both (&from, &from_byte);
2813 inc_both (&from, &from_byte);
2814 rarely_quit (++quit_count);
2815 }
2816 inc_both (&from, &from_byte);
2817 if (!depth && sexpflag) goto done;
2818 break;
2819 default:
2820
2821 break;
2822 }
2823 }
2824
2825
2826 if (depth)
2827 goto lose;
2828
2829 return Qnil;
2830
2831
2832 done:
2833 count--;
2834 }
2835
2836 while (count < 0)
2837 {
2838 while (from > stop)
2839 {
2840 rarely_quit (++quit_count);
2841 dec_both (&from, &from_byte);
2842 UPDATE_SYNTAX_TABLE_BACKWARD (from);
2843 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2844 int syntax = SYNTAX_WITH_FLAGS (c);
2845 code = syntax_multibyte (c, multibyte_symbol_p);
2846 if (depth == min_depth)
2847 last_good = from;
2848 comstyle = 0;
2849 comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax);
2850 if (code == Sendcomment)
2851 comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0);
2852 if (from > stop && SYNTAX_FLAGS_COMEND_SECOND (syntax)
2853 && prev_char_comend_first (from, from_byte)
2854 && parse_sexp_ignore_comments)
2855 {
2856
2857
2858
2859 int c2, other_syntax;
2860 dec_both (&from, &from_byte);
2861 UPDATE_SYNTAX_TABLE_BACKWARD (from);
2862 code = Sendcomment;
2863 c2 = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2864 other_syntax = SYNTAX_WITH_FLAGS (c2);
2865 comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax);
2866 comnested |= SYNTAX_FLAGS_COMMENT_NESTED (other_syntax);
2867 }
2868
2869
2870
2871
2872 if (code != Sendcomment && char_quoted (from, from_byte))
2873 {
2874 dec_both (&from, &from_byte);
2875 code = Sword;
2876 }
2877 else if (SYNTAX_FLAGS_PREFIX (syntax))
2878 continue;
2879
2880 switch (code)
2881 {
2882 case Sword:
2883 case Ssymbol:
2884 case Sescape:
2885 case Scharquote:
2886 if (depth || !sexpflag) break;
2887
2888
2889 while (from > stop)
2890 {
2891 temp_pos = dec_bytepos (from_byte);
2892 UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
2893 c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos);
2894
2895 if (syntax_multibyte (c1, multibyte_symbol_p) == Sendcomment)
2896 goto done2;
2897 quoted = char_quoted (from - 1, temp_pos);
2898 if (quoted)
2899 {
2900 dec_both (&from, &from_byte);
2901 temp_pos = dec_bytepos (temp_pos);
2902 UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
2903 }
2904 c1 = FETCH_CHAR_AS_MULTIBYTE (temp_pos);
2905 if (! quoted)
2906 switch (syntax_multibyte (c1, multibyte_symbol_p))
2907 {
2908 case Sword: case Ssymbol: case Squote: break;
2909 default: goto done2;
2910 }
2911 dec_both (&from, &from_byte);
2912 rarely_quit (++quit_count);
2913 }
2914 goto done2;
2915
2916 case Smath:
2917 if (!sexpflag)
2918 break;
2919 if (from > BEGV)
2920 {
2921 temp_pos = dec_bytepos (from_byte);
2922 UPDATE_SYNTAX_TABLE_BACKWARD (from - 1);
2923 if (from != stop && c == FETCH_CHAR_AS_MULTIBYTE (temp_pos))
2924 dec_both (&from, &from_byte);
2925 }
2926 if (mathexit)
2927 {
2928 mathexit = 0;
2929 goto open2;
2930 }
2931 mathexit = 1;
2932 FALLTHROUGH;
2933 case Sclose:
2934 if (!++depth) goto done2;
2935 break;
2936
2937 case Sopen:
2938 open2:
2939 if (!--depth) goto done2;
2940 if (depth < min_depth)
2941 xsignal3 (Qscan_error,
2942 build_string ("Containing expression ends prematurely"),
2943 make_fixnum (last_good), make_fixnum (from));
2944 break;
2945
2946 case Sendcomment:
2947 if (!parse_sexp_ignore_comments)
2948 break;
2949 found = back_comment (from, from_byte, stop, comnested, comstyle,
2950 &out_charpos, &out_bytepos);
2951
2952
2953
2954
2955
2956
2957 if (found)
2958 from = out_charpos, from_byte = out_bytepos;
2959 break;
2960
2961 case Scomment_fence:
2962 case Sstring_fence:
2963 while (1)
2964 {
2965 if (from == stop)
2966 goto lose;
2967 dec_both (&from, &from_byte);
2968 UPDATE_SYNTAX_TABLE_BACKWARD (from);
2969 if (!char_quoted (from, from_byte))
2970 {
2971 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2972 if (syntax_multibyte (c, multibyte_symbol_p) == code)
2973 break;
2974 }
2975 rarely_quit (++quit_count);
2976 }
2977 if (code == Sstring_fence && !depth && sexpflag) goto done2;
2978 break;
2979
2980 case Sstring:
2981 stringterm = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2982 while (true)
2983 {
2984 if (from == stop)
2985 goto lose;
2986 dec_both (&from, &from_byte);
2987 UPDATE_SYNTAX_TABLE_BACKWARD (from);
2988 if (!char_quoted (from, from_byte))
2989 {
2990 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
2991 if (c == stringterm
2992 && (syntax_multibyte (c, multibyte_symbol_p)
2993 == Sstring))
2994 break;
2995 }
2996 rarely_quit (++quit_count);
2997 }
2998 if (!depth && sexpflag) goto done2;
2999 break;
3000 default:
3001
3002 break;
3003 }
3004 }
3005
3006
3007 if (depth)
3008 goto lose;
3009
3010 return Qnil;
3011
3012 done2:
3013 count++;
3014 }
3015
3016
3017 XSETFASTINT (val, from);
3018 return val;
3019
3020 lose:
3021 xsignal3 (Qscan_error,
3022 build_string ("Unbalanced parentheses"),
3023 make_fixnum (last_good), make_fixnum (from));
3024 }
3025
3026 DEFUN ("scan-lists", Fscan_lists, Sscan_lists, 3, 3, 0,
3027 doc:
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044 )
3045 (Lisp_Object from, Lisp_Object count, Lisp_Object depth)
3046 {
3047 CHECK_FIXNUM (from);
3048 CHECK_FIXNUM (count);
3049 CHECK_FIXNUM (depth);
3050
3051 return scan_lists (XFIXNUM (from), XFIXNUM (count), XFIXNUM (depth), 0);
3052 }
3053
3054 DEFUN ("scan-sexps", Fscan_sexps, Sscan_sexps, 2, 2, 0,
3055 doc:
3056
3057
3058
3059
3060
3061
3062
3063
3064 )
3065 (Lisp_Object from, Lisp_Object count)
3066 {
3067 CHECK_FIXNUM (from);
3068 CHECK_FIXNUM (count);
3069
3070 return scan_lists (XFIXNUM (from), XFIXNUM (count), 0, 1);
3071 }
3072
3073 DEFUN ("backward-prefix-chars", Fbackward_prefix_chars, Sbackward_prefix_chars,
3074 0, 0, 0,
3075 doc:
3076
3077 )
3078 (void)
3079 {
3080 ptrdiff_t beg = BEGV;
3081 ptrdiff_t opoint = PT;
3082 ptrdiff_t opoint_byte = PT_BYTE;
3083 ptrdiff_t pos = PT;
3084 ptrdiff_t pos_byte = PT_BYTE;
3085 int c;
3086
3087 if (pos <= beg)
3088 {
3089 SET_PT_BOTH (opoint, opoint_byte);
3090
3091 return Qnil;
3092 }
3093
3094 SETUP_SYNTAX_TABLE (pos, -1);
3095
3096 dec_both (&pos, &pos_byte);
3097
3098 while (!char_quoted (pos, pos_byte)
3099
3100 && ((c = FETCH_CHAR_AS_MULTIBYTE (pos_byte), SYNTAX (c) == Squote)
3101 || syntax_prefix_flag_p (c)))
3102 {
3103 opoint = pos;
3104 opoint_byte = pos_byte;
3105
3106 if (pos <= beg)
3107 break;
3108 dec_both (&pos, &pos_byte);
3109 rarely_quit (pos);
3110 }
3111
3112 SET_PT_BOTH (opoint, opoint_byte);
3113
3114 return Qnil;
3115 }
3116
3117
3118
3119
3120
3121 static bool
3122 in_2char_comment_start (struct lisp_parse_state *state,
3123 int prev_from_syntax,
3124 ptrdiff_t prev_from,
3125 ptrdiff_t from_byte)
3126 {
3127 int c1, syntax;
3128 if (SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax)
3129 && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte),
3130 syntax = SYNTAX_WITH_FLAGS (c1),
3131 SYNTAX_FLAGS_COMSTART_SECOND (syntax)))
3132 {
3133
3134
3135
3136 state->comstyle
3137 = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax);
3138 bool comnested = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax)
3139 | SYNTAX_FLAGS_COMMENT_NESTED (syntax));
3140 state->incomment = comnested ? 1 : -1;
3141 state->comstr_start = prev_from;
3142 return true;
3143 }
3144 return false;
3145 }
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155 static void
3156 scan_sexps_forward (struct lisp_parse_state *state,
3157 ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t end,
3158 EMACS_INT targetdepth, bool stopbefore,
3159 int commentstop)
3160 {
3161 enum syntaxcode code;
3162 struct level { ptrdiff_t last, prev; };
3163 struct level levelstart[100];
3164 struct level *curlevel = levelstart;
3165 struct level *endlevel = levelstart + 100;
3166 EMACS_INT depth;
3167
3168
3169 EMACS_INT mindepth;
3170 bool start_quoted = 0;
3171 Lisp_Object tem;
3172 ptrdiff_t prev_from;
3173 ptrdiff_t prev_from_byte;
3174 int prev_from_syntax, prev_prev_from_syntax;
3175 bool boundary_stop = commentstop == -1;
3176 bool nofence;
3177 bool found;
3178 ptrdiff_t out_bytepos, out_charpos;
3179 int temp;
3180 unsigned short int quit_count = 0;
3181 ptrdiff_t started_from = from;
3182
3183 prev_from = from;
3184 prev_from_byte = from_byte;
3185 if (from != BEGV)
3186 dec_both (&prev_from, &prev_from_byte);
3187
3188
3189 #define INC_FROM \
3190 do { prev_from = from; \
3191 prev_from_byte = from_byte; \
3192 temp = FETCH_CHAR_AS_MULTIBYTE (prev_from_byte); \
3193 prev_prev_from_syntax = prev_from_syntax; \
3194 prev_from_syntax = SYNTAX_WITH_FLAGS (temp); \
3195 inc_both (&from, &from_byte); \
3196 if (from < end) \
3197 UPDATE_SYNTAX_TABLE_FORWARD (from); \
3198 } while (0)
3199
3200 maybe_quit ();
3201
3202 depth = state->depth;
3203 start_quoted = state->quoted;
3204 prev_prev_from_syntax = Smax;
3205 prev_from_syntax = state->prev_syntax;
3206
3207 tem = state->levelstarts;
3208 while (!NILP (tem))
3209 {
3210 Lisp_Object temhd = Fcar (tem);
3211 if (RANGED_FIXNUMP (PTRDIFF_MIN, temhd, PTRDIFF_MAX))
3212 curlevel->last = XFIXNUM (temhd);
3213 if (++curlevel == endlevel)
3214 curlevel--;
3215 curlevel->prev = -1;
3216 curlevel->last = -1;
3217 tem = Fcdr (tem);
3218 }
3219 curlevel->prev = -1;
3220 curlevel->last = -1;
3221
3222 state->quoted = 0;
3223 mindepth = depth;
3224
3225 SETUP_SYNTAX_TABLE (from, 1);
3226
3227
3228
3229 if (state->incomment)
3230 goto startincomment;
3231 if (state->instring >= 0)
3232 {
3233 nofence = state->instring != ST_STRING_STYLE;
3234 if (start_quoted)
3235 goto startquotedinstring;
3236 goto startinstring;
3237 }
3238 else if (start_quoted)
3239 goto startquoted;
3240 else if ((from < end)
3241 && (in_2char_comment_start (state, prev_from_syntax,
3242 prev_from, from_byte)))
3243 {
3244 INC_FROM;
3245 prev_from_syntax = Smax;
3246 goto atcomment;
3247 }
3248
3249 while (from < end)
3250 {
3251 rarely_quit (++quit_count);
3252 INC_FROM;
3253
3254 if ((from < end)
3255 && (in_2char_comment_start (state, prev_from_syntax,
3256 prev_from, from_byte)))
3257 {
3258 INC_FROM;
3259 prev_from_syntax = Smax;
3260 goto atcomment;
3261 }
3262
3263 if (SYNTAX_FLAGS_PREFIX (prev_from_syntax))
3264 continue;
3265 code = prev_from_syntax & 0xff;
3266 switch (code)
3267 {
3268 case Sescape:
3269 case Scharquote:
3270 if (stopbefore) goto stop;
3271 curlevel->last = prev_from;
3272 startquoted:
3273 if (from == end) goto endquoted;
3274 INC_FROM;
3275 goto symstarted;
3276
3277 case Sword:
3278 case Ssymbol:
3279 if (stopbefore) goto stop;
3280 curlevel->last = prev_from;
3281 symstarted:
3282 while (from < end)
3283 {
3284 if (in_2char_comment_start (state, prev_from_syntax,
3285 prev_from, from_byte))
3286 {
3287 INC_FROM;
3288 prev_from_syntax = Smax;
3289 goto atcomment;
3290 }
3291
3292 int symchar = FETCH_CHAR_AS_MULTIBYTE (from_byte);
3293 switch (SYNTAX (symchar))
3294 {
3295 case Scharquote:
3296 case Sescape:
3297 INC_FROM;
3298 if (from == end) goto endquoted;
3299 break;
3300 case Sword:
3301 case Ssymbol:
3302 case Squote:
3303 break;
3304 default:
3305 goto symdone;
3306 }
3307 INC_FROM;
3308 rarely_quit (++quit_count);
3309 }
3310 symdone:
3311 curlevel->prev = curlevel->last;
3312 break;
3313
3314 case Scomment_fence:
3315
3316
3317
3318 state->comstyle = ST_COMMENT_STYLE;
3319 state->incomment = -1;
3320 state->comstr_start = prev_from;
3321 goto atcomment;
3322 case Scomment:
3323 state->comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0);
3324 state->incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ?
3325 1 : -1);
3326 state->comstr_start = prev_from;
3327 atcomment:
3328 if (commentstop || boundary_stop) goto done;
3329 startincomment:
3330
3331
3332
3333
3334 found = forw_comment (from, from_byte, end,
3335 state->incomment, state->comstyle,
3336 from == BEGV ? 0 : prev_from_syntax,
3337 &out_charpos, &out_bytepos, &state->incomment,
3338 &prev_from_syntax);
3339 from = out_charpos; from_byte = out_bytepos;
3340
3341
3342
3343
3344 if (!found)
3345 {
3346 if ((prev_from_syntax & 0xff) == Sescape
3347 || (prev_from_syntax & 0xff) == Scharquote)
3348 goto endquoted;
3349 else
3350 goto done;
3351 }
3352 INC_FROM;
3353 state->incomment = 0;
3354 state->comstyle = 0;
3355 prev_from_syntax = Smax;
3356 if (boundary_stop) goto done;
3357 break;
3358
3359 case Sopen:
3360 if (stopbefore) goto stop;
3361 depth++;
3362
3363 curlevel->last = prev_from;
3364 if (++curlevel == endlevel)
3365 curlevel--;
3366 curlevel->prev = -1;
3367 curlevel->last = -1;
3368 if (targetdepth == depth) goto done;
3369 break;
3370
3371 case Sclose:
3372 depth--;
3373 if (depth < mindepth)
3374 mindepth = depth;
3375 if (curlevel != levelstart)
3376 curlevel--;
3377 curlevel->prev = curlevel->last;
3378 if (targetdepth == depth) goto done;
3379 break;
3380
3381 case Sstring:
3382 case Sstring_fence:
3383 state->comstr_start = from - 1;
3384 if (stopbefore) goto stop;
3385 curlevel->last = prev_from;
3386 state->instring = (code == Sstring
3387 ? (FETCH_CHAR_AS_MULTIBYTE (prev_from_byte))
3388 : ST_STRING_STYLE);
3389 if (boundary_stop) goto done;
3390 startinstring:
3391 {
3392 nofence = state->instring != ST_STRING_STYLE;
3393
3394 while (1)
3395 {
3396 int c;
3397 enum syntaxcode c_code;
3398
3399 if (from >= end) goto done;
3400 c = FETCH_CHAR_AS_MULTIBYTE (from_byte);
3401 c_code = SYNTAX (c);
3402
3403
3404
3405
3406 if (nofence && c == state->instring && c_code == Sstring)
3407 break;
3408
3409 switch (c_code)
3410 {
3411 case Sstring_fence:
3412 if (!nofence) goto string_end;
3413 break;
3414
3415 case Scharquote:
3416 case Sescape:
3417 INC_FROM;
3418 startquotedinstring:
3419 if (from >= end) goto endquoted;
3420 break;
3421
3422 default:
3423 break;
3424 }
3425 INC_FROM;
3426 rarely_quit (++quit_count);
3427 }
3428 }
3429 string_end:
3430 state->instring = -1;
3431 curlevel->prev = curlevel->last;
3432 INC_FROM;
3433 if (boundary_stop) goto done;
3434 break;
3435
3436 case Smath:
3437
3438 break;
3439 default:
3440
3441 break;
3442 }
3443 }
3444 goto done;
3445
3446 stop:
3447 from = prev_from;
3448 from_byte = prev_from_byte;
3449 prev_from_syntax = prev_prev_from_syntax;
3450 goto done;
3451
3452 endquoted:
3453 state->quoted = 1;
3454 done:
3455 state->depth = depth;
3456 state->mindepth = mindepth;
3457 state->thislevelstart = curlevel->prev;
3458 state->prevlevelstart
3459 = (curlevel == levelstart) ? -1 : (curlevel - 1)->last;
3460 state->location = from;
3461 state->location_byte = from_byte;
3462 state->levelstarts = Qnil;
3463 while (curlevel > levelstart)
3464 state->levelstarts = Fcons (make_fixnum ((--curlevel)->last),
3465 state->levelstarts);
3466 state->prev_syntax = (SYNTAX_FLAGS_COMSTARTEND_FIRST (prev_from_syntax)
3467 || state->quoted) ? prev_from_syntax : Smax;
3468
3469
3470
3471
3472
3473 if (max_redisplay_ticks > 0 && from > started_from)
3474 update_redisplay_ticks ((from - started_from) / 10 + 1, NULL);
3475 }
3476
3477
3478
3479 static void
3480 internalize_parse_state (Lisp_Object external, struct lisp_parse_state *state)
3481 {
3482 Lisp_Object tem;
3483
3484 if (NILP (external))
3485 {
3486 state->depth = 0;
3487 state->instring = -1;
3488 state->incomment = 0;
3489 state->quoted = 0;
3490 state->comstyle = 0;
3491 state->comstr_start = -1;
3492 state->levelstarts = Qnil;
3493 state->prev_syntax = Smax;
3494 }
3495 else
3496 {
3497 tem = Fcar (external);
3498 state->depth = FIXNUMP (tem) ? XFIXNUM (tem) : 0;
3499
3500 external = Fcdr (external);
3501 external = Fcdr (external);
3502 external = Fcdr (external);
3503 tem = Fcar (external);
3504
3505 state->instring = (!NILP (tem)
3506 ? (CHARACTERP (tem) ? XFIXNAT (tem) : ST_STRING_STYLE)
3507 : -1);
3508
3509 external = Fcdr (external);
3510 tem = Fcar (external);
3511 state->incomment = (!NILP (tem)
3512 ? (FIXNUMP (tem) ? XFIXNUM (tem) : -1)
3513 : 0);
3514
3515 external = Fcdr (external);
3516 tem = Fcar (external);
3517 state->quoted = !NILP (tem);
3518
3519
3520
3521 external = Fcdr (external);
3522 external = Fcdr (external);
3523 tem = Fcar (external);
3524 state->comstyle = (NILP (tem)
3525 ? 0
3526 : (RANGED_FIXNUMP (0, tem, ST_COMMENT_STYLE)
3527 ? XFIXNUM (tem)
3528 : ST_COMMENT_STYLE));
3529
3530 external = Fcdr (external);
3531 tem = Fcar (external);
3532 state->comstr_start =
3533 RANGED_FIXNUMP (PTRDIFF_MIN, tem, PTRDIFF_MAX) ? XFIXNUM (tem) : -1;
3534 external = Fcdr (external);
3535 tem = Fcar (external);
3536 state->levelstarts = tem;
3537
3538 external = Fcdr (external);
3539 tem = Fcar (external);
3540 state->prev_syntax = NILP (tem) ? Smax : XFIXNUM (tem);
3541 }
3542 }
3543
3544 DEFUN ("parse-partial-sexp", Fparse_partial_sexp, Sparse_partial_sexp, 2, 6, 0,
3545 doc:
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582 )
3583 (Lisp_Object from, Lisp_Object to, Lisp_Object targetdepth,
3584 Lisp_Object stopbefore, Lisp_Object oldstate, Lisp_Object commentstop)
3585 {
3586 struct lisp_parse_state state;
3587 EMACS_INT target;
3588
3589 if (!NILP (targetdepth))
3590 {
3591 CHECK_FIXNUM (targetdepth);
3592 target = XFIXNUM (targetdepth);
3593 }
3594 else
3595 target = TYPE_MINIMUM (EMACS_INT);
3596
3597 if (fix_position (to) < fix_position (from))
3598 error ("End position is smaller than start position");
3599
3600 validate_region (&from, &to);
3601 internalize_parse_state (oldstate, &state);
3602 scan_sexps_forward (&state, XFIXNUM (from), CHAR_TO_BYTE (XFIXNUM (from)),
3603 XFIXNUM (to),
3604 target, !NILP (stopbefore),
3605 (NILP (commentstop)
3606 ? 0 : (EQ (commentstop, Qsyntax_table) ? -1 : 1)));
3607
3608 SET_PT_BOTH (state.location, state.location_byte);
3609
3610 return
3611 Fcons (make_fixnum (state.depth),
3612 Fcons (state.prevlevelstart < 0
3613 ? Qnil : make_fixnum (state.prevlevelstart),
3614 Fcons (state.thislevelstart < 0
3615 ? Qnil : make_fixnum (state.thislevelstart),
3616 Fcons (state.instring >= 0
3617 ? (state.instring == ST_STRING_STYLE
3618 ? Qt : make_fixnum (state.instring)) : Qnil,
3619 Fcons (state.incomment < 0 ? Qt :
3620 (state.incomment == 0 ? Qnil :
3621 make_fixnum (state.incomment)),
3622 Fcons (state.quoted ? Qt : Qnil,
3623 Fcons (make_fixnum (state.mindepth),
3624 Fcons ((state.comstyle
3625 ? (state.comstyle == ST_COMMENT_STYLE
3626 ? Qsyntax_table
3627 : make_fixnum (state.comstyle))
3628 : Qnil),
3629 Fcons (((state.incomment
3630 || (state.instring >= 0))
3631 ? make_fixnum (state.comstr_start)
3632 : Qnil),
3633 Fcons (state.levelstarts,
3634 Fcons (state.prev_syntax == Smax
3635 ? Qnil
3636 : make_fixnum (state.prev_syntax),
3637 Qnil)))))))))));
3638 }
3639
3640 void
3641 init_syntax_once (void)
3642 {
3643 register int i, c;
3644 Lisp_Object temp;
3645
3646
3647 DEFSYM (Qsyntax_table, "syntax-table");
3648
3649
3650 Vsyntax_code_object = make_nil_vector (Smax);
3651 for (i = 0; i < Smax; i++)
3652 ASET (Vsyntax_code_object, i, list1 (make_fixnum (i)));
3653
3654
3655
3656 Fput (Qsyntax_table, Qchar_table_extra_slots, make_fixnum (0));
3657
3658 temp = AREF (Vsyntax_code_object, Swhitespace);
3659
3660 Vstandard_syntax_table = Fmake_char_table (Qsyntax_table, temp);
3661
3662
3663 temp = AREF (Vsyntax_code_object, Spunct);
3664 for (i = 0; i <= ' ' - 1; i++)
3665 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
3666 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 0177, temp);
3667
3668
3669 temp = AREF (Vsyntax_code_object, Swhitespace);
3670 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ' ', temp);
3671 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\t', temp);
3672 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\n', temp);
3673 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 015, temp);
3674 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, 014, temp);
3675
3676 temp = AREF (Vsyntax_code_object, Sword);
3677 for (i = 'a'; i <= 'z'; i++)
3678 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
3679 for (i = 'A'; i <= 'Z'; i++)
3680 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
3681 for (i = '0'; i <= '9'; i++)
3682 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, i, temp);
3683
3684 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '$', temp);
3685 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '%', temp);
3686
3687 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '(',
3688 Fcons (make_fixnum (Sopen), make_fixnum (')')));
3689 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ')',
3690 Fcons (make_fixnum (Sclose), make_fixnum ('(')));
3691 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '[',
3692 Fcons (make_fixnum (Sopen), make_fixnum (']')));
3693 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, ']',
3694 Fcons (make_fixnum (Sclose), make_fixnum ('[')));
3695 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '{',
3696 Fcons (make_fixnum (Sopen), make_fixnum ('}')));
3697 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '}',
3698 Fcons (make_fixnum (Sclose), make_fixnum ('{')));
3699 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '"',
3700 Fcons (make_fixnum (Sstring), Qnil));
3701 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, '\\',
3702 Fcons (make_fixnum (Sescape), Qnil));
3703
3704 temp = AREF (Vsyntax_code_object, Ssymbol);
3705 for (i = 0; i < 10; i++)
3706 {
3707 c = "_-+*/&|<>="[i];
3708 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp);
3709 }
3710
3711 temp = AREF (Vsyntax_code_object, Spunct);
3712 for (i = 0; i < 12; i++)
3713 {
3714 c = ".,;:?!#@~^'`"[i];
3715 SET_RAW_SYNTAX_ENTRY (Vstandard_syntax_table, c, temp);
3716 }
3717
3718
3719 temp = AREF (Vsyntax_code_object, Sword);
3720 char_table_set_range (Vstandard_syntax_table, 0x80, MAX_CHAR, temp);
3721 }
3722
3723 void
3724 syms_of_syntax (void)
3725 {
3726 DEFSYM (Qsyntax_table_p, "syntax-table-p");
3727 DEFSYM (Qsyntax_ppss, "syntax-ppss");
3728 DEFVAR_LISP ("comment-use-syntax-ppss",
3729 Vcomment_use_syntax_ppss,
3730 doc: );
3731 Vcomment_use_syntax_ppss = Qt;
3732
3733 staticpro (&Vsyntax_code_object);
3734
3735 staticpro (&gl_state.object);
3736 staticpro (&gl_state.global_code);
3737 staticpro (&gl_state.current_syntax_table);
3738 staticpro (&gl_state.old_prop);
3739
3740 DEFSYM (Qscan_error, "scan-error");
3741 Fput (Qscan_error, Qerror_conditions,
3742 pure_list (Qscan_error, Qerror));
3743 Fput (Qscan_error, Qerror_message,
3744 build_pure_c_string ("Scan error"));
3745
3746 DEFVAR_BOOL ("parse-sexp-ignore-comments", parse_sexp_ignore_comments,
3747 doc: );
3748
3749 DEFVAR_BOOL ("parse-sexp-lookup-properties", parse_sexp_lookup_properties,
3750 doc:
3751
3752
3753 );
3754
3755 DEFVAR_INT ("syntax-propertize--done", syntax_propertize__done,
3756 doc: );
3757 syntax_propertize__done = -1;
3758 DEFSYM (Qinternal__syntax_propertize, "internal--syntax-propertize");
3759 Fmake_variable_buffer_local (intern ("syntax-propertize--done"));
3760
3761 words_include_escapes = 0;
3762 DEFVAR_BOOL ("words-include-escapes", words_include_escapes,
3763 doc: );
3764
3765 DEFVAR_BOOL ("multibyte-syntax-as-symbol", multibyte_syntax_as_symbol,
3766 doc: );
3767 multibyte_syntax_as_symbol = 0;
3768
3769 DEFVAR_BOOL ("open-paren-in-column-0-is-defun-start",
3770 open_paren_in_column_0_is_defun_start,
3771 doc: );
3772 open_paren_in_column_0_is_defun_start = 1;
3773
3774
3775 DEFVAR_LISP ("find-word-boundary-function-table",
3776 Vfind_word_boundary_function_table,
3777 doc:
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790 );
3791 Vfind_word_boundary_function_table = Fmake_char_table (Qnil, Qnil);
3792
3793 DEFVAR_BOOL ("comment-end-can-be-escaped", comment_end_can_be_escaped,
3794 doc: );
3795 comment_end_can_be_escaped = false;
3796 DEFSYM (Qcomment_end_can_be_escaped, "comment-end-can-be-escaped");
3797 Fmake_variable_buffer_local (Qcomment_end_can_be_escaped);
3798
3799 defsubr (&Ssyntax_table_p);
3800 defsubr (&Ssyntax_table);
3801 defsubr (&Sstandard_syntax_table);
3802 defsubr (&Scopy_syntax_table);
3803 defsubr (&Sset_syntax_table);
3804 defsubr (&Schar_syntax);
3805 defsubr (&Ssyntax_class_to_char);
3806 defsubr (&Smatching_paren);
3807 defsubr (&Sstring_to_syntax);
3808 defsubr (&Smodify_syntax_entry);
3809 defsubr (&Sinternal_describe_syntax_value);
3810
3811 defsubr (&Sforward_word);
3812
3813 defsubr (&Sskip_chars_forward);
3814 defsubr (&Sskip_chars_backward);
3815 defsubr (&Sskip_syntax_forward);
3816 defsubr (&Sskip_syntax_backward);
3817
3818 defsubr (&Sforward_comment);
3819 defsubr (&Sscan_lists);
3820 defsubr (&Sscan_sexps);
3821 defsubr (&Sbackward_prefix_chars);
3822 defsubr (&Sparse_partial_sexp);
3823 }