Mercurial > lasercutter

     1 ;   Copyright (c) Chris Houser, Dec 2008. All rights reserved.

     2 ;   The use and distribution terms for this software are covered by the

     3 ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)

     4 ;   which can be found in the file epl-v10.html at the root of this distribution.

     5 ;   By using this software in any fashion, you are agreeing to be bound by

     6 ;   the terms of this license.

     7 ;   You must not remove this notice, or any other, from this software.

     8 

     9 ; optional module to allow lazy-xml to use pull parser instead of sax

    10 

    11 (in-ns 'clojure.contrib.lazy-xml)

    12 (import '(org.xmlpull.v1 XmlPullParser XmlPullParserFactory))

    13 

    14 (defn- attrs [xpp]

    15   (for [i (range (.getAttributeCount xpp))]

    16     [(keyword (.getAttributeName xpp i))

    17      (.getAttributeValue xpp i)]))

    18 

    19 (defn- ns-decs [xpp]

    20   (let [d (.getDepth xpp)]

    21     (for [i (range (.getNamespaceCount xpp (dec d)) (.getNamespaceCount xpp d))]

    22       (let [prefix (.getNamespacePrefix xpp i)]

    23         [(keyword (str "xmlns" (when prefix (str ":" prefix))))

    24          (.getNamespaceUri xpp i)]))))

    25 

    26 (defn- attr-hash [xpp]

    27   (into {} (concat (ns-decs xpp) (attrs xpp))))

    28 

    29 (defn- pull-step [xpp]

    30   (let [step (fn [xpp]

    31                (condp = (.next xpp)

    32                  XmlPullParser/START_TAG

    33                    (cons (struct node :start-element

    34                                  (keyword (.getName xpp))

    35                                  (attr-hash xpp))

    36                          (pull-step xpp))

    37                    XmlPullParser/END_TAG

    38                    (cons (struct node :end-element

    39                                  (keyword (.getName xpp)))

    40                          (pull-step xpp))

    41                    XmlPullParser/TEXT

    42                    (let [text (.trim (.getText xpp))]

    43                      (if (empty? text)

    44                        (recur xpp)

    45                        (cons (struct node :characters nil nil text)

    46                              (pull-step xpp))))))]

    47     (lazy-seq (step xpp))))

    48 

    49 (def ^{:private true} factory

    50   (doto (XmlPullParserFactory/newInstance)

    51     (.setNamespaceAware true)))

    52 

    53 (defn- parse-seq-pull [s]

    54   (let [xpp (.newPullParser factory)]

    55     (.setInput xpp s)

    56     (pull-step xpp)))

    57 

    58 (def has-pull true)
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children