[net-nittin-irc-cvs] CVS update: net-nittin-irc/example/cliki.lisp

Brian Mastenbrook bmastenbrook at common-lisp.net
Sat Dec 13 23:08:29 UTC 2003


Update of /project/net-nittin-irc/cvsroot/net-nittin-irc/example
In directory common-lisp.net:/tmp/cvs-serv4884

Modified Files:
	cliki.lisp 
Log Message:
Add small definitions functionality.

Date: Sat Dec 13 18:08:28 2003
Author: bmastenbrook

Index: net-nittin-irc/example/cliki.lisp
diff -u net-nittin-irc/example/cliki.lisp:1.3 net-nittin-irc/example/cliki.lisp:1.4
--- net-nittin-irc/example/cliki.lisp:1.3	Sat Dec 13 09:03:39 2003
+++ net-nittin-irc/example/cliki.lisp	Sat Dec 13 18:08:26 2003
@@ -1,4 +1,4 @@
-;;;; $Id: cliki.lisp,v 1.3 2003/12/13 14:03:39 bmastenbrook Exp $
+;;;; $Id: cliki.lisp,v 1.4 2003/12/13 23:08:26 bmastenbrook Exp $
 ;;;; $Source: /project/net-nittin-irc/cvsroot/net-nittin-irc/example/cliki.lisp,v $
 
 ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL.
@@ -10,6 +10,30 @@
 (defpackage :cliki (:use :common-lisp :irc :sb-bsd-sockets :cl-ppcre))
 (in-package :cliki)
 
+(defvar *small-definitions* nil)
+
+(defun read-small-definitions ()
+  (setf *small-definitions* nil)
+  (with-open-file (sd-file "sd.lisp-expr" :direction :input :if-does-not-exist nil)
+    (when sd-file
+      (block nil
+	(loop (let ((defn (read sd-file nil)))
+		(if defn (push defn *small-definitions*)
+		    (return (setf *small-definitions* (nreverse *small-definitions*))))))))))
+
+(defun write-small-definitions ()
+  (with-open-file (sd-file "sd.lisp-expr" :direction :output :if-exists :supersede)
+    (mapc #'(lambda (defn)
+	      (prin1 defn sd-file)) *small-definitions*)))
+
+(defun write-top-definition ()
+  (with-open-file (sd-file "sd.lisp-expr" :direction :output :if-exists :append)
+    (prin1 (car *small-definitions*) sd-file)))
+
+(defun add-small-definition (term defn)
+  (push (cons term defn) *small-definitions*)
+  (write-small-definitions))
+
 (defun url-port (url)
   (assert (string-equal url "http://" :end1 7))
   (let ((port-start (position #\: url :start 7)))
@@ -107,11 +131,22 @@
 
 (defparameter *cliki-attention-prefix* "cliki: ")
 
+(defparameter *cliki-bot-help* "The CLiki bot supplies small definitions and performs lookups on CLiki. To add a term for IRC, try saying ``cliki: add \"term\" as: definition''.")
+
 (defun cliki-lookup (term-with-question)
   (let ((first-pass (regex-replace-all "^(\\s*)([^?]+)(\\?*)$" term-with-question "\\2")))
     (setf first-pass (regex-replace-all "\\s\\s+" first-pass ""))
     (setf first-pass (regex-replace-all "\\s*$" first-pass ""))
-    (concatenate 'string first-pass ": " (cliki-first-sentence first-pass))))
+    (if (scan "^add \"([^\"]+)\" as: (.+)$" first-pass)
+	(let ((term (regex-replace "^add \"([^\"]+)\" .*$" first-pass "\\1"))
+	      (defn (regex-replace "^add \"[^\"]+\" as: (.+)$" first-pass "\\1")))
+	  (add-small-definition term defn)
+	  "OK, done.")
+	(concatenate 'string first-pass ": "
+		     (or
+		      (if (string-equal first-pass "help") *cliki-bot-help*)
+		      (cdr (assoc first-pass *small-definitions* :test #'string-equal))
+		      (cliki-first-sentence first-pass))))))
 
 (defun valid-cliki-message (message)
   (eql (search *cliki-attention-prefix* (trailing-argument message) :test #'char-equal) 0))





More information about the Net-nittin-irc-cvs mailing list