Merge pull request #867 from arthurgleckler/master

Add support for SXML indentation on output.

lib/chibi/sxml.scm

@@ -80,13 +80,24 @@
   (call-with-output-string
     (lambda (out) (html-display-escaped-string str out))))
 
+(define indentable-elements
+  '(address article aside base blockquote body dd details dialog
+    div dl dt fieldset figcaption figure footer form h1 h2 h3 h4
+    h5 h6 head header hgroup hr li link main meta nav ol p pre
+    script section style table title ul))
+
+(define (indent i out)
+  (do ((j (* 2 i) (- j 1))) ((= j 0)) (write-char #\space out)))
+
 ;;> Render (valid, expanded) \var{sxml} as html.
 ;;> \var{@raw} tag is considered safe text and not processed or escaped.
 (define (sxml-display-as-html sxml . o)
-  (let ((out (if (pair? o) (car o) (current-output-port))))
+  (let-optionals o ((out (current-output-port))
+		    (indent? #false))
     (let lp ((sxml (if (and (pair? sxml) (eq? '*TOP* (car sxml)))
                        (cdr sxml)
-                       sxml)))
+                       sxml))
+	     (depth 0))
       (cond
        ((pair? sxml)
         (let ((tag (car sxml))
@@ -106,17 +117,23 @@
              ((and (pair? rest)
                    (pair? (car rest))
                    (eq? '@ (caar rest)))
+	      (when (and indent? (memq tag indentable-elements))
+		(newline out)
+		(indent depth out))
 	      (display (html-tag->string tag (cdar rest)) out)
-              (for-each lp (cdr rest))
+	      (for-each (lambda (x) (lp x (+ 1 depth))) (cdr rest))
 	      (unless (and (null? (cdr rest)) (memq tag void-elements))
                 (display "</" out) (display tag out) (display ">" out)))
              (else
+	      (when (and indent? (memq tag indentable-elements))
+		(newline out)
+		(indent depth out))
 	      (display (html-tag->string tag '()) out)
-              (for-each lp rest)
+	      (for-each (lambda (x) (lp x (+ 1 depth))) rest)
 	      (unless (and (null? rest) (memq tag void-elements))
                 (display "</" out) (display tag out) (display ">" out)))))
            (else
-            (for-each lp sxml)))))
+            (for-each (lambda (x) (lp x (+ 1 depth))) sxml)))))
        ((null? sxml))
        (else (html-display-escaped-string sxml out))))))
 

lib/chibi/sxml.sld

@@ -4,5 +4,5 @@
 (define-library (chibi sxml)
   (export sxml->xml sxml-display-as-html sxml-display-as-text sxml-strip
           html-escape html-tag->string)
-  (import (scheme base) (scheme write))
+  (import (chibi optional) (scheme base) (scheme write))
   (include "sxml.scm"))