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: Detect MORE in all caps
Date: Tue Aug 10 06:29:30 2004 Author: bmastenbrook
Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.23 cl-irc/example/cliki.lisp:1.24 --- cl-irc/example/cliki.lisp:1.23 Sat Aug 7 13:07:16 2004 +++ cl-irc/example/cliki.lisp Tue Aug 10 06:29:30 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.23 2004/08/07 20:07:16 bmastenbrook Exp $ + ;;;; $Id: cliki.lisp,v 1.24 2004/08/10 13:29:30 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $
;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -459,31 +459,35 @@ '("an" "a" "the"))
(defun scan-for-more (s) - (let ((str (nth-value 1 (scan-to-strings "(?i)more\W+(\w+)\W+(\w+)\W+(\w+)" s)))) + (let ((str (nth-value 1 (scan-to-strings "MORE\W+((\W|[A-Z0-9])+)([A-Z0-9])($|[^A-Z0-9])" s)))) (or (and str - (or (member (elt str 0) *prepositions* :test #'string-equal) - (member (elt str 0) *conjunctions* :test #'string-equal) - (member (elt str 0) *articles* :test #'string-equal)) - (or (member (elt str 1) *prepositions* :test #'string-equal) - (member (elt str 1) *conjunctions* :test #'string-equal) - (member (elt str 1) *articles* :test #'string-equal)) - (setf *more* (string-upcase - (concatenate 'string (elt str 0) " " (elt str 1) - " " (elt str 2))))) - (let ((str (nth-value 1 (scan-to-strings "(?i)more\W+(\w+)\W+(\w+)" s)))) + (setf *more* (concatenate 'string (elt str 0) (elt str 2)))) + (let ((str (nth-value 1 (scan-to-strings "(?i)more\W+(\w+)\W+(\w+)\W+(\w+)" s)))) (or (and str (or (member (elt str 0) *prepositions* :test #'string-equal) (member (elt str 0) *conjunctions* :test #'string-equal) (member (elt str 0) *articles* :test #'string-equal)) + (or (member (elt str 1) *prepositions* :test #'string-equal) + (member (elt str 1) *conjunctions* :test #'string-equal) + (member (elt str 1) *articles* :test #'string-equal)) (setf *more* (string-upcase - (concatenate 'string (elt str 0) " " (elt str 1))))) - (let ((str (nth-value 1 (scan-to-strings "(?i)more\W+(\w+)" s)))) + (concatenate 'string (elt str 0) " " (elt str 1) + " " (elt str 2))))) + (let ((str (nth-value 1 (scan-to-strings "(?i)more\W+(\w+)\W+(\w+)" s)))) (or - (and str (setf *more* (string-upcase (elt str 0)))) - ))))))) - + (and str + (or (member (elt str 0) *prepositions* :test #'string-equal) + (member (elt str 0) *conjunctions* :test #'string-equal) + (member (elt str 0) *articles* :test #'string-equal)) + (setf *more* (string-upcase + (concatenate 'string (elt str 0) " " (elt str 1))))) + (let ((str (nth-value 1 (scan-to-strings "(?i)more\W+(\w+)" s)))) + (or + (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)) @@ -617,7 +621,7 @@ (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) + (if (scan "^(?i)chant(\s|!|\?|\.|$)*" first-pass) (format nil "MORE ~A" *more*)) (if (scan "^(?i)advice$" first-pass) (random-advice))