bkyk8rc3zvpnsf5inmcqq4n3k98cv6hj-my-site-hyper-literate-git.test.suzanne.soy-0.0.1

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

manual-tech.rkt (2620B)

      1 #lang scheme/base
      2 (require racket/contract/base
      3          "../decode.rkt"
      4          "../struct.rkt"
      5          "manual-utils.rkt"
      6          "manual-style.rkt")
      7 
      8 (provide/contract
      9  [deftech (() (#:normalize? any/c
     10                #:style? any/c
     11                #:key (or/c string? #f))
     12            #:rest (listof pre-content?) . ->* . element?)]
     13  [tech (() 
     14         (#:doc (or/c module-path? false/c) 
     15          #:tag-prefixes (or/c (listof string?) false/c) 
     16          #:key (or/c string? #f)
     17          #:normalize? any/c)
     18         #:rest (listof pre-content?) 
     19         . ->* . element?)]
     20  [techlink (() 
     21             (#:doc (or/c module-path? false/c) 
     22              #:tag-prefixes (or/c (listof string?) false/c) 
     23              #:key (or/c string? #f)
     24              #:normalize? any/c)
     25             #:rest (listof pre-content?) 
     26             . ->* . element?)])
     27 
     28 (define (*tech make-elem style doc prefix s key normalize?)
     29   (let* ([c (decode-content s)]
     30          [s (or key (content->string c))]
     31          [s (if normalize?
     32                 (let* ([s (string-foldcase s)]
     33                        [s (regexp-replace #rx"ies$" s "y")]
     34                        [s (regexp-replace #rx"s$" s "")]
     35                        [s (regexp-replace* #px"[-\\s]+" s " ")])
     36                   s)
     37                 s)]
     38          [s (datum-intern-literal s)])
     39     (make-elem style c (list 'tech (doc-prefix doc prefix s)))))
     40 
     41 (define (deftech #:style? [style? #t] 
     42           #:normalize? [normalize? #t] 
     43           #:key [key #f]
     44           . s)
     45   (let* ([e (if style?
     46                 (apply defterm s)
     47                 (make-element #f (decode-content s)))]
     48          [t (*tech make-target-element #f #f #f (list e) key normalize?)])
     49     (make-index-element #f
     50                         (list t)
     51                         (target-element-tag t)
     52                         (list (datum-intern-literal
     53                                (clean-up-index-string (element->string e))))
     54                         (list e)
     55                         'tech)))
     56 
     57 (define (tech #:doc [doc #f] 
     58               #:tag-prefixes [prefix #f] 
     59               #:key [key #f] 
     60               #:normalize? [normalize? #t] 
     61               . s)
     62   (*tech (lambda (style c tag)
     63            (make-link-element
     64             style
     65             (list (make-element "techinside" c))
     66             tag))
     67          "techoutside"
     68          doc prefix s key
     69          normalize?))
     70 
     71 (define (techlink #:doc [doc #f] 
     72                   #:tag-prefixes [prefix #f] 
     73                   #:key [key #f] 
     74                   #:normalize? [normalize? #t] 
     75                   . s)
     76   (*tech make-link-element #f doc prefix s key normalize?))