about summary refs log tree commit diff
path: root/skr/xml.skr
diff options
context:
space:
mode:
authorLudovic Courtes2005-07-01 23:55:56 +0000
committerLudovic Courtes2005-07-01 23:55:56 +0000
commitefea4dc93f2565555e47de0bfd027614a9c8674d (patch)
tree393a916bf215a675ea75af989f1c66adfe9848c9 /skr/xml.skr
parenta85155f7c411761cfbd75431f265675ae0f394e3 (diff)
downloadskribilo-efea4dc93f2565555e47de0bfd027614a9c8674d.tar.gz
skribilo-efea4dc93f2565555e47de0bfd027614a9c8674d.tar.lz
skribilo-efea4dc93f2565555e47de0bfd027614a9c8674d.zip
Lots of changes, again.
Lots of changes, notably the following:

* skr/*.skr:  Moved engines to `src/guile/skribilo/engine'.

* src/guile/skribilo/engine.scm (lookup-engine):  Rewritten.  Don't use
  the auto-load alist.

* src/guile/skribilo/evaluator.scm:  New name of the `eval' module.
  `eval' couldn't be used as the module base-name because of Guile's
  recursive module name space.

git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-2
Diffstat (limited to 'skr/xml.skr')
-rw-r--r--skr/xml.skr111
1 files changed, 0 insertions, 111 deletions
diff --git a/skr/xml.skr b/skr/xml.skr
deleted file mode 100644
index 784b6f0..0000000
--- a/skr/xml.skr
+++ /dev/null
@@ -1,111 +0,0 @@
-;*=====================================================================*/
-;*    serrano/prgm/project/skribe/skr/xml.skr                          */
-;*    -------------------------------------------------------------    */
-;*    Author      :  Manuel Serrano                                    */
-;*    Creation    :  Tue Sep  2 09:46:09 2003                          */
-;*    Last change :  Sat Mar  6 11:22:05 2004 (serrano)                */
-;*    Copyright   :  2003-04 Manuel Serrano                            */
-;*    -------------------------------------------------------------    */
-;*    Generic XML Skribe engine                                        */
-;*    -------------------------------------------------------------    */
-;*    Implementation:                                                  */
-;*       common: @path ../src/common/api.src@                          */
-;*       bigloo: @path ../src/bigloo/api.bgl@                          */
-;*    -------------------------------------------------------------    */
-;*    doc:                                                             */
-;*       @ref ../../doc/user/xmle.skb:ref@                             */
-;*=====================================================================*/
-
-;*---------------------------------------------------------------------*/
-;*    xml-engine ...                                                   */
-;*---------------------------------------------------------------------*/
-(define xml-engine
-   ;; setup the xml engine
-   (default-engine-set!
-      (make-engine 'xml
-		   :version 1.0
-		   :format "html"
-		   :delegate (find-engine 'base)
-		   :filter (make-string-replace '((#\< "&lt;")
-						  (#\> "&gt;")
-						  (#\& "&amp;")
-						  (#\" "&quot;")
-						  (#\@ "&#x40;"))))))
-
-;*---------------------------------------------------------------------*/
-;*    markup ...                                                       */
-;*---------------------------------------------------------------------*/
-(let ((xml-margin 0))
-   (define (make-margin)
-      (make-string xml-margin #\space))
-   (define (xml-attribute? val)
-      (cond
-	 ((or (string? val) (number? val) (boolean? val))
-	  #t)
-	 ((list? val)
-	  (every? xml-attribute? val))
-	 (else
-	  #f)))
-   (define (xml-attribute att val)
-      (let ((s (keyword->string att)))
-	 (printf " ~a=\"" (substring s 1 (string-length s)))
-	 (let loop ((val val))
-	    (cond
-	       ((or (string? val) (number? val))
-		(display val))
-	       ((boolean? val)
-		(display (if val "true" "false")))
-	       ((pair? val)
-		(for-each loop val))
-	       (else
-		#f)))
-	 (display #\")))
-   (define (xml-option opt val e)
-      (let* ((m (make-margin))
-	     (ks (keyword->string opt))
-	     (s (substring ks 1 (string-length ks))))
-	 (printf "~a<~a>\n" m s)
-	 (output val e)
-	 (printf "~a</~a>\n" m s)))
-   (define (xml-options n e)
-      ;; display the true options
-      (let ((opts (filter (lambda (o)
-			     (and (keyword? (car o))
-				  (not (xml-attribute? (cadr o)))))
-			  (markup-options n))))
-	 (if (pair? opts)
-	     (let ((m (make-margin)))
-		(display m)
-		(display "<options>\n")
-		(set! xml-margin (+ xml-margin 1))
-		(for-each (lambda (o)
-			     (xml-option (car o) (cadr o) e))
-			  opts)
-		(set! xml-margin (- xml-margin 1))
-		(display m)
-		(display "</options>\n")))))
-   (markup-writer #t
-      :options 'all
-      :before (lambda (n e)
-		 (printf "~a<~a" (make-margin) (markup-markup n))
-		 ;; display the xml attributes
-		 (for-each (lambda (o)
-			      (if (and (keyword? (car o))
-				       (xml-attribute? (cadr o)))
-				  (xml-attribute (car o) (cadr o))))
-			   (markup-options n))
-		 (set! xml-margin (+ xml-margin 1))
-		 (display ">\n"))
-      :action (lambda (n e)
-		 ;; options
-		 (xml-options n e)
-		 ;; body
-		 (output (markup-body n) e))
-      :after (lambda (n e)
-		(printf "~a</~a>\n" (make-margin) (markup-markup n))
-		(set! xml-margin (- xml-margin 1)))))
-
-;*---------------------------------------------------------------------*/
-;*    Restore the base engine                                          */
-;*---------------------------------------------------------------------*/
-(default-engine-set! (find-engine 'base))