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

refactor: use new

Browse Source
This commit is contained in:
Joao Tavora 2013-10-30 16:28:46 +01:00
parent 478211060c
commit f76b876c53
2 changed files with 78 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
snippet-tests.el
View File

@ -30,38 +30,38 @@
(defvar snippet--test-snippets-alist nil) (defvar snippet--test-snippets-alist nil)
(setq snippet--test-snippets-alist (setq snippet--test-snippets-alist
`((basic ((field 1 "foo") `((basic ((&field 1 "foo")
" bar " " bar "
(mirror 1))) (&mirror 1)))
(contrived ((field 1) (contrived ((&field 1)
(field 2) (&field 2)
(field 3))) (&field 3)))
(nested ("a " (nested ("a "
(field 1 ((field 2 "nested") (&field 1 (&nested (&field 2 "nested")
" " " "
(field 3 "field"))) (&field 3 "field")))
" and its mirror: " " and its mirror: "
(mirror 1))) (&mirror 1)))
(mirror-of-nested-field ("a " (mirror-of-nested-field ("a "
(field 1 ((field 2 "nested") (&field 1 (&nested (&field 2 "nested")
" " " "
(field 3 "field"))) (&field 3 "field")))
(mirror 3 (concat ", nested mirroring: " (&mirror 3 (concat ", nested mirroring: "
field-text)))) field-text))))
(printf ("printf (\"" (printf ("printf (\""
(field 1 "%s") (&field 1 "%s")
(mirror 1 (if (string-match "%" field-text) "\"," "\")")) (&mirror 1 (if (string-match "%" field-text) "\"," "\")"))
(field 2) (&field 2)
(mirror 1 (if (string-match "%" field-text) "\)" "")))) (&mirror 1 (if (string-match "%" field-text) "\)" ""))))
(sprintf-maybe ((mirror 0 (when field-text "s")) (sprintf-maybe ((&mirror 0 (when field-text "s"))
"printf (" "printf ("
(field 0) (&field 0)
(mirror 0 (when field-text ",")) (&mirror 0 (when field-text ","))
"\"" "\""
(field 1 "%s") (&field 1 "%s")
(mirror 1 (if (string-match "%" field-text) "\"," "\")")) (&mirror 1 (if (string-match "%" field-text) "\"," "\")"))
(field 2) (&field 2)
(mirror 1 (if (string-match "%" field-text) "\)" "")))))) (&mirror 1 (if (string-match "%" field-text) "\)" ""))))))
(defun snippet--insert-test-snippet (name) (defun snippet--insert-test-snippet (name)
(funcall (make-snippet (cadr (assoc name snippet--test-snippets-alist))))) (funcall (make-snippet (cadr (assoc name snippet--test-snippets-alist)))))

100
snippet.el
View File

