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

add: field ordering and snippet exits

Browse Source
This commit is contained in:
Joao Tavora 2013-11-04 00:56:22 +00:00
parent b789c13f75
commit d04d5dbae6
2 changed files with 133 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
snippet-tests.el
View File

@ -68,7 +68,13 @@
(wrap-selected-region ("foo" (wrap-selected-region ("foo"
selected-text selected-text
"baz" "baz"
(&field 1 selected-text))))) (&field 1 selected-text)))
(navigate-fields ("foo"
&exit
(&field 2)
&field
(&field last)
(&field 1)))))
(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)))))
@ -188,7 +194,7 @@
(ert-simulate-command '((lambda () (interactive) (insert "somestring")))) (ert-simulate-command '((lambda () (interactive) (insert "somestring"))))
(should (equal (buffer-string) "sprintf (somestring,\"%s\",)")))) (should (equal (buffer-string) "sprintf (somestring,\"%s\",)"))))
(ert-deftest emacs-version () (ert-deftest constants-and-default-values ()
(with-temp-buffer (with-temp-buffer
(snippet--insert-test-snippet 'emacs-version) (snippet--insert-test-snippet 'emacs-version)
(should (equal (buffer-string) (should (equal (buffer-string)
@ -214,6 +220,21 @@
(should (equal (buffer-string) (should (equal (buffer-string)
"foobarbazbar")))) "foobarbazbar"))))
(ert-deftest navigate-fields-and-exit ()
(with-temp-buffer
(snippet--insert-test-snippet 'navigate-fields)
(should (equal (buffer-string) "foo"))
(ert-simulate-command '((lambda () (interactive) (insert "quam"))))
(ert-simulate-command '(snippet-next-field))
(ert-simulate-command '((lambda () (interactive) (insert "bar"))))
(ert-simulate-command '(snippet-next-field))
(ert-simulate-command '((lambda () (interactive) (insert "baz"))))
(ert-simulate-command '(snippet-next-field))
(ert-simulate-command '((lambda () (interactive) (insert "quux"))))
(ert-simulate-command '(snippet-next-field))
(should (equal (buffer-string) "foobarbazquuxquam"))
(should (null (overlay-buffer snippet--field-overlay)))
(should (looking-at "barbazquuxquam"))))
;;; input validation ;;; input validation
@ -231,8 +252,6 @@
'(&field 1 (&nested (foo) (bar))))) '(&field 1 (&nested (foo) (bar)))))
(should (equal (snippet--canonicalize-form '(&field 1)) (should (equal (snippet--canonicalize-form '(&field 1))
'(&field 1 nil))) '(&field 1 nil)))
;; mirrors ;; mirrors
;; ;;
(should (equal (snippet--canonicalize-form '(&mirror 1)) (should (equal (snippet--canonicalize-form '(&mirror 1))
@ -241,7 +260,16 @@
'(&mirror 1 (&transform (foo))))) '(&mirror 1 (&transform (foo)))))
(should (equal (snippet--canonicalize-form '(&mirror 1 (&transform (foo)))) (should (equal (snippet--canonicalize-form '(&mirror 1 (&transform (foo))))
'(&mirror 1 (&transform (foo))))) '(&mirror 1 (&transform (foo)))))
;; normal forms
;; exit
;;
(should (equal (snippet--canonicalize-form '&exit)
'(&exit nil nil)))
(should (equal (snippet--canonicalize-form `(&exit))
'(&exit nil nil)))
(should (equal (snippet--canonicalize-form `(&exit (foo)))
'(&exit nil (&eval (foo)))))
;; constants
;; ;;
(should (equal (snippet--canonicalize-form "bla") (should (equal (snippet--canonicalize-form "bla")
'(&eval "bla"))) '(&eval "bla")))

160
snippet.el
View File

@ -40,6 +40,11 @@
(format "-son-of-%s" parent-field-sym) (format "-son-of-%s" parent-field-sym)
"")))) ""))))
(defun snippet--form-make-exit-sym (parent-field-sym)
(make-symbol (format "exit%s" (if parent-field-sym
(format "-son-of-%s" parent-field-sym)
""))))
(defvar snippet--marker-sym-obarray (make-vector 100 nil)) (defvar snippet--marker-sym-obarray (make-vector 100 nil))
(defun snippet--start-marker-name (sym) (defun snippet--start-marker-name (sym)
@ -49,15 +54,14 @@
(intern (format "%s-end" sym) snippet--marker-sym-obarray)) (intern (format "%s-end" sym) snippet--marker-sym-obarray))
(defvar snippet--form-mirror-sym-idx nil) (defvar snippet--form-mirror-sym-idx nil)
(defvar snippet--form-exit-seen-p nil)
(defun snippet--canonicalize-form (form) (defun snippet--canonicalize-form (form)
(pcase form (pcase form
((or `&field `(&field)) ((or `&field `(&field))
`(&field ,(cl-gensym "auto-") nil)) `(&field ,(cl-gensym "auto") nil))
(`(&field ,name) (`(&field ,name)
`(&field ,name nil)) `(&field ,name nil))
((pred atom)
`(&eval ,form))
(`(&eval ,_) (`(&eval ,_)
form) form)
(`(&eval . ,_) (`(&eval . ,_)
@ -84,6 +88,13 @@
(`(&field ,name ,expr) (`(&field ,name ,expr)
`(&field ,name (&eval ,expr))) `(&field ,name (&eval ,expr)))
(`(&exit ,expr)
`(&exit nil (&eval ,expr)))
((or `&exit `(&exit))
`(&exit nil nil))
((pred atom)
`(&eval ,form))
((pred consp) ((pred consp)
`(&eval ,form)) `(&eval ,form))
(t (t
@ -101,6 +112,7 @@ iterated depth-first, resulting in a flattened list."
(cl-loop with forms = (mapcar #'snippet--canonicalize-form forms) (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 snippet--form-exit-seen-p = snippet--form-exit-seen-p
with sym with sym
with adjacent-prev-sym with adjacent-prev-sym
with has-children-p with has-children-p
@ -128,6 +140,12 @@ iterated depth-first, resulting in a flattened list."
name name
parent-field-sym)) parent-field-sym))
(funcall collect-sym)) (funcall collect-sym))
(`(&exit ,_ ,_expr)
(when snippet--form-exit-seen-p
(error "only one &exit form allowed"))
(setq snippet--form-exit-seen-p t)
(setq sym (snippet--form-make-exit-sym parent-field-sym))
(funcall collect-sym))
(`(&eval ,_expr) (`(&eval ,_expr)
`,form)) `,form))
when has-children-p when has-children-p
@ -176,14 +194,18 @@ I would need these somewhere in the let* form
`(snippet--make-marker)))))) `(snippet--make-marker))))))
(defun snippet--first-field-sym (tuples)
(car (car (snippet--field-tuples tuples))))
(defun snippet--field-tuples (tuples) (defun snippet--field-tuples (tuples)
(cl-remove-if-not #'(lambda (form) (cl-sort (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)
#'(lambda (n1 n2)
(cond ((not (integerp n1)) nil)
((not (integerp n2)) t)
(t (< n1 n2))))
;; cadadr composes cl-second twice to get to the number
;; after the &fild
:key #'cadadr))
(defun snippet--object-init-forms (tuples) (defun snippet--object-init-forms (tuples)
(let* ((field-mirrors (make-hash-table)) (let* ((field-mirrors (make-hash-table))
@ -238,10 +260,19 @@ I would need these somewhere in the let* form
,parent-sym ,parent-sym
,prev-sym ,prev-sym
,next-sym ,next-sym
,name ',name
(list (list
,@(reverse ,@(reverse
(gethash sym field-mirrors)))))))) (gethash sym field-mirrors)))))
when (and sym (eq '&exit type))
collect `((,sym (snippet--make-exit))
(snippet--init-exit
,sym
,(snippet--start-marker-name sym)
,(snippet--end-marker-name sym)
,parent-sym
,prev-sym
,next-sym)))))
(append make-field-forms (append make-field-forms
make-mirror-forms))) make-mirror-forms)))
@ -259,34 +290,29 @@ I would need these somewhere in the let* form
(let* ((tuples (snippet--form-tuples body)) (let* ((tuples (snippet--form-tuples body))
(marker-init-forms (snippet--marker-init-forms tuples)) (marker-init-forms (snippet--marker-init-forms tuples))
(init-object-forms (snippet--object-init-forms tuples)) (init-object-forms (snippet--object-init-forms tuples))
(first-field-sym (snippet--first-field-sym tuples)) (region-text-sym (make-symbol "region-string"))
(region-text-sym (make-symbol "region-string"))) (objects-sym (make-symbol "objects")))
`(let* (,@(mapcar #'car init-object-forms) `(let* (,@(mapcar #'car init-object-forms)
,@marker-init-forms ,@marker-init-forms
(,region-text-sym (and (region-active-p) (,region-text-sym (and (region-active-p)
(buffer-substring-no-properties (buffer-substring-no-properties
(region-beginning) (region-beginning)
(region-end))))) (region-end))))
(,objects-sym (list ,@(remove '&eval (mapcar #'car tuples)))))
,@(mapcar #'second init-object-forms) ,@(mapcar #'second init-object-forms)
,@(cl-loop ,@(cl-loop
for (sym form) in tuples for (sym form) in tuples
append (pcase form collect (pcase form
(`(&field ,_ ,expr) (`(,(or `&field `&mirror `&exit) ,_ ,expr)
`((snippet--insert-object ,sym) `(snippet--insert-object
,(when (eq `&eval (car expr)) ,sym ,(and (eq '&eval (car expr))
`(snippet--with-current-object ,sym `(funcall ,(snippet--eval-lambda (cadr expr))
(insert ,region-text-sym))))
(or (funcall ,(snippet--eval-lambda (cadr expr)) (t
,region-text-sym) `(insert (or (funcall ,(snippet--eval-lambda form)
""))))))
(`(&mirror . ,_)
`((snippet--insert-object ,sym)))
(t
`((insert (or (funcall ,(snippet--eval-lambda form)
,region-text-sym) ,region-text-sym)
" ")))))) " ")))))
,@(cl-loop ,@(cl-loop
for (sym form) in tuples for (sym form) in tuples
append (pcase form append (pcase form
@ -314,8 +340,17 @@ I would need these somewhere in the let* form
(overlay-put snippet--field-overlay (overlay-put snippet--field-overlay
'snippet--objects 'snippet--objects
(list ,@(remove '&eval (mapcar #'car tuples)))) (list ,@(remove '&eval (mapcar #'car tuples))))
,(if first-field-sym (overlay-put snippet--field-overlay
`(snippet--move-to-field ,first-field-sym)) 'snippet--fields
(list ,@(mapcar #'car (snippet--field-tuples tuples))))
(overlay-put snippet--field-overlay 'snippet--exit
,(or (car (cl-find '&exit
(cl-remove '&eval tuples :key #'car)
:key #'caadr))
`(point-marker)))
(snippet-next-field)
(add-hook 'post-command-hook 'snippet--post-command-hook t t)))) (add-hook 'post-command-hook 'snippet--post-command-hook t t))))
@ -409,8 +444,7 @@ meaning is not decided yet"
(snippet--object-prev object) prev)) (snippet--object-prev object) prev))
(cl-defstruct (snippet--field (:constructor snippet--make-field ()) (cl-defstruct (snippet--field (:constructor snippet--make-field ())
(:include snippet--object) (:include snippet--object))
(:print-function snippet--describe-field))
name name
(mirrors '()) (mirrors '())
(modified-p nil)) (modified-p nil))
@ -432,8 +466,7 @@ meaning is not decided yet"
(snippet--field-mirrors object) mirrors)) (snippet--field-mirrors object) mirrors))
(cl-defstruct (snippet--mirror (:constructor snippet--make-mirror ()) (cl-defstruct (snippet--mirror (:constructor snippet--make-mirror ())
(:include snippet--object) (:include snippet--object))
(:print-function snippet--describe-mirror))
source source
(transform nil)) (transform nil))
@ -452,6 +485,21 @@ meaning is not decided yet"
(snippet--object-start mirror) (snippet--object-start mirror)
(snippet--object-end mirror))))) (snippet--object-end mirror)))))
(cl-defstruct (snippet--exit (:constructor snippet--make-exit ())
(:include snippet--object)))
(defun snippet--init-exit (object start end parent-field prev next)
(snippet--init-object object start end parent-field prev next))
(defun snippet--describe-exit (exit)
(with-current-buffer (snippet--object-buffer exit)
(format "exit from %s to %s covering \"%s\""
(marker-position (snippet--object-start exit))
(marker-position (snippet--object-end exit))
(buffer-substring-no-properties
(snippet--object-start exit)
(snippet--object-end exit)))))
(defgroup snippet nil (defgroup snippet nil
"Customize snippet features" "Customize snippet features"
:group 'convenience) :group 'convenience)
@ -470,22 +518,6 @@ meaning is not decided yet"
(defvar snippet--field-overlay nil) (defvar snippet--field-overlay nil)
(defun snippet--object-next-field (object)
(loop for next = (snippet--object-next object)
then (snippet--object-next next)
while (and next)
when (and (snippet--field-p next)
(not (snippet--field-skip-p next)))
return next))
(defun snippet--object-prev-field (object)
(loop for prev = (snippet--object-prev object)
then (snippet--object-prev prev)
while prev
when (and (snippet--field-p prev)
(not (snippet--field-skip-p prev)))
return prev))
(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 field)))
(and parent (and parent
@ -495,14 +527,19 @@ meaning is not decided yet"
(defun snippet-next-field (&optional prev) (defun snippet-next-field (&optional prev)
(interactive) (interactive)
(let* ((field (overlay-get snippet--field-overlay 'snippet--field)) (let* ((field (overlay-get snippet--field-overlay 'snippet--field))
(target (if prev (sorted (overlay-get snippet--field-overlay 'snippet--fields))
(snippet--object-prev-field field) (sorted (if prev (reverse sorted) sorted))
(snippet--object-next-field field)))) (target (if field
(cadr (cl-remove-if #'snippet--field-skip-p
(memq field sorted)))
(first sorted))))
(if target (if target
(snippet--move-to-field target) (snippet--move-to-field target)
(unless prev (let ((exit (overlay-get snippet--field-overlay 'snippet--exit)))
(goto-char (snippet--object-end field))) (goto-char (if (markerp exit)
(snippet-exit-snippet)))) exit
(snippet--object-start exit)))
(snippet-exit-snippet)))))
(defun snippet-prev-field () (defun snippet-prev-field ()
(interactive) (interactive)
@ -560,9 +597,12 @@ meaning is not decided yet"
(declare (indent defun) (debug t)) (declare (indent defun) (debug t))
`(snippet--call-with-current-object ,object #'(lambda () ,@body))) `(snippet--call-with-current-object ,object #'(lambda () ,@body)))
(defun snippet--insert-object (object) (defun snippet--insert-object (object &optional default)
(set-marker (snippet--object-start object) (point)) (set-marker (snippet--object-start object) (point))
(set-marker (snippet--object-end object) (point))) (set-marker (snippet--object-end object) (point))
(when default
(snippet--with-current-object object
(insert default))))
(defun snippet--update-mirror (mirror) (defun snippet--update-mirror (mirror)
(snippet--with-current-object mirror (snippet--with-current-object mirror