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

Brian Mastenbrook bmastenbrook at common-lisp.net
Tue Jul 27 18:47:00 UTC 2004


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 
Log Message:
Don't remember

Date: Tue Jul 27 11:47:00 2004
Author: bmastenbrook

Index: cl-irc/example/cliki.lisp
diff -u cl-irc/example/cliki.lisp:1.13 cl-irc/example/cliki.lisp:1.14
--- cl-irc/example/cliki.lisp:1.13	Tue Jul 20 12:08:46 2004
+++ cl-irc/example/cliki.lisp	Tue Jul 27 11:47:00 2004
@@ -1,4 +1,4 @@
-;;;; $Id: cliki.lisp,v 1.13 2004/07/20 19:08:46 bmastenbrook Exp $
+;;;; $Id: cliki.lisp,v 1.14 2004/07/27 18:47:00 bmastenbrook Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $
 
 ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL.
@@ -265,7 +265,7 @@
                                  (multiple-value-bind (next-line missing-newline-p)
                                      (read-line stream nil)
                                    (if next-line
-                                       (setf first-line (concatenate 'string first-line next-line (string #\newline)))
+                                       (setf first-line (concatenate 'string first-line (string #\newline) next-line))
                                        (return-from cliki-return (format nil "The end of the page was reached before a definition was found in ~A" cliki-url))))
                                  (setf first-line (regex-replace-all "\\r" first-line " "))
                                  (setf first-line (regex-replace-all "\\n" first-line " "))
@@ -351,7 +351,7 @@
 (defparameter *last-warning-time* 0)
 
 (defun do-eliza (first-pass)
-  (if (> (- (get-universal-time) 30)
+  (if (> (- (get-universal-time) 60)
          *last-warning-time*)
       (let ((time-6 (first *last-eliza-times*))
             (time-4 (third *last-eliza-times*))
@@ -361,17 +361,17 @@
             (overload 0))
         (if (or
              (and
-              (< (- current-time 15)
+              (< (- current-time 60)
                  time-2)
               (setf count 3)
               (setf overload (- current-time time-2)))
              (and
-              (< (- current-time 45)
+              (< (- current-time 75)
                  time-4)
               (setf count 5)
               (setf overload (- current-time time-4)))
              (and
-              (< (- current-time 75)
+              (< (- current-time 90)
                  time-6)
               (setf count 7)
               (setf overload (- current-time time-6))))
@@ -385,6 +385,12 @@
             
             ))))
 
+(defvar *more* "CODE")
+
+(defun scan-for-more (s)
+  (let ((str (nth-value 1 (scan-to-strings "(?i)more\\W+(\\w+)" s))))
+    (and str (setf *more* (string-upcase (elt str 0))))))
+
 (defun cliki-lookup (term-with-question &key sender channel)
   (let ((first-pass (regex-replace-all "^(\\s*)([^?]+)(\\?*)$" term-with-question "\\2"))
         (should-send-cant-find t))
@@ -408,6 +414,8 @@
                   "OK, done.")
                 (progn
                   (setf first-pass (regex-replace-all "(:|/|\\\\|\\#)" first-pass ""))
+                  (setf first-pass (regex-replace-all "^(?i)(.*[^, ])(,|)\\s*please$" first-pass "\\1"))
+                  (setf first-pass (regex-replace-all "^(?i)please(,|)\\s*(.*[^, ])$" first-pass "\\1"))
                   (when (and (scan "^(?i)lisppaste(\\s|!|\\?|\\.|$)*" first-pass)
                              (find-package :lisppaste)
                              channel
@@ -418,7 +426,8 @@
                     (return-from cliki-lookup nil))
                   (or
                    (let ((strings
-                          (nth-value 1 (scan-to-strings "^(?i)(direct|tell|show|inform|teach)\\s+(\\S+)\\s+(about|on|in|to|through|)\\s*(.+)$" first-pass))))
+                          (or
+                           (nth-value 1 (scan-to-strings "^(?i)(direct|tell|show|inform|teach)\\s+(\\S+)\\s+(about|on|in|to|through|)\\s*(.+)$" first-pass)))))
                      (if strings
                          (let ((about (cliki-lookup (elt strings 3) :sender sender
                                                     :channel channel)))
@@ -500,6 +509,8 @@
                    (if (scan "^(?i)version(\\s|!|\\?|\\.|$)*" first-pass)
                        (format nil "This is the minion bot, running on a ~A (~A) and running under ~A ~A." (machine-type) (machine-version) (lisp-implementation-type) (lisp-implementation-version)))
                    (if (scan "^(?i)(?i)do my bidding!*$" first-pass) "Yes, my master.")
+                   (if (scan "^(?i)chant$" first-pass)
+                       (format nil "MORE ~A" *more*))
                    (if (should-do-lookup first-pass (or channel sender ""))
                        (aif (or (small-definition-lookup first-pass)
                                 (cliki-first-sentence first-pass)
@@ -522,6 +533,8 @@
                      (format nil "Sorry, I couldn't find anything in the database for ``~A''.~A" first-pass (if (scan " " first-pass) " Maybe you meant to end with punctuation?" "")))
                    ))))))))
 
+
+
 (defun valid-cliki-message (message)
   (scan *cliki-attention-prefix* (trailing-argument message)))
 
@@ -533,6 +546,7 @@
 	  (scan "^(?i)\\s*(hello|hi|yo)\\s*(channel|room|people|ppl|all|peeps|)\\s*$" string))))
 
 (defun msg-hook (message)
+  (scan-for-more (trailing-argument message))
   (let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message)))))
     (if (valid-cliki-message message)
         (let ((response (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") :sender (source message) :channel (first (irc:arguments message)))))


Index: cl-irc/example/specbot.lisp
diff -u cl-irc/example/specbot.lisp:1.5 cl-irc/example/specbot.lisp:1.6
--- cl-irc/example/specbot.lisp:1.5	Tue Jul 20 12:08:46 2004
+++ cl-irc/example/specbot.lisp	Tue Jul 27 11:47:00 2004
@@ -1,4 +1,4 @@
-;;;; $Id: specbot.lisp,v 1.5 2004/07/20 19:08:46 bmastenbrook Exp $
+;;;; $Id: specbot.lisp,v 1.6 2004/07/27 18:47:00 bmastenbrook Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/specbot.lisp,v $
 
 ;;;; specbot.lisp - an example IRC bot for cl-irc
@@ -65,11 +65,12 @@
 (defvar *alists* nil)
 
 (defun add-simple-alist-lookup (file designator prefix description)
-  (let ((alist (with-open-file (s file :direction :input) (read s))))
-    (pushnew (cons designator alist) *alists* :test #'equal)
-    (setf *spec-providers*
-          (nconc *spec-providers*
-                 (list `((simple-alist-lookup ,designator) ,prefix ,description))))))
+  (unless (assoc designator *alists*)
+    (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*))))
@@ -119,9 +120,17 @@
                          (setf looked-up (format nil "Sorry, I couldn't find anything for ~A."  it)))
                      (and looked-up
                           (privmsg *connection* destination looked-up))))))))
-  
+
+(defparameter *754-file*
+  (merge-pathnames "754.lisp-expr"
+                   (make-pathname
+                    :directory
+                    (pathname-directory
+                     (or *load-truename*
+                         *default-pathname-defaults*)))))
+
 (defun start-specbot (nick server &rest channels)
-  (add-simple-alist-lookup "754.lisp-expr" 'ieee754 "ieee754" "Section numbers of IEEE 754")
+  (add-simple-alist-lookup *754-file* 'ieee754 "ieee754" "Section numbers of IEEE 754")
   (setf *nickname* nick)
   (setf *connection* (connect :nickname *nickname* :server server))
   (mapcar #'(lambda (channel) (join *connection* channel)) channels)





More information about the cl-irc-cvs mailing list