More simplification

* snippet.el (with-static-snippet): Dummy param in lambda to
`snippet--make-and-insert-field'.
(with-dynamic-snippet): Use `snippet--make-and-insert-field' and
`snippet-make-and-insert-mirror'
(snippet--make-and-insert-field): Call function with field.
This commit is contained in:
João Távora 2015-04-04 16:30:23 +01:00
parent 5366d29c64
commit e6f5504dd6

View File

@ -193,7 +193,7 @@ As `define-static-snippet' but doesn't define a function."
,parent ,parent
,(pcase expr ,(pcase expr
(`(&eval ,form) (`(&eval ,form)
`(lambda () `(lambda (_ignored)
(funcall (funcall
,(snippet--make-lambda form) ,(snippet--make-lambda form)
region-string)))))))) region-string))))))))
@ -320,18 +320,18 @@ pairs. Its meaning is not decided yet"
(cl-macrolet ((&field (&optional (field-name nil field-name-provided-p) &body field-forms) (cl-macrolet ((&field (&optional (field-name nil field-name-provided-p) &body field-forms)
(unless field-name-provided-p (unless field-name-provided-p
(setf field-name (make-symbol "_ignored"))) (setf field-name (make-symbol "_ignored")))
`(let ((fn (lambda () ,@field-forms)) `(let* ((fn (lambda () ,@field-forms))
(field (field
(setf (gethash ',field-name snippet--fields) (snippet--make-and-insert-field
(make-instance 'snippet--field ',field-name
:name ',field-name snippet--prev-object
:parent snippet--current-field)))) snippet--current-field
(snippet--inserting-object (lambda (fld)
field snippet--prev-object (setf snippet--prev-object fld)
(setf snippet--prev-object field) (let* ((snippet--current-field fld))
(let* ((snippet--current-field field) (funcall fn))))))
(retval (funcall fn))) (setf (gethash ',field-name snippet--fields)
(when (stringp retval) (insert retval)))) field)
(push field snippet--all-objects))) (push field snippet--all-objects)))
(&mirror (field-name &optional (mirror-args nil mirror-args-provided-p) &body mirror-forms) (&mirror (field-name &optional (mirror-args nil mirror-args-provided-p) &body mirror-forms)
(cond ((not mirror-args-provided-p) (cond ((not mirror-args-provided-p)
@ -345,13 +345,14 @@ pairs. Its meaning is not decided yet"
below 2 below 2
collect (make-symbol "_ignored"))))) collect (make-symbol "_ignored")))))
`(let* ((fn (lambda ,mirror-args ,@mirror-forms)) `(let* ((fn (lambda ,mirror-args ,@mirror-forms))
(mirror (make-instance 'snippet--mirror (mirror
:parent snippet--current-field (snippet--make-and-insert-mirror
:transform fn))) snippet--current-field
snippet--prev-object
fn)))
(push mirror (gethash ',field-name snippet--mirrors)) (push mirror (gethash ',field-name snippet--mirrors))
(snippet--inserting-object mirror snippet--prev-object) (push mirror snippet--all-objects)
(setf snippet--prev-object mirror) (setf snippet--prev-object mirror)))
(push mirror snippet--all-objects)))
(&exit () (&exit ()
`(let ((exit (make-instance 'snippet--exit `(let ((exit (make-instance 'snippet--exit
:parent snippet--current-field))) :parent snippet--current-field)))
@ -461,7 +462,7 @@ pairs. Its meaning is not decided yet"
:parent parent))) :parent parent)))
(snippet--inserting-object field prev (snippet--inserting-object field prev
(when fn (when fn
(let ((retval (funcall fn))) (let ((retval (funcall fn field)))
(when (stringp retval) (when (stringp retval)
(insert retval))))))) (insert retval)))))))