From ddca1181a0451baba9f14237cdcec3a2432cb6e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Thu, 2 Apr 2015 21:07:23 +0100 Subject: [PATCH] Use eieio and attempt a snippet-defmacro per Stefan's suggestion * snippet-tests.el (macro-test): Dummy test for `snippet-defmacro'. * snippet.el (eieio): require 'eieio (snippet--define-body, snippet--make-and-insert-mirror) (snippet--make-and-insert-exit): Use `make-instance' (snippet--field-overlay-changed): Use `snippet--object-start' (snippet--field-skip-p): Use `snippet--object-parent' (snippet--object, snippet--field, snippet--mirror) (snippet--exit): Use `defclass' (snippet-defmacro): New broken macro. (&mirror, &field): New edebug specs. --- snippet-tests.el | 28 +++++++++++++ snippet.el | 104 +++++++++++++++++++++++++++++++++++------------ 2 files changed, 107 insertions(+), 25 deletions(-) diff --git a/snippet-tests.el b/snippet-tests.el index d97f2a8..5ec6c2c 100644 --- a/snippet-tests.el +++ b/snippet-tests.el @@ -312,3 +312,31 @@ (should-error (snippet--canonicalize-form '(&mirror 1 (foo) (bar)))) (should-error (snippet--canonicalize-form '(&field 1 (foo) (bar)))) (should-error (snippet--canonicalize-form '(&eval (foo) (bar))))) + + +;;; `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)) + + +(provide 'snippet) + diff --git a/snippet.el b/snippet.el index 864bea5..fde36a5 100644 --- a/snippet.el +++ b/snippet.el @@ -84,6 +84,7 @@ ;;; Code: (require 'cl-lib) +(require 'eieio) ;;; the define-snippet macro and its helpers @@ -171,8 +172,9 @@ Argument BODY is a list of forms as described in `define-snippet'." append (pcase form (`(&field ,name ,_expr (&parent ,parent)) `((,(snippet--make-field-sym name) - (snippet--make-field :parent ,parent - :name ',name)))))) + (make-instance 'snippet--field + :parent ,parent + :name ',name)))))) (region-string (and (region-active-p) (buffer-substring-no-properties (region-beginning) @@ -225,7 +227,7 @@ Argument BODY is a list of forms as described in `define-snippet'." (snippet--activate-snippet (list ,@all-objects)))))) -(cl-defmacro define-snippet (name (&rest properties) &rest snippet-forms) +(cl-defmacro define-snippet (name (&rest _properties) &rest snippet-forms) "Define NAME as a snippet-inserting function. NAME's function definition is set to a function with no arguments @@ -305,22 +307,26 @@ Argument FORMS is a list of forms as described in `define-snippet'." ;;; Snippet mechanics ;;; -(cl-defstruct snippet--object - start end parent next prev (buffer (current-buffer))) +(defclass snippet--object () + ((start :initarg :start :accessor snippet--object-start) + (end :initarg :end :accessor snippet--object-end) + (parent :initarg :parent :reader snippet--object-parent) + (prev :initarg :prev :accessor snippet--object-prev) + (next :initarg :next :accessor snippet--object-next) + (buffer :initform (current-buffer) :reader snippet--object-buffer))) -(cl-defstruct (snippet--field (:constructor snippet--make-field) - (:include snippet--object)) - name - (mirrors '()) - (modified-p nil)) +(defclass snippet--field (snippet--object) + ((name :initarg :name :accessor snippet--field-name) + (modified-p :initform nil :accessor snippet--field-modified-p) + (mirrors :initform (list) :accessor snippet--field-mirrors)) + :documentation "coiso") -(cl-defstruct (snippet--mirror (:constructor snippet--make-mirror) - (:include snippet--object)) - source - (transform nil)) +(defclass snippet--mirror (snippet--object) + ((source :initarg :source :accessor snippet--mirror-source) + (transform :initarg :transform :accessor snippet--mirror-transform)) + :documentation "coiso") -(cl-defstruct (snippet--exit (:constructor snippet--make-exit) - (:include snippet--object))) +(defclass snippet--exit (snippet--object) ()) (defun snippet--call-with-inserting-object (object prev fn) (when prev @@ -363,16 +369,16 @@ Argument FORMS is a list of forms as described in `define-snippet'." (insert default)))) (defun snippet--make-and-insert-mirror (parent prev source transform) - (let ((mirror (snippet--make-mirror - :parent parent - :prev prev - :source source - :transform (snippet--make-transform-lambda transform)))) + (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))))) (defun snippet--make-and-insert-exit (parent prev constant) - (let ((exit (snippet--make-exit :parent parent :prev prev))) + (let ((exit (make-instance 'snippet--exit :parent parent :prev prev))) (snippet--inserting-object exit prev (when constant (insert constant))))) @@ -465,7 +471,7 @@ Argument FORMS is a list of forms as described in `define-snippet'." ;; leave just the newly inserted text. ;; (when (and (not (snippet--field-modified-p field)) - (= beg (snippet--field-start field)) + (= beg (snippet--object-start field)) (zerop pre-change-len)) ;; At first glance, we could just delete the region between `end' ;; and the `field's end, but that wouldn't empty any child fields @@ -512,7 +518,7 @@ Argument FORMS is a list of forms as described in `define-snippet'." "The active keymap while a live snippet is being navigated.") (defun snippet--field-skip-p (field) - (let ((parent (snippet--field-parent field))) + (let ((parent (snippet--object-parent field))) (and parent (snippet--object-empty-p field) (snippet--field-modified-p parent)))) @@ -666,7 +672,55 @@ Skips over nested fields if their parent has been modified." (insert (snippet--describe-exit object) "\n"))))) (display-buffer (current-buffer)))) -(provide 'snippet) + + +;;; `snippet-defmacro' attempt +;;; +(cl-defmacro snippet-defmacro (name args &body body) + (declare (debug (&define name sexp def-body)) + (indent defun)) + `(defun ,name ,args + (let (;; (start (point-marker)) + (fields (make-hash-table)) + (mirrors (make-hash-table))) + (cl-macrolet ((&field (field-name &body field-forms) + `(let ((fn (lambda () ,@field-forms)) + (start (point-marker))) + (funcall fn) + (setf (gethash ,field-name + fields) + (make-instance 'snippet--field :name ,field-name + :start start + :end (point-marker))))) + (&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 ())) + ,@body + (maphash (lambda (field-name mirrors) + (let ((field (gethash field-name fields))) + (unless field + (error "Snippet mirror references field \"%s\" which does not exist!" + field-name)) + (mapc (lambda (mirror) + (push mirror (snippet--field-mirrors 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) + nil)))) + ;; Local Variables: ;; coding: utf-8