Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv15254
Modified Files: command.lisp package.lisp protocol.lisp Log Message: Add asynchronous message handling on SBCL
Date: Fri Nov 14 14:28:01 2003 Author: bmastenbrook
Index: net-nittin-irc/command.lisp diff -u net-nittin-irc/command.lisp:1.3 net-nittin-irc/command.lisp:1.4 --- net-nittin-irc/command.lisp:1.3 Fri Nov 7 10:40:19 2003 +++ net-nittin-irc/command.lisp Fri Nov 14 14:28:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.3 2003/11/07 15:40:19 eenge Exp $ +;;;; $Id: command.lisp,v 1.4 2003/11/14 19:28:00 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/command.lisp,v $
;;;; See LICENSE for licensing information. @@ -170,11 +170,15 @@ :protocol :tcp))) (sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses (sb-bsd-sockets:get-host-by-name host))) port) - (sb-bsd-sockets:socket-make-stream s - :element-type 'character - :input t - :output t - :buffering :none))) + s)) + +#+sbcl +(defun socket-stream (socket) + (sb-bsd-sockets:socket-make-stream socket + :element-type 'character + :input t + :output t + :buffering :none))
(defun connect (&key (nickname *default-nickname*) (username nil) @@ -183,17 +187,20 @@ (server *default-irc-server*) (port *default-irc-server-port*)) "Connect to server and return a connection object." - (let* ((stream #+lispworks (comm:open-tcp-stream server port :errorp t) + (let* ((socket #+sbcl (connect-to-server-socket server port) + #-sbcl nil) + (stream #+lispworks (comm:open-tcp-stream server port :errorp t) #+cmu (sys:make-fd-stream (ext:connect-to-inet-socket server port) :input t :output t :element-type 'character) #+allegro (socket:make-socket :remote-host server :remote-port port) - #+sbcl (connect-to-server-socket server port)) + #+sbcl (socket-stream socket)) (user (make-user :nickname nickname :username username :realname realname)) - (connection (make-connection :server-stream stream + (connection (make-connection :server-socket socket + :server-stream stream :user user :server-name server))) (nick connection nickname)
Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.5 net-nittin-irc/package.lisp:1.6 --- net-nittin-irc/package.lisp:1.5 Fri Nov 14 11:13:21 2003 +++ net-nittin-irc/package.lisp Fri Nov 14 14:28:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.5 2003/11/14 16:13:21 eenge Exp $ +;;;; $Id: package.lisp,v 1.6 2003/11/14 19:28:00 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -11,6 +11,7 @@ (:nicknames :irc) (:export :read-message-loop :read-message + :add-asynchronous-message-handler :send-message :server-name :server-stream
Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.8 net-nittin-irc/protocol.lisp:1.9 --- net-nittin-irc/protocol.lisp:1.8 Fri Nov 14 11:13:21 2003 +++ net-nittin-irc/protocol.lisp Fri Nov 14 14:28:00 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.8 2003/11/14 16:13:21 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.9 2003/11/14 19:28:00 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $
;;;; See LICENSE for licensing information. @@ -28,6 +28,10 @@ :initarg :server-name :accessor server-name :initform "Unknown server") + (server-socket + :initarg :server-socket + :accessor server-socket + :documentation "Socket used to talk to the IRC server.") (server-stream :initarg :server-stream :accessor server-stream @@ -72,6 +76,7 @@
(defun make-connection (&key (user nil) (server-name "") + (server-socket nil) (server-stream nil) (client-stream t) (channels nil) @@ -84,6 +89,7 @@ (connection (make-instance 'connection :user user :server-name server-name + :server-socket server-socket :server-stream server-stream :client-stream client-stream :channels channels @@ -103,6 +109,16 @@ (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)) + (lambda (fd) + (declare (ignore fd)) + (read-messsage connection))) + #-sbcl + (error "add-asynchronous-message-handler is not supported now on non-SBCL"))
(defmethod read-message ((connection connection)) (let ((read-more-p t))