[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
Make *event-queue* and *events-enqueued* slots of the connection struct.

* swank.lisp (*event-queue*, *events-enqueued*): Deleted
([struct] singlethreaded-connection): New slots event-queue and
events-enqueued.
(poll-for-event, send-event, wait-for-event/event-loop): Update
accordingly.

--- /project/slime/cvsroot/slime/ChangeLog	2011/12/07 19:23:44	1.2278
+++ /project/slime/cvsroot/slime/ChangeLog	2011/12/07 21:06:30	1.2279
@@ -1,5 +1,16 @@
 2011-12-07  Helmut Eller  <heller at common-lisp.net>
 
+	Make *event-queue* and *events-enqueued* slots of the connection
+	struct.
+
+	* swank.lisp (*event-queue*, *events-enqueued*): Deleted
+	([struct] singlethreaded-connection): New slots event-queue and
+	events-enqueued.
+	(poll-for-event, send-event, wait-for-event/event-loop): Update
+	accordingly.
+
+2011-12-07  Helmut Eller  <heller at common-lisp.net>
+
 	* slime.el ([xemacs]): Use (find-coding-system 'utf-8-unix)
 	instead of checking the XEmacs version to decide when 'un-define
 	is required.
--- /project/slime/cvsroot/slime/swank.lisp	2011/12/07 18:27:17	1.774
+++ /project/slime/cvsroot/slime/swank.lisp	2011/12/07 21:06:30	1.775
@@ -228,7 +228,14 @@
                                       (:conc-name sconn.))
   ;; The SIGINT handler we should restore when the connection is
   ;; closed.
-  saved-sigint-handler)
+  saved-sigint-handler
+  ;; A queue of events.  Not all events can be processed in order and
+  ;; we need a place to stored them.
+  (event-queue '() :type list)
+  ;; A counter that is incremented whenever an event is added to the
+  ;; queue.  This is used to detected modifications to the event queue
+  ;; by interrupts.  The counter wraps around.
+  (events-enqueued 0 :type fixnum))
 
 (defstruct (multithreaded-connection (:include connection)
                                      (:conc-name mconn.))
@@ -1008,10 +1015,14 @@
 
 (defun send-event (thread event)
   (log-event "send-event: ~s ~s~%" thread event)
-  (cond ((use-threads-p) (send thread event))
-        (t (setf *event-queue* (nconc *event-queue* (list event)))
-           (setf *events-enqueued* (mod (1+ *events-enqueued*)
-                                        most-positive-fixnum)))))
+  (let ((c *emacs-connection*))
+    (etypecase c
+      (multithreaded-connection 
+       (send thread event))
+      (singlethreaded-connection 
+       (setf (sconn.event-queue c) (nconc (sconn.event-queue c) (list event)))
+       (setf (sconn.events-enqueued c) (mod (1+ (sconn.events-enqueued c))
+                                            most-positive-fixnum))))))
 
 (defun send-to-emacs (event)
   "Send EVENT to Emacs."
@@ -1065,13 +1076,13 @@
   (assert (or (not timeout) (eq timeout t)))
   (loop 
    (check-slime-interrupts)
-   (let ((event (poll-for-event pattern)))
+   (let ((event (poll-for-event connection pattern)))
      (when event (return (car event))))
-   (let ((events-enqueued *events-enqueued*)
+   (let ((events-enqueued (sconn.events-enqueued connection))
          (ready (wait-for-input (list (current-socket-io)) timeout)))
      (cond ((and timeout (not ready))
             (return (values nil t)))
-           ((or (/= events-enqueued *events-enqueued*)
+           ((or (/= events-enqueued (sconn.events-enqueued connection))
                 (eq ready :interrupt))
             ;; rescan event queue, interrupts may enqueue new events 
             )
@@ -1080,12 +1091,13 @@
             (dispatch-event connection
                             (decode-message (current-socket-io))))))))
 
-(defun poll-for-event (pattern)
-  (let ((tail (member-if (lambda (e) (event-match-p e pattern))
-                         *event-queue*)))
+(defun poll-for-event (connection pattern)
+  (let* ((c connection)
+         (tail (member-if (lambda (e) (event-match-p e pattern))
+                          (sconn.event-queue c))))
     (when tail 
-      (setq *event-queue* (nconc (ldiff *event-queue* tail)
-                                 (cdr tail)))
+      (setf (sconn.event-queue c) 
+            (nconc (ldiff (sconn.event-queue c) tail) (cdr tail)))
       tail)))
 
 ;;; FIXME: Make this use SWANK-MATCH.