- (let* ((prelim-def (eldoc-symbol-function fn))
- (def (if (eq (car-safe prelim-def) 'macro)
- (cdr prelim-def)
- prelim-def))
- (arglist (cond ((null def) nil)
- ((byte-code-function-p def)
- (if (fboundp 'compiled-function-arglist)
- (funcall 'compiled-function-arglist def)
- (aref def 0)))
- ((eq (car-safe def) 'lambda)
- (nth 1 def))
- (t t))))
- (eldoc-function-argstring-format arglist)))
-
-(defun eldoc-function-argstring-from-docstring (fn)
- (let ((docstring (documentation fn 'raw))
- (doc nil)
- (doclist nil)
- (end nil))
- (save-match-data
- (cond
- ;; Try first searching for args starting with symbol name.
- ;; This is to avoid matching parenthetical remarks in e.g. sit-for.
- ((string-match (format "^(%s[^\n)]*)$" fn) docstring)
- ;; end does not include trailing ")" sequence.
- (setq end (- (match-end 0) 1))
- (if (string-match " +" docstring (match-beginning 0))
- (setq doc (substring docstring (match-end 0) end))
- (setq doc "")))
-
- ;; Try again not requiring this symbol name in the docstring.
- ;; This will be the case when looking up aliases.
- ((string-match (format "^([^\n)]+)$" fn) docstring)
- ;; end does not include trailing ")" sequence.
- (setq end (- (match-end 0) 1))
- (if (string-match " +" docstring (match-beginning 0))
- (setq doc (substring docstring (match-end 0) end))
- (setq doc "")))
-
- ;; Emacs subr docstring style:
- ;; (fn arg1 arg2 ...): description...
- ((string-match "^([^\n)]+):" docstring)
- ;; end does not include trailing "):" sequence.
- (setq end (- (match-end 0) 2))
- (if (string-match " +" docstring (match-beginning 0))
- (setq doc (substring docstring (match-end 0) end))
- (setq doc "")))
-
- ;; XEmacs subr docstring style:
- ;; "arguments: (arg1 arg2 ...)
- ((string-match "^arguments: (\\([^\n)]+\\))" docstring)
- ;; Also, skip leading paren, but the first word is actually an
- ;; argument, not the function name.
- (setq doc (substring docstring
- (match-beginning 1)
- (match-end 1))))
-
- ;; This finds the argstring for `condition-case'.
- ;; I don't know if there are any others with the same pattern.
- ((string-match (format "^Usage looks like \\((%s[^\n)]*)\\)\\.$" fn)
- docstring)
- ;; end does not include trailing ")" sequence.
- (setq end (- (match-end 1) 1))
- (if (string-match " +" docstring (match-beginning 1))
- (setq doc (substring docstring (match-end 0) end))
- (setq doc "")))
-
- ;; This finds the argstring for `setq-default'.
- ;; I don't know if there are any others with the same pattern.
- ((string-match (format "^[ \t]+\\((%s[^\n)]*)\\)$" fn) docstring)
- ;; end does not include trailing ")" sequence.
- (setq end (- (match-end 1) 1))
- (if (string-match " +" docstring (match-beginning 1))
- (setq doc (substring docstring (match-end 0) end))
- (setq doc ""))))
-
- (cond ((not (stringp doc))
- nil)
- ((string-match "&" doc)
- (let ((p 0)
- (l (length doc)))
- (while (< p l)
- (cond ((string-match "[ \t\n]+" doc p)
- (setq doclist
- (cons (substring doc p (match-beginning 0))
- doclist))
- (setq p (match-end 0)))
- (t
- (setq doclist (cons (substring doc p) doclist))
- (setq p l))))
- (eldoc-function-argstring-format (nreverse doclist))))
- (t
- (concat "(" (funcall eldoc-argument-case doc) ")"))))))