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

First working test for the new macrolet approach

Browse Source 
* snippet-tests.el: Use `lexical-binding: t`
(snippet--test-sprintf-snippet): New helper.
(sprintf-variation): Use it.
(macro-test): Removed.
(snippet--sprintf): New macrolet-style snippet for testing.
(sprintf-maybe-2): New test.

* snippet.el (snippet--define-body): Call
`snippet--make-transform-lambda' here.
(snippet--make-and-insert-mirror): Don't require `source' arg.
(snippet--update-mirror): Only insert when transform returns string.
(snippet-defmacro): Redesign.
(&exit): Add indent spec
This commit is contained in:
João Távora 2015-04-03 12:31:35 +01:00
parent 414d2cbc57
commit 9f88e596bf
2 changed files with 87 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
snippet-tests.el
View File

@ -1,4 +1,4 @@
;;; snippet-tests.el --- some basic tests for snippet.el ;;; snippet-tests.el --- some basic tests for snippet.el -*- lexical-binding: t; -*-
;; Copyright (C) 2013 ;; Copyright (C) 2013
@ -212,12 +212,24 @@
(ert-simulate-command '((lambda () (interactive) (insert "somevar")))) (ert-simulate-command '((lambda () (interactive) (insert "somevar"))))
(should (equal (buffer-string) "printf (\"%s\",somevar)")))) (should (equal (buffer-string) "printf (\"%s\",somevar)"))))
(defun snippet--test-sprintf-snippet ()
(should (equal (buffer-string) "printf (\"%s\",)"))
(ert-simulate-command '((lambda () (interactive) (insert "somestring"))))
(should (equal (buffer-string) "sprintf (somestring,\"%s\",)"))
(ert-simulate-command '(snippet-next-field))
(ert-simulate-command '(snippet-next-field))
(should (looking-back "sprintf (somestring,\"%s\","))
(ert-simulate-command '(snippet-prev-field))
(ert-simulate-command '((lambda () (interactive) (insert "bla"))))
(should (equal (buffer-string) "sprintf (somestring,\"bla\")"))
(should (looking-back "sprintf (somestring,\"bla"))
(ert-simulate-command '(snippet-next-field))
(should (looking-back "sprintf (somestring,\"bla\")")))
(ert-deftest sprintf-variation () (ert-deftest sprintf-variation ()
(with-temp-buffer (with-temp-buffer
(snippet--insert-test-snippet 'sprintf-maybe) (snippet--insert-test-snippet 'sprintf-maybe)
(should (equal (buffer-string) "printf (\"%s\",)")) (snippet--test-sprintf-snippet)))
(ert-simulate-command '((lambda () (interactive) (insert "somestring"))))
(should (equal (buffer-string) "sprintf (somestring,\"%s\",)"))))
(ert-deftest constants-and-default-values () (ert-deftest constants-and-default-values ()
(with-temp-buffer (with-temp-buffer
@ -316,27 +328,26 @@
;;; `snippet-defmacro' attempt ;;; `snippet-defmacro' attempt
;;; ;;;
(snippet-defmacro macro-test (variable) (snippet-defmacro snippet--sprintf ()
(let ((start "coiso")) (&mirror 0 (_field-string field-empty-p)
(insert "anything") (unless field-empty-p "s"))
(&field 1 (insert "theformatvar") (insert "printf (")
(insert start)) (&field 0)
(&mirror 1 (field-string) (&mirror 0 (_field-string field-empty-p)
(if (string-match "var" field-string) (unless field-empty-p ","))
(insert start) (insert "\"")
(insert variable))) (&field 1 (insert "%s"))
(&exit) (&mirror 1
(&mirror 1 (field-string) (field-string _field-empty-p)
(if (string-match "var" field-string) (if (string-match "%" field-string) "\"," "\")"))
(insert "ohohoh"))))) (&field 2)
(&mirror 1
(field-string _field-empty-p)
(if (string-match "%" field-string) "\)" "")))
;; (with-current-buffer (generate-new-buffer "*snippet-test*")
;; (display-buffer (current-buffer))
;; (printf))
(ert-deftest sprintf-maybe-2 ()
(snippet--sprintf)
(snippet--test-sprintf-snippet))
(provide 'snippet) (provide 'snippet)

94
snippet.el
View File

@ -201,8 +201,8 @@ Argument BODY is a list of forms as described in `define-snippet'."
`((,sym (snippet--make-and-insert-mirror `((,sym (snippet--make-and-insert-mirror
,parent ,parent
,prev-sym ,prev-sym
,(snippet--make-field-sym name) ,(snippet--make-transform-lambda transform)
',transform)))) ,(snippet--make-field-sym name)))))
(`(&exit (&eval ,form) (&parent ,parent)) (`(&exit (&eval ,form) (&parent ,parent))
(when exit-object (when exit-object
(error "Too many &exit forms given")) (error "Too many &exit forms given"))
@ -368,14 +368,15 @@ Argument FORMS is a list of forms as described in `define-snippet'."
(when default (when default
(insert default)))) (insert default))))
(defun snippet--make-and-insert-mirror (parent prev source transform) (defun snippet--make-and-insert-mirror (parent prev transform &optional source)
(let ((mirror (make-instance 'snippet--mirror (let ((mirror (make-instance 'snippet--mirror
:parent parent :parent parent
:prev prev :prev prev
:source source :source source
:transform (snippet--make-transform-lambda transform)))) :transform transform)))
(snippet--inserting-object mirror prev (when source
(pushnew mirror (snippet--field-mirrors source))))) (pushnew mirror (snippet--field-mirrors source)))
(snippet--inserting-object mirror prev)))
(defun snippet--make-and-insert-exit (parent prev constant) (defun snippet--make-and-insert-exit (parent prev constant)
(let ((exit (make-instance 'snippet--exit :parent parent :prev prev))) (let ((exit (make-instance 'snippet--exit :parent parent :prev prev)))
@ -437,11 +438,12 @@ Argument FORMS is a list of forms as described in `define-snippet'."
(snippet--object-end mirror)) (snippet--object-end mirror))
(save-excursion (save-excursion
(goto-char (snippet--object-start mirror)) (goto-char (snippet--object-start mirror))
(let ((field-string (snippet--field-string (snippet--mirror-source mirror)))) (let* ((field-string (snippet--field-string (snippet--mirror-source mirror)))
(insert (or (funcall (snippet--mirror-transform mirror) (retval (funcall (snippet--mirror-transform mirror)
field-string field-string
(string= "" field-string)) (string= "" field-string))))
"")))))) (when (stringp retval)
(insert retval))))))
(defvar snippet--field-overlay nil) (defvar snippet--field-overlay nil)
@ -681,55 +683,63 @@ Skips over nested fields if their parent has been modified."
(indent defun)) (indent defun))
`(defun ,name ,args `(defun ,name ,args
(let (;; (start (point-marker)) (let (;; (start (point-marker))
(fields (make-hash-table)) (snippet--fields (make-hash-table))
(mirrors (make-hash-table)) (snippet--mirrors (make-hash-table))
(snippet--current-field)) (snippet--current-field)
(snippet--prev-object)
(snippet--all-objects))
(cl-macrolet ((&field (field-name &body field-forms) (cl-macrolet ((&field (field-name &body field-forms)
`(let* ((snippet--current-field `(let* ((field
(setf (gethash ',field-name fields) (setf (gethash ',field-name snippet--fields)
(make-instance 'snippet--field (make-instance 'snippet--field
:name ',field-name :name ',field-name
:parent snippet--current-field))) :parent snippet--current-field)))
(fn (lambda () ,@field-forms))) (fn (lambda ()
(setf (snippet--object-start snippet--current-field) (let ((snippet--current-field field))
(point-marker)) ,@field-forms))))
(funcall fn) (snippet--inserting-object
(setf (snippet--object-end snippet--current-field) field snippet--prev-object
(point-marker)))) (funcall fn))
(setf snippet--prev-object field)
(push field snippet--all-objects)))
(&mirror (field-name mirror-args &body mirror-forms) (&mirror (field-name mirror-args &body mirror-forms)
`(let ((fn (lambda ,mirror-args ,@mirror-forms)) (cond ((> (length mirror-args) 2)
(start (point-marker))) (error "At most two args in mirror transforms"))
(push (make-instance 'snippet--mirror :start start :end start ((not (cadr mirror-args))
:transform (lambda (&rest args) (setcdr mirror-args '(_--snippet-ignored))))
(goto-char start) `(let* ((fn (lambda ,mirror-args ,@mirror-forms))
(apply fn args))) (mirror (make-instance 'snippet--mirror
(gethash ',field-name mirrors)))) :parent snippet--current-field
(&exit ())) :transform fn)))
(push mirror (gethash ',field-name snippet--mirrors))
(snippet--inserting-object mirror snippet--prev-object)
(setf snippet--prev-object mirror)
(push mirror snippet--all-objects)))
(&exit ()
`(let ((exit (make-instance 'snippet--exit
:parent snippet--current-field)))
(snippet--inserting-object exit snippet--prev-object)
(setf snippet--prev-object exit)
(push exit snippet--all-objects))))
,@body ,@body
(maphash (lambda (field-name mirrors) (maphash (lambda (field-name mirrors)
(let ((field (gethash field-name fields))) (let ((field (gethash field-name snippet--fields)))
(unless field (unless field
(error "Snippet mirror references field \"%s\" which does not exist!" (error "Snippet mirror references field \"%s\" which does not exist!"
field-name)) field-name))
(mapc (lambda (mirror) (mapc (lambda (mirror)
(push mirror (snippet--field-mirrors field))) (push mirror (snippet--field-mirrors field))
(setf (snippet--mirror-source mirror) field))
mirrors))) mirrors)))
mirrors) snippet--mirrors)
(maphash (snippet--activate-snippet snippet--all-objects)))))
(lambda (_name field)
(mapc (lambda (mirror)
(funcall (snippet--mirror-transform mirror)
(buffer-substring-no-properties (snippet--object-start field)
(snippet--object-end field))))
(snippet--field-mirrors field)))
fields)
fields))))
(def-edebug-spec &mirror (sexp sexp &rest form)) (def-edebug-spec &mirror (sexp sexp &rest form))
(def-edebug-spec &field (sexp &rest form)) (def-edebug-spec &field (sexp &rest form))
(put '&field 'lisp-indent-function 'defun) (put '&field 'lisp-indent-function 'defun)
(put '&mirror 'lisp-indent-function 'defun) (put '&mirror 'lisp-indent-function 'defun)
(put '&exit 'lisp-indent-function 'defun)