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

[Andreas Fuchs]

Update of /project/beirc/cvsroot/beirc
In directory common-lisp.net:/tmp/cvs-serv20130

Modified Files:
	receivers.lisp 
Log Message:
fix receiver lookup in the presence of global notices and Chanserv on channels.

Date: Sun Sep 25 20:53:54 2005
Author: afuchs

Index: beirc/receivers.lisp
diff -u beirc/receivers.lisp:1.3 beirc/receivers.lisp:1.4
--- beirc/receivers.lisp:1.3	Sun Sep 25 20:19:28 2005
+++ beirc/receivers.lisp	Sun Sep 25 20:53:53 2005
@@ -70,7 +70,7 @@
                                               (lambda (frame pane)
                                                 (beirc-app-display frame pane receiver))
                                               :display-time nil
-                                              :width 400 :height 600
+                                              :width 600 :height 800
                                               :incremental-redisplay t)))
             (setf (gethash normalized-name (receivers frame)) receiver)
             receiver)))))
@@ -85,26 +85,30 @@
   unless the user has opened a query window to the source
   already.")
 
-(defun network-service-p (source frame)
+(defun from-network-service-p (source frame)
   (member source *network-service-sources*
           :test (lambda (source1 source2)
                   (string= (irc:normalize-nickname (current-connection frame) source1)
                            (irc:normalize-nickname (current-connection frame) source2)))))
 
+(defun global-notice-p (message target)
+  (and (typep message 'irc:irc-notice-message) (string= target "$*")))
+
 (macrolet ((define-privmsg-receiver-lookup (message-type)
                `(defmethod receiver-for-message ((message ,message-type) frame)
-                  (if (or
-                       (find-receiver (irc:source message) frame)
-                       (not (network-service-p (irc:source message) frame)))
-                      (let* ((mynick (irc:normalize-nickname (current-connection frame)
+                  (let* ((mynick (irc:normalize-nickname (current-connection frame)
                                                              (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))
-                      (server-receiver frame)))))
+                    (if (or (find-receiver (irc:source message) frame)
+                            (not (from-network-service-p (irc:source message) frame))
+                            (and (string= nominal-target target)
+                                 (not (global-notice-p message nominal-target))))
+                        (intern-receiver target frame :channel target)
+                        (server-receiver frame))))))
   (define-privmsg-receiver-lookup irc:irc-privmsg-message)
   (define-privmsg-receiver-lookup irc:ctcp-action-message)
   (define-privmsg-receiver-lookup irc:irc-notice-message))