A Proposal for a new 'expr2xml' function
Posted: Thu Apr 27, 2006 10:12 am
				
				Recall the function 'expr2xml' from http://newlisp.org/index.cgi?page=S-expressions_to_XML:
It's a beautiful exposition of how you can do some powerful programming in (new)Lisp.  But we need an "ugly" version :-) that handles element attributes and childless elements.  I propose the following.
And the usage is something like:
where 'sxml' is some SXML expression, e.g. '(html (body (p "Hello, World!")))'.
Please let me know what you think. I sometimes get "wrapped around the axle" during coding time, so I may have done things in a less than stellar way.
			Code: Select all
;; translate s-expr to XML
;;
(define (expr2xml expr level)
 (cond 
   ((or (atom? expr) (quote? expr))
       (print (dup "  " level))
       (println expr))
   ((list? (first expr))
       (expr2xml (first expr) (+ level 1))
       (dolist (s (rest expr)) (expr2xml s (+ level 1))))
   ((symbol? (first expr))
       (print (dup "  " level))
       (println "<" (first expr) ">")
       (dolist (s (rest expr)) (expr2xml s (+ level 1)))
       (print (dup "  " level))
       (println "</" (first expr) ">"))
   (true
      (print (dup "  " level) 
      (println "<error>" (string expr) "<error>")))
 ))
Code: Select all
(context 'SXML)
(define (element? maybe-element)
  (and (list? maybe-element)
       (> (length maybe-element) 0)
       (symbol? (maybe-element 0))))
(define (has-attrs? maybe-element)
  (and (SXML:element? maybe-element)
       (> (length maybe-element) 1)
       (list? (maybe-element 1))
       (= '@ (maybe-element 1 0))))
(define (get-attr-string maybe-element)
  (if (SXML:has-attrs? maybe-element)
      (let ((attr-alist (1 (maybe-element 1))))
        (join (map (lambda (attr-pair)
                     (string (attr-pair 0) "="
                             "\"" (attr-pair 1) "\""))
                   attr-alist)
              " "))
    ""))
(define (return-sans-attrs maybe-element)
  (if (SXML:has-attrs? maybe-element)
      (pop maybe-element 1))
  maybe-element)
(define (childless? maybe-element)
  (= 1 (length (SXML:return-sans-attrs maybe-element))))
(define (get-children element)
  (if (SXML:has-attrs? element) (2 element) (1 element)))
(define (name-in-MAIN symbul)
  (if (starts-with (string symbul) "MAIN:")
      (name symbul)
    (string symbul)))
;; The following function is modified from 'expr2xml' in:
;;   http://newlisp.org/index.cgi?page=S-expressions_to_XML
(define (print-xml sxml level)
  (let ((level (or level 0)))
    (cond ((or (atom? sxml) (quote? sxml))
           (print (dup "  " level))
           (println sxml))
          ((list? (first sxml))
           (dolist (s sxml) (print-xml s (+ level 1))))
          ((symbol? (first sxml))
           (let ((attr-string (SXML:get-attr-string sxml))
                 (tag-name (SXML:name-in-MAIN (sxml 0))))
             (print (dup "  " level))
             (println "<" tag-name
                      (if (= attr-string "") "" " ")
                      attr-string
                      (if (SXML:childless? sxml) "/" "")
                      ">")
             (unless (SXML:childless? sxml)
               (let ((kids (SXML:get-children sxml)))
                 (dolist (k kids) (print-xml k (+ level 1)))
                 (print (dup "  " level))
                 (println "</" tag-name ">")))))
          (true
           (print (dup "  " level)) 
           (println "<error>" (string sxml) "<error>")))))
(context MAIN)
Code: Select all
(SXML:print-xml sxml)Please let me know what you think. I sometimes get "wrapped around the axle" during coding time, so I may have done things in a less than stellar way.