[Cl-irc-cvs] CVS update: cl-irc/command.lisp cl-irc/package.lisp cl-irc/protocol.lisp
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))
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
participants (2)
-
Brian Mastenbrook -
Erik Hülsmann