diff --git a/anna.scm b/anna.scm index 9b18bcf..0a6a84d 100644 --- a/anna.scm +++ b/anna.scm @@ -6,6 +6,8 @@ (ice-9 format) (ice-9 control) (ice-9 sandbox) + (ice-9 popen) + (ice-9 regex) (rnrs exceptions)) (define +channels+ '("#tildetown" "#bots")) @@ -77,24 +79,74 @@ (format stream "PRIVMSG ~a :\x01ACTION ~a\x01\r\n" chn action)) (define (input-filter str) - (define (remove-newline lst) + "Remove escaped chars to avoid fooling the bot into performing bad actions." + (define (remove-escaped-chars lst) (cond ((or (null? lst) (null? (cdr lst))) lst) - ((eq? (car lst) #\\) (remove-newline (cddr lst))) - (else (cons (car lst) (remove-newline (cdr lst)))))) - (list->string (remove-newline (string->list str)))) + ((eq? (car lst) #\\) (remove-escaped-chars (cddr lst))) + (else (cons (car lst) (remove-escaped-chars (cdr lst)))))) + (list->string (remove-escaped-chars (string->list str)))) (define (evaluate str) + "Evaluate the given string in a sandbox without crashing on errors." (guard (ex (else (begin (display "error encountered!\n") 'error))) ;; << this gets printed in chat (eval-in-sandbox (read (open-input-string str))))) +(define (find-documentation language search) + "Find documentation for different programming languages." + (cond + ((null? language) "Missing langauge specifier.") + ((null? (string-tokenize search)) "Missing search string.") + ((eq? language 'cl) (find-cl-documentation search)) + (else "Unrecognized language! Supported languages are: cl"))) + +(define (slice start end lst) + "Return the list between index start and end (start inclusive, end not inclusive)." + (cond + ((> start end) (error "Start index can't be more than end index.")) + ((> end (length lst)) (error "End index too large.")) + ((= start end) '()) + (else (cons (list-ref lst start) + (slice (+ 1 start) end lst))))) + +(define (escape-string str) + "Replace all special regex chars with escaped versions." + (define chars '(#\( #\) #\* #\+ #\?)) + (define (member? elem lst) + (cond + ((null? lst) #f) + ((eq? (car lst) elem) #t) + (else (member? elem (cdr lst))))) + (define (loop lst) + (cond + ((null? lst) '()) + ((member? (car lst) chars) (cons #\\ (cons (car lst) (loop (cdr lst))))) + (else (cons (car lst) (loop (cdr lst)))))) + (list->string (loop (string->list str)))) + +(define (find-cl-documentation search) + "Find documentation for Common Lisp." + (let ((status (system* "grep" (string-append "htm#" search "\"") "cl.htm"))) + (cond + ((= 0 status) + (let* ((port (open-input-pipe (string-append "grep htm#" search "\\\" cl.htm"))) + (out (string-match "Body.*\"" (read-line port))) + (sublink (list->string (slice (car (vector-ref out 1)) + (- (cdr (vector-ref out 1)) 1) + (string->list (vector-ref out 0)))))) + (close-pipe port) + (string-append "http://www.lispworks.com/documentation/lw70/CLHS/" + sublink))) + (else "Symbol not found in documentation.")))) + (define (main-loop stream) (let* ((inl (read-line stream)) (data (string-tokenize inl)) - (chn (scar (scdr (member "PRIVMSG" data))))) + (chn (scar (scdr (member "PRIVMSG" data)))) + (filtered-data (map input-filter data))) ;; debug print (format #t "~s~%" data) (cond @@ -104,9 +156,12 @@ (equal? ":!anna" (slist-ref data 3))) (send-message stream chn "Hello! I respond to !rollcall, !anna, and !eval .")) ((equal? ":!eval" (slist-ref data 3)) - (let* ((filtered-data (map input-filter data)) - (expr (string-concatenate (intersperse " " (cdr (member ":!eval" filtered-data)))))) + (let ((expr (string-concatenate (intersperse " " (cdr (member ":!eval" filtered-data)))))) (send-message stream chn (evaluate expr)))) + ((equal? ":!doc" (slist-ref data 3)) + (let ((lang (slist-ref data 4)) + (search (escape-string (string-concatenate (intersperse " " (cddr (member ":!doc" filtered-data))))))) + (send-message stream chn (find-documentation (string->symbol lang) search)))) ((and (= 7 (length data)) (equal? (list-tail data 4) '("ACTION" "shoots" "anna"))) (send-action stream chn "dies") diff --git a/cl.htm b/cl.htm new file mode 100644 index 0000000..7f48c12 --- /dev/null +++ b/cl.htm @@ -0,0 +1,1008 @@ + + + +CLHS: Alphabetical Symbol Index (Full) + + + + + + + + + +

[LISPWORKS][Common Lisp HyperSpec (TM)] [No Previous][Up][No Next]

+ +
+ + + +

Symbol Index

+ + +
+ +[Starting Points][Contents][Index][Symbols][Glossary][Issues]
+ +Copyright 1996-2005, LispWorks Ltd. All rights reserved.

+ +