clementine 0.0.1
Sign up to get free protection for your applications and to get access to all the features.
- data/.gitignore +7 -0
- data/Gemfile +4 -0
- data/README.md +52 -0
- data/Rakefile +1 -0
- data/clementine.gemspec +23 -0
- data/lib/clementine.rb +27 -0
- data/lib/clementine/clementine_rails.rb +8 -0
- data/lib/clementine/clojurescript_engine.rb +49 -0
- data/lib/clementine/clojurescript_engine_mri.rb +65 -0
- data/lib/clementine/clojurescript_template.rb +21 -0
- data/lib/clementine/options.rb +9 -0
- data/lib/clementine/version.rb +3 -0
- data/test/clojurescript_engine_test.rb +46 -0
- data/test/options_test.rb +22 -0
- data/vendor/assets/bin/cljsc.clj +21 -0
- data/vendor/assets/lib/clojure.jar +0 -0
- data/vendor/assets/lib/compiler.jar +0 -0
- data/vendor/assets/lib/goog.jar +0 -0
- data/vendor/assets/lib/js.jar +0 -0
- data/vendor/assets/src/clj/cljs/closure.clj +823 -0
- data/vendor/assets/src/clj/cljs/compiler.clj +1341 -0
- data/vendor/assets/src/clj/cljs/core.clj +702 -0
- data/vendor/assets/src/clj/cljs/repl.clj +162 -0
- data/vendor/assets/src/clj/cljs/repl/browser.clj +341 -0
- data/vendor/assets/src/clj/cljs/repl/rhino.clj +170 -0
- data/vendor/assets/src/cljs/cljs/core.cljs +3330 -0
- data/vendor/assets/src/cljs/cljs/nodejs.cljs +11 -0
- data/vendor/assets/src/cljs/cljs/nodejs_externs.js +2 -0
- data/vendor/assets/src/cljs/cljs/nodejscli.cljs +9 -0
- data/vendor/assets/src/cljs/cljs/reader.cljs +360 -0
- data/vendor/assets/src/cljs/clojure/browser/dom.cljs +106 -0
- data/vendor/assets/src/cljs/clojure/browser/event.cljs +100 -0
- data/vendor/assets/src/cljs/clojure/browser/net.cljs +182 -0
- data/vendor/assets/src/cljs/clojure/browser/repl.cljs +109 -0
- data/vendor/assets/src/cljs/clojure/set.cljs +162 -0
- data/vendor/assets/src/cljs/clojure/string.cljs +160 -0
- data/vendor/assets/src/cljs/clojure/walk.cljs +94 -0
- data/vendor/assets/src/cljs/clojure/zip.cljs +291 -0
- metadata +103 -0
@@ -0,0 +1,160 @@
|
|
1
|
+
; Copyright (c) Rich Hickey. 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
|
+
(ns clojure.string
|
10
|
+
(:refer-clojure :exclude [replace reverse])
|
11
|
+
(:require [goog.string :as gstring]
|
12
|
+
[goog.string.StringBuffer :as gstringbuf]))
|
13
|
+
|
14
|
+
(defn- seq-reverse
|
15
|
+
[coll]
|
16
|
+
(reduce conj () coll))
|
17
|
+
|
18
|
+
(defn reverse
|
19
|
+
"Returns s with its characters reversed."
|
20
|
+
[s]
|
21
|
+
(.. s (split "") (reverse) (join "")))
|
22
|
+
|
23
|
+
(defn replace
|
24
|
+
"Replaces all instance of match with replacement in s.
|
25
|
+
match/replacement can be:
|
26
|
+
|
27
|
+
string / string
|
28
|
+
pattern / (string or function of match)."
|
29
|
+
[s match replacement]
|
30
|
+
(cond (string? match)
|
31
|
+
(.replace s (js/RegExp. (gstring/regExpEscape match) "g") replacement)
|
32
|
+
(.hasOwnProperty match "source")
|
33
|
+
(.replace s (js/RegExp. (.source match) "g") replacement)
|
34
|
+
:else (throw (str "Invalid match arg: " match))))
|
35
|
+
|
36
|
+
(defn replace-first
|
37
|
+
"Replaces the first instance of match with replacement in s.
|
38
|
+
match/replacement can be:
|
39
|
+
|
40
|
+
string / string
|
41
|
+
pattern / (string or function of match)."
|
42
|
+
[s match replacement]
|
43
|
+
(.replace s match replacement))
|
44
|
+
|
45
|
+
(defn join
|
46
|
+
"Returns a string of all elements in coll, as returned by (seq coll),
|
47
|
+
separated by an optional separator."
|
48
|
+
([coll]
|
49
|
+
(apply str coll))
|
50
|
+
([separator coll]
|
51
|
+
(apply str (interpose separator coll))))
|
52
|
+
|
53
|
+
(defn upper-case
|
54
|
+
"Converts string to all upper-case."
|
55
|
+
[s]
|
56
|
+
(. s (toUpperCase)))
|
57
|
+
|
58
|
+
(defn lower-case
|
59
|
+
"Converts string to all lower-case."
|
60
|
+
[s]
|
61
|
+
(. s (toLowerCase)))
|
62
|
+
|
63
|
+
(defn capitalize
|
64
|
+
"Converts first character of the string to upper-case, all other
|
65
|
+
characters to lower-case."
|
66
|
+
[s]
|
67
|
+
(if (< (count s) 2)
|
68
|
+
(upper-case s)
|
69
|
+
(str (upper-case (subs s 0 1))
|
70
|
+
(lower-case (subs s 1)))))
|
71
|
+
|
72
|
+
;; The JavaScript split function takes a limit argument but the return
|
73
|
+
;; value is not the same as the Java split function.
|
74
|
+
;;
|
75
|
+
;; Java: (.split "a-b-c" #"-" 2) => ["a" "b-c"]
|
76
|
+
;; JavaScript: (.split "a-b-c" #"-" 2) => ["a" "b"]
|
77
|
+
;;
|
78
|
+
;; For consistency, the three arg version has been implemented to
|
79
|
+
;; mimic Java's behavior.
|
80
|
+
|
81
|
+
(defn split
|
82
|
+
"Splits string on a regular expression. Optional argument limit is
|
83
|
+
the maximum number of splits. Not lazy. Returns vector of the splits."
|
84
|
+
([s re]
|
85
|
+
(vec (.split (str s) re)))
|
86
|
+
([s re limit]
|
87
|
+
(if (< limit 1)
|
88
|
+
(vec (.split (str s) re))
|
89
|
+
(loop [s s
|
90
|
+
limit limit
|
91
|
+
parts []]
|
92
|
+
(if (= limit 1)
|
93
|
+
(conj parts s)
|
94
|
+
(if-let [m (re-find re s)]
|
95
|
+
(let [index (.indexOf s m)]
|
96
|
+
(recur (.substring s (+ index (count m)))
|
97
|
+
(dec limit)
|
98
|
+
(conj parts (.substring s 0 index))))
|
99
|
+
(conj parts s)))))))
|
100
|
+
|
101
|
+
(defn split-lines
|
102
|
+
"Splits s on \n or \r\n."
|
103
|
+
[s]
|
104
|
+
(split s #"\n|\r\n"))
|
105
|
+
|
106
|
+
(defn trim
|
107
|
+
"Removes whitespace from both ends of string."
|
108
|
+
[s]
|
109
|
+
(gstring/trim s))
|
110
|
+
|
111
|
+
(defn triml
|
112
|
+
"Removes whitespace from the left side of string."
|
113
|
+
[s]
|
114
|
+
(gstring/trimLeft s))
|
115
|
+
|
116
|
+
(defn trimr
|
117
|
+
"Removes whitespace from the right side of string."
|
118
|
+
[s]
|
119
|
+
(gstring/trimRight s))
|
120
|
+
|
121
|
+
(defn trim-newline
|
122
|
+
"Removes all trailing newline \\n or return \\r characters from
|
123
|
+
string. Similar to Perl's chomp."
|
124
|
+
[s]
|
125
|
+
(loop [index (.length s)]
|
126
|
+
(if (zero? index)
|
127
|
+
""
|
128
|
+
(let [ch (get s (dec index))]
|
129
|
+
(if (or (= ch \newline) (= ch \return))
|
130
|
+
(recur (dec index))
|
131
|
+
(.substring s 0 index))))))
|
132
|
+
|
133
|
+
(defn blank?
|
134
|
+
"True is s is nil, empty, or contains only whitespace."
|
135
|
+
[s]
|
136
|
+
(let [s (str s)]
|
137
|
+
(if (or
|
138
|
+
(not s)
|
139
|
+
(= "" s)
|
140
|
+
(re-matches #"\s+" s))
|
141
|
+
true
|
142
|
+
false)))
|
143
|
+
|
144
|
+
(defn escape
|
145
|
+
"Return a new string, using cmap to escape each character ch
|
146
|
+
from s as follows:
|
147
|
+
|
148
|
+
If (cmap ch) is nil, append ch to the new string.
|
149
|
+
If (cmap ch) is non-nil, append (str (cmap ch)) instead."
|
150
|
+
[s cmap]
|
151
|
+
(let [buffer (gstring/StringBuffer.)
|
152
|
+
length (.length s)]
|
153
|
+
(loop [index 0]
|
154
|
+
(if (= length index)
|
155
|
+
(. buffer (toString))
|
156
|
+
(let [ch (.charAt s index)]
|
157
|
+
(if-let [replacement (get cmap ch)]
|
158
|
+
(.append buffer (str replacement))
|
159
|
+
(.append buffer ch))
|
160
|
+
(recur (inc index)))))))
|
@@ -0,0 +1,94 @@
|
|
1
|
+
; Copyright (c) Rich Hickey. 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
|
+
;;; walk.cljs - generic tree walker with replacement
|
10
|
+
|
11
|
+
;; by Stuart Sierra
|
12
|
+
;; Jul5 17, 2011
|
13
|
+
|
14
|
+
;; CHANGE LOG:
|
15
|
+
;;
|
16
|
+
;; * July 17, 2011: Port to ClojureScript
|
17
|
+
;;
|
18
|
+
;; * December 15, 2008: replaced 'walk' with 'prewalk' & 'postwalk'
|
19
|
+
;;
|
20
|
+
;; * December 9, 2008: first version
|
21
|
+
|
22
|
+
|
23
|
+
(ns
|
24
|
+
^{:author "Stuart Sierra",
|
25
|
+
:doc "This file defines a generic tree walker for Clojure data
|
26
|
+
structures. It takes any data structure (list, vector, map, set,
|
27
|
+
seq), calls a function on every element, and uses the return value
|
28
|
+
of the function in place of the original. This makes it fairly
|
29
|
+
easy to write recursive search-and-replace functions, as shown in
|
30
|
+
the examples.
|
31
|
+
|
32
|
+
Note: \"walk\" supports all Clojure data structures EXCEPT maps
|
33
|
+
created with sorted-map-by. There is no (obvious) way to retrieve
|
34
|
+
the sorting function."}
|
35
|
+
clojure.walk)
|
36
|
+
|
37
|
+
(defn walk
|
38
|
+
"Traverses form, an arbitrary data structure. inner and outer are
|
39
|
+
functions. Applies inner to each element of form, building up a
|
40
|
+
data structure of the same type, then applies outer to the result.
|
41
|
+
Recognizes all Clojure data structures. Consumes seqs as with doall."
|
42
|
+
|
43
|
+
{:added "1.1"}
|
44
|
+
[inner outer form]
|
45
|
+
(cond
|
46
|
+
(seq? form) (outer (doall (map inner form)))
|
47
|
+
(coll? form) (outer (into (empty form) (map inner form)))
|
48
|
+
:else (outer form)))
|
49
|
+
|
50
|
+
(defn postwalk
|
51
|
+
"Performs a depth-first, post-order traversal of form. Calls f on
|
52
|
+
each sub-form, uses f's return value in place of the original.
|
53
|
+
Recognizes all Clojure data structures. Consumes seqs as with doall."
|
54
|
+
{:added "1.1"}
|
55
|
+
[f form]
|
56
|
+
(walk (partial postwalk f) f form))
|
57
|
+
|
58
|
+
(defn prewalk
|
59
|
+
"Like postwalk, but does pre-order traversal."
|
60
|
+
{:added "1.1"}
|
61
|
+
[f form]
|
62
|
+
(walk (partial prewalk f) identity (f form)))
|
63
|
+
|
64
|
+
(defn keywordize-keys
|
65
|
+
"Recursively transforms all map keys from strings to keywords."
|
66
|
+
{:added "1.1"}
|
67
|
+
[m]
|
68
|
+
(let [f (fn [[k v]] (if (string? k) [(keyword k) v] [k v]))]
|
69
|
+
;; only apply to maps
|
70
|
+
(postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m)))
|
71
|
+
|
72
|
+
(defn stringify-keys
|
73
|
+
"Recursively transforms all map keys from keywords to strings."
|
74
|
+
{:added "1.1"}
|
75
|
+
[m]
|
76
|
+
(let [f (fn [[k v]] (if (keyword? k) [(name k) v] [k v]))]
|
77
|
+
;; only apply to maps
|
78
|
+
(postwalk (fn [x] (if (map? x) (into {} (map f x)) x)) m)))
|
79
|
+
|
80
|
+
(defn prewalk-replace
|
81
|
+
"Recursively transforms form by replacing keys in smap with their
|
82
|
+
values. Like clojure/replace but works on any data structure. Does
|
83
|
+
replacement at the root of the tree first."
|
84
|
+
{:added "1.1"}
|
85
|
+
[smap form]
|
86
|
+
(prewalk (fn [x] (if (contains? smap x) (smap x) x)) form))
|
87
|
+
|
88
|
+
(defn postwalk-replace
|
89
|
+
"Recursively transforms form by replacing keys in smap with their
|
90
|
+
values. Like clojure/replace but works on any data structure. Does
|
91
|
+
replacement at the leaves of the tree first."
|
92
|
+
{:added "1.1"}
|
93
|
+
[smap form]
|
94
|
+
(postwalk (fn [x] (if (contains? smap x) (smap x) x)) form))
|
@@ -0,0 +1,291 @@
|
|
1
|
+
; Copyright (c) Rich Hickey. 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
|
+
;functional hierarchical zipper, with navigation, editing and enumeration
|
10
|
+
;see Huet
|
11
|
+
|
12
|
+
(ns ^{:doc "Functional hierarchical zipper, with navigation, editing,
|
13
|
+
and enumeration. See Huet"
|
14
|
+
:author "Rich Hickey"}
|
15
|
+
clojure.zip
|
16
|
+
(:refer-clojure :exclude (replace remove next)))
|
17
|
+
|
18
|
+
(defn zipper
|
19
|
+
"Creates a new zipper structure.
|
20
|
+
|
21
|
+
branch? is a fn that, given a node, returns true if can have
|
22
|
+
children, even if it currently doesn't.
|
23
|
+
|
24
|
+
children is a fn that, given a branch node, returns a seq of its
|
25
|
+
children.
|
26
|
+
|
27
|
+
make-node is a fn that, given an existing node and a seq of
|
28
|
+
children, returns a new branch node with the supplied children.
|
29
|
+
root is the root node."
|
30
|
+
[branch? children make-node root]
|
31
|
+
^{:zip/branch? branch? :zip/children children :zip/make-node make-node}
|
32
|
+
[root nil])
|
33
|
+
|
34
|
+
(defn seq-zip
|
35
|
+
"Returns a zipper for nested sequences, given a root sequence"
|
36
|
+
[root]
|
37
|
+
(zipper seq?
|
38
|
+
identity
|
39
|
+
(fn [node children] (with-meta children (meta node)))
|
40
|
+
root))
|
41
|
+
|
42
|
+
(defn vector-zip
|
43
|
+
"Returns a zipper for nested vectors, given a root vector"
|
44
|
+
[root]
|
45
|
+
(zipper vector?
|
46
|
+
seq
|
47
|
+
(fn [node children] (with-meta (vec children) (meta node)))
|
48
|
+
root))
|
49
|
+
|
50
|
+
(defn xml-zip
|
51
|
+
"Returns a zipper for xml elements (as from xml/parse),
|
52
|
+
given a root element"
|
53
|
+
[root]
|
54
|
+
(zipper (complement string?)
|
55
|
+
(comp seq :content)
|
56
|
+
(fn [node children]
|
57
|
+
(assoc node :content (and children (apply vector children))))
|
58
|
+
root))
|
59
|
+
|
60
|
+
(defn node
|
61
|
+
"Returns the node at loc"
|
62
|
+
[loc] (loc 0))
|
63
|
+
|
64
|
+
(defn branch?
|
65
|
+
"Returns true if the node at loc is a branch"
|
66
|
+
[loc]
|
67
|
+
((:zip/branch? (meta loc)) (node loc)))
|
68
|
+
|
69
|
+
(defn children
|
70
|
+
"Returns a seq of the children of node at loc, which must be a branch"
|
71
|
+
[loc]
|
72
|
+
(if (branch? loc)
|
73
|
+
((:zip/children (meta loc)) (node loc))
|
74
|
+
(throw "called children on a leaf node")))
|
75
|
+
|
76
|
+
(defn make-node
|
77
|
+
"Returns a new branch node, given an existing node and new
|
78
|
+
children. The loc is only used to supply the constructor."
|
79
|
+
[loc node children]
|
80
|
+
((:zip/make-node (meta loc)) node children))
|
81
|
+
|
82
|
+
(defn path
|
83
|
+
"Returns a seq of nodes leading to this loc"
|
84
|
+
[loc]
|
85
|
+
(:pnodes (loc 1)))
|
86
|
+
|
87
|
+
(defn lefts
|
88
|
+
"Returns a seq of the left siblings of this loc"
|
89
|
+
[loc]
|
90
|
+
(seq (:l (loc 1))))
|
91
|
+
|
92
|
+
(defn rights
|
93
|
+
"Returns a seq of the right siblings of this loc"
|
94
|
+
[loc]
|
95
|
+
(:r (loc 1)))
|
96
|
+
|
97
|
+
|
98
|
+
(defn down
|
99
|
+
"Returns the loc of the leftmost child of the node at this loc, or
|
100
|
+
nil if no children"
|
101
|
+
[loc]
|
102
|
+
(when (branch? loc)
|
103
|
+
(let [[node path] loc
|
104
|
+
[c & cnext :as cs] (children loc)]
|
105
|
+
(when cs
|
106
|
+
(with-meta [c {:l []
|
107
|
+
:pnodes (if path (conj (:pnodes path) node) [node])
|
108
|
+
:ppath path
|
109
|
+
:r cnext}] (meta loc))))))
|
110
|
+
|
111
|
+
(defn up
|
112
|
+
"Returns the loc of the parent of the node at this loc, or nil if at
|
113
|
+
the top"
|
114
|
+
[loc]
|
115
|
+
(let [[node {l :l, ppath :ppath, pnodes :pnodes r :r, changed? :changed?, :as path}] loc]
|
116
|
+
(when pnodes
|
117
|
+
(let [pnode (peek pnodes)]
|
118
|
+
(with-meta (if changed?
|
119
|
+
[(make-node loc pnode (concat l (cons node r)))
|
120
|
+
(and ppath (assoc ppath :changed? true))]
|
121
|
+
[pnode ppath])
|
122
|
+
(meta loc))))))
|
123
|
+
|
124
|
+
(defn root
|
125
|
+
"zips all the way up and returns the root node, reflecting any
|
126
|
+
changes."
|
127
|
+
[loc]
|
128
|
+
(if (= :end (loc 1))
|
129
|
+
(node loc)
|
130
|
+
(let [p (up loc)]
|
131
|
+
(if p
|
132
|
+
(recur p)
|
133
|
+
(node loc)))))
|
134
|
+
|
135
|
+
(defn right
|
136
|
+
"Returns the loc of the right sibling of the node at this loc, or nil"
|
137
|
+
[loc]
|
138
|
+
(let [[node {l :l [r & rnext :as rs] :r :as path}] loc]
|
139
|
+
(when (and path rs)
|
140
|
+
(with-meta [r (assoc path :l (conj l node) :r rnext)] (meta loc)))))
|
141
|
+
|
142
|
+
(defn rightmost
|
143
|
+
"Returns the loc of the rightmost sibling of the node at this loc, or self"
|
144
|
+
[loc]
|
145
|
+
(let [[node {l :l r :r :as path}] loc]
|
146
|
+
(if (and path r)
|
147
|
+
(with-meta [(last r) (assoc path :l (apply conj l node (butlast r)) :r nil)] (meta loc))
|
148
|
+
loc)))
|
149
|
+
|
150
|
+
(defn left
|
151
|
+
"Returns the loc of the left sibling of the node at this loc, or nil"
|
152
|
+
[loc]
|
153
|
+
(let [[node {l :l r :r :as path}] loc]
|
154
|
+
(when (and path (seq l))
|
155
|
+
(with-meta [(peek l) (assoc path :l (pop l) :r (cons node r))] (meta loc)))))
|
156
|
+
|
157
|
+
(defn leftmost
|
158
|
+
"Returns the loc of the leftmost sibling of the node at this loc, or self"
|
159
|
+
[loc]
|
160
|
+
(let [[node {l :l r :r :as path}] loc]
|
161
|
+
(if (and path (seq l))
|
162
|
+
(with-meta [(first l) (assoc path :l [] :r (concat (rest l) [node] r))] (meta loc))
|
163
|
+
loc)))
|
164
|
+
|
165
|
+
(defn insert-left
|
166
|
+
"Inserts the item as the left sibling of the node at this loc,
|
167
|
+
without moving"
|
168
|
+
[loc item]
|
169
|
+
(let [[node {l :l :as path}] loc]
|
170
|
+
(if (nil? path)
|
171
|
+
(throw "Insert at top")
|
172
|
+
(with-meta [node (assoc path :l (conj l item) :changed? true)] (meta loc)))))
|
173
|
+
|
174
|
+
(defn insert-right
|
175
|
+
"Inserts the item as the right sibling of the node at this loc,
|
176
|
+
without moving"
|
177
|
+
[loc item]
|
178
|
+
(let [[node {r :r :as path}] loc]
|
179
|
+
(if (nil? path)
|
180
|
+
(throw "Insert at top")
|
181
|
+
(with-meta [node (assoc path :r (cons item r) :changed? true)] (meta loc)))))
|
182
|
+
|
183
|
+
(defn replace
|
184
|
+
"Replaces the node at this loc, without moving"
|
185
|
+
[loc node]
|
186
|
+
(let [[_ path] loc]
|
187
|
+
(with-meta [node (assoc path :changed? true)] (meta loc))))
|
188
|
+
|
189
|
+
(defn edit
|
190
|
+
"Replaces the node at this loc with the value of (f node args)"
|
191
|
+
[loc f & args]
|
192
|
+
(replace loc (apply f (node loc) args)))
|
193
|
+
|
194
|
+
(defn insert-child
|
195
|
+
"Inserts the item as the leftmost child of the node at this loc,
|
196
|
+
without moving"
|
197
|
+
[loc item]
|
198
|
+
(replace loc (make-node loc (node loc) (cons item (children loc)))))
|
199
|
+
|
200
|
+
(defn append-child
|
201
|
+
"Inserts the item as the rightmost child of the node at this loc,
|
202
|
+
without moving"
|
203
|
+
[loc item]
|
204
|
+
(replace loc (make-node loc (node loc) (concat (children loc) [item]))))
|
205
|
+
|
206
|
+
(defn next
|
207
|
+
"Moves to the next loc in the hierarchy, depth-first. When reaching
|
208
|
+
the end, returns a distinguished loc detectable via end?. If already
|
209
|
+
at the end, stays there."
|
210
|
+
[loc]
|
211
|
+
(if (= :end (loc 1))
|
212
|
+
loc
|
213
|
+
(or
|
214
|
+
(and (branch? loc) (down loc))
|
215
|
+
(right loc)
|
216
|
+
(loop [p loc]
|
217
|
+
(if (up p)
|
218
|
+
(or (right (up p)) (recur (up p)))
|
219
|
+
[(node p) :end])))))
|
220
|
+
|
221
|
+
(defn prev
|
222
|
+
"Moves to the previous loc in the hierarchy, depth-first. If already
|
223
|
+
at the root, returns nil."
|
224
|
+
[loc]
|
225
|
+
(if-let [lloc (left loc)]
|
226
|
+
(loop [loc lloc]
|
227
|
+
(if-let [child (and (branch? loc) (down loc))]
|
228
|
+
(recur (rightmost child))
|
229
|
+
loc))
|
230
|
+
(up loc)))
|
231
|
+
|
232
|
+
(defn end?
|
233
|
+
"Returns true if loc represents the end of a depth-first walk"
|
234
|
+
[loc]
|
235
|
+
(= :end (loc 1)))
|
236
|
+
|
237
|
+
(defn remove
|
238
|
+
"Removes the node at loc, returning the loc that would have preceded
|
239
|
+
it in a depth-first walk."
|
240
|
+
[loc]
|
241
|
+
(let [[node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc]
|
242
|
+
(if (nil? path)
|
243
|
+
(throw "Remove at top")
|
244
|
+
(if (pos? (count l))
|
245
|
+
(loop [loc (with-meta [(peek l) (assoc path :l (pop l) :changed? true)] (meta loc))]
|
246
|
+
(if-let [child (and (branch? loc) (down loc))]
|
247
|
+
(recur (rightmost child))
|
248
|
+
loc))
|
249
|
+
(with-meta [(make-node loc (peek pnodes) rs)
|
250
|
+
(and ppath (assoc ppath :changed? true))]
|
251
|
+
(meta loc))))))
|
252
|
+
|
253
|
+
(comment
|
254
|
+
|
255
|
+
(load-file "/Users/rich/dev/clojure/src/zip.clj")
|
256
|
+
(refer 'zip)
|
257
|
+
(def data '[[a * b] + [c * d]])
|
258
|
+
(def dz (vector-zip data))
|
259
|
+
|
260
|
+
(right (down dz))
|
261
|
+
(right (down (right (right (down dz)))))
|
262
|
+
(lefts (right (down (right (right (down dz))))))
|
263
|
+
(rights (right (down (right (right (down dz))))))
|
264
|
+
(up (up (right (down (right (right (down dz)))))))
|
265
|
+
(path (right (down (right (right (down dz))))))
|
266
|
+
|
267
|
+
(-> dz down right right down right)
|
268
|
+
(-> dz down right right down right (replace '/) root)
|
269
|
+
(-> dz next next (edit str) next next next (replace '/) root)
|
270
|
+
(-> dz next next next next next next next next next remove root)
|
271
|
+
(-> dz next next next next next next next next next remove (insert-right 'e) root)
|
272
|
+
(-> dz next next next next next next next next next remove up (append-child 'e) root)
|
273
|
+
|
274
|
+
(end? (-> dz next next next next next next next next next remove next))
|
275
|
+
|
276
|
+
(-> dz next remove next remove root)
|
277
|
+
|
278
|
+
(loop [loc dz]
|
279
|
+
(if (end? loc)
|
280
|
+
(root loc)
|
281
|
+
(recur (next (if (= '* (node loc))
|
282
|
+
(replace loc '/)
|
283
|
+
loc)))))
|
284
|
+
|
285
|
+
(loop [loc dz]
|
286
|
+
(if (end? loc)
|
287
|
+
(root loc)
|
288
|
+
(recur (next (if (= '* (node loc))
|
289
|
+
(remove loc)
|
290
|
+
loc)))))
|
291
|
+
)
|