Mercurial > lasercutter

     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
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children