Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example In directory common-lisp.net:/tmp/cvs-serv30814
Modified Files: clhs.lisp Log Message: Multiple attention prefixes, s-b-m-h instead of a-a-m-h, misc. changes
Date: Wed Dec 17 20:45:39 2003 Author: bmastenbrook
Index: net-nittin-irc/example/clhs.lisp diff -u net-nittin-irc/example/clhs.lisp:1.3 net-nittin-irc/example/clhs.lisp:1.4 --- net-nittin-irc/example/clhs.lisp:1.3 Mon Nov 17 09:04:28 2003 +++ net-nittin-irc/example/clhs.lisp Wed Dec 17 20:45:39 2003 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.3 2003/11/17 14:04:28 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.4 2003/12/18 01:45:39 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 @@ -20,7 +20,7 @@ (in-package :clhs)
;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-pathname* #p"/home/chandler/public_html/HyperSpec/") +(defparameter *hyperspec-pathname* #p"/Users/chandler/Sites/HyperSpec/")
(defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*))
@@ -31,7 +31,7 @@
(defparameter *mop-root* "http://www.alu.org/mop/")
-(defparameter *table* (make-hash-table :test 'equalp)) +(defvar *table* (make-hash-table :test 'equalp))
(defun add-clhs-section-to-table (&rest numbers) (let ((key (format nil "~{~d~^.~}" numbers)) @@ -142,30 +142,34 @@ it (format nil "Nothing was found for: ~A" str)))
-(defparameter *clhs-attention-prefix* "clhs ") +(defparameter *clhs-attention-prefixes* '("clhs " "clhs: ")) + +(defun valid-clhs-message-1 (message prefix) + (if (eql (search prefix (trailing-argument message) :test #'char-equal) 0) + (and (not (find #\space (trailing-argument message) :start (length prefix))) + (length prefix)) + nil))
(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)) + (some #'(lambda (e) (valid-clhs-message-1 message e)) *clhs-attention-prefixes*))
(defun msg-hook (message) (if (string-equal (first (arguments message)) *clhs-nickname*) - (if (valid-clhs-message message) - (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*)))) + (aif (valid-clhs-message message) + (privmsg *clhs-connection* (source message) (spec-lookup (subseq (trailing-argument message) it))) (privmsg *clhs-connection* (source message) (spec-lookup (trailing-argument message)))) - (if (valid-clhs-message message) - (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) (length *clhs-attention-prefix*))))))) + (aif (valid-clhs-message message) + (privmsg *clhs-connection* (first (arguments message)) (spec-lookup (subseq (trailing-argument message) it))))))
(defun start-clhs-bot (nick server &rest channels) (populate-table) (setf *clhs-nickname* nick) (setf *clhs-connection* (connect :nickname *clhs-nickname* :server server)) (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*) + (add-hook *clhs-connection* 'irc::irc-privmsg-message 'msg-hook) + #+sbcl (start-background-message-handler *clhs-connection*) #-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)) + (add-hook *clhs-connection* 'irc::irc-privmsg-message 'msg-hook))