Author: ehuelsmann Date: Tue Apr 24 18:15:07 2007 New Revision: 199
Modified: trunk/package.lisp trunk/protocol.lisp Log: Add a dcc-chat-connection class; a non-abstract subclass of dcc-connection.
Modified: trunk/package.lisp ============================================================================== --- trunk/package.lisp (original) +++ trunk/package.lisp Tue Apr 24 18:15:07 2007 @@ -141,9 +141,11 @@ :ison ;; DCC specific dictionary :dcc-connection + :dcc-chat-connection :irc-connection :close-on-main :remote-user :dcc-close + :make-dcc-chat-connection )))
Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp (original) +++ trunk/protocol.lisp Tue Apr 24 18:15:07 2007 @@ -335,7 +335,8 @@ #+openmcl (ccl:process-kill process) #+armedbear (ext:destroy-thread process))
-(defun read-message-loop (connection) +(defgeneric read-message-loop (connection)) +(defmethod read-message-loop (connection) (loop while (read-message connection)))
@@ -360,11 +361,13 @@ (force-output (output-stream connection)) raw-message))
-(defmethod get-hooks ((connection connection) (class symbol)) +;;applies to both irc and dcc-connections +(defmethod get-hooks (connection (class symbol)) "Return a list of all hooks for `class'." (gethash class (hooks connection)))
-(defmethod add-hook ((connection connection) class hook) +;;applies to both irc and dcc-connections +(defmethod add-hook (connection class hook) "Add `hook' to `class'." (setf (gethash class (hooks connection)) (pushnew hook (gethash class (hooks connection))))) @@ -479,6 +482,9 @@
;; CHAT related generic functions (defgeneric send-dcc-message (connection message)) +;;already defined in relation to `connection' +;; (defgeneric read-message (connection)) +;;(defgeneric dcc-message-event (message)) <defined in event.lisp>
;; SEND related generic functions ;;<none yet, we don't do SEND yet...> @@ -487,6 +493,10 @@ (and (streamp stream) (open-stream-p stream))))
+(defmethod send-dcc-message ((connection dcc-connection) message) + (format (output-stream connection) "~A~%" message) + (force-output (network-stream connection))) + (defmethod dcc-close ((connection dcc-connection)) #+(and sbcl (not sb-thread)) (sb-sys:invalidate-descriptor @@ -498,6 +508,68 @@ (dcc-connections (irc-connection connection)) (remove connection (dcc-connections (irc-connection connection)))))
+ +(defclass dcc-chat-connection (dcc-connection) + ((output-stream + :initarg :output-stream + :initform nil + :accessor output-stream + :documentation "Stream used to communicate with the other end +of the network pipe.") + (hooks + :initform (make-hash-table :test #'equal) + :accessor hooks)) + (:documentation "")) + + +(defun make-dcc-chat-connection (&key (remote-user nil) +;; (remote-address nil) +;; (remote-port nil) + (client-stream nil) + (irc-connection nil) + (close-on-main t) + (socket nil) + (network-stream nil) + (outgoing-external-format *default-outgoing-external-format*) + (hooks nil)) + (let* ((output-stream (flexi-streams:make-flexi-stream + network-stream + :element-type 'character + :external-format (external-format-fixup + outgoing-external-format))) + (connection (make-instance 'dcc-chat-connection + :remote-user remote-user + :client-stream client-stream + :output-stream output-stream + :irc-connection irc-connection + :close-on-main close-on-main + :socket socket + :network-stream network-stream))) + (dolist (hook hooks) + (add-hook connection (car hook) (cdar hook))) + connection)) + +(defmethod read-message ((connection dcc-chat-connection)) + (when (connectedp connection) + (let* ((msg-string (read-protocol-line connection)) + (message (create-dcc-message msg-string))) + (setf (connection message) connection) + (when *debug-p* + (format *debug-stream* "~A" (describe message)) + (force-output *debug-stream*)) + (dcc-message-event connection message) + message))) ; needed because of the "loop while" in read-message-loop + +(defmethod read-message-loop ((connection dcc-chat-connection)) + ;; no special setup + (call-next-method) + ;; now, make sure the connection was closed and cleaned up properly... + ;; it *was* the last message, after all... + ;;##TODO, maybe we need some kind of 'auto-clean' slot to indicate + ;; this is the desired behaviour? + ) + + ;; ;; Channel ;; @@ -968,8 +1040,8 @@ (car (last (arguments message)))) (force-output stream)))
- -(defmethod apply-to-hooks ((message irc-message)) +;; applies to both irc- and dcc-messages +(defmethod apply-to-hooks (message) "Applies any applicable hooks to `message'.
Returns non-nil if any of the hooks do."