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))