Mercurial > emacs
annotate src/search.c @ 4413:5a00cec8e9b0
(fill-region-as-paragraph): When we take one word
after the fill column, don't stop at period with just one space.
When checking whether at beginning of line, if no fill prefix,
ignore intervening whitespace.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 02 Aug 1993 05:55:56 +0000 |
parents | 7a2e1d7362c5 |
children | ad4add779dac |
rev | line source |
---|---|
603 | 1 /* String search routines for GNU Emacs. |
2961 | 2 Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc. |
603 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
8 the Free Software Foundation; either version 1, or (at your option) | |
9 any later version. | |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
19 | |
20 | |
21 #include "config.h" | |
22 #include "lisp.h" | |
23 #include "syntax.h" | |
24 #include "buffer.h" | |
25 #include "commands.h" | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
26 #include "blockinput.h" |
621 | 27 |
603 | 28 #include <sys/types.h> |
29 #include "regex.h" | |
30 | |
31 #define max(a, b) ((a) > (b) ? (a) : (b)) | |
32 #define min(a, b) ((a) < (b) ? (a) : (b)) | |
33 | |
34 /* We compile regexps into this buffer and then use it for searching. */ | |
35 | |
36 struct re_pattern_buffer searchbuf; | |
37 | |
38 char search_fastmap[0400]; | |
39 | |
40 /* Last regexp we compiled */ | |
41 | |
42 Lisp_Object last_regexp; | |
43 | |
621 | 44 /* Every call to re_match, etc., must pass &search_regs as the regs |
45 argument unless you can show it is unnecessary (i.e., if re_match | |
46 is certainly going to be called again before region-around-match | |
47 can be called). | |
48 | |
49 Since the registers are now dynamically allocated, we need to make | |
50 sure not to refer to the Nth register before checking that it has | |
708 | 51 been allocated by checking search_regs.num_regs. |
603 | 52 |
708 | 53 The regex code keeps track of whether it has allocated the search |
54 buffer using bits in searchbuf. This means that whenever you | |
55 compile a new pattern, it completely forgets whether it has | |
56 allocated any registers, and will allocate new registers the next | |
57 time you call a searching or matching function. Therefore, we need | |
58 to call re_set_registers after compiling a new pattern or after | |
59 setting the match registers, so that the regex functions will be | |
60 able to free or re-allocate it properly. */ | |
603 | 61 static struct re_registers search_regs; |
62 | |
727 | 63 /* The buffer in which the last search was performed, or |
64 Qt if the last search was done in a string; | |
65 Qnil if no searching has been done yet. */ | |
66 static Lisp_Object last_thing_searched; | |
603 | 67 |
68 /* error condition signalled when regexp compile_pattern fails */ | |
69 | |
70 Lisp_Object Qinvalid_regexp; | |
71 | |
72 static void | |
73 matcher_overflow () | |
74 { | |
75 error ("Stack overflow in regexp matcher"); | |
76 } | |
77 | |
78 #ifdef __STDC__ | |
79 #define CONST const | |
80 #else | |
81 #define CONST | |
82 #endif | |
83 | |
84 /* Compile a regexp and signal a Lisp error if anything goes wrong. */ | |
85 | |
708 | 86 compile_pattern (pattern, bufp, regp, translate) |
603 | 87 Lisp_Object pattern; |
88 struct re_pattern_buffer *bufp; | |
708 | 89 struct re_registers *regp; |
603 | 90 char *translate; |
91 { | |
92 CONST char *val; | |
93 Lisp_Object dummy; | |
94 | |
95 if (EQ (pattern, last_regexp) | |
96 && translate == bufp->translate) | |
97 return; | |
708 | 98 |
603 | 99 last_regexp = Qnil; |
100 bufp->translate = translate; | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
101 BLOCK_INPUT; |
603 | 102 val = re_compile_pattern ((char *) XSTRING (pattern)->data, |
103 XSTRING (pattern)->size, | |
104 bufp); | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
105 UNBLOCK_INPUT; |
603 | 106 if (val) |
107 { | |
108 dummy = build_string (val); | |
109 while (1) | |
110 Fsignal (Qinvalid_regexp, Fcons (dummy, Qnil)); | |
111 } | |
708 | 112 |
603 | 113 last_regexp = pattern; |
708 | 114 |
115 /* Advise the searching functions about the space we have allocated | |
116 for register data. */ | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
117 BLOCK_INPUT; |
808 | 118 if (regp) |
119 re_set_registers (bufp, regp, regp->num_regs, regp->start, regp->end); | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
120 UNBLOCK_INPUT; |
708 | 121 |
603 | 122 return; |
123 } | |
124 | |
125 /* Error condition used for failing searches */ | |
126 Lisp_Object Qsearch_failed; | |
127 | |
128 Lisp_Object | |
129 signal_failure (arg) | |
130 Lisp_Object arg; | |
131 { | |
132 Fsignal (Qsearch_failed, Fcons (arg, Qnil)); | |
133 return Qnil; | |
134 } | |
135 | |
136 DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0, | |
638 | 137 "Return t if text after point matches regular expression PAT.\n\ |
138 This function modifies the match data that `match-beginning',\n\ | |
139 `match-end' and `match-data' access; save and restore the match\n\ | |
635
197f38dd0105
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
621
diff
changeset
|
140 data if you want to preserve them.") |
603 | 141 (string) |
142 Lisp_Object string; | |
143 { | |
144 Lisp_Object val; | |
145 unsigned char *p1, *p2; | |
146 int s1, s2; | |
147 register int i; | |
148 | |
149 CHECK_STRING (string, 0); | |
708 | 150 compile_pattern (string, &searchbuf, &search_regs, |
603 | 151 !NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0); |
152 | |
153 immediate_quit = 1; | |
154 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ | |
155 | |
156 /* Get pointers and sizes of the two strings | |
157 that make up the visible portion of the buffer. */ | |
158 | |
159 p1 = BEGV_ADDR; | |
160 s1 = GPT - BEGV; | |
161 p2 = GAP_END_ADDR; | |
162 s2 = ZV - GPT; | |
163 if (s1 < 0) | |
164 { | |
165 p2 = p1; | |
166 s2 = ZV - BEGV; | |
167 s1 = 0; | |
168 } | |
169 if (s2 < 0) | |
170 { | |
171 s1 = ZV - BEGV; | |
172 s2 = 0; | |
173 } | |
174 | |
175 i = re_match_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2, | |
176 point - BEGV, &search_regs, | |
177 ZV - BEGV); | |
178 if (i == -2) | |
179 matcher_overflow (); | |
180 | |
181 val = (0 <= i ? Qt : Qnil); | |
621 | 182 for (i = 0; i < search_regs.num_regs; i++) |
603 | 183 if (search_regs.start[i] >= 0) |
184 { | |
185 search_regs.start[i] += BEGV; | |
186 search_regs.end[i] += BEGV; | |
187 } | |
727 | 188 XSET (last_thing_searched, Lisp_Buffer, current_buffer); |
603 | 189 immediate_quit = 0; |
190 return val; | |
191 } | |
192 | |
193 DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0, | |
194 "Return index of start of first match for REGEXP in STRING, or nil.\n\ | |
195 If third arg START is non-nil, start search at that index in STRING.\n\ | |
196 For index of first char beyond the match, do (match-end 0).\n\ | |
197 `match-end' and `match-beginning' also give indices of substrings\n\ | |
198 matched by parenthesis constructs in the pattern.") | |
199 (regexp, string, start) | |
200 Lisp_Object regexp, string, start; | |
201 { | |
202 int val; | |
203 int s; | |
204 | |
205 CHECK_STRING (regexp, 0); | |
206 CHECK_STRING (string, 1); | |
207 | |
208 if (NILP (start)) | |
209 s = 0; | |
210 else | |
211 { | |
212 int len = XSTRING (string)->size; | |
213 | |
214 CHECK_NUMBER (start, 2); | |
215 s = XINT (start); | |
216 if (s < 0 && -s <= len) | |
217 s = len - s; | |
218 else if (0 > s || s > len) | |
219 args_out_of_range (string, start); | |
220 } | |
221 | |
708 | 222 compile_pattern (regexp, &searchbuf, &search_regs, |
603 | 223 !NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0); |
224 immediate_quit = 1; | |
225 val = re_search (&searchbuf, (char *) XSTRING (string)->data, | |
226 XSTRING (string)->size, s, XSTRING (string)->size - s, | |
227 &search_regs); | |
228 immediate_quit = 0; | |
727 | 229 last_thing_searched = Qt; |
603 | 230 if (val == -2) |
231 matcher_overflow (); | |
232 if (val < 0) return Qnil; | |
233 return make_number (val); | |
234 } | |
842 | 235 |
236 /* Match REGEXP against STRING, searching all of STRING, | |
237 and return the index of the match, or negative on failure. | |
238 This does not clobber the match data. */ | |
239 | |
240 int | |
241 fast_string_match (regexp, string) | |
242 Lisp_Object regexp, string; | |
243 { | |
244 int val; | |
245 | |
246 compile_pattern (regexp, &searchbuf, 0, 0); | |
247 immediate_quit = 1; | |
248 val = re_search (&searchbuf, (char *) XSTRING (string)->data, | |
249 XSTRING (string)->size, 0, XSTRING (string)->size, | |
250 0); | |
251 immediate_quit = 0; | |
252 return val; | |
253 } | |
603 | 254 |
648 | 255 /* Search for COUNT instances of the character TARGET, starting at START. |
256 If COUNT is negative, search backwards. | |
257 | |
258 If we find COUNT instances, set *SHORTAGE to zero, and return the | |
1413 | 259 position after the COUNTth match. Note that for reverse motion |
260 this is not the same as the usual convention for Emacs motion commands. | |
648 | 261 |
262 If we don't find COUNT instances before reaching the end of the | |
263 buffer (or the beginning, if scanning backwards), set *SHORTAGE to | |
264 the number of TARGETs left unfound, and return the end of the | |
265 buffer we bumped up against. */ | |
266 | |
267 scan_buffer (target, start, count, shortage) | |
268 int *shortage, start; | |
269 register int count, target; | |
603 | 270 { |
648 | 271 int limit = ((count > 0) ? ZV - 1 : BEGV); |
272 int direction = ((count > 0) ? 1 : -1); | |
273 | |
274 register unsigned char *cursor; | |
603 | 275 unsigned char *base; |
648 | 276 |
277 register int ceiling; | |
278 register unsigned char *ceiling_addr; | |
603 | 279 |
280 if (shortage != 0) | |
281 *shortage = 0; | |
282 | |
283 immediate_quit = 1; | |
284 | |
648 | 285 if (count > 0) |
286 while (start != limit + 1) | |
603 | 287 { |
648 | 288 ceiling = BUFFER_CEILING_OF (start); |
289 ceiling = min (limit, ceiling); | |
290 ceiling_addr = &FETCH_CHAR (ceiling) + 1; | |
291 base = (cursor = &FETCH_CHAR (start)); | |
603 | 292 while (1) |
293 { | |
648 | 294 while (*cursor != target && ++cursor != ceiling_addr) |
603 | 295 ; |
648 | 296 if (cursor != ceiling_addr) |
603 | 297 { |
648 | 298 if (--count == 0) |
603 | 299 { |
300 immediate_quit = 0; | |
648 | 301 return (start + cursor - base + 1); |
603 | 302 } |
303 else | |
648 | 304 if (++cursor == ceiling_addr) |
603 | 305 break; |
306 } | |
307 else | |
308 break; | |
309 } | |
648 | 310 start += cursor - base; |
603 | 311 } |
312 else | |
313 { | |
648 | 314 start--; /* first character we scan */ |
315 while (start > limit - 1) | |
316 { /* we WILL scan under start */ | |
317 ceiling = BUFFER_FLOOR_OF (start); | |
318 ceiling = max (limit, ceiling); | |
319 ceiling_addr = &FETCH_CHAR (ceiling) - 1; | |
320 base = (cursor = &FETCH_CHAR (start)); | |
603 | 321 cursor++; |
322 while (1) | |
323 { | |
648 | 324 while (--cursor != ceiling_addr && *cursor != target) |
603 | 325 ; |
648 | 326 if (cursor != ceiling_addr) |
603 | 327 { |
648 | 328 if (++count == 0) |
603 | 329 { |
330 immediate_quit = 0; | |
648 | 331 return (start + cursor - base + 1); |
603 | 332 } |
333 } | |
334 else | |
335 break; | |
336 } | |
648 | 337 start += cursor - base; |
603 | 338 } |
339 } | |
340 immediate_quit = 0; | |
341 if (shortage != 0) | |
648 | 342 *shortage = count * direction; |
343 return (start + ((direction == 1 ? 0 : 1))); | |
603 | 344 } |
345 | |
346 int | |
347 find_next_newline (from, cnt) | |
348 register int from, cnt; | |
349 { | |
350 return (scan_buffer ('\n', from, cnt, (int *) 0)); | |
351 } | |
352 | |
1684
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
353 Lisp_Object skip_chars (); |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
354 |
603 | 355 DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0, |
356 "Move point forward, stopping before a char not in CHARS, or at position LIM.\n\ | |
357 CHARS is like the inside of a `[...]' in a regular expression\n\ | |
358 except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\ | |
359 Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\ | |
1684
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
360 With arg \"^a-zA-Z\", skips nonletters stopping before first letter.\n\ |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
361 Returns the distance traveled, either zero or positive.") |
603 | 362 (string, lim) |
363 Lisp_Object string, lim; | |
364 { | |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
365 return skip_chars (1, 0, string, lim); |
603 | 366 } |
367 | |
368 DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0, | |
369 "Move point backward, stopping after a char not in CHARS, or at position LIM.\n\ | |
1684
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
370 See `skip-chars-forward' for details.\n\ |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
371 Returns the distance traveled, either zero or negative.") |
603 | 372 (string, lim) |
373 Lisp_Object string, lim; | |
374 { | |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
375 return skip_chars (0, 0, string, lim); |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
376 } |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
377 |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
378 DEFUN ("skip-syntax-forward", Fskip_syntax_forward, Sskip_syntax_forward, 1, 2, 0, |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
379 "Move point forward across chars in specified syntax classes.\n\ |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
380 SYNTAX is a string of syntax code characters.\n\ |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
381 Stop before a char whose syntax is not in SYNTAX, or at position LIM.\n\ |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
382 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\ |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
383 This function returns the distance traveled, either zero or positive.") |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
384 (syntax, lim) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
385 Lisp_Object syntax, lim; |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
386 { |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
387 return skip_chars (1, 1, syntax, lim); |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
388 } |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
389 |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
390 DEFUN ("skip-syntax-backward", Fskip_syntax_backward, Sskip_syntax_backward, 1, 2, 0, |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
391 "Move point backward across chars in specified syntax classes.\n\ |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
392 SYNTAX is a string of syntax code characters.\n\ |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
393 Stop on reaching a char whose syntax is not in SYNTAX, or at position LIM.\n\ |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
394 If SYNTAX starts with ^, skip characters whose syntax is NOT in SYNTAX.\n\ |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
395 This function returns the distance traveled, either zero or negative.") |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
396 (syntax, lim) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
397 Lisp_Object syntax, lim; |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
398 { |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
399 return skip_chars (0, 1, syntax, lim); |
603 | 400 } |
401 | |
1684
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
402 Lisp_Object |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
403 skip_chars (forwardp, syntaxp, string, lim) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
404 int forwardp, syntaxp; |
603 | 405 Lisp_Object string, lim; |
406 { | |
407 register unsigned char *p, *pend; | |
408 register unsigned char c; | |
409 unsigned char fastmap[0400]; | |
410 int negate = 0; | |
411 register int i; | |
412 | |
413 CHECK_STRING (string, 0); | |
414 | |
415 if (NILP (lim)) | |
416 XSET (lim, Lisp_Int, forwardp ? ZV : BEGV); | |
417 else | |
418 CHECK_NUMBER_COERCE_MARKER (lim, 1); | |
419 | |
420 #if 0 /* This breaks some things... jla. */ | |
421 /* In any case, don't allow scan outside bounds of buffer. */ | |
422 if (XFASTINT (lim) > ZV) | |
423 XFASTINT (lim) = ZV; | |
424 if (XFASTINT (lim) < BEGV) | |
425 XFASTINT (lim) = BEGV; | |
426 #endif | |
427 | |
428 p = XSTRING (string)->data; | |
429 pend = p + XSTRING (string)->size; | |
430 bzero (fastmap, sizeof fastmap); | |
431 | |
432 if (p != pend && *p == '^') | |
433 { | |
434 negate = 1; p++; | |
435 } | |
436 | |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
437 /* Find the characters specified and set their elements of fastmap. |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
438 If syntaxp, each character counts as itself. |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
439 Otherwise, handle backslashes and ranges specially */ |
603 | 440 |
441 while (p != pend) | |
442 { | |
443 c = *p++; | |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
444 if (syntaxp) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
445 fastmap[c] = 1; |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
446 else |
603 | 447 { |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
448 if (c == '\\') |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
449 { |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
450 if (p == pend) break; |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
451 c = *p++; |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
452 } |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
453 if (p != pend && *p == '-') |
603 | 454 { |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
455 p++; |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
456 if (p == pend) break; |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
457 while (c <= *p) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
458 { |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
459 fastmap[c] = 1; |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
460 c++; |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
461 } |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
462 p++; |
603 | 463 } |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
464 else |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
465 fastmap[c] = 1; |
603 | 466 } |
467 } | |
468 | |
469 /* If ^ was the first character, complement the fastmap. */ | |
470 | |
471 if (negate) | |
472 for (i = 0; i < sizeof fastmap; i++) | |
473 fastmap[i] ^= 1; | |
474 | |
1684
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
475 { |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
476 int start_point = point; |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
477 |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
478 immediate_quit = 1; |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
479 if (syntaxp) |
1684
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
480 { |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
481 |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
482 if (forwardp) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
483 { |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
484 while (point < XINT (lim) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
485 && fastmap[(unsigned char) syntax_code_spec[(int) SYNTAX (FETCH_CHAR (point))]]) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
486 SET_PT (point + 1); |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
487 } |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
488 else |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
489 { |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
490 while (point > XINT (lim) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
491 && fastmap[(unsigned char) syntax_code_spec[(int) SYNTAX (FETCH_CHAR (point - 1))]]) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
492 SET_PT (point - 1); |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
493 } |
1684
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
494 } |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
495 else |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
496 { |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
497 if (forwardp) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
498 { |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
499 while (point < XINT (lim) && fastmap[FETCH_CHAR (point)]) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
500 SET_PT (point + 1); |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
501 } |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
502 else |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
503 { |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
504 while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)]) |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
505 SET_PT (point - 1); |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
506 } |
1684
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
507 } |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
508 immediate_quit = 0; |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
509 |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
510 return make_number (point - start_point); |
f4d848dea8ff
* search.c (Fskip_chars_forward, Fskip_chars_backward): Return the
Jim Blandy <jimb@redhat.com>
parents:
1523
diff
changeset
|
511 } |
603 | 512 } |
513 | |
514 /* Subroutines of Lisp buffer search functions. */ | |
515 | |
516 static Lisp_Object | |
517 search_command (string, bound, noerror, count, direction, RE) | |
518 Lisp_Object string, bound, noerror, count; | |
519 int direction; | |
520 int RE; | |
521 { | |
522 register int np; | |
523 int lim; | |
524 int n = direction; | |
525 | |
526 if (!NILP (count)) | |
527 { | |
528 CHECK_NUMBER (count, 3); | |
529 n *= XINT (count); | |
530 } | |
531 | |
532 CHECK_STRING (string, 0); | |
533 if (NILP (bound)) | |
534 lim = n > 0 ? ZV : BEGV; | |
535 else | |
536 { | |
537 CHECK_NUMBER_COERCE_MARKER (bound, 1); | |
538 lim = XINT (bound); | |
539 if (n > 0 ? lim < point : lim > point) | |
540 error ("Invalid search bound (wrong side of point)"); | |
541 if (lim > ZV) | |
542 lim = ZV; | |
543 if (lim < BEGV) | |
544 lim = BEGV; | |
545 } | |
546 | |
547 np = search_buffer (string, point, lim, n, RE, | |
548 (!NILP (current_buffer->case_fold_search) | |
549 ? XSTRING (current_buffer->case_canon_table)->data : 0), | |
550 (!NILP (current_buffer->case_fold_search) | |
551 ? XSTRING (current_buffer->case_eqv_table)->data : 0)); | |
552 if (np <= 0) | |
553 { | |
554 if (NILP (noerror)) | |
555 return signal_failure (string); | |
556 if (!EQ (noerror, Qt)) | |
557 { | |
558 if (lim < BEGV || lim > ZV) | |
559 abort (); | |
1878
1c26d0049d4f
(search_command): #if 0 previous change.
Richard M. Stallman <rms@gnu.org>
parents:
1877
diff
changeset
|
560 SET_PT (lim); |
1c26d0049d4f
(search_command): #if 0 previous change.
Richard M. Stallman <rms@gnu.org>
parents:
1877
diff
changeset
|
561 return Qnil; |
1c26d0049d4f
(search_command): #if 0 previous change.
Richard M. Stallman <rms@gnu.org>
parents:
1877
diff
changeset
|
562 #if 0 /* This would be clean, but maybe programs depend on |
1c26d0049d4f
(search_command): #if 0 previous change.
Richard M. Stallman <rms@gnu.org>
parents:
1877
diff
changeset
|
563 a value of nil here. */ |
1877
7786f61ec635
(search_command): When moving to LIM on failure, return LIM.
Richard M. Stallman <rms@gnu.org>
parents:
1684
diff
changeset
|
564 np = lim; |
1878
1c26d0049d4f
(search_command): #if 0 previous change.
Richard M. Stallman <rms@gnu.org>
parents:
1877
diff
changeset
|
565 #endif |
603 | 566 } |
1877
7786f61ec635
(search_command): When moving to LIM on failure, return LIM.
Richard M. Stallman <rms@gnu.org>
parents:
1684
diff
changeset
|
567 else |
7786f61ec635
(search_command): When moving to LIM on failure, return LIM.
Richard M. Stallman <rms@gnu.org>
parents:
1684
diff
changeset
|
568 return Qnil; |
603 | 569 } |
570 | |
571 if (np < BEGV || np > ZV) | |
572 abort (); | |
573 | |
574 SET_PT (np); | |
575 | |
576 return make_number (np); | |
577 } | |
578 | |
579 /* search for the n'th occurrence of STRING in the current buffer, | |
580 starting at position POS and stopping at position LIM, | |
581 treating PAT as a literal string if RE is false or as | |
582 a regular expression if RE is true. | |
583 | |
584 If N is positive, searching is forward and LIM must be greater than POS. | |
585 If N is negative, searching is backward and LIM must be less than POS. | |
586 | |
587 Returns -x if only N-x occurrences found (x > 0), | |
588 or else the position at the beginning of the Nth occurrence | |
589 (if searching backward) or the end (if searching forward). */ | |
590 | |
591 search_buffer (string, pos, lim, n, RE, trt, inverse_trt) | |
592 Lisp_Object string; | |
593 int pos; | |
594 int lim; | |
595 int n; | |
596 int RE; | |
597 register unsigned char *trt; | |
598 register unsigned char *inverse_trt; | |
599 { | |
600 int len = XSTRING (string)->size; | |
601 unsigned char *base_pat = XSTRING (string)->data; | |
602 register int *BM_tab; | |
603 int *BM_tab_base; | |
604 register int direction = ((n > 0) ? 1 : -1); | |
605 register int dirlen; | |
606 int infinity, limit, k, stride_for_teases; | |
607 register unsigned char *pat, *cursor, *p_limit; | |
608 register int i, j; | |
609 unsigned char *p1, *p2; | |
610 int s1, s2; | |
611 | |
612 /* Null string is found at starting position. */ | |
4299
7a2e1d7362c5
(search_buffer): If n is 0, just return POS.
Richard M. Stallman <rms@gnu.org>
parents:
3615
diff
changeset
|
613 if (len == 0) |
7a2e1d7362c5
(search_buffer): If n is 0, just return POS.
Richard M. Stallman <rms@gnu.org>
parents:
3615
diff
changeset
|
614 return pos; |
7a2e1d7362c5
(search_buffer): If n is 0, just return POS.
Richard M. Stallman <rms@gnu.org>
parents:
3615
diff
changeset
|
615 |
7a2e1d7362c5
(search_buffer): If n is 0, just return POS.
Richard M. Stallman <rms@gnu.org>
parents:
3615
diff
changeset
|
616 /* Searching 0 times means don't move. */ |
7a2e1d7362c5
(search_buffer): If n is 0, just return POS.
Richard M. Stallman <rms@gnu.org>
parents:
3615
diff
changeset
|
617 if (n == 0) |
603 | 618 return pos; |
619 | |
620 if (RE) | |
708 | 621 compile_pattern (string, &searchbuf, &search_regs, (char *) trt); |
603 | 622 |
623 if (RE /* Here we detect whether the */ | |
624 /* generality of an RE search is */ | |
625 /* really needed. */ | |
626 /* first item is "exact match" */ | |
621 | 627 && *(searchbuf.buffer) == (char) RE_EXACTN_VALUE |
603 | 628 && searchbuf.buffer[1] + 2 == searchbuf.used) /*first is ONLY item */ |
629 { | |
630 RE = 0; /* can do straight (non RE) search */ | |
631 pat = (base_pat = (unsigned char *) searchbuf.buffer + 2); | |
632 /* trt already applied */ | |
633 len = searchbuf.used - 2; | |
634 } | |
635 else if (!RE) | |
636 { | |
637 pat = (unsigned char *) alloca (len); | |
638 | |
639 for (i = len; i--;) /* Copy the pattern; apply trt */ | |
640 *pat++ = (((int) trt) ? trt [*base_pat++] : *base_pat++); | |
641 pat -= len; base_pat = pat; | |
642 } | |
643 | |
644 if (RE) | |
645 { | |
646 immediate_quit = 1; /* Quit immediately if user types ^G, | |
647 because letting this function finish | |
648 can take too long. */ | |
649 QUIT; /* Do a pending quit right away, | |
650 to avoid paradoxical behavior */ | |
651 /* Get pointers and sizes of the two strings | |
652 that make up the visible portion of the buffer. */ | |
653 | |
654 p1 = BEGV_ADDR; | |
655 s1 = GPT - BEGV; | |
656 p2 = GAP_END_ADDR; | |
657 s2 = ZV - GPT; | |
658 if (s1 < 0) | |
659 { | |
660 p2 = p1; | |
661 s2 = ZV - BEGV; | |
662 s1 = 0; | |
663 } | |
664 if (s2 < 0) | |
665 { | |
666 s1 = ZV - BEGV; | |
667 s2 = 0; | |
668 } | |
669 while (n < 0) | |
670 { | |
2475
052bbdf1b817
(search_buffer): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
2439
diff
changeset
|
671 int val; |
052bbdf1b817
(search_buffer): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
2439
diff
changeset
|
672 val = re_search_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2, |
052bbdf1b817
(search_buffer): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
2439
diff
changeset
|
673 pos - BEGV, lim - pos, &search_regs, |
052bbdf1b817
(search_buffer): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
2439
diff
changeset
|
674 /* Don't allow match past current point */ |
052bbdf1b817
(search_buffer): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
2439
diff
changeset
|
675 pos - BEGV); |
603 | 676 if (val == -2) |
677 matcher_overflow (); | |
678 if (val >= 0) | |
679 { | |
680 j = BEGV; | |
621 | 681 for (i = 0; i < search_regs.num_regs; i++) |
603 | 682 if (search_regs.start[i] >= 0) |
683 { | |
684 search_regs.start[i] += j; | |
685 search_regs.end[i] += j; | |
686 } | |
727 | 687 XSET (last_thing_searched, Lisp_Buffer, current_buffer); |
603 | 688 /* Set pos to the new position. */ |
689 pos = search_regs.start[0]; | |
690 } | |
691 else | |
692 { | |
693 immediate_quit = 0; | |
694 return (n); | |
695 } | |
696 n++; | |
697 } | |
698 while (n > 0) | |
699 { | |
2475
052bbdf1b817
(search_buffer): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
2439
diff
changeset
|
700 int val; |
052bbdf1b817
(search_buffer): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
2439
diff
changeset
|
701 val = re_search_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2, |
052bbdf1b817
(search_buffer): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
2439
diff
changeset
|
702 pos - BEGV, lim - pos, &search_regs, |
052bbdf1b817
(search_buffer): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
2439
diff
changeset
|
703 lim - BEGV); |
603 | 704 if (val == -2) |
705 matcher_overflow (); | |
706 if (val >= 0) | |
707 { | |
708 j = BEGV; | |
621 | 709 for (i = 0; i < search_regs.num_regs; i++) |
603 | 710 if (search_regs.start[i] >= 0) |
711 { | |
712 search_regs.start[i] += j; | |
713 search_regs.end[i] += j; | |
714 } | |
727 | 715 XSET (last_thing_searched, Lisp_Buffer, current_buffer); |
603 | 716 pos = search_regs.end[0]; |
717 } | |
718 else | |
719 { | |
720 immediate_quit = 0; | |
721 return (0 - n); | |
722 } | |
723 n--; | |
724 } | |
725 immediate_quit = 0; | |
726 return (pos); | |
727 } | |
728 else /* non-RE case */ | |
729 { | |
730 #ifdef C_ALLOCA | |
731 int BM_tab_space[0400]; | |
732 BM_tab = &BM_tab_space[0]; | |
733 #else | |
734 BM_tab = (int *) alloca (0400 * sizeof (int)); | |
735 #endif | |
736 /* The general approach is that we are going to maintain that we know */ | |
737 /* the first (closest to the present position, in whatever direction */ | |
738 /* we're searching) character that could possibly be the last */ | |
739 /* (furthest from present position) character of a valid match. We */ | |
740 /* advance the state of our knowledge by looking at that character */ | |
741 /* and seeing whether it indeed matches the last character of the */ | |
742 /* pattern. If it does, we take a closer look. If it does not, we */ | |
743 /* move our pointer (to putative last characters) as far as is */ | |
744 /* logically possible. This amount of movement, which I call a */ | |
745 /* stride, will be the length of the pattern if the actual character */ | |
746 /* appears nowhere in the pattern, otherwise it will be the distance */ | |
747 /* from the last occurrence of that character to the end of the */ | |
748 /* pattern. */ | |
749 /* As a coding trick, an enormous stride is coded into the table for */ | |
750 /* characters that match the last character. This allows use of only */ | |
751 /* a single test, a test for having gone past the end of the */ | |
752 /* permissible match region, to test for both possible matches (when */ | |
753 /* the stride goes past the end immediately) and failure to */ | |
754 /* match (where you get nudged past the end one stride at a time). */ | |
755 | |
756 /* Here we make a "mickey mouse" BM table. The stride of the search */ | |
757 /* is determined only by the last character of the putative match. */ | |
758 /* If that character does not match, we will stride the proper */ | |
759 /* distance to propose a match that superimposes it on the last */ | |
760 /* instance of a character that matches it (per trt), or misses */ | |
761 /* it entirely if there is none. */ | |
762 | |
763 dirlen = len * direction; | |
764 infinity = dirlen - (lim + pos + len + len) * direction; | |
765 if (direction < 0) | |
766 pat = (base_pat += len - 1); | |
767 BM_tab_base = BM_tab; | |
768 BM_tab += 0400; | |
769 j = dirlen; /* to get it in a register */ | |
770 /* A character that does not appear in the pattern induces a */ | |
771 /* stride equal to the pattern length. */ | |
772 while (BM_tab_base != BM_tab) | |
773 { | |
774 *--BM_tab = j; | |
775 *--BM_tab = j; | |
776 *--BM_tab = j; | |
777 *--BM_tab = j; | |
778 } | |
779 i = 0; | |
780 while (i != infinity) | |
781 { | |
782 j = pat[i]; i += direction; | |
783 if (i == dirlen) i = infinity; | |
784 if ((int) trt) | |
785 { | |
786 k = (j = trt[j]); | |
787 if (i == infinity) | |
788 stride_for_teases = BM_tab[j]; | |
789 BM_tab[j] = dirlen - i; | |
790 /* A translation table is accompanied by its inverse -- see */ | |
791 /* comment following downcase_table for details */ | |
792 while ((j = inverse_trt[j]) != k) | |
793 BM_tab[j] = dirlen - i; | |
794 } | |
795 else | |
796 { | |
797 if (i == infinity) | |
798 stride_for_teases = BM_tab[j]; | |
799 BM_tab[j] = dirlen - i; | |
800 } | |
801 /* stride_for_teases tells how much to stride if we get a */ | |
802 /* match on the far character but are subsequently */ | |
803 /* disappointed, by recording what the stride would have been */ | |
804 /* for that character if the last character had been */ | |
805 /* different. */ | |
806 } | |
807 infinity = dirlen - infinity; | |
808 pos += dirlen - ((direction > 0) ? direction : 0); | |
809 /* loop invariant - pos points at where last char (first char if reverse) | |
810 of pattern would align in a possible match. */ | |
811 while (n != 0) | |
812 { | |
813 if ((lim - pos - (direction > 0)) * direction < 0) | |
814 return (n * (0 - direction)); | |
815 /* First we do the part we can by pointers (maybe nothing) */ | |
816 QUIT; | |
817 pat = base_pat; | |
818 limit = pos - dirlen + direction; | |
819 limit = ((direction > 0) | |
820 ? BUFFER_CEILING_OF (limit) | |
821 : BUFFER_FLOOR_OF (limit)); | |
822 /* LIMIT is now the last (not beyond-last!) value | |
823 POS can take on without hitting edge of buffer or the gap. */ | |
824 limit = ((direction > 0) | |
825 ? min (lim - 1, min (limit, pos + 20000)) | |
826 : max (lim, max (limit, pos - 20000))); | |
827 if ((limit - pos) * direction > 20) | |
828 { | |
829 p_limit = &FETCH_CHAR (limit); | |
830 p2 = (cursor = &FETCH_CHAR (pos)); | |
831 /* In this loop, pos + cursor - p2 is the surrogate for pos */ | |
832 while (1) /* use one cursor setting as long as i can */ | |
833 { | |
834 if (direction > 0) /* worth duplicating */ | |
835 { | |
836 /* Use signed comparison if appropriate | |
837 to make cursor+infinity sure to be > p_limit. | |
838 Assuming that the buffer lies in a range of addresses | |
839 that are all "positive" (as ints) or all "negative", | |
840 either kind of comparison will work as long | |
841 as we don't step by infinity. So pick the kind | |
842 that works when we do step by infinity. */ | |
843 if ((int) (p_limit + infinity) > (int) p_limit) | |
844 while ((int) cursor <= (int) p_limit) | |
845 cursor += BM_tab[*cursor]; | |
846 else | |
847 while ((unsigned int) cursor <= (unsigned int) p_limit) | |
848 cursor += BM_tab[*cursor]; | |
849 } | |
850 else | |
851 { | |
852 if ((int) (p_limit + infinity) < (int) p_limit) | |
853 while ((int) cursor >= (int) p_limit) | |
854 cursor += BM_tab[*cursor]; | |
855 else | |
856 while ((unsigned int) cursor >= (unsigned int) p_limit) | |
857 cursor += BM_tab[*cursor]; | |
858 } | |
859 /* If you are here, cursor is beyond the end of the searched region. */ | |
860 /* This can happen if you match on the far character of the pattern, */ | |
861 /* because the "stride" of that character is infinity, a number able */ | |
862 /* to throw you well beyond the end of the search. It can also */ | |
863 /* happen if you fail to match within the permitted region and would */ | |
864 /* otherwise try a character beyond that region */ | |
865 if ((cursor - p_limit) * direction <= len) | |
866 break; /* a small overrun is genuine */ | |
867 cursor -= infinity; /* large overrun = hit */ | |
868 i = dirlen - direction; | |
869 if ((int) trt) | |
870 { | |
871 while ((i -= direction) + direction != 0) | |
872 if (pat[i] != trt[*(cursor -= direction)]) | |
873 break; | |
874 } | |
875 else | |
876 { | |
877 while ((i -= direction) + direction != 0) | |
878 if (pat[i] != *(cursor -= direction)) | |
879 break; | |
880 } | |
881 cursor += dirlen - i - direction; /* fix cursor */ | |
882 if (i + direction == 0) | |
883 { | |
884 cursor -= direction; | |
708 | 885 |
886 /* Make sure we have registers in which to store | |
887 the match position. */ | |
888 if (search_regs.num_regs == 0) | |
889 { | |
890 regoff_t *starts, *ends; | |
891 | |
892 starts = | |
893 (regoff_t *) xmalloc (2 * sizeof (regoff_t)); | |
894 ends = | |
895 (regoff_t *) xmalloc (2 * sizeof (regoff_t)); | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
896 BLOCK_INPUT; |
708 | 897 re_set_registers (&searchbuf, |
898 &search_regs, | |
899 2, starts, ends); | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
900 UNBLOCK_INPUT; |
708 | 901 } |
902 | |
603 | 903 search_regs.start[0] |
904 = pos + cursor - p2 + ((direction > 0) | |
905 ? 1 - len : 0); | |
906 search_regs.end[0] = len + search_regs.start[0]; | |
727 | 907 XSET (last_thing_searched, Lisp_Buffer, current_buffer); |
603 | 908 if ((n -= direction) != 0) |
909 cursor += dirlen; /* to resume search */ | |
910 else | |
911 return ((direction > 0) | |
912 ? search_regs.end[0] : search_regs.start[0]); | |
913 } | |
914 else | |
915 cursor += stride_for_teases; /* <sigh> we lose - */ | |
916 } | |
917 pos += cursor - p2; | |
918 } | |
919 else | |
920 /* Now we'll pick up a clump that has to be done the hard */ | |
921 /* way because it covers a discontinuity */ | |
922 { | |
923 limit = ((direction > 0) | |
924 ? BUFFER_CEILING_OF (pos - dirlen + 1) | |
925 : BUFFER_FLOOR_OF (pos - dirlen - 1)); | |
926 limit = ((direction > 0) | |
927 ? min (limit + len, lim - 1) | |
928 : max (limit - len, lim)); | |
929 /* LIMIT is now the last value POS can have | |
930 and still be valid for a possible match. */ | |
931 while (1) | |
932 { | |
933 /* This loop can be coded for space rather than */ | |
934 /* speed because it will usually run only once. */ | |
935 /* (the reach is at most len + 21, and typically */ | |
936 /* does not exceed len) */ | |
937 while ((limit - pos) * direction >= 0) | |
938 pos += BM_tab[FETCH_CHAR(pos)]; | |
939 /* now run the same tests to distinguish going off the */ | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
940 /* end, a match or a phony match. */ |
603 | 941 if ((pos - limit) * direction <= len) |
942 break; /* ran off the end */ | |
943 /* Found what might be a match. | |
944 Set POS back to last (first if reverse) char pos. */ | |
945 pos -= infinity; | |
946 i = dirlen - direction; | |
947 while ((i -= direction) + direction != 0) | |
948 { | |
949 pos -= direction; | |
950 if (pat[i] != (((int) trt) | |
951 ? trt[FETCH_CHAR(pos)] | |
952 : FETCH_CHAR (pos))) | |
953 break; | |
954 } | |
955 /* Above loop has moved POS part or all the way | |
956 back to the first char pos (last char pos if reverse). | |
957 Set it once again at the last (first if reverse) char. */ | |
958 pos += dirlen - i- direction; | |
959 if (i + direction == 0) | |
960 { | |
961 pos -= direction; | |
708 | 962 |
963 /* Make sure we have registers in which to store | |
964 the match position. */ | |
965 if (search_regs.num_regs == 0) | |
966 { | |
967 regoff_t *starts, *ends; | |
968 | |
969 starts = | |
970 (regoff_t *) xmalloc (2 * sizeof (regoff_t)); | |
971 ends = | |
972 (regoff_t *) xmalloc (2 * sizeof (regoff_t)); | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
973 BLOCK_INPUT; |
708 | 974 re_set_registers (&searchbuf, |
975 &search_regs, | |
976 2, starts, ends); | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
977 UNBLOCK_INPUT; |
708 | 978 } |
979 | |
603 | 980 search_regs.start[0] |
981 = pos + ((direction > 0) ? 1 - len : 0); | |
982 search_regs.end[0] = len + search_regs.start[0]; | |
727 | 983 XSET (last_thing_searched, Lisp_Buffer, current_buffer); |
603 | 984 if ((n -= direction) != 0) |
985 pos += dirlen; /* to resume search */ | |
986 else | |
987 return ((direction > 0) | |
988 ? search_regs.end[0] : search_regs.start[0]); | |
989 } | |
990 else | |
991 pos += stride_for_teases; | |
992 } | |
993 } | |
994 /* We have done one clump. Can we continue? */ | |
995 if ((lim - pos) * direction < 0) | |
996 return ((0 - n) * direction); | |
997 } | |
998 return pos; | |
999 } | |
1000 } | |
1001 | |
1002 /* Given a string of words separated by word delimiters, | |
1003 compute a regexp that matches those exact words | |
1004 separated by arbitrary punctuation. */ | |
1005 | |
1006 static Lisp_Object | |
1007 wordify (string) | |
1008 Lisp_Object string; | |
1009 { | |
1010 register unsigned char *p, *o; | |
1011 register int i, len, punct_count = 0, word_count = 0; | |
1012 Lisp_Object val; | |
1013 | |
1014 CHECK_STRING (string, 0); | |
1015 p = XSTRING (string)->data; | |
1016 len = XSTRING (string)->size; | |
1017 | |
1018 for (i = 0; i < len; i++) | |
1019 if (SYNTAX (p[i]) != Sword) | |
1020 { | |
1021 punct_count++; | |
1022 if (i > 0 && SYNTAX (p[i-1]) == Sword) word_count++; | |
1023 } | |
1024 if (SYNTAX (p[len-1]) == Sword) word_count++; | |
1025 if (!word_count) return build_string (""); | |
1026 | |
1027 val = make_string (p, len - punct_count + 5 * (word_count - 1) + 4); | |
1028 | |
1029 o = XSTRING (val)->data; | |
1030 *o++ = '\\'; | |
1031 *o++ = 'b'; | |
1032 | |
1033 for (i = 0; i < len; i++) | |
1034 if (SYNTAX (p[i]) == Sword) | |
1035 *o++ = p[i]; | |
1036 else if (i > 0 && SYNTAX (p[i-1]) == Sword && --word_count) | |
1037 { | |
1038 *o++ = '\\'; | |
1039 *o++ = 'W'; | |
1040 *o++ = '\\'; | |
1041 *o++ = 'W'; | |
1042 *o++ = '*'; | |
1043 } | |
1044 | |
1045 *o++ = '\\'; | |
1046 *o++ = 'b'; | |
1047 | |
1048 return val; | |
1049 } | |
1050 | |
1051 DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4, | |
1052 "sSearch backward: ", | |
1053 "Search backward from point for STRING.\n\ | |
1054 Set point to the beginning of the occurrence found, and return point.\n\ | |
1055 An optional second argument bounds the search; it is a buffer position.\n\ | |
1056 The match found must not extend before that position.\n\ | |
1057 Optional third argument, if t, means if fail just return nil (no error).\n\ | |
1058 If not nil and not t, position at limit of search and return nil.\n\ | |
1059 Optional fourth argument is repeat count--search for successive occurrences.\n\ | |
1060 See also the functions `match-beginning', `match-end' and `replace-match'.") | |
1061 (string, bound, noerror, count) | |
1062 Lisp_Object string, bound, noerror, count; | |
1063 { | |
1064 return search_command (string, bound, noerror, count, -1, 0); | |
1065 } | |
1066 | |
1067 DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "sSearch: ", | |
1068 "Search forward from point for STRING.\n\ | |
1069 Set point to the end of the occurrence found, and return point.\n\ | |
1070 An optional second argument bounds the search; it is a buffer position.\n\ | |
1071 The match found must not extend after that position. nil is equivalent\n\ | |
1072 to (point-max).\n\ | |
1073 Optional third argument, if t, means if fail just return nil (no error).\n\ | |
1074 If not nil and not t, move to limit of search and return nil.\n\ | |
1075 Optional fourth argument is repeat count--search for successive occurrences.\n\ | |
1076 See also the functions `match-beginning', `match-end' and `replace-match'.") | |
1077 (string, bound, noerror, count) | |
1078 Lisp_Object string, bound, noerror, count; | |
1079 { | |
1080 return search_command (string, bound, noerror, count, 1, 0); | |
1081 } | |
1082 | |
1083 DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4, | |
1084 "sWord search backward: ", | |
1085 "Search backward from point for STRING, ignoring differences in punctuation.\n\ | |
1086 Set point to the beginning of the occurrence found, and return point.\n\ | |
1087 An optional second argument bounds the search; it is a buffer position.\n\ | |
1088 The match found must not extend before that position.\n\ | |
1089 Optional third argument, if t, means if fail just return nil (no error).\n\ | |
1090 If not nil and not t, move to limit of search and return nil.\n\ | |
1091 Optional fourth argument is repeat count--search for successive occurrences.") | |
1092 (string, bound, noerror, count) | |
1093 Lisp_Object string, bound, noerror, count; | |
1094 { | |
1095 return search_command (wordify (string), bound, noerror, count, -1, 1); | |
1096 } | |
1097 | |
1098 DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4, | |
1099 "sWord search: ", | |
1100 "Search forward from point for STRING, ignoring differences in punctuation.\n\ | |
1101 Set point to the end of the occurrence found, and return point.\n\ | |
1102 An optional second argument bounds the search; it is a buffer position.\n\ | |
1103 The match found must not extend after that position.\n\ | |
1104 Optional third argument, if t, means if fail just return nil (no error).\n\ | |
1105 If not nil and not t, move to limit of search and return nil.\n\ | |
1106 Optional fourth argument is repeat count--search for successive occurrences.") | |
1107 (string, bound, noerror, count) | |
1108 Lisp_Object string, bound, noerror, count; | |
1109 { | |
1110 return search_command (wordify (string), bound, noerror, count, 1, 1); | |
1111 } | |
1112 | |
1113 DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4, | |
1114 "sRE search backward: ", | |
1115 "Search backward from point for match for regular expression REGEXP.\n\ | |
1116 Set point to the beginning of the match, and return point.\n\ | |
1117 The match found is the one starting last in the buffer\n\ | |
1118 and yet ending before the place the origin of the search.\n\ | |
1119 An optional second argument bounds the search; it is a buffer position.\n\ | |
1120 The match found must start at or after that position.\n\ | |
1121 Optional third argument, if t, means if fail just return nil (no error).\n\ | |
1122 If not nil and not t, move to limit of search and return nil.\n\ | |
1123 Optional fourth argument is repeat count--search for successive occurrences.\n\ | |
1124 See also the functions `match-beginning', `match-end' and `replace-match'.") | |
1125 (string, bound, noerror, count) | |
1126 Lisp_Object string, bound, noerror, count; | |
1127 { | |
1128 return search_command (string, bound, noerror, count, -1, 1); | |
1129 } | |
1130 | |
1131 DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4, | |
1132 "sRE search: ", | |
1133 "Search forward from point for regular expression REGEXP.\n\ | |
1134 Set point to the end of the occurrence found, and return point.\n\ | |
1135 An optional second argument bounds the search; it is a buffer position.\n\ | |
1136 The match found must not extend after that position.\n\ | |
1137 Optional third argument, if t, means if fail just return nil (no error).\n\ | |
1138 If not nil and not t, move to limit of search and return nil.\n\ | |
1139 Optional fourth argument is repeat count--search for successive occurrences.\n\ | |
1140 See also the functions `match-beginning', `match-end' and `replace-match'.") | |
1141 (string, bound, noerror, count) | |
1142 Lisp_Object string, bound, noerror, count; | |
1143 { | |
1144 return search_command (string, bound, noerror, count, 1, 1); | |
1145 } | |
1146 | |
1147 DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 3, 0, | |
1148 "Replace text matched by last search with NEWTEXT.\n\ | |
1149 If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\ | |
1150 Otherwise convert to all caps or cap initials, like replaced text.\n\ | |
1151 If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\ | |
1152 Otherwise treat `\\' as special:\n\ | |
1153 `\\&' in NEWTEXT means substitute original matched text.\n\ | |
1154 `\\N' means substitute what matched the Nth `\\(...\\)'.\n\ | |
1155 If Nth parens didn't match, substitute nothing.\n\ | |
1156 `\\\\' means insert one `\\'.\n\ | |
708 | 1157 FIXEDCASE and LITERAL are optional arguments.\n\ |
603 | 1158 Leaves point at end of replacement text.") |
1159 (string, fixedcase, literal) | |
1160 Lisp_Object string, fixedcase, literal; | |
1161 { | |
1162 enum { nochange, all_caps, cap_initial } case_action; | |
1163 register int pos, last; | |
1164 int some_multiletter_word; | |
2393
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1165 int some_lowercase; |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1166 int some_uppercase_initial; |
603 | 1167 register int c, prevc; |
1168 int inslen; | |
1169 | |
1170 CHECK_STRING (string, 0); | |
1171 | |
1172 case_action = nochange; /* We tried an initialization */ | |
1173 /* but some C compilers blew it */ | |
621 | 1174 |
1175 if (search_regs.num_regs <= 0) | |
1176 error ("replace-match called before any match found"); | |
1177 | |
603 | 1178 if (search_regs.start[0] < BEGV |
1179 || search_regs.start[0] > search_regs.end[0] | |
1180 || search_regs.end[0] > ZV) | |
2393
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1181 args_out_of_range (make_number (search_regs.start[0]), |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1182 make_number (search_regs.end[0])); |
603 | 1183 |
1184 if (NILP (fixedcase)) | |
1185 { | |
1186 /* Decide how to casify by examining the matched text. */ | |
1187 | |
1188 last = search_regs.end[0]; | |
1189 prevc = '\n'; | |
1190 case_action = all_caps; | |
1191 | |
1192 /* some_multiletter_word is set nonzero if any original word | |
1193 is more than one letter long. */ | |
1194 some_multiletter_word = 0; | |
2393
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1195 some_lowercase = 0; |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1196 some_uppercase_initial = 0; |
603 | 1197 |
1198 for (pos = search_regs.start[0]; pos < last; pos++) | |
1199 { | |
1200 c = FETCH_CHAR (pos); | |
1201 if (LOWERCASEP (c)) | |
1202 { | |
1203 /* Cannot be all caps if any original char is lower case */ | |
1204 | |
2393
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1205 some_lowercase = 1; |
603 | 1206 if (SYNTAX (prevc) != Sword) |
2393
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1207 ; |
603 | 1208 else |
1209 some_multiletter_word = 1; | |
1210 } | |
1211 else if (!NOCASEP (c)) | |
1212 { | |
2393
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1213 if (SYNTAX (prevc) != Sword) |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1214 some_uppercase_initial = 1; |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1215 else |
603 | 1216 some_multiletter_word = 1; |
1217 } | |
1218 | |
1219 prevc = c; | |
1220 } | |
1221 | |
2393
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1222 /* Convert to all caps if the old text is all caps |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1223 and has at least one multiletter word. */ |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1224 if (! some_lowercase && some_multiletter_word) |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1225 case_action = all_caps; |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1226 /* Capitalize each word, if the old text has a capitalized word. */ |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1227 else if (some_uppercase_initial) |
603 | 1228 case_action = cap_initial; |
2393
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1229 else |
a35d2c5cbb3b
(Freplace_match): Clean up criterion about converting case.
Richard M. Stallman <rms@gnu.org>
parents:
1926
diff
changeset
|
1230 case_action = nochange; |
603 | 1231 } |
1232 | |
2655
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1233 /* We insert the replacement text before the old text, and then |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1234 delete the original text. This means that markers at the |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1235 beginning or end of the original will float to the corresponding |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1236 position in the replacement. */ |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1237 SET_PT (search_regs.start[0]); |
603 | 1238 if (!NILP (literal)) |
1239 Finsert (1, &string); | |
1240 else | |
1241 { | |
1242 struct gcpro gcpro1; | |
1243 GCPRO1 (string); | |
1244 | |
1245 for (pos = 0; pos < XSTRING (string)->size; pos++) | |
1246 { | |
2655
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1247 int offset = point - search_regs.start[0]; |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1248 |
603 | 1249 c = XSTRING (string)->data[pos]; |
1250 if (c == '\\') | |
1251 { | |
1252 c = XSTRING (string)->data[++pos]; | |
1253 if (c == '&') | |
2655
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1254 Finsert_buffer_substring |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1255 (Fcurrent_buffer (), |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1256 make_number (search_regs.start[0] + offset), |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1257 make_number (search_regs.end[0] + offset)); |
621 | 1258 else if (c >= '1' && c <= search_regs.num_regs + '0') |
603 | 1259 { |
1260 if (search_regs.start[c - '0'] >= 1) | |
2655
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1261 Finsert_buffer_substring |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1262 (Fcurrent_buffer (), |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1263 make_number (search_regs.start[c - '0'] + offset), |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1264 make_number (search_regs.end[c - '0'] + offset)); |
603 | 1265 } |
1266 else | |
1267 insert_char (c); | |
1268 } | |
1269 else | |
1270 insert_char (c); | |
1271 } | |
1272 UNGCPRO; | |
1273 } | |
1274 | |
2655
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1275 inslen = point - (search_regs.start[0]); |
594a33ffed85
* search.c (Freplace_match): Arrange for markers sitting at the
Jim Blandy <jimb@redhat.com>
parents:
2475
diff
changeset
|
1276 del_range (search_regs.start[0] + inslen, search_regs.end[0] + inslen); |
603 | 1277 |
1278 if (case_action == all_caps) | |
1279 Fupcase_region (make_number (point - inslen), make_number (point)); | |
1280 else if (case_action == cap_initial) | |
1281 upcase_initials_region (make_number (point - inslen), make_number (point)); | |
1282 return Qnil; | |
1283 } | |
1284 | |
1285 static Lisp_Object | |
1286 match_limit (num, beginningp) | |
1287 Lisp_Object num; | |
1288 int beginningp; | |
1289 { | |
1290 register int n; | |
1291 | |
1292 CHECK_NUMBER (num, 0); | |
1293 n = XINT (num); | |
621 | 1294 if (n < 0 || n >= search_regs.num_regs) |
1295 args_out_of_range (num, make_number (search_regs.num_regs)); | |
1296 if (search_regs.num_regs <= 0 | |
1297 || search_regs.start[n] < 0) | |
603 | 1298 return Qnil; |
1299 return (make_number ((beginningp) ? search_regs.start[n] | |
1300 : search_regs.end[n])); | |
1301 } | |
1302 | |
1303 DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0, | |
1304 "Return position of start of text matched by last search.\n\ | |
1305 ARG, a number, specifies which parenthesized expression in the last regexp.\n\ | |
1306 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\ | |
1307 Zero means the entire text matched by the whole regexp or whole string.") | |
1308 (num) | |
1309 Lisp_Object num; | |
1310 { | |
1311 return match_limit (num, 1); | |
1312 } | |
1313 | |
1314 DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0, | |
1315 "Return position of end of text matched by last search.\n\ | |
1316 ARG, a number, specifies which parenthesized expression in the last regexp.\n\ | |
1317 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\ | |
1318 Zero means the entire text matched by the whole regexp or whole string.") | |
1319 (num) | |
1320 Lisp_Object num; | |
1321 { | |
1322 return match_limit (num, 0); | |
1323 } | |
1324 | |
1325 DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0, | |
1326 "Return a list containing all info on what the last search matched.\n\ | |
1327 Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\ | |
1328 All the elements are markers or nil (nil if the Nth pair didn't match)\n\ | |
1329 if the last match was on a buffer; integers or nil if a string was matched.\n\ | |
1330 Use `store-match-data' to reinstate the data in this list.") | |
1331 () | |
1332 { | |
621 | 1333 Lisp_Object *data; |
603 | 1334 int i, len; |
1335 | |
727 | 1336 if (NILP (last_thing_searched)) |
1337 error ("match-data called before any match found"); | |
1338 | |
621 | 1339 data = (Lisp_Object *) alloca ((2 * search_regs.num_regs) |
1340 * sizeof (Lisp_Object)); | |
1341 | |
603 | 1342 len = -1; |
621 | 1343 for (i = 0; i < search_regs.num_regs; i++) |
603 | 1344 { |
1345 int start = search_regs.start[i]; | |
1346 if (start >= 0) | |
1347 { | |
727 | 1348 if (EQ (last_thing_searched, Qt)) |
603 | 1349 { |
1350 XFASTINT (data[2 * i]) = start; | |
1351 XFASTINT (data[2 * i + 1]) = search_regs.end[i]; | |
1352 } | |
727 | 1353 else if (XTYPE (last_thing_searched) == Lisp_Buffer) |
603 | 1354 { |
1355 data[2 * i] = Fmake_marker (); | |
727 | 1356 Fset_marker (data[2 * i], |
1357 make_number (start), | |
1358 last_thing_searched); | |
603 | 1359 data[2 * i + 1] = Fmake_marker (); |
1360 Fset_marker (data[2 * i + 1], | |
727 | 1361 make_number (search_regs.end[i]), |
1362 last_thing_searched); | |
603 | 1363 } |
727 | 1364 else |
1365 /* last_thing_searched must always be Qt, a buffer, or Qnil. */ | |
1366 abort (); | |
1367 | |
603 | 1368 len = i; |
1369 } | |
1370 else | |
1371 data[2 * i] = data [2 * i + 1] = Qnil; | |
1372 } | |
1373 return Flist (2 * len + 2, data); | |
1374 } | |
1375 | |
1376 | |
1377 DEFUN ("store-match-data", Fstore_match_data, Sstore_match_data, 1, 1, 0, | |
1378 "Set internal data on last search match from elements of LIST.\n\ | |
1379 LIST should have been created by calling `match-data' previously.") | |
1380 (list) | |
1381 register Lisp_Object list; | |
1382 { | |
1383 register int i; | |
1384 register Lisp_Object marker; | |
1385 | |
1386 if (!CONSP (list) && !NILP (list)) | |
1926
952f2a18f83d
* callint.c (Fcall_interactively): Pass the correct number of
Jim Blandy <jimb@redhat.com>
parents:
1896
diff
changeset
|
1387 list = wrong_type_argument (Qconsp, list); |
603 | 1388 |
727 | 1389 /* Unless we find a marker with a buffer in LIST, assume that this |
1390 match data came from a string. */ | |
1391 last_thing_searched = Qt; | |
1392 | |
621 | 1393 /* Allocate registers if they don't already exist. */ |
1394 { | |
1523
bd61aaa7828b
* search.c (Fstore_match_data): Don't assume Flength returns an
Jim Blandy <jimb@redhat.com>
parents:
1413
diff
changeset
|
1395 int length = XFASTINT (Flength (list)) / 2; |
621 | 1396 |
1397 if (length > search_regs.num_regs) | |
1398 { | |
708 | 1399 if (search_regs.num_regs == 0) |
1400 { | |
1401 search_regs.start | |
1402 = (regoff_t *) xmalloc (length * sizeof (regoff_t)); | |
1403 search_regs.end | |
1404 = (regoff_t *) xmalloc (length * sizeof (regoff_t)); | |
1405 } | |
621 | 1406 else |
708 | 1407 { |
1408 search_regs.start | |
1409 = (regoff_t *) xrealloc (search_regs.start, | |
1410 length * sizeof (regoff_t)); | |
1411 search_regs.end | |
1412 = (regoff_t *) xrealloc (search_regs.end, | |
1413 length * sizeof (regoff_t)); | |
1414 } | |
621 | 1415 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
1416 BLOCK_INPUT; |
708 | 1417 re_set_registers (&searchbuf, &search_regs, length, |
1418 search_regs.start, search_regs.end); | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2393
diff
changeset
|
1419 UNBLOCK_INPUT; |
621 | 1420 } |
1421 } | |
1422 | |
1423 for (i = 0; i < search_regs.num_regs; i++) | |
603 | 1424 { |
1425 marker = Fcar (list); | |
1426 if (NILP (marker)) | |
1427 { | |
1428 search_regs.start[i] = -1; | |
1429 list = Fcdr (list); | |
1430 } | |
1431 else | |
1432 { | |
727 | 1433 if (XTYPE (marker) == Lisp_Marker) |
1434 { | |
1435 if (XMARKER (marker)->buffer == 0) | |
1436 XFASTINT (marker) = 0; | |
1437 else | |
1438 XSET (last_thing_searched, Lisp_Buffer, | |
1439 XMARKER (marker)->buffer); | |
1440 } | |
603 | 1441 |
1442 CHECK_NUMBER_COERCE_MARKER (marker, 0); | |
1443 search_regs.start[i] = XINT (marker); | |
1444 list = Fcdr (list); | |
1445 | |
1446 marker = Fcar (list); | |
1447 if (XTYPE (marker) == Lisp_Marker | |
1448 && XMARKER (marker)->buffer == 0) | |
1449 XFASTINT (marker) = 0; | |
1450 | |
1451 CHECK_NUMBER_COERCE_MARKER (marker, 0); | |
1452 search_regs.end[i] = XINT (marker); | |
1453 } | |
1454 list = Fcdr (list); | |
1455 } | |
1456 | |
1457 return Qnil; | |
1458 } | |
1459 | |
1460 /* Quote a string to inactivate reg-expr chars */ | |
1461 | |
1462 DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0, | |
1463 "Return a regexp string which matches exactly STRING and nothing else.") | |
1464 (str) | |
1465 Lisp_Object str; | |
1466 { | |
1467 register unsigned char *in, *out, *end; | |
1468 register unsigned char *temp; | |
1469 | |
1470 CHECK_STRING (str, 0); | |
1471 | |
1472 temp = (unsigned char *) alloca (XSTRING (str)->size * 2); | |
1473 | |
1474 /* Now copy the data into the new string, inserting escapes. */ | |
1475 | |
1476 in = XSTRING (str)->data; | |
1477 end = in + XSTRING (str)->size; | |
1478 out = temp; | |
1479 | |
1480 for (; in != end; in++) | |
1481 { | |
1482 if (*in == '[' || *in == ']' | |
1483 || *in == '*' || *in == '.' || *in == '\\' | |
1484 || *in == '?' || *in == '+' | |
1485 || *in == '^' || *in == '$') | |
1486 *out++ = '\\'; | |
1487 *out++ = *in; | |
1488 } | |
1489 | |
1490 return make_string (temp, out - temp); | |
1491 } | |
1492 | |
1493 syms_of_search () | |
1494 { | |
1495 register int i; | |
1496 | |
1497 searchbuf.allocated = 100; | |
605 | 1498 searchbuf.buffer = (unsigned char *) malloc (searchbuf.allocated); |
603 | 1499 searchbuf.fastmap = search_fastmap; |
1500 | |
1501 Qsearch_failed = intern ("search-failed"); | |
1502 staticpro (&Qsearch_failed); | |
1503 Qinvalid_regexp = intern ("invalid-regexp"); | |
1504 staticpro (&Qinvalid_regexp); | |
1505 | |
1506 Fput (Qsearch_failed, Qerror_conditions, | |
1507 Fcons (Qsearch_failed, Fcons (Qerror, Qnil))); | |
1508 Fput (Qsearch_failed, Qerror_message, | |
1509 build_string ("Search failed")); | |
1510 | |
1511 Fput (Qinvalid_regexp, Qerror_conditions, | |
1512 Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil))); | |
1513 Fput (Qinvalid_regexp, Qerror_message, | |
1514 build_string ("Invalid regexp")); | |
1515 | |
1516 last_regexp = Qnil; | |
1517 staticpro (&last_regexp); | |
1518 | |
727 | 1519 last_thing_searched = Qnil; |
1520 staticpro (&last_thing_searched); | |
1521 | |
603 | 1522 defsubr (&Sstring_match); |
1523 defsubr (&Slooking_at); | |
1524 defsubr (&Sskip_chars_forward); | |
1525 defsubr (&Sskip_chars_backward); | |
1896
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
1526 defsubr (&Sskip_syntax_forward); |
10895ac08bc6
(Fskip_syntax_backward): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1878
diff
changeset
|
1527 defsubr (&Sskip_syntax_backward); |
603 | 1528 defsubr (&Ssearch_forward); |
1529 defsubr (&Ssearch_backward); | |
1530 defsubr (&Sword_search_forward); | |
1531 defsubr (&Sword_search_backward); | |
1532 defsubr (&Sre_search_forward); | |
1533 defsubr (&Sre_search_backward); | |
1534 defsubr (&Sreplace_match); | |
1535 defsubr (&Smatch_beginning); | |
1536 defsubr (&Smatch_end); | |
1537 defsubr (&Smatch_data); | |
1538 defsubr (&Sstore_match_data); | |
1539 defsubr (&Sregexp_quote); | |
1540 } |