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

More simplification

Browse Source 
* snippet.el (with-static-snippet, with-dynamic-snippet): Use
`snippet--make-object'.
(snippet--object): Reorder slots to avoid strange eieio bug.
(snippet--make-object): Renamed from
`snippet--call-with-inserting-object'.
(snippet--inserting-object, snippet--make-and-insert-field)
(snippet--make-and-insert-mirror): Deleted.
This commit is contained in:
João Távora 2015-04-04 17:39:28 +01:00
parent e6f5504dd6
commit 59113376aa
1 changed files with 80 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

175
snippet.el
View File

@ -187,16 +187,17 @@ As `define-static-snippet' but doesn't define a function."
(pcase form (pcase form
(`(&field ,name ,expr (&parent ,parent)) (`(&field ,name ,expr (&parent ,parent))
(setq sym (snippet--make-field-sym name)) (setq sym (snippet--make-field-sym name))
`((,sym (snippet--make-and-insert-field `((,sym (snippet--make-object
',name 'snippet--field
,prev-sym ,prev-sym
,parent
,(pcase expr ,(pcase expr
(`(&eval ,form) (`(&eval ,form)
`(lambda (_ignored) `(lambda (_ignored)
(funcall (funcall
,(snippet--make-lambda form) ,(snippet--make-lambda form)
region-string)))))))) region-string))))
:name ',name
:parent ,parent))))
(`(&mirror ,name (&transform ,transform) (&parent ,parent)) (`(&mirror ,name (&transform ,transform) (&parent ,parent))
(setq sym (snippet--make-mirror-sym (setq sym (snippet--make-mirror-sym
(cl-incf mirror-idx) name)) (cl-incf mirror-idx) name))
@ -204,21 +205,24 @@ As `define-static-snippet' but doesn't define a function."
(cons sym (cons sym
(snippet--make-field-sym name)) (snippet--make-field-sym name))
mirrors-and-sources) mirrors-and-sources)
`((,sym (snippet--make-and-insert-mirror `((,sym (snippet--make-object
,parent 'snippet--mirror
,prev-sym ,prev-sym
,(snippet--make-transform-lambda transform))))) nil
:transform ,(snippet--make-transform-lambda transform)
:parent ,parent))))
(`(&exit (&eval ,form) (&parent ,parent)) (`(&exit (&eval ,form) (&parent ,parent))
(when exit-object (when exit-object
(error "Too many &exit forms given")) (error "Too many &exit forms given"))
(setq sym (snippet--make-exit-sym) (setq sym (snippet--make-exit-sym)
exit-object sym) exit-object sym)
`((,sym (snippet--make-and-insert-exit `((,sym (snippet--make-object
,parent 'snippet--exit
,prev-sym ,prev-sym
,(and form ,(and form
`(funcall ,(snippet--make-lambda form) `(funcall ,(snippet--make-lambda form)
region-string)))))) region-string))
:parent ,parent))))
(`(&eval ,form (&parent ,parent)) (`(&eval ,form (&parent ,parent))
`((,(cl-gensym "constant-") `((,(cl-gensym "constant-")
(snippet--insert-constant (snippet--insert-constant
@ -322,14 +326,15 @@ pairs. Its meaning is not decided yet"
(setf field-name (make-symbol "_ignored"))) (setf field-name (make-symbol "_ignored")))
`(let* ((fn (lambda () ,@field-forms)) `(let* ((fn (lambda () ,@field-forms))
(field (field
(snippet--make-and-insert-field (snippet--make-object
',field-name 'snippet--field
snippet--prev-object snippet--prev-object
snippet--current-field (lambda (fld)
(lambda (fld) (setf snippet--prev-object fld)
(setf snippet--prev-object fld) (let* ((snippet--current-field fld))
(let* ((snippet--current-field fld)) (funcall fn)))
(funcall fn)))))) :name ',field-name
:parent snippet--current-field)))
(setf (gethash ',field-name snippet--fields) (setf (gethash ',field-name snippet--fields)
field) field)
(push field snippet--all-objects))) (push field snippet--all-objects)))
@ -346,17 +351,21 @@ pairs. Its meaning is not decided yet"
collect (make-symbol "_ignored"))))) collect (make-symbol "_ignored")))))
`(let* ((fn (lambda ,mirror-args ,@mirror-forms)) `(let* ((fn (lambda ,mirror-args ,@mirror-forms))
(mirror (mirror
(snippet--make-and-insert-mirror (snippet--make-object
snippet--current-field 'snippet--mirror
snippet--prev-object snippet--prev-object
fn))) nil
:transform fn
:parent snippet--current-field)))
(push mirror (gethash ',field-name snippet--mirrors)) (push mirror (gethash ',field-name snippet--mirrors))
(push mirror snippet--all-objects) (push mirror snippet--all-objects)
(setf snippet--prev-object mirror))) (setf snippet--prev-object mirror)))
(&exit () (&exit ()
`(let ((exit (make-instance 'snippet--exit `(let ((exit (snippet--make-object
:parent snippet--current-field))) 'snippet--exit
(snippet--inserting-object exit snippet--prev-object) snippet--prev-object
nil
:parent snippet--current-field)))
(setf snippet--prev-object exit) (setf snippet--prev-object exit)
(push exit snippet--all-objects)))) (push exit snippet--all-objects))))
,@body ,@body
@ -394,11 +403,11 @@ pairs. Its meaning is not decided yet"
;;; ;;;
(defclass snippet--object () (defclass snippet--object ()
((start :initarg :start :accessor snippet--object-start) ((parent :initarg :parent :reader snippet--object-parent)
(end :initarg :end :accessor snippet--object-end) (start :accessor snippet--object-start)
(parent :initarg :parent :reader snippet--object-parent) (end :accessor snippet--object-end)
(prev :initarg :prev :accessor snippet--object-prev) (prev :accessor snippet--object-prev)
(next :initarg :next :accessor snippet--object-next) (next :accessor snippet--object-next)
(buffer :initform (current-buffer) :reader snippet--object-buffer))) (buffer :initform (current-buffer) :reader snippet--object-buffer)))
(defclass snippet--field (snippet--object) (defclass snippet--field (snippet--object)
@ -414,72 +423,48 @@ pairs. Its meaning is not decided yet"
(defclass snippet--exit (snippet--object) ()) (defclass snippet--exit (snippet--object) ())
(defun snippet--call-with-inserting-object (object prev fn) (defun snippet--make-object (class prev fn &rest initargs)
(when prev (let ((object (apply #'make-instance class initargs)))
(setf (snippet--object-prev object) prev) (when prev
(cl-assert (null (snippet--object-next prev)) nil (setf (snippet--object-prev object) prev)
"previous object already has another sucessor") (cl-assert (null (snippet--object-next prev)) nil
(setf (snippet--object-next prev) object)) "previous object already has another sucessor")
(setf (snippet--object-start object) (setf (snippet--object-next prev) object))
(let ((parent (snippet--object-parent object))) (setf (snippet--object-start object)
(cond ((and parent (let ((parent (snippet--object-parent object)))
(= (point) (snippet--object-start parent))) (cond ((and parent
(snippet--object-start parent)) (= (point) (snippet--object-start parent)))
((and prev (snippet--object-start parent))
(snippet--object-parent prev) ((and prev
(= (point) (snippet--object-end (snippet--object-parent prev)
(snippet--object-parent prev)))) (= (point) (snippet--object-end
(snippet--object-end (snippet--object-parent prev))))
(snippet--object-parent prev))) (snippet--object-end
((and prev (snippet--object-parent prev)))
(snippet--object-end prev) ((and prev
(= (point) (snippet--object-end prev))) (snippet--object-end prev)
(snippet--object-end prev)) (= (point) (snippet--object-end prev)))
(t (snippet--object-end prev))
(point-marker))))) (t
(funcall fn) (point-marker)))))
;; Don't set the object's end if its already set and matches point. i.e. when (cond ((functionp fn)
;; running its function some nested field might have set it already and, if (let ((retval (funcall fn object)))
;; point hasn't moved since, we need both end markers to be the same object. (when (stringp retval) (insert retval))))
(unless (and (snippet--object-end object) ((stringp fn)
(= (snippet--object-end object) (point))) (insert fn)))
(setf (snippet--object-end object) ;; Don't set the object's end if its already set and matches point. i.e. when
(point-marker))) ;; running its function some nested field might have set it already and, if
(when (snippet--object-parent object) ;; point hasn't moved since, we need both end markers to be the same object.
(setf (snippet--object-end (unless (and (snippet--object-end object)
(snippet--object-parent object)) (= (snippet--object-end object) (point)))
(snippet--object-end object))) (setf (snippet--object-end object)
(snippet--open-object object 'close) (point-marker)))
object) (when (snippet--object-parent object)
(setf (snippet--object-end
(defmacro snippet--inserting-object (object prev &rest body) (snippet--object-parent object))
(declare (indent defun) (debug (sexp sexp &rest form))) (snippet--object-end object)))
`(snippet--call-with-inserting-object ,object ,prev #'(lambda () ,@body))) (snippet--open-object object 'close)
object))
(defun snippet--make-and-insert-field (name prev parent fn)
(let ((field (make-instance 'snippet--field
:name name
:parent parent)))
(snippet--inserting-object field prev
(when fn
(let ((retval (funcall fn field)))
(when (stringp retval)
(insert retval)))))))
(defun snippet--make-and-insert-mirror (parent prev transform &optional source)
(let ((mirror (make-instance 'snippet--mirror
:parent parent
:source source
:transform transform)))
(when source
(pushnew mirror (snippet--field-mirrors source)))
(snippet--inserting-object mirror prev)))
(defun snippet--make-and-insert-exit (parent prev constant)
(let ((exit (make-instance 'snippet--exit :parent parent :prev prev)))
(snippet--inserting-object exit prev
(when constant
(insert constant)))))
(defun snippet--insert-constant (parent constant) (defun snippet--insert-constant (parent constant)
(when constant (when constant