#lang racket/base (require racket/list racket/string sugar/define sugar/test txexpr/base racket/match sugar/unstable/container sugar/coerce sugar/unstable/len "../private/whitespace.rkt") (provide whitespace? whitespace/nbsp?) (define (make-replacer query+replacement) (let ([queries (map car query+replacement)] [replacements (map second query+replacement)]) ;; reverse because first in list should be first applied to str (and compose1 works right-to-left) (apply compose1 (reverse (map (λ (query replacement) (λ (str) (regexp-replace* query str replacement))) queries replacements))))) (define+provide/contract (smart-dashes str) (string? . -> . string?) (define dashes ;; fix em dashes first, else they'll be mistaken for en dashes ;; \\s is whitespace + #\u00A0 is nonbreaking space '((#px"[\\s#\u00A0]*(---|—)[\\s#\u00A0]*" "—") ; em dash (#px"[\\s#\u00A0]*(--|–)[\\s#\u00A0]*" "–"))) ; en dash ((make-replacer dashes) str)) (module-test-external (check-equal? (smart-dashes "I had --- maybe 13 -- 20 --- hob-nobs.") "I had—maybe 13–20—hob-nobs.") (define tricky-string "\"Why,\" she could've asked, \"are we in O‘ahu watching 'Mame'?\"") (check-equal? (smart-quotes tricky-string) "“Why,” she could’ve asked, “are we in O‘ahu watching ‘Mame’?”") (check-equal? (smart-quotes tricky-string #:apostrophe "zing" #:double-open "«" #:double-close "»" #:single-open "‹" #:single-close "›") "«Why,» she couldzingve asked, «are we in O‘ahu watching ‹Mame›?»") (check-equal? (smart-quotes "\"\'Impossible.\' Yes.\"") "“‘Impossible.’ Yes.”") (check-equal? (smart-quotes '(div "don'" (em "t"))) '(div "don’" (em "t"))) (check-equal? (smart-quotes '(div "do '" (em "not'"))) '(div "do ‘" (em "not’")))) (define+provide/contract (smart-quotes x #:apostrophe [apostrophe-str "’"] #:single-open [single-open-str "‘"] #:single-close [single-close-str "’"] #:double-open [double-open-str "“"] #:double-close [double-close-str "”"]) (((or/c string? txexpr?)) (#:apostrophe string? #:single-open string? #:single-close string? #:double-open string? #:double-close string?) . ->* . (or/c string? txexpr?)) (define quotes `((#px"(?<=\\w)'(?=\\w)" ,apostrophe-str) ; apostrophe (#px"(?string (for/list ([c (in-vector char-vec prev-offset offset)]) c))] [else x]))] [else x])) ; wrap initial quotes for hanging punctuation ; todo: improve this ; does not handle

thing properly (define+provide/contract (wrap-hanging-quotes nx #:single-prepend [single-pp '(squo)] #:double-prepend [double-pp '(dquo)]) ((txexpr?) (#:single-prepend list? #:double-prepend list?) . ->* . txexpr?) (define two-or-more-char-string? (λ (i) (and (string? i) (>= (string-length i) 2)))) (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) (define str-first (get tcs 0)) (define str-rest (get tcs 1 (string-length tcs))) (cond [(str-first . in? . '("\"" "“")) ;; can wrap with any inline tag ;; so that linebreak detection etc still works `(,@double-pp ,(->string #\“) ,str-rest)] [(str-first . in? . '("\'" "‘")) `(,@single-pp ,(->string #\‘) ,str-rest)] [else tcs])] [(? txexpr? nx) (wrap-hanging-quotes nx)] [else (car elements)])]) (cons new-car-elements (cdr elements))) elements))) (module-test-external (check-equal? (wrap-hanging-quotes '(p "\"Hi\" there")) '(p (dquo "“" "Hi\" there"))) (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 txexpr without elements passes through unscathed (check-equal? (wrap-hanging-quotes '(div ((style "height:2em")))) '(div ((style "height:2em"))))) ;; insert nbsp between last two words (define+provide/contract (nonbreaking-last-space x #:nbsp [nbsp (->string #\u00A0)] #:minimum-word-length [minimum-word-length 6] #:last-word-proc [last-word-proc (λ (x) x)]) ((txexpr?) (#:nbsp string? #:minimum-word-length integer? #:last-word-proc procedure?) . ->* . txexpr?) ;; 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))] [reversed-nbsp (reverse (string->list (->string nbsp)))]) (define-values (last-word-chars other-chars) (splitf-at reversed-str-list (λ (i) (not (eq? i #\space))))) (define front-chars (if (< (len last-word-chars) minimum-word-length) ; OK for long words to be on their own line ; first char of other-chars will be the space, so use cdr (string-append (list->string (reverse (cdr other-chars))) (->string nbsp)) (list->string (reverse other-chars)))) (define last-word (list->string (reverse last-word-chars))) `(,front-chars ,(last-word-proc last-word))) ; don't concatenate last word bc last-word-proc might be a txexpr wrapper (list str))) (define (find-last-word-space x) ; recursively traverse xexpr (cond [(string? x) (replace-last-space x)] ; todo: this assumes a paragraph only has one string in it. [(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)))]) (define result (find-last-word-space (car last))) (define result-items (if (txexpr? result) (list result) result)) ; might be txexpr, or list of new elements (make-txexpr tag attr `(,@all-but-last ,@result-items))) x))] [else x])) (if ((car x) . in? . tags-to-pay-attention-to) (find-last-word-space x) x)) (module-test-internal ;; todo: make some tougher tests, it gets flaky with edge cases (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 "Ø") '(p "HiØ" "there")) ; but let's make it visible (check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_") '(p "Hi_up_" "there")) (check-equal? (nonbreaking-last-space '(p "Hi there") #:nbsp "_up_" #:minimum-word-length 3) '(p "Hi " "there")) (check-equal? (nonbreaking-last-space '(p "Hi here" (em "ho there")) #:nbsp "Ø") '(p "Hi here" (em "hoØ" "there"))))