Merge from emacs-24; up to 2012-12-17T11:17:34Z!rgm@gnu.org

[gnu-emacs] / src / doc.c

diff --git a/src/doc.c b/src/doc.c
index d17e90f11c09b74eb6e8d2d867a665687b709ba8..7234fb38bf906bb5bcbd0e9a0013429c8aaea684 100644 (file)
--- a/src/doc.c
+++ b/src/doc.c
@@ -1,6 +1,7 @@
 /* Record indices of function doc strings stored in a file.
 
 /* 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.
 
 
 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 <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 <fcntl.h>
 #include <unistd.h>
 

+#include <c-ctype.h>
+

 #include "lisp.h"
 #include "character.h"
 #include "buffer.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;
 
 
 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;
 
 /* 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
    If UNREADFLAG is 1, we unread a byte.  */
 
 int

-read_bytecode_char (int unreadflag)
+read_bytecode_char (bool unreadflag)

 {
   if (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.
 
    (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
    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;
   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;
   USE_SAFE_ALLOCA;
 
   if (INTEGERP (filepos))
     {
       file = Vdoc_file_name;

-      position = XINT (filepos);
+      pos = filepos;

     }
   else if (CONSP (filepos))
     {
       file = XCAR (filepos);
     }
   else if (CONSP (filepos))
     {
       file = XCAR (filepos);

-      position = XINT (XCDR (filepos));
+      pos = XCDR (filepos);

     }
   else
     return Qnil;
 
     }
   else
     return Qnil;
 

-  if (position < 0)
-    position = - position;
+  position = eabs (XINT (pos));

 
   if (!STRINGP (Vdoc_directory))
     return Qnil;
 
   if (!STRINGP (Vdoc_directory))
     return Qnil;


@@ -147,7 +144,8 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition)
        }
 #endif
       if (fd < 0)
        }
 #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.  */
     }
 
   /* Seek only to beginning of disk block.  */


@@ -178,9 +176,9 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition)
       if (space_left <= 0)
        {
          ptrdiff_t in_buffer = p - get_doc_string_buffer;
       if (space_left <= 0)
        {
          ptrdiff_t in_buffer = p - get_doc_string_buffer;

-         get_doc_string_buffer =
-           xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
-                    16 * 1024, -1, 1);
+         get_doc_string_buffer
+           = xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
+                      16 * 1024, -1, 1);

          p = get_doc_string_buffer + in_buffer;
          space_left = (get_doc_string_buffer_size - 1
                        - (p - get_doc_string_buffer));
          p = get_doc_string_buffer + in_buffer;
          space_left = (get_doc_string_buffer_size - 1
                        - (p - get_doc_string_buffer));


@@ -281,10 +279,10 @@ Invalid data in documentation file -- %c followed by code %03o",
   else
     {
       /* The data determines whether the string is multibyte.  */
   else
     {
       /* The data determines whether the string is multibyte.  */

-      ptrdiff_t nchars =
-       multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
-                                 + offset),
-                                to - (get_doc_string_buffer + offset));
+      ptrdiff_t nchars
+       = multibyte_chars_in_text (((unsigned char *) 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));
       return make_string_from_bytes (get_doc_string_buffer + offset,
                                     nchars,
                                     to - (get_doc_string_buffer + offset));


@@ -301,7 +299,7 @@ read_doc_string (Lisp_Object filepos)
   return get_doc_string (filepos, 0, 1);
 }
 
   return get_doc_string (filepos, 0, 1);
 }
 

-static int
+static bool

 reread_doc_file (Lisp_Object file)
 {
 #if 0
 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;
   Lisp_Object fun;
   Lisp_Object funcar;
   Lisp_Object doc;

-  int try_reload = 1;
+  bool try_reload = 1;

 
  documentation:
 
 
  documentation:
 


@@ -349,6 +347,8 @@ string is passed through `substitute-command-keys'.  */)
     }
 
   fun = Findirect_function (function, Qnil);
     }
 
   fun = Findirect_function (function, Qnil);

+  if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
+    fun = XCDR (fun);

   if (SUBRP (fun))
     {
       if (XSUBR (fun)->doc == 0)
   if (SUBRP (fun))
     {
       if (XSUBR (fun)->doc == 0)


@@ -402,8 +402,6 @@ string is passed through `substitute-command-keys'.  */)
          else
            return Qnil;
        }
          else
            return Qnil;
        }

-      else if (EQ (funcar, Qmacro))
-       return Fdocumentation (Fcdr (fun), raw);

       else
        goto oops;
     }
       else
        goto oops;
     }


@@ -413,16 +411,19 @@ string is passed through `substitute-command-keys'.  */)
       xsignal1 (Qinvalid_function, fun);
     }
 
       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))
     {
   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);
                                      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
     }
 
   /* 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)
 {
 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:
   Lisp_Object tem;
 
  documentation_property:


@@ -530,6 +531,8 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
        {
          tem = Fcdr (Fcdr (fun));
          if (CONSP (tem) && INTEGERP (XCAR (tem)))
        {
          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))
            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];
 {
   int fd;
   char buf[1024 + 1];

-  register int filled;
-  register EMACS_INT pos;
-  register char *p;
+  int filled;
+  EMACS_INT pos;

   Lisp_Object sym;
   Lisp_Object sym;

-  char *name;
-  int skip_file = 0;
+  char *p, *name;
+  bool skip_file = 0;

 
   CHECK_STRING (filename);
 
 
   CHECK_STRING (filename);
 


@@ -597,9 +599,9 @@ the same file name is found in the `doc-directory'.  */)
       {
         ptrdiff_t len;
 
       {
         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;
           if (*end == '/') beg = end+1;  /* skip directory part  */
 
         len = end - beg;


@@ -628,11 +630,10 @@ the same file name is found in the `doc-directory'.  */)
        break;
 
       buf[filled] = 0;
        break;
 
       buf[filled] = 0;

-      p = buf;

       end = buf + (filled < 512 ? filled : filled - 128);
       end = buf + (filled < 512 ? filled : filled - 128);

-      while (p != end && *p != '\037') p++;
+      p = memchr (buf, '\037', end - buf);

       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */
       /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n.  */

-      if (p != end)
+      if (p)

        {
          end = strchr (p, '\n');
 
        {
          end = strchr (p, '\n');
 


@@ -721,9 +722,9 @@ Otherwise, return a new string, without any text properties.  */)
   (Lisp_Object string)
 {
   char *buf;
   (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;
   ptrdiff_t idx;
   ptrdiff_t bsize;
   Lisp_Object tem;


@@ -732,7 +733,7 @@ Otherwise, return a new string, without any text properties.  */)
   ptrdiff_t length, length_byte;
   Lisp_Object name;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   ptrdiff_t length, length_byte;
   Lisp_Object name;
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;

-  int multibyte;
+  bool multibyte;

   ptrdiff_t nchars;
 
   if (NILP (string))
   ptrdiff_t nchars;
 
   if (NILP (string))


@@ -786,7 +787,7 @@ Otherwise, return a new string, without any text properties.  */)
       else if (strp[0] == '\\' && strp[1] == '[')
        {
          ptrdiff_t start_idx;
       else if (strp[0] == '\\' && strp[1] == '[')
        {
          ptrdiff_t start_idx;

-         int follow_remap = 1;
+         bool follow_remap = 1;

 
          changed = 1;
          strp += 2;            /* skip \[ */
 
          changed = 1;
          strp += 2;            /* skip \[ */