diff --git a/scribble-html-lib/scribble/html/html.rkt b/scribble-html-lib/scribble/html/html.rkt
index 9bd71e3f96..71f1b82977 100644
--- a/scribble-html-lib/scribble/html/html.rkt
+++ b/scribble-html-lib/scribble/html/html.rkt
@@ -186,11 +186,11 @@
(define-values [attrs body] (attributes+body args))
(make-element
'script attrs
- `("\n" ,(set-prefix 0 (apply cdata #:line-prefix "//" body)) "\n")))
+ (list "\n" (set-prefix 0 (apply cdata #:line-prefix "//" body)) "\n")))
(provide style/inline)
(define (style/inline . args)
(define-values [attrs body] (attributes+body args))
- (make-element 'style attrs `("\n" ,body "\n")))
+ (make-element 'style attrs (list "\n" body "\n")))
;; ----------------------------------------------------------------------------
;; Entities
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..51fa3b3ed3 100644
--- a/scribble-html-lib/scribble/html/xml.rkt
+++ b/scribble-html-lib/scribble/html/xml.rkt
@@ -106,16 +106,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/scribble/lp/lang/common.rkt b/scribble-lib/scribble/lp/lang/common.rkt
index 266e5c3589..396655a97b 100644
--- a/scribble-lib/scribble/lp/lang/common.rkt
+++ b/scribble-lib/scribble/lp/lang/common.rkt
@@ -24,7 +24,7 @@
(cons id (mapping-get chunk-groups id)))
(free-identifier-mapping-put!
chunks id
- `(,@(mapping-get chunks id) ,@exprs))))
+ (append (mapping-get chunks id) exprs))))
(define-syntax (tangle stx)
(define chunk-mentions '())
diff --git a/scribble-lib/scribble/racket.rkt b/scribble-lib/scribble/racket.rkt
index f2665c8130..1603971ef8 100644
--- a/scribble-lib/scribble/racket.rkt
+++ b/scribble-lib/scribble/racket.rkt
@@ -793,9 +793,8 @@
(out ". " (if (positive? quote-depth) value-color paren-color))
(set! src-col (+ src-col 3)))
(hash-set! next-col-map src-col dest-col)
- ((loop init-line! quote-depth first-expr? #f) l (if (and expr? (zero? quote-depth))
- srcless-step
- #f))]))
+ ((loop init-line! quote-depth first-expr? #f) l (and (and expr? (zero? quote-depth))
+ srcless-step))]))
(out (case sh
[(#\[) "]"]
[(#\{) "}"]
@@ -853,22 +852,24 @@
[col (if (= line (syntax-line (cdr p)))
col
col0)])
+ (define e
+ (syntax-ize (car p)
+ (max 0
+ (- (syntax-column (cdr p)) width sep))
+ (syntax-line (cdr p))
+ #:expr? (and expr? (zero? quote-depth))))
(define key
- (let ([e (syntax-ize (car p)
- (max 0 (- (syntax-column (cdr p))
- width
- sep))
- (syntax-line (cdr p))
- #:expr? (and expr? (zero? quote-depth)))])
- (if ((syntax-column e) . <= . col)
- e
- (datum->syntax #f
- (syntax-e e)
- (vector (syntax-source e)
- (syntax-line e)
- col
- (syntax-position e)
- (+ (syntax-span e) (- (syntax-column e) col)))))))
+ (if ((syntax-column e) . <= . col)
+ e
+ (datum->syntax #f
+ (syntax-e e)
+ (vector (syntax-source e)
+ (syntax-line e)
+ col
+ (syntax-position e)
+ (+ (syntax-span e)
+ (- (syntax-column e)
+ col))))))
(define elem
(datum->syntax
#f
@@ -885,11 +886,9 @@
;; constructed:
[(and expr? (zero? quote-depth))
(define l (apply append
- (map (lambda (p)
- (let ([p (syntax-e p)])
- (list (forced-pair-car p)
- (forced-pair-cdr p))))
- (reverse l2))))
+ (for/list ([p (in-list (reverse l2))])
+ (let ([p (syntax-e p)])
+ (list (forced-pair-car p) (forced-pair-cdr p))))))
(datum->syntax
#f
(cons (datum->syntax #f
diff --git a/scribble-test/tests/scribble/markdown.rkt b/scribble-test/tests/scribble/markdown.rkt
index 8cc7dd7033..cb16eb657a 100644
--- a/scribble-test/tests/scribble/markdown.rkt
+++ b/scribble-test/tests/scribble/markdown.rkt
@@ -10,14 +10,14 @@
"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 +40,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)))))
diff --git a/scribble-text-lib/scribble/text/output.rkt b/scribble-text-lib/scribble/text/output.rkt
index 027034b023..d2480f4034 100644
--- a/scribble-text-lib/scribble/text/output.rkt
+++ b/scribble-text-lib/scribble/text/output.rkt
@@ -112,11 +112,12 @@
(cond
[(pair? nls)
(define nl (car nls))
- (if (regexp-match? #rx"^ *$" x start (car nl))
- (newline p) ; only spaces before the end of the line
- (begin
- (output-pfx col pfx lpfx)
- (write x p start (cdr nl))))
+ (cond
+ [(regexp-match? #rx"^ *$" x start (car nl))
+ (newline p)] ; only spaces before the end of the line
+ [else
+ (output-pfx col pfx lpfx)
+ (write x p start (cdr nl))])
(loop (cdr nl) (cdr nls) 0 0)]
;; last substring from here (always set lpfx state when done)
[(start . = . len) (set-mcdr! pfxs lpfx)]
@@ -279,10 +280,7 @@
[(eq? p (car last)) (cdr last)]
[else
(define s
- (or (hash-ref t p #f)
- (let ([s (mcons 0 0)])
- (hash-set! t p s)
- s)))
+ (hash-ref! t p (λ () (mcons 0 0))))
(set! last (cons p s))
s]))))
diff --git a/scribble-text-lib/scribble/text/syntax-utils.rkt b/scribble-text-lib/scribble/text/syntax-utils.rkt
index 0577c13783..955ff8c1f7 100644
--- a/scribble-text-lib/scribble/text/syntax-utils.rkt
+++ b/scribble-text-lib/scribble/text/syntax-utils.rkt
@@ -145,23 +145,24 @@
(loop (append (syntax->list #'(x ...)) (cdr exprs)) ds es)]
[(define-syntaxes (id ...) rhs)
(andmap identifier? (syntax->list #'(id ...)))
- (if (null? es)
- (let ([ids (syntax->list #'(id ...))])
- (syntax-local-bind-syntaxes ids
- (local-transformer-expand #'rhs 'expression '())
- (car ctx))
- (loop (cdr exprs) (cons (rebuild-bindings) ds) es))
- ;; return the unexpanded expr, to be re-expanded later, in the
- ;; right contexts
- (values (reverse ds) (reverse es) exprs))]
+ (cond
+ [(null? es)
+ (define ids (syntax->list #'(id ...)))
+ (syntax-local-bind-syntaxes ids
+ (local-transformer-expand #'rhs 'expression '())
+ (car ctx))
+ (loop (cdr exprs) (cons (rebuild-bindings) ds) es)]
+ ;; return the unexpanded expr, to be re-expanded later, in the
+ ;; right contexts
+ [else (values (reverse ds) (reverse es) exprs)])]
[(define-values (id ...) rhs)
(andmap identifier? (syntax->list #'(id ...)))
- (if (null? es)
- (begin
- (syntax-local-bind-syntaxes (syntax->list #'(id ...)) #f (car ctx))
- (loop (cdr exprs) (cons (rebuild-bindings) ds) es))
- ;; same note here
- (values (reverse ds) (reverse es) exprs))]
+ (cond
+ [(null? es)
+ (syntax-local-bind-syntaxes (syntax->list #'(id ...)) #f (car ctx))
+ (loop (cdr exprs) (cons (rebuild-bindings) ds) es)]
+ ;; same note here
+ [else (values (reverse ds) (reverse es) exprs)])]
[_ (loop (cdr exprs) ds (cons expr* es))])])))
(define-syntax (begin/collect* stx) ; helper, has a boolean flag first
(define-values [exprs always-list?]