@ -57,6 +57,15 @@
(and (eq 'quote (car form)) (and (eq 'quote (car form))
(fboundp (cl-second form))))) (fboundp (cl-second form)))))
(defun snippet--canonicalize-form (form)
(cond ((or (atom form)
(not (memq (first form) '(&mirror &field &eval))))
(list '&eval form))
(t
(cl-assert (not (cdddr form)) nil "malformed snippet form %s" form)
(append form
(make-list (- 3 (length form)) nil)))))
(defun snippet--form-sym-tuples (forms &optional parent-field-sym) (defun snippet--form-sym-tuples (forms &optional parent-field-sym)
"Produce information for composing the snippet expansion function. "Produce information for composing the snippet expansion function.
@ -66,42 +75,43 @@ A tuple of 6 elements is created for each form in FORMS.
Forms representing fields with nested elements are recursively Forms representing fields with nested elements are recursively
iterated depth-first, resulting in a flattened list." iterated depth-first, resulting in a flattened list."
(cl-loop unless forms return nil (cl-loop with forms = (mapcar #'snippet--canonicalize-form forms)
with snippet--form-mirror-sym-idx = (or snippet--form-mirror-sym-idx with snippet--form-mirror-sym-idx = (or snippet--form-mirror-sym-idx
0) 0)
with sym
with adjacent-prev-sym with adjacent-prev-sym
with has-children-p
for (prev-form form next-form) on `(nil ,@forms) for (prev-form form next-form) on `(nil ,@forms)
while form
with collect-sym = #'(lambda () `(,sym ,form
,parent-field-sym
,adjacent-prev-sym
,prev-form ,next-form))
collect
(pcase form
(`(&field ,name ,expr)
(setq sym (snippet--form-make-field-sym name
parent-field-sym)
has-children-p (and (listp expr)
(eq '&nested (car expr))))
for (sym childrenp) = (pcase form (funcall collect-sym))
(`(field ,name . ,rest)
(list (snippet--form-make-field-sym
name
parent-field-sym)
(listp (car rest))))
(`(mirror ,name . ,_)
(incf snippet--form-mirror-sym-idx)
(list (snippet--form-make-mirror-sym
snippet--form-mirror-sym-idx
name
parent-field-sym))))
append (cond (sym (`(&mirror ,name ,_transform)
`((,sym (incf snippet--form-mirror-sym-idx)
,form (setq sym (snippet--form-make-mirror-sym snippet--form-mirror-sym-idx
,parent-field-sym name
,adjacent-prev-sym parent-field-sym))
,prev-form (funcall collect-sym))
,next-form) (`(&eval ,_expr)
,@(when childrenp `,form)
(snippet--form-sym-tuples (third form) sym)))) (t
((null form) nil) (error "unknown type of snippet form %s" form)))
((or (stringp form) when has-children-p
(snippet--function-p form)) append (snippet--form-sym-tuples (cdr (cl-third form)) sym)
`((string-or-function ,form ,parent-field-sym))) do (setq adjacent-prev-sym sym
(t sym nil
(error "unknown type of snippet form %s" form))) has-children-p nil)))
do (setq adjacent-prev-sym sym)))
(defun snippet--make-marker-init-forms (tuples) (defun snippet--make-marker-init-forms (tuples)
"Make marker init forms for the snippet objects in TUPLES. "Make marker init forms for the snippet objects in TUPLES.
@ -127,8 +137,8 @@ I would need these somewhere in the let* form
(mm5-beg ff2-end) (mm5-beg ff2-end)
(mm5-end (make-marker))) (mm5-end (make-marker)))
" "
(cl-loop for (sym nil parent-sym adjacent-prev-sym prev next) in tuples (cl-loop for (sym nil parent-sym adjacent-prev-sym prev next)
unless (eq sym 'string-or-function) in (cl-remove '&eval tuples :key #'car)
append `((,(snippet--start-marker-name sym) append `((,(snippet--start-marker-name sym)
,(or (and adjacent-prev-sym ,(or (and adjacent-prev-sym
(snippet--end-marker-name adjacent-prev-sym)) (snippet--end-marker-name adjacent-prev-sym))
@ -149,7 +159,7 @@ I would need these somewhere in the let* form
(defun snippet--field-tuples (tuples) (defun snippet--field-tuples (tuples)
(cl-remove-if-not #'(lambda (form) (cl-remove-if-not #'(lambda (form)
(and (consp form) (and (consp form)
(eq 'field (car form)))) (eq '&field (car form))))
tuples :key #'cadr)) tuples :key #'cadr))
(defun snippet--init-field-and-mirror-forms (tuples) (defun snippet--init-field-and-mirror-forms (tuples)
@ -157,17 +167,17 @@ I would need these somewhere in the let* form
;; we first collect `snippet--make-mirror' forms. When ;; we first collect `snippet--make-mirror' forms. When
;; collecting them, we populate the `field-mirrors' table... ;; collecting them, we populate the `field-mirrors' table...
;; ;;
(tuples (cl-remove 'string-or-function tuples :key #'car)) (tuples (cl-remove '&eval tuples :key #'car))
(make-mirror-forms (make-mirror-forms
(cl-loop for ((prev-sym) (cl-loop for ((prev-sym)
(sym (type name transform) parent-sym) (sym (type name transform) parent-sym)
(next-sym)) (next-sym))
on `(nil ,@tuples) on `(nil ,@tuples)
when (and sym (eq 'mirror type)) when (and sym (eq '&mirror type))
collect (let ((source-sym nil)) collect (let ((source-sym nil))
(cl-loop for (sym-b (type-b name-b)) in tuples (cl-loop for (sym-b (type-b name-b)) in tuples
when (and when (and
(eq 'field type-b) (eq '&field type-b)
(eq name name-b)) (eq name name-b))
do do
(setq source-sym sym-b) (setq source-sym sym-b)
@ -196,7 +206,7 @@ I would need these somewhere in the let* form
(sym (type name _value) parent-sym) (sym (type name _value) parent-sym)
(next-sym)) (next-sym))
on `(nil ,@tuples) on `(nil ,@tuples)
when (and sym (eq 'field type)) when (and sym (eq '&field type))
collect `((,sym (snippet--make-field)) collect `((,sym (snippet--make-field))
(snippet--init-field (snippet--init-field
,sym ,sym
@ -234,21 +244,19 @@ I would need these somewhere in the let* form
,@(cl-loop ,@(cl-loop
for (sym form) in sym-tuples for (sym form) in sym-tuples
append (pcase form append (pcase form
(`(field ,_ . ,rest) (`(&field ,_ . ,rest)
`((snippet--insert-object ,sym) `((snippet--insert-object ,sym)
,(when (stringp (car rest)) ,(when (stringp (car rest))
`(snippet--with-current-object ,sym `(snippet--with-current-object ,sym
(insert ,(car rest)))))) (insert ,(car rest))))))
(`(mirror . ,_) (`(&mirror . ,_)
`((snippet--insert-object ,sym))) `((snippet--insert-object ,sym)))
((pred stringp) (t
`((insert ,form))) `((insert (eval ,form))))))
((pred functionp)
`((insert (funcall ,form))))))
,@(cl-loop ,@(cl-loop
for (sym form) in sym-tuples for (sym form) in sym-tuples
append (pcase form append (pcase form
(`(field . ,_) (`(&field . ,_)
`((mapc #'snippet--update-mirror `((mapc #'snippet--update-mirror
(snippet--field-mirrors ,sym)))))) (snippet--field-mirrors ,sym))))))
@ -271,9 +279,7 @@ I would need these somewhere in the let* form
snippet-field-keymap) snippet-field-keymap)
(overlay-put snippet--field-overlay (overlay-put snippet--field-overlay
'snippet--objects 'snippet--objects
(list ,@(remove 'string-or-function (list ,@(remove '&eval (mapcar #'car sym-tuples))))
(mapcar #'car
sym-tuples))))
,(if first-field-sym ,(if first-field-sym
`(snippet--move-to-field ,first-field-sym)) `(snippet--move-to-field ,first-field-sym))
(add-hook 'post-command-hook 'snippet--post-command-hook t t)))) (add-hook 'post-command-hook 'snippet--post-command-hook t t))))