Fixed Behaviour of some of the operations; added indentation-aware splice.

Author: Yannick Scherer

CHANGES.md

@@ -18,6 +18,7 @@
   - `insert-left`
   - `insert-right
   - `remove`
+  - `splice`
 
 ### 0.2.0
 

examples/rewrite_clj/cljx.clj

@@ -1,8 +1,6 @@
 (ns ^{ :doc "Implementation of lynaghk/cljx's basic semantics using rewrite-clj."}
   rewrite-clj.cljx
-  (:require [rewrite-clj.parser :as p]
-            [rewrite-clj.zip :as z]
-            [rewrite-clj.printer :as prn]))
+  (:require [rewrite-clj.zip :as z]))
 
 ;; ## Semantics
 ;;
@@ -36,10 +34,14 @@
           (or (.startsWith nm "+") (.startsWith nm "-")))))))
 
 (defn- replace-with-spaces
-  "Replace the given reader macro node with spaces."
+  "Replace the given reader macro node with spaces. The resulting zipper
+   will be on the first element following it."
   [zloc]
-  (let [w (prn/estimate-length (z/node zloc))]
-    (-> zloc (z/prepend-space w) z/remove)))
+  (let [w (z/length zloc)]
+    (-> zloc 
+      (z/prepend-space w)        ;; add space
+      z/remove*                  ;; remove original (without removing an extra space)
+      z/next)))                  ;; go to following node
 
 (defn- remove-reader-macro
   "Remove the macro part of the given reader macro node."
@@ -70,7 +72,12 @@
 
 (defn run-cljx-test
   [profiles]
-  (let [data (z/of-string ";; Test it!\n(defn my-inc\n  [x]\n  #+debug (println \"inc: x =\" x #-nomark \"[debug]\")\n  (+ x 1))")]
+  (let [data (z/of-string ";; Test it!
+(defn my-inc
+  [x]
+  #+debug (println \"inc: x =\" x #-nomark \"[debug]\" {:a 0
+                                                    :b 1})
+  (+ x 1))")]
     (println "Original Code:")
     (z/print-root data)
     (println "\n")

src/rewrite_clj/zip.clj

@@ -71,6 +71,7 @@
 (def leftmost* z/leftmost)
 (def replace* z/replace)
 (def edit* z/edit)
+(def remove* z/remove)
 
 ;; ## Convenience Functions
 

src/rewrite_clj/zip/edit.clj

@@ -60,19 +60,29 @@
     (z/replace zloc (conv/->tree (apply f form args)))))
 
 (defn remove
-  "Remove value at the given zipper location. Will remove a single whitespace following the 
-   node, too."
+  "Remove value at the given zipper location. Returns the first non-whitespace node 
+   that would have preceded it in a depth-first walk. Will remove a single whitespace
+   character following the current node."
   [zloc]
-  (let [rloc (z/remove zloc)
-        ws (z/right rloc)]
-    (->> (if (= (zc/tag ws) :whitespace)
-           (let [w (count (zc/value ws))]
-             (-> ws (zc/append-space (dec w)) z/remove))
-           rloc)
+  (let [ws (z/right zloc)
+        zloc (or
+               (when (= (zc/tag ws) :whitespace)
+                 (let [w (dec (zc/length ws))]
+                   (when-not (neg? w)
+                     (-> ws z/remove (zc/append-space w)))))
+               zloc)]
+    (->> zloc 
+      z/remove 
       (zc/skip-whitespace z/prev))))
 
 (defn splice
-  "Add the current node's children to the parent branch (in place of the current node)."
+  "Add the current node's children to the parent branch (in place of the current node).
+   The resulting zipper will be positioned on the first non-whitespace \"child\"."
   [zloc]
-  (let [ch (z/children zloc)]
-    (-> (reduce z/insert-right zloc (reverse ch)) z/remove z/right)))
+  (if-not (z/branch? zloc)
+    zloc
+    (let [ch (z/children zloc)]
+      (-> (reduce z/insert-right zloc (reverse ch))
+        z/remove
+        z/next
+        zc/skip-whitespace))))

src/rewrite_clj/zip/indent.clj

@@ -94,13 +94,15 @@
   "Searches for a multi-line node right of the given location (starting on
    the same line). If there is none, `nil` is returned."
   [zloc]
-  (loop [zloc zloc]
-    (when-not (or (not zloc) (z/end? zloc) (zc/linebreak? zloc)) 
-      (if-not (z/branch? zloc)
-        (recur (z/right zloc))
-        (if (zf/find-tag zloc z/next :newline)
-          zloc
-          (recur (z/right zloc)))))))
+  (or
+    (loop [zloc zloc]
+      (when-not (or (not zloc) (z/end? zloc) (zc/linebreak? zloc)) 
+        (if-not (z/branch? zloc)
+          (recur (z/right zloc))
+          (if (zf/find-tag (zc/subzip zloc) z/next :newline)
+            zloc
+            (recur (z/right zloc))))))
+    (recur (z/up zloc))))
 
 ;; ## Low-Level Indentation
 
@@ -151,11 +153,11 @@
 ;;
 ;; The insert function should return the inserted element.
 
-(defn insert-left
+(defn- insert-left*
   "Insert the given sexpr to the left of the given zipper location and indent
    accordingly."
-  [zloc v]
-  (let [rloc (ze/insert-left zloc v)
+  [f zloc v]
+  (let [rloc (f zloc v)
         delta (inc (zc/length (-> rloc z/left z/left)))]
     (if (zero? delta) rloc 
       (if-let [iloc (find-node-to-indent rloc)]
@@ -164,11 +166,16 @@
           (zc/move-to-node rloc))
         rloc))))
 
-(defn insert-right
+(def insert-left 
+  "Insert the given sexpr to the left of the given zipper location and indent
+   accordingly."
+  (partial insert-left* ze/insert-left))
+
+(defn insert-right*
   "Insert the given sexpr to the right of the given zipper location and indent
    accordingly."
-  [zloc v]
-  (let [rloc (ze/insert-right zloc v)
+  [f zloc v]
+  (let [rloc (f zloc v)
         delta (inc (zc/length (-> rloc z/right z/right)))]
     (if (zero? delta) rloc 
       (if-let [iloc (find-node-to-indent (-> rloc z/right z/right))]
@@ -177,16 +184,38 @@
           (zc/move-to-node rloc))
         rloc))))
 
+(def insert-right
+  "Insert the given sexpr to the right of the given zipper location and indent
+   accordingly."
+  (partial insert-right* ze/insert-right))
+
 ;; ## Remove + Indent
 
 (defn remove
   "Remove the node at the given zipper location and indent accordingly."
   [zloc]
-  (let [delta (dec (- (zc/length zloc)))
+  (let [delta (- -1 (zc/length zloc))
         rloc (ze/remove zloc)]
     (if (zero? delta) rloc 
-      (if-let [iloc (find-node-to-indent (-> rloc z/next zc/skip-whitespace))]
+      (if-let [iloc (find-node-to-indent (->> rloc z/next (zc/skip-whitespace z/next)))]
         (-> iloc 
           (indent-children delta) 
           (zc/move-to-node rloc))
         rloc))))
+
+(defn splice
+  "Add the current node's children to the parent branch (in place of the current node).
+   The resulting zipper will be positioned on the first non-whitespace \"child\"."
+  [zloc]
+  (if-not (z/branch? zloc)
+    zloc
+    (let [w0 (zc/length zloc)
+          w1 (apply + (map p/estimate-length (z/children zloc)))
+          delta (- w1 w0)
+          rloc (ze/splice zloc)]
+      (if (zero? delta) rloc 
+        (if-let [iloc (find-node-to-indent rloc)]
+          (-> iloc 
+            (indent-children delta) 
+            (zc/move-to-node rloc))
+          rloc)))))

src/rewrite_clj/zip/walk.clj

@@ -3,18 +3,18 @@
   rewrite-clj.zip.walk
   (:require [fast-zip.core :as z]
             [rewrite-clj.zip.core :as c :only [subzip]]
-            [rewrite-clj.zip.move :as m :only [next]]))
+            [rewrite-clj.zip.move :as m :only [next]]
+            [rewrite-clj.zip.find :as f :only [find]]))
 
 (defn prewalk
   "Perform a depth-first pre-order traversal starting at the given zipper location
    and apply the given function to each child node. If a predicate `p?` is given, 
    only apply the function to nodes matching it."
   ([zloc f] (prewalk zloc (constantly true) f))
   ([zloc p? f]
-   (loop [loc (c/subzip zloc)
-          prv loc]
-     (if-let [n0 (find loc m/next p?)]
+   (loop [loc zloc]
+     (if-let [n0 (f/find loc m/next p?)]
        (if-let [n1 (f n0)]
-         (recur (m/next n1) n1)
-         (recur (m/next n0) n0))
-       (z/replace zloc (z/root prv))))))
+         (recur (m/next n1))
+         (recur (m/next n0)))
+       (c/move-to-node loc zloc)))))