Function: combobulate-splice
combobulate-splice is a natively compiled function defined in
combobulate-manipulation.el.
Signature
(combobulate-splice POINT-NODE PARTITIONS)
Documentation
Splice POINT-NODE by PARTITIONS.
Each member of PARTITIONS must be one of:
before, to preserve things before the POINT-NODE;
after, to preserve things after the POINT-NODE;
around to preserve nodes larger than POINT-NODE;
self to preserve POINT-NODE.
Source Code
;; Defined in /nix/store/b5fvrwzi3zvkabyzx0in6gw1cj963z46-emacs-packages-deps/share/emacs/site-lisp/combobulate-manipulation.el
(defun combobulate-splice (point-node partitions)
"Splice POINT-NODE by PARTITIONS.
Each member of PARTITIONS must be one of:
`before', to preserve things before the POINT-NODE;
`after', to preserve things after the POINT-NODE;
`around' to preserve nodes larger than POINT-NODE;
`self' to preserve POINT-NODE."
;; Most sibling procedures disallow anonymous modes as they are not
;; useful navigational targets. However, for splicing, it might be a
;; necessity to preserve them as they could prove integral to
;; maintaining the correct syntax.
(let* ((combobulate-procedure-include-anonymous-nodes t)
;; Some nodes are discarded globally by default -- usually
;; `comment', as line comments mess up the TS tree -- but
;; here we'd want to keep them also.
;;
;; FIXME: should use the shorthand version and shadow it, or
;; have another override flag.
(combobulate-procedure-apply-shared-discard-rules nil)
;; Begin the search at the point node.
(procedure)
(legal-splices)
(action-node)
(pt-type)
(disable-check nil)
(matches)
(source-node)
(all-parents) (valid-parents))
;; The action node is one of the activation nodes that yielded
;; what is hopefully a useful procedure result. To test that it is
;; indeed useful and not a node far away from where point is (the
;; nearest activation node could be in the parent somewhere) we
;; check that point is at the beginning of action node. If we're
;; *not* at the beginning, we instead create an ad hoc procedure
;; to try and ensnare as much of the node(s) around the beginning
;; of point.
(setq procedure (car-safe (combobulate-procedure-start point-node)))
(when procedure
(setq action-node (combobulate-procedure-result-action-node procedure)
matches (combobulate-procedure-result-selected-nodes procedure)))
(when (or (not procedure)
(not (combobulate-point-at-node-p action-node)))
(setq procedure nil)
(let ((largest-pt-node)
(possible-nodes (reverse (save-excursion
;; NOTE: Doing this seems to
;; cut down on the number of
;; useful choices we can splice
;; from.
;;
;; (combobulate-move-to-node
;; point-node)
(combobulate-all-nodes-at-point)))))
;; Starting from the largest node that starts at point,
;; repeatedly try to generate a procedure that yields a valid
;; result.
(while (and possible-nodes (null procedure))
(setq largest-pt-node (pop possible-nodes))
(setq procedure
(car-safe (combobulate-procedure-start
point-node
`((:activation-nodes
((:nodes (,(combobulate-node-type largest-pt-node))
:position at))
:selector (:choose node :match-siblings t)))))))
(unless procedure
(error "Cannot splice from `%s'" (combobulate-pretty-print-node largest-pt-node)))
(setq action-node (combobulate-procedure-result-action-node procedure)
disable-check t)
(setq matches (combobulate-procedure-result-selected-nodes procedure)
point-node action-node)))
(setq pt-type (combobulate-node-type action-node))
(setq all-parents (combobulate-get-parents point-node))
(setq valid-parents (seq-filter (lambda (node)
(member pt-type
(combobulate-production-rules-get
(combobulate-node-type node))))
all-parents))
;; Filter matches to just the ones we want to keep.
(setq matches (seq-keep
;; the only partitions we keep are the ones that are in
;; PARTITIONS
(pcase-lambda (`(,partition ., node))
(and (member partition partitions) node))
(combobulate--partition-by-position
action-node
(seq-keep
;; Only match nodes that are named are kept.
(pcase-lambda (`(,mark . ,node))
(and (eq mark '@match)
(combobulate-node-named-p node)
;; return node if it's a match and named
node))
matches))))
(unless (and matches valid-parents)
(error "Cannot splice from `%s'" point-node))
(pcase-let ((`(,start . ,end)
;; Get the node range extent of the filtered, partitioned
;; nodes. This does mean that we cannot pick things that are
;; disjoint, however.
(combobulate-node-range-extent matches)))
(setq source-node (combobulate-proxy-node-make-from-range start end))
(setf (combobulate-proxy-node-text source-node)
(combobulate-indent-string-first-line
(combobulate-node-text source-node)
(current-column)))
(setq legal-splices
(seq-filter
;; Validation checks are disengaged if we're free-form
;; searching because no applicable sibling procedure was
;; found.
(lambda (n) (or disable-check
(and (combobulate-node-parent n)
(or (member (combobulate-node-parent n) valid-parents)
(member n valid-parents))
(not (equal (combobulate-node-parent n) (car valid-parents)))
(combobulate-node-before-node-p n source-node))))
all-parents))
(cl-flet ((action-function (action)
(with-slots (current-node refactor-id index proxy-nodes) action
(let ((range-ov) (trailing-newline))
(combobulate-refactor (:id refactor-id)
(combobulate-move-to-node current-node)
(mark-node-deleted current-node)
(when (save-excursion
(combobulate-move-to-node current-node t)
(looking-back "\n" nil))
(setq trailing-newline t))
(commit)
;; use an envelope to ensure indentation is handled
;; properly. quicker and easier than reinventing it
;; again here.
(pcase-let ((`((,start . ,end) . ,_)
(combobulate-envelope-expand-instructions
'((r> text)) `((text . ,(combobulate-proxy-node-text source-node))))))
(goto-char start)
;; Use the range overlay as a crude way to
;; keep tabs on the text as it shifts around
;; when we delete horizontal space later.
(setq range-ov (mark-range-highlighted start end)))
;; Test if there's an error node as a result of
;; our changes.
(when-let (err (seq-filter #'combobulate-point-in-node-range-p (combobulate-get-error-nodes)))
(setf (combobulate-proffer-action-display-indicator action)
(combobulate-display-indicator
index (length proxy-nodes)
'combobulate-error-indicator-face nil "E")
(combobulate-proffer-action-prompt-description action)
(propertize "Invalid" 'face 'combobulate-error-indicator-face)))
;; if we merge stuff into a line that is not blank,
;; then elide all but one space and, if there weren't
;; any, add one.
(when trailing-newline
(save-excursion
(goto-char (overlay-end range-ov))
(unless (or (looking-at "\n") (looking-back "\n" nil))
(insert "\n"))))
(unless (combobulate-before-point-blank-p (point))
(if (member
;; Hacky way of checking if there's an
;; anonymous node before point, and if
;; it's the type of anonymous node where
;; you generally want to leave at least
;; one space, or zero spaces.
(thread-first
(combobulate-before-point-anonymous-node-p (point))
(combobulate-node-text))
'("(" "{" "[" "<" "\"" "'"))
(delete-horizontal-space)
(just-one-space)))
(when (combobulate-read envelope-indent-region-function)
(apply (combobulate-read envelope-indent-region-function)
(combobulate-extend-region-to-whole-lines (overlay-start range-ov)
(overlay-end range-ov)))))))))
(let ((proffer-action)
(proxy-matches (combobulate-proxy-node-make-from-nodes matches)))
(when-let (target-node (combobulate-proffer-choices
legal-splices
(lambda (action)
;; hack: hold on to the action so
;; we can repeat it after
(setq proffer-action action)
(action-function action))
:prompt-description "Splice out"
:quiet t))
(combobulate-refactor (:id 'splice)
(setf (combobulate-proffer-action-refactor-id proffer-action) 'splice)
(action-function proffer-action)
(rollback)
(combobulate-message
(format
"Spliced. Keep %s. Discard %s."
(combobulate-tally-nodes proxy-matches t)
(combobulate-tally-nodes
(cons target-node
(seq-take (combobulate-proffer-action-proxy-nodes proffer-action)
(combobulate-proffer-action-index proffer-action)))
t))))))))))