diff options
| -rw-r--r-- | irc/bot.rkt | 35 |
1 files changed, 33 insertions, 2 deletions
diff --git a/irc/bot.rkt b/irc/bot.rkt index a26e0df..c0d9d22 100644 --- a/irc/bot.rkt +++ b/irc/bot.rkt @@ -1,9 +1,31 @@ #lang racket/base (require "core.rkt" (for-syntax racket/base racket/syntax) + racket/string racket/function racket/stxparam) (provide (all-defined-out)) +(define (replace-many s rep) + (foldl (λ (rep acc) (apply string-replace acc rep)) s rep)) + +(define casemap-empty '()) + +(define casemap-uppercase-strict-rfc1459 + '(("{" "[") ("}" "]") ("|" "\\"))) +(define casemap-lowercase-strict-rfc1459 + (map reverse casemap-uppercase-strict-rfc1459)) + +(define casemap-uppercase-relaxed-rfc1459 + (cons '("^" "~") casemap-uppercase-strict-rfc1459)) +(define casemap-lowercase-relaxed-rfc1459 + (map reverse casemap-uppercase-relaxed-rfc1459)) + +(define (irc-downcase s [casemap casemap-lowercase-relaxed-rfc1459]) + (replace-many (string-downcase s) casemap)) + +(define (irc-upcase s [casemap casemap-uppercase-relaxed-rfc1459]) + (replace-many (string-upcase s) casemap)) + (define current-nick (make-parameter #f)) (define (tags) (message-tags (current-message))) @@ -13,7 +35,8 @@ (define (suffix) (message-suffix (current-message))) (define (params) (message-params (current-message))) -(define (source) (message-prefix-nick (current-message))) +(define (unaltered-source) (message-prefix-nick (current-message))) +(define (source) (irc-downcase (unaltered-source))) (define (target) (car (params))) (define (context) (let* ([t (target)] @@ -48,7 +71,7 @@ (comparison-functions context) (define (register [nick (current-nick)] - #:user [user nick] #:mode [mode "*"] + #:user [user nick] #:mode [mode "0"] #:unused [unused "*"] #:realname [realname user] #:pass [pass #f]) (when pass (send (msg 'PASS '() pass))) @@ -75,3 +98,11 @@ (define-syntax-rule (on condition action ...) (hook-add (current-connection) (λ () (when condition action ...)))) + +(define-syntax-rule (on-once condition action ...) + (on condition action ... hook-abort)) + +; does this belong here? +(define (safe-read-string s) + (call-with-default-reading-parameterization + (thunk (read (open-input-string s))))) |