suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 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

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

@ -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

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

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

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

@ -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)