Mercurial > hg > xemacs-beta

diff lisp/help.el @ 5070:b0f4adffca7d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix so that CL docstrings (with &key, etc.) handled properly -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-02-23 Ben Wing <ben@xemacs.org> * autoload.el: * autoload.el (make-autoload): * cl-macs.el (cl-function-arglist): * cl-macs.el (cl-transform-lambda): Don't add argument list with the tag "Common Lisp lambda list:"; instead add in "standard" form using "arguments:" and omitting the function name. Add an arg to `cl-function-arglist' to omit the name and use it in autoload.el instead of just hacking it off. * help.el: * help.el (function-arglist): * help.el (function-documentation-1): New. Extract out common code to recognize and/or strip the arglist from documentation into `function-documentation-1'. Use in `function-arglist' and `function-documentation'. Modify `function-arglist' so it looks for the `arguments: ' stuff in all doc strings, not just subrs/autoloads, so that CL functions get recognized properly. Change the regexp used to match "arguments: " specs to allow nested parens inside the arg list (happens when you have a default value specified in a CL arglist).
author Ben Wing <ben@xemacs.org>
date Tue, 23 Feb 2010 01:12:13 -0600
parents d6368048cd8c
children f28a4e9f0133
line wrap: on
line diff
--- a/lisp/help.el	Mon Feb 22 22:04:55 2010 -0600
+++ b/lisp/help.el	Tue Feb 23 01:12:13 2010 -0600
@@ -1,7 +1,7 @@
 ;; help.el --- help commands for XEmacs.
 
 ;; Copyright (C) 1985, 1986, 1992-4, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 2001, 2002, 2003 Ben Wing.
+;; Copyright (C) 2001, 2002, 2003, 2010 Ben Wing.
 
 ;; Maintainer: FSF
 ;; Keywords: help, internal, dumped
@@ -1182,27 +1182,21 @@
 	 (fndef (if (eq (car-safe fnc) 'macro)
 		    (cdr fnc)
 		  fnc))
+	 (args (cdr (function-documentation-1 function t)))
 	 (arglist
-	  (cond ((compiled-function-p fndef)
-		 (compiled-function-arglist fndef))
-		((eq (car-safe fndef) 'lambda)
-		 (nth 1 fndef))
-		((or (subrp fndef) (eq 'autoload (car-safe fndef)))
-		 (let* ((doc (documentation function))
-			(args (and doc
-				   (string-match
-				    "[\n\t ]*\narguments: ?(\\([^)]*\\))\n?\\'"
-				    doc)
-				   (match-string 1 doc)))
-                        (args (and args (replace-in-string args
-                                                           "[ ]*\\\\\n[ \t]*"
-                                                           " " t))))
-		   ;; If there are no arguments documented for the
-		   ;; subr, rather don't print anything.
-		   (cond ((null args) t)
-			 ((equal args "") nil)
-			 (args))))
-		(t t)))
+	  (or args
+	      (cond ((compiled-function-p fndef)
+		     (compiled-function-arglist fndef))
+		    ((eq (car-safe fndef) 'lambda)
+		     (nth 1 fndef))
+		    ((or (subrp fndef) (eq 'autoload (car-safe fndef)))
+		 
+		     ;; If there are no arguments documented for the
+		     ;; subr, rather don't print anything.
+		     (cond ((null args) t)
+			   ((equal args "") nil)
+			   (args)))
+		    (t t))))
          (print-gensym nil))
     (cond ((listp arglist)
 	   (prin1-to-string
@@ -1217,20 +1211,31 @@
 	  ((stringp arglist)
 	   (format "(%s %s)" function arglist)))))
 
-(defun function-documentation (function &optional strip-arglist)
-  "Return a string giving the documentation for FUNCTION, if any.
-If the optional argument STRIP-ARGLIST is non-nil, remove the arglist
-part of the documentation of internal subroutines."
+;; If STRIP-ARGLIST is true, return a cons (DOC . ARGS) of the documentation
+;; with any embedded arglist stripped out, and the arglist that was stripped
+;; out.  If STIRP-ARGLIST is false, the cons will be (FULL-DOC . nil),
+;; where FULL-DOC is the full documentation without the embedded arglist
+;; stripped out.
+(defun function-documentation-1 (function &optional strip-arglist)
   (let ((doc (condition-case nil
 		 (or (documentation function)
 		     (gettext "not documented"))
 	       (void-function "(alias for undefined function)")
-	       (error "(unexpected error from `documention')"))))
+	       (error "(unexpected error from `documentation')")))
+	args)
     (when (and strip-arglist
-               (string-match "[\n\t ]*\narguments: ?(\\([^)]*\\))\n?\\'" doc))
+               (string-match "[\n\t ]*\narguments: ?(\\(.*\\))\n?\\'" doc))
+      (setq args (match-string 1 doc))
       (setq doc (substring doc 0 (match-beginning 0)))
+      (and args (setq args (replace-in-string args "[ ]*\\\\\n[ \t]*" " " t)))
       (and (zerop (length doc)) (setq doc (gettext "not documented"))))
-    doc))
+    (cons doc args)))
+
+(defun function-documentation (function &optional strip-arglist)
+  "Return a string giving the documentation for FUNCTION, if any.
+If the optional argument STRIP-ARGLIST is non-nil, remove the arglist
+part of the documentation of internal subroutines, CL lambda forms, etc."
+  (car (function-documentation-1 function strip-arglist)))
 
 ;; replacement for `princ' that puts the text in the specified face,
 ;; if possible