scribble-enhanced/collects/scribble/private/manual-tech.rkt
Matthew Flatt f1a593d3a3 read-intern strings generated by Scribble; other interning
This change saves a small amount of space in cross-reference files
and some space in loaded cross-reference information.
It also saves work converting strings to mutable on deserialize,
although the performance difference seems negligible.

original commit: b2fade9206590173e4c2e346357ad13150525387
2011-12-10 11:43:58 -07:00

52 lines
1.9 KiB
Racket

#lang scheme/base
(require racket/contract/base
"../decode.rkt"
"../struct.rkt"
"manual-utils.rkt"
"manual-style.rkt")
(provide/contract
[deftech (() (#:style? boolean?) #: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))
#: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))
#:rest (listof pre-content?)
. ->* . element?)])
(define (*tech make-elem style doc prefix s key)
(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 (read-intern-literal s)])
(make-elem style c (list 'tech (doc-prefix doc prefix s)))))
(define (deftech #:style? [style? #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)])
(make-index-element #f
(list t)
(target-element-tag t)
(list (read-intern-literal
(clean-up-index-string (element->string e))))
(list e)
'tech)))
(define (tech #:doc [doc #f] #:tag-prefixes [prefix #f] #:key [key #f] . s)
(*tech (lambda (style c tag)
(make-link-element
style
(list (make-element "techinside" c))
tag))
"techoutside"
doc prefix s key))
(define (techlink #:doc [doc #f] #:tag-prefixes [prefix #f] #:key [key #f] . s)
(*tech make-link-element #f doc prefix s key))