Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp.net:/tmp/cvs-serv15936
Modified Files:
command.lisp parse-message.lisp protocol.lisp
Log Message:
OpenMCL patches from marco (segv)
Date: Fri May 21 12:41:58 2004
Author: bmastenbrook
Index: cl-irc/command.lisp
diff -u cl-irc/command.lisp:1.3 cl-irc/command.lisp:1.4
--- cl-irc/command.lisp:1.3 Thu Mar 18 16:57:25 2004
+++ cl-irc/command.lisp Fri May 21 12:41:58 2004
@@ -1,4 +1,4 @@
-;;;; $Id: command.lisp,v 1.3 2004/03/18 21:57:25 ehuelsmann Exp $
+;;;; $Id: command.lisp,v 1.4 2004/05/21 16:41:58 bmastenbrook Exp $
;;;; $Source: /project/cl-irc/cvsroot/cl-irc/command.lisp,v $
;;;; See LICENSE for licensing information.
@@ -237,22 +237,26 @@
(defmethod time- ((connection connection) &optional (target ""))
(send-irc-message connection :time nil target))
-#+sbcl
(defun connect-to-server-socket (host port)
+ #+sbcl
(let ((s (make-instance 'sb-bsd-sockets:inet-socket
:type :stream
:protocol :tcp)))
(sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses
(sb-bsd-sockets:get-host-by-name host))) port)
- s))
+ s)
+ #+openmcl
+ (ccl:make-socket :remote-host host :remote-port port))
-#+sbcl
(defun socket-stream (socket)
+ #+sbcl
(sb-bsd-sockets:socket-make-stream socket
:element-type 'character
:input t
:output t
- :buffering :none))
+ :buffering :none)
+ #+openmcl
+ socket)
(defun connect (&key (nickname *default-nickname*)
(username nil)
@@ -262,15 +266,15 @@
(port *default-irc-server-port*)
(logging-stream t))
"Connect to server and return a connection object."
- (let* ((socket #+sbcl (connect-to-server-socket server port)
- #-sbcl nil)
+ (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))
+ #+sbcl (socket-stream socket)
+ #+openmcl socket)
(user (make-user :nickname nickname
:username username
:realname realname))
Index: cl-irc/parse-message.lisp
diff -u cl-irc/parse-message.lisp:1.1.1.1 cl-irc/parse-message.lisp:1.2
--- cl-irc/parse-message.lisp:1.1.1.1 Mon Jan 5 09:13:04 2004
+++ cl-irc/parse-message.lisp Fri May 21 12:41:58 2004
@@ -1,4 +1,4 @@
-;;;; $Id: parse-message.lisp,v 1.1.1.1 2004/01/05 14:13:04 eenge Exp $
+;;;; $Id: parse-message.lisp,v 1.2 2004/05/21 16:41:58 bmastenbrook Exp $
;;;; $Source: /project/cl-irc/cvsroot/cl-irc/parse-message.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -167,15 +167,17 @@
(when ctcp
(setf class (find-ctcp-message-class ctcp)))
(let ((instance (make-instance class
- :source source
- :user user
- :host host
- :command command
+ :source (or source "")
+ :user (or user "")
+ :host (or host "")
+ :command (if command
+ (string command)
+ "")
:arguments arguments
:connection nil
- :trailing-argument trailing-argument
+ :trailing-argument (or trailing-argument "")
:received-time (get-universal-time)
- :raw-message-string string)))
+ :raw-message-string (or string ""))))
(when ctcp
(setf (ctcp-command instance) ctcp))
instance))))
Index: cl-irc/protocol.lisp
diff -u cl-irc/protocol.lisp:1.6 cl-irc/protocol.lisp:1.7
--- cl-irc/protocol.lisp:1.6 Sat Apr 17 07:15:50 2004
+++ cl-irc/protocol.lisp Fri May 21 12:41:58 2004
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.6 2004/04/17 11:15:50 ehuelsmann Exp $
+;;;; $Id: protocol.lisp,v 1.7 2004/05/21 16:41:58 bmastenbrook Exp $
;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
;;;; See LICENSE for licensing information.
@@ -142,14 +142,15 @@
#+allegro (mp:process-run-function name function)
#+cmu (mp:make-process function :name name)
#+lispworks (mp:process-run-function name nil function)
- #+sb-thread (sb-thread:make-thread function))
+ #+sb-thread (sb-thread:make-thread function)
+ #+openmcl (ccl:process-run-function name 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)
+ #+(or allegro cmu lispworks sb-thread openmcl)
(start-process #'do-loop name)
#+(and sbcl (not sb-thread))
(sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor
@@ -163,7 +164,8 @@
#+cmu (mp:destroy-process process)
#+allegro (mp:process-kill process)
#+sb-thread (sb-thread:destroy-thread process)
- #+lispworks (mp:process-kill process))
+ #+lispworks (mp:process-kill process)
+ #+openmcl (ccl:process-kill process))
(defmethod read-message-loop ((connection connection))
(loop while (read-message connection)))
@@ -251,7 +253,14 @@
:stream (sb-bsd-sockets:socket-make-stream socket :input t :output t :buffering :none)
:socket socket
:output-stream t))
- #-sbcl
+ #+openmcl
+ (let ((socket-stream (ccl:make-socket :remote-host remote-address
+ :remote-port remote-port)))
+ (make-instance 'dcc-connection
+ :user user
+ :stream socket-stream
+ :output-stream output-stream))
+ #-(or openmcl sbcl)
(warn "make-dcc-connection not supported for this implementation."))
(defgeneric dcc-close (connection))
@@ -596,6 +605,7 @@
:pong :invite))
(defmethod find-irc-message-class (type)
+ (declare (ignore type))
(find-class 'irc-message))
(defmethod client-log ((connection connection) (message irc-message) &optional (prefix ""))
@@ -645,6 +655,7 @@
:dcc-send-request))
(defmethod find-ctcp-message-class (type)
+ (declare (ignore type))
(find-class 'standard-ctcp-message))
(defmethod client-log ((connection connection) (message ctcp-mixin) &optional (prefix ""))
