guile-elisp bootstrap part (C)

[bpt/emacs.git] / src / doc.c

diff --git a/src/doc.c b/src/doc.c
index df8cfba..e65159d 100644 (file)
--- a/src/doc.c
+++ b/src/doc.c
@@ -84,7 +84,6 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
   int offset;
   EMACS_INT position;
   Lisp_Object file, tem, pos;
-  ptrdiff_t count;
   USE_SAFE_ALLOCA;
 
   if (INTEGERP (filepos))
@@ -150,7 +149,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
                          file, build_string ("\"\n"));
        }
     }
-  count = SPECPDL_INDEX ();
+  dynwind_begin ();
   record_unwind_protect_int (close_file_unwind, fd);
 
   /* Seek only to beginning of disk block.  */
@@ -206,7 +205,7 @@ get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
        }
       p += nread;
     }
-  unbind_to (count, Qnil);
+  dynwind_end ();
   SAFE_FREE ();
 
   /* Sanity checking.  */
@@ -351,20 +350,11 @@ string is passed through `substitute-command-keys'.  */)
     }
 
   fun = Findirect_function (function, Qnil);
-  if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
+  if (CONSP (fun)
+      && (EQ (XCAR (fun), Qmacro)
+          || EQ (XCAR (fun), Qspecial_operator)))
     fun = XCDR (fun);
-  if (SUBRP (fun))
-    {
-      if (XSUBR (fun)->doc == 0)
-       return Qnil;
-      /* FIXME: This is not portable, as it assumes that string
-        pointers have the top bit clear.  */
-      else if ((intptr_t) XSUBR (fun)->doc >= 0)
-       doc = build_string (XSUBR (fun)->doc);
-      else
-       doc = make_number ((intptr_t) XSUBR (fun)->doc);
-    }
-  else if (COMPILEDP (fun))
+  if (COMPILEDP (fun))
     {
       if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) <= COMPILED_DOC_STRING)
        return Qnil;
@@ -379,6 +369,14 @@ string is passed through `substitute-command-keys'.  */)
            return Qnil;
        }
     }
+  else if (scm_is_true (scm_procedure_p (fun)))
+    {
+      Lisp_Object tem = scm_procedure_property (fun, intern ("emacs-documentation"));
+      if (scm_is_true (tem))
+        doc = tem;
+      else
+        return Qnil;
+    }
   else if (STRINGP (fun) || VECTORP (fun))
     {
       return build_string ("Keyboard macro.");
@@ -498,15 +496,16 @@ 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) ? XSYMBOL (obj)->function : obj;
+  Lisp_Object fun = SYMBOLP (obj) ? SYMBOL_FUNCTION (obj) : obj;
 
   /* The type determines where the docstring is stored.  */
 
-  /* Lisp_Subrs have a slot for it.  */
-  if (SUBRP (fun))
+
+  if (scm_is_true (scm_procedure_p (fun)))
     {
-      intptr_t negative_offset = - offset;
-      XSUBR (fun)->doc = (char *) negative_offset;
+      scm_set_procedure_property_x (fun,
+                                    intern ("emacs-documentation"),
+                                    make_number (offset));
     }
 
   /* If it's a lisp form, stick it in the form.  */
@@ -524,7 +523,7 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
               correctness is quite delicate.  */
            XSETCAR (tem, make_number (offset));
        }
-      else if (EQ (tem, Qmacro))
+      else if (EQ (tem, Qmacro) || EQ (tem, Qspecial_operator))
        store_function_docstring (XCDR (fun), offset);
     }
 
@@ -608,7 +607,7 @@ the same file name is found in the `doc-directory'.  */)
       report_file_errno ("Opening doc string file", build_string (name),
                         open_errno);
     }
-  count = SPECPDL_INDEX ();
+  dynwind_begin ();
   record_unwind_protect_int (close_file_unwind, fd);
   Vdoc_file_name = filename;
   filled = 0;
@@ -648,15 +647,17 @@ the same file name is found in the `doc-directory'.  */)
                 }
             }
 
-         sym = oblookup (Vobarray, p + 2,
-                         multibyte_chars_in_text ((unsigned char *) p + 2,
-                                                  end - p - 2),
-                         end - p - 2);
+         Lisp_Object tem = Ffind_symbol (make_specified_string (p + 2,
+                                                                 -1,
+                                                                 end - p - 2,
+                                                                 true),
+                                          Qnil);
+          sym = scm_c_value_ref (tem, 0);
          /* Check skip_file so that when a function is defined several
             times in different files (typically, once in xterm, once in
             w32term, ...), we only pay attention to the one that
             matters.  */
-         if (! skip_file && SYMBOLP (sym))
+         if (! skip_file && ! NILP (scm_c_value_ref (tem, 1)))
            {
              /* Attach a docstring to a variable?  */
              if (p[1] == 'V')
@@ -688,7 +689,8 @@ the same file name is found in the `doc-directory'.  */)
       filled -= end - buf;
       memmove (buf, end, filled);
     }
-  return unbind_to (count, Qnil);
+  dynwind_end ();
+  return Qnil;
 }
 \f
 DEFUN ("substitute-command-keys", Fsubstitute_command_keys,
@@ -747,7 +749,7 @@ Otherwise, return a new string.  */)
   keymap = Voverriding_local_map;
 
   bsize = SBYTES (string);
-  bufp = buf = xmalloc (bsize);
+  bufp = buf = xmalloc_atomic (bsize);
 
   strp = SDATA (string);
   while (strp < SDATA (string) + SBYTES (string))
@@ -844,7 +846,7 @@ Otherwise, return a new string.  */)
          /* This is for computing the SHADOWS arg for describe_map_tree.  */
          Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil);
          Lisp_Object earlier_maps;
-         ptrdiff_t count = SPECPDL_INDEX ();
+          dynwind_begin ();
 
          changed = 1;
          strp += 2;            /* skip \{ or \< */
@@ -909,7 +911,7 @@ Otherwise, return a new string.  */)
          tem = Fbuffer_string ();
          Ferase_buffer ();
          set_buffer_internal (oldbuf);
-         unbind_to (count, Qnil);
+          dynwind_end ();
 
        subst_string:
          start = SDATA (tem);
@@ -951,12 +953,14 @@ Otherwise, return a new string.  */)
   else
     tem = string;
   xfree (buf);
-  RETURN_UNGCPRO (tem);
+  return tem;
 }
 \f
 void
 syms_of_doc (void)
 {
+#include "doc.x"
+
   DEFSYM (Qfunction_documentation, "function-documentation");
 
   DEFVAR_LISP ("internal-doc-file-name", Vdoc_file_name,
@@ -966,9 +970,4 @@ syms_of_doc (void)
   DEFVAR_LISP ("build-files", Vbuild_files,
                doc: /* A list of files used to build this Emacs binary.  */);
   Vbuild_files = Qnil;
-
-  defsubr (&Sdocumentation);
-  defsubr (&Sdocumentation_property);
-  defsubr (&Ssnarf_documentation);
-  defsubr (&Ssubstitute_command_keys);
 }