[beirc-cvs] CVS update: beirc/beirc.lisp beirc/message-display.lisp

[Andreas Fuchs]

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

Modified Files:
	beirc.lisp message-display.lisp 
Log Message:
further printing / command features:

 * don't print "end of <anything>" replies from the server.
 * add a /topic, /names, /op, /deop command.
 * add a method to print irc-mode-messages. 

Date: Sat Sep 24 17:04:07 2005
Author: afuchs

Index: beirc/beirc.lisp
diff -u beirc/beirc.lisp:1.21 beirc/beirc.lisp:1.22
--- beirc/beirc.lisp:1.21	Sat Sep 24 16:36:31 2005
+++ beirc/beirc.lisp	Sat Sep 24 17:04:06 2005
@@ -176,6 +176,34 @@
   (let ((target (first (irc:arguments message))))
     (intern-receiver target frame :channel target)))
 
+(defmethod receiver-for-message ((message irc:irc-mode-message) frame)
+  (destructuring-bind (channel modes args) (irc:arguments message)
+    (declare (ignore modes args))
+    (intern-receiver channel frame :channel channel)))
+
+(macrolet ((define-ignore-message-types (&rest mtypes)
+             `(progn
+                ,@(loop for mtype in mtypes
+                        collect `(defmethod receiver-for-message ((message ,mtype) frame)
+                                   nil)))))
+  (define-ignore-message-types cl-irc:irc-rpl_endofwhowas-message
+    cl-irc:irc-rpl_endoflinks-message
+    cl-irc:irc-rpl_endoptions-message
+    cl-irc:irc-rpl_endofwhois-message
+    cl-irc:irc-rpl_endsitelist-message
+    cl-irc:irc-rpl_endofinvitelist-message
+    cl-irc:irc-rpl_endofservices-message
+    cl-irc:irc-rpl_endmode-message
+    cl-irc:irc-rpl_endofmap-message
+    cl-irc:irc-rpl_endofnames-message
+    cl-irc:irc-rpl_endofusers-message
+    cl-irc:irc-rpl_endofbanlist-message
+    cl-irc:irc-rpl_endofmotd-message
+    cl-irc:irc-rpl_endofinfo-message
+    cl-irc:irc-rpl_endofstats-message
+    cl-irc:irc-rpl_endofwho-message
+    cl-irc:irc-rpl_endofexceptlist-message))
+
 (defmethod receiver-for-message ((message irc:irc-message) frame)
   (server-receiver frame))
 
@@ -463,9 +491,21 @@
 
 (define-beirc-command (com-eval :name t) ((command 'string :prompt "command")
                                           (args '(sequence string) :prompt "arguments"))
-  (multiple-value-bind (symbol status) (find-symbol command :irc)
+  (multiple-value-bind (symbol status) (find-symbol (string-upcase command) :irc)
     (when (eql status :external)
       (apply symbol (current-connection *application-frame*) (coerce args 'list)))))
+
+(define-beirc-command (com-topic :name t) ((topic 'mumble :prompt "topic"))
+  (irc:topic- (current-connection *application-frame*) (target) topic))
+
+(define-beirc-command (com-op :name t) ((who 'nickname :prompt "who"))
+  (irc:op (current-connection *application-frame*) (target) who))
+
+(define-beirc-command (com-deop :name t) ((who 'nickname :prompt "who"))
+  (irc:deop (current-connection *application-frame*) (target) who))
+
+(define-beirc-command (com-names :name t) ()
+  (irc:names (current-connection *application-frame*) (target)))
 
 (define-beirc-command (com-quit :name t) ((reason 'mumble :prompt "reason"))
   (when (current-connection *application-frame*)


Index: beirc/message-display.lisp
diff -u beirc/message-display.lisp:1.8 beirc/message-display.lisp:1.9
--- beirc/message-display.lisp:1.8	Sat Sep 24 16:36:31 2005
+++ beirc/message-display.lisp	Sat Sep 24 17:04:06 2005
@@ -205,6 +205,15 @@
              (present (irc:source message) 'nickname)
              (format t " left ~A: ~A" (first (irc:arguments message)) (irc:trailing-argument message))))))
 
+(defmethod print-message ((message irc:irc-mode-message) receiver)
+  (destructuring-bind (target modes args) (irc:arguments message)
+    (declare (ignore target))
+    (formatting-message (t message receiver)
+            ((format t "   "))
+            ((with-drawing-options (*standard-output* :ink +gray33+ :text-size :small)
+               (present (irc:source message) 'nickname)
+               (format-message* (format nil " set mode ~A ~A" modes args)))))))
+
 (defmethod print-message ((message irc:irc-rpl_motd-message) receiver)
   (formatting-message (t message receiver)
           ((format t "~A" (irc:source message)))