about summary refs log tree commit diff
path: root/src/stklos/engine.stk
diff options
context:
space:
mode:
authorLudovic Court`es2005-11-02 10:08:38 +0000
committerLudovic Court`es2005-11-02 10:08:38 +0000
commitb76d5e1b252967521f210eac10ddbf089dde8c6a (patch)
tree00fc81c51256991c04799d79a749bbdd5b9fad30 /src/stklos/engine.stk
parentba63b8d4780428d9f63f6ace7f49361b77401112 (diff)
parentf553cb65b157b6df9563cefa593902d59301461b (diff)
downloadskribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.gz
skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.tar.lz
skribilo-b76d5e1b252967521f210eac10ddbf089dde8c6a.zip
Cleaned up the source tree and the installation process.
Patches applied:

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-6
   Cosmetic changes.

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-7
   Removed useless files, integrated packages.

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-8
   Removed useless files, integrated packages.

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-9
   Moved the STkLos and Bigloo code to `legacy'.

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-10
   Installed Autoconf/Automake machinery.  Fixed a few things.

 * lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-11
   Changes related to source-highlighting and to the manual.


git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-10
Diffstat (limited to 'src/stklos/engine.stk')
-rw-r--r--src/stklos/engine.stk242
1 files changed, 0 insertions, 242 deletions
diff --git a/src/stklos/engine.stk b/src/stklos/engine.stk
deleted file mode 100644
index a13ed0f..0000000
--- a/src/stklos/engine.stk
+++ /dev/null
@@ -1,242 +0,0 @@
-;;;;
-;;;; engines.stk	-- Skribe Engines Stuff
-;;;; 
-;;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
-;;;; 
-;;;; 
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2 of the License, or
-;;;; (at your option) any later version.
-;;;; 
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;; 
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this program; if not, write to the Free Software
-;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 
-;;;; USA.
-;;;; 
-;;;;           Author: Erick Gallesio [eg@essi.fr]
-;;;;    Creation date: 24-Jul-2003 20:33 (eg)
-;;;; Last file update: 28-Oct-2004 21:21 (eg)
-;;;;
-
-(define-module SKRIBE-ENGINE-MODULE
-  (import SKRIBE-DEBUG-MODULE SKRIBE-EVAL-MODULE)
- 
-  (export default-engine default-engine-set!
-	  make-engine copy-engine find-engine
-	  engine-custom engine-custom-set!
-	  engine-format? engine-add-writer!
-	  processor-get-engine
-	  push-default-engine pop-default-engine)
-)
-
-;;; Module definition is split here because this file is read by the documentation
-;;; Should be changed.
-(select-module SKRIBE-ENGINE-MODULE)
-
-(define *engines*		'())
-(define *default-engine* 	#f)
-(define *default-engines* 	'())
-
-
-(define (default-engine)
-   *default-engine*)
-
-
-(define (default-engine-set! e)
-  (unless (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-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 (make <engine> :ident ident :version version :format format
-		 	  :filter filter :delegate delegate
-			  :symbol-table symbol-table
-			  :custom 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 ((new (shallow-clone e)))
-    (slot-set! new 'ident 	 ident)
-    (slot-set! new 'version 	 version)
-    (slot-set! new 'filter	 (or filter (slot-ref e 'filter)))
-    (slot-set! new 'delegate	 (or delegate (slot-ref e 'delegate)))
-    (slot-set! new 'symbol-table (or symbol-table (slot-ref e 'symbol-table)))
-    (slot-set! new 'customs	 (or custom (slot-ref e 'customs)))
-
-    (set! *engines* (cons new *engines*))
-    new))
-
-
-;;;
-;;; 	FIND-ENGINE
-;;;
-(define (%find-loaded-engine id version)
-  (let Loop ((es *engines*))
-    (cond
-      ((null? es) #f)
-      ((eq? (slot-ref (car es) 'ident) id)
-       (cond
-	   ((eq? version 'unspecified) 		       (car es))
-	   ((eq? version (slot-ref (car es) 'version)) (car es))
-	   (else			 	       (Loop (cdr es)))))
-      (else (loop (cdr es))))))
-
-
-(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 c (string? (cdr c)))
-	       (begin
-		 (skribe-load (cdr c) :engine 'base)
-		 (%find-loaded-engine id version))
-	       #f)))))
-
-;;;
-;;; ENGINE-CUSTOM
-;;;
-(define (engine-custom e id)
-  (let* ((customs (slot-ref e 'customs))
-	 (c       (assq id customs)))
-    (if (pair? c)
-	(cadr c)
-	'unspecified)))
-
-
-;;;
-;;; ENGINE-CUSTOM-SET!
-;;;
-(define (engine-custom-set! e id val)
-  (let* ((customs (slot-ref e 'customs))
-	 (c       (assq id customs)))
-    (if (pair? c)
-	(set-car! (cdr c) val)
-	(slot-set! e 'customs (cons (list id val) customs)))))
-
-
-;;;
-;;; ENGINE-ADD-WRITER!
-;;;
-(define (engine-add-writer! e ident pred upred opt before action after class valid)
-  (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
-  ;;
-  (unless (is-a? e <engine>)
-    (skribe-error ident "Illegal engine" e))
-  
-  ;; check the options
-  (unless (or (eq? opt 'all) (list? opt))
-    (skribe-error ident "Illegal options" opt))
-  
-  ;; check the correctness of the predicate
-  (check-procedure "predicate" pred 2)
-
-  ;; check the correctness of the validation proc
-  (when 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)))
-    (slot-set! e 'writers (cons n (slot-ref e 'writers)))
-    n))
-
-;;;; ======================================================================
-;;;;
-;;;;   				    I N I T S
-;;;;
-;;;; ======================================================================
-
-;; A base engine must pre-exist before anything is loaded. In
-;; particular, this dummy base engine is used to load the actual
-;; definition of base. 
-
-(make-engine 'base :version 'bootstrap)
-
-
-(select-module STklos)