Make `define-function' accept docstring

This makes defsubst accept that docstring as well, as in GNU Emacs.  The
use of `documentation-property' is also as in GNU Emacs.

2014-01-27  Michael Sperber  <[email protected]>

	* symbols.c (Fdefine_function): Allow optional `docstring'
	argument, as in GNU Emacs.

	* lisp.h (Qfunction_documentation): Add extern declaration.

	* doc.c (Fdocumentation_property): Move before its use.
	(Fdocumentation): Retrieve documentation from `define-function'
	docstring for symbols.

-- 
Regards,
Mike

diff --git a/src/doc.c b/src/doc.c
--- a/src/doc.c
+++ b/src/doc.c
@@ -37,6 +37,8 @@
 
 Lisp_Object QSsubstitute, Qdefvar;
 
+Lisp_Object Qfunction_documentation;
+
 /* Work out what source file a function or variable came from, taking the
    information from the documentation file. */
 
@@ -578,6 +580,45 @@
   return Qnil;
 }
 
+DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /*
+Return the documentation string that is SYMBOL's PROP property.
+This is like `get', but it can refer to strings stored in the
+`doc-directory/DOC' file; and if the value is a string, it is passed
+through `substitute-command-keys'.  A non-nil third argument avoids this
+translation.
+*/
+       (symbol, prop, raw))
+{
+  /* This function can GC */
+  Lisp_Object doc = Qnil;
+#ifdef I18N3
+  REGISTER Lisp_Object domain;
+#endif
+  struct gcpro gcpro1;
+
+  GCPRO1 (doc);
+
+  doc = Fget (symbol, prop, Qnil);
+  if (FIXNUMP (doc))
+    doc = get_doc_string (XFIXNUM (doc) > 0 ? doc : make_fixnum (- XFIXNUM (doc)));
+  else if (CONSP (doc))
+    doc = get_doc_string (doc);
+#ifdef I18N3
+  if (!NILP (doc))
+    {
+      domain = Fget (symbol, Qvariable_domain, Qnil);
+      if (NILP (domain))
+	doc = Fgettext (doc);
+      else
+	doc = Fdgettext (domain, doc);
+    }
+#endif
+  if (NILP (raw) && STRINGP (doc))
+    doc = Fsubstitute_command_keys (doc);
+  UNGCPRO;
+  return doc;
+}
+
 DEFUN ("documentation", Fdocumentation, 1, 2, 0, /*
 Return the documentation string of FUNCTION.
 Unless a non-nil second argument RAW is given, the
@@ -589,6 +630,14 @@
   Lisp_Object fun;
   Lisp_Object doc;
 
+  if (SYMBOLP (function))
+    {
+      Lisp_Object tem = Fget (function, Qfunction_documentation, Qnil);
+      if (!NILP (tem))
+	return Fdocumentation_property (function, Qfunction_documentation,
+					raw);
+    }
+
   fun = Findirect_function (function);
 
   if (SUBRP (fun))
@@ -678,45 +727,6 @@
     }
   return doc;
 }
-
-DEFUN ("documentation-property", Fdocumentation_property, 2, 3, 0, /*
-Return the documentation string that is SYMBOL's PROP property.
-This is like `get', but it can refer to strings stored in the
-`doc-directory/DOC' file; and if the value is a string, it is passed
-through `substitute-command-keys'.  A non-nil third argument avoids this
-translation.
-*/
-       (symbol, prop, raw))
-{
-  /* This function can GC */
-  Lisp_Object doc = Qnil;
-#ifdef I18N3
-  REGISTER Lisp_Object domain;
-#endif
-  struct gcpro gcpro1;
-
-  GCPRO1 (doc);
-
-  doc = Fget (symbol, prop, Qnil);
-  if (FIXNUMP (doc))
-    doc = get_doc_string (XFIXNUM (doc) > 0 ? doc : make_fixnum (- XFIXNUM (doc)));
-  else if (CONSP (doc))
-    doc = get_doc_string (doc);
-#ifdef I18N3
-  if (!NILP (doc))
-    {
-      domain = Fget (symbol, Qvariable_domain, Qnil);
-      if (NILP (domain))
-	doc = Fgettext (doc);
-      else
-	doc = Fdgettext (domain, doc);
-    }
-#endif
-  if (NILP (raw) && STRINGP (doc))
-    doc = Fsubstitute_command_keys (doc);
-  UNGCPRO;
-  return doc;
-}
 
 
 DEFUN ("Snarf-documentation", Fsnarf_documentation, 1, 1, 0, /*
@@ -1299,6 +1309,7 @@
   DEFSUBR (Fsubstitute_command_keys);
 
   DEFSYMBOL (Qdefvar);
+  DEFSYMBOL (Qfunction_documentation);
 }
 
 void
diff --git a/src/lisp.h b/src/lisp.h
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4619,6 +4619,8 @@
 /* Defined in doc.c */
 EXFUN (Fsubstitute_command_keys, 1);
 
+extern Lisp_Object Qfunction_documentation;
+
 Lisp_Object unparesseuxify_doc_string (int fd, EMACS_INT position,
 				       Ibyte *name_nonreloc,
 				       Lisp_Object name_reloc,
diff --git a/src/symbols.c b/src/symbols.c
--- a/src/symbols.c
+++ b/src/symbols.c
@@ -749,14 +749,14 @@
 }
 
 /* FSFmacs */
-DEFUN ("define-function", Fdefine_function, 2, 2, 0, /*
+DEFUN ("define-function", Fdefine_function, 2, 3, 0, /*
 Set SYMBOL's function definition to NEWDEF, and return NEWDEF.
 Associates the function with the current load file, if any.
 If NEWDEF is a compiled-function object, stores the function name in
 the `annotated' slot of the compiled-function (retrievable using
 `compiled-function-annotation').
 */
-       (symbol, newdef))
+       (symbol, newdef, docstring))
 {
   /* This function can GC */
   Ffset (symbol, newdef);
@@ -765,6 +765,10 @@
   if (COMPILED_FUNCTIONP (newdef))
     XCOMPILED_FUNCTION (newdef)->annotated = symbol;
 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
+
+  if (!NILP (docstring))
+    Fput (symbol, Qfunction_documentation, docstring);
+
   return newdef;
 }

_______________________________________________
XEmacs-Patches mailing list
[email protected]
http://lists.xemacs.org/mailman/listinfo/xemacs-patches