suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

scribble/manual: make racketblock fall back to racket-style spacing

Browse Source 
When source-location information isn't available, usually due to macros
in compiled modules, make `racketblock` fall back to `racket`-like
spacing. This improvement is visible, for example, in the documentation
for functions like `recycle-icon`.

Using `quote-syntax/srcloc` in a macro is probably a better solution,
because that will preserve the original layout including line breaks,
but the default-spacing fallback seems like an improvement over
unreadable output.

original commit: 86df55a877feca51680aaab9b955ea9220229c14
This commit is contained in:
Matthew Flatt 2014-01-07 15:31:45 -07:00
parent 2828cef1d8
commit 949c5776c8
3 changed files with 76 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/manual.scrbl
View File

@ -2,7 +2,8 @@
@(require scribble/manual "utils.rkt" @(require scribble/manual "utils.rkt"
(for-syntax racket/base) (for-syntax racket/base)
(for-label scribble/manual-struct (for-label scribble/manual-struct
version/utils)) version/utils
syntax/quote))
@(define lit-ellipses (racket ...)) @(define lit-ellipses (racket ...))
@(define lit-ellipses+ (racket ...+)) @(define lit-ellipses+ (racket ...+))
@ -208,7 +209,14 @@ Source-location span information is used to preserve @racket[#true]
versus @racket[#t] and @racket[#false] versus @racket[#f], and versus @racket[#t] and @racket[#false] versus @racket[#f], and
syntax-object properties are used to preserve square brackets and syntax-object properties are used to preserve square brackets and
curly braces versus parentheses; otherwise, using syntax objects tends curly braces versus parentheses; otherwise, using syntax objects tends
to normalize the form of S-expression elements. to normalize the form of S-expression elements, such as rendering
@code{2/4} as @racket[2/4]. When source-location information is not
available, such as when it is lost by bytecode-compiled macros,
spacing is inserted in the same style (within a single line) as the
@racket[racket] form.
@margin-note{See also @racket[quote-syntax/keep-srcloc] for use in a
macro to preserve source-location information in a template.}
In the above example, @racket[define] is typeset as a keyword (in black) In the above example, @racket[define] is typeset as a keyword (in black)
and as a hyperlink to @racket[define]'s definition in the reference and as a hyperlink to @racket[define]'s definition in the reference

4
pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/scheme.scrbl
View File

@ -53,7 +53,9 @@ The @racket[stx-prop-expr] should produce a procedure for recording a
Typesets an S-expression that is represented by a syntax object, where Typesets an S-expression that is represented by a syntax object, where
source-location information in the syntax object controls the source-location information in the syntax object controls the
generated layout. generated layout. When source-location information is not available,
default spacing is used (in the same single-line style as
@racket[to-element]).
Identifiers that have @racket[for-label] bindings are typeset and Identifiers that have @racket[for-label] bindings are typeset and
hyperlinked based on definitions declared elsewhere (via hyperlinked based on definitions declared elsewhere (via

110
pkgs/scribble-pkgs/scribble-lib/scribble/racket.rkt
View File

@ -380,8 +380,11 @@
(set! dest-col (+ dest-col len))]))])) (set! dest-col (+ dest-col len))]))]))
(define advance (define advance
(case-lambda (case-lambda
[(c init-line! delta) [(c init-line! srcless-step delta)
(let ([c (+ delta (or (syntax-column c) 0))] (let ([c (+ delta (or (syntax-column c)
(if srcless-step
(+ src-col srcless-step)
0)))]
[l (syntax-line c)]) [l (syntax-line c)])
(let ([new-line? (and l (l . > . line))]) (let ([new-line? (and l (l . > . line))])
(when new-line? (when new-line?
@ -405,7 +408,12 @@
(set! dest-col (+ old-dest-col amt)))))) (set! dest-col (+ old-dest-col amt))))))
(set! src-col c) (set! src-col c)
(hash-set! next-col-map src-col dest-col)))] (hash-set! next-col-map src-col dest-col)))]
[(c init-line!) (advance c init-line! 0)])) [(c init-line! srcless-step) (advance c init-line! srcless-step 0)]
[(c init-line!) (advance c init-line! #f 0)]))
(define (for-each/i f l v)
(unless (null? l)
(f (car l) v)
(for-each/i f (cdr l) 1)))
(define (convert-infix c quote-depth expr?) (define (convert-infix c quote-depth expr?)
(let ([l (syntax->list c)]) (let ([l (syntax->list c)])
(and l (and l
@ -451,10 +459,10 @@
[(eq? s 'rsquo) "'"] [(eq? s 'rsquo) "'"]
[else s])) [else s]))
(define (loop init-line! quote-depth expr? no-cons?) (define (loop init-line! quote-depth expr? no-cons?)
(lambda (c) (lambda (c srcless-step)
(cond (cond
[(and escapes? (eq? 'code:blank (syntax-e c))) [(and escapes? (eq? 'code:blank (syntax-e c)))
(advance c init-line!)] (advance c init-line! srcless-step)]
[(and escapes? [(and escapes?
(pair? (syntax-e c)) (pair? (syntax-e c))
(eq? (syntax-e (car (syntax-e c))) 'code:comment)) (eq? (syntax-e (car (syntax-e c))) 'code:comment))
@ -464,7 +472,7 @@
#f #f
"does not have a single sub-form" "does not have a single sub-form"
c))) c)))
(advance c init-line!) (advance c init-line! srcless-step)
(out ";" comment-color) (out ";" comment-color)
(out 'nbsp comment-color) (out 'nbsp comment-color)
(let ([v (syntax->datum (cadr (syntax->list c)))]) (let ([v (syntax->datum (cadr (syntax->list c)))])
@ -479,25 +487,27 @@
[(and escapes? [(and escapes?
(pair? (syntax-e c)) (pair? (syntax-e c))
(eq? (syntax-e (car (syntax-e c))) 'code:contract)) (eq? (syntax-e (car (syntax-e c))) 'code:contract))
(advance c init-line!) (advance c init-line! srcless-step)
(out "; " comment-color) (out "; " comment-color)
(let* ([l (cdr (syntax->list c))] (let* ([l (cdr (syntax->list c))]
[s-col (or (syntax-column (car l)) src-col)]) [s-col (or (syntax-column (car l)) src-col)])
(set! src-col s-col) (set! src-col s-col)
(for-each (loop (lambda () (for-each/i (loop (lambda ()
(set! src-col s-col) (set! src-col s-col)
(set! dest-col 0) (set! dest-col 0)
(out "; " comment-color)) (out "; " comment-color))
0 0
expr? expr?
#f) #f)
l))] l
#f))]
[(and escapes? [(and escapes?
(pair? (syntax-e c)) (pair? (syntax-e c))
(eq? (syntax-e (car (syntax-e c))) 'code:line)) (eq? (syntax-e (car (syntax-e c))) 'code:line))
(let ([l (cdr (syntax->list c))]) (let ([l (cdr (syntax->list c))])
(for-each (loop init-line! quote-depth expr? #f) (for-each/i (loop init-line! quote-depth expr? #f)
l))] l
#f))]
[(and escapes? [(and escapes?
(pair? (syntax-e c)) (pair? (syntax-e c))
(eq? (syntax-e (car (syntax-e c))) 'code:hilite)) (eq? (syntax-e (car (syntax-e c))) 'code:hilite))
@ -505,25 +515,27 @@
[h? highlight?]) [h? highlight?])
(unless (and l (= 2 (length l))) (unless (and l (= 2 (length l)))
(error "bad code:redex: ~.s" (syntax->datum c))) (error "bad code:redex: ~.s" (syntax->datum c)))
(advance c init-line!) (advance c init-line! srcless-step)
(set! src-col (syntax-column (cadr l))) (set! src-col (syntax-column (cadr l)))
(hash-set! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
(set! highlight? #t) (set! highlight? #t)
((loop init-line! quote-depth expr? #f) (cadr l)) ((loop init-line! quote-depth expr? #f) (cadr l) #f)
(set! highlight? h?) (set! highlight? h?)
(set! src-col (add1 src-col)))] (set! src-col (add1 src-col)))]
[(and escapes? [(and escapes?
(pair? (syntax-e c)) (pair? (syntax-e c))
(eq? (syntax-e (car (syntax-e c))) 'code:quote)) (eq? (syntax-e (car (syntax-e c))) 'code:quote))
(advance c init-line!) (advance c init-line! srcless-step)
(let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)]) (let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)])
(out "(" (if (positive? quote-depth) value-color paren-color)) (out "(" (if (positive? quote-depth) value-color paren-color))
(set! src-col (+ src-col 1)) (set! src-col (+ src-col 1))
(hash-set! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
((loop init-line! quote-depth expr? #f) ((loop init-line! quote-depth expr? #f)
(datum->syntax #'here 'quote (car (syntax-e c)))) (datum->syntax #'here 'quote (car (syntax-e c)))
(for-each (loop init-line! (add1 quote-depth) expr? #f) #f)
(cdr (syntax->list c))) (for-each/i (loop init-line! (add1 quote-depth) expr? #f)
(cdr (syntax->list c))
1)
(out ")" (if (positive? quote-depth) value-color paren-color)) (out ")" (if (positive? quote-depth) value-color paren-color))
(set! src-col (+ src-col 1)) (set! src-col (+ src-col 1))
#; #;
@ -537,7 +549,7 @@
(or (not expr?) (or (not expr?)
(positive? quote-depth) (positive? quote-depth)
(quotable? c))) (quotable? c)))
(advance c init-line!) (advance c init-line! srcless-step)
(let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)]) (let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)])
(let-values ([(str quote-delta) (let-values ([(str quote-delta)
(case (syntax-e (car (syntax-e c))) (case (syntax-e (car (syntax-e c)))
@ -555,14 +567,14 @@
(let ([i (cadr (syntax->list c))]) (let ([i (cadr (syntax->list c))])
(set! src-col (or (syntax-column i) src-col)) (set! src-col (or (syntax-column i) src-col))
(hash-set! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
((loop init-line! (max 0 (+ quote-depth quote-delta)) expr? #f) i))))] ((loop init-line! (max 0 (+ quote-depth quote-delta)) expr? #f) i #f))))]
[(and (pair? (syntax-e c)) [(and (pair? (syntax-e c))
(or (not expr?) (or (not expr?)
(positive? quote-depth) (positive? quote-depth)
(quotable? c)) (quotable? c))
(convert-infix c quote-depth expr?)) (convert-infix c quote-depth expr?))
=> (lambda (converted) => (lambda (converted)
((loop init-line! quote-depth expr? #f) converted))] ((loop init-line! quote-depth expr? #f) converted srcless-step))]
[(or (pair? (syntax-e c)) [(or (pair? (syntax-e c))
(mpair? (syntax-e c)) (mpair? (syntax-e c))
(forced-pair? (syntax-e c)) (forced-pair? (syntax-e c))
@ -587,7 +599,7 @@
(if (eq? sh #\?) (if (eq? sh #\?)
opt-color opt-color
paren-color))]) paren-color))])
(advance c init-line!) (advance c init-line! srcless-step)
(let ([quote-depth (if (struct-proxy? (syntax-e c)) (let ([quote-depth (if (struct-proxy? (syntax-e c))
quote-depth quote-depth
(to-quoted c expr? quote-depth out color? inc-src-col))]) (to-quoted c expr? quote-depth out color? inc-src-col))])
@ -676,7 +688,8 @@
(or (zero? quote-depth) (or (zero? quote-depth)
(not (struct-proxy? (syntax-e c)))) (not (struct-proxy? (syntax-e c))))
(not no-cons?))] (not no-cons?))]
[dotted? #f]) [dotted? #f]
[srcless-step #f])
(cond (cond
[(and (syntax? l) [(and (syntax? l)
(pair? (syntax-e l)) (pair? (syntax-e l))
@ -689,27 +702,29 @@
(quote-depth . > . 1) (quote-depth . > . 1)
(not (memq (syntax-e (car (syntax-e l))) (not (memq (syntax-e (car (syntax-e l)))
'(unquote unquote-splicing))))))) '(unquote unquote-splicing)))))))
(lloop (syntax-e l) first-expr? #f)] (lloop (syntax-e l) first-expr? #f srcless-step)]
[(and (or (null? l) [(and (or (null? l)
(and (syntax? l) (and (syntax? l)
(null? (syntax-e l))))) (null? (syntax-e l)))))
(void)] (void)]
[(and (pair? l) (not dotted?)) [(and (pair? l) (not dotted?))
((loop init-line! quote-depth first-expr? #f) (car l)) ((loop init-line! quote-depth first-expr? #f) (car l) srcless-step)
(lloop (cdr l) expr? #f)] (lloop (cdr l) expr? #f 1)]
[(forced-pair? l) [(forced-pair? l)
((loop init-line! quote-depth first-expr? #f) (forced-pair-car l)) ((loop init-line! quote-depth first-expr? #f) (forced-pair-car l) srcless-step)
(lloop (forced-pair-cdr l) expr? #t)] (lloop (forced-pair-cdr l) expr? #t 1)]
[(mpair? l) [(mpair? l)
((loop init-line! quote-depth first-expr? #f) (mcar l)) ((loop init-line! quote-depth first-expr? #f) (mcar l) srcless-step)
(lloop (mcdr l) expr? #t)] (lloop (mcdr l) expr? #t 1)]
[else [else
(unless (and expr? (zero? quote-depth)) (unless (and expr? (zero? quote-depth))
(advance l init-line! -2) (advance l init-line! (and srcless-step (+ srcless-step 3)) -2)
(out ". " (if (positive? quote-depth) value-color paren-color)) (out ". " (if (positive? quote-depth) value-color paren-color))
(set! src-col (+ src-col 3))) (set! src-col (+ src-col 3)))
(hash-set! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
((loop init-line! quote-depth first-expr? #f) l)])) ((loop init-line! quote-depth first-expr? #f) l (if (and expr? (zero? quote-depth))
srcless-step
#f))]))
(out (case sh (out (case sh
[(#\[ #\?) "]"] [(#\[ #\?) "]"]
[(#\{) "}"] [(#\{) "}"]
@ -717,7 +732,7 @@
p-color) p-color)
(set! src-col (+ src-col 1))))] (set! src-col (+ src-col 1))))]
[(box? (syntax-e c)) [(box? (syntax-e c))
(advance c init-line!) (advance c init-line! srcless-step)
(let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)]) (let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)])
(if (and expr? (zero? quote-depth)) (if (and expr? (zero? quote-depth))
(begin (begin
@ -729,11 +744,11 @@
(out "#&" value-color) (out "#&" value-color)
(set! src-col (+ src-col 2)))) (set! src-col (+ src-col 2))))
(hash-set! next-col-map src-col dest-col) (hash-set! next-col-map src-col dest-col)
((loop init-line! (if expr? quote-depth +inf.0) expr? #f) (unbox (syntax-e c))) ((loop init-line! (if expr? quote-depth +inf.0) expr? #f) (unbox (syntax-e c)) #f)
(when (and expr? (zero? quote-depth)) (when (and expr? (zero? quote-depth))
(out ")" paren-color)))] (out ")" paren-color)))]
[(hash? (syntax-e c)) [(hash? (syntax-e c))
(advance c init-line!) (advance c init-line! srcless-step)
(let ([equal-table? (hash-equal? (syntax-e c))] (let ([equal-table? (hash-equal? (syntax-e c))]
[eqv-table? (hash-eqv? (syntax-e c))] [eqv-table? (hash-eqv? (syntax-e c))]
[quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)]) [quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)])
@ -823,31 +838,32 @@
(syntax-line c) (syntax-line c)
(+ (syntax-column c) delta) (+ (syntax-column c) delta)
(+ (syntax-position c) delta) (+ (syntax-position c) delta)
(max 1 (- (syntax-span c) delta))))))) (max 1 (- (syntax-span c) delta))))))
#f)
(set! src-col (+ orig-col (syntax-span c)))))] (set! src-col (+ orig-col (syntax-span c)))))]
[(graph-reference? (syntax-e c)) [(graph-reference? (syntax-e c))
(advance c init-line!) (advance c init-line! srcless-step)
(out (iformat "#~a#" (unbox (graph-reference-bx (syntax-e c)))) (out (iformat "#~a#" (unbox (graph-reference-bx (syntax-e c))))
(if (positive? quote-depth) (if (positive? quote-depth)
value-color value-color
paren-color)) paren-color))
(set! src-col (+ src-col (syntax-span c)))] (set! src-col (+ src-col (syntax-span c)))]
[(graph-defn? (syntax-e c)) [(graph-defn? (syntax-e c))
(advance c init-line!) (advance c init-line! srcless-step)
(let ([bx (graph-defn-bx (syntax-e c))]) (let ([bx (graph-defn-bx (syntax-e c))])
(out (iformat "#~a=" (unbox bx)) (out (iformat "#~a=" (unbox bx))
(if (positive? quote-depth) (if (positive? quote-depth)
value-color value-color
paren-color)) paren-color))
(set! src-col (+ src-col 3)) (set! src-col (+ src-col 3))
((loop init-line! quote-depth expr? #f) (graph-defn-r (syntax-e c))))] ((loop init-line! quote-depth expr? #f) (graph-defn-r (syntax-e c)) #f))]
[(and (keyword? (syntax-e c)) expr?) [(and (keyword? (syntax-e c)) expr?)
(advance c init-line!) (advance c init-line! srcless-step)
(let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)]) (let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)])
(typeset-atom c out color? quote-depth expr? escapes? defn?) (typeset-atom c out color? quote-depth expr? escapes? defn?)
(set! src-col (+ src-col (or (syntax-span c) 1))))] (set! src-col (+ src-col (or (syntax-span c) 1))))]
[else [else
(advance c init-line!) (advance c init-line! srcless-step)
(typeset-atom c out color? quote-depth expr? escapes? defn?) (typeset-atom c out color? quote-depth expr? escapes? defn?)
(set! src-col (+ src-col (or (syntax-span c) 1))) (set! src-col (+ src-col (or (syntax-span c) 1)))
#; #;
@ -855,7 +871,7 @@
(out prefix1 #f) (out prefix1 #f)
(set! dest-col 0) (set! dest-col 0)
(hash-set! next-col-map init-col dest-col) (hash-set! next-col-map init-col dest-col)
((loop (lambda () (set! src-col init-col) (set! dest-col 0)) 0 expr? #f) c) ((loop (lambda () (set! src-col init-col) (set! dest-col 0)) 0 expr? #f) c #f)
(if (list? suffix) (if (list? suffix)
(map (lambda (sfx) (map (lambda (sfx)
(finish-line!) (finish-line!)