[Cl-irc-cvs] CVS update: cl-irc/example/754.lisp-expr cl-irc/example/cliki.lisp cl-irc/example/specbot.lisp

[Brian Mastenbrook]

Update of /project/cl-irc/cvsroot/cl-irc/example
In directory common-lisp.net:/home/bmastenbrook/cl-irc/example

Modified Files:
	cliki.lisp specbot.lisp 
Added Files:
	754.lisp-expr 
Log Message:
alist lookup example: IEEE754

Date: Thu Jun 17 10:40:36 2004
Author: bmastenbrook



Index: cl-irc/example/cliki.lisp
diff -u cl-irc/example/cliki.lisp:1.9 cl-irc/example/cliki.lisp:1.10
--- cl-irc/example/cliki.lisp:1.9	Wed Jun  9 11:54:25 2004
+++ cl-irc/example/cliki.lisp	Thu Jun 17 10:40:35 2004
@@ -1,4 +1,4 @@
-;;;; $Id: cliki.lisp,v 1.9 2004/06/09 18:54:25 bmastenbrook Exp $
+;;;; $Id: cliki.lisp,v 1.10 2004/06/17 17:40:35 bmastenbrook Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $
 
 ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL.
@@ -144,7 +144,7 @@
 				(return-from cliki-return first-line))))
 			 (format nil "No definition was found in the first 5 lines of ~A" cliki-url)))
 		(if stream (close stream)))))
-	(condition (c &rest whatever) (return-from cliki-return (format nil "An error was encountered in lookup.")))))))
+	(condition (c &rest whatever) (return-from cliki-return (regex-replace-all "\\n" (format nil "An error was encountered in lookup: ~A." c) " ")))))))
 
 (defvar *cliki-connection*)
 (defvar *cliki-nickname*)
@@ -165,7 +165,7 @@
 (defun make-cliki-attention-prefix (nick)
   (format nil "^~A[,:]\\s+" nick))
 
-(defparameter *cliki-attention-prefix* "")
+(defvar *cliki-attention-prefix* "")
 
 (defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add \"term\" as: definition'' or ``minion: alias \"term\" as: term''; otherwise, edit the corresponding CLiki page.")
 


Index: cl-irc/example/specbot.lisp
diff -u cl-irc/example/specbot.lisp:1.2 cl-irc/example/specbot.lisp:1.3
--- cl-irc/example/specbot.lisp:1.2	Sat Jun 12 13:03:22 2004
+++ cl-irc/example/specbot.lisp	Thu Jun 17 10:40:35 2004
@@ -1,4 +1,4 @@
-;;;; $Id: specbot.lisp,v 1.2 2004/06/12 20:03:22 bmastenbrook Exp $
+;;;; $Id: specbot.lisp,v 1.3 2004/06/17 17:40:35 bmastenbrook Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/specbot.lisp,v $
 
 ;;;; specbot.lisp - an example IRC bot for cl-irc
@@ -57,11 +57,26 @@
        it
        (format nil "Nothing was found for: ~A" str)))
 
-(defparameter *spec-providers*
+(defvar *spec-providers*
   '((clhs-lookup "clhs" "The Common Lisp HyperSpec")
     (r5rs-lookup "r5rs" "The Revised 5th Ed. Report on the Algorithmic Language Scheme")
     (elisp-lookup "elisp" "GNU Emacs Lisp Reference Manual")))
 
+(defvar *alists* nil)
+
+(defun add-simple-alist-lookup (file designator prefix description)
+  (let ((alist (with-open-file (s file :direction :input) (read s))))
+    (push (cons designator alist) *alists*)
+    (setf *spec-providers*
+          (nconc *spec-providers*
+                 (list `((simple-alist-lookup ,designator) ,prefix ,description))))))
+
+(defun simple-alist-lookup (designator string)
+  (let ((alist (cdr (assoc designator *alists*))))
+    (aif (assoc string alist :test #'equalp)
+         (cdr it)
+         (format nil "Nothing was found for: ~A" string))))
+
 (defun valid-message (string prefix &key space-allowed)
   (if (eql (search prefix string :test #'char-equal) 0)
       (and (or space-allowed
@@ -94,11 +109,16 @@
                    (format nil "The available databases are: ~{~{~*~S, ~A~}~^; ~}"
                            *spec-providers*)))
         (loop for type in *spec-providers*
+              for actual-fun = (if (typep (first type) 'symbol)
+                                   (first type)
+                                   (lambda (lookup) (destructuring-bind (fun first-arg) (first type)
+                                                      (funcall fun first-arg lookup))))
               do
               (aif (strip-address to-lookup :address (second type) :final t)
-                   (privmsg *connection* destination (funcall (first type) it)))))))
+                   (privmsg *connection* destination (funcall actual-fun it)))))))
   
 (defun start-specbot (nick server &rest channels)
+  (add-simple-alist-lookup "754.lisp-expr" 'ieee754 "ieee754" "Section numbers of IEEE 754")
   (setf *nickname* nick)
   (setf *connection* (connect :nickname *nickname* :server server))
   (mapcar #'(lambda (channel) (join *connection* channel)) channels)