;clojure pretty print functions for lazy-xml -> xml-zip zippers.
;author: Keith Wyss

(let [tabs (cycle '("  "))]
	(defn attrstr [attr]
	"generates a string to insert into xml for :attr keywork in zipper"
		(let [ks (keys attr)
		 ans (apply str
				(for [x ks]
					(str (name x) "=" (x attr))
				)
			)]
		(if (= ans "")
			ans
			(str " " ans)
		)
		)
	)
	(defn prxmlzip [node stck strvec depth down?]
	"Returns a str-seq that apply-str will turn into an xml-rep of an xml zipper"
	(if down?
	;case for going deeper in xml tree
	(let [elem (first node)]
		(if (nil?  (clojure.zip/down node))		;case element is a leaf node
			(let [new-strvec (conj strvec (str " " elem))
				;adds the entry with tabbing
				 new-strvecifup (conj new-strvec (str " "
						"</" (peek stck) ">"))	;add closing tag if popping
					rght (clojure.zip/right node)
					up (clojure.zip/up node)]
				(if rght
					(recur rght (pop stck) new-strvec depth true)
					(recur up (pop stck) new-strvecifup (dec depth) false)
					; this recur is a pop in the zipper
				)
			)
			;element is not a leaf node
			(let [new-stck (conj stck (name (:tag elem))) ;add the tag to the stack so that it closes correctly
				tag (name (:tag elem))
				new-strvec (conj strvec "\n" (apply str (take depth tabs))
				"<" tag (attrstr (:attr elem)) ">")	;add tag and attr with tabs
				down (clojure.zip/down node)
				]
				(recur down new-stck new-strvec (inc depth) true)
			)
		)
	)
	;case if popping up xml tree
	(let [up (clojure.zip/up node)
		  rght (clojure.zip/right node)
		  	newstrvecifup (conj strvec "\n" (str (apply str (take (dec depth) tabs))
					"</" (peek stck) ">"))]
		;we will look for a tree to traverse downward or travel up towards the root and quit
		(cond rght
			(recur rght stck strvec depth true)
			(and (> depth 0) up) (recur up (pop stck) newstrvecifup (dec depth) false)
			:else strvec
		)
	)
	);end if down
)

(defn ppxml [node]
"Takes a node and returns a string of it's xml subtree"
 	(apply str (next (prxmlzip node '() [] 0 true)))	;next effectively chomps leading \n
)
)