/* Record indices of function doc strings stored in a file.
- Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1993, 1994, 1995 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)
+the Free Software Foundation; either version 2, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
-#include "config.h"
+#include <config.h>
#include <sys/types.h>
#include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
#include <fcntl.h>
#endif
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
#ifndef O_RDONLY
#define O_RDONLY 0
#endif
Lisp_Object Vdoc_file_name;
-Lisp_Object
-get_doc_string (filepos)
- long filepos;
-{
- char buf[512 * 32 + 1];
- register int fd;
- register char *name;
- register char *p, *p1;
- register int count;
- extern char *index ();
+extern char *index ();
- if (XTYPE (Vdata_directory) != Lisp_String
- || XTYPE (Vdoc_file_name) != Lisp_String)
- return Qnil;
+extern Lisp_Object Voverriding_local_map;
- name = (char *) alloca (XSTRING (Vdata_directory)->size
- + XSTRING (Vdoc_file_name)->size + 8);
- strcpy (name, XSTRING (Vdata_directory)->data);
- strcat (name, XSTRING (Vdoc_file_name)->data);
+/* For VMS versions with limited file name syntax,
+ 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,
strcpy (name, sys_translate_unix (name));
#endif /* VMS4_4 */
#endif /* VMS */
+}
+
+/* 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.) */
+
+static Lisp_Object
+get_doc_string (filepos)
+ Lisp_Object filepos;
+{
+ char buf[512 * 32 + 1];
+ char *buffer;
+ int buffer_size;
+ int free_it;
+ char *from, *to;
+ register int fd;
+ register char *name;
+ register char *p, *p1;
+ int minsize;
+ int position;
+ Lisp_Object file, tem;
+
+ if (INTEGERP (filepos))
+ {
+ file = Vdoc_file_name;
+ position = XINT (filepos);
+ }
+ else if (CONSP (filepos))
+ {
+ file = XCONS (filepos)->car;
+ position = XINT (XCONS (filepos)->cdr);
+ if (position < 0)
+ position = - position;
+ }
+ else
+ return Qnil;
+
+ 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;
+ /* 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);
+ munge_doc_file_name (name);
+ }
+ else
+ {
+ name = (char *) XSTRING (file)->data;
+ }
fd = open (name, O_RDONLY, 0);
if (fd < 0)
- error ("Cannot open doc string file \"%s\"", name);
- if (0 > lseek (fd, filepos, 0))
+ {
+#ifndef CANNOT_DUMP
+ if (!NILP (Vpurify_flag))
+ {
+ /* Preparing to dump; DOC file is probably not installed.
+ So check in ../etc. */
+ strcpy (name, "../etc/");
+ strcat (name, XSTRING (file)->data);
+ munge_doc_file_name (name);
+
+ fd = open (name, O_RDONLY, 0);
+ }
+#endif
+
+ if (fd < 0)
+ error ("Cannot open doc string file \"%s\"", name);
+ }
+
+ if (0 > lseek (fd, position, 0))
{
close (fd);
error ("Position %ld out of range in doc string file \"%s\"",
- filepos, name);
+ position, name);
}
+
+ /* Read the doc string into a buffer.
+ Use the fixed buffer BUF if it is big enough;
+ otherwise allocate one and set FREE_IT.
+ We store the buffer in use in BUFFER and its size in BUFFER_SIZE. */
+
+ buffer = buf;
+ buffer_size = sizeof buf;
+ free_it = 0;
p = buf;
- while (p != buf + sizeof buf - 1)
+ while (1)
{
- count = read (fd, p, 512);
- p[count] = 0;
- if (!count)
+ int space_left = buffer_size - (p - buffer);
+ int nread;
+
+ /* Switch to a bigger buffer if we need one. */
+ if (space_left == 0)
+ {
+ if (free_it)
+ {
+ int offset = p - buffer;
+ buffer = (char *) xrealloc (buffer,
+ buffer_size *= 2);
+ p = buffer + offset;
+ }
+ else
+ {
+ buffer = (char *) xmalloc (buffer_size *= 2);
+ bcopy (buf, buffer, p - buf);
+ p = buffer + (p - buf);
+ }
+ free_it = 1;
+ space_left = buffer_size - (p - buffer);
+ }
+
+ /* Don't read too too much at one go. */
+ if (space_left > 1024 * 8)
+ space_left = 1024 * 8;
+ nread = read (fd, p, space_left);
+ if (nread < 0)
+ {
+ close (fd);
+ error ("Read error on documentation file");
+ }
+ p[nread] = 0;
+ if (!nread)
break;
p1 = index (p, '\037');
if (p1)
p = p1;
break;
}
- p += count;
+ p += nread;
}
close (fd);
- return make_string (buf, p - buf);
+
+ /* Scan the text and perform quoting with ^A (char code 1).
+ ^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
+ from = buffer;
+ to = buffer;
+ while (from != p)
+ {
+ if (*from == 1)
+ {
+ int c;
+
+ from++;
+ c = *from++;
+ if (c == 1)
+ *to++ = c;
+ else if (c == '0')
+ *to++ = 0;
+ else if (c == '_')
+ *to++ = 037;
+ else
+ error ("Invalid data in documentation file -- ^A followed by code 0%o", c);
+ }
+ else
+ *to++ = *from++;
+ }
+
+ tem = make_string (buffer, to - buffer);
+ if (free_it)
+ free (buffer);
+
+ return tem;
+}
+
+/* Get a string from position FILEPOS and pass it through the Lisp reader.
+ We use this for fetching the bytecode string and constants vector
+ of a compiled function from the .elc file. */
+
+Lisp_Object
+read_doc_string (filepos)
+ Lisp_Object filepos;
+{
+ return Fread (get_doc_string (filepos));
}
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
fun = Findirect_function (function);
- switch (XTYPE (fun))
+ if (SUBRP (fun))
{
- case Lisp_Subr:
if (XSUBR (fun)->doc == 0) return Qnil;
- if ((int) XSUBR (fun)->doc >= 0)
+ if ((EMACS_INT) XSUBR (fun)->doc >= 0)
doc = build_string (XSUBR (fun)->doc);
else
- doc = get_doc_string (- (int) XSUBR (fun)->doc);
- break;
-
- case Lisp_Compiled:
- if (XVECTOR (fun)->size <= COMPILED_DOC_STRING)
+ doc = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc));
+ }
+ else if (COMPILEDP (fun))
+ {
+ if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
return Qnil;
tem = XVECTOR (fun)->contents[COMPILED_DOC_STRING];
- if (XTYPE (tem) == Lisp_String)
+ if (STRINGP (tem))
doc = tem;
- else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
- doc = get_doc_string (XFASTINT (tem));
+ else if (NATNUMP (tem) || CONSP (tem))
+ doc = get_doc_string (tem);
else
return Qnil;
- break;
-
- case Lisp_String:
- case Lisp_Vector:
+ }
+ else if (STRINGP (fun) || VECTORP (fun))
+ {
return build_string ("Keyboard macro.");
-
- case Lisp_Cons:
+ }
+ else if (CONSP (fun))
+ {
funcar = Fcar (fun);
- if (XTYPE (funcar) != Lisp_Symbol)
+ 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\
else if (EQ (funcar, Qlambda)
|| EQ (funcar, Qautoload))
{
- tem = Fcar (Fcdr (Fcdr (fun)));
- if (XTYPE (tem) == Lisp_String)
+ Lisp_Object tem1;
+ tem1 = Fcdr (Fcdr (fun));
+ tem = Fcar (tem1);
+ if (STRINGP (tem))
doc = tem;
- else if (XTYPE (tem) == Lisp_Int && XINT (tem) >= 0)
- doc = get_doc_string (XFASTINT (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
return Qnil;
-
- break;
}
else if (EQ (funcar, Qmocklisp))
return Qnil;
else if (EQ (funcar, Qmacro))
return Fdocumentation (Fcdr (fun), raw);
-
- /* Fall through to the default to report an error. */
-
- default:
- return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
+ else
+ goto oops;
+ }
+ else
+ {
+ oops:
+ Fsignal (Qinvalid_function, Fcons (fun, Qnil));
}
if (NILP (raw))
return doc;
}
-DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 2, 0,
+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\
register Lisp_Object tem;
tem = Fget (sym, prop);
- if (XTYPE (tem) == Lisp_Int)
- tem = get_doc_string (XINT (tem) > 0 ? XINT (tem) : - XINT (tem));
- if (NILP (raw) && XTYPE (tem) == Lisp_String)
+ 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 (NILP (raw) && STRINGP (tem))
return Fsubstitute_command_keys (tem);
return tem;
}
static void
store_function_docstring (fun, offset)
Lisp_Object fun;
- int offset;
+ /* Use EMACS_INT because we get this from pointer subtraction. */
+ EMACS_INT offset;
{
fun = indirect_function (fun);
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
- if (XTYPE (fun) == Lisp_Subr)
+ if (SUBRP (fun))
XSUBR (fun)->doc = (char *) - offset;
/* If it's a lisp form, stick it in the form. */
if (EQ (tem, Qlambda) || EQ (tem, Qautoload))
{
tem = Fcdr (Fcdr (fun));
- if (CONSP (tem) &&
- XTYPE (XCONS (tem)->car) == Lisp_Int)
- XFASTINT (XCONS (tem)->car) = offset;
+ if (CONSP (tem) && INTEGERP (XCONS (tem)->car))
+ XSETFASTINT (XCONS (tem)->car, offset);
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCONS (fun)->cdr, offset);
}
/* Bytecode objects sometimes have slots for it. */
- else if (XTYPE (fun) == Lisp_Compiled)
+ else if (COMPILEDP (fun))
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
- if (XVECTOR (fun)->size <= COMPILED_DOC_STRING)
- abort ();
-
- XFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING]) = offset;
+ if ((XVECTOR (fun)->size & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
+ XSETFASTINT (XVECTOR (fun)->contents[COMPILED_DOC_STRING], offset);
}
}
name = (char *) alloca (XSTRING (filename)->size + 14);
strcpy (name, "../etc/");
#else /* CANNOT_DUMP */
- CHECK_STRING (Vdata_directory, 0);
+ CHECK_STRING (Vdoc_directory, 0);
name = (char *) alloca (XSTRING (filename)->size +
- XSTRING (Vdata_directory)->size + 1);
- strcpy (name, XSTRING (Vdata_directory)->data);
+ XSTRING (Vdoc_directory)->size + 1);
+ strcpy (name, XSTRING (Vdoc_directory)->data);
#endif /* CANNOT_DUMP */
strcat (name, XSTRING (filename)->data); /*** Add this line ***/
#ifdef VMS
{
end = index (p, '\n');
sym = oblookup (Vobarray, p + 2, end - p - 2);
- if (XTYPE (sym) == Lisp_Symbol)
+ if (SYMBOLP (sym))
{
/* Attach a docstring to a variable? */
if (p[1] == 'V')
name = Qnil;
GCPRO4 (str, tem, keymap, name);
- keymap = current_buffer->keymap;
+ /* KEYMAP is either nil (which means search all the active keymaps)
+ or a specified local map (which means search just that and the
+ global map). If non-nil, it might come from Voverriding_local_map,
+ or from a \\<mapname> construct in STR itself.. */
+ keymap = current_kboard->Voverriding_terminal_local_map;
+ if (NILP (keymap))
+ keymap = Voverriding_local_map;
bsize = XSTRING (str)->size;
bufp = buf = (unsigned char *) xmalloc (bsize);
}
else if (strp[0] == '\\' && strp[1] == '[')
{
+ Lisp_Object firstkey;
+
changed = 1;
strp += 2; /* skip \[ */
start = strp;
/* Save STRP in IDX. */
idx = strp - (unsigned char *) XSTRING (str)->data;
tem = Fintern (make_string (start, length), Qnil);
- tem = Fwhere_is_internal (tem, keymap, Qnil, Qt, 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))
+ {
+ firstkey = Faref (tem, make_number (0));
+ if (EQ (firstkey, Qmenu_bar))
+ tem = Qnil;
+ }
if (NILP (tem)) /* but not on any keys */
{
{
name = Fsymbol_name (name);
insert_string ("\nUses keymap \"");
- insert_from_string (name, 0, XSTRING (name)->size);
+ insert_from_string (name, 0, XSTRING (name)->size, 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);
+ describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0);
tem = Fbuffer_string ();
Ferase_buffer ();
set_buffer_internal (oldbuf);
tem = make_string (buf, bufp - buf);
else
tem = str;
- free (buf);
+ xfree (buf);
RETURN_UNGCPRO (tem);
}
\f