[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