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,8 +112,8 @@
,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)
(pcase form (pcase form
@ -172,64 +172,67 @@
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
,(pcase expr ,parent
(`(&eval ,form) ,(pcase expr
(`(&eval ,form)
`(lambda ()
(funcall
,(snippet--make-lambda form)
region-string))))))))
(`(&mirror ,name (&transform ,transform) (&parent ,parent))
(setq sym (snippet--make-mirror-sym
(cl-incf mirror-idx) name))
(push
(cons sym
(snippet--make-field-sym name))
mirrors-and-sources)
`((,sym (snippet--make-and-insert-mirror
,parent
,prev-sym
,(snippet--make-transform-lambda transform)))))
(`(&exit (&eval ,form) (&parent ,parent))
(when exit-object
(error "Too many &exit forms given"))
(setq sym (snippet--make-exit-sym)
exit-object sym)
`((,sym (snippet--make-and-insert-exit
,parent
,prev-sym
,(and form
`(funcall ,(snippet--make-lambda form) `(funcall ,(snippet--make-lambda form)
region-string))))))) region-string))))))
(`(&mirror ,name (&transform ,transform) (&parent ,parent)) (`(&eval ,form (&parent ,parent))
(setq sym (snippet--make-mirror-sym `((,(cl-gensym "constant-")
(cl-incf mirror-idx) name)) (snippet--insert-constant
`((,sym (snippet--make-and-insert-mirror ,parent
,parent (funcall ,(snippet--make-lambda form)
,prev-sym region-string))))))
,(snippet--make-transform-lambda transform) when sym do
,(snippet--make-field-sym name))))) (push sym all-objects)
(`(&exit (&eval ,form) (&parent ,parent)) (setq prev-sym sym)
(when exit-object (setq sym nil)))
(error "Too many &exit forms given")) ,@(cl-loop for (mirror . source) in mirrors-and-sources
(setq sym (snippet--make-exit-sym) collect `(setf (snippet--mirror-source ,mirror) ,source)
exit-object sym) collect `(push ,mirror (snippet--field-mirrors ,source)))
`((,sym (snippet--make-and-insert-exit (snippet--activate-snippet (list ,@all-objects)))))
,parent
,prev-sym
,(and form
`(funcall ,(snippet--make-lambda form)
region-string))))))
(`(&eval ,form (&parent ,parent))
`((,(cl-gensym "constant-")
(snippet--insert-constant
,parent
(funcall ,(snippet--make-lambda form)
region-string))))))
when sym do
(push sym all-objects)
(setq prev-sym sym)
(setq sym nil)))
(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)
(snippet--inserting-object field prev (let ((field (make-instance 'snippet--field
(when default :name name
(insert default)))) :parent parent)))
(snippet--inserting-object field prev
(when fn
(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