/[emacs]/emacs/lisp/emacs-lisp/eldoc.el
ViewVC logotype

Diff of /emacs/lisp/emacs-lisp/eldoc.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.20 by rms, Tue Jan 8 23:57:30 2002 UTC revision 1.20.4.1 by miles, Fri Apr 4 06:20:16 2003 UTC
# Line 1  Line 1 
1  ;;; eldoc.el --- show function arglist or variable docstring in echo area  ;;; eldoc.el --- show function arglist or variable docstring in echo area
2    
3  ;; Copyright (C) 1996, 97, 98, 99, 2000 Free Software Foundation, Inc.  ;; Copyright (C) 1996, 97, 98, 99, 2000, 2003 Free Software Foundation, Inc.
4    
5  ;; Author: Noah Friedman <friedman@splode.com>  ;; Author: Noah Friedman <friedman@splode.com>
6  ;; Maintainer: friedman@splode.com  ;; Maintainer: friedman@splode.com
# Line 47  Line 47 
47    
48  ;;; Code:  ;;; Code:
49    
50  ;; Use idle timers if available in the version of emacs running.  (require 'help-fns)                    ;For fundoc-usage handling functions.
 ;; Please don't change this to use `require'; this package works  
 ;; as-is in XEmacs 19.14 and later and I am striving to maintain  
 ;; compatibility between emacs variants.  
 (or (featurep 'timer)  
     (load "timer" t))  
51    
52  (defgroup eldoc nil  (defgroup eldoc nil
53    "Show function arglist or variable docstring in echo area."    "Show function arglist or variable docstring in echo area."
# Line 97  former case. Line 92  former case.
92    
93  If value is nil, messages are always truncated to fit in a single line of  If value is nil, messages are always truncated to fit in a single line of
94  display in the echo area.  Function or variable symbol name may be  display in the echo area.  Function or variable symbol name may be
95  truncated to make more of the arglist or documentation string visible.  truncated to make more of the arglist or documentation string visible."
   
 Non-nil values for this variable have no effect unless  
 `eldoc-echo-area-multiline-supported-p' is non-nil."  
96    :type '(radio (const :tag "Always" t)    :type '(radio (const :tag "Always" t)
97                  (const :tag "Never" nil)                  (const :tag "Never" nil)
98                  (const :tag "Yes, but truncate symbol names if it will\                  (const :tag "Yes, but truncate symbol names if it will\
# Line 109  Non-nil values for this variable have no Line 101  Non-nil values for this variable have no
101    
102  ;;; No user options below here.  ;;; No user options below here.
103    
 ;; Non-nil if this version of emacs supports dynamically resizable echo areas.  
 (defvar eldoc-echo-area-multiline-supported-p  
   (and (string-lessp "21" emacs-version)  
        (save-match-data  
          (numberp (string-match "^GNU Emacs" (emacs-version))))))  
   
104  ;; Commands after which it is appropriate to print in the echo area.  ;; Commands after which it is appropriate to print in the echo area.
105  ;; Eldoc does not try to print function arglists, etc. after just any command,  ;; Eldoc does not try to print function arglists, etc. after just any command,
106  ;; because some commands print their own messages in the echo area and these  ;; because some commands print their own messages in the echo area and these
# Line 140  Non-nil values for this variable have no Line 126  Non-nil values for this variable have no
126  (defvar eldoc-last-data (make-vector 3 nil))  (defvar eldoc-last-data (make-vector 3 nil))
127  (defvar eldoc-last-message nil)  (defvar eldoc-last-message nil)
128    
129  ;; Idle timers are supported in Emacs 19.31 and later.  ;; eldoc's timer object.
 (defvar eldoc-use-idle-timer-p (fboundp 'run-with-idle-timer))  
   
 ;; eldoc's timer object, if using idle timers  
130  (defvar eldoc-timer nil)  (defvar eldoc-timer nil)
131    
132  ;; idle time delay currently in use by timer.  ;; idle time delay currently in use by timer.
# Line 168  instead. Line 151  instead.
151  With prefix ARG, turn ElDoc mode on if and only if ARG is positive."  With prefix ARG, turn ElDoc mode on if and only if ARG is positive."
152    nil eldoc-minor-mode-string nil    nil eldoc-minor-mode-string nil
153    (setq eldoc-last-message nil)    (setq eldoc-last-message nil)
154    (cond (eldoc-use-idle-timer-p    (if eldoc-mode
155           (add-hook 'post-command-hook 'eldoc-schedule-timer)        (progn
156           (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area))          (add-hook 'post-command-hook 'eldoc-schedule-timer nil t)
157          (t          (add-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area t))
158           ;; Use post-command-idle-hook if defined, otherwise use     (remove-hook 'post-command-hook 'eldoc-schedule-timer)
159           ;; post-command-hook.  The former is only proper to use in Emacs     (remove-hook 'pre-command-hook 'eldoc-pre-command-refresh-echo-area)))
          ;; 19.30; that is the first version in which it appeared, but it  
          ;; was obsolesced by idle timers in Emacs 19.31.  
          (add-hook (if (boundp 'post-command-idle-hook)  
                        'post-command-idle-hook  
                      'post-command-hook)  
                    'eldoc-print-current-symbol-info t t)  
          ;; quick and dirty hack for seeing if this is XEmacs  
          (and (fboundp 'display-message)  
               (add-hook 'pre-command-hook  
                         'eldoc-pre-command-refresh-echo-area t t)))))  
160    
161  ;;;###autoload  ;;;###autoload
162  (defun turn-on-eldoc-mode ()  (defun turn-on-eldoc-mode ()
# Line 207  With prefix ARG, turn ElDoc mode on if a Line 180  With prefix ARG, turn ElDoc mode on if a
180    
181  (defun eldoc-message (&rest args)  (defun eldoc-message (&rest args)
182    (let ((omessage eldoc-last-message))    (let ((omessage eldoc-last-message))
183      (cond ((eq (car args) eldoc-last-message))      (setq eldoc-last-message
184            ((or (null args)            (cond ((eq (car args) eldoc-last-message) eldoc-last-message)
185                 (null (car args)))                  ((null (car args)) nil)
186             (setq eldoc-last-message nil))                  ;; If only one arg, no formatting to do, so put it in
187            ;; If only one arg, no formatting to do so put it in                  ;; eldoc-last-message so eq test above might succeed on
188            ;; eldoc-last-message so eq test above might succeed on                  ;; subsequent calls.
189            ;; subsequent calls.                  ((null (cdr args)) (car args))
190            ((null (cdr args))                  (t (apply 'format args))))
            (setq eldoc-last-message (car args)))  
           (t  
            (setq eldoc-last-message (apply 'format args))))  
191      ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages      ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages
192      ;; are recorded in a log.  Do not put eldoc messages in that log since      ;; are recorded in a log.  Do not put eldoc messages in that log since
193      ;; they are Legion.      ;; they are Legion.
194      (cond ((fboundp 'display-message)      ;; Emacs way of preventing log messages.
195             ;; XEmacs 19.13 way of preventing log messages.      (let ((message-log-max nil))
196             (cond (eldoc-last-message        (cond (eldoc-last-message (message "%s" eldoc-last-message))
197                    (display-message 'no-log eldoc-last-message))              (omessage (message nil)))))
                  (omessage  
                   (clear-message 'no-log))))  
           (t  
            ;; Emacs way of preventing log messages.  
            (let ((message-log-max nil))  
              (cond (eldoc-last-message  
                     (message "%s" eldoc-last-message))  
                    (omessage  
                     (message nil)))))))  
198    eldoc-last-message)    eldoc-last-message)
199    
200  ;; This function goes on pre-command-hook for XEmacs or when using idle  ;; This function goes on pre-command-hook for XEmacs or when using idle
# Line 251  With prefix ARG, turn ElDoc mode on if a Line 212  With prefix ARG, turn ElDoc mode on if a
212  ;; Decide whether now is a good time to display a message.  ;; Decide whether now is a good time to display a message.
213  (defun eldoc-display-message-p ()  (defun eldoc-display-message-p ()
214    (and (eldoc-display-message-no-interference-p)    (and (eldoc-display-message-no-interference-p)
215         (cond (eldoc-use-idle-timer-p         ;; If this-command is non-nil while running via an idle
216                ;; If this-command is non-nil while running via an idle         ;; timer, we're still in the middle of executing a command,
217                ;; timer, we're still in the middle of executing a command,         ;; e.g. a query-replace where it would be annoying to
218                ;; e.g. a query-replace where it would be annoying to         ;; overwrite the echo area.
219                ;; overwrite the echo area.         (and (not this-command)
220                (and (not this-command)              (symbolp last-command)
221                     (symbolp last-command)              (intern-soft (symbol-name last-command)
222                     (intern-soft (symbol-name last-command)                           eldoc-message-commands))))
                                 eldoc-message-commands)))  
              (t  
               ;; If we don't have idle timers, this function is  
               ;; running on post-command-hook directly; that means the  
               ;; user's last command is still on `this-command', and we  
               ;; must wait briefly for input to see whether to do display.  
               (and (symbolp this-command)  
                    (intern-soft (symbol-name this-command)  
                                 eldoc-message-commands)  
                    (sit-for eldoc-idle-delay))))))  
