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