support PDF metadata fields

main
Matthew Butterick 5 years ago
parent c1ca8e705b
commit 8678403eaf

@ -88,7 +88,7 @@
[(equal? v "true") #true] [(equal? v "true") #true]
[(equal? v "false") #false] [(equal? v "false") #false]
[(string->number v)] [(string->number v)]
[else (string-downcase v)]))) [else v])))
(q #:attrs mheq #:elems (map loop elems))] (q #:attrs mheq #:elems (map loop elems))]
[(list (? qexpr? elems) ...) [(list (? qexpr? elems) ...)
(q #:elems (map loop elems))])] (q #:elems (map loop elems))])]

@ -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. Attributes that can only be set once for the whole document.
@defthing[#:kind "attribute" output-path symbol?]{ @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"]. 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} @subsubsection{Section-level attributes}

@ -7,7 +7,7 @@
(define (list->attrs . kvs) (define (list->attrs . kvs)
(for/list ([kv (in-slice 2 kvs)]) (for/list ([kv (in-slice 2 kvs)])
kv)) kv))
(define (cm->in x) (/ x 2.54)) (define (cm->in x) (/ x 2.54))
(define (in->pts x) (* 72 x)) (define (in->pts x) (* 72 x))
@ -29,18 +29,18 @@
(define (copy-block-attrs source-hash dest-hash) (define (copy-block-attrs source-hash dest-hash)
(define new-hash (make-hasheq)) (define new-hash (make-hasheq))
(for ([(k v) (in-hash dest-hash)]) (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)] (for* ([k (in-list block-attrs)]
[v (in-value (hash-ref source-hash k #f))] [v (in-value (hash-ref source-hash k #f))]
#:when v) #:when v)
(hash-set! new-hash k v)) (hash-set! new-hash k v))
new-hash) new-hash)
(define-syntax (define-attrs stx) (define-syntax (define-attrs stx)
(syntax-case stx () (syntax-case stx ()
[(_ (ATTR-NAME ...)) [(_ (ATTR-NAME ...))
(with-syntax ([(ATTR-ID ...) (for/list ([attr-id (in-list (syntax->list #'(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 #'(begin
(define ATTR-ID 'ATTR-NAME) ...))] (define ATTR-ID 'ATTR-NAME) ...))]
[(_ ID (ATTR-NAME ...)) [(_ ID (ATTR-NAME ...))
@ -84,6 +84,11 @@ Naming guidelines
page-number page-number
doc-title doc-title
pdf-title
pdf-subject
pdf-author
pdf-keywords
draw draw
position position
text text
@ -205,5 +210,11 @@ Naming guidelines
:y1 :y1
:y2)) #true)) :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) (define (takes-path? k)
(and (memq k (list :image-file)) #true)) (and (memq k (list :image-file)) #true))

@ -91,6 +91,14 @@
(hash-update! attrs k parse-dimension)) (hash-update! attrs k parse-dimension))
attrs) 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) (define (complete-every-path! attrs)
;; relies on `current-directory` being parameterized to source file's dir ;; relies on `current-directory` being parameterized to source file's dir
(for ([k (in-hash-keys attrs)] (for ([k (in-hash-keys attrs)]
@ -99,7 +107,8 @@
attrs) attrs)
(define (handle-cascading-attrs 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! complete-every-path!
resolve-font-path! resolve-font-path!
resolve-font-size! resolve-font-size!
@ -177,6 +186,18 @@
(define (setup-column-gap qs) (define (setup-column-gap qs)
(or (debug-column-gap) (quad-ref (car qs) :column-gap default-column-gap))) (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 (define/contract (render-pdf qx-arg pdf-path-arg
[base-dir-arg #false] [base-dir-arg #false]
#:replace [replace-existing-file? #t] #:replace [replace-existing-file? #t]
@ -206,6 +227,8 @@
[section-pages-used 0] [section-pages-used 0]
[verbose-quad-printing? #false]) [verbose-quad-printing? #false])
(define qs (time-log setup-qs (setup-qs qx-arg pdf-path))) (define qs (time-log setup-qs (setup-qs qx-arg pdf-path)))
(when (pair? qs)
(setup-pdf-metadata! qs the-pdf))
(define sections (define sections
(for/fold ([sections-acc null] (for/fold ([sections-acc null]
#:result (reverse sections-acc)) #:result (reverse sections-acc))

Loading…
Cancel
Save