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

refactor: snippet--object struct included in fields and mirrors

Browse Source
This commit is contained in:
Joao Tavora 2013-10-19 00:46:56 +01:00
parent 4149acbaae
commit b682f6bcac
1 changed files with 68 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

126
snippet.el
View File

@ -319,36 +319,59 @@ can be:
;;; Snippet mechanics ;;; Snippet mechanics
;;; ;;;
(cl-defstruct (snippet--field (:constructor snippet--make-field ()))
(cl-defstruct snippet--object
start end parent-field next prev (buffer (current-buffer)))
(cl-defstruct (snippet--field (:constructor snippet--make-field ())
(:include snippet--object)
(:print-function snippet--describe-field))
name name
start end
parent-field
(mirrors '()) (mirrors '())
next-field next-field
prev-field) prev-field)
(defun snippet--describe-field (field)
(with-current-buffer (snippet--object-buffer field)
(format "field %s from %s to %s covering \"%s\""
(snippet--field-name field)
(marker-position (snippet--object-start field))
(marker-position (snippet--object-end field))
(buffer-substring-no-properties
(snippet--object-start field)
(snippet--object-end field)))))
(defun snippet--init-field (object name start end parent-field mirrors (defun snippet--init-field (object name start end parent-field mirrors
next-field prev-field) next-field prev-field)
(setf (snippet--field-name object) name (setf (snippet--field-name object) name
(snippet--field-start object) start (snippet--object-start object) start
(snippet--field-end object) end (snippet--object-end object) end
(snippet--field-parent-field object) parent-field (snippet--object-parent-field object) parent-field
(snippet--field-mirrors object) mirrors (snippet--field-mirrors object) mirrors
(snippet--field-next-field object) next-field (snippet--field-next-field object) next-field
(snippet--field-prev-field object) prev-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)
(:print-function snippet--describe-mirror))
source source
start end (transform nil))
(transform nil)
parent-field)
(defun snippet--init-mirror (object source start end transform parent-field) (defun snippet--init-mirror (object source start end transform parent-field)
(setf (snippet--mirror-source object) source (setf (snippet--mirror-source object) source
(snippet--mirror-start object) start (snippet--object-start object) start
(snippet--mirror-end object) end (snippet--object-end object) end
(snippet--mirror-transform object) transform (snippet--mirror-transform object) transform
(snippet--mirror-parent-field object) parent-field)) (snippet--object-parent-field object) parent-field))
(defun snippet--describe-mirror (mirror)
(with-current-buffer (snippet--object-buffer mirror)
(format "mirror from %s to %s covering \"%s\""
(marker-position (snippet--object-start mirror))
(marker-position (snippet--object-end mirror))
(buffer-substring-no-properties
(snippet--object-start mirror)
(snippet--object-end mirror)))))
(defgroup snippet nil (defgroup snippet nil
"Customize snippet features" "Customize snippet features"
@ -356,8 +379,7 @@ can be:
(defface snippet-field-face (defface snippet-field-face
'((t (:inherit 'region))) '((t (:inherit 'region)))
"Face used to highlight the currently active field of a snippet" "Face used to highlight the currently active field of a snippet")
:group 'snippet)
(defvar snippet-field-keymap (defvar snippet-field-keymap
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
@ -374,12 +396,12 @@ can be:
(cond (prev (cond (prev
(if (snippet--field-prev-field field) (if (snippet--field-prev-field field)
(snippet--move-to-field (snippet--field-prev-field field)) (snippet--move-to-field (snippet--field-prev-field field))
(goto-char (snippet--field-start field)) (goto-char (snippet--object-start field))
(snippet-exit-snippet))) (snippet-exit-snippet)))
(t (t
(if (snippet--field-next-field field) (if (snippet--field-next-field field)
(snippet--move-to-field (snippet--field-next-field field)) (snippet--move-to-field (snippet--field-next-field field))
(goto-char (snippet--field-end field)) (goto-char (snippet--object-end field))
(snippet-exit-snippet)))))) (snippet-exit-snippet))))))
(defun snippet-prev-field () (defun snippet-prev-field ()
@ -398,18 +420,6 @@ can be:
(set-marker-insertion-type marker t) (set-marker-insertion-type marker t)
(set-marker marker (point)))) (set-marker marker (point))))
(defun snippet--object-start-marker (field-or-mirror)
(cond ((snippet--field-p field-or-mirror)
(snippet--field-start field-or-mirror))
((snippet--mirror-p field-or-mirror)
(snippet--mirror-start field-or-mirror))))
(defun snippet--object-end-marker (field-or-mirror)
(cond ((snippet--field-p field-or-mirror)
(snippet--field-end field-or-mirror))
((snippet--mirror-p field-or-mirror)
(snippet--mirror-end field-or-mirror))))
(defun snippet--open-markers (start end) (defun snippet--open-markers (start end)
(set-marker-insertion-type start nil) (set-marker-insertion-type start nil)
(set-marker-insertion-type end t)) (set-marker-insertion-type end t))
@ -423,8 +433,8 @@ can be:
(set-marker-insertion-type end nil)))) (set-marker-insertion-type end nil))))
(defun snippet--call-with-current-object (object fn) (defun snippet--call-with-current-object (object fn)
(let* ((start (snippet--object-start-marker object)) (let* ((start (snippet--object-start object))
(end (snippet--object-end-marker object))) (end (snippet--object-end object)))
(unwind-protect (unwind-protect
(progn (progn
(snippet--open-markers start end) (snippet--open-markers start end)
@ -446,37 +456,37 @@ can be:
(defun snippet--update-mirror (mirror) (defun snippet--update-mirror (mirror)
(snippet--with-current-object mirror (snippet--with-current-object mirror
(delete-region (snippet--object-start-marker mirror) (delete-region (snippet--object-start mirror)
(snippet--object-end-marker mirror)) (snippet--object-end mirror))
(save-excursion (save-excursion
(goto-char (snippet--object-start-marker mirror)) (goto-char (snippet--object-start mirror))
(insert (funcall (snippet--mirror-transform mirror) (insert (funcall (snippet--mirror-transform mirror)
(snippet--field-text (snippet--mirror-source mirror))))))) (snippet--field-text (snippet--mirror-source mirror)))))))
(defun snippet--move-to-field (field) (defun snippet--move-to-field (field)
(goto-char (snippet--object-start-marker field)) (goto-char (snippet--object-start field))
(move-overlay snippet--field-overlay (move-overlay snippet--field-overlay
(point) (point)
(snippet--object-end-marker field)) (snippet--object-end field))
(overlay-put snippet--field-overlay 'snippet--field field)) (overlay-put snippet--field-overlay 'snippet--field field))
(defun snippet--field-overlay-changed (overlay after? _beg _end &optional _length) (defun snippet--field-overlay-changed (overlay after? _beg _end &optional _length)
(let* ((field (overlay-get overlay 'snippet--field)) (let* ((field (overlay-get overlay 'snippet--field))
(inhibit-modification-hooks t)) (inhibit-modification-hooks t))
(cond (after? (cond (after?
(snippet--close-markers (snippet--field-start field) (snippet--close-markers (snippet--object-start field)
(snippet--field-end field)) (snippet--object-end field))
(mapc #'snippet--update-mirror (snippet--field-mirrors field)) (mapc #'snippet--update-mirror (snippet--field-mirrors field))
(move-overlay overlay (move-overlay overlay
(snippet--field-start field) (snippet--object-start field)
(snippet--field-end field))) (snippet--object-end field)))
(t (t
(snippet--open-markers (snippet--field-start field) (snippet--open-markers (snippet--object-start field)
(snippet--field-end field)))))) (snippet--object-end field))))))
(defun snippet--field-text (field) (defun snippet--field-text (field)
(buffer-substring-no-properties (snippet--field-start field) (buffer-substring-no-properties (snippet--object-start field)
(snippet--field-end field))) (snippet--object-end field)))
(defvar snippet--debug nil) (defvar snippet--debug nil)
;; (setq snippet--debug t) ;; (setq snippet--debug t)
@ -498,26 +508,6 @@ can be:
(remove-hook 'post-command-hook 'snippet--post-command-hook t)))) (remove-hook 'post-command-hook 'snippet--post-command-hook t))))
(defun snippet--debug-snippet (field-overlay) (defun snippet--debug-snippet (field-overlay)
(let ((buffer (current-buffer)))
(cl-flet ((describe-field
(field)
(with-current-buffer buffer
(format "field %s [%s,%s] covering \"%s\""
(snippet--field-name field)
(marker-position (snippet--field-start field))
(marker-position (snippet--field-end field))
(buffer-substring-no-properties
(snippet--field-start field)
(snippet--field-end field)))))
(describe-mirror
(mirror)
(with-current-buffer buffer
(format " mirror from %s to %s covering \"%s\""
(marker-position (snippet--mirror-start mirror))
(marker-position (snippet--mirror-end mirror))
(buffer-substring-no-properties
(snippet--mirror-start mirror)
(snippet--mirror-end mirror))))))
(with-current-buffer (get-buffer-create "*snippet-debug*") (with-current-buffer (get-buffer-create "*snippet-debug*")
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(erase-buffer) (erase-buffer)
@ -525,13 +515,13 @@ can be:
(cl-loop for object in (overlay-get field-overlay 'snippet--objects) (cl-loop for object in (overlay-get field-overlay 'snippet--objects)
when (snippet--field-p object) when (snippet--field-p object)
do do
(insert (describe-field object)) (insert (snippet--describe-field object))
(when (eq object active-field) (insert "*ACTIVE*")) (when (eq object active-field) (insert " (active)"))
(insert "\n") (insert "\n")
(cl-loop for mirror in (snippet--field-mirrors object) (cl-loop for mirror in (snippet--field-mirrors object)
do (insert (describe-mirror mirror) do (insert " " (snippet--describe-mirror mirror)
"\n"))))) "\n")))))
(display-buffer (current-buffer)))))) (display-buffer (current-buffer))))
(provide 'snippet) (provide 'snippet)