ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-14 13:33:04 +00:00
Code Issues Packages Projects Releases Wiki Activity

wip: still broken, but closer

Browse Source
This commit is contained in:
Joao Tavora 2013-11-06 00:13:29 +00:00
parent 7b7d2cea53
commit c5f62d81ae
1 changed files with 80 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
snippet.el
View File

@ -76,7 +76,7 @@
(`(&exit ,expr) (`(&exit ,expr)
`(&exit (&eval ,expr))) `(&exit (&eval ,expr)))
((or `&exit `(&exit)) ((or `&exit `(&exit))
`(&exit nil)) `(&exit (&eval nil)))
((pred atom) ((pred atom)
`(&eval ,form)) `(&eval ,form))
((pred consp) ((pred consp)
@ -84,10 +84,10 @@
(t (t
(error "invalid snippet form %s" form)))) (error "invalid snippet form %s" form))))
(defun snippet--unfold-forms (canonic-forms &optional parent-field-sym) (defun snippet--unfold-forms (canonic-forms &optional parent-sym)
(cl-loop for form in canonic-forms (cl-loop for form in canonic-forms
collect (append form collect (append form
`((&parent ,parent-field-sym))) `((&parent ,parent-sym)))
append (pcase form append (pcase form
(`(&field ,name (&nested . ,subforms)) (`(&field ,name (&nested . ,subforms))
(snippet--unfold-forms subforms (snippet--unfold-forms subforms
@ -119,14 +119,15 @@
(defun define--snippet-body (body) (defun define--snippet-body (body)
"Does the actual work for `define-snippet'" "Does the actual work for `define-snippet'"
(let ((unfolded (snippet--unfold-forms body))) (let ((unfolded (snippet--unfold-forms
(mapcar #'snippet--canonicalize-form body))))
`(let* (,@(loop for form in unfolded `(let* (,@(loop for form in unfolded
append (pcase form append (pcase form
(`(&field ,name ,_expr (&parent ,parent)) (`(&field ,name ,_expr (&parent ,parent))
`((,(snippet--make-field-sym name) `((,(snippet--make-field-sym name)
(snippet--make-field :parent-field (snippet--make-field :parent
,parent)))))) ,parent))))))
(region-string (and (region-active-p) (region (and (region-active-p)
(buffer-substring-no-properties (buffer-substring-no-properties
(region-beginning) (region-beginning)
(region-end))))) (region-end)))))
@ -138,40 +139,43 @@
with all-objects with all-objects
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--insert-field
,sym ,sym
:prev ,prev-sym ,prev-sym
:parent ,parent ,(pcase expr
:default ,(pcase expr
(`(&eval ,form) (`(&eval ,form)
`(funcall ,(snippet--eval-lambda form) `(funcall ,(snippet--eval-lambda form)
region-string))))))) region-string)))))))
(`(&mirror ,name ,_expr (&parent ,parent)) (`(&mirror ,name ,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))
`((,sym (snippet--make-and-insert-mirror `((,sym (snippet--make-and-insert-mirror
:source ,(snippet--make-field-sym name) ,parent
:parent ,parent ,prev-sym
:prev ,prev-sym)))) ,(snippet--make-field-sym name)
(`(&exit ,_expr (&parent ,parent)) ,(snippet--transform-lambda transform)))))
(`(&exit (&eval ,form) (&parent ,parent))
(setq sym (snippet--make-exit-sym)) (setq sym (snippet--make-exit-sym))
`((,sym (snippet--make-and-insert-exit `((,sym (snippet--make-and-insert-exit
:parent ,parent ,parent
:prev ,prev-sym)))) ,prev-sym
,(and form
`(funcall ,(snippet--eval-lambda form)
region-string))))))
(`(&eval ,form (&parent ,parent)) (`(&eval ,form (&parent ,parent))
`((,(cl-gensym "constant-") `((,(cl-gensym "constant-")
(snippet--insert-constant (snippet--insert-constant
(funcall ,(snippet--eval-lambda form) (funcall ,(snippet--eval-lambda form)
region-string) region-string)
:parent ,parent))))) into object-forms ,parent)))))
into object-forms
when sym do when sym do
(push sym all-objects) (push sym all-objects)
(setq prev-sym sym) (setq prev-sym sym)
(setq sym nil) (setq sym nil)
finally finally (cl-return
(cl-return
(append object-forms (append object-forms
`((all-objects ,all-objects))))) `((all-objects ,all-objects)))))
(sorted-fields ,(snippet--sorted-field-syms (sorted-fields ,(snippet--sorted-field-syms
@ -284,7 +288,7 @@ meaning is not decided yet"
;;; ;;;
(cl-defstruct snippet--object (cl-defstruct snippet--object
start end parent-field next prev (buffer (current-buffer))) start end parent next prev (buffer (current-buffer)))
(cl-defstruct (snippet--field (:constructor snippet--make-field-1) (cl-defstruct (snippet--field (:constructor snippet--make-field-1)
(:include snippet--object)) (:include snippet--object))
@ -304,21 +308,52 @@ meaning is not decided yet"
(let ((field (snippet--make-field-1 :parent parent))) (let ((field (snippet--make-field-1 :parent parent)))
field)) field))
(cl-defun snippet-insert-field (&rest args) (defmacro snippet--inserting-object (object prev &rest body)
) (declare (indent defun) (debug (sexp sexp &rest form)))
`(progn
(cl-assert (null (snippet--object-next ,prev)) nil
"previous object already has another sucessor")
(setf (snippet--object-next ,prev) ,object)
(setf (snippet--object-start ,object)
(if (= (point) (snippet--object-end ,prev))
(snippet--object-end ,prev)
(point-marker)))
,@body
(setf (snippet--object-end ,object)
(point-marker))
(when (snippet--object-parent ,object)
(setf (snippet--object-end
(snippet--object-parent ,object))
(snippet--object-end ,object)))))
(cl-defun snippet--make-and-insert-mirror (&rest args) (defun snippet--insert-field (field prev default)
(let ((mirror (apply #'snippet--make-mirror-1 args))) (snippet--inserting-object field prev
(snippet--init-object mirror) (when default
(cl-assert (snippet--mirror-source mirror) nil (insert default))))
"can't create mirror without source field")
(pushnew mirror (snippet--field-mirrors (snippet--mirror-source mirror))) (defun snippet--make-and-insert-mirror (parent prev source transform)
(let ((mirror (snippet--make-mirror-1
:parent parent
:prev prev
:source source
:transform transform)))
(snippet--inserting-object mirror prev
(pushnew mirror (snippet--field-mirrors source))
(setf (snippet--mirror-source mirror) source)
(setf (snippet--mirror-transform mirror) transform))
mirror)) mirror))
(defun snippet--make-exit (&rest args) (defun snippet--make-and-insert-exit (parent prev constant)
(let ((exit (apply #'snippet--make-exit-1 args))) (let ((exit (snippet--make-exit-1 :parent parent :prev prev)))
(snippet--init-object exit) (snippet--inserting-object exit prev
exit)) (when constant
(insert constant)))))
(defun snippet--insert-constant (constant parent)
(when constant
(insert constant))
(when parent
(setf (snippet--object-next parent) (point-marker))))
(defun snippet--describe-field (field) (defun snippet--describe-field (field)
(with-current-buffer (snippet--object-buffer field) (with-current-buffer (snippet--object-buffer field)
@ -369,7 +404,7 @@ meaning is not decided yet"
(defvar snippet--field-overlay nil) (defvar snippet--field-overlay nil)
(defun snippet--field-skip-p (field) (defun snippet--field-skip-p (field)
(let ((parent (snippet--field-parent-field field))) (let ((parent (snippet--field-parent field)))
(and parent (and parent
(snippet--object-empty-p field) (snippet--object-empty-p field)
(snippet--field-modified-p parent)))) (snippet--field-modified-p parent))))
@ -468,8 +503,8 @@ meaning is not decided yet"
(defun snippet--update-field-mirrors (field) (defun snippet--update-field-mirrors (field)
(mapc #'snippet--update-mirror (snippet--field-mirrors field)) (mapc #'snippet--update-mirror (snippet--field-mirrors field))
(when (snippet--object-parent-field field) (when (snippet--object-parent field)
(snippet--update-field-mirrors (snippet--object-parent-field field)))) (snippet--update-field-mirrors (snippet--object-parent field))))
(defun snippet--field-overlay-changed (overlay after? beg end (defun snippet--field-overlay-changed (overlay after? beg end
&optional pre-change-len) &optional pre-change-len)