diff --git a/scribble-lib/scribble/base/lang.rkt b/scribble-lib/scribble/base/lang.rkt index f8411b65f6..8faa4a3862 100644 --- a/scribble-lib/scribble/base/lang.rkt +++ b/scribble-lib/scribble/base/lang.rkt @@ -1,5 +1,6 @@ #lang racket/base -(require scribble/doclang scribble/base) +(require scribble/base + scribble/doclang) (provide (all-from-out scribble/doclang scribble/base)) (module configure-runtime racket/base (require scribble/base/lang/configure-runtime)) diff --git a/scribble-lib/scribble/private/define-popup.rkt b/scribble-lib/scribble/private/define-popup.rkt index 946d02ca49..8e7fa40db5 100644 --- a/scribble-lib/scribble/private/define-popup.rkt +++ b/scribble-lib/scribble/private/define-popup.rkt @@ -13,21 +13,12 @@ [found-open? (cond [(char=? char #\}) - (regexp-replace - #rx"^[\n ]*" - (regexp-replace - #rx"[\n ]*$" - (apply string (reverse chars)) - "") - "")] - [else - (loop (+ pos 1) #t (cons char chars))])] - [else - (cond - [(char=? char #\{) - (loop (+ pos 1) #t '())] - [else - (loop (+ pos 1) #f '())])])] + (regexp-replace #rx"^[\n ]*" + (regexp-replace #rx"[\n ]*$" (apply string (reverse chars)) "") + "")] + [else (loop (+ pos 1) #t (cons char chars))])] + [(char=? char #\{) (loop (+ pos 1) #t '())] + [else (loop (+ pos 1) #f '())])] [else #f]))) (define define-popup diff --git a/scribble-lib/scriblib/figure.rkt b/scribble-lib/scriblib/figure.rkt index ff250b9585..fde186e560 100644 --- a/scribble-lib/scriblib/figure.rkt +++ b/scribble-lib/scriblib/figure.rkt @@ -1,13 +1,13 @@ #lang racket/base (require racket/contract/base - scribble/manual scribble/core scribble/decode scribble/html-properties scribble/latex-properties + scribble/manual + scribble/private/lang-parameters setup/main-collects - "private/counter.rkt" - scribble/private/lang-parameters) + "private/counter.rkt") (provide figure figure* diff --git a/scribble-lib/scriblib/footnote.rkt b/scribble-lib/scriblib/footnote.rkt index c40ad6972f..bfa31617fa 100644 --- a/scribble-lib/scriblib/footnote.rkt +++ b/scribble-lib/scriblib/footnote.rkt @@ -1,10 +1,10 @@ #lang racket/base -(require scribble/core +(require racket/promise + scribble/core scribble/decode scribble/html-properties scribble/latex-properties - racket/promise setup/main-collects "private/counter.rkt") @@ -44,27 +44,19 @@ (define (footnote-part . text) (do-footnote-part footnotes id)))) (define (do-footnote footnotes id text) - (let ([tag (generated-tag)] - [content (decode-content text)]) - (make-traverse-element - (lambda (get set) - (set id (cons (cons - (make-element footnote-target-style - (make-element - 'superscript - (counter-target footnotes tag #f))) + (define tag (generated-tag)) + (define content (decode-content text)) + (make-traverse-element + (lambda (get set) + (set id + (cons (cons (make-element footnote-target-style + (make-element 'superscript (counter-target footnotes tag #f))) content) - (get id null))) - (make-element footnote-style - (list - (make-element - footnote-ref-style - (make-element - 'superscript - (counter-ref footnotes tag #f))) - (make-element - footnote-content-style - content))))))) + (get id null))) + (make-element footnote-style + (list (make-element footnote-ref-style + (make-element 'superscript (counter-ref footnotes tag #f))) + (make-element footnote-content-style content)))))) (define (do-footnote-part footnotes id) (make-part @@ -78,9 +70,6 @@ (lambda (get set) (make-compound-paragraph footnote-block-style - (map (lambda (content) - (make-paragraph - footnote-block-content-style - content)) - (reverse (get id null))))))) + (for/list ([content (in-list (reverse (get id null)))]) + (make-paragraph footnote-block-content-style content)))))) null)) diff --git a/scribble-lib/scriblib/gui-eval.rkt b/scribble-lib/scriblib/gui-eval.rkt index 69b3ee3576..bb8e7c661d 100644 --- a/scribble-lib/scriblib/gui-eval.rkt +++ b/scribble-lib/scriblib/gui-eval.rkt @@ -1,39 +1,37 @@ #lang racket/base -(require scribble/eval - scribble/core - scribble/scheme +(require (for-syntax racket/base) racket/class racket/file racket/runtime-path + racket/sandbox racket/serialize - "private/gui-eval-exn.rkt" racket/system - racket/sandbox - (for-syntax racket/base)) + scribble/core + scribble/eval + scribble/scheme + "private/gui-eval-exn.rkt") -(define-syntax define-mr - (syntax-rules () - [(_ mr orig) - (begin - (provide mr) - (define-syntax (mr stx) - (syntax-case stx () - [(_ #:eval+opts the-eval get-predicate? get-render get-get-width get-get-height x (... ...)) - #'(let ([the-eval-x the-eval]) - (parameterize ([scribble-eval-handler (gui-eval-handler the-eval-x - get-predicate? - get-render - get-get-width - get-get-height)]) - (orig #:eval the-eval-x x (... ...))))] - [(_ x (... ...)) - #'(parameterize ([scribble-eval-handler (gui-eval-handler gui-eval - (λ () (gui-eval 'pict?)) - (λ () (gui-eval 'draw-pict)) - (λ () (gui-eval 'pict-width)) - (λ () (gui-eval 'pict-height)))]) - (orig #:eval gui-eval x (... ...)))])))])) +(define-syntax-rule (define-mr mr orig) + (begin + (provide mr) + (define-syntax (mr stx) + (syntax-case stx () + [(_ #:eval+opts the-eval get-predicate? get-render get-get-width get-get-height x (... ...)) + #'(let ([the-eval-x the-eval]) + (parameterize ([scribble-eval-handler (gui-eval-handler the-eval-x + get-predicate? + get-render + get-get-width + get-get-height)]) + (orig #:eval the-eval-x x (... ...))))] + [(_ x (... ...)) + #'(parameterize ([scribble-eval-handler (gui-eval-handler gui-eval + (λ () (gui-eval 'pict?)) + (λ () (gui-eval 'draw-pict)) + (λ () (gui-eval 'pict-width)) + (λ () (gui-eval 'pict-height)))]) + (orig #:eval gui-eval x (... ...)))])))) (define gui-eval (make-base-eval #:pretty-print? #f)) @@ -68,61 +66,61 @@ "exprs.dat")) (define gui-eval-handler - (if mred? - (let ([eh (scribble-eval-handler)] - [log-file (open-output-file exprs-dat-file #:exists 'truncate/replace)]) - (λ (gui-eval get-predicate? get-render get-get-width get-get-height) - (lambda (ev catching-exns? expr) - (write (serialize (if (syntax? expr) (syntax->datum expr) expr)) log-file) - (newline log-file) - (flush-output log-file) - (let ([result - (with-handlers ([exn:fail? - (lambda (exn) - (make-gui-exn (exn-message exn)))]) - ;; put the call to fixup-picts in the handlers - ;; so that errors in the user-supplied predicates & - ;; conversion functions show up in the rendered output - (fixup-picts (get-predicate?) (get-render) (get-get-width) (get-get-height) - (eh ev catching-exns? expr)))]) - (write (serialize result) log-file) - (newline log-file) - (flush-output log-file) - (if (gui-exn? result) - (raise (make-exn:fail - (gui-exn-message result) - (current-continuation-marks))) - result))))) - (let ([log-file (with-handlers ([exn:fail:filesystem? - (lambda (exn) - (open-input-string ""))]) - (open-input-file exprs-dat-file))]) - (λ (gui-eval get-predicate? get-render get-get-width get-get-height) - (lambda (ev catching-exns? expr) - (with-handlers ([exn:fail? (lambda (exn) - (if catching-exns? - (raise exn) - (void)))]) - (let ([v (read log-file)]) - (if (eof-object? v) - (error "expression not in log file") - (let ([v (deserialize v)]) - (if (equal? v (if (syntax? expr) - (syntax->datum expr) - expr)) - (let ([v (read log-file)]) - (if (eof-object? v) - (error "expression result missing in log file") - (let ([v (deserialize v)]) - (if (gui-exn? v) - (raise (make-exn:fail - (gui-exn-message v) - (current-continuation-marks))) - v)))) - (error 'mreval - "expression does not match log file: ~e versus: ~e" - expr - v))))))))))) + (cond + [mred? + (define eh (scribble-eval-handler)) + (define log-file (open-output-file exprs-dat-file #:exists 'truncate/replace)) + (λ (gui-eval get-predicate? get-render get-get-width get-get-height) + (lambda (ev catching-exns? expr) + (write (serialize (if (syntax? expr) + (syntax->datum expr) + expr)) + log-file) + (newline log-file) + (flush-output log-file) + (define result + (with-handlers ([exn:fail? (lambda (exn) (make-gui-exn (exn-message exn)))]) + ;; put the call to fixup-picts in the handlers + ;; so that errors in the user-supplied predicates & + ;; conversion functions show up in the rendered output + (fixup-picts (get-predicate?) + (get-render) + (get-get-width) + (get-get-height) + (eh ev catching-exns? expr)))) + (write (serialize result) log-file) + (newline log-file) + (flush-output log-file) + (if (gui-exn? result) + (raise (make-exn:fail (gui-exn-message result) (current-continuation-marks))) + result)))] + [else + (define log-file + (with-handlers ([exn:fail:filesystem? (lambda (exn) (open-input-string ""))]) + (open-input-file exprs-dat-file))) + (λ (gui-eval get-predicate? get-render get-get-width get-get-height) + (lambda (ev catching-exns? expr) + (with-handlers ([exn:fail? (lambda (exn) + (when catching-exns? + (raise exn)) + (void))]) + (define v (read log-file)) + (if (eof-object? v) + (error "expression not in log file") + (let ([v (deserialize v)]) + (if (equal? v + (if (syntax? expr) + (syntax->datum expr) + expr)) + (let ([v (read log-file)]) + (if (eof-object? v) + (error "expression result missing in log file") + (let ([v (deserialize v)]) + (if (gui-exn? v) + (raise (make-exn:fail (gui-exn-message v) + (current-continuation-marks))) + v)))) + (error 'mreval "expression does not match log file: ~e versus: ~e" expr v)))))))])) (define image-counter 0) @@ -133,41 +131,40 @@ (let loop ([v v]) (cond [(predicate? v) - (let ([fn (build-string-path img-dir - (format "img~a.png" image-counter))]) - (set! image-counter (add1 image-counter)) - (let ([dc (let ([pss (make-object (gui-eval 'ps-setup%))]) - (send pss set-mode 'file) - (send pss set-file (path-replace-suffix fn #".pdf")) - (parameterize ([(gui-eval 'current-ps-setup) pss]) - (let ([xb (box 0)] - [yb (box 0)]) - (send pss get-scaling xb yb) - (new (gui-eval 'pdf-dc%) - [interactive #f] - [width (* (unbox xb) (get-width v))] - [height (* (unbox yb) (get-height v))]))))]) - (send dc start-doc "Image") - (send dc start-page) - (render v dc 0 0) - (send dc end-page) - (send dc end-doc)) - (let* ([bm (make-object (gui-eval 'bitmap%) + (define fn (build-string-path img-dir (format "img~a.png" image-counter))) + (set! image-counter (add1 image-counter)) + (let ([dc (let ([pss (make-object (gui-eval 'ps-setup%))]) + (send pss set-mode 'file) + (send pss set-file (path-replace-suffix fn #".pdf")) + (parameterize ([(gui-eval 'current-ps-setup) pss]) + (let ([xb (box 0)] + [yb (box 0)]) + (send pss get-scaling xb yb) + (new (gui-eval 'pdf-dc%) + [interactive #f] + [width (* (unbox xb) (get-width v))] + [height (* (unbox yb) (get-height v))]))))]) + (send dc start-doc "Image") + (send dc start-page) + (render v dc 0 0) + (send dc end-page) + (send dc end-doc)) + (define bm + (make-object (gui-eval 'bitmap%) (inexact->exact (ceiling (get-width v))) - (inexact->exact (ceiling (get-height v))))] - [dc (make-object (gui-eval 'bitmap-dc%) bm)]) - (send dc set-smoothing 'aligned) - (send dc clear) - (render v dc 0 0) - (send bm save-file fn 'png) - (make-image-element - #f - (list "[image]") - ;; Be sure to use a string rather than a path, because - ;; it gets recorded in "exprs.dat". - (path->string (path-replace-suffix fn #"")) - '(".pdf" ".png") - 1.0)))] + (inexact->exact (ceiling (get-height v))))) + (define dc (make-object (gui-eval 'bitmap-dc%) bm)) + (send dc set-smoothing 'aligned) + (send dc clear) + (render v dc 0 0) + (send bm save-file fn 'png) + (make-image-element #f + (list "[image]") + ;; Be sure to use a string rather than a path, because + ;; it gets recorded in "exprs.dat". + (path->string (path-replace-suffix fn #"")) + '(".pdf" ".png") + 1.0)] [(pair? v) (cons (loop (car v)) (loop (cdr v)))] [(serializable? v) v] diff --git a/scribble-lib/scriblib/render-cond.rkt b/scribble-lib/scriblib/render-cond.rkt index b76eabd8ea..afe7422069 100644 --- a/scribble-lib/scriblib/render-cond.rkt +++ b/scribble-lib/scriblib/render-cond.rkt @@ -1,6 +1,6 @@ #lang racket/base -(require scribble/core - (for-syntax racket/base)) +(require (for-syntax racket/base) + scribble/core) (provide cond-element cond-block) diff --git a/scribble-test/tests/scribble/main.rkt b/scribble-test/tests/scribble/main.rkt index cb542ae1ee..3e23cbe883 100644 --- a/scribble-test/tests/scribble/main.rkt +++ b/scribble-test/tests/scribble/main.rkt @@ -1,8 +1,14 @@ #lang racket/base (require tests/eli-tester - "reader.rkt" "text-collect.rkt" "text-lang.rkt" "text-wrap.rkt" - "docs.rkt" "render.rkt" "xref.rkt" "markdown.rkt") + "docs.rkt" + "markdown.rkt" + "reader.rkt" + "render.rkt" + "text-collect.rkt" + "text-lang.rkt" + "text-wrap.rkt" + "xref.rkt") (test do (reader-tests) do (begin/collect-tests) diff --git a/scribble-test/tests/scribble/markdown.rkt b/scribble-test/tests/scribble/markdown.rkt index 8cc7dd7033..8de726a003 100644 --- a/scribble-test/tests/scribble/markdown.rkt +++ b/scribble-test/tests/scribble/markdown.rkt @@ -2,22 +2,26 @@ ;; Use text renderer to check some Scribble functionality -(require scribble/base-render (prefix-in markdown: scribble/markdown-render) - racket/file racket/class racket/runtime-path tests/eli-tester) +(require racket/class + racket/file + racket/runtime-path + scribble/base-render + tests/eli-tester + (prefix-in markdown: scribble/markdown-render)) (define-runtime-path source-dir "markdown-docs") (define work-dir (build-path (find-system-path 'temp-dir) "scribble-docs-tests")) (define (build-markdown-doc src-file dest-file) - (let* ([renderer (new (markdown:render-mixin render%) [dest-dir work-dir])] - [docs (list (dynamic-require src-file 'doc))] - [fns (list (build-path work-dir dest-file))] - [fp (send renderer traverse docs fns)] - [info (send renderer collect docs fns fp)] - [r-info (send renderer resolve docs fns info)]) - (send renderer render docs fns r-info) - (send renderer get-undefined r-info))) + (define renderer (new (markdown:render-mixin render%) [dest-dir work-dir])) + (define docs (list (dynamic-require src-file 'doc))) + (define fns (list (build-path work-dir dest-file))) + (define fp (send renderer traverse docs fns)) + (define info (send renderer collect docs fns fp)) + (define r-info (send renderer resolve docs fns info)) + (send renderer render docs fns r-info) + (send renderer get-undefined r-info)) (provide markdown-tests) (module+ main (markdown-tests)) @@ -40,11 +44,9 @@ (define (contents file) (regexp-replace #rx"\n+$" (file->string file) "")) (define undefineds (build-markdown-doc src-file "gen.md")) - (for ([u (in-list undefineds)]) - (when (eq? 'tech (car u)) - (test #:failure-message - (format "undefined tech: ~e" u) - #f))) + (for ([u (in-list undefineds)] + #:when (eq? 'tech (car u))) + (test #:failure-message (format "undefined tech: ~e" u) #f)) (test #:failure-message (format "mismatch for: \"~a\", expected text in: \"~a\", got:\n~a" diff --git a/scribble-test/tests/scribble/reader.rkt b/scribble-test/tests/scribble/reader.rkt index 1fa756db15..ed0627b692 100644 --- a/scribble-test/tests/scribble/reader.rkt +++ b/scribble-test/tests/scribble/reader.rkt @@ -947,14 +947,14 @@ END-OF-TESTS (define m (or (regexp-match #px"^(.*)\n\\s*(-\\S+->)\\s*\n(.*)$" t) (regexp-match #px"^(.*\\S)\\s+(-\\S+->)\\s+(\\S.*)$" t))) - (if (not (and m (= 4 (length m)))) - (error 'bad-test "~a" t) - (let-values ([(x y) ((string->tester (caddr m)) (cadr m) (cadddr m))]) - (test #:failure-message (format "bad result in\n ~a\n results:\n ~s != ~s" - (regexp-replace* #rx"\n" t "\n ") - x - y) - (matching? x y))))))) + (unless (and m (= 4 (length m))) + (error 'bad-test "~a" t)) + (let-values ([(x y) ((string->tester (caddr m)) (cadr m) (cadddr m))]) + (test #:failure-message (format "bad result in\n ~a\n results:\n ~s != ~s" + (regexp-replace* #rx"\n" t "\n ") + x + y) + (matching? x y)))))) ;; Check static versus dynamic readtable for command (dynamic when "c" in the ;; name) and datum (dynamic when "d" in the name) parts: diff --git a/scribble-test/tests/scribble/text-lang.rkt b/scribble-test/tests/scribble/text-lang.rkt index 364821b279..1f886cb469 100644 --- a/scribble-test/tests/scribble/text-lang.rkt +++ b/scribble-test/tests/scribble/text-lang.rkt @@ -67,4 +67,4 @@ (call-with-trusted-sandbox-configuration (lambda () (for ([t (in-list (doc:tests))]) - (begin (apply text-test t)))))) + (apply text-test t)))))