mirror of
https://github.com/joaotavora/yasnippet.git
synced 2025-10-14 05:23:04 +00:00
new: tests go in separate file, minor cleanup in snippet.el
This commit is contained in:
Joao Tavora
parent
2d0a1b831d
commit
3446300c1f
69
snippet-tests.el
Normal file
69
snippet-tests.el
Normal file
@ -0,0 +1,69 @@
|
|||||||
|
;;; snippet-tests.el --- some basic tests for snippet.el -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2013
|
||||||
|
|
||||||
|
;; Author: ;;; some basic test snippets <joaot@BELMONTE>
|
||||||
|
;; Keywords:
|
||||||
|
|
||||||
|
;; This program is free software; you can redistribute it and/or modify
|
||||||
|
;; it under the terms of the GNU General Public License as published by
|
||||||
|
;; the Free Software Foundation, either version 3 of the License, or
|
||||||
|
;; (at your option) any later version.
|
||||||
|
|
||||||
|
;; This program is distributed in the hope that it will be useful,
|
||||||
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;; GNU General Public License for more details.
|
||||||
|
|
||||||
|
;; You should have received a copy of the GNU General Public License
|
||||||
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;;
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'snippet)
|
||||||
|
|
||||||
|
(define-snippet printf ()
|
||||||
|
"printf (\""
|
||||||
|
(field 1 "%s")
|
||||||
|
(mirror 1 (if (string-match "%" field-text) "\"," "\);"))
|
||||||
|
(field 2)
|
||||||
|
(mirror 1 (if (string-match "%" field-text) "\);" "")))
|
||||||
|
|
||||||
|
(define-snippet foo ()
|
||||||
|
(field 1 "bla")
|
||||||
|
"ble"
|
||||||
|
(mirror 1)
|
||||||
|
(field 2
|
||||||
|
((field 3 "fonix")
|
||||||
|
"fotrix"
|
||||||
|
(mirror 1 (concat field-text "qqcoisa"))))
|
||||||
|
"end")
|
||||||
|
|
||||||
|
(define-snippet easy ()
|
||||||
|
"A "
|
||||||
|
(field 1 "field")
|
||||||
|
" and its mirror: "
|
||||||
|
(mirror 1 (format "(mirror of %s)" field-text)))
|
||||||
|
|
||||||
|
(defun test ()
|
||||||
|
(interactive)
|
||||||
|
(with-current-buffer (switch-to-buffer (get-buffer-create "*test easy snippet*"))
|
||||||
|
(erase-buffer)
|
||||||
|
(easy)))
|
||||||
|
|
||||||
|
(defun test2 ()
|
||||||
|
(interactive)
|
||||||
|
(with-current-buffer (switch-to-buffer (get-buffer-create "*test printf snippent*"))
|
||||||
|
(erase-buffer)
|
||||||
|
(printf)))
|
||||||
|
|
||||||
|
(provide 'snippet-tests)
|
||||||
|
|
||||||
|
;;; Local Variables:
|
||||||
|
;;; lexical-binding: t
|
||||||
|
;;; End:
|
||||||
|
;;; snippet-tests.el ends here
|
||||||
439
snippet.el
439
snippet.el
@ -26,215 +26,6 @@
|
|||||||
|
|
||||||
(eval-when-compile (require 'cl))
|
(eval-when-compile (require 'cl))
|
||||||
|
|
||||||
|
|
||||||
(cl-defstruct (snippet--field (:constructor snippet--make-field ()))
|
|
||||||
name
|
|
||||||
start end
|
|
||||||
parent-field
|
|
||||||
(mirrors '())
|
|
||||||
next-field
|
|
||||||
prev-field)
|
|
||||||
|
|
||||||
(defun snippet--init-field (object name start end parent-field mirrors next-field prev-field)
|
|
||||||
(setf (snippet--field-name object) name
|
|
||||||
(snippet--field-start object) start
|
|
||||||
(snippet--field-end object) end
|
|
||||||
(snippet--field-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 ()))
|
|
||||||
source
|
|
||||||
start end
|
|
||||||
(transform nil)
|
|
||||||
parent-field)
|
|
||||||
|
|
||||||
(defun snippet--init-mirror (object source start end transform parent-field)
|
|
||||||
(setf (snippet--mirror-source object) source
|
|
||||||
(snippet--mirror-start object) start
|
|
||||||
(snippet--mirror-end object) end
|
|
||||||
(snippet--mirror-transform object) transform
|
|
||||||
(snippet--mirror-parent-field object) parent-field))
|
|
||||||
|
|
||||||
(defgroup snippet nil
|
|
||||||
"Customize snippet features"
|
|
||||||
:group 'convenience)
|
|
||||||
|
|
||||||
(defface snippet-field-face
|
|
||||||
'((t (:inherit 'region)))
|
|
||||||
"Face used to highlight the currently active field of a snippet"
|
|
||||||
:group 'snippet)
|
|
||||||
|
|
||||||
(defvar snippet-field-keymap
|
|
||||||
(let ((map (make-sparse-keymap)))
|
|
||||||
(define-key map (kbd "<tab>") 'snippet-next-field)
|
|
||||||
(define-key map (kbd "S-<tab>") 'snippet-prev-field)
|
|
||||||
map)
|
|
||||||
"The active keymap while a snippet expansion is in progress.")
|
|
||||||
|
|
||||||
(defvar snippet--field-overlay nil)
|
|
||||||
|
|
||||||
(defun snippet-next-field (&optional prev)
|
|
||||||
(interactive)
|
|
||||||
(let ((field (overlay-get snippet--field-overlay 'snippet--field)))
|
|
||||||
(cond (prev
|
|
||||||
(if (snippet--field-prev-field field)
|
|
||||||
(snippet--move-to-field (snippet--field-prev-field field))
|
|
||||||
(goto-char (snippet--field-start field))
|
|
||||||
(snippet-exit-snippet)))
|
|
||||||
(t
|
|
||||||
(if (snippet--field-next-field field)
|
|
||||||
(snippet--move-to-field (snippet--field-next-field field))
|
|
||||||
(goto-char (snippet--field-end field))
|
|
||||||
(snippet-exit-snippet))))))
|
|
||||||
|
|
||||||
(defun snippet-prev-field ()
|
|
||||||
(interactive)
|
|
||||||
(snippet-next-field t))
|
|
||||||
|
|
||||||
(defun snippet-exit-snippet (&optional reason)
|
|
||||||
(delete-overlay snippet--field-overlay)
|
|
||||||
(message "snippet exited%s"
|
|
||||||
(or (and reason
|
|
||||||
(format " (%s)" reason))
|
|
||||||
"")))
|
|
||||||
|
|
||||||
(defun snippet--make-marker ()
|
|
||||||
(let ((marker (make-marker)))
|
|
||||||
(set-marker-insertion-type marker t)
|
|
||||||
(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)
|
|
||||||
(set-marker-insertion-type start nil)
|
|
||||||
(set-marker-insertion-type end t))
|
|
||||||
|
|
||||||
(defun snippet--close-markers (start end)
|
|
||||||
(cond ((= start end)
|
|
||||||
(set-marker-insertion-type start t)
|
|
||||||
(set-marker-insertion-type end t))
|
|
||||||
(t
|
|
||||||
(set-marker-insertion-type start t)
|
|
||||||
(set-marker-insertion-type end nil))))
|
|
||||||
|
|
||||||
(defun snippet--call-with-current-object (object fn)
|
|
||||||
(let* ((start (snippet--object-start-marker object))
|
|
||||||
(end (snippet--object-end-marker object)))
|
|
||||||
(unwind-protect
|
|
||||||
(progn
|
|
||||||
(snippet--open-markers start end)
|
|
||||||
(funcall fn))
|
|
||||||
(snippet--close-markers start end))))
|
|
||||||
|
|
||||||
(defmacro snippet--with-current-object (object &rest body)
|
|
||||||
(declare (indent defun) (debug t))
|
|
||||||
`(snippet--call-with-current-object ,object #'(lambda () ,@body)))
|
|
||||||
|
|
||||||
|
|
||||||
(defun snippet--insert-field (field text)
|
|
||||||
(when text
|
|
||||||
(snippet--with-current-object field
|
|
||||||
(insert text))))
|
|
||||||
|
|
||||||
(defun snippet--insert-mirror (mirror)
|
|
||||||
(snippet--update-mirror mirror))
|
|
||||||
|
|
||||||
(defun snippet--update-mirror (mirror)
|
|
||||||
(snippet--with-current-object mirror
|
|
||||||
(delete-region (snippet--object-start-marker mirror)
|
|
||||||
(snippet--object-end-marker mirror))
|
|
||||||
(save-excursion
|
|
||||||
(goto-char (snippet--object-start-marker mirror))
|
|
||||||
(insert (funcall (snippet--mirror-transform mirror))))))
|
|
||||||
|
|
||||||
(defun snippet--move-to-field (field)
|
|
||||||
(goto-char (snippet--object-start-marker field))
|
|
||||||
(move-overlay snippet--field-overlay
|
|
||||||
(point)
|
|
||||||
(snippet--object-end-marker field))
|
|
||||||
(overlay-put snippet--field-overlay 'snippet--field field))
|
|
||||||
|
|
||||||
(defun snippet--field-overlay-changed (overlay after? _beg _end &optional _length)
|
|
||||||
(let* ((field (overlay-get overlay 'snippet--field))
|
|
||||||
(inhibit-modification-hooks t))
|
|
||||||
(cond (after?
|
|
||||||
(snippet--close-markers (snippet--field-start field) (snippet--field-end field))
|
|
||||||
(mapc #'snippet--update-mirror (snippet--field-mirrors field))
|
|
||||||
(move-overlay overlay (snippet--field-start field) (snippet--field-end field)))
|
|
||||||
(t
|
|
||||||
(snippet--open-markers (snippet--field-start field) (snippet--field-end field))))))
|
|
||||||
|
|
||||||
(defun snippet--field-text (field)
|
|
||||||
(buffer-substring-no-properties (snippet--field-start field)
|
|
||||||
(snippet--field-end field)))
|
|
||||||
|
|
||||||
(defvar snippet--debug nil)
|
|
||||||
;; (setq snippet--debug t)
|
|
||||||
|
|
||||||
(defun snippet--post-command-hook ()
|
|
||||||
(cond ((and snippet--field-overlay
|
|
||||||
(overlay-buffer snippet--field-overlay))
|
|
||||||
(cond ((or (< (point)
|
|
||||||
(overlay-start snippet--field-overlay))
|
|
||||||
(> (point)
|
|
||||||
(overlay-end snippet--field-overlay)))
|
|
||||||
(snippet-exit-snippet "point left snippet")
|
|
||||||
(remove-hook 'post-command-hook 'snippet--post-command-hook t))
|
|
||||||
(snippet--debug
|
|
||||||
(snippet--debug-snippet snippet--field-overlay))))
|
|
||||||
(snippet--field-overlay
|
|
||||||
;; snippet must have been exited for some other reason
|
|
||||||
;;
|
|
||||||
(remove-hook 'post-command-hook 'snippet--post-command-hook t))))
|
|
||||||
|
|
||||||
(defun snippet--debug-snippet (field-overlay)
|
|
||||||
(let ((buffer (current-buffer)))
|
|
||||||
(cl-flet ((describe-field
|
|
||||||
(field)
|
|
||||||
(with-current-buffer buffer
|
|
||||||
(format "active field overlay %s from %s to %s covering \"%s\", with %s mirrors"
|
|
||||||
(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))
|
|
||||||
(length (snippet--field-mirrors 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*")
|
|
||||||
(let ((inhibit-read-only t))
|
|
||||||
(erase-buffer)
|
|
||||||
(let ((active-field (overlay-get field-overlay 'snippet--field)))
|
|
||||||
(loop for object in (overlay-get field-overlay 'snippet--objects)
|
|
||||||
when (snippet--field-p object)
|
|
||||||
do
|
|
||||||
(insert (describe-field object))
|
|
||||||
(when (eq object active-field) (insert "*ACTIVE*"))
|
|
||||||
(insert "\n")
|
|
||||||
(loop for mirror in (snippet--field-mirrors object)
|
|
||||||
do (insert (describe-mirror mirror)
|
|
||||||
"\n")))))
|
|
||||||
(display-buffer (current-buffer))))))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; the define-snippet macro and its helpers
|
;;; the define-snippet macro and its helpers
|
||||||
;;;
|
;;;
|
||||||
@ -495,42 +286,214 @@ can be:
|
|||||||
(funcall insert-snippet-fn)))))
|
(funcall insert-snippet-fn)))))
|
||||||
|
|
||||||
|
|
||||||
;;; some basic test snippets
|
;;; Snippet mechanics
|
||||||
(define-snippet printf ()
|
;;;
|
||||||
"printf (\""
|
(cl-defstruct (snippet--field (:constructor snippet--make-field ()))
|
||||||
(field 1 "%s")
|
name
|
||||||
(mirror 1 (if (string-match "%" field-text) "\"," "\);"))
|
start end
|
||||||
(field 2)
|
parent-field
|
||||||
(mirror 1 (if (string-match "%" field-text) "\);" "")))
|
(mirrors '())
|
||||||
|
next-field
|
||||||
|
prev-field)
|
||||||
|
|
||||||
(define-snippet foo ()
|
(defun snippet--init-field (object name start end parent-field mirrors next-field prev-field)
|
||||||
(field 1 "bla")
|
(setf (snippet--field-name object) name
|
||||||
"ble"
|
(snippet--field-start object) start
|
||||||
(mirror 1)
|
(snippet--field-end object) end
|
||||||
(field 2
|
(snippet--field-parent-field object) parent-field
|
||||||
((field 3 "fonix")
|
(snippet--field-mirrors object) mirrors
|
||||||
"fotrix"
|
(snippet--field-next-field object) next-field
|
||||||
(mirror 1 (concat field-text "qqcoisa"))))
|
(snippet--field-prev-field object) prev-field))
|
||||||
"end")
|
|
||||||
|
|
||||||
(define-snippet easy ()
|
(cl-defstruct (snippet--mirror (:constructor snippet--make-mirror ()))
|
||||||
"A "
|
source
|
||||||
(field 1 "field")
|
start end
|
||||||
" and its mirror: "
|
(transform nil)
|
||||||
(mirror 1 (format "(mirror of %s)" field-text)))
|
parent-field)
|
||||||
|
|
||||||
(defun test ()
|
(defun snippet--init-mirror (object source start end transform parent-field)
|
||||||
|
(setf (snippet--mirror-source object) source
|
||||||
|
(snippet--mirror-start object) start
|
||||||
|
(snippet--mirror-end object) end
|
||||||
|
(snippet--mirror-transform object) transform
|
||||||
|
(snippet--mirror-parent-field object) parent-field))
|
||||||
|
|
||||||
|
(defgroup snippet nil
|
||||||
|
"Customize snippet features"
|
||||||
|
:group 'convenience)
|
||||||
|
|
||||||
|
(defface snippet-field-face
|
||||||
|
'((t (:inherit 'region)))
|
||||||
|
"Face used to highlight the currently active field of a snippet"
|
||||||
|
:group 'snippet)
|
||||||
|
|
||||||
|
(defvar snippet-field-keymap
|
||||||
|
(let ((map (make-sparse-keymap)))
|
||||||
|
(define-key map (kbd "<tab>") 'snippet-next-field)
|
||||||
|
(define-key map (kbd "S-<tab>") 'snippet-prev-field)
|
||||||
|
map)
|
||||||
|
"The active keymap while a snippet expansion is in progress.")
|
||||||
|
|
||||||
|
(defvar snippet--field-overlay nil)
|
||||||
|
|
||||||
|
(defun snippet-next-field (&optional prev)
|
||||||
(interactive)
|
(interactive)
|
||||||
(with-current-buffer (switch-to-buffer (get-buffer-create "*test easy snippet*"))
|
(let ((field (overlay-get snippet--field-overlay 'snippet--field)))
|
||||||
(erase-buffer)
|
(cond (prev
|
||||||
(easy)))
|
(if (snippet--field-prev-field field)
|
||||||
|
(snippet--move-to-field (snippet--field-prev-field field))
|
||||||
|
(goto-char (snippet--field-start field))
|
||||||
|
(snippet-exit-snippet)))
|
||||||
|
(t
|
||||||
|
(if (snippet--field-next-field field)
|
||||||
|
(snippet--move-to-field (snippet--field-next-field field))
|
||||||
|
(goto-char (snippet--field-end field))
|
||||||
|
(snippet-exit-snippet))))))
|
||||||
|
|
||||||
(defun test2 ()
|
(defun snippet-prev-field ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(with-current-buffer (switch-to-buffer (get-buffer-create "*test printf snippet*"))
|
(snippet-next-field t))
|
||||||
(erase-buffer)
|
|
||||||
(printf)))
|
|
||||||
|
|
||||||
|
(defun snippet-exit-snippet (&optional reason)
|
||||||
|
(delete-overlay snippet--field-overlay)
|
||||||
|
(message "snippet exited%s"
|
||||||
|
(or (and reason
|
||||||
|
(format " (%s)" reason))
|
||||||
|
"")))
|
||||||
|
|
||||||
|
(defun snippet--make-marker ()
|
||||||
|
(let ((marker (make-marker)))
|
||||||
|
(set-marker-insertion-type marker t)
|
||||||
|
(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)
|
||||||
|
(set-marker-insertion-type start nil)
|
||||||
|
(set-marker-insertion-type end t))
|
||||||
|
|
||||||
|
(defun snippet--close-markers (start end)
|
||||||
|
(cond ((= start end)
|
||||||
|
(set-marker-insertion-type start t)
|
||||||
|
(set-marker-insertion-type end t))
|
||||||
|
(t
|
||||||
|
(set-marker-insertion-type start t)
|
||||||
|
(set-marker-insertion-type end nil))))
|
||||||
|
|
||||||
|
(defun snippet--call-with-current-object (object fn)
|
||||||
|
(let* ((start (snippet--object-start-marker object))
|
||||||
|
(end (snippet--object-end-marker object)))
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(snippet--open-markers start end)
|
||||||
|
(funcall fn))
|
||||||
|
(snippet--close-markers start end))))
|
||||||
|
|
||||||
|
(defmacro snippet--with-current-object (object &rest body)
|
||||||
|
(declare (indent defun) (debug t))
|
||||||
|
`(snippet--call-with-current-object ,object #'(lambda () ,@body)))
|
||||||
|
|
||||||
|
|
||||||
|
(defun snippet--insert-field (field text)
|
||||||
|
(when text
|
||||||
|
(snippet--with-current-object field
|
||||||
|
(insert text))))
|
||||||
|
|
||||||
|
(defun snippet--insert-mirror (mirror)
|
||||||
|
(snippet--update-mirror mirror))
|
||||||
|
|
||||||
|
(defun snippet--update-mirror (mirror)
|
||||||
|
(snippet--with-current-object mirror
|
||||||
|
(delete-region (snippet--object-start-marker mirror)
|
||||||
|
(snippet--object-end-marker mirror))
|
||||||
|
(save-excursion
|
||||||
|
(goto-char (snippet--object-start-marker mirror))
|
||||||
|
(insert (funcall (snippet--mirror-transform mirror))))))
|
||||||
|
|
||||||
|
(defun snippet--move-to-field (field)
|
||||||
|
(goto-char (snippet--object-start-marker field))
|
||||||
|
(move-overlay snippet--field-overlay
|
||||||
|
(point)
|
||||||
|
(snippet--object-end-marker field))
|
||||||
|
(overlay-put snippet--field-overlay 'snippet--field field))
|
||||||
|
|
||||||
|
(defun snippet--field-overlay-changed (overlay after? _beg _end &optional _length)
|
||||||
|
(let* ((field (overlay-get overlay 'snippet--field))
|
||||||
|
(inhibit-modification-hooks t))
|
||||||
|
(cond (after?
|
||||||
|
(snippet--close-markers (snippet--field-start field) (snippet--field-end field))
|
||||||
|
(mapc #'snippet--update-mirror (snippet--field-mirrors field))
|
||||||
|
(move-overlay overlay (snippet--field-start field) (snippet--field-end field)))
|
||||||
|
(t
|
||||||
|
(snippet--open-markers (snippet--field-start field) (snippet--field-end field))))))
|
||||||
|
|
||||||
|
(defun snippet--field-text (field)
|
||||||
|
(buffer-substring-no-properties (snippet--field-start field)
|
||||||
|
(snippet--field-end field)))
|
||||||
|
|
||||||
|
(defvar snippet--debug nil)
|
||||||
|
;; (setq snippet--debug t)
|
||||||
|
|
||||||
|
(defun snippet--post-command-hook ()
|
||||||
|
(cond ((and snippet--field-overlay
|
||||||
|
(overlay-buffer snippet--field-overlay))
|
||||||
|
(cond ((or (< (point)
|
||||||
|
(overlay-start snippet--field-overlay))
|
||||||
|
(> (point)
|
||||||
|
(overlay-end snippet--field-overlay)))
|
||||||
|
(snippet-exit-snippet "point left snippet")
|
||||||
|
(remove-hook 'post-command-hook 'snippet--post-command-hook t))
|
||||||
|
(snippet--debug
|
||||||
|
(snippet--debug-snippet snippet--field-overlay))))
|
||||||
|
(snippet--field-overlay
|
||||||
|
;; snippet must have been exited for some other reason
|
||||||
|
;;
|
||||||
|
(remove-hook 'post-command-hook 'snippet--post-command-hook t))))
|
||||||
|
|
||||||
|
(defun snippet--debug-snippet (field-overlay)
|
||||||
|
(let ((buffer (current-buffer)))
|
||||||
|
(cl-flet ((describe-field
|
||||||
|
(field)
|
||||||
|
(with-current-buffer buffer
|
||||||
|
(format "active field overlay %s from %s to %s covering \"%s\", with %s mirrors"
|
||||||
|
(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))
|
||||||
|
(length (snippet--field-mirrors 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*")
|
||||||
|
(let ((inhibit-read-only t))
|
||||||
|
(erase-buffer)
|
||||||
|
(let ((active-field (overlay-get field-overlay 'snippet--field)))
|
||||||
|
(loop for object in (overlay-get field-overlay 'snippet--objects)
|
||||||
|
when (snippet--field-p object)
|
||||||
|
do
|
||||||
|
(insert (describe-field object))
|
||||||
|
(when (eq object active-field) (insert "*ACTIVE*"))
|
||||||
|
(insert "\n")
|
||||||
|
(loop for mirror in (snippet--field-mirrors object)
|
||||||
|
do (insert (describe-mirror mirror)
|
||||||
|
"\n")))))
|
||||||
|
(display-buffer (current-buffer))))))
|
||||||
|
|
||||||
(provide 'snippet)
|
(provide 'snippet)
|
||||||
|
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user