reasoning

quad/qtest/fark.rkt

@@ -1,5 +1,18 @@
 #lang qtest/markdown
 
-x
+So why did his sister not go and join the others? She had probably
-
+only just got up and had not even begun to get dressed.  And why was
-y
+she crying? Was it because he had not got up, and had not let the
+chief clerk in, because he was in danger of losing his job and if
+that happened his boss would once more pursue their parents with the
+same demands as before? There was no need to worry about things like
+that yet.  Gregor was still there and had not the slightest
+intention of abandoning his family.  For the time being he just lay
+there on the carpet, and no-one who knew the condition he was in
+would seriously have expected him to let the chief clerk in.  It was
+only a minor discourtesy, and a suitable excuse could easily be
+found for it later on, it was not something for which Gregor could
+be sacked on the spot.  And it seemed to Gregor much more sensible
+to leave him now in peace instead of disturbing him with talking at
+him and crying.  But the others didn't know what was happening, they
+were worried, that would excuse their behaviour.

quad/qtest/markdown.rkt

@@ -1,6 +1,6 @@
 #lang debug racket/base
 (require (for-syntax racket/base) txexpr racket/runtime-path racket/path racket/string racket/promise racket/match racket/list
-         pitfall quad sugar/debug pollen/tag racket/unsafe/ops)
+         pitfall quad sugar/debug pollen/tag racket/unsafe/ops hyphenate)
 (provide (except-out (all-from-out racket/base) #%module-begin)
          (rename-out [mb #%module-begin])
          p id strong em attr-list h1 h2 h3 h4 h5 h6 
@@ -18,7 +18,7 @@
 
 (define-tag-function (p attrs exprs)
   ;; no font-family so that it adopts whatever the surrounding family is
-  (qexpr (append `((keep-first "2")(keep-last "3") (display ,(symbol->string (gensym)))) attrs) exprs))
+  (qexpr (append `((keep-first "2")(keep-last "3") (hyphenate "true") (display ,(symbol->string (gensym)))) attrs) exprs))
 
 (define-tag-function (hr attrs exprs)
   hrbr)
@@ -229,8 +229,22 @@
     (hash-set! dest-hash k v))
   dest-hash)
 
-(define (line-wrap xs wrap-size)
+(define (handle-hyphenate qs)
-  (wrap xs (λ (q idx) (- wrap-size (quad-ref q 'inset-left 0) (quad-ref q 'inset-right 0)))
+  ;; find quads that want hyphenation and split them into smaller pieces
+  ;; do this before ->string-quad so that it can handle the sizing promises
+  (apply append (for/list ([q (in-list qs)])
+                  (match (quad-ref q 'hyphenate #false)
+                    [(or #false "false") (list q)]
+                    [_ (for*/list ([str (in-list (quad-elems q))]
+                                   [hstr (in-value (hyphenate str
+                                                              #:min-left-length 4
+                                                              #:min-right-length 4
+                                                              #:min-hyphens 1))]
+                                   [substr (in-list (regexp-match* #rx"(-|\u00AD)" hstr #:gap-select? #t))])
+                         (struct-copy quad q [elems (list substr)]))]))))
+
+(define (line-wrap qs wrap-size)
+  (wrap (handle-hyphenate qs) (λ (q idx) (- wrap-size (quad-ref q 'inset-left 0) (quad-ref q 'inset-right 0)))
         #:nicely #t
         #:hard-break line-break?
         #:soft-break soft-break-for-line?
@@ -543,6 +557,7 @@
   (setup-font-path-table! pdf-path)
   (let* ([x (time-name parse-qexpr (qexpr->quad xs))]
          [x (time-name atomize (atomize x #:attrs-proc handle-cascading-attrs))]
+         [x (time-name hyphenate (handle-hyphenate x))]
          [x (time-name ->string-quad (map (λ (x) (->string-quad pdf x)) x))]
          [x (time-name line-wrap (line-wrap x line-width))]
          [x (time-name apply-keeps (apply-keeps x))]

quad/quad/atomize.rkt

@@ -78,11 +78,10 @@
          (define x-tail (drop (struct->list x) 2))
          (append* 
           (for/list ([elem (in-list (merge-adjacent-strings elems 'isolate-white))])
-                  (if (string? elem)
+            (match elem
-                      (if (zero? (string-length elem))
+              ["" null]
-                          null
+              [(? string? str) (list (apply x-maker next-attrs (list str) x-tail))]
-                          (list (apply x-maker next-attrs (list elem) x-tail)))
+              [_ (loop elem next-attrs next-key)])))]
-                      (loop elem next-attrs next-key))))]
         [_ ((quad-attrs x) . update-with! . next-attrs) (list x)])))
   #;(trimf atomized-qs (λ (q) (equal? (quad-elems q) '(" "))))
   atomized-qs)