[beirc-cvs] CVS update: beirc/application.lisp

Andreas Fuchs afuchs at common-lisp.net
Sun Sep 25 16:30:42 UTC 2005


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

Modified Files:
	application.lisp 
Log Message:
rename QUIT->DISCONNECT and use it from a restart in the irc listener process.

also, use :prompt nil on /Me.

Date: Sun Sep 25 18:30:40 2005
Author: afuchs

Index: beirc/application.lisp
diff -u beirc/application.lisp:1.4 beirc/application.lisp:1.5
--- beirc/application.lisp:1.4	Sun Sep 25 18:07:58 2005
+++ beirc/application.lisp	Sun Sep 25 18:30:40 2005
@@ -346,12 +346,12 @@
 
 (define-beirc-command (com-quit :name t) ((reason 'mumble :prompt "reason"))
   (when (current-connection *application-frame*)
-    (quit *application-frame* reason))
+    (disconnect *application-frame* reason))
   (frame-exit *application-frame*))
 
 (define-beirc-command (com-disconnect :name t) ((reason 'mumble :prompt "reason"))
   (when (current-connection *application-frame*)
-    (quit *application-frame* reason)))
+    (disconnect *application-frame* reason)))
 
 (define-beirc-command (com-switch-timestamp-orientation :name t) ()
   (setf *timestamp-column-orientation* (if (eql *timestamp-column-orientation* :left)
@@ -480,9 +480,13 @@
              (setf (gethash "*Server*" (receivers frame)) (server-receiver frame))
              (setf (connection-process *application-frame*)
                    (clim-sys:make-process #'(lambda ()
-                                              (irc-event-loop frame connection))
+                                              (restart-case
+                                                  (irc-event-loop frame connection)
+                                                (disconnect ()
+                                                  :report "Disconnect from IRC"
+                                                  (disconnect frame "Client Disconnect"))))
                                           :name "IRC Message Muffling Loop")))))))
-(defun quit (frame reason)
+(defun disconnect (frame reason)
   (raise-receiver (server-receiver frame))
   (irc:quit (current-connection frame) reason)
   (when (and (connection-process frame)
@@ -586,7 +590,7 @@
 
 ;;;;;;
 
-(define-beirc-command (com-me :name t) ((what 'mumble))
+(define-beirc-command (com-me :name t) ((what 'mumble :prompt nil))
   (with-slots (connection) *application-frame*
     (let ((m (make-fake-irc-message 'irc:ctcp-action-message
                                     :trailing-argument




More information about the Beirc-cvs mailing list