|
|
|
@ -1,7 +1,7 @@
|
|
|
|
|
#lang racket/base
|
|
|
|
|
(require racket/contract racket/list racket/string racket/match)
|
|
|
|
|
(require (only-in xml xexpr/c))
|
|
|
|
|
(require "tools.rkt" "predicates.rkt" sugar tagged-xexpr)
|
|
|
|
|
(require "tools.rkt" "predicates.rkt" sugar txexpr)
|
|
|
|
|
|
|
|
|
|
(module+ test (require rackunit))
|
|
|
|
|
|
|
|
|
@ -39,25 +39,25 @@
|
|
|
|
|
#:block-xexpr-proc procedure?
|
|
|
|
|
#:inline-xexpr-proc procedure?
|
|
|
|
|
#:string-proc procedure?)
|
|
|
|
|
. ->* . tagged-xexpr?)
|
|
|
|
|
(when (not (tagged-xexpr? nx))
|
|
|
|
|
(error (format "decode: ~v not a full tagged-xexpr" nx)))
|
|
|
|
|
. ->* . txexpr?)
|
|
|
|
|
(when (not (txexpr? nx))
|
|
|
|
|
(error (format "decode: ~v not a full txexpr" nx)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (&decode x)
|
|
|
|
|
(cond
|
|
|
|
|
[(tagged-xexpr? x) (let-values([(tag attr elements) (tagged-xexpr->values x)])
|
|
|
|
|
[(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)])
|
|
|
|
|
(if (tag . in? . excluded-xexpr-tags)
|
|
|
|
|
x ; let x pass through untouched
|
|
|
|
|
(let ([decoded-xexpr (apply make-tagged-xexpr
|
|
|
|
|
(let ([decoded-xexpr (apply make-txexpr
|
|
|
|
|
(map &decode (list tag attr elements)))])
|
|
|
|
|
((if (block-xexpr? decoded-xexpr)
|
|
|
|
|
block-xexpr-proc
|
|
|
|
|
inline-xexpr-proc) decoded-xexpr))))]
|
|
|
|
|
[(tagged-xexpr-tag? x) (xexpr-tag-proc x)]
|
|
|
|
|
[(tagged-xexpr-attrs? x) (xexpr-attrs-proc x)]
|
|
|
|
|
[(txexpr-tag? x) (xexpr-tag-proc x)]
|
|
|
|
|
[(txexpr-attrs? x) (xexpr-attrs-proc x)]
|
|
|
|
|
;; need this for operations that may depend on context in list
|
|
|
|
|
[(tagged-xexpr-elements? x) (map &decode (xexpr-elements-proc x))]
|
|
|
|
|
[(txexpr-elements? x) (map &decode (xexpr-elements-proc x))]
|
|
|
|
|
[(string? x) (string-proc x)]
|
|
|
|
|
;; if something has made it through undecoded, that's a problem
|
|
|
|
|
[else (error "Can't decode" x)]))
|
|
|
|
@ -118,7 +118,7 @@
|
|
|
|
|
(define/contract (nonbreaking-last-space x
|
|
|
|
|
#:nbsp [nbsp (->string #\u00A0)]
|
|
|
|
|
#:minimum-word-length [minimum-word-length 6])
|
|
|
|
|
((tagged-xexpr?) (#:nbsp string? #:minimum-word-length integer?) . ->* . tagged-xexpr?)
|
|
|
|
|
((txexpr?) (#:nbsp string? #:minimum-word-length integer?) . ->* . txexpr?)
|
|
|
|
|
;; todo: parameterize this, as it will be different for each project
|
|
|
|
|
(define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs
|
|
|
|
|
|
|
|
|
@ -139,11 +139,11 @@
|
|
|
|
|
(define (find-last-word-space x) ; recursively traverse xexpr
|
|
|
|
|
(cond
|
|
|
|
|
[(string? x) (replace-last-space x)]
|
|
|
|
|
[(tagged-xexpr? x)
|
|
|
|
|
(let-values([(tag attr elements) (tagged-xexpr->values x)])
|
|
|
|
|
[(txexpr? x)
|
|
|
|
|
(let-values([(tag attr elements) (txexpr->values x)])
|
|
|
|
|
(if (> (length elements) 0) ; elements is list of xexprs
|
|
|
|
|
(let-values ([(all-but-last last) (split-at elements (sub1 (length elements)))])
|
|
|
|
|
(make-tagged-xexpr tag attr `(,@all-but-last ,(find-last-word-space (car last)))))
|
|
|
|
|
(make-txexpr tag attr `(,@all-but-last ,(find-last-word-space (car last)))))
|
|
|
|
|
x))]
|
|
|
|
|
[else x]))
|
|
|
|
|
|
|
|
|
@ -167,10 +167,10 @@
|
|
|
|
|
(define/contract (wrap-hanging-quotes nx
|
|
|
|
|
#:single-prepend [single-pp '(squo)]
|
|
|
|
|
#:double-prepend [double-pp '(dquo)])
|
|
|
|
|
((tagged-xexpr?) (#:single-prepend list? #:double-prepend list?) . ->* . tagged-xexpr?)
|
|
|
|
|
((txexpr?) (#:single-prepend list? #:double-prepend list?) . ->* . txexpr?)
|
|
|
|
|
(define two-or-more-char-string? (λ(i) (and (string? i) (>= (len i) 2))))
|
|
|
|
|
(define-values (tag attr elements) (tagged-xexpr->values nx))
|
|
|
|
|
(make-tagged-xexpr tag attr
|
|
|
|
|
(define-values (tag attr elements) (txexpr->values nx))
|
|
|
|
|
(make-txexpr tag attr
|
|
|
|
|
(if (and (list? elements) (not (empty? elements)))
|
|
|
|
|
(let ([new-car-elements (match (car elements)
|
|
|
|
|
[(? two-or-more-char-string? tcs)
|
|
|
|
@ -184,7 +184,7 @@
|
|
|
|
|
[(str-first . in? . '("\'" "‘"))
|
|
|
|
|
`(,@single-pp ,(->string #\‘) ,str-rest)]
|
|
|
|
|
[else tcs])]
|
|
|
|
|
[(? tagged-xexpr? nx) (wrap-hanging-quotes nx)]
|
|
|
|
|
[(? txexpr? nx) (wrap-hanging-quotes nx)]
|
|
|
|
|
[else (car elements)])])
|
|
|
|
|
(cons new-car-elements (cdr elements)))
|
|
|
|
|
elements)))
|
|
|
|
@ -196,7 +196,7 @@
|
|
|
|
|
(check-equal? (wrap-hanging-quotes '(p "'Hi' there")) '(p (squo "‘" "Hi' there")))
|
|
|
|
|
(check-equal? (wrap-hanging-quotes '(p "'Hi' there") #:single-prepend '(foo ((bar "ino"))))
|
|
|
|
|
'(p (foo ((bar "ino")) "‘" "Hi' there")))
|
|
|
|
|
;; make sure tagged-xexpr without elements passes through unscathed
|
|
|
|
|
;; make sure txexpr without elements passes through unscathed
|
|
|
|
|
(check-equal? (wrap-hanging-quotes '(div ((style "height:2em")))) '(div ((style "height:2em")))))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
@ -209,7 +209,7 @@
|
|
|
|
|
|
|
|
|
|
;; turn the right items into <br> tags
|
|
|
|
|
(define/contract (convert-linebreaks xc #:newline [newline "\n"])
|
|
|
|
|
((tagged-xexpr-elements?) (#:newline string?) . ->* . tagged-xexpr-elements?)
|
|
|
|
|
((txexpr-elements?) (#:newline string?) . ->* . txexpr-elements?)
|
|
|
|
|
;; todo: should this test be not block + not whitespace?
|
|
|
|
|
(define not-block? (λ(i) (not (block-xexpr? i))))
|
|
|
|
|
(filter-not empty?
|
|
|
|
@ -292,7 +292,7 @@
|
|
|
|
|
|
|
|
|
|
;; prepare elements for paragraph testing
|
|
|
|
|
(define/contract (prep-paragraph-flow xc)
|
|
|
|
|
(tagged-xexpr-elements? . -> . tagged-xexpr-elements?)
|
|
|
|
|
(txexpr-elements? . -> . txexpr-elements?)
|
|
|
|
|
(convert-linebreaks (merge-newlines (trim xc whitespace?))))
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
@ -301,10 +301,10 @@
|
|
|
|
|
|
|
|
|
|
;; apply paragraph tag
|
|
|
|
|
(define/contract (wrap-paragraph xc #:tag [tag 'p])
|
|
|
|
|
((tagged-xexpr-elements?) (#:tag symbol?) . ->* . block-xexpr?)
|
|
|
|
|
((txexpr-elements?) (#:tag symbol?) . ->* . block-xexpr?)
|
|
|
|
|
(match xc
|
|
|
|
|
[(list (? block-xexpr? bx)) bx] ; leave a single block xexpr alone
|
|
|
|
|
[else (make-tagged-xexpr tag empty xc)])) ; otherwise wrap in p tag
|
|
|
|
|
[else (make-txexpr tag empty xc)])) ; otherwise wrap in p tag
|
|
|
|
|
|
|
|
|
|
(module+ test
|
|
|
|
|
(check-equal? (wrap-paragraph '("foo" "bar")) '(p "foo" "bar"))
|
|
|
|
@ -317,7 +317,7 @@
|
|
|
|
|
;; detect paragraphs
|
|
|
|
|
;; todo: unit tests
|
|
|
|
|
(define/contract (detect-paragraphs elements)
|
|
|
|
|
(tagged-xexpr-elements? . -> . tagged-xexpr-elements?)
|
|
|
|
|
(txexpr-elements? . -> . txexpr-elements?)
|
|
|
|
|
(let ([elements (prep-paragraph-flow elements)])
|
|
|
|
|
(if (ormap paragraph-break? elements) ; need this condition to prevent infinite recursion
|
|
|
|
|
(map wrap-paragraph (splitf-at* elements paragraph-break?)) ; split into ¶¶
|
|
|
|
|