summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--irc/bot.rkt35
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)))))