diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/guile/skribilo/engine.scm | 47 |
1 files changed, 25 insertions, 22 deletions
diff --git a/src/guile/skribilo/engine.scm b/src/guile/skribilo/engine.scm index 0622e11..163fe06 100644 --- a/src/guile/skribilo/engine.scm +++ b/src/guile/skribilo/engine.scm @@ -107,23 +107,10 @@ (customs :init-keyword :custom :init-value '()) (symbol-table :init-keyword :symbol-table :init-value '())) -(define-class <engine> () +(define-class <engine> (<object>) (customs :init-keyword :customs :init-value '()) :metaclass <engine-class>) -(define-method (compute-cpl (class <engine-class>)) - ;; Automatically set the class precedence list of <engine> subclasses. - (format (current-error-port) "computing CPL for ~a~%" class) - (list class <engine> <top>)) - -(define-method (initialize (engine-class <engine-class>) . args) - ;; Set the name of <engine> subclasses. - (let ((result (next-method)) - (ident (slot-ref engine-class 'ident))) - (slot-set! engine-class 'name - (symbol-append '<engine: ident '>)) - result)) - (define %format format) (define* (make-engine-class ident :key (version 'unspecified) @@ -133,7 +120,11 @@ (symbol-table '()) (custom '()) (info '())) - (let ((e (make <engine-class> + ;; We use `make-class' from `(oop goops)' (currently undocumented). + (let ((e (make-class (list <engine>) '() + :metaclass <engine-class> + :name (symbol-append '<engine: ident '>) + :ident ident :version version :format format :filter filter :delegate delegate :symbol-table symbol-table @@ -169,27 +160,34 @@ (define (engine? obj) (is-a? obj <engine>)) +(define (engine-class e) + (and (engine? e) (class-of e))) + ;; A mapping of engine classes to hooks. (define %engine-instantiate-hook (make-hash-table)) -(define-method (initialize (engine <engine>) . args) - (format (current-error-port) "initializing engine ~a~%" engine) - engine) - (define-method (make-instance (class <engine-class>) . args) + (define (initialize-engine! engine) + ;; Automatically initialize the `customs' slot of the newly created + ;; engine. + (let ((init-values (engine-class-customs class))) + (slot-set! engine 'customs (map list-copy init-values)) + engine)) + (format #t "making engine of class ~a~%" class) (let ((engine (next-method))) (if (engine? engine) - (let ((hook (hashq-ref %engine-instantiate-hook engine-class))) + (let ((hook (hashq-ref %engine-instantiate-hook class))) (format (current-error-port) "engine made: ~a~%" engine) + (initialize-engine! engine) (if (hook? hook) (run-hook hook engine class)) engine) engine))) (define (make-engine engine-class) - (make engine-class - :customs (list-copy (slot-ref engine-class 'customs)))) + (make engine-class)) + ;; Convenience functions. @@ -209,6 +207,11 @@ (string=? fmt (engine-format e))))) + +;;; +;;; Writers. +;;; + (define (engine-class-add-writer! e ident pred upred opt before action after class valid) ;; Add a writer to engine class E. If IDENT is a symbol, then it should |