diff options
author | Ludovic Courtes | 2006-09-21 06:31:29 +0000 |
---|---|---|
committer | Ludovic Courtes | 2006-09-21 06:31:29 +0000 |
commit | 3f4ddb15782273aa1370c899d21a0dfd90578d71 (patch) | |
tree | 8faa0d0b67cf26fb0539f178b0838f759ee3c165 /src | |
parent | 2995e1109063b227827a2e50e34e42d72da3ece2 (diff) | |
download | skribilo-3f4ddb15782273aa1370c899d21a0dfd90578d71.tar.gz skribilo-3f4ddb15782273aa1370c899d21a0dfd90578d71.tar.lz skribilo-3f4ddb15782273aa1370c899d21a0dfd90578d71.zip |
Preliminary support for engine classes (not working).
git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--engine-classes--1.2--patch-1
Diffstat (limited to 'src')
-rw-r--r-- | src/guile/skribilo/biblio/bibtex.scm | 7 | ||||
-rw-r--r-- | src/guile/skribilo/engine.scm | 375 | ||||
-rw-r--r-- | src/guile/skribilo/engine/base.scm | 31 | ||||
-rw-r--r-- | src/guile/skribilo/evaluator.scm | 7 | ||||
-rw-r--r-- | src/guile/skribilo/module.scm | 4 | ||||
-rw-r--r-- | src/guile/skribilo/output.scm | 2 | ||||
-rw-r--r-- | src/guile/skribilo/package/eq.scm | 22 | ||||
-rw-r--r-- | src/guile/skribilo/package/eq/lout.scm | 27 | ||||
-rw-r--r-- | src/guile/skribilo/package/pie.scm | 8 | ||||
-rw-r--r-- | src/guile/skribilo/package/pie/lout.scm | 16 | ||||
-rw-r--r-- | src/guile/skribilo/package/slide.scm | 8 | ||||
-rw-r--r-- | src/guile/skribilo/package/slide/base.scm | 6 | ||||
-rw-r--r-- | src/guile/skribilo/utils/compat.scm | 128 | ||||
-rw-r--r-- | src/guile/skribilo/verify.scm | 2 | ||||
-rw-r--r-- | src/guile/skribilo/writer.scm | 42 |
15 files changed, 454 insertions, 231 deletions
diff --git a/src/guile/skribilo/biblio/bibtex.scm b/src/guile/skribilo/biblio/bibtex.scm index 319df1d..d3d1cca 100644 --- a/src/guile/skribilo/biblio/bibtex.scm +++ b/src/guile/skribilo/biblio/bibtex.scm @@ -22,7 +22,8 @@ (define-module (skribilo biblio bibtex) :autoload (skribilo utils strings) (make-string-replace) :autoload (skribilo ast) (markup-option ast->string) - :autoload (skribilo engine) (engine-filter find-engine) + :autoload (skribilo engine) (engine-class-filter + lookup-engine-class) :use-module (skribilo biblio author) :use-module (srfi srfi-39) :export (print-as-bibtex-entry)) @@ -60,8 +61,8 @@ (markup-ident entry)) (for-each (lambda (opt) (let* ((o (show-option opt)) - (tex-filter (engine-filter - (find-engine 'latex))) + (tex-filter (engine-class-filter + (lookup-engine-class 'latex))) (filter (lambda (n) (tex-filter (ast->string n)))) (id (lambda (a) a))) diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm index 06667ad..0622e11 100644 --- a/src/guile/skribilo/engine.scm +++ b/src/guile/skribilo/engine.scm @@ -1,7 +1,7 @@ ;;; engine.scm -- Skribilo engines. ;;; -;;; Copyright 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> -;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr> +;;; Copyright 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -32,25 +32,38 @@ :use-module (ice-9 optargs) :autoload (srfi srfi-39) (make-parameter) - :export (<engine> engine? engine-ident engine-format - engine-customs engine-filter engine-symbol-table + :export (<engine-class> engine-class? engine-class-ident + engine-class-format + engine-class-customs engine-class-filter + engine-class-symbol-table + copy-engine-class + + <engine> engine? engine-custom + engine-custom-set! engine-custom-add! + engine-format? + + engine-ident engine-format + engine-filter engine-symbol-table *current-engine* - default-engine default-engine-set! - make-engine copy-engine find-engine lookup-engine - engine-custom engine-custom-set! engine-custom-add! - engine-format? engine-add-writer! + default-engine-class default-engine-class-set! + push-default-engine-class pop-default-engine-class + + make-engine-class lookup-engine-class + make-engine copy-engine engine-class + engine-class-add-writer! + processor-get-engine - push-default-engine pop-default-engine - engine-loaded? when-engine-is-loaded)) + engine-class-loaded? when-engine-class-is-loaded + when-engine-is-instantiated)) (fluid-set! current-reader %skribilo-module-reader) ;;; -;;; Class definition. +;;; Class definitions. ;;; ;; Note on writers @@ -81,7 +94,7 @@ ;; For more details, see `markup-writer-get' and `lookup-markup-writer' in ;; `(skribilo writer)'. -(define-class <engine> () +(define-class <engine-class> (<class>) (ident :init-keyword :ident :init-value '???) (format :init-keyword :format :init-value "raw") (info :init-keyword :info :init-value '()) @@ -92,109 +105,182 @@ (free-writers :init-value '()) (filter :init-keyword :filter :init-value #f) (customs :init-keyword :custom :init-value '()) - (symbol-table :init-keyword :symbol-table :init-value '())) + (symbol-table :init-keyword :symbol-table :init-value '())) +(define-class <engine> () + (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) + (format "raw") + (filter #f) + (delegate #f) + (symbol-table '()) + (custom '()) + (info '())) + (let ((e (make <engine-class> + :ident ident :version version :format format + :filter filter :delegate delegate + :symbol-table symbol-table + :custom custom :info info))) + (%format (current-error-port) "make-engine-class returns ~a~%" e) + e)) -(define (engine? obj) - (is-a? obj <engine>)) +(define (engine-class? obj) + (is-a? obj <engine-class>)) -(define (engine-ident obj) +(define (engine-class-ident obj) (slot-ref obj 'ident)) -(define (engine-format obj) +(define (engine-class-format obj) (slot-ref obj 'format)) -(define (engine-customs obj) +(define (engine-class-customs obj) (slot-ref obj 'customs)) -(define (engine-filter obj) +(define (engine-class-filter obj) (slot-ref obj 'filter)) -(define (engine-symbol-table obj) +(define (engine-class-symbol-table obj) (slot-ref obj 'symbol-table)) ;;; -;;; Default engines. +;;; Engine instances. ;;; -(define *default-engine* #f) -(define *default-engines* '()) +(define (engine? obj) + (is-a? obj <engine>)) -(define (default-engine) - *default-engine*) +;; 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) + (format #t "making engine of class ~a~%" class) + (let ((engine (next-method))) + (if (engine? engine) + (let ((hook (hashq-ref %engine-instantiate-hook engine-class))) + (format (current-error-port) "engine made: ~a~%" 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)))) + +;; 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))) +(define (engine-format? fmt . e) + (let ((e (cond + ((pair? e) (car e)) + (else (*current-engine*))))) + (if (not (engine? e)) + (skribe-error 'engine-format? "no engine" e) + (string=? fmt (engine-format e))))) -(define (default-engine-set! e) - (with-debug 5 'default-engine-set! - (debug-item "engine=" e) - (if (not (engine? e)) - (skribe-error 'default-engine-set! "bad engine ~S" e)) - (set! *default-engine* e) - (set! *default-engines* (cons e *default-engines*)) - e)) +(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 + ;; denote a markup name and the writer being added is specific to that + ;; markup. If IDENT is `#t' (for instance), then it is assumed to be a + ;; ``free writer'' that may apply to any kind of markup for which PRED + ;; returns true. + (define (check-procedure name proc arity) + (cond + ((not (procedure? proc)) + (skribe-error ident "Illegal procedure" proc)) + ((not (equal? (%procedure-arity proc) arity)) + (skribe-error ident + (format #f "Illegal ~S procedure" name) + proc)))) -(define (push-default-engine e) - (set! *default-engines* (cons e *default-engines*)) - (default-engine-set! e)) + (define (check-output name proc) + (and proc (or (string? proc) (check-procedure name proc 2)))) -(define (pop-default-engine) - (if (null? *default-engines*) - (skribe-error 'pop-default-engine "Empty engine stack" '()) - (begin - (set! *default-engines* (cdr *default-engines*)) - (if (pair? *default-engines*) - (default-engine-set! (car *default-engines*)) - (set! *default-engine* #f))))) + ;; + ;; Engine-add-writer! starts here + ;; + (if (not (is-a? e <engine-class>)) + (skribe-error ident "Illegal engine" e)) + ;; check the options + (if (not (or (eq? opt 'all) (list? opt))) + (skribe-error ident "Illegal options" opt)) -(define (processor-get-engine combinator newe olde) - (cond - ((procedure? combinator) - (combinator newe olde)) - ((engine? newe) - newe) - (else - olde))) + ;; check the correctness of the predicate + (if pred + (check-procedure "predicate" pred 2)) + ;; check the correctness of the validation proc + (if valid + (check-procedure "validate" valid 2)) -(define (engine-format? fmt . e) - (let ((e (cond - ((pair? e) (car e)) - (else (*current-engine*))))) - (if (not (engine? e)) - (skribe-error 'engine-format? "no engine" e) - (string=? fmt (engine-format e))))) + ;; check the correctness of the three actions + (check-output "before" before) + (check-output "action" action) + (check-output "after" after) -;;; -;;; MAKE-ENGINE -;;; -(define* (make-engine ident :key (version 'unspecified) - (format "raw") - (filter #f) - (delegate #f) - (symbol-table '()) - (custom '()) - (info '())) - (let ((e (make <engine> :ident ident :version version :format format - :filter filter :delegate delegate - :symbol-table symbol-table - :custom custom :info info))) - e)) + ;; create a new writer and bind it + (let ((n (make <writer> + :ident (if (symbol? ident) ident 'all) + :class class :pred pred :upred upred :options opt + :before before :action action :after after + :validate valid))) + (if (symbol? ident) + (let ((writers (slot-ref e 'writers))) + (hashq-set! writers ident + (cons n (hashq-ref writers ident '())))) + (slot-set! e 'free-writers + (cons n (slot-ref e 'free-writers)))) + n)) ;;; ;;; COPY-ENGINE ;;; -(define* (copy-engine ident e :key (version 'unspecified) - (filter #f) - (delegate #f) - (symbol-table #f) - (custom #f)) +(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))) + new)) + +(define* (copy-engine-class ident e :key (version 'unspecified) + (filter #f) + (delegate #f) + (symbol-table #f) + (custom #f)) (let ((new (shallow-clone e))) (slot-set! new 'ident ident) (slot-set! new 'version version) @@ -212,14 +298,11 @@ (hash-for-each (lambda (m w*) (hashq-set! new-writers m w*)) (slot-ref e 'writers)) - (slot-set! new 'writers new-writers)) - - new)) - + (slot-set! new 'writers new-writers)))) ;;; -;;; Engine loading. +;;; Engine class loading. ;;; ;; Each engine is to be stored in its own module with the `(skribilo engine)' @@ -229,39 +312,47 @@ (define (engine-id->module-name id) `(skribilo engine ,id)) -(define (engine-loaded? id) +(define (engine-class-loaded? id) "Check whether engine @var{id} is already loaded." ;; Trick taken from `resolve-module' in `boot-9.scm'. (nested-ref the-root-module `(%app modules ,@(engine-id->module-name id)))) ;; A mapping of engine names to hooks. -(define %engine-load-hook (make-hash-table)) +(define %engine-class-load-hook (make-hash-table)) (define (consume-load-hook! id) (with-debug 5 'consume-load-hook! - (let ((hook (hashq-ref %engine-load-hook id))) + (let ((hook (hashq-ref %engine-class-load-hook id))) (if hook (begin (debug-item "running hook " hook " for engine " id) - (hashq-remove! %engine-load-hook id) + (hashq-remove! %engine-class-load-hook id) (run-hook hook)))))) -(define (when-engine-is-loaded id thunk) +(define (when-engine-class-is-loaded id thunk) "Run @var{thunk} only when engine with identifier @var{id} is loaded." - (if (engine-loaded? id) + (if (engine-class-loaded? id) (begin ;; Maybe the engine had already been loaded via `use-modules'. (consume-load-hook! id) (thunk)) - (let ((hook (or (hashq-ref %engine-load-hook id) + (let ((hook (or (hashq-ref %engine-class-load-hook id) (let ((hook (make-hook))) - (hashq-set! %engine-load-hook id hook) + (hashq-set! %engine-class-load-hook id hook) hook)))) (add-hook! hook thunk)))) +(define (when-engine-is-instantiated engine-class proc) + (let loop ((hook (hashq-ref %engine-instantiate-hook engine-class))) + (if (not hook) + (let ((hook (make-hook 2))) + (hashq-set! %engine-instantiate-hook engine-class hook) + (loop hook)) + (add-hook! hook proc)))) -(define* (lookup-engine id :key (version 'unspecified)) + +(define* (lookup-engine-class id :key (version 'unspecified)) "Look for an engine named @var{name} (a symbol) in the @code{(skribilo engine)} module hierarchy. If no such engine was found, an error is raised, otherwise the requested engine is returned." @@ -276,11 +367,6 @@ otherwise the requested engine is returned." e) (error "no such engine" id))))) -(define* (find-engine id :key (version 'unspecified)) - (false-if-exception (apply lookup-engine (list id version)))) - - - ;;; @@ -294,7 +380,6 @@ otherwise the requested engine is returned." (cadr c) 'unspecified))) - (define (engine-custom-set! e id val) (let* ((customs (slot-ref e 'customs)) (c (assq id customs))) @@ -308,61 +393,47 @@ otherwise the requested engine is returned." (engine-custom-set! e id (list val)) (engine-custom-set! e id (cons val old))))) -(define (engine-add-writer! e ident pred upred opt before action - after class valid) - ;; Add a writer to engine E. If IDENT is a symbol, then it should denote - ;; a markup name and the writer being added is specific to that markup. If - ;; IDENT is `#t' (for instance), then it is assumed to be a ``free writer'' - ;; that may apply to any kind of markup for which PRED returns true. +(define (processor-get-engine combinator newe olde) + (cond + ((procedure? combinator) + (combinator newe olde)) + ((engine? newe) + newe) + (else + olde))) - (define (check-procedure name proc arity) - (cond - ((not (procedure? proc)) - (skribe-error ident "Illegal procedure" proc)) - ((not (equal? (%procedure-arity proc) arity)) - (skribe-error ident - (format #f "Illegal ~S procedure" name) - proc)))) - (define (check-output name proc) - (and proc (or (string? proc) (check-procedure name proc 2)))) + +;;; +;;; Default engines. +;;; - ;; - ;; Engine-add-writer! starts here - ;; - (if (not (is-a? e <engine>)) - (skribe-error ident "Illegal engine" e)) +(define *default-engine-classes* '(html)) - ;; check the options - (if (not (or (eq? opt 'all) (list? opt))) - (skribe-error ident "Illegal options" opt)) +(define (default-engine-class) + (let ((class (car *default-engine-classes*))) + (cond ((symbol? class) (lookup-engine-class class)) + (else class)))) - ;; check the correctness of the predicate - (if pred - (check-procedure "predicate" pred 2)) +(define (default-engine-class-set! e) + (with-debug 5 'default-engine-set! + (debug-item "engine=" e) - ;; check the correctness of the validation proc - (if valid - (check-procedure "validate" valid 2)) + (if (not (or (symbol? e) (engine-class? e))) + (skribe-error 'default-engine-class-set! "bad engine class ~S" e)) + (set-car! *default-engine-classes* e) + e)) - ;; check the correctness of the three actions - (check-output "before" before) - (check-output "action" action) - (check-output "after" after) - ;; create a new writer and bind it - (let ((n (make <writer> - :ident (if (symbol? ident) ident 'all) - :class class :pred pred :upred upred :options opt - :before before :action action :after after - :validate valid))) - (if (symbol? ident) - (let ((writers (slot-ref e 'writers))) - (hashq-set! writers ident - (cons n (hashq-ref writers ident '())))) - (slot-set! e 'free-writers - (cons n (slot-ref e 'free-writers)))) - n)) +(define (push-default-engine-class e) + (set! *default-engine-classes* + (cons e *default-engine-classes*)) + e) + +(define (pop-default-engine-class) + (if (null? *default-engine-classes*) + (skribe-error 'pop-default-engine-class "empty engine class stack" '()) + (set! *default-engine-classes* (cdr *default-engine-classes*)))) @@ -374,14 +445,20 @@ otherwise the requested engine is returned." (use-modules (skribilo module)) ;; At this point, we're almost done with the bootstrap process. -;(format #t "base engine: ~a~%" (lookup-engine 'base)) +(format (current-error-port) "HERE~%") +(format #t "base engine: ~a~%" (lookup-engine-class 'base)) +(format (current-error-port) "THERE~%") (define *current-engine* ;; By default, use the HTML engine. - (make-parameter (lookup-engine 'html) + (make-parameter #f ;'html ;(make-engine (lookup-engine-class 'html)) (lambda (val) - (cond ((symbol? val) (lookup-engine val)) + (cond ((symbol? val) + (make-engine (lookup-engine-class val))) + ((engine-class? val) + (make-engine val)) ((engine? val) val) + ((not val) val) (else (error "invalid value for `*current-engine*'" val)))))) diff --git a/src/guile/skribilo/engine/base.scm b/src/guile/skribilo/engine/base.scm index 8418e8b..c7f7dd2 100644 --- a/src/guile/skribilo/engine/base.scm +++ b/src/guile/skribilo/engine/base.scm @@ -1,6 +1,7 @@ ;;; base.scm -- BASE Skribe engine ;;; ;;; 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 @@ -18,14 +19,26 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; USA. -(define-skribe-module (skribilo engine base)) +(define-module (skribilo engine base) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo writer) + :autoload (skribilo output) (output) + :use-module (skribilo evaluator) + ;; syntactic sugar + :use-module (skribilo reader) + :use-module (skribilo utils syntax)) + +(fluid-set! current-reader (make-reader 'skribe)) + + ;*---------------------------------------------------------------------*/ ;* base-engine ... */ ;*---------------------------------------------------------------------*/ (define base-engine - (default-engine-set! - (make-engine 'base + (default-engine-class-set! + (make-engine-class 'base :version 'plain :symbol-table '(("iexcl" "!") ("cent" "c") @@ -166,7 +179,7 @@ (format #f "?~a " k)))) (msg (list f (markup-body n))) (n (list "[" (color :fg "red" (bold msg)) "]"))) - (skribe-eval n e)))) + (evaluate-document n e)))) ;*---------------------------------------------------------------------*/ ;* &the-bibliography ... */ @@ -314,14 +327,14 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-title :action (lambda (n e) - (skribe-eval (bold (markup-body n)) e))) + (evaluate-document (bold (markup-body n)) e))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-publisher ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-publisher :action (lambda (n e) - (skribe-eval (it (markup-body n)) e))) + (evaluate-document (it (markup-body n)) e))) ;*---------------------------------------------------------------------*/ ;* &the-index ... @label the-index@ */ @@ -441,7 +454,7 @@ ;;:&skribe-eval-location loc :class "index-table" (make-sub-tables ie nc pref)))))) - (output (skribe-eval t e) e)))) + (output (evaluate-document t e) e)))) ;*---------------------------------------------------------------------*/ ;* &the-index-header ... */ @@ -458,7 +471,7 @@ (markup-writer '&prog-line :before (lambda (n e) (let ((n (markup-ident n))) - (if n (skribe-eval (it (list n) ": ") e)))) + (if n (evaluate-document (it (list n) ": ") e)))) :after "\n") ;*---------------------------------------------------------------------*/ @@ -469,7 +482,7 @@ :action (lambda (n e) (let ((o (markup-option n :offset)) (n (markup-ident (handle-body (markup-body n))))) - (skribe-eval (it (if (integer? o) (+ o n) n)) e)))) + (evaluate-document (it (if (integer? o) (+ o n) n)) e)))) diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm index 8502d51..4450298 100644 --- a/src/guile/skribilo/evaluator.scm +++ b/src/guile/skribilo/evaluator.scm @@ -27,7 +27,8 @@ :autoload (skribilo location) (<location>) :autoload (skribilo ast) (ast? markup?) :autoload (skribilo engine) (*current-engine* - engine? find-engine engine-ident) + engine? lookup-engine-class + engine-ident) :autoload (skribilo reader) (*document-reader*) :autoload (skribilo verify) (verify) @@ -99,7 +100,9 @@ (debug-item "engine=" engine) (debug-item "reader=" reader) - (let ((e (if (symbol? engine) (find-engine engine) engine))) + (let ((e (if (symbol? engine) + (make-engine (lookup-engine-class engine)) + engine))) (debug-item "e=" e) (if (not (engine? e)) (skribe-error 'evaluate-document-from-port "cannot find engine" engine) diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm index ac8eee0..b709079 100644 --- a/src/guile/skribilo/module.scm +++ b/src/guile/skribilo/module.scm @@ -58,8 +58,8 @@ (skribilo biblio) (skribilo lib) ;; `define-markup', `unwind-protect', etc. (skribilo resolve) - (skribilo engine) - (skribilo writer) + ;;(skribilo engine) + ;;(skribilo writer) (skribilo output) (skribilo evaluator) (skribilo debug) diff --git a/src/guile/skribilo/output.scm b/src/guile/skribilo/output.scm index a33c040..27906ec 100644 --- a/src/guile/skribilo/output.scm +++ b/src/guile/skribilo/output.scm @@ -222,7 +222,7 @@ (define-method (out (node <markup>) e) - (let ((w (lookup-markup-writer node e))) + (let ((w (lookup-markup-writer node (engine-class e)))) (if (writer? w) (%out/writer node e w) (output (slot-ref node 'body) e)))) diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm index 4f5020e..eec84d6 100644 --- a/src/guile/skribilo/package/eq.scm +++ b/src/guile/skribilo/package/eq.scm @@ -258,7 +258,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., ;;; -(markup-writer 'eq (find-engine 'base) +(markup-writer 'eq (lookup-engine-class 'base) :action (lambda (node engine) ;; The `:renderer' option should be a symbol (naming an engine ;; class) or an engine or engine class. This allows the use of @@ -276,7 +276,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (let ((lout-code (with-output-to-string (lambda () - (output node (find-engine 'lout)))))) + (output node (lookup-engine-class 'lout)))))) (output (lout-illustration :ident (markup-ident node) lout-code) @@ -292,7 +292,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., ;; Note: The text-only rendering is less ambiguous if we parenthesize ;; without taking operator precedence into account. (let ((precedence (operator-precedence op))) - `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base) + `(markup-writer ',(symbol-append 'eq: op) (lookup-engine-class 'base) :action (lambda (node engine) (let loop ((operands (markup-body node))) (if (null? operands) @@ -334,14 +334,14 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (simple-markup-writer >= (symbol "ge")) (simple-markup-writer <= (symbol "le")) -(markup-writer 'eq:sqrt (find-engine 'base) +(markup-writer 'eq:sqrt (lookup-engine-class 'base) :action (lambda (node engine) (display "sqrt(") (output (markup-body node) engine) (display ")"))) (define-macro (simple-binary-markup-writer op obj) - `(markup-writer ',(symbol-append 'eq: op) (find-engine 'base) + `(markup-writer ',(symbol-append 'eq: op) (lookup-engine-class 'base) :action (lambda (node engine) (let ((body (markup-body node))) (if (= (length body) 2) @@ -358,7 +358,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., "wrong argument type" body)))))) -(markup-writer 'eq:expt (find-engine 'base) +(markup-writer 'eq:expt (lookup-engine-class 'base) :action (lambda (node engine) (let ((body (markup-body node))) (if (= (length body) 2) @@ -372,7 +372,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (simple-binary-markup-writer in (symbol "in")) (simple-binary-markup-writer notin (symbol "notin")) -(markup-writer 'eq:apply (find-engine 'base) +(markup-writer 'eq:apply (lookup-engine-class 'base) :action (lambda (node engine) (let ((func (car (markup-body node)))) (output func engine) @@ -387,7 +387,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (loop (cdr operands))))) (display ")")))) -(markup-writer 'eq:sum (find-engine 'base) +(markup-writer 'eq:sum (lookup-engine-class 'base) :action (lambda (node engine) (let ((from (markup-option node :from)) (to (markup-option node :to))) @@ -400,7 +400,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (output (markup-body node) engine) (display ")")))) -(markup-writer 'eq:prod (find-engine 'base) +(markup-writer 'eq:prod (lookup-engine-class 'base) :action (lambda (node engine) (let ((from (markup-option node :from)) (to (markup-option node :to))) @@ -413,7 +413,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (output (markup-body node) engine) (display ")")))) -(markup-writer 'eq:script (find-engine 'base) +(markup-writer 'eq:script (lookup-engine-class 'base) :action (lambda (node engine) (let ((body (markup-body node)) (sup* (markup-option node :sup)) @@ -429,7 +429,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., ;;; Initialization. ;;; -(when-engine-is-loaded 'lout +(when-engine-class-is-loaded 'lout (lambda () (resolve-module '(skribilo package eq lout)))) diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm index c487b85..c38e74c 100644 --- a/src/guile/skribilo/package/eq/lout.scm +++ b/src/guile/skribilo/package/eq/lout.scm @@ -37,14 +37,13 @@ ;;; Initialization. ;;; -(let ((lout (find-engine 'lout))) - (if (not lout) - (skribe-error 'eq "Lout engine not found" lout) - (let ((includes (engine-custom lout 'includes))) - ;; Append the `eq' include file - (engine-custom-set! lout 'includes - (string-append includes "\n" - "@SysInclude { eq }\n"))))) +(when-engine-is-instantiated (lookup-engine-class 'lout) + (lambda (lout class) + (let ((includes (engine-custom lout 'includes))) + ;; Append the `eq' include file + (engine-custom-set! lout 'includes + (string-append includes "\n" + "@SysInclude { eq }\n"))))) ;;; @@ -52,7 +51,7 @@ ;;; -(markup-writer 'eq (find-engine 'lout) +(markup-writer 'eq (lookup-engine-class 'lout) :options '(:inline?) :before "{ " :action (lambda (node engine) @@ -81,7 +80,7 @@ (close-par `(if need-paren? "{ @VScale ) }" ""))) `(markup-writer ',(symbol-append 'eq: sym) - (find-engine 'lout) + (lookup-engine-class 'lout) :action (lambda (node engine) (let loop ((operands (markup-body node))) (if (null? operands) @@ -132,7 +131,7 @@ (simple-lout-markup-writer >=) (define-macro (binary-lout-markup-writer sym lout-name) - `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout) + `(markup-writer ',(symbol-append 'eq: sym) (lookup-engine-class 'lout) :action (lambda (node engine) (let ((body (markup-body node))) (if (= (length body) 2) @@ -154,7 +153,7 @@ (binary-lout-markup-writer in "element") (binary-lout-markup-writer notin "notelement") -(markup-writer 'eq:apply (find-engine 'lout) +(markup-writer 'eq:apply (lookup-engine-class 'lout) :action (lambda (node engine) (let ((func (car (markup-body node)))) (output func engine) @@ -176,7 +175,7 @@ ;;; (define-macro (range-lout-markup-writer sym lout-name) - `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout) + `(markup-writer ',(symbol-append 'eq: sym) (lookup-engine-class 'lout) :action (lambda (node engine) (let ((from (markup-option node :from)) (to (markup-option node :to)) @@ -193,7 +192,7 @@ (range-lout-markup-writer sum "sum") (range-lout-markup-writer product "prod") -(markup-writer 'eq:script (find-engine 'lout) +(markup-writer 'eq:script (lookup-engine-class 'lout) :action (lambda (node engine) (let ((body (markup-body node)) (sup (markup-option node :sup)) diff --git a/src/guile/skribilo/package/pie.scm b/src/guile/skribilo/package/pie.scm index 8ccf858..c5ae84a 100644 --- a/src/guile/skribilo/package/pie.scm +++ b/src/guile/skribilo/package/pie.scm @@ -251,7 +251,7 @@ the string \"hello\". Implement `sliceweight' markups too." "\n") `("colors: " ,@colors "\n"))))) -(markup-writer 'pie (find-engine 'base) +(markup-writer 'pie (lookup-engine-class 'base) :action (lambda (node engine) (let* ((fmt (select-output-format engine)) (pie-file (string-append (markup-ident node) "." @@ -291,12 +291,12 @@ the string \"hello\". Implement `sliceweight' markups too." "A Pie Chart")) engine)))) -(markup-writer 'slice (find-engine 'base) +(markup-writer 'slice (lookup-engine-class 'base) :action (lambda (node engine) ;; Nothing to do here (error "slice: this writer should never be invoked"))) -(markup-writer 'sliceweight (find-engine 'base) +(markup-writer 'sliceweight (lookup-engine-class 'base) :action (lambda (node engine) ;; Nothing to do here. (error "sliceweight: this writer should never be invoked"))) @@ -306,7 +306,7 @@ the string \"hello\". Implement `sliceweight' markups too." ;;; Initialization. ;;; -(when-engine-is-loaded 'lout +(when-engine-class-is-loaded 'lout (lambda () (resolve-module '(skribilo package pie lout)))) diff --git a/src/guile/skribilo/package/pie/lout.scm b/src/guile/skribilo/package/pie/lout.scm index 61dbcb7..1841960 100644 --- a/src/guile/skribilo/package/pie/lout.scm +++ b/src/guile/skribilo/package/pie/lout.scm @@ -38,11 +38,11 @@ ;;; Helper functions. ;;; -(let ((lout (find-engine 'lout))) - (if lout - (engine-custom-set! lout 'includes - (string-append (engine-custom lout 'includes) - "\n@SysInclude { pie } # Pie Charts\n")))) +(when-engine-is-instantiated (lookup-engine-class 'lout) + (lambda (lout class) + (engine-custom-set! lout 'includes + (string-append (engine-custom lout 'includes) + "\n@SysInclude { pie }\n")))) @@ -50,7 +50,7 @@ ;;; Writers. ;;; -(markup-writer 'pie (find-engine 'lout) +(markup-writer 'pie (lookup-engine-class 'lout) :before (lambda (node engine) (let* ((weights (map (lambda (slice) (markup-option slice :weight)) @@ -102,7 +102,7 @@ (display "{\n"))) :after "\n} # @Pie\n") -(markup-writer 'slice (find-engine 'lout) +(markup-writer 'slice (lookup-engine-class 'lout) :options '(:weight :detach? :color) :action (lambda (node engine) (display " @Slice\n") @@ -120,7 +120,7 @@ (output (markup-body node) engine) (display " }\n"))) -(markup-writer 'sliceweight (find-engine 'base) +(markup-writer 'sliceweight (lookup-engine-class 'base) ;; This writer should work for every engine, provided the `pie' markup has ;; a proper `&total-weight' option. :action (lambda (node engine) diff --git a/src/guile/skribilo/package/slide.scm b/src/guile/skribilo/package/slide.scm index 380fdc5..12955ce 100644 --- a/src/guile/skribilo/package/slide.scm +++ b/src/guile/skribilo/package/slide.scm @@ -257,16 +257,16 @@ (format (current-error-port) "Slides initializing...~%") ;; Register specific implementations for lazy loading. -(when-engine-is-loaded 'base +(when-engine-class-is-loaded 'base (lambda () (resolve-module '(skribilo package slide base)))) -(when-engine-is-loaded 'latex +(when-engine-class-is-loaded 'latex (lambda () (resolve-module '(skribilo package slide latex)))) -(when-engine-is-loaded 'html +(when-engine-class-is-loaded 'html (lambda () (resolve-module '(skribilo package slide html)))) -(when-engine-is-loaded 'lout +(when-engine-class-is-loaded 'lout (lambda () (resolve-module '(skribilo package slide lout)))) diff --git a/src/guile/skribilo/package/slide/base.scm b/src/guile/skribilo/package/slide/base.scm index c8e652c..1d8d84c 100644 --- a/src/guile/skribilo/package/slide/base.scm +++ b/src/guile/skribilo/package/slide/base.scm @@ -40,7 +40,7 @@ ;;; ;;; Simple markups. ;;; -(let ((be (find-engine 'base))) +(let ((be (lookup-engine-class 'base))) ;; slide-pause (markup-writer 'slide-pause be @@ -164,7 +164,7 @@ engine))) -(markup-writer 'slide-topic (find-engine 'base) +(markup-writer 'slide-topic (lookup-engine-class 'base) :options '(:title :outline? :class :ident) :action (lambda (n e) (if (markup-option n :outline?) @@ -172,7 +172,7 @@ (output (markup-body n) e))) -(markup-writer 'slide-subtopic (find-engine 'base) +(markup-writer 'slide-subtopic (lookup-engine-class 'base) ;; FIXME: Largely untested. :options '(:title :outline? :class :ident) :action (lambda (n e) diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm index 118f294..787d9b9 100644 --- a/src/guile/skribilo/utils/compat.scm +++ b/src/guile/skribilo/utils/compat.scm @@ -35,6 +35,8 @@ :autoload (skribilo lib) (type-name) :autoload (skribilo resolve) (*document-being-resolved*) :autoload (skribilo output) (*document-being-output*) + :use-module ((skribilo engine) :renamer (symbol-prefix-proc 'orig:)) + :use-module ((skribilo writer) :renamer (symbol-prefix-proc 'orig:)) :use-module (skribilo debug) :re-export (file-size) ;; re-exported from `(skribilo utils files)' @@ -142,6 +144,7 @@ ("acmproc.skr" . (skribilo package acmproc)))) (define*-public (skribe-load file :rest args) + ;; FIXME: Convert the `:engine' arg to an engine class. (guard (c ((file-search-error? c) ;; Regular file loading failed. Try built-ins. (let ((mod-name (assoc-ref %skribe-known-files file))) @@ -178,6 +181,131 @@ (set! %skribe-reader (make-reader 'skribe))) (%skribe-reader port)) + +;;; +;;; Engines and engine classes. +;;; + +(define %per-class-current-engines + (make-hash-table)) + +(define (engine-class-singleton class) + (let ((e (hashq-ref %per-class-current-engines class))) + (if e + e + (let ((e (orig:make-engine class))) + (format (current-error-port) "e: ~a~%" e) + (hashq-set! %per-class-current-engines class e) + e)))) + +(define-public (find-engine class-name) + ;; The old `find-engine' gave the illusion of a single instance per engine + ;; class. + (let ((class (false-if-exception (orig:lookup-engine-class class-name)))) + (if class + (engine-class-singleton class) + #f))) + +(define (make-engine-compat-proc wrapped-engine-class-proc) + (lambda (e) + (if (orig:engine? e) + (wrapped-engine-class-proc (orig:engine-class e)) + (wrapped-engine-class-proc e)))) + +(define-public engine? + (make-engine-compat-proc orig:engine-class?)) +(define engine-format + (make-engine-compat-proc orig:engine-class-format)) +(define-public engine-customs + (make-engine-compat-proc orig:engine-class-customs)) +(define-public engine-filter + (make-engine-compat-proc orig:engine-class-filter)) +(define-public engine-symbol-table + (make-engine-compat-proc orig:engine-class-symbol-table)) + +(define-public (make-engine first-arg . args) + ;; The old-style `make-engine' should translate to a `make-engine-class'. + ;; Its `:delegate' argument should be an engine class rather than an + ;; engine. + + (define (rewrite-delegate-arg args) + (let loop ((args args) + (result '())) + (if (null? args) + (reverse! result) + (let ((arg (car args))) + (if (eq? arg :delegate) + (let ((delegate (cadr args))) + (loop (cddr args) + (cons* :delegate + (if (orig:engine? delegate) + (orig:engine-class delegate) + delegate) + result))) + (loop (cdr args) (cons arg result))))))) + + (if (symbol? first-arg) + (apply orig:make-engine-class first-arg (rewrite-delegate-arg args)) + (apply orig:make-engine-class first-arg args))) + +(define-public (markup-writer markup . args) + ;; In old-style `markup-writer', the first arg could (optionally) be an + ;; engine. Now, this must be (optionally) an engine class instead of an + ;; engine. + (if (null? args) + (apply orig:markup-writer markup args) + (let loop ((first-arg (car args))) + (if (orig:engine? first-arg) + (loop (orig:engine-class first-arg)) + (apply orig:markup-writer markup first-arg (cdr args)))))) + + +(define (ensure-engine engine-or-class) + (cond ((orig:engine-class? engine-or-class) + (engine-class-singleton engine-or-class)) + (else engine-or-class))) + +(define %default-engines '()) + +(define-public (default-engine) + (ensure-engine + (if (null? %default-engines) + (let* ((class (orig:default-engine-class)) + (engine (find-engine (orig:engine-class-ident class)))) + (set! %default-engine (list engine)) + engine) + (car %default-engines)))) + +(define-public (default-engine-set! e) + (let ((e (ensure-engine e))) + (format (current-error-port) "DEFAULT-ENGINE-SET! ~a~%" e) + (if (null? %default-engines) + (set! %default-engines (list e)) + (set-car! %default-engines e)) + e)) + +(define-public (push-default-engine e) + (let ((e (ensure-engine e))) + (set! %default-engines (cons e %default-engines)) + e)) + +(define-public (pop-default-engine) + (ensure-engine + (if (null? %default-engines) + (skribe-error 'pop-default-engine "empty stack" '()) + (let ((e (car %default-engines))) + (set! %default-engines (cdr %default-engines)) + e)))) + +(define-public (copy-engine ident e . args) + (cond ((engine? e) + (orig:copy-engine e)) + (else + (apply orig:copy-engine-class ident e args)))) + +(define-public engine-custom orig:engine-custom) +(define-public engine-custom-set! orig:engine-custom-set!) +(define-public engine-format? orig:engine-format?) ;;; diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm index 052b5cc..6b67156 100644 --- a/src/guile/skribilo/verify.scm +++ b/src/guile/skribilo/verify.scm @@ -127,7 +127,7 @@ (next-method) - (let ((w (lookup-markup-writer node e))) + (let ((w (lookup-markup-writer node (engine-class e)))) (when (writer? w) (check-required-options node w e) (when (pair? (writer-options w)) diff --git a/src/guile/skribilo/writer.scm b/src/guile/skribilo/writer.scm index b16819d..df12eaa 100644 --- a/src/guile/skribilo/writer.scm +++ b/src/guile/skribilo/writer.scm @@ -28,7 +28,8 @@ :use-module (skribilo utils syntax) :autoload (srfi srfi-1) (find filter) - :autoload (skribilo engine) (engine? engine-ident? default-engine)) + :autoload (skribilo engine) (engine-class? engine-ident + default-engine-class)) (use-modules (skribilo debug) @@ -133,13 +134,13 @@ (let ((e (or (if (and (list? engine) (not (keyword? (car engine)))) (car engine) #f) - (default-engine)))) + (default-engine-class)))) (cond ((and (not (symbol? markup)) (not (eq? markup #t))) (skribe-error 'markup-writer "illegal markup" markup)) - ((not (engine? e)) - (skribe-error 'markup-writer "illegal engine" e)) + ((not (engine-class? e)) + (skribe-error 'markup-writer "illegal engine class" e)) ((and (not predicate) (not class) (null? options) @@ -152,8 +153,9 @@ (ac (if (eq? action 'unspecified) (lambda (n e) (output (markup-body n) e)) action))) - (engine-add-writer! e markup m predicate - options before ac after class validate)))))) + (engine-class-add-writer! e markup m predicate + options before ac after + class validate)))))) @@ -162,8 +164,8 @@ ;;; (define (lookup-markup-writer node e) - ;; Find the writer that applies best to NODE. See also `markup-writer-get' - ;; and `markup-writer-get*'. + ;; Find the writer that applies best to NODE. E should be an engine class. + ;; See also `markup-writer-get' and `markup-writer-get*'. (define (matching-writer writers) (find (lambda (w) @@ -179,14 +181,14 @@ (or (matching-writer node-writers) (matching-writer (slot-ref e 'free-writers)) - (and (engine? delegate) + (and (engine-class? delegate) (lookup-markup-writer node delegate))))) (define* (markup-writer-get markup :optional engine :key (class #f) (pred #f)) - ;; Get a markup writer for MARKUP (a symbol) in ENGINE, with class CLASS - ;; and user predicate PRED. [FIXME: Useless since PRED is a procedure and - ;; therefore not comparable?] + ;; Get a markup writer for MARKUP (a symbol) in engine class ENGINE, with + ;; class CLASS and user predicate PRED. [FIXME: Useless since PRED is a + ;; procedure and therefore not comparable?] (define (matching-writer writers) (find (lambda (w) @@ -195,19 +197,19 @@ (eq? (slot-ref w 'upred) pred)))) writers)) - (let ((e (or engine (default-engine)))) + (let ((e (or engine (default-engine-class)))) (cond ((not (symbol? markup)) (skribe-error 'markup-writer-get "illegal symbol" markup)) - ((not (engine? e)) - (skribe-error 'markup-writer-get "illegal engine" e)) + ((not (engine-class? e)) + (skribe-error 'markup-writer-get "illegal engine class" e)) (else (let* ((writers (slot-ref e 'writers)) (markup-writers (hashq-ref writers markup '())) (delegate (slot-ref e 'delegate))) (or (matching-writer markup-writers) - (and (engine? delegate) + (and (engine-class? delegate) (markup-writer-get markup delegate :class class :pred pred)))))))) @@ -222,19 +224,19 @@ (equal? (writer-class w) class))) writers)) - (let ((e (or engine (default-engine)))) + (let ((e (or engine (default-engine-class)))) (cond ((not (symbol? markup)) (skribe-error 'markup-writer "illegal symbol" markup)) - ((not (engine? e)) - (skribe-error 'markup-writer "illegal engine" e)) + ((not (engine-class? e)) + (skribe-error 'markup-writer "illegal engine class" e)) (else (let* ((writers (slot-ref e 'writers)) (markup-writers (hashq-ref writers markup '())) (delegate (slot-ref e 'delegate))) (append (matching-writers writers) - (if (engine? delegate) + (if (engine-class? delegate) (markup-writer-get* markup delegate :class class) '()))))))) |