Author: ehuelsmann Date: Tue Apr 24 18:28:02 2007 New Revision: 201
Modified: trunk/package.lisp trunk/parse-message.lisp trunk/protocol.lisp Log: Implement CTCP-over-DCC framework.
Modified: trunk/package.lisp ============================================================================== --- trunk/package.lisp (original) +++ trunk/package.lisp Tue Apr 24 18:28:02 2007 @@ -146,6 +146,7 @@ :close-on-main :remote-user :dcc-close + :dcc-message :dcc-message-event :make-dcc-chat-connection )))
Modified: trunk/parse-message.lisp ============================================================================== --- trunk/parse-message.lisp (original) +++ trunk/parse-message.lisp Tue Apr 24 18:28:02 2007 @@ -226,13 +226,13 @@ (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))) + (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)) + (when ctcp + (setf (ctcp-command instance) ctcp)) instance)))
Modified: trunk/protocol.lisp ============================================================================== --- trunk/protocol.lisp (original) +++ trunk/protocol.lisp Tue Apr 24 18:28:02 2007 @@ -1117,12 +1117,21 @@ :accessor ctcp-command)))
(defclass standard-ctcp-message (ctcp-mixin irc-message) ()) +(defclass standard-dcc-ctcp-message (ctcp-mixin dcc-message) ())
(defgeneric find-ctcp-message-class (type)) +(defgeneric find-dcc-ctcp-message-class (type)) (defgeneric ctcp-request-p (message)) (defgeneric ctcp-reply-p (message))
(eval-when (:compile-toplevel :load-toplevel :execute) + (defun define-dcc-ctcp-message (ctcp-command) + (let ((name (intern-message-symbol :dcc-ctcp ctcp-command))) + `(progn + (defmethod find-dcc-ctcp-message-class ((type (eql ,ctcp-command))) + (find-class ',name)) + (export ',name) + (defclass ,name (ctcp-mixin dcc-message) ())))) (defun define-ctcp-message (ctcp-command) (let ((name (intern-message-symbol :ctcp ctcp-command))) `(progn @@ -1132,7 +1141,8 @@ (defclass ,name (ctcp-mixin irc-message) ())))))
(defmacro create-ctcp-message-classes (class-list) - `(progn ,@(mapcar #'define-ctcp-message class-list))) + `(progn ,@(mapcar #'define-ctcp-message class-list) + ,@(mapcar #'define-dcc-ctcp-message class-list)))
;; should perhaps wrap this in an eval-when? (create-ctcp-message-classes (:action :source :finger :ping @@ -1143,6 +1153,10 @@ (declare (ignore type)) (find-class 'standard-ctcp-message))
+(defmethod find-dcc-ctcp-message-class (type) + (declare (ignore type)) + (find-class 'standard-dcc-ctcp-message)) + (defmethod ctcp-request-p ((message ctcp-mixin)) (string= (command message) :privmsg))