From 272de5b9dc48596d0c3776cf3e9e7acf49655136 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Fri, 21 Jul 2006 13:33:30 +0000 Subject: Added support for the `:keywords' option of `document' (Lout + HTML). * NEWS: Mention it. * doc/user/document.skb: Document it. * doc/user/user.skb (document): Added keywords. Slightly modified the introduction. * src/guile/skribilo/engine/html.scm (document): Added `:keywords' to the list of supported options. (&html-head): Reformatted. (&html-meta): New. (&html-generic-document): Use it. * src/guile/skribilo/engine/lout.scm: Document `pdf-keywords' as deprecated. (lout-pdf-docinfo): Check the `:keywords' option. (document): Mention it as supported. * src/guile/skribilo/skribe/api.scm (document): Added the `keywords' option. (keyword-list->comma-separated): New (stolen from Lout). git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-20 --- src/guile/skribilo/engine/html.scm | 30 ++++++++++++++++++++++++------ src/guile/skribilo/engine/lout.scm | 28 +++++++++++----------------- src/guile/skribilo/skribe/api.scm | 16 +++++++++++++++- 3 files changed, 50 insertions(+), 24 deletions(-) (limited to 'src/guile') 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,12 +601,22 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&html-head :before (lambda (n e) - (printf "\n") - (printf "\n" (engine-custom (find-engine 'html) - 'charset))) + (printf "\n") + (printf "\n" (engine-custom (find-engine 'html) + 'charset))) :after "\n\n") +;*---------------------------------------------------------------------*/ +;* &html-meta ... */ +;*---------------------------------------------------------------------*/ +(markup-writer '&html-meta + :before "string (or (markup-body n) '())))) + (output (keyword-list->comma-separated kw*) e))) + :after "\">\n") + ;*---------------------------------------------------------------------*/ ;* &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 @@ -67,6 +67,20 @@ (list 'footnote-counter 0) (list 'footnote-env '()) (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 ... */ ;*---------------------------------------------------------------------*/ -- cgit v1.2.3