[cl-irc-devel] CVS cl-irc
Erik Huelsmann
e.huelsmann at gmx.net
Wed Feb 15 23:38:06 UTC 2006
> 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-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)
>
> _______________________________________________
> cl-irc-cvs mailing list
> cl-irc-cvs at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/cl-irc-cvs
>
--
10 GB Mailbox, 100 FreeSMS/Monat http://www.gmx.net/de/go/topmail
+++ GMX - die erste Adresse für Mail, Message, More +++
More information about the cl-irc-devel
mailing list