Re: arglist display

[cgay@majestix.cs.uoregon.edu]

   From: lynch@ils.nwu.edu
   Newsgroups: comp.lang.lisp.mcl
   Date: 15 Jan 93 18:15:46 GMT

   (setq ccl::*save-arglist-info* t)

   However, what it still doesn't do, is if you type (foo , and foo is not a
   function is erase the old arglist.
   Basically, if I'm looking for a function name that I'm not sure of and I
   just used another function with a similar arglist, I have to type (let and
   then erase that just to get a known arglist so I can see if it changes when
   I type (foo to see if foo *really* has an arglist, or I'm just seeing the
   arglist from before.

Here's something that I find works pretty well.  It searches backwards
for the current function and displays its arglist.  As is my custom,
I've left it unfinished.  See the bugs list.

Cheers.
- -Carl

;;; ________________________________________
;;; Improved Arglist  (c-x c-a)
 
;;; Bugs:
;;; - ed-arglist will display the arglist for FOO:BAR even if BAR isn't exported
;;; from FOO.  This is confusing.  ed-improved-arglist gets a reader error in
;;; this case.  Since only a simple-error is signalled I'm not going to bother
;;; to handle it.  Hopefully in MCL 2.0 final a more specific condition will be
;;; signalled.
;;; - ed-improved-arglist can be fooled if the cursor is in a string.  Once
;;; again we need to have some concept of the current syntactic context...
;;; - Blows chow on '(#\c
;;; - ARGLIST returns NIL for some forms like LET, (SETF C*R), etc but
;;; ed-arglist finds the arglist somehow.  Need to figure out how it works.
 
;;; to do:
;;; - Find local function arglists a la FLET, LABELS and MACROLET.
;;; This could be an option since it will be slow
;;; - Figure out how wide the minibuffer display is so I can determine whether
;;; the function name should be abbreviated (or left off entirely, if it isn't
;;; already.
 
(defparameter *arglist-show-function-name* nil)
 
(defun display-arglist (symbol window)
  ;;(set-mini-buffer window "~%")         ; clear the mini-buffer
  (multiple-value-bind (arglist arglist-type)
                       (arglist symbol t)
    (if (null arglist-type)
      (set-mini-buffer window "~S is not defined." symbol)
      (let ((text (with-output-to-string (s)
                    (when *arglist-show-function-name*
                      (format s "(~S" symbol))
                    (if (null arglist)
                      (write-char #\) s)
                      (progn (when *arglist-show-function-name*
                               (write-char #\Space s))
                             (arglist-to-stream symbol s)
                             (when *arglist-show-function-name*
                               (write-char #\) s)))))))
        (set-mini-buffer window "~A" text)))))
 
(defmethod ed-improved-arglist ((window fred-mixin))
  (flet ((function-not-found ()
           (set-mini-buffer window "Can't find current function.")
           (ed-beep)
           (return-from ed-improved-arglist nil)))
    (let ((b (fred-buffer window)))
      (when (> (buffer-size b) 0)
        (do* ((pos (buffer-position b) (buffer-bwd-sexp b pos))
              (char (buffer-char b (- pos 1)) (and pos (buffer-char b (- pos 1)))))
             ((and char (char-equal char #\())
              (multiple-value-bind (symbol found-p prev-char)
                                   (buffer-current-sexp b pos)
                (declare (ignore prev-char))
                (if (not found-p)
                  (function-not-found)
                  (progn
                    (when (eql symbol 'setf)
                      (setq pos (buffer-skip-fwd-wsp&comments b (buffer-fwd-sexp b pos)
                                                              (buffer-size b)))
                      (when pos
                        (let ((what (buffer-current-sexp b pos)))
                          (when (and (consp what)   ; What about symbol macros?
                                     (atom (car what)))
                            (setq symbol `(setf ,(car what)))))))
                    (display-arglist symbol window)))))
          (when (or (null pos)
                    ;; Stop searching backwards when we get to the beginning of
                    ;; a top-level definition.
                    (and (= 0 (buffer-column b pos))
                         (char-equal #\( (buffer-char b pos))))
            (function-not-found)))))))
 
;;; This replaces the normal ed-arglist binding, but the old version can still
;;; be accessed with Space if *arglist-on-space* is T.
(comtak-set-key *control-x-comtab* '(:control #\a) 'ed-improved-arglist)



------- End of Forwarded Message