Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv31339
Modified Files: beirc.lisp Log Message: Refactor the receiver-for-message definitions and fix incoming PRIVMSGs to us.
Date: Sat Sep 17 23:28:30 2005 Author: afuchs
Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.9 beirc/beirc.lisp:1.10 --- beirc/beirc.lisp:1.9 Sat Sep 17 22:41:42 2005 +++ beirc/beirc.lisp Sat Sep 17 23:28:29 2005 @@ -101,49 +101,52 @@ receiver))
(defun intern-receiver (name frame &rest initargs) - (let ((rec (gethash name (receivers frame)))) + (let ((rec (gethash (irc:normalize-channel-name (slot-value frame 'connection) + name) (receivers frame)))) (if rec rec (let ((*application-frame* frame)) - (apply 'make-receiver name initargs))))) + (let ((receiver (apply 'make-receiver name initargs))) + (setf (sheet-enabled-p (pane receiver)) nil) + (sheet-adopt-child (find-pane-named *application-frame* 'query) + (pane receiver)) + receiver)))))
(defun receiver-for-pane (pane &optional (frame *application-frame*)) (gethash pane (receiver-panes frame)))
- -;;; FIXME: many of these methods are the same and should be refactored -;;; into perhaps three types. -(defmethod receiver-for-message ((message irc:irc-privmsg-message) frame) - ;; XXX: handle target=ournick - (let ((target (first (irc:arguments message)))) - (intern-receiver target frame :channel target))) - -(defmethod receiver-for-message ((message irc:ctcp-action-message) frame) - ;; XXX: handle target=ournick - (let ((target (first (irc:arguments message)))) - (intern-receiver target frame :channel target))) - -(defmethod receiver-for-message ((message irc:irc-notice-message) frame) - ;; XXX: handle target=ournick - (let ((target (first (irc:arguments message)))) - (intern-receiver target frame :channel target))) +(macrolet ((define-privmsg-receiver-lookup (message-type) + `(defmethod receiver-for-message ((message ,message-type) frame) + (let* ((mynick (irc:normalize-nickname (slot-value frame 'connection) + (slot-value frame 'nick))) + (nominal-target (irc:normalize-channel-name (slot-value frame 'connection) + (first (irc:arguments message)))) + (target (if (equal nominal-target mynick) + (irc:source message) + nominal-target))) + (intern-receiver target frame :channel target))))) + (define-privmsg-receiver-lookup irc:irc-privmsg-message) + (define-privmsg-receiver-lookup irc:ctcp-action-message) + (define-privmsg-receiver-lookup irc:irc-notice-message)) + +(macrolet ((define-global-message-receiver-lookup (message-type) + `(defmethod receiver-for-message ((message ,message-type) frame) + ;; FIXME: global messages should go to all + ;; channels/queries the source (user) was on. + (current-receiver frame)))) + (define-global-message-receiver-lookup irc:irc-quit-message) + (define-global-message-receiver-lookup irc:irc-nick-message))
(defmethod receiver-for-message ((message irc:irc-join-message) frame) (let ((target (irc:trailing-argument message))) (intern-receiver target frame :channel target)))
-(defmethod receiver-for-message ((message irc:irc-quit-message) frame) - (current-receiver frame) ; FIXME: quit messages should go to all channels/queries the user was on. - ) -(defmethod receiver-for-message ((message irc:irc-nick-message) frame) - (current-receiver frame) ; FIXME: quit messages should go to all channels/queries the user was on. - ) (defmethod receiver-for-message ((message irc:irc-part-message) frame) (let ((target (first (irc:arguments message)))) (intern-receiver target frame :channel target))) - ;; TODO: more receiver-for-message methods.
+ (macrolet ((define-delegate (function-name accessor &optional define-setter-p) `(progn ,(when define-setter-p @@ -476,8 +479,6 @@ (define-beirc-command (com-join :name t) ((channel 'string :prompt "channel")) (setf (current-receiver *application-frame*) (intern-receiver channel *application-frame* :channel channel)) - (sheet-adopt-child (find-pane-named *application-frame* 'query) - (pane (current-receiver *application-frame*))) (raise-receiver (current-receiver *application-frame*)) (irc:join (slot-value *application-frame* 'connection) channel))