aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJim Blandy1992-04-01 10:45:51 +0000
committerJim Blandy1992-04-01 10:45:51 +0000
commitca1d1d23251bc8f159d0131d345702aabf2dd078 (patch)
tree00811cb1b7cf786e26bce72efe3e9d464a51c081
parent23a227f7179a440649f6a79115f8c299e77bfdce (diff)
downloademacs-ca1d1d23251bc8f159d0131d345702aabf2dd078.tar.gz
emacs-ca1d1d23251bc8f159d0131d345702aabf2dd078.zip
Initial revision
-rwxr-xr-xconfigure1.in471
-rw-r--r--src/search.c1294
2 files changed, 1765 insertions, 0 deletions
diff --git a/configure1.in b/configure1.in
new file mode 100755
index 00000000000..be045bbfb00
--- /dev/null
+++ b/configure1.in
@@ -0,0 +1,471 @@
1#!/bin/sh
2# Configuration script for GNU Emacs
3# Copyright (C) 1992 Free Software Foundation, Inc.
4
5#This file is part of GNU Emacs.
6
7#GNU Emacs is free software; you can redistribute it and/or modify
8#it under the terms of the GNU General Public License as published by
9#the Free Software Foundation; either version 1, or (at your option)
10#any later version.
11
12#GNU Emacs is distributed in the hope that it will be useful,
13#but WITHOUT ANY WARRANTY; without even the implied warranty of
14#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15#GNU General Public License for more details.
16
17#You should have received a copy of the GNU General Public License
18#along with GNU Emacs; see the file COPYING. If not, write to
19#the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20
21# Shell script to edit files and make symlinks in preparation for
22# compiling Emacs.
23#
24# Usage: configure machine
25#
26# If configure succeeds, it leaves its status in config.status.
27# If configure fails after disturbing the status quo,
28# config.status is removed.
29#
30
31progname=$0
32
33short_usage="Type \`${progname} -usage' for more information about options."
34
35usage_message="Usage: ${progname} MACHINENAME [-OPTION[=VALUE] ...]
36Set compilation and installation parameters for GNU Emacs, and report.
37MACHINENAME is the machine to build for. See \`etc/MACHINES'.
38Options are:
39 -opsystem=SYSTEM - operating system to build for; see \`etc/MACHINES'.
40 -libroot=DIR - where to install Emacs's library files
41These options have reasonable defaults (in []s), and may not be needed:
42 -g, -O - Passed to the compiler. If omitted, use -O only.
43 -cc=COMPILER - Which compiler to use. Defaults to gcc if available.
44 -libdir=DIR - where to look for arch-dependent library files
45 -datadir=DIR - where to look for architecture-independent library files
46 -installbin=DIR - where to install the Emacs executable, and some friends
47 -lisppath=PATH - colon-separated list of Elisp directories
48 -lockdir=DIR - where Emacs should do its file-locking stuff
49 -window_system=none or [x11, if it is installed] - what window system to use
50 -have_x_menu=yes or [no] - include menu support under X11
51 -gnu_malloc=[yes] or no - use the GNU memory allocator
52 -rel_alloc=[yes] or no - use compacting allocator for buffers
53 -highpri=N - run at N points higher-than-normal priority
54 -lisp_float_type=[yes] or no - Support floating point in Elisp
55If successful, ${progname} leaves its status in config.status. If
56unsuccessful after disturbing the status quo, config.status is removed."
57
58if [ ! -r ./src/lisp.h ]; then
59 echo "${progname}: Can't find Emacs sources in \`./src'.
60Run this config script in the top directory of the Emacs source tree." 1>&2
61 exit 1
62fi
63
64options=":\
65usage:help:\
66machine:opsystem:\
67g:O:cc:\
68libroot:datadir:libdir:installbin:lisppath:lockdir:\
69gnu_malloc:rel_alloc:highpri:lisp_float_type:\
70window_system:have_x_menu:\
71"
72
73boolean_opts=":\
74g:O:\
75gnu_malloc:rel_alloc:lisp_float_type:have_x_menu:\
76"
77
78config_h_opts=":\
79highpri:gnu_malloc:rel_alloc:lisp_float_type:\
80have_x_windows:have_x11:have_x_menu:\
81c_switch_site:sigtype:\
82"
83
84libroot=
85installbin=/usr/local/bin
86gnu_malloc=yes
87lisp_float_type=yes
88
89# The default values for the following options are guessed at after other
90# options have been checked and given values, so we set them to null here.
91lisppath=""
92datadir=""
93libdir=""
94lockdir=""
95window_system=""
96have_x_menu=""
97
98# This must be the only option on the line, and it can't be abbreviated.
99# This keeps it from interfering with the other, documented options.
100if [ "$*" = "+distribute" ]; then
101 libroot=/usr/local/lib/emacs
102 machine=hp300bsd
103 opsystem=bsd4-3
104 shift
105fi
106
107echo "Examining options..."
108for arg in $*; do
109 case "${arg}" in
110 -*)
111 # Separate the switch name from the value it's being given.
112 case "${arg}" in
113 -*=* )
114 opt=`echo ${arg} | sed 's:^-\([^=]*\)=.*$:\1:'`
115 val=`echo ${arg} | sed 's:^-[^=]*=\(.*\)$:\1:'`
116 valomitted=no
117 ;;
118 -* )
119 # If FOO is a boolean argument, -FOO is equivalent to -FOO=yes.
120 opt=`echo ${arg} | sed 's:^-\(.*\)$:\1:'`
121 val="yes"
122 valomitted=yes
123 ;;
124 esac
125
126 # Make sure the argument is valid and unambiguous.
127 case ${options} in
128 *:${opt}:* ) # Exact match.
129 optvar=${opt}
130 ;;
131 *:${opt}*:${opt}*:* ) # Ambiguous prefix.
132 echo "\`-${opt}' is an ambiguous switch; it could be any of the following:"
133 echo `echo ${options} | tr ':' '\012' | grep '^'${opt}`
134 echo ${short_usage}
135 exit 1
136 ;;
137 *:${opt}*:* ) # Unambigous prefix.
138 optvar=`echo ${options} | sed 's/^.*:\('${opt}'[^:]*\):.*$/\1/'`
139 ;;
140 * )
141 (echo "\`-${opt}' is not a valid option."
142 echo "${short_usage}") | more
143 exit 1
144 ;;
145 esac
146
147 case "${optvar}" in
148 usage | help)
149 echo "${usage_message}" | more
150 exit 1
151 ;;
152 esac
153
154 # If the variable is supposed to be boolean, make sure the value
155 # given is either "yes" or "no". If not, make sure some value
156 # was given.
157 case "${boolean_opts}" in
158 *:${optvar}:* )
159 case "${val}" in
160 y | ye | yes ) val=yes ;;
161 n | no ) val=no ;;
162 * )
163 echo "The \`-${optvar}' option (\`-${opt}') is supposed to have a boolean
164 value - set it to either \`yes' or \`no'." 1>&2
165 exit 1
166 ;;
167 esac
168 ;;
169 *)
170 if [ "${valomitted}" = "yes" ]; then
171 (echo "${progname}: You must give a value for the \`-${opt}' option, as in
172 \`-${opt}=FOO'."
173 echo "${short_usage}") | more
174 exit 1
175 fi
176 ;;
177 esac
178
179 eval "${optvar}=\"${val}\""
180 ;;
181 *)
182 machine=${arg}
183 ;;
184 esac
185done
186
187if [ "${machine}" = "" ]; then
188 (echo "You must specify a machine name as an argument to ${progname}."
189 echo "${short_usage}") | more
190 exit 1
191fi
192
193echo "Checking machine..."
194machfile="m/${machine}.h"
195if [ ! -r src/${machfile} ]; then
196 echo "${progname}: Emacs has no configuration info for the machine called
197\`${machine}'. Look at etc/MACHINES for the names of machines
198that Emacs has been ported to." 1>&2
199 exit 1
200fi
201
202echo "Checking operating system..."
203if [ "${opsystem}" = "" ]; then
204
205 echo " No operating system explicitly specified."
206 echo " Guessing, based on machine..."
207 # Get the default operating system to go with the specified machine.
208 opsystem=`grep 'USUAL-OPSYS="' src/${machfile} \
209 | sed 's/^.*USUAL-OPSYS="\([^"]*\)".*$/\1/'`
210
211 if [ "${opsystem}" = "" ]; then
212 echo "${progname}: Emacs's configuration files don't suggest what operating
213system a \`${machine}' machine might run. Try specifying the
214operating system explicitly by passing ${progname} an
215\`-opsystem=SYSTEM-NAME' flag. Look at etc/MACHINES for the
216names of operating systems that Emacs has been ported to." 1>&2
217 exit 1
218 fi
219
220 if [ "${opsystem}" = "note" ]; then
221 echo "The \`${machine}' machine can be used with more than one operating
222system, and Emacs's configuration info isn't clever enough to figure
223out which one you're running. Run ${progname} with -machine and
224-opsystem arguments as specified below for the appropriate system.
225(This information comes from the file \`etc/MACHINES' - see that
226file for more detail.)
227
228" 1>&2
229 sed < src/${machfile} -e '1,/NOTE-START/d' -e '/NOTE-END/,$d' | more
230 echo
231 exit 1
232 fi
233
234 opsysfile="s/${opsystem}.h"
235 if [ ! -r src/${opsysfile} ]; then
236 echo "${progname}: Emacs's configuration files say that the default
237operating system for the machine \`${machine}' is \`${opsystem}',
238but there is no configuration file for \`${opsystem}', so Emacs's
239default info is screwed up. Try specifying the operating system
240explicitly by passing ${progname} an \`-opsystem=SYSTEM-NAME' flag." 1>&2
241 exit 1
242 fi
243else
244 opsysfile="s/${opsystem}.h"
245 if [ ! -r src/${opsysfile} ]; then
246 echo "${progname}: Emacs has no configuration info for the operating system
247\`${opsystem}'. Look at etc/MACHINES for the names of operating
248systems that Emacs has been ported to." 1>&2
249 exit 1
250 fi
251fi
252
253if [ "${libroot}" = "" ]; then
254 echo "Guessing library directory..."
255 libroot=`/bin/pwd`
256fi
257
258echo "Checking window system..."
259window_system="`echo ${window_system} | tr A-Z a-z`"
260case "${window_system}" in
261 "none" | "x11" | "x10" ) ;;
262 "x" ) window_system=x11 ;;
263 "" )
264 echo " No window system specifed. Looking for X Windows."
265 window_system=none
266 if [ -r /usr/lib/libX11.a -a -d /usr/include/X11 ]; then
267 window_system=x11
268 fi
269 ;;
270 * )
271 echo "The \`-window_system' option must be set to \`none' or \`X11'." 1>&2
272 exit 1
273 ;;
274esac
275
276case "${window_system}" in
277 x11 )
278 have_x_windows=yes
279 have_x11=yes
280 ;;
281 x10 )
282 have_x_windows=yes
283 have_x11=no
284 ;;
285 none )
286 have_x_windows=no
287 have_x11=no
288 ;;
289esac
290
291# What is the return type of a signal handler? We grep
292# /usr/include/signal.h for the declaration of the signal function.
293# Yuck.
294echo "Looking for return type of signal handler functions..."
295if [ -r /usr/include/signal.h ]; then
296 sigpattern='[ ]*([ ]*\*[ ]*signal[ ]*('
297 sigtype=void
298 if grep -s "int${sigpattern}" /usr/include/signal.h; then
299 sigtype=int
300 fi
301fi
302
303
304# Do the opsystem or machine files prohibit the use of the GNU malloc?
305echo "Checking to see if the GNU malloc routines are permissible..."
306if (cd ./src;grep SYSTEM_MALLOC ${opsysfile} ${machfile} > /dev/null); then
307 gnu_malloc=no
308 gnu_malloc_reason="
309 (The GNU allocators don't work with this machine and/or operating system.)"
310fi
311
312rel_alloc=${gnu_malloc}
313
314if [ "${have_x_menu}" = "" ]; then
315 have_x_menu=no
316fi
317
318if [ "${lisppath}" = "" ]; then
319 lisppath=${libroot}/local-lisp:${libroot}/lisp
320fi
321
322if [ "${datadir}" = "" ]; then
323 datadir=${libroot}/etc
324fi
325
326if [ "${libdir}" = "" ]; then
327 libdir=${libroot}/arch-lib
328fi
329
330if [ "${lockdir}" = "" ]; then
331 lockdir=${libroot}/lock
332fi
333
334echo "Checking for GCC..."
335case "${cc}" in
336 "" )
337 temppath=`echo $PATH | sed 's/^:/.:/
338 s/::/:.:/g
339 s/:$/:./
340 s/:/ /g'`
341 cc=`(
342 for dir in ${temppath}; do
343 if [ -f ${dir}/gcc ]; then echo gcc; exit 0; fi
344 done
345 echo cc
346 )`
347 ;;
348esac
349
350case "${O},${g},${cc}" in
351 ,,gcc ) O=yes; g=yes ;;
352 ,,* ) O=yes; g=no ;;
353esac
354
355echo "Guessing which libraries the lib-src programs will want,"
356echo " based on the machine- and system-dependent files..."
357echo '#include "src/'${machfile}'"
358#include "src/'${opsysfile}'"
359#ifndef LIBS_MACHINE
360#define LIBS_MACHINE
361#endif
362#ifndef LIBS_SYSTEM
363#define LIBS_SYSTEM
364#endif
365libsrc_libs=LIBS_MACHINE LIBS_SYSTEM
366' > config-tmp-$$.c
367eval `${cc} -E config-tmp-$$.c | grep 'libsrc_libs='`
368rm config-tmp-$$.c
369
370rm -f config.status
371set -e
372
373# Make the proper settings in the config file.
374echo "Making src/config.h from src/config.h-dist"
375if [ "${highpri}" != "" ]; then
376 highpri="(-${highpri})"
377fi
378case "${g}" in
379 "yes" ) c_switch_site="${c_switch_site} -g" ;;
380esac
381case "${O}" in
382 "yes" ) c_switch_site="${c_switch_site} -O" ;;
383esac
384sed_flags="-e 's:@machine@:${machfile}:'"
385sed_flags="${sed_flags} -e 's:@opsystem@:${opsysfile}:'"
386for flag in `echo ${config_h_opts} | tr ':' ' '`; do
387 cflagname=`echo ${flag} | tr a-z A-Z`
388 val=`eval echo '$'${flag}`
389 case ${val} in
390 no | "")
391 f="-e 's:.*#define ${cflagname}.*:/\\* #define ${cflagname} \\*/:'"
392 ;;
393 yes)
394 f="-e 's:.*#define ${cflagname}.*:#define ${cflagname}:'"
395 ;;
396 *)
397 f="-e 's:.*#define ${cflagname}.*:#define ${cflagname} ${val}:'"
398 ;;
399 esac
400 sed_flags="${sed_flags} ${f}"
401done
402eval '/bin/sed '${sed_flags}' < src/config.h-dist > src/config.h'
403
404# Modify the parameters in the top makefile.
405echo "Editing ./Makefile..."
406tempMakefile="tempMakefile"$$
407/bin/sed < Makefile > ${tempMakefile} \
408-e 's;^\(LIBROOT=\).*$;\1'"${libroot};" \
409-e 's;^\(INSTALLBIN=\).*$;\1'"${installbin};" \
410-e 's;^\(LISPPATH=\).*$;\1'"${lisppath};" \
411-e 's;^\(DATADIR=\).*$;\1'"${datadir};" \
412-e 's;^\(LOCKDIR=\).*$;\1'"${lockdir};" \
413-e 's;^\(LIBDIR=\).*$;\1'"${libdir};"
414mv ${tempMakefile} Makefile
415
416# Modify the parameters in the `build-install' script.
417echo "Editing ./build-install..."
418tempbi="tempbi"$$
419/bin/sed < build-install > ${tempbi} \
420-e 's;^\(LIBROOT=\).*$;\1'"${libroot};" \
421-e 's;^\(BINDIR=\).*$;\1'"${installbin};" \
422-e 's;^\(LISPPATH=\).*$;\1'"${lisppath};" \
423-e 's;^\(DATADIR=\).*$;\1'"${datadir};" \
424-e 's;^\(LOCKDIR=\).*$;\1'"${lockdir};" \
425-e 's;^\(LIBDIR=\).*$;\1'"${libdir};"
426mv ${tempbi} build-install
427chmod a+x build-install
428
429# Modify the parameters in the src makefile.
430echo "Editing src/Makefile..."
431tempMakefile="tempMakefile"$$
432/bin/sed < src/Makefile > ${tempMakefile} \
433-e 's;^\(CC[ ]*=\).*$;\1'"${cc};"
434mv ${tempMakefile} src/Makefile
435
436# Modify the parameters in the lib-src makefile.
437echo "Editing lib-src/Makefile..."
438tempMakefile="tempMakefile"$$
439/bin/sed < lib-src/Makefile > ${tempMakefile} \
440-e 's;^\(CFLAGS=\).*$;\1'"${c_switch_site};" \
441-e 's;^\(LOADLIBES=\).*$;\1'"${libsrc_libs};" \
442-e 's;^\(CC=\).*$;\1'"${cc};"
443mv ${tempMakefile} lib-src/Makefile
444
445# Document the damage we have done.
446echo
447echo "Configured for machine \`${machine}' running \`${opsystem}'.
448The following values have been set in ./Makefile and ./build-install:
449 Executables will be placed in
450 ${installbin}.
451 Emacs's lisp search path will be
452 \`${lisppath}'.
453 Emacs will look for its architecture-independent data in
454 ${datadir}.
455 Emacs will look for its utility programs and other architecture-
456 dependent data in
457 ${libdir}.
458 Emacs will keep track of file-locking in
459 ${lockdir}.
460The following values have been set in src/config.h:
461 At how much higher than normal priority should Emacs run? ${highpri-none}
462 Should Emacs use the GNU version of malloc? ${gnu_malloc}${gnu_malloc_reason}
463 Should Emacs use the relocating allocator for buffers? ${rel_alloc}
464 Should Emacs support a floating point Elisp type? ${lisp_float_type}
465 What window system should Emacs use? ${window_system}
466 Should Emacs support mouse menus, which require X11? ${have_x_menu}
467 What compiler should emacs be built with? ${cc}
468 Should the compilation use \`-g' and/or \`-O'? ${c_switch_site- neither}" \
469| tee config.status 1>&2
470
471exit 0
diff --git a/src/search.c b/src/search.c
new file mode 100644
index 00000000000..3f268c44010
--- /dev/null
+++ b/src/search.c
@@ -0,0 +1,1294 @@
1/* String search routines for GNU Emacs.
2 Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 1, or (at your option)
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the 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"
26#include <sys/types.h>
27#include "regex.h"
28
29#define max(a, b) ((a) > (b) ? (a) : (b))
30#define min(a, b) ((a) < (b) ? (a) : (b))
31
32/* We compile regexps into this buffer and then use it for searching. */
33
34struct re_pattern_buffer searchbuf;
35
36char search_fastmap[0400];
37
38/* Last regexp we compiled */
39
40Lisp_Object last_regexp;
41
42/* Every call to re_match, etc., must pass &search_regs as the regs argument
43 unless you can show it is unnecessary (i.e., if re_match is certainly going
44 to be called again before region-around-match can be called). */
45
46static struct re_registers search_regs;
47
48/* Nonzero if search_regs are indices in a string; 0 if in a buffer. */
49
50static int search_regs_from_string;
51
52/* error condition signalled when regexp compile_pattern fails */
53
54Lisp_Object Qinvalid_regexp;
55
56static void
57matcher_overflow ()
58{
59 error ("Stack overflow in regexp matcher");
60}
61
62#ifdef __STDC__
63#define CONST const
64#else
65#define CONST
66#endif
67
68/* Compile a regexp and signal a Lisp error if anything goes wrong. */
69
70compile_pattern (pattern, bufp, translate)
71 Lisp_Object pattern;
72 struct re_pattern_buffer *bufp;
73 char *translate;
74{
75 CONST char *val;
76 Lisp_Object dummy;
77
78 if (EQ (pattern, last_regexp)
79 && translate == bufp->translate)
80 return;
81 last_regexp = Qnil;
82 bufp->translate = translate;
83 val = re_compile_pattern ((char *) XSTRING (pattern)->data,
84 XSTRING (pattern)->size,
85 bufp);
86 if (val)
87 {
88 dummy = build_string (val);
89 while (1)
90 Fsignal (Qinvalid_regexp, Fcons (dummy, Qnil));
91 }
92 last_regexp = pattern;
93 return;
94}
95
96/* Error condition used for failing searches */
97Lisp_Object Qsearch_failed;
98
99Lisp_Object
100signal_failure (arg)
101 Lisp_Object arg;
102{
103 Fsignal (Qsearch_failed, Fcons (arg, Qnil));
104 return Qnil;
105}
106
107DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0,
108 "Return t if text after point matches regular expression PAT.")
109 (string)
110 Lisp_Object string;
111{
112 Lisp_Object val;
113 unsigned char *p1, *p2;
114 int s1, s2;
115 register int i;
116
117 CHECK_STRING (string, 0);
118 compile_pattern (string, &searchbuf,
119 !NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0);
120
121 immediate_quit = 1;
122 QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */
123
124 /* Get pointers and sizes of the two strings
125 that make up the visible portion of the buffer. */
126
127 p1 = BEGV_ADDR;
128 s1 = GPT - BEGV;
129 p2 = GAP_END_ADDR;
130 s2 = ZV - GPT;
131 if (s1 < 0)
132 {
133 p2 = p1;
134 s2 = ZV - BEGV;
135 s1 = 0;
136 }
137 if (s2 < 0)
138 {
139 s1 = ZV - BEGV;
140 s2 = 0;
141 }
142
143 i = re_match_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2,
144 point - BEGV, &search_regs,
145 ZV - BEGV);
146 if (i == -2)
147 matcher_overflow ();
148
149 val = (0 <= i ? Qt : Qnil);
150 for (i = 0; i < RE_NREGS; i++)
151 if (search_regs.start[i] >= 0)
152 {
153 search_regs.start[i] += BEGV;
154 search_regs.end[i] += BEGV;
155 }
156 search_regs_from_string = 0;
157 immediate_quit = 0;
158 return val;
159}
160
161DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0,
162 "Return index of start of first match for REGEXP in STRING, or nil.\n\
163If third arg START is non-nil, start search at that index in STRING.\n\
164For index of first char beyond the match, do (match-end 0).\n\
165`match-end' and `match-beginning' also give indices of substrings\n\
166matched by parenthesis constructs in the pattern.")
167 (regexp, string, start)
168 Lisp_Object regexp, string, start;
169{
170 int val;
171 int s;
172
173 CHECK_STRING (regexp, 0);
174 CHECK_STRING (string, 1);
175
176 if (NILP (start))
177 s = 0;
178 else
179 {
180 int len = XSTRING (string)->size;
181
182 CHECK_NUMBER (start, 2);
183 s = XINT (start);
184 if (s < 0 && -s <= len)
185 s = len - s;
186 else if (0 > s || s > len)
187 args_out_of_range (string, start);
188 }
189
190 compile_pattern (regexp, &searchbuf,
191 !NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0);
192 immediate_quit = 1;
193 val = re_search (&searchbuf, (char *) XSTRING (string)->data,
194 XSTRING (string)->size, s, XSTRING (string)->size - s,
195 &search_regs);
196 immediate_quit = 0;
197 search_regs_from_string = 1;
198 if (val == -2)
199 matcher_overflow ();
200 if (val < 0) return Qnil;
201 return make_number (val);
202}
203
204scan_buffer (target, pos, cnt, shortage)
205 int *shortage, pos;
206 register int cnt, target;
207{
208 int lim = ((cnt > 0) ? ZV - 1 : BEGV);
209 int direction = ((cnt > 0) ? 1 : -1);
210 register int lim0;
211 unsigned char *base;
212 register unsigned char *cursor, *limit;
213
214 if (shortage != 0)
215 *shortage = 0;
216
217 immediate_quit = 1;
218
219 if (cnt > 0)
220 while (pos != lim + 1)
221 {
222 lim0 = BUFFER_CEILING_OF (pos);
223 lim0 = min (lim, lim0);
224 limit = &FETCH_CHAR (lim0) + 1;
225 base = (cursor = &FETCH_CHAR (pos));
226 while (1)
227 {
228 while (*cursor != target && ++cursor != limit)
229 ;
230 if (cursor != limit)
231 {
232 if (--cnt == 0)
233 {
234 immediate_quit = 0;
235 return (pos + cursor - base + 1);
236 }
237 else
238 if (++cursor == limit)
239 break;
240 }
241 else
242 break;
243 }
244 pos += cursor - base;
245 }
246 else
247 {
248 pos--; /* first character we scan */
249 while (pos > lim - 1)
250 { /* we WILL scan under pos */
251 lim0 = BUFFER_FLOOR_OF (pos);
252 lim0 = max (lim, lim0);
253 limit = &FETCH_CHAR (lim0) - 1;
254 base = (cursor = &FETCH_CHAR (pos));
255 cursor++;
256 while (1)
257 {
258 while (--cursor != limit && *cursor != target)
259 ;
260 if (cursor != limit)
261 {
262 if (++cnt == 0)
263 {
264 immediate_quit = 0;
265 return (pos + cursor - base + 1);
266 }
267 }
268 else
269 break;
270 }
271 pos += cursor - base;
272 }
273 }
274 immediate_quit = 0;
275 if (shortage != 0)
276 *shortage = cnt * direction;
277 return (pos + ((direction == 1 ? 0 : 1)));
278}
279
280int
281find_next_newline (from, cnt)
282 register int from, cnt;
283{
284 return (scan_buffer ('\n', from, cnt, (int *) 0));
285}
286
287DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0,
288 "Move point forward, stopping before a char not in CHARS, or at position LIM.\n\
289CHARS is like the inside of a `[...]' in a regular expression\n\
290except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\
291Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\
292With arg \"^a-zA-Z\", skips nonletters stopping before first letter.")
293 (string, lim)
294 Lisp_Object string, lim;
295{
296 skip_chars (1, string, lim);
297 return Qnil;
298}
299
300DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0,
301 "Move point backward, stopping after a char not in CHARS, or at position LIM.\n\
302See `skip-chars-forward' for details.")
303 (string, lim)
304 Lisp_Object string, lim;
305{
306 skip_chars (0, string, lim);
307 return Qnil;
308}
309
310skip_chars (forwardp, string, lim)
311 int forwardp;
312 Lisp_Object string, lim;
313{
314 register unsigned char *p, *pend;
315 register unsigned char c;
316 unsigned char fastmap[0400];
317 int negate = 0;
318 register int i;
319
320 CHECK_STRING (string, 0);
321
322 if (NILP (lim))
323 XSET (lim, Lisp_Int, forwardp ? ZV : BEGV);
324 else
325 CHECK_NUMBER_COERCE_MARKER (lim, 1);
326
327#if 0 /* This breaks some things... jla. */
328 /* In any case, don't allow scan outside bounds of buffer. */
329 if (XFASTINT (lim) > ZV)
330 XFASTINT (lim) = ZV;
331 if (XFASTINT (lim) < BEGV)
332 XFASTINT (lim) = BEGV;
333#endif
334
335 p = XSTRING (string)->data;
336 pend = p + XSTRING (string)->size;
337 bzero (fastmap, sizeof fastmap);
338
339 if (p != pend && *p == '^')
340 {
341 negate = 1; p++;
342 }
343
344 /* Find the characters specified and set their elements of fastmap. */
345
346 while (p != pend)
347 {
348 c = *p++;
349 if (c == '\\')
350 {
351 if (p == pend) break;
352 c = *p++;
353 }
354 if (p != pend && *p == '-')
355 {
356 p++;
357 if (p == pend) break;
358 while (c <= *p)
359 {
360 fastmap[c] = 1;
361 c++;
362 }
363 p++;
364 }
365 else
366 fastmap[c] = 1;
367 }
368
369 /* If ^ was the first character, complement the fastmap. */
370
371 if (negate)
372 for (i = 0; i < sizeof fastmap; i++)
373 fastmap[i] ^= 1;
374
375 immediate_quit = 1;
376 if (forwardp)
377 {
378 while (point < XINT (lim) && fastmap[FETCH_CHAR (point)])
379 SET_PT (point + 1);
380 }
381 else
382 {
383 while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)])
384 SET_PT (point - 1);
385 }
386 immediate_quit = 0;
387}
388
389/* Subroutines of Lisp buffer search functions. */
390
391static Lisp_Object
392search_command (string, bound, noerror, count, direction, RE)
393 Lisp_Object string, bound, noerror, count;
394 int direction;
395 int RE;
396{
397 register int np;
398 int lim;
399 int n = direction;
400
401 if (!NILP (count))
402 {
403 CHECK_NUMBER (count, 3);
404 n *= XINT (count);
405 }
406
407 CHECK_STRING (string, 0);
408 if (NILP (bound))
409 lim = n > 0 ? ZV : BEGV;
410 else
411 {
412 CHECK_NUMBER_COERCE_MARKER (bound, 1);
413 lim = XINT (bound);
414 if (n > 0 ? lim < point : lim > point)
415 error ("Invalid search bound (wrong side of point)");
416 if (lim > ZV)
417 lim = ZV;
418 if (lim < BEGV)
419 lim = BEGV;
420 }
421
422 np = search_buffer (string, point, lim, n, RE,
423 (!NILP (current_buffer->case_fold_search)
424 ? XSTRING (current_buffer->case_canon_table)->data : 0),
425 (!NILP (current_buffer->case_fold_search)
426 ? XSTRING (current_buffer->case_eqv_table)->data : 0));
427 if (np <= 0)
428 {
429 if (NILP (noerror))
430 return signal_failure (string);
431 if (!EQ (noerror, Qt))
432 {
433 if (lim < BEGV || lim > ZV)
434 abort ();
435 SET_PT (lim);
436 }
437 return Qnil;
438 }
439
440 if (np < BEGV || np > ZV)
441 abort ();
442
443 SET_PT (np);
444
445 return make_number (np);
446}
447
448/* search for the n'th occurrence of STRING in the current buffer,
449 starting at position POS and stopping at position LIM,
450 treating PAT as a literal string if RE is false or as
451 a regular expression if RE is true.
452
453 If N is positive, searching is forward and LIM must be greater than POS.
454 If N is negative, searching is backward and LIM must be less than POS.
455
456 Returns -x if only N-x occurrences found (x > 0),
457 or else the position at the beginning of the Nth occurrence
458 (if searching backward) or the end (if searching forward). */
459
460search_buffer (string, pos, lim, n, RE, trt, inverse_trt)
461 Lisp_Object string;
462 int pos;
463 int lim;
464 int n;
465 int RE;
466 register unsigned char *trt;
467 register unsigned char *inverse_trt;
468{
469 int len = XSTRING (string)->size;
470 unsigned char *base_pat = XSTRING (string)->data;
471 register int *BM_tab;
472 int *BM_tab_base;
473 register int direction = ((n > 0) ? 1 : -1);
474 register int dirlen;
475 int infinity, limit, k, stride_for_teases;
476 register unsigned char *pat, *cursor, *p_limit;
477 register int i, j;
478 unsigned char *p1, *p2;
479 int s1, s2;
480
481 /* Null string is found at starting position. */
482 if (!len)
483 return pos;
484
485 if (RE)
486 compile_pattern (string, &searchbuf, (char *) trt);
487
488 if (RE /* Here we detect whether the */
489 /* generality of an RE search is */
490 /* really needed. */
491 /* first item is "exact match" */
492 && *(searchbuf.buffer) == RE_EXACTN_VALUE
493 && searchbuf.buffer[1] + 2 == searchbuf.used) /*first is ONLY item */
494 {
495 RE = 0; /* can do straight (non RE) search */
496 pat = (base_pat = (unsigned char *) searchbuf.buffer + 2);
497 /* trt already applied */
498 len = searchbuf.used - 2;
499 }
500 else if (!RE)
501 {
502 pat = (unsigned char *) alloca (len);
503
504 for (i = len; i--;) /* Copy the pattern; apply trt */
505 *pat++ = (((int) trt) ? trt [*base_pat++] : *base_pat++);
506 pat -= len; base_pat = pat;
507 }
508
509 if (RE)
510 {
511 immediate_quit = 1; /* Quit immediately if user types ^G,
512 because letting this function finish
513 can take too long. */
514 QUIT; /* Do a pending quit right away,
515 to avoid paradoxical behavior */
516 /* Get pointers and sizes of the two strings
517 that make up the visible portion of the buffer. */
518
519 p1 = BEGV_ADDR;
520 s1 = GPT - BEGV;
521 p2 = GAP_END_ADDR;
522 s2 = ZV - GPT;
523 if (s1 < 0)
524 {
525 p2 = p1;
526 s2 = ZV - BEGV;
527 s1 = 0;
528 }
529 if (s2 < 0)
530 {
531 s1 = ZV - BEGV;
532 s2 = 0;
533 }
534 while (n < 0)
535 {
536 int val = re_search_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2,
537 pos - BEGV, lim - pos, &search_regs,
538 /* Don't allow match past current point */
539 pos - BEGV);
540 if (val == -2)
541 matcher_overflow ();
542 if (val >= 0)
543 {
544 j = BEGV;
545 for (i = 0; i < RE_NREGS; i++)
546 if (search_regs.start[i] >= 0)
547 {
548 search_regs.start[i] += j;
549 search_regs.end[i] += j;
550 }
551 search_regs_from_string = 0;
552 /* Set pos to the new position. */
553 pos = search_regs.start[0];
554 }
555 else
556 {
557 immediate_quit = 0;
558 return (n);
559 }
560 n++;
561 }
562 while (n > 0)
563 {
564 int val = re_search_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2,
565 pos - BEGV, lim - pos, &search_regs,
566 lim - BEGV);
567 if (val == -2)
568 matcher_overflow ();
569 if (val >= 0)
570 {
571 j = BEGV;
572 for (i = 0; i < RE_NREGS; i++)
573 if (search_regs.start[i] >= 0)
574 {
575 search_regs.start[i] += j;
576 search_regs.end[i] += j;
577 }
578 search_regs_from_string = 0;
579 pos = search_regs.end[0];
580 }
581 else
582 {
583 immediate_quit = 0;
584 return (0 - n);
585 }
586 n--;
587 }
588 immediate_quit = 0;
589 return (pos);
590 }
591 else /* non-RE case */
592 {
593#ifdef C_ALLOCA
594 int BM_tab_space[0400];
595 BM_tab = &BM_tab_space[0];
596#else
597 BM_tab = (int *) alloca (0400 * sizeof (int));
598#endif
599 /* The general approach is that we are going to maintain that we know */
600 /* the first (closest to the present position, in whatever direction */
601 /* we're searching) character that could possibly be the last */
602 /* (furthest from present position) character of a valid match. We */
603 /* advance the state of our knowledge by looking at that character */
604 /* and seeing whether it indeed matches the last character of the */
605 /* pattern. If it does, we take a closer look. If it does not, we */
606 /* move our pointer (to putative last characters) as far as is */
607 /* logically possible. This amount of movement, which I call a */
608 /* stride, will be the length of the pattern if the actual character */
609 /* appears nowhere in the pattern, otherwise it will be the distance */
610 /* from the last occurrence of that character to the end of the */
611 /* pattern. */
612 /* As a coding trick, an enormous stride is coded into the table for */
613 /* characters that match the last character. This allows use of only */
614 /* a single test, a test for having gone past the end of the */
615 /* permissible match region, to test for both possible matches (when */
616 /* the stride goes past the end immediately) and failure to */
617 /* match (where you get nudged past the end one stride at a time). */
618
619 /* Here we make a "mickey mouse" BM table. The stride of the search */
620 /* is determined only by the last character of the putative match. */
621 /* If that character does not match, we will stride the proper */
622 /* distance to propose a match that superimposes it on the last */
623 /* instance of a character that matches it (per trt), or misses */
624 /* it entirely if there is none. */
625
626 dirlen = len * direction;
627 infinity = dirlen - (lim + pos + len + len) * direction;
628 if (direction < 0)
629 pat = (base_pat += len - 1);
630 BM_tab_base = BM_tab;
631 BM_tab += 0400;
632 j = dirlen; /* to get it in a register */
633 /* A character that does not appear in the pattern induces a */
634 /* stride equal to the pattern length. */
635 while (BM_tab_base != BM_tab)
636 {
637 *--BM_tab = j;
638 *--BM_tab = j;
639 *--BM_tab = j;
640 *--BM_tab = j;
641 }
642 i = 0;
643 while (i != infinity)
644 {
645 j = pat[i]; i += direction;
646 if (i == dirlen) i = infinity;
647 if ((int) trt)
648 {
649 k = (j = trt[j]);
650 if (i == infinity)
651 stride_for_teases = BM_tab[j];
652 BM_tab[j] = dirlen - i;
653 /* A translation table is accompanied by its inverse -- see */
654 /* comment following downcase_table for details */
655 while ((j = inverse_trt[j]) != k)
656 BM_tab[j] = dirlen - i;
657 }
658 else
659 {
660 if (i == infinity)
661 stride_for_teases = BM_tab[j];
662 BM_tab[j] = dirlen - i;
663 }
664 /* stride_for_teases tells how much to stride if we get a */
665 /* match on the far character but are subsequently */
666 /* disappointed, by recording what the stride would have been */
667 /* for that character if the last character had been */
668 /* different. */
669 }
670 infinity = dirlen - infinity;
671 pos += dirlen - ((direction > 0) ? direction : 0);
672 /* loop invariant - pos points at where last char (first char if reverse)
673 of pattern would align in a possible match. */
674 while (n != 0)
675 {
676 if ((lim - pos - (direction > 0)) * direction < 0)
677 return (n * (0 - direction));
678 /* First we do the part we can by pointers (maybe nothing) */
679 QUIT;
680 pat = base_pat;
681 limit = pos - dirlen + direction;
682 limit = ((direction > 0)
683 ? BUFFER_CEILING_OF (limit)
684 : BUFFER_FLOOR_OF (limit));
685 /* LIMIT is now the last (not beyond-last!) value
686 POS can take on without hitting edge of buffer or the gap. */
687 limit = ((direction > 0)
688 ? min (lim - 1, min (limit, pos + 20000))
689 : max (lim, max (limit, pos - 20000)));
690 if ((limit - pos) * direction > 20)
691 {
692 p_limit = &FETCH_CHAR (limit);
693 p2 = (cursor = &FETCH_CHAR (pos));
694 /* In this loop, pos + cursor - p2 is the surrogate for pos */
695 while (1) /* use one cursor setting as long as i can */
696 {
697 if (direction > 0) /* worth duplicating */
698 {
699 /* Use signed comparison if appropriate
700 to make cursor+infinity sure to be > p_limit.
701 Assuming that the buffer lies in a range of addresses
702 that are all "positive" (as ints) or all "negative",
703 either kind of comparison will work as long
704 as we don't step by infinity. So pick the kind
705 that works when we do step by infinity. */
706 if ((int) (p_limit + infinity) > (int) p_limit)
707 while ((int) cursor <= (int) p_limit)
708 cursor += BM_tab[*cursor];
709 else
710 while ((unsigned int) cursor <= (unsigned int) p_limit)
711 cursor += BM_tab[*cursor];
712 }
713 else
714 {
715 if ((int) (p_limit + infinity) < (int) p_limit)
716 while ((int) cursor >= (int) p_limit)
717 cursor += BM_tab[*cursor];
718 else
719 while ((unsigned int) cursor >= (unsigned int) p_limit)
720 cursor += BM_tab[*cursor];
721 }
722/* If you are here, cursor is beyond the end of the searched region. */
723 /* This can happen if you match on the far character of the pattern, */
724 /* because the "stride" of that character is infinity, a number able */
725 /* to throw you well beyond the end of the search. It can also */
726 /* happen if you fail to match within the permitted region and would */
727 /* otherwise try a character beyond that region */
728 if ((cursor - p_limit) * direction <= len)
729 break; /* a small overrun is genuine */
730 cursor -= infinity; /* large overrun = hit */
731 i = dirlen - direction;
732 if ((int) trt)
733 {
734 while ((i -= direction) + direction != 0)
735 if (pat[i] != trt[*(cursor -= direction)])
736 break;
737 }
738 else
739 {
740 while ((i -= direction) + direction != 0)
741 if (pat[i] != *(cursor -= direction))
742 break;
743 }
744 cursor += dirlen - i - direction; /* fix cursor */
745 if (i + direction == 0)
746 {
747 cursor -= direction;
748 search_regs.start[0]
749 = pos + cursor - p2 + ((direction > 0)
750 ? 1 - len : 0);
751 search_regs.end[0] = len + search_regs.start[0];
752 search_regs_from_string = 0;
753 if ((n -= direction) != 0)
754 cursor += dirlen; /* to resume search */
755 else
756 return ((direction > 0)
757 ? search_regs.end[0] : search_regs.start[0]);
758 }
759 else
760 cursor += stride_for_teases; /* <sigh> we lose - */
761 }
762 pos += cursor - p2;
763 }
764 else
765 /* Now we'll pick up a clump that has to be done the hard */
766 /* way because it covers a discontinuity */
767 {
768 limit = ((direction > 0)
769 ? BUFFER_CEILING_OF (pos - dirlen + 1)
770 : BUFFER_FLOOR_OF (pos - dirlen - 1));
771 limit = ((direction > 0)
772 ? min (limit + len, lim - 1)
773 : max (limit - len, lim));
774 /* LIMIT is now the last value POS can have
775 and still be valid for a possible match. */
776 while (1)
777 {
778 /* This loop can be coded for space rather than */
779 /* speed because it will usually run only once. */
780 /* (the reach is at most len + 21, and typically */
781 /* does not exceed len) */
782 while ((limit - pos) * direction >= 0)
783 pos += BM_tab[FETCH_CHAR(pos)];
784 /* now run the same tests to distinguish going off the */
785 /* end, a match or a phoney match. */
786 if ((pos - limit) * direction <= len)
787 break; /* ran off the end */
788 /* Found what might be a match.
789 Set POS back to last (first if reverse) char pos. */
790 pos -= infinity;
791 i = dirlen - direction;
792 while ((i -= direction) + direction != 0)
793 {
794 pos -= direction;
795 if (pat[i] != (((int) trt)
796 ? trt[FETCH_CHAR(pos)]
797 : FETCH_CHAR (pos)))
798 break;
799 }
800 /* Above loop has moved POS part or all the way
801 back to the first char pos (last char pos if reverse).
802 Set it once again at the last (first if reverse) char. */
803 pos += dirlen - i- direction;
804 if (i + direction == 0)
805 {
806 pos -= direction;
807 search_regs.start[0]
808 = pos + ((direction > 0) ? 1 - len : 0);
809 search_regs.end[0] = len + search_regs.start[0];
810 search_regs_from_string = 0;
811 if ((n -= direction) != 0)
812 pos += dirlen; /* to resume search */
813 else
814 return ((direction > 0)
815 ? search_regs.end[0] : search_regs.start[0]);
816 }
817 else
818 pos += stride_for_teases;
819 }
820 }
821 /* We have done one clump. Can we continue? */
822 if ((lim - pos) * direction < 0)
823 return ((0 - n) * direction);
824 }
825 return pos;
826 }
827}
828
829/* Given a string of words separated by word delimiters,
830 compute a regexp that matches those exact words
831 separated by arbitrary punctuation. */
832
833static Lisp_Object
834wordify (string)
835 Lisp_Object string;
836{
837 register unsigned char *p, *o;
838 register int i, len, punct_count = 0, word_count = 0;
839 Lisp_Object val;
840
841 CHECK_STRING (string, 0);
842 p = XSTRING (string)->data;
843 len = XSTRING (string)->size;
844
845 for (i = 0; i < len; i++)
846 if (SYNTAX (p[i]) != Sword)
847 {
848 punct_count++;
849 if (i > 0 && SYNTAX (p[i-1]) == Sword) word_count++;
850 }
851 if (SYNTAX (p[len-1]) == Sword) word_count++;
852 if (!word_count) return build_string ("");
853
854 val = make_string (p, len - punct_count + 5 * (word_count - 1) + 4);
855
856 o = XSTRING (val)->data;
857 *o++ = '\\';
858 *o++ = 'b';
859
860 for (i = 0; i < len; i++)
861 if (SYNTAX (p[i]) == Sword)
862 *o++ = p[i];
863 else if (i > 0 && SYNTAX (p[i-1]) == Sword && --word_count)
864 {
865 *o++ = '\\';
866 *o++ = 'W';
867 *o++ = '\\';
868 *o++ = 'W';
869 *o++ = '*';
870 }
871
872 *o++ = '\\';
873 *o++ = 'b';
874
875 return val;
876}
877
878DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4,
879 "sSearch backward: ",
880 "Search backward from point for STRING.\n\
881Set point to the beginning of the occurrence found, and return point.\n\
882An optional second argument bounds the search; it is a buffer position.\n\
883The match found must not extend before that position.\n\
884Optional third argument, if t, means if fail just return nil (no error).\n\
885 If not nil and not t, position at limit of search and return nil.\n\
886Optional fourth argument is repeat count--search for successive occurrences.\n\
887See also the functions `match-beginning', `match-end' and `replace-match'.")
888 (string, bound, noerror, count)
889 Lisp_Object string, bound, noerror, count;
890{
891 return search_command (string, bound, noerror, count, -1, 0);
892}
893
894DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "sSearch: ",
895 "Search forward from point for STRING.\n\
896Set point to the end of the occurrence found, and return point.\n\
897An optional second argument bounds the search; it is a buffer position.\n\
898The match found must not extend after that position. nil is equivalent\n\
899 to (point-max).\n\
900Optional third argument, if t, means if fail just return nil (no error).\n\
901 If not nil and not t, move to limit of search and return nil.\n\
902Optional fourth argument is repeat count--search for successive occurrences.\n\
903See also the functions `match-beginning', `match-end' and `replace-match'.")
904 (string, bound, noerror, count)
905 Lisp_Object string, bound, noerror, count;
906{
907 return search_command (string, bound, noerror, count, 1, 0);
908}
909
910DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4,
911 "sWord search backward: ",
912 "Search backward from point for STRING, ignoring differences in punctuation.\n\
913Set point to the beginning of the occurrence found, and return point.\n\
914An optional second argument bounds the search; it is a buffer position.\n\
915The match found must not extend before that position.\n\
916Optional third argument, if t, means if fail just return nil (no error).\n\
917 If not nil and not t, move to limit of search and return nil.\n\
918Optional fourth argument is repeat count--search for successive occurrences.")
919 (string, bound, noerror, count)
920 Lisp_Object string, bound, noerror, count;
921{
922 return search_command (wordify (string), bound, noerror, count, -1, 1);
923}
924
925DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4,
926 "sWord search: ",
927 "Search forward from point for STRING, ignoring differences in punctuation.\n\
928Set point to the end of the occurrence found, and return point.\n\
929An optional second argument bounds the search; it is a buffer position.\n\
930The match found must not extend after that position.\n\
931Optional third argument, if t, means if fail just return nil (no error).\n\
932 If not nil and not t, move to limit of search and return nil.\n\
933Optional fourth argument is repeat count--search for successive occurrences.")
934 (string, bound, noerror, count)
935 Lisp_Object string, bound, noerror, count;
936{
937 return search_command (wordify (string), bound, noerror, count, 1, 1);
938}
939
940DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4,
941 "sRE search backward: ",
942 "Search backward from point for match for regular expression REGEXP.\n\
943Set point to the beginning of the match, and return point.\n\
944The match found is the one starting last in the buffer\n\
945and yet ending before the place the origin of the search.\n\
946An optional second argument bounds the search; it is a buffer position.\n\
947The match found must start at or after that position.\n\
948Optional third argument, if t, means if fail just return nil (no error).\n\
949 If not nil and not t, move to limit of search and return nil.\n\
950Optional fourth argument is repeat count--search for successive occurrences.\n\
951See also the functions `match-beginning', `match-end' and `replace-match'.")
952 (string, bound, noerror, count)
953 Lisp_Object string, bound, noerror, count;
954{
955 return search_command (string, bound, noerror, count, -1, 1);
956}
957
958DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4,
959 "sRE search: ",
960 "Search forward from point for regular expression REGEXP.\n\
961Set point to the end of the occurrence found, and return point.\n\
962An optional second argument bounds the search; it is a buffer position.\n\
963The match found must not extend after that position.\n\
964Optional third argument, if t, means if fail just return nil (no error).\n\
965 If not nil and not t, move to limit of search and return nil.\n\
966Optional fourth argument is repeat count--search for successive occurrences.\n\
967See also the functions `match-beginning', `match-end' and `replace-match'.")
968 (string, bound, noerror, count)
969 Lisp_Object string, bound, noerror, count;
970{
971 return search_command (string, bound, noerror, count, 1, 1);
972}
973
974DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 3, 0,
975 "Replace text matched by last search with NEWTEXT.\n\
976If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\
977Otherwise convert to all caps or cap initials, like replaced text.\n\
978If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\
979Otherwise treat `\\' as special:\n\
980 `\\&' in NEWTEXT means substitute original matched text.\n\
981 `\\N' means substitute what matched the Nth `\\(...\\)'.\n\
982 If Nth parens didn't match, substitute nothing.\n\
983 `\\\\' means insert one `\\'.\n\
984Leaves point at end of replacement text.")
985 (string, fixedcase, literal)
986 Lisp_Object string, fixedcase, literal;
987{
988 enum { nochange, all_caps, cap_initial } case_action;
989 register int pos, last;
990 int some_multiletter_word;
991 int some_letter = 0;
992 register int c, prevc;
993 int inslen;
994
995 CHECK_STRING (string, 0);
996
997 case_action = nochange; /* We tried an initialization */
998 /* but some C compilers blew it */
999 if (search_regs.start[0] < BEGV
1000 || search_regs.start[0] > search_regs.end[0]
1001 || search_regs.end[0] > ZV)
1002 args_out_of_range(make_number (search_regs.start[0]),
1003 make_number (search_regs.end[0]));
1004
1005 if (NILP (fixedcase))
1006 {
1007 /* Decide how to casify by examining the matched text. */
1008
1009 last = search_regs.end[0];
1010 prevc = '\n';
1011 case_action = all_caps;
1012
1013 /* some_multiletter_word is set nonzero if any original word
1014 is more than one letter long. */
1015 some_multiletter_word = 0;
1016
1017 for (pos = search_regs.start[0]; pos < last; pos++)
1018 {
1019 c = FETCH_CHAR (pos);
1020 if (LOWERCASEP (c))
1021 {
1022 /* Cannot be all caps if any original char is lower case */
1023
1024 case_action = cap_initial;
1025 if (SYNTAX (prevc) != Sword)
1026 {
1027 /* Cannot even be cap initials
1028 if some original initial is lower case */
1029 case_action = nochange;
1030 break;
1031 }
1032 else
1033 some_multiletter_word = 1;
1034 }
1035 else if (!NOCASEP (c))
1036 {
1037 some_letter = 1;
1038 if (!some_multiletter_word && SYNTAX (prevc) == Sword)
1039 some_multiletter_word = 1;
1040 }
1041
1042 prevc = c;
1043 }
1044
1045 /* Do not make new text all caps
1046 if the original text contained only single letter words. */
1047 if (case_action == all_caps && !some_multiletter_word)
1048 case_action = cap_initial;
1049
1050 if (!some_letter) case_action = nochange;
1051 }
1052
1053 SET_PT (search_regs.end[0]);
1054 if (!NILP (literal))
1055 Finsert (1, &string);
1056 else
1057 {
1058 struct gcpro gcpro1;
1059 GCPRO1 (string);
1060
1061 for (pos = 0; pos < XSTRING (string)->size; pos++)
1062 {
1063 c = XSTRING (string)->data[pos];
1064 if (c == '\\')
1065 {
1066 c = XSTRING (string)->data[++pos];
1067 if (c == '&')
1068 Finsert_buffer_substring (Fcurrent_buffer (),
1069 make_number (search_regs.start[0]),
1070 make_number (search_regs.end[0]));
1071 else if (c >= '1' && c <= RE_NREGS + '0')
1072 {
1073 if (search_regs.start[c - '0'] >= 1)
1074 Finsert_buffer_substring (Fcurrent_buffer (),
1075 make_number (search_regs.start[c - '0']),
1076 make_number (search_regs.end[c - '0']));
1077 }
1078 else
1079 insert_char (c);
1080 }
1081 else
1082 insert_char (c);
1083 }
1084 UNGCPRO;
1085 }
1086
1087 inslen = point - (search_regs.end[0]);
1088 del_range (search_regs.start[0], search_regs.end[0]);
1089
1090 if (case_action == all_caps)
1091 Fupcase_region (make_number (point - inslen), make_number (point));
1092 else if (case_action == cap_initial)
1093 upcase_initials_region (make_number (point - inslen), make_number (point));
1094 return Qnil;
1095}
1096
1097static Lisp_Object
1098match_limit (num, beginningp)
1099 Lisp_Object num;
1100 int beginningp;
1101{
1102 register int n;
1103
1104 CHECK_NUMBER (num, 0);
1105 n = XINT (num);
1106 if (n < 0 || n >= RE_NREGS)
1107 args_out_of_range (num, make_number (RE_NREGS));
1108 if (search_regs.start[n] < 0)
1109 return Qnil;
1110 return (make_number ((beginningp) ? search_regs.start[n]
1111 : search_regs.end[n]));
1112}
1113
1114DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0,
1115 "Return position of start of text matched by last search.\n\
1116ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1117 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1118Zero means the entire text matched by the whole regexp or whole string.")
1119 (num)
1120 Lisp_Object num;
1121{
1122 return match_limit (num, 1);
1123}
1124
1125DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0,
1126 "Return position of end of text matched by last search.\n\
1127ARG, a number, specifies which parenthesized expression in the last regexp.\n\
1128 Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\
1129Zero means the entire text matched by the whole regexp or whole string.")
1130 (num)
1131 Lisp_Object num;
1132{
1133 return match_limit (num, 0);
1134}
1135
1136DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0,
1137 "Return a list containing all info on what the last search matched.\n\
1138Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\
1139All the elements are markers or nil (nil if the Nth pair didn't match)\n\
1140if the last match was on a buffer; integers or nil if a string was matched.\n\
1141Use `store-match-data' to reinstate the data in this list.")
1142 ()
1143{
1144 Lisp_Object data[2 * RE_NREGS];
1145 int i, len;
1146
1147 len = -1;
1148 for (i = 0; i < RE_NREGS; i++)
1149 {
1150 int start = search_regs.start[i];
1151 if (start >= 0)
1152 {
1153 if (search_regs_from_string)
1154 {
1155 XFASTINT (data[2 * i]) = start;
1156 XFASTINT (data[2 * i + 1]) = search_regs.end[i];
1157 }
1158 else
1159 {
1160 data[2 * i] = Fmake_marker ();
1161 Fset_marker (data[2 * i], make_number (start), Qnil);
1162 data[2 * i + 1] = Fmake_marker ();
1163 Fset_marker (data[2 * i + 1],
1164 make_number (search_regs.end[i]), Qnil);
1165 }
1166 len = i;
1167 }
1168 else
1169 data[2 * i] = data [2 * i + 1] = Qnil;
1170 }
1171 return Flist (2 * len + 2, data);
1172}
1173
1174
1175DEFUN ("store-match-data", Fstore_match_data, Sstore_match_data, 1, 1, 0,
1176 "Set internal data on last search match from elements of LIST.\n\
1177LIST should have been created by calling `match-data' previously.")
1178 (list)
1179 register Lisp_Object list;
1180{
1181 register int i;
1182 register Lisp_Object marker;
1183
1184 if (!CONSP (list) && !NILP (list))
1185 list = wrong_type_argument (Qconsp, list, 0);
1186
1187 for (i = 0; i < RE_NREGS; i++)
1188 {
1189 marker = Fcar (list);
1190 if (NILP (marker))
1191 {
1192 search_regs.start[i] = -1;
1193 list = Fcdr (list);
1194 }
1195 else
1196 {
1197 if (XTYPE (marker) == Lisp_Marker
1198 && XMARKER (marker)->buffer == 0)
1199 XFASTINT (marker) = 0;
1200
1201 CHECK_NUMBER_COERCE_MARKER (marker, 0);
1202 search_regs.start[i] = XINT (marker);
1203 list = Fcdr (list);
1204
1205 marker = Fcar (list);
1206 if (XTYPE (marker) == Lisp_Marker
1207 && XMARKER (marker)->buffer == 0)
1208 XFASTINT (marker) = 0;
1209
1210 CHECK_NUMBER_COERCE_MARKER (marker, 0);
1211 search_regs.end[i] = XINT (marker);
1212 }
1213 list = Fcdr (list);
1214 }
1215
1216 return Qnil;
1217}
1218
1219/* Quote a string to inactivate reg-expr chars */
1220
1221DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0,
1222 "Return a regexp string which matches exactly STRING and nothing else.")
1223 (str)
1224 Lisp_Object str;
1225{
1226 register unsigned char *in, *out, *end;
1227 register unsigned char *temp;
1228
1229 CHECK_STRING (str, 0);
1230
1231 temp = (unsigned char *) alloca (XSTRING (str)->size * 2);
1232
1233 /* Now copy the data into the new string, inserting escapes. */
1234
1235 in = XSTRING (str)->data;
1236 end = in + XSTRING (str)->size;
1237 out = temp;
1238
1239 for (; in != end; in++)
1240 {
1241 if (*in == '[' || *in == ']'
1242 || *in == '*' || *in == '.' || *in == '\\'
1243 || *in == '?' || *in == '+'
1244 || *in == '^' || *in == '$')
1245 *out++ = '\\';
1246 *out++ = *in;
1247 }
1248
1249 return make_string (temp, out - temp);
1250}
1251
1252syms_of_search ()
1253{
1254 register int i;
1255
1256 searchbuf.allocated = 100;
1257 searchbuf.buffer = (char *) malloc (searchbuf.allocated);
1258 searchbuf.fastmap = search_fastmap;
1259
1260 Qsearch_failed = intern ("search-failed");
1261 staticpro (&Qsearch_failed);
1262 Qinvalid_regexp = intern ("invalid-regexp");
1263 staticpro (&Qinvalid_regexp);
1264
1265 Fput (Qsearch_failed, Qerror_conditions,
1266 Fcons (Qsearch_failed, Fcons (Qerror, Qnil)));
1267 Fput (Qsearch_failed, Qerror_message,
1268 build_string ("Search failed"));
1269
1270 Fput (Qinvalid_regexp, Qerror_conditions,
1271 Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil)));
1272 Fput (Qinvalid_regexp, Qerror_message,
1273 build_string ("Invalid regexp"));
1274
1275 last_regexp = Qnil;
1276 staticpro (&last_regexp);
1277
1278 defsubr (&Sstring_match);
1279 defsubr (&Slooking_at);
1280 defsubr (&Sskip_chars_forward);
1281 defsubr (&Sskip_chars_backward);
1282 defsubr (&Ssearch_forward);
1283 defsubr (&Ssearch_backward);
1284 defsubr (&Sword_search_forward);
1285 defsubr (&Sword_search_backward);
1286 defsubr (&Sre_search_forward);
1287 defsubr (&Sre_search_backward);
1288 defsubr (&Sreplace_match);
1289 defsubr (&Smatch_beginning);
1290 defsubr (&Smatch_end);
1291 defsubr (&Smatch_data);
1292 defsubr (&Sstore_match_data);
1293 defsubr (&Sregexp_quote);
1294}