Minor simplification

(with-static-snippet, with-dynamic-snippet)
(snippet--activate-snippet): Update use of `snippet--make-object'.
(snippet--make-object): Don't take `prev' arg.
This commit is contained in:
João Távora 2015-04-04 22:38:52 +01:00
parent 7a00c79746
commit 2d111e82b1

View File

@ -189,7 +189,6 @@ As `define-static-snippet' but doesn't define a function."
(setq sym (snippet--make-field-sym name)) (setq sym (snippet--make-field-sym name))
`((,sym (snippet--make-object `((,sym (snippet--make-object
'snippet--field 'snippet--field
,prev-sym
,(pcase expr ,(pcase expr
(`(&eval ,form) (`(&eval ,form)
`(lambda (_ignored) `(lambda (_ignored)
@ -197,6 +196,7 @@ As `define-static-snippet' but doesn't define a function."
,(snippet--make-lambda form) ,(snippet--make-lambda form)
region-string)))) region-string))))
:name ',name :name ',name
:prev ,prev-sym
:parent ,parent)))) :parent ,parent))))
(`(&mirror ,name (&transform ,transform) (&parent ,parent)) (`(&mirror ,name (&transform ,transform) (&parent ,parent))
(setq sym (snippet--make-mirror-sym (setq sym (snippet--make-mirror-sym
@ -207,9 +207,9 @@ As `define-static-snippet' but doesn't define a function."
mirrors-and-sources) mirrors-and-sources)
`((,sym (snippet--make-object `((,sym (snippet--make-object
'snippet--mirror 'snippet--mirror
,prev-sym
nil nil
:transform ,(snippet--make-transform-lambda transform) :transform ,(snippet--make-transform-lambda transform)
:prev ,prev-sym
:parent ,parent)))) :parent ,parent))))
(`(&exit (&eval ,form) (&parent ,parent)) (`(&exit (&eval ,form) (&parent ,parent))
(when exit-object (when exit-object
@ -218,10 +218,10 @@ As `define-static-snippet' but doesn't define a function."
exit-object sym) exit-object sym)
`((,sym (snippet--make-object `((,sym (snippet--make-object
'snippet--exit 'snippet--exit
,prev-sym
,(and form ,(and form
`(funcall ,(snippet--make-lambda form) `(funcall ,(snippet--make-lambda form)
region-string)) region-string))
:prev ,prev-sym
:parent ,parent)))) :parent ,parent))))
(`(&eval ,form (&parent ,parent)) (`(&eval ,form (&parent ,parent))
`((,(cl-gensym "constant-") `((,(cl-gensym "constant-")
@ -328,13 +328,13 @@ pairs. Its meaning is not decided yet"
(field (field
(snippet--make-object (snippet--make-object
'snippet--field 'snippet--field
snippet--prev-object
(lambda (fld) (lambda (fld)
(setf snippet--prev-object fld) (setf snippet--prev-object fld)
(let* ((snippet--current-field fld)) (let* ((snippet--current-field fld))
(funcall fn))) (funcall fn)))
:name ',field-name :name ',field-name
:parent snippet--current-field))) :parent snippet--current-field
:prev snippet--prev-object)))
(setf (gethash ',field-name snippet--fields) (setf (gethash ',field-name snippet--fields)
field) field)
(push field snippet--all-objects))) (push field snippet--all-objects)))
@ -353,9 +353,9 @@ pairs. Its meaning is not decided yet"
(mirror (mirror
(snippet--make-object (snippet--make-object
'snippet--mirror 'snippet--mirror
snippet--prev-object
nil nil
:transform fn :transform fn
:prev snippet--prev-object
:parent snippet--current-field))) :parent snippet--current-field)))
(push mirror (gethash ',field-name snippet--mirrors)) (push mirror (gethash ',field-name snippet--mirrors))
(push mirror snippet--all-objects) (push mirror snippet--all-objects)
@ -363,8 +363,8 @@ pairs. Its meaning is not decided yet"
(&exit () (&exit ()
`(let ((exit (snippet--make-object `(let ((exit (snippet--make-object
'snippet--exit 'snippet--exit
snippet--prev-object
nil nil
:prev snippet--prev-object
:parent snippet--current-field))) :parent snippet--current-field)))
(setf snippet--prev-object exit) (setf snippet--prev-object exit)
(push exit snippet--all-objects)))) (push exit snippet--all-objects))))
@ -403,10 +403,12 @@ pairs. Its meaning is not decided yet"
;;; ;;;
(defclass snippet--object () (defclass snippet--object ()
;; keep the two initargable slots on top otherwise everything breaks.
;; TODO: report this to Stefan or Eric
((parent :initarg :parent :reader snippet--object-parent) ((parent :initarg :parent :reader snippet--object-parent)
(prev :initarg :prev :accessor snippet--object-prev)
(start :accessor snippet--object-start) (start :accessor snippet--object-start)
(end :accessor snippet--object-end) (end :accessor snippet--object-end)
(prev :accessor snippet--object-prev)
(next :accessor snippet--object-next) (next :accessor snippet--object-next)
(buffer :initform (current-buffer) :reader snippet--object-buffer))) (buffer :initform (current-buffer) :reader snippet--object-buffer)))
@ -432,10 +434,10 @@ pairs. Its meaning is not decided yet"
nil nil
(snippet--object-parent o2))))) (snippet--object-parent o2)))))
(defun snippet--make-object (class prev fn &rest initargs) (defun snippet--make-object (class fn &rest initargs)
(let ((object (apply #'make-instance class initargs))) (let* ((object (apply #'make-instance class initargs))
(prev (snippet--object-prev object)))
(when prev (when prev
(setf (snippet--object-prev object) prev)
(when (snippet--object-next prev) (when (snippet--object-next prev)
(error "previous object already has another sucessor")) (error "previous object already has another sucessor"))
(setf (snippet--object-next prev) object)) (setf (snippet--object-next prev) object))
@ -658,10 +660,10 @@ Skips over nested fields if their parent has been modified."
(let* ((exit (or (cl-find-if #'snippet--exit-p objects) (let* ((exit (or (cl-find-if #'snippet--exit-p objects)
(progn (push (snippet--make-object (progn (push (snippet--make-object
'snippet--exit 'snippet--exit
nil
;; the first in `objects' must have been the ;; the first in `objects' must have been the
;; last inserted ;; last inserted
(car objects) :prev (car objects)
nil
:parent nil :parent nil
:name 'snippet--exit-field) :name 'snippet--exit-field)
objects) objects)