Updated zip-filter and zip-filter.xml for new clojure.contrib layout.

2 files changed, 115 insertions, 97 deletions

diff --git a/zip-filter.clj b/zip_filter/xml/xml.clj
index de58c7a2..16f67e8e 100644
--- a/zip-filter.clj
+++ b/zip_filter/xml/xml.clj
@@ -6,97 +6,19 @@
 ;   the terms of this license.
 ;   You must not remove this notice, or any other, from this software.
 
-; System for filtering trees and nodes generated by zip.clj in
-; general, and xml trees in particular.
+; Specialization of zip-filter for xml trees.
 
-(clojure/in-ns 'zip-filter)
+(clojure/in-ns 'clojure.contrib.zip-filter.xml)
 (clojure/refer 'clojure)
-(alias 'zip 'clojure.zip)
-
-(defn sequential?
-  "Returns true if x implements Sequential."
-  [x] (instance? clojure.lang.Sequential x))
-
-; This uses the negative form (no-auto) so that the result from any
-; naive function, including user functions, defaults to "auto".
-(defn auto
-  [v x] (with-meta x ((if v dissoc assoc) ^x :zip-filter/no-auto? true)))
-
-(defn auto?
-  [x] (not (:zip-filter/no-auto? ^x)))
-
-(defn right-locs
-  "Returns a lazy sequence of locations to the right of loc, starting with loc."
-  [loc] (when loc (lazy-cons (auto false loc) (right-locs (zip/right loc)))))
-
-(defn left-locs
-  "Returns a lazy sequence of locations to the left of loc, starting with loc."
-  [loc] (when loc (lazy-cons (auto false loc) (left-locs (zip/left loc)))))
-
-(defn leftmost?
-  "Returns true if there are no more nodes to the left of location loc."
-  [loc] (nil? (zip/left loc)))
-
-(defn rightmost?
-  "Returns true if there are no more nodes to the right of location loc."
-  [loc] (nil? (zip/right loc)))
-
-(defn children
-  "Returns a lazy sequence of all immediate children of location loc,
-  left-to-right."
-  [loc]
-    (when (zip/branch? loc)
-      (map #(auto false %) (right-locs (zip/down loc)))))
 
-(defn children-auto
-  "Returns a lazy sequence of all immediate children of location loc,
-  left-to-right, marked so that a following tag= predicate will auto-descend."
-  #^{:private true}
-  [loc]
-    (when (zip/branch? loc)
-      (map #(auto true %) (right-locs (zip/down loc)))))
-
-(defn descendants
-  "Returns a lazy sequence of all descendants of location loc, in
-  depth-first order, left-to-right, starting with loc."
-  [loc] (lazy-cons (auto false loc) (mapcat descendants (children loc))))
-
-(defn ancestors
-  "Returns a lazy sequence of all ancestors of location loc, starting
-  with loc and proceeding to loc's parent node and on through to the
-  root of the tree."
-  [loc] (when loc (lazy-cons (auto false loc) (ancestors (zip/up loc)))))
-
-(defn fixup-apply
-  "Calls (pred loc), and then converts the result to the 'appropriate'
-  sequence."
-  #^{:private true}
-  [pred loc]
-      (let [rtn (pred loc)]
-        (cond (and (map? ^rtn) (:zip-filter/is-node? ^rtn)) (list rtn)
-              (= rtn true)                (list loc)
-              (= rtn false)               nil
-              (nil? rtn)                  nil
-              (sequential? rtn)           rtn
-              :else                       (list rtn))))
-
-(defn mapcat-chain
-  #^{:private true}
-  [loc preds mkpred]
-    (reduce (fn [prevseq expr]
-                (mapcat #(fixup-apply (or (mkpred expr) expr) %) prevseq))
-            (list (with-meta loc (assoc ^loc :zip-filter/is-node? true)))
-            preds))
-
-
-; === specialization for xml filtering  ===
-
-(clojure/in-ns 'zip-filter-xml)
-(clojure/refer 'clojure)
+; load zip-filter if it isn't already -- when will lib.clj be guaranteed?
+(when-not (find-ns 'clojure.contrib.zip-filter)
+  (clojure.lang.RT/loadResourceScript
+    "clojure/contrib/zip_filter/zip_filter.clj"))
 
+(alias 'zf 'clojure.contrib.zip-filter)
 (alias 'zip 'clojure.zip)
 (alias 'xml 'clojure.xml)
-(refer 'zip-filter)
 
 (def xml->)
 
@@ -115,15 +37,18 @@
   named tagname."
   [tagname]
     (fn [loc]
-        (filter #(and (zip/branch? %) (= tagname ((zip/node %) :tag)))
-                (if (auto? loc) (children-auto loc) (list (auto true loc))))))
+      (filter #(and (zip/branch? %) (= tagname ((zip/node %) :tag)))
+              (if (zf/auto? loc)
+                (zf/children-auto loc)
+                (list (zf/auto true loc))))))
 
 (defn text
   "Returns the textual contents of the given location, similar to
   xpaths's value-of"
   [loc]
-    (.replaceAll #^String (apply str (xml-> loc descendants zip/node string?))
-       (str "[\\s" (char 160) "]+") " "))
+    (.replaceAll
+      #^String (apply str (xml-> loc zf/descendants zip/node string?))
+      (str "[\\s" (char 160) "]+") " "))
 
 (defn text=
   "Returns a query predicate that matches a node when its textual
@@ -154,10 +79,10 @@
 
   See the footer of zip-query.clj for examples."
   [loc & preds]
-    (mapcat-chain loc preds
-                  #(cond (keyword? %) (tag= %)
-                         (string?  %) (text= %)
-                         (vector?  %) (seq-test %))))
+    (zf/mapcat-chain loc preds
+                     #(cond (keyword? %) (tag= %)
+                            (string?  %) (text= %)
+                            (vector?  %) (seq-test %))))
 
 (defn xml1->
   "Returns the first item from loc based on the query predicates
@@ -232,19 +157,21 @@
            '("text/html")))
 
 ; ancestors
-(assert (= (xml-> atom1 descendants :id "2" ancestors zip/node #(:tag %))
+(assert (= (xml-> atom1 zf/descendants :id "2" zf/ancestors zip/node #(:tag %))
            '(:id :entry :feed)))
 
 ; ancestors with non-auto tag= (:entry), followed by auto tag= (:id)
-(assert (= (xml-> atom1 descendants :name "Chouser" ancestors :entry :id text)
+(assert (= (xml-> atom1 zf/descendants :name "Chouser" zf/ancestors
+                  :entry :id text)
            '("1")))
 
 ; left-locs and detection of returning a single loc (zip/up)
-(assert (= (xml-> atom1 descendants :name "Chouser" zip/up left-locs :id text)
+(assert (= (xml-> atom1 zf/descendants :name "Chouser" zip/up
+                  zf/left-locs :id text)
            '("1")))
 
 ; right-locs
-(assert (= (xml-> atom1 descendants :id right-locs :author text)
+(assert (= (xml-> atom1 zf/descendants :id zf/right-locs :author text)
            '("Chouser" "agriffis")))
 
 )
diff --git a/zip_filter/zip_filter.clj b/zip_filter/zip_filter.clj
new file mode 100644
index 00000000..76388c10
--- /dev/null
+++ b/zip_filter/zip_filter.clj
@@ -0,0 +1,91 @@
+;   Copyright (c) Chris Houser, April 2008. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
+;   which can be found in the file CPL.TXT at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+; System for filtering trees and nodes generated by zip.clj in
+; general, and xml trees in particular.
+
+(clojure/in-ns 'clojure.contrib.zip-filter)
+(clojure/refer 'clojure :exclude '(descendants ancestors))
+(alias 'zip 'clojure.zip)
+
+(defn sequential?
+  "Returns true if x implements Sequential."
+  [x] (instance? clojure.lang.Sequential x))
+
+; This uses the negative form (no-auto) so that the result from any
+; naive function, including user functions, defaults to "auto".
+(defn auto
+  [v x] (with-meta x ((if v dissoc assoc) ^x :zip-filter/no-auto? true)))
+
+(defn auto?
+  [x] (not (:zip-filter/no-auto? ^x)))
+
+(defn right-locs
+  "Returns a lazy sequence of locations to the right of loc, starting with loc."
+  [loc] (when loc (lazy-cons (auto false loc) (right-locs (zip/right loc)))))
+
+(defn left-locs
+  "Returns a lazy sequence of locations to the left of loc, starting with loc."
+  [loc] (when loc (lazy-cons (auto false loc) (left-locs (zip/left loc)))))
+
+(defn leftmost?
+  "Returns true if there are no more nodes to the left of location loc."
+  [loc] (nil? (zip/left loc)))
+
+(defn rightmost?
+  "Returns true if there are no more nodes to the right of location loc."
+  [loc] (nil? (zip/right loc)))
+
+(defn children
+  "Returns a lazy sequence of all immediate children of location loc,
+  left-to-right."
+  [loc]
+    (when (zip/branch? loc)
+      (map #(auto false %) (right-locs (zip/down loc)))))
+
+(defn children-auto
+  "Returns a lazy sequence of all immediate children of location loc,
+  left-to-right, marked so that a following tag= predicate will auto-descend."
+  #^{:private true}
+  [loc]
+    (when (zip/branch? loc)
+      (map #(auto true %) (right-locs (zip/down loc)))))
+
+(defn descendants
+  "Returns a lazy sequence of all descendants of location loc, in
+  depth-first order, left-to-right, starting with loc."
+  [loc] (lazy-cons (auto false loc) (mapcat descendants (children loc))))
+
+(defn ancestors
+  "Returns a lazy sequence of all ancestors of location loc, starting
+  with loc and proceeding to loc's parent node and on through to the
+  root of the tree."
+  [loc] (when loc (lazy-cons (auto false loc) (ancestors (zip/up loc)))))
+
+(defn- fixup-apply
+  "Calls (pred loc), and then converts the result to the 'appropriate'
+  sequence."
+  #^{:private true}
+  [pred loc]
+      (let [rtn (pred loc)]
+        (cond (and (map? ^rtn) (:zip-filter/is-node? ^rtn)) (list rtn)
+              (= rtn true)                (list loc)
+              (= rtn false)               nil
+              (nil? rtn)                  nil
+              (sequential? rtn)           rtn
+              :else                       (list rtn))))
+
+(defn mapcat-chain
+  #^{:private true}
+  [loc preds mkpred]
+    (reduce (fn [prevseq expr]
+                (mapcat #(fixup-apply (or (mkpred expr) expr) %) prevseq))
+            (list (with-meta loc (assoc ^loc :zip-filter/is-node? true)))
+            preds))
+
+; see clojure.contrib.zip-filter.xml for examples