]> code.delx.au - gnu-emacs/blobdiff - src/doc.c
Merge from emacs-24; up to 2012-12-06T01:39:03Z!monnier@iro.umontreal.ca
[gnu-emacs] / src / doc.c
index e57b26525e1290e6b2fe90f8440d1eeaa52b29b8..16c0d4090a08e77b3e48d4bd30d988e429fb273c 100644 (file)
--- a/src/doc.c
+++ b/src/doc.c
@@ -1,6 +1,7 @@
 /* Record indices of function doc strings stored in a file.
 
-Copyright (C) 1985-1986, 1993-1995, 1997-2012 Free Software Foundation, Inc.
+Copyright (C) 1985-1986, 1993-1995, 1997-2013 Free Software Foundation,
+Inc.
 
 This file is part of GNU Emacs.
 
@@ -21,12 +22,12 @@ 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*/
-#include <ctype.h>
-#include <setjmp.h>
+#include <sys/file.h>  /* Must be after sys/types.h for USG.  */
 #include <fcntl.h>
 #include <unistd.h>
 
+#include <c-ctype.h>
+
 #include "lisp.h"
 #include "character.h"
 #include "buffer.h"
@@ -36,18 +37,17 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 Lisp_Object Qfunction_documentation;
 
-extern Lisp_Object Qclosure;
 /* Buffer used for reading from documentation file.  */
 static char *get_doc_string_buffer;
 static ptrdiff_t get_doc_string_buffer_size;
 
 static unsigned char *read_bytecode_pointer;
 
-/* readchar in lread.c calls back here to fetch the next byte.
+/* `readchar' in lread.c calls back here to fetch the next byte.
    If UNREADFLAG is 1, we unread a byte.  */
 
 int
-read_bytecode_char (int unreadflag)
+read_bytecode_char (bool unreadflag)
 {
   if (unreadflag)
     {
@@ -69,41 +69,38 @@ read_bytecode_char (int unreadflag)
    (e.g. because the file has been modified and the location is stale),
    return nil.
 
-   If UNIBYTE is nonzero, always make a unibyte string.
+   If UNIBYTE, always make a unibyte string.
 
-   If DEFINITION is nonzero, assume this is for reading
+   If DEFINITION, 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 (Lisp_Object filepos, int unibyte, int definition)
+get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
 {
-  char *from, *to;
-  register int fd;
-  register char *name;
-  register char *p, *p1;
+  char *from, *to, *name, *p, *p1;
+  int fd;
   ptrdiff_t minsize;
   int offset;
   EMACS_INT position;
-  Lisp_Object file, tem;
+  Lisp_Object file, tem, pos;
   USE_SAFE_ALLOCA;
 
   if (INTEGERP (filepos))
     {
       file = Vdoc_file_name;
-      position = XINT (filepos);
+      pos = filepos;
     }
   else if (CONSP (filepos))
     {
       file = XCAR (filepos);
-      position = XINT (XCDR (filepos));
+      pos = XCDR (filepos);
     }
   else
     return Qnil;
 
-  if (position < 0)
-    position = - position;
+  position = eabs (XINT (pos));
 
   if (!STRINGP (Vdoc_directory))
     return Qnil;
@@ -123,7 +120,7 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition)
       /* sizeof ("../etc/") == 8 */
       if (minsize < 8)
        minsize = 8;
-      SAFE_ALLOCA (name, char *, minsize + SCHARS (file) + 8);
+      name = SAFE_ALLOCA (minsize + SCHARS (file) + 8);
       strcpy (name, SSDATA (docdir));
       strcat (name, SSDATA (file));
     }
@@ -147,7 +144,8 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition)
        }
 #endif
       if (fd < 0)
-       error ("Cannot open doc string file \"%s\"", name);
+       return concat3 (build_string ("Cannot open doc string file \""),
+                       file, build_string ("\"\n"));
     }
 
   /* Seek only to beginning of disk block.  */
@@ -301,7 +299,7 @@ read_doc_string (Lisp_Object filepos)
   return get_doc_string (filepos, 0, 1);
 }
 
-static int
+static bool
 reread_doc_file (Lisp_Object file)
 {
 #if 0
@@ -334,7 +332,7 @@ string is passed through `substitute-command-keys'.  */)
   Lisp_Object fun;
   Lisp_Object funcar;
   Lisp_Object doc;
-  int try_reload = 1;
+  bool try_reload = 1;
 
  documentation:
 
@@ -349,6 +347,8 @@ string is passed through `substitute-command-keys'.  */)
     }
 
   fun = Findirect_function (function, Qnil);
