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 OF ENGLISH

Date: Sat Aug 7 13:07:16 2004 Author: bmastenbrook

Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.22 cl-irc/example/cliki.lisp:1.23 --- cl-irc/example/cliki.lisp:1.22 Thu Aug 5 09:54:09 2004 +++ cl-irc/example/cliki.lisp Sat Aug 7 13:07:16 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.22 2004/08/05 16:54:09 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.23 2004/08/07 20:07:16 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $

;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -449,9 +449,40 @@

(defvar *more* "CODE")

+(defvar *prepositions* + '("aboard" "about" "above" "across" "after" "against" "along" "among" "around" "as" "at" "before" "behind" "below" "beneath" "beside" "between" "beyond" "but" "except" "by" "concerning" "despite" "down" "during" "except" "for" "from" "in" "into" "like" "near" "of" "off" "on" "onto" "out" "outside" "over" "past" "per" "regarding" "since" "through" "throughout" "till" "to" "toward" "under" "underneath" "until" "up" "upon" "with" "within" "without")) + +(defvar *conjunctions* + '("for" "and" "nor" "but" "or" "yet" "so")) + +(defvar *articles* + '("an" "a" "the")) + (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)))))) + (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) + " " (elt str 2))))) + (let ((str (nth-value 1 (scan-to-strings "(?i)more\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)) + (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"))