[cl-irc-cvs] r219 - trunk
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Sun Sep 23 09:50:08 UTC 2012
Author: ehuelsmann
Date: Sun Sep 23 02:50:06 2012
New Revision: 219
Log:
Fix long-standing complaint that cl-irc hits the debugger on unknown
(and, as Matthew Emerson puts it, irrelevant) response codes.
* parse-message.lisp:
(find-reply-name): Simply return the reply name.
(create-irc-message): If there's no reply name, raise an error.
* protocol.lisp:
(read-irc-message, read-message, read-message-loop): restructure
condition handling for END-OF-FILE and NO-SUCH-REPLY to eliminate
"trickery" (returning values which mean different things than what
they are)
* variable.lisp:
(*unknown-reply-hook*): New variable for function to catch unhandled
replies. Defaults to ignore unhandled replies.
Modified:
trunk/parse-message.lisp
trunk/protocol.lisp
trunk/variable.lisp
Modified: trunk/parse-message.lisp
==============================================================================
--- trunk/parse-message.lisp Sat Aug 18 14:58:37 2012 (r218)
+++ trunk/parse-message.lisp Sun Sep 23 02:50:06 2012 (r219)
@@ -12,12 +12,8 @@
(`no-such-reply') which gives you the opportunity to ignore the
situation."
(let ((name (assoc reply-number reply-names)))
- (if name
- (cadr name)
- (progn
- (cerror "Ignore unknown reply."
- 'no-such-reply :reply-number reply-number)
- :unknown-reply))))
+ (when name
+ (cadr name))))
(defun return-source (string &key (start 0))
"Assuming `string' is a valid IRC message this function returns the
@@ -198,14 +194,17 @@
;; (setf command (find-reply-name (parse-integer command)))
;; (setf class 'irc-error-reply)))
((numeric-reply-p command)
- (progn
- (setf command (find-reply-name (parse-integer command)))
+ (let* ((reply-number (parse-integer command))
+ (reply-name (find-reply-name reply-number)))
+ (unless reply-name
+ (error "Ignore unknown reply."
+ 'no-such-reply :reply-number reply-number))
+ (setf command reply-name)
(setf class (find-irc-message-class command))))
(t
- (progn
- (setf command (intern (string-upcase command)
- (find-package :keyword)))
- (setf class (find-irc-message-class command))))))
+ (setf command (intern (string-upcase command)
+ (find-package :keyword)))
+ (setf class (find-irc-message-class command)))))
(when ctcp
(setf class (find-ctcp-message-class ctcp)))
(let ((instance (make-instance class
Modified: trunk/protocol.lisp
==============================================================================
--- trunk/protocol.lisp Sat Aug 18 14:58:37 2012 (r218)
+++ trunk/protocol.lisp Sun Sep 23 02:50:06 2012 (r219)
@@ -280,8 +280,8 @@
(when *debug-p*
(format *debug-stream* "~A" (describe message)))
(when message
- (irc-message-event connection message))
- message))) ; needed because of the "loop while" in read-message-loop
+ (irc-message-event connection message)))
+ t)) ;; connected -> continue processing
(defvar *process-count* 0)
@@ -311,34 +311,21 @@
(flet ((select-handler (fd)
(declare (ignore fd))
(if (listen (network-stream connection))
- (handler-bind
- ;; install sensible recovery: nobody can wrap the
- ;; handler...
- ((no-such-reply
- #'(lambda (c)
- (declare (ignore c))
- (invoke-restart 'continue))))
- (read-message connection))
- ;; select() returns with no
- ;; available data if the stream
- ;; has been closed on the other
- ;; end (EPIPE)
- (sb-sys:invalidate-descriptor
- (sb-sys:fd-stream-fd
- (network-stream connection))))))
+ (read-message connection)
+ ;; select() returns with no
+ ;; available data if the stream
+ ;; has been closed on the other
+ ;; end (EPIPE)
+ (sb-sys:invalidate-descriptor
+ (sb-sys:fd-stream-fd
+ (network-stream connection))))))
(sb-sys:add-fd-handler (sb-sys:fd-stream-fd
(network-stream connection))
:input #'select-handler))
#-(and sbcl (not sb-thread))
(flet ((do-loop ()
- (loop
- (handler-bind
- ((no-such-reply
- #'(lambda (c)
- (declare (ignore c))
- (invoke-restart 'continue))))
- (read-message-loop connection)))))
+ (read-message-loop connection)))
(let ((name (format nil "irc-handler-~D" (incf *process-count*))))
(start-process #'do-loop name))))
@@ -357,19 +344,23 @@
(defgeneric read-message-loop (connection))
(defmethod read-message-loop (connection)
- (loop while (read-message connection)))
+ (handler-bind
+ (loop while (read-message connection))
+ (end-of-file () nil)))
(defmethod read-irc-message ((connection connection))
- "Read and parse an IRC-message from the `connection'."
- (handler-case
- (let* ((msg-string (read-protocol-line connection))
- (message (when msg-string (create-irc-message msg-string))))
- (when message (setf (connection message) connection))
- message)
- (end-of-file
- ;; satisfy read-message-loop assumption of nil when no more messages
- ())))
+ "Read and parse an IRC message from the `connection'."
+ (let* ((msg-string (read-protocol-line connection))
+ (message (when msg-string
+ (handler-case
+ (create-irc-message msg-string)
+ (no-such-reply ()
+ (when *unknown-reply-hook*
+ (funcall *unknown-reply-hook*
+ connection msg-string)))))))
+ (when message (setf (connection message) connection))
+ message))
(defmethod send-irc-message ((connection connection) command
Modified: trunk/variable.lisp
==============================================================================
--- trunk/variable.lisp Sat Aug 18 14:58:37 2012 (r218)
+++ trunk/variable.lisp Sun Sep 23 02:50:06 2012 (r219)
@@ -15,8 +15,8 @@
(format nil "CL IRC library, cl-irc:~A:~A ~A"
*version* (machine-type) (machine-version)))
-(defparameter *download-host* "ftp://common-lisp.net/")
-(defparameter *download-directory* "/pub/project/cl-irc/")
+(defparameter *download-host* "http://common-lisp.net/")
+(defparameter *download-directory* "/project/cl-irc/")
(defparameter *download-file*
(format nil "cl-irc-~A.tar.gz" *version*))
@@ -28,6 +28,15 @@
(defvar *default-quit-message*
"Common Lisp IRC library - http://common-lisp.net/project/cl-irc")
+(defparameter *unknown-reply-hook* nil
+ "A function of two arguments, called with the related irc connection
+object and the protocol message string upon detection of an unmappable
+response code.
+
+The function should return a valid IRC-MESSAGE class or NIL.
+
+The parameter can be NIL to disable the hook.")
+
(defparameter *default-isupport-CHANMODES*
"beI,kO,l,aimnpqsrt")
(defparameter *default-isupport-PREFIX*
More information about the cl-irc-cvs
mailing list