commit 1a192ed8d43bfae8f0e819afa4f9740903d2f9f4
parent f165cc9dcd2d6597470f452e46bedfa6d529ae21
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 6 Nov 2013 18:26:29 -0700
scribble/manual: add `#:escapes?` argument to `to-paragraph`, etc.
Use the new option to fix `codeblock`, which shouldn't have any
escapes.
Closes PR 14104
original commit: 5d5522ad4c82f4c448ead013b31f23cec6a8d2ff
Diffstat:
3 files changed, 55 insertions(+), 32 deletions(-)
diff --git a/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/scheme.scrbl b/pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/scheme.scrbl
@@ -46,7 +46,8 @@ The @racket[stx-prop-expr] should produce a procedure for recording a
@defproc[(to-paragraph [v any/c]
[#:expr? expr? any/c #f]
- [#:color? color? any/c #t]
+ [#:escapes? escapes? any/c #t]
+ [#:color? color? any/c #t]
[#:wrap-elem wrap-elem (element? . -> . element?) (lambda (e) e)])
block?]{
@@ -56,7 +57,8 @@ generated layout.
Identifiers that have @racket[for-label] bindings are typeset and
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:blank}, @racketidfont{code:hilite}, and
@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])
- [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)])
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.}
-@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
mostly ignored, since the result is meant to be inlined into a
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
ignored, and the generated text is uncolored. This variant is
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-code.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-code.rkt
@@ -98,7 +98,8 @@
(to-element (syntax-property
e
'display-string
- str)))
+ str)
+ #:escapes? #f))
pos
(+ pos (syntax-span e))
1)))]
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/racket.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/racket.rkt
@@ -201,7 +201,7 @@
[(str val) (datum-intern-literal (format str val))]
[(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))
(zero? quote-depth))
(out (iformat "~s" (let ([v (var-id-sym (syntax-e c))])
@@ -226,7 +226,8 @@
"#false"
"#f")]
[else (iformat "~s" sc)])])
- (if (and (symbol? sc)
+ (if (and escapes?
+ (symbol? sc)
((string-length s) . > . 1)
(char=? (string-ref s 0) #\_)
(not (or (identifier-label-binding c)
@@ -283,13 +284,15 @@
(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?)]
[content null]
[docs null]
- [first (syntax-case c (code:line)
- [(code:line e . rest) #'e]
- [else c])]
+ [first (if escapes?
+ (syntax-case c (code:line)
+ [(code:line e . rest) #'e]
+ [else c])
+ c)]
[init-col (or (syntax-column first) 0)]
[src-col init-col]
[inc-src-col (lambda () (set! src-col (add1 src-col)))]
@@ -403,7 +406,7 @@
(if val? value-color #f)
(list
(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) '" ."))
(+ (syntax-span a) 4)))
(list (syntax-source a)
@@ -424,9 +427,10 @@
(define (loop init-line! quote-depth expr? no-cons?)
(lambda (c)
(cond
- [(eq? 'code:blank (syntax-e c))
+ [(and escapes? (eq? 'code:blank (syntax-e c)))
(advance c init-line!)]
- [(and (pair? (syntax-e c))
+ [(and escapes?
+ (pair? (syntax-e c))
(eq? (syntax-e (car (syntax-e c))) 'code:comment))
(let ([l (syntax->list c)])
(unless (and l (= 2 (length l)))
@@ -446,7 +450,8 @@
(out v #f))))
(paragraph-content v))
(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))
(advance c init-line!)
(out "; " comment-color)
@@ -461,12 +466,14 @@
expr?
#f)
l))]
- [(and (pair? (syntax-e c))
+ [(and escapes?
+ (pair? (syntax-e c))
(eq? (syntax-e (car (syntax-e c))) 'code:line))
(let ([l (cdr (syntax->list c))])
(for-each (loop init-line! quote-depth expr? #f)
l))]
- [(and (pair? (syntax-e c))
+ [(and escapes?
+ (pair? (syntax-e c))
(eq? (syntax-e (car (syntax-e c))) 'code:hilite))
(let ([l (syntax->list c)]
[h? highlight?])
@@ -479,7 +486,8 @@
((loop init-line! quote-depth expr? #f) (cadr l))
(set! highlight? h?)
(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))
(advance c init-line!)
(let ([quote-depth (to-quoted c expr? quote-depth out color? inc-src-col)])
@@ -810,11 +818,11 @@
[(and (keyword? (syntax-e c)) expr?)
(advance c init-line!)
(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))))]
[else
(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)))
#;
(hash-set! next-col-map src-col dest-col)])))
@@ -836,11 +844,11 @@
(make-table block-color (map list (reverse docs))))
(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?)]
[s (syntax-e c)])
(if (or multi-line?
- (eq? 'code:blank s)
+ (and escapes? (eq? 'code:blank s))
(pair? s)
(mpair? s)
(vector? s)
@@ -852,8 +860,8 @@
(graph-reference? s)
(struct-proxy? s)
(and expr? (or (identifier? c)
- (keyword? (syntax-e c)))))
- (gen-typeset c multi-line? prefix1 prefix suffix color? expr? elem-wrap)
+ (keyword? (syntax-e c)))))
+ (gen-typeset c multi-line? prefix1 prefix suffix color? expr? escapes? elem-wrap)
(typeset-atom c
(letrec ([mk
(case-lambda
@@ -866,25 +874,31 @@
(make-element/cache (and color? color) elem)
(make-sized-element (and color? color) elem len)))])])
mk)
- color? 0 expr?))))
+ color? 0 expr? escapes?))))
- (define (to-element c #:expr? [expr? #f])
- (typeset c #f "" "" "" #t expr? values))
+ (define (to-element c
+ #:expr? [expr? #f]
+ #:escapes? [escapes? #t])
+ (typeset c #f "" "" "" #t expr? escapes? values))
- (define (to-element/no-color c #:expr? [expr? #f])
- (typeset c #f "" "" "" #f expr? values))
+ (define (to-element/no-color c
+ #:expr? [expr? #f]
+ #:escapes? [escapes? #t])
+ (typeset c #f "" "" "" #f expr? escapes? values))
(define (to-paragraph c
#:expr? [expr? #f]
+ #:escapes? [escapes? #t]
#:color? [color? #t]
#: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
#:expr? [expr? #f]
+ #:escapes? [escapes? #t]
#:color? [color? #t]
#: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
(define-struct variable-id (sym)
