[beirc-cvs] CVS update: beirc/beirc.lisp

[Andreas Fuchs]

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