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