Merge from skribilo@sv.gnu.org--2006

Patches applied:

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2  (patch 75-78, 80-83)

   - Adding missing patch logs from `lcourtes@laas.fr--2005-libre'.
   - Merge from skribilo@sv.gnu.org--2006/skribilo--devo--1.2
   - Added the `(skribilo biblio template)' module.
   - Lout engine: Make URLs breakable; make bibliography defaults sane.

 * skribilo@sv.gnu.org--2006/skribilo--devo--1.2  (patch 7-14)

   - Added a `:arguments' keyword to `slide-embed'.
   - Lout engine: Implemented `slide-embed'.
   - Lout engine: Added a `lout-program-arguments' custom.
   - slide: Improved HTML output, especially wrt. the use of CSS.
   - slide/html: Issue only one anchor per slide.
   - lout engine: Fixed the default value of `lout-program-arguments'.
   - Added the `(skribilo biblio template)' module.
   - Lout engine: Make URLs breakable; make bibliography defaults sane.

git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--devo--1.2--patch-72

4 files changed, 254 insertions, 99 deletions

diff --git a/src/guile/skribilo/biblio/Makefile.am b/src/guile/skribilo/biblio/Makefile.am
index 9442562..ee81406 100644
--- a/src/guile/skribilo/biblio/Makefile.am
+++ b/src/guile/skribilo/biblio/Makefile.am
@@ -1,4 +1,4 @@
 guilemoduledir = $(GUILE_SITE)/skribilo/biblio
-dist_guilemodule_DATA = bibtex.scm author.scm abbrev.scm
+dist_guilemodule_DATA = bibtex.scm author.scm abbrev.scm template.scm
 
 ## arch-tag: aeffaead-c3f0-47f3-a0b3-bb3e22da2657
