Fix #54: support slurping from within string (#55)

Author: borkdude

CHANGELOG.md

@@ -1,5 +1,9 @@
 # Changelog
 
+## 0.3.3
+
+- Fix [#54](https://github.com/nextjournal/clojure-mode/issues/54): support slurping from within string literal
+
 ## 0.3.2
 
 - Bump squint to 0.7.105

package.json

@@ -23,7 +23,7 @@
     "@lezer/highlight": "^1.0.0",
     "@lezer/lr": "^1.0.0",
     "@nextjournal/lezer-clojure": "1.0.0",
-    "squint-cljs": "0.7.105",
+    "squint-cljs": "0.7.111",
     "w3c-keyname": "^2.2.4"
   },
   "comments": {

src-shared/nextjournal/clojure_mode/commands.cljc

@@ -112,15 +112,15 @@
 (defn nav [dir]
   (fn [state]
     (u/update-ranges state
-      (j/fn [^:js {:as range :keys [from to empty]}]
+      (j/fn [^:js {:keys [from to empty]}]
         (if empty
           {:cursor (nav-position state from dir)}
           {:cursor (j/get (u/from-to from to) (case dir -1 :from 1 :to))})))))
 
 (defn nav-select [dir]
   (fn [^js state]
     (u/update-ranges state
-      (j/fn [^:js {:as range :keys [from to empty]}]
+      (j/fn [^:js {:keys [from to empty]}]
         (if empty
           {:range (n/balanced-range state from (nav-position state from dir))}
           {:range (j/let [^:js {:keys [from to]} (u/from-to from to)]
@@ -136,40 +136,46 @@
 
 (def log js/console.log)
 
+(defn ->str [x]
+  (js/JSON.stringify (str x)))
+
 (defn slurp [direction]
   (fn [^js state]
     (u/update-ranges state
-      (j/fn [^:js {:as range :keys [from to empty]}]
+      (j/fn [^:js {:keys [from empty]}]
         (when empty
           (when-let [parent (n/closest (n/tree state from)
-                                       (every-pred n/coll?
+                                       (every-pred (some-fn n/coll?
+                                                            n/string?)
                                                    #(not
                                                      (case direction
                                                         1 (some-> % n/with-prefix n/right n/end-edge?)
-                                                       -1 (some-> % n/with-prefix n/left n/start-edge?)))))]
-            (when-let [target (case direction 1 (first (remove n/line-comment? (n/rights (n/with-prefix parent))))
-                                              -1 (first (remove n/line-comment? (n/lefts (n/with-prefix parent)))))]
-              {:cursor/mapped from
-               :changes (case direction
-                          1
-                          (let [edge (n/down-last parent)]
-                            [{:from (-> target n/end)
-                              :insert (n/name edge)}
-                             (-> edge
-                                 n/from-to
-                                 (j/assoc! :insert " "))])
-                          -1
-                          (let [^string edge (n/left-edge-with-prefix state parent)
-                                start (n/start (n/with-prefix parent))]
-                            [{:from start
-                              :to (+ start (count edge))
-                              :insert " "}
-                             {:from (n/start target)
-                              :insert edge}]))})))))))
+                                                        -1 (some-> % n/with-prefix n/left n/start-edge?)))))]
+            (let [str? (n/string? parent)]
+              (when-let [target (case direction 1 (first (remove n/line-comment? (n/rights (n/with-prefix parent))))
+                                      -1 (first (remove n/line-comment? (n/lefts (n/with-prefix parent)))))]
+                {:cursor/mapped from
+                 :changes (case direction
+                            1
+                            (let [edge (n/down-last parent)]
+                              #js [#js {:from (-> target n/end)
+                                    :insert (n/name edge)}
+                               (-> edge
+                                   n/from-to
+                                   (cond->
+                                       (not str?) (j/assoc! :insert " ")))])
+                            -1
+                            (let [^string edge (n/left-edge-with-prefix state parent)
+                                  start (n/start (n/with-prefix parent))]
+                              #js [(cond-> #js {:from start
+                                                :to (+ start (count edge))}
+                                     (not str?) (j/assoc! :insert " "))
+                                   #js {:from (n/start target)
+                                    :insert edge}]))}))))))))
 
 (defn barf [direction]
   (fn [^js state]
-    (->> (j/fn [^:js {:as range :keys [from to empty]}]
+    (->> (j/fn [^:js {:keys [from empty]}]
            (when empty
              (when-let [parent (-> (n/tree state from)
                                    (n/closest n/coll?))]

test/nextjournal/clojure_mode_tests.cljc

@@ -8,11 +8,14 @@
             [nextjournal.clojure-mode.commands :as commands]
             [nextjournal.clojure-mode.extensions.formatting :as format]
             [nextjournal.clojure-mode.extensions.eval-region :as eval-region]
+            [nextjournal.scratch]
             #?@(:squint []
                 :cljs [[nextjournal.livedoc :as livedoc]])
             #?(:squint ["assert" :as assert]))
   #?(:squint (:require-macros [nextjournal.clojure-mode-tests.macros :refer [deftest are testing is]])))
 
+#_(js/process.exit 0)
+
 (def extensions
   (.concat cm-clojure/default-extensions (eval-region/extension #js {}))
   ;; optionally test with live grammar
@@ -249,7 +252,7 @@
       "(<a) b>" "<(a) b>"
       ))
 
-  (deftest slurp
+  (deftest slurp-test
     (are [input dir expected]
         (= (apply-f (commands/slurp dir) input) expected)
       "(|) a" 1 "(|a)"
@@ -272,7 +275,9 @@
       "('is-d|ata) :x" 1 "('is-d|ata :x)"
       "('xy|z 1) 2" 1 "('xy|z 1 2)"
       "'ab|c 1" 1 "'ab|c 1"
-      ))
+
+      "\"x|\" 1" 1 "\"x| 1\""
+      "1 \"x|\"" -1 "\"1 x|\""))
 
   #?(:squint nil
      :cljs

test/nextjournal/scratch.cljs

@@ -0,0 +1,15 @@
+(ns nextjournal.scratch
+  (:require [nextjournal.clojure-mode.commands :as commands]
+            [nextjournal.clojure-mode :as cm-clojure]
+            [nextjournal.clojure-mode.extensions.eval-region :as eval-region]
+            [nextjournal.clojure-mode.test-utils :as test-utils]))
+
+(comment
+  (def extensions
+    (.concat cm-clojure/default-extensions (eval-region/extension #js {})))
+
+  (def apply-f (partial test-utils/apply-f extensions))
+
+  (js/console.log "a ;; hello\n(|)")
+  (js/console.log (apply-f (commands/slurp -1) "a ;; hello\n(|)")))
+

yarn.lock

@@ -1176,10 +1176,10 @@ source-map@^0.5.6:
   resolved "https://registry.npmjs.org/source-map/-/source-map-0.5.7.tgz"
   integrity sha1-igOdLRAh0i0eoUyA2OpGi6LvP8w=
 
-[email protected].105:
-  version "0.7.105"
-  resolved "https://registry.yarnpkg.com/squint-cljs/-/squint-cljs-0.7.105.tgz#848a588aaf5d19593b2d8b24bad026382435a4ff"
-  integrity sha512-YtnPewo1ZM5p9kaC6j/rNw4F/FzsLaAS61Vhikw6z6dRJvns/Y/3rwGcb8BCoD6Abx23/frlk0B4/xhedgCbUw==
+[email protected].111:
+  version "0.7.111"
+  resolved "https://registry.yarnpkg.com/squint-cljs/-/squint-cljs-0.7.111.tgz#1441933ed7162d5590570875394c12b181db9427"
+  integrity sha512-BZSq3OxqdRN1xpIYBOWDI03tppaOLxtmapUDsS32ViKg2anu6fo44qh3qGAvXcapDwc1mkIS6A2y2GA+SgB2Rw==
   dependencies:
     chokidar "^3.5.3"