X-Git-Url: http://git.pond.sub.org/?p=eow;a=blobdiff_plain;f=web.lisp;h=c7ead803bf9f3a808610b80a10d0a286ed2447db;hp=96fcb29d51da10120c0dd1e6a8004d6c03c5356d;hb=d0df339544e58ba26876518ca78eedc1ebb72583;hpb=93ee0f65819529e7361cfc585c6509a045e4344b;ds=sidebyside

diff --git a/web.lisp b/web.lisp
index 96fcb29..c7ead80 100644
--- a/web.lisp
+++ b/web.lisp
@@ -37,6 +37,10 @@
     :accessor update-queue
     :initform (locked-queue:create)
     :documentation "Updates to be sent to the browser")
+   (update-thread
+    :accessor update-thread
+    :initform nil
+    :documentation "COMET thread waiting for updates of non-NIL")
    (connection
    :accessor connection
    :documentation "Connection to the empire game server")))
@@ -64,7 +68,16 @@
 (defun update ()
   "Send stream of updates to client"
   (with-session
-    (locked-queue:dequeue (update-queue *empire-session*))))
+      (when (update-thread *empire-session*)
+	(empire-log:info "~a: Killing update thread ~a." *empire-session* (update-thread *empire-session*))
+	(sb-thread:terminate-thread (update-thread *empire-session*)))
+    (setf (update-thread *empire-session*) sb-thread:*current-thread*)
+    (let ((next-updates (locked-queue:dequeue-all (update-queue *empire-session*))))
+      ; There's a race here. The next update thread might kill this one before
+      ; sending the reply.
+      (setf (update-thread *empire-session*) nil)
+      (nconc next-updates (list (parenscript:ps* '(next))))
+      (apply #'concatenate 'string next-updates))))
 
 (defmethod send ((s session) string)
   "Push a javascript update fragment to the client."