Merge from lcourtes@laas.fr--2005-libre

Patches applied:

 * lcourtes@laas.fr--2005-libre/skribilo--engine-classes--1.2  (patch 1-6)

   - Preliminary support for engine classes (not working).
   - Fixed creation of engines from an engine class.
   - Tolerate engine instances in `lookup-engine-class'.
   - `base' engine: tolerate engine classes and instances in `processor'.
   - `slide' package: use the native APIs.
   - doc: Started documenting the engine and engine classes.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--engine-classes--1.2--patch-2

4 files changed, 137 insertions, 72 deletions

diff --git a/doc/user/engine.skb b/doc/user/engine.skb
index 30b8fd2..183f26d 100644
--- a/doc/user/engine.skb
+++ b/doc/user/engine.skb
@@ -1,6 +1,7 @@
-;;; engine.skb  --  The description of the Skribe engines
+;;; engine.skb  --  Description of Skribilo engines.
 ;;;
 ;;; 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
@@ -35,10 +36,10 @@
 ;*---------------------------------------------------------------------*/
 (chapter :title "Engines" 
 
-   (p [When Skribe produces a document in a given format, it uses a
-specialize engine. For instance, when a Web page is made from a Skribe
-document, the HTML engine is used. The engines provided by Skribe are
-given below:])
+   (p [When Skribilo produces a document in a given format, it uses a
+specialized engine. For instance, when a Web page is made from a
+Skribilo document, an HTML engine is used. The engine classes provided
+by Skribe are given below:])
 
    (resolve (lambda (n e env)
 	       (let* ((current-chapter (ast-chapter n))
@@ -51,52 +52,91 @@ given below:])
 			     (let ((title (markup-option x :title)))
 				(item (ref :text title :section title))))
 			  sects)))))
-   
-   (section :title "Functions dealing with engines"
+
+   (p [Skribilo differentiates an ,(emph [engine class]) from an ,(emph
+[engine]).  An engine class defines the overall behavior of a type of
+engine (e.g., HTML, Lout, LaTeX, etc.).  This includes, for instance,
+information about how to produce particular symbols and how to produce
+various markups in the particular format represented by the engine class
+(e.g., a ,(code [code]) markup can be rendered using the ,(code
+[<code>]) tag in HTML).  Conversely, an engine is an ,(emph [instance])
+of an engine class.  Therefore, the behavior of an engine is mostly
+defined by its class, but engines can have their own settings (e.g.,
+their own ,(ref :text (emph [customs]) :ident "engine-customs")) that
+can defer from the default settings specified by their class.])
+   (p [Skribe users will notice that this is slightly different from
+Skribe's notion of an engine which encompasses both notions (or, in
+other words, Skribe only allow the instantiation of one engine for each
+engine class).  A compatibility layer is available in the ,(code
+"(skribilo utils compat)") module.])
+
+   (section :title "Functions Dealing With Engines"
       
-      (subsection :title "Creating engines"
-	 (p [The function ,(code "make-engine") creates a brand new engine.])
+      (subsection :title "Creating Engine Classes"
+	 (p [The function ,(code "make-engine-class") creates a brand
+new engine class.])
 	 
-	 (doc-markup 'make-engine
-	    '((ident [The name (a symbol) of the new engine.])
+	 (doc-markup 'make-engine-class
+	    '((ident [The name (a symbol) of the new engine class.])
 	      (:version [The version number.])
-	      (:format [The output format (a string) of this engine.])
+	      (:format [The output format (a string) of this engine class.])
 	      (:filter [A string filter (a function).])
-	      (:delegate [A delegate engine.])
-	      (:symbol-table [The engine symbol table.])
-	      (:custom [The engine custom list.])
-	      (:info [Miscellaneous.]))
+	      (:delegate [A delegate engine class.])
+	      (:symbol-table [The engine class symbol table.])
+	      (:custom [The engine class custom list and default values.])
+	      (:info [Miscellaneous information.]))
 	    :common-args '()
             :skribe-source? #f
 	    :source *engine-src*
 	    :idx *function-index*)
+
+	 (p [Once an engine class has been created or ,(ref :text
+[retrieved] :ident "engine-lookup"), it can be instantiated using ,(code
+"make-engine"):])
 	 
+	 (doc-markup 'make-engine
+	    '((engine-class [The engine class that is to be
+instantiated.]))
+	    :common-args '()
+	    :skribe-source? #f
+	    :source *engine-src*
+	    :idx *function-index*)
+
+	 (p [Each engine has its own values for its customs (initially
+the default values that were specified in the ,(code ":custom")
+parameter passed when creating its class).  Thus, it is possible to have
+several engines of a same class that peacefully coexist, even with
+different customs.])
+
 	 (p [The function ,(code "copy-engine") duplicates an existing engine.])
 	 (doc-markup 'copy-engine
-	    '((ident [The name (a symbol) of the new engine.])
-	      (e [The old engine to be duplicated.])
-	      (:version [The version number.])
-	      (:filter [A string filter (a function).])
-	      (:delegate [A delegate engine.])
-	      (:symbol-table [The engine symbol table.])
-	      (:custom [The engine custom list.]))
+	    '((e [The engine to be duplicated.]))
 	    :common-args '()
             :skribe-source? #f
 	    :source *engine-src*
 	    :idx *function-index*))
 	      
-      (subsection :title "Retrieving engines"
+      (subsection :title "Retrieving Engines"
+	          :ident "engine-lookup"
 	 
-	 (p [The ,(code "find-engine") function searches in the list of defined
-engines. It returns an ,(code "engine") object on success and ,(code "#f")
-on failure.])
-	 (doc-markup 'find-engine
-	    '((id [The name (a symbol) of the engine to be searched.])
-	      (:version [An optional version number for the searched engine.]))
+	 (p [It is customary to fetch an engine class from Skribilo's
+directory (e.g., the ,(ref :text [HTML engine] :ident "html-engine"),
+the ,(ref :text [LaTeX engine] :ident "latex-engine")) using ,(code
+"lookup-engine-class") (for instance, this is what the ,(code
+"--target") option of the ,(code "skribilo") program does).])
+	 
+	 (doc-markup 'lookup-engine-class
+	    '((id [The name (a symbol) of the engine class that is looked
+for.])
+	      (:version [The version number.]))
 	    :common-args '()
             :skribe-source? #f
 	    :source *engine-src*
-	    :idx *function-index*))
+	    :idx *function-index*)
+
+	 (p [This function is roughly equivalent to Skribe's ,(code
+"find-engine"), with the noticeable difference that ,(code
+"find-engine") returns an engine rather than an engine class.]))
       
       (subsection :title "Engine accessors"
 	 (p [The predicate ,(code "engine?") returns ,(code "#t") if its
@@ -115,12 +155,13 @@ argument is an engine. Otherwise, it returns ,(code "#f"). In other words,
 	 (doc-markup 'engine-ident
 	    '((obj [The engine.]))
 	    :common-args '()
-	    :others '(engine-format engine-customs engine-filter engine-symbol-table)
+	    :others '(engine-format engine-filter engine-symbol-table)
             :skribe-source? #f
 	    :source *engine-src*
 	    :idx *function-index*))
       
-      (subsection :title "Engine customs"
+      (subsection :title "Engine Customs"
+	          :ident "engine-customs"
 	 
 	 (p [Engine customs are locations where dynamic informations relative
 to engines can be stored. Engine custom can be seen a global variables that
@@ -128,10 +169,10 @@ are specific to engines. The function ,(code "engine-custom") returns the
 value of a custom or ,(code "#f") if that custom is not defined. The
 function ,(code "engine-custom-set!") defines or sets a new value for
 a custom.])
-	 
+
 	 (doc-markup 'engine-custom
 	    `((e ,[The engine (as returned by 
-,(ref :mark "find-engine" :text (code "find-engine"))).])
+,(ref :mark "make-engine" :text (code "make-engine"))).])
 	      (id [The name of the custom.]))
 	    :common-args '()
             :skribe-source? #f
