Some styling.
original commit: 75f710dc62c8c5a1ce04f22b6c37a4c611a3445e
This commit is contained in:
Eli Barzilay
parent
9650c4767b
commit
5cb1ba3a4a
|
|
@ -22,7 +22,7 @@
|
|||
;; resource that uses this value. Creating a resource registers the `renderer'
|
||||
;; to be executed when rendering is initiated by `render-all'. Note that more
|
||||
;; resources can be created while rendering; they will also be rendered in turn
|
||||
;; until no more resources are created.
|
||||
;; until no more new resources are created.
|
||||
|
||||
(require scribble/text)
|
||||
|
||||
|
|
@ -34,12 +34,13 @@
|
|||
(define rendered-dirpath (make-parameter '()))
|
||||
|
||||
;; A mapping from path prefixes to urls (actually, any string) -- when two
|
||||
;; paths are in the same prefix, links from one to the other are relative, but
|
||||
;; if they're in different prefixes, the url will be used instead; the roots
|
||||
;; are expected to be disjoint (= no "/foo" and "/foo/bar" roots).
|
||||
;; Additionally, optional symbol flags can appear in each entry, currently only
|
||||
;; 'abs is used below for roots that should always use absolute links (needed
|
||||
;; for some skeleton pages that are used in nested subdirectories).
|
||||
;; paths are in the same prefix, links from one to the other are relative
|
||||
;; (unless absolute links are requested) , but if they're in different
|
||||
;; prefixes, the url will be used instead; the roots are expected to be
|
||||
;; disjoint (= no "/foo" and "/foo/bar" roots). Additionally, optional symbol
|
||||
;; flags can appear in each entry, currently only 'abs is used below for roots
|
||||
;; that should always use absolute links (needed for some skeleton pages that
|
||||
;; are used in nested subdirectories).
|
||||
(provide url-roots)
|
||||
(define url-roots (make-parameter #f))
|
||||
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
(provide output)
|
||||
|
||||
;; Outputs some value for the `scribble/text' language:
|
||||
;; Outputs values for the `scribble/text' language:
|
||||
;; - several atomic values are printed as in `display',
|
||||
;; - promises, thunks, and boxes are indirections for the value they contain
|
||||
;; (useful in various cases),
|
||||
|
|
@ -87,12 +87,12 @@
|
|||
[nls (regexp-match-positions* #rx"\n" x)])
|
||||
(let loop ([start 0] [nls nls] [lpfx (mcdr pfxs)] [col (getcol)])
|
||||
(cond [(pair? nls)
|
||||
(let ([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))))
|
||||
(loop (cdr nl) (cdr nls) 0 0))]
|
||||
(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))))
|
||||
(loop (cdr nl) (cdr nls) 0 0)]
|
||||
;; last substring from here (always set lpfx state when done)
|
||||
[(start . = . len)
|
||||
(set-mcdr! pfxs lpfx)]
|
||||
|
|
@ -101,23 +101,24 @@
|
|||
;; the prefix was already shown, no accumulation needed
|
||||
(write x p start)]
|
||||
[else
|
||||
(let ([m (regexp-match-positions #rx"^ +" x start)])
|
||||
;; accumulate spaces to lpfx, display if it's not all spaces
|
||||
(let ([lpfx (if m (pfx+ lpfx (- (cdar m) (caar m))) lpfx)])
|
||||
(set-mcdr! pfxs lpfx)
|
||||
(unless (and m (= len (cdar m)))
|
||||
(output-pfx col pfx lpfx)
|
||||
;; the spaces were already added to lpfx
|
||||
(write x p (if m (cdar m) start)))))])))))
|
||||
(define m (regexp-match-positions #rx"^ +" x start))
|
||||
;; accumulate spaces to lpfx, display if it's not all spaces
|
||||
(define lpfx* (if m (pfx+ lpfx (- (cdar m) (caar m))) lpfx))
|
||||
(set-mcdr! pfxs lpfx*)
|
||||
(unless (and m (= len (cdar m)))
|
||||
(output-pfx col pfx lpfx*)
|
||||
;; the spaces were already added to lpfx
|
||||
(write x p (if m (cdar m) start)))])))))
|
||||
;; blocks and splices
|
||||
(define (output-block c)
|
||||
(let* ([pfx (mcar pfxs)] [lpfx (mcdr pfxs)]
|
||||
[npfx (pfx+col (pfx+ pfx lpfx))])
|
||||
(set-mcar! pfxs npfx) (set-mcdr! pfxs 0)
|
||||
(if (list? c)
|
||||
(for ([c (in-list c)]) (loop c))
|
||||
(begin (loop (car c)) (loop (cdr c))))
|
||||
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx)))
|
||||
(define pfx (mcar pfxs))
|
||||
(define lpfx (mcdr pfxs))
|
||||
(define npfx (pfx+col (pfx+ pfx lpfx)))
|
||||
(set-mcar! pfxs npfx) (set-mcdr! pfxs 0)
|
||||
(if (list? c)
|
||||
(for ([c (in-list c)]) (loop c))
|
||||
(begin (loop (car c)) (loop (cdr c))))
|
||||
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx))
|
||||
(define (output-splice c)
|
||||
(for-each loop c))
|
||||
;; main loop
|
||||
|
|
@ -136,92 +137,97 @@
|
|||
[(box? x) (loop (unbox x))]
|
||||
;; special output wrappers
|
||||
[(special? x)
|
||||
(let ([c (special-contents x)])
|
||||
(case (special-flag x)
|
||||
;; preserve tailness & avoid `set!' for blocks/splices if possible
|
||||
[(block) (if list=block?
|
||||
(output-block c)
|
||||
(begin (set! list=block? #t)
|
||||
(output-block c)
|
||||
(set! list=block? #f)))]
|
||||
[(splice) (if list=block?
|
||||
(begin (set! list=block? #f)
|
||||
(output-splice c)
|
||||
(set! list=block? #t))
|
||||
(output-splice c))]
|
||||
[(flush) ; useful before `disable-prefix'
|
||||
(output-pfx (getcol) (mcar pfxs) (mcdr pfxs))]
|
||||
[(disable-prefix) ; save the previous pfxs
|
||||
(let ([pfx (mcar pfxs)] [lpfx (mcdr pfxs)])
|
||||
(set-mcar! pfxs #f) (set-mcdr! pfxs (cons pfx lpfx))
|
||||
(for-each loop c)
|
||||
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx))]
|
||||
[(restore-prefix) ; restore the previous pfxs
|
||||
(let* ([pfx (mcar pfxs)] [lpfx (mcdr pfxs)]
|
||||
[npfx (pfx+col (if (and (not pfx) (pair? lpfx))
|
||||
(pfx+ (car lpfx) (cdr lpfx))
|
||||
(pfx+ pfx lpfx)))])
|
||||
(set-mcar! pfxs npfx) (set-mcdr! pfxs 0)
|
||||
(for-each loop c)
|
||||
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx))]
|
||||
[(add-prefix) ; add to the current prefix (unless it's #f)
|
||||
(let* ([pfx (mcar pfxs)] [lpfx (mcdr pfxs)]
|
||||
[npfx (pfx+ (pfx+col (pfx+ pfx lpfx)) (car c))])
|
||||
(set-mcar! pfxs npfx) (set-mcdr! pfxs 0)
|
||||
(for-each loop (cdr c))
|
||||
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx))]
|
||||
[(set-prefix)
|
||||
(let ([pfx (mcar pfxs)] [lpfx (mcdr pfxs)])
|
||||
(set-mcar! pfxs (car c)) (set-mcdr! pfxs 0)
|
||||
(for-each loop (cdr c))
|
||||
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx))]
|
||||
[(with-writer)
|
||||
(let ([old write])
|
||||
(set! write (or (car c) write-string))
|
||||
(for-each loop (cdr c))
|
||||
(set! write old))]
|
||||
#; ; no need for this hack yet
|
||||
[(with-writer-change)
|
||||
;; The function gets the old writer and return a new one (useful to
|
||||
;; save the current writer and restore it inside). Could also be
|
||||
;; used to extend a writer, but that shows why a customizable
|
||||
;; writer is a bad choice: instead, it should be a list of
|
||||
;; substitutions that can be extended more conveniently. A simple
|
||||
;; implementation would be to chain functions that do
|
||||
;; substitutions. But that runs into problems when functions want
|
||||
;; to substitute the same thing, and worse: when the output of one
|
||||
;; function would get substituted again by another. Another
|
||||
;; approach would be to join matcher regexps with "|" after
|
||||
;; wrapping each one with parens, then find out which one matched
|
||||
;; by looking at the result and applying its substitution, but the
|
||||
;; problem with that is that is that it forbids having parens in
|
||||
;; the regexps -- this could be fixed by not parenthesizing each
|
||||
;; expression, and instead running the found match against each of
|
||||
;; the input regexps to find the matching one, but that can be very
|
||||
;; inefficient. Yet another issue is that in some cases we might
|
||||
;; *want* the "worse" feature mentioned earlier: for example, when
|
||||
;; we want to do some massaging of the input texts yet still have
|
||||
;; the result encoded for HTML output -- so perhaps the simple
|
||||
;; approach is still better. The only difference from the current
|
||||
;; `with-writer' is using a substituting function, so it can be
|
||||
;; composed with the current one instead of replacing it
|
||||
;; completely.
|
||||
(let ([old write])
|
||||
(set! write ((car c) write))
|
||||
(for-each loop (cdr c))
|
||||
(set! write old))]
|
||||
[else (error 'output "unknown special value flag: ~e"
|
||||
(special-flag x))]))]
|
||||
(define c (special-contents x))
|
||||
(case (special-flag x)
|
||||
;; preserve tailness & avoid `set!' for blocks/splices if possible
|
||||
[(block) (if list=block?
|
||||
(output-block c)
|
||||
(begin (set! list=block? #t)
|
||||
(output-block c)
|
||||
(set! list=block? #f)))]
|
||||
[(splice) (if list=block?
|
||||
(begin (set! list=block? #f)
|
||||
(output-splice c)
|
||||
(set! list=block? #t))
|
||||
(output-splice c))]
|
||||
[(flush) ; useful before `disable-prefix'
|
||||
(output-pfx (getcol) (mcar pfxs) (mcdr pfxs))]
|
||||
[(disable-prefix) ; save the previous pfxs
|
||||
(define pfx (mcar pfxs))
|
||||
(define lpfx (mcdr pfxs))
|
||||
(set-mcar! pfxs #f) (set-mcdr! pfxs (cons pfx lpfx))
|
||||
(for-each loop c)
|
||||
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx)]
|
||||
[(restore-prefix) ; restore the previous pfxs
|
||||
(define pfx (mcar pfxs))
|
||||
(define lpfx (mcdr pfxs))
|
||||
(define npfx (pfx+col (if (and (not pfx) (pair? lpfx))
|
||||
(pfx+ (car lpfx) (cdr lpfx))
|
||||
(pfx+ pfx lpfx))))
|
||||
(set-mcar! pfxs npfx) (set-mcdr! pfxs 0)
|
||||
(for-each loop c)
|
||||
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx)]
|
||||
[(add-prefix) ; add to the current prefix (unless it's #f)
|
||||
(define pfx (mcar pfxs))
|
||||
(define lpfx (mcdr pfxs))
|
||||
(define npfx (pfx+ (pfx+col (pfx+ pfx lpfx)) (car c)))
|
||||
(set-mcar! pfxs npfx) (set-mcdr! pfxs 0)
|
||||
(for-each loop (cdr c))
|
||||
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx)]
|
||||
[(set-prefix)
|
||||
(define pfx (mcar pfxs))
|
||||
(define lpfx (mcdr pfxs))
|
||||
(set-mcar! pfxs (car c)) (set-mcdr! pfxs 0)
|
||||
(for-each loop (cdr c))
|
||||
(set-mcar! pfxs pfx) (set-mcdr! pfxs lpfx)]
|
||||
[(with-writer)
|
||||
(define old write)
|
||||
(set! write (or (car c) write-string))
|
||||
(for-each loop (cdr c))
|
||||
(set! write old)]
|
||||
#; ; no need for this hack yet
|
||||
[(with-writer-change)
|
||||
;; The function gets the old writer and return a new one (useful to
|
||||
;; save the current writer and restore it inside). Could also be
|
||||
;; used to extend a writer, but that shows why a customizable writer
|
||||
;; is a bad choice: instead, it should be a list of substitutions
|
||||
;; that can be extended more conveniently. A simple implementation
|
||||
;; would be to chain functions that do substitutions. But that runs
|
||||
;; into problems when functions want to substitute the same thing,
|
||||
;; and worse: when the output of one function would get substituted
|
||||
;; again by another. Another approach would be to join matcher
|
||||
;; regexps with "|" after wrapping each one with parens, then find
|
||||
;; out which one matched by looking at the result and applying its
|
||||
;; substitution, but the problem with that is that is that it forbids
|
||||
;; having parens in the regexps -- this could be fixed by not
|
||||
;; parenthesizing each expression, and instead running the found
|
||||
;; match against each of the input regexps to find the matching one,
|
||||
;; but that can be very inefficient. Yet another issue is that in
|
||||
;; some cases we might *want* the "worse" feature mentioned earlier:
|
||||
;; for example, when we want to do some massaging of the input texts
|
||||
;; yet still have the result encoded for HTML output -- so perhaps
|
||||
;; the simple approach is still better. The only difference from the
|
||||
;; current `with-writer' is using a substituting function, so it can
|
||||
;; be composed with the current one instead of replacing it
|
||||
;; completely.
|
||||
(define old write)
|
||||
(set! write ((car c) write))
|
||||
(for-each loop (cdr c))
|
||||
(set! write old)]
|
||||
[else (error 'output "unknown special value flag: ~e"
|
||||
(special-flag x))])]
|
||||
[else
|
||||
(output-string
|
||||
(cond [(string? x) x]
|
||||
[(bytes? x) (bytes->string/utf-8 x)]
|
||||
[(symbol? x) (symbol->string x)]
|
||||
[(path? x) (path->string x)]
|
||||
(cond [(string? x) x]
|
||||
[(bytes? x) (bytes->string/utf-8 x)]
|
||||
[(symbol? x) (symbol->string x)]
|
||||
[(path? x) (path->string x)]
|
||||
[(keyword? x) (keyword->string x)]
|
||||
[(number? x) (number->string x)]
|
||||
[(char? x) (string x)]
|
||||
;; generic fallback: throw an error
|
||||
[(number? x) (number->string x)]
|
||||
[(char? x) (string x)]
|
||||
;; generic fallback: throw an error (could use `display' so new
|
||||
;; values can define how they're shown, but the same
|
||||
;; functionality can be achieved with thunks and prop:procedure)
|
||||
[else (error 'output "don't know how to render value: ~v" x)]))]))
|
||||
;;
|
||||
(port-count-lines! p)
|
||||
|
|
@ -231,7 +237,7 @@
|
|||
(define port->state
|
||||
(let ([t (make-weak-hasheq)]
|
||||
[last '(#f #f)]) ; cache for the last port, to avoid a hash lookup
|
||||
(lambda (p)
|
||||
(λ (p)
|
||||
(if (eq? p (car last)) (cdr last)
|
||||
(let ([s (or (hash-ref t p #f)
|
||||
(let ([s (mcons 0 0)]) (hash-set! t p s) s))])
|
||||
|
|
@ -269,7 +275,7 @@
|
|||
|
||||
(define make-spaces ; (efficiently)
|
||||
(let ([t (make-hasheq)] [v (make-vector 200 #f)])
|
||||
(lambda (n)
|
||||
(λ (n)
|
||||
(or (if (< n 200) (vector-ref v n) (hash-ref t n #f))
|
||||
(let ([spaces (make-string n #\space)])
|
||||
(if (< n 200) (vector-set! v n spaces) (hash-set! t n spaces))
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@
|
|||
(define stoplist (append definition-ids (kernel-form-identifier-list)))
|
||||
(define (definition-id? id)
|
||||
(and (identifier? id)
|
||||
(ormap (lambda (i) (free-identifier=? id i)) definition-ids)))
|
||||
(ormap (λ (i) (free-identifier=? id i)) definition-ids)))
|
||||
(define (definition? x)
|
||||
(syntax-case x () [(id . rest) (and (definition-id? #'id) #'id)] [_ #f]))
|
||||
(define (begin?->list x)
|
||||
|
|
@ -34,20 +34,20 @@
|
|||
[(or cur (pair? after)) (loop xs '() x '() (add))]
|
||||
[else (loop xs before x '() r)])))))
|
||||
(define (group-stxs stxs fun)
|
||||
(group-by (lambda (stx)
|
||||
(let ([p (syntax-property stx 'scribble)])
|
||||
(cond [(and (pair? p) (eq? (car p) 'newline)) '>]
|
||||
[(eq? 'indentation p) '<]
|
||||
[else #f])))
|
||||
(group-by (λ (stx)
|
||||
(define p (syntax-property stx 'scribble))
|
||||
(cond [(and (pair? p) (eq? (car p) 'newline)) '>]
|
||||
[(eq? 'indentation p) '<]
|
||||
[else #f]))
|
||||
stxs fun))
|
||||
#; ; tests for this
|
||||
(for-each
|
||||
(lambda (t)
|
||||
(let ([r (group-by (lambda (x)
|
||||
(cond [(number? x) '<] [(symbol? x) '>] [else #f]))
|
||||
(car t)
|
||||
list)])
|
||||
(unless (equal? r (cadr t)) (printf "FAILURE: ~s -> ~s\n" (car t) r))))
|
||||
(λ (t)
|
||||
(define r (group-by (λ (x)
|
||||
(cond [(number? x) '<] [(symbol? x) '>] [else #f]))
|
||||
(car t)
|
||||
list))
|
||||
(unless (equal? r (cadr t)) (printf "FAILURE: ~s -> ~s\n" (car t) r)))
|
||||
'([() ()]
|
||||
[("a") ((() "a" ()))]
|
||||
[("a" "b") ((() "a" ()) (() "b" ()))]
|
||||
|
|
@ -83,7 +83,7 @@
|
|||
#,@(if post? #'((decor 'post) ...) #'()))
|
||||
expr))
|
||||
(cond [(begin?->list expr*)
|
||||
=> (lambda (xs)
|
||||
=> (λ (xs)
|
||||
(if (null? xs)
|
||||
(if (or pre? post?)
|
||||
#'(begin (decor 'pre) ... (decor 'post) ...)
|
||||
|
|
@ -97,7 +97,7 @@
|
|||
(define (process-body decor body)
|
||||
(group-stxs
|
||||
(syntax->list body)
|
||||
(lambda (pre expr post)
|
||||
(λ (pre expr post)
|
||||
(with-syntax ([decor decor])
|
||||
(if (not expr) ; no need to decorate these
|
||||
(with-syntax ([(x ...) (append pre post)]) #`(decor '(x ...)))
|
||||
|
|
@ -146,7 +146,7 @@
|
|||
(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?)
|
||||
(define-values [exprs always-list?]
|
||||
(let ([exprs (syntax->list stx)])
|
||||
(if (and (pair? exprs) (pair? (cdr exprs)))
|
||||
(values (cddr exprs) (syntax-e (cadr exprs)))
|
||||
|
|
@ -178,7 +178,7 @@
|
|||
(begin/text
|
||||
(include-at/relative-to/reader path-spec path-spec path-spec
|
||||
(let ([xs #f])
|
||||
(lambda (src inp)
|
||||
(λ (src inp)
|
||||
(unless xs
|
||||
(set! xs (scribble:read-syntax-inside src inp))
|
||||
(when (syntax? xs) (set! xs (or (syntax->list xs) (list xs)))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user