- net-nittin-irc-cvs@lists.common-lisp.net

[net-nittin-irc-cvs] CVS update: net-nittin-irc/protocol.lisp
by Erik Enge 22 Nov '03

22 Nov '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv11616 Modified Files: protocol.lisp Log Message: adding a few better docstrings Date: Sat Nov 22 14:24:13 2003 Author: eenge Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.12 net-nittin-irc/protocol.lisp:1.13 --- net-nittin-irc/protocol.lisp:1.12 Fri Nov 14 15:35:01 2003 +++ net-nittin-irc/protocol.lisp Sat Nov 22 14:24:13 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.12 2003/11/14 20:35:01 bmastenbrook Exp $ +;;;; $Id: protocol.lisp,v 1.13 2003/11/22 19:24:13 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -106,6 +106,8 @@ (force-output stream))) (defmethod connectedp ((connection connection)) + "Returns t if `connection' is connected to a server and is ready for +input." (let ((stream (server-stream connection))) (and (streamp stream) (open-stream-p stream)))) @@ -129,14 +131,16 @@ (when *debug-p* (format *debug-stream* "~A" (describe message))) (irc-message-event message) - message))) ; needed because of the "loop while" in read-meesage-loop + message))) ; needed because of the "loop while" in read-message-loop (stream-error () (setf read-more-p nil))))) (defmethod read-message-loop ((connection connection)) + "Read messages from the `connection', parse them and dispatch +irc-message-event on them." (loop while (read-message connection))) (defmethod read-irc-message ((connection connection)) - "Read an IRC-message from the connection." + "Read and parse an IRC-message from the `connection'." (let ((message (create-irc-message (read-line (server-stream connection) t)))) (setf (connection message) connection)

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/parse-message.lisp
by Erik Enge 22 Nov '03

