[beirc-cvs] CVS beirc

[afuchs]

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

Modified Files:
	message-display.lisp 
Log Message:
Add (simple) printers for all the server reply lines I see at startup.

Well, not all of them. There's still an odd one I get from zelazny.freenode.net.


--- /project/beirc/cvsroot/beirc/message-display.lisp	2005/10/06 23:35:20	1.26
+++ /project/beirc/cvsroot/beirc/message-display.lisp	2006/01/27 22:39:09	1.27
@@ -165,6 +165,48 @@
 
 ;;; server messages
 
+(macrolet ((define-server-message-printer ((&rest message-specs))
+               `(progn
+                  ,@(loop for (message-type . message-name) in message-specs
+                          collect
+                          `(defmethod print-message ((message ,message-type) receiver)
+                             (formatting-message (t message receiver)
+                                                 ((format t "~A" (irc:source message)))
+                                                 ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+                                                    (format-message*
+                                                     (format nil "~@[~A: ~]~{~A ~}~A"
+                                                             ,message-name
+                                                             (cdr (irc:arguments message))
+                                                             (irc:trailing-argument message)))))))))))
+  (define-server-message-printer ((irc:irc-rpl_motd-message . "MODT")
+                                  (irc:irc-rpl_motdstart-message . "MOTD")
+                                  (irc:irc-rpl_isupport-message)
+                                  (irc:irc-rpl_yourid-message . "Your id")
+                                  (irc:irc-rpl_luserop-message)
+                                  (irc:irc-rpl_luserclient-message)
+                                  (irc:irc-rpl_luserme-message)
+                                  (irc:irc-rpl_luserchannels-message)
+                                  (irc:irc-rpl_luserunknown-message)
+                                  (irc:irc-rpl_globalusers-message)
+                                  (irc:irc-rpl_localusers-message)
+                                  (irc:irc-rpl_created-message)
+                                  (irc:irc-rpl_welcome-message)
+                                  (irc:irc-rpl_yourhost-message)
+                                  (irc:irc-rpl_myinfo-message)
+                                  (irc:irc-rpl_hello-message)
+                                  (irc:irc-rpl_statsdline-message)
+                                  (irc:irc-rpl_statskline-message)
+                                  (irc:irc-rpl_statshline-message)
+                                  (irc:irc-rpl_statsvline-message)
+                                  (irc:irc-rpl_noaway-message)
+                                  (irc:irc-rpl_unaway-message))))
+
+(defmethod print-message ((message irc:irc-rpl_isupport-message) receiver)
+  (formatting-message (t message receiver)
+          ((format t "~A" (irc:source message)))
+          ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+             (format t "MOTD: ~A" (irc:trailing-argument message))))))
+
 (defmethod print-message ((message irc:irc-rpl_motd-message) receiver)
   (formatting-message (t message receiver)
           ((format t "~A" (irc:source message)))