[net-nittin-irc-cvs] CVS update: net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp

[Kevin Rosenberg]

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc
In directory common-lisp.net:/tmp/cvs-serv7798

Modified Files:
	package.lisp protocol.lisp 
Log Message:
add read-message-loop-background function
Date: Tue Dec 16 17:45:54 2003
Author: krosenberg

Index: net-nittin-irc/package.lisp
diff -u net-nittin-irc/package.lisp:1.13 net-nittin-irc/package.lisp:1.14
--- net-nittin-irc/package.lisp:1.13	Tue Dec 16 16:29:12 2003
+++ net-nittin-irc/package.lisp	Tue Dec 16 17:45:54 2003
@@ -1,4 +1,4 @@
-;;;; $Id: package.lisp,v 1.13 2003/12/16 21:29:12 krosenberg Exp $
+;;;; $Id: package.lisp,v 1.14 2003/12/16 22:45:54 krosenberg Exp $
 ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -12,6 +12,7 @@
     (:nicknames :irc :cl-irc)
     (:export :read-message-loop
              :read-message
+	     :read-message-loop-background
              :add-asynchronous-message-handler
              :send-message
              :server-name


Index: net-nittin-irc/protocol.lisp
diff -u net-nittin-irc/protocol.lisp:1.25 net-nittin-irc/protocol.lisp:1.26
--- net-nittin-irc/protocol.lisp:1.25	Tue Dec 16 13:57:36 2003
+++ net-nittin-irc/protocol.lisp	Tue Dec 16 17:45:54 2003
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.25 2003/12/16 18:57:36 krosenberg Exp $
+;;;; $Id: protocol.lisp,v 1.26 2003/12/16 22:45:54 krosenberg Exp $
 ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -130,9 +130,22 @@
               message))) ; needed because of the "loop while" in read-message-loop
       (stream-error () (setf read-more-p nil)))))
 
-(defmethod read-message-loop ((connection connection))
+(defvar *background-count* 0)
+(defmethod read-message-loop-background ((connection connection))
   "Read messages from the `connection', parse them and dispatch
 irc-message-event on them."
+  (flet ((do-loop () (read-message-loop connection)))
+    (let ((name (format nil "irc-hander-~D" (incf *background-count*))))
+      (cond
+       (async
+	#+allegro (mp:process-run-function name #'do-loop)
+	#+cmu (mp:make-process #'do-loop :name name)
+	#+lispworks (mp:process-run-function name nil #'do-loop)
+	#+sbcl-thread (sb-thread:make-thread #'do-loop)
+	#+(and sbcl (not sbcl-thread)) (add-asynchronous-message-handler
+					connection))))))
+
+(defmethod read-message-loop ((connection connection))
   (loop while (read-message connection)))
 
 (defmethod read-irc-message ((connection connection))