Function: combobulate-envelope-expand-post-run-instructions
combobulate-envelope-expand-post-run-instructions is a natively
compiled function defined in combobulate-envelope.el.
Signature
(combobulate-envelope-expand-post-run-instructions CTX CATEGORIES)
Documentation
Expand the user actions in CTX according to CATEGORIES.
CATEGORIES is a list of instructions to expand now.
Valid choices are: prompt, choice, repeat and point. All
other categories are ignored.
Every instruction in CTX's :user-actions must be of the form
(TYPE . REST)
Where TYPE is one of the CATEGORIES and REST could be anything, depending on TYPE.
This function will expand the user actions in the order they are given in CATEGORIES.
Source Code
;; Defined in /nix/store/b5fvrwzi3zvkabyzx0in6gw1cj963z46-emacs-packages-deps/share/emacs/site-lisp/combobulate-envelope.el
(cl-defun combobulate-envelope-expand-post-run-instructions (ctx categories)
"Expand the user actions in CTX according to CATEGORIES.
CATEGORIES is a list of instructions to expand now.
Valid choices are: `prompt', `choice', `repeat' and `point'. All
other categories are ignored.
Every instruction in CTX's `:user-actions' must be of the form
(TYPE . REST)
Where TYPE is one of the CATEGORIES and REST could be anything,
depending on TYPE.
This function will expand the user actions in the order
they are given in CATEGORIES."
(pcase-let (((cl-struct combobulate-envelope-context
(user-actions user-actions))
ctx))
;; We need to group the instructions by category so that we can
;; action each category as one cohesive whole. `seq-group-by'
;; preserves the relative order in the user actions, which
;; is also important.
(let ((selected-point) (grouped-instructions (seq-group-by #'car user-actions))
(remaining-user-actions)
(end (point-marker)))
;; The set of categories we're asked to process is possibly a
;; subset of the user actions we've been given. All
;; instructions that we have not been told to process are passed
;; through unchanged.
(setq remaining-user-actions (seq-remove (lambda (x) (member (car x) categories)) user-actions))
;; Re-use the global refactor ID here so we manipulate the same
;; refactoring instance as the progenitor instance the envelope
;; code was first activated with.
(combobulate-refactor (:id combobulate-envelope-refactor-id)
(dolist (category categories)
(pcase (assoc category grouped-instructions)
(`(prompt . ,prompts)
(save-excursion (mapc #'funcall (mapcar #'cdr prompts))))
(`(choice . ,choices)
(let ((nodes))
(pcase-dolist (`(choice ,pt ,name ,missing ,rest-envelope ,text) choices)
(push (combobulate-proxy-node-create
:start pt
:end pt
:text text
:named t
:type "Choice"
:pp (if name (format "Choice: %s" name) "Choice")
:extra (cons missing rest-envelope))
nodes))
(when-let (selected-node
(combobulate-proffer-choices
nodes
#'combobulate-envelope-render-choice-preview
;; ordinarily, we'd want to filter out nodes
;; that have identical node ranges. However,
;; with choices, we may well have multiple
;; choices in a row, each occupying the exact
;; same range, but nevertheless expanding to
;; vastly different things.
:unique-only nil
;; pass whatever the value of
;; `combobulate-envelope-static' is to the
;; proffer function. If it's non-nil, then
;; the caller of this function does not
;; intend for the user to make a choice;
;; instead, the first is picked
;; automatically. The automatic choice is
;; made because we want to expand some
;; instructions (like prompt and choice)
;; without actually triggering a user
;; interaction
:first-choice combobulate-envelope-static
:signal-on-abort t
:quiet t
:reset-point-on-abort nil
:reset-point-on-accept nil
;; `combobulate-envelope-render-choice-preview'
;; inserts text for potentially many nodes,
;; which would be preserved if the normal
;; accept action -- rollback -- were used
;; instead.
:accept-action 'commit))
;; If one of the proffered choices was selected, then
;; we need to:
;;
;; 1. Move to the node
;;
;; 2. Expand the envelope found in either `:missing'
;; or `:rest'. The `:missing' envelope is expanded
;; if the node is not the selected node, and the
;; `:rest' envelope is expanded if the node is the
;; selected node.
;;
;; 3. The outcome of recursively expanding the
;; envelope will yield user actions that
;; require further processing. However, these
;; user actions may include categories the
;; `b' block cannot process itself. Namely, that
;; is almost always just `point' nodes. We'll need
;; to walk each user action in turn and put
;; them back into the grouped instructions alist
;; so they can be processed in turn.
(dolist (node nodes)
(pcase-let ((`(,missing . ,rest-envelope) (combobulate-proxy-node-extra node)))
(combobulate-move-to-node node)
(pcase-let (((cl-struct combobulate-envelope-context
(user-actions user-actions)
(end ctx-end))
(combobulate-envelope-expand-instructions-1
;; If the node is selected we use
;; the rest-envelope; for
;; everything else, the missing
;; envelope.
;;
;; Regardless of the envelope, we
;; ensure it's wrapped in an
;; implicit `b' block.
`((b ,@(if (equal node selected-node) rest-envelope missing))))))
(pcase-dolist (`(,block-category . ,user-action) user-actions)
;; If we're dealing with any sort of block
;; instruction that is part of the categories
;; we are dealing with, put them back into
;; the grouped instructions alist so they can
;; be processed in turn.
(if (member block-category categories)
(setf (alist-get block-category grouped-instructions)
(cons (cons block-category user-action)
(alist-get block-category grouped-instructions)))
(push (cons block-category user-action) remaining-user-actions)))
(setq end (max end ctx-end))))))))
(`(selected-point . ,pts)
;; it's possible there's more than one selected-point, I
;; suppose? It should not happen, though.
(dolist (pt pts)
(goto-char (cdr pt))))
(`(point . ,points)
(let ((nodes (mapcar (lambda (pt-instruction)
(combobulate-proxy-node-make-point-node (cadr pt-instruction)))
points)))
;; Ensure every single point node has a cursor visible
;; so the user can see the available cursor choices.
(mapc #'mark-node-cursor nodes)
(save-excursion
(if-let (selected-node (combobulate-proffer-choices
nodes
(lambda-slots (current-node refactor-id)
(combobulate-refactor (:id refactor-id)
(combobulate-move-to-node current-node)))
;; as above, if we're in static mode, we do not
;; prompt the user to pick a cursor
:first-choice combobulate-envelope-static
:signal-on-abort t
:quiet t
:reset-point-on-abort t
:reset-point-on-accept nil))
(setq selected-point (combobulate-node-start selected-node))
(setq selected-point nil)))
;; `selected-point' is a special post-run block
;; instruction that we only ever action once we've
;; exited the entire envelope instruction loop. It is
;; the final action carried out at the very end.
(push (cons 'selected-point selected-point) remaining-user-actions)))))
(if combobulate-envelope-static
(rollback)
(commit)))
(combobulate-envelope-context-create
:user-actions remaining-user-actions
:start nil
:end end))))