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

wip: even closer

Browse Source
This commit is contained in:
Joao Tavora 2013-11-06 11:15:51 +00:00
parent 891c76fa71
commit 539c143d49
1 changed files with 31 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
snippet.el
View File

@ -41,6 +41,14 @@
(defun snippet--make-exit-sym () (defun snippet--make-exit-sym ()
(intern "exit" snippet--sym-obarray)) (intern "exit" snippet--sym-obarray))
(defun snippet--make-transform-lambda (transform-form)
`(lambda (field-string field-empty-p)
,transform-form))
(defun snippet--make-lambda (eval-form)
`#'(lambda (region-string)
,eval-form))
(defun snippet--canonicalize-form (form) (defun snippet--canonicalize-form (form)
(pcase form (pcase form
((or `&field `(&field)) ((or `&field `(&field))
@ -84,8 +92,8 @@
(t (t
(error "invalid snippet form %s" form)))) (error "invalid snippet form %s" form))))
(defun snippet--unfold-forms (canonic-forms &optional parent-sym) (defun snippet--unfold-forms (forms &optional parent-sym)
(cl-loop for form in canonic-forms (cl-loop for form in forms
collect (append form collect (append form
`((&parent ,parent-sym))) `((&parent ,parent-sym)))
append (pcase form append (pcase form
@ -93,37 +101,11 @@
(snippet--unfold-forms subforms (snippet--unfold-forms subforms
(snippet--make-field-sym name)))))) (snippet--make-field-sym name))))))
(defun snippet--sorted-field-syms (forms)
(let* ((field-forms (loop for form in forms
when (eq '&field (car form))
collect form))
(sorted (cl-sort field-forms
#'(lambda (n1 n2)
(cond ((not (integerp n1)) nil)
((not (integerp n2)) t)
(t (< n1 n2))))
:key #'(lambda (form)
(pcase form (`(&field ,name . ,_)
name))))))
(loop for form in sorted
collect (snippet--make-field-sym (cadr form)))))
(defun snippet--make-transform-lambda (transform-form)
`(lambda (field-string field-empty-p)
,transform-form))
(defun snippet--make-lambda (eval-form)
`#'(lambda (region-string)
,eval-form))
(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 (let ((unfolded (snippet--unfold-forms
(mapcar #'snippet--canonicalize-form body))) (mapcar #'snippet--canonicalize-form body)))
exit-object all-objects all-mirrors all-fields exit-object)
all-objects
all-mirrors)
`(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))
@ -143,6 +125,7 @@
(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))
(push sym all-fields)
`((,sym (snippet--insert-field `((,sym (snippet--insert-field
,sym ,sym
,prev-sym ,prev-sym
@ -177,12 +160,13 @@
(funcall ,(snippet--make-lambda form) (funcall ,(snippet--make-lambda form)
region-string)))))) region-string))))))
into object-forms 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
(progn
(unless exit-object (unless exit-object
(setq exit-object (snippet--make-exit-sym)) (setq exit-object (snippet--make-exit-sym))
(push exit-object all-objects) (push exit-object all-objects)
@ -191,13 +175,8 @@
nil nil
,prev-sym ,prev-sym
nil))))) nil)))))
(cl-return (cl-return object-forms)))
(append object-forms (mapc #'snippet--update-mirror (list ,@all-mirrors))
`((all-objects (list ,@all-objects)))))))
(sorted-fields (list ,@(snippet--sorted-field-syms
unfolded)))
(all-mirrors (list ,@all-mirrors)))
(mapc #'snippet--update-mirror all-mirrors)
(setq snippet--field-overlay (setq snippet--field-overlay
(let ((overlay (make-overlay (point) (point) nil nil t))) (let ((overlay (make-overlay (point) (point) nil nil t)))
(overlay-put overlay (overlay-put overlay
@ -217,10 +196,15 @@
snippet-field-keymap) snippet-field-keymap)
(overlay-put overlay (overlay-put overlay
'snippet--objects 'snippet--objects
all-objects) (list ,@all-objects))
(overlay-put overlay (overlay-put overlay
'snippet--fields 'snippet--fields
sorted-fields) (cl-sort (list ,@all-fields)
#'(lambda (n1 n2)
(cond ((not (integerp n2)) t)
((not (integerp n1)) nil)
(t (< n1 n2))))
:key #'snippet--field-name))
(overlay-put overlay (overlay-put overlay
'snippet--exit 'snippet--exit
,exit-object) ,exit-object)
@ -330,7 +314,6 @@ meaning is not decided yet"
(cl-assert (null (snippet--object-next prev)) nil (cl-assert (null (snippet--object-next prev)) nil
"previous object already has another sucessor") "previous object already has another sucessor")
(setf (snippet--object-next prev) object)) (setf (snippet--object-next prev) object))
(setf (snippet--object-start object) (setf (snippet--object-start object)
(let ((parent (snippet--object-parent object))) (let ((parent (snippet--object-parent object)))
(cond ((and parent (cond ((and parent
@ -461,9 +444,6 @@ meaning is not decided yet"
(format " (%s)" reason)) (format " (%s)" reason))
""))) "")))
(defun snippet--make-marker ()
(point-marker))
(defun snippet--object-empty-p (object) (defun snippet--object-empty-p (object)
(= (snippet--object-start object) (= (snippet--object-start object)
(snippet--object-end object))) (snippet--object-end object)))