add `page-margin-gutter` attribute (closes #25)

quad/qtest/test-sections.rkt

@@ -1,15 +1,23 @@
 #lang quadwriter
 
+'(q ((page-margin-gutter "1.5in")(page-margin-left "0.5in")(page-margin-right "0.5in"))
+
 "Section 1 Page 1 on right"
 
-'(q ((break "section")))
+(q ((break "section")))
 
-'(q ((page-width "5in")(page-height "5in")(page-side-start "right")) "Section 2 Page 1 on right"
+(q ((page-width "5in")(page-height "5in")(page-side-start "right")) "Section 2 Page 1 on right"
 
 (q ((break "page")))
 
 "Section 2 Page 2 on left")
 
-'(q ((break "section")))
+(q ((break "section")))
+
+(q ((page-width "5in")(page-height "5in")(page-side-start "left")) "Section 3 Page 1 on left"
+
+(q ((break "page")))
+
+"Section 3 Page 2 on right")
 
-'(q ((page-width "5in")(page-height "5in")(page-side-start "left")) "Section 3 Page 1 on left")
+)

quad/quad/scribblings/quad.scrbl

@@ -484,15 +484,19 @@ The unusual way of setting the overall page dimensions of the rendered PDF. Both
               @defthing[#:kind "attribute" page-margin-bottom symbol?]
               @defthing[#:kind "attribute" page-margin-left symbol?]
               @defthing[#:kind "attribute" page-margin-right symbol?])]{
-Inset values from the page edges. Value is given as a @tech{dimension string}. Default values depend on size of the page: they are chosen to be not completely bananas.
+Inset values from the page edges. Value is a @tech{dimension string}. Default values depend on size of the page: they are chosen to be not completely bananas.
+}
+
+@defthing[#:kind "attribute" page-margin-gutter symbol?]{
+Extra space added to the inner margin of page. Value is a @tech{dimension string}. On right-hand pages, the gutter will be added to the left margin. On left-hand pages, it will be added to the right margin.  Default is @racket[0].
 }
 
 @defthing[#:kind "attribute" page-number-start symbol?]{
-First page number used. Default is @racket[1].
+First page number used. Value is an integer. Default is @racket[1].
 }
 
 @defthing[#:kind "attribute" page-side-start symbol?]{
-Side that first page appears on. Can be @racket['left] or @racket['right]. A blank page will be inserted if necessary. Default is @racket['right].
+Side that first page appears on. Value is @racket['left] or @racket['right]. A blank page will be inserted if necessary. Default is @racket['right].
 }
 
 @deftogether[(@defthing[#:kind "attribute" column-count symbol?]
@@ -508,21 +512,21 @@ A block is a paragraph or other rectangular item (say, a blockquote or code bloc
               @defthing[#:kind "attribute" inset-bottom symbol?]
               @defthing[#:kind "attribute" inset-left symbol?]
               @defthing[#:kind "attribute" inset-right symbol?])]{
-Inset values increase the layout boundary of the quad. Value is given as a @tech{dimension string}. @racket["0"] by default.
+Inset values increase the layout boundary of the quad. Value is a @tech{dimension string}. @racket["0"] by default.
 }
 
 @deftogether[(@defthing[#:kind "attribute" border-inset-top symbol?]
               @defthing[#:kind "attribute" border-inset-bottom symbol?]
               @defthing[#:kind "attribute" border-inset-left symbol?]
               @defthing[#:kind "attribute" border-inset-right symbol?])]{
-Border-inset values do not change the layout boundary of the quad. Rather, they change the position of the border (if any) relative to the layout boundary. Value is given as a @tech{dimension string}. @racket["0"] by default (meaning, the border sits on the layout boundary).
+Border-inset values do not change the layout boundary of the quad. Rather, they change the position of the border (if any) relative to the layout boundary. Value is a @tech{dimension string}. @racket["0"] by default (meaning, the border sits on the layout boundary).
 }
 
 @deftogether[(@defthing[#:kind "attribute" border-width-top symbol?]
               @defthing[#:kind "attribute" border-width-bottom symbol?]
               @defthing[#:kind "attribute" border-width-left symbol?]
               @defthing[#:kind "attribute" border-width-right symbol?])]{
-Width of the border on each edge of the quad. Value is given as a @tech{dimension string}. @racket["0"] by default (meaning no border).
+Width of the border on each edge of the quad. Value is a @tech{dimension string}. @racket["0"] by default (meaning no border).
 }
 
 @deftogether[(@defthing[#:kind "attribute" border-color-top symbol?]
@@ -538,7 +542,7 @@ Color of the background of the quad. Value is a @tech{hex color} string or @tech
 
 @deftogether[(@defthing[#:kind "attribute" space-before symbol?]
               @defthing[#:kind "attribute" space-after symbol?])]{
-Vertical space added around a block. Value is given as a @tech{dimension string}.
+Vertical space added around a block. Value is a @tech{dimension string}.
 }
 
 @deftogether[(@defthing[#:kind "attribute" keep-first-lines symbol?]
@@ -559,7 +563,7 @@ How the lines are aligned horizontally in the quad. Possibilities are @racket["l
 }
 
 @defthing[#:kind "attribute" first-line-indent symbol?]{
-The indent of the first line in the quad. Value is given as a @tech{dimension string}.
+The indent of the first line in the quad. Value is a @tech{dimension string}.
 }
 
 
@@ -616,11 +620,11 @@ Two ways of setting OpenType layout features. @racket[font-features] takes a @de
  
 
 @defthing[#:kind "attribute" font-tracking symbol?]{
-Space between characters. Value is given as a @tech{dimension string}.
+Space between characters. Value is a @tech{dimension string}.
 }
 
 @defthing[#:kind "attribute" font-baseline-shift symbol?]{
-Vertical offset of font baseline (positive values move the baseline up, negative down). Value is given as a @tech{dimension string}.
+Vertical offset of font baseline (positive values move the baseline up, negative down). Value is a @tech{dimension string}.
 }
 
 @defthing[#:kind "attribute" line-height symbol?]{

quad/quadwriter/attrs.rkt

@@ -155,6 +155,7 @@ Naming guidelines
                            page-margin-bottom
                            page-margin-left
                            page-margin-right
+                           page-margin-gutter
 
                            footer-display))
 
@@ -165,6 +166,7 @@ Naming guidelines
                      :page-margin-bottom
                      :page-margin-left
                      :page-margin-right
+                     :page-margin-gutter
                      :column-gap
                      :inset-top
                      :inset-bottom

quad/quadwriter/layout.rkt

@@ -512,7 +512,8 @@
 (define (make-footer-quad col-q page-idx path)
   (define-values (dir name _) (split-path (path-replace-extension path #"")))
   (q #:size (pt 50 default-line-height)
-     #:attrs (hasheq :page-number (+ (quad-ref col-q :page-number-start (add1 (current-page-count))) (sub1 page-idx))
+     #:attrs (hasheq :page-number (+ (quad-ref col-q :page-number-start (add1 (section-pages-used)))
+                                     (sub1 page-idx))
                      :doc-title (string-titlecase (path->string name)))
      #:from-parent 'sw
      #:to 'nw
@@ -661,7 +662,8 @@
          #:finish-wrap (col-finish-wrap column-quad))
    col-spacer))
 
-(define ((page-finish-wrap page-quad path) cols q0 q page-idx)
+(define ((page-finish-wrap make-page-quad path) cols q0 q page-idx)
+  (define page-quad (make-page-quad (+ (section-pages-used) page-idx)))
   (define elems
     (match (quad-ref (car cols) :footer-display #true)
       [(or #false "none") (from-parent cols 'nw)]
@@ -671,7 +673,7 @@
                    [attrs (copy-block-attrs (quad-attrs (car cols))
                                             (hash-copy (quad-attrs page-quad)))])))
 
-(define (page-wrap qs width [page-quad q:page])
+(define (page-wrap qs width [make-page-quad (λ _ q:page)])
   (unless (positive? width)
     (raise-argument-error 'page-wrap "positive number" width))
   (wrap qs width
@@ -681,7 +683,7 @@
         #:distance (λ (q dist-so-far wrap-qs)
                      (for/sum ([x (in-list wrap-qs)])
                               (pt-x (size x))))
-        #:finish-wrap (page-finish-wrap page-quad (pdf-output-path (current-pdf)))))
+        #:finish-wrap (page-finish-wrap make-page-quad (pdf-output-path (current-pdf)))))
 
 (define (insert-blocks lines)
   (define groups-of-lines (contiguous-group-by (λ (x) (quad-ref x :display)) lines))

quad/quadwriter/param.rkt

@@ -10,7 +10,7 @@
          (define current-doc (make-parameter #false))
          (define current-pdf (make-parameter #false))
          (define current-line-wrap (make-parameter #f)) ; because kp is slow and maybe we want to disable for "draft" mode
-         (define current-page-count (make-parameter 0))
+         (define section-pages-used (make-parameter 0))
          
          (define quadwriter-test-mode (make-parameter #f)) ; used during rackunit to suppress nondeterministic elements, like timestamp in header
 
@@ -34,7 +34,7 @@
          (define current-doc (make-parameter #false))
          (define current-pdf (make-parameter #false))
          (define current-line-wrap (make-parameter #f))
-         (define current-page-count (make-parameter 0))
+         (define section-pages-used (make-parameter 0))
          
          (define quadwriter-test-mode (make-parameter #f))
 

quad/quadwriter/render.rkt

@@ -34,10 +34,10 @@
     [(_ ALL-BREAKS-ID . TYPES)
      (with-syntax ([((TYPE-BREAK TYPE-STR Q:TYPE-BREAK) ...)
                     (for/list ([type (in-list (syntax->list #'TYPES))])
-                              (list
-                               (format-id #'TYPES "~a-break" type)
-                               (symbol->string (syntax->datum type))
-                               (format-id #'TYPES "q:~a-break" type)))])
+                      (list
+                       (format-id #'TYPES "~a-break" type)
+                       (symbol->string (syntax->datum type))
+                       (format-id #'TYPES "q:~a-break" type)))])
        #'(begin
            (define TYPE-BREAK '(q ((break TYPE-STR)))) ...
            (define ALL-BREAKS-ID (list (cons TYPE-BREAK Q:TYPE-BREAK) ...))))]))
@@ -56,22 +56,22 @@
   ;; 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)
-                     [#true #:when (and (pair? (quad-elems q))
-                                        (andmap string? (quad-elems q)))
-                            (for*/list ([str (in-list (quad-elems q))]
-                                        [hyphen-char (in-value #\u00AD)]
-                                        [hstr (in-value (hyphenate str hyphen-char
-                                                                   #:min-left-length 3
-                                                                   #:min-right-length 3))]
-                                        [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))])
-                                       (struct-copy quad q [elems (list substr)]))]
-                     [_ (list q)]))))
+           (match (quad-ref q :hyphenate)
+             [#true #:when (and (pair? (quad-elems q))
+                                (andmap string? (quad-elems q)))
+                    (for*/list ([str (in-list (quad-elems q))]
+                                [hyphen-char (in-value #\u00AD)]
+                                [hstr (in-value (hyphenate str hyphen-char
+                                                           #:min-left-length 3
+                                                           #:min-right-length 3))]
+                                [substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))])
+                      (struct-copy quad q [elems (list substr)]))]
+             [_ (list q)]))))
 
 
 (define (string->feature-list str)
   (for/list ([kv (in-slice 2 (string-split str))])
-            (cons (string->bytes/utf-8 (first kv)) (string->number (second kv)))))
+    (cons (string->bytes/utf-8 (first kv)) (string->number (second kv)))))
 
 (define (parse-font-features! attrs)
   (cond
@@ -93,14 +93,14 @@
 (define (parse-dimension-strings! attrs)
   (for ([k (in-hash-keys attrs)]
         #:when (takes-dimension-string? k))
-       (hash-update! attrs k parse-dimension))
+    (hash-update! attrs k parse-dimension))
   attrs)
 
 (define (complete-every-path! attrs)
   ;; relies on `current-directory` being parameterized to source file's dir
   (for ([k (in-hash-keys attrs)]
         #:when (takes-path? k))
-       (hash-update! attrs k (compose1 path->string path->complete-path)))
+    (hash-update! attrs k (compose1 path->string path->complete-path)))
   attrs)
 
 (define (handle-cascading-attrs attrs)
@@ -135,27 +135,39 @@
   indented-qs)
 
 (define (setup-margins qs page-width page-height)
+  ;; if only left or right margin is provided, copy other value in preference to default margin
+  (define q (car qs))
   (define default-side-margin (min (* 72 1.5) (floor (* .20 page-width))))
   (define default-top-margin (min 72 (floor (* .10 page-height))))
-
-  ;; if only left or right margin is provided, copy other value in preference to default margin
-  (define left
-    (or (debug-x-margin)
-        (quad-ref (car qs) :page-margin-left
-                  (λ ()  (quad-ref (car qs) :page-margin-right default-side-margin)))))
-  (define right
-    (or (debug-x-margin)
-        (quad-ref (car qs) :page-margin-right
-                  (λ ()  (quad-ref (car qs) :page-margin-left default-side-margin)))))
-  (define top
-    (or (debug-y-margin)
-        (quad-ref (car qs) :page-margin-top
-                  (λ ()  (quad-ref (car qs) :page-margin-bottom default-top-margin)))))
-  (define vert-optical-adjustment 10)
-  (define bottom
-    (or (debug-y-margin)
-        (quad-ref (car qs) :page-margin-bottom
-                  (λ () (+ vert-optical-adjustment (quad-ref (car qs) :page-margin-top (* default-top-margin 1.4)))))))
+  
+  (define left (cond
+                 [(debug-x-margin)]
+                 [(quad-ref q :page-margin-left)]
+                 [(quad-ref q :page-margin-right)]
+                 [else default-side-margin]))
+  
+  (define right (cond
+                  [(debug-x-margin)]
+                  [(quad-ref q :page-margin-right)]
+                  [(quad-ref q :page-margin-left)]
+                  [else default-side-margin]))
+  
+  (define top (cond
+                [(debug-y-margin)]
+                [(quad-ref q :page-margin-top)]
+                [(quad-ref q :page-margin-bottom)]
+                [else default-top-margin]))
+  
+  (define bottom (cond
+                   [(debug-y-margin)]
+                   [(quad-ref q :page-margin-bottom)]
+                   [else
+                    (define vert-optical-adjustment 10)
+                    (+ vert-optical-adjustment
+                       (cond
+                         [(quad-ref q :page-margin-top)]
+                         [else (* default-top-margin 1.4)]))]))
+  
   (list left top right bottom))
 
 (define default-column-count 1)
@@ -195,7 +207,7 @@
                  ;; set `current-directory` so that ops like `path->complete-path`
                  ;; will be handled relative to the original directory
                  [current-directory base-dir]
-                 [current-page-count 0]
+                 [section-pages-used 0]
                  [verbose-quad-printing? #false])
     (define qs (time-log setup-qs (setup-qs qx-arg pdf-path)))
     (define sections
@@ -205,7 +217,8 @@
         (match-define (list page-width page-height) (parse-page-size (and (pair? qs) (car qs))))
         (match-define (list left-margin top-margin right-margin bottom-margin)
           (setup-margins qs page-width page-height))
-        (define printable-width (- page-width left-margin right-margin))
+        (define maybe-gutter-margin (and (pair? qs) (quad-ref (car qs) :page-margin-gutter)))
+        (define printable-width (- page-width left-margin right-margin (or maybe-gutter-margin 0)))
         (define printable-height (- page-height top-margin bottom-margin))
         (define column-count (setup-column-count qs))
         (define column-gap (setup-column-gap qs))
@@ -216,20 +229,26 @@
         (define col-quad-prototype (struct-copy quad q:column
                                                 [size (pt line-wrap-size printable-height)]))
         (define column-qs (time-log column-wrap (column-wrap line-qs printable-height column-gap col-quad-prototype)))
-    
-        (define page-quad-prototype (struct-copy quad q:page
-                                                 [shift (pt left-margin top-margin)]
-                                                 [size (pt line-wrap-size printable-height)]))
+
+        (define page-quad-prototype
+          (λ (page-count)
+            (define left-shift (+ left-margin
+                                  (cond
+                                    [(and (odd? page-count) maybe-gutter-margin)]
+                                    [else 0])))
+            (struct-copy quad q:page
+                         [shift (pt left-shift top-margin)]
+                         [size (pt line-wrap-size printable-height)])))
 
         (define section-starting-side (string->symbol (quad-ref (car qs) :page-side-start "right")))
         (define insert-blank-page?
           (and (pair? qs)
                ;; if we need a 'left page and will get 'right (or vice versa) then insert page
-               (let ([next-page-side (if (even? (add1 (current-page-count))) 'left 'right)])
+               (let ([next-page-side (if (even? (add1 (section-pages-used))) 'left 'right)])
                  (not (eq? section-starting-side next-page-side)))))
         ;; update page count before starting page wrap
         (when insert-blank-page?
-          (current-page-count (add1 (current-page-count))))
+          (section-pages-used (add1 (section-pages-used))))
         
         (define section-pages (time-log page-wrap (page-wrap column-qs printable-width page-quad-prototype)))
         
@@ -258,7 +277,7 @@
                   [_ (list new-section)])])]
             [else (define new-section (struct-copy quad q:section [elems section-pages]) )
                   (cons new-section sections-acc)])
-          (current-page-count (+ (current-page-count) (length section-pages))))))
+          (section-pages-used (+ (section-pages-used) (length section-pages))))))
 
     (define doc (time-log position (position (struct-copy quad q:doc [elems sections]))))
     (time-log draw (draw doc (current-pdf))))