diff --git a/src/guile/skribilo/biblio/template.scm b/src/guile/skribilo/biblio/template.scm
new file mode 100644
index 0000000..da0c948
--- /dev/null
+++ b/src/guile/skribilo/biblio/template.scm
@@ -0,0 +1,194 @@
+;;; template.scm  --  Template system for bibliography entries.
+;;;
+;;; Copyright 2003, 2004  Manuel Serrano
+;;; Copyright 2006  Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
+;;; USA.
+
+(define-module (skribilo biblio template)
+  :use-module (skribilo ast)
+  :autoload   (skribilo lib)    (skribe-error)
+  :autoload   (skribilo output) (output)
+
+  :use-module (ice-9 optargs)
+
+  :use-module (skribilo utils syntax)
+
+  :export (output-bib-entry-template
+           make-bib-entry-template/default
+           make-bib-entry-template/skribe))
+
+(fluid-set! current-reader %skribilo-module-reader)
+
+;;; Author: Manuel Serrano, Ludovic Courtès
+;;;
+;;; Commentary:
+;;;
+;;; This module provides a helper procedure to output bibliography entries
+;;; according to a given template, as well as ready-to-use templates.  A
+;;; template only contains part of the style information for a bibliography
+;;; entry.  Specific style information can be added by modifying the markup
+;;; writers for `&bib-entry-author', `&bib-entry-title', etc. (see `(skribilo
+;;; package base)' for details).
+;;;
+;;; Code:
+
+
+;;;
+;;; Outputting a bibliography entry template for a specific entry.
+;;;
+
+(define* (output-bib-entry-template bib engine template
+                                    :optional (get-field markup-option))
+  ;; Output the fields of BIB (a bibliography entry) for ENGINE according to
+  ;; TEMPLATE.  Example of templates are found below (e.g.,
+  ;; `make-bib-entry-template/default').
+  (let loop ((template template)
+             (pending #f)
+             (armed #f))
+    (cond
+     ((null? template)
+      'done)
+     ((pair? (car template))
+      (if (eq? (caar template) 'or)
+          (let ((o1 (cadr (car template))))
+            (if (get-field bib o1)
+                (loop (cons o1 (cdr template))
+                      pending
+                      #t)
+                (let ((o2 (caddr (car template))))
+                  (loop (cons o2 (cdr template))
+                        pending
+                        armed))))
+          (let ((o (get-field bib (cadr (car template)))))
+            (if o
+                (begin
+                  (if (and pending armed)
+                      (output pending engine))
+                  (output (caar template) engine)
+                  (output o engine)
+                  (if (pair? (cddr (car template)))
+                      (output (caddr (car template)) engine))
+                  (loop (cdr template) #f #t))
+                (loop (cdr template) pending armed)))))
+     ((symbol? (car template))
+      (let ((o (get-field bib (car template))))
+        (if o
+            (begin
+              (if (and armed pending)
+                  (output pending engine))
+              (output o engine)
+              (loop (cdr template) #f #t))
+            (loop (cdr template) pending armed))))
+     ((null? (cdr template))
+      (output (car template) engine))
+     ((string? (car template))
+      (loop (cdr template)
+            (if pending pending (car template))
+            armed))
+     (else
+      (skribe-error 'output-bib-fields
+                    "Illegal templateiption"
+                    (car template))))))
+
+
+;;;
+;;; Example bibliography entry templates.
+;;;
+
+(define (make-bib-entry-template/default kind)
+  ;; The default bibliography entry template.
+  (case kind
+    ((techreport)
+     `(author ". " (or title url documenturl) ". "
+              number ", " institution ", "
+              address ", " month " " year ", "
+              ("pp. " pages) "."))
+    ((article)
+     `(author ". " (or title url documenturl) ". "
+              "In " journal ", " volume
+              ("(" number ")") ", "
+              address ", " month " " year ", "
+              ("pp. " pages) "."))
+    ((inproceedings)
+     `(author ". " (or title url documenturl) ". "
+              "In " booktitle ", "
+              (series ", ")
+              ("(" number ")")
+              ("pp. " pages ", ")
+              ;; FIXME:  Addr., month., pub.
+              year "."))
+    ((book) ;; FIXME:  Title should be in italics
+     '(author ". " (or title url documenturl) ". "
+              publisher ", " address
+              ", " month " " year ", "
+              ("pp. " pages) "."))
+    ((phdthesis)
+     '(author ". " (or title url documenturl)
+              ". " type ", "
+              school ", " address
+              ", " month " " year"."))
+    ((misc)
+     '(author ". " (or title url documenturl) ". "
+              publisher ", " address
+              ", " month " " year
+              (", " url) "."))
+    (else
+     '(author ". " (or title url documenturl) ". "
+              publisher ", " address
+              ", " month " " year ", "
+              ("pp. " pages) "."))))
+
+(define (make-bib-entry-template/skribe kind)
+  ;; The awful template found by default in Skribe.
+  (case kind
+    ((techreport)
+     `(author " -- " (or title url documenturl) " -- "
+              number ", " institution ", "
+              address ", " month ", " year ", "
+              ("pp. " pages) "."))
+    ((article)
+     `(author " -- " (or title url documenturl) " -- "
+              journal ", " volume "" ("(" number ")") ", "
+              address ", " month ", " year ", "
+              ("pp. " pages) "."))
+    ((inproceedings)
+     `(author " -- " (or title url documenturl) " -- "
+              booktitle ", " series ", " ("(" number ")") ", "
+              address ", " month ", " year ", "
+              ("pp. " pages) "."))
+    ((book)
+     '(author " -- " (or title url documenturl) " -- "
+              publisher ", " address
+              ", " month ", " year ", " ("pp. " pages) "."))
+    ((phdthesis)
+     '(author " -- " (or title url documenturl) " -- " type ", "
+              school ", " address
+              ", " month ", " year"."))
+    ((misc)
+     '(author " -- " (or title url documenturl) " -- "
+              publisher ", " address
+              ", " month ", " year"."))
+    (else
+     '(author " -- " (or title url documenturl) " -- "
+              publisher ", " address
+              ", " month ", " year ", " ("pp. " pages) "."))))
+
+
+;;; arch-tag: 5931579f-b606-442d-9a45-6047c94da5a2
+
+;;; template.scm ends here
diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm
index d49b732..3b70f66 100644
--- a/src/guile/skribilo/engine/base.scm
+++ b/src/guile/skribilo/engine/base.scm
@@ -20,6 +20,8 @@
 ;;; USA.
 
 (define-skribe-module (skribilo engine base)
+  :autoload (skribilo biblio template) (make-bib-entry-template/default
+                                        output-bib-entry-template)
   :use-module (srfi srfi-13))
 
 ;*---------------------------------------------------------------------*/
@@ -218,91 +220,31 @@
    :after "]")
 
 ;*---------------------------------------------------------------------*/
+;*    &bib-entry-author ...                                            */
+;*---------------------------------------------------------------------*/
+; (markup-writer '&bib-entry-author
+;                :action (lambda (n e)
+;                          (let ((names (markup-body n)))
+;                            (skribe-eval
+;                             (sc (abbreviate-first-names names)) e))))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-url ...                                               */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-url
+               :action (lambda (n e)
+                         (let ((url (markup-body n)))
+                           (skribe-eval
+                            (ref :text (it url) :url url) e))))
+
+;*---------------------------------------------------------------------*/
 ;*    &bib-entry-body ...                                              */
 ;*---------------------------------------------------------------------*/
 (markup-writer '&bib-entry-body
    :action (lambda (n e)
-	      (define (output-fields descr)
-		 (let loop ((descr descr)
-			    (pending #f)
-			    (armed #f))
-		    (cond
-		       ((null? descr)
-			'done)
-		       ((pair? (car descr))
-			(if (eq? (caar descr) 'or)
-			    (let ((o1 (cadr (car descr))))
-			       (if (markup-option n o1)
-				   (loop (cons o1 (cdr descr))
-					 pending
-					 #t)
-				   (let ((o2 (caddr (car descr))))
-				      (loop (cons o2 (cdr descr))
-					    pending
-					    armed))))
-			    (let ((o (markup-option n (cadr (car descr)))))
-			       (if o
-				   (begin
-				      (if (and pending armed)
-					  (output pending e))
-				      (output (caar descr) e)
-				      (output o e)
-				      (if (pair? (cddr (car descr)))
-					  (output (caddr (car descr)) e))
-				      (loop (cdr descr) #f #t))
-				   (loop (cdr descr) pending armed)))))
-		       ((symbol? (car descr))
-			(let ((o (markup-option n (car descr))))
-			   (if o
-			       (begin
-				  (if (and armed pending)
-				      (output pending e))
-				  (output o e)
-				  (loop (cdr descr) #f #t))
-			       (loop (cdr descr) pending armed))))
-		       ((null? (cdr descr))
-			(output (car descr) e))
-		       ((string? (car descr))
-			(loop (cdr descr)
-			      (if pending pending (car descr))
-			      armed))
-		       (else
-			(skribe-error 'output-bib-fields
-				      "Illegal description"
-				      (car descr))))))
-	      (output-fields
-	       (case (markup-option n 'kind)
-		  ((techreport)
-		   `(author " -- " (or title url documenturl) " -- "
-			    number ", " institution ", "
-			    address ", " month ", " year ", "
-			    ("pp. " pages) "."))
-		  ((article)
-		   `(author " -- " (or title url documenturl) " -- "
-			    journal ", " volume "" ("(" number ")") ", "
-			    address ", " month ", " year ", "
-			    ("pp. " pages) "."))
-		  ((inproceedings)
-		   `(author " -- " (or title url documenturl) " -- "
-			    booktitle ", " series ", " ("(" number ")") ", "
-			    address ", " month ", " year ", "
-			    ("pp. " pages) "."))
-		  ((book)
-		   '(author " -- " (or title url documenturl) " -- "
-			    publisher ", " address
-			    ", " month ", " year ", " ("pp. " pages) "."))
-		  ((phdthesis)
-		   '(author " -- " (or title url documenturl) " -- " type ", "
-			    school ", " address
-			    ", " month ", " year"."))
-		  ((misc)
-		   '(author " -- " (or title url documenturl) " -- "
-			    publisher ", " address
-			    ", " month ", " year"."))
-		  (else
-		   '(author " -- " (or title url documenturl) " -- "
-			    publisher ", " address
-			    ", " month ", " year ", " ("pp. " pages) "."))))))
+	      (let* ((kind (markup-option n 'kind))
+                     (template (make-bib-entry-template/default kind)))
+                (output-bib-entry-template n e template))))
 
 ;*---------------------------------------------------------------------*/
 ;*    &bib-entry-ident ...                                             */
