/* Record indices of function doc strings stored in a file.
Copyright (C) 1985, 1986, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+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 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, 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
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, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include <sys/types.h>
-#include <sys/file.h> /* Must be after sys/types.h for USG and BSD4_1*/
+#include <sys/file.h> /* Must be after sys/types.h for USG*/
#include <ctype.h>
+#include <setjmp.h>
#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#include "lisp.h"
#include "buffer.h"
#include "keyboard.h"
-#include "charset.h"
+#include "character.h"
#include "keymap.h"
+#include "buildobj.h"
#ifdef HAVE_INDEX
extern char *index P_ ((const char *, int));
/* A list of files used to build this Emacs binary. */
static Lisp_Object Vbuild_files;
-extern Lisp_Object Voverriding_local_map;
+extern Lisp_Object Voverriding_local_map, Qclosure;
extern Lisp_Object Qremap;
-/* 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 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 /* NO_HYPHENS_IN_FILENAMES */
-#endif /* VMS */
-}
-
/* Buffer used for reading from documentation file. */
static char *get_doc_string_buffer;
static int get_doc_string_buffer_size;
name = (char *) alloca (minsize + SCHARS (file) + 8);
strcpy (name, SDATA (Vdoc_directory));
strcat (name, SDATA (file));
- munge_doc_file_name (name);
}
else
{
So check in ../etc. */
strcpy (name, "../etc/");
strcat (name, SDATA (file));
- munge_doc_file_name (name);
fd = emacs_open (name, O_RDONLY, 0);
}
else
return Qnil;
}
+ else if (FUNVECP (fun))
+ {
+ /* Unless otherwise handled, funvecs have no documentation. */
+ return Qnil;
+ }
else if (STRINGP (fun) || VECTORP (fun))
{
return build_string ("Keyboard macro.");
else
return Qnil;
}
+ else if (EQ (funcar, Qclosure))
+ return Fdocumentation (Fcdr (XCDR (fun)), raw);
else if (EQ (funcar, Qmacro))
return Fdocumentation (Fcdr (fun), raw);
else
xsignal1 (Qinvalid_function, fun);
}
+ /* Check for an advised function. Its doc string
+ has an `ad-advice-info' text property. */
+ if (STRINGP (doc))
+ {
+ Lisp_Object innerfunc;
+ innerfunc = Fget_text_property (make_number (0),
+ intern ("ad-advice-info"),
+ doc);
+ if (! NILP (innerfunc))
+ doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
+ }
+
/* 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)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
- XSETCARFASTINT (tem, offset);
+ XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset);
+ else if (EQ (tem, Qclosure))
+ store_function_docstring (Fcdr (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 ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
- XSETFASTINT (AREF (fun, COMPILED_DOC_STRING), offset);
+ ASET (fun, COMPILED_DOC_STRING, make_number (offset));
}
}
+static const char buildobj[] = BUILDOBJ;
DEFUN ("Snarf-documentation", Fsnarf_documentation, Ssnarf_documentation,
1, 1, 0,
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;
+ const char *beg, *end;
- for (beg = cp; *beg; beg = end)
+ for (beg = buildobj; *beg; beg = end)
{
int len;
if (len > 0)
Vbuild_files = Fcons (make_string (beg, len), Vbuild_files);
}
-
- xfree (cp);
+ Vbuild_files = Fpurecopy (Vbuild_files);
}
fd = emacs_open (name, O_RDONLY, 0);
if (multibyte)
{
int len;
- int maxlen = SDATA (string) + SBYTES (string) - strp;
- STRING_CHAR_AND_LENGTH (strp, maxlen, len);
+ STRING_CHAR_AND_LENGTH (strp, len);
if (len == 1)
*bufp = *strp;
else
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);
+ 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))
else
{
int len;
- int maxlen = SDATA (string) + SBYTES (string) - strp;
- STRING_CHAR_AND_LENGTH (strp, maxlen, len);
+ STRING_CHAR_AND_LENGTH (strp, len);
if (len == 1)
*bufp = *strp;
else
void
syms_of_doc ()
{
- Qfunction_documentation = intern ("function-documentation");
+ Qfunction_documentation = intern_c_string ("function-documentation");
staticpro (&Qfunction_documentation);
DEFVAR_LISP ("internal-doc-file-name", &Vdoc_file_name,