Update of /project/beirc/cvsroot/beirc In directory common-lisp.net:/tmp/cvs-serv25317
Modified Files: beirc.lisp Log Message: Show QUIT and NICK messages in every channel the user and me are in.
This change comes at a price: I had to basically copy cl-irc's READ-MESSAGE method, and use a lot of unexported symbols, too. Ugh.
Date: Sun Sep 25 14:31:13 2005 Author: afuchs
Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.29 beirc/beirc.lisp:1.30 --- beirc/beirc.lisp:1.29 Sun Sep 25 00:30:23 2005 +++ beirc/beirc.lisp Sun Sep 25 14:31:05 2005 @@ -157,9 +157,11 @@
(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)))) + (remove nil + (mapcar (lambda (channel) + (find-receiver (irc:name channel) frame)) + (irc:channels (irc:find-user (beirc::current-connection frame) + (irc:source message)))))))) (define-global-message-receiver-lookup irc:irc-quit-message) (define-global-message-receiver-lookup irc:irc-nick-message))
@@ -438,20 +440,26 @@ (text (or (irc:trailing-argument message) ""))) (search my-nick text)))
+(defun post-message-to-receiver (frame message 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) + (defun post-message (frame message) (let ((receiver (receiver-for-message message frame))) - (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))) + (cond ((consp receiver) + (loop for 1-receiver in receiver + do (post-message-to-receiver frame message 1-receiver))) + ((null receiver) nil) + (t (post-message-to-receiver frame message receiver)))))
(defun ticker (frame) (loop @@ -818,10 +826,23 @@ (defclass beirc-connection (irc:connection) ())
-(defmethod irc:read-message :around ((connection beirc-connection)) - (let ((message (call-next-method connection))) - (post-message *application-frame* message) - message)) +;;; KLUDGE: "why isn't this an :around method," you ask? CL-IRC's +;;; read-message registers the message's content before passing the +;;; message back, which means that QUIT and NICK messages can not be +;;; meaningfully decoded, with respect to: on which channels was the +;;; user before we got the message (so that we can display it +;;; everywhere it is relevant). +;;; So, this method is basically a copy of IRC:READ-MESSAGE. ugh. +(defmethod irc:read-message ((connection beirc-connection)) + (handler-case + (when (irc::connectedp connection) + (let ((message (irc::read-irc-message connection))) + (post-message *application-frame* message) + (irc::irc-message-event message) + message)) + (stream-error (c) (signal 'irc::invalidate-me :stream + (irc:server-stream connection) + :condition c))))
(defun irc-event-loop (frame connection) (unwind-protect