[cl-irc-cvs] r197 - trunk

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Tue Apr 24 18:01:01 2007
New Revision: 197

Modified:
   trunk/parse-message.lisp
   trunk/protocol.lisp
Log:
Create a DCC CHAT message class, just like the IRC message classes we have.

Modified: trunk/parse-message.lisp
==============================================================================
--- trunk/parse-message.lisp	(original)
+++ trunk/parse-message.lisp	Tue Apr 24 18:01:01 2007
@@ -222,3 +222,17 @@
         (when ctcp
           (setf (ctcp-command instance) ctcp))
         instance))))
+
+(defun create-dcc-message (string)
+  (let* ((class 'dcc-privmsg-message)
+         (ctcp (ctcp-message-type string)))
+    (when ctcp
+      (setf class (find-dcc-ctcp-message class ctcp)))
+    (let ((instance (make-instance class
+                                   :arguments (list string)
+                                   :connection nil
+                                   :received-time (get-universal-time)
+                                   :raw-message-string string)))
+      (when ctcp
+        (setf (ctcp-command instance) ctcp))
+      instance)))

Modified: trunk/protocol.lisp
==============================================================================
--- trunk/protocol.lisp	(original)
+++ trunk/protocol.lisp	Tue Apr 24 18:01:01 2007
@@ -981,6 +981,61 @@
                        result)))))
 
 ;;
+;; DCC CHAT messages
+;;
+
+(defclass dcc-message ()
+  ((connection
+    :initarg :connection
+    :accessor connection
+    :documentation "")
+   (arguments
+    :initarg :arguments
+    :accessor arguments
+    :type list
+    :documentation "")
+   (received-time
+    :initarg :received-time
+    :accessor received-time)
+   (raw-message-string
+    :initarg :raw-message-string
+    :accessor raw-message-string
+    :type sting))
+  (:documentation ""))
+
+(defmethod print-object ((object dcc-message) stream)
+  "Print the object for the Lisp reader."
+  (print-unreadable-object (object stream :type t :identity t)
+    (format stream "~A ~A"
+            (nickname (remote-user (connection object)))
+            (command object))))
+
+(defgeneric find-dcc-message-class (type))
+;;already defined in the context of IRC messages:
+;; (defgeneric client-log (connection message &optional prefix))
+;; (defgeneric apply-to-hooks (message))
+
+
+(export 'dcc-privmsg-message)
+(defclass dcc-privmsg-message (dcc-message) ())
+(defmethod find-dcc-message-class ((type (eql :privmsg)))
+  (find-class 'dcc-privmsg-message))
+
+(defmethod find-dcc-message-class (type)
+  (declare (ignore type))
+  (find-class 'dcc-message))
+
+(defmethod client-log ((connection dcc-connection)
+                       (message dcc-message) &optional (prefix ""))
+  (let ((stream (client-stream connection)))
+    (format stream "~A~A: ~{ ~A~} \"~A\"~%"
+            prefix
+            (received-time message)
+            (butlast (arguments message))
+            (car (last (arguments message))))
+    (force-output stream)))
+
+;;
 ;; CTCP Message
 ;;