mirror of
https://github.com/joaotavora/yasnippet.git
synced 2025-10-14 05:23:04 +00:00
add: support expansion-time evaluation forms and validate some input
This commit is contained in:
Joao Tavora
parent
f76b876c53
commit
db38009ee8
@ -61,7 +61,10 @@
|
||||
(&field 1 "%s")
|
||||
(&mirror 1 (if (string-match "%" field-text) "\"," "\")"))
|
||||
(&field 2)
|
||||
(&mirror 1 (if (string-match "%" field-text) "\)" ""))))))
|
||||
(&mirror 1 (if (string-match "%" field-text) "\)" ""))))
|
||||
(emacs-version ((&field 1 emacs-version)
|
||||
" " (upcase (emacs-version)) " "
|
||||
(&mirror 1)))))
|
||||
|
||||
(defun snippet--insert-test-snippet (name)
|
||||
(funcall (make-snippet (cadr (assoc name snippet--test-snippets-alist)))))
|
||||
@ -180,3 +183,59 @@
|
||||
(should (equal (buffer-string) "printf (\"%s\",)"))
|
||||
(ert-simulate-command '((lambda () (interactive) (insert "somestring"))))
|
||||
(should (equal (buffer-string) "sprintf (somestring,\"%s\",)"))))
|
||||
|
||||
(ert-deftest emacs-version ()
|
||||
(with-temp-buffer
|
||||
(snippet--insert-test-snippet 'emacs-version)
|
||||
(should (equal (buffer-string)
|
||||
(concat emacs-version " "
|
||||
(upcase (emacs-version)) " "
|
||||
emacs-version)))
|
||||
(ert-simulate-command '((lambda () (interactive) (insert "somestring"))))
|
||||
(should (equal (buffer-string)
|
||||
(concat "somestring" " "
|
||||
(upcase (emacs-version)) " "
|
||||
"somestring")))))
|
||||
|
||||
|
||||
;;; input validation
|
||||
;;;
|
||||
(ert-deftest valid-forms ()
|
||||
;; fields
|
||||
;;
|
||||
(should (equal (snippet--canonicalize-form '(&field 1 (foo)))
|
||||
'(&field 1 (&eval (foo)))))
|
||||
(should (equal (snippet--canonicalize-form '(&field 1 (&eval (foo))))
|
||||
'(&field 1 (&eval (foo)))))
|
||||
(should (equal (snippet--canonicalize-form '(&field 1 (&transform (foo))))
|
||||
'(&field 1 (&transform (foo)))))
|
||||
(should (equal (snippet--canonicalize-form '(&field 1 (&nested (foo) (bar))))
|
||||
'(&field 1 (&nested (foo) (bar)))))
|
||||
(should (equal (snippet--canonicalize-form '(&field 1))
|
||||
'(&field 1 nil)))
|
||||
|
||||
|
||||
;; mirrors
|
||||
;;
|
||||
(should (equal (snippet--canonicalize-form '(&mirror 1))
|
||||
'(&mirror 1 (&transform field-text))))
|
||||
(should (equal (snippet--canonicalize-form '(&mirror 1 (foo)))
|
||||
'(&mirror 1 (&transform (foo)))))
|
||||
(should (equal (snippet--canonicalize-form '(&mirror 1 (&transform (foo))))
|
||||
'(&mirror 1 (&transform (foo)))))
|
||||
;; normal forms
|
||||
;;
|
||||
(should (equal (snippet--canonicalize-form "bla")
|
||||
'(&eval "bla")))
|
||||
(should (equal (snippet--canonicalize-form '(&eval "bla"))
|
||||
'(&eval "bla")))
|
||||
(should (equal (snippet--canonicalize-form '(foo))
|
||||
'(&eval (foo))))
|
||||
(should (equal (snippet--canonicalize-form '(&eval (foo)))
|
||||
'(&eval (foo)))))
|
||||
|
||||
(ert-deftest invalid-forms ()
|
||||
;; fields
|
||||
(should-error (snippet--canonicalize-form '(&field 1 (&transform (foo) (bar)))))
|
||||
(should-error (snippet--canonicalize-form '(&field 1 (&eval (foo) (bar)))))
|
||||
(should-error (snippet--canonicalize-form '(&eval (foo) (bar)))))
|
||||
|
||||
89
snippet.el
89
snippet.el
@ -58,15 +58,40 @@
|
||||
(fboundp (cl-second form)))))
|
||||
|
||||
(defun snippet--canonicalize-form (form)
|
||||
(cond ((or (atom form)
|
||||
(not (memq (first form) '(&mirror &field &eval))))
|
||||
(list '&eval form))
|
||||
(t
|
||||
(cl-assert (not (cdddr form)) nil "malformed snippet form %s" form)
|
||||
(append form
|
||||
(make-list (- 3 (length form)) nil)))))
|
||||
(pcase form
|
||||
((or `&field `(&field))
|
||||
`(&field ,(cl-gensym "auto-") nil))
|
||||
(`(&field ,name)
|
||||
`(&field ,name nil))
|
||||
((pred atom)
|
||||
`(&eval ,form))
|
||||
(`(&eval ,_)
|
||||
form)
|
||||
(`(&eval . ,_)
|
||||
(error "provide only one form after &eval or &transform"))
|
||||
(`(&mirror ,name)
|
||||
`(&mirror ,name (&transform field-text)))
|
||||
(`(&mirror ,_ (&transform ,_))
|
||||
form)
|
||||
(`(&field ,_ (,(or `&transform `&eval) ,_))
|
||||
form)
|
||||
(`(,(or `&mirror `&field) ,_ (,(or `&transform `&eval) . ,_))
|
||||
(error "provide only one form after &eval or &transform"))
|
||||
(`(&field ,name (&nested . ,more-forms))
|
||||
`(&field ,name (&nested . (mapcar #'snippet--canonicalize-form
|
||||
,more-forms)))
|
||||
form)
|
||||
(`(&mirror ,name ,expr)
|
||||
`(&mirror ,name (&transform ,expr)))
|
||||
|
||||
(defun snippet--form-sym-tuples (forms &optional parent-field-sym)
|
||||
(`(&field ,name ,expr)
|
||||
`(&field ,name (&eval ,expr)))
|
||||
((pred consp)
|
||||
`(&eval ,form))
|
||||
(t
|
||||
(error "invalid snippet form %s" form))))
|
||||
|
||||
(defun snippet--form-tuples (forms &optional parent-field-sym)
|
||||
"Produce information for composing the snippet expansion function.
|
||||
|
||||
A tuple of 6 elements is created for each form in FORMS.
|
||||
@ -81,8 +106,10 @@ iterated depth-first, resulting in a flattened list."
|
||||
with sym
|
||||
with adjacent-prev-sym
|
||||
with has-children-p
|
||||
|
||||
for (prev-form form next-form) on `(nil ,@forms)
|
||||
while form
|
||||
|
||||
with collect-sym = #'(lambda () `(,sym ,form
|
||||
,parent-field-sym
|
||||
,adjacent-prev-sym
|
||||
@ -97,23 +124,21 @@ iterated depth-first, resulting in a flattened list."
|
||||
|
||||
(funcall collect-sym))
|
||||
|
||||
(`(&mirror ,name ,_transform)
|
||||
(`(&mirror ,name ,_expr)
|
||||
(incf snippet--form-mirror-sym-idx)
|
||||
(setq sym (snippet--form-make-mirror-sym snippet--form-mirror-sym-idx
|
||||
name
|
||||
parent-field-sym))
|
||||
(funcall collect-sym))
|
||||
(`(&eval ,_expr)
|
||||
`,form)
|
||||
(t
|
||||
(error "unknown type of snippet form %s" form)))
|
||||
`,form))
|
||||
when has-children-p
|
||||
append (snippet--form-sym-tuples (cdr (cl-third form)) sym)
|
||||
append (snippet--form-tuples (cdr (cl-third form)) sym)
|
||||
do (setq adjacent-prev-sym sym
|
||||
sym nil
|
||||
has-children-p nil)))
|
||||
|
||||
(defun snippet--make-marker-init-forms (tuples)
|
||||
(defun snippet--marker-init-forms (tuples)
|
||||
"Make marker init forms for the snippet objects in TUPLES.
|
||||
|
||||
Imagine this snippet:
|
||||
@ -162,7 +187,7 @@ I would need these somewhere in the let* form
|
||||
(eq '&field (car form))))
|
||||
tuples :key #'cadr))
|
||||
|
||||
(defun snippet--init-field-and-mirror-forms (tuples)
|
||||
(defun snippet--object-init-forms (tuples)
|
||||
(let* ((field-mirrors (make-hash-table))
|
||||
;; we first collect `snippet--make-mirror' forms. When
|
||||
;; collecting them, we populate the `field-mirrors' table...
|
||||
@ -170,7 +195,7 @@ I would need these somewhere in the let* form
|
||||
(tuples (cl-remove '&eval tuples :key #'car))
|
||||
(make-mirror-forms
|
||||
(cl-loop for ((prev-sym)
|
||||
(sym (type name transform) parent-sym)
|
||||
(sym (type name (_ transform)) parent-sym)
|
||||
(next-sym))
|
||||
on `(nil ,@tuples)
|
||||
when (and sym (eq '&mirror type))
|
||||
@ -227,34 +252,42 @@ I would need these somewhere in the let* form
|
||||
`(lambda (field-text)
|
||||
(if (null field-text)
|
||||
""
|
||||
,(or transform-form
|
||||
'field-text))))
|
||||
,transform-form)))
|
||||
|
||||
(defun snippet--eval-lambda (eval-form)
|
||||
`(lambda (selected-text)
|
||||
,eval-form))
|
||||
|
||||
(defun define--snippet-body (body)
|
||||
"Does the actual work for `define-snippet'"
|
||||
(let* ((sym-tuples (snippet--form-sym-tuples body))
|
||||
(marker-init-forms (snippet--make-marker-init-forms sym-tuples))
|
||||
(init-object-forms (snippet--init-field-and-mirror-forms sym-tuples))
|
||||
(first-field-sym (snippet--first-field-sym sym-tuples)))
|
||||
(let* ((tuples (snippet--form-tuples body))
|
||||
(marker-init-forms (snippet--marker-init-forms tuples))
|
||||
(init-object-forms (snippet--object-init-forms tuples))
|
||||
(first-field-sym (snippet--first-field-sym tuples)))
|
||||
`(let* (,@(mapcar #'car init-object-forms)
|
||||
,@marker-init-forms)
|
||||
|
||||
,@(mapcar #'second init-object-forms)
|
||||
|
||||
,@(cl-loop
|
||||
for (sym form) in sym-tuples
|
||||
for (sym form) in tuples
|
||||
append (pcase form
|
||||
(`(&field ,_ . ,rest)
|
||||
(`(&field ,_ ,expr)
|
||||
`((snippet--insert-object ,sym)
|
||||
,(when (stringp (car rest))
|
||||
,(when (eq `&eval (car expr))
|
||||
`(snippet--with-current-object ,sym
|
||||
(insert ,(car rest))))))
|
||||
(insert
|
||||
(funcall ,(snippet--eval-lambda (cadr expr))
|
||||
(and (region-active-p)
|
||||
(buffer-substring-no-properties
|
||||
(region-beginning)
|
||||
(region-end)))))))))
|
||||
(`(&mirror . ,_)
|
||||
`((snippet--insert-object ,sym)))
|
||||
(t
|
||||
`((insert (eval ,form))))))
|
||||
,@(cl-loop
|
||||
for (sym form) in sym-tuples
|
||||
for (sym form) in tuples
|
||||
append (pcase form
|
||||
(`(&field . ,_)
|
||||
`((mapc #'snippet--update-mirror
|
||||
@ -279,7 +312,7 @@ I would need these somewhere in the let* form
|
||||
snippet-field-keymap)
|
||||
(overlay-put snippet--field-overlay
|
||||
'snippet--objects
|
||||
(list ,@(remove '&eval (mapcar #'car sym-tuples))))
|
||||
(list ,@(remove '&eval (mapcar #'car tuples))))
|
||||
,(if first-field-sym
|
||||
`(snippet--move-to-field ,first-field-sym))
|
||||
(add-hook 'post-command-hook 'snippet--post-command-hook t t))))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user