diff --git a/collects/scribble/private/manual-tech.rkt b/collects/scribble/private/manual-tech.rkt index 52ca9a5b..ce90f592 100644 --- a/collects/scribble/private/manual-tech.rkt +++ b/collects/scribble/private/manual-tech.rkt @@ -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?)) diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index 1e325349..ee9e70e9 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -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?]{ diff --git a/collects/tests/scribble/docs.rkt b/collects/tests/scribble/docs.rkt index e902165e..d5eecf15 100644 --- a/collects/tests/scribble/docs.rkt +++ b/collects/tests/scribble/docs.rkt @@ -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" diff --git a/collects/tests/scribble/docs/tech.scrbl b/collects/tests/scribble/docs/tech.scrbl new file mode 100644 index 00000000..1d78262e --- /dev/null +++ b/collects/tests/scribble/docs/tech.scrbl @@ -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. + + + diff --git a/collects/tests/scribble/docs/tech.txt b/collects/tests/scribble/docs/tech.txt new file mode 100644 index 00000000..eb99d000 --- /dev/null +++ b/collects/tests/scribble/docs/tech.txt @@ -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.