Upgrade to SLIME version 2.21

slime/contrib/swank-arglists.lisp

@@ -673,7 +673,7 @@ whether &allow-other-keys appears somewhere."
          amuc
          (compute-applicable-methods generic-function arguments)))))
 
-(defgeneric extra-keywords (operator &rest args)
+(defgeneric extra-keywords (operator args)
    (:documentation "Return a list of extra keywords of OPERATOR (a
 symbol) when applied to the (unevaluated) ARGS.
 As a secondary value, return whether other keys are allowed.
@@ -693,7 +693,7 @@ to determine the extra keywords."))
 ;;; obfuscating the arglist of MAKE-INSTANCE.
 ;;;
 
-(defmethod extra-keywords :around (op &rest args)
+(defmethod extra-keywords :around (op args)
   (declare (ignorable op args))
   (multiple-value-bind (keywords aok enrichments) (call-next-method)
     (values (sort-extra-keywords keywords) aok enrichments)))
@@ -734,7 +734,7 @@ forward keywords to OPERATOR."
     (values (arglist.keyword-args arglist)
             (arglist.allow-other-keys-p arglist))))
 
-(defmethod extra-keywords (operator &rest args)
+(defmethod extra-keywords (operator args)
   ;; default method
   (declare (ignore args))
   (let ((symbol-function (symbol-function operator)))
@@ -771,7 +771,7 @@ forward keywords to OPERATOR."
                           (swank-mop:slot-definition-initargs slot)))))
       (values slot-init-keywords allow-other-keys-p))))
 
-(defun extra-keywords/make-instance (operator &rest args)
+(defun extra-keywords/make-instance (operator args)
   (declare (ignore operator))
   (unless (null args)
     (let* ((class-name-form (car args))
@@ -799,7 +799,7 @@ forward keywords to OPERATOR."
                         (or class-aokp ai-aokp ii-aokp si-aokp)
                         (list class-name-form))))))))))
 