22 Nov '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv10244 Modified Files: parse-message.lisp Log Message: adding better docstrings Date: Sat Nov 22 14:21:33 2003 Author: eenge Index: net-nittin-irc/parse-message.lisp diff -u net-nittin-irc/parse-message.lisp:1.4 net-nittin-irc/parse-message.lisp:1.5 --- net-nittin-irc/parse-message.lisp:1.4 Mon Nov 10 12:25:38 2003 +++ net-nittin-irc/parse-message.lisp Sat Nov 22 14:21:33 2003 @@ -1,4 +1,4 @@ -;;;; $Id: parse-message.lisp,v 1.4 2003/11/10 17:25:38 eenge Exp $ +;;;; $Id: parse-message.lisp,v 1.5 2003/11/22 19:21:33 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/parse-message.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -6,6 +6,11 @@ (in-package :irc) (defun find-reply-name (reply-number &key (reply-names *reply-names*)) + "Numeric replies in the IRC RFCs have more meaningful names. Given +a numeric reply (`reply-number') this function will either return the +symbol representing the reply or raise a continuable error +(`no-such-reply') which gives you the opportunity to ignore the +situation." (let ((name (assoc reply-number reply-names))) (if name (cadr name) @@ -15,29 +20,58 @@ :unknown-reply)))) (defun return-source (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +source part of the message. Returns nil if the source part is not +present." (cut-between string #\: '(#\! #\Space) :start start)) (defun return-user (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +user part of the message. Returns nil if the user part is not +present." (cut-between string #\! '(#\@ #\Space) :start start)) (defun return-host (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +host part of the message. Returns nil if the host part is not +present." (cut-between string #\@ '(#\Space) :start start)) (defun return-command (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +command part of the message. Returns nil if the command part is not +present." (if (eql (char string start) #\Space) (cut-between string #\Space '(#\Space) :start start) (cut-between string nil '(#\Space) :start start :cut-extra nil))) (defun return-arguments (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +arguments part of the message as a list. Returns nil if the arguments +part is not present." (multiple-value-bind (end-position return-argument) (cut-between string nil '(#\:) :start start) (values end-position (tokenize-string return-argument :delimiters '(#\Space))))) (defun return-trailing-argument (string &key (start 0)) + "Assuming `string' is a valid IRC message this function returns the +trailing-argument part of the message. Returns nil if the +trailing-argument part is not present." (cut-between string #\: '(#\Return) :start start)) (defun parse-raw-message (string &key (start 0)) + "Assuming `string' is a valid IRC message, parse the message and +return the values in the following order: + + - source + - user + - host + - command + - arguments + - trailing-argument + +Any values not present will be represented as nil." (let ((index start) (returns nil)) (dolist (function '(return-source @@ -53,6 +87,8 @@ (apply #'values (reverse returns)))) (defun irc-error-reply-p (string) + "Returns t if `string' is a string-representation of an IRC error +reply message, nil otherwise." (unless (zerop (length string)) (if (and (every #'digit-char-p string) (member (char string 0) '(#\4 #\5))) @@ -60,17 +96,20 @@ nil))) (defun numeric-reply-p (string) + "Returns t if `string' is a string-representation of an IRC number +reply, nil otherwise." (every #'digit-char-p string)) (defun ctcp-type-p (string type) - "What type of CTCP message is this?" - (if (string-equal (subseq string 1 (min (length string) - (1+ (length (symbol-name type))))) + "Is the `string' actually a representation of the CTCP `type'?" + (if (string-equal (subseq string 1 (min (length string) + (1+ (length (symbol-name type))))) type) type nil)) (defun dcc-type-p (string type) + "Is the `string' actually a representation of the DCC `type'?" (case type (:dcc-chat-request (when (string-equal (char string 5) #\C) @@ -80,7 +119,10 @@ :dcc-send-request)) (otherwise nil))) -(defun parse-ctcp-message (string) +(defun ctcp-message-p (string) + "If `string' is a CTCP message, return the type of the message or +nil if this is a) not a CTCP message or b) a CTCP message we don't +know about." (if (or (not (stringp string)) (zerop (length string)) (not (eql (char string 0) +soh+))) @@ -100,10 +142,13 @@ (otherwise nil)))) (defun create-irc-message (string) + "If `string' is a valid IRC message parse it and return an object of +the correct type with its slots prefilled according to the information +in the message." (multiple-value-bind (source user host command arguments trailing-argument) (parse-raw-message string) (let ((class 'irc-message) - (ctcp (parse-ctcp-message trailing-argument))) + (ctcp (ctcp-message-type trailing-argument))) (when command (cond ((irc-error-reply-p command)

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/utility.lisp
by Erik Enge 22 Nov '03

22 Nov '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv4404 Modified Files: utility.lisp Log Message: adding better docstring for cut-between Date: Sat Nov 22 14:07:16 2003 Author: eenge Index: net-nittin-irc/utility.lisp diff -u net-nittin-irc/utility.lisp:1.3 net-nittin-irc/utility.lisp:1.4 --- net-nittin-irc/utility.lisp:1.3 Fri Nov 7 10:40:19 2003 +++ net-nittin-irc/utility.lisp Sat Nov 22 14:07:16 2003 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.3 2003/11/07 15:40:19 eenge Exp $ +;;;; $Id: utility.lisp,v 1.4 2003/11/22 19:07:16 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -118,11 +118,16 @@ (vector first second third fourth))) (defun cut-between (string start-char end-chars &key (start 0) (cut-extra t)) - "If start-char is not nil, cut string between start-char and any of -the end-chars, from start. If start-char is nil, cut from start until -any of the end-chars. - -If cut-extra is t, we will cut from start + 1 instead of just start." + "If `start-char' is not nil, cut string between `start-char' and any +of the `end-chars', from `start'. If `start-char' is nil, cut from +`start' until any of the `end-chars'. + +If `cut-extra' is t, we will cut from start + 1 instead of just +`start'. + +When there is no string matching the input parameters `start' and nil +will be returned, otherwise `end-position' and the string are +returned." (let ((end-position (position-if #'(lambda (char) (member char end-chars)) string :start (1+ start)))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/net-nittin-irc.asd
by Erik Enge 22 Nov '03

22 Nov '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv32580 Modified Files: net-nittin-irc.asd Log Message: adding properties for albert Date: Sat Nov 22 13:57:14 2003 Author: eenge Index: net-nittin-irc/net-nittin-irc.asd diff -u net-nittin-irc/net-nittin-irc.asd:1.2 net-nittin-irc/net-nittin-irc.asd:1.3 --- net-nittin-irc/net-nittin-irc.asd:1.2 Fri Nov 7 08:43:06 2003 +++ net-nittin-irc/net-nittin-irc.asd Sat Nov 22 13:57:14 2003 @@ -1,4 +1,4 @@ -;;;; $Id: net-nittin-irc.asd,v 1.2 2003/11/07 13:43:06 eenge Exp $ +;;;; $Id: net-nittin-irc.asd,v 1.3 2003/11/22 18:57:14 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/net-nittin-irc.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -18,6 +18,13 @@ :description "Common Lisp interface to the IRC protocol" #+sbcl :depends-on (:sb-bsd-sockets :split-sequence) :depends-on (:split-sequence) + :properties ((#:author-email . "net-nittin-irc-devel(a)common-lisp.net") + (#:date . "$Date: 2003/11/22 18:57:14 $") + ((#:albert #:output-dir) . "doc/api-doc/") + ((#:albert #:formats) . ("docbook")) + ((#:albert #:docbook #:template) . "book") + ((#:albert #:docbook #:bgcolor) . "white") + ((#:albert #:docbook #:textcolor) . "black")) :components ((:file "package") (:file "variable" :depends-on ("package"))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/event.lisp
by Erik Enge 22 Nov '03

22 Nov '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv32206 Modified Files: event.lisp Log Message: removing all those methods with basically no content Date: Sat Nov 22 13:55:53 2003 Author: eenge Index: net-nittin-irc/event.lisp diff -u net-nittin-irc/event.lisp:1.7 net-nittin-irc/event.lisp:1.8 --- net-nittin-irc/event.lisp:1.7 Fri Nov 14 11:13:21 2003 +++ net-nittin-irc/event.lisp Sat Nov 22 13:55:53 2003 @@ -1,4 +1,4 @@ -;;;; $Id: event.lisp,v 1.7 2003/11/14 16:13:21 eenge Exp $ +;;;; $Id: event.lisp,v 1.8 2003/11/22 18:55:53 eenge Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/event.lisp,v $ ;;;; See LICENSE for licensing information. @@ -20,813 +20,53 @@ (stream (client-stream connection))) (client-log connection message))) -(defmethod irc-message-event ((message irc-rpl_welcome-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_yourhost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_created-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_myinfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_bounce-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tracelink-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceconnecting-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tracehandshake-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceunknown-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceoperator-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceuser-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceservice-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tracenewtype-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceclass-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tracereconnect-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statslinkinfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statscommands-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statscline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsnline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsiline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statskline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsqline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsyline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofstats-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_umodeis-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsdline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_option-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endoptions-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_serviceinfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofservices-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_service-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_servlist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_servlistend-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsvline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statslline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsonline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statshline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statssline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsping-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsbline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsuline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_statsdebug-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_luserclient-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_luserop-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_luserunknown-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_luserchannels-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_luserme-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_adminme-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_adminloc1-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_adminloc2-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_adminemail-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tracelog-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_traceend-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_tryagain-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_localusers-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_globalusers-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_mode-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endmode-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_sitelist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_clientcapab-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_noservicehost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_none-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_away-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_userhost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_ison-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_unaway-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_noaway-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoisuser-message)) - (apply-to-hooks message) - (client-log (connection message) message) - (let ((user (find-user (connection message) (second (arguments message)))) - (realname (trailing-argument message)) - (username (third (arguments message))) - (hostname (fourth (arguments message)))) - (setf (realname user) realname) - (setf (username user) username) - (setf (hostname user) hostname))) - -(defmethod irc-message-event ((message irc-rpl_whoisserver-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoisoperator-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whowasuser-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofwho-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoischanop-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoisidle-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofwhois-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoischannels-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_liststart-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_list-message)) - (apply-to-hooks message) - (client-log (connection message) message) - (let ((connection (connection message)) - (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)) - (channel-list connection)))) - -(defmethod irc-message-event ((message irc-rpl_listend-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_channelmodeis-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_uniqopis-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoisoperprivs-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoisrealhost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_creationtime-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_notopic-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_topic-message)) - (apply-to-hooks message) - (client-log (connection message) message) - (setf (topic (find-channel (connection message) - (second (arguments message)))) - (trailing-argument message))) - -(defmethod irc-message-event ((message irc-rpl_topicwhotime-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_inviting-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_summoning-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_invitelist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofinvitelist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_exceptlist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofexceptlist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_version-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_whoreply-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_namreply-message)) - (apply-to-hooks message) - (client-log (connection message) message) - (let ((channel (find-channel (connection message) (car (last (arguments message)))))) - (dolist (nickname (tokenize-string (trailing-argument message))) - (add-user channel - (find-or-make-user (connection message) - (canonicalize-nickname nickname) - :username (user message) - :hostname (host message)))))) - -(defmethod irc-message-event ((message irc-rpl_killdone-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_closing-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_closeend-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofnames-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_links-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endoflinks-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_banlist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofbanlist-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofwhowas-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_info-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_motd-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_infostart-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofinfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_motdstart-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofmotd-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_map-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofmap-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_forward-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_youreoper-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_rehashing-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_yourservice-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_myportis-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_time-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_usersstart-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_users-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_endofusers-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_nousers-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-rpl_message-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -;; -;; Error events -;; - -(defmethod irc-message-event ((message irc-err_nosuchnick-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nosuchserver-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nosuchchannel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_cannotsendtochan-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_toomanychannels-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_wasnosuchnick-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nosuchservice-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_noorigin-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_services_offline-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_norecipient-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_notexttosend-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_notoplevel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_wildtoplevel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_badmask-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_unknowncommand-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nomotd-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_noadmininfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_fileerror-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nonicknamegiven-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_erroneusnickname-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nicknameinuse-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nickcollision-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_unavailresource-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_bannickchange-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_usernotinchannel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_notonchannel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_useronchannel-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nologin-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_summondisabled-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_userdisabled-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_targetninvite-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_sourceninvite-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_notregistered-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_needmoreparams-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_alreadyregistered-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nopermforhost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_passwdmismatch-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_yourebannedcreep-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_youwillbebanned-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_keyset-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_channelisfull-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_unknownmode-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_inviteonlychan-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_bannedfromchan-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_badchannelkey-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_badchanmask-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nochanmodes-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_banlistfull-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_badchanname-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_throttled-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_noprivileges-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_chanoprivsneeded-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_cantkillserver-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_restricted-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_uniqopprivsneeded-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_no_op_split-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_need_umode-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_nooperhost-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_umodeunknownflag-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_usersdontmatch-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_ghostedclient-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_blocking_notid-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_sitelistfull-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_maxmapnodes-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - -(defmethod irc-message-event ((message irc-err_maxforwarding-message)) +(defmethod irc-message-event ((message irc-rpl_whoisuser-message)) (apply-to-hooks message) - (client-log (connection message) message)) + (client-log (connection message) message) + (let ((user (find-user (connection message) (second (arguments message)))) + (realname (trailing-argument message)) + (username (third (arguments message))) + (hostname (fourth (arguments message)))) + (setf (realname user) realname) + (setf (username user) username) + (setf (hostname user) hostname))) -(defmethod irc-message-event ((message irc-err_noforwarding-message)) +(defmethod irc-message-event ((message irc-rpl_list-message)) (apply-to-hooks message) - (client-log (connection message) message)) + (client-log (connection message) message) + (let ((connection (connection message)) + (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)) + (channel-list connection)))) -(defmethod irc-message-event ((message irc-err_nounidentified-message)) +(defmethod irc-message-event ((message irc-rpl_topic-message)) (apply-to-hooks message) - (client-log (connection message) message)) + (client-log (connection message) message) + (setf (topic (find-channel (connection message) + (second (arguments message)))) + (trailing-argument message))) -(defmethod irc-message-event ((message irc-err_last_err_msg-message)) +(defmethod irc-message-event ((message irc-rpl_namreply-message)) (apply-to-hooks message) - (client-log (connection message) message)) + (client-log (connection message) message) + (let ((channel (find-channel (connection message) (car (last (arguments message)))))) + (dolist (nickname (tokenize-string (trailing-argument message))) + (add-user channel + (find-or-make-user (connection message) + (canonicalize-nickname nickname) + :username (user message) + :hostname (host message)))))) (defmethod irc-message-event ((message irc-ping-message)) (apply-to-hooks message) (client-log (connection message) message) (pong (connection message) (trailing-argument message) )) -(defmethod irc-message-event ((message irc-error-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - (defmethod irc-message-event ((message irc-join-message)) (apply-to-hooks message) (client-log (connection message) message) @@ -878,10 +118,6 @@ (format nil "Could not find user with nick ~A~%" (source message))))))) -(defmethod irc-message-event ((message irc-notice-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - ;; if we don't know about the user, we should probably add him here to ;; the dangling-users as he is messaging us without being on a channel ;; we are. @@ -889,10 +125,6 @@ (apply-to-hooks message) (client-log (connection message) message)) -(defmethod irc-message-event ((message irc-mode-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - (defmethod irc-message-event ((message irc-kick-message)) (apply-to-hooks message) (client-log (connection message) message) @@ -903,10 +135,6 @@ (remove-channel connection channel) (remove-user channel user)))) -;; -;; CTCP events -;; - (defmethod irc-message-event ((message ctcp-time-message)) (apply-to-hooks message) (client-log (connection message) message) @@ -918,10 +146,6 @@ (make-time-message second minute hour date month year day))) (source message)))) -(defmethod irc-message-event ((message ctcp-action-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - (defmethod irc-message-event ((message ctcp-source-message)) (apply-to-hooks message) (client-log (connection message) message) @@ -956,10 +180,6 @@ (format nil "VERSION ~A" *ctcp-version*)) (source message))) -(defmethod irc-message-event ((message ctcp-userinfo-message)) - (apply-to-hooks message) - (client-log (connection message) message)) - (defmethod irc-message-event ((message ctcp-ping-message)) (apply-to-hooks message) (client-log (connection message) message) @@ -968,10 +188,6 @@ :notice (make-ctcp-message (format nil "PING ~A" (trailing-argument message))) (source message))) - -;; -;; DCC events (which are a variant of CTCP events) -;; (defmethod irc-message-event ((message ctcp-dcc-chat-request-message)) (apply-to-hooks message)

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/LICENSE
by Erik Enge 22 Nov '03

22 Nov '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv26235 Modified Files: LICENSE Log Message: removing Jochens address Date: Sat Nov 22 13:41:03 2003 Author: eenge Index: net-nittin-irc/LICENSE diff -u net-nittin-irc/LICENSE:1.2 net-nittin-irc/LICENSE:1.3 --- net-nittin-irc/LICENSE:1.2 Tue Nov 11 08:35:41 2003 +++ net-nittin-irc/LICENSE Sat Nov 22 13:41:03 2003 @@ -22,9 +22,4 @@ For further details contact the authors of this software. - Jochen Schmidt - Zuckmantelstr. 11 - 91616 Neusitz - Germany - Erik Enge, erik(a)nittin.net

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/CREDITS
by Erik Enge 22 Nov '03

22 Nov '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv26157 Modified Files: CREDITS Log Message: adding brian to CREDITS file Date: Sat Nov 22 13:40:36 2003 Author: eenge Index: net-nittin-irc/CREDITS diff -u net-nittin-irc/CREDITS:1.1.1.1 net-nittin-irc/CREDITS:1.2 --- net-nittin-irc/CREDITS:1.1.1.1 Mon Nov 3 12:00:54 2003 +++ net-nittin-irc/CREDITS Sat Nov 22 13:40:36 2003 @@ -1,2 +1,3 @@ +Erik Enge +Brian Mastenbrook Jochen Schmidt -Erik Enge \ No newline at end of file

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/clhs.lisp
by Brian Mastenbrook 17 Nov '03

17 Nov '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv8784 Modified Files: clhs.lisp Log Message: Bugfixen Date: Mon Nov 17 09:04:28 2003 Author: bmastenbrook Index: net-nittin-irc/example/clhs.lisp diff -u net-nittin-irc/example/clhs.lisp:1.2 net-nittin-irc/example/clhs.lisp:1.3 --- net-nittin-irc/example/clhs.lisp:1.2 Fri Nov 14 15:35:22 2003 +++ net-nittin-irc/example/clhs.lisp Mon Nov 17 09:04:28 2003 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.2 2003/11/14 20:35:22 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.3 2003/11/17 14:04:28 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/example/clhs.lisp,v $ ;;;; clhs.lisp - an example IRC bot for net-nittin-irc @@ -19,12 +19,10 @@ (defpackage :clhs (:use :common-lisp :irc)) (in-package :clhs) -(defparameter *table* (make-hash-table :test 'equalp)) - ;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-map-file* #p"HyperSpec/Data/Map_Sym.txt") +(defparameter *hyperspec-pathname* #p"/home/chandler/public_html/HyperSpec/") -(defparameter *hyperspec-pathname* #p"HyperSpec/") +(defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) (defparameter *hyperspec-root* "http://www.lispworks.com/reference/HyperSpec/") @@ -32,6 +30,8 @@ (defparameter *mop-map-file* #p"Mop_Sym.txt") (defparameter *mop-root* "http://www.alu.org/mop/") + +(defparameter *table* (make-hash-table :test 'equalp)) (defun add-clhs-section-to-table (&rest numbers) (let ((key (format nil "~{~d~^.~}" numbers)) @@ -144,12 +144,17 @@ (defparameter *clhs-attention-prefix* "clhs ") +(defun valid-clhs-message (message) + (if (eql (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) 0) + (not (find #\space (trailing-argument message) :start (length *clhs-attention-prefix*))) + nil)) + (defun msg-hook (message) (if (string-equal (first (arguments message)) *clhs-nickname*) - (if (eql (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) 0) + (if (valid-clhs-message message) (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*)))) (privmsg *clhs-connection* (source message) (spec-lookup (trailing-argument message)))) - (if (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) + (if (valid-clhs-message message) (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*))))))) (defun start-clhs-bot (nick server &rest channels) @@ -159,4 +164,8 @@ (mapcar #'(lambda (channel) (join *clhs-connection* channel)) channels) (add-hook *clhs-connection* 'irc::irc-privmsg-message #'msg-hook) #+sbcl (add-asynchronous-message-handler *clhs-connection*) - #-sbcl (read-message-loop *clhs-connection*)) \ No newline at end of file + #-sbcl (read-message-loop *clhs-connection*)) + +(defun shuffle-hooks () + (irc::remove-hooks *clhs-connection* 'irc::irc-privmsg-message) + (add-hook *clhs-connection* 'irc::irc-privmsg-message #'msg-hook))

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/clhs.lisp
by Brian Mastenbrook 14 Nov '03

14 Nov '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv13083 Modified Files: clhs.lisp Log Message: Untabify, per kire. Date: Fri Nov 14 15:35:22 2003 Author: bmastenbrook Index: net-nittin-irc/example/clhs.lisp diff -u net-nittin-irc/example/clhs.lisp:1.1 net-nittin-irc/example/clhs.lisp:1.2 --- net-nittin-irc/example/clhs.lisp:1.1 Fri Nov 14 14:37:05 2003 +++ net-nittin-irc/example/clhs.lisp Fri Nov 14 15:35:22 2003 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.1 2003/11/14 19:37:05 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.2 2003/11/14 20:35:22 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/example/clhs.lisp,v $ ;;;; clhs.lisp - an example IRC bot for net-nittin-irc @@ -32,10 +32,10 @@ (defparameter *mop-map-file* #p"Mop_Sym.txt") (defparameter *mop-root* "http://www.alu.org/mop/") - + (defun add-clhs-section-to-table (&rest numbers) (let ((key (format nil "~{~d~^.~}" numbers)) - (target (concatenate 'string *hyperspec-root* (format nil "Body/~2,'0d_~(~{~36r~}~).htm" (car numbers) (mapcar #'(lambda (x) (+ x 9)) (cdr numbers)))))) + (target (concatenate 'string *hyperspec-root* (format nil "Body/~2,'0d_~(~{~36r~}~).htm" (car numbers) (mapcar #'(lambda (x) (+ x 9)) (cdr numbers)))))) (setf (gethash key *table*) target))) (defun valid-target (&rest numbers) @@ -47,85 +47,85 @@ ;; populate the table with the symbols from the Map file ;; this bit is easy and portable. (do ((symbol-name (read-line s nil s) (read-line s nil s)) - (url (read-line s nil s) (read-line s nil s))) - ((eq url s) 'done) + (url (read-line s nil s) (read-line s nil s))) + ((eq url s) 'done) (setf (gethash symbol-name *table*) (concatenate 'string *hyperspec-root* (subseq url 3)))) ;; add in section references. (let ((*default-pathname-defaults* *hyperspec-pathname*)) ;; Yuk. I know. Fixes welcome. (loop for section from 0 to 27 - do (add-clhs-section-to-table section) - do (loop named s for s1 from 1 to 17 - unless (valid-target section s1) - do (return-from s nil) - do (add-clhs-section-to-table section s1) - do (loop named ss for s2 from 1 to 17 - unless (valid-target section s1 s2) - do (return-from ss nil) - do (add-clhs-section-to-table section s1 s2) - do (loop named sss for s3 from 1 to 17 - unless (valid-target section s1 s2 s3) - do (return-from sss nil) - do (add-clhs-section-to-table section s1 s2 s3) - do (loop named ssss for s4 from 1 to 17 - unless (valid-target section s1 s2 s3 s4) - do (return-from ssss nil) - do (add-clhs-section-to-table section s1 s2 s3 s4) - do (loop named sssss for s5 from 1 to 17 - unless (valid-target section s1 s2 s3 s4 s5) - do (return-from sssss nil) - do (add-clhs-section-to-table section s1 s2 s3 s4 s5)))))))) + do (add-clhs-section-to-table section) + do (loop named s for s1 from 1 to 17 + unless (valid-target section s1) + do (return-from s nil) + do (add-clhs-section-to-table section s1) + do (loop named ss for s2 from 1 to 17 + unless (valid-target section s1 s2) + do (return-from ss nil) + do (add-clhs-section-to-table section s1 s2) + do (loop named sss for s3 from 1 to 17 + unless (valid-target section s1 s2 s3) + do (return-from sss nil) + do (add-clhs-section-to-table section s1 s2 s3) + do (loop named ssss for s4 from 1 to 17 + unless (valid-target section s1 s2 s3 s4) + do (return-from ssss nil) + do (add-clhs-section-to-table section s1 s2 s3 s4) + do (loop named sssss for s5 from 1 to 17 + unless (valid-target section s1 s2 s3 s4 s5) + do (return-from sssss nil) + do (add-clhs-section-to-table section s1 s2 s3 s4 s5)))))))) ;; format directives (loop for code from 32 to 127 - do (setf (gethash (format nil "format:~A" (code-char code)) *table*) - (concatenate 'string - *hyperspec-root* - (case (code-char code) - ((#\c #\C) "Body/22_caa.htm") - ((#\%) "Body/22_cab.htm") - ((#\&) "Body/22_cac.htm") - ((#\|) "Body/22_cad.htm") - ((#\~) "Body/22_cae.htm") - ((#\r #\R) "Body/22_cba.htm") - ((#\d #\D) "Body/22_cbb.htm") - ((#\b #\B) "Body/22_cbc.htm") - ((#\o #\O) "Body/22_cbd.htm") - ((#\x #\X) "Body/22_cbe.htm") - ((#\f #\F) "Body/22_cca.htm") - ((#\e #\E) "Body/22_ccb.htm") - ((#\g #\G) "Body/22_ccc.htm") - ((#\$) "Body/22_ccd.htm") - ((#\a #\A) "Body/22_cda.htm") - ((#\s #\S) "Body/22_cdb.htm") - ((#\w #\W) "Body/22_cdc.htm") - ((#\_) "Body/22_cea.htm") - ((#\<) "Body/22_ceb.htm") - ((#\i #\I) "Body/22_cec.htm") - ((#\/) "Body/22_ced.htm") - ((#\t #\T) "Body/22_cfa.htm") - ;; FIXME - ((#\<) "Body/22_cfb.htm") - ((#\>) "Body/22_cfc.htm") - ((#\*) "Body/22_cga.htm") - ((#\[) "Body/22_cgb.htm") - ((#\]) "Body/22_cgc.htm") - ((#\{) "Body/22_cgd.htm") - ((#\}) "Body/22_cge.htm") - ((#\?) "Body/22_cgf.htm") - ((#$) "Body/22_cha.htm") - ((#$) "Body/22_chb.htm") - ((#\p #\P) "Body/22_chc.htm") - ((#\;) "Body/22_cia.htm") - ((#\^) "Body/22_cib.htm") - ((#\Newline) "Body/22_cic.htm") - (t "Body/22_c.htm"))))) + do (setf (gethash (format nil "format:~A" (code-char code)) *table*) + (concatenate 'string + *hyperspec-root* + (case (code-char code) + ((#\c #\C) "Body/22_caa.htm") + ((#\%) "Body/22_cab.htm") + ((#\&) "Body/22_cac.htm") + ((#\|) "Body/22_cad.htm") + ((#\~) "Body/22_cae.htm") + ((#\r #\R) "Body/22_cba.htm") + ((#\d #\D) "Body/22_cbb.htm") + ((#\b #\B) "Body/22_cbc.htm") + ((#\o #\O) "Body/22_cbd.htm") + ((#\x #\X) "Body/22_cbe.htm") + ((#\f #\F) "Body/22_cca.htm") + ((#\e #\E) "Body/22_ccb.htm") + ((#\g #\G) "Body/22_ccc.htm") + ((#\$) "Body/22_ccd.htm") + ((#\a #\A) "Body/22_cda.htm") + ((#\s #\S) "Body/22_cdb.htm") + ((#\w #\W) "Body/22_cdc.htm") + ((#\_) "Body/22_cea.htm") + ((#\<) "Body/22_ceb.htm") + ((#\i #\I) "Body/22_cec.htm") + ((#\/) "Body/22_ced.htm") + ((#\t #\T) "Body/22_cfa.htm") + ;; FIXME + ((#\<) "Body/22_cfb.htm") + ((#\>) "Body/22_cfc.htm") + ((#\*) "Body/22_cga.htm") + ((#\[) "Body/22_cgb.htm") + ((#\]) "Body/22_cgc.htm") + ((#\{) "Body/22_cgd.htm") + ((#\}) "Body/22_cge.htm") + ((#\?) "Body/22_cgf.htm") + ((#$) "Body/22_cha.htm") + ((#$) "Body/22_chb.htm") + ((#\p #\P) "Body/22_chc.htm") + ((#\;) "Body/22_cia.htm") + ((#\^) "Body/22_cib.htm") + ((#\Newline) "Body/22_cic.htm") + (t "Body/22_c.htm"))))) ;; glossary. ) ;; MOP (with-open-file (s *mop-map-file*) (do ((symbol-name (read-line s nil s) (read-line s nil s)) - (url (read-line s nil s) (read-line s nil s))) - ((eq url s) 'done) + (url (read-line s nil s) (read-line s nil s))) + ((eq url s) 'done) (setf (gethash (concatenate 'string "MOP:" symbol-name) *table*) (concatenate 'string *mop-root* url))))) (defvar *clhs-connection*) @@ -135,7 +135,7 @@ `(let ((it ,test)) (if it ,conseq (symbol-macrolet ((it ,test)) - ,else)))) + ,else)))) (defun spec-lookup (str) (aif (gethash str *table*) @@ -147,10 +147,10 @@ (defun msg-hook (message) (if (string-equal (first (arguments message)) *clhs-nickname*) (if (eql (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) 0) - (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*)))) - (privmsg *clhs-connection* (source message) (spec-lookup (trailing-argument message)))) + (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*)))) + (privmsg *clhs-connection* (source message) (spec-lookup (trailing-argument message)))) (if (search *clhs-attention-prefix* (trailing-argument message) :test #'char-equal) - (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*))))))) + (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*))))))) (defun start-clhs-bot (nick server &rest channels) (populate-table)

1 0

[net-nittin-irc-cvs] CVS update: net-nittin-irc/command.lisp net-nittin-irc/package.lisp net-nittin-irc/protocol.lisp
by Brian Mastenbrook 14 Nov '03

14 Nov '03

Update of /project/net-nittin-irc/cvsroot/net-nittin-irc In directory common-lisp.net:/tmp/cvs-serv12718 Modified Files: command.lisp package.lisp protocol.lisp Log Message: Untabify files, per kire. Date: Fri Nov 14 15:35:01 2003 Author: bmastenbrook Index: net-nittin-irc/command.lisp diff -u net-nittin-irc/command.lisp:1.5 net-nittin-irc/command.lisp:1.6 --- net-nittin-irc/command.lisp:1.5 Fri Nov 14 15:23:53 2003 +++ net-nittin-irc/command.lisp Fri Nov 14 15:35:01 2003 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.5 2003/11/14 20:23:53 bmastenbrook Exp $ +;;;; $Id: command.lisp,v 1.6 2003/11/14 20:35:01 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -175,10 +175,10 @@ #+sbcl (defun socket-stream (socket) (sb-bsd-sockets:socket-make-stream socket - :element-type 'character - :input t - :output t - :buffering :none)) + :element-type 'character + :input t + :output t + :buffering :none)) (defun connect (&key (nickname *default-nickname*) (username nil) @@ -186,11 +186,11 @@ (mode 0) (server *default-irc-server*) (port *default-irc-server-port*) - (logging-stream t)) + (logging-stream t)) "Connect to server and return a connection object." (let* ((socket #+sbcl (connect-to-server-socket server port) - #-sbcl nil) - (stream #+lispworks (comm:open-tcp-stream server port :errorp t) + #-sbcl nil) + (stream #+lispworks (comm:open-tcp-stream server port :errorp t) #+cmu (sys:make-fd-stream (ext:connect-to-inet-socket server port) :input t :output t @@ -201,8 +201,8 @@ :username username :realname realname)) (connection (make-connection :server-socket socket - :server-stream stream - :client-stream logging-stream + :server-stream stream + :client-stream logging-stream :user user :server-name server))) (nick connection nickname) Index: net-nittin-irc/package.lisp diff -u net-nittin-irc/package.lisp:1.7 net-nittin-irc/package.lisp:1.8 --- net-nittin-irc/package.lisp:1.7 Fri Nov 14 15:23:53 2003 +++ net-nittin-irc/package.lisp Fri Nov 14 15:35:01 2003 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.7 2003/11/14 20:23:53 bmastenbrook Exp $ +;;;; $Id: package.lisp,v 1.8 2003/11/14 20:35:01 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -11,7 +11,7 @@ (:nicknames :irc) (:export :read-message-loop :read-message - :add-asynchronous-message-handler + :add-asynchronous-message-handler :send-message :server-name :server-stream @@ -28,16 +28,16 @@ :get-hooks :make-user :change-nickname - :irc-message - :source - :user - :host - :command - :arguments - :trailing-argument - :connection - :received-time - :raw-message-string + :irc-message + :source + :user + :host + :command + :arguments + :trailing-argument + :connection + :received-time + :raw-message-string :make-connection :make-channel :client-log Index: net-nittin-irc/protocol.lisp diff -u net-nittin-irc/protocol.lisp:1.11 net-nittin-irc/protocol.lisp:1.12 --- net-nittin-irc/protocol.lisp:1.11 Fri Nov 14 15:24:39 2003 +++ net-nittin-irc/protocol.lisp Fri Nov 14 15:35:01 2003 @@ -1,4 +1,4 @@ -;;;; $Id: protocol.lisp,v 1.11 2003/11/14 20:24:39 bmastenbrook Exp $ +;;;; $Id: protocol.lisp,v 1.12 2003/11/14 20:35:01 bmastenbrook Exp $ ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/protocol.lisp,v $ ;;;; See LICENSE for licensing information. @@ -76,7 +76,7 @@ (defun make-connection (&key (user nil) (server-name "") - (server-socket nil) + (server-socket nil) (server-stream nil) (client-stream t) (channels nil) @@ -89,7 +89,7 @@ (connection (make-instance 'connection :user user :server-name server-name - :server-socket server-socket + :server-socket server-socket :server-stream server-stream :client-stream client-stream :channels channels @@ -113,10 +113,10 @@ (defmethod add-asynchronous-message-handler ((connection connection)) #+sbcl (sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor - (server-socket connection)) - :input (lambda (fd) - (declare (ignore fd)) - (read-messsage connection))) + (server-socket connection)) + :input (lambda (fd) + (declare (ignore fd)) + (read-message connection))) #-sbcl (error "add-asynchronous-message-handler is not supported now on non-SBCL")) @@ -479,10 +479,10 @@ (let ((*print-case* :upcase)) (let ((name (intern (format nil "IRC-~A-MESSAGE" command)))) `(progn - (defmethod find-irc-message-class ((type (eql ,command))) - (find-class ',name)) - (export ',name) - (defclass ,name (irc-message) ()))))) + (defmethod find-irc-message-class ((type (eql ,command))) + (find-class ',name)) + (export ',name) + (defclass ,name (irc-message) ()))))) (defun create-irc-message-classes (class-list) (dolist (class class-list) @@ -527,10 +527,10 @@ (let ((*print-case* :upcase)) (let ((name (intern (format nil "CTCP-~A-MESSAGE" ctcp-command)))) `(progn - (defmethod find-ctcp-message-class ((type (eql ,ctcp-command))) - (find-class ',name)) - (export ',name) - (defclass ,name (ctcp-mixin irc-message) ()))))) + (defmethod find-ctcp-message-class ((type (eql ,ctcp-command))) + (find-class ',name)) + (export ',name) + (defclass ,name (ctcp-mixin irc-message) ()))))) (defun create-ctcp-message-classes (class-list) (dolist (class class-list)

1 0