Update of /project/beirc/cvsroot/beirc In directory common-lisp:/tmp/cvs-serv5203
Modified Files: application.lisp Log Message: * Bring beirc up-to-date with recent cl-irc, and remove the kludgy read-message method
* Add a password &key argument to com-connect
* Add com-back; /away with empty reason is too awkward.
--- /project/beirc/cvsroot/beirc/application.lisp 2005/10/07 00:59:58 1.34 +++ /project/beirc/cvsroot/beirc/application.lisp 2006/01/27 22:35:57 1.35 @@ -435,6 +435,9 @@ (define-beirc-command (com-away :name t) ((reason 'mumble :prompt "reason")) (irc:away (current-connection *application-frame*) reason))
+(define-beirc-command (com-back :name t) () + (irc:away (current-connection *application-frame*) "")) + (define-beirc-command (com-quit :name t) ((reason 'mumble :prompt "reason")) (when (current-connection *application-frame*) (disconnect *application-frame* reason)) @@ -672,13 +675,19 @@ (define-beirc-command (com-connect :name t) ((server 'string :prompt "Server") &key - (nick 'string :prompt "Nick name" :default *default-nick*)) + (nick 'string :prompt "Nick name" :default *default-nick*) + (pass 'string :prompt "Password" :default nil) + (port 'number :prompt "Port" :default irc::*default-irc-server-port*)) (let ((success nil)) (cond ((current-connection *application-frame*) (format *query-io* "You are already connected.~%")) (t (setf (slot-value *application-frame* 'connection) - (irc:connect :nickname nick :server server :connection-type 'beirc-connection)) + (apply #'irc:connect + :nickname nick :server server :connection-type 'beirc-connection :port port + (if (null pass) + nil + `(:password ,pass)))) (unwind-protect (progn (setf (irc:client-stream (current-connection *application-frame*)) @@ -784,16 +793,9 @@ ;;; user before we got the message (so that we can display it ;;; everywhere it is relevant). ;;; So, this method is basically a copy of IRC:READ-MESSAGE. ugh. -(defmethod irc:read-message ((connection beirc-connection)) - (handler-case - (when (irc::connectedp connection) - (let ((message (irc::read-irc-message connection))) - (post-message *application-frame* message) - (irc::irc-message-event message) - message)) - (stream-error (c) (signal 'irc::invalidate-me :stream - (irc:server-stream connection) - :condition c)))) +(defmethod irc::irc-message-event :around ((connection beirc-connection) message) + (post-message *application-frame* message) + (call-next-method))
(defun irc-event-loop (frame connection) (unwind-protect