[beirc-cvs] CVS beirc

[afuchs]

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]