[editor] add slurp/barf

[bobbicodes]

This has all been figured out before by the people at Nextjournal: https://github.com/nextjournal/clojure-mode/blob/7b911bf6feab0f67b60236036d124997627cbe5e/src/nextjournal/clojure_mode/commands.cljs#L138

It just needs to be translated into JavaScript.

The function doing most of the work is update-ranges:

(defn update-ranges
  "Applies `f` to each range in `state` (see `changeByRange`)"
  ([state f]
   (update-ranges state nil f))
  ([^js state tr-specs f ]
   (->> (fn [range]
          (or (when-some [result (f range)]
                (map-cursor range state result))
              #js{:range range}))
        (.changeByRange state)
        (#(j/extend! % tr-specs))
        (.update state))))

Notice the comment, (see changeByRange). This is referring to the Codemirror API: https://codemirror.net/examples/change/

[bobbicodes]

I've simplified the commands by only implementing the forward versions, which are the only ones I've ever used. Tbh I barely ever use barf, I only use slurp forward in the case that I want to add a form at the beginning of a list, which is quite often.

slurp

parent

(n/closest (n/tree state from)
           (every-pred n/coll?
                       #(not (some-> % n/with-prefix n/right n/end-edge?))))

target

(first (remove n/line-comment? (n/rights (n/with-prefix parent))))

cursor - from

changes

(let [edge (n/down-last parent)]
  [{:from   (-> target n/end)
    :insert (n/name edge)}
   (-> edge n/from-to (j/assoc! :insert " "))])

barf

parent

(-> (n/tree state from) (n/closest n/coll?))

target

(some->> (n/down-last parent)
         n/lefts
         (remove n/line-comment?)
         (drop 1)
         first)

cursor - (min (n/end target) from)

changes

[{:from   (n/end target)
  :insert (n/name (n/down-last parent))}
 (-> (n/down-last parent)
     n/from-to
     (j/assoc! :insert " "))]

[bobbicodes]

This is the general idea. They will just need to be modified to conform to the specs above.

function slurp(view) {
    var doc = view.state.doc.toString()
    var pos = mainSelection(view.state).from
    var node = tree(view.state, pos)
    var parent = up(node)
    console.log("rights")
    var target = rights(node)[0]
    var edge = parent.lastChild
    var s1 = right(node).from
    var e1 = right(node).to
    var s2 = node.from + 1
    var e2 = node.to
    view.dispatch({
        changes: { from: pos, to: 7,
            insert: doc.substring(s1, e1) + doc.substring(s2, e2)}
    })
    return true
}

function barf(view) {
    var doc = view.state.doc.toString()
    var pos = mainSelection(view.state).from
    var node = tree(view.state, pos)
    var parent = up(node)
    var target = lefts(node)[0]
    var edge = parent.lastChild
    var s1 = node.to - 1
    var e1 = node.to
    var s2 = node.from + 1
    var e2 = node.to - 1
    view.dispatch({
        changes: { from: pos, to: 7,
            insert: doc.substring(s1, e1) + doc.substring(s2, e2)}
    })
    return true
}

Note: These will convert the form ()range to (range) and back again with the cursor in the second position, but will fail on anything else. A decent start.

[bobbicodes]

The Clojure functions above for defining the node parent, target, cursor, and changes values are dependent on numerous sub-processes, so I'll enumerate them here for completeness. Then I'm hoping that the clearest implementation should follow naturally.

slurp

parent

(n/closest (n/tree state from)
           (every-pred n/coll?
                       #(not (some-> % n/with-prefix n/right n/end-edge?))))

closest

(defn ancestors [^js node]
  (when-some [parent (up node)]
    (cons parent
          (lazy-seq (ancestors parent)))))

(defn ^js closest [node pred]
  (if (pred node)
    node
    (reduce (fn [_ x]
              (if (pred x) (reduced x) nil))
            nil (ancestors node))))

tree

(defn ^js tree
  "Returns a (Tree https://lezer.codemirror.net/docs/ref/#common.Tree) for editor state
  or the SyntaxNode at pos.

  If pos is given and we're using Clojure language support embedded in other languages (e.g. markdown)
  enters overlaid Clojure nodes (https://lezer.codemirror.net/docs/ref/#common.MountedTree)."
  ([^js state] (language/syntaxTree state))
  ([^js state pos] (-> state language/syntaxTree (.resolveInner pos)))
  ([^js state pos dir] (-> state language/syntaxTree (.resolveInner pos dir))))

with-prefix

(defn guard [x f] (when (f x) x))

(defn ^js up [node] (.-parent ^js node))

(defn ^js down [node]
  {:pre [(not (fn? (.-lastChild ^js node)))]}
  (.-firstChild ^js node))

(defn prefix [node]
  (when-some [parent (up node)]
    (or (u/guard parent prefix-container?)
        (u/guard (down parent) prefix-edge?))))

(defn with-prefix [node]
  (cond-> node
    (prefix node) up))

right

(defn ^number end [^js node]
  {:pre [(.-to node)]}
  (.-to node))

(defn ^js right [node]
  (.childAfter (up node) (end node))
  #_(.-nextSibling node))

end-edge?

(defn ^lz-tree/NodeType type [^js node] (.-type node))
(defn ^boolean end-edge-type? [node-type] (.prop ^js node-type end-edge-prop))
(defn ^boolean end-edge? [n] (end-edge-type? (type n)))

target

(first (remove n/line-comment? (n/rights (n/with-prefix parent))))

line-comment?

(defn line-comment? [node] (identical? "LineComment" (name node)))

rights

(defn ^js right [node]
  (.childAfter (up node) (end node))
  #_(.-nextSibling node))

(defn rights [node]
  (take-while identity (iterate right (right node))))

changes

(defn ^js down-last [node]
  {:pre [(not (fn? (.-lastChild ^js node)))]}
  (.-lastChild ^js node))

(defn ^string name [^js node] (.-name node))

(defn ^number start [^js node]
  {:pre [(.-from node)]}
  (.-from node))

(defn from-to
  ([from to] #js{:from from :to to})
  ([node]
   (from-to (start node) (end node))))

(let [edge (n/down-last parent)]
  [{:from   (-> target n/end)
    :insert (n/name edge)}
   (-> edge n/from-to (j/assoc! :insert " "))])

[bobbicodes]

barf

parent

(-> (n/tree state from) (n/closest n/coll?))

target

(some->> (n/down-last parent)
         n/lefts
         (remove n/line-comment?)
         (drop 1)
         first)

cursor

(min (n/end target) from)

changes

[{:from   (n/end target)
  :insert (n/name (n/down-last parent))}
 (-> (n/down-last parent)
     n/from-to
     (j/assoc! :insert " "))]