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
