support PDF metadata fields

main
Matthew Butterick 5 years ago
parent c1ca8e705b
commit 8678403eaf

@ -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))])]

@ -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}

@ -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))

@ -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))

Loading…
Cancel
Save