Update of /project/beirc/cvsroot/beirc In directory clnet:/tmp/cvs-serv2704

Modified Files: application.lisp Log Message: Fix message-directed-to-me-p for messages with no args.

--- /project/beirc/cvsroot/beirc/application.lisp 2006/05/29 20:05:41 1.83 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/05/31 19:35:39 1.84 @@ -190,16 +190,17 @@ (defvar *beirc-frame*)

(defun beirc-status-display (*application-frame* *standard-output*) - (with-text-family (t :sans-serif) - (multiple-value-bind (seconds minutes hours) (decode-universal-time (get-universal-time)) - seconds + (multiple-value-bind (seconds minutes hours) + (decode-universal-time (get-universal-time)) + seconds + (with-text-family (t :sans-serif) (format t "~:[~;~2,'0D:~2,'0D ~]~A~:[~;(away)~] ~@[on ~A~]~@[ speaking to ~A~]~100T~D messages" (processes-supported-p) ; don't display time if threads are not supported hours minutes (current-nickname) (away-status *application-frame* (current-connection *application-frame*)) (current-channel) - (current-query) + (current-query) (length (current-messages))))))

(defun beirc-prompt (*standard-output* *application-frame*) @@ -328,9 +329,9 @@

(defun message-directed-to-me-p (message) - (irc:destructuring-arguments (&rest :ignored &req body) message - (let ((my-nick (current-nickname (irc:connection message)))) - (search my-nick (or body ""))))) + (let ((body (car (last (irc:arguments message)))) + (my-nick (current-nickname (irc:connection message)))) + (search my-nick (or body ""))))

(defun interesting-message-p (message) (typep message '(or irc:irc-privmsg-message irc:irc-notice-message irc:irc-topic-message irc:irc-kick-message irc:ctcp-action-message))) @@ -339,7 +340,7 @@ (let ((message-to-me-p (message-directed-to-me-p message)) (interesting-message-p (interesting-message-p message))) (setf (messages receiver) - (append (messages receiver) (list message))) + (nconc (messages receiver) (list message))) (unless (eql receiver (current-receiver frame)) (when interesting-message-p (incf (unseen-messages receiver))) @@ -770,7 +771,7 @@ (define-presentation-to-command-translator nickname-to-query-translator (nickname com-query beirc :menu t - :gesture nil + :gesture :describe :documentation "Query this user" :pointer-documentation "Query this user") (object) @@ -856,7 +857,9 @@ ;;; presentation types, I bet I could fold this into the previous ;;; translator. [2006/04/18:rpg] (define-presentation-to-command-translator meme-url-to-browse-url-translator - (meme-url com-browse-url beirc :pointer-documentation "Browse meme log" + (meme-url com-browse-url beirc + :documentation "Browse meme log" + :pointer-documentation "Browse meme log" ;; override url-to-browse-url-translator :priority 1) (presentation) @@ -963,7 +966,8 @@ (disconnect connection frame "Client Disconnect")))) :name "IRC Message Muffling Loop")) (irc:start-background-message-handler connection)) - (setf success t)) + (setf success t) + connection) (unless success (disconnect connection frame "Client error."))))) ;; added auto-identify [2006/05/09:rpg]