[beirc-cvs] CVS beirc

[afuchs]

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