[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/clhs.lisp

[Brian Mastenbrook]

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))