diff --git a/cog.scm b/cog.scm index 24d73a6..1ee9532 100644 --- a/cog.scm +++ b/cog.scm @@ -1,3 +1,3 @@ (define package-name 'paredit.hx) -(define version "0.1.0") +(define version "0.2.0") (define dependencies '()) diff --git a/src/lang.scm b/src/lang.scm index 98893a4..444736f 100644 --- a/src/lang.scm +++ b/src/lang.scm @@ -107,11 +107,13 @@ ;;;; Clojure's comma counts) ;;;; --------------------------------------------------------------------------- -;;@doc Is char `c` whitespace in `lang`? +;;@doc +;; Is char `c` whitespace in `lang`? (define (ws-char? lang c) (and (member c (Language-whitespace lang)) #t)) -;;@doc `s` with leading `lang`-whitespace removed. +;;@doc +;; `s` with leading `lang`-whitespace removed. (define (trim-leading-ws lang s) (let ([len (string-length s)]) (let loop ([i 0]) @@ -119,7 +121,8 @@ (loop (+ i 1)) (substring s i len))))) -;;@doc `s` with trailing `lang`-whitespace removed. +;;@doc +;; `s` with trailing `lang`-whitespace removed. (define (trim-trailing-ws lang s) (let loop ([n (string-length s)]) (if (and (> n 0) (ws-char? lang (string-ref s (- n 1)))) diff --git a/src/ops/barf.scm b/src/ops/barf.scm index c8e7df4..633aea8 100644 --- a/src/ops/barf.scm +++ b/src/ops/barf.scm @@ -53,28 +53,34 @@ [(null? children) (set-status! "paredit: nothing to barf")] [else (let* ([rope (current-rope)] - [edges (get-form-edges rope form)] - [open-end (cdr (car edges))] - [close-range (cdr edges)] - [close-start (car close-range)] - [close-end (cdr close-range)] - [close-text (char-range-text rope close-start close-end)] - [last-child (last-of children)] - [prev (prev-sibling-skipping-comments lang last-child)] - ;; where the closing delimiter lands: after the previous - ;; element, or right after the opening delimiter - [anchor (if prev (node-end-char rope prev) open-end)] - [middle-text (char-range-text rope anchor close-start)] - ;; ensure the ejected element is separated from the delimiter - [sep (if (starts-with-ws? lang middle-text) "" " ")] - [cursor (cursor-position)] - ;; the closing delimiter is re-written first at `anchor`, - ;; so that is its new position - [edge-char anchor]) - (apply-edits - (list (make-edit anchor close-end - (string-append close-text sep middle-text)))) - (reposition-cursor cursor edge-char #f))]))]))]))) + [edges (get-form-edges rope form)]) + (if (not edges) + (set-status! "paredit: form has no delimiters") + (barf-forward-edit lang rope children edges)))]))]))]))) + +;; Emit the barf-forward edit once the form's children and edges are resolved. +(define (barf-forward-edit lang rope children edges) + (let* ([open-end (cdr (car edges))] + [close-range (cdr edges)] + [close-start (car close-range)] + [close-end (cdr close-range)] + [close-text (char-range-text rope close-start close-end)] + [last-child (last-of children)] + [prev (prev-sibling-skipping-comments lang last-child)] + ;; where the closing delimiter lands: after the previous + ;; element, or right after the opening delimiter + [anchor (if prev (node-end-char rope prev) open-end)] + [middle-text (char-range-text rope anchor close-start)] + ;; ensure the ejected element is separated from the delimiter + [sep (if (starts-with-ws? lang middle-text) "" " ")] + [cursor (cursor-position)] + ;; the closing delimiter is re-written first at `anchor`, + ;; so that is its new position + [edge-char anchor]) + (apply-edits + (list (make-edit anchor close-end + (string-append close-text sep middle-text)))) + (reposition-cursor cursor edge-char #f))) ;; Shrink the enclosing form, ejecting its first element to the left. ;; @@ -100,27 +106,33 @@ [(null? children) (set-status! "paredit: nothing to barf")] [else (let* ([rope (current-rope)] - [edges (get-form-edges rope form)] - [open-range (car edges)] - [open-start (car open-range)] - [open-end (cdr open-range)] - [open-text (char-range-text rope open-start open-end)] - [close-start (car (cdr edges))] - [first-child (car children)] - [next (next-sibling-skipping-comments lang first-child)] - ;; where the opening delimiter lands: before the second - ;; element, or right before the closing delimiter - [anchor (if next (node-start-char rope next) close-start)] - [middle-text (char-range-text rope open-end anchor)] - ;; ensure the ejected element is separated from the delimiter - [sep (if (ends-with-ws? lang middle-text) "" " ")] - [cursor (cursor-position)] - ;; the opening delimiter is re-written after middle-text - ;; and the separator, so its new start sits past both - [edge-char (+ open-start - (string-length middle-text) - (string-length sep))]) - (apply-edits - (list (make-edit open-start anchor - (string-append middle-text sep open-text)))) - (reposition-cursor cursor edge-char #t))]))]))]))) + [edges (get-form-edges rope form)]) + (if (not edges) + (set-status! "paredit: form has no delimiters") + (barf-backward-edit lang rope children edges)))]))]))]))) + +;; Emit the barf-backward edit once the form's children and edges are resolved. +(define (barf-backward-edit lang rope children edges) + (let* ([open-range (car edges)] + [open-start (car open-range)] + [open-end (cdr open-range)] + [open-text (char-range-text rope open-start open-end)] + [close-start (car (cdr edges))] + [first-child (car children)] + [next (next-sibling-skipping-comments lang first-child)] + ;; where the opening delimiter lands: before the second + ;; element, or right before the closing delimiter + [anchor (if next (node-start-char rope next) close-start)] + [middle-text (char-range-text rope open-end anchor)] + ;; ensure the ejected element is separated from the delimiter + [sep (if (ends-with-ws? lang middle-text) "" " ")] + [cursor (cursor-position)] + ;; the opening delimiter is re-written after middle-text + ;; and the separator, so its new start sits past both + [edge-char (+ open-start + (string-length middle-text) + (string-length sep))]) + (apply-edits + (list (make-edit open-start anchor + (string-append middle-text sep open-text)))) + (reposition-cursor cursor edge-char #t))) diff --git a/src/ops/slurp.scm b/src/ops/slurp.scm index 755f9ec..8a88eed 100644 --- a/src/ops/slurp.scm +++ b/src/ops/slurp.scm @@ -46,26 +46,33 @@ [(not target) (set-status! "paredit: nothing to slurp")] [else (let* ([rope (current-rope)] - [close-range (cdr (get-form-edges rope form))] - [close-start (car close-range)] - [close-end (cdr close-range)] - [close-text (char-range-text rope close-start close-end)] - [target-end (node-end-char rope target)] - ;; text between the old delimiter and the slurped element's end - [middle-text (char-range-text rope close-end target-end)] - ;; an empty form has no element to separate from, so the - ;; old form/element gap shouldn't become leading space - [middle (if (null? (children-skipping-comments lang form)) - (trim-leading-ws lang middle-text) - middle-text)] - [cursor (cursor-position)] - ;; the closing delimiter is re-appended after `middle`, - ;; so its new start is close-start + (length of middle) - [edge-char (+ close-start (string-length middle))]) - (apply-edits - (list (make-edit close-start target-end - (string-append middle close-text)))) - (reposition-cursor cursor edge-char #f))]))]))]))) + [edges (get-form-edges rope form)]) + (if (not edges) + (set-status! "paredit: form has no delimiters") + (slurp-forward-edit lang rope form target edges)))]))]))]))) + +;; Emit the slurp-forward edit once the form, target, and edges are resolved. +(define (slurp-forward-edit lang rope form target edges) + (let* ([close-range (cdr edges)] + [close-start (car close-range)] + [close-end (cdr close-range)] + [close-text (char-range-text rope close-start close-end)] + [target-end (node-end-char rope target)] + ;; text between the old delimiter and the slurped element's end + [middle-text (char-range-text rope close-end target-end)] + ;; an empty form has no element to separate from, so the + ;; old form/element gap shouldn't become leading space + [middle (if (null? (children-skipping-comments lang form)) + (trim-leading-ws lang middle-text) + middle-text)] + [cursor (cursor-position)] + ;; the closing delimiter is re-appended after `middle`, + ;; so its new start is close-start + (length of middle) + [edge-char (+ close-start (string-length middle))]) + (apply-edits + (list (make-edit close-start target-end + (string-append middle close-text)))) + (reposition-cursor cursor edge-char #f))) ;; Extend the enclosing form leftward over the preceding element. ;; @@ -90,22 +97,29 @@ [(not target) (set-status! "paredit: nothing to slurp")] [else (let* ([rope (current-rope)] - [open-range (car (get-form-edges rope form))] - [open-start (car open-range)] - [open-end (cdr open-range)] - [open-text (char-range-text rope open-start open-end)] - [target-start (node-start-char rope target)] - ;; text between the preceding element's start and the old delimiter - [middle-text (char-range-text rope target-start open-start)] - ;; an empty form has no element to separate from, so the - ;; old form/element gap shouldn't become trailing space - [middle (if (null? (children-skipping-comments lang form)) - (trim-trailing-ws lang middle-text) - middle-text)] - [cursor (cursor-position)] - ;; the opening delimiter is re-prepended at target-start - [edge-char target-start]) - (apply-edits - (list (make-edit target-start open-end - (string-append open-text middle)))) - (reposition-cursor cursor edge-char #t))]))]))]))) + [edges (get-form-edges rope form)]) + (if (not edges) + (set-status! "paredit: form has no delimiters") + (slurp-backward-edit lang rope form target edges)))]))]))]))) + +;; Emit the slurp-backward edit once the form, target, and edges are resolved. +(define (slurp-backward-edit lang rope form target edges) + (let* ([open-range (car edges)] + [open-start (car open-range)] + [open-end (cdr open-range)] + [open-text (char-range-text rope open-start open-end)] + [target-start (node-start-char rope target)] + ;; text between the preceding element's start and the old delimiter + [middle-text (char-range-text rope target-start open-start)] + ;; an empty form has no element to separate from, so the + ;; old form/element gap shouldn't become trailing space + [middle (if (null? (children-skipping-comments lang form)) + (trim-trailing-ws lang middle-text) + middle-text)] + [cursor (cursor-position)] + ;; the opening delimiter is re-prepended at target-start + [edge-char target-start]) + (apply-edits + (list (make-edit target-start open-end + (string-append open-text middle)))) + (reposition-cursor cursor edge-char #t))) diff --git a/src/ops/split-join.scm b/src/ops/split-join.scm index 0e6c2a5..25612bd 100644 --- a/src/ops/split-join.scm +++ b/src/ops/split-join.scm @@ -164,18 +164,26 @@ [ctx (or enclosing (current-root))] [children (children-skipping-comments lang ctx)] [cur (cursor-position)] - [pair (or (pick-join-pair rope children cur) - (and enclosing - (let ([sib (next-sibling-skipping-comments lang enclosing)]) - (and sib (cons enclosing sib)))))]) + [straddled (pick-join-pair rope children cur)] + [fallback (and enclosing + (let ([sib (next-sibling-skipping-comments lang enclosing)]) + (and sib (cons enclosing sib))))] + ;; prefer the straddled pair, but only if it is joinable — a gap + ;; between two atoms (e.g. `(a | b) (c d)`) falls through to joining + ;; `enclosing` with its sibling rather than erroring + [pair (cond + [(and straddled + (joinable-same? lang (car straddled) (cdr straddled))) + straddled] + [(and fallback + (joinable-same? lang (car fallback) (cdr fallback))) + fallback] + [else #f])]) (cond - [(not pair) (set-status! "paredit: nothing to join")] - [else - (let ([left (car pair)] - [right (cdr pair)]) - (if (joinable-same? lang left right) - (join-pair lang rope left right) - (set-status! "paredit: can only join two forms or two strings")))]))) + [pair (join-pair lang rope (car pair) (cdr pair))] + [(or straddled fallback) + (set-status! "paredit: can only join two forms or two strings")] + [else (set-status! "paredit: nothing to join")]))) ;; The adjacent (left . right) child pair straddling `cur`: left is the last ;; child ending at or before the cursor, right its following sibling. #f if there diff --git a/src/pairs.scm b/src/pairs.scm index e3b9eb8..16135ce 100644 --- a/src/pairs.scm +++ b/src/pairs.scm @@ -11,9 +11,10 @@ pairwise-nodes-for) ;;@doc -;; Build a TSQueryLoader from `lang`'s pairs-query-src (compiling once), or #f -;; if the language has no pairs query. The returned loader yields the compiled -;; query only for `lang`'s id and #f for every other layer. +;; Build a TSQueryLoader from `lang`'s pairs-query-src, or #f if the language +;; has no pairs query. The returned loader yields the compiled query only for +;; `lang`'s id and #f for every other layer. Compiles on every call — use +;; `pairs-loader-for` for the cached loader. (define (build-pairs-loader lang) (let ([src (Language-pairs-query-src lang)]) (if src @@ -24,6 +25,18 @@ (if (equal? layer-lang id) query #f)))) #f))) +;; Language-id -> loader (or #f), so each language's query compiles once. +(define *pairs-loaders* (hash)) + +;; The memoized pairs loader for `lang`: built on first use, cached thereafter. +(define (pairs-loader-for lang) + (let ([id (Language-id lang)]) + (if (hash-contains? *pairs-loaders* id) + (hash-ref *pairs-loaders* id) + (let ([loader (build-pairs-loader lang)]) + (set! *pairs-loaders* (hash-insert *pairs-loaders* id loader)) + loader)))) + ;;@doc ;; All @pair nodes within the char range [lo, hi) of the focused document, in ;; document order, or '() when the language has no pairs query / no matches. @@ -31,7 +44,7 @@ ;; capture flattens every @pair node across the range (TSMatch pitfall), so we ;; sort by start byte and let `pair-chunks` recover the key/value grouping. (define (pair-nodes-in-range lang lo-char hi-char) - (let ([loader (build-pairs-loader lang)]) + (let ([loader (pairs-loader-for lang)]) (if (not loader) '() (let* ([rope (current-rope)]