@@ -316,7 +258,22 @@
 ;*---------------------------------------------------------------------*/
 (markup-writer '&bib-entry-title
    :action (lambda (n e)
-	      (skribe-eval (bold (markup-body n)) e)))
+	      (skribe-eval (markup-body n)) e))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-booktitle ...                                         */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-booktitle
+               :action (lambda (n e)
+                         (let ((title (markup-body n)))
+                           (skribe-eval (it title) e))))
+
+;*---------------------------------------------------------------------*/
+;*    &bib-entry-journal ...                                           */
+;*---------------------------------------------------------------------*/
+(markup-writer '&bib-entry-journal
+               :action (lambda (n e)
+                         (skribe-eval (it (markup-body n)) e)))
 
 ;*---------------------------------------------------------------------*/
 ;*    &bib-entry-publisher ...                                         */
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index ddbb7b7..92977e7 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -472,7 +472,8 @@
 					(loop (- where 1))
 					where)))))
 		   `(,(ref :url url :text (substring text 0 split))
-		     ,(substring text split len)))
+		     ,(!lout (lout-make-url-breakable
+                              (substring text split len)))))
 		 (list markup))))
 
 	  ((markup? text)
@@ -2519,6 +2520,19 @@
    :after "]")
 
 ;*---------------------------------------------------------------------*/
+;*    lout-make-url-breakable ...                                      */
+;*---------------------------------------------------------------------*/
+(define-public lout-make-url-breakable
+  ;; Make the given string (which is assumed to be a URL) breakable.
+  (make-string-replace `((#\/ "\"/\"&0ik{}")
+                         (#\. ".&0ik{}")
+                         (#\- "-&0ik{}")
+                         (#\_ "_&0ik{}")
+                         (#\@ "\"@\"&0ik{}")
+                         ,@lout-verbatim-encoding
+                         (#\newline ""))))
+
+;*---------------------------------------------------------------------*/
 ;*    url-ref ...                                                      */
 ;*---------------------------------------------------------------------*/
 (markup-writer 'url-ref
@@ -2531,19 +2545,9 @@
 		       (markup-option n '&transformed))
 		   (begin
 		     (printf "{ \"~a\" @ExternalLink { " url)
-		     (if text ;; FIXME: Should be (not (string-index text #\space))
-			 (output text e)
-			 (let ((filter-url (make-string-replace
-					    `((#\/ "\"/\"&-")
-					      (#\. ".&-")
-					      (#\- "&-")
-					      (#\_ "_&-")
-					      ,@lout-verbatim-encoding
-					      (#\newline "")))))
-			   ;; Filter the URL in a way to give Lout hints on
-			   ;; where hyphenation should take place.
-			   (fprint (current-error-port) "Here!!!" filter-url)
-			   (display (filter-url url) e)))
+		     (if text
+                         (output text e)
+                         (display (lout-make-url-breakable url) e))
 		     (printf " } }"))
 		   (begin
 		     (markup-option-add! n '&transformed #t)
@@ -2630,7 +2634,7 @@
 ;*---------------------------------------------------------------------*/
 (markup-writer '&bib-entry-title
    :action (lambda (n e)
-	      (let* ((t (bold (markup-body n)))
+	      (let* ((t (markup-body n))
 		     (en (handle-ast (ast-parent n)))
 		     (url (markup-option en 'url))
 		     (ht (if url (ref :url (markup-body url) :text t) t)))
@@ -2652,7 +2656,7 @@
    :action (lambda (n e)
 	      (let* ((en (handle-ast (ast-parent n)))
 		     (url (markup-option en 'url))
-		     (t (bold (markup-body url))))
+		     (t (it (markup-body url))))
 		 (skribe-eval (ref :url (markup-body url) :text t) e))))
 
 ;*---------------------------------------------------------------------*/