-\f
-(defun eldoc-print-var-docstring (sym)
- (eldoc-print-docstring sym (documentation-property
- sym 'variable-documentation t)))
-
-;; Print the brief (one-line) documentation string for the symbol.
-(defun eldoc-print-docstring (symbol doc)
- (and doc
- (eldoc-message "%s" (eldoc-docstring-message symbol doc))))
-
-;; If the entire line cannot fit in the echo area, the variable name may be
-;; truncated or eliminated entirely from the output to make room.
-;; Any leading `*' in the docstring (which indicates the variable is a user
-;; option) is not printed."
-(defun eldoc-docstring-message (symbol doc)
- (and doc
- (let ((name (symbol-name symbol)))
- (setq doc (eldoc-docstring-first-line doc))
- (save-match-data
- (let* ((doclen (+ (length name) (length ": ") (length doc)))
- ;; Subtract 1 from window width since emacs seems not to
- ;; write any chars to the last column, at least for some
- ;; terminal types.
- (strip (- doclen (1- (window-width (minibuffer-window))))))
- (cond ((> strip 0)
- (let* ((len (length name)))
- (cond ((>= strip len)
- (format "%s" doc))
- (t
- (setq name (substring name 0 (- len strip)))
- (format "%s: %s" name doc)))))
- (t
- (format "%s: %s" symbol doc))))))))
-
-(defun eldoc-docstring-first-line (doc)
- (save-match-data
- (and (string-match "\n" doc)
- (setq doc (substring doc 0 (match-beginning 0))))
- (and (string-match "^\\*" doc)
- (setq doc (substring doc 1))))
- doc)
-
-\f
-;; Alist of predicate/action pairs.
-;; Each member of the list is a sublist consisting of a predicate function
-;; used to determine if the arglist for a function can be found using a
-;; certain pattern, and a function which returns the actual arglist from
-;; that docstring.
-;;
-;; The order in this table is significant, since later predicates may be
-;; more general than earlier ones.
-;;
-;; Compiler note for Emacs 19.29 and later: these functions will be
-;; compiled to bytecode, but can't be lazy-loaded even if you set
-;; byte-compile-dynamic; to do that would require making them named
-;; top-level defuns, and that's not particularly desirable either.
-(defconst eldoc-function-argstring-from-docstring-method-table
- (list
- ;; Try first searching for args starting with symbol name.
- ;; This is to avoid matching parenthetical remarks in e.g. sit-for.
- (list (function (lambda (doc fn)
- (string-match (format "^(%s[^\n)]*)$" fn) doc)))
- (function (lambda (doc)
- ;; end does not include trailing ")" sequence.
- (let ((end (- (match-end 0) 1)))
- (if (string-match " +" doc (match-beginning 0))
- (substring doc (match-end 0) end)
- "")))))
-
- ;; Try again not requiring this symbol name in the docstring.
- ;; This will be the case when looking up aliases.
- (list (function (lambda (doc fn)
- (string-match "^([^\n)]+)$" doc)))
- (function (lambda (doc)
- ;; end does not include trailing ")" sequence.
- (let ((end (- (match-end 0) 1)))
- (and (string-match " +" doc (match-beginning 0))
- (substring doc (match-end 0) end))))))
-
- ;; Emacs subr docstring style:
- ;; (fn arg1 arg2 ...): description...
- (list (function (lambda (doc fn)
- (string-match "^([^\n)]+):" doc)))
- (function (lambda (doc)
- ;; end does not include trailing "):" sequence.
- (let ((end (- (match-end 0) 2)))
- (and (string-match " +" doc (match-beginning 0))
- (substring doc (match-end 0) end))))))
-
- ;; XEmacs subr docstring style:
- ;; "arguments: (arg1 arg2 ...)
- (list (function (lambda (doc fn)
- (string-match "^arguments: (\\([^\n)]+\\))" doc)))
- (function (lambda (doc)
- ;; also skip leading paren, but the first word is
- ;; actually an argument, not the function name.
- (substring doc (match-beginning 1) (match-end 1)))))
-
- ;; This finds the argstring for `condition-case'. Any others?
- (list (function (lambda (doc fn)
- (string-match
- (format "^Usage looks like \\((%s[^\n)]*)\\)\\.$" fn)
- doc)))
- (function (lambda (doc)
- ;; end does not include trailing ")" sequence.
- (let ((end (- (match-end 1) 1)))
- (and (string-match " +" doc (match-beginning 1))
- (substring doc (match-end 0) end))))))
-
- ;; This finds the argstring for `setq-default'. Any others?
- (list (function (lambda (doc fn)
- (string-match (format "^[ \t]+\\((%s[^\n)]*)\\)$" fn)
- doc)))
- (function (lambda (doc)
- ;; end does not include trailing ")" sequence.
- (let ((end (- (match-end 1) 1)))
- (and (string-match " +" doc (match-beginning 1))
- (substring doc (match-end 0) end))))))
-
- ;; This finds the argstring for `start-process'. Any others?
- (list (function (lambda (doc fn)
- (string-match "^Args are +\\([^\n]+\\)$" doc)))
- (function (lambda (doc)
- (substring doc (match-beginning 1) (match-end 1)))))
-
- ;; These subrs don't have arglists in their docstrings.
- ;; This is cheating.
- (list (function (lambda (doc fn)
- (memq fn '(and or list + -))))
- (function (lambda (doc)
- ;; The value nil is a placeholder; otherwise, the
- ;; following string may be compiled as a docstring,
- ;; and not a return value for the function.
- ;; In interpreted lisp form they are
- ;; indistinguishable; it only matters for compiled
- ;; forms.
- nil
- "&rest args")))
- ))
-
-(defun eldoc-function-argstring-from-docstring (fn)
- (let ((docstring (documentation fn 'raw))
- (table eldoc-function-argstring-from-docstring-method-table)
- (doc nil)
- (doclist nil))
- (save-match-data
- (while table
- (cond ((funcall (car (car table)) docstring fn)
- (setq doc (funcall (car (cdr (car table))) docstring))
- (setq table nil))
- (t
- (setq table (cdr table)))))
-
- (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) ")"))))))
-