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)))