[slime-cvs] CVS slime

[CVS User nsiivola]

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

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Add :WAIT keyword argument to support blocking in SWANK:INSPECT-IN-EMACS.


--- /project/slime/cvsroot/slime/ChangeLog	2009/06/21 12:18:25	1.1791
+++ /project/slime/cvsroot/slime/ChangeLog	2009/06/24 15:33:19	1.1792
@@ -1,3 +1,16 @@
+2009-06-24  Nikodemus Siivola <nikodemus at random-state.net>
+
+	Add :WAIT keyword argument to support blocking in
+	SWANK:INSPECT-IN-EMACS.
+
+	* swank.lisp (inspect-in-emacs): added keyword argument :wait.
+	
+	* slime.el (slime-dispatch-event): if swank requests response to
+	:inspect, add a hook to the inspector to signal swank once done.
+	(slime-open-inspector): add optional hook argument to be added as
+	local kill-buffer-hook.
+	
+
 2009-06-21  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-initialize-lisp-buffer-for-test-suite): Moved to
--- /project/slime/cvsroot/slime/slime.el	2009/06/21 12:18:25	1.1189
+++ /project/slime/cvsroot/slime/slime.el	2009/06/24 15:33:20	1.1190
@@ -2424,8 +2424,13 @@
            (slime-send `(:emacs-return ,thread ,tag ,value)))
           ((:ed what)
            (slime-ed what))
-          ((:inspect what)
-           (slime-open-inspector what))
+          ((:inspect what wait-thread wait-tag)
+           (let ((hook (when (and wait-thread wait-tag)
+                         (lexical-let ((thread wait-thread)
+                                       (tag wait-tag))
+                           (lambda ()
+                             (slime-send `(:emacs-return ,thread ,tag nil)))))))
+             (slime-open-inspector what nil hook)))
           ((:background-message message)
            (slime-background-message "%s" message))
           ((:debug-condition thread message)
@@ -6313,10 +6318,13 @@
 
 (defvar slime-inspector-insert-ispec-function 'slime-inspector-insert-ispec)
 
-(defun slime-open-inspector (inspected-parts &optional point)
+(defun slime-open-inspector (inspected-parts &optional point hook)
   "Display INSPECTED-PARTS in a new inspector window.
-Optionally set point to POINT."
+Optionally set point to POINT. If HOOK is provided, it is added to local
+KILL-BUFFER hooks for the inspector buffer."
   (with-current-buffer (slime-inspector-buffer)
+    (when hook
+      (add-hook 'kill-buffer-hook hook t t))
     (setq slime-buffer-connection (slime-current-connection))
     (let ((inhibit-read-only t))
       (erase-buffer)
--- /project/slime/cvsroot/slime/swank.lisp	2009/06/21 07:22:56	1.649
+++ /project/slime/cvsroot/slime/swank.lisp	2009/06/24 15:33:20	1.650
@@ -2384,13 +2384,20 @@
            (send-oob-to-emacs `(:ed ,target))))
         (t nil)))))
 
-(defslimefun inspect-in-emacs (what)
-  "Inspect WHAT in Emacs."
+(defslimefun inspect-in-emacs (what &key wait)
+  "Inspect WHAT in Emacs. If WAIT is true (default NIL) blocks until the
+inspector has been closed in Emacs."
   (flet ((send-it ()
-           (with-buffer-syntax ()
-             (reset-inspector)
-             (send-oob-to-emacs `(:inspect ,(inspect-object what))))))
-    (cond 
+           (let ((tag (when wait (make-tag)))
+                 (thread (when wait (current-thread-id))))
+             (with-buffer-syntax ()
+               (reset-inspector)
+               (send-oob-to-emacs `(:inspect ,(inspect-object what)
+                                             ,thread
+                                             ,tag)))
+             (when wait
+               (wait-for-event `(:emacs-return ,tag result))))))
+    (cond
       (*emacs-connection*
        (send-it))
       ((default-connection)