[beirc-cvs] CVS beirc

[afuchs]

Update of /project/beirc/cvsroot/beirc
In directory common-lisp:/tmp/cvs-serv18126

Modified Files:
	application.lisp message-display.lisp receivers.lisp 
Log Message:
Add ban/invite/exceptlist display functionality.


--- /project/beirc/cvsroot/beirc/application.lisp	2006/01/30 18:56:00	1.36
+++ /project/beirc/cvsroot/beirc/application.lisp	2006/02/05 21:50:51	1.37
@@ -247,7 +247,7 @@
     (search my-nick text)))
 
 (defun interesting-message-p (message)
-  (typep message '(or irc:irc-privmsg-message irc:irc-topic-message irc:irc-kick-message irc:ctcp-action-message)))
+  (typep message '(or irc:irc-privmsg-message irc:irc-notice-message irc:irc-topic-message irc:irc-kick-message irc:ctcp-action-message)))
 
 (defun post-message-to-receiver (frame message receiver)
   (setf (messages receiver)
@@ -418,6 +418,9 @@
 (define-beirc-command (com-deop :name t) ((who 'nickname :prompt "who"))
   (irc:deop (current-connection *application-frame*) (target) who))
 
+(define-beirc-command (com-show-ban-list :name t) ()
+  (irc:ban (current-connection *application-frame*) (target) ""))
+
 (define-beirc-command (com-ban-nick :name t) ((who 'nickname :prompt "who"))
   (irc:ban (current-connection *application-frame*) (target) (format nil "~A!*@*" who)))
 
--- /project/beirc/cvsroot/beirc/message-display.lisp	2006/01/27 22:39:09	1.27
+++ /project/beirc/cvsroot/beirc/message-display.lisp	2006/02/05 21:50:51	1.28
@@ -435,6 +435,25 @@
                                       if (not (null rest))
                                         do (write-string ", "))))))))))
 
+(macrolet ((define-*list-printer (&rest message-types)
+               `(progn
+                  ,@(loop for (message-type prefix) in message-types
+                          collect
+                          `(defmethod print-message ((message ,message-type) receiver)
+                             (formatting-message (t message receiver)
+                                                 ((format t "    "))
+                                                 ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+                                                    (write-string ,prefix)
+                                                    (present (nth 2 (irc:arguments message)) 'hostmask)
+                                                    (when (find #\! (nth 3 (irc:arguments message)))
+                                                      (write-string " by ")
+                                                      (present (first (split-sequence:split-sequence #\! (nth 3 (irc:arguments message))))
+                                                               'nickname))))))))))
+  (define-*list-printer
+      (irc:irc-rpl_banlist-message "BANNED: ")
+      (irc:irc-rpl_invitelist-message "INVITED: ")
+      (irc:irc-rpl_exceptlist-message "UNBANNED: ")))
+
 ;;; the display function (& utilities)
 
 (defgeneric preamble-length (message)
--- /project/beirc/cvsroot/beirc/receivers.lisp	2006/01/27 22:40:32	1.13
+++ /project/beirc/cvsroot/beirc/receivers.lisp	2006/02/05 21:50:51	1.14
@@ -159,7 +159,9 @@
                                            (intern-receiver target frame :channel target))))))))
   (define-nth-arg-message-receiver-lookup
       (0 irc:irc-topic-message irc:irc-kick-message)
-      (1 irc:irc-rpl_topic-message irc:irc-rpl_topicwhotime-message irc:irc-err_chanoprivsneeded-message)
+      (1 irc:irc-rpl_topic-message irc:irc-rpl_topicwhotime-message
+         irc:irc-err_chanoprivsneeded-message irc:irc-rpl_banlist-message
+         irc:irc-rpl_invitelist-message irc:irc-rpl_exceptlist-message)
       (2 irc:irc-rpl_namreply-message)
       (nil irc:irc-join-message)))