scribble/manual: add #:normalize?' option to
deftech' et al.
original commit: 5e5e5038597c468ef699cf8c9fbc0a1577ca0d0d
This commit is contained in:
parent
c53e65ab66
commit
ae5d9f9413
|
@ -6,30 +6,42 @@
|
|||
"manual-style.rkt")
|
||||
|
||||
(provide/contract
|
||||
[deftech (() (#:style? boolean?) #:rest (listof pre-content?) . ->* . element?)]
|
||||
[deftech (() (#:normalize? any/c
|
||||
#:style? any/c)
|
||||
#:rest (listof pre-content?) . ->* . element?)]
|
||||
[tech (()
|
||||
(#:doc (or/c module-path? false/c) #:tag-prefixes (or/c (listof string?) false/c) #:key (or/c string? #f))
|
||||
(#:doc (or/c module-path? false/c)
|
||||
#:tag-prefixes (or/c (listof string?) false/c)
|
||||
#:key (or/c string? #f)
|
||||
#:normalize? any/c)
|
||||
#:rest (listof pre-content?)
|
||||
. ->* . element?)]
|
||||
[techlink (()
|
||||
(#:doc (or/c module-path? false/c) #:tag-prefixes (or/c (listof string?) false/c) #:key (or/c string? #f))
|
||||
(#:doc (or/c module-path? false/c)
|
||||
#:tag-prefixes (or/c (listof string?) false/c)
|
||||
#:key (or/c string? #f)
|
||||
#:normalize? any/c)
|
||||
#:rest (listof pre-content?)
|
||||
. ->* . element?)])
|
||||
|
||||
(define (*tech make-elem style doc prefix s key)
|
||||
(define (*tech make-elem style doc prefix s key normalize?)
|
||||
(let* ([c (decode-content s)]
|
||||
[s (string-foldcase (or key (content->string c)))]
|
||||
[s (regexp-replace #rx"ies$" s "y")]
|
||||
[s (regexp-replace #rx"s$" s "")]
|
||||
[s (regexp-replace* #px"[-\\s]+" s " ")]
|
||||
[s (or key (content->string c))]
|
||||
[s (if normalize?
|
||||
(let* ([s (string-foldcase s)]
|
||||
[s (regexp-replace #rx"ies$" s "y")]
|
||||
[s (regexp-replace #rx"s$" s "")]
|
||||
[s (regexp-replace* #px"[-\\s]+" s " ")])
|
||||
s)
|
||||
s)]
|
||||
[s (datum-intern-literal s)])
|
||||
(make-elem style c (list 'tech (doc-prefix doc prefix s)))))
|
||||
|
||||
(define (deftech #:style? [style? #t] . s)
|
||||
(define (deftech #:style? [style? #t] #:normalize? [normalize? #t] . s)
|
||||
(let* ([e (if style?
|
||||
(apply defterm s)
|
||||
(make-element #f (decode-content s)))]
|
||||
[t (*tech make-target-element #f #f #f (list e) #f)])
|
||||
[t (*tech make-target-element #f #f #f (list e) #f normalize?)])
|
||||
(make-index-element #f
|
||||
(list t)
|
||||
(target-element-tag t)
|
||||
|
@ -38,14 +50,23 @@
|
|||
(list e)
|
||||
'tech)))
|
||||
|
||||
(define (tech #:doc [doc #f] #:tag-prefixes [prefix #f] #:key [key #f] . s)
|
||||
(define (tech #:doc [doc #f]
|
||||
#:tag-prefixes [prefix #f]
|
||||
#:key [key #f]
|
||||
#:normalize? [normalize? #t]
|
||||
. s)
|
||||
(*tech (lambda (style c tag)
|
||||
(make-link-element
|
||||
style
|
||||
(list (make-element "techinside" c))
|
||||
tag))
|
||||
"techoutside"
|
||||
doc prefix s key))
|
||||
doc prefix s key
|
||||
normalize?))
|
||||
|
||||
(define (techlink #:doc [doc #f] #:tag-prefixes [prefix #f] #:key [key #f] . s)
|
||||
(*tech make-link-element #f doc prefix s key))
|
||||
(define (techlink #:doc [doc #f]
|
||||
#:tag-prefixes [prefix #f]
|
||||
#:key [key #f]
|
||||
#:normalize? [normalize? #t]
|
||||
. s)
|
||||
(*tech make-link-element #f doc prefix s key normalize?))
|
||||
|
|
|
@ -1283,15 +1283,16 @@ Alias of @racket[hyperlink] for backward compatibility.}
|
|||
Alias of @racket[other-doc] for backward compatibility.}
|
||||
|
||||
@defproc[(deftech [pre-content pre-content?] ...
|
||||
[#:style? style? boolean? #t]) element?]{
|
||||
[#:normalize? normalize? any/c #t]
|
||||
[#:style? style? any/c #t]) element?]{
|
||||
|
||||
Produces an element for the @tech{decode}d @racket[pre-content], and
|
||||
also defines a term that can be referenced elsewhere using
|
||||
@racket[tech].
|
||||
|
||||
The @racket[content->string] result of the @tech{decode}d
|
||||
@racket[pre-content] is used as a key for references, but normalized
|
||||
as follows:
|
||||
@racket[pre-content] is used as a key for references; if
|
||||
@racket[normalize?] is true, then the string is normalized as follows:
|
||||
|
||||
@itemize[
|
||||
|
||||
|
@ -1315,6 +1316,7 @@ If @racket[style?] is true, then @racket[defterm] is used on
|
|||
|
||||
@defproc[(tech [pre-content pre-content?] ...
|
||||
[#:key key (or/c string? #f) #f]
|
||||
[#:normalize? normalize? any/c #t]
|
||||
[#:doc module-path (or/c module-path? #f) #f]
|
||||
[#:tag-prefixes prefixes (or/c (listof string?) #f) #f])
|
||||
element?]{
|
||||
|
@ -1323,7 +1325,7 @@ Produces an element for the @tech{decode}d @racket[pre-content], and
|
|||
hyperlinks it to the definition of the key as established by
|
||||
@racket[deftech]. If @racket[key] is false, the decoded content is
|
||||
converted to a string (using @racket[content->string]) to use as a
|
||||
key; in either case, the key is normalized in the same way as for
|
||||
key; in either case, if @racket[normalize?] is true, the key is normalized in the same way as for
|
||||
@racket[deftech]. The @racket[#:doc] and @racket[#:tag-prefixes]
|
||||
arguments support cross-document and section-specific references, like
|
||||
in @racket[secref].
|
||||
|
@ -1341,6 +1343,7 @@ linked to the former using @racketfont["@tech{bind}ing"].}
|
|||
|
||||
@defproc[(techlink [pre-content pre-content?] ...
|
||||
[#:key key (or/c string? #f) #f]
|
||||
[#:normalize? normalize? any/c #t]
|
||||
[#:doc module-path (or/c module-path? #f) #f]
|
||||
[#:tag-prefixes prefixes (or/c (listof string?) #f) #f])
|
||||
element?]{
|
||||
|
|
|
@ -16,7 +16,8 @@
|
|||
[fp (send renderer traverse docs fns)]
|
||||
[info (send renderer collect docs fns fp)]
|
||||
[r-info (send renderer resolve docs fns info)])
|
||||
(send renderer render docs fns r-info)))
|
||||
(send renderer render docs fns r-info)
|
||||
(send renderer get-undefined r-info)))
|
||||
|
||||
(provide docs-tests)
|
||||
(module+ main (docs-tests))
|
||||
|
@ -38,7 +39,12 @@
|
|||
(define generated-file (build-path work-dir "gen.txt"))
|
||||
(define (contents file)
|
||||
(regexp-replace #rx"\n+$" (file->string file) ""))
|
||||
(build-text-doc src-file "gen.txt")
|
||||
(define undefineds (build-text-doc src-file "gen.txt"))
|
||||
(for ([u (in-list undefineds)])
|
||||
(when (eq? 'tech (car u))
|
||||
(test #:failure-message
|
||||
(format "undefined tech: ~e" u)
|
||||
#f)))
|
||||
(test #:failure-message
|
||||
(format
|
||||
"mismatch for: \"~a\", expected text in: \"~a\", got:\n~a"
|
||||
|
|
27
collects/tests/scribble/docs/tech.scrbl
Normal file
27
collects/tests/scribble/docs/tech.scrbl
Normal file
|
@ -0,0 +1,27 @@
|
|||
#lang scribble/manual
|
||||
|
||||
Check case and ``s'' normalization:
|
||||
Here is @deftech{apple}.
|
||||
@tech{Apples} are great!
|
||||
We all like the
|
||||
@techlink[#:key "APPLE"]{fruit of an apple tree}.
|
||||
|
||||
Check case and ``ies'' normalization:
|
||||
Here is @deftech{cherry}.
|
||||
@tech{CHERRIES} are great!
|
||||
|
||||
Check non-normalization:
|
||||
Here is @deftech[#:normalize? #f]{egGPlant}.
|
||||
No one likes @tech[#:normalize? #f]{egGPlant}.
|
||||
It's the @techlink[#:key "egGPlant" #:normalize? #f]{fruit of an egGPlant plant}.
|
||||
Here is @deftech[#:normalize? #f]{EGgpLANT},
|
||||
which is completely different.
|
||||
|
||||
Check space and hyphen normalization:
|
||||
Here is @deftech{granola bar}.
|
||||
A @tech{granola-bar} breakfast is good enough.
|
||||
A @tech{granola--bar} combination is close enough.
|
||||
You can eat a spacey @tech{granola bar}, too.
|
||||
|
||||
|
||||
|
12
collects/tests/scribble/docs/tech.txt
Normal file
12
collects/tests/scribble/docs/tech.txt
Normal file
|
@ -0,0 +1,12 @@
|
|||
Check case and “s” normalization: Here is apple. Apples are great! We
|
||||
all like the fruit of an apple tree.
|
||||
|
||||
Check case and “ies” normalization: Here is cherry. CHERRIES are great!
|
||||
|
||||
Check non-normalization: Here is egGPlant. No one likes egGPlant. It’s
|
||||
the fruit of an egGPlant plant. Here is EGgpLANT, which is completely
|
||||
different.
|
||||
|
||||
Check space and hyphen normalization: Here is granola bar. A granola-bar
|
||||
breakfast is good enough. A granola–bar combination is close enough. You
|
||||
can eat a spacey granola bar, too.
|
Loading…
Reference in New Issue
Block a user