@@ -140,7 +181,7 @@ a custom.])
 	 
 	 (doc-markup 'engine-custom-set!
 	    `((e ,[The engine (as returned by 
-,(ref :mark "find-engine" :text (code "find-engine"))).])
+,(ref :mark "make-engine" :text (code "make-engine"))).])
 	      (id [The name of the custom.])
 	      (val [The new value of the custom.]))
 	    :common-args '()
diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm
index 0622e11..b1e4235 100644
--- a/src/guile/skribilo/engine.scm
+++ b/src/guile/skribilo/engine.scm
@@ -107,23 +107,10 @@
   (customs		:init-keyword :custom		:init-value '())
   (symbol-table		:init-keyword :symbol-table	:init-value '()))
 
-(define-class <engine> ()
+(define-class <engine> (<object>)
   (customs	:init-keyword :customs	:init-value '())
   :metaclass <engine-class>)
 
-(define-method (compute-cpl (class <engine-class>))
-  ;; Automatically set the class precedence list of <engine> subclasses.
-  (format (current-error-port) "computing CPL for ~a~%" class)
-  (list class <engine> <top>))
-
-(define-method (initialize (engine-class <engine-class>) . args)
-  ;; Set the name of <engine> subclasses.
-  (let ((result (next-method))
-	(ident (slot-ref engine-class 'ident)))
-    (slot-set! engine-class 'name
-	       (symbol-append '<engine: ident '>))
-    result))
-
 
 (define %format format)
 (define* (make-engine-class ident :key (version 'unspecified)
@@ -133,7 +120,11 @@
 				       (symbol-table '())
 				       (custom '())
 				       (info '()))
-  (let ((e (make <engine-class>
+  ;; We use `make-class' from `(oop goops)' (currently undocumented).
+  (let ((e (make-class (list <engine>) '()
+             :metaclass <engine-class>
+             :name (symbol-append '<engine: ident '>)
+
 	     :ident ident :version version :format format
 	     :filter filter :delegate delegate
 	     :symbol-table symbol-table
@@ -169,33 +160,40 @@
 (define (engine? obj)
   (is-a? obj <engine>))
 
+(define (engine-class e)
+  (and (engine? e) (class-of e)))
+
 ;; A mapping of engine classes to hooks.
 (define %engine-instantiate-hook (make-hash-table))
 
-(define-method (initialize (engine <engine>) . args)
-  (format (current-error-port) "initializing engine ~a~%" engine)
-  engine)
-
 (define-method (make-instance (class <engine-class>) . args)
+  (define (initialize-engine! engine)
+    ;; Automatically initialize the `customs' slot of the newly created
+    ;; engine.
+    (let ((init-values (engine-class-customs class)))
+      (slot-set! engine 'customs (map list-copy init-values))
+      engine))
+
   (format #t "making engine of class ~a~%" class)
   (let ((engine (next-method)))
     (if (engine? engine)
-	(let ((hook (hashq-ref %engine-instantiate-hook engine-class)))
+	(let ((hook (hashq-ref %engine-instantiate-hook class)))
 	  (format (current-error-port) "engine made: ~a~%" engine)
+          (initialize-engine! engine)
 	  (if (hook? hook)
 	      (run-hook hook engine class))
 	  engine)
 	engine)))
 
 (define (make-engine engine-class)
-  (make engine-class
-    :customs (list-copy (slot-ref engine-class 'customs))))
+  ;; Instantiate ENGINE-CLASS.
+  (make engine-class))
+
 
 ;; Convenience functions.
 
 (define (engine-ident obj) (engine-class-ident (engine-class obj)))
 (define (engine-format obj) (engine-class-format (engine-class obj)))
-;;(define (engine-customs obj) (engine-class-customs (engine-class obj)))
 (define (engine-filter obj) (engine-class-filter (engine-class obj)))
 (define (engine-symbol-table obj)
   (engine-class-symbol-table (engine-class obj)))
@@ -209,6 +207,11 @@
 	(string=? fmt (engine-format e)))))
 
 
+
+;;;
+;;; Writers.
+;;;
+
 (define (engine-class-add-writer! e ident pred upred opt before action
 				  after class valid)
   ;; Add a writer to engine class E.  If IDENT is a symbol, then it should
@@ -272,8 +275,7 @@
 ;;;
 (define (copy-engine e)
   (let ((new (shallow-clone e)))
-    (slot-set! new 'class   (engine-class e))
-    (slot-set! new 'customs (list-copy (slot-ref e 'customs)))
+    (slot-set! new 'customs (map list-copy (slot-ref e 'customs)))
     new))
 
 (define* (copy-engine-class ident e :key (version 'unspecified)
@@ -362,9 +364,15 @@ otherwise the requested engine is returned."
      (let* ((engine (symbol-append id '-engine))
 	    (m (resolve-module (engine-id->module-name id))))
        (if (module-bound? m engine)
-	   (let ((e (module-ref m engine)))
-	     (if e (consume-load-hook! id))
-	     e)
+	   (let* ((e (module-ref m engine))
+                  ;; We have to have this thin compatibility layer here.
+                  (c (cond ((engine-class? e) e)
+                           ((engine? e) (engine-class e))
+                           (else
+                            (skribe-error 'lookup-engine-class
+                                          "not an engine class" e)))))
+	     (if c (consume-load-hook! id))
+	     c)
 	   (error "no such engine" id)))))
 
 
diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm
index bbb2a62..53f9e5c 100644
--- a/src/guile/skribilo/package/base.scm
+++ b/src/guile/skribilo/package/base.scm
@@ -30,7 +30,7 @@
   :use-module (skribilo utils keywords)
   :autoload   (srfi srfi-1)        (every any filter)
   :autoload   (skribilo evaluator) (include-document)
-  :autoload   (skribilo engine)    (engine?)
+  :autoload   (skribilo engine)    (engine? engine-class?)
 
   ;; optional ``sub-packages''
   :autoload   (skribilo biblio)    (default-bib-table resolve-bib
@@ -896,7 +896,7 @@
    (cond
       ((and combinator (not (procedure? combinator)))
        (skribe-error 'processor "Combinator not a procedure" combinator))
-      ((and engine (not (engine? engine)))
+      ((and engine (not (or (engine? engine) (engine-class? engine))))
        (skribe-error 'processor "Illegal engine" engine))
       ((and procedure
 	    (or (not (procedure? procedure))
@@ -911,7 +911,9 @@
       (else
        (new processor
 	  (combinator combinator)
-	  (engine engine)
+	  (engine (if (engine-class? engine)
+                      (make-engine engine)
+                      engine))
 	  (procedure (or procedure (lambda (n e) n)))
 	  (body (the-body opts))))))
 
diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm
index 12955ce..e25e222 100644
--- a/src/guile/skribilo/package/slide.scm
+++ b/src/guile/skribilo/package/slide.scm
@@ -20,13 +20,27 @@
 ;;; USA.
 
 
-(define-skribe-module (skribilo package slide))
+(define-module (skribilo package slide)
+  :use-module (skribilo reader)
+  :use-module (skribilo utils syntax)
 
+  :use-module (skribilo lib)
+  :use-module (skribilo ast)
+  :use-module (skribilo engine)
+  :use-module (skribilo evaluator) ;; `*load-options*'
+  :use-module (skribilo package base)
 
+  :use-module (srfi srfi-1)
+  :use-module (ice-9 optargs))
+
+(fluid-set! current-reader (make-reader 'skribe))
+
+
+
 ;*---------------------------------------------------------------------*/
 ;*    slide-options                                                    */
 ;*---------------------------------------------------------------------*/
-(define-public &slide-load-options (skribe-load-options))
+(define-public &slide-load-options (*load-options*))
 
 
 ;*---------------------------------------------------------------------*/
@@ -49,7 +63,7 @@
    (let ((s (new container
 	       (markup 'slide)
 	       (ident (if (not ident)
-			  (symbol->string (gensym 'slide))
+			  (symbol->string (gensym "slide"))
 			  ident))
 	       (class class)
 	       (required-options '(:title :number :toc))
@@ -231,7 +245,7 @@
    (new container
       (markup 'slide-topic)
       (required-options '(:title :outline?))
-      (ident (or ident (symbol->string (gensym 'slide-topic))))
+      (ident (or ident (symbol->string (gensym "slide-topic"))))
       (options (the-options opt))
       (body (the-body opt))))
 
@@ -244,7 +258,7 @@
    (new container
       (markup 'slide-subtopic)
       (required-options '(:title :outline?))
-      (ident (or ident (symbol->string (gensym 'slide-subtopic))))
+      (ident (or ident (symbol->string (gensym "slide-subtopic"))))
       (options (the-options opt))
       (body (the-body opt))))