cl-irc-cvs

Download

cl-irc-cvs@common-lisp.net

June 2004

2 participants
12 discussions

[Cl-irc-cvs] CVS update: cl-irc/example/clhs.lisp cl-irc/example/cliki.lisp
by Brian Mastenbrook 01 Jun '04

01 Jun '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/bmastenbrook/cl-irc/example Modified Files: clhs.lisp cliki.lisp Log Message: wootage! minion talks to lisppaste, if it can Date: Tue Jun 1 08:29:19 2004 Author: bmastenbrook Index: cl-irc/example/clhs.lisp diff -u cl-irc/example/clhs.lisp:1.5 cl-irc/example/clhs.lisp:1.6 --- cl-irc/example/clhs.lisp:1.5 Tue Jun 1 06:48:12 2004 +++ cl-irc/example/clhs.lisp Tue Jun 1 08:29:19 2004 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.6 2004/06/01 15:29:19 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/clhs.lisp,v $ ;;;; clhs.lisp - an example IRC bot for cl-irc @@ -20,7 +20,7 @@ (in-package :clhs) ;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-pathname* #p"/Users/chandler/HyperSpec/") +(defparameter *hyperspec-pathname* #p"/home/bmastenbrook/HyperSpec/") (defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) @@ -77,7 +77,7 @@ do (add-clhs-section-to-table section s1 s2 s3 s4 s5)))))))) ;; format directives (loop for code from 32 to 127 - do (setf (gethash (format nil "format:~A" (code-char code)) *table*) + do (setf (gethash (format nil "~~~A" (code-char code)) *table*) (concatenate 'string *hyperspec-root* (case (code-char code) Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.5 cl-irc/example/cliki.lisp:1.6 --- cl-irc/example/cliki.lisp:1.5 Tue Jun 1 06:48:12 2004 +++ cl-irc/example/cliki.lisp Tue Jun 1 08:29:19 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.6 2004/06/01 15:29:19 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -174,7 +174,7 @@ (defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add \"term\" as: definition'' or ``minion: alias \"term\" as: term''; otherwise, edit the corresponding CLiki page.") -(defun cliki-lookup (term-with-question &optional sender) +(defun cliki-lookup (term-with-question &key sender channel) (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 "")) @@ -190,6 +190,14 @@ "OK, done.") (progn (setf first-pass (regex-replace-all "(:|/|\\\\|\\#)" first-pass "")) + (when (and (scan "^(?i)lisppaste(\\s|!|\\?|\\.|$)*" first-pass) + (find-package :lisppaste) + channel + (> (length channel) 0) + (char= (elt channel 0) #\#)) + (funcall (intern "SAY-HELP" :lisppaste) + channel) + (return-from cliki-lookup nil)) (or (if (string-equal first-pass "help") *cliki-bot-help*) (if (scan "^(?i)hello(\\s|$)*" first-pass) "what's up?") @@ -225,7 +233,8 @@ (defun msg-hook (message) (let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message))))) (if (valid-cliki-message message) - (privmsg *cliki-connection* respond-to (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") (source message))) + (let ((response (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") :sender (source message) :channel (first (irc:arguments message))))) + (and response (privmsg *cliki-connection* respond-to response))) (if (string-equal (first (arguments message)) *cliki-nickname*) (privmsg *cliki-connection* respond-to (cliki-lookup (trailing-argument message))) (if (anybody-here (trailing-argument message))

1 0

[Cl-irc-cvs] CVS update: cl-irc/example/clhs.lisp cl-irc/example/cliki-bot.asd cl-irc/example/cliki.lisp cl-irc/example/eliza-rules.lisp
by Brian Mastenbrook 01 Jun '04

01 Jun '04

Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/tmp/cvs-serv12457/example Modified Files: clhs.lisp cliki-bot.asd cliki.lisp eliza-rules.lisp Log Message: Portability fixes Date: Tue Jun 1 06:48:12 2004 Author: bmastenbrook Index: cl-irc/example/clhs.lisp diff -u cl-irc/example/clhs.lisp:1.4 cl-irc/example/clhs.lisp:1.5 --- cl-irc/example/clhs.lisp:1.4 Sun Feb 1 06:11:56 2004 +++ cl-irc/example/clhs.lisp Tue Jun 1 06:48:12 2004 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.4 2004/02/01 14:11:56 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/clhs.lisp,v $ ;;;; clhs.lisp - an example IRC bot for cl-irc @@ -20,7 +20,7 @@ (in-package :clhs) ;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-pathname* #p"/home/bmastenbrook/HyperSpec/") +(defparameter *hyperspec-pathname* #p"/Users/chandler/HyperSpec/") (defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) @@ -167,8 +167,12 @@ (setf *clhs-connection* (connect :nickname *clhs-nickname* :server server)) (mapcar #'(lambda (channel) (join *clhs-connection* channel)) channels) (add-hook *clhs-connection* 'irc::irc-privmsg-message 'msg-hook) - #+sbcl (start-background-message-handler *clhs-connection*) - #-sbcl (read-message-loop *clhs-connection*)) + #+(or sbcl + openmcl) + (start-background-message-handler *clhs-connection*) + #-(or sbcl + openmcl) + (read-message-loop *clhs-connection*)) (defun shuffle-hooks () (irc::remove-hooks *clhs-connection* 'irc::irc-privmsg-message) Index: cl-irc/example/cliki-bot.asd diff -u cl-irc/example/cliki-bot.asd:1.1 cl-irc/example/cliki-bot.asd:1.2 --- cl-irc/example/cliki-bot.asd:1.1 Sat Jan 17 11:19:55 2004 +++ cl-irc/example/cliki-bot.asd Tue Jun 1 06:48:12 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki-bot.asd,v 1.1 2004/01/17 19:19:55 bmastenbrook Exp $ +;;;; $Id: cliki-bot.asd,v 1.2 2004/06/01 13:48:12 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki-bot.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -17,10 +17,9 @@ :licence "MIT" :description "IRC bot for SBCL" :depends-on - #+sbcl (:cl-irc :cl-ppcre) - #-sbcl (:sbcl) + (:cl-irc :cl-ppcre) :properties ((#:author-email . "cl-irc-devel(a)common-lisp.net") - (#:date . "$Date: 2004/01/17 19:19:55 $") + (#:date . "$Date: 2004/06/01 13:48:12 $") ((#:albert #:output-dir) . "doc/api-doc/") ((#:albert #:formats) . ("docbook")) ((#:albert #:docbook #:template) . "book") @@ -30,4 +29,4 @@ (:file "eliza-rules" :depends-on ("mp2eliza")) (:file "cliki" - :depends-on ("mp2eliza")))) \ No newline at end of file + :depends-on ("mp2eliza")))) Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.4 cl-irc/example/cliki.lisp:1.5 --- cl-irc/example/cliki.lisp:1.4 Sun Feb 1 06:11:56 2004 +++ cl-irc/example/cliki.lisp Tue Jun 1 06:48:12 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.4 2004/02/01 14:11:56 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $ ;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -7,7 +7,7 @@ ;;; cliki.lisp, and invoke (cliki::start-cliki-bot "desirednickname" ;;; "desiredserver" "#channel1" "#channel2" "#channel3" ...) -(defpackage :cliki (:use :common-lisp :irc :sb-bsd-sockets :cl-ppcre) +(defpackage :cliki (:use :common-lisp :irc :cl-ppcre) (:export :start-cliki-bot :*cliki-nickserv-password* :*respond-to-general-hellos*)) (in-package :cliki) @@ -50,31 +50,47 @@ (or port-start (length url))))) (subseq url 7 host-end))) +#+(or ccl allegro) +(defun socket-connect (host port) + (#+ccl ccl:make-socket + #+allegro socket:make-socket + :connect :active + :remote-host host + :remote-port port)) + +#+sbcl +(defun socket-connect (host port) + (let ((s (make-instance 'sb-bsd-sockets:inet-socket + :type :stream + :protocol :tcp))) + (sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses + (sb-bsd-sockets:get-host-by-name host))) port) + (sb-bsd-sockets:socket-make-stream s + :element-type 'character + :input t + :output t + :buffering :none))) + (defun url-connection (url) - (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)) - (host (url-host url)) - (port (url-port url))) - (declare (ignore port)) - (socket-connect - s (car (host-ent-addresses (get-host-by-name (url-host url)))) - (url-port url)) - (let ((stream (socket-make-stream s :input t :output t :buffering :full))) - ;; we are exceedingly unportable about proper line-endings here. - ;; Anyone wishing to run this under non-SBCL should take especial care - (format stream "GET ~A HTTP/1.0~%Host: ~A~%User-Agent: CLiki Bot~%~%" url host) - (force-output stream) - (list - (let* ((l (read-line stream)) - (space (position #\Space l))) - (parse-integer l :start (1+ space) :junk-allowed t)) - (loop for line = (read-line stream nil nil) - until (or (null line) (eql (elt line 0) (code-char 13))) - collect - (let ((colon (position #\: line))) - (cons (intern (string-upcase (subseq line 0 colon)) :keyword) - (string-trim (list #\Space (code-char 13)) - (subseq line (1+ colon)))))) - stream)))) + (let* ((host (url-host url)) + (port (url-port url)) + (stream (socket-connect host port))) + ;; we are exceedingly unportable about proper line-endings here. + ;; Anyone wishing to run this under non-SBCL should take especial care + (format stream "GET ~A HTTP/1.0~%Host: ~A~%User-Agent: CLiki Bot~%~%" url host) + (force-output stream) + (list + (let* ((l (read-line stream)) + (space (position #\Space l))) + (parse-integer l :start (1+ space) :junk-allowed t)) + (loop for line = (read-line stream nil nil) + until (or (null line) (eql (elt line 0) (code-char 13))) + collect + (let ((colon (position #\: line))) + (cons (intern (string-upcase (subseq line 0 colon)) :keyword) + (string-trim (list #\Space (code-char 13)) + (subseq line (1+ colon)))))) + stream))) (defun encode-for-url (str) (setf str (regex-replace-all " " str "%20")) @@ -83,13 +99,33 @@ ;(format t "hi ~A~%" str) str) +#+sbcl +(defmacro host-with-timeout (timeout &body body) + `(sb-ext:with-timeout ,timeout ,@body)) + +#+ccl +(defmacro host-with-timeout (timeout &body body) + `(let ((interrupt-thread nil)) + (setf interrupt-thread + (ccl:process-run-function 'timeout + (let ((process ccl:*current-process*)) + (lambda () + (sleep ,timeout) + (ccl:process-interrupt process + (lambda () + (signal 'openmcl-timeout))))))) + (unwind-protect + (progn ,@body) + (if interrupt-thread + (ccl:process-kill interrupt-thread))))) + (defun cliki-first-sentence (term) (let* ((cliki-url (format nil "http://www.cliki.net/~A" (encode-for-url term))) (url (concatenate 'string cliki-url "?source"))) (block cliki-return (handler-case - (sb-ext:with-timeout 5 + (host-with-timeout 5 (destructuring-bind (response headers stream) (block got (loop @@ -138,7 +174,7 @@ (defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add \"term\" as: definition'' or ``minion: alias \"term\" as: term''; otherwise, edit the corresponding CLiki page.") -(defun cliki-lookup (term-with-question) +(defun cliki-lookup (term-with-question &optional sender) (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 "")) @@ -156,9 +192,15 @@ (setf first-pass (regex-replace-all "(:|/|\\\\|\\#)" first-pass "")) (or (if (string-equal first-pass "help") *cliki-bot-help*) - (if (scan "^(?i)hello(\\s|$)" first-pass) "what's up?") - (if (scan "^(?i)hi(\\s|$)" first-pass) "what's up?") - (if (scan "^(?i)yo(\\s|$)" first-pass) "what's up?") + (if (scan "^(?i)hello(\\s|$)*" first-pass) "what's up?") + (if (scan "^(?i)hi(\\s|$)*" first-pass) "what's up?") + (if (scan "^(?i)yo(\\s|$)*" first-pass) "what's up?") + (if (scan "^(?i)thank(s| you)(\\s|!|\\?|\\.|$)*" first-pass) + (if sender + (format nil "~A: you failed the inverse turing test!" sender) + "you failed the inverse turing test!")) + (if (scan "^(?i)version(\\s|!|\\?|\\.|$)*" first-pass) + (format nil "This is the minion bot, running on a ~A (~A) and running under ~A ~A." (machine-type) (machine-version) (lisp-implementation-type) (lisp-implementation-version))) (if (scan "^(?i)(?i)do my bidding!*$" first-pass) "Yes, my master.") (aif (or (let ((term (cdr (assoc first-pass *small-definitions* :test #'string-equal)))) (if term (if (stringp term) term (cliki-lookup (car term))))) @@ -183,7 +225,7 @@ (defun msg-hook (message) (let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message))))) (if (valid-cliki-message message) - (privmsg *cliki-connection* respond-to (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) ""))) + (privmsg *cliki-connection* respond-to (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") (source message))) (if (string-equal (first (arguments message)) *cliki-nickname*) (privmsg *cliki-connection* respond-to (cliki-lookup (trailing-argument message))) (if (anybody-here (trailing-argument message)) @@ -203,8 +245,7 @@ (mapcar #'(lambda (channel) (join *cliki-connection* channel)) channels) (add-hook *cliki-connection* 'irc::irc-privmsg-message 'msg-hook) (add-hook *cliki-connection* 'irc::irc-notice-message 'notice-hook) - #+sbcl (start-background-message-handler *cliki-connection*) - #-sbcl (read-message-loop *cliki-connection*)) + (start-background-message-handler *cliki-connection*)) (defun shuffle-hooks () (irc::remove-hooks *cliki-connection* 'irc::irc-privmsg-message) Index: cl-irc/example/eliza-rules.lisp diff -u cl-irc/example/eliza-rules.lisp:1.2 cl-irc/example/eliza-rules.lisp:1.3 --- cl-irc/example/eliza-rules.lisp:1.2 Sun Feb 1 06:11:56 2004 +++ cl-irc/example/eliza-rules.lisp Tue Jun 1 06:48:12 2004 @@ -21,6 +21,9 @@ (((?* ?x) bot (?* ?y)) (|I'm| not a |bot.| I prefer the term |``electronically composed''.|)) + ((seen ?x) + (?x was last seen 5y6m14d32h43m10s |ago,| saying |"minion: when are you going to support seen?"|)) + (((?* ?x) did you (?* ?y)) (|no, I didn't| ?y) (|yes, I| ?y)) @@ -34,6 +37,9 @@ (Thanks!)) ((bot snack) + (Thanks!)) + + ((welcome (?* ?y)) (Thanks!)) ((not much) (good))

1 0