+  if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
+    fun = XCDR (fun);
   if (SUBRP (fun))
     {
       if (XSUBR (fun)->doc == 0)
@@ -402,8 +402,6 @@ string is passed through `substitute-command-keys'.  */)
          else
            return Qnil;
        }
-      else if (EQ (funcar, Qmacro))
-       return Fdocumentation (Fcdr (fun), raw);
       else
        goto oops;
     }
@@ -413,16 +411,19 @@ string is passed through `substitute-command-keys'.  */)
       xsignal1 (Qinvalid_function, fun);
     }
 
-  /* Check for an advised function.  Its doc string
-     has an `ad-advice-info' text property.  */
+  /* Check for a dynamic docstring.  These come with
+     a dynamic-docstring-function text property.  */
   if (STRINGP (doc))
     {
-      Lisp_Object innerfunc;
-      innerfunc = Fget_text_property (make_number (0),
-                                     intern ("ad-advice-info"),
+      Lisp_Object func
+       = Fget_text_property (make_number (0),
+                             intern ("dynamic-docstring-function"),
                                      doc);
-      if (! NILP (innerfunc))
-       doc = call1 (intern ("ad-make-advised-docstring"), innerfunc);
+      if (!NILP (func))
+       /* Pass both `doc' and `function' since `function' can be needed, and
+          finding `doc' can be annoying: calling `documentation' is not an
+          option because it would infloop.  */
+       doc = call2 (func, doc, function);
     }
 
   /* If DOC is 0, it's typically because of a dumped file missing
@@ -466,7 +467,7 @@ This differs from `get' in that it can refer to strings stored in the
 aren't strings.  */)
   (Lisp_Object symbol, Lisp_Object prop, Lisp_Object raw)
 {
-  int try_reload = 1;
+  bool try_reload = 1;
   Lisp_Object tem;
 
  documentation_property:
@@ -508,7 +509,7 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
 {
   /* Don't use indirect_function here, or defaliases will apply their
      docstrings to the base functions (Bug#2603).  */
-  Lisp_Object fun = SYMBOLP (obj) ? SVAR (XSYMBOL (obj), function) : obj;
+  Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
 
   /* The type determines where the docstring is stored.  */
 
@@ -530,6 +531,8 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
        {
          tem = Fcdr (Fcdr (fun));
          if (CONSP (tem) && INTEGERP (XCAR (tem)))
+           /* FIXME: This modifies typically pure hash-cons'd data, so its
+              correctness is quite delicate.  */
            XSETCAR (tem, make_number (offset));
        }
       else if (EQ (tem, Qmacro))
@@ -561,12 +564,11 @@ the same file name is found in the `doc-directory'.  */)
 {
   int fd;
   char buf[1024 + 1];
-  register int filled;
-  register EMACS_INT pos;
-  register char *p;
+  int filled;
+  EMACS_INT pos;
   Lisp_Object sym;
-  char *name;
-  int skip_file = 0;
+  char *p, *name;
+  bool skip_file = 0;
 
   CHECK_STRING (filename);
 
@@ -597,9 +599,9 @@ the same file name is found in the `doc-directory'.  */)
       {
         ptrdiff_t len;
 
-        while (*beg && isspace (*beg)) ++beg;
+        while (*beg && c_isspace (*beg)) ++beg;
 
-        for (end = beg; *end && ! isspace (*end); ++end)
+        for (end = beg; *end && ! c_isspace (*end); ++end)
           if (*end == '/') beg = end+1;  /* skip directory part  */
 
         len = end - beg;
@@ -721,9 +723,9 @@ Otherwise, return a new string, without any text properties.  */)
   (Lisp_Object string)
 {
   char *buf;
-  int changed = 0;
-  register unsigned char *strp;
-  register char *bufp;
+  bool changed = 0;
+  unsigned char *strp;
+  char *bufp;
   ptrdiff_t idx;
   ptrdiff_t bsize;
   Lisp_Object tem;
@@ -732,7 +734,7 @@ Otherwise, return a new string, without any text properties.  */)
   ptrdiff_t length, length_byte;
   Lisp_Object name;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
-  int multibyte;
+  bool multibyte;
   ptrdiff_t nchars;
 
   if (NILP (string))
@@ -786,7 +788,7 @@ Otherwise, return a new string, without any text properties.  */)
       else if (strp[0] == '\\' && strp[1] == '[')
        {
          ptrdiff_t start_idx;
-         int follow_remap = 1;
+         bool follow_remap = 1;
 
          changed = 1;
          strp += 2;            /* skip \[ */