Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv23681
Modified Files: event.lisp package.lisp protocol.lisp Log Message: (channels connection) is now a hash-table and the LIST- command is fairly efficient. now normalizing channel-names and cleaned up some other minor things (all-users and all-channels no longer used).
Date: Mon Nov 24 22:35:55 2003 Author: eenge
Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.11 net-nittin-irc/event.lisp:1.12 --- net-nittin-irc/event.lisp:1.11 Mon Nov 24 16:30:11 2003 +++ net-nittin-irc/event.lisp Mon Nov 24 22:35:55 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.11 2003/11/24 21:30:11 eenge Exp $ +;;;; $Id: event.lisp,v 1.12 2003/11/25 03:35:55 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $
;;;; See LICENSE for licensing information. @@ -29,11 +29,10 @@ (channel (second (arguments message))) (user-count (parse-integer (or (third (arguments message)) "0"))) (topic (trailing-argument message))) - (pushnew (or (find-channel connection channel) - (make-channel :name channel - :topic topic - :user-count user-count)) - (channels connection)))) + (add-channel connection (or (find-channel connection channel) + (make-channel :name channel + :topic topic + :user-count user-count)))))
(defmethod default-hook ((message irc-rpl_topic-message)) (setf (topic (find-channel (connection message)
Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.10 net-nittin-irc/package.lisp:1.11 --- net-nittin-irc/package.lisp:1.10 Sun Nov 23 18:06:13 2003 +++ net-nittin-irc/package.lisp Mon Nov 24 22:35:55 2003 @@ -1,10 +1,11 @@ -;;;; $Id: package.lisp,v 1.10 2003/11/23 23:06:13 eenge Exp $ +;;;; $Id: package.lisp,v 1.11 2003/11/25 03:35:55 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $
;;;; See the LICENSE file for licensing information.
(in-package :cl-user)
+;; the exports list needs some cleanup/clarification/categorization (eval-when (:execute :load-toplevel :compile-toplevel) (defpackage :net-nittin-irc (:use :cl) @@ -16,12 +17,12 @@ :server-name :no-such-reply :parse-raw-message + :normalize-nickname + :normalize-channel-name :server-stream :client-stream :channels :configuration - :all-users - :all-channels :dangling-users :channel-list :add-hook
Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.19 net-nittin-irc/protocol.lisp:1.20 --- net-nittin-irc/protocol.lisp:1.19 Mon Nov 24 16:56:49 2003 +++ net-nittin-irc/protocol.lisp Mon Nov 24 22:35:55 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.19 2003/11/24 21:56:49 eenge Exp $ +;;;; $Id: protocol.lisp,v 1.20 2003/11/25 03:35:55 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $
;;;; See LICENSE for licensing information. @@ -46,7 +46,7 @@ (channels :initarg :channels :accessor channels - :initform nil) + :initform (make-hash-table :test #'equal)) (hooks :initarg :hooks :accessor hooks @@ -252,6 +252,9 @@ ((name :initarg :name :accessor name) + (normalized-name + :initarg :normalized-name + :accessor normalized-name) (topic :initarg :topic :accessor topic) @@ -278,6 +281,11 @@ (print-unreadable-object (object stream :type t :identity t) (princ (name object) stream)))
+(defun normalize-channel-name (string) + "Normalize `string' so that it represents an all-downcased channel +name." + (string-downcase string)) + (defun make-channel (&key (name "") (topic "") (modes nil) @@ -286,6 +294,7 @@ (let ((channel (make-instance 'channel :name name + :normalized-name (normalize-channel-name name) :topic topic :modes modes :user-count user-count))) @@ -296,19 +305,20 @@ (defmethod find-channel ((connection connection) (channel string)) "Return channel as designated by `channel'. If no such channel can be found, return nil." - (find channel (channels connection) :key #'name :test #'string-equal)) + (let ((channel-name (normalize-channel-name channel))) + (gethash channel-name (channels connection))))
(defmethod remove-all-channels ((connection connection)) "Remove all channels known to `connection'." - (setf (channels connection) nil)) + (clrhash (channels connection)))
(defmethod add-channel ((connection connection) (channel channel)) "Add `channel' to `connection'." - (pushnew channel (channels connection))) + (setf (gethash (normalized-name channel) (channels connection)) channel))
(defmethod remove-channel ((connection connection) (channel channel)) "Remove `channel' from `connection'." - (setf (channels connection) (remove channel (channels connection)))) + (remhash (normalized-name channel) (channels connection)))
(defmethod remove-users ((channel channel)) "Remove all users on `channel'." @@ -369,15 +379,15 @@ (subseq nickname 1) nickname))
-;; oh, what a terrible operator name (defun normalize-nickname (string) + "Normalize `string' so that represents an all-downcased IRC +nickname." (let* ((new-string (substitute #[ #{ string)) (new-string (substitute #] #} new-string)) (new-string (substitute #\ #| new-string)) (new-string (substitute #~ #^ new-string))) (string-downcase string)))
-;; this is broken. we should use #'irc-nick-equal somehow. (defmethod find-user ((connection connection) (nickname string)) "Return user as designated by `nickname' or nil if no such user is known." @@ -395,8 +405,7 @@
(defmethod remove-all-users ((connection connection)) "Remove all users known to `connection'." - (setf (users connection) nil) - (mapc #'remove-users (channels connection))) + (clrhash (users connection)))
(defmethod remove-user ((channel channel) (user user)) "Remove `user' from `channel' and `channel' from `user'."