[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	slime.el swank.lisp 
Log Message:
Experimental channels

--- /project/slime/cvsroot/slime/slime.el	2009/01/02 21:57:23	1.1089
+++ /project/slime/cvsroot/slime/slime.el	2009/01/02 21:57:31	1.1090
@@ -2269,8 +2269,7 @@
   ;; slime-autodoc.)  If this ever happens again, returning the
   ;; following will make debugging much easier:
   :slime-eval-async)
-
-
+  
 ;;; These functions can be handy too:
 
 (defun slime-connected-p ()
@@ -2365,6 +2364,10 @@
            (sldb-exit thread level stepping))
           ((:emacs-interrupt thread)
            (slime-send `(:emacs-interrupt ,thread)))
+          ((:channel-send id msg)
+           (slime-channel-send (or (slime-find-channel id)
+                                   (error "Invalid channel id: %S %S" id msg))
+                               msg))
           ((:y-or-n-p thread tag question)
            (slime-y-or-n-p thread tag question))
           ((:emacs-return-string thread tag string)
@@ -2414,6 +2417,40 @@
   (interactive)
   (signal-process (slime-pid) 'SIGINT))
 
+
+;;;;; Channels
+
+(slime-def-connection-var slime-channels '()
+  "Alist of the form (ID . CHANNEL).")
+
+(slime-def-connection-var slime-channels-counter 0
+  "Channel serial number counter.")
+
+(defstruct (slime-channel (:conc-name slime-channel.)
+                          (:constructor 
+                           slime-make-channel% (operations name id)))
+  operations name id)
+
+(defun slime-make-channel (operations &optional name)
+  (let* ((id (incf (slime-channels-counter)))
+         (ch (slime-make-channel% operations name id)))
+    (push (cons (cons id ch) (slime-channels)))))
+
+(defun slime-close-channel (channel)
+  (setf (slime-channels.operations channel) 'closed-channel)
+  (let ((probe (assq (slime-channel.id channel) (slime-channels))))
+    (cond (probe (setf (slime-channels) (delete probe (slime-channels))))
+          (t (error "Invalid channel: %s" channel)))))
+
+(defun slime-find-channel (id)
+  (cdr (assq id (slime-channels))))
+
+(defun slime-channel-send (channel message)
+  (apply (or (cdr (assq (car message)
+                        (slime-channel.operations channel)))
+             (error "Unsupported operation: %S %S" message channel))
+         (cdr message)))
+
 ;;;;; Event logging to *slime-events*
 ;;;
 ;;; The *slime-events* buffer logs all protocol messages for debugging
--- /project/slime/cvsroot/slime/swank.lisp	2009/01/01 14:48:04	1.621
+++ /project/slime/cvsroot/slime/swank.lisp	2009/01/02 21:57:31	1.622
@@ -1105,8 +1105,8 @@
      (encode-message `(:return , at args) (current-socket-io)))
     ((:emacs-interrupt thread-id)
      (interrupt-worker-thread thread-id))
-    (((:write-string
-       :debug :debug-condition :debug-activate :debug-return
+    (((:write-string 
+       :debug :debug-condition :debug-activate :debug-return :channel-send
        :presentation-start :presentation-end
        :new-package :new-features :ed :%apply :indentation-update
        :eval :eval-no-wait :background-message :inspect :ping