lisp/emacs-lisp/eldoc.el

   1 ;;; eldoc.el --- show function arglist or variable docstring in echo area
   2
   3 ;; Copyright (C) 1996, 97, 98, 99, 2000 Free Software Foundation, Inc.
   4
   5 ;; Author: Noah Friedman <friedman@splode.com>
   6 ;; Maintainer: friedman@splode.com
   7 ;; Keywords: extensions
   8 ;; Created: 1995-10-06
   9
  10 ;; $Id: eldoc.el,v 1.20 2000/06/03 19:50:18 friedman Exp $
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  27 ;; Boston, MA 02111-1307, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; This program was inspired by the behavior of the "mouse documentation
  32 ;; window" on many Lisp Machine systems; as you type a function's symbol
  33 ;; name as part of a sexp, it will print the argument list for that
  34 ;; function.  Behavior is not identical; for example, you need not actually
  35 ;; type the function name, you need only move point around in a sexp that
  36 ;; calls it.  Also, if point is over a documented variable, it will print
  37 ;; the one-line documentation for that variable instead, to remind you of
  38 ;; that variable's meaning.
  39
  40 ;; One useful way to enable this minor mode is to put the following in your
  41 ;; .emacs:
  42 ;;
  43 ;;      (autoload 'turn-on-eldoc-mode "eldoc" nil t)
  44 ;;      (add-hook 'emacs-lisp-mode-hook 'turn-on-eldoc-mode)
  45 ;;      (add-hook 'lisp-interaction-mode-hook 'turn-on-eldoc-mode)
  46 ;;      (add-hook 'ielm-mode-hook 'turn-on-eldoc-mode)
  47
  48 ;;; Code:
  49
  50 ;; Use idle timers if available in the version of emacs running.
  51 ;; Please don't change this to use `require'; this package works
  52 ;; as-is in XEmacs 19.14 and later and I am striving to maintain
  53 ;; compatibility between emacs variants.
  54 (or (featurep 'timer)
  55     (load "timer" t))
  56
  57 (defgroup eldoc nil
  58   "Show function arglist or variable docstring in echo area."
  59   :group 'eldoc
  60   :group 'lisp
  61   :group 'extensions)
  62
  63 ;;;###autoload
  64 (defcustom eldoc-mode nil
  65   "*If non-nil, show the defined parameters for the elisp function near point.
  66
  67 For the emacs lisp function at the beginning of the sexp which point is
  68 within, show the defined parameters for the function in the echo area.
  69 This information is extracted directly from the function or macro if it is
  70 in pure lisp.  If the emacs function is a subr, the parameters are obtained
  71 from the documentation string if possible.
  72
  73 If point is over a documented variable, print that variable's docstring
  74 instead.
  75
  76 This variable is buffer-local."
  77   :type 'boolean
  78   :group 'eldoc)
  79 (make-variable-buffer-local 'eldoc-mode)
  80
  81 (defcustom eldoc-idle-delay 0.50
  82   "*Number of seconds of idle time to wait before printing.
  83 If user input arrives before this interval of time has elapsed after the
  84 last input, no documentation will be printed.
  85
  86 If this variable is set to 0, no idle time is required."
  87   :type 'number
  88   :group 'eldoc)
  89
  90 ;;;###autoload
  91 (defcustom eldoc-minor-mode-string " ElDoc"
  92   "*String to display in mode line when Eldoc Mode is enabled."
  93   :type 'string
  94   :group 'eldoc)
  95
  96 (defcustom eldoc-argument-case 'upcase
  97   "Case to display argument names of functions, as a symbol.
  98 This has two preferred values: `upcase' or `downcase'.
  99 Actually, any name of a function which takes a string as an argument and
 100 returns another string is acceptable."
 101   :type '(radio (function-item upcase)
 102                 (function-item downcase)
 103                 function)
 104   :group 'eldoc)
 105
 106 (defcustom eldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit
 107   "*Allow long eldoc messages to resize echo area display.
 108 If value is `t', never attempt to truncate messages; complete symbol name
 109 and function arglist or 1-line variable documentation will be displayed
 110 even if echo area must be resized to fit.
 111
 112 If value is any non-nil value other than `t', symbol name may be truncated
 113 if it will enable the function arglist or documentation string to fit on a
 114 single line without resizing window.  Otherwise, behavior is just like
 115 former case.
 116
 117 If value is nil, messages are always truncated to fit in a single line of
 118 display in the echo area.  Function or variable symbol name may be
 119 truncated to make more of the arglist or documentation string visible.
 120
 121 Non-nil values for this variable have no effect unless
 122 `eldoc-echo-area-multiline-supported-p' is non-nil."
 123   :type '(radio (const :tag "Always" t)
 124                 (const :tag "Never" nil)
 125                 (const :tag "Yes, but truncate symbol names if it will\
 126  enable argument list to fit on one line" truncate-sym-name-if-fit))
 127   :group 'eldoc)
 128
 129 ;;; No user options below here.
 130
 131 ;; Non-nil if this version of emacs supports dynamically resizable echo areas.
 132 (defvar eldoc-echo-area-multiline-supported-p
 133   (and (string-lessp "21" emacs-version)
 134        (save-match-data
 135          (numberp (string-match "^GNU Emacs" (emacs-version))))))
 136
 137 ;; Commands after which it is appropriate to print in the echo area.
 138 ;; Eldoc does not try to print function arglists, etc. after just any command,
 139 ;; because some commands print their own messages in the echo area and these
 140 ;; functions would instantly overwrite them.  But self-insert-command as well
 141 ;; as most motion commands are good candidates.
 142 ;; This variable contains an obarray of symbols; do not manipulate it
 143 ;; directly.  Instead, use `eldoc-add-command' and `eldoc-remove-command'.
 144 (defvar eldoc-message-commands nil)
 145
 146 ;; This is used by eldoc-add-command to initialize eldoc-message-commands
 147 ;; as an obarray.
 148 ;; It should probably never be necessary to do so, but if you
 149 ;; choose to increase the number of buckets, you must do so before loading
 150 ;; this file since the obarray is initialized at load time.
 151 ;; Remember to keep it a prime number to improve hash performance.
 152 (defvar eldoc-message-commands-table-size 31)
 153
 154 ;; Bookkeeping; elements are as follows:
 155 ;;   0 - contains the last symbol read from the buffer.
 156 ;;   1 - contains the string last displayed in the echo area for that
 157 ;;       symbol, so it can be printed again if necessary without reconsing.
 158 ;;   2 - 'function if function args, 'variable if variable documentation.
 159 (defvar eldoc-last-data (make-vector 3 nil))
 160 (defvar eldoc-last-message nil)
 161
 162 ;; Idle timers are supported in Emacs 19.31 and later.
 163 (defvar eldoc-use-idle-timer-p (fboundp 'run-with-idle-timer))
 164
 165 ;; eldoc's timer object, if using idle timers
 166 (defvar eldoc-timer nil)
 167
 168 ;; idle time delay currently in use by timer.
 169 ;; This is used to determine if eldoc-idle-delay is changed by the user.
 170 (defvar eldoc-current-idle-delay eldoc-idle-delay)
 171
 172 ;; Put minor mode string on the global minor-mode-alist.
 173 ;;;###autoload
 174 (cond ((fboundp 'add-minor-mode)
 175        (add-minor-mode 'eldoc-mode 'eldoc-minor-mode-string))
 176       ((assq 'eldoc-mode (default-value 'minor-mode-alist)))
 177       (t
 178        (setq-default minor-mode-alist
 179                      (append (default-value 'minor-mode-alist)
 180                              '((eldoc-mode eldoc-minor-mode-string))))))
 181
 182 \f
 183 ;;;###autoload
 184 (defun eldoc-mode (&optional prefix)
 185   "*Enable or disable eldoc mode.
 186 See documentation for the variable of the same name for more details.
 187
 188 If called interactively with no prefix argument, toggle current condition
 189 of the mode.
 190 If called with a positive or negative prefix argument, enable or disable
 191 the mode, respectively."
 192   (interactive "P")
 193   (setq eldoc-last-message nil)
 194   (cond (eldoc-use-idle-timer-p
 195          (add-hook 'post-command-hook 'eldoc-schedule-timer)
 196          (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area))
 197         (t
 198          ;; Use post-command-idle-hook if defined, otherwise use
 199          ;; post-command-hook.  The former is only proper to use in Emacs
 200          ;; 19.30; that is the first version in which it appeared, but it
 201          ;; was obsolesced by idle timers in Emacs 19.31.
 202          (add-hook (if (boundp 'post-command-idle-hook)
 203                        'post-command-idle-hook
 204                      'post-command-hook)
 205                    'eldoc-print-current-symbol-info t t)
 206          ;; quick and dirty hack for seeing if this is XEmacs
 207          (and (fboundp 'display-message)
 208               (add-hook 'pre-command-hook
 209                         'eldoc-pre-command-refresh-echo-area t t))))
 210   (setq eldoc-mode (if prefix
 211                        (>= (prefix-numeric-value prefix) 0)
 212                      (not eldoc-mode)))
 213   (and (interactive-p)
 214        (if eldoc-mode
 215            (message "eldoc-mode is enabled")
 216          (message "eldoc-mode is disabled")))
 217   eldoc-mode)
 218
 219 ;;;###autoload
 220 (defun turn-on-eldoc-mode ()
 221   "Unequivocally turn on eldoc-mode (see variable documentation)."
 222   (interactive)
 223   (eldoc-mode 1))
 224
 225 \f
 226 ;; Idle timers are part of Emacs 19.31 and later.
 227 (defun eldoc-schedule-timer ()
 228   (or (and eldoc-timer
 229            (memq eldoc-timer timer-idle-list))
 230       (setq eldoc-timer
 231             (run-with-idle-timer eldoc-idle-delay t
 232                                  'eldoc-print-current-symbol-info)))
 233
 234   ;; If user has changed the idle delay, update the timer.
 235   (cond ((not (= eldoc-idle-delay eldoc-current-idle-delay))
 236          (setq eldoc-current-idle-delay eldoc-idle-delay)
 237          (timer-set-idle-time eldoc-timer eldoc-idle-delay t))))
 238
 239 (defun eldoc-message (&rest args)
 240   (let ((omessage eldoc-last-message))
 241     (cond ((eq (car args) eldoc-last-message))
 242           ((or (null args)
 243                (null (car args)))
 244            (setq eldoc-last-message nil))
 245           ;; If only one arg, no formatting to do so put it in
 246           ;; eldoc-last-message so eq test above might succeed on
 247           ;; subsequent calls.
 248           ((null (cdr args))
 249            (setq eldoc-last-message (car args)))
 250           (t
 251            (setq eldoc-last-message (apply 'format args))))
 252     ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages
 253     ;; are recorded in a log.  Do not put eldoc messages in that log since
 254     ;; they are Legion.
 255     (cond ((fboundp 'display-message)
 256            ;; XEmacs 19.13 way of preventing log messages.
 257            (cond (eldoc-last-message
 258                   (display-message 'no-log eldoc-last-message))
 259                  (omessage
 260                   (clear-message 'no-log))))
 261           (t
 262            ;; Emacs way of preventing log messages.
 263            (let ((message-log-max nil))
 264              (cond (eldoc-last-message
 265                     (message "%s" eldoc-last-message))
 266                    (omessage
 267                     (message nil)))))))
 268   eldoc-last-message)
 269
 270 ;; This function goes on pre-command-hook for XEmacs or when using idle
 271 ;; timers in Emacs.  Motion commands clear the echo area for some reason,
 272 ;; which make eldoc messages flicker or disappear just before motion
 273 ;; begins.  This function reprints the last eldoc message immediately
 274 ;; before the next command executes, which does away with the flicker.
 275 ;; This doesn't seem to be required for Emacs 19.28 and earlier.
 276 (defun eldoc-pre-command-refresh-echo-area ()
 277   (and eldoc-last-message
 278        (if (eldoc-display-message-no-interference-p)
 279            (eldoc-message eldoc-last-message)
 280          (setq eldoc-last-message nil))))
 281
 282 ;; Decide whether now is a good time to display a message.
 283 (defun eldoc-display-message-p ()
 284   (and (eldoc-display-message-no-interference-p)
 285        (cond (eldoc-use-idle-timer-p
 286               ;; If this-command is non-nil while running via an idle
 287               ;; timer, we're still in the middle of executing a command,
 288               ;; e.g. a query-replace where it would be annoying to
 289               ;; overwrite the echo area.
 290               (and (not this-command)
 291                    (symbolp last-command)
 292                    (intern-soft (symbol-name last-command)
 293                                 eldoc-message-commands)))
 294              (t
 295               ;; If we don't have idle timers, this function is
 296               ;; running on post-command-hook directly; that means the
 297               ;; user's last command is still on `this-command', and we
 298               ;; must wait briefly for input to see whether to do display.
 299               (and (symbolp this-command)
 300                    (intern-soft (symbol-name this-command)
 301                                 eldoc-message-commands)
 302                    (sit-for eldoc-idle-delay))))))
 303
 304 ;; Check various conditions about the current environment that might make
 305 ;; it undesirable to print eldoc messages right this instant.
 306 (defun eldoc-display-message-no-interference-p ()
 307   (and eldoc-mode
 308        (not executing-kbd-macro)
 309        (not (and (boundp 'edebug-active) edebug-active))
 310        ;; Having this mode operate in an active minibuffer/echo area causes
 311        ;; interference with what's going on there.
 312        (not cursor-in-echo-area)
 313        (not (eq (selected-window) (minibuffer-window)))))
 314
 315 \f
 316 (defun eldoc-print-current-symbol-info ()
 317   (and (eldoc-display-message-p)
 318        (let* ((current-symbol (eldoc-current-symbol))
 319               (current-fnsym  (eldoc-fnsym-in-current-sexp))
 320               (doc (cond ((eq current-symbol current-fnsym)
 321                           (or (eldoc-get-fnsym-args-string current-fnsym)
 322                               (eldoc-get-var-docstring current-symbol)))
 323                          (t
 324                           (or (eldoc-get-var-docstring current-symbol)
 325                               (eldoc-get-fnsym-args-string current-fnsym))))))
 326          (eldoc-message doc))))
 327
 328 ;; Return a string containing the function parameter list, or 1-line
 329 ;; docstring if function is a subr and no arglist is obtainable from the
 330 ;; docstring or elsewhere.
 331 (defun eldoc-get-fnsym-args-string (sym)
 332   (let ((args nil)
 333         (doc nil))
 334     (cond ((not (and sym
 335                      (symbolp sym)
 336                      (fboundp sym))))
 337           ((and (eq sym (aref eldoc-last-data 0))
 338                 (eq 'function (aref eldoc-last-data 2)))
 339            (setq doc (aref eldoc-last-data 1)))
 340           ((subrp (eldoc-symbol-function sym))
 341            (setq args (or (eldoc-function-argstring-from-docstring sym)
 342                           (eldoc-docstring-first-line (documentation sym t)))))
 343           (t
 344            (setq args (eldoc-function-argstring sym))))
 345     (cond (args
 346            (setq doc (eldoc-docstring-format-sym-doc sym args))
 347            (eldoc-last-data-store sym doc 'function)))
 348     doc))
 349
 350 ;; Return a string containing a brief (one-line) documentation string for
 351 ;; the variable.
 352 (defun eldoc-get-var-docstring (sym)
 353   (cond ((and (eq sym (aref eldoc-last-data 0))
 354               (eq 'variable (aref eldoc-last-data 2)))
 355          (aref eldoc-last-data 1))
 356         (t
 357          (let ((doc (documentation-property sym 'variable-documentation t)))
 358            (cond (doc
 359                   (setq doc (eldoc-docstring-format-sym-doc
 360                              sym (eldoc-docstring-first-line doc)))
 361                   (eldoc-last-data-store sym doc 'variable)))
 362            doc))))
 363
 364 (defun eldoc-last-data-store (symbol doc type)
 365   (aset eldoc-last-data 0 symbol)
 366   (aset eldoc-last-data 1 doc)
 367   (aset eldoc-last-data 2 type))
 368
 369 ;; Note that any leading `*' in the docstring (which indicates the variable
 370 ;; is a user option) is removed.
 371 (defun eldoc-docstring-first-line (doc)
 372   (and (stringp doc)
 373        (substitute-command-keys
 374         (save-match-data
 375           (let ((start (if (string-match "^\\*" doc) (match-end 0) 0)))
 376             (cond ((string-match "\n" doc)
 377                    (substring doc start (match-beginning 0)))
 378                   ((zerop start) doc)
 379                   (t (substring doc start))))))))
 380
 381 ;; If the entire line cannot fit in the echo area, the symbol name may be
 382 ;; truncated or eliminated entirely from the output to make room for the
 383 ;; description.
 384 (defun eldoc-docstring-format-sym-doc (sym doc)
 385   (save-match-data
 386     (let* ((name (symbol-name sym))
 387            (ea-multi (and eldoc-echo-area-multiline-supported-p
 388                           eldoc-echo-area-use-multiline-p))
 389            ;; Subtract 1 from window width since emacs will not write
 390            ;; any chars to the last column, or in later versions, will
 391            ;; cause a wraparound and resize of the echo area.
 392            (ea-width (1- (window-width (minibuffer-window))))
 393            (strip (- (+ (length name) (length ": ") (length doc)) ea-width)))
 394       (cond ((or (<= strip 0)
 395                  (eq ea-multi t)
 396                  (and ea-multi (> (length doc) ea-width)))
 397              (format "%s: %s" sym doc))
 398             ((> (length doc) ea-width)
 399              (substring (format "%s" doc) 0 ea-width))
 400             ((>= strip (length name))
 401              (format "%s" doc))
 402             (t
 403              ;; Show the end of the partial symbol name, rather
 404              ;; than the beginning, since the former is more likely
 405              ;; to be unique given package namespace conventions.
 406              (setq name (substring name strip))
 407              (format "%s: %s" name doc))))))
 408
 409 \f
 410 (defun eldoc-fnsym-in-current-sexp ()
 411   (let ((p (point)))
 412     (eldoc-beginning-of-sexp)
 413     (prog1
 414         ;; Don't do anything if current word is inside a string.
 415         (if (= (or (char-after (1- (point))) 0) ?\")
 416             nil
 417           (eldoc-current-symbol))
 418       (goto-char p))))
 419
 420 (defun eldoc-beginning-of-sexp ()
 421   (let ((parse-sexp-ignore-comments t))
 422     (condition-case err
 423         (while (progn
 424                  (forward-sexp -1)
 425                  (or (= (or (char-after (1- (point)))) ?\")
 426                      (> (point) (point-min)))))
 427       (error nil))))
 428
 429 ;; returns nil unless current word is an interned symbol.
 430 (defun eldoc-current-symbol ()
 431   (let ((c (char-after (point))))
 432     (and c
 433          (memq (char-syntax c) '(?w ?_))
 434          (intern-soft (current-word)))))
 435
 436 ;; Do indirect function resolution if possible.
 437 (defun eldoc-symbol-function (fsym)
 438   (let ((defn (and (fboundp fsym)
 439                    (symbol-function fsym))))
 440     (and (symbolp defn)
 441          (condition-case err
 442              (setq defn (indirect-function fsym))
 443            (error (setq defn nil))))
 444     defn))
 445
 446 (defun eldoc-function-arglist (fn)
 447   (let* ((prelim-def (eldoc-symbol-function fn))
 448          (def (if (eq (car-safe prelim-def) 'macro)
 449                   (cdr prelim-def)
 450                 prelim-def))
 451          (arglist (cond ((null def) nil)
 452                         ((byte-code-function-p def)
 453                          (cond ((fboundp 'compiled-function-arglist)
 454                                 (funcall 'compiled-function-arglist def))
 455                                (t
 456                                 (aref def 0))))
 457                         ((eq (car-safe def) 'lambda)
 458                          (nth 1 def))
 459                         (t t))))
 460     arglist))
 461
 462 (defun eldoc-function-argstring (fn)
 463   (eldoc-function-argstring-format (eldoc-function-arglist fn)))
 464
 465 (defun eldoc-function-argstring-format (arglist)
 466   (cond ((not (listp arglist))
 467          (setq arglist nil))
 468         ((symbolp (car arglist))
 469          (setq arglist
 470                (mapcar (function (lambda (s)
 471                                    (if (memq s '(&optional &rest))
 472                                        (symbol-name s)
 473                                      (funcall eldoc-argument-case
 474                                               (symbol-name s)))))
 475                        arglist)))
 476         ((stringp (car arglist))
 477          (setq arglist
 478                (mapcar (function (lambda (s)
 479                                    (if (member s '("&optional" "&rest"))
 480                                        s
 481                                      (funcall eldoc-argument-case s))))
 482                        arglist))))
 483   (concat "(" (mapconcat 'identity arglist " ") ")"))
 484
 485 \f
 486 ;; Alist of predicate/action pairs.
 487 ;; Each member of the list is a sublist consisting of a predicate function
 488 ;; used to determine if the arglist for a function can be found using a
 489 ;; certain pattern, and a function which returns the actual arglist from
 490 ;; that docstring.
 491 ;;
 492 ;; The order in this table is significant, since later predicates may be
 493 ;; more general than earlier ones.
 494 ;;
 495 ;; Compiler note for Emacs/XEmacs versions which support dynamic loading:
 496 ;; these functions will be compiled to bytecode, but can't be lazy-loaded
 497 ;; even if you set byte-compile-dynamic; to do that would require making
 498 ;; them named top-level defuns, which is not particularly desirable either.
 499 (defvar eldoc-function-argstring-from-docstring-method-table
 500   (list
 501    ;; Try first searching for args starting with symbol name.
 502    ;; This is to avoid matching parenthetical remarks in e.g. sit-for.
 503    (list (function (lambda (doc fn)
 504                      (string-match (format "^(%s[^\n)]*)$" fn) doc)))
 505          (function (lambda (doc)
 506                      ;; end does not include trailing ")" sequence.
 507                      (let ((end (- (match-end 0) 1)))
 508                        (if (string-match " +" doc (match-beginning 0))
 509                            (substring doc (match-end 0) end)
 510                          "")))))
 511
 512    ;; Try again not requiring this symbol name in the docstring.
 513    ;; This will be the case when looking up aliases.
 514    (list (function (lambda (doc fn)
 515                      ;; save-restriction has a pathological docstring in
 516                      ;; Emacs/XEmacs 19.
 517                      (and (not (eq fn 'save-restriction))
 518                           (string-match "^([^\n)]+)$" doc))))
 519          (function (lambda (doc)
 520                      ;; end does not include trailing ")" sequence.
 521                      (let ((end (- (match-end 0) 1)))
 522                        (and (string-match " +" doc (match-beginning 0))
 523                             (substring doc (match-end 0) end))))))
 524
 525    ;; Emacs subr docstring style:
 526    ;;   (fn arg1 arg2 ...): description...
 527    (list (function (lambda (doc fn)
 528                      (string-match "^([^\n)]+):" doc)))
 529          (function (lambda (doc)
 530                      ;; end does not include trailing "):" sequence.
 531                      (let ((end (- (match-end 0) 2)))
 532                        (and (string-match " +" doc (match-beginning 0))
 533                             (substring doc (match-end 0) end))))))
 534
 535    ;; XEmacs subr docstring style:
 536    ;;   "arguments: (arg1 arg2 ...)
 537    (list (function (lambda (doc fn)
 538                      (string-match "^arguments: (\\([^\n)]+\\))" doc)))
 539          (function (lambda (doc)
 540                      ;; also skip leading paren, but the first word is
 541                      ;; actually an argument, not the function name.
 542                      (substring doc (match-beginning 1) (match-end 1)))))
 543
 544    ;; This finds the argstring for `condition-case'.  Any others?
 545    (list (function (lambda (doc fn)
 546                      (string-match
 547                       (format "^Usage looks like \\((%s[^\n)]*)\\)\\.$" fn)
 548                       doc)))
 549          (function (lambda (doc)
 550                      ;; end does not include trailing ")" sequence.
 551                      (let ((end (- (match-end 1) 1)))
 552                        (and (string-match " +" doc (match-beginning 1))
 553                             (substring doc (match-end 0) end))))))
 554
 555    ;; This finds the argstring for `setq-default'.  Any others?
 556    (list (function (lambda (doc fn)
 557                      (string-match (format "^[ \t]+\\((%s[^\n)]*)\\)$" fn)
 558                                    doc)))
 559          (function (lambda (doc)
 560                      ;; end does not include trailing ")" sequence.
 561                      (let ((end (- (match-end 1) 1)))
 562                        (and (string-match " +" doc (match-beginning 1))
 563                             (substring doc (match-end 0) end))))))
 564
 565    ;; This finds the argstring for `start-process'.  Any others?
 566    (list (function (lambda (doc fn)
 567                      (string-match "^Args are +\\([^\n]+\\)$" doc)))
 568          (function (lambda (doc)
 569                      (substring doc (match-beginning 1) (match-end 1)))))
 570
 571    ;; These common subrs don't have arglists in their docstrings.  So cheat.
 572    (list (function (lambda (doc fn)
 573                      (memq fn '(and or list + -))))
 574          (function (lambda (doc)
 575                      ;; The value nil is a placeholder; otherwise, the
 576                      ;; following string may be compiled as a docstring,
 577                      ;; and not a return value for the function.
 578                      ;; In interpreted lisp form they are
 579                      ;; indistinguishable; it only matters for compiled
 580                      ;; forms.
 581                      nil
 582                      "&rest args")))
 583    ))
 584
 585 (defun eldoc-function-argstring-from-docstring (fn)
 586   (let ((docstring (documentation fn 'raw))
 587         (table eldoc-function-argstring-from-docstring-method-table)
 588         (doc nil)
 589         (doclist nil))
 590     (save-match-data
 591       (while table
 592         (cond ((funcall (car (car table)) docstring fn)
 593                (setq doc (funcall (car (cdr (car table))) docstring))
 594                (setq table nil))
 595               (t
 596                (setq table (cdr table)))))
 597
 598       (cond ((not (stringp doc))
 599              nil)
 600             ((string-match "&" doc)
 601              (let ((p 0)
 602                    (l (length doc)))
 603                (while (< p l)
 604                  (cond ((string-match "[ \t\n]+" doc p)
 605                         (setq doclist
 606                               (cons (substring doc p (match-beginning 0))
 607                                     doclist))
 608                         (setq p (match-end 0)))
 609                        (t
 610                         (setq doclist (cons (substring doc p) doclist))
 611                         (setq p l))))
 612                (eldoc-function-argstring-format (nreverse doclist))))
 613             (t
 614              (concat "(" (funcall eldoc-argument-case doc) ")"))))))
 615
 616 \f
 617 ;; When point is in a sexp, the function args are not reprinted in the echo
 618 ;; area after every possible interactive command because some of them print
 619 ;; their own messages in the echo area; the eldoc functions would instantly
 620 ;; overwrite them unless it is more restrained.
 621 ;; These functions do display-command table management.
 622
 623 (defun eldoc-add-command (&rest cmds)
 624   (or eldoc-message-commands
 625       (setq eldoc-message-commands
 626             (make-vector eldoc-message-commands-table-size 0)))
 627
 628   (let (name sym)
 629     (while cmds
 630       (setq name (car cmds))
 631       (setq cmds (cdr cmds))
 632
 633       (cond ((symbolp name)
 634              (setq sym name)
 635              (setq name (symbol-name sym)))
 636             ((stringp name)
 637              (setq sym (intern-soft name))))
 638
 639       (and (symbolp sym)
 640            (fboundp sym)
 641            (set (intern name eldoc-message-commands) t)))))
 642
 643 (defun eldoc-add-command-completions (&rest names)
 644   (while names
 645       (apply 'eldoc-add-command
 646              (all-completions (car names) obarray 'fboundp))
 647       (setq names (cdr names))))
 648
 649 (defun eldoc-remove-command (&rest cmds)
 650   (let (name)
 651     (while cmds
 652       (setq name (car cmds))
 653       (setq cmds (cdr cmds))
 654
 655       (and (symbolp name)
 656            (setq name (symbol-name name)))
 657
 658       (if (fboundp 'unintern)
 659           (unintern name eldoc-message-commands)
 660         (let ((s (intern-soft name eldoc-message-commands)))
 661           (and s
 662                (makunbound s)))))))
 663
 664 (defun eldoc-remove-command-completions (&rest names)
 665   (while names
 666     (apply 'eldoc-remove-command
 667            (all-completions (car names) eldoc-message-commands))
 668     (setq names (cdr names))))
 669
 670 \f
 671 ;; Prime the command list.
 672 (eldoc-add-command-completions
 673  "backward-" "beginning-of-" "delete-other-windows" "delete-window"
 674  "end-of-" "forward-" "indent-for-tab-command" "goto-" "mouse-set-point"
 675  "next-" "other-window" "previous-" "recenter" "scroll-"
 676  "self-insert-command" "split-window-"
 677  "up-list" "down-list")
 678
 679 (provide 'eldoc)
 680
 681 ;;; eldoc.el ends here