Prepare for more simplification

* snippet.el (snippet--make-lambda, with-static-snippet): Simplify.
(snippet--make-and-insert-field): Renamed from `snippet--insert-field'
(snippet--call-with-inserting-object): Improve docstring.
This commit is contained in:
João Távora 2015-04-04 15:44:38 +01:00
parent 04591a4a86
commit 5366d29c64

View File

@ -112,7 +112,7 @@
,transform-form)) ,transform-form))
(defun snippet--make-lambda (eval-form) (defun snippet--make-lambda (eval-form)
`#'(lambda (region-string) `(lambda (region-string)
,eval-form)) ,eval-form))
(defun snippet--canonicalize-form (form) (defun snippet--canonicalize-form (form)
@ -172,42 +172,42 @@
As `define-static-snippet' but doesn't define a function." As `define-static-snippet' but doesn't define a function."
(let ((unfolded (snippet--unfold-forms (let ((unfolded (snippet--unfold-forms
(mapcar #'snippet--canonicalize-form forms))) (mapcar #'snippet--canonicalize-form forms)))
mirrors-and-sources
all-objects exit-object) all-objects exit-object)
`(let* (,@(loop for form in unfolded `(let* ((region-string (and (region-active-p)
append (pcase form
(`(&field ,name ,_expr (&parent ,parent))
`((,(snippet--make-field-sym name)
(make-instance 'snippet--field
:parent ,parent
:name ',name))))))
(region-string (and (region-active-p)
(buffer-substring-no-properties (buffer-substring-no-properties
(region-beginning) (region-beginning)
(region-end))))) (region-end))))
(let* (,@(loop ,@(loop
for form in unfolded for form in unfolded
with mirror-idx = 0 with mirror-idx = 0
with sym with sym
with prev-sym with prev-sym
append append
(pcase form (pcase form
(`(&field ,name ,expr (&parent ,_parent)) (`(&field ,name ,expr (&parent ,parent))
(setq sym (snippet--make-field-sym name)) (setq sym (snippet--make-field-sym name))
`((,sym (snippet--insert-field `((,sym (snippet--make-and-insert-field
,sym ',name
,prev-sym ,prev-sym
,parent
,(pcase expr ,(pcase expr
(`(&eval ,form) (`(&eval ,form)
`(funcall ,(snippet--make-lambda form) `(lambda ()
region-string))))))) (funcall
,(snippet--make-lambda form)
region-string))))))))
(`(&mirror ,name (&transform ,transform) (&parent ,parent)) (`(&mirror ,name (&transform ,transform) (&parent ,parent))
(setq sym (snippet--make-mirror-sym (setq sym (snippet--make-mirror-sym
(cl-incf mirror-idx) name)) (cl-incf mirror-idx) name))
(push
(cons sym
(snippet--make-field-sym name))
mirrors-and-sources)
`((,sym (snippet--make-and-insert-mirror `((,sym (snippet--make-and-insert-mirror
,parent ,parent
,prev-sym ,prev-sym
,(snippet--make-transform-lambda transform) ,(snippet--make-transform-lambda transform)))))
,(snippet--make-field-sym name)))))
(`(&exit (&eval ,form) (&parent ,parent)) (`(&exit (&eval ,form) (&parent ,parent))
(when exit-object (when exit-object
(error "Too many &exit forms given")) (error "Too many &exit forms given"))
@ -229,7 +229,10 @@ As `define-static-snippet' but doesn't define a function."
(push sym all-objects) (push sym all-objects)
(setq prev-sym sym) (setq prev-sym sym)
(setq sym nil))) (setq sym nil)))
(snippet--activate-snippet (list ,@all-objects)))))) ,@(cl-loop for (mirror . source) in mirrors-and-sources
collect `(setf (snippet--mirror-source ,mirror) ,source)
collect `(push ,mirror (snippet--field-mirrors ,source)))
(snippet--activate-snippet (list ,@all-objects)))))
(def-edebug-spec snippet-form (def-edebug-spec snippet-form
(&or (&or
@ -435,7 +438,8 @@ pairs. Its meaning is not decided yet"
(point-marker))))) (point-marker)))))
(funcall fn) (funcall fn)
;; Don't set the object's end if its already set and matches point. i.e. when ;; Don't set the object's end if its already set and matches point. i.e. when
;; running its function some nested field might have set it already and ;; running its function some nested field might have set it already and, if
;; point hasn't moved since, we need both end markers to be the same object.
(unless (and (snippet--object-end object) (unless (and (snippet--object-end object)
(= (snippet--object-end object) (point))) (= (snippet--object-end object) (point)))
(setf (snippet--object-end object) (setf (snippet--object-end object)
@ -451,15 +455,19 @@ pairs. Its meaning is not decided yet"
(declare (indent defun) (debug (sexp sexp &rest form))) (declare (indent defun) (debug (sexp sexp &rest form)))
`(snippet--call-with-inserting-object ,object ,prev #'(lambda () ,@body))) `(snippet--call-with-inserting-object ,object ,prev #'(lambda () ,@body)))
(defun snippet--insert-field (field prev default) (defun snippet--make-and-insert-field (name prev parent fn)
(let ((field (make-instance 'snippet--field
:name name
:parent parent)))
(snippet--inserting-object field prev (snippet--inserting-object field prev
(when default (when fn
(insert default)))) (let ((retval (funcall fn)))
(when (stringp retval)
(insert retval)))))))
(defun snippet--make-and-insert-mirror (parent prev transform &optional source) (defun snippet--make-and-insert-mirror (parent prev transform &optional source)
(let ((mirror (make-instance 'snippet--mirror (let ((mirror (make-instance 'snippet--mirror
:parent parent :parent parent
:prev prev
:source source :source source
:transform transform))) :transform transform)))
(when source (when source