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, 211 deletions

diff --git a/src/stklos/writer.stk b/src/stklos/writer.stk
deleted file mode 100644
index 2b0f91c..0000000
--- a/src/stklos/writer.stk
+++ /dev/null
@@ -1,211 +0,0 @@
-;;;;
-;;;; writer.stk	-- Skribe Writer 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: 15-Sep-2003 22:21 (eg)
-;;;; Last file update:  4-Mar-2004 10:48 (eg)
-;;;;
-
-
-(define-module SKRIBE-WRITER-MODULE
-  (import SKRIBE-DEBUG-MODULE SKRIBE-ENGINE-MODULE SKRIBE-OUTPUT-MODULE)
-  (export invoke markup-writer markup-writer-get markup-writer-get*
-	  lookup-markup-writer copy-markup-writer)
-
-;;;; ======================================================================
-;;;;
-;;;; 				INVOKE
-;;;;
-;;;; ======================================================================
-(define (invoke proc node e)
-  (with-debug 5 'invoke
-     (debug-item "e=" (engine-ident e))
-     (debug-item "node=" node " " (if (markup? node) (markup-markup node) ""))
-
-     (if (string? proc)
-	 (display proc)
-	 (if (procedure? proc)
-	     (proc node e)))))
-
-
-;;;; ======================================================================
-;;;;
-;;;; 				LOOKUP-MARKUP-WRITER
-;;;;
-;;;; ======================================================================
-(define (lookup-markup-writer node e)
-  (let ((writers (slot-ref e 'writers))
-	(delegate (slot-ref e 'delegate)))
-    (let Loop ((w* writers))
-      (cond
-	((pair? w*)
-	   (let ((pred (slot-ref (car w*) 'pred)))
-	     (if (pred node e)
-		 (car w*)
-		 (loop (cdr w*)))))
-	((engine? delegate)
-	   (lookup-markup-writer node delegate))
-	(else
-	   #f)))))
-
-;;;; ======================================================================
-;;;;
-;;;; 				MAKE-WRITER-PREDICATE
-;;;;
-;;;; ======================================================================
-(define (make-writer-predicate markup predicate class)
-  (let* ((t1 (if (symbol? markup)
-		 (lambda (n e) (is-markup? n markup))
-		 (lambda (n e) #t)))
-	 (t2 (if class
-		 (lambda (n e)
-		   (and (t1 n e) (equal? (markup-class n) class)))
-		 t1)))
-    (if predicate
-	(cond
-	  ((not (procedure? predicate))
-	     (skribe-error 'markup-writer
-			   "Illegal predicate (procedure expected)"
-			   predicate))
-	  ((not (eq? (%procedure-arity predicate) 2))
-	     (skribe-error 'markup-writer
-			   "Illegal predicate arity (2 arguments expected)"
-			   predicate))
-	  (else
-	     (lambda (n e)
-	       (and (t2 n e) (predicate n e)))))
-	t2)))
-
-;;;; ======================================================================
-;;;;
-;;;; 				MARKUP-WRITER
-;;;;
-;;;; ======================================================================
-(define (markup-writer markup :optional engine
-		       :key (predicate #f) (class #f) (options '())
-		            (validate #f)
-		            (before #f) (action 'unspecified) (after #f))
-  (let ((e (or engine (default-engine))))
-    (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))
-      ((and (not predicate)
-	    (not class)
-	    (null? options)
-	    (not before)
-	    (eq? action 'unspecified)
-	    (not after))
-         (skribe-error 'markup-writer "Illegal writer" markup))
-      (else
-       (let ((m  (make-writer-predicate markup predicate class))
-	     (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))))))
-
-
-;;;; ======================================================================
-;;;;
-;;;; 				MARKUP-WRITER-GET
-;;;;
-;;;; ======================================================================
-(define (markup-writer-get markup :optional engine :key (class #f) (pred #f))
-  (let ((e (or engine (default-engine))))
-    (cond
-      ((not (symbol? markup))
-         (skribe-error 'markup-writer-get "Illegal symbol" markup))
-      ((not (engine? e))
-         (skribe-error 'markup-writer-get "Illegal engine" e))
-      (else
-       (let liip ((e e))
-	 (let loop ((w* (slot-ref e 'writers)))
-	   (cond
-	     ((pair? w*)
-	        (if (and (eq? (writer-ident (car w*)) markup)
-			 (equal? (writer-class (car w*)) class)
-			 (or (unspecified? pred)
-			     (eq? (slot-ref (car w*) 'upred) pred)))
-		    (car w*)
-		    (loop (cdr w*))))
-	     ((engine? (slot-ref e 'delegate))
-	        (liip (slot-ref e 'delegate)))
-	     (else
-	        #f))))))))
-
-;;;; ======================================================================
-;;;;
-;;;; 				MARKUP-WRITER-GET*
-;;;;
-;;;; ======================================================================
-
-;; Finds all writers that matches MARKUP with optional CLASS attribute.
-
-(define (markup-writer-get* markup #!optional engine #!key (class #f))
-  (let ((e (or engine (default-engine))))
-    (cond
-      ((not (symbol? markup))
-       (skribe-error 'markup-writer "Illegal symbol" markup))
-      ((not (engine? e))
-       (skribe-error 'markup-writer "Illegal engine" e))
-      (else
-       (let liip ((e e)
-		  (res '()))
-	 (let loop ((w* (slot-ref e 'writers))
-		    (res res))
-	   (cond
-	     ((pair? w*)
-	      (if (and (eq? (slot-ref (car w*) 'ident) markup)
-		       (equal? (slot-ref (car w*) 'class) class))
-		  (loop (cdr w*) (cons (car w*) res))
-		  (loop (cdr w*) res)))
-	     ((engine? (slot-ref e 'delegate))
-	      (liip (slot-ref e 'delegate) res))
-	     (else
-	      (reverse! res)))))))))
-
-;;; ======================================================================
-;;;;
-;;;; 				COPY-MARKUP-WRITER
-;;;;
-;;;; ======================================================================
-(define (copy-markup-writer markup old-engine :optional new-engine
-			      :key (predicate 'unspecified) 
-			           (class 'unspecified) 
-				   (options 'unspecified)
-			           (validate 'unspecified) 
-				   (before 'unspecified) 
-				   (action 'unspecified) 
-				   (after 'unspecified))
-    (let ((old        (markup-writer-get markup old-engine))
-	  (new-engine (or new-engine old-engine)))
-      (markup-writer markup new-engine
-	 :pred      (if (unspecified? predicate) (slot-ref old 'pred) predicate)
-	 :class     (if (unspecified? class)     (slot-ref old 'class) class)
-	 :options   (if (unspecified? options)   (slot-ref old 'options) options)
-	 :validate  (if (unspecified? validate)  (slot-ref old 'validate) validate)
-	 :before    (if (unspecified? before)    (slot-ref old 'before) before)
-	 :action    (if (unspecified? action)    (slot-ref old 'action) action)
-	 :after     (if (unspecified? after)     (slot-ref old 'after) after))))
-
-)