/* Record indices of function doc strings stored in a file.
- Copyright (C) 1985, 1986, 1993, 1994 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,
Lisp_Object Vdoc_file_name;
+extern char *index ();
+
extern Lisp_Object Voverriding_local_map;
-Lisp_Object
-get_doc_string (filepos)
- long filepos;
+/* 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;
{
- char buf[512 * 32 + 1];
- register int fd;
- register char *name;
- register char *p, *p1;
- register int count;
- extern char *index ();
-
- if (XTYPE (Vdoc_directory) != Lisp_String
- || XTYPE (Vdoc_file_name) != Lisp_String)
- return Qnil;
-
- name = (char *) alloca (XSTRING (Vdoc_directory)->size
- + XSTRING (Vdoc_file_name)->size + 8);
- strcpy (name, XSTRING (Vdoc_directory)->data);
- strcat (name, XSTRING (Vdoc_file_name)->data);
#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))
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)
- 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);
}
}
{
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')
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;
+ 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 (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);
tem = Fbuffer_string ();
Ferase_buffer ();
set_buffer_internal (oldbuf);
HCoop / bpt / emacs.git / blobdiff