-;;; yasnippet-tests.el --- some yasnippet tests
+;;; yasnippet-tests.el --- some yasnippet tests -*- lexical-binding: t -*-
-;; Copyright (C) 2012 João Távora
+;; Copyright (C) 2012, 2013, 2014, 2015 Free Software Foundation, Inc.
;; Author: João Távora <joaot@siscog.pt>
;; Keywords: emulations, convenience
(require 'yasnippet)
(require 'ert)
(require 'ert-x)
+(require 'cl)
\f
;;; Snippet mechanics
(yas-expand-snippet "${1:brother} from another $1")
(should (string= (yas--buffer-contents)
"brother from another brother"))
- (ert-simulate-command `(yas-mock-insert "bla"))
+ (yas-mock-insert "bla")
(should (string= (yas--buffer-contents)
"bla from another bla"))))
(yas-expand-snippet "${1:brother} from another ${1:$(upcase yas-text)}")
(should (string= (yas--buffer-contents)
"brother from another BROTHER"))
- (ert-simulate-command `(yas-mock-insert "bla"))
+ (yas-mock-insert "bla")
(should (string= (yas--buffer-contents)
"bla from another BLA"))))
(let ((snippet "${1:$$(upcase yas-text)}${1:$(concat \"bar\" yas-text)}"))
(yas-expand-snippet snippet)
(should (string= (yas--buffer-contents) "bar"))
- (ert-simulate-command `(yas-mock-insert "foo"))
+ (yas-mock-insert "foo")
(should (string= (yas--buffer-contents) "FOObarFOO")))))
(ert-deftest nested-placeholders-kill-superfield ()
(yas-expand-snippet "brother from ${2:another ${3:mother}}!")
(should (string= (yas--buffer-contents)
"brother from another mother!"))
- (ert-simulate-command `(yas-mock-insert "bla"))
+ (yas-mock-insert "bla")
(should (string= (yas--buffer-contents)
"brother from bla!"))))
(yas-minor-mode 1)
(yas-expand-snippet "brother from ${2:another ${3:mother}}!")
(ert-simulate-command '(yas-next-field-or-maybe-expand))
- (ert-simulate-command `(yas-mock-insert "bla"))
+ (yas-mock-insert "bla")
(should (string= (yas--buffer-contents)
"brother from another bla!"))))
(yas-expand-snippet "<%= f.submit \"${1:Submit}\"${2:$(and (yas-text) \", :disable_with => '\")}${2:$1ing...}${2:$(and (yas-text) \"'\")} %>")
(should (string= (yas--buffer-contents)
"<%= f.submit \"Submit\", :disable_with => 'Submiting...' %>"))
- (ert-simulate-command `(yas-mock-insert "Send"))
+ (yas-mock-insert "Send")
(should (string= (yas--buffer-contents)
"<%= f.submit \"Send\", :disable_with => 'Sending...' %>"))))
(with-temp-buffer
(yas-minor-mode 1)
(yas-expand-snippet "${1:FOOOOOOO}${2:$1}${3:$2}${4:$3}")
- (ert-simulate-command `(yas-mock-insert "abc"))
+ (yas-mock-insert "abc")
(should (string= (yas--buffer-contents) "abcabcabcabc"))))
(ert-deftest delete-numberless-inner-snippet-issue-562 ()
(should (looking-at "ble"))
(should (null (yas--snippets-at-point)))))
+ (ert-deftest ignore-trailing-whitespace ()
+ (should (equal
+ (with-temp-buffer
+ (insert "# key: foo\n# --\nfoo")
+ (yas--parse-template))
+ (with-temp-buffer
+ (insert "# key: foo \n# --\nfoo")
+ (yas--parse-template)))))
+
;; (ert-deftest in-snippet-undo ()
;; (with-temp-buffer
;; (yas-minor-mode 1)
;; (yas-expand-snippet "brother from ${2:another ${3:mother}}!")
;; (ert-simulate-command '(yas-next-field-or-maybe-expand))
- ;; (ert-simulate-command `(yas-mock-insert "bla"))
+ ;; (yas-mock-insert "bla")
;; (ert-simulate-command '(undo))
;; (should (string= (yas--buffer-contents)
;; "brother from another mother!"))))
(snippet "if ${1:condition}\n`yas-selected-text`\nelse\n$3\nend"))
(yas-expand-snippet snippet)
(yas-next-field)
- (ert-simulate-command `(yas-mock-insert "bbb"))
+ (yas-mock-insert "bbb")
(should (string= (yas--buffer-contents) "if condition\naaa\nelse\nbbb\nend")))))
(defmacro yas--with-font-locked-temp-buffer (&rest body)
(and (buffer-name ,temp-buffer)
(kill-buffer ,temp-buffer))))))))
+(defmacro yas-saving-variables (&rest body)
+ `(yas-call-with-saving-variables #'(lambda () ,@body)))
+
+(defmacro yas-with-snippet-dirs (dirs &rest body)
+ (declare (indent defun))
+ `(yas-call-with-snippet-dirs ,dirs
+ #'(lambda ()
+ ,@body)))
+
(ert-deftest example-for-issue-474 ()
(yas--with-font-locked-temp-buffer
(c-mode)
\"fail\")}"))
(yas-expand-snippet snippet)
(should (string= (yas--buffer-contents) "fail"))
- (ert-simulate-command `(yas-mock-insert "foobaaar"))
+ (yas-mock-insert "foobaaar")
(should (string= (yas--buffer-contents) "foobaaarfail"))
- (ert-simulate-command `(yas-mock-insert "baz"))
+ (yas-mock-insert "baz")
(should (string= (yas--buffer-contents) "foobaaarbazok")))))
\f
"brother from another mother") ;; no newline should be here!
)))
+(defvar yas--barbaz)
+(defvar yas--foobarbaz)
+
;; See issue #497. To understand this test, follow the example of the
;; `yas-key-syntaxes' docstring.
- ;;
+ ;;
(ert-deftest complicated-yas-key-syntaxes ()
(with-temp-buffer
(yas-saving-variables
("lisp-interaction-mode" ("sc" . "brother from another mother"))))
,@body))))
+ (ert-deftest snippet-lookup ()
+ "Test `yas-lookup-snippet'."
+ (yas-with-some-interesting-snippet-dirs
+ (yas-reload-all 'no-jit)
+ (should (equal (yas-lookup-snippet "printf" 'c-mode) "printf($1);"))
+ (should (equal (yas-lookup-snippet "def" 'c-mode) "# define"))
+ (should-not (yas-lookup-snippet "no such snippet" nil 'noerror))
+ (should-not (yas-lookup-snippet "printf" 'emacs-lisp-mode 'noerror))))
(ert-deftest basic-jit-loading ()
"Test basic loading and expansion of snippets"
(yas--basic-jit-loading-1)))
(ert-deftest basic-jit-loading-with-compiled-snippets ()
- "Test basic loading and expansion of snippets"
+ "Test basic loading and expansion of compiled snippets"
(yas-with-some-interesting-snippet-dirs
(yas-reload-all)
(yas-recompile-all)
(yas-reload-all)
(yas--basic-jit-loading-1))))
+ (ert-deftest visiting-compiled-snippets ()
+ "Test snippet visiting for compiled snippets."
+ (yas-with-some-interesting-snippet-dirs
+ (yas-recompile-all)
+ (yas-reload-all 'no-jit) ; must be loaded for `yas-lookup-snippet' to work.
+ (yas--with-temporary-redefinitions ((find-file-noselect
+ (filename &rest _)
+ (throw 'yas-snippet-file filename)))
+ (should (string-suffix-p
+ "cc-mode/def"
+ (catch 'yas-snippet-file
+ (yas--visit-snippet-file-1
+ (yas--lookup-snippet-1 "def" 'cc-mode))))))))
+
(ert-deftest loading-with-cyclic-parenthood ()
"Test loading when cyclic parenthood is setup."
(yas-saving-variables
yet-another-c-mode
and-also-this-one
and-that-one
- ;; prog-mode doesn't exit in emacs 24.3
+ ;; prog-mode doesn't exist in emacs 24.3
,@(if (fboundp 'prog-mode)
'(prog-mode))
emacs-lisp-mode
lisp-interaction-mode))
(observed (yas--modes-to-activate)))
- (should (null (cl-set-exclusive-or expected observed)))
- (should (= (length expected)
- (length observed))))))))
+ (should (equal major-mode (car observed)))
+ (should (equal (sort expected #'string<) (sort observed #'string<))))))))
+
+ (ert-deftest extra-modes-parenthood ()
+ "Test activation of parents of `yas--extra-modes'."
+ (yas-saving-variables
+ (yas-with-snippet-dirs '((".emacs.d/snippets"
+ ("c-mode"
+ (".yas-parents" . "cc-mode"))
+ ("yet-another-c-mode"
+ (".yas-parents" . "c-mode and-also-this-one lisp-interaction-mode"))))
+ (yas-reload-all)
+ (with-temp-buffer
+ (yas-activate-extra-mode 'c-mode)
+ (yas-activate-extra-mode 'yet-another-c-mode)
+ (yas-activate-extra-mode 'and-that-one)
+ (let* ((expected-first `(and-that-one
+ yet-another-c-mode
+ c-mode
+ ,major-mode))
+ (expected-rest `(cc-mode
+ ;; prog-mode doesn't exist in emacs 24.3
+ ,@(if (fboundp 'prog-mode)
+ '(prog-mode))
+ emacs-lisp-mode
+ and-also-this-one
+ lisp-interaction-mode))
+ (observed (yas--modes-to-activate)))
+ (should (equal expected-first
+ (cl-subseq observed 0 (length expected-first))))
+ (should (equal (sort expected-rest #'string<)
+ (sort (cl-subseq observed (length expected-first)) #'string<))))))))
+(defalias 'yas--phony-c-mode 'c-mode)
+
(ert-deftest issue-492-and-494 ()
- (defalias 'yas--phony-c-mode 'c-mode)
(define-derived-mode yas--test-mode yas--phony-c-mode "Just a test mode")
(yas-with-snippet-dirs '((".emacs.d/snippets"
("yas--test-mode")))
(should (= (length expected)
(length observed)))))))
+(define-derived-mode yas--test-mode c-mode "Just a test mode")
+(define-derived-mode yas--another-test-mode c-mode "Another test mode")
+
(ert-deftest issue-504-tricky-jit ()
- (define-derived-mode yas--test-mode c-mode "Just a test mode")
- (define-derived-mode yas--another-test-mode c-mode "Another test mode")
(yas-with-snippet-dirs
'((".emacs.d/snippets"
("yas--another-test-mode"
(should (not (eq (key-binding (yas--read-keybinding "TAB")) 'yas-expand)))
(should (eq (key-binding (yas--read-keybinding "SPC")) 'yas-expand))))
;; FIXME: actually should restore to whatever saved values where there.
- ;;
+ ;;
(define-key yas-minor-mode-map [tab] 'yas-expand)
(define-key yas-minor-mode-map (kbd "TAB") 'yas-expand)
(define-key yas-minor-mode-map (kbd "SPC") nil)))
(yas--buffer-contents))))))
(defun yas-mock-insert (string)
- (interactive)
- (do ((i 0 (1+ i)))
- ((= i (length string)))
- (insert (aref string i))))
+ (dotimes (i (length string))
+ (let ((last-command-event (aref string i)))
+ (ert-simulate-command '(self-insert-command 1)))))
(defun yas-make-file-or-dirs (ass)
(let ((file-or-dir-name (car ass))
for saved in saved-values
do (set var saved)))))
-(defmacro yas-saving-variables (&rest body)
- `(yas-call-with-saving-variables #'(lambda () ,@body)))
-
-
(defun yas-call-with-snippet-dirs (dirs fn)
(let* ((default-directory (make-temp-file "yasnippet-fixture" t))
(yas-snippet-dirs (mapcar #'car dirs)))
(when (>= emacs-major-version 24)
(delete-directory default-directory 'recursive))))))
-(defmacro yas-with-snippet-dirs (dirs &rest body)
- (declare (indent defun))
- `(yas-call-with-snippet-dirs ,dirs
- #'(lambda ()
- ,@body)))
-
;;; Older emacsen
;;;
(unless (fboundp 'special-mode)
;; FIXME: Why provide this default definition here?!?
(defalias 'special-mode 'fundamental))
+ (unless (fboundp 'string-suffix-p)
+ ;; introduced in Emacs 24.4
+ (defun string-suffix-p (suffix string &optional ignore-case)
+ "Return non-nil if SUFFIX is a suffix of STRING.
+ If IGNORE-CASE is non-nil, the comparison is done without paying
+ attention to case differences."
+ (let ((start-pos (- (length string) (length suffix))))
+ (and (>= start-pos 0)
+ (eq t (compare-strings suffix nil nil
+ string start-pos nil ignore-case))))))
+
;;; btw to test this in emacs22 mac osx:
;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el
;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert-x.el
(provide 'yasnippet-tests)
;; Local Variables:
;; indent-tabs-mode: nil
-;; lexical-binding: t
;; byte-compile-warnings: (not cl-functions)
;; End:
;;; yasnippet-tests.el ends here
;;; yasnippet.el --- Yet another snippet extension for Emacs.
;; Copyright (C) 2008-2013, 2015 Free Software Foundation, Inc.
- ;; Authors: pluskid <pluskid@gmail.com>, João Távora <joaotavora@gmail.com>
- ;; Maintainer: João Távora <joaotavora@gmail.com>
+ ;; Authors: pluskid <pluskid@gmail.com>, João Távora <joaotavora@gmail.com>, Noam Postavsky <npostavs@gmail.com>
+ ;; Maintainer: Noam Postavsky <npostavs@gmail.com>
;; Version: 0.8.1
;; Package-version: 0.8.0
;; X-URL: http://github.com/capitaomorte/yasnippet
;; stored. Can also be a list of directories. In that case,
;; when used for bulk (re)loading of snippets (at startup or
;; via `yas-reload-all'), directories appearing earlier in
- ;; the list shadow other dir's snippets. Also, the first
+ ;; the list override other dir's snippets. Also, the first
;; directory is taken as the default for storing the user's
;; new snippets.
;;
(when load-file-name
(concat (file-name-directory load-file-name) "snippets")))
+ (defconst yas--default-user-snippets-dir
+ (concat user-emacs-directory "snippets"))
+
(defcustom yas-snippet-dirs (remove nil
- (list "~/.emacs.d/snippets"
+ (list yas--default-user-snippets-dir
'yas-installed-snippets-dir))
"List of top-level snippet directories.
designates a top-level directory where per-mode snippet
directories can be found.
- Elements appearing earlier in the list shadow later elements'
+ Elements appearing earlier in the list override later elements'
snippets.
The first directory is taken as the default for storing snippet's
(defcustom yas-prompt-functions '(yas-x-prompt
yas-dropdown-prompt
yas-completing-prompt
- yas-ido-prompt
+ yas-maybe-ido-prompt
yas-no-prompt)
"Functions to prompt for keys, templates, etc interactively.
"Hooks to run just before expanding a snippet.")
(defvar yas-buffer-local-condition
- '(if (and (or (fourth (syntax-ppss))
- (fifth (syntax-ppss)))
- this-command
- (eq this-command 'yas-expand-from-trigger-key))
+ '(if (and (let ((ppss (syntax-ppss)))
+ (or (nth 3 ppss) (nth 4 ppss)))
+ (memq this-command '(yas-expand yas-expand-from-trigger-key
+ yas-expand-from-keymap)))
'(require-snippet-condition . force-in-comment)
t)
"Snippet expanding condition.
yas--direct-keymaps))
yas--tables))
- (defun yas--modes-to-activate ()
+ (defun yas--modes-to-activate (&optional mode)
"Compute list of mode symbols that are active for `yas-expand'
and friends."
- (let (dfs)
- (setq dfs (lambda (mode &optional explored)
- (push mode explored)
- (cons mode
- (loop for neighbour
- in (cl-list* (get mode 'derived-mode-parent)
- (ignore-errors (symbol-function mode))
- (gethash mode yas--parents))
- when (and neighbour
- (not (memq neighbour explored))
- (symbolp neighbour))
- append (funcall dfs neighbour explored)))))
- (remove-duplicates (append yas--extra-modes
- (funcall dfs major-mode)))))
+ (let* ((explored (if mode (list mode) ; Building up list in reverse.
+ (cons major-mode (reverse yas--extra-modes))))
+ (dfs
+ (lambda (mode)
+ (cl-loop for neighbour
+ in (cl-list* (get mode 'derived-mode-parent)
+ (ignore-errors (symbol-function mode))
+ (gethash mode yas--parents))
+ when (and neighbour
+ (not (memq neighbour explored))
+ (symbolp neighbour))
+ do (push neighbour explored)
+ (funcall dfs neighbour)))))
+ (mapcar dfs explored)
+ (nreverse explored)))
(defvar yas-minor-mode-hook nil
"Hook run when `yas-minor-mode' is turned on.")
\f
;;; Internal structs for template management
- (defstruct (yas--template (:constructor yas--make-template))
+ (cl-defstruct (yas--template
+ (:constructor yas--make-template)
+ ;; Handles `yas-define-snippets' format, plus the
+ ;; initial TABLE argument.
+ (:constructor
+ yas--define-snippets-2
+ (table
+ key content
+ &optional xname condition group
+ expand-env load-file xkeybinding xuuid save-file
+ &aux
+ (name (or xname
+ ;; A little redundant: we always get a name
+ ;; from `yas--parse-template' except when
+ ;; there isn't a file.
+ (and load-file (file-name-nondirectory load-file))
+ (and save-file (file-name-nondirectory save-file))
+ key))
+ (keybinding (yas--read-keybinding xkeybinding))
+ (uuid (or xuuid name))
+ (old (gethash uuid (yas--table-uuidhash table)))
+ (menu-binding-pair
+ (and old (yas--template-menu-binding-pair old)))
+ (perm-group
+ (and old (yas--template-perm-group old))))))
"A template for a snippet."
key
content
name
condition
expand-env
- file
+ load-file
+ save-file
keybinding
uuid
menu-binding-pair
(defun yas--update-template (table template)
"Add or update TEMPLATE in TABLE.
- Also takes care of adding and updating to the associated menu."
+ Also takes care of adding and updating to the associated menu.
+ Return TEMPLATE."
;; Remove from table by uuid
;;
(yas--remove-template-by-uuid table (yas--template-uuid template))
(yas--add-template table template)
;; Take care of the menu
;;
- (yas--update-template-menu table template))
+ (yas--update-template-menu table template)
+ template)
(defun yas--update-template-menu (table template)
"Update every menu-related for TEMPLATE."
'again)
(setq methods (cdr methods))))
(t
- (yas--warning "Warning invalid element %s in `yas-key-syntaxes'" method)))
+ (setq methods (cdr methods))
+ (yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method)))
(let ((possible-key (buffer-substring-no-properties (point) original)))
(save-excursion
(goto-char original)
yas--direct-keymaps))
table))
- (defun yas--get-snippet-tables ()
- "Get snippet tables for current buffer.
+ (defun yas--get-snippet-tables (&optional mode)
+ "Get snippet tables for MODE.
+
+ MODE defaults to the current buffer's `major-mode'.
Return a list of `yas--table' objects. The list of modes to
consider is returned by `yas--modes-to-activate'"
(remove nil
(mapcar #'(lambda (name)
(gethash name yas--tables))
- (yas--modes-to-activate))))
+ (yas--modes-to-activate mode))))
(defun yas--menu-keymap-get-create (mode &optional parents)
"Get or create the menu keymap for MODE and its PARENTS.
:visible (yas--show-menu-p ',mode)))
menu-keymap))
-
- (defmacro yas--called-interactively-p (&optional kind)
- "A backward-compatible version of `called-interactively-p'.
-
- Optional KIND is as documented at `called-interactively-p'
- in GNU Emacs 24.1 or higher."
- (if (string< emacs-version "24.1")
- '(called-interactively-p)
- `(called-interactively-p ,kind)))
-
\f
;;; Template-related and snippet loading functions
Return a snippet-definition, i.e. a list
- (KEY TEMPLATE NAME CONDITION GROUP VARS FILE KEYBINDING UUID)
+ (KEY TEMPLATE NAME CONDITION GROUP VARS LOAD-FILE KEYBINDING UUID)
If the buffer contains a line of \"# --\" then the contents above
this line are ignored. Directives can set most of these with the syntax:
(point-max)))
(setq bound (point))
(goto-char (point-min))
- (while (re-search-forward "^# *\\([^ ]+?\\) *: *\\(.*\\)$" bound t)
+ (while (re-search-forward "^# *\\([^ ]+?\\) *: *\\(.*?\\)[[:space:]]*$" bound t)
(when (string= "uuid" (match-string-no-properties 1))
(setq uuid (match-string-no-properties 2)))
(when (string= "type" (match-string-no-properties 1))
(defun yas-x-prompt (prompt choices &optional display-fn)
"Display choices in a x-window prompt."
(when (and window-system choices)
+ ;; Let window position be recalculated to ensure that
+ ;; `posn-at-point' returns non-nil.
+ (redisplay)
(or
(x-popup-menu
(if (fboundp 'posn-at-point)
(if display-fn (mapcar display-fn choices) choices)))))
(keyboard-quit))))
+ (defun yas-maybe-ido-prompt (prompt choices &optional display-fn)
+ (when (bound-and-true-p ido-mode)
+ (yas-ido-prompt prompt choices display-fn)))
+
(defun yas-ido-prompt (prompt choices &optional display-fn)
- (when (and (fboundp 'ido-completing-read)
- (or (>= emacs-major-version 24)
- ido-mode))
- (yas-completing-prompt prompt choices display-fn #'ido-completing-read)))
+ (require 'ido)
+ (yas-completing-prompt prompt choices display-fn #'ido-completing-read))
(defun yas-dropdown-prompt (_prompt choices &optional display-fn)
(when (fboundp 'dropdown-list)
(defun yas--define-snippets-1 (snippet snippet-table)
"Helper for `yas-define-snippets'."
- ;; X) Calculate some more defaults on the values returned by
- ;; `yas--parse-template'.
- ;;
- (let* ((file (seventh snippet))
- (key (car snippet))
- (name (or (third snippet)
- (and file
- (file-name-directory file))))
- (condition (fourth snippet))
- (group (fifth snippet))
- (keybinding (yas--read-keybinding (eighth snippet)))
- (uuid (or (ninth snippet)
- name))
- (template (or (gethash uuid (yas--table-uuidhash snippet-table))
- (yas--make-template :uuid uuid
- :table snippet-table))))
- ;; X) populate the template object
- ;;
- (setf (yas--template-key template) key)
- (setf (yas--template-content template) (second snippet))
- (setf (yas--template-name template) (or name key))
- (setf (yas--template-group template) group)
- (setf (yas--template-condition template) condition)
- (setf (yas--template-expand-env template) (sixth snippet))
- (setf (yas--template-file template) (seventh snippet))
- (setf (yas--template-keybinding template) keybinding)
-
- ;; X) Update this template in the appropriate table. This step
- ;; also will take care of adding the key indicators in the
- ;; templates menu entry, if any
- ;;
- (yas--update-template snippet-table template)
- ;; X) Return the template
- ;;
- ;;
- template))
+ ;; Update the appropriate table. Also takes care of adding the
+ ;; key indicators in the templates menu entry, if any.
+ (yas--update-template
+ snippet-table (apply #'yas--define-snippets-2 snippet-table snippet)))
(defun yas-define-snippets (mode snippets)
"Define SNIPPETS for MODE.
SNIPPETS is a list of snippet definitions, each taking the
following form
- (KEY TEMPLATE NAME CONDITION GROUP EXPAND-ENV FILE KEYBINDING UUID)
+ (KEY TEMPLATE NAME CONDITION GROUP EXPAND-ENV LOAD-FILE KEYBINDING UUID SAVE-FILE)
Within these, only KEY and TEMPLATE are actually mandatory.
You can use `yas--parse-template' to return such lists based on
the current buffers contents."
(if yas--creating-compiled-snippets
- (progn
+ (let ((print-length nil))
(insert ";;; Snippet definitions:\n;;;\n")
- (let ((literal-snippets (list))
- (print-length nil))
- (dolist (snippet snippets)
- (let ((key (nth 0 snippet))
- (template-content (nth 1 snippet))
- (name (nth 2 snippet))
- (condition (nth 3 snippet))
- (group (nth 4 snippet))
- (expand-env (nth 5 snippet))
- (file nil) ;; omit on purpose
- (binding (nth 7 snippet))
- (uuid (nth 8 snippet)))
- (push `(,key
- ,template-content
- ,name
- ,condition
- ,group
- ,expand-env
- ,file
- ,binding
- ,uuid)
- literal-snippets)))
- (insert (pp-to-string
- `(yas-define-snippets ',mode ',literal-snippets)))
- (insert "\n\n")))
+ (dolist (snippet snippets)
+ ;; Fill in missing elements with nil.
+ (setq snippet (append snippet (make-list (- 10 (length snippet)) nil)))
+ ;; Move LOAD-FILE to SAVE-FILE because we will load from the
+ ;; compiled file, not LOAD-FILE.
+ (let ((load-file (nth 6 snippet)))
+ (setcar (nthcdr 6 snippet) nil)
+ (setcar (nthcdr 9 snippet) load-file)))
+ (insert (pp-to-string
+ `(yas-define-snippets ',mode ',snippets)))
+ (insert "\n\n"))
;; Normal case.
(let ((snippet-table (yas--table-get-create mode))
(template nil))
\f
;;; Loading snippets from files
+ (defun yas--template-get-file (template)
+ "Return TEMPLATE's LOAD-FILE or SAVE-FILE."
+ (or (yas--template-load-file template)
+ (let ((file (yas--template-save-file template)))
+ (when file
+ (yas--message 2 "%s has no load file, use save file, %s, instead."
+ (yas--template-name template) file))
+ file)))
+
(defun yas--load-yas-setup-file (file)
(if (not yas--creating-compiled-snippets)
;; Normal case.
- (load file 'noerror)
+ (load file 'noerror (<= yas-verbosity 2))
(let ((elfile (concat file ".el")))
(when (file-exists-p elfile)
- (insert ";;; .yas-setup.el support file if any:\n;;;\n")
+ (insert ";;; contents of the .yas-setup.el support file:\n;;;\n")
(insert-file-contents elfile)
(goto-char (point-max))))))
(funcall fun)))
;; Look for buffers that are already in `mode-sym', and so
;; need the new snippets immediately...
- ;;
- (when use-jit
+ ;;
+ (when use-jit
(cl-loop for buffer in (buffer-list)
do (with-current-buffer buffer
(when (eq major-mode mode-sym)
(push buffer impatient-buffers)))))))
;; ...after TOP-LEVEL-DIR has been completely loaded, call
;; `yas--load-pending-jits' in these impatient buffers.
- ;;
+ ;;
(cl-loop for buffer in impatient-buffers
do (with-current-buffer buffer (yas--load-pending-jits))))
(when interactive
(current-time-string)))))
;; Normal case.
(unless (file-exists-p (concat directory "/" ".yas-skip"))
- (if (and (progn (yas--message 2 "Loading compiled snippets from %s" directory) t)
- (load (expand-file-name ".yas-compiled-snippets" directory) 'noerror (<= yas-verbosity 3)))
- (yas--message 2 "Loading snippet files from %s" directory)
+ (unless (and (load (expand-file-name ".yas-compiled-snippets" directory) 'noerror (<= yas-verbosity 3))
+ (progn (yas--message 2 "Loaded compiled snippets from %s" directory) t))
+ (yas--message 2 "Loading snippet files from %s" directory)
(yas--load-directory-2 directory mode-sym)))))
(defun yas--load-directory-2 (directory mode-sym)
"Reload the directories listed in `yas-snippet-dirs' or
prompt the user to select one."
(let (errors)
- (if yas-snippet-dirs
- (dolist (directory (reverse (yas-snippet-dirs)))
- (cond ((file-directory-p directory)
- (yas-load-directory directory (not nojit))
- (if nojit
- (yas--message 3 "Loaded %s" directory)
- (yas--message 3 "Prepared just-in-time loading for %s" directory)))
- (t
- (push (yas--message 0 "Check your `yas-snippet-dirs': %s is not a directory" directory) errors))))
- (call-interactively 'yas-load-directory))
+ (if (null yas-snippet-dirs)
+ (call-interactively 'yas-load-directory)
+ (when (member yas--default-user-snippets-dir yas-snippet-dirs)
+ (make-directory yas--default-user-snippets-dir t))
+ (dolist (directory (reverse (yas-snippet-dirs)))
+ (cond ((file-directory-p directory)
+ (yas-load-directory directory (not nojit))
+ (if nojit
+ (yas--message 3 "Loaded %s" directory)
+ (yas--message 3 "Prepared just-in-time loading for %s" directory)))
+ (t
+ (push (yas--message 0 "Check your `yas-snippet-dirs': %s is not a directory" directory) errors)))))
errors))
(defun yas-reload-all (&optional no-jit interactive)
(interactive)
(message (concat "yasnippet (version "
yas--version
- ") -- pluskid <pluskid@gmail.com>/joaotavora <joaotavora@gmail.com>")))
+ ") -- pluskid/joaotavora/npostavs")))
\f
;;; Apropos snippet menu:
;; loops when other extensions use mechanisms similar
;; to `yas--keybinding-beyond-yasnippet'. (github #525
;; and #526)
- ;;
+ ;;
(yas-minor-mode nil)
(beyond-yasnippet (yas--keybinding-beyond-yasnippet)))
(yas--message 4 "Falling back to %s" beyond-yasnippet)
(assert (or (null beyond-yasnippet) (commandp beyond-yasnippet)))
- (setq this-original-command beyond-yasnippet)
+ (setq this-command beyond-yasnippet)
(when beyond-yasnippet
(call-interactively beyond-yasnippet))))
((and (listp yas-fallback-behavior)
(remove-duplicates (mapcan #'yas--table-templates tables)
:test #'equal))))
+ (defun yas--lookup-snippet-1 (name mode)
+ "Get the snippet called NAME in MODE's tables."
+ (let ((yas-choose-tables-first nil) ; avoid prompts
+ (yas-choose-keys-first nil))
+ (cl-find name (yas--all-templates
+ (yas--get-snippet-tables mode))
+ :key #'yas--template-name :test #'string=)))
+
+ (defun yas-lookup-snippet (name &optional mode noerror)
+ "Get the snippet content for the snippet NAME in MODE's tables.
+
+ MODE defaults to the current buffer's `major-mode'. If NOERROR
+ is non-nil, then don't signal an error if there isn't any snippet
+ called NAME.
+
+ Honours `yas-buffer-local-condition'."
+ (let ((snippet (yas--lookup-snippet-1 name mode)))
+ (cond
+ (snippet (yas--template-content snippet))
+ (noerror nil)
+ (t (error "No snippet named: %s" name)))))
+
(defun yas-insert-snippet (&optional no-condition)
"Choose a snippet to expand, pop-up a list of choices according
to `yas-prompt-functions'.
(interactive)
(let* ((yas-buffer-local-condition 'always)
(templates (yas--all-templates (yas--get-snippet-tables)))
- (yas-prompt-functions '(yas-ido-prompt yas-completing-prompt))
(template (and templates
(or (yas--prompt-for-template templates
"Choose a snippet template to edit: ")
(defun yas--visit-snippet-file-1 (template)
"Helper for `yas-visit-snippet-file'."
- (let ((file (yas--template-file template)))
+ (let ((file (yas--template-get-file template)))
(cond ((and file (file-readable-p file))
(find-file-other-window file)
(snippet-mode)
(let ((main-dir (replace-regexp-in-string
"/+$" ""
(or (first (or (yas-snippet-dirs)
- (setq yas-snippet-dirs '("~/.emacs.d/snippets")))))))
+ (setq yas-snippet-dirs (list yas--default-user-snippets-dir)))))))
(tables (or (and table
(list table))
(yas--get-snippet-tables))))
;; template which is already loaded and neatly positioned,...
;;
(yas--editing-template
- (yas--define-snippets-1 (yas--parse-template (yas--template-file yas--editing-template))
+ (yas--define-snippets-1 (yas--parse-template (yas--template-load-file yas--editing-template))
(yas--template-table yas--editing-template)))
;; Try to use `yas--guessed-modes'. If we don't have that use the
;; value from `yas--compute-major-mode-and-parents'
and `kill-buffer' instead."
(interactive (list (yas--read-table) current-prefix-arg))
(yas-load-snippet-buffer table t)
- (when (and (or
- ;; Only offer to save this if it looks like a library or new
- ;; snippet (loaded from elisp, from a dir in `yas-snippet-dirs'
- ;; which is not the first, or from an unwritable file)
- ;;
- (not (yas--template-file yas--editing-template))
- (not (file-writable-p (yas--template-file yas--editing-template)))
- (and (listp yas-snippet-dirs)
- (second yas-snippet-dirs)
- (not (string-match (expand-file-name (first yas-snippet-dirs))
- (yas--template-file yas--editing-template)))))
- (y-or-n-p (yas--format "Looks like a library or new snippet. Save to new file? ")))
- (let* ((option (first (yas--guess-snippet-directories (yas--template-table yas--editing-template))))
- (chosen (and option
- (yas--make-directory-maybe option))))
- (when chosen
- (let ((default-file-name (or (and (yas--template-file yas--editing-template)
- (file-name-nondirectory (yas--template-file yas--editing-template)))
- (yas--template-name yas--editing-template))))
- (write-file (concat chosen "/"
- (read-from-minibuffer (format "File name to create in %s? " chosen)
- default-file-name)))
- (setf (yas--template-file yas--editing-template) buffer-file-name)))))
+ (let ((file (yas--template-get-file yas--editing-template)))
+ (when (and (or
+ ;; Only offer to save this if it looks like a library or new
+ ;; snippet (loaded from elisp, from a dir in `yas-snippet-dirs'
+ ;; which is not the first, or from an unwritable file)
+ ;;
+ (not file)
+ (not (file-writable-p file))
+ (and (cdr-safe yas-snippet-dirs)
+ (not (string-prefix-p (expand-file-name (car yas-snippet-dirs)) file))))
+ (y-or-n-p (yas--format "Looks like a library or new snippet. Save to new file? ")))
+ (let* ((option (first (yas--guess-snippet-directories (yas--template-table yas--editing-template))))
+ (chosen (and option
+ (yas--make-directory-maybe option))))
+ (when chosen
+ (let ((default-file-name (or (and file (file-name-nondirectory file))
+ (yas--template-name yas--editing-template))))
+ (write-file (concat chosen "/"
+ (read-from-minibuffer (format "File name to create in %s? " chosen)
+ default-file-name)))
+ (setf (yas--template-load-file yas--editing-template) buffer-file-name))))))
(when buffer-file-name
(save-buffer)
(quit-window kill)))
The most recently-inserted snippets are returned first."
(sort
- (remove nil (remove-duplicates (mapcar #'(lambda (ov)
- (overlay-get ov 'yas--snippet))
- (if all-snippets
- (overlays-in (point-min) (point-max))
- (nconc (overlays-at (point)) (overlays-at (1- (point))))))))
+ (delq nil (delete-dups
+ (mapcar (lambda (ov) (overlay-get ov 'yas--snippet))
+ (if all-snippets (overlays-in (point-min) (point-max))
+ (nconc (overlays-at (point))
+ (overlays-at (1- (point))))))))
#'(lambda (s1 s2)
(<= (yas--snippet-id s2) (yas--snippet-id s1)))))
(defvar yas--inhibit-overlay-hooks nil
"Bind this temporarily to non-nil to prevent running `yas--on-*-modification'.")
- (defmacro yas--inhibit-overlay-hooks (&rest body)
- "Run BODY with `yas--inhibit-overlay-hooks' set to t."
- (declare (indent 0))
- `(let ((yas--inhibit-overlay-hooks t))
- ,@body))
-
(defvar yas-snippet-beg nil "Beginning position of the last snippet committed.")
(defvar yas-snippet-end nil "End position of the last snippet committed.")
(setq yas-snippet-end (overlay-end control-overlay))
(delete-overlay control-overlay))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(when yas--active-field-overlay
(delete-overlay yas--active-field-overlay))
(when yas--field-protection-overlays
(defun yas--on-field-overlay-modification (overlay after? _beg _end &optional _length)
"Clears the field and updates mirrors, conditionally.
- Only clears the field if it hasn't been modified and it point it
- at field start. This hook doesn't do anything if an undo is in
- progress."
+ Only clears the field if it hasn't been modified and point is at
+ field start. This hook does nothing if an undo is in progress."
(unless (or yas--inhibit-overlay-hooks
+ (not (overlayp yas--active-field-overlay)) ; Avoid Emacs bug #21824.
(yas--undo-in-progress))
(let* ((field (overlay-get overlay 'yas--field))
(snippet (overlay-get yas--active-field-overlay 'yas--snippet)))
(yas--field-update-display field))
(yas--update-mirrors snippet))
(field
- (when (and (not after?)
+ (when (and (eq this-command 'self-insert-command)
(not (yas--field-modified-p field))
- (eq (point) (if (markerp (yas--field-start field))
- (marker-position (yas--field-start field))
- (yas--field-start field))))
+ (= (point) (yas--field-start field)))
(yas--skip-and-clear field))
(setf (yas--field-modified-p field) t))))))
\f
;; As of github #537 this no longer inhibits the command by issuing an
;; error: all the snippets at point, including nested snippets, are
;; automatically commited and the current command can proceed.
- ;;
+ ;;
(defun yas--make-move-field-protection-overlays (snippet field)
"Place protection overlays surrounding SNIPPET's FIELD.
;;
(when (< (buffer-size) end)
(save-excursion
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(goto-char (point-max))
(newline))))
;; go on to normal overlay creation/moving
;; them mostly to make the undo information
;;
(setq yas--start-column (current-column))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(setq snippet
(if expand-env
(eval `(let* ,expand-env
(set-marker marker nil)))))
(defun yas--scan-sexps (from count)
- (condition-case _
+ (ignore-errors
+ (save-match-data ; `scan-sexps' may modify match data.
(with-syntax-table (standard-syntax-table)
- (scan-sexps from count))
- (error
- nil)))
+ (scan-sexps from count)))))
(defun yas--make-marker (pos)
"Create a marker at POS with nil `marker-insertion-type'."
;; after the ":", this will be
;; caught as a mirror with
;; transform later.
- (not (save-match-data
- (eq (string-match "$[ \t\n]*("
- (match-string-no-properties 2)) 0)))
+ (not (string-match-p "\\`\\$[ \t\n]*("
+ (match-string-no-properties 2)))
;; allow ${0: some exit text}
;; (not (and number (zerop number)))
(yas--make-field number
(not (string= reflection (buffer-substring-no-properties (yas--mirror-start mirror)
(yas--mirror-end mirror)))))
(goto-char (yas--mirror-start mirror))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(insert reflection))
(if (> (yas--mirror-end mirror) (point))
(delete-region (point) (yas--mirror-end mirror))
(yas--field-end field)))))
(setf (yas--field-modified-p field) t)
(goto-char (yas--field-start field))
- (yas--inhibit-overlay-hooks
+ (let ((yas--inhibit-overlay-hooks t))
(insert transformed)
(if (> (yas--field-end field) (point))
(delete-region (point) (yas--field-end field))
(or (and fallback
(format "call command `%s'."
(pp-to-string fallback)))
- "do nothing (`yas-expand' doesn't shadow\nanything).")))
+ "do nothing (`yas-expand' doesn't override\nanything).")))
((eq yas-fallback-behavior 'return-nil)
"do nothing.")
(t "defer to `yas-fallback-behavior' (which see)."))))
(defun yas-initialize ()
"For backward compatibility, enable `yas-minor-mode' globally."
+ (declare (obsolete "Use (yas-global-mode 1) instead." "0.8"))
(yas-global-mode 1))
(defvar yas--backported-syms '(;; `defcustom's