*** /home/chris/lisp-libs/slime/swank.lisp	2004-11-24 03:21:10.368750024 -0600
--- /home/chris/lisp-libs/slime/swank.lisp.~1.264.~	2004-11-19 22:55:00.000000000 -0600
***************
*** 1060,1082 ****
      (error (cond)
        (format nil "ARGLIST: ~A" cond))))
  
- (defmacro clean-arglist ((arglist index-symbol symbol-to-clean) &body body)
-   "Binding INDEX-SYMBOL to the position of SYMBOL-TO-CLEAN in
- the list ARGLIST, execute BODY if INDEX-SYMBOL is not nil, otherwise
- return ARGLIST."
-   `(let ((,index-symbol (position ',symbol-to-clean ,arglist)))
-      (if ,index-symbol
-          ,@body
-          ,arglist)))
- 
- (defun remove-aux-from-arglist (arglist)
-   (clean-arglist (arglist aux-index &aux)
-     (subseq arglist 0 aux-index)))
- 
- (defun remove-whole-from-arglist (arglist)
-   (clean-arglist (arglist aux-index &whole)
-     (subseq arglist 2)))
- 
  (defun format-arglist-for-echo-area (symbol name)
    "Return SYMBOL's arglist as string for display in the echo area.
  Use the string NAME as operator name."
--- 1060,1065 ----
***************
*** 1091,1120 ****
  pretty printing of (function foo) as #'foo is suppressed."
    (etypecase arglist
      (null "()")
!     (cons
!      (let ((arglist (remove-whole-from-arglist (remove-aux-from-arglist arglist))))
!        (with-output-to-string (*standard-output*)
!          (with-standard-io-syntax
!            (let ((*package* package)
!                  (*print-case* :downcase)
!                  (*print-pretty* t)
!                  (*print-circle* nil)
!                  (*print-readably* nil)
!                  (*print-level* 10)
!                  (*print-length* 20))
!              (pprint-logical-block (nil nil :prefix "(" :suffix ")")
!                (loop
!                   (let ((arg (pop arglist)))
!                     (etypecase arg
!                       (symbol (princ arg))
!                       (string (princ arg))
!                       (cons (pprint-logical-block (nil nil :prefix "(" :suffix ")")
!                               (princ (car arg))
!                               (write-char #\space)
!                               (pprint-fill *standard-output* (cdr arg) nil))))
!                     (when (null arglist) (return))
!                     (write-char #\space)
!                     (pprint-newline :fill)))))))))))
  
  (defun test-print-arglist (list string)
    (string= (arglist-to-string list (find-package :swank)) string))
--- 1077,1105 ----
  pretty printing of (function foo) as #'foo is suppressed."
    (etypecase arglist
      (null "()")
!     (cons 
!      (with-output-to-string (*standard-output*)
!        (with-standard-io-syntax
!          (let ((*package* package)
!                (*print-case* :downcase)
!                (*print-pretty* t)
!                (*print-circle* nil)
!                (*print-readably* nil)
!                (*print-level* 10)
!                (*print-length* 20))
!            (pprint-logical-block (nil nil :prefix "(" :suffix ")")
!              (loop
!               (let ((arg (pop arglist)))
!                 (etypecase arg
!                   (symbol (princ arg))
!                   (string (princ arg))
!                   (cons (pprint-logical-block (nil nil :prefix "(" :suffix ")")
!                           (princ (car arg))
!                           (write-char #\space)
!                           (pprint-fill *standard-output* (cdr arg) nil))))
!                 (when (null arglist) (return))
!                 (write-char #\space)
!                 (pprint-newline :fill))))))))))
  
  (defun test-print-arglist (list string)
    (string= (arglist-to-string list (find-package :swank)) string))
***************
*** 1123,1130 ****
  (assert (test-print-arglist '(function cons) "(function cons)"))
  (assert (test-print-arglist '(quote cons) "(quote cons)"))
  (assert (test-print-arglist '(&key (function #'+)) "(&key (function #'+))"))
- (assert (test-print-arglist '(&whole x y z) "(y z)"))
- (assert (test-print-arglist '(x &aux y z) "(x)"))
  ;; Expected failure:
  ;; (assert (test-print-arglist '(&key ((function f))) "(&key ((function f)))"))
  
--- 1108,1113 ----