[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp cl-irc/example/specbot.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Tue Jul 20 19:08:47 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:
big changes to cliki-bot: tell users about things, gets mad over abuse
Date: Tue Jul 20 12:08:46 2004
Author: bmastenbrook
Index: cl-irc/example/cliki.lisp
diff -u cl-irc/example/cliki.lisp:1.12 cl-irc/example/cliki.lisp:1.13
--- cl-irc/example/cliki.lisp:1.12 Tue Jul 6 14:30:44 2004
+++ cl-irc/example/cliki.lisp Tue Jul 20 12:08:46 2004
@@ -1,4 +1,4 @@
-;;;; $Id: cliki.lisp,v 1.12 2004/07/06 21:30:44 bmastenbrook Exp $
+;;;; $Id: cliki.lisp,v 1.13 2004/07/20 19:08:46 bmastenbrook Exp $
;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $
;;;; cliki.lisp - CLiki as an infobot; only works on SBCL.
@@ -151,6 +151,19 @@
:contents contents)
*pending-memos*))
+(defun remove-memos (to &key from)
+ (let ((count 0))
+ (setf *pending-memos*
+ (remove-if #'(lambda (m)
+ (and (string-equal (without-non-alphanumeric to)
+ (memo-to m))
+ (or (not from)
+ (string-equal (without-non-alphanumeric from)
+ (memo-from m)))
+ (incf count)))
+ *pending-memos*))
+ count))
+
(defun lookup-paste (number)
(and (find-package :lisppaste)
(let ((paste (funcall (intern "FIND-PASTE" :lisppaste) number)))
@@ -257,6 +270,7 @@
(setf first-line (regex-replace-all "\\r" first-line " "))
(setf first-line (regex-replace-all "\\n" first-line " "))
(setf first-line (regex-replace-all "_\\(([^)]*)\\)" first-line "\\1"))
+ (setf first-line (regex-replace-all "#H\\(([^)]*)\\)" first-line "\\1"))
(setf first-line (regex-replace-all "\\*\\(([^)]*)\\)" first-line "\\1"))
(setf first-line (regex-replace-all "<[^>]+>" first-line ""))
(setf first-line (regex-replace-all "^(([^.]|\\.\\S)+)\\.\\s+.*$" first-line "\\1."))
@@ -301,6 +315,9 @@
("memos" .
,(lambda (nick)
(format nil "To send a memo, say something like ``~A: memo for nick: the memo''. I'll remember the memo for any nick which is the same as the given nick, +/- differences in punctuation, and any nick which is an alias for it, and give it to them when they next speak." nick)))
+ ("avoiding memos" .
+ ,(lambda (nick)
+ (format nil "To flush all your memos without delivery, say something like ``~A: discard my memos''. To flush only memos from a specific person, say ``~A: discard my memos from person''." nick nick)))
("nicknames" .
,(lambda (nick)
(format nil "If you have multiple nicknames and want to get your memos at any of them, say something like ``~A: nick1 is another nick for nick2''. If you decide to give up a nick, say ``~:*~A: forget nick2'' and I'll forget it." nick)))
@@ -326,94 +343,185 @@
(cliki-find-help (concatenate 'string string
(string #\s))))))))
+(defun random-element (list)
+ (elt list (random (length list))))
+
+(defparameter *last-eliza-times* (make-list 6 :initial-element 0))
+
+(defparameter *last-warning-time* 0)
+
+(defun do-eliza (first-pass)
+ (if (> (- (get-universal-time) 30)
+ *last-warning-time*)
+ (let ((time-6 (first *last-eliza-times*))
+ (time-4 (third *last-eliza-times*))
+ (time-2 (fifth *last-eliza-times*))
+ (current-time (get-universal-time))
+ (count 0)
+ (overload 0))
+ (if (or
+ (and
+ (< (- current-time 15)
+ time-2)
+ (setf count 3)
+ (setf overload (- current-time time-2)))
+ (and
+ (< (- current-time 45)
+ time-4)
+ (setf count 5)
+ (setf overload (- current-time time-4)))
+ (and
+ (< (- current-time 75)
+ time-6)
+ (setf count 7)
+ (setf overload (- current-time time-6))))
+ (progn
+ (setf *last-warning-time* (get-universal-time))
+ (format nil "Would you /please/ stop playing with me? ~A messages in ~A seconds is too many." count overload))
+ (progn
+ (setf *last-eliza-times* (nconc (cdr *last-eliza-times*)
+ (list (get-universal-time))))
+ (ignore-errors (eliza::eliza first-pass)))
+
+ ))))
+
(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))
(setf first-pass (regex-replace-all "\\s\\s+" first-pass ""))
(setf first-pass (regex-replace-all "\\s*$" first-pass ""))
(let ((scanned (or (nth-value 1 (scan-to-strings "^add\\s+\"([^\"]+)\"\\s+as:*\\s+(.+)$" first-pass))
- (nth-value 1 (scan-to-strings "^add\\s+(.+)\\s+as:*\\s+(.+)$" first-pass)))))
+ (nth-value 1 (scan-to-strings "^add\\s+(.+)\\s+as:*\\s+(.+)$" first-pass)))))
(if scanned
(let ((term (elt scanned 0))
(defn (elt scanned 1)))
(add-small-definition term defn)
"OK, done.")
- (let ((scanned (or
- (nth-value 1 (scan-to-strings "^alias\\s+\"([^\"]+)\"\\s+as:*\\s+(.+)$" first-pass))
- (nth-value 1 (scan-to-strings "^alias\\s+(.+)\\s+as:*\\s+(.+)$" first-pass))
- (nth-value 1 (scan-to-strings "^(.+)\\s+is\\s+another\\s+(name|word)\\s+for:*\\s+([^.]+)\\.*$" first-pass)))))
- (if scanned
- (let ((term (elt scanned 0))
- (defn (elt scanned (1- (length scanned)))))
- (add-alias term defn)
- "OK, done.")
- (progn
- (setf first-pass (regex-replace-all "(:|/|\\\\|\\#)" first-pass ""))
- (when (and (scan "^(?i)lisppaste(\\s|!|\\?|\\.|$)*" first-pass)
- (find-package :lisppaste)
- channel
- (> (length channel) 0)
- (char= (elt channel 0) #\#)
- (funcall (intern "SAY-HELP" :lisppaste)
- channel))
- (return-from cliki-lookup nil))
-
- (or
- (if (string-equal first-pass "help")
- (cliki-bot-help *cliki-nickname*))
- (let ((strings (nth-value 1 (scan-to-strings "^(?i)help\\s\"*([^\"]+)\"*$" first-pass))))
- (when strings
- (cliki-find-help (elt strings 0))))
- (let ((strings (nth-value 1 (scan-to-strings "^(?i)(memo|note)\\s+(for|to)\\s+(\\S+)\\s*[:,]+\\s+(.+)$" term-with-question))))
- (when (and sender strings)
- (if (string-equal (without-non-alphanumeric
- (elt strings 2))
- (without-non-alphanumeric
- *cliki-nickname*))
- "Buzz off."
- (progn
- (add-memo
- sender
- (if (member (elt strings 2) '("self" "myself" "me") :test #'string-equal)
- sender
- (elt strings 2))
- (elt strings 3))
- (format nil "Remembered. I'll tell ~A when he/she/it next speaks." (elt strings 2))))))
- (let ((to-forget (nth-value 1 (scan-to-strings "^forget\\s+([^.]+)\\.*$" first-pass))))
- (when to-forget
- (forget (elt to-forget 0))
- (format nil "What's ~A? Never heard of it." (elt to-forget 0))))
- (let ((strs (nth-value 1 (scan-to-strings "^(?i)paste\\s+(\\d+)$" first-pass))))
- (and strs
- (lookup-paste (parse-integer (elt strs 0)))))
- (if (scan "^(?i)hello(\\s|$)*" first-pass) "what's up?")
- (if (scan "^(?i)hi(\\s|$)*" first-pass) "what's up?")
- (if (scan "^(?i)yo(\\s|$)*" first-pass) "what's up?")
- (if (scan "^(?i)thank(s| you)(\\s|!|\\?|\\.|$)*" first-pass)
- (if sender
- (format nil "~A: you failed the inverse turing test!" sender)
- "you failed the inverse turing test!"))
- (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 (should-do-lookup first-pass (or channel sender ""))
- (aif (or (small-definition-lookup first-pass)
- (cliki-first-sentence first-pass)
- (alias-lookup first-pass))
- (prog1
- (concatenate 'string first-pass ": " it)
- (did-lookup first-pass (or channel sender ""))))
- (setf should-send-cant-find nil))
- (if (or
- (scan "(!|\\.|\\s.+\\?|\\)|\\()\\s*$" term-with-question)
- (scan "^\\s*\\S+\\s+\\S+.*$" term-with-question))
- ;;(generate-text (+ 20 (random 6)))
- (ignore-errors (eliza::eliza first-pass))
- )
- (when should-send-cant-find
- (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?" "")))
- ))))))))
-
+ (let ((scanned (or
+ (nth-value 1 (scan-to-strings "^alias\\s+\"([^\"]+)\"\\s+as:*\\s+(.+)$" first-pass))
+ (nth-value 1 (scan-to-strings "^alias\\s+(.+)\\s+as:*\\s+(.+)$" first-pass))
+ (nth-value 1 (scan-to-strings "^(.+)\\s+is\\s+another\\s+(name|word)\\s+for:*\\s+([^.]+)\\.*$" first-pass)))))
+ (if scanned
+ (let ((term (elt scanned 0))
+ (defn (elt scanned (1- (length scanned)))))
+ (add-alias term defn)
+ "OK, done.")
+ (progn
+ (setf first-pass (regex-replace-all "(:|/|\\\\|\\#)" first-pass ""))
+ (when (and (scan "^(?i)lisppaste(\\s|!|\\?|\\.|$)*" first-pass)
+ (find-package :lisppaste)
+ channel
+ (> (length channel) 0)
+ (char= (elt channel 0) #\#)
+ (funcall (intern "SAY-HELP" :lisppaste)
+ channel))
+ (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))))
+ (if strings
+ (let ((about (cliki-lookup (elt strings 3) :sender sender
+ :channel channel)))
+ (if about
+ (format nil "~A: ~A~A"
+ (elt strings 1)
+ (if (scan "http:" about)
+ (concatenate 'string
+ (random-element
+ '("have a look at"
+ "please look at"
+ "please see"
+ "direct your attention towards"
+ "look at"))
+ " ")
+ "")
+ about)
+ (setf should-send-cant-find nil)))))
+ (if (string-equal first-pass "help")
+ (if (should-do-lookup first-pass (or channel sender ""))
+ (progn
+ (did-lookup first-pass (or channel sender ""))
+ (cliki-bot-help *cliki-nickname*))
+ (setf should-send-cant-find nil)))
+ (let ((strings (nth-value 1 (scan-to-strings "^(?i)help\\s+(on|about|to|describing|)\\s*\"*([^\"]+)\"*$" first-pass))))
+ (if strings
+ (if
+ (should-do-lookup first-pass (or channel sender ""))
+ (progn
+ (did-lookup first-pass (or channel sender ""))
+ (cliki-find-help (elt strings 1)))
+ (setf should-send-cant-find nil))))
+ (let ((strings (nth-value 1 (scan-to-strings "^(?i)(memo|note)\\s+(for|to)\\s+(\\S+)\\s*[:,]+\\s+(.+)$" term-with-question))))
+ (when (and sender strings)
+ (if (string-equal (without-non-alphanumeric
+ (elt strings 2))
+ (without-non-alphanumeric
+ *cliki-nickname*))
+ "Buzz off."
+ (progn
+ (add-memo
+ sender
+ (if (member (elt strings 2) '("self" "myself" "me") :test #'string-equal)
+ sender
+ (elt strings 2))
+ (elt strings 3))
+ (format nil "Remembered. I'll tell ~A when he/she/it next speaks." (elt strings 2))))))
+ (when (and sender
+ (scan "^(?i)(discard|forget)\\s+(my\\s+|)memo(s|)$" first-pass))
+ (let ((count (remove-memos sender)))
+ (case count
+ (0 "You didn't have any memos!")
+ (1 "OK, I threw it out.")
+ (t "OK, I threw them out."))))
+ (let ((strings (nth-value 1 (scan-to-strings "^(?i)(discard|forget)\\s+(my\\s+|)memo(s|)\\s+from\\s+([^ .]+)\\.*$" first-pass))))
+ (when (and sender
+ strings)
+ (let ((count (remove-memos sender :from (elt strings 3))))
+ (case count
+ (0 "You didn't have any memos!")
+ (1 "OK, I threw it out.")
+ (t "OK, I threw them out.")))
+ ))
+ (let ((to-forget (nth-value 1 (scan-to-strings "^forget\\s+([^.]+)\\.*$" first-pass))))
+ (when to-forget
+ (forget (elt to-forget 0))
+ (format nil "What's ~A? Never heard of it." (elt to-forget 0))))
+ (let ((strs (nth-value 1 (scan-to-strings "^(?i)paste\\s+(\\d+)$" first-pass))))
+ (and strs
+ (lookup-paste (parse-integer (elt strs 0)))))
+
+ (if (scan "^(?i)hello(\\s|$)*" first-pass) "what's up?")
+ (if (scan "^(?i)hi(\\s|$)*" first-pass) "what's up?")
+ (if (scan "^(?i)yo(\\s|$)*" first-pass) "what's up?")
+ (if (scan "^(?i)thank(s| you)(\\s|!|\\?|\\.|$)*" first-pass)
+ (if sender
+ (format nil "~A: you failed the inverse turing test!" sender)
+ "you failed the inverse turing test!"))
+ (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 (should-do-lookup first-pass (or channel sender ""))
+ (aif (or (small-definition-lookup first-pass)
+ (cliki-first-sentence first-pass)
+ (alias-lookup first-pass))
+ (prog1
+ (concatenate 'string first-pass ": " it)
+ (did-lookup first-pass (or channel sender ""))))
+ (setf should-send-cant-find nil))
+ (if (and
+ should-send-cant-find
+ (or
+ (scan "(!|\\.|\\s.+\\?|\\)|\\()\\s*$" term-with-question)
+ (scan "^\\s*\\S+\\s+\\S+.*$" term-with-question)))
+ ;;(generate-text (+ 20 (random 6)))
+ (progn
+ (setf should-send-cant-find nil)
+ (do-eliza first-pass))
+ )
+ (when should-send-cant-find
+ (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)))
@@ -426,7 +534,6 @@
(defun msg-hook (message)
(let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message)))))
- (take-care-of-memos respond-to (source 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)))))
(and response (privmsg *cliki-connection* respond-to response)))
@@ -434,7 +541,8 @@
(aif (cliki-lookup (trailing-argument message) :sender (source message))
(privmsg *cliki-connection* respond-to it))
(if (anybody-here (trailing-argument message))
- (privmsg *cliki-connection* (first (arguments message)) (format nil "~A: hello." (source message))))))))
+ (privmsg *cliki-connection* (first (arguments message)) (format nil "~A: hello." (source message))))))
+ (take-care-of-memos respond-to (source message))))
(defvar *cliki-nickserv-password* "")
Index: cl-irc/example/specbot.lisp
diff -u cl-irc/example/specbot.lisp:1.4 cl-irc/example/specbot.lisp:1.5
--- cl-irc/example/specbot.lisp:1.4 Fri Jul 9 09:03:35 2004
+++ cl-irc/example/specbot.lisp Tue Jul 20 12:08:46 2004
@@ -1,4 +1,4 @@
-;;;; $Id: specbot.lisp,v 1.4 2004/07/09 16:03:35 bmastenbrook Exp $
+;;;; $Id: specbot.lisp,v 1.5 2004/07/20 19:08:46 bmastenbrook Exp $
;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/specbot.lisp,v $
;;;; specbot.lisp - an example IRC bot for cl-irc
@@ -66,7 +66,7 @@
(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*)
+ (pushnew (cons designator alist) *alists* :test #'equal)
(setf *spec-providers*
(nconc *spec-providers*
(list `((simple-alist-lookup ,designator) ,prefix ,description))))))
@@ -114,7 +114,7 @@
do
(aif (strip-address to-lookup :address (second type) :final t)
(let ((looked-up (funcall actual-fun it)))
- (if (and (< 0 (count #\space it) 3)
+ (if (and (<= 0 (count #\space it) 1)
(not looked-up))
(setf looked-up (format nil "Sorry, I couldn't find anything for ~A." it)))
(and looked-up
More information about the cl-irc-cvs
mailing list