[net-nittin-irc-cvs] CVS update: net-nittin-irc/event.lisp net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp
Erik Enge
eenge at common-lisp.net
Tue Nov 25 03:35:56 UTC 2003
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'."
More information about the Net-nittin-irc-cvs
mailing list