July 2004 - cl-irc-cvs@common-lisp.net - mailman3.common-lisp.net

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by Brian Mastenbrook 28 Jul '04

28 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: cliki.lisp Log Message: MORE GRAMMAR Date: Wed Jul 28 08:45:42 2004 Author: bmastenbrook Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.20 cl-irc/example/cliki.lisp:1.21 --- cl-irc/example/cliki.lisp:1.20 Wed Jul 28 07:36:25 2004 +++ cl-irc/example/cliki.lisp Wed Jul 28 08:45:42 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.20 2004/07/28 14:36:25 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.21 2004/07/28 15:45:42 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -477,7 +477,7 @@ (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")) + (setf first-pass (regex-replace-all "^(?i)please(,|)\\s*(.*[^, ])$" first-pass "\\2")) (when (and (scan "^(?i)lisppaste(\\s|!|\\?|\\.|$)*" first-pass) (find-package :lisppaste) channel @@ -490,7 +490,7 @@ (let ((strings (or (aif - (nth-value 1 (scan-to-strings "^(?i)(direct|tell|show|inform|teach)\\s+(\\S+)\\s+(about|on|in|to|through|for|)\\s*(.+)$" first-pass)) + (nth-value 1 (scan-to-strings "^(?i)(direct|tell|show|inform|teach|give)\\s+(\\S+)\\s+(about|on|in|to|through|for|some|)\\s*(.+)$" first-pass)) (cons :forward it)) (aif (nth-value 1 (scan-to-strings "^(?i)(look\\s+up\\s+|)\\s*(.+)\\s+(for|to|at)\\s+(\\S+)$" first-pass)) @@ -597,16 +597,16 @@ (or sender channel "you") (elt str 1)) (random-advice)))) - (let ((str (nth-value 1 (scan-to-strings "^(?i)advi[cs]e\\s+(for\\s+|)(\\S+)\\s+(on|about)\\s+(.+)$" first-pass)))) + (let ((str (nth-value 1 (scan-to-strings "^(?i)(any\\s+|some\\s+|)advi[cs]e\\s+(for\\s+|)(\\S+)\\s+(on|about)\\s+(.+)$" first-pass)))) (and str (format nil "~A: ~A" - (if (string-equal (elt str 1) "me") + (if (string-equal (elt str 2) "me") (or sender channel "you") - (elt str 1)) - (search-advice (elt str 3))))) - (let ((str (nth-value 1 (scan-to-strings "^(?i)advi[cs]e\\s+(on|about)\\s+(.+)$" first-pass)))) + (elt str 2)) + (search-advice (elt str 4))))) + (let ((str (nth-value 1 (scan-to-strings "^(?i)(any\\s+|some\\s+|)advi[cs]e\\s+(on|about)\\s+(.+)$" first-pass)))) (and str - (search-advice (elt str 1)))) + (search-advice (elt str 2)))) (let ((str (nth-value 1 (scan-to-strings "^(?i)advice\\W+(\\d+)$" first-pass)))) (and str (lookup-advice (elt str 0))))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by Brian Mastenbrook 28 Jul '04

28 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: cliki.lisp Log Message: BUGS Date: Wed Jul 28 07:36:25 2004 Author: bmastenbrook Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.19 cl-irc/example/cliki.lisp:1.20 --- cl-irc/example/cliki.lisp:1.19 Wed Jul 28 07:34:46 2004 +++ cl-irc/example/cliki.lisp Wed Jul 28 07:36:25 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.19 2004/07/28 14:34:46 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.20 2004/07/28 14:36:25 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -504,7 +504,8 @@ (:forward (elt (cdr strings) 1)) (:backward (elt (cdr strings) 3)))) (person (if (string-equal person "me") - (or sender channel "you"))) + (or sender channel "you") + person)) (about (cliki-lookup term :sender sender :channel channel))) (if about

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by Brian Mastenbrook 28 Jul '04

28 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: cliki.lisp Log Message: MORE GRAMMAR Date: Wed Jul 28 07:34:46 2004 Author: bmastenbrook Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.18 cl-irc/example/cliki.lisp:1.19 --- cl-irc/example/cliki.lisp:1.18 Wed Jul 28 07:15:22 2004 +++ cl-irc/example/cliki.lisp Wed Jul 28 07:34:46 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.18 2004/07/28 14:15:22 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.19 2004/07/28 14:34:46 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -179,7 +179,7 @@ (when (not *advice-db*) (with-open-file (ad *advice-file* :direction :input) (setf *advice-db* (read ad)))) - (or (cddr (assoc num *advice-db*)) + (or (cdr (assoc num *advice-db*)) "You can't just make up advice numbers and expect a response."))) (defun random-advice () @@ -503,6 +503,8 @@ (person (case (car strings) (:forward (elt (cdr strings) 1)) (:backward (elt (cdr strings) 3)))) + (person (if (string-equal person "me") + (or sender channel "you"))) (about (cliki-lookup term :sender sender :channel channel))) (if about @@ -587,15 +589,20 @@ (format nil "MORE ~A" *more*)) (if (scan "^(?i)advice$" first-pass) (random-advice)) - (let ((str (nth-value 1 (scan-to-strings "^(?i)advise\\s+(\\S+)$" first-pass)))) + (let ((str (nth-value 1 (scan-to-strings "^(?i)advise\\s+(for\\s+|)(\\S+)$" first-pass)))) (and str - (format nil "~A: ~A" (elt str 0) + (format nil "~A: ~A" + (if (string-equal (elt str 1) "me") + (or sender channel "you") + (elt str 1)) (random-advice)))) - (let ((str (nth-value 1 (scan-to-strings "^(?i)advi[cs]e\\s+(\\S+)\\s+(on|about)\\s+(.+)$" first-pass)))) + (let ((str (nth-value 1 (scan-to-strings "^(?i)advi[cs]e\\s+(for\\s+|)(\\S+)\\s+(on|about)\\s+(.+)$" first-pass)))) (and str (format nil "~A: ~A" - (elt str 0) - (search-advice (elt str 2))))) + (if (string-equal (elt str 1) "me") + (or sender channel "you") + (elt str 1)) + (search-advice (elt str 3))))) (let ((str (nth-value 1 (scan-to-strings "^(?i)advi[cs]e\\s+(on|about)\\s+(.+)$" first-pass)))) (and str (search-advice (elt str 1)))) @@ -637,17 +644,22 @@ (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 (ignore-errors (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))) - (if (string-equal (first (arguments message)) *cliki-nickname*) - (aif (ignore-errors (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)))))) - (take-care-of-memos respond-to (source message)))) + (handler-case + (progn + (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))))) + (and response (privmsg *cliki-connection* respond-to response))) + (if (string-equal (first (arguments message)) *cliki-nickname*) + (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)))))) + (take-care-of-memos respond-to (source message)))) + (serious-condition (c) + (format *trace-output* "Caught error: ~A~%" c) + #+sbcl (sb-debug:backtrace 5 *trace-output*)))) (defvar *cliki-nickserv-password* "")

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by Brian Mastenbrook 28 Jul '04

28 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: cliki.lisp Log Message: MORE GRAMMAR Date: Wed Jul 28 07:15:22 2004 Author: bmastenbrook Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.17 cl-irc/example/cliki.lisp:1.18 --- cl-irc/example/cliki.lisp:1.17 Tue Jul 27 13:51:56 2004 +++ cl-irc/example/cliki.lisp Wed Jul 28 07:15:22 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.17 2004/07/27 20:51:56 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.18 2004/07/28 14:15:22 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -191,15 +191,17 @@ (setf str (regex-replace-all "[^a-zA-Z0-9 ]" str "")) (let* ((terms (split-sequence #\space str)) (terms (mapcar #'(lambda (e) - (regex-replace-all "^(.+)s$" e "\\1")) terms)) - (terms (mapcar #'(lambda (e) - (regex-replace-all "^(.+)ing$" e "\\1")) terms)) + (loop for r = (regex-replace-all "^(.+)(ness|ing|ation|ion|ly)$" e "\\1") + if (equal e r) return r + do (setf e r) + )) terms)) (terms (mapcar #'(lambda (e) - (regex-replace-all "^(.+)ation$" e "\\1")) terms)) + (regex-replace-all "^(.+)([a-zA-Z])\\2+$" e "\\1\\2")) terms)) (terms (mapcar #'(lambda (e) - (regex-replace-all "^(.+)ion$" e "\\1")) terms)) - (max-score 0) - (max-score-items nil)) + (regex-replace-all "^(.+)s$" e "\\1")) terms)) + (max-score 0) + (max-score-items nil)) + ;;(format t "terms is ~S~%" terms) (mapc #'(lambda (e) (let ((score (loop for i in terms @@ -589,6 +591,11 @@ (and str (format nil "~A: ~A" (elt str 0) (random-advice)))) + (let ((str (nth-value 1 (scan-to-strings "^(?i)advi[cs]e\\s+(\\S+)\\s+(on|about)\\s+(.+)$" first-pass)))) + (and str + (format nil "~A: ~A" + (elt str 0) + (search-advice (elt str 2))))) (let ((str (nth-value 1 (scan-to-strings "^(?i)advi[cs]e\\s+(on|about)\\s+(.+)$" first-pass)))) (and str (search-advice (elt str 1)))) @@ -633,10 +640,10 @@ (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))))) + (let ((response (ignore-errors (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))) (if (string-equal (first (arguments message)) *cliki-nickname*) - (aif (cliki-lookup (trailing-argument message) :sender (source message)) + (aif (ignore-errors (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))))))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by Brian Mastenbrook 27 Jul '04

27 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: cliki.lisp Log Message: Remove a temp function Date: Tue Jul 27 13:51:56 2004 Author: bmastenbrook Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.16 cl-irc/example/cliki.lisp:1.17 --- cl-irc/example/cliki.lisp:1.16 Tue Jul 27 13:51:24 2004 +++ cl-irc/example/cliki.lisp Tue Jul 27 13:51:56 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.16 2004/07/27 20:51:24 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.17 2004/07/27 20:51:56 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -181,11 +181,6 @@ (setf *advice-db* (read ad)))) (or (cddr (assoc num *advice-db*)) "You can't just make up advice numbers and expect a response."))) - -(defun fix-advice () - (mapc #'(lambda (e) - (setf (cdr e) - (cddr e))) *advice-db*)) (defun random-advice () (let ((item (random-element *advice-db*)))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by Brian Mastenbrook 27 Jul '04

27 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: cliki.lisp Log Message: Dunno. Some changes. Date: Tue Jul 27 13:51:25 2004 Author: bmastenbrook Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.15 cl-irc/example/cliki.lisp:1.16 --- cl-irc/example/cliki.lisp:1.15 Tue Jul 27 13:39:42 2004 +++ cl-irc/example/cliki.lisp Tue Jul 27 13:51:24 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.15 2004/07/27 20:39:42 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.16 2004/07/27 20:51:24 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -594,7 +594,7 @@ (and str (format nil "~A: ~A" (elt str 0) (random-advice)))) - (let ((str (nth-value 1 (scan-to-strings "^(?i)advice\\s+(on|about)\\s+(.+)$" first-pass)))) + (let ((str (nth-value 1 (scan-to-strings "^(?i)advi[cs]e\\s+(on|about)\\s+(.+)$" first-pass)))) (and str (search-advice (elt str 1)))) (let ((str (nth-value 1 (scan-to-strings "^(?i)advice\\W+(\\d+)$" first-pass))))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/advice cl-irc/example/cliki-bot.asd cl-irc/example/cliki.lisp
by Brian Mastenbrook 27 Jul '04

27 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: cliki-bot.asd cliki.lisp Added Files: advice Log Message: Advice! Date: Tue Jul 27 13:39:42 2004 Author: bmastenbrook Index: cl-irc/example/cliki-bot.asd diff -u cl-irc/example/cliki-bot.asd:1.2 cl-irc/example/cliki-bot.asd:1.3 --- cl-irc/example/cliki-bot.asd:1.2 Tue Jun 1 06:48:12 2004 +++ cl-irc/example/cliki-bot.asd Tue Jul 27 13:39:42 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki-bot.asd,v 1.2 2004/06/01 13:48:12 bmastenbrook Exp $ +;;;; $Id: cliki-bot.asd,v 1.3 2004/07/27 20:39:42 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki-bot.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -17,9 +17,9 @@ :licence "MIT" :description "IRC bot for SBCL" :depends-on - (:cl-irc :cl-ppcre) + (:cl-irc :cl-ppcre :split-sequence) :properties ((#:author-email . "cl-irc-devel(a)common-lisp.net") - (#:date . "$Date: 2004/06/01 13:48:12 $") + (#:date . "$Date: 2004/07/27 20:39:42 $") ((#:albert #:output-dir) . "doc/api-doc/") ((#:albert #:formats) . ("docbook")) ((#:albert #:docbook #:template) . "book") Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.14 cl-irc/example/cliki.lisp:1.15 --- cl-irc/example/cliki.lisp:1.14 Tue Jul 27 11:47:00 2004 +++ cl-irc/example/cliki.lisp Tue Jul 27 13:39:42 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.14 2004/07/27 18:47:00 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.15 2004/07/27 20:39:42 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -7,7 +7,7 @@ ;;; cliki.lisp, and invoke (cliki::start-cliki-bot "desirednickname" ;;; "desiredserver" "#channel1" "#channel2" "#channel3" ...) -(defpackage :cliki (:use :common-lisp :irc :cl-ppcre) +(defpackage :cliki (:use :common-lisp :irc :cl-ppcre :split-sequence) (:export :start-cliki-bot :*cliki-nickserv-password* :*respond-to-general-hellos* :shut-up :un-shut-up)) (in-package :cliki) @@ -164,6 +164,65 @@ *pending-memos*)) count)) +(defparameter *advice-file* + (merge-pathnames "advice" + (make-pathname + :directory + (pathname-directory + (or *load-truename* + *default-pathname-defaults*))))) + +(defvar *advice-db* nil) + +(defun lookup-advice (num-str) + (let ((num (parse-integer num-str :junk-allowed t))) + (when (not *advice-db*) + (with-open-file (ad *advice-file* :direction :input) + (setf *advice-db* (read ad)))) + (or (cddr (assoc num *advice-db*)) + "You can't just make up advice numbers and expect a response."))) + +(defun fix-advice () + (mapc #'(lambda (e) + (setf (cdr e) + (cddr e))) *advice-db*)) + +(defun random-advice () + (let ((item (random-element *advice-db*))) + (format nil "#~A: ~A" (car item) (cdr item)))) + +(defun search-advice (str) + (setf str (regex-replace-all "\\s+" str " ")) + (setf str (regex-replace-all "[^a-zA-Z0-9 ]" str "")) + (let* ((terms (split-sequence #\space str)) + (terms (mapcar #'(lambda (e) + (regex-replace-all "^(.+)s$" e "\\1")) terms)) + (terms (mapcar #'(lambda (e) + (regex-replace-all "^(.+)ing$" e "\\1")) terms)) + (terms (mapcar #'(lambda (e) + (regex-replace-all "^(.+)ation$" e "\\1")) terms)) + (terms (mapcar #'(lambda (e) + (regex-replace-all "^(.+)ion$" e "\\1")) terms)) + (max-score 0) + (max-score-items nil)) + (mapc #'(lambda (e) + (let ((score + (loop for i in terms + if (search i (cdr e) :test #'char-equal) + count it))) + (if (> score max-score) + (progn + (setf max-score score) + (setf max-score-items (list e))) + (if (and (not (zerop score)) + (eql score max-score)) + (push e max-score-items))))) + *advice-db*) + (if (zerop max-score) + "You can't expect automated advice for everything." + (let ((item (random-element max-score-items))) + (format nil "#~A: ~A" (car item) (cdr item)))))) + (defun lookup-paste (number) (and (find-package :lisppaste) (let ((paste (funcall (intern "FIND-PASTE" :lisppaste) number))) @@ -303,6 +362,9 @@ (defparameter *help-text* `(("lookups" . ,(lambda (nick) (format nil "To look up a term, say something like ``~A: term?''. I will either return a definition for the term or say that it could not be found. Lookups check the internal database first and then try to retrieve the first sentence of the page named like that on CLiki." nick))) + ("helping others" . + ,(lambda (nick) + (format nil "I can tell another user about something if you address me like ``~A: show some-user something else''. I respond to a lot of different ways of asking for this, and you can have me show pretty much anything to another user." nick))) ("adding terms" . ,(lambda (nick) (format nil "To add a term, say something like ``~A: add \"term\" as: the definition''. I will remember the definition." nick))) @@ -327,7 +389,10 @@ ("eliza" . ,(lambda (nick) (declare (ignore nick)) - (format nil "If you say multiple words to me which I don't recognize and it's not found as a lookup, you might get a sarcastic reply. Don't abuse this too much."))))) + (format nil "If you say multiple words to me which I don't recognize and it's not found as a lookup, you might get a sarcastic reply. Don't abuse this too much."))) + ("advice" . + ,(lambda (nick) + (format nil "Try saying something like ``~A: advice #11904'' to get some advice." nick))))) (defun cliki-bot-help (nick) (format nil "There are multiple help modules. Try ``/msg ~A help kind'', where kind is one of: ~{\"~A\"~^, ~}." @@ -427,13 +492,25 @@ (or (let ((strings (or - (nth-value 1 (scan-to-strings "^(?i)(direct|tell|show|inform|teach)\\s+(\\S+)\\s+(about|on|in|to|through|)\\s*(.+)$" first-pass))))) + (aif + (nth-value 1 (scan-to-strings "^(?i)(direct|tell|show|inform|teach)\\s+(\\S+)\\s+(about|on|in|to|through|for|)\\s*(.+)$" first-pass)) + (cons :forward it)) + (aif + (nth-value 1 (scan-to-strings "^(?i)(look\\s+up\\s+|)\\s*(.+)\\s+(for|to|at)\\s+(\\S+)$" first-pass)) + (cons :backward it)) + ))) (if strings - (let ((about (cliki-lookup (elt strings 3) :sender sender + (let* ((term (case (car strings) + (:forward (elt (cdr strings) 3)) + (:backward (elt (cdr strings) 1)))) + (person (case (car strings) + (:forward (elt (cdr strings) 1)) + (:backward (elt (cdr strings) 3)))) + (about (cliki-lookup term :sender sender :channel channel))) (if about (format nil "~A: ~A~A" - (elt strings 1) + person (if (scan "http:" about) (concatenate 'string (random-element @@ -511,6 +588,18 @@ (if (scan "^(?i)(?i)do my bidding!*$" first-pass) "Yes, my master.") (if (scan "^(?i)chant$" first-pass) (format nil "MORE ~A" *more*)) + (if (scan "^(?i)advice$" first-pass) + (random-advice)) + (let ((str (nth-value 1 (scan-to-strings "^(?i)advise\\s+(\\S+)$" first-pass)))) + (and str + (format nil "~A: ~A" (elt str 0) + (random-advice)))) + (let ((str (nth-value 1 (scan-to-strings "^(?i)advice\\s+(on|about)\\s+(.+)$" first-pass)))) + (and str + (search-advice (elt str 1)))) + (let ((str (nth-value 1 (scan-to-strings "^(?i)advice\\W+(\\d+)$" first-pass)))) + (and str + (lookup-advice (elt str 0)))) (if (should-do-lookup first-pass (or channel sender "")) (aif (or (small-definition-lookup first-pass) (cliki-first-sentence first-pass)

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp cl-irc/example/specbot.lisp
by Brian Mastenbrook 27 Jul '04

27 Jul '04

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)

1 0

[Cl-irc-cvs] CVS update: cl-irc/command.lisp
by Brian Mastenbrook 27 Jul '04

27 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/home/bmastenbrook/cl-irc Modified Files: command.lisp Log Message: Don't remember Date: Tue Jul 27 11:46:53 2004 Author: bmastenbrook Index: cl-irc/command.lisp diff -u cl-irc/command.lisp:1.5 cl-irc/command.lisp:1.6 --- cl-irc/command.lisp:1.5 Wed Jun 9 11:54:25 2004 +++ cl-irc/command.lisp Tue Jul 27 11:46:53 2004 @@ -1,4 +1,4 @@ -;;;; $Id: command.lisp,v 1.5 2004/06/09 18:54:25 bmastenbrook Exp $ +;;;; $Id: command.lisp,v 1.6 2004/07/27 18:46:53 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/command.lisp,v $ ;;;; See LICENSE for licensing information. @@ -249,11 +249,13 @@ (defun socket-stream (socket) #+sbcl - (sb-bsd-sockets:socket-make-stream socket - :element-type 'character - :input t - :output t - :buffering :none) + (values + (sb-bsd-sockets:socket-make-stream socket + :element-type 'character + :input t + :output t + :buffering :none) + socket) #+openmcl socket) @@ -277,18 +279,20 @@ (port *default-irc-server-port*) (logging-stream t)) "Connect to server and return a connection object." - (let* ((stream (socket-connect server port)) - (user (make-user :nickname nickname - :username username - :realname realname)) - (connection (make-connection :server-stream stream - :client-stream logging-stream - :user user - :server-name server))) + (multiple-value-bind (stream socket) + (socket-connect server port) + (let* ((user (make-user :nickname nickname + :username username + :realname realname)) + (connection (make-connection :server-stream stream + :server-socket socket + :client-stream logging-stream + :user user + :server-name server))) (nick connection nickname) (user- connection (or username nickname) mode (or realname nickname)) (add-default-hooks connection) - connection)) + connection))) (defmethod trace- ((connection connection) &optional (target "")) (send-irc-message connection :trace nil target))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/eliza-rules.lisp
by Brian Mastenbrook 20 Jul '04

20 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: eliza-rules.lisp Log Message: add inscruitable song reference requested by nyef Date: Tue Jul 20 12:18:43 2004 Author: bmastenbrook Index: cl-irc/example/eliza-rules.lisp diff -u cl-irc/example/eliza-rules.lisp:1.5 cl-irc/example/eliza-rules.lisp:1.6 --- cl-irc/example/eliza-rules.lisp:1.5 Tue Jul 6 14:30:44 2004 +++ cl-irc/example/eliza-rules.lisp Tue Jul 20 12:18:43 2004 @@ -20,7 +20,27 @@ ((more (?* ?x)) (?x me harder)) - + + ((what s the difference between (?* ?x) and (?* ?y)) + (?x has similar features but longer hair) + (?y has similar features but longer hair)) + + ((what are the differences between (?* ?x) and (?* ?y)) + (?x has similar features but longer hair) + (?y has similar features but longer hair)) + + ((what is the difference between (?* ?x) and (?* ?y)) + (?x has similar features but longer hair) + (?y has similar features but longer hair)) + + ((the difference between (?* ?x) and (?* ?y)) + (?x has similar features but longer hair) + (?y has similar features but longer hair)) + + ((the differences between (?* ?x) and (?* ?y)) + (?x has similar features but longer hair) + (?y has similar features but longer hair)) + (((?* ?x) you (?* ?y) written (?* ?z)) (|I'm| written in Common Lisp))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp cl-irc/example/specbot.lisp
by Brian Mastenbrook 20 Jul '04

20 Jul '04

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

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/clim-lookup.lisp cl-irc/example/mrindex
by Brian Mastenbrook 09 Jul '04

09 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Added Files: clim-lookup.lisp mrindex Log Message: CLIM spec lookup Date: Fri Jul 9 09:03:47 2004 Author: bmastenbrook

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/specbot.lisp
by Brian Mastenbrook 09 Jul '04

09 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: specbot.lisp Log Message: CLIM spec lookup Date: Fri Jul 9 09:03:35 2004 Author: bmastenbrook Index: cl-irc/example/specbot.lisp diff -u cl-irc/example/specbot.lisp:1.3 cl-irc/example/specbot.lisp:1.4 --- cl-irc/example/specbot.lisp:1.3 Thu Jun 17 10:40:35 2004 +++ cl-irc/example/specbot.lisp Fri Jul 9 09:03:35 2004 @@ -1,4 +1,4 @@ -;;;; $Id: specbot.lisp,v 1.3 2004/06/17 17:40:35 bmastenbrook Exp $ +;;;; $Id: specbot.lisp,v 1.4 2004/07/09 16:03:35 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/specbot.lisp,v $ ;;;; specbot.lisp - an example IRC bot for cl-irc @@ -37,30 +37,30 @@ ,else)))) (defun clhs-lookup (str) - (aif (and (find-package :clhs-lookup) - (funcall (intern "SPEC-LOOKUP" :clhs-lookup) - str)) - it - (format nil "Nothing was found for: ~A" str))) + (and (find-package :clhs-lookup) + (funcall (intern "SPEC-LOOKUP" :clhs-lookup) + str))) (defun r5rs-lookup (str) - (aif (and (find-package :r5rs-lookup) - (funcall (intern "SYMBOL-LOOKUP" :r5rs-lookup) - str)) - it - (format nil "Nothing was found for: ~A" str))) + (and (find-package :r5rs-lookup) + (funcall (intern "SYMBOL-LOOKUP" :r5rs-lookup) + str))) (defun elisp-lookup (str) - (aif (and (find-package :elisp-lookup) - (funcall (intern "SYMBOL-LOOKUP" :elisp-lookup) - str)) - it - (format nil "Nothing was found for: ~A" str))) + (and (find-package :elisp-lookup) + (funcall (intern "SYMBOL-LOOKUP" :elisp-lookup) + str))) + +(defun clim-lookup (str) + (and (find-package :clim-lookup) + (funcall (intern "TERM-LOOKUP" :clim-lookup) + str))) (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"))) + (elisp-lookup "elisp" "GNU Emacs Lisp Reference Manual") + (clim-lookup "clim" "Common Lisp Interface Manager II Specification"))) (defvar *alists* nil) @@ -73,9 +73,7 @@ (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)))) + (cdr (assoc string alist :test #'equalp)))) (defun valid-message (string prefix &key space-allowed) (if (eql (search prefix string :test #'char-equal) 0) @@ -89,7 +87,7 @@ (format nil "~A: " address) (format nil "~A:" address) (format nil "~A, " address)) - do (aif (valid-message string i :space-allowed (not final)) + do (aif (valid-message string i :space-allowed t) (return-from strip-address (subseq string it)))) (and (not final) string)) @@ -115,7 +113,12 @@ (funcall fun first-arg lookup)))) do (aif (strip-address to-lookup :address (second type) :final t) - (privmsg *connection* destination (funcall actual-fun it))))))) + (let ((looked-up (funcall actual-fun it))) + (if (and (< 0 (count #\space it) 3) + (not looked-up)) + (setf looked-up (format nil "Sorry, I couldn't find anything for ~A." it))) + (and looked-up + (privmsg *connection* destination looked-up)))))))) (defun start-specbot (nick server &rest channels) (add-simple-alist-lookup "754.lisp-expr" 'ieee754 "ieee754" "Section numbers of IEEE 754")

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp cl-irc/example/eliza-rules.lisp
by Brian Mastenbrook 06 Jul '04

06 Jul '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: cliki.lisp eliza-rules.lisp Log Message: w00t! minion! Date: Tue Jul 6 14:30:44 2004 Author: bmastenbrook Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.11 cl-irc/example/cliki.lisp:1.12 --- cl-irc/example/cliki.lisp:1.11 Tue Jun 22 11:21:05 2004 +++ cl-irc/example/cliki.lisp Tue Jul 6 14:30:44 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.11 2004/06/22 18:21:05 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.12 2004/07/06 21:30:44 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -16,6 +16,14 @@ (defvar *aliases* nil) +(defparameter *sd-file* + (merge-pathnames "sd.lisp-expr" + (make-pathname + :directory + (pathname-directory + (or *load-truename* + *default-pathname-defaults*))))) + (defun forget (term-or-alias) (setf *small-definitions* (remove term-or-alias *small-definitions* :test #'string-equal :key #'car)) (setf *aliases* (remove term-or-alias *aliases* :test #'string-equal :key #'car)) @@ -32,7 +40,7 @@ (defun read-small-definitions () (setf *small-definitions* nil) (setf *aliases* nil) - (with-open-file (sd-file "sd.lisp-expr" :direction :input :if-does-not-exist nil) + (with-open-file (sd-file *sd-file* :direction :input :if-does-not-exist nil) (when sd-file (loop for defn = (read sd-file nil) if defn do (ecase (car defn) @@ -41,7 +49,7 @@ else return *small-definitions*)))) (defun write-small-definitions () - (with-open-file (sd-file "sd.lisp-expr" :direction :output :if-exists :supersede) + (with-open-file (sd-file *sd-file* :direction :output :if-exists :supersede) (mapc #'(lambda (db) (mapc #'(lambda (defn) (prin1 (cons (car db) defn) sd-file) @@ -50,7 +58,7 @@ (cons :alias *aliases*))))) (defun write-top-definition (&key (of *small-definitions*) (type :sd)) - (with-open-file (sd-file "sd.lisp-expr" :direction :output :if-exists :append) + (with-open-file (sd-file *sd-file* :direction :output :if-exists :append) (prin1 (cons type (car of)) sd-file) (format sd-file "~%"))) @@ -66,10 +74,31 @@ (defvar *followed-aliases* nil) +(defvar *last-lookup* "") +(defvar *last-lookup-source* "") +(defvar *last-lookup-time* (get-universal-time)) + (defun alias-string-equal (orig candidate) (unless (member candidate *followed-aliases* :test #'string-equal) (string-equal orig candidate))) +(defun should-do-lookup (text source) + (not (and (string-equal text *last-lookup*) + (string-equal source *last-lookup-source*) + (< (- (get-universal-time) + *last-lookup-time*) 5)))) + +(defun did-lookup (text source) + (setf *last-lookup* text) + (setf *last-lookup-source* source) + (setf *last-lookup-time* (get-universal-time))) + +(defmacro aif (test conseq &optional (else nil)) + `(let ((it ,test)) + (if it ,conseq + (symbol-macrolet ((it ,test)) + ,else)))) + (defun small-definition-lookup (text) (cdr (assoc text *small-definitions* :test #'string-equal))) @@ -122,6 +151,17 @@ :contents contents) *pending-memos*)) +(defun lookup-paste (number) + (and (find-package :lisppaste) + (let ((paste (funcall (intern "FIND-PASTE" :lisppaste) number))) + (and paste + (format nil "Paste number ~A: \"~A\" by ~A in ~A. ~A" + number + (funcall (intern "PASTE-TITLE" :lisppaste) paste) + (funcall (intern "PASTE-USER" :lisppaste) paste) + (funcall (intern "PASTE-CHANNEL" :lisppaste) paste) + (funcall (intern "PASTE-DISPLAY-URL" :lisppaste) paste)))))) + (defun url-port (url) (assert (string-equal url "http://" :end1 7)) (let ((port-start (position #\: url :start 7))) @@ -189,45 +229,46 @@ (defun cliki-first-sentence (term) (let* ((cliki-url (format nil "http://www.cliki.net/~A" - (encode-for-url term))) - (url (concatenate 'string cliki-url "?source"))) + (encode-for-url term))) + (url (concatenate 'string cliki-url "?source"))) (block cliki-return (handler-case - (host-with-timeout 5 - (destructuring-bind (response headers stream) - (block got - (loop - (destructuring-bind (response headers stream) (url-connection url) - (unless (member response '(301 302)) - (return-from got (list response headers stream))) - (close stream) - (setf url (cdr (assoc :location headers)))))) - (unwind-protect - (if (not (eql response 200)) + (host-with-timeout 5 + (destructuring-bind (response headers stream) + (block got + (loop + (destructuring-bind (response headers stream) (url-connection url) + (unless (member response '(301 302)) + (return-from got (list response headers stream))) + (close stream) + (setf url (cdr (assoc :location headers)))))) + (unwind-protect + (if (not (eql response 200)) nil - ;;(format nil "The term ~A was not found in CLiki." term) - (let ((first-line "")) - (loop for i from 1 to 5 do ;; scan the first 5 lines - (progn - (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))) - (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 " ")) - (setf first-line (regex-replace-all "_\$([^)]*)\$" 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.")) - (setf first-line (regex-replace-all "(\\s)\\s+" first-line "\\1")) - (setf first-line (regex-replace-all "^\\s*(.+\\S)\\s*$" first-line "\\1")) - (when (scan "^([^.]|\\.\\S)+[.?!]$" first-line) - (setf first-line (concatenate 'string first-line " " cliki-url)) - (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 (regex-replace-all "\\n" (format nil "An error was encountered in lookup: ~A." c) " "))))))) + ;;(format nil "The term ~A was not found in CLiki." term) + (let ((first-line "")) + (loop for i from 1 to 5 do ;; scan the first 5 lines + (progn + (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))) + (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 " ")) + (setf first-line (regex-replace-all "_\$([^)]*)\$" 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.")) + (setf first-line (regex-replace-all "(\\s)\\s+" first-line "\\1")) + (setf first-line (regex-replace-all "^\\s*(.+\\S)\\s*$" first-line "\\1")) + (when (scan "^([^.]|\\.\\S)+[.?!]$" first-line) + (setf first-line (concatenate 'string first-line " " cliki-url)) + (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 (regex-replace-all "\\n" (format nil "An error was encountered in lookup: ~A." c) " "))))) + )) (defvar *cliki-connection*) (defvar *cliki-nickname*) @@ -238,25 +279,60 @@ (defun un-shut-up () (setf (irc:client-stream *cliki-connection*) *trace-output*)) -(defmacro aif (test conseq &optional (else nil)) - `(let ((it ,test)) - (if it ,conseq - (symbol-macrolet ((it ,test)) - ,else)))) + (defun make-cliki-attention-prefix (nick) (format nil "^~A[,:]\\s+" nick)) (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.") +(defparameter *help-text* + `(("lookups" . ,(lambda (nick) + (format nil "To look up a term, say something like ``~A: term?''. I will either return a definition for the term or say that it could not be found. Lookups check the internal database first and then try to retrieve the first sentence of the page named like that on CLiki." nick))) + ("adding terms" . + ,(lambda (nick) + (format nil "To add a term, say something like ``~A: add \"term\" as: the definition''. I will remember the definition." nick))) + ("aliasing terms" . + ,(lambda (nick) + (format nil "To make a term an alias for another term, say something like ``~A: alias \"term\" as: some other term''. I will remember the alias." nick))) + ("forgetting" . + ,(lambda (nick) + (format nil "To make me forget something, say something like ``~A: forget term''. I'll forget what I know about that term or nickname." nick))) + ("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))) + ("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))) + ("goodies" . + ,(lambda (nick) + (format nil "If I'm connected to a lisppaste bot, try ``~A: paste 42'' or some other number." nick))) + ("eliza" . + ,(lambda (nick) + (declare (ignore nick)) + (format nil "If you say multiple words to me which I don't recognize and it's not found as a lookup, you might get a sarcastic reply. Don't abuse this too much."))))) + +(defun cliki-bot-help (nick) + (format nil "There are multiple help modules. Try ``/msg ~A help kind'', where kind is one of: ~{\"~A\"~^, ~}." + nick + (mapcar #'car *help-text*))) + +(defun cliki-find-help (string) + (and (> (length string) 0) + (let ((resp-generator (cdr (assoc string *help-text* :test #'string-equal)))) + (if resp-generator + (funcall resp-generator *cliki-nickname*) + (if (not (char-equal (elt string (1- (length string))) #\s)) + (cliki-find-help (concatenate 'string string + (string #\s)))))))) (defun cliki-lookup (term-with-question &key sender channel) - (let ((first-pass (regex-replace-all "^(\\s*)([^?]+)(\\?*)$" term-with-question "\\2"))) + (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))) @@ -281,21 +357,35 @@ (funcall (intern "SAY-HELP" :lisppaste) channel)) (return-from cliki-lookup nil)) + (or - (if (string-equal first-pass "help") *cliki-bot-help*) - (let ((strings (nth-value 1 (scan-to-strings "^(?i)memo\\s+(for|to)\\s+(\\S+)\\s+:*\\s*(.+)$" first-pass)))) + (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) - (add-memo - sender - (if (member (elt strings 1) '("self" "myself" "me") :test #'string-equal) - sender - (elt strings 1)) - (elt strings 2)) - (format nil "Remembered. I'll tell ~A when he/she/it next speaks." (elt strings 1)))) + (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?") @@ -306,16 +396,22 @@ (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.") - (aif (or (small-definition-lookup first-pass) - (cliki-first-sentence first-pass) - (alias-lookup first-pass)) (concatenate 'string first-pass ": " it)) + (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)) ) - (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?" "")) + (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) @@ -335,9 +431,10 @@ (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))) (if (string-equal (first (arguments message)) *cliki-nickname*) - (privmsg *cliki-connection* respond-to (cliki-lookup (trailing-argument message) :sender (source message))) - (if (anybody-here (trailing-argument message)) - (privmsg *cliki-connection* (first (arguments message)) (format nil "~A: hello." (source message)))))))) + (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)))))))) (defvar *cliki-nickserv-password* "") @@ -345,6 +442,11 @@ (if (and (string-equal (source message) "NickServ") (scan "owned by someone else" (trailing-argument message))) (privmsg *cliki-connection* (source message) (format nil "IDENTIFY ~A" *cliki-nickserv-password*)))) + +(defun rename-cliki (new-nick) + (setf *cliki-nickname* new-nick) + (nick *cliki-connection* new-nick) + (setf *cliki-attention-prefix* (make-cliki-attention-prefix new-nick))) (defun start-cliki-bot (nick server &rest channels) (read-small-definitions) Index: cl-irc/example/eliza-rules.lisp diff -u cl-irc/example/eliza-rules.lisp:1.4 cl-irc/example/eliza-rules.lisp:1.5 --- cl-irc/example/eliza-rules.lisp:1.4 Wed Jun 9 11:54:25 2004 +++ cl-irc/example/eliza-rules.lisp Tue Jul 6 14:30:44 2004 @@ -14,6 +14,12 @@ (((?* ?x) ass (?* ?y)) (|Can't| you be a bit more polite?)) + + (((?* ?x) me harder) + ("MORE" ?x)) + + ((more (?* ?x)) + (?x me harder)) (((?* ?x) you (?* ?y) written (?* ?z)) (|I'm| written in Common Lisp)) @@ -234,6 +240,11 @@ (yes) (maybe)) + ((does (?* ?x)) + (no) + (yes) + (maybe)) + ((attack the (?* ?y)) (|Die,| ?y)) ((attack (?* ?y)) @@ -410,4 +421,4 @@ (you speak nonsense) (does torturing a poor bot with things beyond its comprehension please you?) (please stop playing with |me...| I am not a toy) - (watch |out,| |you'll| make Krystof angry)))) \ No newline at end of file + (watch |out,| |you'll| make Krystof angry))))

1 0