# HG changeset patch # User Ben Wing # Date 1266909133 21600 # Node ID b0f4adffca7d2eff7e47459f9e4e449b8672694e # Parent 14f0dd1fabdb2a57d7a30d58d108130f099fb119 fix so that CL docstrings (with &key, etc.) handled properly -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-02-23 Ben Wing * 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 + + * 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 * 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 ;; 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@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)) 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