summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2023-01-13 17:56:04 -0500
committerStefan Monnier <monnier@iro.umontreal.ca>2023-01-13 17:56:04 -0500
commitf5d8aa6edacc8f4d06bb78010e408034b83f98e0 (patch)
tree8d3431fcbbca2820f264b64e7292114d41fb9f11
parentf56fea2fcc0a3fbb261628ad887a0bbee72820e3 (diff)
downloademacs-f5d8aa6edacc8f4d06bb78010e408034b83f98e0.tar.gz
(function-documentation): Make it work for the remaining cases
* lisp/simple.el (function-documentation): Use `internal-subr-documentation` and make it work also with symbols and macros. * src/doc.c (Fsubr_documentation): New function, extracted from Fdocumentation. (syms_of_doc): defsubr it. (Fdocumentation): Don't handle subrs and module functions here.
-rw-r--r--lisp/simple.el11
-rw-r--r--src/doc.c34
2 files changed, 31 insertions, 14 deletions
diff --git a/lisp/simple.el b/lisp/simple.el
index f5712177234..eedc5d7244e 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2709,7 +2709,16 @@ function as needed."
(let ((doc (car body)))
(when (funcall docstring-p doc)
doc)))
- (_ (signal 'invalid-function (list function))))))
+ ((pred symbolp)
+ (let ((f (indirect-function function)))
+ (if f (function-documentation f)
+ (signal 'void-function (list function)))))
+ (`(macro . ,f) (function-documentation f))
+ (_
+ (let ((doc (internal-subr-documentation function)))
+ (if (eq t doc)
+ (signal 'invalid-function (list function))
+ doc))))))
(cl-defmethod function-documentation ((function accessor))
(oclosure--accessor-docstring function)) ;; FIXME: η-reduce!
diff --git a/src/doc.c b/src/doc.c
index df57f84603e..174341523d7 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -330,19 +330,7 @@ string is passed through `substitute-command-keys'. */)
xsignal1 (Qvoid_function, function);
if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
fun = XCDR (fun);
-#ifdef HAVE_NATIVE_COMP
- if (!NILP (Fsubr_native_elisp_p (fun)))
- doc = native_function_doc (fun);
- else
-#endif
- if (SUBRP (fun))
- doc = make_fixnum (XSUBR (fun)->doc);
-#ifdef HAVE_MODULES
- else if (MODULE_FUNCTIONP (fun))
- doc = module_function_documentation (XMODULE_FUNCTION (fun));
-#endif
- else
- doc = call1 (Qfunction_documentation, fun);
+ doc = call1 (Qfunction_documentation, fun);
/* If DOC is 0, it's typically because of a dumped file missing
from the DOC file (bug in src/Makefile.in). */
@@ -371,6 +359,25 @@ string is passed through `substitute-command-keys'. */)
return doc;
}
+DEFUN ("internal-subr-documentation", Fsubr_documentation, Ssubr_documentation, 1, 1, 0,
+ doc: /* Return the raw documentation info of a C primitive. */)
+ (Lisp_Object function)
+{
+#ifdef HAVE_NATIVE_COMP
+ if (!NILP (Fsubr_native_elisp_p (function)))
+ return native_function_doc (function);
+ else
+#endif
+ if (SUBRP (function))
+ return make_fixnum (XSUBR (function)->doc);
+#ifdef HAVE_MODULES
+ else if (MODULE_FUNCTIONP (function))
+ return module_function_documentation (XMODULE_FUNCTION (function));
+#endif
+ else
+ return Qt;
+}
+
DEFUN ("documentation-property", Fdocumentation_property,
Sdocumentation_property, 2, 3, 0,
doc: /* Return the documentation string that is SYMBOL's PROP property.
@@ -713,6 +720,7 @@ compute the correct value for the current terminal in the nil case. */);
/* Initialized by ‘main’. */
defsubr (&Sdocumentation);
+ defsubr (&Ssubr_documentation);
defsubr (&Sdocumentation_property);
defsubr (&Ssnarf_documentation);
defsubr (&Stext_quoting_style);