/* Record indices of function doc strings stored in a file.
- Copyright (C) 1985, 86, 93, 94, 95, 97, 1998 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
+ 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
#include <config.h>
#include <sys/types.h>
#include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
+#include <ctype.h>
-#ifdef USG5
+#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
#include "buffer.h"
#include "keyboard.h"
#include "charset.h"
+#include "keymap.h"
+
+#ifdef HAVE_INDEX
+extern char *index P_ ((const char *, int));
+#endif
Lisp_Object Vdoc_file_name;
-extern char *index ();
+Lisp_Object Qfunction_documentation;
+
+/* A list of files used to build this Emacs binary. */
+static Lisp_Object Vbuild_files;
extern Lisp_Object Voverriding_local_map;
+extern Lisp_Object Qremap;
+
/* For VMS versions with limited file name syntax,
- convert the name to something VMS will allow. */
+ convert the name to something VMS will allow. */
static void
munge_doc_file_name (name)
char *name;
{
#ifdef VMS
-#ifndef VMS4_4
- /* For VMS versions with limited file name syntax,
- convert the name to something VMS will allow. */
- p = name;
+#ifndef NO_HYPHENS_IN_FILENAMES
+ extern char * sys_translate_unix (char *ufile);
+ strcpy (name, sys_translate_unix (name));
+#else /* NO_HYPHENS_IN_FILENAMES */
+ char *p = name;
while (*p)
{
if (*p == '-')
*p = '_';
p++;
}
-#endif /* not VMS4_4 */
-#ifdef VMS4_4
- strcpy (name, sys_translate_unix (name));
-#endif /* VMS4_4 */
+#endif /* NO_HYPHENS_IN_FILENAMES */
#endif /* VMS */
}
static char *get_doc_string_buffer;
static int get_doc_string_buffer_size;
+static unsigned char *read_bytecode_pointer;
+Lisp_Object Fsnarf_documentation P_ ((Lisp_Object));
+
+/* readchar in lread.c calls back here to fetch the next byte.
+ If UNREADFLAG is 1, we unread a byte. */
+
+int
+read_bytecode_char (unreadflag)
+ int unreadflag;
+{
+ if (unreadflag)
+ {
+ read_bytecode_pointer--;
+ return 0;
+ }
+ return *read_bytecode_pointer++;
+}
+
/* Extract a doc string from a file. FILEPOS says where to get it.
If it is an integer, use that position in the standard DOC-... file.
If it is (FILE . INTEGER), use FILE as the file name
and INTEGER as the position in that file.
But if INTEGER is negative, make it positive.
(A negative integer is used for user variables, so we can distinguish
- them without actually fetching the doc string.) */
+ them without actually fetching the doc string.)
+
+ If the location does not point to the beginning of a docstring
+ (e.g. because the file has been modified and the location is stale),
+ return nil.
+
+ If UNIBYTE is nonzero, always make a unibyte string.
-static Lisp_Object
-get_doc_string (filepos)
+ If DEFINITION is nonzero, assume this is for reading
+ a dynamic function definition; convert the bytestring
+ and the constants vector with appropriate byte handling,
+ and return a cons cell. */
+
+Lisp_Object
+get_doc_string (filepos, unibyte, definition)
Lisp_Object filepos;
+ int unibyte, definition;
{
char *from, *to;
register int fd;
}
else if (CONSP (filepos))
{
- file = XCONS (filepos)->car;
- position = XINT (XCONS (filepos)->cdr);
- if (position < 0)
- position = - position;
+ file = XCAR (filepos);
+ position = XINT (XCDR (filepos));
}
else
return Qnil;
+ if (position < 0)
+ position = - position;
+
if (!STRINGP (Vdoc_directory))
return Qnil;
if (!STRINGP (file))
return Qnil;
-
+
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
if (NILP (tem))
{
- minsize = XSTRING (Vdoc_directory)->size;
+ minsize = SCHARS (Vdoc_directory);
/* sizeof ("../etc/") == 8 */
if (minsize < 8)
minsize = 8;
- name = (char *) alloca (minsize + XSTRING (file)->size + 8);
- strcpy (name, XSTRING (Vdoc_directory)->data);
- strcat (name, XSTRING (file)->data);
+ name = (char *) alloca (minsize + SCHARS (file) + 8);
+ strcpy (name, SDATA (Vdoc_directory));
+ strcat (name, SDATA (file));
munge_doc_file_name (name);
}
else
{
- name = (char *) XSTRING (file)->data;
+ name = (char *) SDATA (file);
}
- fd = open (name, O_RDONLY, 0);
+ fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
{
#ifndef CANNOT_DUMP
/* Preparing to dump; DOC file is probably not installed.
So check in ../etc. */
strcpy (name, "../etc/");
- strcat (name, XSTRING (file)->data);
+ strcat (name, SDATA (file));
munge_doc_file_name (name);
- fd = open (name, O_RDONLY, 0);
+ fd = emacs_open (name, O_RDONLY, 0);
}
#endif
if (fd < 0)
}
/* Seek only to beginning of disk block. */
- offset = position % (8 * 1024);
+ /* Make sure we read at least 1024 bytes before `position'
+ so we can check the leading text for consistency. */
+ offset = min (position, max (1024, position % (8 * 1024)));
if (0 > lseek (fd, position - offset, 0))
{
- close (fd);
+ emacs_close (fd);
error ("Position %ld out of range in doc string file \"%s\"",
position, name);
}
If we read the same block last time, maybe skip this? */
if (space_left > 1024 * 8)
space_left = 1024 * 8;
- nread = read (fd, p, space_left);
+ nread = emacs_read (fd, p, space_left);
if (nread < 0)
{
- close (fd);
+ emacs_close (fd);
error ("Read error on documentation file");
}
p[nread] = 0;
if (!nread)
break;
if (p == get_doc_string_buffer)
- p1 = index (p + offset, '\037');
+ p1 = (char *) index (p + offset, '\037');
else
- p1 = index (p, '\037');
+ p1 = (char *) index (p, '\037');
if (p1)
{
*p1 = 0;
}
p += nread;
}
- close (fd);
+ emacs_close (fd);
+
+ /* Sanity checking. */
+ if (CONSP (filepos))
+ {
+ int test = 1;
+ if (get_doc_string_buffer[offset - test++] != ' ')
+ return Qnil;
+ while (get_doc_string_buffer[offset - test] >= '0'
+ && get_doc_string_buffer[offset - test] <= '9')
+ test++;
+ if (get_doc_string_buffer[offset - test++] != '@'
+ || get_doc_string_buffer[offset - test] != '#')
+ return Qnil;
+ }
+ else
+ {
+ int test = 1;
+ if (get_doc_string_buffer[offset - test++] != '\n')
+ return Qnil;
+ while (get_doc_string_buffer[offset - test] > ' ')
+ test++;
+ if (get_doc_string_buffer[offset - test] != '\037')
+ return Qnil;
+ }
/* Scan the text and perform quoting with ^A (char code 1).
^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
*to++ = *from++;
}
- return make_string (get_doc_string_buffer + offset,
- to - (get_doc_string_buffer + offset));
+ /* If DEFINITION, read from this buffer
+ the same way we would read bytes from a file. */
+ if (definition)
+ {
+ read_bytecode_pointer = get_doc_string_buffer + offset;
+ return Fread (Qlambda);
+ }
+
+ if (unibyte)
+ return make_unibyte_string (get_doc_string_buffer + offset,
+ to - (get_doc_string_buffer + offset));
+ else
+ {
+ /* Let the data determine whether the string is multibyte,
+ even if Emacs is running in --unibyte mode. */
+ int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset,
+ to - (get_doc_string_buffer + offset));
+ return make_string_from_bytes (get_doc_string_buffer + offset,
+ nchars,
+ to - (get_doc_string_buffer + offset));
+ }
}
/* Get a string from position FILEPOS and pass it through the Lisp reader.
read_doc_string (filepos)
Lisp_Object filepos;
{
- return Fread (get_doc_string (filepos));
+ return get_doc_string (filepos, 0, 1);
+}
+
+static int
+reread_doc_file (file)
+ Lisp_Object file;
+{
+#if 0
+ Lisp_Object reply, prompt[3];
+ struct gcpro gcpro1;
+ GCPRO1 (file);
+ prompt[0] = build_string ("File ");
+ prompt[1] = NILP (file) ? Vdoc_file_name : file;
+ prompt[2] = build_string (" is out of sync. Reload? ");
+ reply = Fy_or_n_p (Fconcat (3, prompt));
+ UNGCPRO;
+ if (NILP (reply))
+ return 0;
+#endif
+
+ if (NILP (file))
+ Fsnarf_documentation (Vdoc_file_name);
+ else
+ Fload (file, Qt, Qt, Qt, Qnil);
+
+ return 1;
}
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
- "Return the documentation string of FUNCTION.\n\
-Unless a non-nil second argument RAW is given, the\n\
-string is passed through `substitute-command-keys'.")
- (function, raw)
+ doc: /* Return the documentation string of FUNCTION.
+Unless a non-nil second argument RAW is given, the
+string is passed through `substitute-command-keys'. */)
+ (function, raw)
Lisp_Object function, raw;
{
Lisp_Object fun;
Lisp_Object funcar;
Lisp_Object tem, doc;
+ int try_reload = 1;
- fun = Findirect_function (function);
+ documentation:
+ doc = Qnil;
+
+ if (SYMBOLP (function)
+ && (tem = Fget (function, Qfunction_documentation),
+ !NILP (tem)))
+ return Fdocumentation_property (function, Qfunction_documentation, raw);
+
+ fun = Findirect_function (function, Qnil);
if (SUBRP (fun))
{
- if (XSUBR (fun)->doc == 0) return Qnil;
- if ((EMACS_INT) XSUBR (fun)->doc >= 0)
+ if (XSUBR (fun)->doc == 0)
+ return Qnil;
+ else if ((EMACS_INT) XSUBR (fun)->doc >= 0)
doc = build_string (XSUBR (fun)->doc);
else
- doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc));
+ doc = make_number ((EMACS_INT) XSUBR (fun)->doc);
}
else if (COMPILEDP (fun))
{
- if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
+ if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
return Qnil;
- tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
+ tem = AREF (fun, COMPILED_DOC_STRING);
if (STRINGP (tem))
doc = tem;
else if (NATNUMP (tem) || CONSP (tem))
- doc = get_doc_string (tem);
+ doc = tem;
else
return Qnil;
}
if (!SYMBOLP (funcar))
return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
else if (EQ (funcar, Qkeymap))
- return build_string ("Prefix command (definition is a keymap associating keystrokes with\n\
-subcommands.)");
+ return build_string ("Prefix command (definition is a keymap associating keystrokes with commands).");
else if (EQ (funcar, Qlambda)
|| EQ (funcar, Qautoload))
{
doc = tem;
/* Handle a doc reference--but these never come last
in the function body, so reject them if they are last. */
- else if ((NATNUMP (tem) || CONSP (tem))
- && ! NILP (XCONS (tem1)->cdr))
- doc = get_doc_string (tem);
+ else if ((NATNUMP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
+ && !NILP (XCDR (tem1)))
+ doc = tem;
else
return Qnil;
}
- else if (EQ (funcar, Qmocklisp))
- return Qnil;
else if (EQ (funcar, Qmacro))
return Fdocumentation (Fcdr (fun), raw);
else
Fsignal (Qinvalid_function, Fcons (fun, Qnil));
}
- if (NILP (raw))
+ /* If DOC is 0, it's typically because of a dumped file missing
+ from the DOC file (bug in src/Makefile.in). */
+ if (EQ (doc, make_number (0)))
+ doc = Qnil;
+ if (INTEGERP (doc) || CONSP (doc))
{
- struct gcpro gcpro1;
-
- GCPRO1 (doc);
- doc = Fsubstitute_command_keys (doc);
- UNGCPRO;
+ Lisp_Object tem;
+ tem = get_doc_string (doc, 0, 0);
+ if (NILP (tem) && try_reload)
+ {
+ /* The file is newer, we need to reset the pointers. */
+ struct gcpro gcpro1, gcpro2;
+ GCPRO2 (function, raw);
+ try_reload = reread_doc_file (Fcar_safe (doc));
+ UNGCPRO;
+ if (try_reload)
+ {
+ try_reload = 0;
+ goto documentation;
+ }
+ }
+ else
+ doc = tem;
}
+
+ if (NILP (raw))
+ doc = Fsubstitute_command_keys (doc);
return doc;
}
-DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 3, 0,
- "Return the documentation string that is SYMBOL's PROP property.\n\
-This is like `get', but it can refer to strings stored in the\n\
-`etc/DOC' file; and if the value is a string, it is passed through\n\
-`substitute-command-keys'. A non-nil third argument RAW avoids this\n\
-translation.")
+DEFUN ("documentation-property", Fdocumentation_property,
+ Sdocumentation_property, 2, 3, 0,
+ doc: /* Return the documentation string that is SYMBOL's PROP property.
+Third argument RAW omitted or nil means pass the result through
+`substitute-command-keys' if it is a string.
+
+This differs from `get' in that it can refer to strings stored in the
+`etc/DOC' file; and that it evaluates documentation properties that
+aren't strings. */)
(symbol, prop, raw)
Lisp_Object symbol, prop, raw;
{
- register Lisp_Object tem;
+ int try_reload = 1;
+ Lisp_Object tem;
+
+ documentation_property:
tem = Fget (symbol, prop);
- if (INTEGERP (tem))
- tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)));
- else if (CONSP (tem))
- tem = get_doc_string (tem);
+ if (EQ (tem, make_number (0)))
+ tem = Qnil;
+ if (INTEGERP (tem) || (CONSP (tem) && INTEGERP (XCDR (tem))))
+ {
+ Lisp_Object doc = tem;
+ tem = get_doc_string (tem, 0, 0);
+ if (NILP (tem) && try_reload)
+ {
+ /* The file is newer, we need to reset the pointers. */
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ GCPRO3 (symbol, prop, raw);
+ try_reload = reread_doc_file (Fcar_safe (doc));
+ UNGCPRO;
+ if (try_reload)
+ {
+ try_reload = 0;
+ goto documentation_property;
+ }
+ }
+ }
+ else if (!STRINGP (tem))
+ /* Feval protects its argument. */
+ tem = Feval (tem);
+
if (NILP (raw) && STRINGP (tem))
- return Fsubstitute_command_keys (tem);
+ tem = Fsubstitute_command_keys (tem);
return tem;
}
\f
{
Lisp_Object tem;
- tem = XCONS (fun)->car;
+ tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
{
tem = Fcdr (Fcdr (fun));
- if (CONSP (tem) && INTEGERP (XCONS (tem)->car))
- XSETFASTINT (XCONS (tem)->car, offset);
+ if (CONSP (tem) && INTEGERP (XCAR (tem)))
+ XSETCARFASTINT (tem, offset);
}
else if (EQ (tem, Qmacro))
- store_function_docstring (XCONS (fun)->cdr, offset);
+ store_function_docstring (XCDR (fun), offset);
}
/* Bytecode objects sometimes have slots for it. */
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
- if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
- XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
+ if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
+ XSETFASTINT (AREF (fun, COMPILED_DOC_STRING), offset);
}
}
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
- 1, 1, 0,
- "Used during Emacs initialization, before dumping runnable Emacs,\n\
-to find pointers to doc strings stored in `etc/DOC...' and\n\
-record them in function definitions.\n\
-One arg, FILENAME, a string which does not include a directory.\n\
-The file is found in `../etc' now; found in the `data-directory'\n\
-when doc strings are referred to later in the dumped Emacs.")
- (filename)
+ 1, 1, 0,
+ doc: /* Used during Emacs initialization to scan the `etc/DOC...' file.
+This searches the `etc/DOC...' file for doc strings and
+records them in function and variable definitions.
+The function takes one argument, FILENAME, a string;
+it specifies the file name (without a directory) of the DOC file.
+That file is found in `../etc' now; later, when the dumped Emacs is run,
+the same file name is found in the `doc-directory'. */)
+ (filename)
Lisp_Object filename;
{
int fd;
register int filled;
register int pos;
register char *p, *end;
- Lisp_Object sym, fun, tem;
+ Lisp_Object sym;
char *name;
- extern char *index ();
-
-#ifndef CANNOT_DUMP
- if (NILP (Vpurify_flag))
- error ("Snarf-documentation can only be called in an undumped Emacs");
-#endif
+ int skip_file = 0;
- CHECK_STRING (filename, 0);
+ CHECK_STRING (filename);
+ if
#ifndef CANNOT_DUMP
- name = (char *) alloca (XSTRING (filename)->size + 14);
- strcpy (name, "../etc/");
+ (!NILP (Vpurify_flag))
#else /* CANNOT_DUMP */
- CHECK_STRING (Vdoc_directory, 0);
- name = (char *) alloca (XSTRING (filename)->size +
- XSTRING (Vdoc_directory)->size + 1);
- strcpy (name, XSTRING (Vdoc_directory)->data);
+ (0)
#endif /* CANNOT_DUMP */
- strcat (name, XSTRING (filename)->data); /*** Add this line ***/
-#ifdef VMS
-#ifndef VMS4_4
- /* For VMS versions with limited file name syntax,
- convert the name to something VMS will allow. */
- p = name;
- while (*p)
{
- if (*p == '-')
- *p = '_';
- p++;
+ name = (char *) alloca (SCHARS (filename) + 14);
+ strcpy (name, "../etc/");
}
-#endif /* not VMS4_4 */
-#ifdef VMS4_4
- strcpy (name, sys_translate_unix (name));
-#endif /* VMS4_4 */
-#endif /* VMS */
-
- fd = open (name, O_RDONLY, 0);
+ else
+ {
+ CHECK_STRING (Vdoc_directory);
+ name = (char *) alloca (SCHARS (filename)
+ + SCHARS (Vdoc_directory) + 1);
+ strcpy (name, SDATA (Vdoc_directory));
+ }
+ strcat (name, SDATA (filename)); /*** Add this line ***/
+ munge_doc_file_name (name);
+
+ /* Vbuild_files is nil when temacs is run, and non-nil after that. */
+ if (NILP (Vbuild_files))
+ {
+ size_t cp_size = 0;
+ size_t to_read;
+ int nr_read;
+ char *cp = NULL;
+ char *beg, *end;
+
+ fd = emacs_open ("buildobj.lst", O_RDONLY, 0);
+ if (fd < 0)
+ report_file_error ("Opening file buildobj.lst", Qnil);
+
+ filled = 0;
+ for (;;)
+ {
+ cp_size += 1024;
+ to_read = cp_size - 1 - filled;
+ cp = xrealloc (cp, cp_size);
+ nr_read = emacs_read (fd, &cp[filled], to_read);
+ filled += nr_read;
+ if (nr_read < to_read)
+ break;
+ }
+
+ emacs_close (fd);
+ cp[filled] = 0;
+
+ for (beg = cp; *beg; beg = end)
+ {
+ int len;
+
+ while (*beg && isspace (*beg)) ++beg;
+
+ for (end = beg; *end && ! isspace (*end); ++end)
+ if (*end == '/') beg = end+1; /* skip directory part */
+
+ len = end - beg;
+ if (len > 4 && end[-4] == '.' && end[-3] == 'o')
+ len -= 2; /* Just take .o if it ends in .obj */
+
+ if (len > 0)
+ Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
+ }
+
+ xfree (cp);
+ }
+
+ fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
report_file_error ("Opening doc string file",
Fcons (build_string (name), Qnil));
while (1)
{
if (filled < 512)
- filled += read (fd, &buf[filled], sizeof buf - 1 - filled);
+ filled += emacs_read (fd, &buf[filled], sizeof buf - 1 - filled);
if (!filled)
break;
/* p points to ^_Ffunctionname\n or ^_Vvarname\n. */
if (p != end)
{
- end = index (p, '\n');
+ end = (char *) index (p, '\n');
+
+ /* See if this is a file name, and if it is a file in build-files. */
+ if (p[1] == 'S' && end - p > 4 && end[-2] == '.'
+ && (end[-1] == 'o' || end[-1] == 'c'))
+ {
+ int len = end - p - 2;
+ char *fromfile = alloca (len + 1);
+ strncpy (fromfile, &p[2], len);
+ fromfile[len] = 0;
+ if (fromfile[len-1] == 'c')
+ fromfile[len-1] = 'o';
+
+ if (EQ (Fmember (build_string (fromfile), Vbuild_files), Qnil))
+ skip_file = 1;
+ else
+ skip_file = 0;
+ }
+
sym = oblookup (Vobarray, p + 2,
multibyte_chars_in_text (p + 2, end - p - 2),
end - p - 2);
- if (SYMBOLP (sym))
+ if (! skip_file && SYMBOLP (sym))
{
/* Attach a docstring to a variable? */
if (p[1] == 'V')
else if (p[1] == 'F')
store_function_docstring (sym, pos + end + 1 - buf);
+ else if (p[1] == 'S')
+ ; /* Just a source file name boundary marker. Ignore it. */
+
else
error ("DOC file invalid at position %d", pos);
}
filled -= end - buf;
bcopy (end, buf, filled);
}
- close (fd);
+ emacs_close (fd);
return Qnil;
}
\f
DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
- Ssubstitute_command_keys, 1, 1, 0,
- "Substitute key descriptions for command names in STRING.\n\
-Return a new string which is STRING with substrings of the form \\=\\[COMMAND]\n\
-replaced by either: a keystroke sequence that will invoke COMMAND,\n\
-or \"M-x COMMAND\" if COMMAND is not on any keys.\n\
-Substrings of the form \\=\\{MAPVAR} are replaced by summaries\n\
-\(made by describe-bindings) of the value of MAPVAR, taken as a keymap.\n\
-Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR\n\
-as the keymap for future \\=\\[COMMAND] substrings.\n\
-\\=\\= quotes the following character and is discarded;\n\
-thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.")
- (string)
+ Ssubstitute_command_keys, 1, 1, 0,
+ doc: /* Substitute key descriptions for command names in STRING.
+Substrings of the form \\=\\[COMMAND] replaced by either: a keystroke
+sequence that will invoke COMMAND, or "M-x COMMAND" if COMMAND is not
+on any keys.
+Substrings of the form \\=\\{MAPVAR} are replaced by summaries
+\(made by `describe-bindings') of the value of MAPVAR, taken as a keymap.
+Substrings of the form \\=\\<MAPVAR> specify to use the value of MAPVAR
+as the keymap for future \\=\\[COMMAND] substrings.
+\\=\\= quotes the following character and is discarded;
+thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output.
+
+Returns original STRING if no substitutions were made. Othwerwise,
+a new string, without any text properties, is returned. */)
+ (string)
Lisp_Object string;
{
unsigned char *buf;
register unsigned char *bufp;
int idx;
int bsize;
- unsigned char *new;
Lisp_Object tem;
Lisp_Object keymap;
unsigned char *start;
if (NILP (string))
return Qnil;
- CHECK_STRING (string, 0);
+ CHECK_STRING (string);
tem = Qnil;
keymap = Qnil;
name = Qnil;
if (NILP (keymap))
keymap = Voverriding_local_map;
- bsize = XSTRING (string)->size_byte;
+ bsize = SBYTES (string);
bufp = buf = (unsigned char *) xmalloc (bsize);
- strp = (unsigned char *) XSTRING (string)->data;
- while (strp < XSTRING (string)->data + XSTRING (string)->size_byte)
+ strp = SDATA (string);
+ while (strp < SDATA (string) + SBYTES (string))
{
if (strp[0] == '\\' && strp[1] == '=')
{
if (multibyte)
{
int len;
- int maxlen = XSTRING (string)->data + XSTRING (string)->size_byte - strp;
+ int maxlen = SDATA (string) + SBYTES (string) - strp;
STRING_CHAR_AND_LENGTH (strp, maxlen, len);
if (len == 1)
}
else if (strp[0] == '\\' && strp[1] == '[')
{
- Lisp_Object firstkey;
+ int start_idx;
+ int follow_remap = 1;
changed = 1;
strp += 2; /* skip \[ */
start = strp;
+ start_idx = start - SDATA (string);
- while ((strp - (unsigned char *) XSTRING (string)->data
- < XSTRING (string)->size_byte)
+ while ((strp - SDATA (string)
+ < SBYTES (string))
&& *strp != ']')
strp++;
length_byte = strp - start;
strp++; /* skip ] */
/* Save STRP in IDX. */
- idx = strp - (unsigned char *) XSTRING (string)->data;
- tem = Fintern (make_string (start, length_byte), Qnil);
- tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
-
- /* Disregard menu bar bindings; it is positively annoying to
- mention them when there's no menu bar, and it isn't terribly
- useful even when there is a menu bar. */
- if (!NILP (tem))
+ idx = strp - SDATA (string);
+ name = Fintern (make_string (start, length_byte), Qnil);
+
+ do_remap:
+ /* Ignore remappings unless there are no ordinary bindings. */
+ tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qt);
+ if (NILP (tem))
+ tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil);
+
+ if (VECTORP (tem) && XVECTOR (tem)->size > 1
+ && EQ (AREF (tem, 0), Qremap) && SYMBOLP (AREF (tem, 1))
+ && follow_remap)
{
- firstkey = Faref (tem, make_number (0));
- if (EQ (firstkey, Qmenu_bar))
- tem = Qnil;
+ name = AREF (tem, 1);
+ follow_remap = 0;
+ goto do_remap;
}
+ /* Note the Fwhere_is_internal can GC, so we have to take
+ relocation of string contents into account. */
+ strp = SDATA (string) + idx;
+ start = SDATA (string) + start_idx;
+
if (NILP (tem)) /* but not on any keys */
{
- new = (unsigned char *) xrealloc (buf, bsize += 4);
- bufp += new - buf;
- buf = new;
+ int offset = bufp - buf;
+ buf = (unsigned char *) xrealloc (buf, bsize += 4);
+ bufp = buf + offset;
bcopy ("M-x ", bufp, 4);
bufp += 4;
nchars += 4;
}
else
{ /* function is on a key */
- tem = Fkey_description (tem);
+ tem = Fkey_description (tem, Qnil);
goto subst_string;
}
}
else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
{
struct buffer *oldbuf;
+ int start_idx;
+ /* This is for computing the SHADOWS arg for describe_map_tree. */
+ Lisp_Object active_maps = Fcurrent_active_maps (Qnil);
+ Lisp_Object earlier_maps;
changed = 1;
strp += 2; /* skip \{ or \< */
start = strp;
+ start_idx = start - SDATA (string);
- while ((strp - (unsigned char *) XSTRING (string)->data
- < XSTRING (string)->size)
+ while ((strp - SDATA (string) < SBYTES (string))
&& *strp != '}' && *strp != '>')
strp++;
strp++; /* skip } or > */
/* Save STRP in IDX. */
- idx = strp - (unsigned char *) XSTRING (string)->data;
+ idx = strp - SDATA (string);
/* Get the value of the keymap in TEM, or nil if undefined.
Do this while still in the user's current buffer
{
tem = Fsymbol_value (name);
if (! NILP (tem))
- tem = get_keymap_1 (tem, 0, 1);
+ {
+ tem = get_keymap (tem, 0, 1);
+ /* Note that get_keymap can GC. */
+ strp = SDATA (string) + idx;
+ start = SDATA (string) + start_idx;
+ }
}
/* Now switch to a temp buffer. */
name = Fsymbol_name (name);
insert_string ("\nUses keymap \"");
insert_from_string (name, 0, 0,
- XSTRING (name)->size,
- XSTRING (name)->size_byte, 1);
+ SCHARS (name),
+ SBYTES (name), 1);
insert_string ("\", which is not currently defined.\n");
if (start[-1] == '<') keymap = Qnil;
}
else if (start[-1] == '<')
keymap = tem;
else
- describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
+ {
+ /* Get the list of active keymaps that precede this one.
+ If this one's not active, get nil. */
+ earlier_maps = Fcdr (Fmemq (tem, Freverse (active_maps)));
+ describe_map_tree (tem, 1, Fnreverse (earlier_maps),
+ Qnil, (char *)0, 1, 0, 0, 1);
+ }
tem = Fbuffer_string ();
Ferase_buffer ();
set_buffer_internal (oldbuf);
subst_string:
- start = XSTRING (tem)->data;
- length = XSTRING (tem)->size;
- length_byte = XSTRING (tem)->size_byte;
+ start = SDATA (tem);
+ length = SCHARS (tem);
+ length_byte = SBYTES (tem);
subst:
- new = (unsigned char *) xrealloc (buf, bsize += length_byte);
- bufp += new - buf;
- buf = new;
- bcopy (start, bufp, length_byte);
- bufp += length_byte;
- nchars += length;
- /* Check STRING again in case gc relocated it. */
- strp = (unsigned char *) XSTRING (string)->data + idx;
+ {
+ int offset = bufp - buf;
+ buf = (unsigned char *) xrealloc (buf, bsize += length_byte);
+ bufp = buf + offset;
+ bcopy (start, bufp, length_byte);
+ bufp += length_byte;
+ nchars += length;
+ /* Check STRING again in case gc relocated it. */
+ strp = (unsigned char *) SDATA (string) + idx;
+ }
}
else if (! multibyte) /* just copy other chars */
*bufp++ = *strp++, nchars++;
else
{
int len;
- int maxlen = XSTRING (string)->data + XSTRING (string)->size_byte - strp;
+ int maxlen = SDATA (string) + SBYTES (string) - strp;
STRING_CHAR_AND_LENGTH (strp, maxlen, len);
if (len == 1)
}
if (changed) /* don't bother if nothing substituted */
- tem = make_multibyte_string (buf, nchars, bufp - buf);
+ tem = make_string_from_bytes (buf, nchars, bufp - buf);
else
tem = string;
xfree (buf);
RETURN_UNGCPRO (tem);
}
\f
+void
syms_of_doc ()
{
+ Qfunction_documentation = intern ("function-documentation");
+ staticpro (&Qfunction_documentation);
+
DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,
- "Name of file containing documentation strings of built-in symbols.");
+ doc: /* Name of file containing documentation strings of built-in symbols. */);
Vdoc_file_name = Qnil;
+ DEFVAR_LISP ("build-files", &Vbuild_files,
+ doc: /* A list of files used to build this Emacs binary. */);
+ Vbuild_files = Qnil;
+
defsubr (&Sdocumentation);
defsubr (&Sdocumentation_property);
defsubr (&Ssnarf_documentation);
defsubr (&Ssubstitute_command_keys);
}
+
+/* arch-tag: 56281d4d-6949-43e2-be2e-f6517de744ba
+ (do not change this comment) */