home *** CD-ROM | disk | FTP | other *** search
/ VIPER Paradice / VIPER.ISO / pc / SCRIPTS / XSELEMENT.VSC < prev   
Encoding:
Text File  |  2000-02-04  |  1.4 KB  |  75 lines
  1. ;;
  2. ;; xselement.vsc
  3. ;;
  4.  
  5. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  6. ;; xs-elementâAâNâZâT
  7. (define (extract-sum-aux contents)
  8.   (let* ((r #f))
  9.     (for-each
  10.      (lambda (x) (if r #f (set! r (extract-sum x))))
  11.      contents)
  12.     r)
  13.   )
  14.  
  15. (define (extract-sum xs-element)
  16.   (cond
  17.    ((string? xs-element)            #f)
  18.    ((eq? 'sum (caar xs-element))    (car xs-element))
  19.    (else                            (extract-sum-aux (cdr xs-element))))
  20.   )
  21.  
  22. (define (replace-sum xs-element replacement)
  23.   (cond
  24.    ((string? xs-element)            xs-element)
  25.    ((eq? 'sum (caar xs-element))    replacement)
  26.    (else
  27.     (cons
  28.      (car xs-element)
  29.      (map
  30.       (lambda (x) (replace-sum x replacement))
  31.       (cdr xs-element)))))
  32.   )
  33.   
  34. (define (xs-element->xml xs-element)
  35.   (cond
  36.    ((string? xs-element)            xs-element)
  37.    (else
  38.     (string-append
  39.      (xs-stag->xml (car xs-element))
  40.      (xs-contents->xml (cdr xs-element))
  41.      (xs-etag->xml (car xs-element)))))
  42.   )
  43.     
  44. (define (xs-stag->xml xs-tag)
  45.   (let* ((s            (string-append  )))
  46.     (string-append
  47.      "<"
  48.      (symbol->string (car xs-tag))
  49.      (apply
  50.       string-append
  51.       (map
  52.        (lambda (x)
  53.          (string-append " "
  54.                         (symbol->string (car x))
  55.                         "=\""
  56.                         (cdr x)
  57.                         "\""))
  58.        (cdr xs-tag)))
  59.      ">")
  60.     )
  61.   )
  62.  
  63. (define (xs-etag->xml xs-tag)
  64.   (string-append "</" (symbol->string (car xs-tag)) ">")
  65.   )
  66.  
  67. (define (xs-contents->xml contents)
  68.   (apply
  69.    string-append
  70.    (map
  71.     (lambda (x)
  72.       (xs-element->xml x))
  73.     contents))
  74.   )
  75.