October 2005 - cl-irc-cvs@common-lisp.net

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by lisppaste＠common-lisp.net 15 Oct '05

15 Oct '05

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/lisppaste/cl-irc/example Modified Files: cliki.lisp Log Message: For bmastenbrook: protect acronym generation from abuse Date: Sat Oct 15 21:16:52 2005 Author: lisppaste Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.37 cl-irc/example/cliki.lisp:1.38 --- cl-irc/example/cliki.lisp:1.37 Thu Oct 13 21:52:33 2005 +++ cl-irc/example/cliki.lisp Sat Oct 15 21:16:52 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.37 2005/10/13 19:52:33 lisppaste Exp $ +;;;; $Id: cliki.lisp,v 1.38 2005/10/15 19:16:52 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -433,40 +433,44 @@ (defparameter *last-warning-time* 0) +(defmacro without-abuse (&body body) + `(flet ((doit () ,@body)) + (if (> (- (get-universal-time) 60) + *last-warning-time*) + (let ((time-6 (first *last-eliza-times*)) + (time-4 (third *last-eliza-times*)) + (time-2 (fifth *last-eliza-times*)) + (current-time (get-universal-time)) + (count 0) + (overload 0)) + (if (or + (and + (< (- current-time 60) + time-2) + (setf count 3) + (setf overload (- current-time time-2))) + (and + (< (- current-time 75) + time-4) + (setf count 5) + (setf overload (- current-time time-4))) + (and + (< (- current-time 90) + time-6) + (setf count 7) + (setf overload (- current-time time-6)))) + (progn + (setf *last-warning-time* (get-universal-time)) + (format nil "Would you /please/ stop playing with me? ~A messages in ~A seconds is too many." count overload)) + (progn + (setf *last-eliza-times* (nconc (cdr *last-eliza-times*) + (list (get-universal-time)))) + (doit)) + + ))))) + (defun do-eliza (first-pass) - (if (> (- (get-universal-time) 60) - *last-warning-time*) - (let ((time-6 (first *last-eliza-times*)) - (time-4 (third *last-eliza-times*)) - (time-2 (fifth *last-eliza-times*)) - (current-time (get-universal-time)) - (count 0) - (overload 0)) - (if (or - (and - (< (- current-time 60) - time-2) - (setf count 3) - (setf overload (- current-time time-2))) - (and - (< (- current-time 75) - time-4) - (setf count 5) - (setf overload (- current-time time-4))) - (and - (< (- current-time 90) - time-6) - (setf count 7) - (setf overload (- current-time time-6)))) - (progn - (setf *last-warning-time* (get-universal-time)) - (format nil "Would you /please/ stop playing with me? ~A messages in ~A seconds is too many." count overload)) - (progn - (setf *last-eliza-times* (nconc (cdr *last-eliza-times*) - (list (get-universal-time)))) - (ignore-errors (eliza::eliza first-pass))) - - )))) + (without-abuse (ignore-errors (eliza::eliza first-pass)))) (defvar *more* "CODE") @@ -685,11 +689,12 @@ (and str (let ((letters (remove #\" (elt str 0)))) (when (< (length letters) 9) - (if (and (> (length letters) 2) - (string-equal (subseq letters (- (length letters) 2)) "cl")) - (steel-bazooka:steel-whatever :letters (string-downcase (subseq letters 0 (- (length letters) 2)))) - (steel-bazooka:steel-whatever :letters (string-downcase letters) :suffix nil)))))) - (let ((str (nth-value 1 (scan-to-strings "^(?i)shorten\\s+(\\w+://.+\\S)\\s*$" term-with-question)))) + (without-abuse + (if (and (> (length letters) 2) + (string-equal (subseq letters (- (length letters) 2)) "cl")) + (steel-bazooka:steel-whatever :letters (string-downcase (subseq letters 0 (- (length letters) 2)))) + (steel-bazooka:steel-whatever :letters (string-downcase letters) :suffix nil))))))) + (let ((str (nth-value 1 (scan-to-strings "^(?i)shorten\\s+(\\w+://.+\\S)\\s*$" term-with-question)))) (and str (shorten (elt str 0)))) (if (should-do-lookup first-pass (or channel sender ""))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by lisppaste＠common-lisp.net 13 Oct '05

13 Oct '05

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/lisppaste/cl-irc/example Modified Files: cliki.lisp Log Message: for bmastenbrook: length limit Date: Thu Oct 13 21:52:34 2005 Author: lisppaste Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.36 cl-irc/example/cliki.lisp:1.37 --- cl-irc/example/cliki.lisp:1.36 Thu Oct 13 20:35:08 2005 +++ cl-irc/example/cliki.lisp Thu Oct 13 21:52:33 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.36 2005/10/13 18:35:08 lisppaste Exp $ +;;;; $Id: cliki.lisp,v 1.37 2005/10/13 19:52:33 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -684,10 +684,11 @@ (nth-value 1 (scan-to-strings "^(?i)what\\s+([a-zA-Z\"]+)\\s+(means|stands\\s+for)$" first-pass))))) (and str (let ((letters (remove #\" (elt str 0)))) - (if (and (> (length letters) 2) - (string-equal (subseq letters (- (length letters) 2)) "cl")) - (steel-bazooka:steel-whatever :letters (string-downcase (subseq letters 0 (- (length letters) 2)))) - (steel-bazooka:steel-whatever :letters (string-downcase letters) :suffix nil))))) + (when (< (length letters) 9) + (if (and (> (length letters) 2) + (string-equal (subseq letters (- (length letters) 2)) "cl")) + (steel-bazooka:steel-whatever :letters (string-downcase (subseq letters 0 (- (length letters) 2)))) + (steel-bazooka:steel-whatever :letters (string-downcase letters) :suffix nil)))))) (let ((str (nth-value 1 (scan-to-strings "^(?i)shorten\\s+(\\w+://.+\\S)\\s*$" term-with-question)))) (and str (shorten (elt str 0))))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by lisppaste＠common-lisp.net 13 Oct '05

13 Oct '05

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/lisppaste/cl-irc/example Modified Files: cliki.lisp Log Message: for bmastenbrook: quotes! Date: Thu Oct 13 20:35:08 2005 Author: lisppaste Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.35 cl-irc/example/cliki.lisp:1.36 --- cl-irc/example/cliki.lisp:1.35 Thu Oct 13 20:33:13 2005 +++ cl-irc/example/cliki.lisp Thu Oct 13 20:35:08 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.35 2005/10/13 18:33:13 lisppaste Exp $ +;;;; $Id: cliki.lisp,v 1.36 2005/10/13 18:35:08 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -680,10 +680,10 @@ (lookup-advice (elt str 0)))) (let ((str (or - (nth-value 1 (scan-to-strings "^(?i)what\\s+does\\s+([a-zA-Z]+)\\s+(mean|stand\\s+for)$" first-pass)) - (nth-value 1 (scan-to-strings "^(?i)what\\s+([a-zA-Z]+)\\s+(means|stands\\s+for)$" first-pass))))) + (nth-value 1 (scan-to-strings "^(?i)what\\s+does\\s+([a-zA-Z\"]+)\\s+(mean|stand\\s+for)$" first-pass)) + (nth-value 1 (scan-to-strings "^(?i)what\\s+([a-zA-Z\"]+)\\s+(means|stands\\s+for)$" first-pass))))) (and str - (let ((letters (elt str 0))) + (let ((letters (remove #\" (elt str 0)))) (if (and (> (length letters) 2) (string-equal (subseq letters (- (length letters) 2)) "cl")) (steel-bazooka:steel-whatever :letters (string-downcase (subseq letters 0 (- (length letters) 2))))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by lisppaste＠common-lisp.net 13 Oct '05

13 Oct '05

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/lisppaste/cl-irc/example Modified Files: cliki.lisp Log Message: MORE REGEXPS Date: Thu Oct 13 20:33:13 2005 Author: lisppaste Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.34 cl-irc/example/cliki.lisp:1.35 --- cl-irc/example/cliki.lisp:1.34 Thu Oct 13 20:26:21 2005 +++ cl-irc/example/cliki.lisp Thu Oct 13 20:33:13 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.34 2005/10/13 18:26:21 lisppaste Exp $ +;;;; $Id: cliki.lisp,v 1.35 2005/10/13 18:33:13 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -678,7 +678,10 @@ (let ((str (nth-value 1 (scan-to-strings "^(?i)advice\\W+(\\d+)$" first-pass)))) (and str (lookup-advice (elt str 0)))) - (let ((str (nth-value 1 (scan-to-strings "^(?i)what\\s+does\\s+([a-zA-Z]+)\\s+(mean|stand\\s+for)$" first-pass)))) + (let ((str + (or + (nth-value 1 (scan-to-strings "^(?i)what\\s+does\\s+([a-zA-Z]+)\\s+(mean|stand\\s+for)$" first-pass)) + (nth-value 1 (scan-to-strings "^(?i)what\\s+([a-zA-Z]+)\\s+(means|stands\\s+for)$" first-pass))))) (and str (let ((letters (elt str 0))) (if (and (> (length letters) 2)

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/cliki.lisp
by lisppaste＠common-lisp.net 13 Oct '05

13 Oct '05

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/lisppaste/cl-irc/example Modified Files: cliki.lisp Log Message: for bmastenbrook: MORE HELP Date: Thu Oct 13 20:26:21 2005 Author: lisppaste Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.33 cl-irc/example/cliki.lisp:1.34 --- cl-irc/example/cliki.lisp:1.33 Thu Oct 13 20:22:38 2005 +++ cl-irc/example/cliki.lisp Thu Oct 13 20:26:21 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.33 2005/10/13 18:22:38 lisppaste Exp $ +;;;; $Id: cliki.lisp,v 1.34 2005/10/13 18:26:21 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -407,7 +407,10 @@ (format nil "Try saying something like ``~A: advice #11904'' to get some advice." nick))) ("apropos" . ,(lambda (nick) - (format nil "Try ``~A: apropos foo'' to search for all small definitions containing ''foo''." nick))))) + (format nil "Try ``~A: apropos foo'' to search for all small definitions containing ''foo''." nick))) + ("acronyms" . + ,(lambda (nick) + (format nil "See an acronym you don't recognize? Try ``~A: what does sbcl stand for?'' to find out what it means!" nick))))) (defun cliki-bot-help (nick) (format nil "There are multiple help modules. Try ``/msg ~A help kind'', where kind is one of: ~{\"~A\"~^, ~}."

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/steel-bazooka.lisp cl-irc/example/words cl-irc/example/cliki-bot.asd cl-irc/example/cliki.lisp
by lisppaste＠common-lisp.net 13 Oct '05

13 Oct '05

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/lisppaste/cl-irc/example Modified Files: cliki-bot.asd cliki.lisp Added Files: steel-bazooka.lisp words Log Message: For bmastenbrook: Steel Bazooka Common Lisp! Date: Thu Oct 13 20:22:40 2005 Author: lisppaste Index: cl-irc/example/cliki-bot.asd diff -u cl-irc/example/cliki-bot.asd:1.4 cl-irc/example/cliki-bot.asd:1.5 --- cl-irc/example/cliki-bot.asd:1.4 Tue May 10 02:36:26 2005 +++ cl-irc/example/cliki-bot.asd Thu Oct 13 20:22:38 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cliki-bot.asd,v 1.4 2005/05/10 00:36:26 lisppaste Exp $ +;;;; $Id: cliki-bot.asd,v 1.5 2005/10/13 18:22:38 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki-bot.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -19,7 +19,7 @@ :depends-on (:cl-irc :cl-ppcre :split-sequence :trivial-http) :properties ((#:author-email . "cl-irc-devel(a)common-lisp.net") - (#:date . "$Date: 2005/05/10 00:36:26 $") + (#:date . "$Date: 2005/10/13 18:22:38 $") ((#:albert #:output-dir) . "doc/api-doc/") ((#:albert #:formats) . ("docbook")) ((#:albert #:docbook #:template) . "book") @@ -28,5 +28,6 @@ :components ((:file "mp2eliza") (:file "eliza-rules" :depends-on ("mp2eliza")) + (:file "steel-bazooka") (:file "cliki" - :depends-on ("mp2eliza")))) + :depends-on ("mp2eliza" "steel-bazooka")))) Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.32 cl-irc/example/cliki.lisp:1.33 --- cl-irc/example/cliki.lisp:1.32 Thu Sep 1 21:05:30 2005 +++ cl-irc/example/cliki.lisp Thu Oct 13 20:22:38 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.32 2005/09/01 19:05:30 lisppaste Exp $ +;;;; $Id: cliki.lisp,v 1.33 2005/10/13 18:22:38 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -675,6 +675,13 @@ (let ((str (nth-value 1 (scan-to-strings "^(?i)advice\\W+(\\d+)$" first-pass)))) (and str (lookup-advice (elt str 0)))) + (let ((str (nth-value 1 (scan-to-strings "^(?i)what\\s+does\\s+([a-zA-Z]+)\\s+(mean|stand\\s+for)$" first-pass)))) + (and str + (let ((letters (elt str 0))) + (if (and (> (length letters) 2) + (string-equal (subseq letters (- (length letters) 2)) "cl")) + (steel-bazooka:steel-whatever :letters (string-downcase (subseq letters 0 (- (length letters) 2)))) + (steel-bazooka:steel-whatever :letters (string-downcase letters) :suffix nil))))) (let ((str (nth-value 1 (scan-to-strings "^(?i)shorten\\s+(\\w+://.+\\S)\\s*$" term-with-question)))) (and str (shorten (elt str 0))))

1 0

[Cl-irc-cvs] CVS update: cl-irc/utility.lisp
by afuchs＠common-lisp.net 03 Oct '05

03 Oct '05

Update of /project/cl-irc/cvsroot/cl-irc In directory common-lisp.net:/tmp/cvs-serv31157 Modified Files: utility.lisp Log Message: fix parsing of mode args that contain #\+ or #\-, e.g. -o+b. Date: Mon Oct 3 16:11:03 2005 Author: afuchs Index: cl-irc/utility.lisp diff -u cl-irc/utility.lisp:1.7 cl-irc/utility.lisp:1.8 --- cl-irc/utility.lisp:1.7 Sun Apr 17 21:45:42 2005 +++ cl-irc/utility.lisp Mon Oct 3 16:11:02 2005 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.7 2005/04/17 19:45:42 ehuelsmann Exp $ +;;;; $Id: utility.lisp,v 1.8 2005/10/03 14:11:02 afuchs Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -319,18 +319,21 @@ (unless (position this-op "+-") (throw 'illegal-mode-spec nil)) (dotimes (i (length modes)) - (let* ((mode-rec - (mode-description connection target - (mode-name-from-char connection target - (char modes i)))) - (param-p (funcall param-req mode-rec))) - (when (and param-p - (= 0 (length arguments))) - (throw 'illegal-mode-spec nil)) - (push (list this-op - (mode-desc-symbol mode-rec) - (when param-p - (if (mode-desc-nick-param-p mode-rec) - (find-user connection (pop arguments)) - (pop arguments)))) ops))))))))) + (case (char modes i) + ((#\+ #\-) (setf this-op (char modes i))) + (t + (let* ((mode-rec + (mode-description connection target + (mode-name-from-char connection target + (char modes i)))) + (param-p (funcall param-req mode-rec))) + (when (and param-p + (= 0 (length arguments))) + (throw 'illegal-mode-spec nil)) + (push (list this-op + (mode-desc-symbol mode-rec) + (when param-p + (if (mode-desc-nick-param-p mode-rec) + (find-user connection (pop arguments)) + (pop arguments)))) ops)))))))))))

1 0