Mercurial > hg > xemacs-beta
diff lisp/cl-macs.el @ 5070:b0f4adffca7d
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 | 8800b5350a13 |
| children | cc74f60c150e |
line wrap: on
line diff
--- 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@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@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))