XEmacs 21.2.9
[chise/xemacs-chise.git.1] / src / search.c
1 /* String search routines for XEmacs.
2    Copyright (C) 1985, 1986, 1987, 1992-1995 Free Software Foundation, Inc.
3    Copyright (C) 1995 Sun Microsystems, Inc.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING.  If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA.  */
21
22 /* Synched up with: FSF 19.29, except for region-cache stuff. */
23
24 /* Hacked on for Mule by Ben Wing, December 1994 and August 1995. */
25
26 /* This file has been Mule-ized except for the TRT stuff. */
27
28 #include <config.h>
29 #include "lisp.h"
30
31 #include "buffer.h"
32 #include "insdel.h"
33 #include "opaque.h"
34 #ifdef REGION_CACHE_NEEDS_WORK
35 #include "region-cache.h"
36 #endif
37 #include "syntax.h"
38
39 #include <sys/types.h>
40 #include "regex.h"
41
42 \f
43 #define REGEXP_CACHE_SIZE 20
44
45 /* If the regexp is non-nil, then the buffer contains the compiled form
46    of that regexp, suitable for searching.  */
47 struct regexp_cache {
48   struct regexp_cache *next;
49   Lisp_Object regexp;
50   struct re_pattern_buffer buf;
51   char fastmap[0400];
52   /* Nonzero means regexp was compiled to do full POSIX backtracking.  */
53   char posix;
54 };
55
56 /* The instances of that struct.  */
57 struct regexp_cache searchbufs[REGEXP_CACHE_SIZE];
58
59 /* The head of the linked list; points to the most recently used buffer.  */
60 struct regexp_cache *searchbuf_head;
61
62
63 /* Every call to re_match, etc., must pass &search_regs as the regs
64    argument unless you can show it is unnecessary (i.e., if re_match
65    is certainly going to be called again before region-around-match
66    can be called).
67
68    Since the registers are now dynamically allocated, we need to make
69    sure not to refer to the Nth register before checking that it has
70    been allocated by checking search_regs.num_regs.
71
72    The regex code keeps track of whether it has allocated the search
73    buffer using bits in the re_pattern_buffer.  This means that whenever
74    you compile a new pattern, it completely forgets whether it has
75    allocated any registers, and will allocate new registers the next
76    time you call a searching or matching function.  Therefore, we need
77    to call re_set_registers after compiling a new pattern or after
78    setting the match registers, so that the regex functions will be
79    able to free or re-allocate it properly.  */
80
81 /* Note: things get trickier under Mule because the values returned from
82    the regexp routines are in Bytinds but we need them to be in Bufpos's.
83    We take the easy way out for the moment and just convert them immediately.
84    We could be more clever by not converting them until necessary, but
85    that gets real ugly real fast since the buffer might have changed and
86    the positions might be out of sync or out of range.
87    */
88 static struct re_registers search_regs;
89
90 /* The buffer in which the last search was performed, or
91    Qt if the last search was done in a string;
92    Qnil if no searching has been done yet.  */
93 static Lisp_Object last_thing_searched;
94
95 /* error condition signalled when regexp compile_pattern fails */
96
97 Lisp_Object Qinvalid_regexp;
98
99 /* Regular expressions used in forward/backward-word */
100 Lisp_Object Vforward_word_regexp, Vbackward_word_regexp;
101
102 /* range table for use with skip_chars.  Only needed for Mule. */
103 Lisp_Object Vskip_chars_range_table;
104
105 static void set_search_regs (struct buffer *buf, Bufpos beg, Charcount len);
106 static void save_search_regs (void);
107 static Bufpos search_buffer (struct buffer *buf, Lisp_Object str,
108                              Bufpos bufpos, Bufpos buflim, EMACS_INT n, int RE,
109                              unsigned char *trt, unsigned char *inverse_trt,
110                              int posix);
111
112 static void
113 matcher_overflow (void)
114 {
115   error ("Stack overflow in regexp matcher");
116 }
117
118 /* Compile a regexp and signal a Lisp error if anything goes wrong.
119    PATTERN is the pattern to compile.
120    CP is the place to put the result.
121    TRANSLATE is a translation table for ignoring case, or NULL for none.
122    REGP is the structure that says where to store the "register"
123    values that will result from matching this pattern.
124    If it is 0, we should compile the pattern not to record any
125    subexpression bounds.
126    POSIX is nonzero if we want full backtracking (POSIX style)
127    for this pattern.  0 means backtrack only enough to get a valid match.  */
128
129 static int
130 compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern,
131                    char *translate, struct re_registers *regp, int posix,
132                    Error_behavior errb)
133 {
134   CONST char *val;
135   reg_syntax_t old;
136
137   cp->regexp = Qnil;
138   cp->buf.translate = translate;
139   cp->posix = posix;
140   old = re_set_syntax (RE_SYNTAX_EMACS
141                        | (posix ? 0 : RE_NO_POSIX_BACKTRACKING));
142   val = (CONST char *)
143     re_compile_pattern ((char *) XSTRING_DATA (pattern),
144                         XSTRING_LENGTH (pattern), &cp->buf);
145   re_set_syntax (old);
146   if (val)
147     {
148       maybe_signal_error (Qinvalid_regexp, list1 (build_string (val)),
149                           Qsearch, errb);
150       return 0;
151     }
152
153   cp->regexp = Fcopy_sequence (pattern);
154   return 1;
155 }
156
157 /* Compile a regexp if necessary, but first check to see if there's one in
158    the cache.
159    PATTERN is the pattern to compile.
160    TRANSLATE is a translation table for ignoring case, or NULL for none.
161    REGP is the structure that says where to store the "register"
162    values that will result from matching this pattern.
163    If it is 0, we should compile the pattern not to record any
164    subexpression bounds.
165    POSIX is nonzero if we want full backtracking (POSIX style)
166    for this pattern.  0 means backtrack only enough to get a valid match.  */
167
168 struct re_pattern_buffer *
169 compile_pattern (Lisp_Object pattern, struct re_registers *regp,
170                  char *translate, int posix, Error_behavior errb)
171 {
172   struct regexp_cache *cp, **cpp;
173
174   for (cpp = &searchbuf_head; ; cpp = &cp->next)
175     {
176       cp = *cpp;
177       if (!NILP (Fstring_equal (cp->regexp, pattern))
178           && cp->buf.translate == translate
179           && cp->posix == posix)
180         break;
181
182       /* If we're at the end of the cache, compile into the last cell.  */
183       if (cp->next == 0)
184         {
185           if (!compile_pattern_1 (cp, pattern, translate, regp, posix,
186                                   errb))
187             return 0;
188           break;
189         }
190     }
191
192   /* When we get here, cp (aka *cpp) contains the compiled pattern,
193      either because we found it in the cache or because we just compiled it.
194      Move it to the front of the queue to mark it as most recently used.  */
195   *cpp = cp->next;
196   cp->next = searchbuf_head;
197   searchbuf_head = cp;
198
199   /* Advise the searching functions about the space we have allocated
200      for register data.  */
201   if (regp)
202     re_set_registers (&cp->buf, regp, regp->num_regs, regp->start, regp->end);
203
204   return &cp->buf;
205 }
206
207 /* Error condition used for failing searches */
208 Lisp_Object Qsearch_failed;
209
210 static Lisp_Object
211 signal_failure (Lisp_Object arg)
212 {
213   Fsignal (Qsearch_failed, list1 (arg));
214   return Qnil;
215 }
216
217 /* Convert the search registers from Bytinds to Bufpos's.  Needs to be
218    done after each regexp match that uses the search regs.
219
220    We could get a potential speedup by not converting the search registers
221    until it's really necessary, e.g. when match-data or replace-match is
222    called.  However, this complexifies the code a lot (e.g. the buffer
223    could have changed and the Bytinds stored might be invalid) and is
224    probably not a great time-saver. */
225
226 static void
227 fixup_search_regs_for_buffer (struct buffer *buf)
228 {
229   int i;
230   int num_regs = search_regs.num_regs;
231
232   for (i = 0; i < num_regs; i++)
233     {
234       if (search_regs.start[i] >= 0)
235         search_regs.start[i] = bytind_to_bufpos (buf, search_regs.start[i]);
236       if (search_regs.end[i] >= 0)
237         search_regs.end[i] = bytind_to_bufpos (buf, search_regs.end[i]);
238     }
239 }
240
241 /* Similar but for strings. */
242 static void
243 fixup_search_regs_for_string (Lisp_Object string)
244 {
245   int i;
246   int num_regs = search_regs.num_regs;
247
248   /* #### bytecount_to_charcount() is not that efficient.  This function
249      could be faster if it did its own conversion (using INC_CHARPTR()
250      and such), because the register ends are likely to be somewhat ordered.
251      (Even if not, you could sort them.)
252
253      Think about this if this function is a time hog, which it's probably
254      not. */
255   for (i = 0; i < num_regs; i++)
256     {
257       if (search_regs.start[i] > 0)
258         {
259           search_regs.start[i] =
260             bytecount_to_charcount (XSTRING_DATA (string),
261                                     search_regs.start[i]);
262         }
263       if (search_regs.end[i] > 0)
264         {
265           search_regs.end[i] =
266             bytecount_to_charcount (XSTRING_DATA (string),
267                                     search_regs.end[i]);
268         }
269     }
270 }
271
272 \f
273 static Lisp_Object
274 looking_at_1 (Lisp_Object string, struct buffer *buf, int posix)
275 {
276   /* This function has been Mule-ized, except for the trt table handling. */
277   Lisp_Object val;
278   Bytind p1, p2;
279   Bytecount s1, s2;
280   REGISTER int i;
281   struct re_pattern_buffer *bufp;
282
283   if (running_asynch_code)
284     save_search_regs ();
285
286   CHECK_STRING (string);
287   bufp = compile_pattern (string, &search_regs,
288                           (!NILP (buf->case_fold_search)
289                            ? (char *) MIRROR_DOWNCASE_TABLE_AS_STRING (buf)
290                            : 0),
291                           posix, ERROR_ME);
292
293   QUIT;
294
295   /* Get pointers and sizes of the two strings
296      that make up the visible portion of the buffer. */
297
298   p1 = BI_BUF_BEGV (buf);
299   p2 = BI_BUF_CEILING_OF (buf, p1);
300   s1 = p2 - p1;
301   s2 = BI_BUF_ZV (buf) - p2;
302
303   regex_emacs_buffer = buf;
304   i = re_match_2 (bufp, (char *) BI_BUF_BYTE_ADDRESS (buf, p1),
305                   s1, (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2,
306                   BI_BUF_PT (buf) - BI_BUF_BEGV (buf), &search_regs,
307                   BI_BUF_ZV (buf) - BI_BUF_BEGV (buf));
308
309   if (i == -2)
310     matcher_overflow ();
311
312   val = (0 <= i ? Qt : Qnil);
313   if (NILP (val))
314     return Qnil;
315   {
316     int num_regs = search_regs.num_regs;
317     for (i = 0; i < num_regs; i++)
318       if (search_regs.start[i] >= 0)
319         {
320           search_regs.start[i] += BI_BUF_BEGV (buf);
321           search_regs.end[i] += BI_BUF_BEGV (buf);
322         }
323   }
324   XSETBUFFER (last_thing_searched, buf);
325   fixup_search_regs_for_buffer (buf);
326   return val;
327 }
328
329 DEFUN ("looking-at", Flooking_at, 1, 2, 0, /*
330 Return t if text after point matches regular expression REGEXP.
331 This function modifies the match data that `match-beginning',
332 `match-end' and `match-data' access; save and restore the match
333 data if you want to preserve them.
334
335 Optional argument BUFFER defaults to the current buffer.
336 */
337        (regexp, buffer))
338 {
339   return looking_at_1 (regexp, decode_buffer (buffer, 0), 0);
340 }
341
342 DEFUN ("posix-looking-at", Fposix_looking_at, 1, 2, 0, /*
343 Return t if text after point matches regular expression REGEXP.
344 Find the longest match, in accord with Posix regular expression rules.
345 This function modifies the match data that `match-beginning',
346 `match-end' and `match-data' access; save and restore the match
347 data if you want to preserve them.
348
349 Optional argument BUFFER defaults to the current buffer.
350 */
351        (regexp, buffer))
352 {
353   return looking_at_1 (regexp,  decode_buffer (buffer, 0), 1);
354 }
355 \f
356 static Lisp_Object
357 string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start,
358                 struct buffer *buf, int posix)
359 {
360   /* This function has been Mule-ized, except for the trt table handling. */
361   Bytecount val;
362   Charcount s;
363   struct re_pattern_buffer *bufp;
364
365   if (running_asynch_code)
366     save_search_regs ();
367
368   CHECK_STRING (regexp);
369   CHECK_STRING (string);
370
371   if (NILP (start))
372     s = 0;
373   else
374     {
375       Charcount len = XSTRING_CHAR_LENGTH (string);
376
377       CHECK_INT (start);
378       s = XINT (start);
379       if (s < 0 && -s <= len)
380         s = len + s;
381       else if (0 > s || s > len)
382         args_out_of_range (string, start);
383     }
384
385
386   bufp = compile_pattern (regexp, &search_regs,
387                           (!NILP (buf->case_fold_search)
388                            ? (char *) MIRROR_DOWNCASE_TABLE_AS_STRING (buf)
389                            : 0), 0, ERROR_ME);
390   QUIT;
391   {
392     Bytecount bis = charcount_to_bytecount (XSTRING_DATA (string), s);
393     regex_emacs_buffer = buf;
394     val = re_search (bufp, (char *) XSTRING_DATA (string),
395                      XSTRING_LENGTH (string), bis,
396                      XSTRING_LENGTH (string) - bis,
397                      &search_regs);
398   }
399   if (val == -2)
400     matcher_overflow ();
401   if (val < 0) return Qnil;
402   last_thing_searched = Qt;
403   fixup_search_regs_for_string (string);
404   return make_int (bytecount_to_charcount (XSTRING_DATA (string), val));
405 }
406
407 DEFUN ("string-match", Fstring_match, 2, 4, 0, /*
408 Return index of start of first match for REGEXP in STRING, or nil.
409 If third arg START is non-nil, start search at that index in STRING.
410 For index of first char beyond the match, do (match-end 0).
411 `match-end' and `match-beginning' also give indices of substrings
412 matched by parenthesis constructs in the pattern.
413
414 Optional arg BUFFER controls how case folding is done (according to
415 the value of `case-fold-search' in that buffer and that buffer's case
416 tables) and defaults to the current buffer.
417 */
418        (regexp, string, start, buffer))
419 {
420   return string_match_1 (regexp, string, start, decode_buffer (buffer, 0), 0);
421 }
422
423 DEFUN ("posix-string-match", Fposix_string_match, 2, 4, 0, /*
424 Return index of start of first match for REGEXP in STRING, or nil.
425 Find the longest match, in accord with Posix regular expression rules.
426 If third arg START is non-nil, start search at that index in STRING.
427 For index of first char beyond the match, do (match-end 0).
428 `match-end' and `match-beginning' also give indices of substrings
429 matched by parenthesis constructs in the pattern.
430
431 Optional arg BUFFER controls how case folding is done (according to
432 the value of `case-fold-search' in that buffer and that buffer's case
433 tables) and defaults to the current buffer.
434 */
435        (regexp, string, start, buffer))
436 {
437   return string_match_1 (regexp, string, start, decode_buffer (buffer, 0), 1);
438 }
439
440 /* Match REGEXP against STRING, searching all of STRING,
441    and return the index of the match, or negative on failure.
442    This does not clobber the match data. */
443
444 Bytecount
445 fast_string_match (Lisp_Object regexp,  CONST Bufbyte *nonreloc,
446                    Lisp_Object reloc, Bytecount offset,
447                    Bytecount length, int case_fold_search,
448                    Error_behavior errb, int no_quit)
449 {
450   /* This function has been Mule-ized, except for the trt table handling. */
451   Bytecount val;
452   Bufbyte *newnonreloc = (Bufbyte *) nonreloc;
453   struct re_pattern_buffer *bufp;
454
455   bufp = compile_pattern (regexp, 0,
456                           (case_fold_search
457                            ? (char *)
458                            /* #### evil current-buffer dependency */
459                            MIRROR_DOWNCASE_TABLE_AS_STRING (current_buffer)
460                            : 0),
461                           0, errb);
462   if (!bufp)
463     return -1; /* will only do this when errb != ERROR_ME */
464   if (!no_quit)
465     QUIT;
466   else
467     no_quit_in_re_search = 1;
468
469   fixup_internal_substring (nonreloc, reloc, offset, &length);
470
471   if (!NILP (reloc))
472     {
473       if (no_quit)
474         newnonreloc = XSTRING_DATA (reloc);
475       else
476         {
477           /* QUIT could relocate RELOC.  Therefore we must alloca()
478              and copy.  No way around this except some serious
479              rewriting of re_search(). */
480           newnonreloc = (Bufbyte *) alloca (length);
481           memcpy (newnonreloc, XSTRING_DATA (reloc), length);
482         }
483     }
484
485   /* #### evil current-buffer dependency */
486   regex_emacs_buffer = current_buffer;
487   val = re_search (bufp, (char *) newnonreloc + offset, length, 0,
488                    length, 0);
489
490   no_quit_in_re_search = 0;
491   return val;
492 }
493
494 Bytecount
495 fast_lisp_string_match (Lisp_Object regex, Lisp_Object string)
496 {
497   return fast_string_match (regex, 0, string, 0, -1, 0, ERROR_ME, 0);
498 }
499
500 \f
501 #ifdef REGION_CACHE_NEEDS_WORK
502 /* The newline cache: remembering which sections of text have no newlines.  */
503
504 /* If the user has requested newline caching, make sure it's on.
505    Otherwise, make sure it's off.
506    This is our cheezy way of associating an action with the change of
507    state of a buffer-local variable.  */
508 static void
509 newline_cache_on_off (struct buffer *buf)
510 {
511   if (NILP (buf->cache_long_line_scans))
512     {
513       /* It should be off.  */
514       if (buf->newline_cache)
515         {
516           free_region_cache (buf->newline_cache);
517           buf->newline_cache = 0;
518         }
519     }
520   else
521     {
522       /* It should be on.  */
523       if (buf->newline_cache == 0)
524         buf->newline_cache = new_region_cache ();
525     }
526 }
527 #endif
528 \f
529 /* Search in BUF for COUNT instances of the character TARGET between
530    START and END.
531
532    If COUNT is positive, search forwards; END must be >= START.
533    If COUNT is negative, search backwards for the -COUNTth instance;
534       END must be <= START.
535    If COUNT is zero, do anything you please; run rogue, for all I care.
536
537    If END is zero, use BEGV or ZV instead, as appropriate for the
538    direction indicated by COUNT.
539
540    If we find COUNT instances, set *SHORTAGE to zero, and return the
541    position after the COUNTth match.  Note that for reverse motion
542    this is not the same as the usual convention for Emacs motion commands.
543
544    If we don't find COUNT instances before reaching END, set *SHORTAGE
545    to the number of TARGETs left unfound, and return END.
546
547    If ALLOW_QUIT is non-zero, call QUIT periodically. */
548
549 static Bytind
550 bi_scan_buffer (struct buffer *buf, Emchar target, Bytind st, Bytind en,
551                 EMACS_INT count, EMACS_INT *shortage, int allow_quit)
552 {
553   /* This function has been Mule-ized. */
554   Bytind lim = en > 0 ? en :
555     ((count > 0) ? BI_BUF_ZV (buf) : BI_BUF_BEGV (buf));
556
557   /* #### newline cache stuff in this function not yet ported */
558
559   assert (count != 0);
560
561   if (shortage)
562     *shortage = 0;
563
564   if (count > 0)
565     {
566 #ifdef MULE
567       /* Due to the Mule representation of characters in a buffer,
568          we can simply search for characters in the range 0 - 127
569          directly.  For other characters, we do it the "hard" way.
570          Note that this way works for all characters but the other
571          way is faster. */
572       if (target >= 0200)
573         {
574           while (st < lim && count > 0)
575             {
576               if (BI_BUF_FETCH_CHAR (buf, st) == target)
577                 count--;
578               INC_BYTIND (buf, st);
579             }
580         }
581       else
582 #endif
583         {
584           while (st < lim && count > 0)
585             {
586               Bytind ceil;
587               Bufbyte *bufptr;
588
589               ceil = BI_BUF_CEILING_OF (buf, st);
590               ceil = min (lim, ceil);
591               bufptr = (Bufbyte *) memchr (BI_BUF_BYTE_ADDRESS (buf, st),
592                                            (int) target, ceil - st);
593               if (bufptr)
594                 {
595                   count--;
596                   st = BI_BUF_PTR_BYTE_POS (buf, bufptr) + 1;
597                 }
598               else
599                 st = ceil;
600             }
601         }
602
603       if (shortage)
604         *shortage = count;
605       if (allow_quit)
606         QUIT;
607       return st;
608     }
609   else
610     {
611 #ifdef MULE
612       if (target >= 0200)
613         {
614           while (st > lim && count < 0)
615             {
616               DEC_BYTIND (buf, st);
617               if (BI_BUF_FETCH_CHAR (buf, st) == target)
618                 count++;
619             }
620         }
621       else
622 #endif
623         {
624           while (st > lim && count < 0)
625             {
626               Bytind floor;
627               Bufbyte *bufptr;
628               Bufbyte *floorptr;
629
630               floor = BI_BUF_FLOOR_OF (buf, st);
631               floor = max (lim, floor);
632               /* No memrchr() ... */
633               bufptr = BI_BUF_BYTE_ADDRESS_BEFORE (buf, st);
634               floorptr = BI_BUF_BYTE_ADDRESS (buf, floor);
635               while (bufptr >= floorptr)
636                 {
637                   st--;
638                   /* At this point, both ST and BUFPTR refer to the same
639                      character.  When the loop terminates, ST will
640                      always point to the last character we tried. */
641                   if (* (unsigned char *) bufptr == (unsigned char) target)
642                     {
643                       count++;
644                       break;
645                     }
646                   bufptr--;
647                 }
648             }
649         }
650
651       if (shortage)
652         *shortage = -count;
653       if (allow_quit)
654         QUIT;
655       if (count)
656         return st;
657       else
658         {
659         /* We found the character we were looking for; we have to return
660            the position *after* it due to the strange way that the return
661            value is defined. */
662           INC_BYTIND (buf, st);
663           return st;
664         }
665     }
666 }
667
668 Bufpos
669 scan_buffer (struct buffer *buf, Emchar target, Bufpos start, Bufpos end,
670              EMACS_INT count, EMACS_INT *shortage, int allow_quit)
671 {
672   Bytind bi_retval;
673   Bytind bi_start, bi_end;
674
675   bi_start = bufpos_to_bytind (buf, start);
676   if (end)
677     bi_end = bufpos_to_bytind (buf, end);
678   else
679     bi_end = 0;
680   bi_retval = bi_scan_buffer (buf, target, bi_start, bi_end, count,
681                               shortage, allow_quit);
682   return bytind_to_bufpos (buf, bi_retval);
683 }
684
685 Bytind
686 bi_find_next_newline_no_quit (struct buffer *buf, Bytind from, int count)
687 {
688   return bi_scan_buffer (buf, '\n', from, 0, count, 0, 0);
689 }
690
691 Bufpos
692 find_next_newline_no_quit (struct buffer *buf, Bufpos from, int count)
693 {
694   return scan_buffer (buf, '\n', from, 0, count, 0, 0);
695 }
696
697 Bufpos
698 find_next_newline (struct buffer *buf, Bufpos from, int count)
699 {
700   return scan_buffer (buf, '\n', from, 0, count, 0, 1);
701 }
702
703 /* Like find_next_newline, but returns position before the newline,
704    not after, and only search up to TO.  This isn't just
705    find_next_newline (...)-1, because you might hit TO.  */
706 Bufpos
707 find_before_next_newline (struct buffer *buf, Bufpos from, Bufpos to, int count)
708 {
709   EMACS_INT shortage;
710   Bufpos pos = scan_buffer (buf, '\n', from, to, count, &shortage, 1);
711
712   if (shortage == 0)
713     pos--;
714
715   return pos;
716 }
717 \f
718 static Lisp_Object
719 skip_chars (struct buffer *buf, int forwardp, int syntaxp,
720             Lisp_Object string, Lisp_Object lim)
721 {
722   /* This function has been Mule-ized. */
723   REGISTER Bufbyte *p, *pend;
724   REGISTER Emchar c;
725   /* We store the first 256 chars in an array here and the rest in
726      a range table. */
727   unsigned char fastmap[0400];
728   int negate = 0;
729   REGISTER int i;
730   struct Lisp_Char_Table *syntax_table =
731     XCHAR_TABLE (buf->mirror_syntax_table);
732   Bufpos limit;
733
734   if (NILP (lim))
735     limit = forwardp ? BUF_ZV (buf) : BUF_BEGV (buf);
736   else
737     {
738       CHECK_INT_COERCE_MARKER (lim);
739       limit = XINT (lim);
740
741       /* In any case, don't allow scan outside bounds of buffer.  */
742       if (limit > BUF_ZV   (buf)) limit = BUF_ZV   (buf);
743       if (limit < BUF_BEGV (buf)) limit = BUF_BEGV (buf);
744     }
745
746   CHECK_STRING (string);
747   p = XSTRING_DATA (string);
748   pend = p + XSTRING_LENGTH (string);
749   memset (fastmap, 0, sizeof (fastmap));
750
751   Fclear_range_table (Vskip_chars_range_table);
752
753   if (p != pend && *p == '^')
754     {
755       negate = 1;
756       p++;
757     }
758
759   /* Find the characters specified and set their elements of fastmap.
760      If syntaxp, each character counts as itself.
761      Otherwise, handle backslashes and ranges specially  */
762
763   while (p != pend)
764     {
765       c = charptr_emchar (p);
766       INC_CHARPTR (p);
767       if (syntaxp)
768         {
769           if (c < 0400 && syntax_spec_code[c] < (unsigned char) Smax)
770             fastmap[c] = 1;
771           else
772             signal_simple_error ("Invalid syntax designator",
773                                  make_char (c));
774         }
775       else
776         {
777           if (c == '\\')
778             {
779               if (p == pend) break;
780               c = charptr_emchar (p);
781               INC_CHARPTR (p);
782             }
783           if (p != pend && *p == '-')
784             {
785               Emchar cend;
786
787               p++;
788               if (p == pend) break;
789               cend = charptr_emchar (p);
790               while (c <= cend && c < 0400)
791                 {
792                   fastmap[c] = 1;
793                   c++;
794                 }
795               if (c <= cend)
796                 Fput_range_table (make_int (c), make_int (cend), Qt,
797                                   Vskip_chars_range_table);
798               INC_CHARPTR (p);
799             }
800           else
801             {
802               if (c < 0400)
803                 fastmap[c] = 1;
804               else
805                 Fput_range_table (make_int (c), make_int (c), Qt,
806                                   Vskip_chars_range_table);
807             }
808         }
809     }
810
811   if (syntaxp && fastmap['-'] != 0)
812     fastmap[' '] = 1;
813
814   /* If ^ was the first character, complement the fastmap.
815      We don't complement the range table, however; we just use negate
816      in the comparisons below. */
817
818   if (negate)
819     for (i = 0; i < (int) (sizeof fastmap); i++)
820       fastmap[i] ^= 1;
821
822   {
823     Bufpos start_point = BUF_PT (buf);
824
825     if (syntaxp)
826       {
827         /* All syntax designators are normal chars so nothing strange
828            to worry about */
829         if (forwardp)
830           {
831             while (BUF_PT (buf) < limit
832                    && fastmap[(unsigned char)
833                               syntax_code_spec
834                               [(int) SYNTAX (syntax_table,
835                                              BUF_FETCH_CHAR
836                                              (buf, BUF_PT (buf)))]])
837               BUF_SET_PT (buf, BUF_PT (buf) + 1);
838           }
839         else
840           {
841             while (BUF_PT (buf) > limit
842                    && fastmap[(unsigned char)
843                               syntax_code_spec
844                               [(int) SYNTAX (syntax_table,
845                                              BUF_FETCH_CHAR
846                                              (buf, BUF_PT (buf) - 1))]])
847               BUF_SET_PT (buf, BUF_PT (buf) - 1);
848           }
849       }
850     else
851       {
852         if (forwardp)
853           {
854             while (BUF_PT (buf) < limit)
855               {
856                 Emchar ch = BUF_FETCH_CHAR (buf, BUF_PT (buf));
857                 if ((ch < 0400) ? fastmap[ch] :
858                     (NILP (Fget_range_table (make_int (ch),
859                                              Vskip_chars_range_table,
860                                              Qnil))
861                      == negate))
862                   BUF_SET_PT (buf, BUF_PT (buf) + 1);
863                 else
864                   break;
865               }
866           }
867         else
868           {
869             while (BUF_PT (buf) > limit)
870               {
871                 Emchar ch = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1);
872                 if ((ch < 0400) ? fastmap[ch] :
873                     (NILP (Fget_range_table (make_int (ch),
874                                              Vskip_chars_range_table,
875                                              Qnil))
876                      == negate))
877                   BUF_SET_PT (buf, BUF_PT (buf) - 1);
878                 else
879                   break;
880               }
881           }
882       }
883     QUIT;
884     return make_int (BUF_PT (buf) - start_point);
885   }
886 }
887
888 DEFUN ("skip-chars-forward", Fskip_chars_forward, 1, 3, 0, /*
889 Move point forward, stopping before a char not in STRING, or at pos LIM.
890 STRING is like the inside of a `[...]' in a regular expression
891 except that `]' is never special and `\\' quotes `^', `-' or `\\'.
892 Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter.
893 With arg "^a-zA-Z", skips nonletters stopping before first letter.
894 Returns the distance traveled, either zero or positive.
895
896 Optional argument BUFFER defaults to the current buffer.
897 */
898        (string, lim, buffer))
899 {
900   return skip_chars (decode_buffer (buffer, 0), 1, 0, string, lim);
901 }
902
903 DEFUN ("skip-chars-backward", Fskip_chars_backward, 1, 3, 0, /*
904 Move point backward, stopping after a char not in STRING, or at pos LIM.
905 See `skip-chars-forward' for details.
906 Returns the distance traveled, either zero or negative.
907
908 Optional argument BUFFER defaults to the current buffer.
909 */
910        (string, lim, buffer))
911 {
912   return skip_chars (decode_buffer (buffer, 0), 0, 0, string, lim);
913 }
914
915
916 DEFUN ("skip-syntax-forward", Fskip_syntax_forward, 1, 3, 0, /*
917 Move point forward across chars in specified syntax classes.
918 SYNTAX is a string of syntax code characters.
919 Stop before a char whose syntax is not in SYNTAX, or at position LIM.
920 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
921 This function returns the distance traveled, either zero or positive.
922
923 Optional argument BUFFER defaults to the current buffer.
924 */
925        (syntax, lim, buffer))
926 {
927   return skip_chars (decode_buffer (buffer, 0), 1, 1, syntax, lim);
928 }
929
930 DEFUN ("skip-syntax-backward", Fskip_syntax_backward, 1, 3, 0, /*
931 Move point backward across chars in specified syntax classes.
932 SYNTAX is a string of syntax code characters.
933 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.
934 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
935 This function returns the distance traveled, either zero or negative.
936
937 Optional argument BUFFER defaults to the current buffer.
938 */
939        (syntax, lim, buffer))
940 {
941   return skip_chars (decode_buffer (buffer, 0), 0, 1, syntax, lim);
942 }
943
944 \f
945 /* Subroutines of Lisp buffer search functions. */
946
947 static Lisp_Object
948 search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object no_error,
949                 Lisp_Object count, Lisp_Object buffer, int direction,
950                 int RE, int posix)
951 {
952   /* This function has been Mule-ized, except for the trt table handling. */
953   REGISTER Bufpos np;
954   Bufpos lim;
955   EMACS_INT n = direction;
956   struct buffer *buf;
957
958   if (!NILP (count))
959     {
960       CHECK_INT (count);
961       n *= XINT (count);
962     }
963
964   buf = decode_buffer (buffer, 0);
965   CHECK_STRING (string);
966   if (NILP (bound))
967     lim = n > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
968   else
969     {
970       CHECK_INT_COERCE_MARKER (bound);
971       lim = XINT (bound);
972       if (n > 0 ? lim < BUF_PT (buf) : lim > BUF_PT (buf))
973         error ("Invalid search bound (wrong side of point)");
974       if (lim > BUF_ZV (buf))
975         lim = BUF_ZV (buf);
976       if (lim < BUF_BEGV (buf))
977         lim = BUF_BEGV (buf);
978     }
979
980   np = search_buffer (buf, string, BUF_PT (buf), lim, n, RE,
981                       (!NILP (buf->case_fold_search)
982                        ? MIRROR_CANON_TABLE_AS_STRING (buf)
983                        : 0),
984                       (!NILP (buf->case_fold_search)
985                        ? MIRROR_EQV_TABLE_AS_STRING (buf)
986                        : 0), posix);
987
988   if (np <= 0)
989     {
990       if (NILP (no_error))
991         return signal_failure (string);
992       if (!EQ (no_error, Qt))
993         {
994           if (lim < BUF_BEGV (buf) || lim > BUF_ZV (buf))
995             abort ();
996           BUF_SET_PT (buf, lim);
997           return Qnil;
998 #if 0 /* This would be clean, but maybe programs depend on
999          a value of nil here.  */
1000           np = lim;
1001 #endif
1002         }
1003       else
1004         return Qnil;
1005     }
1006
1007   if (np < BUF_BEGV (buf) || np > BUF_ZV (buf))
1008     abort ();
1009
1010   BUF_SET_PT (buf, np);
1011
1012   return make_int (np);
1013 }
1014 \f
1015 static int
1016 trivial_regexp_p (Lisp_Object regexp)
1017 {
1018   /* This function has been Mule-ized. */
1019   Bytecount len = XSTRING_LENGTH (regexp);
1020   Bufbyte *s = XSTRING_DATA (regexp);
1021   while (--len >= 0)
1022     {
1023       switch (*s++)
1024         {
1025         case '.': case '*': case '+': case '?': case '[': case '^': case '$':
1026           return 0;
1027         case '\\':
1028           if (--len < 0)
1029             return 0;
1030           switch (*s++)
1031             {
1032             case '|': case '(': case ')': case '`': case '\'': case 'b':
1033             case 'B': case '<': case '>': case 'w': case 'W': case 's':
1034             case 'S': case '=':
1035 #ifdef MULE
1036             /* 97/2/25 jhod Added for category matches */
1037             case 'c': case 'C':
1038 #endif /* MULE */
1039             case '1': case '2': case '3': case '4': case '5':
1040             case '6': case '7': case '8': case '9':
1041               return 0;
1042             }
1043         }
1044     }
1045   return 1;
1046 }
1047
1048 /* Search for the n'th occurrence of STRING in BUF,
1049    starting at position BUFPOS and stopping at position BUFLIM,
1050    treating PAT as a literal string if RE is false or as
1051    a regular expression if RE is true.
1052
1053    If N is positive, searching is forward and BUFLIM must be greater
1054    than BUFPOS.
1055    If N is negative, searching is backward and BUFLIM must be less
1056    than BUFPOS.
1057
1058    Returns -x if only N-x occurrences found (x > 0),
1059    or else the position at the beginning of the Nth occurrence
1060    (if searching backward) or the end (if searching forward).
1061
1062    POSIX is nonzero if we want full backtracking (POSIX style)
1063    for this pattern.  0 means backtrack only enough to get a valid match.  */
1064
1065 static Bufpos
1066 search_buffer (struct buffer *buf, Lisp_Object string, Bufpos bufpos,
1067                Bufpos buflim, EMACS_INT n, int RE, unsigned char *trt,
1068                unsigned char *inverse_trt, int posix)
1069 {
1070   /* This function has been Mule-ized, except for the trt table handling. */
1071   Bytecount len = XSTRING_LENGTH (string);
1072   Bufbyte *base_pat = XSTRING_DATA (string);
1073   REGISTER EMACS_INT *BM_tab;
1074   EMACS_INT *BM_tab_base;
1075   REGISTER int direction = ((n > 0) ? 1 : -1);
1076   REGISTER Bytecount dirlen;
1077   EMACS_INT infinity;
1078   Bytind limit;
1079   EMACS_INT k;
1080   Bytecount stride_for_teases = 0;
1081   REGISTER Bufbyte *pat = 0;
1082   REGISTER Bufbyte *cursor, *p_limit, *ptr2;
1083   REGISTER EMACS_INT i, j;
1084   Bytind p1, p2;
1085   Bytecount s1, s2;
1086   Bytind pos, lim;
1087
1088   if (running_asynch_code)
1089     save_search_regs ();
1090
1091   /* Null string is found at starting position.  */
1092   if (len == 0)
1093     {
1094       set_search_regs (buf, bufpos, 0);
1095       return bufpos;
1096     }
1097
1098   /* Searching 0 times means don't move.  */
1099   if (n == 0)
1100     return bufpos;
1101
1102   pos = bufpos_to_bytind (buf, bufpos);
1103   lim = bufpos_to_bytind (buf, buflim);
1104   if (RE && !trivial_regexp_p (string))
1105     {
1106       struct re_pattern_buffer *bufp;
1107
1108       bufp = compile_pattern (string, &search_regs, (char *) trt, posix,
1109                               ERROR_ME);
1110
1111       /* Get pointers and sizes of the two strings
1112          that make up the visible portion of the buffer. */
1113
1114       p1 = BI_BUF_BEGV (buf);
1115       p2 = BI_BUF_CEILING_OF (buf, p1);
1116       s1 = p2 - p1;
1117       s2 = BI_BUF_ZV (buf) - p2;
1118
1119       while (n < 0)
1120         {
1121           Bytecount val;
1122           QUIT;
1123           regex_emacs_buffer = buf;
1124           val = re_search_2 (bufp,
1125                              (char *) BI_BUF_BYTE_ADDRESS (buf, p1), s1,
1126                              (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2,
1127                              pos - BI_BUF_BEGV (buf), lim - pos, &search_regs,
1128                              pos - BI_BUF_BEGV (buf));
1129
1130           if (val == -2)
1131             {
1132               matcher_overflow ();
1133             }
1134           if (val >= 0)
1135             {
1136               int num_regs = search_regs.num_regs;
1137               j = BI_BUF_BEGV (buf);
1138               for (i = 0; i < num_regs; i++)
1139                 if (search_regs.start[i] >= 0)
1140                   {
1141                     search_regs.start[i] += j;
1142                     search_regs.end[i] += j;
1143                   }
1144               XSETBUFFER (last_thing_searched, buf);
1145               /* Set pos to the new position. */
1146               pos = search_regs.start[0];
1147               fixup_search_regs_for_buffer (buf);
1148               /* And bufpos too. */
1149               bufpos = search_regs.start[0];
1150             }
1151           else
1152             {
1153               return n;
1154             }
1155           n++;
1156         }
1157       while (n > 0)
1158         {
1159           Bytecount val;
1160           QUIT;
1161           regex_emacs_buffer = buf;
1162           val = re_search_2 (bufp,
1163                              (char *) BI_BUF_BYTE_ADDRESS (buf, p1), s1,
1164                              (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2,
1165                              pos - BI_BUF_BEGV (buf), lim - pos, &search_regs,
1166                              lim - BI_BUF_BEGV (buf));
1167           if (val == -2)
1168             {
1169               matcher_overflow ();
1170             }
1171           if (val >= 0)
1172             {
1173               int num_regs = search_regs.num_regs;
1174               j = BI_BUF_BEGV (buf);
1175               for (i = 0; i < num_regs; i++)
1176                 if (search_regs.start[i] >= 0)
1177                   {
1178                     search_regs.start[i] += j;
1179                     search_regs.end[i] += j;
1180                   }
1181               XSETBUFFER (last_thing_searched, buf);
1182               /* Set pos to the new position. */
1183               pos = search_regs.end[0];
1184               fixup_search_regs_for_buffer (buf);
1185               /* And bufpos too. */
1186               bufpos = search_regs.end[0];
1187             }
1188           else
1189             {
1190               return 0 - n;
1191             }
1192           n--;
1193         }
1194       return bufpos;
1195     }
1196   else                          /* non-RE case */
1197     /* #### Someone really really really needs to comment the workings
1198        of this junk somewhat better.
1199
1200        BTW "BM" stands for Boyer-Moore, which is one of the standard
1201        string-searching algorithms.  It's the best string-searching
1202        algorithm out there provided
1203
1204        a) You're not fazed by algorithm complexity. (Rabin-Karp, which
1205           uses hashing, is much much easier to code but not as fast.)
1206        b) You can freely move backwards in the string that you're
1207           searching through.
1208
1209        As the comment below tries to explain (but garbles in typical
1210        programmer-ese), the idea is that you don't have to do a
1211        string match at every successive position in the text.  For
1212        example, let's say the pattern is "a very long string".  We
1213        compare the last character in the string (`g') with the
1214        corresponding character in the text.  If it mismatches, and
1215        it is, say, `z', then we can skip forward by the entire
1216        length of the pattern because `z' does not occur anywhere
1217        in the pattern.  If the mismatching character does occur
1218        in the pattern, we can usually still skip forward by more
1219        than one: e.g. if it is `l', then we can skip forward
1220        by the length of the substring "ong string" -- i.e. the
1221        largest end section of the pattern that does not contain
1222        the mismatched character.  So what we do is compute, for
1223        each possible character, the distance we can skip forward
1224        (the "stride") and use it in the string matching.  This
1225        is what the BM_tab holds. */
1226     {
1227 #ifdef C_ALLOCA
1228       EMACS_INT BM_tab_space[0400];
1229       BM_tab = &BM_tab_space[0];
1230 #else
1231       BM_tab = alloca_array (EMACS_INT, 256);
1232 #endif
1233       {
1234         Bufbyte *patbuf = alloca_array (Bufbyte, len);
1235         pat = patbuf;
1236         while (--len >= 0)
1237           {
1238             /* If we got here and the RE flag is set, it's because we're
1239                dealing with a regexp known to be trivial, so the backslash
1240                just quotes the next character.  */
1241             if (RE && *base_pat == '\\')
1242               {
1243                 len--;
1244                 base_pat++;
1245               }
1246             *pat++ = (trt ? trt[*base_pat++] : *base_pat++);
1247           }
1248         len = pat - patbuf;
1249         pat = base_pat = patbuf;
1250       }
1251       /* The general approach is that we are going to maintain that we know */
1252       /* the first (closest to the present position, in whatever direction */
1253       /* we're searching) character that could possibly be the last */
1254       /* (furthest from present position) character of a valid match.  We */
1255       /* advance the state of our knowledge by looking at that character */
1256       /* and seeing whether it indeed matches the last character of the */
1257       /* pattern.  If it does, we take a closer look.  If it does not, we */
1258       /* move our pointer (to putative last characters) as far as is */
1259       /* logically possible.  This amount of movement, which I call a */
1260       /* stride, will be the length of the pattern if the actual character */
1261       /* appears nowhere in the pattern, otherwise it will be the distance */
1262       /* from the last occurrence of that character to the end of the */
1263       /* pattern. */
1264       /* As a coding trick, an enormous stride is coded into the table for */
1265       /* characters that match the last character.  This allows use of only */
1266       /* a single test, a test for having gone past the end of the */
1267       /* permissible match region, to test for both possible matches (when */
1268       /* the stride goes past the end immediately) and failure to */
1269       /* match (where you get nudged past the end one stride at a time). */
1270
1271       /* Here we make a "mickey mouse" BM table.  The stride of the search */
1272       /* is determined only by the last character of the putative match. */
1273       /* If that character does not match, we will stride the proper */
1274       /* distance to propose a match that superimposes it on the last */
1275       /* instance of a character that matches it (per trt), or misses */
1276       /* it entirely if there is none. */
1277
1278       dirlen = len * direction;
1279       infinity = dirlen - (lim + pos + len + len) * direction;
1280       if (direction < 0)
1281         pat = (base_pat += len - 1);
1282       BM_tab_base = BM_tab;
1283       BM_tab += 0400;
1284       j = dirlen;               /* to get it in a register */
1285       /* A character that does not appear in the pattern induces a */
1286       /* stride equal to the pattern length. */
1287       while (BM_tab_base != BM_tab)
1288         {
1289           *--BM_tab = j;
1290           *--BM_tab = j;
1291           *--BM_tab = j;
1292           *--BM_tab = j;
1293         }
1294       i = 0;
1295       while (i != infinity)
1296         {
1297           j = pat[i]; i += direction;
1298           if (i == dirlen) i = infinity;
1299           if (trt != 0)
1300             {
1301               k = (j = trt[j]);
1302               if (i == infinity)
1303                 stride_for_teases = BM_tab[j];
1304               BM_tab[j] = dirlen - i;
1305               /* A translation table is accompanied by its inverse -- see */
1306               /* comment following downcase_table for details */
1307
1308               while ((j = inverse_trt[j]) != k)
1309                 BM_tab[j] = dirlen - i;
1310             }
1311           else
1312             {
1313               if (i == infinity)
1314                 stride_for_teases = BM_tab[j];
1315               BM_tab[j] = dirlen - i;
1316             }
1317           /* stride_for_teases tells how much to stride if we get a */
1318           /* match on the far character but are subsequently */
1319           /* disappointed, by recording what the stride would have been */
1320           /* for that character if the last character had been */
1321           /* different. */
1322         }
1323       infinity = dirlen - infinity;
1324       pos += dirlen - ((direction > 0) ? direction : 0);
1325       /* loop invariant - pos points at where last char (first char if reverse)
1326          of pattern would align in a possible match.  */
1327       while (n != 0)
1328         {
1329           /* It's been reported that some (broken) compiler thinks that
1330              Boolean expressions in an arithmetic context are unsigned.
1331              Using an explicit ?1:0 prevents this.  */
1332           if ((lim - pos - ((direction > 0) ? 1 : 0)) * direction < 0)
1333             return n * (0 - direction);
1334           /* First we do the part we can by pointers (maybe nothing) */
1335           QUIT;
1336           pat = base_pat;
1337           limit = pos - dirlen + direction;
1338           /* XEmacs change: definitions of CEILING_OF and FLOOR_OF
1339              have changed.  See buffer.h. */
1340           limit = ((direction > 0)
1341                    ? BI_BUF_CEILING_OF (buf, limit) - 1
1342                    : BI_BUF_FLOOR_OF (buf, limit + 1));
1343           /* LIMIT is now the last (not beyond-last!) value
1344              POS can take on without hitting edge of buffer or the gap.  */
1345           limit = ((direction > 0)
1346                    ? min (lim - 1, min (limit, pos + 20000))
1347                    : max (lim, max (limit, pos - 20000)));
1348           if ((limit - pos) * direction > 20)
1349             {
1350               p_limit = BI_BUF_BYTE_ADDRESS (buf, limit);
1351               ptr2 = (cursor = BI_BUF_BYTE_ADDRESS (buf, pos));
1352               /* In this loop, pos + cursor - ptr2 is the surrogate for pos */
1353               while (1)         /* use one cursor setting as long as i can */
1354                 {
1355                   if (direction > 0) /* worth duplicating */
1356                     {
1357                       /* Use signed comparison if appropriate
1358                          to make cursor+infinity sure to be > p_limit.
1359                          Assuming that the buffer lies in a range of addresses
1360                          that are all "positive" (as ints) or all "negative",
1361                          either kind of comparison will work as long
1362                          as we don't step by infinity.  So pick the kind
1363                          that works when we do step by infinity.  */
1364                       if ((EMACS_INT) (p_limit + infinity) >
1365                           (EMACS_INT) p_limit)
1366                         while ((EMACS_INT) cursor <=
1367                                (EMACS_INT) p_limit)
1368                           cursor += BM_tab[*cursor];
1369                       else
1370                         while ((EMACS_UINT) cursor <=
1371                                (EMACS_UINT) p_limit)
1372                           cursor += BM_tab[*cursor];
1373                     }
1374                   else
1375                     {
1376                       if ((EMACS_INT) (p_limit + infinity) <
1377                           (EMACS_INT) p_limit)
1378                         while ((EMACS_INT) cursor >=
1379                                (EMACS_INT) p_limit)
1380                           cursor += BM_tab[*cursor];
1381                       else
1382                         while ((EMACS_UINT) cursor >=
1383                                (EMACS_UINT) p_limit)
1384                           cursor += BM_tab[*cursor];
1385                     }
1386  /* If you are here, cursor is beyond the end of the searched region. */
1387  /* This can happen if you match on the far character of the pattern, */
1388  /* because the "stride" of that character is infinity, a number able */
1389  /* to throw you well beyond the end of the search.  It can also */
1390  /* happen if you fail to match within the permitted region and would */
1391  /* otherwise try a character beyond that region */
1392                   if ((cursor - p_limit) * direction <= len)
1393                     break;      /* a small overrun is genuine */
1394                   cursor -= infinity; /* large overrun = hit */
1395                   i = dirlen - direction;
1396                   if (trt != 0)
1397                     {
1398                       while ((i -= direction) + direction != 0)
1399                         if (pat[i] != trt[*(cursor -= direction)])
1400                           break;
1401                     }
1402                   else
1403                     {
1404                       while ((i -= direction) + direction != 0)
1405                         if (pat[i] != *(cursor -= direction))
1406                           break;
1407                     }
1408                   cursor += dirlen - i - direction;     /* fix cursor */
1409                   if (i + direction == 0)
1410                     {
1411                       cursor -= direction;
1412
1413                       {
1414                         Bytind bytstart = (pos + cursor - ptr2 +
1415                                            ((direction > 0)
1416                                             ? 1 - len : 0));
1417                         Bufpos bufstart = bytind_to_bufpos (buf, bytstart);
1418                         Bufpos bufend = bytind_to_bufpos (buf, bytstart + len);
1419
1420                         set_search_regs (buf, bufstart, bufend - bufstart);
1421                       }
1422
1423                       if ((n -= direction) != 0)
1424                         cursor += dirlen; /* to resume search */
1425                       else
1426                         return ((direction > 0)
1427                                 ? search_regs.end[0] : search_regs.start[0]);
1428                     }
1429                   else
1430                     cursor += stride_for_teases; /* <sigh> we lose -  */
1431                 }
1432               pos += cursor - ptr2;
1433             }
1434           else
1435             /* Now we'll pick up a clump that has to be done the hard */
1436             /* way because it covers a discontinuity */
1437             {
1438               /* XEmacs change: definitions of CEILING_OF and FLOOR_OF
1439                  have changed.  See buffer.h. */
1440               limit = ((direction > 0)
1441                        ? BI_BUF_CEILING_OF (buf, pos - dirlen + 1) - 1
1442                        : BI_BUF_FLOOR_OF (buf, pos - dirlen));
1443               limit = ((direction > 0)
1444                        ? min (limit + len, lim - 1)
1445                        : max (limit - len, lim));
1446               /* LIMIT is now the last value POS can have
1447                  and still be valid for a possible match.  */
1448               while (1)
1449                 {
1450                   /* This loop can be coded for space rather than */
1451                   /* speed because it will usually run only once. */
1452                   /* (the reach is at most len + 21, and typically */
1453                   /* does not exceed len) */
1454                   while ((limit - pos) * direction >= 0)
1455                     /* *not* BI_BUF_FETCH_CHAR.  We are working here
1456                        with bytes, not characters. */
1457                     pos += BM_tab[*BI_BUF_BYTE_ADDRESS (buf, pos)];
1458                   /* now run the same tests to distinguish going off the */
1459                   /* end, a match or a phony match. */
1460                   if ((pos - limit) * direction <= len)
1461                     break;      /* ran off the end */
1462                   /* Found what might be a match.
1463                      Set POS back to last (first if reverse) char pos.  */
1464                   pos -= infinity;
1465                   i = dirlen - direction;
1466                   while ((i -= direction) + direction != 0)
1467                     {
1468                       pos -= direction;
1469                       if (pat[i] != (((Bufbyte *) trt)
1470                                      /* #### Does not handle TRT right */
1471                                      ? trt[*BI_BUF_BYTE_ADDRESS (buf, pos)]
1472                                      : *BI_BUF_BYTE_ADDRESS (buf, pos)))
1473                         break;
1474                     }
1475                   /* Above loop has moved POS part or all the way
1476                      back to the first char pos (last char pos if reverse).
1477                      Set it once again at the last (first if reverse) char.  */
1478                   pos += dirlen - i- direction;
1479                   if (i + direction == 0)
1480                     {
1481                       pos -= direction;
1482
1483                       {
1484                         Bytind bytstart = (pos +
1485                                            ((direction > 0)
1486                                             ? 1 - len : 0));
1487                         Bufpos bufstart = bytind_to_bufpos (buf, bytstart);
1488                         Bufpos bufend = bytind_to_bufpos (buf, bytstart + len);
1489
1490                         set_search_regs (buf, bufstart, bufend - bufstart);
1491                       }
1492
1493                       if ((n -= direction) != 0)
1494                         pos += dirlen; /* to resume search */
1495                       else
1496                         return ((direction > 0)
1497                                 ? search_regs.end[0] : search_regs.start[0]);
1498                     }
1499                   else
1500                     pos += stride_for_teases;
1501                 }
1502               }
1503           /* We have done one clump.  Can we continue? */
1504           if ((lim - pos) * direction < 0)
1505             return (0 - n) * direction;
1506         }
1507       return bytind_to_bufpos (buf, pos);
1508     }
1509 }
1510
1511 /* Record beginning BEG and end BEG + LEN
1512    for a match just found in the current buffer.  */
1513
1514 static void
1515 set_search_regs (struct buffer *buf, Bufpos beg, Charcount len)
1516 {
1517   /* This function has been Mule-ized. */
1518   /* Make sure we have registers in which to store
1519      the match position.  */
1520   if (search_regs.num_regs == 0)
1521     {
1522       search_regs.start = xnew (regoff_t);
1523       search_regs.end   = xnew (regoff_t);
1524       search_regs.num_regs = 1;
1525     }
1526
1527   search_regs.start[0] = beg;
1528   search_regs.end[0] = beg + len;
1529   XSETBUFFER (last_thing_searched, buf);
1530 }
1531
1532 \f
1533 /* Given a string of words separated by word delimiters,
1534   compute a regexp that matches those exact words
1535   separated by arbitrary punctuation.  */
1536
1537 static Lisp_Object
1538 wordify (Lisp_Object buffer, Lisp_Object string)
1539 {
1540   Charcount i, len;
1541   EMACS_INT punct_count = 0, word_count = 0;
1542   struct buffer *buf = decode_buffer (buffer, 0);
1543   struct Lisp_Char_Table *syntax_table =
1544     XCHAR_TABLE (buf->mirror_syntax_table);
1545
1546   CHECK_STRING (string);
1547   len = XSTRING_CHAR_LENGTH (string);
1548
1549   for (i = 0; i < len; i++)
1550     if (!WORD_SYNTAX_P (syntax_table, string_char (XSTRING (string), i)))
1551       {
1552         punct_count++;
1553         if (i > 0 && WORD_SYNTAX_P (syntax_table,
1554                                     string_char (XSTRING (string), i - 1)))
1555           word_count++;
1556       }
1557   if (WORD_SYNTAX_P (syntax_table, string_char (XSTRING (string), len - 1)))
1558     word_count++;
1559   if (!word_count) return build_string ("");
1560
1561   {
1562     /* The following value is an upper bound on the amount of storage we
1563        need.  In non-Mule, it is exact. */
1564     Bufbyte *storage =
1565       (Bufbyte *) alloca (XSTRING_LENGTH (string) - punct_count +
1566                           5 * (word_count - 1) + 4);
1567     Bufbyte *o = storage;
1568
1569     *o++ = '\\';
1570     *o++ = 'b';
1571
1572     for (i = 0; i < len; i++)
1573       {
1574         Emchar ch = string_char (XSTRING (string), i);
1575
1576         if (WORD_SYNTAX_P (syntax_table, ch))
1577           o += set_charptr_emchar (o, ch);
1578         else if (i > 0
1579                  && WORD_SYNTAX_P (syntax_table,
1580                                    string_char (XSTRING (string), i - 1))
1581                  && --word_count)
1582           {
1583             *o++ = '\\';
1584             *o++ = 'W';
1585             *o++ = '\\';
1586             *o++ = 'W';
1587             *o++ = '*';
1588           }
1589       }
1590
1591     *o++ = '\\';
1592     *o++ = 'b';
1593
1594     return make_string (storage, o - storage);
1595   }
1596 }
1597 \f
1598 DEFUN ("search-backward", Fsearch_backward, 1, 5, "sSearch backward: ", /*
1599 Search backward from point for STRING.
1600 Set point to the beginning of the occurrence found, and return point.
1601 An optional second argument bounds the search; it is a buffer position.
1602 The match found must not extend before that position.
1603 Optional third argument, if t, means if fail just return nil (no error).
1604  If not nil and not t, position at limit of search and return nil.
1605 Optional fourth argument is repeat count--search for successive occurrences.
1606 Optional fifth argument BUFFER specifies the buffer to search in and
1607  defaults to the current buffer.
1608 See also the functions `match-beginning', `match-end' and `replace-match'.
1609 */
1610        (string, bound, no_error, count, buffer))
1611 {
1612   return search_command (string, bound, no_error, count, buffer, -1, 0, 0);
1613 }
1614
1615 DEFUN ("search-forward", Fsearch_forward, 1, 5, "sSearch: ", /*
1616 Search forward from point for STRING.
1617 Set point to the end of the occurrence found, and return point.
1618 An optional second argument bounds the search; it is a buffer position.
1619 The match found must not extend after that position.  nil is equivalent
1620   to (point-max).
1621 Optional third argument, if t, means if fail just return nil (no error).
1622   If not nil and not t, move to limit of search and return nil.
1623 Optional fourth argument is repeat count--search for successive occurrences.
1624 Optional fifth argument BUFFER specifies the buffer to search in and
1625  defaults to the current buffer.
1626 See also the functions `match-beginning', `match-end' and `replace-match'.
1627 */
1628        (string, bound, no_error, count, buffer))
1629 {
1630   return search_command (string, bound, no_error, count, buffer, 1, 0, 0);
1631 }
1632
1633 DEFUN ("word-search-backward", Fword_search_backward, 1, 5,
1634        "sWord search backward: ", /*
1635 Search backward from point for STRING, ignoring differences in punctuation.
1636 Set point to the beginning of the occurrence found, and return point.
1637 An optional second argument bounds the search; it is a buffer position.
1638 The match found must not extend before that position.
1639 Optional third argument, if t, means if fail just return nil (no error).
1640   If not nil and not t, move to limit of search and return nil.
1641 Optional fourth argument is repeat count--search for successive occurrences.
1642 Optional fifth argument BUFFER specifies the buffer to search in and
1643  defaults to the current buffer.
1644 */
1645        (string, bound, no_error, count, buffer))
1646 {
1647   return search_command (wordify (buffer, string), bound, no_error, count,
1648                          buffer, -1, 1, 0);
1649 }
1650
1651 DEFUN ("word-search-forward", Fword_search_forward, 1, 5, "sWord search: ", /*
1652 Search forward from point for STRING, ignoring differences in punctuation.
1653 Set point to the end of the occurrence found, and return point.
1654 An optional second argument bounds the search; it is a buffer position.
1655 The match found must not extend after that position.
1656 Optional third argument, if t, means if fail just return nil (no error).
1657   If not nil and not t, move to limit of search and return nil.
1658 Optional fourth argument is repeat count--search for successive occurrences.
1659 Optional fifth argument BUFFER specifies the buffer to search in and
1660  defaults to the current buffer.
1661 */
1662        (string, bound, no_error, count, buffer))
1663 {
1664   return search_command (wordify (buffer, string), bound, no_error, count,
1665                          buffer, 1, 1, 0);
1666 }
1667
1668 DEFUN ("re-search-backward", Fre_search_backward, 1, 5,
1669        "sRE search backward: ", /*
1670 Search backward from point for match for regular expression REGEXP.
1671 Set point to the beginning of the match, and return point.
1672 The match found is the one starting last in the buffer
1673 and yet ending before the origin of the search.
1674 An optional second argument bounds the search; it is a buffer position.
1675 The match found must start at or after that position.
1676 Optional third argument, if t, means if fail just return nil (no error).
1677   If not nil and not t, move to limit of search and return nil.
1678 Optional fourth argument is repeat count--search for successive occurrences.
1679 Optional fifth argument BUFFER specifies the buffer to search in and
1680  defaults to the current buffer.
1681 See also the functions `match-beginning', `match-end' and `replace-match'.
1682 */
1683        (regexp, bound, no_error, count, buffer))
1684 {
1685   return search_command (regexp, bound, no_error, count, buffer, -1, 1, 0);
1686 }
1687
1688 DEFUN ("re-search-forward", Fre_search_forward, 1, 5, "sRE search: ", /*
1689 Search forward from point for regular expression REGEXP.
1690 Set point to the end of the occurrence found, and return point.
1691 An optional second argument bounds the search; it is a buffer position.
1692 The match found must not extend after that position.
1693 Optional third argument, if t, means if fail just return nil (no error).
1694   If not nil and not t, move to limit of search and return nil.
1695 Optional fourth argument is repeat count--search for successive occurrences.
1696 Optional fifth argument BUFFER specifies the buffer to search in and
1697  defaults to the current buffer.
1698 See also the functions `match-beginning', `match-end' and `replace-match'.
1699 */
1700        (regexp, bound, no_error, count, buffer))
1701 {
1702   return search_command (regexp, bound, no_error, count, buffer, 1, 1, 0);
1703 }
1704
1705 DEFUN ("posix-search-backward", Fposix_search_backward, 1, 5,
1706        "sPosix search backward: ", /*
1707 Search backward from point for match for regular expression REGEXP.
1708 Find the longest match in accord with Posix regular expression rules.
1709 Set point to the beginning of the match, and return point.
1710 The match found is the one starting last in the buffer
1711 and yet ending before the origin of the search.
1712 An optional second argument bounds the search; it is a buffer position.
1713 The match found must start at or after that position.
1714 Optional third argument, if t, means if fail just return nil (no error).
1715   If not nil and not t, move to limit of search and return nil.
1716 Optional fourth argument is repeat count--search for successive occurrences.
1717 Optional fifth argument BUFFER specifies the buffer to search in and
1718  defaults to the current buffer.
1719 See also the functions `match-beginning', `match-end' and `replace-match'.
1720 */
1721        (regexp, bound, no_error, count, buffer))
1722 {
1723   return search_command (regexp, bound, no_error, count, buffer, -1, 1, 1);
1724 }
1725
1726 DEFUN ("posix-search-forward", Fposix_search_forward, 1, 5, "sPosix search: ", /*
1727 Search forward from point for regular expression REGEXP.
1728 Find the longest match in accord with Posix regular expression rules.
1729 Set point to the end of the occurrence found, and return point.
1730 An optional second argument bounds the search; it is a buffer position.
1731 The match found must not extend after that position.
1732 Optional third argument, if t, means if fail just return nil (no error).
1733   If not nil and not t, move to limit of search and return nil.
1734 Optional fourth argument is repeat count--search for successive occurrences.
1735 Optional fifth argument BUFFER specifies the buffer to search in and
1736  defaults to the current buffer.
1737 See also the functions `match-beginning', `match-end' and `replace-match'.
1738 */
1739        (regexp, bound, no_error, count, buffer))
1740 {
1741   return search_command (regexp, bound, no_error, count, buffer, 1, 1, 1);
1742 }
1743
1744 \f
1745 static Lisp_Object
1746 free_created_dynarrs (Lisp_Object cons)
1747 {
1748   Dynarr_free (get_opaque_ptr (XCAR (cons)));
1749   Dynarr_free (get_opaque_ptr (XCDR (cons)));
1750   free_opaque_ptr (XCAR (cons));
1751   free_opaque_ptr (XCDR (cons));
1752   free_cons (XCONS (cons));
1753   return Qnil;
1754 }
1755
1756 DEFUN ("replace-match", Freplace_match, 1, 5, 0, /*
1757 Replace text matched by last search with NEWTEXT.
1758 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
1759 Otherwise maybe capitalize the whole text, or maybe just word initials,
1760 based on the replaced text.
1761 If the replaced text has only capital letters
1762 and has at least one multiletter word, convert NEWTEXT to all caps.
1763 If the replaced text has at least one word starting with a capital letter,
1764 then capitalize each word in NEWTEXT.
1765
1766 If third arg LITERAL is non-nil, insert NEWTEXT literally.
1767 Otherwise treat `\\' as special:
1768   `\\&' in NEWTEXT means substitute original matched text.
1769   `\\N' means substitute what matched the Nth `\\(...\\)'.
1770        If Nth parens didn't match, substitute nothing.
1771   `\\\\' means insert one `\\'.
1772   `\\u' means upcase the next character.
1773   `\\l' means downcase the next character.
1774   `\\U' means begin upcasing all following characters.
1775   `\\L' means begin downcasing all following characters.
1776   `\\E' means terminate the effect of any `\\U' or `\\L'.
1777   Case changes made with `\\u', `\\l', `\\U', and `\\L' override
1778   all other case changes that may be made in the replaced text.
1779 FIXEDCASE and LITERAL are optional arguments.
1780 Leaves point at end of replacement text.
1781
1782 The optional fourth argument STRING can be a string to modify.
1783 In that case, this function creates and returns a new string
1784 which is made by replacing the part of STRING that was matched.
1785 When fourth argument is a string, fifth argument STRBUFFER specifies
1786 the buffer to be used for syntax-table and case-table lookup and
1787 defaults to the current buffer. (When fourth argument is not a string,
1788 the buffer that the match occurred in has automatically been remembered
1789 and you do not need to specify it.)
1790 */
1791        (newtext, fixedcase, literal, string, strbuffer))
1792 {
1793   /* This function has been Mule-ized. */
1794   /* This function can GC */
1795   enum { nochange, all_caps, cap_initial } case_action;
1796   Bufpos pos, last;
1797   int some_multiletter_word;
1798   int some_lowercase;
1799   int some_uppercase;
1800   int some_nonuppercase_initial;
1801   Emchar c, prevc;
1802   Charcount inslen;
1803   struct buffer *buf;
1804   struct Lisp_Char_Table *syntax_table;
1805   int mc_count;
1806   Lisp_Object buffer;
1807   int_dynarr *ul_action_dynarr = 0;
1808   int_dynarr *ul_pos_dynarr = 0;
1809   int speccount;
1810
1811   CHECK_STRING (newtext);
1812
1813   if (! NILP (string))
1814     {
1815       CHECK_STRING (string);
1816       if (!EQ (last_thing_searched, Qt))
1817         error ("last thing matched was not a string");
1818       /* If the match data
1819          were abstracted into a special "match data" type instead
1820          of the typical half-assed "let the implementation be
1821          visible" form it's in, we could extend it to include
1822          the last string matched and the buffer used for that
1823          matching.  But of course we can't change it as it is. */
1824       buf = decode_buffer (strbuffer, 0);
1825       XSETBUFFER (buffer, buf);
1826     }
1827   else
1828     {
1829       if (!BUFFERP (last_thing_searched))
1830         error ("last thing matched was not a buffer");
1831       buffer = last_thing_searched;
1832       buf = XBUFFER (buffer);
1833     }
1834
1835   syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
1836
1837   case_action = nochange;       /* We tried an initialization */
1838                                 /* but some C compilers blew it */
1839
1840   if (search_regs.num_regs == 0)
1841     error ("replace-match called before any match found");
1842
1843   if (NILP (string))
1844     {
1845       if (search_regs.start[0] < BUF_BEGV (buf)
1846           || search_regs.start[0] > search_regs.end[0]
1847           || search_regs.end[0] > BUF_ZV (buf))
1848         args_out_of_range (make_int (search_regs.start[0]),
1849                            make_int (search_regs.end[0]));
1850     }
1851   else
1852     {
1853       if (search_regs.start[0] < 0
1854           || search_regs.start[0] > search_regs.end[0]
1855           || search_regs.end[0] > XSTRING_CHAR_LENGTH (string))
1856         args_out_of_range (make_int (search_regs.start[0]),
1857                            make_int (search_regs.end[0]));
1858     }
1859
1860   if (NILP (fixedcase))
1861     {
1862       /* Decide how to casify by examining the matched text. */
1863
1864       last = search_regs.end[0];
1865       prevc = '\n';
1866       case_action = all_caps;
1867
1868       /* some_multiletter_word is set nonzero if any original word
1869          is more than one letter long. */
1870       some_multiletter_word = 0;
1871       some_lowercase = 0;
1872       some_nonuppercase_initial = 0;
1873       some_uppercase = 0;
1874
1875       for (pos = search_regs.start[0]; pos < last; pos++)
1876         {
1877           if (NILP (string))
1878             c = BUF_FETCH_CHAR (buf, pos);
1879           else
1880             c = string_char (XSTRING (string), pos);
1881
1882           if (LOWERCASEP (buf, c))
1883             {
1884               /* Cannot be all caps if any original char is lower case */
1885
1886               some_lowercase = 1;
1887               if (!WORD_SYNTAX_P (syntax_table, prevc))
1888                 some_nonuppercase_initial = 1;
1889               else
1890                 some_multiletter_word = 1;
1891             }
1892           else if (!NOCASEP (buf, c))
1893             {
1894               some_uppercase = 1;
1895               if (!WORD_SYNTAX_P (syntax_table, prevc))
1896                 ;
1897               else
1898                 some_multiletter_word = 1;
1899             }
1900           else
1901             {
1902               /* If the initial is a caseless word constituent,
1903                  treat that like a lowercase initial.  */
1904               if (!WORD_SYNTAX_P (syntax_table, prevc))
1905                 some_nonuppercase_initial = 1;
1906             }
1907
1908           prevc = c;
1909         }
1910
1911       /* Convert to all caps if the old text is all caps
1912          and has at least one multiletter word.  */
1913       if (! some_lowercase && some_multiletter_word)
1914         case_action = all_caps;
1915       /* Capitalize each word, if the old text has all capitalized words.  */
1916       else if (!some_nonuppercase_initial && some_multiletter_word)
1917         case_action = cap_initial;
1918       else if (!some_nonuppercase_initial && some_uppercase)
1919         /* Should x -> yz, operating on X, give Yz or YZ?
1920            We'll assume the latter.  */
1921         case_action = all_caps;
1922       else
1923         case_action = nochange;
1924     }
1925
1926   /* Do replacement in a string.  */
1927   if (!NILP (string))
1928     {
1929       Lisp_Object before, after;
1930
1931       speccount = specpdl_depth ();
1932       before = Fsubstring (string, Qzero, make_int (search_regs.start[0]));
1933       after = Fsubstring (string, make_int (search_regs.end[0]), Qnil);
1934
1935       /* Do case substitution into NEWTEXT if desired.  */
1936       if (NILP (literal))
1937         {
1938           Charcount stlen = XSTRING_CHAR_LENGTH (newtext);
1939           Charcount strpos;
1940           /* XEmacs change: rewrote this loop somewhat to make it
1941              cleaner.  Also added \U, \E, etc. */
1942           Charcount literal_start = 0;
1943           /* We build up the substituted string in ACCUM.  */
1944           Lisp_Object accum;
1945
1946           accum = Qnil;
1947
1948           /* OK, the basic idea here is that we scan through the
1949              replacement string until we find a backslash, which
1950              represents a substring of the original string to be
1951              substituted.  We then append onto ACCUM the literal
1952              text before the backslash (LASTPOS marks the
1953              beginning of this) followed by the substring of the
1954              original string that needs to be inserted. */
1955           for (strpos = 0; strpos < stlen; strpos++)
1956             {
1957               /* If LITERAL_END is set, we've encountered a backslash
1958                  (the end of literal text to be inserted). */
1959               Charcount literal_end = -1;
1960               /* If SUBSTART is set, we need to also insert the
1961                  text from SUBSTART to SUBEND in the original string. */
1962               Charcount substart = -1;
1963               Charcount subend   = -1;
1964
1965               c = string_char (XSTRING (newtext), strpos);
1966               if (c == '\\' && strpos < stlen - 1)
1967                 {
1968                   c = string_char (XSTRING (newtext), ++strpos);
1969                   if (c == '&')
1970                     {
1971                       literal_end = strpos - 1;
1972                       substart = search_regs.start[0];
1973                       subend = search_regs.end[0];
1974                     }
1975                   else if (c >= '1' && c <= '9' &&
1976                            c <= search_regs.num_regs + '0')
1977                     {
1978                       if (search_regs.start[c - '0'] >= 0)
1979                         {
1980                           literal_end = strpos - 1;
1981                           substart = search_regs.start[c - '0'];
1982                           subend = search_regs.end[c - '0'];
1983                         }
1984                     }
1985                   else if (c == 'U' || c == 'u' || c == 'L' || c == 'l' ||
1986                            c == 'E')
1987                     {
1988                       /* Keep track of all case changes requested, but don't
1989                          make them now.  Do them later so we override
1990                          everything else. */
1991                       if (!ul_pos_dynarr)
1992                         {
1993                           ul_pos_dynarr = Dynarr_new (int);
1994                           ul_action_dynarr = Dynarr_new (int);
1995                           record_unwind_protect
1996                             (free_created_dynarrs,
1997                              noseeum_cons
1998                              (make_opaque_ptr (ul_pos_dynarr),
1999                               make_opaque_ptr (ul_action_dynarr)));
2000                         }
2001                       literal_end = strpos - 1;
2002                       Dynarr_add (ul_pos_dynarr,
2003                                   (!NILP (accum)
2004                                   ? XSTRING_CHAR_LENGTH (accum)
2005                                   : 0) + (literal_end - literal_start));
2006                       Dynarr_add (ul_action_dynarr, c);
2007                     }
2008                   else if (c == '\\')
2009                     /* So we get just one backslash. */
2010                     literal_end = strpos;
2011                 }
2012               if (literal_end >= 0)
2013                 {
2014                   Lisp_Object literal_text = Qnil;
2015                   Lisp_Object substring = Qnil;
2016                   if (literal_end != literal_start)
2017                     literal_text = Fsubstring (newtext,
2018                                                make_int (literal_start),
2019                                                make_int (literal_end));
2020                   if (substart >= 0 && subend != substart)
2021                     substring = Fsubstring (string,
2022                                             make_int (substart),
2023                                             make_int (subend));
2024                   if (!NILP (literal_text) || !NILP (substring))
2025                     accum = concat3 (accum, literal_text, substring);
2026                   literal_start = strpos + 1;
2027                 }
2028             }
2029
2030           if (strpos != literal_start)
2031             /* some literal text at end to be inserted */
2032             newtext = concat2 (accum, Fsubstring (newtext,
2033                                                   make_int (literal_start),
2034                                                   make_int (strpos)));
2035           else
2036             newtext = accum;
2037         }
2038
2039       if (case_action == all_caps)
2040         newtext = Fupcase (newtext, buffer);
2041       else if (case_action == cap_initial)
2042         newtext = Fupcase_initials (newtext, buffer);
2043
2044       /* Now finally, we need to process the \U's, \E's, etc. */
2045       if (ul_pos_dynarr)
2046         {
2047           int i = 0;
2048           int cur_action = 'E';
2049           Charcount stlen = XSTRING_CHAR_LENGTH (newtext);
2050           Charcount strpos;
2051
2052           for (strpos = 0; strpos < stlen; strpos++)
2053             {
2054               Emchar curchar = string_char (XSTRING (newtext), strpos);
2055               Emchar newchar = -1;
2056               if (i < Dynarr_length (ul_pos_dynarr) &&
2057                   strpos == Dynarr_at (ul_pos_dynarr, i))
2058                 {
2059                   int new_action = Dynarr_at (ul_action_dynarr, i);
2060                   i++;
2061                   if (new_action == 'u')
2062                     newchar = UPCASE (buf, curchar);
2063                   else if (new_action == 'l')
2064                     newchar = DOWNCASE (buf, curchar);
2065                   else
2066                     cur_action = new_action;
2067                 }
2068               if (newchar == -1)
2069                 {
2070                   if (cur_action == 'U')
2071                     newchar = UPCASE (buf, curchar);
2072                   else if (cur_action == 'L')
2073                     newchar = DOWNCASE (buf, curchar);
2074                   else
2075                     newchar = curchar;
2076                 }
2077               if (newchar != curchar)
2078                 set_string_char (XSTRING (newtext), strpos, newchar);
2079             }
2080         }
2081
2082       /* frees the Dynarrs if necessary. */
2083       unbind_to (speccount, Qnil);
2084       return concat3 (before, newtext, after);
2085     }
2086
2087   mc_count = begin_multiple_change (buf, search_regs.start[0],
2088                                     search_regs.end[0]);
2089
2090   /* begin_multiple_change() records an unwind-protect, so we need to
2091      record this value now. */
2092   speccount = specpdl_depth ();
2093
2094   /* We insert the replacement text before the old text, and then
2095      delete the original text.  This means that markers at the
2096      beginning or end of the original will float to the corresponding
2097      position in the replacement.  */
2098   BUF_SET_PT (buf, search_regs.start[0]);
2099   if (!NILP (literal))
2100     Finsert (1, &newtext);
2101   else
2102     {
2103       Charcount stlen = XSTRING_CHAR_LENGTH (newtext);
2104       Charcount strpos;
2105       struct gcpro gcpro1;
2106       GCPRO1 (newtext);
2107       for (strpos = 0; strpos < stlen; strpos++)
2108         {
2109           Charcount offset = BUF_PT (buf) - search_regs.start[0];
2110
2111           c = string_char (XSTRING (newtext), strpos);
2112           if (c == '\\' && strpos < stlen - 1)
2113             {
2114               c = string_char (XSTRING (newtext), ++strpos);
2115               if (c == '&')
2116                 Finsert_buffer_substring
2117                   (buffer,
2118                    make_int (search_regs.start[0] + offset),
2119                    make_int (search_regs.end[0] + offset));
2120               else if (c >= '1' && c <= '9' &&
2121                        c <= search_regs.num_regs + '0')
2122                 {
2123                   if (search_regs.start[c - '0'] >= 1)
2124                     Finsert_buffer_substring
2125                       (buffer,
2126                        make_int (search_regs.start[c - '0'] + offset),
2127                        make_int (search_regs.end[c - '0'] + offset));
2128                 }
2129               else if (c == 'U' || c == 'u' || c == 'L' || c == 'l' ||
2130                        c == 'E')
2131                 {
2132                   /* Keep track of all case changes requested, but don't
2133                      make them now.  Do them later so we override
2134                      everything else. */
2135                   if (!ul_pos_dynarr)
2136                     {
2137                       ul_pos_dynarr = Dynarr_new (int);
2138                       ul_action_dynarr = Dynarr_new (int);
2139                       record_unwind_protect
2140                         (free_created_dynarrs,
2141                          Fcons (make_opaque_ptr (ul_pos_dynarr),
2142                                 make_opaque_ptr (ul_action_dynarr)));
2143                     }
2144                   Dynarr_add (ul_pos_dynarr, BUF_PT (buf));
2145                   Dynarr_add (ul_action_dynarr, c);
2146                 }
2147               else
2148                 buffer_insert_emacs_char (buf, c);
2149             }
2150           else
2151             buffer_insert_emacs_char (buf, c);
2152         }
2153       UNGCPRO;
2154     }
2155
2156   inslen = BUF_PT (buf) - (search_regs.start[0]);
2157   buffer_delete_range (buf, search_regs.start[0] + inslen, search_regs.end[0] +
2158                        inslen, 0);
2159
2160   if (case_action == all_caps)
2161     Fupcase_region (make_int (BUF_PT (buf) - inslen),
2162                     make_int (BUF_PT (buf)),  buffer);
2163   else if (case_action == cap_initial)
2164     Fupcase_initials_region (make_int (BUF_PT (buf) - inslen),
2165                              make_int (BUF_PT (buf)), buffer);
2166
2167   /* Now go through and make all the case changes that were requested
2168      in the replacement string. */
2169   if (ul_pos_dynarr)
2170     {
2171       Bufpos eend = BUF_PT (buf);
2172       int i = 0;
2173       int cur_action = 'E';
2174
2175       for (pos = BUF_PT (buf) - inslen; pos < eend; pos++)
2176         {
2177           Emchar curchar = BUF_FETCH_CHAR (buf, pos);
2178           Emchar newchar = -1;
2179           if (i < Dynarr_length (ul_pos_dynarr) &&
2180               pos == Dynarr_at (ul_pos_dynarr, i))
2181             {
2182               int new_action = Dynarr_at (ul_action_dynarr, i);
2183               i++;
2184               if (new_action == 'u')
2185                 newchar = UPCASE (buf, curchar);
2186               else if (new_action == 'l')
2187                 newchar = DOWNCASE (buf, curchar);
2188               else
2189                 cur_action = new_action;
2190             }
2191           if (newchar == -1)
2192             {
2193               if (cur_action == 'U')
2194                 newchar = UPCASE (buf, curchar);
2195               else if (cur_action == 'L')
2196                 newchar = DOWNCASE (buf, curchar);
2197               else
2198                 newchar = curchar;
2199             }
2200           if (newchar != curchar)
2201             buffer_replace_char (buf, pos, newchar, 0, 0);
2202         }
2203     }
2204
2205   /* frees the Dynarrs if necessary. */
2206   unbind_to (speccount, Qnil);
2207   end_multiple_change (buf, mc_count);
2208
2209   return Qnil;
2210 }
2211 \f
2212 static Lisp_Object
2213 match_limit (Lisp_Object num, int beginningp)
2214 {
2215   /* This function has been Mule-ized. */
2216   int n;
2217
2218   CHECK_INT (num);
2219   n = XINT (num);
2220   if (n < 0 || n >= search_regs.num_regs)
2221     args_out_of_range (num, make_int (search_regs.num_regs));
2222   if (search_regs.num_regs == 0 ||
2223       search_regs.start[n] < 0)
2224     return Qnil;
2225   return make_int (beginningp ? search_regs.start[n] : search_regs.end[n]);
2226 }
2227
2228 DEFUN ("match-beginning", Fmatch_beginning, 1, 1, 0, /*
2229 Return position of start of text matched by last regexp search.
2230 NUM, specifies which parenthesized expression in the last regexp.
2231  Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
2232 Zero means the entire text matched by the whole regexp or whole string.
2233 */
2234        (num))
2235 {
2236   return match_limit (num, 1);
2237 }
2238
2239 DEFUN ("match-end", Fmatch_end, 1, 1, 0, /*
2240 Return position of end of text matched by last regexp search.
2241 NUM specifies which parenthesized expression in the last regexp.
2242  Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
2243 Zero means the entire text matched by the whole regexp or whole string.
2244 */
2245        (num))
2246 {
2247   return match_limit (num, 0);
2248 }
2249
2250 DEFUN ("match-data", Fmatch_data, 0, 2, 0, /*
2251 Return a list containing all info on what the last regexp search matched.
2252 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.
2253 All the elements are markers or nil (nil if the Nth pair didn't match)
2254 if the last match was on a buffer; integers or nil if a string was matched.
2255 Use `store-match-data' to reinstate the data in this list.
2256
2257 If INTEGERS (the optional first argument) is non-nil, always use integers
2258 \(rather than markers) to represent buffer positions.
2259 If REUSE is a list, reuse it as part of the value.  If REUSE is long enough
2260 to hold all the values, and if INTEGERS is non-nil, no consing is done.
2261 */
2262        (integers, reuse))
2263 {
2264   /* This function has been Mule-ized. */
2265   Lisp_Object tail, prev;
2266   Lisp_Object *data;
2267   int i;
2268   Charcount len;
2269
2270   if (NILP (last_thing_searched))
2271     /*error ("match-data called before any match found");*/
2272     return Qnil;
2273
2274   data = alloca_array (Lisp_Object, 2 * search_regs.num_regs);
2275
2276   len = -1;
2277   for (i = 0; i < search_regs.num_regs; i++)
2278     {
2279       Bufpos start = search_regs.start[i];
2280       if (start >= 0)
2281         {
2282           if (EQ (last_thing_searched, Qt)
2283               || !NILP (integers))
2284             {
2285               data[2 * i] = make_int (start);
2286               data[2 * i + 1] = make_int (search_regs.end[i]);
2287             }
2288           else if (BUFFERP (last_thing_searched))
2289             {
2290               data[2 * i] = Fmake_marker ();
2291               Fset_marker (data[2 * i],
2292                            make_int (start),
2293                            last_thing_searched);
2294               data[2 * i + 1] = Fmake_marker ();
2295               Fset_marker (data[2 * i + 1],
2296                            make_int (search_regs.end[i]),
2297                            last_thing_searched);
2298             }
2299           else
2300             /* last_thing_searched must always be Qt, a buffer, or Qnil.  */
2301             abort ();
2302
2303           len = i;
2304         }
2305       else
2306         data[2 * i] = data [2 * i + 1] = Qnil;
2307     }
2308   if (!CONSP (reuse))
2309     return Flist (2 * len + 2, data);
2310
2311   /* If REUSE is a list, store as many value elements as will fit
2312      into the elements of REUSE.  */
2313   for (prev = Qnil, i = 0, tail = reuse; CONSP (tail); i++, tail = XCDR (tail))
2314     {
2315       if (i < 2 * len + 2)
2316         XCAR (tail) = data[i];
2317       else
2318         XCAR (tail) = Qnil;
2319       prev = tail;
2320     }
2321
2322   /* If we couldn't fit all value elements into REUSE,
2323      cons up the rest of them and add them to the end of REUSE.  */
2324   if (i < 2 * len + 2)
2325     XCDR (prev) = Flist (2 * len + 2 - i, data + i);
2326
2327   return reuse;
2328 }
2329
2330
2331 DEFUN ("store-match-data", Fstore_match_data, 1, 1, 0, /*
2332 Set internal data on last search match from elements of LIST.
2333 LIST should have been created by calling `match-data' previously.
2334 */
2335        (list))
2336 {
2337   /* This function has been Mule-ized. */
2338   REGISTER int i;
2339   REGISTER Lisp_Object marker;
2340   int num_regs;
2341   int length;
2342
2343   if (running_asynch_code)
2344     save_search_regs ();
2345
2346   CONCHECK_LIST (list);
2347
2348   /* Unless we find a marker with a buffer in LIST, assume that this
2349      match data came from a string.  */
2350   last_thing_searched = Qt;
2351
2352   /* Allocate registers if they don't already exist.  */
2353   length = XINT (Flength (list)) / 2;
2354   num_regs = search_regs.num_regs;
2355
2356   if (length > num_regs)
2357     {
2358       if (search_regs.num_regs == 0)
2359         {
2360           search_regs.start = xnew_array (regoff_t, length);
2361           search_regs.end   = xnew_array (regoff_t, length);
2362         }
2363       else
2364         {
2365           XREALLOC_ARRAY (search_regs.start, regoff_t, length);
2366           XREALLOC_ARRAY (search_regs.end,   regoff_t, length);
2367         }
2368
2369       search_regs.num_regs = length;
2370     }
2371
2372   for (i = 0; i < num_regs; i++)
2373     {
2374       marker = Fcar (list);
2375       if (NILP (marker))
2376         {
2377           search_regs.start[i] = -1;
2378           list = Fcdr (list);
2379         }
2380       else
2381         {
2382           if (MARKERP (marker))
2383             {
2384               if (XMARKER (marker)->buffer == 0)
2385                 marker = Qzero;
2386               else
2387                 XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
2388             }
2389
2390           CHECK_INT_COERCE_MARKER (marker);
2391           search_regs.start[i] = XINT (marker);
2392           list = Fcdr (list);
2393
2394           marker = Fcar (list);
2395           if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
2396             marker = Qzero;
2397
2398           CHECK_INT_COERCE_MARKER (marker);
2399           search_regs.end[i] = XINT (marker);
2400         }
2401       list = Fcdr (list);
2402     }
2403
2404   return Qnil;
2405 }
2406
2407 /* If non-zero the match data have been saved in saved_search_regs
2408    during the execution of a sentinel or filter. */
2409 static int search_regs_saved;
2410 static struct re_registers saved_search_regs;
2411
2412 /* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
2413    if asynchronous code (filter or sentinel) is running. */
2414 static void
2415 save_search_regs (void)
2416 {
2417   if (!search_regs_saved)
2418     {
2419       saved_search_regs.num_regs = search_regs.num_regs;
2420       saved_search_regs.start = search_regs.start;
2421       saved_search_regs.end = search_regs.end;
2422       search_regs.num_regs = 0;
2423       search_regs.start = 0;
2424       search_regs.end = 0;
2425
2426       search_regs_saved = 1;
2427     }
2428 }
2429
2430 /* Called upon exit from filters and sentinels. */
2431 void
2432 restore_match_data (void)
2433 {
2434   if (search_regs_saved)
2435     {
2436       if (search_regs.num_regs > 0)
2437         {
2438           xfree (search_regs.start);
2439           xfree (search_regs.end);
2440         }
2441       search_regs.num_regs = saved_search_regs.num_regs;
2442       search_regs.start = saved_search_regs.start;
2443       search_regs.end = saved_search_regs.end;
2444
2445       search_regs_saved = 0;
2446     }
2447 }
2448
2449 /* Quote a string to inactivate reg-expr chars */
2450
2451 DEFUN ("regexp-quote", Fregexp_quote, 1, 1, 0, /*
2452 Return a regexp string which matches exactly STRING and nothing else.
2453 */
2454        (str))
2455 {
2456   REGISTER Bufbyte *in, *out, *end;
2457   REGISTER Bufbyte *temp;
2458
2459   CHECK_STRING (str);
2460
2461   temp = (Bufbyte *) alloca (XSTRING_LENGTH (str) * 2);
2462
2463   /* Now copy the data into the new string, inserting escapes. */
2464
2465   in = XSTRING_DATA (str);
2466   end = in + XSTRING_LENGTH (str);
2467   out = temp;
2468
2469   while (in < end)
2470     {
2471       Emchar c = charptr_emchar (in);
2472
2473       if (c == '[' || c == ']'
2474           || c == '*' || c == '.' || c == '\\'
2475           || c == '?' || c == '+'
2476           || c == '^' || c == '$')
2477         *out++ = '\\';
2478       out += set_charptr_emchar (out, c);
2479       INC_CHARPTR (in);
2480     }
2481
2482   return make_string (temp, out - temp);
2483 }
2484
2485 DEFUN ("set-word-regexp", Fset_word_regexp, 1, 1, 0, /*
2486 Set the regexp to be used to match a word in regular-expression searching.
2487 #### Not yet implemented.  Currently does nothing.
2488 #### Do not use this yet.  Its calling interface is likely to change.
2489 */
2490        (regexp))
2491 {
2492   return Qnil;
2493 }
2494
2495 \f
2496 /************************************************************************/
2497 /*                            initialization                            */
2498 /************************************************************************/
2499
2500 void
2501 syms_of_search (void)
2502 {
2503
2504   deferror (&Qsearch_failed, "search-failed", "Search failed", Qerror);
2505   deferror (&Qinvalid_regexp, "invalid-regexp", "Invalid regexp", Qerror);
2506
2507   DEFSUBR (Flooking_at);
2508   DEFSUBR (Fposix_looking_at);
2509   DEFSUBR (Fstring_match);
2510   DEFSUBR (Fposix_string_match);
2511   DEFSUBR (Fskip_chars_forward);
2512   DEFSUBR (Fskip_chars_backward);
2513   DEFSUBR (Fskip_syntax_forward);
2514   DEFSUBR (Fskip_syntax_backward);
2515   DEFSUBR (Fsearch_forward);
2516   DEFSUBR (Fsearch_backward);
2517   DEFSUBR (Fword_search_forward);
2518   DEFSUBR (Fword_search_backward);
2519   DEFSUBR (Fre_search_forward);
2520   DEFSUBR (Fre_search_backward);
2521   DEFSUBR (Fposix_search_forward);
2522   DEFSUBR (Fposix_search_backward);
2523   DEFSUBR (Freplace_match);
2524   DEFSUBR (Fmatch_beginning);
2525   DEFSUBR (Fmatch_end);
2526   DEFSUBR (Fmatch_data);
2527   DEFSUBR (Fstore_match_data);
2528   DEFSUBR (Fregexp_quote);
2529   DEFSUBR (Fset_word_regexp);
2530 }
2531
2532 void
2533 vars_of_search (void)
2534 {
2535   REGISTER int i;
2536
2537   for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
2538     {
2539       searchbufs[i].buf.allocated = 100;
2540       searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100);
2541       searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
2542       searchbufs[i].regexp = Qnil;
2543       staticpro (&searchbufs[i].regexp);
2544       searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
2545     }
2546   searchbuf_head = &searchbufs[0];
2547
2548   last_thing_searched = Qnil;
2549   staticpro (&last_thing_searched);
2550
2551   DEFVAR_LISP ("forward-word-regexp", &Vforward_word_regexp /*
2552 *Regular expression to be used in `forward-word'.
2553 #### Not yet implemented.
2554 */ );
2555   Vforward_word_regexp = Qnil;
2556
2557   DEFVAR_LISP ("backward-word-regexp", &Vbackward_word_regexp /*
2558 *Regular expression to be used in `backward-word'.
2559 #### Not yet implemented.
2560 */ );
2561   Vbackward_word_regexp = Qnil;
2562 }
2563
2564 void
2565 complex_vars_of_search (void)
2566 {
2567   Vskip_chars_range_table = Fmake_range_table ();
2568   staticpro (&Vskip_chars_range_table);
2569 }