diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/guile/skribilo/engine/html.scm | 30 | ||||
| -rw-r--r-- | src/guile/skribilo/engine/lout.scm | 28 | ||||
| -rw-r--r-- | src/guile/skribilo/skribe/api.scm | 16 |
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 |