Log Message: Fix crash on unknown modes.tility.lisp
Sorry guys, this commit contains way more than intended. The code included however, is good.
It includes the rewrite to remove calls to trailing-argument.
bye,
Erik.
--- /project/cl-irc/cvsroot/cl-irc/event.lisp 2006/02/15 20:42:48 1.17 +++ /project/cl-irc/cvsroot/cl-irc/event.lisp 2006/02/15 23:24:34 1.18 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.17 2006/02/15 20:42:48 ehuelsmann Exp $ +;;;; $Id: event.lisp,v 1.18 2006/02/15 23:24:34 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/event.lisp,v $
;;;; See LICENSE for licensing information. @@ -108,9 +108,11 @@ :user-count user-count))))))
(defmethod default-hook ((message irc-rpl_topic-message))
- (setf (topic (find-channel (connection message)
(second (arguments message))))(trailing-argument message)))
- (destructuring-bind
(target channel topic)(arguments message)- (declare (ignore target))
- (setf (topic (find-channel (connection message) channel)) topic)))
(defmethod default-hook ((message irc-rpl_namreply-message)) (let* ((connection (connection message))) @@ -159,32 +161,43 @@ (apply #'pong (connection message) (arguments message)))
(defmethod default-hook ((message irc-join-message))
- (let* ((connection (connection message))
(user (find-or-make-user(connection message)(source message):hostname (host message):username (user message)))(channel (or (find-channel connection (trailing-argumentmessage))
(make-channel connection:name (trailing-argument message)))))- (when (self-message-p message)
(add-channel connection channel))- (add-user connection user)
- (add-user channel user)))
- (with-slots
(connection source host user arguments)message- (destructuring-bind
(channel)arguments(let ((user (find-or-make-user connection source:hostname host:username user))(channel (or (find-channel connection channel)(make-channel connection :name channel))))(when (self-message-p message)(add-channel connection channel))(add-user connection user)(add-user channel user)))))(defmethod default-hook ((message irc-topic-message))
- (setf (topic (find-channel (connection message)
(first (arguments message))))(trailing-argument message)))
- (with-slots
(connection arguments)message- (destructuring-bind
(channel &optional topic)arguments(setf (topic (find-channel connection channel)) topic))))(defmethod default-hook ((message irc-part-message))
- (let* ((connection (connection message))
(channel (find-channel connection (first (arguments message))))(user (find-user connection (source message))))- (if (self-message-p message)
(remove-channel user channel)(remove-user channel user))))
- (with-slots
(connection arguments source)message- (destructuring-bind
(channel &optional text)arguments(let ((channel (find-channel connection channel))(user (find-user connection source)))(if (self-message-p message)(remove-channel user channel)(remove-user channel user))))))(defmethod default-hook ((message irc-quit-message)) (let* ((connection (connection message)) @@ -193,30 +206,34 @@ (remove-user-everywhere connection user))))
(defmethod default-hook ((message irc-rpl_channelmodeis-message))
- (destructuring-bind
(target &rest arguments);; ignore the my own nick which is the first message argument(rest (arguments message))- (let* ((connection (connection message))
(target (find-channel connection target))
- (with-slots
(connection arguments)message- (destructuring-bind
(target channel &rest mode-arguments)arguments- (declare (ignore target))
- (let* ((channel (find-channel connection channel)) (mode-changes
(when target(parse-mode-arguments connection target arguments
(when channel(parse-mode-arguments connection channel arguments :server-p (user connection))))) (dolist (change mode-changes) (destructuring-bind (op mode-name value) change
(unless (has-mode-p target mode-name)
(unless (has-mode-p channel mode-name) (add-mode target mode-name
(make-mode connection target mode-name)))
(make-mode connection channel mode-name))) (funcall (if (char= #\+ op) #'set-mode #'unset-mode)
target mode-name value))))))
channel mode-name value)))))))(defmethod default-hook ((message irc-mode-message)) (destructuring-bind (target &rest arguments) (arguments message)
- (print (arguments message))
- (print arguments) (let* ((connection (connection message)) (target (or (find-channel connection target) (find-user connection target)))
@@ -235,22 +252,35 @@ target mode-name value))))))
(defmethod default-hook ((message irc-nick-message))
- (let* ((con (connection message))
(user (find-or-make-user con (source message):hostname (host message):username (user message))))- (change-nickname con user (trailing-argument message))))
- (with-slots
(connection source host user arguments)message- (destructuring-bind
(new-nick)arguments(let* ((user (find-or-make-user connection source:hostname host:username user)))(change-nickname connection user new-nick)))))(defmethod default-hook ((message irc-kick-message))
- (let* ((connection (connection message))
(channel (find-channel connection (first (arguments message))))(user (find-user connection (second (arguments message)))))- (if (self-message-p message)
(remove-channel user channel)(remove-user channel user))))
- (with-slots
(connection arguments)message- (destructuring-bind
(channel nick &optional reason)arguments(declare (ignore arguments))(let* ((channel (find-channel connection channel))(user (find-user connection nick)))(if (self-message-p message)(remove-channel user channel)(remove-user channel user))))))(defmethod default-hook ((message ctcp-time-message))
- (multiple-value-bind (second minute hour date month year day)
(get-decoded-time)
- (multiple-value-bind
(second minute hour date month year day)(get-decoded-time)--- /project/cl-irc/cvsroot/cl-irc/utility.lisp 2006/02/15 20:14:21 1.10 +++ /project/cl-irc/cvsroot/cl-irc/utility.lisp 2006/02/15 23:24:34 1.11 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.10 2006/02/15 20:14:21 ehuelsmann Exp $ +;;;; $Id: utility.lisp,v 1.11 2006/02/15 23:24:34 ehuelsmann Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/utility.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -292,9 +292,11 @@ (mode-description connection target (mode-name-from-char connection target (char modes i))))
(param-p (funcall param-req mode-rec)))(when (and param-p(= 0 (length arguments)))
(param-p (when mode-rec(funcall param-req mode-rec))))(when (or (null mode-rec)(and param-p(= 0 (length arguments)))) (throw 'illegal-mode-spec nil)) (push (list this-op (mode-desc-symbol mode-rec)
cl-irc-cvs mailing list cl-irc-cvs@common-lisp.net http://common-lisp.net/cgi-bin/mailman/listinfo/cl-irc-cvs