[Cl-irc-cvs] CVS update: cl-irc/command.lisp cl-irc/package.lisp cl-irc/protocol.lisp - cl-irc-cvs@common-lisp.net - mailman3.common-lisp.net

9 Jun 2004

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

    