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))
|
||||
|
||||
|
||||
(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
|
||||
;;;
|
||||
@ -495,42 +286,214 @@ can be:
|
||||
(funcall insert-snippet-fn)))))
|
||||
|
||||
|
||||
;;; some basic test snippets
|
||||
(define-snippet printf ()
|
||||
"printf (\""
|
||||
(field 1 "%s")
|
||||
(mirror 1 (if (string-match "%" field-text) "\"," "\);"))
|
||||
(field 2)
|
||||
(mirror 1 (if (string-match "%" field-text) "\);" "")))
|
||||
;;; Snippet mechanics
|
||||
;;;
|
||||
(cl-defstruct (snippet--field (:constructor snippet--make-field ()))
|
||||
name
|
||||
start end
|
||||
parent-field
|
||||
(mirrors '())
|
||||
next-field
|
||||
prev-field)
|
||||
|
||||
(define-snippet foo ()
|
||||
(field 1 "bla")
|
||||
"ble"
|
||||
(mirror 1)
|
||||
(field 2
|
||||
((field 3 "fonix")
|
||||
"fotrix"
|
||||
(mirror 1 (concat field-text "qqcoisa"))))
|
||||
"end")
|
||||
(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))
|
||||
|
||||
(define-snippet easy ()
|
||||
"A "
|
||||
(field 1 "field")
|
||||
" and its mirror: "
|
||||
(mirror 1 (format "(mirror of %s)" field-text)))
|
||||
(cl-defstruct (snippet--mirror (:constructor snippet--make-mirror ()))
|
||||
source
|
||||
start end
|
||||
(transform nil)
|
||||
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)
|
||||
(with-current-buffer (switch-to-buffer (get-buffer-create "*test easy snippet*"))
|
||||
(erase-buffer)
|
||||
(easy)))
|
||||
(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 test2 ()
|
||||
(defun snippet-prev-field ()
|
||||
(interactive)
|
||||
(with-current-buffer (switch-to-buffer (get-buffer-create "*test printf snippet*"))
|
||||
(erase-buffer)
|
||||
(printf)))
|
||||
(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))))))
|
||||
|
||||
(provide 'snippet)
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user