diff --git a/decode.rkt b/decode.rkt index 8186e73..4e18656 100644 --- a/decode.rkt +++ b/decode.rkt @@ -55,6 +55,9 @@ '(p "\n" "foo" "\n\n" "bar" (em "\n\n\n")))) +;; todo: add native support for list-xexpr +;; decode triple newlines to list items + ;; is the named-xexpr a block element (as opposed to inline) (define/contract (block-xexpr? x) (any/c . -> . boolean?) @@ -168,8 +171,6 @@ (when (not (named-xexpr? nx)) (error (format "decode: ~v not a full named-xexpr" nx))) - (define metas (list)) - (define (&decode x) (cond [(named-xexpr? x) (let-values([(name attr content) (break-named-xexpr x)]) @@ -188,41 +189,4 @@ (let-values ([(nx metas) (extract-tag-from-xexpr 'meta nx)]) - (append (&decode nx) (map meta-proc metas)))) - -#| -;; default content decoder for pollen -(define/contract (decode x) - (named-xexpr? . -> . named-xexpr?) - - (define (&decode x) - (cond - [(named-xexpr? x) - (let-values([(name attr content) (break-named-xexpr x)]) - (define decoded-x (make-named-xexpr name attr (&decode content))) - (if (block-xexpr? decoded-x) - ; add nonbreaking-last-space to the next line when ready - (wrap-hanging-quotes (nonbreaking-last-space decoded-x)) ; do special processing for block xexprs - decoded-x))] - [(xexpr-content? x) ; a list of xexprs - (let ([x (prep-paragraph-flow x)]) - (map &decode (if (ormap paragraph-break? x) ; need this condition to prevent infinite recursion - (map wrap-paragraph (splitf-at* x paragraph-break?)) ; split into ¶¶ - x)))] - [(string? x) (typogrify x)] - [else x])) - - (define (stringify x) ; convert numbers to strings - (cond - [(list? x) (map stringify x)] - [(number? x) (~a x)] - [else x])) - - (let* ([x (stringify x)] - [x (trim-whitespace x)]) - (if (named-xexpr? x) - (&decode x) - ;todo: improve this error message, more specific location - ; now, it just spits out the whole defective content - (error (format "decode: ~v not a full named-xexpr" x))))) -|# \ No newline at end of file + (append (&decode nx) (map meta-proc metas)))) \ No newline at end of file diff --git a/tests/pollen-lang-test.p b/tests/pollen-lang-test.p index c1fbdec..c3a35a0 100644 --- a/tests/pollen-lang-test.p +++ b/tests/pollen-lang-test.p @@ -2,14 +2,18 @@ ◊meta["metakey" "metavalue"] -Hello world +◊;todo: make this recognized as a block. +◊bloq{In a block} + +"Hello" world, aren't you --- yes, you — about 1--2 inches tall? ◊em{Love} +◊foo + Goodnight -moon +moon light -◊foo diff --git a/tests/requires/include-me.rkt b/tests/requires/include-me.rkt index ff36178..53362ec 100644 --- a/tests/requires/include-me.rkt +++ b/tests/requires/include-me.rkt @@ -64,6 +64,130 @@ (map wrap-paragraph (splitf-at* content paragraph-break?)) ; split into ¶¶ content))) + +;; insert nbsp between last two words +(define/contract (nonbreaking-last-space x #:nbsp-char [nbsp #\ ]) + ((named-xexpr?) (#:nbsp-char char?) . ->* . named-xexpr?) + (define minimum-word-length (add1 5)) ; add1 to account for final punctuation + ; todo: parameterize this, as it will be different for each project + (define tags-to-pay-attention-to '(p aside)) ; only apply to paragraphs + + (define (replace-last-space str) + (if (#\space . in . str) + (let ([reversed-str-list (reverse (string->list str))]) + (define-values (last-word-chars other-chars) + (splitf-at reversed-str-list (λ(i) (not (eq? i #\space))))) + (list->string (reverse (append last-word-chars + ; OK for long words to be on their own line. + (if (< (len last-word-chars) minimum-word-length) + ; first char of other-chars will be the space, so use cdr + (cons nbsp (cdr other-chars)) + other-chars))))) + str)) + + (define (find-last-word-space x) ; recursively traverse xexpr + (cond + [(string? x) (replace-last-space x)] + [(named-xexpr? x) + (let-values([(name attr content) (break-named-xexpr x)]) + (if (> (length content) 0) ; content is list of xexprs + (let-values ([(all-but-last last) (split-at content (sub1 (length content)))]) + (make-named-xexpr name attr `(,@all-but-last ,(find-last-word-space (car last))))) + x))] + [else x])) + + (if ((car x) . in . tags-to-pay-attention-to) + (find-last-word-space x) + x)) + +;; todo: make some tougher tests, it gets flaky with edge cases +(module+ test + (check-equal? (nonbreaking-last-space '(p "Hi there")) '(p "Hi there")) ; nbsp in between last two words + (check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp-char #\Ø) '(p "HiØthere")) ; but let's make it visible + (check-equal? (nonbreaking-last-space '(p "Hi here" (em "ho there")) #:nbsp-char #\Ø) '(p "Hi here" (em "hoØthere")))) + + +; wrap initial quotes for hanging punctuation +; todo: improve this +; does not handle

