From 9f88e596bf49a569bf42e9cfd25b9bf8eff5951b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Fri, 3 Apr 2015 12:31:35 +0100 Subject: [PATCH] First working test for the new macrolet approach * 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 --- snippet-tests.el | 59 +++++++++++++++++------------- snippet.el | 94 ++++++++++++++++++++++++++---------------------- 2 files changed, 87 insertions(+), 66 deletions(-) diff --git a/snippet-tests.el b/snippet-tests.el index 5ec6c2c..9edd5ac 100644 --- a/snippet-tests.el +++ b/snippet-tests.el @@ -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 @@ -212,12 +212,24 @@ (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) - (should (equal (buffer-string) "printf (\"%s\",)")) - (ert-simulate-command '((lambda () (interactive) (insert "somestring")))) - (should (equal (buffer-string) "sprintf (somestring,\"%s\",)")))) + (snippet--test-sprintf-snippet))) (ert-deftest constants-and-default-values () (with-temp-buffer @@ -316,27 +328,26 @@ ;;; `snippet-defmacro' attempt ;;; -(snippet-defmacro macro-test (variable) - (let ((start "coiso")) - (insert "anything") - (&field 1 (insert "theformatvar") - (insert start)) - (&mirror 1 (field-string) - (if (string-match "var" field-string) - (insert start) - (insert variable))) - (&exit) - (&mirror 1 (field-string) - (if (string-match "var" field-string) - (insert "ohohoh"))))) - - - - -;; (with-current-buffer (generate-new-buffer "*snippet-test*") -;; (display-buffer (current-buffer)) -;; (printf)) +(snippet-defmacro 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) diff --git a/snippet.el b/snippet.el index 168a5b5..beb10c9 100644 --- a/snippet.el +++ b/snippet.el @@ -201,8 +201,8 @@ Argument BODY is a list of forms as described in `define-snippet'." `((,sym (snippet--make-and-insert-mirror ,parent ,prev-sym - ,(snippet--make-field-sym name) - ',transform)))) + ,(snippet--make-transform-lambda transform) + ,(snippet--make-field-sym name))))) (`(&exit (&eval ,form) (&parent ,parent)) (when exit-object (error "Too many &exit forms given")) @@ -368,14 +368,15 @@ Argument FORMS is a list of forms as described in `define-snippet'." (when 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 :parent parent :prev prev :source source - :transform (snippet--make-transform-lambda transform)))) - (snippet--inserting-object mirror prev - (pushnew mirror (snippet--field-mirrors source))))) + :transform transform))) + (when source + (pushnew mirror (snippet--field-mirrors source))) + (snippet--inserting-object mirror prev))) (defun snippet--make-and-insert-exit (parent prev constant) (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)) (save-excursion (goto-char (snippet--object-start mirror)) - (let ((field-string (snippet--field-string (snippet--mirror-source mirror)))) - (insert (or (funcall (snippet--mirror-transform mirror) - field-string - (string= "" field-string)) - "")))))) + (let* ((field-string (snippet--field-string (snippet--mirror-source mirror))) + (retval (funcall (snippet--mirror-transform mirror) + field-string + (string= "" field-string)))) + (when (stringp retval) + (insert retval)))))) (defvar snippet--field-overlay nil) @@ -681,55 +683,63 @@ Skips over nested fields if their parent has been modified." (indent defun)) `(defun ,name ,args (let (;; (start (point-marker)) - (fields (make-hash-table)) - (mirrors (make-hash-table)) - (snippet--current-field)) + (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* ((snippet--current-field - (setf (gethash ',field-name fields) + `(let* ((field + (setf (gethash ',field-name snippet--fields) (make-instance 'snippet--field :name ',field-name :parent snippet--current-field))) - (fn (lambda () ,@field-forms))) - (setf (snippet--object-start snippet--current-field) - (point-marker)) - (funcall fn) - (setf (snippet--object-end snippet--current-field) - (point-marker)))) + (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) - `(let ((fn (lambda ,mirror-args ,@mirror-forms)) - (start (point-marker))) - (push (make-instance 'snippet--mirror :start start :end start - :transform (lambda (&rest args) - (goto-char start) - (apply fn args))) - (gethash ',field-name mirrors)))) - (&exit ())) + (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 fields))) + (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))) + (push mirror (snippet--field-mirrors field)) + (setf (snippet--mirror-source mirror) field)) mirrors))) - mirrors) - (maphash - (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)))) + 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)