diff options
25 files changed, 700 insertions, 380 deletions
diff --git a/doc/modules/skribilo/documentation/api.scm b/doc/modules/skribilo/documentation/api.scm index 84108c9..d369b1a 100644 --- a/doc/modules/skribilo/documentation/api.scm +++ b/doc/modules/skribilo/documentation/api.scm @@ -27,7 +27,6 @@ :use-module (skribilo output) :use-module (skribilo lib) ;; `define-markup' :use-module (skribilo utils keywords) - :use-module (skribilo utils compat) :use-module (skribilo utils syntax) ;; `%skribilo-module-reader' :use-module (skribilo package base) @@ -44,7 +43,7 @@ ;*---------------------------------------------------------------------*/ ;* Html configuration */ ;*---------------------------------------------------------------------*/ -(let* ((he (find-engine 'html)) +(let* ((he (lookup-engine-class 'html)) (tro (markup-writer-get 'tr he))) (markup-writer 'tr he :class 'api-table-header @@ -71,7 +70,7 @@ ;*---------------------------------------------------------------------*/ ;* LaTeX configuration */ ;*---------------------------------------------------------------------*/ -(let* ((le (find-engine 'latex)) +(let* ((le (lookup-engine-class 'latex)) (tro (markup-writer-get 'tr le))) (markup-writer 'tr le :class 'api-table-prototype @@ -93,8 +92,8 @@ (define* (api-search-definition id file pred :optional (skribe-source? #t)) ;; If SKRIBE-SOURCE? is true, then assume Skribe syntax. Otherwise, use ;; the ``Skribilo module syntax''. - (let* ((path (append %load-path (skribe-path))) - (f (find-file/path file path)) + (let* ((path %load-path) + (f (search-path path file)) (read (if skribe-source? (make-reader 'skribe) %skribilo-module-reader))) (if (not (string? f)) @@ -371,7 +370,7 @@ (define (opt-engine-support opt) ;; find the engines providing a writer for id (map (lambda (e) - (let* ((id (engine-ident e)) + (let* ((id (engine-class-ident e)) (s (symbol->string id))) (if (engine-format? "latex") (list s " ") diff --git a/doc/modules/skribilo/documentation/env.scm b/doc/modules/skribilo/documentation/env.scm index 569f194..0510796 100644 --- a/doc/modules/skribilo/documentation/env.scm +++ b/doc/modules/skribilo/documentation/env.scm @@ -44,4 +44,5 @@ (define-public *disp-color* "#ccffcc") (define-public *header-color* "#cccccc") -(define-public *api-engines* (map find-engine '(html latex xml))) +(define-public *api-engines* (map lookup-engine-class + '(html lout latex xml))) diff --git a/doc/modules/skribilo/documentation/extension.scm b/doc/modules/skribilo/documentation/extension.scm index e012cb2..a7e5c20 100644 --- a/doc/modules/skribilo/documentation/extension.scm +++ b/doc/modules/skribilo/documentation/extension.scm @@ -29,7 +29,7 @@ ;* extension */ ;*---------------------------------------------------------------------*/ (define-markup (extension #!rest opt - #!key (ident (symbol->string (gensym 'extension))) + #!key (ident (symbol->string (gensym "extension"))) (class "extension") title html-title ending author description (env '())) diff --git a/doc/modules/skribilo/documentation/manual.scm b/doc/modules/skribilo/documentation/manual.scm index f2a6cdd..97501d8 100644 --- a/doc/modules/skribilo/documentation/manual.scm +++ b/doc/modules/skribilo/documentation/manual.scm @@ -26,8 +26,8 @@ :use-module (skribilo lib) ;; `define-markup' :use-module (skribilo resolve) :use-module (skribilo output) + :use-module (skribilo evaluator) :use-module (skribilo utils keywords) - :use-module (skribilo utils compat) :use-module (skribilo utils syntax) ;; `when' :use-module (skribilo documentation env) @@ -52,20 +52,20 @@ ;*---------------------------------------------------------------------*/ ;* Base configuration */ ;*---------------------------------------------------------------------*/ -(let ((be (find-engine 'base))) +(let ((be (lookup-engine-class 'base))) (markup-writer 'example be :options '(:legend :number) :action (lambda (n e) (let ((ident (markup-ident n)) (number (markup-option n :number)) (legend (markup-option n :legend))) - (skribe-eval (mark ident) e) - (skribe-eval (center - (markup-body n) - (if number - (bold (format #f "Ex. ~a: " number))) - legend) - e))))) + (evaluate-document (mark ident) e) + (evaluate-document + (center (markup-body n) + (if number + (bold (format #f "Ex. ~a: " number))) + legend) + e))))) ;*---------------------------------------------------------------------*/ ;* html-browsing-extra ... */ @@ -95,7 +95,7 @@ ;*---------------------------------------------------------------------*/ ;* Html configuration */ ;*---------------------------------------------------------------------*/ -(let* ((he (find-engine 'html)) +(let* ((he (lookup-engine-class 'html)) (bd (markup-writer-get 'bold he))) (markup-writer 'bold he :class 'api-proto-ident @@ -108,7 +108,7 @@ ;*---------------------------------------------------------------------*/ ;* LaTeX */ ;*---------------------------------------------------------------------*/ -(let* ((le (find-engine 'latex)) +(let* ((le (lookup-engine-class 'latex)) (opckg (engine-custom le 'usepackage)) (lpckg "\\usepackage{fullpage}\n\\usepackage{eurosym}\n") (npckg (if (string? opckg) @@ -190,7 +190,7 @@ (define-markup (example #!rest opts #!key legend class) (new container (markup 'example) - (ident (symbol->string (gensym 'example))) + (ident (symbol->string (gensym "example"))) (class class) (required-options '(:legend :number)) (options `((:number @@ -290,19 +290,19 @@ (pref (eq? (engine-custom e 'index-page-ref) #t)) (loc (ast-loc n)) ;; FIXME: Since we don't support - ;; `:&skribe-eval-location', we could set up a - ;; `parameterize' thing around `skribe-eval' to provide + ;; `:&evaluate-document-location', we could set up a + ;; `parameterize' thing around `evaluate-document' to provide ;; it with the right location information. (t (cond ((null? ie) "") ((or (not (integer? nc)) (= nc 1)) - (table :width 100. ;;:&skribe-eval-location loc + (table :width 100. ;;:&evaluate-document-location loc (make-column ie pref))) (else - (table :width 100. ;;:&skribe-eval-location loc + (table :width 100. ;;:&evaluate-document-location loc (make-sub-tables ie nc pref)))))) - (output (skribe-eval t e) e)))) + (evaluate-document t e)))) ;*---------------------------------------------------------------------*/ ;* compiler-command ... */ 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/doc/user/slide.skb b/doc/user/slide.skb index f937a75..35332f2 100644 --- a/doc/user/slide.skb +++ b/doc/user/slide.skb @@ -191,7 +191,8 @@ output format does not support embedded application.])) :options '(:title :ident :number :toc :vspace) :action dummy-slide-output) - (markup-writer 'slide-vspace + (markup-writer 'slide-vspace e + :options '(:alt) :action dummy-slide-vspace-output) (markup-writer 'slide-embed :options '(:command :arguments :alt) diff --git a/doc/user/user.skb b/doc/user/user.skb index 5cfe209..4a249fb 100644 --- a/doc/user/user.skb +++ b/doc/user/user.skb @@ -32,7 +32,8 @@ ;* Packages */ ;*---------------------------------------------------------------------*/ (use-modules (skribilo package eq) - (skribilo package pie)) + (skribilo package pie) + (skribilo package slide)) ;; Load the compile-time configuration file. (load "doc-config.scm") 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..b1e4235 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,75 +105,98 @@ (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> (<object>) + (customs :init-keyword :customs :init-value '()) + :metaclass <engine-class>) + + +(define %format format) +(define* (make-engine-class ident :key (version 'unspecified) + (format "raw") + (filter #f) + (delegate #f) + (symbol-table '()) + (custom '()) + (info '())) + ;; 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 + :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 (default-engine) - *default-engine*) - - -(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 (push-default-engine e) - (set! *default-engines* (cons e *default-engines*)) - (default-engine-set! e)) - -(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))))) - - -(define (processor-get-engine combinator newe olde) - (cond - ((procedure? combinator) - (combinator newe olde)) - ((engine? newe) - newe) - (else - olde))) +(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 (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 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) + ;; 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-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 @@ -170,31 +206,83 @@ (skribe-error 'engine-format? "no engine" e) (string=? fmt (engine-format e))))) + + ;;; -;;; MAKE-ENGINE +;;; Writers. ;;; -(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)) + +(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 (check-output name proc) + (and proc (or (string? proc) (check-procedure name proc 2)))) + + ;; + ;; 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)) + + ;; 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)) + + ;; 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)) ;;; ;;; 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 'customs (map 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 +300,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 +314,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." @@ -271,16 +364,17 @@ 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))))) -(define* (find-engine id :key (version 'unspecified)) - (false-if-exception (apply lookup-engine (list id version)))) - - - ;;; @@ -294,7 +388,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 +401,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 +453,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 711c179..9c1fdd2 100644 --- a/src/guile/skribilo/engine/base.scm +++ b/src/guile/skribilo/engine/base.scm @@ -19,17 +19,29 @@ ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, ;;; 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)) +(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) + :autoload (skribilo package base) (color) + :autoload (skribilo utils keywords) (list-split) + :autoload (skribilo biblio template) (make-bib-entry-template/default + output-bib-entry-template) + ;; 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") @@ -170,20 +182,20 @@ (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 ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&the-bibliography :before (lambda (n e) - (let ((w (markup-writer-get 'table e))) + (let ((w (markup-writer-get 'table (engine-class e)))) (and (writer? w) (invoke (writer-before w) n e)))) :action (lambda (n e) (when (pair? (markup-body n)) (for-each (lambda (i) (output i e)) (markup-body n)))) :after (lambda (n e) - (let ((w (markup-writer-get 'table e))) + (let ((w (markup-writer-get 'table (engine-class e)))) (and (writer? w) (invoke (writer-after w) n e))))) ;*---------------------------------------------------------------------*/ @@ -192,23 +204,28 @@ (markup-writer '&bib-entry :options '(:title) :before (lambda (n e) - (invoke (writer-before (markup-writer-get 'tr e)) n e)) + (invoke (writer-before (markup-writer-get 'tr + (engine-class e))) + n e)) :action (lambda (n e) - (let ((wtc (markup-writer-get 'tc e))) + (let ((wtc (markup-writer-get 'tc (engine-class e)))) ;; the label (markup-option-add! n :valign 'top) (markup-option-add! n :align 'right) (invoke (writer-before wtc) n e) - (output n e (markup-writer-get '&bib-entry-label e)) + (output n e (markup-writer-get '&bib-entry-label + (engine-class e))) (invoke (writer-after wtc) n e) ;; the body (markup-option-add! n :valign 'top) (markup-option-add! n :align 'left) (invoke (writer-before wtc) n e) - (output n e (markup-writer-get '&bib-entry-body)) + (output n e (markup-writer-get '&bib-entry-body + (engine-class e))) (invoke (writer-after wtc) n e))) :after (lambda (n e) - (invoke (writer-after (markup-writer-get 'tr e)) n e))) + (invoke (writer-after (markup-writer-get 'tr (engine-class e))) + n e))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-label ... */ @@ -234,7 +251,7 @@ (markup-writer '&bib-entry-url :action (lambda (n e) (let ((url (markup-body n))) - (skribe-eval + (evaluate-document (ref :text (it url) :url url) e)))) ;*---------------------------------------------------------------------*/ @@ -258,7 +275,7 @@ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-title :action (lambda (n e) - (skribe-eval (markup-body n)) e)) + (evaluate-document (bold (markup-body n)) e))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-booktitle ... */ @@ -266,21 +283,21 @@ (markup-writer '&bib-entry-booktitle :action (lambda (n e) (let ((title (markup-body n))) - (skribe-eval (it title) e)))) + (evaluate-document (it title) e)))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-journal ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-journal :action (lambda (n e) - (skribe-eval (it (markup-body n)) e))) + (evaluate-document (it (markup-body n)) e))) ;*---------------------------------------------------------------------*/ ;* &bib-entry-publisher ... */ ;*---------------------------------------------------------------------*/ (markup-writer '&bib-entry-publisher :action (lambda (n e) - (skribe-eval (markup-body n) e))) + (evaluate-document (it (markup-body n)) e))) ;*---------------------------------------------------------------------*/ ;* &the-index ... @label the-index@ */ @@ -400,7 +417,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 ... */ @@ -418,7 +435,7 @@ :before (lambda (n e) (let ((num (markup-option n :number))) (if (number? num) - (skribe-eval + (evaluate-document (it (string-append (string-pad (number->string num) 3) ": ")) e)))) @@ -432,11 +449,5 @@ :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)))) -;;;; A VIRER (mais handle-body n'est pas défini) -(markup-writer 'line-ref - :options '(:offset) - :action #f) diff --git a/src/guile/skribilo/evaluator.scm b/src/guile/skribilo/evaluator.scm index 8502d51..3297cc7 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) @@ -58,18 +59,17 @@ ;;; %EVALUATE ;;; (define (%evaluate expr) - ;; Evaluate EXPR, an arbitrary S-expression that may contain calls to the - ;; markup functions defined in a markup package such as - ;; `(skribilo package base)', e.g., `(bold "hello")'. - (let ((result (eval expr (*skribilo-user-module*)))) - + ;; Evaluate EXPR in the current module. EXPR is an arbitrary S-expression + ;; that may contain calls to the markup functions defined in a markup + ;; package such as `(skribilo package base)', e.g., `(bold "hello")'. + (let ((result (eval expr (current-module)))) (if (ast? result) - (let ((file (source-property expr 'filename)) - (line (source-property expr 'line)) - (column (source-property expr 'column))) - (slot-set! result 'loc - (make <location> - :file file :line line :pos column)))) + (let ((file (source-property expr 'filename)) + (line (source-property expr 'line)) + (column (source-property expr 'column))) + (slot-set! result 'loc + (make <location> + :file file :line line :pos column)))) result)) @@ -99,16 +99,25 @@ (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) - (let loop ((exp (reader port))) - (with-debug 10 'evaluate-document-from-port - (debug-item "exp=" exp)) - (unless (eof-object? exp) - (evaluate-document (%evaluate exp) e :env env) - (loop (reader port)))))))) + (save-module-excursion + (lambda () + (with-debug 10 'evaluate-document-from-port + (debug-item "exp=" exp)) + (set-current-module (*skribilo-user-module*)) + + (let loop ((exp (reader port))) + (if (eof-object? exp) + (evaluate-document (%evaluate exp) e :env env) + (begin + (evaluate-document (%evaluate exp) e :env env) + (loop (reader port))))))))))) + ;;; @@ -123,7 +132,7 @@ (define* (load-document file :key (engine #f) (path #f) :allow-other-keys :rest opt) - (with-debug 4 'skribe-load + (with-debug 4 'load-document (debug-item " engine=" engine) (debug-item " path=" path) (debug-item " opt=" opt) @@ -138,15 +147,7 @@ (argument path))))) (else path)) %load-path)) - (filep (or (search-path path file) - (search-path (append path %load-path) file) - (search-path (append path %load-path) - (let ((dot (string-rindex file #\.))) - (if dot - (string-append - (string-take file dot) - ".scm") - file)))))) + (filep (search-path path file))) (unless (and (string? filep) (file-exists? filep)) (raise (condition (&file-search-error @@ -177,7 +178,8 @@ ;;; INCLUDE-DOCUMENT ;;; (define* (include-document file :key (path (*document-path*)) - (reader (*document-reader*))) + (reader (*document-reader*)) + (module (current-module))) (unless (every string? path) (raise (condition (&invalid-argument-error (proc-name 'include-document) (argument path))))) @@ -193,11 +195,15 @@ (with-input-from-file full-path (lambda () - (let Loop ((exp (reader (current-input-port))) - (res '())) - (if (eof-object? exp) - (if (and (pair? res) (null? (cdr res))) - (car res) - (reverse! res)) - (Loop (reader (current-input-port)) - (cons (%evaluate exp) res)))))))) + (save-module-excursion + (lambda () + (set-current-module module) + + (let Loop ((exp (reader (current-input-port))) + (res '())) + (if (eof-object? exp) + (if (and (pair? res) (null? (cdr res))) + (car res) + (reverse! res)) + (Loop (reader (current-input-port)) + (cons (%evaluate exp) res)))))))))) 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..a056c55 100644 --- a/src/guile/skribilo/output.scm +++ b/src/guile/skribilo/output.scm @@ -21,9 +21,10 @@ (define-module (skribilo output) - :autoload (skribilo engine) (engine-ident processor-get-engine) :autoload (skribilo writer) (writer? writer-ident lookup-markup-writer) :autoload (skribilo location) (location?) + :autoload (skribilo engine) (engine-class engine-ident engine-filter) + :use-module (skribilo ast) :use-module (skribilo debug) :use-module (skribilo utils syntax) @@ -146,7 +147,7 @@ (define-method (out (node <string>) e) - (let ((f (slot-ref e 'filter))) + (let ((f (engine-filter e))) (if (procedure? f) (display (f node)) (display node)))) @@ -222,7 +223,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/base.scm b/src/guile/skribilo/package/base.scm index 01e8667..b904ed8 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) (*bib-table* resolve-bib @@ -63,7 +63,7 @@ (define-markup (include file) (if (not (string? file)) (skribe-error 'include "Illegal file (string expected)" file) - (include-document file))) + (include-document file :module (current-module)))) ;*---------------------------------------------------------------------*/ ;* document ... */ @@ -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/eq.scm b/src/guile/skribilo/package/eq.scm index cadc1ba..821840f 100644 --- a/src/guile/skribilo/package/eq.scm +++ b/src/guile/skribilo/package/eq.scm @@ -336,7 +336,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., ;;; -(markup-writer 'eq-display (find-engine 'base) +(markup-writer 'eq-display (lookup-engine-class 'base) :action (lambda (node engine) (for-each (lambda (node) (let ((eq? (is-markup? node 'eq))) @@ -345,7 +345,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (if eq? (output (linebreak) engine)))) (markup-body node)))) -(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 @@ -364,7 +364,9 @@ 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 + (make-engine + (lookup-engine-class 'lout))))))) (output (lout-illustration :ident (markup-ident node) lout-code) @@ -380,7 +382,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) @@ -422,14 +424,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) @@ -446,7 +448,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) @@ -460,7 +462,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) @@ -475,7 +477,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))) @@ -488,7 +490,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))) @@ -501,7 +503,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)) @@ -510,7 +512,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (output (sup sup*) engine) (output (sub sub*) engine)))) -(markup-writer 'eq:limit (find-engine 'base) +(markup-writer 'eq:limit (lookup-engine-class 'base) :action (lambda (node engine) (let ((body (markup-body node)) (var (markup-option node :var)) @@ -523,7 +525,7 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (output body engine) (display ")")))) -(markup-writer 'eq:combinations (find-engine 'base) +(markup-writer 'eq:combinations (lookup-engine-class 'base) :action (lambda (node engine) (let ((of (markup-option node :of)) (among (markup-option node :among))) @@ -539,7 +541,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 21e8f92..cc305f1 100644 --- a/src/guile/skribilo/package/eq/lout.scm +++ b/src/guile/skribilo/package/eq/lout.scm @@ -37,25 +37,24 @@ ;;; 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"))))) ;;; ;;; Simple markup writers. ;;; -(markup-writer 'eq-display (find-engine 'lout) +(markup-writer 'eq-display (lookup-engine-class 'lout) :before "\n@BeginAlignedDisplays\n" :after "\n@EndAlignedDisplays\n") -(markup-writer 'eq (find-engine 'lout) +(markup-writer 'eq (lookup-engine-class 'lout) :options '(:inline? :align-with :div-style :mul-style) :before (lambda (node engine) (let* ((parent (ast-parent node)) @@ -113,7 +112,8 @@ `(if need-paren? %right-paren "") ""))) - `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout) + `(markup-writer ',(symbol-append 'eq: sym) + (lookup-engine-class 'lout) :action (lambda (node engine) (let* ((lout-name ,(if (string? lout-name) lout-name @@ -188,7 +188,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) @@ -210,7 +210,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) @@ -226,7 +226,7 @@ (display %right-paren)))) -(markup-writer 'eq:limit (find-engine 'lout) +(markup-writer 'eq:limit (lookup-engine-class 'lout) :action (lambda (node engine) (let ((body (markup-body node)) (var (markup-option node :var)) @@ -239,7 +239,7 @@ (output body engine) (display (string-append %right-paren " } "))))) -(markup-writer 'eq:combinations (find-engine 'lout) +(markup-writer 'eq:combinations (lookup-engine-class 'lout) :action (lambda (node engine) (let ((of (markup-option node :of)) (among (markup-option node :among))) @@ -256,7 +256,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)) @@ -273,7 +273,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 898f105..fbdf912 100644 --- a/src/guile/skribilo/package/slide.scm +++ b/src/guile/skribilo/package/slide.scm @@ -20,13 +20,29 @@ ;;; 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) + :autoload (skribilo utils keywords) (the-options the-body) + + :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 +65,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)) @@ -232,7 +248,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")))) (class class) (options `((:outline? ,outline?) ,@(the-options opt :outline? :class))) @@ -247,7 +263,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")))) (class class) (options `((:outline? ,outline?) ,@(the-options opt :outline? :class))) @@ -262,16 +278,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 1eeb25f..0686a7c 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/package/slide/html.scm b/src/guile/skribilo/package/slide/html.scm index 024e1fd..9a5148d 100644 --- a/src/guile/skribilo/package/slide/html.scm +++ b/src/guile/skribilo/package/slide/html.scm @@ -38,7 +38,7 @@ (define-public (%slide-html-initialize!) - (let ((he (find-engine 'html))) + (let ((he (lookup-engine-class 'html))) (display "HTML slides setup...\n" (current-error-port)) ;; &html-page-title @@ -141,7 +141,7 @@ ;;; Slide topics/subtopics. ;;; -(markup-writer 'slide-topic (find-engine 'html) +(markup-writer 'slide-topic (lookup-engine-class 'html) :options '(:title :outline? :class :ident) :action (lambda (n e) (let ((title (markup-option n :title)) diff --git a/src/guile/skribilo/package/slide/lout.scm b/src/guile/skribilo/package/slide/lout.scm index f3c9a61..6597442 100644 --- a/src/guile/skribilo/package/slide/lout.scm +++ b/src/guile/skribilo/package/slide/lout.scm @@ -49,7 +49,7 @@ (format (current-error-port) "Lout slides setup...~%") -(let ((le (find-engine 'lout))) +(let ((le (lookup-engine-class 'lout))) ;; FIXME: Automatically switching to `slides' is problematic, e.g., for the ;; user manual which embeds slides. @@ -145,7 +145,7 @@ ;;; Customs for a nice handling of topics/subtopics. ;;; -(let ((lout (find-engine 'lout))) +(let ((lout (lookup-engine-class 'lout))) (if lout (begin (engine-custom-set! lout 'pdf-bookmark-node-pred diff --git a/src/guile/skribilo/utils/compat.scm b/src/guile/skribilo/utils/compat.scm index 4905cef..1142142 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:)) :autoload (skribilo biblio) (*bib-table* open-bib-file) :use-module (skribilo debug) @@ -143,6 +145,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))) @@ -153,7 +156,7 @@ " skribe-load: `~a' -> `~a'~%" file mod-name)) (let ((mod (false-if-exception - (resolve-module mod-name)))) + (resolve-interface mod-name)))) (if (not mod) (raise c) (begin @@ -179,6 +182,151 @@ (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* (if (orig:engine? delegate) + (orig:engine-class delegate) + 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 (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-engines (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-ident orig:engine-ident) +(define-public engine-custom orig:engine-custom) +(define-public engine-custom-set! orig:engine-custom-set!) +(define-public engine-format? orig:engine-format?) + + +;;; +;;; Writers. +;;; + +(define-public (markup-writer markup . args) + ;; In old-style `markup-writer', the second 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)) + (rest (cdr args))) + (cond ((orig:engine? first-arg) + (loop (orig:engine-class first-arg) rest)) + ((orig:engine-class? first-arg) + (apply orig:markup-writer markup first-arg rest)) + (else + ;; FIRST-ARG does not specify an engine: keep it and use the + ;; current default engine. + (loop (default-engine) (cons first-arg rest))))))) + +(define*-public (markup-writer-get markup :optional engine :key (class #f) + (pred #f)) + (let ((eclass (if (orig:engine? engine) + (orig:engine-class engine) + (orig:engine-class (default-engine))))) + (orig:markup-writer-get markup eclass + :class class :pred pred))) ;;; diff --git a/src/guile/skribilo/verify.scm b/src/guile/skribilo/verify.scm index 052b5cc..60ef519 100644 --- a/src/guile/skribilo/verify.scm +++ b/src/guile/skribilo/verify.scm @@ -20,16 +20,19 @@ ;;; USA. (define-module (skribilo verify) - :autoload (skribilo engine) (engine-ident processor-get-engine) + :autoload (skribilo engine) (engine-ident engine-class processor-get-engine) :autoload (skribilo writer) (writer? writer-options lookup-markup-writer) :autoload (skribilo lib) (skribe-warning/ast skribe-warning skribe-error) + + :use-module (skribilo debug) + :use-module (skribilo ast) + :use-module (oop goops) + + :use-module (skribilo utils syntax) + :export (verify)) -(use-modules (skribilo debug) - (skribilo ast) - (skribilo utils syntax) - (oop goops)) (fluid-set! current-reader %skribilo-module-reader) @@ -127,7 +130,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) '()))))))) |