suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

scribble/manual: add #:escapes? argument to to-paragraph, etc.

Browse Source 
Use the new option to fix `codeblock`, which shouldn't have any
escapes.

Closes PR 14104

original commit: 5d5522ad4c82f4c448ead013b31f23cec6a8d2ff
This commit is contained in:
Matthew Flatt 2013-11-06 18:26:29 -07:00
parent f165cc9dcd
commit 1a192ed8d4
3 changed files with 55 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -46,6 +46,7 @@ The @racket[stx-prop-expr] should produce a procedure for recording a
@defproc[(to-paragraph [v any/c] @defproc[(to-paragraph [v any/c]
[#:expr? expr? any/c #f] [#:expr? expr? any/c #f]
[#:escapes? escapes? any/c #t]
[#:color? color? any/c #t] [#:color? color? any/c #t]
[#:wrap-elem wrap-elem (element? . -> . element?) (lambda (e) e)]) [#:wrap-elem wrap-elem (element? . -> . element?) (lambda (e) e)])
block?]{ block?]{
@ -56,7 +57,8 @@ generated layout.
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
@racket[defproc], @racket[defform], etc.). The identifiers @racket[defproc], @racket[defform], etc.). Unless @racket[escapes?]
is @racket[#f], the identifiers
@racketidfont{code:line}, @racketidfont{code:comment}, @racketidfont{code:line}, @racketidfont{code:comment},
@racketidfont{code:blank}, @racketidfont{code:hilite}, and @racketidfont{code:blank}, @racketidfont{code:hilite}, and
@racketidfont{code:quote} are handled as in @racket[racketblock], as @racketidfont{code:quote} are handled as in @racket[racketblock], as
@ -85,7 +87,8 @@ be used to give a style to an element.}
@defproc[((to-paragraph/prefix [prefix1 any/c] [prefix any/c] [suffix any/c]) @defproc[((to-paragraph/prefix [prefix1 any/c] [prefix any/c] [suffix any/c])
[v any/c] [#:expr? expr? any/c #f] [#:color? color? any/c #f] [v any/c] [#:expr? expr? any/c #f] [#:escapes? escapes? any/c #t]
[#:color? color? any/c #f]
[#:wrap-elem wrap-elem (element? . -> . element?) (lambda (e) e)]) [#:wrap-elem wrap-elem (element? . -> . element?) (lambda (e) e)])
block?]{ block?]{
@ -97,13 +100,18 @@ first line, @racket[prefix] is prefix to any subsequent line, and
it is added to the end on its own line.} it is added to the end on its own line.}
@defproc[(to-element [v any/c] [#:expr? expr? any/c #f]) element?]{ @defproc[(to-element [v any/c]
[#:expr? expr? any/c #f]
[#:escapes? escapes? any/c #t]) element?]{
Like @racket[to-paragraph], except that source-location information is Like @racket[to-paragraph], except that source-location information is
mostly ignored, since the result is meant to be inlined into a mostly ignored, since the result is meant to be inlined into a
paragraph.} paragraph.}
@defproc[(to-element/no-color [v any/c] [#:expr? expr? any/c #f]) element?]{ @defproc[(to-element/no-color [v any/c]
[#:expr? expr? any/c #f]
[#:escapes? escapes? any/c #t])
element?]{
Like @racket[to-element], but @racket[for-syntax] bindings are Like @racket[to-element], but @racket[for-syntax] bindings are
ignored, and the generated text is uncolored. This variant is ignored, and the generated text is uncolored. This variant is

3
pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-code.rkt
View File

@ -98,7 +98,8 @@
(to-element (syntax-property (to-element (syntax-property
e e
'display-string 'display-string
str))) str)
#:escapes? #f))
pos pos
(+ pos (syntax-span e)) (+ pos (syntax-span e))
1)))] 1)))]

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

@ -201,7 +201,7 @@
[(str val) (datum-intern-literal (format str val))] [(str val) (datum-intern-literal (format str val))]
[(str . vals) (datum-intern-literal (apply format str vals))])) [(str . vals) (datum-intern-literal (apply format str vals))]))
(define (typeset-atom c out color? quote-depth expr?) (define (typeset-atom c out color? quote-depth expr? escapes?)
(if (and (var-id? (syntax-e c)) (if (and (var-id? (syntax-e c))
(zero? quote-depth)) (zero? quote-depth))
(out (iformat "~s" (let ([v (var-id-sym (syntax-e c))]) (out (iformat "~s" (let ([v (var-id-sym (syntax-e c))])
@ -226,7 +226,8 @@
"#false" "#false"
"#f")] "#f")]
[else (iformat "~s" sc)])]) [else (iformat "~s" sc)])])
(if (and (symbol? sc) (if (and escapes?
(symbol? sc)
((string-length s) . > . 1) ((string-length s) . > . 1)
(char=? (string-ref s 0) #\_) (char=? (string-ref s 0) #\_)
(not (or (identifier-label-binding c) (not (or (identifier-label-binding c)
@ -283,13 +284,15 @@
(define omitable (make-style #f '(omitable))) (define omitable (make-style #f '(omitable)))
(define (gen-typeset c multi-line? prefix1 prefix suffix color? expr? elem-wrap) (define (gen-typeset c multi-line? prefix1 prefix suffix color? expr? escapes? elem-wrap)
(let* ([c (syntax-ize c 0 #:expr? expr?)] (let* ([c (syntax-ize c 0 #:expr? expr?)]
[content null] [content null]
[docs null] [docs null]
[first (syntax-case c (code:line) [first (if escapes?
(syntax-case c (code:line)
[(code:line e . rest) #'e] [(code:line e . rest) #'e]
[else c])] [else c])
c)]
[init-col (or (syntax-column first) 0)] [init-col (or (syntax-column first) 0)]
[src-col init-col] [src-col init-col]
[inc-src-col (lambda () (set! src-col (add1 src-col)))] [inc-src-col (lambda () (set! src-col (add1 src-col)))]
@ -403,7 +406,7 @@
(if val? value-color #f) (if val? value-color #f)
(list (list
(make-element/cache (if val? value-color paren-color) '". ") (make-element/cache (if val? value-color paren-color) '". ")
(typeset a #f "" "" "" (not val?) expr? elem-wrap) (typeset a #f "" "" "" (not val?) expr? escapes? elem-wrap)
(make-element/cache (if val? value-color paren-color) '" .")) (make-element/cache (if val? value-color paren-color) '" ."))
(+ (syntax-span a) 4))) (+ (syntax-span a) 4)))
(list (syntax-source a) (list (syntax-source a)
@ -424,9 +427,10 @@
(define (loop init-line! quote-depth expr? no-cons?) (define (loop init-line! quote-depth expr? no-cons?)
(lambda (c) (lambda (c)
(cond (cond
[(eq? 'code:blank (syntax-e c)) [(and escapes? (eq? 'code:blank (syntax-e c)))
(advance c init-line!)] (advance c init-line!)]
[(and (pair? (syntax-e c)) [(and escapes?
(pair? (syntax-e c))
(eq? (syntax-e (car (syntax-e c))) 'code:comment)) (eq? (syntax-e (car (syntax-e c))) 'code:comment))
(let ([l (syntax->list c)]) (let ([l (syntax->list c)])
(unless (and l (= 2 (length l))) (unless (and l (= 2 (length l)))
@ -446,7 +450,8 @@
(out v #f)))) (out v #f))))
(paragraph-content v)) (paragraph-content v))
(out (no-fancy-chars v) comment-color)))] (out (no-fancy-chars v) comment-color)))]
[(and (pair? (syntax-e c)) [(and escapes?
(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!)
(out "; " comment-color) (out "; " comment-color)
@ -461,12 +466,14 @@
expr? expr?
#f) #f)
l))] l))]
[(and (pair? (syntax-e c)) [(and escapes?
(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 (loop init-line! quote-depth expr? #f)
l))] l))]
[(and (pair? (syntax-e c)) [(and escapes?
(pair? (syntax-e c))
(eq? (syntax-e (car (syntax-e c))) 'code:hilite)) (eq? (syntax-e (car (syntax-e c))) 'code:hilite))
(let ([l (syntax->list c)] (let ([l (syntax->list c)]
[h? highlight?]) [h? highlight?])
@ -479,7 +486,8 @@
((loop init-line! quote-depth expr? #f) (cadr l)) ((loop init-line! quote-depth expr? #f) (cadr l))
(set! highlight? h?) (set! highlight? h?)
(set! src-col (add1 src-col)))] (set! src-col (add1 src-col)))]
[(and (pair? (syntax-e c)) [(and escapes?
(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!)
(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)])
@ -810,11 +818,11 @@
[(and (keyword? (syntax-e c)) expr?) [(and (keyword? (syntax-e c)) expr?)
(advance c init-line!) (advance c init-line!)
(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?) (typeset-atom c out color? quote-depth expr? escapes?)
(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!)
(typeset-atom c out color? quote-depth expr?) (typeset-atom c out color? quote-depth expr? escapes?)
(set! src-col (+ src-col (or (syntax-span c) 1))) (set! src-col (+ src-col (or (syntax-span c) 1)))
#; #;
(hash-set! next-col-map src-col dest-col)]))) (hash-set! next-col-map src-col dest-col)])))
@ -836,11 +844,11 @@
(make-table block-color (map list (reverse docs)))) (make-table block-color (map list (reverse docs))))
(make-sized-element #f (reverse content) dest-col)))) (make-sized-element #f (reverse content) dest-col))))
(define (typeset c multi-line? prefix1 prefix suffix color? expr? elem-wrap) (define (typeset c multi-line? prefix1 prefix suffix color? expr? escapes? elem-wrap)
(let* ([c (syntax-ize c 0 #:expr? expr?)] (let* ([c (syntax-ize c 0 #:expr? expr?)]
[s (syntax-e c)]) [s (syntax-e c)])
(if (or multi-line? (if (or multi-line?
(eq? 'code:blank s) (and escapes? (eq? 'code:blank s))
(pair? s) (pair? s)
(mpair? s) (mpair? s)
(vector? s) (vector? s)
@ -853,7 +861,7 @@
(struct-proxy? s) (struct-proxy? s)
(and expr? (or (identifier? c) (and expr? (or (identifier? c)
(keyword? (syntax-e c))))) (keyword? (syntax-e c)))))
(gen-typeset c multi-line? prefix1 prefix suffix color? expr? elem-wrap) (gen-typeset c multi-line? prefix1 prefix suffix color? expr? escapes? elem-wrap)
(typeset-atom c (typeset-atom c
(letrec ([mk (letrec ([mk
(case-lambda (case-lambda
@ -866,25 +874,31 @@
(make-element/cache (and color? color) elem) (make-element/cache (and color? color) elem)
(make-sized-element (and color? color) elem len)))])]) (make-sized-element (and color? color) elem len)))])])
mk) mk)
color? 0 expr?)))) color? 0 expr? escapes?))))
(define (to-element c #:expr? [expr? #f]) (define (to-element c
(typeset c #f "" "" "" #t expr? values)) #:expr? [expr? #f]
#:escapes? [escapes? #t])
(typeset c #f "" "" "" #t expr? escapes? values))
(define (to-element/no-color c #:expr? [expr? #f]) (define (to-element/no-color c
(typeset c #f "" "" "" #f expr? values)) #:expr? [expr? #f]
#:escapes? [escapes? #t])
(typeset c #f "" "" "" #f expr? escapes? values))
(define (to-paragraph c (define (to-paragraph c
#:expr? [expr? #f] #:expr? [expr? #f]
#:escapes? [escapes? #t]
#:color? [color? #t] #:color? [color? #t]
#:wrap-elem [elem-wrap (lambda (e) e)]) #:wrap-elem [elem-wrap (lambda (e) e)])
(typeset c #t "" "" "" color? expr? elem-wrap)) (typeset c #t "" "" "" color? expr? escapes? elem-wrap))
(define ((to-paragraph/prefix pfx1 pfx sfx) c (define ((to-paragraph/prefix pfx1 pfx sfx) c
#:expr? [expr? #f] #:expr? [expr? #f]
#:escapes? [escapes? #t]
#:color? [color? #t] #:color? [color? #t]
#:wrap-elem [elem-wrap (lambda (e) e)]) #:wrap-elem [elem-wrap (lambda (e) e)])
(typeset c #t pfx1 pfx sfx color? expr? elem-wrap)) (typeset c #t pfx1 pfx sfx color? expr? escapes? elem-wrap))
(begin-for-syntax (begin-for-syntax
(define-struct variable-id (sym) (define-struct variable-id (sym)