/* Record indices of function doc strings stored in a file.
- Copyright (C) 1985, 1986, 1993, 1994, 1995 Free Software Foundation, Inc.
+ Copyright (C) 1985, 86,93,94,95,97,98,99, 2000 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, 675 Mass Ave, Cambridge, MA 02139, USA. */
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA. */
#include <config.h>
#include "lisp.h"
#include "buffer.h"
#include "keyboard.h"
+#include "charset.h"
-Lisp_Object Vdoc_file_name;
+#ifdef HAVE_INDEX
+extern char *index P_ ((const char *, int));
+#endif
+
+Lisp_Object Vdoc_file_name, Vhelp_manyarg_func_alist;
-extern char *index ();
+Lisp_Object Qfunction_documentation;
extern Lisp_Object Voverriding_local_map;
#endif /* VMS */
}
+/* Buffer used for reading from documentation file. */
+static char *get_doc_string_buffer;
+static int get_doc_string_buffer_size;
+
+static unsigned char *read_bytecode_pointer;
+
+/* 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.)
-static Lisp_Object
-get_doc_string (filepos)
+ If UNIBYTE is nonzero, always make a unibyte string.
+
+ 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 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;
+ int offset, position;
Lisp_Object file, tem;
if (INTEGERP (filepos))
}
else if (CONSP (filepos))
{
- file = XCONS (filepos)->car;
- position = XINT (XCONS (filepos)->cdr);
+ file = XCAR (filepos);
+ position = XINT (XCDR (filepos));
if (position < 0)
position = - position;
}
}
else
{
- name = XSTRING (file)->data;
+ name = (char *) XSTRING (file)->data;
}
- fd = open (name, O_RDONLY, 0);
+ fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
{
#ifndef CANNOT_DUMP
strcat (name, XSTRING (file)->data);
munge_doc_file_name (name);
- fd = open (name, O_RDONLY, 0);
+ fd = emacs_open (name, O_RDONLY, 0);
}
#endif
-
if (fd < 0)
error ("Cannot open doc string file \"%s\"", name);
}
- if (0 > lseek (fd, position, 0))
+ /* Seek only to beginning of disk block. */
+ offset = 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);
}
- /* 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. */
+ /* Read the doc string into get_doc_string_buffer.
+ P points beyond the data just read. */
- buffer = buf;
- buffer_size = sizeof buf;
- free_it = 0;
- p = buf;
+ p = get_doc_string_buffer;
while (1)
{
- int space_left = buffer_size - (p - buffer);
+ int space_left = (get_doc_string_buffer_size
+ - (p - get_doc_string_buffer));
int nread;
- /* Switch to a bigger buffer if we need one. */
+ /* Allocate or grow the buffer if we need to. */
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);
+ int in_buffer = p - get_doc_string_buffer;
+ get_doc_string_buffer_size += 16 * 1024;
+ get_doc_string_buffer
+ = (char *) xrealloc (get_doc_string_buffer,
+ get_doc_string_buffer_size + 1);
+ p = get_doc_string_buffer + in_buffer;
+ space_left = (get_doc_string_buffer_size
+ - (p - get_doc_string_buffer));
}
- /* Don't read too too much at one go. */
+ /* Read a disk block at a time.
+ 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;
- p1 = index (p, '\037');
+ if (p == get_doc_string_buffer)
+ p1 = (char *) index (p + offset, '\037');
+ else
+ p1 = (char *) index (p, '\037');
if (p1)
{
*p1 = 0;
}
p += nread;
}
- close (fd);
+ emacs_close (fd);
/* 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;
+ from = get_doc_string_buffer + offset;
+ to = get_doc_string_buffer + offset;
while (from != p)
{
if (*from == 1)
*to++ = *from++;
}
- tem = make_string (buffer, to - buffer);
- if (free_it)
- free (buffer);
+ /* 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);
+ }
- return tem;
+ 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);
}
DEFUN ("documentation", Fdocumentation, Sdocumentation, 1, 2, 0,
"Return the documentation string of FUNCTION.\n\
-Unless a non-nil second argument is given, the\n\
+Unless a non-nil second argument RAW is given, the\n\
string is passed through `substitute-command-keys'.")
(function, raw)
Lisp_Object function, raw;
Lisp_Object funcar;
Lisp_Object tem, doc;
+ if (SYMBOLP (function)
+ && (tem = Fget (function, Qfunction_documentation),
+ !NILP (tem)))
+ return Fdocumentation_property (function, Qfunction_documentation, raw);
+
fun = Findirect_function (function);
-
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 = get_doc_string (make_number (- (EMACS_INT) XSUBR (fun)->doc),
+ 0, 0);
+ if (! NILP (tem = Fassq (function, Vhelp_manyarg_func_alist)))
+ doc = concat3 (doc, build_string ("\n"), Fcdr (tem));
}
else if (COMPILEDP (fun))
{
if (STRINGP (tem))
doc = tem;
else if (NATNUMP (tem) || CONSP (tem))
- doc = get_doc_string (tem);
+ doc = get_doc_string (tem, 0, 0);
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))
{
- tem = Fcar (Fcdr (Fcdr (fun)));
+ Lisp_Object tem1;
+ tem1 = Fcdr (Fcdr (fun));
+ tem = Fcar (tem1);
if (STRINGP (tem))
doc = tem;
- else if (NATNUMP (tem) || CONSP (tem))
- doc = get_doc_string (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 (XCDR (tem1)))
+ doc = get_doc_string (tem, 0, 0);
else
return Qnil;
}
}
if (NILP (raw))
- {
- struct gcpro gcpro1;
-
- GCPRO1 (doc);
- doc = Fsubstitute_command_keys (doc);
- UNGCPRO;
- }
+ doc = Fsubstitute_command_keys (doc);
return doc;
}
-DEFUN ("documentation-property", Fdocumentation_property, Sdocumentation_property, 2, 3, 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\
-`substitute-command-keys'. A non-nil third argument avoids this\n\
-translation.")
- (sym, prop, raw)
- Lisp_Object sym, prop, raw;
+Third argument RAW omitted or nil means pass the result through\n\
+`substitute-command-keys' if it is a string.\n\
+\n\
+This is differs from `get' in that it can refer to strings stored in the\n\
+`etc/DOC' file; and that it evaluates documentation properties that\n\
+aren't strings.")
+ (symbol, prop, raw)
+ Lisp_Object symbol, prop, raw;
{
- register Lisp_Object tem;
+ Lisp_Object tem;
- tem = Fget (sym, prop);
+ 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);
+ tem = get_doc_string (XINT (tem) > 0 ? tem : make_number (- XINT (tem)), 0, 0);
+ else if (CONSP (tem) && INTEGERP (XCDR (tem)))
+ tem = get_doc_string (tem, 0, 0);
+ 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)))
+ XSETFASTINT (XCAR (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. */
register char *p, *end;
Lisp_Object sym, fun, tem;
char *name;
- extern char *index ();
#ifndef CANNOT_DUMP
if (NILP (Vpurify_flag))
#endif /* VMS4_4 */
#endif /* VMS */
- fd = open (name, O_RDONLY, 0);
+ 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');
- sym = oblookup (Vobarray, p + 2, end - p - 2);
+ end = (char *) index (p, '\n');
+ sym = oblookup (Vobarray, p + 2,
+ multibyte_chars_in_text (p + 2, end - p - 2),
+ end - p - 2);
if (SYMBOLP (sym))
{
/* Attach a docstring to a variable? */
filled -= end - buf;
bcopy (end, buf, filled);
}
- close (fd);
+ emacs_close (fd);
return Qnil;
}
\f
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.")
- (str)
- Lisp_Object str;
+ (string)
+ Lisp_Object string;
{
unsigned char *buf;
int changed = 0;
Lisp_Object tem;
Lisp_Object keymap;
unsigned char *start;
- int length;
+ int length, length_byte;
Lisp_Object name;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ int multibyte;
+ int nchars;
- if (NILP (str))
+ if (NILP (string))
return Qnil;
- CHECK_STRING (str, 0);
+ CHECK_STRING (string, 0);
tem = Qnil;
keymap = Qnil;
name = Qnil;
- GCPRO4 (str, tem, keymap, name);
+ GCPRO4 (string, tem, keymap, name);
+
+ multibyte = STRING_MULTIBYTE (string);
+ nchars = 0;
/* 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 = Voverriding_local_map;
+ or from a \\<mapname> construct in STRING itself.. */
+ keymap = current_kboard->Voverriding_terminal_local_map;
+ if (NILP (keymap))
+ keymap = Voverriding_local_map;
- bsize = XSTRING (str)->size;
+ bsize = STRING_BYTES (XSTRING (string));
bufp = buf = (unsigned char *) xmalloc (bsize);
- strp = (unsigned char *) XSTRING (str)->data;
- while (strp < (unsigned char *) XSTRING (str)->data + XSTRING (str)->size)
+ strp = (unsigned char *) XSTRING (string)->data;
+ while (strp < XSTRING (string)->data + STRING_BYTES (XSTRING (string)))
{
if (strp[0] == '\\' && strp[1] == '=')
{
/* \= quotes the next character;
thus, to put in \[ without its special meaning, use \=\[. */
changed = 1;
- *bufp++ = strp[2];
- strp += 3;
+ strp += 2;
+ if (multibyte)
+ {
+ int len;
+ int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
+
+ STRING_CHAR_AND_LENGTH (strp, maxlen, len);
+ if (len == 1)
+ *bufp = *strp;
+ else
+ bcopy (strp, bufp, len);
+ strp += len;
+ bufp += len;
+ nchars++;
+ }
+ else
+ *bufp++ = *strp++, nchars++;
}
else if (strp[0] == '\\' && strp[1] == '[')
{
Lisp_Object firstkey;
+ int start_idx;
changed = 1;
strp += 2; /* skip \[ */
start = strp;
+ start_idx = start - XSTRING (string)->data;
- while ((strp - (unsigned char *) XSTRING (str)->data
- < XSTRING (str)->size)
+ while ((strp - (unsigned char *) XSTRING (string)->data
+ < STRING_BYTES (XSTRING (string)))
&& *strp != ']')
strp++;
- length = strp - start;
+ length_byte = strp - start;
+
strp++; /* skip ] */
/* Save STRP in IDX. */
- idx = strp - (unsigned char *) XSTRING (str)->data;
- tem = Fintern (make_string (start, length), Qnil);
+ idx = strp - (unsigned char *) XSTRING (string)->data;
+ tem = Fintern (make_string (start, length_byte), Qnil);
+
+ /* Note the Fwhere_is_internal can GC, so we have to take
+ relocation of string contents into account. */
tem = Fwhere_is_internal (tem, keymap, Qt, Qnil);
+ strp = XSTRING (string)->data + idx;
+ start = XSTRING (string)->data + start_idx;
/* Disregard menu bar bindings; it is positively annoying to
mention them when there's no menu bar, and it isn't terribly
buf = new;
bcopy ("M-x ", bufp, 4);
bufp += 4;
+ nchars += 4;
+ if (multibyte)
+ length = multibyte_chars_in_text (start, length_byte);
+ else
+ length = length_byte;
goto subst;
}
else
else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<'))
{
struct buffer *oldbuf;
+ int start_idx;
changed = 1;
strp += 2; /* skip \{ or \< */
start = strp;
+ start_idx = start - XSTRING (string)->data;
- while ((strp - (unsigned char *) XSTRING (str)->data
- < XSTRING (str)->size)
+ while ((strp - (unsigned char *) XSTRING (string)->data
+ < XSTRING (string)->size)
&& *strp != '}' && *strp != '>')
strp++;
- length = strp - start;
+
+ length_byte = strp - start;
strp++; /* skip } or > */
/* Save STRP in IDX. */
- idx = strp - (unsigned char *) XSTRING (str)->data;
+ idx = strp - (unsigned char *) XSTRING (string)->data;
/* Get the value of the keymap in TEM, or nil if undefined.
Do this while still in the user's current buffer
in case it is a local variable. */
- name = Fintern (make_string (start, length), Qnil);
+ name = Fintern (make_string (start, length_byte), Qnil);
tem = Fboundp (name);
if (! NILP (tem))
{
tem = Fsymbol_value (name);
if (! NILP (tem))
- tem = get_keymap_1 (tem, 0, 1);
+ {
+ tem = get_keymap_1 (tem, 0, 1);
+ /* Note that get_keymap_1 can GC. */
+ strp = XSTRING (string)->data + idx;
+ start = XSTRING (string)->data + start_idx;
+ }
}
/* Now switch to a temp buffer. */
{
name = Fsymbol_name (name);
insert_string ("\nUses keymap \"");
- insert_from_string (name, 0, XSTRING (name)->size, 1);
+ insert_from_string (name, 0, 0,
+ XSTRING (name)->size,
+ STRING_BYTES (XSTRING (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, 0, 1);
+ describe_map_tree (tem, 1, Qnil, Qnil, (char *)0, 1, 0, 0);
tem = Fbuffer_string ();
Ferase_buffer ();
set_buffer_internal (oldbuf);
subst_string:
start = XSTRING (tem)->data;
length = XSTRING (tem)->size;
+ length_byte = STRING_BYTES (XSTRING (tem));
subst:
- new = (unsigned char *) xrealloc (buf, bsize += length);
+ new = (unsigned char *) xrealloc (buf, bsize += length_byte);
bufp += new - buf;
buf = new;
- bcopy (start, bufp, length);
- bufp += length;
- /* Check STR again in case gc relocated it. */
- strp = (unsigned char *) XSTRING (str)->data + idx;
+ 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;
+ }
+ else if (! multibyte) /* just copy other chars */
+ *bufp++ = *strp++, nchars++;
+ else
+ {
+ int len;
+ int maxlen = XSTRING (string)->data + STRING_BYTES (XSTRING (string)) - strp;
+
+ STRING_CHAR_AND_LENGTH (strp, maxlen, len);
+ if (len == 1)
+ *bufp = *strp;
+ else
+ bcopy (strp, bufp, len);
+ strp += len;
+ bufp += len;
+ nchars++;
}
- else /* just copy other chars */
- *bufp++ = *strp++;
}
if (changed) /* don't bother if nothing substituted */
- tem = make_string (buf, bufp - buf);
+ tem = make_string_from_bytes (buf, nchars, bufp - buf);
else
- tem = str;
+ 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.");
Vdoc_file_name = Qnil;
+ DEFVAR_LISP ("help-manyarg-func-alist", &Vhelp_manyarg_func_alist,
+ "Alist of primitive functions and descriptions of their arg lists.\n\
+All special forms and primitives which effectively have &rest args\n\
+should have an entry here so that `documentation' can provide their\n\
+arg list.");
+ Vhelp_manyarg_func_alist = Qnil;
defsubr (&Sdocumentation);
defsubr (&Sdocumentation_property);