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

Modified Files: beirc.lisp Log Message: fix NOTICE handling, including network service notices.

also, revert the TICKER function back to its old self; the handler-case in there served no purpose.

Date: Sat Sep 24 13:43:37 2005 Author: afuchs

Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.19 beirc/beirc.lisp:1.20 --- beirc/beirc.lisp:1.19 Sat Sep 24 11:14:03 2005 +++ beirc/beirc.lisp Sat Sep 24 13:43:37 2005 @@ -97,13 +97,17 @@ (add-pane (tab-pane receiver) (find-pane-named frame 'query)))) (setf (gethash (tab-pane receiver) (tab-panes-to-receivers frame)) receiver))

+(defun find-receiver (name frame) + (gethash (irc:normalize-channel-name (slot-value frame 'connection) name) + (receivers frame))) + (defun intern-receiver (name frame &rest initargs) - (let ((rec (gethash (irc:normalize-channel-name (slot-value frame 'connection) name) - (receivers frame)))) + (let* ((normalized-name (irc:normalize-channel-name (slot-value frame 'connection) name)) + (rec (find-receiver name frame))) (if rec rec (let ((*application-frame* frame)) - (let ((receiver (apply 'make-paneless-receiver name initargs))) + (let ((receiver (apply 'make-paneless-receiver normalized-name initargs))) (initialize-receiver-with-pane receiver frame (with-look-and-feel-realization ((frame-manager *application-frame*) *application-frame*) @@ -117,20 +121,35 @@ (setf (gethash name (receivers frame)) receiver) receiver)))))

+(defparameter *network-service-sources* '("nickserv" "memoserv" "chanserv" "") + "Sources whose private messages (PRIVMSG, NOTICE, ...) should + be treated as if they came from the connected server itself, + unless the user has opened a query window to the source + already.") + +(defun 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))))) + (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))))) + (if (or + (find-receiver (irc:source message) frame) + (not (network-service-p (irc:source message) 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))))) (define-privmsg-receiver-lookup irc:irc-privmsg-message) (define-privmsg-receiver-lookup irc:ctcp-action-message) - ;; (define-privmsg-receiver-lookup irc:irc-notice-message) ; XXX: NOTICEs in freenode are a bit tricky. - ) + (define-privmsg-receiver-lookup irc:irc-notice-message))

(macrolet ((define-global-message-receiver-lookup (message-type) `(defmethod receiver-for-message ((message ,message-type) frame) @@ -361,28 +380,24 @@

(defun post-message (frame message) (let ((receiver (receiver-for-message message frame))) - (setf (messages receiver) - (append (messages receiver) (list message))) - (unless (eql receiver (current-receiver frame)) - (incf (unseen-messages receiver)) - (when (message-directed-to-me-p frame message) - (incf (messages-directed-to-me receiver)))) - (update-drawing-options receiver) - (clim-internals::event-queue-prepend - (climi::frame-event-queue frame) - (make-instance 'foo-event :sheet frame :receiver receiver)) - nil)) + (unless (null receiver) + (setf (messages receiver) + (append (messages receiver) (list message))) + (unless (eql receiver (current-receiver frame)) + (incf (unseen-messages receiver)) + (when (message-directed-to-me-p frame message) + (incf (messages-directed-to-me receiver)))) + (update-drawing-options receiver) + (clim-internals::event-queue-prepend + (climi::frame-event-queue frame) + (make-instance 'foo-event :sheet frame :receiver receiver)) + nil)))

-;;; XXX: ticker continues to run even if the frame is no longer active -;;; or on the display. (defun ticker (frame) - (handler-case - (loop - (clim-internals::event-queue-prepend (climi::frame-event-queue frame) - (make-instance 'bar-event :sheet frame)) - (sleep 1)) - (frame-exit () - nil))) + (loop + (clim-internals::event-queue-prepend (climi::frame-event-queue frame) + (make-instance 'bar-event :sheet frame)) + (sleep 1)))

(define-presentation-type nickname ()) (define-presentation-type ignored-nickname (nickname))