[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