December 2003 - net-nittin-irc-cvs@common-lisp.net

[net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp
by Kevin Rosenberg 18 Dec '03

18 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv17171 Modified Files: protocol.lisp Log Message: fix typo in function name Date: Thu Dec 18 14:43:09 2003 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.31 net-nittin-irc/protocol.lisp:1.32 --- net-nittin-irc/protocol.lisp:1.31 Thu Dec 18 14:28:29 2003 +++ net-nittin-irc/protocol.lisp Thu Dec 18 14:43:08 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.31 2003/12/18 19:28:29 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.32 2003/12/18 19:43:08 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -137,7 +137,7 @@ (declare (ignore fd)) (read-message connection)))))) -(defun stop-backgound-message-handler (process) +(defun stop-background-message-handler (process) "Stops a background message handler process returned by the start function." #+cmu (mp:destroy-process process) #+allegro (mp:process-kill process)

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp
by Kevin Rosenberg 18 Dec '03

18 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv8388 Modified Files: package.lisp protocol.lisp Log Message: add stop-background-message-handler function Date: Thu Dec 18 14:28:30 2003 Author: krosenberg Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.15 net-nittin-irc/package.lisp:1.16 --- net-nittin-irc/package.lisp:1.15 Tue Dec 16 18:27:25 2003 +++ net-nittin-irc/package.lisp Thu Dec 18 14:28:28 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.15 2003/12/16 23:27:25 krosenberg Exp $ +;;;; $Id: package.lisp,v 1.16 2003/12/18 19:28:28 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -13,6 +13,7 @@ (:export :read-message-loop :read-message :start-background-message-handler + :stop-background-message-handler :send-message :server-name :no-such-reply Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.30 net-nittin-irc/protocol.lisp:1.31 --- net-nittin-irc/protocol.lisp:1.30 Tue Dec 16 18:32:26 2003 +++ net-nittin-irc/protocol.lisp Thu Dec 18 14:28:29 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.30 2003/12/16 23:32:26 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.31 2003/12/18 19:28:29 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -123,7 +123,7 @@ (defvar *process-count* 0) (defmethod start-background-message-handler ((connection connection)) "Read messages from the `connection', parse them and dispatch -irc-message-event on them." +irc-message-event on them. Returns background process ID if available." (flet ((do-loop () (read-message-loop connection))) (let ((name (format nil "irc-hander-~D" (incf *process-count*)))) #+allegro (mp:process-run-function name #'do-loop) @@ -136,6 +136,13 @@ :input (lambda (fd) (declare (ignore fd)) (read-message connection)))))) + +(defun stop-backgound-message-handler (process) + "Stops a background message handler process returned by the start function." + #+cmu (mp:destroy-process process) + #+allegro (mp:process-kill process) + #+sb-thread (sb-thread:destroy-thread process) + #+lispworks (mp:process-kill process)) (defmethod read-message-loop ((connection connection)) (loop while (read-message connection)))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/cliki.lisp
by Brian Mastenbrook 17 Dec '03

17 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv31020 Modified Files: cliki.lisp Log Message: s-b-m-h instead of a-a-m-h Date: Wed Dec 17 20:46:00 2003 Author: bmastenbrook Index: net-nittin-irc/example/cliki.lisp diff -u net-nittin-irc/example/cliki.lisp:1.8 net-nittin-irc/example/cliki.lisp:1.9 --- net-nittin-irc/example/cliki.lisp:1.8 Tue Dec 16 18:18:01 2003 +++ net-nittin-irc/example/cliki.lisp Wed Dec 17 20:46:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.8 2003/12/16 23:18:01 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.9 2003/12/18 01:46:00 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -182,7 +182,7 @@ (mapcar #'(lambda (channel) (join *cliki-connection* channel)) channels) (add-hook *cliki-connection* 'irc::irc-privmsg-message 'msg-hook) (add-hook *cliki-connection* 'irc::irc-notice-message 'notice-hook) - #+sbcl (add-asynchronous-message-handler *cliki-connection*) + #+sbcl (start-background-message-handler *cliki-connection*) #-sbcl (read-message-loop *cliki-connection*)) (defun shuffle-hooks ()

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/clhs.lisp
by Brian Mastenbrook 17 Dec '03

17 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv30814 Modified Files: clhs.lisp Log Message: Multiple attention prefixes, s-b-m-h instead of a-a-m-h, misc. changes Date: Wed Dec 17 20:45:39 2003 Author: bmastenbrook Index: net-nittin-irc/example/clhs.lisp diff -u net-nittin-irc/example/clhs.lisp:1.3 net-nittin-irc/example/clhs.lisp:1.4 --- net-nittin-irc/example/clhs.lisp:1.3 Mon Nov 17 09:04:28 2003 +++ net-nittin-irc/example/clhs.lisp Wed Dec 17 20:45:39 2003 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.3 2003/11/17 14:04:28 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.4 2003/12/18 01:45:39 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/example/clhs.lisp,v $ ;;;; clhs.lisp - an example IRC bot for net-nittin-irc @@ -20,7 +20,7 @@ (in-package :clhs) ;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-pathname* #p"/home/chandler/public_html/HyperSpec/") +(defparameter *hyperspec-pathname* #p"/Users/chandler/Sites/HyperSpec/") (defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) @@ -31,7 +31,7 @@ (defparameter *mop-root* "http://www.alu.org/mop/") -(defparameter *table* (make-hash-table :test 'equalp)) +(defvar *table* (make-hash-table :test 'equalp)) (defun add-clhs-section-to-table (&rest numbers) (let ((key (format nil "~{~d~^.~}" numbers)) @@ -142,30 +142,34 @@ it (format nil "Nothing was found for: ~A" str))) -(defparameter *clhs-attention-prefix* "clhs ") +(defparameter *clhs-attention-prefixes* '("clhs " "clhs: ")) + +(defun valid-clhs-message-1 (message prefix) + (if (eql (search prefix (trailing-argument message) :test #'char-equal) 0) + (and (not (find #\space (trailing-argument message) :start (length prefix))) + (length prefix)) + nil)) (defun valid-clhs-message (message) - (if (eql (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) 0) - (not (find #\space (trailing-argument message) :start (length *clhs-attention-prefix*))) - nil)) + (some #'(lambda (e) (valid-clhs-message-1 message e)) *clhs-attention-prefixes*)) (defun msg-hook (message) (if (string-equal (first (arguments message)) *clhs-nickname*) - (if (valid-clhs-message message) - (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*)))) + (aif (valid-clhs-message message) + (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) it))) (privmsg *clhs-connection* (source message) (spec-lookup (trailing-argument message)))) - (if (valid-clhs-message message) - (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*))))))) + (aif (valid-clhs-message message) + (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) it)))))) (defun start-clhs-bot (nick server &rest channels) (populate-table) (setf *clhs-nickname* nick) (setf *clhs-connection* (connect :nickname *clhs-nickname* :server server)) (mapcar #'(lambda (channel) (join *clhs-connection* channel)) channels) - (add-hook *clhs-connection* 'irc::irc-privmsg-message #'msg-hook) - #+sbcl (add-asynchronous-message-handler *clhs-connection*) + (add-hook *clhs-connection* 'irc::irc-privmsg-message 'msg-hook) + #+sbcl (start-background-message-handler *clhs-connection*) #-sbcl (read-message-loop *clhs-connection*)) (defun shuffle-hooks () (irc::remove-hooks *clhs-connection* 'irc::irc-privmsg-message) - (add-hook *clhs-connection* 'irc::irc-privmsg-message #'msg-hook)) + (add-hook *clhs-connection* 'irc::irc-privmsg-message 'msg-hook))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv26938 Modified Files: protocol.lisp Log Message: fix typo Date: Tue Dec 16 18:32:26 2003 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.29 net-nittin-irc/protocol.lisp:1.30 --- net-nittin-irc/protocol.lisp:1.29 Tue Dec 16 18:31:17 2003 +++ net-nittin-irc/protocol.lisp Tue Dec 16 18:32:26 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.29 2003/12/16 23:31:17 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.30 2003/12/16 23:32:26 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -130,7 +130,7 @@ #+cmu (mp:make-process #'do-loop :name name) #+lispworks (mp:process-run-function name nil #'do-loop) #+sb-thread (sb-thread:make-thread #'do-loop) - #+(and sbcl (not sbcl-thread)) + #+(and sbcl (not sb-thread)) (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor (server-socket connection)) :input (lambda (fd)

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv26733 Modified Files: protocol.lisp Log Message: fix typo Date: Tue Dec 16 18:31:17 2003 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.28 net-nittin-irc/protocol.lisp:1.29 --- net-nittin-irc/protocol.lisp:1.28 Tue Dec 16 18:27:25 2003 +++ net-nittin-irc/protocol.lisp Tue Dec 16 18:31:17 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.28 2003/12/16 23:27:25 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.29 2003/12/16 23:31:17 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -129,7 +129,7 @@ #+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) + #+sb-thread (sb-thread:make-thread #'do-loop) #+(and sbcl (not sbcl-thread)) (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor (server-socket connection))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv24683 Modified Files: package.lisp protocol.lisp Log Message: remove read-message-loop-background, subsume add-asynchronous-message-handler Date: Tue Dec 16 18:27:25 2003 Author: krosenberg Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.14 net-nittin-irc/package.lisp:1.15 --- net-nittin-irc/package.lisp:1.14 Tue Dec 16 17:45:54 2003 +++ net-nittin-irc/package.lisp Tue Dec 16 18:27:25 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.14 2003/12/16 22:45:54 krosenberg Exp $ +;;;; $Id: package.lisp,v 1.15 2003/12/16 23:27:25 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -12,8 +12,7 @@ (:nicknames :irc :cl-irc) (:export :read-message-loop :read-message - :read-message-loop-background - :add-asynchronous-message-handler + :start-background-message-handler :send-message :server-name :no-such-reply Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.27 net-nittin-irc/protocol.lisp:1.28 --- net-nittin-irc/protocol.lisp:1.27 Tue Dec 16 18:21:56 2003 +++ net-nittin-irc/protocol.lisp Tue Dec 16 18:27:25 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.27 2003/12/16 23:21:56 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.28 2003/12/16 23:27:25 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -107,16 +107,6 @@ (let ((stream (server-stream connection))) (and (streamp stream) (open-stream-p stream)))) - -(defmethod add-asynchronous-message-handler ((connection connection)) - #+sbcl - (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor - (server-socket connection)) - :input (lambda (fd) - (declare (ignore fd)) - (read-message connection))) - #-sbcl - (error "add-asynchronous-message-handler is not supported now on non-SBCL")) (defmethod read-message ((connection connection)) (let ((read-more-p t)) @@ -130,18 +120,22 @@ message))) ; needed because of the "loop while" in read-message-loop (stream-error () (setf read-more-p nil))))) -(defvar *background-count* 0) -(defmethod read-message-loop-background ((connection connection)) +(defvar *process-count* 0) +(defmethod start-background-message-handler ((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*)))) + (let ((name (format nil "irc-hander-~D" (incf *process-count*)))) #+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)))) + #+(and sbcl (not sbcl-thread)) + (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor + (server-socket connection)) + :input (lambda (fd) + (declare (ignore fd)) + (read-message connection)))))) (defmethod read-message-loop ((connection connection)) (loop while (read-message connection)))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv22463 Modified Files: protocol.lisp Log Message: fix typo Date: Tue Dec 16 18:21:56 2003 Author: krosenberg Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.26 net-nittin-irc/protocol.lisp:1.27 --- net-nittin-irc/protocol.lisp:1.26 Tue Dec 16 17:45:54 2003 +++ net-nittin-irc/protocol.lisp Tue Dec 16 18:21:56 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.26 2003/12/16 22:45:54 krosenberg Exp $ +;;;; $Id: protocol.lisp,v 1.27 2003/12/16 23:21:56 krosenberg Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -136,14 +136,12 @@ 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)))))) + #+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)))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/cliki.lisp
by Brian Mastenbrook 16 Dec '03

16 Dec '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv20742 Modified Files: cliki.lisp Log Message: Just in case commit Date: Tue Dec 16 18:18:02 2003 Author: bmastenbrook Index: net-nittin-irc/example/cliki.lisp diff -u net-nittin-irc/example/cliki.lisp:1.7 net-nittin-irc/example/cliki.lisp:1.8 --- net-nittin-irc/example/cliki.lisp:1.7 Mon Dec 15 18:11:12 2003 +++ net-nittin-irc/example/cliki.lisp Tue Dec 16 18:18:01 2003 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.7 2003/12/15 23:11:12 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.8 2003/12/16 23:18:01 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -133,7 +133,7 @@ (defparameter *cliki-attention-prefix* "minion: ") -(defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add \"term\" as: definition''; otherwise, edit the corresponding CLiki page.") +(defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add \"term\" as: definition'' or ``minion: alias \"term\" as: term''; otherwise, edit the corresponding CLiki page.") (defun cliki-lookup (term-with-question) (let ((first-pass (regex-replace-all "^(\\s*)([^?]+)(\\?*)$" term-with-question "\\2")))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp
by Kevin Rosenberg 16 Dec '03

16 Dec '03

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

1 0