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