start tidying into passes

quad/quadwriter/render.rkt

@@ -34,9 +34,9 @@
 (provide (all-defined-out))
 
 
-
-(define (setup-pdf-path pdf-path-arg)
+(define (setup-pdf-path pdf-path-arg replace-existing-file?)
   ;; convert pathlike arg into nice complete path.
+  (define pdf-path
     (path->complete-path
      (simplify-path
       (expand-user-path
@@ -46,6 +46,10 @@
           ;; so we use a temp path to write the file, and we'll delete it later.
           [#false (build-path (find-system-path 'temp-dir) "quadwriter-temp.pdf")]
           [path path]))))))
+  (unless replace-existing-file?
+    (when (file-exists? pdf-path)
+      (raise-argument-error 'render-pdf "path that doesn't exist" pdf-path)))
+  pdf-path)
 
 
 (define (handle-hyphenate q)
@@ -168,18 +172,15 @@
       (hash-set! (current-named-quads) (get-define-val (car dq-group)) dq-group))
     not-dqs)
 
-(define default-line-height-multiplier 1.42)
-(define (setup-qs qx-arg base-dir)
-  ;; convert our input Q-expression into a useful form.
-
-  ;; some typographic niceties
-  (define qexpr
-    (let ([qx (decode qx-arg
+(define (insert-typographic-niceties qx-arg)
+  (decode qx-arg
           #:string-proc (compose1 smart-ellipses smart-dashes)
-                        #:txexpr-proc smart-quotes)])
+          #:txexpr-proc smart-quotes))
+
+(define (insert-dummy-element qx)
   (match qx
     [(txexpr tag attrs elements)
-         ;; we insert a dummy quad '(q ".")
+     ;; we insert a dummy element "."
      ;; (could be anything, but we want to use something obvious
      ;; so we don't trigger a fallback font)
      ;; to get a sample of the global attrs
@@ -187,31 +188,47 @@
      ;; but keep the attrs around in case anyone needs to use them
      ;; for instance, quads added to the layout like footers
      ;; won't have another way of getting this
-      (list* tag attrs (cons '(q ".") elements))])))
+     (list* tag attrs (cons "." elements))]))
 
+(define (apply-default-styling-attributes qexpr)
   ;; apply some default styling attributes.
   ;; These will only be used if the underlying q-expression hasn't specified its own values,
   ;; which will naturally override these.
-  (define q
   (qexpr->quad (list 'q (list->attrs
                          :font-family default-font-family
                          :font-size (number->string default-font-size)
                          :font-features default-font-features
                          :hyphenate "true"
-                           :line-height (number->string (floor (* default-line-height-multiplier default-font-size)))) qexpr)))
-  (setup-font-path-table! base-dir)
-  (let* ([qs (atomize q
+                         :line-height
+                         (number->string (floor (* default-line-height-multiplier default-font-size)))) qexpr)))
+
+(define (make-atomic-qs q)
+  (atomize q
            #:attrs-proc handle-cascading-attrs
            #:missing-glyph-action 'fallback
            #:fallback "fallback"
            #:emoji "fallback-emoji"
            #:math "fallback-math"
-                      #:font-path-resolver resolve-font-path!)]
-         [qs (let ()
-               ;; store the dummy element and discard
+           #:font-path-resolver resolve-font-path!))
+
+(define (store-dummy-element-and-discard qs)
   (current-top-level-quad (car qs))
-               (cdr qs))]
-         [qs (time-log hyphenate (apply append (map handle-hyphenate qs)))]
+  (cdr qs))
+
+(define (apply-hyphenation qs)
+  (time-log hyphenate (apply append (map handle-hyphenate qs))))
+
+(define default-line-height-multiplier 1.42)
+(define (setup-qs qx-arg [base-dir (current-directory)])
+  ;; convert our input Q-expression into a useful form.
+
+  (setup-font-path-table! base-dir)
+  (let* ([qx (insert-typographic-niceties qx-arg)]
+         [qexpr (insert-dummy-element qx)]
+         [q (apply-default-styling-attributes qexpr)]
+         [qs (make-atomic-qs q)]
+         [qs (store-dummy-element-and-discard qs)]
+         [qs (apply-hyphenation qs)]
          [qs (map generic->typed-quad qs)]
          [qs (drop-leading-breaks qs)]
          #;[qs (extract-defined-quads qs)]
@@ -265,7 +282,7 @@
 (define (setup-column-gap qs)
   (or (debug-column-gap)  (quad-ref (car qs) :column-gap default-column-gap)))
 
-(define (setup-pdf-metadata! qs pdf)
+(define (setup-pdf-metadata! pdf qs)
   (define kv-dict
     (cons
      (cons 'Creator (format "Racket ~a [Quad ~a]" (version) (pkg-checksum "quad" #:short #true)))
@@ -306,9 +323,10 @@
                [size (pt line-wrap-size printable-height)]))
   (time-log page-wrap (page-wrap column-qs printable-width page-quad-prototype)))
 
+(define (layout qs)
+  (quad-update! q:doc [elems (make-sections qs)]))
 
 (define (make-sections all-qs)
-  
   (for/fold ([sections-acc null]
              #:result (reverse sections-acc))
             ([qs (in-list (filter-split all-qs section-break-quad?))])
@@ -449,6 +467,33 @@
         [(quad? x) (for-each loop (quad-elems x))])))
   doc)
 
+(define (setup-base-dir base-dir-arg pdf-path-arg)
+  (define maybe-dir (cond
+                      ;; for reasons unclear, DrRacket sometimes sneaks
+                      ;; an "unsaved editor" into base-dir-arg, despite efforts
+                      ;; probably my fault 
+                      [(equal? base-dir-arg "unsaved editor") pdf-path-arg]
+                      [base-dir-arg]
+                      [pdf-path-arg]
+                      [else (current-directory)]))
+  (define base-dir (match maybe-dir
+                     [(? directory-exists? dir) dir]
+                     [(app path->complete-path cp)
+                      (define-values (dir name _) (split-path cp))
+                      dir]))
+  (unless (directory-exists? base-dir)
+    (raise-argument-error 'render-pdf "existing directory" base-dir))
+  base-dir)
+
+(define (log-completion)
+  (log-quadwriter-info (format "wrote PDF to ~a" (pdf-output-path (current-pdf)))))
+
+(define (return-pdf-bytes pdf-path-arg)
+  (define pdf-path (pdf-output-path (current-pdf)))
+  (begin0
+    (file->bytes pdf-path)
+    (delete-file pdf-path)))
+
 (define/contract (render-pdf qx-arg
                              [pdf-path-arg #false]
                              [base-dir-arg #false]
@@ -465,59 +510,28 @@
   ;; `base-dir-arg` is the starting point for resolving any relative pathnames,
   ;; and looking for fonts and other assets.
 
-  (define base-dir (let ([maybe-dir (cond
-                                      ;; for reasons unclear, DrRacket sometimes sneaks
-                                      ;; an "unsaved editor" into base-dir-arg, despite efforts
-                                      ;; probably my fault 
-                                      [(equal? base-dir-arg "unsaved editor") pdf-path-arg]
-                                      [base-dir-arg]
-                                      [pdf-path-arg]
-                                      [else (current-directory)])])
-                     (match maybe-dir
-                       [(? directory-exists? dir) dir]
-                       [(app path->complete-path cp)
-                        (define-values (dir name _) (split-path cp))
-                        dir])))
-  
-  (unless (directory-exists? base-dir)
-    (raise-argument-error 'render-pdf "existing directory" base-dir))
-  
-  (define pdf-path (setup-pdf-path pdf-path-arg))
-  (unless replace-existing-file?
-    (when (file-exists? pdf-path)
-      (raise-argument-error 'render-pdf "path that doesn't exist" pdf-path)))
-
   ;; `make-pdf` creates a PDF data structure using the pitfall library.
   ;; this structure provides some services as we lay out the document,
   ;; and then when we render, we'll rely on pitfall's PDF-drawing routines.
-  (parameterize ([current-pdf (make-pdf #:compress compress?
+  (parameterize ([current-pdf
+                  (make-pdf #:compress compress?
                             #:auto-first-page #false
-                                        #:output-path pdf-path)]
+                            #:output-path (setup-pdf-path pdf-path-arg replace-existing-file?))]
                  ;; set `current-directory` so that ops like `path->complete-path`
                  ;; will be handled relative to the original directory
-                 [current-directory base-dir]
+                 [current-directory (setup-base-dir base-dir-arg pdf-path-arg)]
                  ;; a lot of operations need to look at pages used so it's easier to
                  ;; make it a parameter than endlessly pass it around as an argument.
                  [section-pages-used 0]
                  [verbose-quad-printing? #false]
                  #;[current-named-quads (make-hash)]) ; for ease of debugging; not mandatory
-    (define qs (time-log setup-qs (setup-qs qx-arg base-dir)))
-    (setup-pdf-metadata! qs (current-pdf))
-    ;; all the heavy lifting happens inside `make-sections`
-    ;; which calls out to `make-pages`, `make-columns`, and so on.
-   
-    (define doc (let ([doc (quad-update! q:doc [elems (make-sections qs)])])
-                  (time-log prep-doc (let* ([doc (correct-line-alignment doc)]
+    (let* ([qs (time-log setup-qs (setup-qs qx-arg))]
+           [_ (setup-pdf-metadata! (current-pdf) qs)]
+           ;; all the heavy lifting happens inside `layout`
+           [doc (layout qs)]
+           [doc (correct-line-alignment doc)]
            [doc (resolve-repeaters doc)]
-                                            [doc (resolve-parents doc)])
-                                       doc))))
-    ;; call `position` and `draw` separately so we can print a timer for each
-    (define positioned-doc (time-log position (position doc)))
-    ;; drawing implies that a PDF is written to disk
-    (time-log draw (draw positioned-doc (current-pdf))))
-
-  (if pdf-path-arg
-      (log-quadwriter-info (format "wrote PDF to ~a" pdf-path))
-      (begin0
-        (file->bytes pdf-path)
-        (delete-file pdf-path))))
+           [doc (resolve-parents doc)]
+           [positioned-doc (position doc)]
+           [_ (draw positioned-doc (current-pdf))])
+      (if pdf-path-arg (log-completion) (return-pdf-bytes)))))