From 8678403eaf69442bb64469a5b0c9c9c496773d18 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Wed, 21 Aug 2019 13:37:34 -0700
Subject: [PATCH] support PDF metadata fields

---
 quad/quad/qexpr.rkt              |  2 +-
 quad/quad/scribblings/quad.scrbl |  8 +++++++-
 quad/quadwriter/attrs.rkt        | 19 +++++++++++++++----
 quad/quadwriter/render.rkt       | 25 ++++++++++++++++++++++++-
 4 files changed, 47 insertions(+), 7 deletions(-)

diff --git a/quad/quad/qexpr.rkt b/quad/quad/qexpr.rkt
index 5dbcd15c..84c8e4a8 100644
--- a/quad/quad/qexpr.rkt
+++ b/quad/quad/qexpr.rkt
@@ -88,7 +88,7 @@
                                 [(equal? v "true") #true]
                                 [(equal? v "false") #false]
                                 [(string->number v)]
-                                [else (string-downcase v)])))
+                                [else v])))
           (q #:attrs mheq #:elems (map loop elems))]
          [(list (? qexpr? elems) ...)
           (q #:elems (map loop elems))])]
diff --git a/quad/quad/scribblings/quad.scrbl b/quad/quad/scribblings/quad.scrbl
index 47405986..a421be49 100644
--- a/quad/quad/scribblings/quad.scrbl
+++ b/quad/quad/scribblings/quad.scrbl
@@ -461,11 +461,17 @@ A @deftech{dimension string} represents a distance in the plane. If unitless, it
 
 Attributes that can only be set once for the whole document.
 
-
 @defthing[#:kind "attribute" output-path symbol?]{
 Output path for the rendered PDF. Default is the name of the source file with its extension changed to @racket[.pdf]. For instance, @racket["my-source.rkt"] would become @racket["my-source.pdf"]. Unsaved source files are rendered as @racket["untitled.pdf"].
 }
 
+@deftogether[(@defthing[#:kind "attribute" pdf-title symbol?]
+              @defthing[#:kind "attribute" pdf-author symbol?]
+              @defthing[#:kind "attribute" pdf-subject symbol?]
+              @defthing[#:kind "attribute" pdf-keywords symbol?])]{
+Strings that are used to fill in the corresponding @link["https://helpx.adobe.com/acrobat/using/pdf-properties-metadata.html"]{PDF metadata} fields. Default for each is the empty string.
+}
+
 
 @subsubsection{Section-level attributes}
 
diff --git a/quad/quadwriter/attrs.rkt b/quad/quadwriter/attrs.rkt
index ab7cdb68..8a68799f 100644
--- a/quad/quadwriter/attrs.rkt
+++ b/quad/quadwriter/attrs.rkt
@@ -7,7 +7,7 @@
 
 (define (list->attrs . kvs)
   (for/list ([kv (in-slice 2 kvs)])
-            kv))
+    kv))
 
 (define (cm->in x) (/ x 2.54))
 (define (in->pts x) (* 72 x))
@@ -29,18 +29,18 @@
 (define (copy-block-attrs source-hash dest-hash)
   (define new-hash (make-hasheq))
   (for ([(k v) (in-hash dest-hash)])
-       (hash-set! new-hash k v))
+    (hash-set! new-hash k v))
   (for* ([k (in-list block-attrs)]
          [v (in-value (hash-ref source-hash k #f))]
          #:when v)
-        (hash-set! new-hash k v))
+    (hash-set! new-hash k v))
   new-hash)
 
 (define-syntax (define-attrs stx)
   (syntax-case stx ()
     [(_ (ATTR-NAME ...))
      (with-syntax ([(ATTR-ID ...) (for/list ([attr-id (in-list (syntax->list #'(ATTR-NAME ...)))])
-                                            (format-id stx ":~a" (syntax-e attr-id)))])
+                                    (format-id stx ":~a" (syntax-e attr-id)))])
        #'(begin
            (define ATTR-ID 'ATTR-NAME) ...))]
     [(_ ID (ATTR-NAME ...))
@@ -84,6 +84,11 @@ Naming guidelines
                page-number
                doc-title
 
+               pdf-title
+               pdf-subject
+               pdf-author
+               pdf-keywords
+
                draw
                position
                text
@@ -205,5 +210,11 @@ Naming guidelines
                      :y1
                      :y2)) #true))
 
+(define (has-case-sensitive-value? k)
+  (and (memq k (list :pdf-title
+                     :pdf-subject
+                     :pdf-author
+                     :pdf-keywords)) #true))
+
 (define (takes-path? k)
   (and (memq k (list :image-file)) #true))
\ No newline at end of file
diff --git a/quad/quadwriter/render.rkt b/quad/quadwriter/render.rkt
index ecd1402c..2bfcd4fe 100644
--- a/quad/quadwriter/render.rkt
+++ b/quad/quadwriter/render.rkt
@@ -91,6 +91,14 @@
     (hash-update! attrs k parse-dimension))
   attrs)
 
+(define (downcase-values! attrs)
+  (for ([k (in-hash-keys attrs)]
+        #:unless (has-case-sensitive-value? k))
+    (hash-update! attrs k (λ (val) (match val
+                                     [(? string? str) (string-downcase str)]
+                                     [_ val]))))
+  attrs)
+
 (define (complete-every-path! attrs)
   ;; relies on `current-directory` being parameterized to source file's dir
   (for ([k (in-hash-keys attrs)]
@@ -99,7 +107,8 @@
   attrs)
 
 (define (handle-cascading-attrs attrs)
-  (for ([proc (in-list (list parse-dimension-strings!
+  (for ([proc (in-list (list downcase-values!
+                             parse-dimension-strings!
                              complete-every-path!
                              resolve-font-path!
                              resolve-font-size!
@@ -177,6 +186,18 @@
 (define (setup-column-gap qs)
   (or (debug-column-gap)  (quad-ref (car qs) :column-gap default-column-gap)))
 
+(define (setup-pdf-metadata! qs pdf)
+  (for ([k (in-list (list :pdf-title
+                          :pdf-author
+                          :pdf-subject
+                          :pdf-keywords))]
+        [pdf-k (in-list (list 'Title
+                              'Author
+                              'Subject
+                              'Keywords))])
+    (hash-set! (pdf-info pdf) pdf-k (quad-ref (car qs) k "")))
+  (hash-set! (pdf-info pdf) 'Creator (format "Racket ~a (Quad library)" (version))))
+
 (define/contract (render-pdf qx-arg pdf-path-arg
                              [base-dir-arg #false]
                              #:replace [replace-existing-file? #t]
@@ -206,6 +227,8 @@
                  [section-pages-used 0]
                  [verbose-quad-printing? #false])
     (define qs (time-log setup-qs (setup-qs qx-arg pdf-path)))
+    (when (pair? qs)
+      (setup-pdf-metadata! qs the-pdf))
     (define sections
       (for/fold ([sections-acc null]
                  #:result (reverse sections-acc))