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