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