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

Implement snippet exits as snippet fields

Browse Source 
* snippet.el (snippet--object-<): New function.
(snippet--make-object): Replace `cl-assert' with ordinary error.
(snippet--open-object, snippet--with-current-object): Remove #'
prefix from lambda.
(snippet-next-field): Exiting is moving to the exit field.
(snippet--activate-snippet): Create exit field here if not created
yet.
(snippet--debug-snippet): Use `snippet--object-<'.
This commit is contained in:
João Távora 2015-04-04 22:30:33 +01:00
parent 59113376aa
commit 7a00c79746
1 changed files with 44 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
snippet.el
View File

@ -421,14 +421,23 @@ pairs. Its meaning is not decided yet"
(transform :initarg :transform :accessor snippet--mirror-transform)) (transform :initarg :transform :accessor snippet--mirror-transform))
:documentation "coiso") :documentation "coiso")
(defclass snippet--exit (snippet--object) ()) (defclass snippet--exit (snippet--field) ())
(defun snippet--object-< (o1 o2)
(let ((start1 (snippet--object-start o1))
(start2 (snippet--object-start o2)))
(if (< start1 start2)
t
(if (> start2 start1)
nil
(snippet--object-parent o2)))))
(defun snippet--make-object (class prev fn &rest initargs) (defun snippet--make-object (class prev fn &rest initargs)
(let ((object (apply #'make-instance class initargs))) (let ((object (apply #'make-instance class initargs)))
(when prev (when prev
(setf (snippet--object-prev object) prev) (setf (snippet--object-prev object) prev)
(cl-assert (null (snippet--object-next prev)) nil (when (snippet--object-next prev)
"previous object already has another sucessor") (error "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)))
@ -500,8 +509,8 @@ pairs. Its meaning is not decided yet"
(setq stay (append stay push) (setq stay (append stay push)
push nil) push nil)
(cl-rotatef stay push))) (cl-rotatef stay push)))
(mapc #'(lambda (m) (set-marker-insertion-type m nil)) stay) (mapc (lambda (m) (set-marker-insertion-type m nil)) stay)
(mapc #'(lambda (m) (set-marker-insertion-type m t)) push))) (mapc (lambda (m) (set-marker-insertion-type m t)) push)))
(defun snippet--call-with-current-object (object fn) (defun snippet--call-with-current-object (object fn)
(unwind-protect (unwind-protect
@ -512,7 +521,7 @@ pairs. Its meaning is not decided yet"
(defmacro snippet--with-current-object (object &rest body) (defmacro snippet--with-current-object (object &rest body)
(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--update-mirror (mirror) (defun snippet--update-mirror (mirror)
(snippet--with-current-object mirror (snippet--with-current-object mirror
@ -625,10 +634,8 @@ PREV means move to the previous field."
(snippet--move-to-field target) (snippet--move-to-field target)
(let ((exit (overlay-get snippet--field-overlay (let ((exit (overlay-get snippet--field-overlay
'snippet--exit))) 'snippet--exit)))
(goto-char (if (markerp exit) (snippet--move-to-field exit)
exit (overlay-put snippet--field-overlay 'snippet--exit-reason "exit")))))
(snippet--object-start exit))))
(snippet-exit-snippet "moved to exit"))))
(defun snippet-prev-field () (defun snippet-prev-field ()
"Move the the start of the previous field in the current snippet. "Move the the start of the previous field in the current snippet.
@ -648,25 +655,33 @@ Skips over nested fields if their parent has been modified."
;; (setq snippet--debug nil) ;; (setq snippet--debug nil)
(defun snippet--activate-snippet (objects) (defun snippet--activate-snippet (objects)
(let ((mirrors (cl-sort (let* ((exit (or (cl-find-if #'snippet--exit-p objects)
(progn (push (snippet--make-object
'snippet--exit
;; the first in `objects' must have been the
;; last inserted
(car objects)
nil
:parent nil
:name 'snippet--exit-field)
objects)
(car objects))))
(mirrors (cl-sort
(cl-copy-list
(cl-remove-if-not #'snippet--mirror-p objects))
#'(lambda (p1 p2)
(cond ((not p2) t)
((not p1) nil)))
:key #'snippet--object-parent))
(fields (cl-sort
(cl-copy-list (cl-copy-list
(cl-remove-if-not #'snippet--mirror-p objects)) (cl-remove-if #'snippet--exit-p
#'(lambda (p1 p2) (cl-remove-if-not #'snippet--field-p objects)))
(cond ((not p2) t) #'(lambda (n1 n2)
((not p1) nil))) (cond ((not (integerp n2)) t)
:key #'snippet--object-parent)) ((not (integerp n1)) nil)
(fields (cl-sort (t (< n1 n2))))
(cl-copy-list (cl-remove-if-not #'snippet--field-p objects)) :key #'snippet--field-name)))
#'(lambda (n1 n2)
(cond ((not (integerp n2)) t)
((not (integerp n1)) nil)
(t (< n1 n2))))
:key #'snippet--field-name))
(exit (or
(cl-find-if #'snippet--exit-p objects)
(let ((marker (point-marker)))
(prog1 marker
(set-marker-insertion-type marker t))))))
(mapc #'snippet--update-mirror mirrors) (mapc #'snippet--update-mirror 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)))
@ -780,14 +795,7 @@ Skips over nested fields if their parent has been modified."
(let ((inhibit-read-only t) (let ((inhibit-read-only t)
(sorted (cl-sort (cl-copy-list (sorted (cl-sort (cl-copy-list
(overlay-get field-overlay 'snippet--objects)) (overlay-get field-overlay 'snippet--objects))
#'(lambda (f1 f2) #'snippet--object-<)))
(let ((start1 (snippet--object-start f1))
(start2 (snippet--object-start f2)))
(if (< start1 start2)
t
(if (> start2 start1)
nil
(snippet--object-parent f2))))))))
(erase-buffer) (erase-buffer)
(cl-loop for object in sorted (cl-loop for object in sorted
do (insert (snippet--describe-object object) "\n"))) do (insert (snippet--describe-object object) "\n")))