[slime-cvs] CVS update: slime/swank.lisp

[Matthias Koeppe]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv1712

Modified Files:
	swank.lisp 
Log Message:
(dispatch-event, send-to-socket-io): Handle new
messages :y-or-n-p, :background-message.  
(y-or-n-p-in-emacs): New function.

Date: Mon Aug 29 21:31:36 2005
Author: mkoeppe

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.326 slime/swank.lisp:1.327
--- slime/swank.lisp:1.326	Sun Aug 28 16:50:03 2005
+++ slime/swank.lisp	Mon Aug 29 21:31:35 2005
@@ -588,6 +588,8 @@
      (encode-message `(,(car event) ,(thread-id thread) , at args) socket-io))
     ((:read-string thread &rest args)
      (encode-message `(:read-string ,(thread-id thread) , at args) socket-io))
+    ((:y-or-n-p thread &rest args)
+     (encode-message `(:y-or-n-p ,(thread-id thread) , at args) socket-io))
     ((:evaluate-in-emacs string thread &rest args)
      (encode-message `(:evaluate-in-emacs ,string ,(thread-id thread) , at args)
                      socket-io))
@@ -601,7 +603,7 @@
      (send (find-thread thread-id) `(take-input ,tag ,value)))
     (((:read-output :presentation-start :presentation-end
                     :new-package :new-features :ed :%apply :indentation-update
-                    :eval-no-wait)
+                    :eval-no-wait :background-message)
       &rest _)
      (declare (ignore _))
      (encode-message event socket-io))))
@@ -712,7 +714,7 @@
              (encode-message o (current-socket-io)))))
     (destructure-case event
       (((:debug-activate :debug :debug-return :read-string :read-aborted 
-                         :eval)
+                         :y-or-n-p :eval)
         thread &rest args)
        (declare (ignore thread))
        (send `(,(car event) 0 , at args)))
@@ -723,7 +725,8 @@
        (send `(:evaluate-in-emacs ,string 0 , at args)))
       (((:read-output :new-package :new-features :debug-condition
                       :presentation-start :presentation-end
-                      :indentation-update :ed :%apply :eval-no-wait)
+                      :indentation-update :ed :%apply :eval-no-wait
+                      :background-message)
         &rest _)
        (declare (ignore _))
        (send event)))))
@@ -1015,6 +1018,18 @@
              (setq ok t))
         (unless ok 
           (send-to-emacs `(:read-aborted ,(current-thread) ,tag)))))))
+
+(defun y-or-n-p-in-emacs (&optional format-string &rest arguments)
+  "Like y-or-n-p, but ask in the Emacs minibuffer."
+  (let ((tag (incf *read-input-catch-tag*))
+        (question (if format-string
+                      (apply #'format nil format-string arguments)
+                      "")))
+    (force-output)
+    (send-to-emacs `(:y-or-n-p ,(current-thread) ,tag ,question))
+    (unwind-protect
+         (catch (intern-catch-tag tag)
+           (loop (read-from-emacs))))))
 
 (defslimefun take-input (tag input)
   "Return the string INPUT to the continuation TAG."