-(defun extra-keywords/change-class (operator &rest args)
+(defun extra-keywords/change-class (operator args)
   (declare (ignore operator))
   (unless (null args)
     (let* ((class-name-form (car args))
@@ -824,44 +824,43 @@ forward keywords to OPERATOR."
                     (list class-name-form))))))))
 
 (defmethod extra-keywords ((operator (eql 'make-instance))
-                           &rest args)
-  (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+                           args)
+  (multiple-value-or (extra-keywords/make-instance operator args)
                      (call-next-method)))
 
 (defmethod extra-keywords ((operator (eql 'make-condition))
-                           &rest args)
-  (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+                           args)
+  (multiple-value-or (extra-keywords/make-instance operator args)
                      (call-next-method)))
 
 (defmethod extra-keywords ((operator (eql 'error))
-                           &rest args)
-  (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+                           args)
+  (multiple-value-or (extra-keywords/make-instance operator args)
                      (call-next-method)))
 
 (defmethod extra-keywords ((operator (eql 'signal))
-                           &rest args)
-  (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+                           args)
+  (multiple-value-or (extra-keywords/make-instance operator args)
                      (call-next-method)))
 
 (defmethod extra-keywords ((operator (eql 'warn))
-                           &rest args)
-  (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+                           args)
+  (multiple-value-or (extra-keywords/make-instance operator args)
                      (call-next-method)))
 
 (defmethod extra-keywords ((operator (eql 'cerror))
-                           &rest args)
+                           args)
   (multiple-value-bind (keywords aok determiners)
-      (apply #'extra-keywords/make-instance operator
-             (cdr args))
+      (extra-keywords/make-instance operator (cdr args))
     (if keywords
         (values keywords aok
                 (cons (car args) determiners))
         (call-next-method))))
 
 (defmethod extra-keywords ((operator (eql 'change-class))
-                           &rest args)
+                           args)
   (multiple-value-bind (keywords aok determiners)
-      (apply #'extra-keywords/change-class operator (cdr args))
+      (extra-keywords/change-class operator (cdr args))
     (if keywords
         (values keywords aok
                 (cons (car args) determiners))
@@ -888,7 +887,7 @@ the initial sublist of ARGS that was needed to determine the extra
 keywords.  As a tertiary return value, return whether any enrichment
 was done."
   (multiple-value-bind (extra-keywords extra-aok determining-args)
-      (apply #'extra-keywords form)
+      (extra-keywords (car form) (cdr form))
     ;; enrich the list of keywords with the extra keywords
     (enrich-decoded-arglist-with-keywords decoded-arglist
                                           extra-keywords extra-aok)

slime/contrib/swank-asdf.lisp

@@ -425,13 +425,19 @@ already knows."
                  (asdf:module (map () #'f (asdf:module-components x))))))
       (f component))))
 
+(defun make-operation (x)
+  #+#.(swank/backend:with-symbol 'make-operation 'asdf)
+  (asdf:make-operation x)
+  #-#.(swank/backend:with-symbol 'make-operation 'asdf)
+  (make-instance x))
+
 (defun asdf-component-output-files (component)
   (while-collecting (c)
     (labels ((f (x)
                (typecase x
                  (asdf:source-file
                   (map () #'c
-                       (asdf:output-files (make-instance 'asdf:compile-op) x)))
+                       (asdf:output-files (make-operation 'asdf:compile-op) x)))
                  (asdf:module (map () #'f (asdf:module-components x))))))
       (f component))))
 
@@ -452,7 +458,7 @@ already knows."
   (component-loaded-p name))
 
 (defslimefun asdf-system-directory (name)
-  (namestring (asdf:system-source-directory name)))
+  (namestring (translate-logical-pathname (asdf:system-source-directory name))))
 
 (defun pathname-system (pathname)
   (let ((component (pathname-component pathname)))
@@ -516,11 +522,11 @@ already knows."
   (let ((component (pathname-component pathname)))
     (when component
       ;;(format t "~&Compiling ASDF component ~S~%" component)
-      (let ((op (make-instance 'asdf:compile-op)))
+      (let ((op (make-operation 'asdf:compile-op)))
         (with-compilation-hooks ()
           (asdf:perform op component))
         (when load-p
-          (asdf:perform (make-instance 'asdf:load-op) component))
+          (asdf:perform (make-operation 'asdf:load-op) component))
         (values t t nil (first (asdf:output-files op component)))))))
 
 (defun try-compile-asd-file (pathname load-p &rest options)

slime/contrib/swank-fancy-inspector.lisp

@@ -936,13 +936,11 @@ SPECIAL-OPERATOR groups."
 
 (defmethod emacs-inspect ((f float))
   (cond
-    ((> f most-positive-long-float)
-     (list "Positive infinity."))
-    ((< f most-negative-long-float)
-     (list "Negative infinity."))
-    ((not (= f f))
+    ((float-nan-p f)
+     ;; try NaN first because the next tests may perform operations
+     ;; that are undefined for NaNs.
      (list "Not a Number."))
-    (t
+    ((not (float-infinity-p f))
      (multiple-value-bind (significand exponent sign) (decode-float f)
        (append
 	`("Scientific: " ,(format nil "~E" f) (:newline)
@@ -952,7 +950,11 @@ SPECIAL-OPERATOR groups."
 			 (:value ,(float-radix f)) "^"
 			 (:value ,exponent) (:newline))
 	(label-value-line "Digits" (float-digits f))
-	(label-value-line "Precision" (float-precision f)))))))
+	(label-value-line "Precision" (float-precision f)))))
+    ((> f 0)
+     (list "Positive infinity."))
+    ((< f 0)
+     (list "Negative infinity."))))
 
 (defun make-pathname-ispec (pathname position)
   `("Pathname: "

slime/contrib/swank-kawa.scm

@@ -809,6 +809,12 @@
          (l (values-to-list (eval form env))))
     (apply cat (map pprint-to-string l))))
 
+(defslimefun eval-and-grab-output (env string)
+  (let ((form (read (open-input-string string))))
+    (let-values ((values (eval form env)))
+      (list ""
+            (format #f "~{~S~^~%~}" values)))))
+
 (df call-with-abort (f)
   (try-catch (f) (ex <throwable> (exception-message ex))))
 

slime/contrib/swank-macrostep.lisp

@@ -1,6 +1,6 @@
 ;;; swank-macrostep.lisp -- fancy macro-expansion via macrostep.el
 ;;
-;; Authors: Luís Oliveira <luismbo@gmail.com>
+;; Authors: Luis Oliveira <luismbo@gmail.com>
 ;;          Jon Oddie <j.j.oddie@gmail.com>
 ;;
 ;; License: Public Domain

slime/contrib/swank-repl.lisp

@@ -111,8 +111,7 @@ DEDICATED-OUTPUT INPUT OUTPUT IO REPL-RESULTS"
     (typecase connection
       (multithreaded-connection
        (setf (mconn.auto-flush-thread connection)
-	     (spawn (lambda () (auto-flush-loop out))
-		    :name "auto-flush-thread"))))
+             (make-auto-flush-thread out))))
     (values dedicated-output in out io repl-results)))
 
 (defun make-output-function (connection)

slime/contrib/swank-sbcl-exts.lisp

@@ -37,6 +37,9 @@
                      (symbol
                       (string-downcase instruction))))
                  (instr-fn
+                   #+#.(swank/backend:with-symbol 'op-encoder-name 'sb-assem)
+                   (or (sb-assem::op-encoder-name instr-name)
+                       (sb-assem::op-encoder-name (string-upcase instr-name)))
                    #+#.(swank/backend:with-symbol 'inst-emitter-symbol 'sb-assem)
                    (sb-assem::inst-emitter-symbol instr-name)
                    #+(and

slime/contrib/swank-snapshot.lisp

@@ -52,7 +52,7 @@
 	 (stream (make-fd-stream fd nil))
 	 (connection (make-connection nil stream style)))
     (let ((*emacs-connection* connection))
-      (when repl (swank::create-repl nil))
+      (when repl (swank-repl:create-repl nil))
       (background-message "~A" "Lisp image restored"))
     (serve-requests connection)
     (simple-repl)))

slime/packages.lisp

@@ -60,12 +60,15 @@
            profile-reset
            profile-package
 
-           with-collected-macro-forms))
+           with-collected-macro-forms
+           auto-flush-loop
+           *auto-flush-interval*))
 
 (defpackage swank/rpc
   (:use :cl)
   (:export
    read-message
+   read-packet
    swank-reader-error
    swank-reader-error.packet
    swank-reader-error.cause