refactor: store prev' and next' in all objects, not prev-field' and next-field'

This commit is contained in:
Joao Tavora 2013-10-19 01:40:44 +01:00
parent 67ddacd916
commit d43f42186d

View File

@ -159,8 +159,11 @@ I would need these somewhere in the let* form
;; ;;
(tuples (cl-remove 'string-or-function tuples :key #'car)) (tuples (cl-remove 'string-or-function tuples :key #'car))
(make-mirror-forms (make-mirror-forms
(cl-loop for (sym (type name transform) parent-sym) in tuples (cl-loop for ((prev-sym)
when (eq 'mirror type) (sym (type name transform) parent-sym)
(next-sym))
on `(nil ,@tuples)
when (and sym (eq 'mirror type))
collect (let ((source-sym nil)) collect (let ((source-sym nil))
(cl-loop for (sym-b (type-b name-b)) in tuples (cl-loop for (sym-b (type-b name-b)) in tuples
when (and when (and
@ -178,33 +181,34 @@ I would need these somewhere in the let* form
`((,sym (snippet--make-mirror)) `((,sym (snippet--make-mirror))
(snippet--init-mirror (snippet--init-mirror
,sym ,sym
,source-sym
,(snippet--start-marker-name sym) ,(snippet--start-marker-name sym)
,(snippet--end-marker-name sym) ,(snippet--end-marker-name sym)
,(snippet--transform-lambda transform) ,parent-sym
,parent-sym))))) ,prev-sym
,next-sym
,source-sym
,(snippet--transform-lambda transform))))))
;; so that we can now create `snippet--make-field' forms with ;; so that we can now create `snippet--make-field' forms with
;; complete lists of mirror symbols. ;; complete lists of mirror symbols.
;; ;;
(make-field-forms (make-field-forms
(cl-loop with field-tuples = (snippet--field-tuples tuples) (cl-loop for ((prev-sym)
for ((prev-sym) (sym (type name _value) parent-sym)
(sym (_type name _value) parent-sym) (next-sym))
(next-sym)) on `(nil ,@field-tuples) on `(nil ,@tuples)
when sym when (and sym (eq 'field type))
collect `((,sym (snippet--make-field))
collect `((,sym (snippet--make-field)) (snippet--init-field
(snippet--init-field ,sym
,sym ,(snippet--start-marker-name sym)
,name ,(snippet--end-marker-name sym)
,(snippet--start-marker-name sym) ,parent-sym
,(snippet--end-marker-name sym) ,prev-sym
,parent-sym ,next-sym
(list ,name
,@(reverse (list
(gethash sym field-mirrors))) ,@(reverse
,next-sym (gethash sym field-mirrors))))))))
,prev-sym)))))
(append make-field-forms (append make-field-forms
make-mirror-forms))) make-mirror-forms)))
@ -323,13 +327,18 @@ can be:
(cl-defstruct snippet--object (cl-defstruct snippet--object
start end parent-field next prev (buffer (current-buffer))) start end parent-field next prev (buffer (current-buffer)))
(defun snippet--init-object (object start end parent-field prev next)
(setf (snippet--object-start object) start
(snippet--object-end object) end
(snippet--object-parent-field object) parent-field
(snippet--object-next object) next
(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)) (:print-function snippet--describe-field))
name name
(mirrors '()) (mirrors '()))
next-field
prev-field)
(defun snippet--describe-field (field) (defun snippet--describe-field (field)
(with-current-buffer (snippet--object-buffer field) (with-current-buffer (snippet--object-buffer field)
@ -341,15 +350,11 @@ can be:
(snippet--object-start field) (snippet--object-start field)
(snippet--object-end field))))) (snippet--object-end field)))))
(defun snippet--init-field (object name start end parent-field mirrors (defun snippet--init-field (object start end parent-field prev next
next-field prev-field) name mirrors)
(snippet--init-object object start end parent-field prev next)
(setf (snippet--field-name object) name (setf (snippet--field-name object) name
(snippet--object-start object) start (snippet--field-mirrors object) mirrors))
(snippet--object-end object) end
(snippet--object-parent-field object) parent-field
(snippet--field-mirrors object) mirrors
(snippet--field-next-field object) next-field
(snippet--field-prev-field object) prev-field))
(cl-defstruct (snippet--mirror (:constructor snippet--make-mirror ()) (cl-defstruct (snippet--mirror (:constructor snippet--make-mirror ())
(:include snippet--object) (:include snippet--object)
@ -357,12 +362,11 @@ can be:
source source
(transform nil)) (transform nil))
(defun snippet--init-mirror (object source start end transform parent-field) (defun snippet--init-mirror (object start end parent-field prev next
source transform)
(snippet--init-object object start end parent-field prev next)
(setf (snippet--mirror-source object) source (setf (snippet--mirror-source object) source
(snippet--object-start object) start (snippet--mirror-transform object) transform))
(snippet--object-end object) end
(snippet--mirror-transform object) transform
(snippet--object-parent-field object) parent-field))
(defun snippet--describe-mirror (mirror) (defun snippet--describe-mirror (mirror)
(with-current-buffer (snippet--object-buffer mirror) (with-current-buffer (snippet--object-buffer mirror)
@ -390,19 +394,29 @@ can be:
(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)
when (snippet--field-p next)
return next))
(defun snippet--object-prev-field (object)
(loop for prev = (snippet--object-prev object)
then (snippet--object-prev prev)
when (snippet--field-p prev)
return prev))
(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))
(cond (prev (target (if prev
(if (snippet--field-prev-field field) (snippet--object-prev-field field)
(snippet--move-to-field (snippet--field-prev-field field)) (snippet--object-next-field field))))
(goto-char (snippet--object-start field)) (if target
(snippet-exit-snippet))) (snippet--move-to-field target)
(t (unless prev
(if (snippet--field-next-field field) (goto-char (snippet--object-end field)))
(snippet--move-to-field (snippet--field-next-field field)) (snippet-exit-snippet))))
(goto-char (snippet--object-end field))
(snippet-exit-snippet))))))
(defun snippet-prev-field () (defun snippet-prev-field ()
(interactive) (interactive)