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