ovidiu 01/12/21 10:48:11 Modified: scratchpad/schecoon/scheme sitemap.scm Log: Simplified the sitemap definitions. Revision Changes Path 1.4 +25 -44 xml-cocoon2/scratchpad/schecoon/scheme/sitemap.scm Index: sitemap.scm =================================================================== RCS file: /home/cvs/xml-cocoon2/scratchpad/schecoon/scheme/sitemap.scm,v retrieving revision 1.3 retrieving revision 1.4 diff -u -r1.3 -r1.4 --- sitemap.scm 2001/12/17 06:57:11 1.3 +++ sitemap.scm 2001/12/21 18:48:11 1.4 @@ -34,16 +34,14 @@ ;; ;;(define pipelines ;; (define-pipelines -;; (define-pipeline docbook-xhtml -;; (lambda (file . args) +;; (define-pipeline docbook-xhtml (file . rest) ;; (generate file) ;; (transform '((type xslt) ;; (name "docbook2xhtml.xsl") ;; (parameter "view-source" (concat "docs/samples/" file)))) ;; (serialize (type xml)))) ;; -;; (define-pipeline gif-image -;; (lambda (file . args) +;; (define-pipeline gif-image (file . rest) ;; (read (concat "src/" file ".gif") "image/gif"))) ;; )) ;; @@ -59,66 +57,49 @@ (load-module "sisc.modules.Regexp") -(define-syntax define-pipelines - ; FIXME: tail recursive - (lambda (x) - (syntax-case x () - ((_ e) (syntax (list e))) - ((_ e1 e2 ...) - (syntax (let ((pipedef e1)) - (cons pipedef (define-pipelines e2 ...))))) - ))) +(define define-pipelines + (lambda l l)) (define-syntax define-pipeline - (lambda (x) - (syntax-case x () - ((_) (syntax #f)) - ((_ name body) - (syntax (cons (quote name) body)))))) + (syntax-rules () + ((_ name args body ...) + (cons (quote name) + (lambda args (begin body ...)))))) ;; Sitemap definition ;; ;; The sitemap specifies how to map URLs to pipelines, or to Scheme -;; functions to control the page flow in an application. +;; functions, to control the page flow in an application. ;; ;;(define the-sitemap ;; (define-sitemap -;; (match "sql/(.*)" -;; (lambda (file . args) +;; (match "sql/(.*)" (file . rest) ;; (call-pipeline docbook-xhtml))) ;; -;; (match "slides/(.*)\.gif" -;; (lambda (file . args) +;; (match "slides/(.*)\.gif" (file . rest) ;; (call-pipeline gif-image)) ;; -;; (match "view-source/(*).(*)" -;; (lambda (file type . args) +;; (match "view-source/(*).(*)" (file type . rest) ;; (generate file)) ;; (transform '((type xslt) (name "xsp")))) ;; (serialize (type xml))))) ;; -;; (match "shopping-cart" -;; (lambda (dummy . args) +;; (match "shopping-cart" (dummy . args) ;; (shopping-cart)) ;; )) (define-syntax define-sitemap - (lambda (x) - (syntax-case x () - ((_ e ...) - (syntax (lambda (url) - (or (e url) ...)))) - ))) + (syntax-rules () + ((_ m ...) + (lambda (url cm env) (or (m url cm env) ...))))) (define-syntax match - (lambda (x) - (syntax-case x () - ((_ pattern expression) - (syntax (let ((rx (regexp pattern))) - (lambda (url) - (let ((result (regexp-match rx url))) - (if result - (apply expression result) - #f)))))) - ))) - + (syntax-rules () + ((_ pattern args body ...) + (let ((rx (regexp pattern))) + (lambda (url cm env) + (let ((result (regexp-match rx url))) + (if result + ((lambda args (begin body ...)) cm env result) + #f))))) + ))
---------------------------------------------------------------------- In case of troubles, e-mail: [EMAIL PROTECTED] To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
