[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