thing properly +(define/contract (wrap-hanging-quotes nx) + (named-xexpr? . -> . named-xexpr?) + (define-values (name attr content) (break-named-xexpr nx)) + (cond + [(and (not (empty? content)) + (string? (car content)) + (> (string-length (car content)) 1)) + (let ([new-car + (letrec ([x (car content)] + [first (get x 0)] + [rest (get x 1 'end)]) + (cond + [(first . in . '("\"" "“")) + ; this has to be span so that it's explicitly + ; an inline element. If not, + ; things like linebreak detection won't work. + `(span ((class "dquo")) ,(->string #\“) ,rest)] + [(first . in . '("\'" "‘")) + `(span ((class "squo")) ,(->string #\‘) ,rest)] + [else x]))]) + (make-named-xexpr name attr (cons new-car (cdr content))))] + [(and content (not (empty? content)) (named-xexpr? (car content))) + (make-named-xexpr name attr (cons (wrap-hanging-quotes (car content)) (cdr content)))] + [else nx])) + + +(module+ test + (check-equal? (wrap-hanging-quotes '(p "\"Hi\" there")) '(p (span ((class "dquo")) "“" "Hi\" there"))) + (check-equal? (wrap-hanging-quotes '(p "'Hi' there")) '(p (span ((class "squo")) "‘" "Hi' there")))) + + +(define (block-xexpr-proc bx) + (named-xexpr? . -> . named-xexpr?) + (wrap-hanging-quotes (nonbreaking-last-space bx))) + + +;; insert typographic niceties +;; ligatures are handled in css +(define (typogrify str) + (string? . -> . string?) + ;; make set of functions for replacers + (define (make-replacer query replacement) + (λ(str) (regexp-replace* query str replacement))) + + ;; just store the query strings + replacement strings + (define dashes + ;; fix em dashes first, else they'll be mistaken for en dashes + ;; [\\s ] is whitespace + nonbreaking space + '((#px"[\\s ]*(---|—)[\\s ]*" "—") ; em dash + (#px"[\\s ]*(--|–)[\\s ]*" "–"))) ; en dash + + (define smart-quotes + '((#px"(?<=\\w)'(?=\\w)" "’") ; apostrophe + (#px"(? . string?) + (typogrify str)) + (define (root . items) (named-xexpr? . -> . named-xexpr?) (decode (cons 'root items) @@ -71,9 +195,9 @@ ; #:xexpr-name-proc [xexpr-name-proc (λ(x)x)] ; #:xexpr-attr-proc [xexpr-attr-proc (λ(x)x)] #:xexpr-content-proc xexpr-content-proc - ; #:block-xexpr-proc [block-xexpr-proc (λ(x)x)] + #:block-xexpr-proc block-xexpr-proc ; #:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)] - ; #:string-proc string-proc + #:string-proc string-proc #:meta-proc meta-proc ))