diff --git a/scribble-html-lib/scribble/html/html.rkt b/scribble-html-lib/scribble/html/html.rkt
index 9bd71e3f96..5de0684ec0 100644
--- a/scribble-html-lib/scribble/html/html.rkt
+++ b/scribble-html-lib/scribble/html/html.rkt
@@ -5,7 +5,8 @@
;; https://html.spec.whatwg.org/multipage/#toc-semantics
;; Put esoteric elements in scribble/html/extra
-(require "xml.rkt" scribble/text)
+(require scribble/text
+ "xml.rkt")
;; ----------------------------------------------------------------------------
;; Doctype line
diff --git a/scribble-html-lib/scribble/html/lang.rkt b/scribble-html-lib/scribble/html/lang.rkt
index 3caefb4a32..07b315711f 100644
--- a/scribble-html-lib/scribble/html/lang.rkt
+++ b/scribble-html-lib/scribble/html/lang.rkt
@@ -1,7 +1,8 @@
#lang racket/base
-(require "main.rkt" (except-in scribble/text/lang #%top)
- scribble/text/syntax-utils)
+(require scribble/text/syntax-utils
+ (except-in scribble/text/lang #%top)
+ "main.rkt")
(provide (except-out (all-from-out scribble/text/lang) #%module-begin)
(rename-out [module-begin #%module-begin])
diff --git a/scribble-html-lib/scribble/html/resource.rkt b/scribble-html-lib/scribble/html/resource.rkt
index 454ff63393..8923f7c00c 100644
--- a/scribble-html-lib/scribble/html/resource.rkt
+++ b/scribble-html-lib/scribble/html/resource.rkt
@@ -57,11 +57,10 @@
(set! cached-roots
(cons roots
(and (list? roots) (pair? roots)
- (map (lambda (root)
- (list* (regexp-match* #rx"[^/]+" (car root))
- (regexp-replace #rx"/$" (cadr root) "")
- (cddr root)))
- roots)))))
+ (for/list ([root (in-list roots)])
+ (list* (regexp-match* #rx"[^/]+" (car root))
+ (regexp-replace #rx"/$" (cadr root) "")
+ (cddr root)))))))
(cdr cached-roots))
;; a utility for relative paths, taking the above `default-file' and
@@ -70,22 +69,23 @@
(define file* (if (equal? file default-file) "" file))
(define roots (current-url-roots))
(define (find-root path mode)
- (ormap (lambda (root+url+flags)
- (let loop ([r (car root+url+flags)] [p path])
- (if (pair? r)
- (and (pair? p) (equal? (car p) (car r))
- (loop (cdr r) (cdr p)))
- (case mode
- [(get-path) `(,(cadr root+url+flags)
- ,@p
- ,(if (and (equal? file* "")
- (memq 'index (cddr root+url+flags)))
- default-file
- file*))]
- [(get-abs-or-true)
- (if (memq 'abs (cddr root+url+flags)) `("" ,@p) #t)]
- [else (error 'relativize "internal error: ~e" mode)]))))
- roots))
+ (for/or ([root+url+flags (in-list roots)])
+ (let loop ([r (car root+url+flags)]
+ [p path])
+ (if (pair? r)
+ (and (pair? p) (equal? (car p) (car r)) (loop (cdr r) (cdr p)))
+ (case mode
+ [(get-path)
+ `(,(cadr root+url+flags) ,@p
+ ,(if (and (equal? file* "")
+ (memq 'index (cddr root+url+flags)))
+ default-file
+ file*))]
+ [(get-abs-or-true)
+ (if (memq 'abs (cddr root+url+flags))
+ `("" ,@p)
+ #t)]
+ [else (error 'relativize "internal error: ~e" mode)])))))
(define result
(let loop ([t tgtdir] [c curdir] [pfx '()])
(cond
@@ -165,9 +165,11 @@
(define t (make-hash))
(define-syntax-rule (S body) (call-with-semaphore s (lambda () body)))
(values (lambda (path renderer)
- (S (if (hash-ref t path #f)
- (error 'resource "path used for two resources: ~e" path)
- (begin (hash-set! t path #t) (set! l (cons renderer l))))))
+ (S (cond
+ [(hash-ref t path #f) (error 'resource "path used for two resources: ~e" path)]
+ [else
+ (hash-set! t path #t)
+ (set! l (cons renderer l))])))
(lambda () (S (begin0 (reverse l) (set! l '())))))))
;; `#:exists' determines what happens when the render destination exists, it
@@ -180,32 +182,33 @@
(define (resource path0 renderer #:exists [exists 'delete-file])
(define (bad reason) (error 'resource "bad path, ~a: ~e" reason path0))
(unless (string? path0) (bad "must be a string"))
- (for ([x (in-list '([#rx"^/" "must be relative"]
- [#rx"//" "must not have empty elements"]
- [#rx"(?:^|/)[.][.]?(?:/|$)"
- "must not contain `.' or `..'"]))])
- (when (regexp-match? (car x) path0) (bad (cadr x))))
+ (for ([x (in-list '([#rx"^/" "must be relative"] [#rx"//" "must not have empty elements"]
+ [#rx"(?:^|/)[.][.]?(?:/|$)"
+ "must not contain `.' or `..'"]))]
+ #:when (regexp-match? (car x) path0))
+ (bad (cadr x)))
(define path (regexp-replace #rx"(?<=^|/)$" path0 default-file))
(define-values [dirpathlist filename]
(let-values ([(l r) (split-at-right (regexp-split #rx"/" path) 1)])
(values l (car r))))
(define (render)
(let loop ([ps dirpathlist])
- (if (pair? ps)
- (begin (unless (directory-exists? (car ps))
- (if (or (file-exists? (car ps)) (link-exists? (car ps)))
- (bad "exists as a file/link")
- (make-directory (car ps))))
- (parameterize ([current-directory (car ps)])
- (loop (cdr ps))))
- (begin (cond [(not exists)] ; do nothing
- [(or (file-exists? filename) (link-exists? filename))
- (delete-file filename)]
- [(directory-exists? filename)
- (bad "exists as directory")])
- (parameterize ([rendered-dirpath dirpathlist])
- (printf " ~a\n" path)
- (renderer filename))))))
+ (cond
+ [(pair? ps)
+ (unless (directory-exists? (car ps))
+ (if (or (file-exists? (car ps)) (link-exists? (car ps)))
+ (bad "exists as a file/link")
+ (make-directory (car ps))))
+ (parameterize ([current-directory (car ps)])
+ (loop (cdr ps)))]
+ [else
+ (cond
+ [(not exists)] ; do nothing
+ [(or (file-exists? filename) (link-exists? filename)) (delete-file filename)]
+ [(directory-exists? filename) (bad "exists as directory")])
+ (parameterize ([rendered-dirpath dirpathlist])
+ (printf " ~a\n" path)
+ (renderer filename))])))
(define absolute-url
(lazy (define url (relativize filename dirpathlist '()))
(if (url-roots)
diff --git a/scribble-html-lib/scribble/html/xml.rkt b/scribble-html-lib/scribble/html/xml.rkt
index 6e4f416f96..5f92811410 100644
--- a/scribble-html-lib/scribble/html/xml.rkt
+++ b/scribble-html-lib/scribble/html/xml.rkt
@@ -2,7 +2,8 @@
;; XML-like objects and functions, with rendering
-(require scribble/text racket/port)
+(require racket/port
+ scribble/text)
;; ----------------------------------------------------------------------------
;; Represent attribute names as `foo:' symbols. They are made self-quoting in
@@ -106,16 +107,14 @@
;; null body means a lone tag, tags that should always have a closer will
;; have a '(#f) as their body (see below)
(list (with-writer #f "<" tag)
- (map (lambda (attr)
- (define name (car attr))
- (define val (cdr attr))
- (cond [(not val) #f]
- ;; #t means just mention the attribute
- [(eq? #t val) (with-writer #f (list " " name))]
- [else (list (with-writer #f (list " " name "=\""))
- val
- (with-writer #f "\""))]))
- attrs)
+ (for/list ([attr (in-list attrs)])
+ (define name (car attr))
+ (define val (cdr attr))
+ (cond
+ [(not val) #f]
+ ;; #t means just mention the attribute
+ [(eq? #t val) (with-writer #f (list " " name))]
+ [else (list (with-writer #f (list " " name "=\"")) val (with-writer #f "\""))]))
(if (null? body)
(with-writer #f " />")
(list (with-writer #f ">")
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..a1dc5eb652 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,63 @@
"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)
+ (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))))]
+ [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)
+ (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))))))))]))
(define image-counter 0)
@@ -133,41 +133,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/scriblib/autobib.rkt b/scribble-test/tests/scriblib/autobib.rkt
index 560bc0515f..000afd2126 100644
--- a/scribble-test/tests/scriblib/autobib.rkt
+++ b/scribble-test/tests/scriblib/autobib.rkt
@@ -1,6 +1,9 @@
#lang racket/base
-(require rackunit scriblib/autobib scribble/base scribble/core)
+(require rackunit
+ scribble/base
+ scribble/core
+ scriblib/autobib)
(test-case "define-cite"
;; Check that `define-cite` binds the expected identifiers
diff --git a/scribble-test/tests/scriblib/bibtex.rkt b/scribble-test/tests/scriblib/bibtex.rkt
index 04cc5ee1e7..ec2674c28f 100644
--- a/scribble-test/tests/scriblib/bibtex.rkt
+++ b/scribble-test/tests/scriblib/bibtex.rkt
@@ -1,9 +1,9 @@
#lang racket
(require racket/runtime-path
- tests/eli-tester
- scriblib/bibtex
- scriblib/autobib
scribble/render
+ scriblib/autobib
+ scriblib/bibtex
+ tests/eli-tester
(prefix-in text: scribble/text-render))
(define-runtime-path example.bib "example.bib")