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

fix: correctly allow functions as snippet forms

Browse Source 
also make define-snippet expand directly to a defun
This commit is contained in:
Joao Tavora 2013-10-16 18:59:17 +01:00
parent 123f204d20
commit 33c696516a
1 changed files with 53 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
snippet.el
View File

@ -57,6 +57,13 @@
(defvar snippet--form-mirror-sym-idx nil) (defvar snippet--form-mirror-sym-idx nil)
(defun snippet--function-p (form)
(or (functionp form)
(and (eq 'function (first form))
(fboundp (second form)))
(and (eq 'quote (first form))
(fboundp (second form)))))
(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.
@ -95,11 +102,11 @@ iterated depth-first, resulting in a flattened list."
,@(when childrenp ,@(when childrenp
(snippet--form-sym-tuples (third form) sym)))) (snippet--form-sym-tuples (third form) sym))))
((null form) nil) ((null form) nil)
((or (stringp form) ((or (stringp form)
(symbolp form) (snippet--function-p form))
(eq (car form) 'lambda)) `((string-or-function ,form ,parent-field-sym)))
`((ignore ,form ,parent-field-sym)))) (t
(error "unknown type of snippet form %s" form)))
do (setq adjacent-prev-sym sym))) do (setq adjacent-prev-sym sym)))
(defun snippet--make-marker-init-forms (tuples) (defun snippet--make-marker-init-forms (tuples)
@ -215,7 +222,7 @@ I would need these somewhere in the let* form
(defmacro define-snippet (name _args &rest body) (defmacro define-snippet (name _args &rest body)
"Define NAME as a snippet. "Define NAME as a snippet-inserting function.
NAME's function definition is set to a function with no arguments NAME's function definition is set to a function with no arguments
that inserts the fields components at point. that inserts the fields components at point.
@ -255,51 +262,50 @@ can be:
(marker-init-forms (snippet--make-marker-init-forms sym-tuples)) (marker-init-forms (snippet--make-marker-init-forms sym-tuples))
(init-object-forms (snippet--init-field-and-mirror-forms sym-tuples)) (init-object-forms (snippet--init-field-and-mirror-forms sym-tuples))
(first-field-sym (snippet--first-field-sym sym-tuples))) (first-field-sym (snippet--first-field-sym sym-tuples)))
`(let ((insert-snippet-fn `(defun ,name ()
#'(lambda () (let* (,@(mapcar #'first init-object-forms)
(let* (,@(mapcar #'first init-object-forms) ,@marker-init-forms)
,@marker-init-forms)
,@(mapcar #'second init-object-forms) ,@(mapcar #'second init-object-forms)
,@(loop ,@(loop
for (sym form) in sym-tuples for (sym form) in sym-tuples
collect (cond ((snippet--form-field-p form) collect (cond ((snippet--form-field-p form)
`(snippet--insert-field ,sym ,(if (stringp (third form)) `(snippet--insert-field ,sym ,(if (stringp
(third form)))) (third form))
((snippet--form-mirror-p form) (third form))))
`(snippet--insert-mirror ,sym)) ((snippet--form-mirror-p form)
((stringp form) `(snippet--insert-mirror ,sym))
`(insert ,form)) ((stringp form)
((functionp form) `(insert ,form))
`(insert (funcall ,form))))) ((snippet--function-p form)
`(insert (funcall ,form)))))
(setq snippet--field-overlay (setq snippet--field-overlay
(make-overlay (point) (point) nil nil t)) (make-overlay (point) (point) nil nil t))
(overlay-put snippet--field-overlay (overlay-put snippet--field-overlay
'face 'face
'snippet-field-face) 'snippet-field-face)
(overlay-put snippet--field-overlay (overlay-put snippet--field-overlay
'modification-hooks 'modification-hooks
'(snippet--field-overlay-changed)) '(snippet--field-overlay-changed))
(overlay-put snippet--field-overlay (overlay-put snippet--field-overlay
'insert-in-front-hooks 'insert-in-front-hooks
'(snippet--field-overlay-changed)) '(snippet--field-overlay-changed))
(overlay-put snippet--field-overlay (overlay-put snippet--field-overlay
'insert-behind-hooks 'insert-behind-hooks
'(snippet--field-overlay-changed)) '(snippet--field-overlay-changed))
(overlay-put snippet--field-overlay (overlay-put snippet--field-overlay
'keymap 'keymap
snippet-field-keymap) snippet-field-keymap)
(overlay-put snippet--field-overlay (overlay-put snippet--field-overlay
'snippet--objects 'snippet--objects
(list ,@(remove 'ignore (mapcar #'first sym-tuples)))) (list ,@(remove 'string-or-function
,(if first-field-sym (mapcar #'first
`(snippet--move-to-field ,first-field-sym)) sym-tuples))))
(add-hook 'post-command-hook 'snippet--post-command-hook t t) ,(if first-field-sym
(snippet--post-command-hook))))) `(snippet--move-to-field ,first-field-sym))
(defun ,name () (add-hook 'post-command-hook 'snippet--post-command-hook t t)))))
(funcall insert-snippet-fn)))))
;;; Snippet mechanics ;;; Snippet mechanics