XEmacs 21.2.29 "Hestia".
[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 static struct regexp_cache searchbufs[REGEXP_CACHE_SIZE];
58
59 /* The head of the linked list; points to the most recently used buffer.  */
60 static 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 Bytind
704 bi_find_next_emchar_in_string (Lisp_String* str, Emchar target, Bytind st,
705                                EMACS_INT count)
706 {
707   /* This function has been Mule-ized. */
708   Bytind lim = string_length (str) -1;
709   Bufbyte* s = string_data (str);
710
711   assert (count >= 0);
712
713 #ifdef MULE
714   /* Due to the Mule representation of characters in a buffer,
715      we can simply search for characters in the range 0 - 127
716      directly.  For other characters, we do it the "hard" way.
717      Note that this way works for all characters but the other
718      way is faster. */
719   if (target >= 0200)
720     {
721       while (st < lim && count > 0)
722         {
723           if (string_char (str, st) == target)
724             count--;
725           INC_CHARBYTIND (s, st);
726         }
727     }
728   else
729 #endif
730     {
731       while (st < lim && count > 0)
732         {
733           Bufbyte *bufptr = (Bufbyte *) memchr (charptr_n_addr (s, st),
734                                                 (int) target, lim - st);
735           if (bufptr)
736             {
737               count--;
738               st =  (Bytind)(bufptr - s) + 1;
739             }
740           else
741             st = lim;
742         }
743     }
744   return st;
745 }
746
747 /* Like find_next_newline, but returns position before the newline,
748    not after, and only search up to TO.  This isn't just
749    find_next_newline (...)-1, because you might hit TO.  */
750 Bufpos
751 find_before_next_newline (struct buffer *buf, Bufpos from, Bufpos to, int count)
752 {
753   EMACS_INT shortage;
754   Bufpos pos = scan_buffer (buf, '\n', from, to, count, &shortage, 1);
755
756   if (shortage == 0)
757     pos--;
758
759   return pos;
760 }
761 \f
762 static Lisp_Object
763 skip_chars (struct buffer *buf, int forwardp, int syntaxp,
764             Lisp_Object string, Lisp_Object lim)
765 {
766   /* This function has been Mule-ized. */
767   REGISTER Bufbyte *p, *pend;
768   REGISTER Emchar c;
769   /* We store the first 256 chars in an array here and the rest in
770      a range table. */
771   unsigned char fastmap[0400];
772   int negate = 0;
773   REGISTER int i;
774   Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
775   Bufpos limit;
776
777   if (NILP (lim))
778     limit = forwardp ? BUF_ZV (buf) : BUF_BEGV (buf);
779   else
780     {
781       CHECK_INT_COERCE_MARKER (lim);
782       limit = XINT (lim);
783
784       /* In any case, don't allow scan outside bounds of buffer.  */
785       if (limit > BUF_ZV   (buf)) limit = BUF_ZV   (buf);
786       if (limit < BUF_BEGV (buf)) limit = BUF_BEGV (buf);
787     }
788
789   CHECK_STRING (string);
790   p = XSTRING_DATA (string);
791   pend = p + XSTRING_LENGTH (string);
792   memset (fastmap, 0, sizeof (fastmap));
793
794   Fclear_range_table (Vskip_chars_range_table);
795
796   if (p != pend && *p == '^')
797     {
798       negate = 1;
799       p++;
800     }
801
802   /* Find the characters specified and set their elements of fastmap.
803      If syntaxp, each character counts as itself.
804      Otherwise, handle backslashes and ranges specially  */
805
806   while (p != pend)
807     {
808       c = charptr_emchar (p);
809       INC_CHARPTR (p);
810       if (syntaxp)
811         {
812           if (c < 0400 && syntax_spec_code[c] < (unsigned char) Smax)
813             fastmap[c] = 1;
814           else
815             signal_simple_error ("Invalid syntax designator",
816                                  make_char (c));
817         }
818       else
819         {
820           if (c == '\\')
821             {
822               if (p == pend) break;
823               c = charptr_emchar (p);
824               INC_CHARPTR (p);
825             }
826           if (p != pend && *p == '-')
827             {
828               Emchar cend;
829
830               p++;
831               if (p == pend) break;
832               cend = charptr_emchar (p);
833               while (c <= cend && c < 0400)
834                 {
835                   fastmap[c] = 1;
836                   c++;
837                 }
838               if (c <= cend)
839                 Fput_range_table (make_int (c), make_int (cend), Qt,
840                                   Vskip_chars_range_table);
841               INC_CHARPTR (p);
842             }
843           else
844             {
845               if (c < 0400)
846                 fastmap[c] = 1;
847               else
848                 Fput_range_table (make_int (c), make_int (c), Qt,
849                                   Vskip_chars_range_table);
850             }
851         }
852     }
853
854   if (syntaxp && fastmap['-'] != 0)
855     fastmap[' '] = 1;
856
857   /* If ^ was the first character, complement the fastmap.
858      We don't complement the range table, however; we just use negate
859      in the comparisons below. */
860
861   if (negate)
862     for (i = 0; i < (int) (sizeof fastmap); i++)
863       fastmap[i] ^= 1;
864
865   {
866     Bufpos start_point = BUF_PT (buf);
867
868     if (syntaxp)
869       {
870         /* All syntax designators are normal chars so nothing strange
871            to worry about */
872         if (forwardp)
873           {
874             while (BUF_PT (buf) < limit
875                    && fastmap[(unsigned char)
876                               syntax_code_spec
877                               [(int) SYNTAX (syntax_table,
878                                              BUF_FETCH_CHAR
879                                              (buf, BUF_PT (buf)))]])
880               BUF_SET_PT (buf, BUF_PT (buf) + 1);
881           }
882         else
883           {
884             while (BUF_PT (buf) > limit
885                    && fastmap[(unsigned char)
886                               syntax_code_spec
887                               [(int) SYNTAX (syntax_table,
888                                              BUF_FETCH_CHAR
889                                              (buf, BUF_PT (buf) - 1))]])
890               BUF_SET_PT (buf, BUF_PT (buf) - 1);
891           }
892       }
893     else
894       {
895         if (forwardp)
896           {
897             while (BUF_PT (buf) < limit)
898               {
899                 Emchar ch = BUF_FETCH_CHAR (buf, BUF_PT (buf));
900                 if ((ch < 0400) ? fastmap[ch] :
901                     (NILP (Fget_range_table (make_int (ch),
902                                              Vskip_chars_range_table,
903                                              Qnil))
904                      == negate))
905                   BUF_SET_PT (buf, BUF_PT (buf) + 1);
906                 else
907                   break;
908               }
909           }
910         else
911           {
912             while (BUF_PT (buf) > limit)
913               {
914                 Emchar ch = BUF_FETCH_CHAR (buf, BUF_PT (buf) - 1);
915                 if ((ch < 0400) ? fastmap[ch] :
916                     (NILP (Fget_range_table (make_int (ch),
917                                              Vskip_chars_range_table,
918                                              Qnil))
919                      == negate))
920                   BUF_SET_PT (buf, BUF_PT (buf) - 1);
921                 else
922                   break;
923               }
924           }
925       }
926     QUIT;
927     return make_int (BUF_PT (buf) - start_point);
928   }
929 }
930
931 DEFUN ("skip-chars-forward", Fskip_chars_forward, 1, 3, 0, /*
932 Move point forward, stopping before a char not in STRING, or at pos LIM.
933 STRING is like the inside of a `[...]' in a regular expression
934 except that `]' is never special and `\\' quotes `^', `-' or `\\'.
935 Thus, with arg "a-zA-Z", this skips letters stopping before first nonletter.
936 With arg "^a-zA-Z", skips nonletters stopping before first letter.
937 Returns the distance traveled, either zero or positive.
938
939 Optional argument BUFFER defaults to the current buffer.
940 */
941        (string, lim, buffer))
942 {
943   return skip_chars (decode_buffer (buffer, 0), 1, 0, string, lim);
944 }
945
946 DEFUN ("skip-chars-backward", Fskip_chars_backward, 1, 3, 0, /*
947 Move point backward, stopping after a char not in STRING, or at pos LIM.
948 See `skip-chars-forward' for details.
949 Returns the distance traveled, either zero or negative.
950
951 Optional argument BUFFER defaults to the current buffer.
952 */
953        (string, lim, buffer))
954 {
955   return skip_chars (decode_buffer (buffer, 0), 0, 0, string, lim);
956 }
957
958
959 DEFUN ("skip-syntax-forward", Fskip_syntax_forward, 1, 3, 0, /*
960 Move point forward across chars in specified syntax classes.
961 SYNTAX is a string of syntax code characters.
962 Stop before a char whose syntax is not in SYNTAX, or at position LIM.
963 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
964 This function returns the distance traveled, either zero or positive.
965
966 Optional argument BUFFER defaults to the current buffer.
967 */
968        (syntax, lim, buffer))
969 {
970   return skip_chars (decode_buffer (buffer, 0), 1, 1, syntax, lim);
971 }
972
973 DEFUN ("skip-syntax-backward", Fskip_syntax_backward, 1, 3, 0, /*
974 Move point backward across chars in specified syntax classes.
975 SYNTAX is a string of syntax code characters.
976 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.
977 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.
978 This function returns the distance traveled, either zero or negative.
979
980 Optional argument BUFFER defaults to the current buffer.
981 */
982        (syntax, lim, buffer))
983 {
984   return skip_chars (decode_buffer (buffer, 0), 0, 1, syntax, lim);
985 }
986
987 \f
988 /* Subroutines of Lisp buffer search functions. */
989
990 static Lisp_Object
991 search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object no_error,
992                 Lisp_Object count, Lisp_Object buffer, int direction,
993                 int RE, int posix)
994 {
995   /* This function has been Mule-ized, except for the trt table handling. */
996   REGISTER Bufpos np;
997   Bufpos lim;
998   EMACS_INT n = direction;
999   struct buffer *buf;
1000
1001   if (!NILP (count))
1002     {
1003       CHECK_INT (count);
1004       n *= XINT (count);
1005     }
1006
1007   buf = decode_buffer (buffer, 0);
1008   CHECK_STRING (string);
1009   if (NILP (bound))
1010     lim = n > 0 ? BUF_ZV (buf) : BUF_BEGV (buf);
1011   else
1012     {
1013       CHECK_INT_COERCE_MARKER (bound);
1014       lim = XINT (bound);
1015       if (n > 0 ? lim < BUF_PT (buf) : lim > BUF_PT (buf))
1016         error ("Invalid search bound (wrong side of point)");
1017       if (lim > BUF_ZV (buf))
1018         lim = BUF_ZV (buf);
1019       if (lim < BUF_BEGV (buf))
1020         lim = BUF_BEGV (buf);
1021     }
1022
1023   np = search_buffer (buf, string, BUF_PT (buf), lim, n, RE,
1024                       (!NILP (buf->case_fold_search)
1025                        ? MIRROR_CANON_TABLE_AS_STRING (buf)
1026                        : 0),
1027                       (!NILP (buf->case_fold_search)
1028                        ? MIRROR_EQV_TABLE_AS_STRING (buf)
1029                        : 0), posix);
1030
1031   if (np <= 0)
1032     {
1033       if (NILP (no_error))
1034         return signal_failure (string);
1035       if (!EQ (no_error, Qt))
1036         {
1037           if (lim < BUF_BEGV (buf) || lim > BUF_ZV (buf))
1038             abort ();
1039           BUF_SET_PT (buf, lim);
1040           return Qnil;
1041 #if 0 /* This would be clean, but maybe programs depend on
1042          a value of nil here.  */
1043           np = lim;
1044 #endif
1045         }
1046       else
1047         return Qnil;
1048     }
1049
1050   if (np < BUF_BEGV (buf) || np > BUF_ZV (buf))
1051     abort ();
1052
1053   BUF_SET_PT (buf, np);
1054
1055   return make_int (np);
1056 }
1057 \f
1058 static int
1059 trivial_regexp_p (Lisp_Object regexp)
1060 {
1061   /* This function has been Mule-ized. */
1062   Bytecount len = XSTRING_LENGTH (regexp);
1063   Bufbyte *s = XSTRING_DATA (regexp);
1064   while (--len >= 0)
1065     {
1066       switch (*s++)
1067         {
1068         case '.': case '*': case '+': case '?': case '[': case '^': case '$':
1069           return 0;
1070         case '\\':
1071           if (--len < 0)
1072             return 0;
1073           switch (*s++)
1074             {
1075             case '|': case '(': case ')': case '`': case '\'': case 'b':
1076             case 'B': case '<': case '>': case 'w': case 'W': case 's':
1077             case 'S': case '=':
1078 #ifdef MULE
1079             /* 97/2/25 jhod Added for category matches */
1080             case 'c': case 'C':
1081 #endif /* MULE */
1082             case '1': case '2': case '3': case '4': case '5':
1083             case '6': case '7': case '8': case '9':
1084               return 0;
1085             }
1086         }
1087     }
1088   return 1;
1089 }
1090
1091 /* Search for the n'th occurrence of STRING in BUF,
1092    starting at position BUFPOS and stopping at position BUFLIM,
1093    treating PAT as a literal string if RE is false or as
1094    a regular expression if RE is true.
1095
1096    If N is positive, searching is forward and BUFLIM must be greater
1097    than BUFPOS.
1098    If N is negative, searching is backward and BUFLIM must be less
1099    than BUFPOS.
1100
1101    Returns -x if only N-x occurrences found (x > 0),
1102    or else the position at the beginning of the Nth occurrence
1103    (if searching backward) or the end (if searching forward).
1104
1105    POSIX is nonzero if we want full backtracking (POSIX style)
1106    for this pattern.  0 means backtrack only enough to get a valid match.  */
1107
1108 static Bufpos
1109 search_buffer (struct buffer *buf, Lisp_Object string, Bufpos bufpos,
1110                Bufpos buflim, EMACS_INT n, int RE, unsigned char *trt,
1111                unsigned char *inverse_trt, int posix)
1112 {
1113   /* This function has been Mule-ized, except for the trt table handling. */
1114   Bytecount len = XSTRING_LENGTH (string);
1115   Bufbyte *base_pat = XSTRING_DATA (string);
1116   REGISTER EMACS_INT *BM_tab;
1117   EMACS_INT *BM_tab_base;
1118   REGISTER int direction = ((n > 0) ? 1 : -1);
1119   REGISTER Bytecount dirlen;
1120   EMACS_INT infinity;
1121   Bytind limit;
1122   EMACS_INT k;
1123   Bytecount stride_for_teases = 0;
1124   REGISTER Bufbyte *pat = 0;
1125   REGISTER Bufbyte *cursor, *p_limit, *ptr2;
1126   REGISTER EMACS_INT i, j;
1127   Bytind p1, p2;
1128   Bytecount s1, s2;
1129   Bytind pos, lim;
1130
1131   if (running_asynch_code)
1132     save_search_regs ();
1133
1134   /* Null string is found at starting position.  */
1135   if (len == 0)
1136     {
1137       set_search_regs (buf, bufpos, 0);
1138       return bufpos;
1139     }
1140
1141   /* Searching 0 times means don't move.  */
1142   if (n == 0)
1143     return bufpos;
1144
1145   pos = bufpos_to_bytind (buf, bufpos);
1146   lim = bufpos_to_bytind (buf, buflim);
1147   if (RE && !trivial_regexp_p (string))
1148     {
1149       struct re_pattern_buffer *bufp;
1150
1151       bufp = compile_pattern (string, &search_regs, (char *) trt, posix,
1152                               ERROR_ME);
1153
1154       /* Get pointers and sizes of the two strings
1155          that make up the visible portion of the buffer. */
1156
1157       p1 = BI_BUF_BEGV (buf);
1158       p2 = BI_BUF_CEILING_OF (buf, p1);
1159       s1 = p2 - p1;
1160       s2 = BI_BUF_ZV (buf) - p2;
1161
1162       while (n < 0)
1163         {
1164           Bytecount val;
1165           QUIT;
1166           regex_emacs_buffer = buf;
1167           val = re_search_2 (bufp,
1168                              (char *) BI_BUF_BYTE_ADDRESS (buf, p1), s1,
1169                              (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2,
1170                              pos - BI_BUF_BEGV (buf), lim - pos, &search_regs,
1171                              pos - BI_BUF_BEGV (buf));
1172
1173           if (val == -2)
1174             {
1175               matcher_overflow ();
1176             }
1177           if (val >= 0)
1178             {
1179               int num_regs = search_regs.num_regs;
1180               j = BI_BUF_BEGV (buf);
1181               for (i = 0; i < num_regs; i++)
1182                 if (search_regs.start[i] >= 0)
1183                   {
1184                     search_regs.start[i] += j;
1185                     search_regs.end[i] += j;
1186                   }
1187               XSETBUFFER (last_thing_searched, buf);
1188               /* Set pos to the new position. */
1189               pos = search_regs.start[0];
1190               fixup_search_regs_for_buffer (buf);
1191               /* And bufpos too. */
1192               bufpos = search_regs.start[0];
1193             }
1194           else
1195             {
1196               return n;
1197             }
1198           n++;
1199         }
1200       while (n > 0)
1201         {
1202           Bytecount val;
1203           QUIT;
1204           regex_emacs_buffer = buf;
1205           val = re_search_2 (bufp,
1206                              (char *) BI_BUF_BYTE_ADDRESS (buf, p1), s1,
1207                              (char *) BI_BUF_BYTE_ADDRESS (buf, p2), s2,
1208                              pos - BI_BUF_BEGV (buf), lim - pos, &search_regs,
1209                              lim - BI_BUF_BEGV (buf));
1210           if (val == -2)
1211             {
1212               matcher_overflow ();
1213             }
1214           if (val >= 0)
1215             {
1216               int num_regs = search_regs.num_regs;
1217               j = BI_BUF_BEGV (buf);
1218               for (i = 0; i < num_regs; i++)
1219                 if (search_regs.start[i] >= 0)
1220                   {
1221                     search_regs.start[i] += j;
1222                     search_regs.end[i] += j;
1223                   }
1224               XSETBUFFER (last_thing_searched, buf);
1225               /* Set pos to the new position. */
1226               pos = search_regs.end[0];
1227               fixup_search_regs_for_buffer (buf);
1228               /* And bufpos too. */
1229               bufpos = search_regs.end[0];
1230             }
1231           else
1232             {
1233               return 0 - n;
1234             }
1235           n--;
1236         }
1237       return bufpos;
1238     }
1239   else                          /* non-RE case */
1240     /* #### Someone really really really needs to comment the workings
1241        of this junk somewhat better.
1242
1243        BTW "BM" stands for Boyer-Moore, which is one of the standard
1244        string-searching algorithms.  It's the best string-searching
1245        algorithm out there provided
1246
1247        a) You're not fazed by algorithm complexity. (Rabin-Karp, which
1248           uses hashing, is much much easier to code but not as fast.)
1249        b) You can freely move backwards in the string that you're
1250           searching through.
1251
1252        As the comment below tries to explain (but garbles in typical
1253        programmer-ese), the idea is that you don't have to do a
1254        string match at every successive position in the text.  For
1255        example, let's say the pattern is "a very long string".  We
1256        compare the last character in the string (`g') with the
1257        corresponding character in the text.  If it mismatches, and
1258        it is, say, `z', then we can skip forward by the entire
1259        length of the pattern because `z' does not occur anywhere
1260        in the pattern.  If the mismatching character does occur
1261        in the pattern, we can usually still skip forward by more
1262        than one: e.g. if it is `l', then we can skip forward
1263        by the length of the substring "ong string" -- i.e. the
1264        largest end section of the pattern that does not contain
1265        the mismatched character.  So what we do is compute, for
1266        each possible character, the distance we can skip forward
1267        (the "stride") and use it in the string matching.  This
1268        is what the BM_tab holds. */
1269     {
1270 #ifdef C_ALLOCA
1271       EMACS_INT BM_tab_space[0400];
1272       BM_tab = &BM_tab_space[0];
1273 #else
1274       BM_tab = alloca_array (EMACS_INT, 256);
1275 #endif
1276       {
1277         Bufbyte *patbuf = alloca_array (Bufbyte, len);
1278         pat = patbuf;
1279         while (--len >= 0)
1280           {
1281             /* If we got here and the RE flag is set, it's because we're
1282                dealing with a regexp known to be trivial, so the backslash
1283                just quotes the next character.  */
1284             if (RE && *base_pat == '\\')
1285               {
1286                 len--;
1287                 base_pat++;
1288               }
1289             *pat++ = (trt ? trt[*base_pat++] : *base_pat++);
1290           }
1291         len = pat - patbuf;
1292         pat = base_pat = patbuf;
1293       }
1294       /* The general approach is that we are going to maintain that we know */
1295       /* the first (closest to the present position, in whatever direction */
1296       /* we're searching) character that could possibly be the last */
1297       /* (furthest from present position) character of a valid match.  We */
1298       /* advance the state of our knowledge by looking at that character */
1299       /* and seeing whether it indeed matches the last character of the */
1300       /* pattern.  If it does, we take a closer look.  If it does not, we */
1301       /* move our pointer (to putative last characters) as far as is */
1302       /* logically possible.  This amount of movement, which I call a */
1303       /* stride, will be the length of the pattern if the actual character */
1304       /* appears nowhere in the pattern, otherwise it will be the distance */
1305       /* from the last occurrence of that character to the end of the */
1306       /* pattern. */
1307       /* As a coding trick, an enormous stride is coded into the table for */
1308       /* characters that match the last character.  This allows use of only */
1309       /* a single test, a test for having gone past the end of the */
1310       /* permissible match region, to test for both possible matches (when */
1311       /* the stride goes past the end immediately) and failure to */
1312       /* match (where you get nudged past the end one stride at a time). */
1313
1314       /* Here we make a "mickey mouse" BM table.  The stride of the search */
1315       /* is determined only by the last character of the putative match. */
1316       /* If that character does not match, we will stride the proper */
1317       /* distance to propose a match that superimposes it on the last */
1318       /* instance of a character that matches it (per trt), or misses */
1319       /* it entirely if there is none. */
1320
1321       dirlen = len * direction;
1322       infinity = dirlen - (lim + pos + len + len) * direction;
1323       if (direction < 0)
1324         pat = (base_pat += len - 1);
1325       BM_tab_base = BM_tab;
1326       BM_tab += 0400;
1327       j = dirlen;               /* to get it in a register */
1328       /* A character that does not appear in the pattern induces a */
1329       /* stride equal to the pattern length. */
1330       while (BM_tab_base != BM_tab)
1331         {
1332           *--BM_tab = j;
1333           *--BM_tab = j;
1334           *--BM_tab = j;
1335           *--BM_tab = j;
1336         }
1337       i = 0;
1338       while (i != infinity)
1339         {
1340           j = pat[i]; i += direction;
1341           if (i == dirlen) i = infinity;
1342           if (trt != 0)
1343             {
1344               k = (j = trt[j]);
1345               if (i == infinity)
1346                 stride_for_teases = BM_tab[j];
1347               BM_tab[j] = dirlen - i;
1348               /* A translation table is accompanied by its inverse -- see */
1349               /* comment following downcase_table for details */
1350
1351               while ((j = inverse_trt[j]) != k)
1352                 BM_tab[j] = dirlen - i;
1353             }
1354           else
1355             {
1356               if (i == infinity)
1357                 stride_for_teases = BM_tab[j];
1358               BM_tab[j] = dirlen - i;
1359             }
1360           /* stride_for_teases tells how much to stride if we get a */
1361           /* match on the far character but are subsequently */
1362           /* disappointed, by recording what the stride would have been */
1363           /* for that character if the last character had been */
1364           /* different. */
1365         }
1366       infinity = dirlen - infinity;
1367       pos += dirlen - ((direction > 0) ? direction : 0);
1368       /* loop invariant - pos points at where last char (first char if reverse)
1369          of pattern would align in a possible match.  */
1370       while (n != 0)
1371         {
1372           /* It's been reported that some (broken) compiler thinks that
1373              Boolean expressions in an arithmetic context are unsigned.
1374              Using an explicit ?1:0 prevents this.  */
1375           if ((lim - pos - ((direction > 0) ? 1 : 0)) * direction < 0)
1376             return n * (0 - direction);
1377           /* First we do the part we can by pointers (maybe nothing) */
1378           QUIT;
1379           pat = base_pat;
1380           limit = pos - dirlen + direction;
1381           /* XEmacs change: definitions of CEILING_OF and FLOOR_OF
1382              have changed.  See buffer.h. */
1383           limit = ((direction > 0)
1384                    ? BI_BUF_CEILING_OF (buf, limit) - 1
1385                    : BI_BUF_FLOOR_OF (buf, limit + 1));
1386           /* LIMIT is now the last (not beyond-last!) value
1387              POS can take on without hitting edge of buffer or the gap.  */
1388           limit = ((direction > 0)
1389                    ? min (lim - 1, min (limit, pos + 20000))
1390                    : max (lim, max (limit, pos - 20000)));
1391           if ((limit - pos) * direction > 20)
1392             {
1393               p_limit = BI_BUF_BYTE_ADDRESS (buf, limit);
1394               ptr2 = (cursor = BI_BUF_BYTE_ADDRESS (buf, pos));
1395               /* In this loop, pos + cursor - ptr2 is the surrogate for pos */
1396               while (1)         /* use one cursor setting as long as i can */
1397                 {
1398                   if (direction > 0) /* worth duplicating */
1399                     {
1400                       /* Use signed comparison if appropriate
1401                          to make cursor+infinity sure to be > p_limit.
1402                          Assuming that the buffer lies in a range of addresses
1403                          that are all "positive" (as ints) or all "negative",
1404                          either kind of comparison will work as long
1405                          as we don't step by infinity.  So pick the kind
1406                          that works when we do step by infinity.  */
1407                       if ((EMACS_INT) (p_limit + infinity) >
1408                           (EMACS_INT) p_limit)
1409                         while ((EMACS_INT) cursor <=
1410                                (EMACS_INT) p_limit)
1411                           cursor += BM_tab[*cursor];
1412                       else
1413                         while ((EMACS_UINT) cursor <=
1414                                (EMACS_UINT) p_limit)
1415                           cursor += BM_tab[*cursor];
1416                     }
1417                   else
1418                     {
1419                       if ((EMACS_INT) (p_limit + infinity) <
1420                           (EMACS_INT) p_limit)
1421                         while ((EMACS_INT) cursor >=
1422                                (EMACS_INT) p_limit)
1423                           cursor += BM_tab[*cursor];
1424                       else
1425                         while ((EMACS_UINT) cursor >=
1426                                (EMACS_UINT) p_limit)
1427                           cursor += BM_tab[*cursor];
1428                     }
1429  /* If you are here, cursor is beyond the end of the searched region. */
1430  /* This can happen if you match on the far character of the pattern, */
1431  /* because the "stride" of that character is infinity, a number able */
1432  /* to throw you well beyond the end of the search.  It can also */
1433  /* happen if you fail to match within the permitted region and would */
1434  /* otherwise try a character beyond that region */
1435                   if ((cursor - p_limit) * direction <= len)
1436                     break;      /* a small overrun is genuine */
1437                   cursor -= infinity; /* large overrun = hit */
1438                   i = dirlen - direction;
1439                   if (trt != 0)
1440                     {
1441                       while ((i -= direction) + direction != 0)
1442                         if (pat[i] != trt[*(cursor -= direction)])
1443                           break;
1444                     }
1445                   else
1446                     {
1447                       while ((i -= direction) + direction != 0)
1448                         if (pat[i] != *(cursor -= direction))
1449                           break;
1450                     }
1451                   cursor += dirlen - i - direction;     /* fix cursor */
1452                   if (i + direction == 0)
1453                     {
1454                       cursor -= direction;
1455
1456                       {
1457                         Bytind bytstart = (pos + cursor - ptr2 +
1458                                            ((direction > 0)
1459                                             ? 1 - len : 0));
1460                         Bufpos bufstart = bytind_to_bufpos (buf, bytstart);
1461                         Bufpos bufend = bytind_to_bufpos (buf, bytstart + len);
1462
1463                         set_search_regs (buf, bufstart, bufend - bufstart);
1464                       }
1465
1466                       if ((n -= direction) != 0)
1467                         cursor += dirlen; /* to resume search */
1468                       else
1469                         return ((direction > 0)
1470                                 ? search_regs.end[0] : search_regs.start[0]);
1471                     }
1472                   else
1473                     cursor += stride_for_teases; /* <sigh> we lose -  */
1474                 }
1475               pos += cursor - ptr2;
1476             }
1477           else
1478             /* Now we'll pick up a clump that has to be done the hard */
1479             /* way because it covers a discontinuity */
1480             {
1481               /* XEmacs change: definitions of CEILING_OF and FLOOR_OF
1482                  have changed.  See buffer.h. */
1483               limit = ((direction > 0)
1484                        ? BI_BUF_CEILING_OF (buf, pos - dirlen + 1) - 1
1485                        : BI_BUF_FLOOR_OF (buf, pos - dirlen));
1486               limit = ((direction > 0)
1487                        ? min (limit + len, lim - 1)
1488                        : max (limit - len, lim));
1489               /* LIMIT is now the last value POS can have
1490                  and still be valid for a possible match.  */
1491               while (1)
1492                 {
1493                   /* This loop can be coded for space rather than */
1494                   /* speed because it will usually run only once. */
1495                   /* (the reach is at most len + 21, and typically */
1496                   /* does not exceed len) */
1497                   while ((limit - pos) * direction >= 0)
1498                     /* *not* BI_BUF_FETCH_CHAR.  We are working here
1499                        with bytes, not characters. */
1500                     pos += BM_tab[*BI_BUF_BYTE_ADDRESS (buf, pos)];
1501                   /* now run the same tests to distinguish going off the */
1502                   /* end, a match or a phony match. */
1503                   if ((pos - limit) * direction <= len)
1504                     break;      /* ran off the end */
1505                   /* Found what might be a match.
1506                      Set POS back to last (first if reverse) char pos.  */
1507                   pos -= infinity;
1508                   i = dirlen - direction;
1509                   while ((i -= direction) + direction != 0)
1510                     {
1511                       pos -= direction;
1512                       if (pat[i] != (((Bufbyte *) trt)
1513                                      /* #### Does not handle TRT right */
1514                                      ? trt[*BI_BUF_BYTE_ADDRESS (buf, pos)]
1515                                      : *BI_BUF_BYTE_ADDRESS (buf, pos)))
1516                         break;
1517                     }
1518                   /* Above loop has moved POS part or all the way
1519                      back to the first char pos (last char pos if reverse).
1520                      Set it once again at the last (first if reverse) char.  */
1521                   pos += dirlen - i- direction;
1522                   if (i + direction == 0)
1523                     {
1524                       pos -= direction;
1525
1526                       {
1527                         Bytind bytstart = (pos +
1528                                            ((direction > 0)
1529                                             ? 1 - len : 0));
1530                         Bufpos bufstart = bytind_to_bufpos (buf, bytstart);
1531                         Bufpos bufend = bytind_to_bufpos (buf, bytstart + len);
1532
1533                         set_search_regs (buf, bufstart, bufend - bufstart);
1534                       }
1535
1536                       if ((n -= direction) != 0)
1537                         pos += dirlen; /* to resume search */
1538                       else
1539                         return ((direction > 0)
1540                                 ? search_regs.end[0] : search_regs.start[0]);
1541                     }
1542                   else
1543                     pos += stride_for_teases;
1544                 }
1545               }
1546           /* We have done one clump.  Can we continue? */
1547           if ((lim - pos) * direction < 0)
1548             return (0 - n) * direction;
1549         }
1550       return bytind_to_bufpos (buf, pos);
1551     }
1552 }
1553
1554 /* Record beginning BEG and end BEG + LEN
1555    for a match just found in the current buffer.  */
1556
1557 static void
1558 set_search_regs (struct buffer *buf, Bufpos beg, Charcount len)
1559 {
1560   /* This function has been Mule-ized. */
1561   /* Make sure we have registers in which to store
1562      the match position.  */
1563   if (search_regs.num_regs == 0)
1564     {
1565       search_regs.start = xnew (regoff_t);
1566       search_regs.end   = xnew (regoff_t);
1567       search_regs.num_regs = 1;
1568     }
1569
1570   search_regs.start[0] = beg;
1571   search_regs.end[0] = beg + len;
1572   XSETBUFFER (last_thing_searched, buf);
1573 }
1574
1575 \f
1576 /* Given a string of words separated by word delimiters,
1577   compute a regexp that matches those exact words
1578   separated by arbitrary punctuation.  */
1579
1580 static Lisp_Object
1581 wordify (Lisp_Object buffer, Lisp_Object string)
1582 {
1583   Charcount i, len;
1584   EMACS_INT punct_count = 0, word_count = 0;
1585   struct buffer *buf = decode_buffer (buffer, 0);
1586   Lisp_Char_Table *syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
1587
1588   CHECK_STRING (string);
1589   len = XSTRING_CHAR_LENGTH (string);
1590
1591   for (i = 0; i < len; i++)
1592     if (!WORD_SYNTAX_P (syntax_table, string_char (XSTRING (string), i)))
1593       {
1594         punct_count++;
1595         if (i > 0 && WORD_SYNTAX_P (syntax_table,
1596                                     string_char (XSTRING (string), i - 1)))
1597           word_count++;
1598       }
1599   if (WORD_SYNTAX_P (syntax_table, string_char (XSTRING (string), len - 1)))
1600     word_count++;
1601   if (!word_count) return build_string ("");
1602
1603   {
1604     /* The following value is an upper bound on the amount of storage we
1605        need.  In non-Mule, it is exact. */
1606     Bufbyte *storage =
1607       (Bufbyte *) alloca (XSTRING_LENGTH (string) - punct_count +
1608                           5 * (word_count - 1) + 4);
1609     Bufbyte *o = storage;
1610
1611     *o++ = '\\';
1612     *o++ = 'b';
1613
1614     for (i = 0; i < len; i++)
1615       {
1616         Emchar ch = string_char (XSTRING (string), i);
1617
1618         if (WORD_SYNTAX_P (syntax_table, ch))
1619           o += set_charptr_emchar (o, ch);
1620         else if (i > 0
1621                  && WORD_SYNTAX_P (syntax_table,
1622                                    string_char (XSTRING (string), i - 1))
1623                  && --word_count)
1624           {
1625             *o++ = '\\';
1626             *o++ = 'W';
1627             *o++ = '\\';
1628             *o++ = 'W';
1629             *o++ = '*';
1630           }
1631       }
1632
1633     *o++ = '\\';
1634     *o++ = 'b';
1635
1636     return make_string (storage, o - storage);
1637   }
1638 }
1639 \f
1640 DEFUN ("search-backward", Fsearch_backward, 1, 5, "sSearch backward: ", /*
1641 Search backward from point for STRING.
1642 Set point to the beginning of the occurrence found, and return point.
1643 An optional second argument bounds the search; it is a buffer position.
1644 The match found must not extend before that position.
1645 Optional third argument, if t, means if fail just return nil (no error).
1646  If not nil and not t, position at limit of search and return nil.
1647 Optional fourth argument is repeat count--search for successive occurrences.
1648 Optional fifth argument BUFFER specifies the buffer to search in and
1649  defaults to the current buffer.
1650 See also the functions `match-beginning', `match-end' and `replace-match'.
1651 */
1652        (string, bound, no_error, count, buffer))
1653 {
1654   return search_command (string, bound, no_error, count, buffer, -1, 0, 0);
1655 }
1656
1657 DEFUN ("search-forward", Fsearch_forward, 1, 5, "sSearch: ", /*
1658 Search forward from point for STRING.
1659 Set point to the end of the occurrence found, and return point.
1660 An optional second argument bounds the search; it is a buffer position.
1661 The match found must not extend after that position.  nil is equivalent
1662   to (point-max).
1663 Optional third argument, if t, means if fail just return nil (no error).
1664   If not nil and not t, move to limit of search and return nil.
1665 Optional fourth argument is repeat count--search for successive occurrences.
1666 Optional fifth argument BUFFER specifies the buffer to search in and
1667  defaults to the current buffer.
1668 See also the functions `match-beginning', `match-end' and `replace-match'.
1669 */
1670        (string, bound, no_error, count, buffer))
1671 {
1672   return search_command (string, bound, no_error, count, buffer, 1, 0, 0);
1673 }
1674
1675 DEFUN ("word-search-backward", Fword_search_backward, 1, 5,
1676        "sWord search backward: ", /*
1677 Search backward from point for STRING, ignoring differences in punctuation.
1678 Set point to the beginning of the occurrence found, and return point.
1679 An optional second argument bounds the search; it is a buffer position.
1680 The match found must not extend before that position.
1681 Optional third argument, if t, means if fail just return nil (no error).
1682   If not nil and not t, move to limit of search and return nil.
1683 Optional fourth argument is repeat count--search for successive occurrences.
1684 Optional fifth argument BUFFER specifies the buffer to search in and
1685  defaults to the current buffer.
1686 */
1687        (string, bound, no_error, count, buffer))
1688 {
1689   return search_command (wordify (buffer, string), bound, no_error, count,
1690                          buffer, -1, 1, 0);
1691 }
1692
1693 DEFUN ("word-search-forward", Fword_search_forward, 1, 5, "sWord search: ", /*
1694 Search forward from point for STRING, ignoring differences in punctuation.
1695 Set point to the end of the occurrence found, and return point.
1696 An optional second argument bounds the search; it is a buffer position.
1697 The match found must not extend after that position.
1698 Optional third argument, if t, means if fail just return nil (no error).
1699   If not nil and not t, move to limit of search and return nil.
1700 Optional fourth argument is repeat count--search for successive occurrences.
1701 Optional fifth argument BUFFER specifies the buffer to search in and
1702  defaults to the current buffer.
1703 */
1704        (string, bound, no_error, count, buffer))
1705 {
1706   return search_command (wordify (buffer, string), bound, no_error, count,
1707                          buffer, 1, 1, 0);
1708 }
1709
1710 DEFUN ("re-search-backward", Fre_search_backward, 1, 5,
1711        "sRE search backward: ", /*
1712 Search backward from point for match for regular expression REGEXP.
1713 Set point to the beginning of the match, and return point.
1714 The match found is the one starting last in the buffer
1715 and yet ending before the origin of the search.
1716 An optional second argument bounds the search; it is a buffer position.
1717 The match found must start at or after that position.
1718 Optional third argument, if t, means if fail just return nil (no error).
1719   If not nil and not t, move to limit of search and return nil.
1720 Optional fourth argument is repeat count--search for successive occurrences.
1721 Optional fifth argument BUFFER specifies the buffer to search in and
1722  defaults to the current buffer.
1723 See also the functions `match-beginning', `match-end' and `replace-match'.
1724 */
1725        (regexp, bound, no_error, count, buffer))
1726 {
1727   return search_command (regexp, bound, no_error, count, buffer, -1, 1, 0);
1728 }
1729
1730 DEFUN ("re-search-forward", Fre_search_forward, 1, 5, "sRE search: ", /*
1731 Search forward from point for regular expression REGEXP.
1732 Set point to the end of the occurrence found, and return point.
1733 An optional second argument bounds the search; it is a buffer position.
1734 The match found must not extend after that position.
1735 Optional third argument, if t, means if fail just return nil (no error).
1736   If not nil and not t, move to limit of search and return nil.
1737 Optional fourth argument is repeat count--search for successive occurrences.
1738 Optional fifth argument BUFFER specifies the buffer to search in and
1739  defaults to the current buffer.
1740 See also the functions `match-beginning', `match-end' and `replace-match'.
1741 */
1742        (regexp, bound, no_error, count, buffer))
1743 {
1744   return search_command (regexp, bound, no_error, count, buffer, 1, 1, 0);
1745 }
1746
1747 DEFUN ("posix-search-backward", Fposix_search_backward, 1, 5,
1748        "sPosix search backward: ", /*
1749 Search backward from point for match for regular expression REGEXP.
1750 Find the longest match in accord with Posix regular expression rules.
1751 Set point to the beginning of the match, and return point.
1752 The match found is the one starting last in the buffer
1753 and yet ending before the origin of the search.
1754 An optional second argument bounds the search; it is a buffer position.
1755 The match found must start at or after that position.
1756 Optional third argument, if t, means if fail just return nil (no error).
1757   If not nil and not t, move to limit of search and return nil.
1758 Optional fourth argument is repeat count--search for successive occurrences.
1759 Optional fifth argument BUFFER specifies the buffer to search in and
1760  defaults to the current buffer.
1761 See also the functions `match-beginning', `match-end' and `replace-match'.
1762 */
1763        (regexp, bound, no_error, count, buffer))
1764 {
1765   return search_command (regexp, bound, no_error, count, buffer, -1, 1, 1);
1766 }
1767
1768 DEFUN ("posix-search-forward", Fposix_search_forward, 1, 5, "sPosix search: ", /*
1769 Search forward from point for regular expression REGEXP.
1770 Find the longest match in accord with Posix regular expression rules.
1771 Set point to the end of the occurrence found, and return point.
1772 An optional second argument bounds the search; it is a buffer position.
1773 The match found must not extend after that position.
1774 Optional third argument, if t, means if fail just return nil (no error).
1775   If not nil and not t, move to limit of search and return nil.
1776 Optional fourth argument is repeat count--search for successive occurrences.
1777 Optional fifth argument BUFFER specifies the buffer to search in and
1778  defaults to the current buffer.
1779 See also the functions `match-beginning', `match-end' and `replace-match'.
1780 */
1781        (regexp, bound, no_error, count, buffer))
1782 {
1783   return search_command (regexp, bound, no_error, count, buffer, 1, 1, 1);
1784 }
1785
1786 \f
1787 static Lisp_Object
1788 free_created_dynarrs (Lisp_Object cons)
1789 {
1790   Dynarr_free (get_opaque_ptr (XCAR (cons)));
1791   Dynarr_free (get_opaque_ptr (XCDR (cons)));
1792   free_opaque_ptr (XCAR (cons));
1793   free_opaque_ptr (XCDR (cons));
1794   free_cons (XCONS (cons));
1795   return Qnil;
1796 }
1797
1798 DEFUN ("replace-match", Freplace_match, 1, 5, 0, /*
1799 Replace text matched by last search with NEWTEXT.
1800 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.
1801 Otherwise maybe capitalize the whole text, or maybe just word initials,
1802 based on the replaced text.
1803 If the replaced text has only capital letters
1804 and has at least one multiletter word, convert NEWTEXT to all caps.
1805 If the replaced text has at least one word starting with a capital letter,
1806 then capitalize each word in NEWTEXT.
1807
1808 If third arg LITERAL is non-nil, insert NEWTEXT literally.
1809 Otherwise treat `\\' as special:
1810   `\\&' in NEWTEXT means substitute original matched text.
1811   `\\N' means substitute what matched the Nth `\\(...\\)'.
1812        If Nth parens didn't match, substitute nothing.
1813   `\\\\' means insert one `\\'.
1814   `\\u' means upcase the next character.
1815   `\\l' means downcase the next character.
1816   `\\U' means begin upcasing all following characters.
1817   `\\L' means begin downcasing all following characters.
1818   `\\E' means terminate the effect of any `\\U' or `\\L'.
1819   Case changes made with `\\u', `\\l', `\\U', and `\\L' override
1820   all other case changes that may be made in the replaced text.
1821 FIXEDCASE and LITERAL are optional arguments.
1822 Leaves point at end of replacement text.
1823
1824 The optional fourth argument STRING can be a string to modify.
1825 In that case, this function creates and returns a new string
1826 which is made by replacing the part of STRING that was matched.
1827 When fourth argument is a string, fifth argument STRBUFFER specifies
1828 the buffer to be used for syntax-table and case-table lookup and
1829 defaults to the current buffer. (When fourth argument is not a string,
1830 the buffer that the match occurred in has automatically been remembered
1831 and you do not need to specify it.)
1832 */
1833        (newtext, fixedcase, literal, string, strbuffer))
1834 {
1835   /* This function has been Mule-ized. */
1836   /* This function can GC */
1837   enum { nochange, all_caps, cap_initial } case_action;
1838   Bufpos pos, last;
1839   int some_multiletter_word;
1840   int some_lowercase;
1841   int some_uppercase;
1842   int some_nonuppercase_initial;
1843   Emchar c, prevc;
1844   Charcount inslen;
1845   struct buffer *buf;
1846   Lisp_Char_Table *syntax_table;
1847   int mc_count;
1848   Lisp_Object buffer;
1849   int_dynarr *ul_action_dynarr = 0;
1850   int_dynarr *ul_pos_dynarr = 0;
1851   int speccount;
1852
1853   CHECK_STRING (newtext);
1854
1855   if (! NILP (string))
1856     {
1857       CHECK_STRING (string);
1858       if (!EQ (last_thing_searched, Qt))
1859         error ("last thing matched was not a string");
1860       /* If the match data
1861          were abstracted into a special "match data" type instead
1862          of the typical half-assed "let the implementation be
1863          visible" form it's in, we could extend it to include
1864          the last string matched and the buffer used for that
1865          matching.  But of course we can't change it as it is. */
1866       buf = decode_buffer (strbuffer, 0);
1867       XSETBUFFER (buffer, buf);
1868     }
1869   else
1870     {
1871       if (!BUFFERP (last_thing_searched))
1872         error ("last thing matched was not a buffer");
1873       buffer = last_thing_searched;
1874       buf = XBUFFER (buffer);
1875     }
1876
1877   syntax_table = XCHAR_TABLE (buf->mirror_syntax_table);
1878
1879   case_action = nochange;       /* We tried an initialization */
1880                                 /* but some C compilers blew it */
1881
1882   if (search_regs.num_regs == 0)
1883     error ("replace-match called before any match found");
1884
1885   if (NILP (string))
1886     {
1887       if (search_regs.start[0] < BUF_BEGV (buf)
1888           || search_regs.start[0] > search_regs.end[0]
1889           || search_regs.end[0] > BUF_ZV (buf))
1890         args_out_of_range (make_int (search_regs.start[0]),
1891                            make_int (search_regs.end[0]));
1892     }
1893   else
1894     {
1895       if (search_regs.start[0] < 0
1896           || search_regs.start[0] > search_regs.end[0]
1897           || search_regs.end[0] > XSTRING_CHAR_LENGTH (string))
1898         args_out_of_range (make_int (search_regs.start[0]),
1899                            make_int (search_regs.end[0]));
1900     }
1901
1902   if (NILP (fixedcase))
1903     {
1904       /* Decide how to casify by examining the matched text. */
1905
1906       last = search_regs.end[0];
1907       prevc = '\n';
1908       case_action = all_caps;
1909
1910       /* some_multiletter_word is set nonzero if any original word
1911          is more than one letter long. */
1912       some_multiletter_word = 0;
1913       some_lowercase = 0;
1914       some_nonuppercase_initial = 0;
1915       some_uppercase = 0;
1916
1917       for (pos = search_regs.start[0]; pos < last; pos++)
1918         {
1919           if (NILP (string))
1920             c = BUF_FETCH_CHAR (buf, pos);
1921           else
1922             c = string_char (XSTRING (string), pos);
1923
1924           if (LOWERCASEP (buf, c))
1925             {
1926               /* Cannot be all caps if any original char is lower case */
1927
1928               some_lowercase = 1;
1929               if (!WORD_SYNTAX_P (syntax_table, prevc))
1930                 some_nonuppercase_initial = 1;
1931               else
1932                 some_multiletter_word = 1;
1933             }
1934           else if (!NOCASEP (buf, c))
1935             {
1936               some_uppercase = 1;
1937               if (!WORD_SYNTAX_P (syntax_table, prevc))
1938                 ;
1939               else
1940                 some_multiletter_word = 1;
1941             }
1942           else
1943             {
1944               /* If the initial is a caseless word constituent,
1945                  treat that like a lowercase initial.  */
1946               if (!WORD_SYNTAX_P (syntax_table, prevc))
1947                 some_nonuppercase_initial = 1;
1948             }
1949
1950           prevc = c;
1951         }
1952
1953       /* Convert to all caps if the old text is all caps
1954          and has at least one multiletter word.  */
1955       if (! some_lowercase && some_multiletter_word)
1956         case_action = all_caps;
1957       /* Capitalize each word, if the old text has all capitalized words.  */
1958       else if (!some_nonuppercase_initial && some_multiletter_word)
1959         case_action = cap_initial;
1960       else if (!some_nonuppercase_initial && some_uppercase)
1961         /* Should x -> yz, operating on X, give Yz or YZ?
1962            We'll assume the latter.  */
1963         case_action = all_caps;
1964       else
1965         case_action = nochange;
1966     }
1967
1968   /* Do replacement in a string.  */
1969   if (!NILP (string))
1970     {
1971       Lisp_Object before, after;
1972
1973       speccount = specpdl_depth ();
1974       before = Fsubstring (string, Qzero, make_int (search_regs.start[0]));
1975       after = Fsubstring (string, make_int (search_regs.end[0]), Qnil);
1976
1977       /* Do case substitution into NEWTEXT if desired.  */
1978       if (NILP (literal))
1979         {
1980           Charcount stlen = XSTRING_CHAR_LENGTH (newtext);
1981           Charcount strpos;
1982           /* XEmacs change: rewrote this loop somewhat to make it
1983              cleaner.  Also added \U, \E, etc. */
1984           Charcount literal_start = 0;
1985           /* We build up the substituted string in ACCUM.  */
1986           Lisp_Object accum;
1987
1988           accum = Qnil;
1989
1990           /* OK, the basic idea here is that we scan through the
1991              replacement string until we find a backslash, which
1992              represents a substring of the original string to be
1993              substituted.  We then append onto ACCUM the literal
1994              text before the backslash (LASTPOS marks the
1995              beginning of this) followed by the substring of the
1996              original string that needs to be inserted. */
1997           for (strpos = 0; strpos < stlen; strpos++)
1998             {
1999               /* If LITERAL_END is set, we've encountered a backslash
2000                  (the end of literal text to be inserted). */
2001               Charcount literal_end = -1;
2002               /* If SUBSTART is set, we need to also insert the
2003                  text from SUBSTART to SUBEND in the original string. */
2004               Charcount substart = -1;
2005               Charcount subend   = -1;
2006
2007               c = string_char (XSTRING (newtext), strpos);
2008               if (c == '\\' && strpos < stlen - 1)
2009                 {
2010                   c = string_char (XSTRING (newtext), ++strpos);
2011                   if (c == '&')
2012                     {
2013                       literal_end = strpos - 1;
2014                       substart = search_regs.start[0];
2015                       subend = search_regs.end[0];
2016                     }
2017                   else if (c >= '1' && c <= '9' &&
2018                            c <= search_regs.num_regs + '0')
2019                     {
2020                       if (search_regs.start[c - '0'] >= 0)
2021                         {
2022                           literal_end = strpos - 1;
2023                           substart = search_regs.start[c - '0'];
2024                           subend = search_regs.end[c - '0'];
2025                         }
2026                     }
2027                   else if (c == 'U' || c == 'u' || c == 'L' || c == 'l' ||
2028                            c == 'E')
2029                     {
2030                       /* Keep track of all case changes requested, but don't
2031                          make them now.  Do them later so we override
2032                          everything else. */
2033                       if (!ul_pos_dynarr)
2034                         {
2035                           ul_pos_dynarr = Dynarr_new (int);
2036                           ul_action_dynarr = Dynarr_new (int);
2037                           record_unwind_protect
2038                             (free_created_dynarrs,
2039                              noseeum_cons
2040                              (make_opaque_ptr (ul_pos_dynarr),
2041                               make_opaque_ptr (ul_action_dynarr)));
2042                         }
2043                       literal_end = strpos - 1;
2044                       Dynarr_add (ul_pos_dynarr,
2045                                   (!NILP (accum)
2046                                   ? XSTRING_CHAR_LENGTH (accum)
2047                                   : 0) + (literal_end - literal_start));
2048                       Dynarr_add (ul_action_dynarr, c);
2049                     }
2050                   else if (c == '\\')
2051                     /* So we get just one backslash. */
2052                     literal_end = strpos;
2053                 }
2054               if (literal_end >= 0)
2055                 {
2056                   Lisp_Object literal_text = Qnil;
2057                   Lisp_Object substring = Qnil;
2058                   if (literal_end != literal_start)
2059                     literal_text = Fsubstring (newtext,
2060                                                make_int (literal_start),
2061                                                make_int (literal_end));
2062                   if (substart >= 0 && subend != substart)
2063                     substring = Fsubstring (string,
2064                                             make_int (substart),
2065                                             make_int (subend));
2066                   if (!NILP (literal_text) || !NILP (substring))
2067                     accum = concat3 (accum, literal_text, substring);
2068                   literal_start = strpos + 1;
2069                 }
2070             }
2071
2072           if (strpos != literal_start)
2073             /* some literal text at end to be inserted */
2074             newtext = concat2 (accum, Fsubstring (newtext,
2075                                                   make_int (literal_start),
2076                                                   make_int (strpos)));
2077           else
2078             newtext = accum;
2079         }
2080
2081       if (case_action == all_caps)
2082         newtext = Fupcase (newtext, buffer);
2083       else if (case_action == cap_initial)
2084         newtext = Fupcase_initials (newtext, buffer);
2085
2086       /* Now finally, we need to process the \U's, \E's, etc. */
2087       if (ul_pos_dynarr)
2088         {
2089           int i = 0;
2090           int cur_action = 'E';
2091           Charcount stlen = XSTRING_CHAR_LENGTH (newtext);
2092           Charcount strpos;
2093
2094           for (strpos = 0; strpos < stlen; strpos++)
2095             {
2096               Emchar curchar = string_char (XSTRING (newtext), strpos);
2097               Emchar newchar = -1;
2098               if (i < Dynarr_length (ul_pos_dynarr) &&
2099                   strpos == Dynarr_at (ul_pos_dynarr, i))
2100                 {
2101                   int new_action = Dynarr_at (ul_action_dynarr, i);
2102                   i++;
2103                   if (new_action == 'u')
2104                     newchar = UPCASE (buf, curchar);
2105                   else if (new_action == 'l')
2106                     newchar = DOWNCASE (buf, curchar);
2107                   else
2108                     cur_action = new_action;
2109                 }
2110               if (newchar == -1)
2111                 {
2112                   if (cur_action == 'U')
2113                     newchar = UPCASE (buf, curchar);
2114                   else if (cur_action == 'L')
2115                     newchar = DOWNCASE (buf, curchar);
2116                   else
2117                     newchar = curchar;
2118                 }
2119               if (newchar != curchar)
2120                 set_string_char (XSTRING (newtext), strpos, newchar);
2121             }
2122         }
2123
2124       /* frees the Dynarrs if necessary. */
2125       unbind_to (speccount, Qnil);
2126       return concat3 (before, newtext, after);
2127     }
2128
2129   mc_count = begin_multiple_change (buf, search_regs.start[0],
2130                                     search_regs.end[0]);
2131
2132   /* begin_multiple_change() records an unwind-protect, so we need to
2133      record this value now. */
2134   speccount = specpdl_depth ();
2135
2136   /* We insert the replacement text before the old text, and then
2137      delete the original text.  This means that markers at the
2138      beginning or end of the original will float to the corresponding
2139      position in the replacement.  */
2140   BUF_SET_PT (buf, search_regs.start[0]);
2141   if (!NILP (literal))
2142     Finsert (1, &newtext);
2143   else
2144     {
2145       Charcount stlen = XSTRING_CHAR_LENGTH (newtext);
2146       Charcount strpos;
2147       struct gcpro gcpro1;
2148       GCPRO1 (newtext);
2149       for (strpos = 0; strpos < stlen; strpos++)
2150         {
2151           Charcount offset = BUF_PT (buf) - search_regs.start[0];
2152
2153           c = string_char (XSTRING (newtext), strpos);
2154           if (c == '\\' && strpos < stlen - 1)
2155             {
2156               c = string_char (XSTRING (newtext), ++strpos);
2157               if (c == '&')
2158                 Finsert_buffer_substring
2159                   (buffer,
2160                    make_int (search_regs.start[0] + offset),
2161                    make_int (search_regs.end[0] + offset));
2162               else if (c >= '1' && c <= '9' &&
2163                        c <= search_regs.num_regs + '0')
2164                 {
2165                   if (search_regs.start[c - '0'] >= 1)
2166                     Finsert_buffer_substring
2167                       (buffer,
2168                        make_int (search_regs.start[c - '0'] + offset),
2169                        make_int (search_regs.end[c - '0'] + offset));
2170                 }
2171               else if (c == 'U' || c == 'u' || c == 'L' || c == 'l' ||
2172                        c == 'E')
2173                 {
2174                   /* Keep track of all case changes requested, but don't
2175                      make them now.  Do them later so we override
2176                      everything else. */
2177                   if (!ul_pos_dynarr)
2178                     {
2179                       ul_pos_dynarr = Dynarr_new (int);
2180                       ul_action_dynarr = Dynarr_new (int);
2181                       record_unwind_protect
2182                         (free_created_dynarrs,
2183                          Fcons (make_opaque_ptr (ul_pos_dynarr),
2184                                 make_opaque_ptr (ul_action_dynarr)));
2185                     }
2186                   Dynarr_add (ul_pos_dynarr, BUF_PT (buf));
2187                   Dynarr_add (ul_action_dynarr, c);
2188                 }
2189               else
2190                 buffer_insert_emacs_char (buf, c);
2191             }
2192           else
2193             buffer_insert_emacs_char (buf, c);
2194         }
2195       UNGCPRO;
2196     }
2197
2198   inslen = BUF_PT (buf) - (search_regs.start[0]);
2199   buffer_delete_range (buf, search_regs.start[0] + inslen, search_regs.end[0] +
2200                        inslen, 0);
2201
2202   if (case_action == all_caps)
2203     Fupcase_region (make_int (BUF_PT (buf) - inslen),
2204                     make_int (BUF_PT (buf)),  buffer);
2205   else if (case_action == cap_initial)
2206     Fupcase_initials_region (make_int (BUF_PT (buf) - inslen),
2207                              make_int (BUF_PT (buf)), buffer);
2208
2209   /* Now go through and make all the case changes that were requested
2210      in the replacement string. */
2211   if (ul_pos_dynarr)
2212     {
2213       Bufpos eend = BUF_PT (buf);
2214       int i = 0;
2215       int cur_action = 'E';
2216
2217       for (pos = BUF_PT (buf) - inslen; pos < eend; pos++)
2218         {
2219           Emchar curchar = BUF_FETCH_CHAR (buf, pos);
2220           Emchar newchar = -1;
2221           if (i < Dynarr_length (ul_pos_dynarr) &&
2222               pos == Dynarr_at (ul_pos_dynarr, i))
2223             {
2224               int new_action = Dynarr_at (ul_action_dynarr, i);
2225               i++;
2226               if (new_action == 'u')
2227                 newchar = UPCASE (buf, curchar);
2228               else if (new_action == 'l')
2229                 newchar = DOWNCASE (buf, curchar);
2230               else
2231                 cur_action = new_action;
2232             }
2233           if (newchar == -1)
2234             {
2235               if (cur_action == 'U')
2236                 newchar = UPCASE (buf, curchar);
2237               else if (cur_action == 'L')
2238                 newchar = DOWNCASE (buf, curchar);
2239               else
2240                 newchar = curchar;
2241             }
2242           if (newchar != curchar)
2243             buffer_replace_char (buf, pos, newchar, 0, 0);
2244         }
2245     }
2246
2247   /* frees the Dynarrs if necessary. */
2248   unbind_to (speccount, Qnil);
2249   end_multiple_change (buf, mc_count);
2250
2251   return Qnil;
2252 }
2253 \f
2254 static Lisp_Object
2255 match_limit (Lisp_Object num, int beginningp)
2256 {
2257   /* This function has been Mule-ized. */
2258   int n;
2259
2260   CHECK_INT (num);
2261   n = XINT (num);
2262   if (n < 0 || n >= search_regs.num_regs)
2263     args_out_of_range (num, make_int (search_regs.num_regs));
2264   if (search_regs.num_regs == 0 ||
2265       search_regs.start[n] < 0)
2266     return Qnil;
2267   return make_int (beginningp ? search_regs.start[n] : search_regs.end[n]);
2268 }
2269
2270 DEFUN ("match-beginning", Fmatch_beginning, 1, 1, 0, /*
2271 Return position of start of text matched by last regexp search.
2272 NUM, specifies which parenthesized expression in the last regexp.
2273  Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
2274 Zero means the entire text matched by the whole regexp or whole string.
2275 */
2276        (num))
2277 {
2278   return match_limit (num, 1);
2279 }
2280
2281 DEFUN ("match-end", Fmatch_end, 1, 1, 0, /*
2282 Return position of end of text matched by last regexp search.
2283 NUM specifies which parenthesized expression in the last regexp.
2284  Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
2285 Zero means the entire text matched by the whole regexp or whole string.
2286 */
2287        (num))
2288 {
2289   return match_limit (num, 0);
2290 }
2291
2292 DEFUN ("match-data", Fmatch_data, 0, 2, 0, /*
2293 Return a list containing all info on what the last regexp search matched.
2294 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.
2295 All the elements are markers or nil (nil if the Nth pair didn't match)
2296 if the last match was on a buffer; integers or nil if a string was matched.
2297 Use `store-match-data' to reinstate the data in this list.
2298
2299 If INTEGERS (the optional first argument) is non-nil, always use integers
2300 \(rather than markers) to represent buffer positions.
2301 If REUSE is a list, reuse it as part of the value.  If REUSE is long enough
2302 to hold all the values, and if INTEGERS is non-nil, no consing is done.
2303 */
2304        (integers, reuse))
2305 {
2306   /* This function has been Mule-ized. */
2307   Lisp_Object tail, prev;
2308   Lisp_Object *data;
2309   int i;
2310   Charcount len;
2311
2312   if (NILP (last_thing_searched))
2313     /*error ("match-data called before any match found");*/
2314     return Qnil;
2315
2316   data = alloca_array (Lisp_Object, 2 * search_regs.num_regs);
2317
2318   len = -1;
2319   for (i = 0; i < search_regs.num_regs; i++)
2320     {
2321       Bufpos start = search_regs.start[i];
2322       if (start >= 0)
2323         {
2324           if (EQ (last_thing_searched, Qt)
2325               || !NILP (integers))
2326             {
2327               data[2 * i] = make_int (start);
2328               data[2 * i + 1] = make_int (search_regs.end[i]);
2329             }
2330           else if (BUFFERP (last_thing_searched))
2331             {
2332               data[2 * i] = Fmake_marker ();
2333               Fset_marker (data[2 * i],
2334                            make_int (start),
2335                            last_thing_searched);
2336               data[2 * i + 1] = Fmake_marker ();
2337               Fset_marker (data[2 * i + 1],
2338                            make_int (search_regs.end[i]),
2339                            last_thing_searched);
2340             }
2341           else
2342             /* last_thing_searched must always be Qt, a buffer, or Qnil.  */
2343             abort ();
2344
2345           len = i;
2346         }
2347       else
2348         data[2 * i] = data [2 * i + 1] = Qnil;
2349     }
2350   if (!CONSP (reuse))
2351     return Flist (2 * len + 2, data);
2352
2353   /* If REUSE is a list, store as many value elements as will fit
2354      into the elements of REUSE.  */
2355   for (prev = Qnil, i = 0, tail = reuse; CONSP (tail); i++, tail = XCDR (tail))
2356     {
2357       if (i < 2 * len + 2)
2358         XCAR (tail) = data[i];
2359       else
2360         XCAR (tail) = Qnil;
2361       prev = tail;
2362     }
2363
2364   /* If we couldn't fit all value elements into REUSE,
2365      cons up the rest of them and add them to the end of REUSE.  */
2366   if (i < 2 * len + 2)
2367     XCDR (prev) = Flist (2 * len + 2 - i, data + i);
2368
2369   return reuse;
2370 }
2371
2372
2373 DEFUN ("store-match-data", Fstore_match_data, 1, 1, 0, /*
2374 Set internal data on last search match from elements of LIST.
2375 LIST should have been created by calling `match-data' previously.
2376 */
2377        (list))
2378 {
2379   /* This function has been Mule-ized. */
2380   REGISTER int i;
2381   REGISTER Lisp_Object marker;
2382   int num_regs;
2383   int length;
2384
2385   if (running_asynch_code)
2386     save_search_regs ();
2387
2388   CONCHECK_LIST (list);
2389
2390   /* Unless we find a marker with a buffer in LIST, assume that this
2391      match data came from a string.  */
2392   last_thing_searched = Qt;
2393
2394   /* Allocate registers if they don't already exist.  */
2395   length = XINT (Flength (list)) / 2;
2396   num_regs = search_regs.num_regs;
2397
2398   if (length > num_regs)
2399     {
2400       if (search_regs.num_regs == 0)
2401         {
2402           search_regs.start = xnew_array (regoff_t, length);
2403           search_regs.end   = xnew_array (regoff_t, length);
2404         }
2405       else
2406         {
2407           XREALLOC_ARRAY (search_regs.start, regoff_t, length);
2408           XREALLOC_ARRAY (search_regs.end,   regoff_t, length);
2409         }
2410
2411       search_regs.num_regs = length;
2412     }
2413
2414   for (i = 0; i < num_regs; i++)
2415     {
2416       marker = Fcar (list);
2417       if (NILP (marker))
2418         {
2419           search_regs.start[i] = -1;
2420           list = Fcdr (list);
2421         }
2422       else
2423         {
2424           if (MARKERP (marker))
2425             {
2426               if (XMARKER (marker)->buffer == 0)
2427                 marker = Qzero;
2428               else
2429                 XSETBUFFER (last_thing_searched, XMARKER (marker)->buffer);
2430             }
2431
2432           CHECK_INT_COERCE_MARKER (marker);
2433           search_regs.start[i] = XINT (marker);
2434           list = Fcdr (list);
2435
2436           marker = Fcar (list);
2437           if (MARKERP (marker) && XMARKER (marker)->buffer == 0)
2438             marker = Qzero;
2439
2440           CHECK_INT_COERCE_MARKER (marker);
2441           search_regs.end[i] = XINT (marker);
2442         }
2443       list = Fcdr (list);
2444     }
2445
2446   return Qnil;
2447 }
2448
2449 /* If non-zero the match data have been saved in saved_search_regs
2450    during the execution of a sentinel or filter. */
2451 static int search_regs_saved;
2452 static struct re_registers saved_search_regs;
2453
2454 /* Called from Flooking_at, Fstring_match, search_buffer, Fstore_match_data
2455    if asynchronous code (filter or sentinel) is running. */
2456 static void
2457 save_search_regs (void)
2458 {
2459   if (!search_regs_saved)
2460     {
2461       saved_search_regs.num_regs = search_regs.num_regs;
2462       saved_search_regs.start = search_regs.start;
2463       saved_search_regs.end = search_regs.end;
2464       search_regs.num_regs = 0;
2465       search_regs.start = 0;
2466       search_regs.end = 0;
2467
2468       search_regs_saved = 1;
2469     }
2470 }
2471
2472 /* Called upon exit from filters and sentinels. */
2473 void
2474 restore_match_data (void)
2475 {
2476   if (search_regs_saved)
2477     {
2478       if (search_regs.num_regs > 0)
2479         {
2480           xfree (search_regs.start);
2481           xfree (search_regs.end);
2482         }
2483       search_regs.num_regs = saved_search_regs.num_regs;
2484       search_regs.start = saved_search_regs.start;
2485       search_regs.end = saved_search_regs.end;
2486
2487       search_regs_saved = 0;
2488     }
2489 }
2490
2491 /* Quote a string to inactivate reg-expr chars */
2492
2493 DEFUN ("regexp-quote", Fregexp_quote, 1, 1, 0, /*
2494 Return a regexp string which matches exactly STRING and nothing else.
2495 */
2496        (str))
2497 {
2498   REGISTER Bufbyte *in, *out, *end;
2499   REGISTER Bufbyte *temp;
2500
2501   CHECK_STRING (str);
2502
2503   temp = (Bufbyte *) alloca (XSTRING_LENGTH (str) * 2);
2504
2505   /* Now copy the data into the new string, inserting escapes. */
2506
2507   in = XSTRING_DATA (str);
2508   end = in + XSTRING_LENGTH (str);
2509   out = temp;
2510
2511   while (in < end)
2512     {
2513       Emchar c = charptr_emchar (in);
2514
2515       if (c == '[' || c == ']'
2516           || c == '*' || c == '.' || c == '\\'
2517           || c == '?' || c == '+'
2518           || c == '^' || c == '$')
2519         *out++ = '\\';
2520       out += set_charptr_emchar (out, c);
2521       INC_CHARPTR (in);
2522     }
2523
2524   return make_string (temp, out - temp);
2525 }
2526
2527 DEFUN ("set-word-regexp", Fset_word_regexp, 1, 1, 0, /*
2528 Set the regexp to be used to match a word in regular-expression searching.
2529 #### Not yet implemented.  Currently does nothing.
2530 #### Do not use this yet.  Its calling interface is likely to change.
2531 */
2532        (regexp))
2533 {
2534   return Qnil;
2535 }
2536
2537 \f
2538 /************************************************************************/
2539 /*                            initialization                            */
2540 /************************************************************************/
2541
2542 void
2543 syms_of_search (void)
2544 {
2545
2546   deferror (&Qsearch_failed, "search-failed", "Search failed", Qerror);
2547   deferror (&Qinvalid_regexp, "invalid-regexp", "Invalid regexp", Qerror);
2548
2549   DEFSUBR (Flooking_at);
2550   DEFSUBR (Fposix_looking_at);
2551   DEFSUBR (Fstring_match);
2552   DEFSUBR (Fposix_string_match);
2553   DEFSUBR (Fskip_chars_forward);
2554   DEFSUBR (Fskip_chars_backward);
2555   DEFSUBR (Fskip_syntax_forward);
2556   DEFSUBR (Fskip_syntax_backward);
2557   DEFSUBR (Fsearch_forward);
2558   DEFSUBR (Fsearch_backward);
2559   DEFSUBR (Fword_search_forward);
2560   DEFSUBR (Fword_search_backward);
2561   DEFSUBR (Fre_search_forward);
2562   DEFSUBR (Fre_search_backward);
2563   DEFSUBR (Fposix_search_forward);
2564   DEFSUBR (Fposix_search_backward);
2565   DEFSUBR (Freplace_match);
2566   DEFSUBR (Fmatch_beginning);
2567   DEFSUBR (Fmatch_end);
2568   DEFSUBR (Fmatch_data);
2569   DEFSUBR (Fstore_match_data);
2570   DEFSUBR (Fregexp_quote);
2571   DEFSUBR (Fset_word_regexp);
2572 }
2573
2574 void
2575 reinit_vars_of_search (void)
2576 {
2577   int i;
2578
2579   last_thing_searched = Qnil;
2580   staticpro_nodump (&last_thing_searched);
2581
2582   for (i = 0; i < REGEXP_CACHE_SIZE; ++i)
2583     {
2584       searchbufs[i].buf.allocated = 100;
2585       searchbufs[i].buf.buffer = (unsigned char *) xmalloc (100);
2586       searchbufs[i].buf.fastmap = searchbufs[i].fastmap;
2587       searchbufs[i].regexp = Qnil;
2588       staticpro_nodump (&searchbufs[i].regexp);
2589       searchbufs[i].next = (i == REGEXP_CACHE_SIZE-1 ? 0 : &searchbufs[i+1]);
2590     }
2591   searchbuf_head = &searchbufs[0];
2592 }
2593
2594 void
2595 vars_of_search (void)
2596 {
2597   reinit_vars_of_search ();
2598
2599   DEFVAR_LISP ("forward-word-regexp", &Vforward_word_regexp /*
2600 *Regular expression to be used in `forward-word'.
2601 #### Not yet implemented.
2602 */ );
2603   Vforward_word_regexp = Qnil;
2604
2605   DEFVAR_LISP ("backward-word-regexp", &Vbackward_word_regexp /*
2606 *Regular expression to be used in `backward-word'.
2607 #### Not yet implemented.
2608 */ );
2609   Vbackward_word_regexp = Qnil;
2610 }
2611
2612 void
2613 complex_vars_of_search (void)
2614 {
2615   Vskip_chars_range_table = Fmake_range_table ();
2616   staticpro (&Vskip_chars_range_table);
2617 }