[cl-irc-cvs] CVS cl-irc
ehuelsmann
ehuelsmann at common-lisp.net
Wed Feb 15 23:24:35 UTC 2006
Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv16585
Modified Files:
event.lisp utility.lisp
Log Message:
Fix crash on unknown modes.tility.lisp
--- /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-argument message))
- (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)
(send-irc-message
(connection message)
:notice (source message)
--- /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)
More information about the cl-irc-cvs
mailing list