Mercurial > lasercutter

comparison src/clojure/contrib/zip_filter.clj @ 10:ef7dbbd6452c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
comparison
equal deleted inserted replaced
9:35cf337adfcf 10:ef7dbbd6452c
1 ; Copyright (c) Chris Houser, April 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 ; System for filtering trees and nodes generated by zip.clj in
10 ; general, and xml trees in particular.
11
12 (ns
13 ^{:author "Chris Houser",
14 :doc "System for filtering trees and nodes generated by zip.clj in
15 general, and xml trees in particular.
16 "}
17 clojure.contrib.zip-filter
18 (:refer-clojure :exclude (descendants ancestors))
19 (:require [clojure.zip :as zip]))
20
21 ; This uses the negative form (no-auto) so that the result from any
22 ; naive function, including user functions, defaults to "auto".
23 (defn auto
24 [v x] (with-meta x ((if v dissoc assoc) (meta x) :zip-filter/no-auto? true)))
25
26 (defn auto?
27 [x] (not (:zip-filter/no-auto? (meta x))))
28
29 (defn right-locs
30 "Returns a lazy sequence of locations to the right of loc, starting with loc."
31 [loc] (lazy-seq (when loc (cons (auto false loc) (right-locs (zip/right loc))))))
32
33 (defn left-locs
34 "Returns a lazy sequence of locations to the left of loc, starting with loc."
35 [loc] (lazy-seq (when loc (cons (auto false loc) (left-locs (zip/left loc))))))
36
37 (defn leftmost?
38 "Returns true if there are no more nodes to the left of location loc."
39 [loc] (nil? (zip/left loc)))
40
41 (defn rightmost?
42 "Returns true if there are no more nodes to the right of location loc."
43 [loc] (nil? (zip/right loc)))
44
45 (defn children
46 "Returns a lazy sequence of all immediate children of location loc,
47 left-to-right."
48 [loc]
49 (when (zip/branch? loc)
50 (map #(auto false %) (right-locs (zip/down loc)))))
51
52 (defn children-auto
53 "Returns a lazy sequence of all immediate children of location loc,
54 left-to-right, marked so that a following tag= predicate will auto-descend."
55 ^{:private true}
56 [loc]
57 (when (zip/branch? loc)
58 (map #(auto true %) (right-locs (zip/down loc)))))
59
60 (defn descendants
61 "Returns a lazy sequence of all descendants of location loc, in
62 depth-first order, left-to-right, starting with loc."
63 [loc] (lazy-seq (cons (auto false loc) (mapcat descendants (children loc)))))
64
65 (defn ancestors
66 "Returns a lazy sequence of all ancestors of location loc, starting
67 with loc and proceeding to loc's parent node and on through to the
68 root of the tree."
69 [loc] (lazy-seq (when loc (cons (auto false loc) (ancestors (zip/up loc))))))
70
71 (defn- fixup-apply
72 "Calls (pred loc), and then converts the result to the 'appropriate'
73 sequence."
74 ^{:private true}
75 [pred loc]
76 (let [rtn (pred loc)]
77 (cond (and (map? (meta rtn)) (:zip-filter/is-node? (meta rtn))) (list rtn)
78 (= rtn true) (list loc)
79 (= rtn false) nil
80 (nil? rtn) nil
81 (sequential? rtn) rtn
82 :else (list rtn))))
83
84 (defn mapcat-chain
85 ^{:private true}
86 [loc preds mkpred]
87 (reduce (fn [prevseq expr]
88 (mapcat #(fixup-apply (or (mkpred expr) expr) %) prevseq))
89 (list (with-meta loc (assoc (meta loc) :zip-filter/is-node? true)))
90 preds))
91
92 ; see clojure.contrib.zip-filter.xml for examples