mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

no bang

Browse Source
main
Matthew Butterick 5 years ago
parent f9a539cf68
commit 2f56c76f41
1 changed files with 18 additions and 19 deletions
Show Stats Download Patch File Download Diff File

37
quad/quadwriter/core.rkt
Unescape Escape View File

@ -226,18 +226,17 @@
(define hung-word-sublists (define hung-word-sublists
(match word-sublists (match word-sublists
[(list sublists ... (list prev-qs ... last-q)) [(list sublists ... (list prev-qs ... last-q))
(define last-char-str (regexp-match #rx"[.,!’-]$" (car (quad-elems last-q)))) (define last-char-str (regexp-match #rx"[.,:;’-]$" (car (quad-elems last-q))))
(match last-char-str (match last-char-str
[#false word-sublists] [#false word-sublists]
[_ [_ (define hanger-q (struct-copy quad last-q
(define hanger-q (struct-copy quad last-q [elems null]
[elems null] [size (let ([p (make-size-promise last-q (car last-char-str))])
[size (let ([p (make-size-promise last-q (car last-char-str))]) (delay
(delay (match-define (list x y) (force p))
(match-define (list x y) (force p)) (pt (- x) y)))]))
(pt (- x) y)))])) (define last-sublist (append prev-qs (list last-q hanger-q)))
(define last-sublist (append prev-qs (list last-q hanger-q))) (append sublists (list last-sublist))])]))
(append sublists (list last-sublist))])]))
(define word-width (sum-of-widths hung-word-sublists)) (define word-width (sum-of-widths hung-word-sublists))
(define word-space-width (sum-of-widths word-space-sublists)) (define word-space-width (sum-of-widths word-space-sublists))
(define empty-hspace (- line-width (define empty-hspace (- line-width
@ -591,15 +590,15 @@
(define ((page-finish-wrap page-quad path) cols q0 q page-idx) (define ((page-finish-wrap page-quad path) cols q0 q page-idx)
(define elems (define elems
(match (quad-ref (car cols) 'footer-display "true") (match (quad-ref (car cols) 'footer-display "true")
[(or "false" "none") (from-parent cols 'nw)] [(or "false" "none") (from-parent cols 'nw)]
[_ [_
(define-values (dir name _) (split-path (path-replace-extension path #""))) (define-values (dir name _) (split-path (path-replace-extension path #"")))
(define footer (struct-copy quad q:footer (define footer (struct-copy quad q:footer
[attrs (let ([h (hash-copy (quad-attrs q:footer))]) [attrs (let ([h (hash-copy (quad-attrs q:footer))])
(hash-set! h 'page-number page-idx) (hash-set! h 'page-number page-idx)
(hash-set! h 'doc-title (string-titlecase (path->string name))) (hash-set! h 'doc-title (string-titlecase (path->string name)))
h)])) h)]))
(cons footer (from-parent cols 'nw))])) (cons footer (from-parent cols 'nw))]))
(list (struct-copy quad page-quad [elems elems]))) (list (struct-copy quad page-quad [elems elems])))
(define (page-wrap qs width [page-quad q:page]) (define (page-wrap qs width [page-quad q:page])

Write Preview
Loading…
Cancel
Save