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