[slime-cvs] CVS slime

[CVS User trittweiler]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv13872

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
	* slime.el (slime-dispatch-event): New event
	`:read-from-minibuffer'.
	(slime-read-from-minibuffer-for-swank): New.

	* swank.lisp (dispatch-event): Pass through :read-from-minibuffer
	event.
	(read-from-minibuffer-in-emacs): Now uses new event rather than
	eval-in-emacs.


--- /project/slime/cvsroot/slime/ChangeLog	2009/05/17 14:21:55	1.1763
+++ /project/slime/cvsroot/slime/ChangeLog	2009/05/17 19:12:53	1.1764
@@ -1,3 +1,14 @@
+2009-05-17  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-dispatch-event): New event
+	`:read-from-minibuffer'.
+	(slime-read-from-minibuffer-for-swank): New.
+
+	* swank.lisp (dispatch-event): Pass through :read-from-minibuffer
+	event.
+	(read-from-minibuffer-in-emacs): Now uses new event rather than
+	eval-in-emacs.
+
 2009-05-17  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-openmcl.lisp (compile-temp-file): Remove backward
--- /project/slime/cvsroot/slime/slime.el	2009/05/16 12:46:04	1.1173
+++ /project/slime/cvsroot/slime/slime.el	2009/05/17 19:12:53	1.1174
@@ -2397,6 +2397,8 @@
                                msg))
           ((:emacs-channel-send id msg)
            (slime-send `(:emacs-channel-send ,id ,msg)))
+          ((:read-from-minibuffer thread tag prompt initial-value)
+           (slime-read-from-minibuffer-for-swank thread tag prompt initial-value))
           ((:y-or-n-p thread tag question)
            (slime-y-or-n-p thread tag question))
           ((:emacs-return-string thread tag string)
@@ -4072,6 +4074,11 @@
 (defun slime-y-or-n-p (thread tag question)
   (slime-dispatch-event `(:emacs-return ,thread ,tag ,(y-or-n-p question))))
 
+(defun slime-read-from-minibuffer-for-swank (thread tag prompt initial-value)
+  (let ((answer (condition-case nil 
+                    (slime-read-from-minibuffer prompt initial-value)
+                  (quit nil))))
+    (slime-dispatch-event `(:emacs-return ,thread ,tag ,answer))))
 
 ;;;; Interactive evaluation.
 
--- /project/slime/cvsroot/slime/swank.lisp	2009/05/16 17:21:12	1.646
+++ /project/slime/cvsroot/slime/swank.lisp	2009/05/17 19:12:53	1.647
@@ -1161,7 +1161,7 @@
        :presentation-start :presentation-end
        :new-package :new-features :ed :%apply :indentation-update
        :eval :eval-no-wait :background-message :inspect :ping
-       :y-or-n-p :read-string :read-aborted)
+       :y-or-n-p :read-from-minibuffer :read-string :read-aborted)
       &rest _)
      (declare (ignore _))
      (encode-message event (current-socket-io)))
@@ -1820,7 +1820,18 @@
         (question (apply #'format nil format-string arguments)))
     (force-output)
     (send-to-emacs `(:y-or-n-p ,(current-thread-id) ,tag ,question))
-    (caddr (wait-for-event `(:emacs-return ,tag result)))))
+    (third (wait-for-event `(:emacs-return ,tag result)))))
+
+(defun read-from-minibuffer-in-emacs (prompt &optional initial-value)
+  "Ask user a question in Emacs' minibuffer. Returns \"\" when user
+entered nothing, returns NIL when user pressed C-g."
+  (check-type prompt string) (check-type initial-value (or null string))
+  (let ((tag (make-tag)))
+    (force-output)
+    (send-to-emacs `(:read-from-minibuffer ,(current-thread-id) ,tag
+                                           ,prompt ,initial-value))
+    (third (wait-for-event `(:emacs-return ,tag result)))))
+
 
 (defun process-form-for-emacs (form)
   "Returns a string which emacs will read as equivalent to
@@ -1858,13 +1869,6 @@
 	       ((:ok value) value)
 	       ((:abort) (abort))))))))
 
-;;; FIXME: This should not use EVAL-IN-EMACS but get its own events.
-(defun read-from-minibuffer-in-emacs (prompt &optional initial-value)
-  (eval-in-emacs
-   `(condition-case c
-        (slime-read-from-minibuffer ,prompt ,initial-value)
-      (quit nil))))
-
 (defvar *swank-wire-protocol-version* nil
   "The version of the swank/slime communication protocol.")