1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/zip_filter.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,92 @@
     1.4 +;   Copyright (c) Chris Houser, April 2008. All rights reserved.
     1.5 +;   The use and distribution terms for this software are covered by the
     1.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
     1.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
     1.8 +;   By using this software in any fashion, you are agreeing to be bound by
     1.9 +;   the terms of this license.
    1.10 +;   You must not remove this notice, or any other, from this software.
    1.11 +
    1.12 +; System for filtering trees and nodes generated by zip.clj in
    1.13 +; general, and xml trees in particular.
    1.14 +
    1.15 +(ns 
    1.16 +  ^{:author "Chris Houser",
    1.17 +     :doc "System for filtering trees and nodes generated by zip.clj in
    1.18 +general, and xml trees in particular.
    1.19 +"}
    1.20 +  clojure.contrib.zip-filter
    1.21 +  (:refer-clojure :exclude (descendants ancestors))
    1.22 +  (:require [clojure.zip :as zip]))
    1.23 +
    1.24 +; This uses the negative form (no-auto) so that the result from any
    1.25 +; naive function, including user functions, defaults to "auto".
    1.26 +(defn auto
    1.27 +  [v x] (with-meta x ((if v dissoc assoc) (meta x) :zip-filter/no-auto? true)))
    1.28 +
    1.29 +(defn auto?
    1.30 +  [x] (not (:zip-filter/no-auto? (meta x))))
    1.31 +
    1.32 +(defn right-locs
    1.33 +  "Returns a lazy sequence of locations to the right of loc, starting with loc."
    1.34 +  [loc] (lazy-seq (when loc (cons (auto false loc) (right-locs (zip/right loc))))))
    1.35 +
    1.36 +(defn left-locs
    1.37 +  "Returns a lazy sequence of locations to the left of loc, starting with loc."
    1.38 +  [loc] (lazy-seq (when loc (cons (auto false loc) (left-locs (zip/left loc))))))
    1.39 +
    1.40 +(defn leftmost?
    1.41 +  "Returns true if there are no more nodes to the left of location loc."
    1.42 +  [loc] (nil? (zip/left loc)))
    1.43 +
    1.44 +(defn rightmost?
    1.45 +  "Returns true if there are no more nodes to the right of location loc."
    1.46 +  [loc] (nil? (zip/right loc)))
    1.47 +
    1.48 +(defn children
    1.49 +  "Returns a lazy sequence of all immediate children of location loc,
    1.50 +  left-to-right."
    1.51 +  [loc]
    1.52 +    (when (zip/branch? loc)
    1.53 +      (map #(auto false %) (right-locs (zip/down loc)))))
    1.54 +
    1.55 +(defn children-auto
    1.56 +  "Returns a lazy sequence of all immediate children of location loc,
    1.57 +  left-to-right, marked so that a following tag= predicate will auto-descend."
    1.58 +  ^{:private true}
    1.59 +  [loc]
    1.60 +    (when (zip/branch? loc)
    1.61 +      (map #(auto true %) (right-locs (zip/down loc)))))
    1.62 +
    1.63 +(defn descendants
    1.64 +  "Returns a lazy sequence of all descendants of location loc, in
    1.65 +  depth-first order, left-to-right, starting with loc."
    1.66 +  [loc] (lazy-seq (cons (auto false loc) (mapcat descendants (children loc)))))
    1.67 +
    1.68 +(defn ancestors
    1.69 +  "Returns a lazy sequence of all ancestors of location loc, starting
    1.70 +  with loc and proceeding to loc's parent node and on through to the
    1.71 +  root of the tree."
    1.72 +  [loc] (lazy-seq (when loc (cons (auto false loc) (ancestors (zip/up loc))))))
    1.73 +
    1.74 +(defn- fixup-apply
    1.75 +  "Calls (pred loc), and then converts the result to the 'appropriate'
    1.76 +  sequence."
    1.77 +  ^{:private true}
    1.78 +  [pred loc]
    1.79 +      (let [rtn (pred loc)]
    1.80 +        (cond (and (map? (meta rtn)) (:zip-filter/is-node? (meta rtn))) (list rtn)
    1.81 +              (= rtn true)                (list loc)
    1.82 +              (= rtn false)               nil
    1.83 +              (nil? rtn)                  nil
    1.84 +              (sequential? rtn)           rtn
    1.85 +              :else                       (list rtn))))
    1.86 +
    1.87 +(defn mapcat-chain
    1.88 +  ^{:private true}
    1.89 +  [loc preds mkpred]
    1.90 +    (reduce (fn [prevseq expr]
    1.91 +                (mapcat #(fixup-apply (or (mkpred expr) expr) %) prevseq))
    1.92 +            (list (with-meta loc (assoc (meta loc) :zip-filter/is-node? true)))
    1.93 +            preds))
    1.94 +
    1.95 +; see clojure.contrib.zip-filter.xml for examples