From 0fe4342c25a3db2f077f0fe9f90abc4394e358c1 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Wed, 27 Sep 2006 13:57:53 +0000 Subject: Fixed creation of engines from an engine class. * src/guile/skribilo/engine.scm (): Inherit from `' for which there exists an `initialize' method. (make-engine-class): Use `make-class' rather than just `(make ...)'. (engine-class): New. (initialize): Removed. (make-instance)[initialize-engine!]: New. (make-engine): Don't pass `:customs'. git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--engine-classes--1.2--patch-2 --- src/guile/skribilo/engine.scm | 47 +++++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 22 deletions(-) (limited to 'src') diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm index 0622e11..163fe06 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 () +(define-class () (customs :init-keyword :customs :init-value '()) :metaclass ) -(define-method (compute-cpl (class )) - ;; Automatically set the class precedence list of subclasses. - (format (current-error-port) "computing CPL for ~a~%" class) - (list class )) - -(define-method (initialize (engine-class ) . args) - ;; Set the name of subclasses. - (let ((result (next-method)) - (ident (slot-ref engine-class 'ident))) - (slot-set! engine-class 'name - (symbol-append ')) - result)) - (define %format format) (define* (make-engine-class ident :key (version 'unspecified) @@ -133,7 +120,11 @@ (symbol-table '()) (custom '()) (info '())) - (let ((e (make + ;; We use `make-class' from `(oop goops)' (currently undocumented). + (let ((e (make-class (list ) '() + :metaclass + :name (symbol-append ') + :ident ident :version version :format format :filter filter :delegate delegate :symbol-table symbol-table @@ -169,27 +160,34 @@ (define (engine? obj) (is-a? obj )) +(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 ) . args) - (format (current-error-port) "initializing engine ~a~%" engine) - engine) - (define-method (make-instance (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)))) + (make engine-class)) + ;; Convenience functions. @@ -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 -- cgit v1.2.3 From 72fcb722a8ea8959edf160a676ca05df1665b64c Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Wed, 27 Sep 2006 15:40:46 +0000 Subject: Tolerate engine instances in `lookup-engine-class'. * src/guile/skribilo/engine.scm (copy-engine): Make a whole copy of the engine customs. (lookup-engine-class): Tolerate engine instances (while actually expecting classes. git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--engine-classes--1.2--patch-3 --- src/guile/skribilo/engine.scm | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'src') diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm index 163fe06..b1e4235 100644 --- a/src/guile/skribilo/engine.scm +++ b/src/guile/skribilo/engine.scm @@ -186,6 +186,7 @@ engine))) (define (make-engine engine-class) + ;; Instantiate ENGINE-CLASS. (make engine-class)) @@ -193,7 +194,6 @@ (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))) @@ -275,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) @@ -365,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))))) -- cgit v1.2.3 From 76074a64af9da255cdfb4b6ff59c786b444fbc18 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Wed, 27 Sep 2006 15:44:11 +0000 Subject: `base' engine: tolerate engine classes and instances in `processor'. * src/guile/skribilo/package/base.scm: Autoload `(skribilo engine)' upon `engine-class?' as well. (processor): Tolerate both engine classes and instances as the `:engine' argument. git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--engine-classes--1.2--patch-4 --- src/guile/skribilo/package/base.scm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'src') 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)))))) -- cgit v1.2.3 From d36f9ffd927818493230c82efc20c29a50b9afa5 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Wed, 27 Sep 2006 15:45:04 +0000 Subject: `slide' package: use the native APIs. * src/guile/skribilo/package/slide.scm: Use the native APIs rather than `define-skribe-module'. (&slide-load-options): Use `*load-options*'. git-archimport-id: lcourtes@laas.fr--2005-libre/skribilo--engine-classes--1.2--patch-5 --- src/guile/skribilo/package/slide.scm | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) (limited to 'src') 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)))) -- cgit v1.2.3