[slime-devel] [PATCH] add eldoc support

[Andras Simon]

On Sat, 1 Nov 2003, Sean O'Rourke wrote:

> This patch lets SLIME support Eldoc (i.e. flashing argument lists in
> the minibuffer).  Inspired by semantic/cedet, which does this for
> many languages.

I applied your patch (both against 1.61 and 1.70), but I must have screwed up
something in the process, because it doesn't seem to work. It shows the elisp
arglists, and when I press space (i.e., slime-space), emacs enters the debugger
with

Debugger entered--Lisp error: (void-variable show)
  (funcall show "%s" (let* (... ...) (let ... ...)))
  (lambda (G20750 arglist) (funcall show "%s" (let* ... ...)))(--symbol-name-- "(&environment env name args &body body)")
  apply((lambda (G20750 arglist) (funcall show "%s" (let* ... ...))) --symbol-name-- "(&environment env name args &body body)")
  (lambda (&rest --cl-rest--) (apply (quote ...) (quote --symbol-name--) --cl-rest--))("(&environment env name args &body body)")
  funcall((lambda (&rest --cl-rest--) (apply (quote ...) (quote --symbol-name--) --cl-rest--)) "(&environment env name args &body body)")

etc.

What am I missing?

In the meantime, here's some experimental code that I use for the same
purpose. Since it is SBCL only, and also to make it easier to try
without messing with the slime sources, I post it as a collection of
elisp and CL functions which can be loaded after slime is up, and not
as a diff. It modifies swank:arglist-string and slime-arglist
slightly. Once both parts are loaded, start it with M-x sldoc-mode in
a slime buffer. sldoc doesn't use eldoc.

The reason I'd prefer yours is that it's elisp only. I had to mess
with swank to avoid (a) swank:arglist-string interning symbols (via
from-string) and (b) "(-- <Unknown-Function>)" messages.

Andras



;;elisp part, load it into emacs _after_ slime.el

(defvar sldoc-timer nil)
(make-variable-buffer-local 'sldoc-timer)
(defvar sldoc-something-happened nil)
(make-variable-buffer-local 'sldoc-something-happened)


(defun sldoc-watch ()
  (setq sldoc-something-happened t))

(easy-mmode-define-minor-mode
 sldoc-mode "Always show arglist for function near point." nil " Sldoc" nil
 (if sldoc-timer
     (progn
       (cancel-timer sldoc-timer)
       (setq sldoc-timer nil)
       (remove-hook 'post-command-hook 'sldoc-watch t))

   (add-hook 'post-command-hook 'sldoc-watch nil t)
   (setq
    sldoc-timer
    (run-with-idle-timer
     0.5 t
     (lambda ()
       (when
           (and sldoc-mode
                sldoc-something-happened
                (slime-connected-p)
                (not (slime-busy-p))
                (slime-function-called-at-point/line)
                (not executing-kbd-macro)
                (not cursor-in-echo-area)
                (not (eq (selected-window) (minibuffer-window))))
         (slime-arglist
          (symbol-name (slime-function-called-at-point/line)) t)
         (setq sldoc-something-happened nil)))))))

(defun slime-arglist (symbol-name &optional silent-if-failed)
  "Show the argument list for the nearest function call, if any."
  (interactive (list (slime-read-symbol "Arglist of: ")))
  (slime-eval-async
   `(swank:arglist-string ,symbol-name ,silent-if-failed)
   (slime-buffer-package)
   (lexical-let ((symbol-name symbol-name))
     (lambda (arglist)
       (when arglist
         (message "%s" (slime-format-arglist symbol-name arglist)))))))

;;sbcl part, load it into SBCL after M-x slime.

(in-package :swank)

(defun safe-fboundp (symbol-name package-name)
  "See if symbol-name is fbound, without interning
it. package-name is ignored if symbol-name is qualified"
  (declare (optimize (safety 0) (debug 0) (speed 3))
           (type simple-base-string symbol-name))
  (setq symbol-name (string-upcase symbol-name))
  (let ((pack-end (position #\:  symbol-name)))
    (declare (type (or null (integer 0 255)) pack-end))
    (when pack-end
      (setq package-name (subseq symbol-name 0 pack-end)
            symbol-name (string-left-trim ":" (subseq symbol-name (1+ pack-end)))))
    (let ((package (find-package package-name)))
      (and package
           (fboundp (find-symbol symbol-name package))))))

(defslimefun arglist-string (fname &optional silent-if-failed)
  (let ((*print-case* :downcase))
    (multiple-value-bind (function condition)
        (when (safe-fboundp fname *buffer-package*)
          (ignore-errors (values (from-string fname))))
      (when condition
        (return-from arglist-string (format nil "(-- ~A)" condition)))
      (let ((arglist
             (ignore-errors (sb-introspect:function-arglist function))))
        (if arglist
            (princ-to-string arglist)
          (unless silent-if-failed "(-- <Unknown-Function>)"))))))