changeset 5789:72c5d36ba3b6

Make `define-function' accept docstring, as in GNU Emacs. 2014-01-27 Michael Sperber <mike@xemacs.org> * 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.
author Mike Sperber <sperber@deinprogramm.de>
date Mon, 27 Jan 2014 17:50:57 +0100
parents 6a6c89b53c5d
children dcf9067f26bb
files src/ChangeLog src/doc.c src/lisp.h src/symbols.c
diffstat 4 files changed, 69 insertions(+), 41 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Mon Jan 27 17:45:03 2014 +0100
+++ b/src/ChangeLog	Mon Jan 27 17:50:57 2014 +0100
@@ -1,3 +1,14 @@
+2014-01-27  Michael Sperber  <mike@xemacs.org>
+
+	* 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.
+
 2014-01-23  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* text.h (buffered_bytecount_to_charcount): This was
--- a/src/doc.c	Mon Jan 27 17:45:03 2014 +0100
+++ b/src/doc.c	Mon Jan 27 17:50:57 2014 +0100
@@ -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
--- a/src/lisp.h	Mon Jan 27 17:45:03 2014 +0100
+++ b/src/lisp.h	Mon Jan 27 17:50:57 2014 +0100
@@ -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,
--- a/src/symbols.c	Mon Jan 27 17:45:03 2014 +0100
+++ b/src/symbols.c	Mon Jan 27 17:50:57 2014 +0100
@@ -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;
 }