tag.rkt (1374B)
1 #lang scheme/base 2 3 ;; It might make sense to make these functions public, but since they weren't originally, 4 ;; I am going to keep them in the private folder for now. 5 ;; -- With Love, Leif 6 7 (provide (all-defined-out)) 8 9 (require racket/list 10 scribble/core 11 "../tag.rkt") 12 13 (define (gen-tag content) 14 (datum-intern-literal 15 ;; Generate tag from ASCII plus CJK characters. Constraining to 16 ;; ASCII for most purposes helps avoid encoding issues for 17 ;; uncooperative environments, but constraining to ASCII is too 18 ;; uncooperative in another direction for CJK text (i.e., creates 19 ;; too many conflicting tags). 20 (regexp-replace* #px"[^-a-zA-Z0-9_=\u4e00-\u9fff\u3040-\u309F\u30A0-\u30FF]" 21 (content->string content) "_"))) 22 23 (define (convert-tag tag content) 24 (if (list? tag) 25 (append-map (lambda (t) (convert-tag t content)) tag) 26 `((part ,(or tag (gen-tag content)))))) 27 28 (define (convert-part-style who s) 29 (cond 30 [(style? s) s] 31 [(not s) plain] 32 [(string? s) (make-style s null)] 33 [(symbol? s) (make-style #f (list s))] 34 [(and (list? s) (andmap symbol? s)) (make-style #f s)] 35 [else (raise-argument-error who "(or/c style? string? symbol? (listof symbol?) #f)" s)])) 36 37 (define (prefix->string p) 38 (and p (if (string? p) 39 (datum-intern-literal p) 40 (module-path-prefix->string p))))