This commit broke start-background-message-handler on non-threaded
SBCL which apparently is the only system which was still using
server-socket. How about this patch to fix?

Log
[[[
Fix use of start-background-message-handler in non-threaded SBCL;
also remove unused 'server-socket' slot from the 'connection' class.

]]]

Index: protocol.lisp
===================================================================
RCS file: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v
retrieving revision 1.8
diff -u -r1.8 protocol.lisp
--- protocol.lisp       9 Jun 2004 18:54:25 -0000       1.8
+++ protocol.lisp       22 Jun 2004 17:36:12 -0000
@@ -29,10 +29,6 @@
     :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
@@ -79,14 +75,12 @@
  
 (defun make-connection (&key (user nil)
                              (server-name "")
-                             (server-socket nil)
                              (server-stream nil)
                              (client-stream t)
                              (hooks nil))
   (let ((connection (make-instance 'connection
                                    :user user
                                    :server-name server-name
-                                   :server-socket server-socket
                                    :server-stream server-stream
                                    :client-stream client-stream)))
     (dolist (hook hooks)
@@ -154,8 +148,8 @@
       #+(or allegro cmu lispworks sb-thread openmcl armedbear)
       (start-process #'do-loop name)
       #+(and sbcl (not sb-thread))
-      (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor
-                             (server-socket connection))
+      (sb-sys:add-fd-handler (sb-sys:fd-stream-fd
+                             (server-stream connection))
                             :input (lambda (fd)
                                      (declare (ignore fd))
                                      (read-message connection))))))




>Update of /project/cl-irc/cvsroot/cl-irc
>In directory common-lisp.net:/tmp/cvs-serv10886
>
>Modified Files:
>	command.lisp package.lisp protocol.lisp 
>Log Message:
>Armed Bear Common Lisp compatibility
>
>Date: Wed Jun  9 11:54:25 2004
>Author: bmastenbrook
>
>Index: cl-irc/command.lisp
>diff -u cl-irc/command.lisp:1.4 cl-irc/command.lisp:1.5
>--- cl-irc/command.lisp:1.4	Fri May 21 09:41:58 2004
>+++ cl-irc/command.lisp	Wed Jun  9 11:54:25 2004
>@@ -1,4 +1,4 @@
>-;;;; $Id: command.lisp,v 1.4 2004/05/21 16:41:58 bmastenbrook Exp $
>+;;;; $Id: command.lisp,v 1.5 2004/06/09 18:54:25 bmastenbrook Exp $
> ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/command.lisp,v $
> 
> ;;;; See LICENSE for licensing information.
>@@ -245,8 +245,7 @@
>     (sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses
>                                            (sb-bsd-sockets:get-host-by-name host))) port)
>     s)
>-  #+openmcl
>-  (ccl:make-socket :remote-host host :remote-port port))
>+  )
> 
> (defun socket-stream (socket)
>   #+sbcl
>@@ -258,6 +257,18 @@
>   #+openmcl
>   socket)
> 
>+(defun socket-connect (server port)
>+  #+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 (socket-stream (connect-to-server-socket server port))
>+  #+openmcl (ccl:make-socket :remote-host server :remote-port port)
>+  #+armedbear (ext:get-socket-stream (ext:make-socket server port))
>+  )
>+  
> (defun connect (&key (nickname *default-nickname*)
>                      (username nil)
>                      (realname nil)
>@@ -266,20 +277,11 @@
>                      (port *default-irc-server-port*)
>                      (logging-stream t))
>   "Connect to server and return a connection object."
>-  (let* ((socket #+(or sbcl openmcl) (connect-to-server-socket server port))
>-         (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 (socket-stream socket)
>-                 #+openmcl socket)
>+  (let* ((stream (socket-connect server port))
>          (user (make-user :nickname nickname
>                           :username username
>                           :realname realname))
>-         (connection (make-connection :server-socket socket
>-                                      :server-stream stream
>+         (connection (make-connection :server-stream stream
>                                       :client-stream logging-stream
>                                       :user user
>                                       :server-name server)))
>
>
>Index: cl-irc/package.lisp
>diff -u cl-irc/package.lisp:1.3 cl-irc/package.lisp:1.4
>--- cl-irc/package.lisp:1.3	Tue Mar  9 10:45:10 2004
>+++ cl-irc/package.lisp	Wed Jun  9 11:54:25 2004
>@@ -1,4 +1,4 @@
>-;;;; $Id: package.lisp,v 1.3 2004/03/09 18:45:10 ehuelsmann Exp $
>+;;;; $Id: package.lisp,v 1.4 2004/06/09 18:54:25 bmastenbrook Exp $
> ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/package.lisp,v $
> 
> ;;;; See the LICENSE file for licensing information.
>@@ -14,6 +14,7 @@
>              :read-message
>              :start-background-message-handler
>              :stop-background-message-handler
>+             :socket-connect
>              :send-message
>              :server-name
>              :no-such-reply
>
>
>Index: cl-irc/protocol.lisp
>diff -u cl-irc/protocol.lisp:1.7 cl-irc/protocol.lisp:1.8
>--- cl-irc/protocol.lisp:1.7	Fri May 21 09:41:58 2004
>+++ cl-irc/protocol.lisp	Wed Jun  9 11:54:25 2004
>@@ -1,4 +1,4 @@
>-;;;; $Id: protocol.lisp,v 1.7 2004/05/21 16:41:58 bmastenbrook Exp $
>+;;;; $Id: protocol.lisp,v 1.8 2004/06/09 18:54:25 bmastenbrook Exp $
> ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
> 
> ;;;; See LICENSE for licensing information.
>@@ -143,14 +143,15 @@
>   #+cmu (mp:make-process function :name name)
>   #+lispworks (mp:process-run-function name nil function)
>   #+sb-thread (sb-thread:make-thread function)
>-  #+openmcl (ccl:process-run-function name function))
>+  #+openmcl (ccl:process-run-function name function)
>+  #+armedbear (ext:make-thread function))
> 
> (defmethod start-background-message-handler ((connection connection))
>   "Read messages from the `connection', parse them and dispatch
> 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*))))
>-      #+(or allegro cmu lispworks sb-thread openmcl)
>+      #+(or allegro cmu lispworks sb-thread openmcl armedbear)
>       (start-process #'do-loop name)
>       #+(and sbcl (not sb-thread))
>       (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor
>@@ -165,7 +166,8 @@
>     #+allegro (mp:process-kill process)
>     #+sb-thread (sb-thread:destroy-thread process)
>     #+lispworks (mp:process-kill process)
>-    #+openmcl (ccl:process-kill process))
>+    #+openmcl (ccl:process-kill process)
>+    #+armedbear (ext:destroy-thread process))
> 
> (defmethod read-message-loop ((connection connection))
>   (loop while (read-message connection)))
>@@ -633,7 +635,7 @@
>     :initarg :ctcp-command
>     :accessor ctcp-command)))
> 
>-(defclass standard-ctcp-message (ctcp-mixin message) ())
>+(defclass standard-ctcp-message (ctcp-mixin irc-message) ())
> 
> (defgeneric find-ctcp-message-class (type))
> 
>
>
>_______________________________________________
>Cl-irc-cvs mailing list
>Cl-irc-cvs@common-lisp.net
>http://common-lisp.net/mailman/listinfo/cl-irc-cvs


