diff options
Diffstat (limited to 'irc/core.rkt')
| -rw-r--r-- | irc/core.rkt | 19 |
1 files changed, 13 insertions, 6 deletions
diff --git a/irc/core.rkt b/irc/core.rkt index fa5edce..342cb78 100644 --- a/irc/core.rkt +++ b/irc/core.rkt @@ -1,12 +1,14 @@ #lang racket/base (require (for-syntax racket/provide) racket/provide - racket/string + racket/string racket/list racket/function racket/promise racket/exn racket/tcp openssl (only-in srfi/13 string-index string-index-right)) (provide current-connection current-message current-hook-fail-handler - connect hook-add hook-process + connect hook-add hook-process hook-abort msg send listen + connection-storage set-connection-storage! + (matching-identifiers-out #rx"^log-irc-" (all-defined-out)) (matching-identifiers-out #rx"^message-" (all-defined-out))) (define-logger irc) @@ -18,7 +20,7 @@ (make-parameter (λ (x) (displayln (exn->string x))))) (struct connection - (input output hooks output-lock) + (input output hooks output-lock storage) #:mutable) (struct message @@ -29,15 +31,20 @@ (define (connect host port #:ssl (ssl #f)) (define-values (i o) ((if ssl ssl-connect tcp-connect) host port)) - (connection i o '() (make-semaphore 1))) + (connection i o '() (make-semaphore 1) #f)) (define (hook-add conn fn) (set-connection-hooks! conn (cons fn (connection-hooks conn)))) +(define hook-abort (string->uninterned-symbol "abort")) (define (hook-process msg) + (define conn (current-connection)) + ; TODO add synchronisation (with-handlers ([exn:fail? (current-hook-fail-handler)]) (parameterize ([current-message msg]) - (for-each (λ (h) (h)) (connection-hooks (current-connection)))))) + (set-connection-hooks! conn + (filter-not (λ (h) (eq? (h) hook-abort)) + (connection-hooks conn)))))) (define (msg-print-raw msg out) (define (clean s) @@ -90,7 +97,7 @@ (message tags prefix (string->symbol command) (reverse args) suffix)) -(define (message-params msg) (append (message-args msg) (message-suffix msg))) +(define (message-params msg) (append (message-args msg) (list (message-suffix msg)))) (define (message-prefix-nick msg) (let* ([prefix (message-prefix msg)] |