- (cond ((ad-compiled-p definition)
- (aref (ad-compiled-code definition) 0))
- ((consp definition)
- (car (cdr (ad-lambda-expression definition))))
- ((ad-subr-p definition)
- (if name
- (ad-subr-arglist name)
- ;; otherwise get it from its printed representation:
- (setq name (format "%s" definition))
- (string-match "^#<subr \\([^>]+\\)>$" name)
- (ad-subr-arglist (intern (match-string 1 name)))))))
-
-;; Store subr-args as `((arg1 arg2 ...))' so I can distinguish
-;; a defined empty arglist `(nil)' from an undefined arglist:
-(defmacro ad-define-subr-args (subr arglist)
- `(put ,subr 'ad-subr-arglist (list ,arglist)))
-(defmacro ad-undefine-subr-args (subr)
- `(put ,subr 'ad-subr-arglist nil))
-(defmacro ad-subr-args-defined-p (subr)
- `(get ,subr 'ad-subr-arglist))
-(defmacro ad-get-subr-args (subr)
- `(car (get ,subr 'ad-subr-arglist)))
-
-(defun ad-subr-arglist (subr-name)
- "Retrieve arglist of the subr with SUBR-NAME.
-Either use the one stored under the `ad-subr-arglist' property,
-or try to retrieve it from the docstring and cache it under
-that property, or otherwise use `(&rest ad-subr-args)'."
- (if (ad-subr-args-defined-p subr-name)
- (ad-get-subr-args subr-name)
- ;; says jwz: Should use this for Lemacs 19.8 and above:
- ;;((fboundp 'subr-min-args)
- ;; ...)
- ;; says hans: I guess what Jamie means is that I should use the values
- ;; of `subr-min-args' and `subr-max-args' to construct the subr arglist
- ;; without having to look it up via parsing the docstring, e.g.,
- ;; values 1 and 2 would suggest `(arg1 &optional arg2)' as an
- ;; argument list. However, that won't work because there is no
- ;; way to distinguish a subr with args `(a &optional b &rest c)' from
- ;; one with args `(a &rest c)' using that mechanism. Also, the argument
- ;; names from the docstring are more meaningful. Hence, I'll stick with
- ;; the old way of doing things.
- (let ((doc (or (ad-real-documentation subr-name t) "")))
- (if (not (string-match "\n\n\\((.+)\\)\\'" doc))
- ;; Signalling an error leads to bugs during bootstrapping because
- ;; the DOC file is not yet built (which is an error, BTW).
- ;; (error "The usage info is missing from the subr %s" subr-name)
- '(&rest ad-subr-args)
- (ad-define-subr-args
- subr-name
- (cdr (car (read-from-string
- (downcase (match-string 1 doc))))))
- (ad-get-subr-args subr-name)))))