scribble/manual: add #:normalize?' option to deftech' et al.

original commit: 5e5e5038597c468ef699cf8c9fbc0a1577ca0d0d

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 (or key (content->string c))]
-         [s (regexp-replace #rx"ies$" s "y")]
+         [s (if normalize?
-         [s (regexp-replace #rx"s$" s "")]
+                (let* ([s (string-foldcase s)]
-         [s (regexp-replace* #px"[-\\s]+" 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)
+(define (techlink #:doc [doc #f] 
-  (*tech make-link-element #f doc prefix s key))
+                  #:tag-prefixes [prefix #f] 
+                  #:key [key #f] 
+                  #:normalize? [normalize? #t] 
+                  . s)
+  (*tech make-link-element #f doc prefix s key normalize?))

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
+@racket[pre-content] is used as a key for references; if
-as follows:
+@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?]{

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"

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.
+
+
+

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.