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