ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-14 13:33:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

add: support expansion-time evaluation forms and validate some input

Browse Source
This commit is contained in:
Joao Tavora 2013-10-31 01:35:19 +00:00
parent f76b876c53
commit db38009ee8
2 changed files with 121 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
snippet-tests.el
View File

@ -61,7 +61,10 @@
(&field 1 "%s") (&field 1 "%s")
(&mirror 1 (if (string-match "%" field-text) "\"," "\")")) (&mirror 1 (if (string-match "%" field-text) "\"," "\")"))
(&field 2) (&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) (defun snippet--insert-test-snippet (name)
(funcall (make-snippet (cadr (assoc name snippet--test-snippets-alist))))) (funcall (make-snippet (cadr (assoc name snippet--test-snippets-alist)))))
@ -180,3 +183,59 @@
(should (equal (buffer-string) "printf (\"%s\",)")) (should (equal (buffer-string) "printf (\"%s\",)"))
(ert-simulate-command '((lambda () (interactive) (insert "somestring")))) (ert-simulate-command '((lambda () (interactive) (insert "somestring"))))
(should (equal (buffer-string) "sprintf (somestring,\"%s\",)")))) (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
View File

@ -58,15 +58,40 @@
(fboundp (cl-second form))))) (fboundp (cl-second form)))))
(defun snippet--canonicalize-form (form) (defun snippet--canonicalize-form (form)
(cond ((or (atom form) (pcase form
(not (memq (first form) '(&mirror &field &eval)))) ((or `&field `(&field))
(list '&eval form)) `(&field ,(cl-gensym "auto-") nil))
(t (`(&field ,name)
(cl-assert (not (cdddr form)) nil "malformed snippet form %s" form) `(&field ,name nil))
(append form ((pred atom)
(make-list (- 3 (length form)) nil))))) `(&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. "Produce information for composing the snippet expansion function.
A tuple of 6 elements is created for each form in FORMS. 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 sym
with adjacent-prev-sym with adjacent-prev-sym
with has-children-p with has-children-p
for (prev-form form next-form) on `(nil ,@forms) for (prev-form form next-form) on `(nil ,@forms)
while form while form
with collect-sym = #'(lambda () `(,sym ,form with collect-sym = #'(lambda () `(,sym ,form
,parent-field-sym ,parent-field-sym
,adjacent-prev-sym ,adjacent-prev-sym
@ -97,23 +124,21 @@ iterated depth-first, resulting in a flattened list."
(funcall collect-sym)) (funcall collect-sym))
(`(&mirror ,name ,_transform) (`(&mirror ,name ,_expr)
(incf snippet--form-mirror-sym-idx) (incf snippet--form-mirror-sym-idx)
(setq sym (snippet--form-make-mirror-sym snippet--form-mirror-sym-idx (setq sym (snippet--form-make-mirror-sym snippet--form-mirror-sym-idx
name name
parent-field-sym)) parent-field-sym))
(funcall collect-sym)) (funcall collect-sym))
(`(&eval ,_expr) (`(&eval ,_expr)
`,form) `,form))
(t
(error "unknown type of snippet form %s" form)))
when has-children-p 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 do (setq adjacent-prev-sym sym
sym nil sym nil
has-children-p 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. "Make marker init forms for the snippet objects in TUPLES.
Imagine this snippet: Imagine this snippet:
@ -162,7 +187,7 @@ I would need these somewhere in the let* form
(eq '&field (car form)))) (eq '&field (car form))))
tuples :key #'cadr)) tuples :key #'cadr))
(defun snippet--init-field-and-mirror-forms (tuples) (defun snippet--object-init-forms (tuples)
(let* ((field-mirrors (make-hash-table)) (let* ((field-mirrors (make-hash-table))
;; we first collect `snippet--make-mirror' forms. When ;; we first collect `snippet--make-mirror' forms. When
;; collecting them, we populate the `field-mirrors' table... ;; 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)) (tuples (cl-remove '&eval tuples :key #'car))
(make-mirror-forms (make-mirror-forms
(cl-loop for ((prev-sym) (cl-loop for ((prev-sym)
(sym (type name transform) parent-sym) (sym (type name (_ transform)) parent-sym)
(next-sym)) (next-sym))
on `(nil ,@tuples) on `(nil ,@tuples)
when (and sym (eq '&mirror type)) when (and sym (eq '&mirror type))
@ -227,34 +252,42 @@ I would need these somewhere in the let* form
`(lambda (field-text) `(lambda (field-text)
(if (null field-text) (if (null field-text)
"" ""
,(or transform-form ,transform-form)))
'field-text))))
(defun snippet--eval-lambda (eval-form)
`(lambda (selected-text)
,eval-form))
(defun define--snippet-body (body) (defun define--snippet-body (body)
"Does the actual work for `define-snippet'" "Does the actual work for `define-snippet'"
(let* ((sym-tuples (snippet--form-sym-tuples body)) (let* ((tuples (snippet--form-tuples body))
(marker-init-forms (snippet--make-marker-init-forms sym-tuples)) (marker-init-forms (snippet--marker-init-forms tuples))
(init-object-forms (snippet--init-field-and-mirror-forms sym-tuples)) (init-object-forms (snippet--object-init-forms tuples))
(first-field-sym (snippet--first-field-sym sym-tuples))) (first-field-sym (snippet--first-field-sym tuples)))
`(let* (,@(mapcar #'car init-object-forms) `(let* (,@(mapcar #'car init-object-forms)
,@marker-init-forms) ,@marker-init-forms)
,@(mapcar #'second init-object-forms) ,@(mapcar #'second init-object-forms)
,@(cl-loop ,@(cl-loop
for (sym form) in sym-tuples for (sym form) in tuples
append (pcase form append (pcase form
(`(&field ,_ . ,rest) (`(&field ,_ ,expr)
`((snippet--insert-object ,sym) `((snippet--insert-object ,sym)
,(when (stringp (car rest)) ,(when (eq `&eval (car expr))
`(snippet--with-current-object ,sym `(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 . ,_) (`(&mirror . ,_)
`((snippet--insert-object ,sym))) `((snippet--insert-object ,sym)))
(t (t
`((insert (eval ,form)))))) `((insert (eval ,form))))))
,@(cl-loop ,@(cl-loop
for (sym form) in sym-tuples for (sym form) in tuples
append (pcase form append (pcase form
(`(&field . ,_) (`(&field . ,_)
`((mapc #'snippet--update-mirror `((mapc #'snippet--update-mirror
@ -279,7 +312,7 @@ I would need these somewhere in the let* form
snippet-field-keymap) snippet-field-keymap)
(overlay-put snippet--field-overlay (overlay-put snippet--field-overlay
'snippet--objects 'snippet--objects
(list ,@(remove '&eval (mapcar #'car sym-tuples)))) (list ,@(remove '&eval (mapcar #'car tuples))))
,(if first-field-sym ,(if first-field-sym
`(snippet--move-to-field ,first-field-sym)) `(snippet--move-to-field ,first-field-sym))
(add-hook 'post-command-hook 'snippet--post-command-hook t t)))) (add-hook 'post-command-hook 'snippet--post-command-hook t t))))