Moved the STkLos and Bigloo code to `legacy'.

Moved the STkLos and Bigloo code from `src' to `legacy'.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9

1 files changed, 0 insertions, 262 deletions

diff --git a/src/bigloo/engine.scm b/src/bigloo/engine.scm
deleted file mode 100644
index bd8a027..0000000
--- a/src/bigloo/engine.scm
+++ /dev/null
@@ -1,262 +0,0 @@
-;*=====================================================================*/
-;*    serrano/prgm/project/skribe/src/bigloo/engine.scm                */
-;*    -------------------------------------------------------------    */
-;*    Author      :  Manuel Serrano                                    */
-;*    Creation    :  Tue Sep  9 08:01:30 2003                          */
-;*    Last change :  Fri May 21 16:12:32 2004 (serrano)                */
-;*    Copyright   :  2003-04 Manuel Serrano                            */
-;*    -------------------------------------------------------------    */
-;*    Skribe engines                                                   */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;*    The module                                                       */
-;*---------------------------------------------------------------------*/
-(module skribe_engine
-   
-   (option  (set! dsssl-symbol->keyword 
-		  (lambda (s)
-		     (string->keyword
-		      (string-append ":" (symbol->string s))))))
-   
-   (include "debug.sch")
-   
-   (import  skribe_types
-	    skribe_eval
-	    skribe_param
-	    skribe_output)
-   
-   (export  (make-engine::%engine ::symbol #!key v fmt in fi cu st if)
-	    (copy-engine::%engine ::symbol ::%engine #!key v in fi cu st)
-	    (find-engine ::symbol #!key version)
-
-	    (default-engine::obj)
-	    (default-engine-set! ::%engine)
-	    (push-default-engine ::%engine)
-	    (pop-default-engine)
-
-	    (processor-get-engine ::obj ::obj ::%engine)
-	    
-	    (engine-format? ::bstring . e)
-
-	    (engine-custom::obj ::%engine ::symbol)
-	    (engine-custom-set! ::%engine ::symbol ::obj)
-
-	    (engine-add-writer! ::%engine ::obj ::procedure ::obj
-				::obj ::obj ::obj ::obj ::obj ::obj)))
-   
-;*---------------------------------------------------------------------*/
-;*    *engines* ...                                                    */
-;*---------------------------------------------------------------------*/
-(define *engines* '())
-
-;*---------------------------------------------------------------------*/
-;*    *default-engine* ...                                             */
-;*---------------------------------------------------------------------*/
-(define *default-engine* #f)
-(define *default-engines* '())
-
-;*---------------------------------------------------------------------*/
-;*    default-engine-set! ...                                          */
-;*---------------------------------------------------------------------*/
-(define (default-engine-set! e)
-   (if (not (engine? e))
-       (skribe-type-error 'default-engine-set! "engine" e (find-runtime-type e))
-       (begin
-	  (set! *default-engine* e)
-	  (set! *default-engines* (cons *default-engine* *default-engines*))
-	  e)))
-
-;*---------------------------------------------------------------------*/
-;*    default-engine ...                                               */
-;*---------------------------------------------------------------------*/
-(define (default-engine)
-   *default-engine*)
-
-;*---------------------------------------------------------------------*/
-;*    push-default-engine ...                                          */
-;*---------------------------------------------------------------------*/
-(define (push-default-engine e)
-   (set! *default-engines* (cons e *default-engines*))
-   (default-engine-set! e))
-
-;*---------------------------------------------------------------------*/
-;*    pop-default-engine ...                                           */
-;*---------------------------------------------------------------------*/
-(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)))))
-
-;*---------------------------------------------------------------------*/
-;*    processor-get-engine ...                                         */
-;*---------------------------------------------------------------------*/
-(define (processor-get-engine combinator newe olde)
-   (cond
-      ((procedure? combinator)
-       (combinator newe olde))
-      ((engine? newe)
-       newe)
-      (else
-       olde)))
-
-;*---------------------------------------------------------------------*/
-;*    engine-format? ...                                               */
-;*---------------------------------------------------------------------*/
-(define (engine-format? fmt . e)
-   (let ((e (cond
-	       ((pair? e) (car e))
-	       ((%engine? *skribe-engine*) *skribe-engine*)
-	       (else (find-engine *skribe-engine*)))))
-      (if (not (%engine? e))
-	  (skribe-error 'engine-format? "No engine" e)
-	  (string=? fmt (%engine-format e)))))
-
-;*---------------------------------------------------------------------*/
-;*    make-engine ...                                                  */
-;*---------------------------------------------------------------------*/
-(define (make-engine ident
-		     #!key
-		     (version #unspecified)
-		     (format "raw")
-		     (filter #f)
-		     (delegate #f)
-		     (symbol-table '())
-		     (custom '())
-		     (info '()))
-   (let ((e (instantiate::%engine
-	       (ident ident)
-	       (version version)
-	       (format format)
-	       (filter filter)
-	       (delegate delegate)
-	       (symbol-table symbol-table)
-	       (customs custom)
-	       (info info))))
-      ;; store the engine in the global table
-      (set! *engines* (cons e *engines*))
-      ;; return it
-      e))
-
-;*---------------------------------------------------------------------*/
-;*    copy-engine ...                                                  */
-;*---------------------------------------------------------------------*/
-(define (copy-engine ident
-		     e
-		     #!key
-		     (version #unspecified)
-		     (filter #f)
-		     (delegate #f)
-		     (symbol-table #f)
-		     (custom #f))
-   (let ((e (duplicate::%engine e
-	       (ident ident)
-	       (version version)
-	       (filter (or filter (%engine-filter e)))
-	       (delegate (or delegate (%engine-delegate e)))
-	       (symbol-table (or symbol-table (%engine-symbol-table e)))
-	       (customs (or custom (%engine-customs e))))))
-      (set! *engines* (cons e *engines*))
-      e))
-
-;*---------------------------------------------------------------------*/
-;*    find-loaded-engine ...                                           */
-;*---------------------------------------------------------------------*/
-(define (find-loaded-engine id version)
-   (let loop ((es *engines*))
-      (cond
-	 ((null? es)
-	  #f)
-	 ((eq? (%engine-ident (car es)) id)
-	  (cond
-	     ((eq? version #unspecified)
-	      (car es))
-	     ((eq? version (%engine-version (car es)))
-	      (car es))
-	     (else
-	      (loop (cdr es)))))
-	 (else
-	  (loop (cdr es))))))
-
-;*---------------------------------------------------------------------*/
-;*    find-engine ...                                                  */
-;*---------------------------------------------------------------------*/
-(define (find-engine id #!key (version #unspecified))
-   (with-debug 5 'find-engine
-      (debug-item "id=" id " version=" version)
-      (or (find-loaded-engine id version)
-	  (let ((c (assq id *skribe-auto-load-alist*)))
-	     (debug-item "c=" c)
-	     (if (and (pair? c) (string? (cdr c)))
-		 (begin
-		    (skribe-load (cdr c) :engine 'base)
-		    (find-loaded-engine id version))
-		 #f)))))
-
-;*---------------------------------------------------------------------*/
-;*    engine-custom ...                                                */
-;*---------------------------------------------------------------------*/
-(define (engine-custom e id)
-   (with-access::%engine e (customs)
-      (let ((c (assq id customs)))
-	 (if (pair? c)
-	     (cadr c)
-	     #unspecified))))
-
-;*---------------------------------------------------------------------*/
-;*    engine-custom-set! ...                                           */
-;*---------------------------------------------------------------------*/
-(define (engine-custom-set! e id val)
-   (with-access::%engine e (customs)
-      (let ((c (assq id customs)))
-	 (if (pair? c)
-	     (set-car! (cdr c) val)
-	     (set! customs (cons (list id val) customs))))))
-
-;*---------------------------------------------------------------------*/
-;*    engine-add-writer! ...                                           */
-;*---------------------------------------------------------------------*/
-(define (engine-add-writer! e id pred upred opt before action after class va)
-   ;; check the arity of a procedure
-   (define (check-procedure name proc arity)
-      (cond
-	 ((not (procedure? proc))
-	  (skribe-error id "Illegal procedure" proc))
-	 ((not (correct-arity? proc arity))
-	  (skribe-error id
-			(string-append "Illegal `" name "'procedure")
-			proc))))
-   (define (check-output name proc)
-      (and proc (or (string? proc) (check-procedure name proc 2))))
-   ;; check the engine
-   (if (not (engine? e))
-       (skribe-error id "Illegal engine" e))
-   ;; check the options
-   (if (not (or (eq? opt 'all) (list? opt)))
-       (skribe-error id "Illegal options" opt))
-   ;; check the correctness of the predicate and the validator
-   (check-procedure "predicate" pred 2)
-   (when va (check-procedure "validate" va 2))
-   ;; check the correctness of the three actions
-   (check-output "before" before)
-   (check-output "action" action)
-   (check-output "after" after)
-   ;; create a new writer...
-   (let ((n (instantiate::%writer
-	       (ident (if (symbol? id) id 'all))
-	       (class class)
-	       (pred pred)
-	       (upred upred)
-	       (options opt)
-	       (before before)
-	       (action action)
-	       (after after)
-	       (validate va))))
-      ;; ...and bind it
-      (with-access::%engine e (writers)
-	 (set! writers (cons n writers))
-	 n)))