fix: correctly allow functions as snippet forms

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

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,8 +262,7 @@ 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)
@ -265,13 +271,14 @@ can be:
,@(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)))) (third form))))
((snippet--form-mirror-p form) ((snippet--form-mirror-p form)
`(snippet--insert-mirror ,sym)) `(snippet--insert-mirror ,sym))
((stringp form) ((stringp form)
`(insert ,form)) `(insert ,form))
((functionp form) ((snippet--function-p form)
`(insert (funcall ,form))))) `(insert (funcall ,form)))))
(setq snippet--field-overlay (setq snippet--field-overlay
@ -293,13 +300,12 @@ can be:
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
(mapcar #'first
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)))))
(snippet--post-command-hook)))))
(defun ,name ()
(funcall insert-snippet-fn)))))
;;; Snippet mechanics ;;; Snippet mechanics