Prepare groundwork for solution to #558 and others

* yasnippet.el (yas-good-grace): Overhaul docstring.
(yas--eval-for-string): Renamed from `yas--eval-lisp'. Redesigned.
(yas--handle-error): Removed.
(yas--eval-for-effect): Renamed from `yas--eval-lisp-no-saves'. Redesigned.
(yas-define-snippets): Update docstring.
(yas-throw): Don't throw, just signal.
(yas--snippet): Add `exit-hook' field.
(yas-next-field, yas--save-backquotes, yas--apply-transform): Use `yas-eval-for-string'.
(yas--safely-run-hook): Renamed from `yas--safely-run-hooks'. Redesigned.
(yas--check-commit-snippet): Collect snippet hooks and run them.
(yas-expand-snippet): Use `yas--eval-for-effect'.
(yas--snippet-create): Stamp the exit-hook variable in the snippet-local hook.
This commit is contained in:
João Távora 2015-02-04 12:01:36 +00:00
parent 197ef7f0b6
commit 2b706dc379

View File

@ -350,9 +350,16 @@ can be overridden on a per-snippet basis."
:group 'yasnippet)
(defcustom yas-good-grace t
"If non-nil, don't raise errors in inline elisp evaluation.
"If non-nil, don't raise errors in elisp evaluation
An error string \"[yas] error\" is returned instead."
This affects both the inline elisp in snippets and the hook
variables such as `yas-after-exit-snippet-hook'.
If this variable's value is `inline', an error string \"[yas]
error\" is returned instead of raising the error. If this
variable's value is `hooks', a message is output to according to
`yas-verbosity-level'. If this variable's value is t, both are
active."
:type 'boolean
:group 'yasnippet)
@ -1293,33 +1300,27 @@ yasnippet keeps a list of modes like this to help the judgment."
(or (fboundp mode)
(find mode yas--known-modes)))
(defun yas--handle-error (err)
"Handle error depending on value of `yas-good-grace'."
(let ((msg (yas--format "elisp error: %s" (error-message-string err))))
(if yas-good-grace msg
(error "%s" msg))))
(defun yas--eval-lisp (form)
(defun yas--eval-for-string (form)
"Evaluate FORM and convert the result to string."
(let ((retval (catch 'yas--exception
(condition-case err
(save-excursion
(save-restriction
(save-match-data
(widen)
(let ((result (eval form)))
(when result
(format "%s" result))))))
(error (yas--handle-error err))))))
(when (and (consp retval)
(eq 'yas--exception (car retval)))
(error (cdr retval)))
retval))
(let ((eval-saving-stuff
(lambda (form)
(save-excursion
(save-restriction
(save-match-data
(widen)
(let ((result (eval form)))
(when result
(format "%s" result)))))))))
(if (memq yas-good-grace '(t inline))
(condition-case oops
(funcall eval-saving-stuff form)
(yas--exception (signal 'yas-exception (cdr oops)))
(error (cdr oops)))
(funcall eval-saving-stuff form))))
(defun yas--eval-lisp-no-saves (form)
(condition-case err
(eval form)
(error (message "%s" (yas--handle-error err)))))
(defun yas--eval-for-effect (form)
;; FIXME: simulating lexical-binding.
(yas--safely-run-hook `(lambda () ,form)))
(defun yas--read-lisp (string &optional nil-on-error)
"Read STRING as a elisp expression and return it.
@ -1673,7 +1674,7 @@ this is a snippet or a snippet-command.
CONDITION, EXPAND-ENV and KEYBINDING are Lisp forms, they have
been `yas--read-lisp'-ed and will eventually be
`yas--eval-lisp'-ed.
`yas--eval-for-string'-ed.
The remaining elements are strings.
@ -2835,7 +2836,8 @@ The last element of POSSIBILITIES may be a list of strings."
(defun yas-throw (text)
"Throw a yas--exception with TEXT as the reason."
(throw 'yas--exception (cons 'yas--exception text)))
(signal 'yas--exception text))
(put 'yas--exception 'error-conditions '(error yas--exception))
(defun yas-verify-value (possibilities)
"Verify that the current field value is in POSSIBILITIES.
@ -2920,7 +2922,8 @@ Use this in primary and mirror transformations to tget."
;; stacked expansion: the `previous-active-field' slot saves the
;; active field where the child expansion took place
previous-active-field
force-exit)
force-exit
exit-hook)
(defstruct (yas--field (:constructor yas--make-field (number start end parent-field)))
"A field.
@ -2979,7 +2982,7 @@ string iff EMPTY-ON-NIL-P is true."
(transformed (and transform
(save-excursion
(goto-char start-point)
(let ((ret (yas--eval-lisp transform)))
(let ((ret (yas--eval-for-string transform)))
(or ret (and empty-on-nil-p "")))))))
transformed))
@ -3095,7 +3098,7 @@ If there's none, exit the snippet."
(yas-text (yas--field-text-for-display active-field))
(yas-modified-p (yas--field-modified-p active-field)))
;; primary field transform: exit call to field-transform
(yas--eval-lisp (yas--field-transform active-field))))
(yas--eval-for-string (yas--field-transform active-field))))
;; Now actually move...
(cond ((and target-pos (>= target-pos (length live-fields)))
(yas-exit-snippet snippet))
@ -3221,11 +3224,16 @@ This renders the snippet as ordinary text."
(yas--message 3 "Snippet %s exited." (yas--snippet-id snippet)))
(defun yas--safely-run-hooks (hook-var)
(condition-case error
(run-hooks hook-var)
(error
(yas--message 3 "%s error: %s" hook-var (error-message-string error)))))
(defun yas--safely-run-hook (hook)
(let ((run-the-hook (lambda (hook) (funcall hook))))
(if (memq yas-good-grace '(t hooks))
(funcall run-the-hook hook)
(condition-case error
(funcall run-the-hook hook)
(error
(yas--message 3 "Error running %s: %s"
(if (symbolp hook) hook "a hook")
(error-message-string error)))))))
(defun yas--check-commit-snippet ()
@ -3234,10 +3242,11 @@ This renders the snippet as ordinary text."
If so cleans up the whole snippet up."
(let* ((snippets (yas--snippets-at-point 'all-snippets))
(snippets-left snippets)
(snippet-exit-transform))
(snippet-exit-transform)
(exit-hooks))
(dolist (snippet snippets)
(setq snippet-exit-transform (yas--snippet-force-exit snippet))
(let ((active-field (yas--snippet-active-field snippet)))
(setq snippet-exit-transform (yas--snippet-force-exit snippet))
(cond ((or snippet-exit-transform
(not (and active-field (yas--field-contains-point-p active-field))))
(setq snippets-left (delete snippet snippets-left))
@ -3255,11 +3264,14 @@ If so cleans up the whole snippet up."
(yas--move-to-field snippet active-field)
(yas--update-mirrors snippet)))
(t
nil))))
nil)))
(let ((exit-hook (yas--snippet-exit-hook snippet)))
(when exit-hook
(push exit-hook exit-hooks))))
(unless (or (null snippets) snippets-left)
(if snippet-exit-transform
(yas--eval-lisp-no-saves snippet-exit-transform))
(yas--safely-run-hooks 'yas-after-exit-snippet-hook))))
(yas--eval-for-effect snippet-exit-transform)))
(mapcar #'yas--safely-run-hook exit-hooks)))
;; Apropos markers-to-points:
;;
@ -3546,7 +3558,7 @@ considered when expanding the snippet."
(cond ((listp content)
;; x) This is a snippet-command
;;
(yas--eval-lisp-no-saves content))
(yas--eval-for-effect content))
(t
;; x) This is a snippet-snippet :-)
;;
@ -3668,6 +3680,12 @@ Returns the newly created snippet."
;; Move to end
(goto-char (point-max))
;; The snippet's exit hook is set to the current value of the
;; exit hook variable, unless it already holds something.
;;
(unless (yas--snippet-exit-hook snippet)
(setf (yas--snippet-exit-hook snippet)
yas-after-exit-snippet-hook))
snippet)))
@ -3994,7 +4012,7 @@ with their evaluated value into `yas--backquote-markers-and-strings'."
(let ((current-string (match-string-no-properties 1)) transformed)
(save-restriction (widen)
(delete-region (match-beginning 0) (match-end 0)))
(setq transformed (yas--eval-lisp (yas--read-lisp (yas--restore-escapes current-string '(?`)))))
(setq transformed (yas--eval-for-string (yas--read-lisp (yas--restore-escapes current-string '(?`)))))
(goto-char (match-beginning 0))
(when transformed
(let ((marker (make-marker)))