223    
224  ;; Check various conditions about the current environment that might make  ;; Check various conditions about the current environment that might make
225  ;; it undesirable to print eldoc messages right this instant.  ;; it undesirable to print eldoc messages right this instant.
# Line 283  With prefix ARG, turn ElDoc mode on if a Line 234  With prefix ARG, turn ElDoc mode on if a
234    
235    
236  (defun eldoc-print-current-symbol-info ()  (defun eldoc-print-current-symbol-info ()
237    (and (eldoc-display-message-p)    (condition-case err
238         (let* ((current-symbol (eldoc-current-symbol))        (and (eldoc-display-message-p)
239                (current-fnsym  (eldoc-fnsym-in-current-sexp))             (let* ((current-symbol (eldoc-current-symbol))
240                (doc (cond ((eq current-symbol current-fnsym)                    (current-fnsym  (eldoc-fnsym-in-current-sexp))
241                            (or (eldoc-get-fnsym-args-string current-fnsym)                    (doc (cond
242                                (eldoc-get-var-docstring current-symbol)))                          ((eq current-symbol current-fnsym)
243                           (t                           (or (eldoc-get-fnsym-args-string current-fnsym)
244                            (or (eldoc-get-var-docstring current-symbol)                               (eldoc-get-var-docstring current-symbol)))
245                                (eldoc-get-fnsym-args-string current-fnsym))))))                          (t
246           (eldoc-message doc))))                           (or (eldoc-get-var-docstring current-symbol)
247                                 (eldoc-get-fnsym-args-string current-fnsym))))))
248                 (eldoc-message doc)))
249        ;; This is run from post-command-hook or some idle timer thing,
250        ;; so we need to be careful that errors aren't ignored.
251        (error (message "eldoc error: %s" err))))
252    
253  ;; Return a string containing the function parameter list, or 1-line  ;; Return a string containing the function parameter list, or 1-line
254  ;; docstring if function is a subr and no arglist is obtainable from the  ;; docstring if function is a subr and no arglist is obtainable from the
# Line 300  With prefix ARG, turn ElDoc mode on if a Line 256  With prefix ARG, turn ElDoc mode on if a
256  (defun eldoc-get-fnsym-args-string (sym)  (defun eldoc-get-fnsym-args-string (sym)
257    (let ((args nil)    (let ((args nil)
258          (doc nil))          (doc nil))
259      (cond ((not (and sym      (cond ((not (and sym (symbolp sym) (fboundp sym))))
                      (symbolp sym)  
                      (fboundp sym))))  
260            ((and (eq sym (aref eldoc-last-data 0))            ((and (eq sym (aref eldoc-last-data 0))
261                  (eq 'function (aref eldoc-last-data 2)))                  (eq 'function (aref eldoc-last-data 2)))
262             (setq doc (aref eldoc-last-data 1)))             (setq doc (aref eldoc-last-data 1)))
263            ((subrp (eldoc-symbol-function sym))            ((setq doc (help-split-fundoc (documentation sym t) sym))
264             (setq args (or (eldoc-function-argstring-from-docstring sym)             (setq args (car doc))
265                            (eldoc-docstring-first-line (documentation sym t)))))             (string-match "\\`[^ )]* ?" args)
266               (setq args (concat "(" (substring args (match-end 0)))))
267            (t            (t
268             (setq args (eldoc-function-argstring sym))))             (setq args (eldoc-function-argstring sym))))
269      (cond (args      (cond (args
# Line 319  With prefix ARG, turn ElDoc mode on if a Line 274  With prefix ARG, turn ElDoc mode on if a
274  ;; Return a string containing a brief (one-line) documentation string for  ;; Return a string containing a brief (one-line) documentation string for
275  ;; the variable.  ;; the variable.
276  (defun eldoc-get-var-docstring (sym)  (defun eldoc-get-var-docstring (sym)
277    (cond ((and (eq sym (aref eldoc-last-data 0))    (when sym
278                (eq 'variable (aref eldoc-last-data 2)))      (cond ((and (eq sym (aref eldoc-last-data 0))
279           (aref eldoc-last-data 1))                  (eq 'variable (aref eldoc-last-data 2)))
280          (t             (aref eldoc-last-data 1))
281           (let ((doc (documentation-property sym 'variable-documentation t)))            (t
282             (cond (doc             (let ((doc (documentation-property sym 'variable-documentation t)))
283                    (setq doc (eldoc-docstring-format-sym-doc               (cond (doc
284                               sym (eldoc-docstring-first-line doc)))                      (setq doc (eldoc-docstring-format-sym-doc
285                    (eldoc-last-data-store sym doc 'variable)))                                 sym (eldoc-docstring-first-line doc)))
286             doc))))                      (eldoc-last-data-store sym doc 'variable)))
287                 doc)))))
288    
289  (defun eldoc-last-data-store (symbol doc type)  (defun eldoc-last-data-store (symbol doc type)
290    (aset eldoc-last-data 0 symbol)    (aset eldoc-last-data 0 symbol)
# Line 353  With prefix ARG, turn ElDoc mode on if a Line 309  With prefix ARG, turn ElDoc mode on if a
309  (defun eldoc-docstring-format-sym-doc (sym doc)  (defun eldoc-docstring-format-sym-doc (sym doc)
310    (save-match-data    (save-match-data
311      (let* ((name (symbol-name sym))      (let* ((name (symbol-name sym))
312             (ea-multi (and eldoc-echo-area-multiline-supported-p             (ea-multi eldoc-echo-area-use-multiline-p)
                           eldoc-echo-area-use-multiline-p))  
313             ;; Subtract 1 from window width since emacs will not write             ;; Subtract 1 from window width since emacs will not write
314             ;; any chars to the last column, or in later versions, will             ;; any chars to the last column, or in later versions, will
315             ;; cause a wraparound and resize of the echo area.             ;; cause a wraparound and resize of the echo area.
# Line 391  With prefix ARG, turn ElDoc mode on if a Line 346  With prefix ARG, turn ElDoc mode on if a
346      (condition-case err      (condition-case err
347          (while (progn          (while (progn
348                   (forward-sexp -1)                   (forward-sexp -1)
349                   (or (= (or (char-after (1- (point)))) ?\")                   (or (= (char-before) ?\")
350                       (> (point) (point-min)))))                       (> (point) (point-min)))))
351        (error nil))))        (error nil))))
352    
# Line 412  With prefix ARG, turn ElDoc mode on if a Line 367  With prefix ARG, turn ElDoc mode on if a
367             (error (setq defn nil))))             (error (setq defn nil))))
368      defn))      defn))
369    
 (defun eldoc-function-arglist (fn)  
   (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)  
                          (cond ((fboundp 'compiled-function-arglist)  
                                 (funcall 'compiled-function-arglist def))  
                                (t  
                                 (aref def 0))))  
                         ((eq (car-safe def) 'lambda)  
                          (nth 1 def))  
                         (t t))))  
     arglist))  
   
370  (defun eldoc-function-argstring (fn)  (defun eldoc-function-argstring (fn)
371    (eldoc-function-argstring-format (eldoc-function-arglist fn)))    (eldoc-function-argstring-format (help-function-arglist fn)))
372    
373  (defun eldoc-function-argstring-format (arglist)  (defun eldoc-function-argstring-format (arglist)
374    (cond ((not (listp arglist))    (cond ((not (listp arglist))
# Line 452  With prefix ARG, turn ElDoc mode on if a Line 391  With prefix ARG, turn ElDoc mode on if a
391    (concat "(" (mapconcat 'identity arglist " ") ")"))    (concat "(" (mapconcat 'identity arglist " ") ")"))
392    
393    
 ;; 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/XEmacs versions which support dynamic loading:  
 ;; 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, which is not particularly desirable either.  
 (defvar 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)  
                      ;; save-restriction has a pathological docstring in  
                      ;; Emacs/XEmacs 19.  
                      (and (not (eq fn 'save-restriction))  
                           (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 common subrs don't have arglists in their docstrings.  So cheat.  
    (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) ")"))))))  
   
   
394  ;; When point is in a sexp, the function args are not reprinted in the echo  ;; When point is in a sexp, the function args are not reprinted in the echo
395  ;; area after every possible interactive command because some of them print  ;; area after every possible interactive command because some of them print
396  ;; their own messages in the echo area; the eldoc functions would instantly  ;; their own messages in the echo area; the eldoc functions would instantly
# Line 611  With prefix ARG, turn ElDoc mode on if a Line 419  With prefix ARG, turn ElDoc mode on if a
419    
420  (defun eldoc-add-command-completions (&rest names)  (defun eldoc-add-command-completions (&rest names)
421    (while names    (while names
422        (apply 'eldoc-add-command      (apply 'eldoc-add-command
423               (all-completions (car names) obarray 'fboundp))             (all-completions (car names) obarray 'fboundp))
424        (setq names (cdr names))))      (setq names (cdr names))))
425    
426  (defun eldoc-remove-command (&rest cmds)  (defun eldoc-remove-command (&rest cmds)
427    (let (name)    (let (name)
# Line 624  With prefix ARG, turn ElDoc mode on if a Line 432  With prefix ARG, turn ElDoc mode on if a
432        (and (symbolp name)        (and (symbolp name)
433             (setq name (symbol-name name)))             (setq name (symbol-name name)))
434    
435        (if (fboundp 'unintern)        (unintern name eldoc-message-commands))))
           (unintern name eldoc-message-commands)  
         (let ((s (intern-soft name eldoc-message-commands)))  
           (and s  
                (makunbound s)))))))  
436    
437  (defun eldoc-remove-command-completions (&rest names)  (defun eldoc-remove-command-completions (&rest names)
438    (while names    (while names

Legend:
Removed from v.1.20  
changed lines
  Added in v.1.20.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26