diff --git a/scribble-html-lib/scribble/html/html.rkt b/scribble-html-lib/scribble/html/html.rkt
index 9bd71e3f96..13f17758b8 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
@@ -186,11 +187,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/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/scribble/base-render.rkt b/scribble-lib/scribble/base-render.rkt
index 2c63b679e9..b5d094b42e 100644
--- a/scribble-lib/scribble/base-render.rkt
+++ b/scribble-lib/scribble/base-render.rkt
@@ -1,17 +1,17 @@
#lang racket/base
-(require "core.rkt"
- "private/render-utils.rkt"
+(require file/convertible
mzlib/class
mzlib/serialize
+ net/url-structs
racket/file
racket/path
setup/collects
setup/path-relativize
- file/convertible
- net/url-structs
- "render-struct.rkt"
- "manual-struct.rkt")
+ "core.rkt"
+ "manual-struct.rkt"
+ "private/render-utils.rkt"
+ "render-struct.rkt")
(provide render%
render<%>)
@@ -83,30 +83,25 @@
(not (ormap number? number))))
null]
[else
+ (define s
+ (string-append (apply string-append
+ (map (lambda (n)
+ (cond
+ [(number? n) (format "~a." n)]
+ [(or (not n) (string? n)) ""]
+ [(pair? n) (string-append (car n) (cadr n))]))
+ (reverse (cdr number))))
+ (if (and (car number) (not (equal? "" (car number))))
+ (if (pair? (car number))
+ (if keep-separator?
+ (string-append (caar number) (cadar number))
+ (caar number))
+ (format "~a." (car number)))
+ "")))
(define result-s
- (let ([s (string-append
- (apply
- string-append
- (map (lambda (n)
- (cond
- [(number? n) (format "~a." n)]
- [(or (not n) (string? n)) ""]
- [(pair? n) (string-append (car n) (cadr n))]))
- (reverse (cdr number))))
- (if (and (car number)
- (not (equal? "" (car number))))
- (if (pair? (car number))
- (if keep-separator?
- (string-append (caar number)
- (cadar number))
- (caar number))
- (format "~a." (car number)))
- ""))])
- (if (or keep-separator?
- (pair? (car number))
- (equal? s ""))
- s
- (substring s 0 (sub1 (string-length s))))))
+ (if (or keep-separator? (pair? (car number)) (equal? s ""))
+ s
+ (substring s 0 (sub1 (string-length s)))))
(if (equal? result-s "")
null
(cons result-s sep))]))
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/sigplan.rkt b/scribble-lib/scribble/sigplan.rkt
index d57ed2d5a6..6f1bd7e3bd 100644
--- a/scribble-lib/scribble/sigplan.rkt
+++ b/scribble-lib/scribble/sigplan.rkt
@@ -1,51 +1,26 @@
#lang racket/base
-(require setup/collects
+(require (for-syntax racket/base)
racket/contract/base
- scribble/core
scribble/base
+ scribble/core
scribble/decode
scribble/html-properties
scribble/latex-properties
- (for-syntax racket/base))
-
-(provide/contract
- [abstract
- (->* () () #:rest (listof pre-content?)
- block?)]
- [subtitle
- (->* () () #:rest (listof pre-content?)
- content?)]
- [authorinfo
- (-> pre-content? pre-content? pre-content?
- block?)]
- [conferenceinfo
- (-> pre-content? pre-content?
- block?)]
- [copyrightyear
- (->* () () #:rest (listof pre-content?)
- block?)]
- [copyrightdata
- (->* () () #:rest (listof pre-content?)
- block?)]
- [exclusive-license
- (->* () ()
- block?)]
- [doi
- (->* () () #:rest (listof pre-content?)
- block?)]
- [to-appear
- (->* () () #:rest pre-content?
- block?)]
- [category
- (->* (pre-content? pre-content? pre-content?)
- ((or/c #f pre-content?))
- content?)]
- [terms
- (->* () () #:rest (listof pre-content?)
- content?)]
- [keywords
- (->* () () #:rest (listof pre-content?)
- content?)])
+ setup/collects)
+
+(provide (contract-out
+ [abstract (->* () () #:rest (listof pre-content?) block?)]
+ [subtitle (->* () () #:rest (listof pre-content?) content?)]
+ [authorinfo (-> pre-content? pre-content? pre-content? block?)]
+ [conferenceinfo (-> pre-content? pre-content? block?)]
+ [copyrightyear (->* () () #:rest (listof pre-content?) block?)]
+ [copyrightdata (->* () () #:rest (listof pre-content?) block?)]
+ [exclusive-license (->* () () block?)]
+ [doi (->* () () #:rest (listof pre-content?) block?)]
+ [to-appear (->* () () #:rest pre-content? block?)]
+ [category (->* (pre-content? pre-content? pre-content?) ((or/c #f pre-content?)) content?)]
+ [terms (->* () () #:rest (listof pre-content?) content?)]
+ [keywords (->* () () #:rest (listof pre-content?) content?)]))
(provide preprint 10pt nocopyright onecolumn noqcourier notimes
include-abstract)
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?]