summary refs log tree commit diff
path: root/src/guile
diff options
context:
space:
mode:
authorLudovic Court`es2006-07-21 13:33:30 +0000
committerLudovic Court`es2006-07-21 13:33:30 +0000
commit272de5b9dc48596d0c3776cf3e9e7acf49655136 (patch)
tree1d0e5e74c0369562425df249b2c31e6a88c22796 /src/guile
parentc3c35546b401dd10fba2b5a7807d84d7f4440d09 (diff)
downloadskribilo-272de5b9dc48596d0c3776cf3e9e7acf49655136.tar.gz
skribilo-272de5b9dc48596d0c3776cf3e9e7acf49655136.tar.lz
skribilo-272de5b9dc48596d0c3776cf3e9e7acf49655136.zip
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
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