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

Modified Files: beirc.lisp Log Message: Fix (mostly) two of the three known problems and implement "unseen messages" functionality in the receiver list.

* on join (you or anybody else), you are no longer thrown into the debugger (the problem was that I missed the : in the IRC spec for JOIN messages. the channel is passed as the trailing arg. * implemented more message types for the receiver finder; beirc can now stay on #lisp for more than 5 minutes without barfing!

Date: Wed Sep 14 22:12:42 2005 Author: afuchs

Index: beirc/beirc.lisp diff -u beirc/beirc.lisp:1.2 beirc/beirc.lisp:1.3 --- beirc/beirc.lisp:1.2 Tue Sep 13 22:48:11 2005 +++ beirc/beirc.lisp Wed Sep 14 22:12:40 2005 @@ -31,7 +31,8 @@ (cl:eval-when (:compile-toplevel :load-toplevel :execute) (cl:require :split-sequence) (cl:require :cl-irc) - (cl:require :mcclim)) + (cl:require :mcclim) + (cl:require :mcclim-freetype))

(defpackage :beirc (:use :clim :clim-lisp :clim-sys) @@ -68,6 +69,8 @@ (defclass receiver () ((name :reader receiver-name :initarg :name) (messages :accessor messages :initform nil) + (unseen-messages :accessor unseen-messages :initform 0) + (messages-directed-to-me :accessor messages-directed-to-me :initform 0) (channel :reader channel :initform nil :initarg :channel) (query :reader query :initform nil :initarg :query) ;; <- XXX: remove this. (pane :reader pane :initform nil) @@ -105,18 +108,36 @@ (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:irc-join-message) frame) +(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))) + +(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.

@@ -160,11 +181,14 @@ &key initial-contents &allow-other-keys) (declare (ignore args)) - (dolist (k initial-contents) + (dolist (k (or initial-contents + (list (make-clim-application-pane)))) (sheet-adopt-child pane k)))

(defun raise-receiver (receiver &optional (frame *application-frame*)) (setf (current-receiver frame) receiver) + (setf (unseen-messages receiver) 0) + (setf (messages-directed-to-me receiver) 0) (mapcar (lambda (pane) (let ((pane-receiver (receiver-for-pane pane frame))) (setf (sheet-enabled-p pane) @@ -399,10 +423,19 @@ :name "Beirc Ticker") (run-frame-top-level frame))))))))

+(defun message-directed-to-me-p (frame message) + (let ((my-nick (slot-value frame 'nick)) + (text (or (irc:trailing-argument message) ""))) + (search my-nick text))) + (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)))) (clim-internals::event-queue-prepend (climi::frame-event-queue frame) (make-instance 'foo-event :sheet frame :receiver receiver)) @@ -431,7 +464,10 @@ (maphash #'suggest (receivers *application-frame*))))

(define-presentation-method present (o (type receiver) *standard-output* (view textual-view) &key) - (format t "~A" (receiver-name o))) + (with-drawing-options (t :ink (cond ((> (messages-directed-to-me o) 0) +green+) + ((> (unseen-messages o) 0) +red+) + (t +black+))) + (format t "~A" (receiver-name o))))

(define-presentation-to-command-translator raise-this-receiver (receiver com-raise-receiver beirc