Taking care with comments in 'remove'.

Author: Yannick Scherer

src/rewrite_clj/zip/core.clj

@@ -7,8 +7,7 @@
 
 ;; ## Zipper
 
-(declare skip-whitespace
-         skip-whitespace-left)
+(declare skip-whitespace)
 
 (defn- z-branch?
   [node]
@@ -62,8 +61,19 @@
   (when zloc
     (prn/estimate-length (z/node zloc))))
 
+(defn comment?
+  "Check if the node at the current zipper location is a comment."
+  [zloc]
+  (= (tag zloc) :comment))
+
 (defn whitespace?
-  "Check if the node at the current zipper location is whitespace or comment."
+  "Check if the node at the current zipper location is whitespace (including linebreak)."
+  [zloc]
+  (contains? #{:whitespace :newline} (tag zloc)))
+
+(defn whitespace-or-comment?
+  "Check if the node at the current zipper location is whitespace (including linebreak)
+   or comment."
   [zloc]
   (contains? #{:comment :whitespace :newline} (tag zloc)))
 
@@ -72,16 +82,6 @@
   [zloc]
   (= (tag zloc) :newline))
 
-(defn leftmost?
-  "Check if the given zipper is at the leftmost non-whitespace position."
-  [zloc]
-  (nil? (skip-whitespace-left (z/left zloc))))
-
-(defn rightmost?
-  "Check if the given zipper is at the rightmost non-whitespace position."
-  [zloc]
-  (nil? (skip-whitespace (z/right zloc))))
-
 ;; ## Skip
 
 (defn skip
@@ -99,13 +99,23 @@
   "Apply movement function (default: `clojure.z/right`) until a non-whitespace/non-comment
    element is reached."
   ([zloc] (skip-whitespace z/right zloc))
-  ([f zloc] (skip f whitespace? zloc)))
+  ([f zloc] (skip f whitespace-or-comment? zloc)))
 
 (defn skip-whitespace-left
   "Move left until a non-whitespace/non-comment element is reached."
   [zloc]
   (skip-whitespace z/left zloc))
 
+(defn leftmost?
+  "Check if the given zipper is at the leftmost non-whitespace position."
+  [zloc]
+  (nil? (skip-whitespace-left (z/left zloc))))
+
+(defn rightmost?
+  "Check if the given zipper is at the rightmost non-whitespace position."
+  [zloc]
+  (nil? (skip-whitespace (z/right zloc))))
+
 ;; ## Whitespace Nodes
 
 (defn prepend-space

src/rewrite_clj/zip/edit.clj

@@ -67,21 +67,12 @@
 (defn- remove-trailing-space
   "Remove all whitespace following a given node."
   [zloc]
-  (loop [zloc zloc]
-    (if-let [rloc (z/right zloc)]
-      (if (zc/whitespace? rloc)
-        (recur (zu/remove-right zloc))
-        zloc)
-      zloc)))
+  (zu/remove-right-while zloc zc/whitespace?))
 
 (defn- remove-preceding-space
+  "Remove all whitespace preceding a given node."
   [zloc]
-  (loop [zloc zloc]
-    (if-let [lloc (z/left zloc)]
-      (if (zc/whitespace? lloc)
-        (recur (zu/remove-left zloc))
-        zloc)
-      zloc)))
+  (zu/remove-left-while zloc zc/whitespace?))
 
 (defn remove
   "Remove value at the given zipper location. Returns the first non-whitespace node 
@@ -95,9 +86,10 @@
      [1 [2 3] 4] => [1 [2 3]]
      [1 [2 3] 4] => [[2 3] 4]
 
-  If a node is located rightmost, both preceding and trailing spaces are removed, otherwise only
-  trailing spaces are touched. This means that a following element (no matter whether on the
-  same line or not) will end up in the same position (line/column) as the removed one."
+   If a node is located rightmost, both preceding and trailing spaces are removed, otherwise only
+   trailing spaces are touched. This means that a following element (no matter whether on the
+   same line or not) will end up in the same position (line/column) as the removed one, 
+   _unless_ a comment lies between the original node and the neighbour."
   [zloc]
   (let [zloc (if (zc/rightmost? zloc) (remove-preceding-space zloc) zloc)
         zloc (-> zloc remove-trailing-space z/remove)]

src/rewrite_clj/zip/utils.clj

@@ -55,3 +55,25 @@
         (.make-node zloc)
         (first (.r path))
         (assoc path :r (clojure.core/next (.r path)) :changed? true)))))
+
+(defn remove-right-while
+  "Remove elements to the right of the current zipper location as long as
+   the given predicate matches."
+  [zloc p?]
+  (loop [zloc zloc]
+    (if-let [rloc (z/right zloc)]
+      (if (p? rloc)
+        (recur (remove-right zloc))
+        zloc)
+      zloc)))
+
+(defn remove-left-while
+  "Remove elements to the left of the current zipper location as long as
+   the given predicate matches."
+  [zloc p?]
+  (loop [zloc zloc]
+    (if-let [lloc (z/left zloc)]
+      (if (p? lloc)
+        (recur (remove-left zloc))
+        zloc)
+      zloc)))

test/rewrite_clj/zip_test.clj

@@ -111,6 +111,14 @@
     (let [r0 (-> root z/down z/remove)]
       (z/sexpr r0) => [2]
       (z/->root-string r0) => "[2]"))
+  (let [root (z/of-string "[1 ;;comment\n 2]")]
+    (z/sexpr root) => [1 2]
+    (let [r0 (-> root z/down z/remove)]
+      (z/sexpr r0) => [2]
+      (z/->root-string r0) => "[;;comment\n 2]") 
+    (let [r0 (-> root z/down z/right z/remove)]
+      (z/sexpr (z/up r0)) => [1]
+      (z/->root-string r0) => "[1 ;;comment\n]"))
   (let [root (z/of-string "[1 [2 3] 4]")]
     (z/sexpr root) => [1 [2 3] 4]
     (let [r0 (-> root z/down z/remove*)]