diff --git a/collects/unstable/logging.rkt b/collects/unstable/logging.rkt new file mode 100644 index 0000000000..afe353e307 --- /dev/null +++ b/collects/unstable/logging.rkt @@ -0,0 +1,38 @@ +#lang racket/base + +(require racket/contract) + +(define (with-logging-to-port port level proc) + (let* ([logger (make-logger #f (current-logger))] + [receiver (make-log-receiver logger level)] + [stop-chan (make-channel)] + [t (thread (lambda () + (define (output-event l) + (displayln (vector-ref l 1) ; actual message + port)) + (define (clear-events) + (let ([l (sync/timeout 0 receiver)]) + (when l ; still something to read + (output-event l) + (clear-events)))) + (let loop () + (let ([l (sync receiver stop-chan)]) + (cond [(eq? l 'stop) + ;; we received all the events we were supposed + ;; to get, read them all (w/o waiting), then + ;; stop + (clear-events)] + [else ; keep going + (output-event l) + (loop)])))))]) + (begin0 + (parameterize ([current-logger logger]) + (proc)) + (channel-put stop-chan 'stop) ; stop the receiver thread + (thread-wait t)))) + +(provide/contract [with-logging-to-port + (-> output-port? + (or/c 'fatal 'error 'warning 'info 'debug) + (-> any) + any)]) diff --git a/collects/unstable/scribblings/logging.scrbl b/collects/unstable/scribblings/logging.scrbl new file mode 100644 index 0000000000..0348fc995b --- /dev/null +++ b/collects/unstable/scribblings/logging.scrbl @@ -0,0 +1,31 @@ +#lang scribble/manual + +@(require scribble/eval "utils.rkt" (for-label racket unstable/logging)) + +@title{Logging} + +@defmodule[unstable/logging] + +This module provides tools for logging. + +@unstable[@author+email["Vincent St-Amour" "stamourv@racket-lang.org"]] + +@defproc[(with-logging-to-port [port output-port?] + [level (or/c 'fatal 'error 'warning 'info 'debug)] + [proc (-> any)]) + any]{ + +Runs @racket[proc], outputting any logging of level @racket[level] or higher to +@racket[port]. Returns whatever @racket[proc] returns. + +@defexamples[ +#:eval (eval/require 'unstable/logging) +(let ([my-log (open-output-string)]) + (with-logging-to-port my-log 'warning + (lambda () + (log-warning "Warning World!") + (+ 2 2))) + (display (get-output-string my-log))) +] + +} diff --git a/collects/unstable/scribblings/unstable.scrbl b/collects/unstable/scribblings/unstable.scrbl index 331e5c74f2..250b2b9317 100644 --- a/collects/unstable/scribblings/unstable.scrbl +++ b/collects/unstable/scribblings/unstable.scrbl @@ -88,6 +88,7 @@ Keep documentation and tests up to date. @include-section["hash.scrbl"] @include-section["class-iop.scrbl"] ;; Interface-oriented Programming @include-section["list.scrbl"] +@include-section["logging.scrbl"] @include-section["markparam.scrbl"] @include-section["match.scrbl"] @include-section["net.scrbl"]