Mercurial > emacs
changeset 603:470f556a9453
Initial revision
| author | Jim Blandy <jimb@redhat.com> |
|---|---|
| date | Wed, 01 Apr 1992 10:45:51 +0000 |
| parents | d2de231ee7f5 |
| children | 63a8e7b3c547 |
| files | configure1.in src/search.c |
| diffstat | 2 files changed, 1765 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/configure1.in Wed Apr 01 10:45:51 1992 +0000 @@ -0,0 +1,471 @@ +#!/bin/sh +# Configuration script for GNU Emacs +# Copyright (C) 1992 Free Software Foundation, Inc. + +#This file is part of GNU Emacs. + +#GNU Emacs is free software; you can redistribute it and/or modify +#it under the terms of the GNU General Public License as published by +#the Free Software Foundation; either version 1, or (at your option) +#any later version. + +#GNU Emacs is distributed in the hope that it will be useful, +#but WITHOUT ANY WARRANTY; without even the implied warranty of +#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +#GNU General Public License for more details. + +#You should have received a copy of the GNU General Public License +#along with GNU Emacs; see the file COPYING. If not, write to +#the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +# Shell script to edit files and make symlinks in preparation for +# compiling Emacs. +# +# Usage: configure machine +# +# If configure succeeds, it leaves its status in config.status. +# If configure fails after disturbing the status quo, +# config.status is removed. +# + +progname=$0 + +short_usage="Type \`${progname} -usage' for more information about options." + +usage_message="Usage: ${progname} MACHINENAME [-OPTION[=VALUE] ...] +Set compilation and installation parameters for GNU Emacs, and report. +MACHINENAME is the machine to build for. See \`etc/MACHINES'. +Options are: + -opsystem=SYSTEM - operating system to build for; see \`etc/MACHINES'. + -libroot=DIR - where to install Emacs's library files +These options have reasonable defaults (in []s), and may not be needed: + -g, -O - Passed to the compiler. If omitted, use -O only. + -cc=COMPILER - Which compiler to use. Defaults to gcc if available. + -libdir=DIR - where to look for arch-dependent library files + -datadir=DIR - where to look for architecture-independent library files + -installbin=DIR - where to install the Emacs executable, and some friends + -lisppath=PATH - colon-separated list of Elisp directories + -lockdir=DIR - where Emacs should do its file-locking stuff + -window_system=none or [x11, if it is installed] - what window system to use + -have_x_menu=yes or [no] - include menu support under X11 + -gnu_malloc=[yes] or no - use the GNU memory allocator + -rel_alloc=[yes] or no - use compacting allocator for buffers + -highpri=N - run at N points higher-than-normal priority + -lisp_float_type=[yes] or no - Support floating point in Elisp +If successful, ${progname} leaves its status in config.status. If +unsuccessful after disturbing the status quo, config.status is removed." + +if [ ! -r ./src/lisp.h ]; then + echo "${progname}: Can't find Emacs sources in \`./src'. +Run this config script in the top directory of the Emacs source tree." 1>&2 + exit 1 +fi + +options=":\ +usage:help:\ +machine:opsystem:\ +g:O:cc:\ +libroot:datadir:libdir:installbin:lisppath:lockdir:\ +gnu_malloc:rel_alloc:highpri:lisp_float_type:\ +window_system:have_x_menu:\ +" + +boolean_opts=":\ +g:O:\ +gnu_malloc:rel_alloc:lisp_float_type:have_x_menu:\ +" + +config_h_opts=":\ +highpri:gnu_malloc:rel_alloc:lisp_float_type:\ +have_x_windows:have_x11:have_x_menu:\ +c_switch_site:sigtype:\ +" + +libroot= +installbin=/usr/local/bin +gnu_malloc=yes +lisp_float_type=yes + +# The default values for the following options are guessed at after other +# options have been checked and given values, so we set them to null here. +lisppath="" +datadir="" +libdir="" +lockdir="" +window_system="" +have_x_menu="" + +# This must be the only option on the line, and it can't be abbreviated. +# This keeps it from interfering with the other, documented options. +if [ "$*" = "+distribute" ]; then + libroot=/usr/local/lib/emacs + machine=hp300bsd + opsystem=bsd4-3 + shift +fi + +echo "Examining options..." +for arg in $*; do + case "${arg}" in + -*) + # Separate the switch name from the value it's being given. + case "${arg}" in + -*=* ) + opt=`echo ${arg} | sed 's:^-\([^=]*\)=.*$:\1:'` + val=`echo ${arg} | sed 's:^-[^=]*=\(.*\)$:\1:'` + valomitted=no + ;; + -* ) + # If FOO is a boolean argument, -FOO is equivalent to -FOO=yes. + opt=`echo ${arg} | sed 's:^-\(.*\)$:\1:'` + val="yes" + valomitted=yes + ;; + esac + + # Make sure the argument is valid and unambiguous. + case ${options} in + *:${opt}:* ) # Exact match. + optvar=${opt} + ;; + *:${opt}*:${opt}*:* ) # Ambiguous prefix. + echo "\`-${opt}' is an ambiguous switch; it could be any of the following:" + echo `echo ${options} | tr ':' '\012' | grep '^'${opt}` + echo ${short_usage} + exit 1 + ;; + *:${opt}*:* ) # Unambigous prefix. + optvar=`echo ${options} | sed 's/^.*:\('${opt}'[^:]*\):.*$/\1/'` + ;; + * ) + (echo "\`-${opt}' is not a valid option." + echo "${short_usage}") | more + exit 1 + ;; + esac + + case "${optvar}" in + usage | help) + echo "${usage_message}" | more + exit 1 + ;; + esac + + # If the variable is supposed to be boolean, make sure the value + # given is either "yes" or "no". If not, make sure some value + # was given. + case "${boolean_opts}" in + *:${optvar}:* ) + case "${val}" in + y | ye | yes ) val=yes ;; + n | no ) val=no ;; + * ) + echo "The \`-${optvar}' option (\`-${opt}') is supposed to have a boolean + value - set it to either \`yes' or \`no'." 1>&2 + exit 1 + ;; + esac + ;; + *) + if [ "${valomitted}" = "yes" ]; then + (echo "${progname}: You must give a value for the \`-${opt}' option, as in + \`-${opt}=FOO'." + echo "${short_usage}") | more + exit 1 + fi + ;; + esac + + eval "${optvar}=\"${val}\"" + ;; + *) + machine=${arg} + ;; + esac +done + +if [ "${machine}" = "" ]; then + (echo "You must specify a machine name as an argument to ${progname}." + echo "${short_usage}") | more + exit 1 +fi + +echo "Checking machine..." +machfile="m/${machine}.h" +if [ ! -r src/${machfile} ]; then + echo "${progname}: Emacs has no configuration info for the machine called +\`${machine}'. Look at etc/MACHINES for the names of machines +that Emacs has been ported to." 1>&2 + exit 1 +fi + +echo "Checking operating system..." +if [ "${opsystem}" = "" ]; then + + echo " No operating system explicitly specified." + echo " Guessing, based on machine..." + # Get the default operating system to go with the specified machine. + opsystem=`grep 'USUAL-OPSYS="' src/${machfile} \ + | sed 's/^.*USUAL-OPSYS="\([^"]*\)".*$/\1/'` + + if [ "${opsystem}" = "" ]; then + echo "${progname}: Emacs's configuration files don't suggest what operating +system a \`${machine}' machine might run. Try specifying the +operating system explicitly by passing ${progname} an +\`-opsystem=SYSTEM-NAME' flag. Look at etc/MACHINES for the +names of operating systems that Emacs has been ported to." 1>&2 + exit 1 + fi + + if [ "${opsystem}" = "note" ]; then + echo "The \`${machine}' machine can be used with more than one operating +system, and Emacs's configuration info isn't clever enough to figure +out which one you're running. Run ${progname} with -machine and +-opsystem arguments as specified below for the appropriate system. +(This information comes from the file \`etc/MACHINES' - see that +file for more detail.) + +" 1>&2 + sed < src/${machfile} -e '1,/NOTE-START/d' -e '/NOTE-END/,$d' | more + echo + exit 1 + fi + + opsysfile="s/${opsystem}.h" + if [ ! -r src/${opsysfile} ]; then + echo "${progname}: Emacs's configuration files say that the default +operating system for the machine \`${machine}' is \`${opsystem}', +but there is no configuration file for \`${opsystem}', so Emacs's +default info is screwed up. Try specifying the operating system +explicitly by passing ${progname} an \`-opsystem=SYSTEM-NAME' flag." 1>&2 + exit 1 + fi +else + opsysfile="s/${opsystem}.h" + if [ ! -r src/${opsysfile} ]; then + echo "${progname}: Emacs has no configuration info for the operating system +\`${opsystem}'. Look at etc/MACHINES for the names of operating +systems that Emacs has been ported to." 1>&2 + exit 1 + fi +fi + +if [ "${libroot}" = "" ]; then + echo "Guessing library directory..." + libroot=`/bin/pwd` +fi + +echo "Checking window system..." +window_system="`echo ${window_system} | tr A-Z a-z`" +case "${window_system}" in + "none" | "x11" | "x10" ) ;; + "x" ) window_system=x11 ;; + "" ) + echo " No window system specifed. Looking for X Windows." + window_system=none + if [ -r /usr/lib/libX11.a -a -d /usr/include/X11 ]; then + window_system=x11 + fi + ;; + * ) + echo "The \`-window_system' option must be set to \`none' or \`X11'." 1>&2 + exit 1 + ;; +esac + +case "${window_system}" in + x11 ) + have_x_windows=yes + have_x11=yes + ;; + x10 ) + have_x_windows=yes + have_x11=no + ;; + none ) + have_x_windows=no + have_x11=no + ;; +esac + +# What is the return type of a signal handler? We grep +# /usr/include/signal.h for the declaration of the signal function. +# Yuck. +echo "Looking for return type of signal handler functions..." +if [ -r /usr/include/signal.h ]; then + sigpattern='[ ]*([ ]*\*[ ]*signal[ ]*(' + sigtype=void + if grep -s "int${sigpattern}" /usr/include/signal.h; then + sigtype=int + fi +fi + + +# Do the opsystem or machine files prohibit the use of the GNU malloc? +echo "Checking to see if the GNU malloc routines are permissible..." +if (cd ./src;grep SYSTEM_MALLOC ${opsysfile} ${machfile} > /dev/null); then + gnu_malloc=no + gnu_malloc_reason=" + (The GNU allocators don't work with this machine and/or operating system.)" +fi + +rel_alloc=${gnu_malloc} + +if [ "${have_x_menu}" = "" ]; then + have_x_menu=no +fi + +if [ "${lisppath}" = "" ]; then + lisppath=${libroot}/local-lisp:${libroot}/lisp +fi + +if [ "${datadir}" = "" ]; then + datadir=${libroot}/etc +fi + +if [ "${libdir}" = "" ]; then + libdir=${libroot}/arch-lib +fi + +if [ "${lockdir}" = "" ]; then + lockdir=${libroot}/lock +fi + +echo "Checking for GCC..." +case "${cc}" in + "" ) + temppath=`echo $PATH | sed 's/^:/.:/ + s/::/:.:/g + s/:$/:./ + s/:/ /g'` + cc=`( + for dir in ${temppath}; do + if [ -f ${dir}/gcc ]; then echo gcc; exit 0; fi + done + echo cc + )` + ;; +esac + +case "${O},${g},${cc}" in + ,,gcc ) O=yes; g=yes ;; + ,,* ) O=yes; g=no ;; +esac + +echo "Guessing which libraries the lib-src programs will want," +echo " based on the machine- and system-dependent files..." +echo '#include "src/'${machfile}'" +#include "src/'${opsysfile}'" +#ifndef LIBS_MACHINE +#define LIBS_MACHINE +#endif +#ifndef LIBS_SYSTEM +#define LIBS_SYSTEM +#endif +libsrc_libs=LIBS_MACHINE LIBS_SYSTEM +' > config-tmp-$$.c +eval `${cc} -E config-tmp-$$.c | grep 'libsrc_libs='` +rm config-tmp-$$.c + +rm -f config.status +set -e + +# Make the proper settings in the config file. +echo "Making src/config.h from src/config.h-dist" +if [ "${highpri}" != "" ]; then + highpri="(-${highpri})" +fi +case "${g}" in + "yes" ) c_switch_site="${c_switch_site} -g" ;; +esac +case "${O}" in + "yes" ) c_switch_site="${c_switch_site} -O" ;; +esac +sed_flags="-e 's:@machine@:${machfile}:'" +sed_flags="${sed_flags} -e 's:@opsystem@:${opsysfile}:'" +for flag in `echo ${config_h_opts} | tr ':' ' '`; do + cflagname=`echo ${flag} | tr a-z A-Z` + val=`eval echo '$'${flag}` + case ${val} in + no | "") + f="-e 's:.*#define ${cflagname}.*:/\\* #define ${cflagname} \\*/:'" + ;; + yes) + f="-e 's:.*#define ${cflagname}.*:#define ${cflagname}:'" + ;; + *) + f="-e 's:.*#define ${cflagname}.*:#define ${cflagname} ${val}:'" + ;; + esac + sed_flags="${sed_flags} ${f}" +done +eval '/bin/sed '${sed_flags}' < src/config.h-dist > src/config.h' + +# Modify the parameters in the top makefile. +echo "Editing ./Makefile..." +tempMakefile="tempMakefile"$$ +/bin/sed < Makefile > ${tempMakefile} \ +-e 's;^\(LIBROOT=\).*$;\1'"${libroot};" \ +-e 's;^\(INSTALLBIN=\).*$;\1'"${installbin};" \ +-e 's;^\(LISPPATH=\).*$;\1'"${lisppath};" \ +-e 's;^\(DATADIR=\).*$;\1'"${datadir};" \ +-e 's;^\(LOCKDIR=\).*$;\1'"${lockdir};" \ +-e 's;^\(LIBDIR=\).*$;\1'"${libdir};" +mv ${tempMakefile} Makefile + +# Modify the parameters in the `build-install' script. +echo "Editing ./build-install..." +tempbi="tempbi"$$ +/bin/sed < build-install > ${tempbi} \ +-e 's;^\(LIBROOT=\).*$;\1'"${libroot};" \ +-e 's;^\(BINDIR=\).*$;\1'"${installbin};" \ +-e 's;^\(LISPPATH=\).*$;\1'"${lisppath};" \ +-e 's;^\(DATADIR=\).*$;\1'"${datadir};" \ +-e 's;^\(LOCKDIR=\).*$;\1'"${lockdir};" \ +-e 's;^\(LIBDIR=\).*$;\1'"${libdir};" +mv ${tempbi} build-install +chmod a+x build-install + +# Modify the parameters in the src makefile. +echo "Editing src/Makefile..." +tempMakefile="tempMakefile"$$ +/bin/sed < src/Makefile > ${tempMakefile} \ +-e 's;^\(CC[ ]*=\).*$;\1'"${cc};" +mv ${tempMakefile} src/Makefile + +# Modify the parameters in the lib-src makefile. +echo "Editing lib-src/Makefile..." +tempMakefile="tempMakefile"$$ +/bin/sed < lib-src/Makefile > ${tempMakefile} \ +-e 's;^\(CFLAGS=\).*$;\1'"${c_switch_site};" \ +-e 's;^\(LOADLIBES=\).*$;\1'"${libsrc_libs};" \ +-e 's;^\(CC=\).*$;\1'"${cc};" +mv ${tempMakefile} lib-src/Makefile + +# Document the damage we have done. +echo +echo "Configured for machine \`${machine}' running \`${opsystem}'. +The following values have been set in ./Makefile and ./build-install: + Executables will be placed in + ${installbin}. + Emacs's lisp search path will be + \`${lisppath}'. + Emacs will look for its architecture-independent data in + ${datadir}. + Emacs will look for its utility programs and other architecture- + dependent data in + ${libdir}. + Emacs will keep track of file-locking in + ${lockdir}. +The following values have been set in src/config.h: + At how much higher than normal priority should Emacs run? ${highpri-none} + Should Emacs use the GNU version of malloc? ${gnu_malloc}${gnu_malloc_reason} + Should Emacs use the relocating allocator for buffers? ${rel_alloc} + Should Emacs support a floating point Elisp type? ${lisp_float_type} + What window system should Emacs use? ${window_system} + Should Emacs support mouse menus, which require X11? ${have_x_menu} + What compiler should emacs be built with? ${cc} + Should the compilation use \`-g' and/or \`-O'? ${c_switch_site- neither}" \ +| tee config.status 1>&2 + +exit 0
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/search.c Wed Apr 01 10:45:51 1992 +0000 @@ -0,0 +1,1294 @@ +/* String search routines for GNU Emacs. + Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 1, or (at your option) +any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs; see the file COPYING. If not, write to +the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ + + +#include "config.h" +#include "lisp.h" +#include "syntax.h" +#include "buffer.h" +#include "commands.h" +#include <sys/types.h> +#include "regex.h" + +#define max(a, b) ((a) > (b) ? (a) : (b)) +#define min(a, b) ((a) < (b) ? (a) : (b)) + +/* We compile regexps into this buffer and then use it for searching. */ + +struct re_pattern_buffer searchbuf; + +char search_fastmap[0400]; + +/* Last regexp we compiled */ + +Lisp_Object last_regexp; + +/* Every call to re_match, etc., must pass &search_regs as the regs argument + unless you can show it is unnecessary (i.e., if re_match is certainly going + to be called again before region-around-match can be called). */ + +static struct re_registers search_regs; + +/* Nonzero if search_regs are indices in a string; 0 if in a buffer. */ + +static int search_regs_from_string; + +/* error condition signalled when regexp compile_pattern fails */ + +Lisp_Object Qinvalid_regexp; + +static void +matcher_overflow () +{ + error ("Stack overflow in regexp matcher"); +} + +#ifdef __STDC__ +#define CONST const +#else +#define CONST +#endif + +/* Compile a regexp and signal a Lisp error if anything goes wrong. */ + +compile_pattern (pattern, bufp, translate) + Lisp_Object pattern; + struct re_pattern_buffer *bufp; + char *translate; +{ + CONST char *val; + Lisp_Object dummy; + + if (EQ (pattern, last_regexp) + && translate == bufp->translate) + return; + last_regexp = Qnil; + bufp->translate = translate; + val = re_compile_pattern ((char *) XSTRING (pattern)->data, + XSTRING (pattern)->size, + bufp); + if (val) + { + dummy = build_string (val); + while (1) + Fsignal (Qinvalid_regexp, Fcons (dummy, Qnil)); + } + last_regexp = pattern; + return; +} + +/* Error condition used for failing searches */ +Lisp_Object Qsearch_failed; + +Lisp_Object +signal_failure (arg) + Lisp_Object arg; +{ + Fsignal (Qsearch_failed, Fcons (arg, Qnil)); + return Qnil; +} + +DEFUN ("looking-at", Flooking_at, Slooking_at, 1, 1, 0, + "Return t if text after point matches regular expression PAT.") + (string) + Lisp_Object string; +{ + Lisp_Object val; + unsigned char *p1, *p2; + int s1, s2; + register int i; + + CHECK_STRING (string, 0); + compile_pattern (string, &searchbuf, + !NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0); + + immediate_quit = 1; + QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ + + /* Get pointers and sizes of the two strings + that make up the visible portion of the buffer. */ + + p1 = BEGV_ADDR; + s1 = GPT - BEGV; + p2 = GAP_END_ADDR; + s2 = ZV - GPT; + if (s1 < 0) + { + p2 = p1; + s2 = ZV - BEGV; + s1 = 0; + } + if (s2 < 0) + { + s1 = ZV - BEGV; + s2 = 0; + } + + i = re_match_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2, + point - BEGV, &search_regs, + ZV - BEGV); + if (i == -2) + matcher_overflow (); + + val = (0 <= i ? Qt : Qnil); + for (i = 0; i < RE_NREGS; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] += BEGV; + search_regs.end[i] += BEGV; + } + search_regs_from_string = 0; + immediate_quit = 0; + return val; +} + +DEFUN ("string-match", Fstring_match, Sstring_match, 2, 3, 0, + "Return index of start of first match for REGEXP in STRING, or nil.\n\ +If third arg START is non-nil, start search at that index in STRING.\n\ +For index of first char beyond the match, do (match-end 0).\n\ +`match-end' and `match-beginning' also give indices of substrings\n\ +matched by parenthesis constructs in the pattern.") + (regexp, string, start) + Lisp_Object regexp, string, start; +{ + int val; + int s; + + CHECK_STRING (regexp, 0); + CHECK_STRING (string, 1); + + if (NILP (start)) + s = 0; + else + { + int len = XSTRING (string)->size; + + CHECK_NUMBER (start, 2); + s = XINT (start); + if (s < 0 && -s <= len) + s = len - s; + else if (0 > s || s > len) + args_out_of_range (string, start); + } + + compile_pattern (regexp, &searchbuf, + !NILP (current_buffer->case_fold_search) ? DOWNCASE_TABLE : 0); + immediate_quit = 1; + val = re_search (&searchbuf, (char *) XSTRING (string)->data, + XSTRING (string)->size, s, XSTRING (string)->size - s, + &search_regs); + immediate_quit = 0; + search_regs_from_string = 1; + if (val == -2) + matcher_overflow (); + if (val < 0) return Qnil; + return make_number (val); +} + +scan_buffer (target, pos, cnt, shortage) + int *shortage, pos; + register int cnt, target; +{ + int lim = ((cnt > 0) ? ZV - 1 : BEGV); + int direction = ((cnt > 0) ? 1 : -1); + register int lim0; + unsigned char *base; + register unsigned char *cursor, *limit; + + if (shortage != 0) + *shortage = 0; + + immediate_quit = 1; + + if (cnt > 0) + while (pos != lim + 1) + { + lim0 = BUFFER_CEILING_OF (pos); + lim0 = min (lim, lim0); + limit = &FETCH_CHAR (lim0) + 1; + base = (cursor = &FETCH_CHAR (pos)); + while (1) + { + while (*cursor != target && ++cursor != limit) + ; + if (cursor != limit) + { + if (--cnt == 0) + { + immediate_quit = 0; + return (pos + cursor - base + 1); + } + else + if (++cursor == limit) + break; + } + else + break; + } + pos += cursor - base; + } + else + { + pos--; /* first character we scan */ + while (pos > lim - 1) + { /* we WILL scan under pos */ + lim0 = BUFFER_FLOOR_OF (pos); + lim0 = max (lim, lim0); + limit = &FETCH_CHAR (lim0) - 1; + base = (cursor = &FETCH_CHAR (pos)); + cursor++; + while (1) + { + while (--cursor != limit && *cursor != target) + ; + if (cursor != limit) + { + if (++cnt == 0) + { + immediate_quit = 0; + return (pos + cursor - base + 1); + } + } + else + break; + } + pos += cursor - base; + } + } + immediate_quit = 0; + if (shortage != 0) + *shortage = cnt * direction; + return (pos + ((direction == 1 ? 0 : 1))); +} + +int +find_next_newline (from, cnt) + register int from, cnt; +{ + return (scan_buffer ('\n', from, cnt, (int *) 0)); +} + +DEFUN ("skip-chars-forward", Fskip_chars_forward, Sskip_chars_forward, 1, 2, 0, + "Move point forward, stopping before a char not in CHARS, or at position LIM.\n\ +CHARS is like the inside of a `[...]' in a regular expression\n\ +except that `]' is never special and `\\' quotes `^', `-' or `\\'.\n\ +Thus, with arg \"a-zA-Z\", this skips letters stopping before first nonletter.\n\ +With arg \"^a-zA-Z\", skips nonletters stopping before first letter.") + (string, lim) + Lisp_Object string, lim; +{ + skip_chars (1, string, lim); + return Qnil; +} + +DEFUN ("skip-chars-backward", Fskip_chars_backward, Sskip_chars_backward, 1, 2, 0, + "Move point backward, stopping after a char not in CHARS, or at position LIM.\n\ +See `skip-chars-forward' for details.") + (string, lim) + Lisp_Object string, lim; +{ + skip_chars (0, string, lim); + return Qnil; +} + +skip_chars (forwardp, string, lim) + int forwardp; + Lisp_Object string, lim; +{ + register unsigned char *p, *pend; + register unsigned char c; + unsigned char fastmap[0400]; + int negate = 0; + register int i; + + CHECK_STRING (string, 0); + + if (NILP (lim)) + XSET (lim, Lisp_Int, forwardp ? ZV : BEGV); + else + CHECK_NUMBER_COERCE_MARKER (lim, 1); + +#if 0 /* This breaks some things... jla. */ + /* In any case, don't allow scan outside bounds of buffer. */ + if (XFASTINT (lim) > ZV) + XFASTINT (lim) = ZV; + if (XFASTINT (lim) < BEGV) + XFASTINT (lim) = BEGV; +#endif + + p = XSTRING (string)->data; + pend = p + XSTRING (string)->size; + bzero (fastmap, sizeof fastmap); + + if (p != pend && *p == '^') + { + negate = 1; p++; + } + + /* Find the characters specified and set their elements of fastmap. */ + + while (p != pend) + { + c = *p++; + if (c == '\\') + { + if (p == pend) break; + c = *p++; + } + if (p != pend && *p == '-') + { + p++; + if (p == pend) break; + while (c <= *p) + { + fastmap[c] = 1; + c++; + } + p++; + } + else + fastmap[c] = 1; + } + + /* If ^ was the first character, complement the fastmap. */ + + if (negate) + for (i = 0; i < sizeof fastmap; i++) + fastmap[i] ^= 1; + + immediate_quit = 1; + if (forwardp) + { + while (point < XINT (lim) && fastmap[FETCH_CHAR (point)]) + SET_PT (point + 1); + } + else + { + while (point > XINT (lim) && fastmap[FETCH_CHAR (point - 1)]) + SET_PT (point - 1); + } + immediate_quit = 0; +} + +/* Subroutines of Lisp buffer search functions. */ + +static Lisp_Object +search_command (string, bound, noerror, count, direction, RE) + Lisp_Object string, bound, noerror, count; + int direction; + int RE; +{ + register int np; + int lim; + int n = direction; + + if (!NILP (count)) + { + CHECK_NUMBER (count, 3); + n *= XINT (count); + } + + CHECK_STRING (string, 0); + if (NILP (bound)) + lim = n > 0 ? ZV : BEGV; + else + { + CHECK_NUMBER_COERCE_MARKER (bound, 1); + lim = XINT (bound); + if (n > 0 ? lim < point : lim > point) + error ("Invalid search bound (wrong side of point)"); + if (lim > ZV) + lim = ZV; + if (lim < BEGV) + lim = BEGV; + } + + np = search_buffer (string, point, lim, n, RE, + (!NILP (current_buffer->case_fold_search) + ? XSTRING (current_buffer->case_canon_table)->data : 0), + (!NILP (current_buffer->case_fold_search) + ? XSTRING (current_buffer->case_eqv_table)->data : 0)); + if (np <= 0) + { + if (NILP (noerror)) + return signal_failure (string); + if (!EQ (noerror, Qt)) + { + if (lim < BEGV || lim > ZV) + abort (); + SET_PT (lim); + } + return Qnil; + } + + if (np < BEGV || np > ZV) + abort (); + + SET_PT (np); + + return make_number (np); +} + +/* search for the n'th occurrence of STRING in the current buffer, + starting at position POS and stopping at position LIM, + treating PAT as a literal string if RE is false or as + a regular expression if RE is true. + + If N is positive, searching is forward and LIM must be greater than POS. + If N is negative, searching is backward and LIM must be less than POS. + + Returns -x if only N-x occurrences found (x > 0), + or else the position at the beginning of the Nth occurrence + (if searching backward) or the end (if searching forward). */ + +search_buffer (string, pos, lim, n, RE, trt, inverse_trt) + Lisp_Object string; + int pos; + int lim; + int n; + int RE; + register unsigned char *trt; + register unsigned char *inverse_trt; +{ + int len = XSTRING (string)->size; + unsigned char *base_pat = XSTRING (string)->data; + register int *BM_tab; + int *BM_tab_base; + register int direction = ((n > 0) ? 1 : -1); + register int dirlen; + int infinity, limit, k, stride_for_teases; + register unsigned char *pat, *cursor, *p_limit; + register int i, j; + unsigned char *p1, *p2; + int s1, s2; + + /* Null string is found at starting position. */ + if (!len) + return pos; + + if (RE) + compile_pattern (string, &searchbuf, (char *) trt); + + if (RE /* Here we detect whether the */ + /* generality of an RE search is */ + /* really needed. */ + /* first item is "exact match" */ + && *(searchbuf.buffer) == RE_EXACTN_VALUE + && searchbuf.buffer[1] + 2 == searchbuf.used) /*first is ONLY item */ + { + RE = 0; /* can do straight (non RE) search */ + pat = (base_pat = (unsigned char *) searchbuf.buffer + 2); + /* trt already applied */ + len = searchbuf.used - 2; + } + else if (!RE) + { + pat = (unsigned char *) alloca (len); + + for (i = len; i--;) /* Copy the pattern; apply trt */ + *pat++ = (((int) trt) ? trt [*base_pat++] : *base_pat++); + pat -= len; base_pat = pat; + } + + if (RE) + { + immediate_quit = 1; /* Quit immediately if user types ^G, + because letting this function finish + can take too long. */ + QUIT; /* Do a pending quit right away, + to avoid paradoxical behavior */ + /* Get pointers and sizes of the two strings + that make up the visible portion of the buffer. */ + + p1 = BEGV_ADDR; + s1 = GPT - BEGV; + p2 = GAP_END_ADDR; + s2 = ZV - GPT; + if (s1 < 0) + { + p2 = p1; + s2 = ZV - BEGV; + s1 = 0; + } + if (s2 < 0) + { + s1 = ZV - BEGV; + s2 = 0; + } + while (n < 0) + { + int val = re_search_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2, + pos - BEGV, lim - pos, &search_regs, + /* Don't allow match past current point */ + pos - BEGV); + if (val == -2) + matcher_overflow (); + if (val >= 0) + { + j = BEGV; + for (i = 0; i < RE_NREGS; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] += j; + search_regs.end[i] += j; + } + search_regs_from_string = 0; + /* Set pos to the new position. */ + pos = search_regs.start[0]; + } + else + { + immediate_quit = 0; + return (n); + } + n++; + } + while (n > 0) + { + int val = re_search_2 (&searchbuf, (char *) p1, s1, (char *) p2, s2, + pos - BEGV, lim - pos, &search_regs, + lim - BEGV); + if (val == -2) + matcher_overflow (); + if (val >= 0) + { + j = BEGV; + for (i = 0; i < RE_NREGS; i++) + if (search_regs.start[i] >= 0) + { + search_regs.start[i] += j; + search_regs.end[i] += j; + } + search_regs_from_string = 0; + pos = search_regs.end[0]; + } + else + { + immediate_quit = 0; + return (0 - n); + } + n--; + } + immediate_quit = 0; + return (pos); + } + else /* non-RE case */ + { +#ifdef C_ALLOCA + int BM_tab_space[0400]; + BM_tab = &BM_tab_space[0]; +#else + BM_tab = (int *) alloca (0400 * sizeof (int)); +#endif + /* The general approach is that we are going to maintain that we know */ + /* the first (closest to the present position, in whatever direction */ + /* we're searching) character that could possibly be the last */ + /* (furthest from present position) character of a valid match. We */ + /* advance the state of our knowledge by looking at that character */ + /* and seeing whether it indeed matches the last character of the */ + /* pattern. If it does, we take a closer look. If it does not, we */ + /* move our pointer (to putative last characters) as far as is */ + /* logically possible. This amount of movement, which I call a */ + /* stride, will be the length of the pattern if the actual character */ + /* appears nowhere in the pattern, otherwise it will be the distance */ + /* from the last occurrence of that character to the end of the */ + /* pattern. */ + /* As a coding trick, an enormous stride is coded into the table for */ + /* characters that match the last character. This allows use of only */ + /* a single test, a test for having gone past the end of the */ + /* permissible match region, to test for both possible matches (when */ + /* the stride goes past the end immediately) and failure to */ + /* match (where you get nudged past the end one stride at a time). */ + + /* Here we make a "mickey mouse" BM table. The stride of the search */ + /* is determined only by the last character of the putative match. */ + /* If that character does not match, we will stride the proper */ + /* distance to propose a match that superimposes it on the last */ + /* instance of a character that matches it (per trt), or misses */ + /* it entirely if there is none. */ + + dirlen = len * direction; + infinity = dirlen - (lim + pos + len + len) * direction; + if (direction < 0) + pat = (base_pat += len - 1); + BM_tab_base = BM_tab; + BM_tab += 0400; + j = dirlen; /* to get it in a register */ + /* A character that does not appear in the pattern induces a */ + /* stride equal to the pattern length. */ + while (BM_tab_base != BM_tab) + { + *--BM_tab = j; + *--BM_tab = j; + *--BM_tab = j; + *--BM_tab = j; + } + i = 0; + while (i != infinity) + { + j = pat[i]; i += direction; + if (i == dirlen) i = infinity; + if ((int) trt) + { + k = (j = trt[j]); + if (i == infinity) + stride_for_teases = BM_tab[j]; + BM_tab[j] = dirlen - i; + /* A translation table is accompanied by its inverse -- see */ + /* comment following downcase_table for details */ + while ((j = inverse_trt[j]) != k) + BM_tab[j] = dirlen - i; + } + else + { + if (i == infinity) + stride_for_teases = BM_tab[j]; + BM_tab[j] = dirlen - i; + } + /* stride_for_teases tells how much to stride if we get a */ + /* match on the far character but are subsequently */ + /* disappointed, by recording what the stride would have been */ + /* for that character if the last character had been */ + /* different. */ + } + infinity = dirlen - infinity; + pos += dirlen - ((direction > 0) ? direction : 0); + /* loop invariant - pos points at where last char (first char if reverse) + of pattern would align in a possible match. */ + while (n != 0) + { + if ((lim - pos - (direction > 0)) * direction < 0) + return (n * (0 - direction)); + /* First we do the part we can by pointers (maybe nothing) */ + QUIT; + pat = base_pat; + limit = pos - dirlen + direction; + limit = ((direction > 0) + ? BUFFER_CEILING_OF (limit) + : BUFFER_FLOOR_OF (limit)); + /* LIMIT is now the last (not beyond-last!) value + POS can take on without hitting edge of buffer or the gap. */ + limit = ((direction > 0) + ? min (lim - 1, min (limit, pos + 20000)) + : max (lim, max (limit, pos - 20000))); + if ((limit - pos) * direction > 20) + { + p_limit = &FETCH_CHAR (limit); + p2 = (cursor = &FETCH_CHAR (pos)); + /* In this loop, pos + cursor - p2 is the surrogate for pos */ + while (1) /* use one cursor setting as long as i can */ + { + if (direction > 0) /* worth duplicating */ + { + /* Use signed comparison if appropriate + to make cursor+infinity sure to be > p_limit. + Assuming that the buffer lies in a range of addresses + that are all "positive" (as ints) or all "negative", + either kind of comparison will work as long + as we don't step by infinity. So pick the kind + that works when we do step by infinity. */ + if ((int) (p_limit + infinity) > (int) p_limit) + while ((int) cursor <= (int) p_limit) + cursor += BM_tab[*cursor]; + else + while ((unsigned int) cursor <= (unsigned int) p_limit) + cursor += BM_tab[*cursor]; + } + else + { + if ((int) (p_limit + infinity) < (int) p_limit) + while ((int) cursor >= (int) p_limit) + cursor += BM_tab[*cursor]; + else + while ((unsigned int) cursor >= (unsigned int) p_limit) + cursor += BM_tab[*cursor]; + } +/* If you are here, cursor is beyond the end of the searched region. */ + /* This can happen if you match on the far character of the pattern, */ + /* because the "stride" of that character is infinity, a number able */ + /* to throw you well beyond the end of the search. It can also */ + /* happen if you fail to match within the permitted region and would */ + /* otherwise try a character beyond that region */ + if ((cursor - p_limit) * direction <= len) + break; /* a small overrun is genuine */ + cursor -= infinity; /* large overrun = hit */ + i = dirlen - direction; + if ((int) trt) + { + while ((i -= direction) + direction != 0) + if (pat[i] != trt[*(cursor -= direction)]) + break; + } + else + { + while ((i -= direction) + direction != 0) + if (pat[i] != *(cursor -= direction)) + break; + } + cursor += dirlen - i - direction; /* fix cursor */ + if (i + direction == 0) + { + cursor -= direction; + search_regs.start[0] + = pos + cursor - p2 + ((direction > 0) + ? 1 - len : 0); + search_regs.end[0] = len + search_regs.start[0]; + search_regs_from_string = 0; + if ((n -= direction) != 0) + cursor += dirlen; /* to resume search */ + else + return ((direction > 0) + ? search_regs.end[0] : search_regs.start[0]); + } + else + cursor += stride_for_teases; /* <sigh> we lose - */ + } + pos += cursor - p2; + } + else + /* Now we'll pick up a clump that has to be done the hard */ + /* way because it covers a discontinuity */ + { + limit = ((direction > 0) + ? BUFFER_CEILING_OF (pos - dirlen + 1) + : BUFFER_FLOOR_OF (pos - dirlen - 1)); + limit = ((direction > 0) + ? min (limit + len, lim - 1) + : max (limit - len, lim)); + /* LIMIT is now the last value POS can have + and still be valid for a possible match. */ + while (1) + { + /* This loop can be coded for space rather than */ + /* speed because it will usually run only once. */ + /* (the reach is at most len + 21, and typically */ + /* does not exceed len) */ + while ((limit - pos) * direction >= 0) + pos += BM_tab[FETCH_CHAR(pos)]; + /* now run the same tests to distinguish going off the */ + /* end, a match or a phoney match. */ + if ((pos - limit) * direction <= len) + break; /* ran off the end */ + /* Found what might be a match. + Set POS back to last (first if reverse) char pos. */ + pos -= infinity; + i = dirlen - direction; + while ((i -= direction) + direction != 0) + { + pos -= direction; + if (pat[i] != (((int) trt) + ? trt[FETCH_CHAR(pos)] + : FETCH_CHAR (pos))) + break; + } + /* Above loop has moved POS part or all the way + back to the first char pos (last char pos if reverse). + Set it once again at the last (first if reverse) char. */ + pos += dirlen - i- direction; + if (i + direction == 0) + { + pos -= direction; + search_regs.start[0] + = pos + ((direction > 0) ? 1 - len : 0); + search_regs.end[0] = len + search_regs.start[0]; + search_regs_from_string = 0; + if ((n -= direction) != 0) + pos += dirlen; /* to resume search */ + else + return ((direction > 0) + ? search_regs.end[0] : search_regs.start[0]); + } + else + pos += stride_for_teases; + } + } + /* We have done one clump. Can we continue? */ + if ((lim - pos) * direction < 0) + return ((0 - n) * direction); + } + return pos; + } +} + +/* Given a string of words separated by word delimiters, + compute a regexp that matches those exact words + separated by arbitrary punctuation. */ + +static Lisp_Object +wordify (string) + Lisp_Object string; +{ + register unsigned char *p, *o; + register int i, len, punct_count = 0, word_count = 0; + Lisp_Object val; + + CHECK_STRING (string, 0); + p = XSTRING (string)->data; + len = XSTRING (string)->size; + + for (i = 0; i < len; i++) + if (SYNTAX (p[i]) != Sword) + { + punct_count++; + if (i > 0 && SYNTAX (p[i-1]) == Sword) word_count++; + } + if (SYNTAX (p[len-1]) == Sword) word_count++; + if (!word_count) return build_string (""); + + val = make_string (p, len - punct_count + 5 * (word_count - 1) + 4); + + o = XSTRING (val)->data; + *o++ = '\\'; + *o++ = 'b'; + + for (i = 0; i < len; i++) + if (SYNTAX (p[i]) == Sword) + *o++ = p[i]; + else if (i > 0 && SYNTAX (p[i-1]) == Sword && --word_count) + { + *o++ = '\\'; + *o++ = 'W'; + *o++ = '\\'; + *o++ = 'W'; + *o++ = '*'; + } + + *o++ = '\\'; + *o++ = 'b'; + + return val; +} + +DEFUN ("search-backward", Fsearch_backward, Ssearch_backward, 1, 4, + "sSearch backward: ", + "Search backward from point for STRING.\n\ +Set point to the beginning of the occurrence found, and return point.\n\ +An optional second argument bounds the search; it is a buffer position.\n\ +The match found must not extend before that position.\n\ +Optional third argument, if t, means if fail just return nil (no error).\n\ + If not nil and not t, position at limit of search and return nil.\n\ +Optional fourth argument is repeat count--search for successive occurrences.\n\ +See also the functions `match-beginning', `match-end' and `replace-match'.") + (string, bound, noerror, count) + Lisp_Object string, bound, noerror, count; +{ + return search_command (string, bound, noerror, count, -1, 0); +} + +DEFUN ("search-forward", Fsearch_forward, Ssearch_forward, 1, 4, "sSearch: ", + "Search forward from point for STRING.\n\ +Set point to the end of the occurrence found, and return point.\n\ +An optional second argument bounds the search; it is a buffer position.\n\ +The match found must not extend after that position. nil is equivalent\n\ + to (point-max).\n\ +Optional third argument, if t, means if fail just return nil (no error).\n\ + If not nil and not t, move to limit of search and return nil.\n\ +Optional fourth argument is repeat count--search for successive occurrences.\n\ +See also the functions `match-beginning', `match-end' and `replace-match'.") + (string, bound, noerror, count) + Lisp_Object string, bound, noerror, count; +{ + return search_command (string, bound, noerror, count, 1, 0); +} + +DEFUN ("word-search-backward", Fword_search_backward, Sword_search_backward, 1, 4, + "sWord search backward: ", + "Search backward from point for STRING, ignoring differences in punctuation.\n\ +Set point to the beginning of the occurrence found, and return point.\n\ +An optional second argument bounds the search; it is a buffer position.\n\ +The match found must not extend before that position.\n\ +Optional third argument, if t, means if fail just return nil (no error).\n\ + If not nil and not t, move to limit of search and return nil.\n\ +Optional fourth argument is repeat count--search for successive occurrences.") + (string, bound, noerror, count) + Lisp_Object string, bound, noerror, count; +{ + return search_command (wordify (string), bound, noerror, count, -1, 1); +} + +DEFUN ("word-search-forward", Fword_search_forward, Sword_search_forward, 1, 4, + "sWord search: ", + "Search forward from point for STRING, ignoring differences in punctuation.\n\ +Set point to the end of the occurrence found, and return point.\n\ +An optional second argument bounds the search; it is a buffer position.\n\ +The match found must not extend after that position.\n\ +Optional third argument, if t, means if fail just return nil (no error).\n\ + If not nil and not t, move to limit of search and return nil.\n\ +Optional fourth argument is repeat count--search for successive occurrences.") + (string, bound, noerror, count) + Lisp_Object string, bound, noerror, count; +{ + return search_command (wordify (string), bound, noerror, count, 1, 1); +} + +DEFUN ("re-search-backward", Fre_search_backward, Sre_search_backward, 1, 4, + "sRE search backward: ", + "Search backward from point for match for regular expression REGEXP.\n\ +Set point to the beginning of the match, and return point.\n\ +The match found is the one starting last in the buffer\n\ +and yet ending before the place the origin of the search.\n\ +An optional second argument bounds the search; it is a buffer position.\n\ +The match found must start at or after that position.\n\ +Optional third argument, if t, means if fail just return nil (no error).\n\ + If not nil and not t, move to limit of search and return nil.\n\ +Optional fourth argument is repeat count--search for successive occurrences.\n\ +See also the functions `match-beginning', `match-end' and `replace-match'.") + (string, bound, noerror, count) + Lisp_Object string, bound, noerror, count; +{ + return search_command (string, bound, noerror, count, -1, 1); +} + +DEFUN ("re-search-forward", Fre_search_forward, Sre_search_forward, 1, 4, + "sRE search: ", + "Search forward from point for regular expression REGEXP.\n\ +Set point to the end of the occurrence found, and return point.\n\ +An optional second argument bounds the search; it is a buffer position.\n\ +The match found must not extend after that position.\n\ +Optional third argument, if t, means if fail just return nil (no error).\n\ + If not nil and not t, move to limit of search and return nil.\n\ +Optional fourth argument is repeat count--search for successive occurrences.\n\ +See also the functions `match-beginning', `match-end' and `replace-match'.") + (string, bound, noerror, count) + Lisp_Object string, bound, noerror, count; +{ + return search_command (string, bound, noerror, count, 1, 1); +} + +DEFUN ("replace-match", Freplace_match, Sreplace_match, 1, 3, 0, + "Replace text matched by last search with NEWTEXT.\n\ +If second arg FIXEDCASE is non-nil, do not alter case of replacement text.\n\ +Otherwise convert to all caps or cap initials, like replaced text.\n\ +If third arg LITERAL is non-nil, insert NEWTEXT literally.\n\ +Otherwise treat `\\' as special:\n\ + `\\&' in NEWTEXT means substitute original matched text.\n\ + `\\N' means substitute what matched the Nth `\\(...\\)'.\n\ + If Nth parens didn't match, substitute nothing.\n\ + `\\\\' means insert one `\\'.\n\ +Leaves point at end of replacement text.") + (string, fixedcase, literal) + Lisp_Object string, fixedcase, literal; +{ + enum { nochange, all_caps, cap_initial } case_action; + register int pos, last; + int some_multiletter_word; + int some_letter = 0; + register int c, prevc; + int inslen; + + CHECK_STRING (string, 0); + + case_action = nochange; /* We tried an initialization */ + /* but some C compilers blew it */ + if (search_regs.start[0] < BEGV + || search_regs.start[0] > search_regs.end[0] + || search_regs.end[0] > ZV) + args_out_of_range(make_number (search_regs.start[0]), + make_number (search_regs.end[0])); + + if (NILP (fixedcase)) + { + /* Decide how to casify by examining the matched text. */ + + last = search_regs.end[0]; + prevc = '\n'; + case_action = all_caps; + + /* some_multiletter_word is set nonzero if any original word + is more than one letter long. */ + some_multiletter_word = 0; + + for (pos = search_regs.start[0]; pos < last; pos++) + { + c = FETCH_CHAR (pos); + if (LOWERCASEP (c)) + { + /* Cannot be all caps if any original char is lower case */ + + case_action = cap_initial; + if (SYNTAX (prevc) != Sword) + { + /* Cannot even be cap initials + if some original initial is lower case */ + case_action = nochange; + break; + } + else + some_multiletter_word = 1; + } + else if (!NOCASEP (c)) + { + some_letter = 1; + if (!some_multiletter_word && SYNTAX (prevc) == Sword) + some_multiletter_word = 1; + } + + prevc = c; + } + + /* Do not make new text all caps + if the original text contained only single letter words. */ + if (case_action == all_caps && !some_multiletter_word) + case_action = cap_initial; + + if (!some_letter) case_action = nochange; + } + + SET_PT (search_regs.end[0]); + if (!NILP (literal)) + Finsert (1, &string); + else + { + struct gcpro gcpro1; + GCPRO1 (string); + + for (pos = 0; pos < XSTRING (string)->size; pos++) + { + c = XSTRING (string)->data[pos]; + if (c == '\\') + { + c = XSTRING (string)->data[++pos]; + if (c == '&') + Finsert_buffer_substring (Fcurrent_buffer (), + make_number (search_regs.start[0]), + make_number (search_regs.end[0])); + else if (c >= '1' && c <= RE_NREGS + '0') + { + if (search_regs.start[c - '0'] >= 1) + Finsert_buffer_substring (Fcurrent_buffer (), + make_number (search_regs.start[c - '0']), + make_number (search_regs.end[c - '0'])); + } + else + insert_char (c); + } + else + insert_char (c); + } + UNGCPRO; + } + + inslen = point - (search_regs.end[0]); + del_range (search_regs.start[0], search_regs.end[0]); + + if (case_action == all_caps) + Fupcase_region (make_number (point - inslen), make_number (point)); + else if (case_action == cap_initial) + upcase_initials_region (make_number (point - inslen), make_number (point)); + return Qnil; +} + +static Lisp_Object +match_limit (num, beginningp) + Lisp_Object num; + int beginningp; +{ + register int n; + + CHECK_NUMBER (num, 0); + n = XINT (num); + if (n < 0 || n >= RE_NREGS) + args_out_of_range (num, make_number (RE_NREGS)); + if (search_regs.start[n] < 0) + return Qnil; + return (make_number ((beginningp) ? search_regs.start[n] + : search_regs.end[n])); +} + +DEFUN ("match-beginning", Fmatch_beginning, Smatch_beginning, 1, 1, 0, + "Return position of start of text matched by last search.\n\ +ARG, a number, specifies which parenthesized expression in the last regexp.\n\ + Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\ +Zero means the entire text matched by the whole regexp or whole string.") + (num) + Lisp_Object num; +{ + return match_limit (num, 1); +} + +DEFUN ("match-end", Fmatch_end, Smatch_end, 1, 1, 0, + "Return position of end of text matched by last search.\n\ +ARG, a number, specifies which parenthesized expression in the last regexp.\n\ + Value is nil if ARGth pair didn't match, or there were less than ARG pairs.\n\ +Zero means the entire text matched by the whole regexp or whole string.") + (num) + Lisp_Object num; +{ + return match_limit (num, 0); +} + +DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 0, 0, + "Return a list containing all info on what the last search matched.\n\ +Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.\n\ +All the elements are markers or nil (nil if the Nth pair didn't match)\n\ +if the last match was on a buffer; integers or nil if a string was matched.\n\ +Use `store-match-data' to reinstate the data in this list.") + () +{ + Lisp_Object data[2 * RE_NREGS]; + int i, len; + + len = -1; + for (i = 0; i < RE_NREGS; i++) + { + int start = search_regs.start[i]; + if (start >= 0) + { + if (search_regs_from_string) + { + XFASTINT (data[2 * i]) = start; + XFASTINT (data[2 * i + 1]) = search_regs.end[i]; + } + else + { + data[2 * i] = Fmake_marker (); + Fset_marker (data[2 * i], make_number (start), Qnil); + data[2 * i + 1] = Fmake_marker (); + Fset_marker (data[2 * i + 1], + make_number (search_regs.end[i]), Qnil); + } + len = i; + } + else + data[2 * i] = data [2 * i + 1] = Qnil; + } + return Flist (2 * len + 2, data); +} + + +DEFUN ("store-match-data", Fstore_match_data, Sstore_match_data, 1, 1, 0, + "Set internal data on last search match from elements of LIST.\n\ +LIST should have been created by calling `match-data' previously.") + (list) + register Lisp_Object list; +{ + register int i; + register Lisp_Object marker; + + if (!CONSP (list) && !NILP (list)) + list = wrong_type_argument (Qconsp, list, 0); + + for (i = 0; i < RE_NREGS; i++) + { + marker = Fcar (list); + if (NILP (marker)) + { + search_regs.start[i] = -1; + list = Fcdr (list); + } + else + { + if (XTYPE (marker) == Lisp_Marker + && XMARKER (marker)->buffer == 0) + XFASTINT (marker) = 0; + + CHECK_NUMBER_COERCE_MARKER (marker, 0); + search_regs.start[i] = XINT (marker); + list = Fcdr (list); + + marker = Fcar (list); + if (XTYPE (marker) == Lisp_Marker + && XMARKER (marker)->buffer == 0) + XFASTINT (marker) = 0; + + CHECK_NUMBER_COERCE_MARKER (marker, 0); + search_regs.end[i] = XINT (marker); + } + list = Fcdr (list); + } + + return Qnil; +} + +/* Quote a string to inactivate reg-expr chars */ + +DEFUN ("regexp-quote", Fregexp_quote, Sregexp_quote, 1, 1, 0, + "Return a regexp string which matches exactly STRING and nothing else.") + (str) + Lisp_Object str; +{ + register unsigned char *in, *out, *end; + register unsigned char *temp; + + CHECK_STRING (str, 0); + + temp = (unsigned char *) alloca (XSTRING (str)->size * 2); + + /* Now copy the data into the new string, inserting escapes. */ + + in = XSTRING (str)->data; + end = in + XSTRING (str)->size; + out = temp; + + for (; in != end; in++) + { + if (*in == '[' || *in == ']' + || *in == '*' || *in == '.' || *in == '\\' + || *in == '?' || *in == '+' + || *in == '^' || *in == '$') + *out++ = '\\'; + *out++ = *in; + } + + return make_string (temp, out - temp); +} + +syms_of_search () +{ + register int i; + + searchbuf.allocated = 100; + searchbuf.buffer = (char *) malloc (searchbuf.allocated); + searchbuf.fastmap = search_fastmap; + + Qsearch_failed = intern ("search-failed"); + staticpro (&Qsearch_failed); + Qinvalid_regexp = intern ("invalid-regexp"); + staticpro (&Qinvalid_regexp); + + Fput (Qsearch_failed, Qerror_conditions, + Fcons (Qsearch_failed, Fcons (Qerror, Qnil))); + Fput (Qsearch_failed, Qerror_message, + build_string ("Search failed")); + + Fput (Qinvalid_regexp, Qerror_conditions, + Fcons (Qinvalid_regexp, Fcons (Qerror, Qnil))); + Fput (Qinvalid_regexp, Qerror_message, + build_string ("Invalid regexp")); + + last_regexp = Qnil; + staticpro (&last_regexp); + + defsubr (&Sstring_match); + defsubr (&Slooking_at); + defsubr (&Sskip_chars_forward); + defsubr (&Sskip_chars_backward); + defsubr (&Ssearch_forward); + defsubr (&Ssearch_backward); + defsubr (&Sword_search_forward); + defsubr (&Sword_search_backward); + defsubr (&Sre_search_forward); + defsubr (&Sre_search_backward); + defsubr (&Sreplace_match); + defsubr (&Smatch_beginning); + defsubr (&Smatch_end); + defsubr (&Smatch_data); + defsubr (&Sstore_match_data); + defsubr (&Sregexp_quote); +}