aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/engine/html.scm30
-rw-r--r--src/guile/skribilo/engine/lout.scm28
-rw-r--r--src/guile/skribilo/skribe/api.scm16
3 files changed, 50 insertions, 24 deletions
diff --git a/src/guile/skribilo/engine/html.scm b/src/guile/skribilo/engine/html.scm
index 4ba058a..15bea53 100644
--- a/src/guile/skribilo/engine/html.scm
+++ b/src/guile/skribilo/engine/html.scm
@@ -572,7 +572,7 @@
;* document ... */
;*---------------------------------------------------------------------*/
(markup-writer 'document
- :options '(:title :author :ending :html-title :env)
+ :options '(:title :author :ending :html-title :env :keywords)
:action (lambda (n e)
(let* ((id (markup-ident n))
(title (new markup
@@ -601,13 +601,23 @@
;*---------------------------------------------------------------------*/
(markup-writer '&html-head
:before (lambda (n e)
- (printf "<head>\n")
- (printf "<meta http-equiv=\"Content-Type\" content=\"text/html;")
- (printf "charset=~A\">\n" (engine-custom (find-engine 'html)
- 'charset)))
+ (printf "<head>\n")
+ (printf "<meta http-equiv=\"Content-Type\" content=\"text/html;")
+ (printf "charset=~A\">\n" (engine-custom (find-engine 'html)
+ 'charset)))
:after "</head>\n\n")
;*---------------------------------------------------------------------*/
+;* &html-meta ... */
+;*---------------------------------------------------------------------*/
+(markup-writer '&html-meta
+ :before "<meta name=\"keywords\" content=\""
+ :action (lambda (n e)
+ (let ((kw* (map ast->string (or (markup-body n) '()))))
+ (output (keyword-list->comma-separated kw*) e)))
+ :after "\">\n")
+
+;*---------------------------------------------------------------------*/
;* &html-body ... */
;*---------------------------------------------------------------------*/
(markup-writer '&html-body
@@ -1190,12 +1200,20 @@
(class (markup-class n))
(parent n)
(body (html-browser-title n))))
+ (meta (new markup
+ (markup '&html-meta)
+ (ident (string-append id "-meta"))
+ (class (markup-class n))
+ (parent n)
+ (body (markup-option n :keywords))))
(head (new markup
(markup '&html-head)
(ident (string-append id "-head"))
(class (markup-class n))
+ (options (the-options (list :keywords
+ (markup-option n :keywords))))
(parent n)
- (body header)))
+ (body (list header meta))))
(ftnote (new markup
(markup '&html-footnotes)
(ident (string-append id "-footnote"))
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index 3b62224..294a528 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -642,7 +642,8 @@
(pdf-author #t)
;; Keywords (a list of string) in the PDF
- ;; document information.
+ ;; document information. This custom is deprecated,
+ ;; use the `:keywords' option of `document' instead.
(pdf-keywords #f)
;; Extra PDF information, an alist of key-value
@@ -812,15 +813,10 @@
(if (or (string? t) (ast? t))
t
(markup-option doc :title))))
- (keywords (engine-custom engine 'pdf-keywords))
- (extra-fields (engine-custom engine 'pdf-extra-info))
- (stringify-kw (lambda (kws)
- (let loop ((kws kws) (s ""))
- (if (null? kws) s
- (loop (cdr kws)
- (string-append s (car kws)
- (if (pair? (cdr kws))
- ", " ""))))))))
+ (keywords (or (engine-custom engine 'pdf-keywords)
+ (map ast->string (markup-option doc :keywords))))
+ (extra-fields (engine-custom engine 'pdf-extra-info)))
+
(string-append "[ "
(if title
(docinfo-field "Title" (ast->string title))
@@ -837,13 +833,11 @@
(else (ast->string author)))
""))
"")
- (if keywords
+ (if (pair? keywords)
(docinfo-field "Keywords"
- (cond ((string? keywords)
- keywords)
- ((pair? keywords)
- (stringify-kw keywords))
- (else "")))
+ (apply string-append
+ (keyword-list->comma-separated
+ keywords)))
"")
;; arbitrary key-value pairs, see sect. 4.7, "Info
;; dictionary" of the `pdfmark' reference.
@@ -975,7 +969,7 @@
;* document ... */
;*---------------------------------------------------------------------*/
(markup-writer 'document
- :options '(:title :author :ending :env)
+ :options '(:title :author :ending :keywords :env)
:before (lambda (n e) ;; `e' is the engine
(let* ((doc-type (let ((d (engine-custom e 'document-type)))
(if (string? d)
diff --git a/src/guile/skribilo/skribe/api.scm b/src/guile/skribilo/skribe/api.scm
index 2a4d0ae..df73427 100644
--- a/src/guile/skribilo/skribe/api.scm
+++ b/src/guile/skribilo/skribe/api.scm
@@ -51,7 +51,7 @@
#!key
(ident #f) (class "document")
(title #f) (html-title #f) (author #f)
- (ending #f) (env '()))
+ (ending #f) (keywords '()) (env '()))
(new document
(markup 'document)
(ident (or ident
@@ -68,6 +68,20 @@
(list 'figure-counter 0) (list 'figure-env '()))))))
;*---------------------------------------------------------------------*/
+;* keyword-list->comma-separated ... */
+;*---------------------------------------------------------------------*/
+(define-public (keyword-list->comma-separated kw*)
+ ;; Turn the the list of keywords (which may be strings or other markups)
+ ;; KW* into a markup where the elements of KW* are comma-separated. This
+ ;; may commonly be used in handling the `:keywords' option of `document'.
+ (let loop ((kw* kw*) (result '()))
+ (if (null? kw*)
+ (reverse! result)
+ (loop (cdr kw*)
+ (cons* (if (pair? (cdr kw*)) ", " "")
+ (car kw*) result)))))
+
+;*---------------------------------------------------------------------*/
;* author ... */
;*---------------------------------------------------------------------*/
(define-markup (author #!rest