commit: fix so that CL docstrings (with &key, etc.) handled properly
Ben Wing
ben at xemacs.org
Tue Feb 23 06:23:12 EST 2010
changeset: 5070:b0f4adffca7d
user: Ben Wing <ben at xemacs.org>
date: Tue Feb 23 01:12:13 2010 -0600
files: lisp/ChangeLog lisp/autoload.el lisp/cl-macs.el lisp/help.el
description:
fix so that CL docstrings (with &key, etc.) handled properly
-------------------- ChangeLog entries follow: --------------------
lisp/ChangeLog addition:
2010-02-23 Ben Wing <ben at 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).
diff -r 14f0dd1fabdb -r b0f4adffca7d lisp/ChangeLog
--- a/lisp/ChangeLog Mon Feb 22 22:04:55 2010 -0600
+++ b/lisp/ChangeLog Tue Feb 23 01:12:13 2010 -0600
@@ -1,3 +1,26 @@
+2010-02-23 Ben Wing <ben at 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).
+
2010-02-22 Ben Wing <ben at xemacs.org>
* test-harness.el:
diff -r 14f0dd1fabdb -r b0f4adffca7d lisp/autoload.el
--- a/lisp/autoload.el Mon Feb 22 22:04:55 2010 -0600
+++ b/lisp/autoload.el Tue Feb 23 01:12:13 2010 -0600
@@ -2,7 +2,7 @@
;; Copyright (C) 1991-1994, 1997, 2003 Free Software Foundation, Inc.
;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
-;; Copyright (C) 1996, 2000, 2002, 2003, 2004 Ben Wing.
+;; Copyright (C) 1996, 2000, 2002, 2003, 2004, 2010 Ben Wing.
;; Original Author: Roland McGrath <roland at gnu.ai.mit.edu>
;; Heavily Modified: XEmacs Maintainers
@@ -290,10 +290,8 @@
(placeholder (eval-when-compile (gensym))))
(setq doc (concat (or doc "")
"\n\narguments: "
- (replace-in-string
- (cl-function-arglist placeholder arglist)
- (format "^(%s ?" placeholder)
- "(") "\n"))))
+ (cl-function-arglist placeholder arglist t)
+ "\n"))))
;; `define-generic-mode' quotes the name, so take care of that
(list 'autoload (if (listp name) name (list 'quote name)) file doc
(or (and (memq car '(define-skeleton define-derived-mode
diff -r 14f0dd1fabdb -r b0f4adffca7d lisp/cl-macs.el
--- a/lisp/cl-macs.el Mon Feb 22 22:04:55 2010 -0600
+++ b/lisp/cl-macs.el Tue Feb 23 01:12:13 2010 -0600
@@ -299,29 +299,33 @@
;; npak at ispras.ru
;;;###autoload
-(defun cl-function-arglist (name arglist)
+(defun cl-function-arglist (name arglist &optional omit-name)
"Returns string with printed representation of arguments list.
Supports Common Lisp lambda lists."
+ ;; #### I would just change this so that OMIT-NAME is always true and
+ ;; eliminate the argument, but this function is autoloaded, which means
+ ;; someone might be using it somewhere.
(if (not (or (listp arglist) (symbolp arglist)))
"Not available"
(check-argument-type #'true-list-p arglist)
(let ((print-gensym nil))
(condition-case nil
(prin1-to-string
- (cons (if (eq name 'cl-none) 'lambda name)
- (cond ((null arglist) nil)
- ((listp arglist) (cl-upcase-arg arglist))
- ((symbolp arglist)
- (cl-upcase-arg (list '&rest arglist)))
- (t (wrong-type-argument 'listp arglist)))))
- (t "Not available")))))
+ (let ((args (cond ((null arglist) nil)
+ ((listp arglist) (cl-upcase-arg arglist))
+ ((symbolp arglist)
+ (cl-upcase-arg (list '&rest arglist)))
+ (t (wrong-type-argument 'listp arglist)))))
+ (if omit-name args
+ (cons (if (eq name 'cl-none) 'lambda name) args))))
+ (t "Not available")))))
(defun cl-transform-lambda (form bind-block)
(let* ((args (car form)) (body (cdr form))
(bind-defs nil) (bind-enquote nil)
(bind-inits nil) (bind-lets nil) (bind-forms nil)
(header nil) (simple-args nil)
- (complex-arglist (cl-function-arglist bind-block args))
+ (complex-arglist (cl-function-arglist bind-block args t))
(doc ""))
(while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive))
(push (pop body) header))
@@ -348,12 +352,12 @@
;; Add CL lambda list to documentation, if the CL lambda list differs
;; from the non-CL lambda list. npak at ispras.ru
(unless (equal complex-arglist
- (cl-function-arglist bind-block simple-args))
+ (cl-function-arglist bind-block simple-args t))
(and (stringp (car header)) (setq doc (pop header)))
- (push (concat doc
- "\n\nCommon Lisp lambda list:\n"
- " " complex-arglist "\n\n")
- header))
+ ;; Stick the arguments onto the end of the doc string in a way that
+ ;; will be recognized specially by `function-arglist'.
+ (push (concat doc "\n\narguments: " complex-arglist "\n")
+ header))
(if (null args)
(list* nil simple-args (nconc header body))
(if (memq '&optional simple-args) (push '&optional args))
diff -r 14f0dd1fabdb -r b0f4adffca7d lisp/help.el
--- 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
More information about the XEmacs-Patches
mailing list