Function: combobulate-envelope-expand-instructions-1
combobulate-envelope-expand-instructions-1 is a natively compiled
function defined in combobulate-envelope.el.
Signature
(combobulate-envelope-expand-instructions-1 INSTRUCTIONS)
Documentation
Internal function that expands INSTRUCTIONS.
Source Code
;; Defined in /nix/store/b5fvrwzi3zvkabyzx0in6gw1cj963z46-emacs-packages-deps/share/emacs/site-lisp/combobulate-envelope.el
(defun combobulate-envelope-expand-instructions-1 (instructions)
"Internal function that expands INSTRUCTIONS."
(let ((buf (current-buffer))
(user-actions)
(end)
(start (point-marker)))
(ignore end)
(cl-flet ((expand-block (rest-instructions categories)
;; Expand a block of instructions.
(let ((ctx (combobulate-envelope-expand-instructions-1 rest-instructions))
(expanded-ctx))
(setq expanded-ctx
(combobulate-envelope-expand-post-run-instructions
ctx
;; categories to expand right now. Note that we
;; intentionally exclude `point' as the default
;; as they should only be run once everything
;; else is finalised: they are literally the only
;; thing to run after everything else is done.
categories))
(setq user-actions
(nconc user-actions
(combobulate-envelope-context-user-actions
expanded-ctx)))
(setq end (combobulate-envelope-context-end expanded-ctx)))))
(combobulate-refactor (:id combobulate-envelope-refactor-id)
(dolist (sub-instruction instructions)
(pcase sub-instruction
;; `(b instructions)'
;; `(b* instructions)'
;; Execute INSTRUCTIONS in a block, and interactively ask
;; the user to complete `repeat' and `choice' instructions.
;;
;; The special block `b*' will also execute `point' instructions.
((or (and `(b . ,rest) (let categories '(repeat choice prompt)))
(and `(b* ,categories . ,rest)))
(expand-block rest categories))
;; `(choice instructions)'
;; `(choice* :name NAME :missing MISSING :rest INSTRUCTIONS)'
;;
;; Presents a prompt to the user to choose between any of
;; the choices in the same block. `choice' is the simplest,
;; and `choice*' is more complex.
;;
;; `choice*' allows you to specify a name for the choice; it
;; is shown in the prompt. The `:missing' keyword argument
;; is a string that is shown if the user does not pick that
;; choice. `:rest' is the instructions to execute if the
;; user picks that choice.
((or (and `(choice . ,rest)
(let name nil)
(let missing nil)
(let rest-instructions rest))
(and `(choice* . ,rest)
(let name (plist-get rest :name))
(let missing (plist-get rest :missing))
(let rest-instructions (plist-get rest :rest))))
(push `(choice ,(point-marker) ,name ,missing ,rest-instructions
,(apply-partially #'combobulate-envelope-expand-instructions-1
rest-instructions))
user-actions))
;; `(save-column BLOCK)'
;;
;; Records the `current-column' of `point' when it enters
;; BLOCK and resets `point' to that column when after exiting.
(`(save-column . ,rest)
(let ((col (current-column)))
(expand-block rest nil)
;; (delete-horizontal-space)
(insert (make-string col ? ))))
;; `(prompt TAG PROMPT [TRANSFORM-FN])' / `(p TAG PROMPT [TRANSFORM-FN])'
;;
;; Prompts the user with PROMPT and stores the returned value
;; against TAG. Any fields tagged TAG (alongside the prompt
;; itself) are updated automatically.
((or (and `(prompt ,tag ,prompt) (let transformer-fn nil))
(and `(p ,tag ,prompt) (let transformer-fn nil))
(and `(prompt ,tag ,prompt ,transformer-fn))
(and `(p ,tag ,prompt ,transformer-fn)))
(when (and transformer-fn (not (functionp transformer-fn)))
(error "Prompt has invalid transformer function `%s'" transformer-fn))
(let ((prompt-point (point-marker)))
(push (cons 'prompt
(lambda () (save-excursion
(goto-char prompt-point)
(mark-field prompt-point tag (combobulate-envelope-get-register tag) transformer-fn)
(unless combobulate-envelope-static
(let ((new-text (or (combobulate-envelope-get-register tag)
(combobulate-envelope-prompt
prompt tag nil
(lambda ()
(combobulate-envelope--update-prompts
buf tag (minibuffer-contents)))))))
(push (cons tag new-text) combobulate-envelope--registers)
(combobulate-envelope--update-prompts buf tag new-text))))))
user-actions)))
;; `(field TAG)' or `(f TAG)'
;;
;; If there is a matching prompt TAG, update its text to that value.
((or (and `(field ,tag) (let transformer-fn nil))
(and `(f ,tag) (let transformer-fn nil))
(and `(field ,tag ,transformer-fn))
(and `(f ,tag ,transformer-fn)))
(mark-field (point-marker) tag (combobulate-envelope-get-register tag) transformer-fn))
;; `@>'
;;
;; Push a `point-marker' that will moves with insertions
;; made at the marker.
('@> (push `(point ,(let ((m (point-marker)))
(set-marker-insertion-type m t)
m))
user-actions))
;; `@'
;;
;; Push a `point-marker' that will serve as a possible
;; placement point for point after expansion.
('@ (push `(point ,(point-marker))
user-actions))
;; `@@'
;;
;; Push a `point' that will serve as a possible
;; placement point for point after expansion.
('@@ (push `(point ,(point)) user-actions))
;; `n' or `n>'
;;
;; Calls `newline', or `newline' then `indent-according-to-mode'.
;;
;; Never `newline-and-indent' because it strips horizontal
;; space, which is unhelpful.
('n (newline))
('n> (newline) (indent-according-to-mode))
;; `>'
;;
;; Call `indent-according-to-mode'
('> (indent-according-to-mode))
;; `<'
;;
;; For whitespace-sensitive languages, this is a way to move
;; back one level of indentation.
('< (let ((col (or (and (combobulate-read envelope-deindent-function)
(funcall (combobulate-read envelope-deindent-function)))
0)))
(delete-horizontal-space)
(insert (make-string col ? ))))
;; `(r> REGISTER [DEFAULT])' and `(r REGISTER [DEFAULT])'; or `r>' and `r'
;;
;; Inserts the register REGISTER (retreived from
;; `combobulate-envelope--registers') or, if there is no
;; register specified, default to the REGISTER `region' (or
;; `region-indented' if
;; `envelope-indent-region-function' is nil) which
;; holds that captured region (if any).
;;
;; Forms ending with `>' are indented as per the major mode's
;; indentation engine. Forms without `>' are not indented at all.
((or
;; surely there's a better way than this?
(and 'r>
(let register nil)
(let default "")
(let indent t))
(and 'r
(let register nil)
(let default "")
(let indent nil))
(and `(r> ,register)
(let indent t)
(let default ""))
(and `(r ,register)
(let indent nil)
(let default ""))
(and `(r> ,register ,default)
(let indent t))
(and `(r ,register ,default)
(let indent nil)))
(setq default (combobulate-envelope-get-register
(or register
(if (and (null (combobulate-read envelope-indent-region-function)) indent)
'region-indented
'region))
default))
(cond
((and (combobulate-read envelope-indent-region-function) indent)
(funcall (combobulate-read envelope-indent-region-function)
(point) (progn (insert default) (point))))
;; if `envelope-indent-region-function' is nil
;; then we default to a simplistic indentation style that
;; works well with the likes of Python where crass,
;; region-based indentation will never work.
((and (not (combobulate-read envelope-indent-region-function)) indent)
(let ((offset (current-indentation)))
;; Check if point has nothing but whitespace before
;; it. Only if it does do we delete it. This is
;; perhaps the only reasonable way of checking if
;; we're dealing with something that a
;; whitespace-based language's indentation function
;; can reasonably indent again after the whitespace
;; has been deleted.
;;
;; Whitespace in any other place may in fact be
;; either syntactically mandatory or used for
;; formatting. We should avoid touching that.
(when (save-excursion
(skip-chars-backward combobulate-skip-prefix-regexp
(line-beginning-position))
(bolp))
(delete-horizontal-space))
(setf start (point))
;; clear whitespace from the start of the line
(let ((before-pt (point)))
(insert (combobulate-indent-string
default
:first-line-operation 'absolute
:first-line-amount offset
:rest-lines-operation 'relative))
(save-excursion
(goto-char before-pt)
(combobulate-skip-whitespace-forward)
(push `(point ,(point-marker)) user-actions)))))
(t (insert default))))
;; "string"
;;
;; Strings are inserted at point.
((and (pred stringp) s)
(insert s))
;; `(repeat BLOCK)' or `(repeat-1 BLOCK)'
;;
;; Repeats BLOCK an unlimited number of times or at most once.
((or (and `(repeat . ,repeat-instructions) (let max-repeat most-positive-fixnum))
(and `(repeat-1 . ,repeat-instructions) (let max-repeat 1)))
(condition-case nil
;; we start with `repeat-answer' set to `t' by default
;; because we want to expand `repeat-instructions'
;; *first* and *then* prompt the user if they want
;; to keep the now-displayed instruction.
(let ((repeat-answer t))
(when combobulate-envelope-static
(setq max-repeat 1))
(while (and repeat-answer (> max-repeat 0))
(combobulate-refactor ()
;; call with `combobulate-envelope-static' set to
;; `t'. When an envelope is static, no
;; interactive functions are called (prompts and
;; such).
;;
;; That way we can safely insert the template
;; knowing that it won't block for user input.
(seq-let [[inst-start &rest inst-end] &rest _]
(let ((combobulate-envelope-static t))
(combobulate-envelope-expand-instructions-1 repeat-instructions))
;; mark the range as highlighted, so it's
;; easier to see its extent; and as deleted,
;; so that -- due to how we're using
;; `combobulate-refactor' -- we can delete
;; the expansion immediately after the
;; prompt.
;; BUG: if
;; `combobulate-envelope-expand-instructions-1'
;; ends up calling `save-column' as its last form
;; before exiting, then the call to set the column
;; will corrupt the `inst-end' value resulting in
;; text being left behind.
(mark-range-deleted inst-start inst-end)
(mark-range-highlighted inst-start inst-end)
;; note that regardless of whether we accept
;; or decline the expansion, we `commit'
;; (i.e., delete!) the expansion we created
;; above. The reason this is done is so that
;; we ditch the static ersatz template and
;; instead re-run it, and this time
;; interactively so prompts and the like are
;; invoked.
(if (setq repeat-answer
(or combobulate-envelope-static
(combobulate-envelope-prompt-expansion "Apply this expansion? ")))
(progn (commit)
(let ((sub-inst (combobulate-envelope-expand-instructions-1 repeat-instructions)))
(setq user-actions (append user-actions (cdr sub-inst))))
(cl-decf max-repeat)
(commit))
(commit))))))
;; capture `C-g' (`keyboard-quit') so that a user can
;; enter an expansion and back out one step.
;;
;; The actual cleanup is done when
;; `combobulate-refactor' captures the uncaught error
;; and undoes everything.
(quit (combobulate-message "Keyboard quit. Undoing expansion."))))
(_ (error "Unknown sub-instruction: %S" sub-instruction)))))
(combobulate-envelope-context-create
:start start
:end end
:user-actions user-actions))))