diff --git a/snippet-tests.el b/snippet-tests.el index cb0e72d..b8dfbd6 100644 --- a/snippet-tests.el +++ b/snippet-tests.el @@ -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) diff --git a/snippet.el b/snippet.el index caaf4ba..c7f03ab 100644 --- a/snippet.el +++ b/snippet.el @@ -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