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

Better names for dynamic and static version

Browse Source 
* snippet-tests.el (snippet--test-snippets-alist): Add static and
dynamic version of snippet to fixture.
(snippet--insert-test-snippet): Aware of dynamic snippets.
(sprintf-variation): Reintegrated deleted `snippet--test-sprintf-snippet'
(snippet--test-sprintf-snippet): Deleted.
(snippet-tests): Provide it.

* snippet.el: Better documentation.
(with-static-snippet): Renamed from `snippet--define-body'.
(define-dynamic-snippet): Renamed from `define-snippet'.
(with-dynamic-snippet): New macro.
This commit is contained in:
João Távora 2015-04-03 20:17:32 +01:00
parent ece2e7d1f2
commit 42543cd9e2
2 changed files with 148 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
snippet-tests.el
View File

@ -65,15 +65,35 @@
(&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
(&field 2)
(&mirror 1 (if (string-match "%" field-string) "\)" ""))))
(sprintf-maybe ((&mirror 0 (unless field-empty-p "s"))
"printf ("
(&field 0)
(&mirror 0 (unless field-empty-p ","))
"\""
(&field 1 "%s")
(&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
(&field 2)
(&mirror 1 (if (string-match "%" field-string) "\)" ""))))
(sprintf-maybe
;; static version
;;
((&mirror 0 (unless field-empty-p "s"))
"printf ("
(&field 0)
(&mirror 0 (unless field-empty-p ","))
"\""
(&field 1 "%s")
(&mirror 1 (if (string-match "%" field-string) "\"," "\")"))
(&field 2)
(&mirror 1 (if (string-match "%" field-string) "\)" "")))
;; dynamic version
;;
((&mirror 0 (_field-string field-empty-p)
(unless field-empty-p "s"))
(insert "printf (")
(&field 0)
(&mirror 0 (_field-string field-empty-p)
(unless field-empty-p ","))
(insert "\"")
(&field 1 (insert "%s"))
(&mirror 1
(field-string _field-empty-p)
(if (string-match "%" field-string) "\"," "\")"))
(&field 2)
(&mirror 1
(field-string _field-empty-p)
(if (string-match "%" field-string) "\)" ""))))
(emacs-version ((&field 1 emacs-version)
" " (upcase (emacs-version)) " "
(&mirror 1)))
@ -88,8 +108,17 @@
(&field last)
(&field 1)))))
(defun snippet--insert-test-snippet (name)
(funcall (make-snippet (cadr (assoc name snippet--test-snippets-alist)))))
(defun snippet--insert-test-snippet (name &optional dynamic-p)
(let* ((assoc (assoc name snippet--test-snippets-alist))
(forms (if dynamic-p
(caddr assoc)
(cadr assoc))))
(unless forms
(error "No %s definition for %s" (if dynamic-p "dynamic" "static") name))
(cond (dynamic-p
(eval `(with-dynamic-snippet ,@forms)))
(t
(eval `(with-static-snippet ,@forms))))))
(ert-deftest basic-expansion ()
(with-temp-buffer
@ -212,24 +241,21 @@
(ert-simulate-command '((lambda () (interactive) (insert "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 ()
(with-temp-buffer
(snippet--insert-test-snippet 'sprintf-maybe)
(snippet--test-sprintf-snippet)))
(snippet--insert-test-snippet 'sprintf-maybe 'dynamic)
(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 constants-and-default-values ()
(with-temp-buffer
@ -325,29 +351,5 @@
(should-error (snippet--canonicalize-form '(&field 1 (foo) (bar))))
(should-error (snippet--canonicalize-form '(&eval (foo) (bar)))))
;;; `snippet-defmacro' attempt
;;;
(define-snippet snippet--sprintf ()
(&mirror 0 (_field-string field-empty-p)
(unless field-empty-p "s"))
(insert "printf (")
(&field 0)
(&mirror 0 (_field-string field-empty-p)
(unless field-empty-p ","))
(insert "\"")
(&field 1 (insert "%s"))
(&mirror 1
(field-string _field-empty-p)
(if (string-match "%" field-string) "\"," "\")"))
(&field 2)
(&mirror 1
(field-string _field-empty-p)
(if (string-match "%" field-string) "\)" "")))
(ert-deftest sprintf-maybe-2 ()
(snippet--sprintf)
(snippet--test-sprintf-snippet))
(provide 'snippet)
(provide 'snippet-tests)

171
snippet.el
View File

@ -26,9 +26,13 @@
;; frontends with the bare minimum funcionality to define, insert, navigate and
;; undo snippets.
;;
;; Snippets are defined via the `define-snippet' or `make-snippet'
;; entrypoints. The snippet definition syntax is quite different (TODO: how so?)
;; Both are as powerful as yasnippet's (inspired by textmate's).
;; Snippets are defined via the `define-dynamic-snippet' or
;; `define-static-snippet' entrypoints. The snippet definition syntax is quite
;; different (TODO: how so?). Static snippets have better syntax checks at
;; compile-time, but complex snippets may be easier to write as dynamic
;; snippets. Both are as powerful as yasnippet's, in turn inspired by
;; textmate's). There are also `with-dynamic-snippet' and `with-static-snippet'
;; macros to use in your own defuns.
;;
;; Once inserted into a buffer, snippets are navigated using
;; `snippet-next-field' and `snippet-prev-field', bound to TAB and S-TAB by
@ -87,7 +91,7 @@
(require 'eieio)
;;; the `make-snippet' function and its helpers
;;; the `define-static-snippet' macro and its helpers
;;;
(defvar snippet--sym-obarray (make-vector 100 nil))
@ -162,10 +166,11 @@
(snippet--unfold-forms subforms
(snippet--make-field-sym name))))))
(defun snippet--define-body (body)
"Does the actual work for `make-snippet'."
(defmacro with-static-snippet (&rest forms)
"Define and insert a snippet from FORMS.
As `define-static-snippet' but doesn't define a function."
(let ((unfolded (snippet--unfold-forms
(mapcar #'snippet--canonicalize-form body)))
(mapcar #'snippet--canonicalize-form forms)))
all-objects exit-object)
`(let* (,@(loop for form in unfolded
append (pcase form
@ -231,7 +236,7 @@
("&field" sexp &or ("&nested" &rest snippet-form) def-form)
def-form))
(defun make-snippet (forms)
(defmacro define-static-snippet (name args &optional docstring &rest forms)
"Make a snippet-inserting function from FORMS.
Each form in SNIPPET-FORMS, inserted at point in order, can be:
@ -289,7 +294,86 @@ considered to have returned a single whitespace.
PROPERTIES is an even-numbered property list of (KEY VAL)
pairs. Its meaning is not decided yet"
`(lambda () ,(snippet--define-body forms)))
(declare ;; (debug (&define name sexp def-body))
(indent defun))
(unless (stringp docstring)
(push docstring forms)
(setq docstring nil))
`(defun ,name ,args ,docstring
(with-static-snippet ,@forms)))
;;; The `define-dynamic-snippet' macro
;;;
(defmacro with-dynamic-snippet (&rest body)
`(let (;; (start (point-marker))
(snippet--fields (make-hash-table))
(snippet--mirrors (make-hash-table))
(snippet--current-field)
(snippet--prev-object)
(snippet--all-objects))
(cl-macrolet ((&field (field-name &body field-forms)
`(let* ((field
(setf (gethash ',field-name snippet--fields)
(make-instance 'snippet--field
:name ',field-name
:parent snippet--current-field)))
(fn (lambda ()
(let ((snippet--current-field field))
,@field-forms))))
(snippet--inserting-object
field snippet--prev-object
(funcall fn))
(setf snippet--prev-object field)
(push field snippet--all-objects)))
(&mirror (field-name mirror-args &body mirror-forms)
(cond ((> (length mirror-args) 2)
(error "At most two args in mirror transforms"))
((not (cadr mirror-args))
(setcdr mirror-args '(_--snippet-ignored))))
`(let* ((fn (lambda ,mirror-args ,@mirror-forms))
(mirror (make-instance 'snippet--mirror
:parent snippet--current-field
: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
(maphash (lambda (field-name mirrors)
(let ((field (gethash field-name snippet--fields)))
(unless field
(error "Snippet mirror references field \"%s\" which does not exist!"
field-name))
(mapc (lambda (mirror)
(push mirror (snippet--field-mirrors field))
(setf (snippet--mirror-source mirror) field))
mirrors)))
snippet--mirrors)
(snippet--activate-snippet snippet--all-objects))))
(defmacro define-dynamic-snippet (name args &optional docstring &rest body)
(declare (debug (&define name sexp def-body))
(indent defun))
(unless (stringp docstring)
(push docstring body)
(setq docstring nil))
`(defun ,name ,args ,docstring
(with-dynamic-snippet ,@body)))
(def-edebug-spec &mirror (sexp sexp &rest form))
(def-edebug-spec &field (sexp &rest form))
(put '&field 'lisp-indent-function 'defun)
(put '&mirror 'lisp-indent-function 'defun)
(put '&exit 'lisp-indent-function 'defun)
;;; Snippet mechanics
@ -663,74 +747,7 @@ Skips over nested fields if their parent has been modified."
(display-buffer (current-buffer))))
;;; The `define-snippet' macro
;;;
(defmacro define-snippet (name args &optional docstring &rest body)
(declare (debug (&define name sexp def-body))
(indent defun))
(unless (stringp docstring)
(push docstring body)
(setq docstring nil))
`(defun ,name ,args ,docstring
(let (;; (start (point-marker))
(snippet--fields (make-hash-table))
(snippet--mirrors (make-hash-table))
(snippet--current-field)
(snippet--prev-object)
(snippet--all-objects))
(cl-macrolet ((&field (field-name &body field-forms)
`(let* ((field
(setf (gethash ',field-name snippet--fields)
(make-instance 'snippet--field
:name ',field-name
:parent snippet--current-field)))
(fn (lambda ()
(let ((snippet--current-field field))
,@field-forms))))
(snippet--inserting-object
field snippet--prev-object
(funcall fn))
(setf snippet--prev-object field)
(push field snippet--all-objects)))
(&mirror (field-name mirror-args &body mirror-forms)
(cond ((> (length mirror-args) 2)
(error "At most two args in mirror transforms"))
((not (cadr mirror-args))
(setcdr mirror-args '(_--snippet-ignored))))
`(let* ((fn (lambda ,mirror-args ,@mirror-forms))
(mirror (make-instance 'snippet--mirror
:parent snippet--current-field
: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
(maphash (lambda (field-name mirrors)
(let ((field (gethash field-name snippet--fields)))
(unless field
(error "Snippet mirror references field \"%s\" which does not exist!"
field-name))
(mapc (lambda (mirror)
(push mirror (snippet--field-mirrors field))
(setf (snippet--mirror-source mirror) field))
mirrors)))
snippet--mirrors)
(snippet--activate-snippet snippet--all-objects)))))
(def-edebug-spec &mirror (sexp sexp &rest form))
(def-edebug-spec &field (sexp &rest form))
(put '&field 'lisp-indent-function 'defun)
(put '&mirror 'lisp-indent-function 'defun)
(put '&exit 'lisp-indent-function 'defun)
(provide 'snippet)
;; Local Variables:
;; coding: utf-8