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

[Brian Mastenbrook]

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