[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp

[Brian Mastenbrook]

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"))