;;; yasnippet.el --- Yet another snippet extension for Emacs.
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; 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>
;; Version: 0.8.1
;; 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.
;;
;;; Code:
(require 'cl)
-(eval-and-compile
- (require 'cl-lib))
+(require 'cl-lib)
(require 'easymenu)
(require 'help-mode)
(defgroup yasnippet nil
"Yet Another Snippet extension"
+ :prefix "yas-"
:group 'editing)
-(defvar yas--load-file-name load-file-name
- "Store the filename that yasnippet.el was originally loaded from.")
+(defvar yas-installed-snippets-dir nil)
+(setq yas-installed-snippets-dir
+ (when load-file-name
+ (concat (file-name-directory load-file-name) "snippets")))
(defcustom yas-snippet-dirs (remove nil
(list "~/.emacs.d/snippets"
- (when yas--load-file-name
- (concat (file-name-directory yas--load-file-name) "snippets"))))
- "Directory or list of snippet dirs for each major mode.
-
-The directory where user-created snippets are to be 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 directory is taken
-as the default for storing the user's new snippets."
+ 'yas-installed-snippets-dir))
+ "List of top-level snippet directories.
+
+Each element, a string or a symbol whose value is a string,
+designates a top-level directory where per-mode snippet
+directories can be found.
+
+Elements appearing earlier in the list override later elements'
+snippets.
+
+The first directory is taken as the default for storing snippet's
+created with `yas-new-snippet'. "
:type '(choice (string :tag "Single directory (string)")
(repeat :args (string) :tag "List of directories (strings)"))
:group 'yasnippet
(yas-reload-all)))))
(defun yas-snippet-dirs ()
- "Return `yas-snippet-dirs' (which see) as a list."
- (if (listp yas-snippet-dirs) yas-snippet-dirs (list yas-snippet-dirs)))
+ "Return variable `yas-snippet-dirs' as list of strings."
+ (cl-loop for e in (if (listp yas-snippet-dirs)
+ yas-snippet-dirs
+ (list yas-snippet-dirs))
+ collect
+ (cond ((stringp e) e)
+ ((and (symbolp e)
+ (boundp e)
+ (stringp (symbol-value e)))
+ (symbol-value e))
+ (t
+ (error "[yas] invalid element %s in `yas-snippet-dirs'" e)))))
(defvaralias 'yas/root-directory 'yas-snippet-dirs)
# -*- mode: snippet; require-final-newline: nil -*-
# name: $1
# key: ${2:${1:$(yas--key-from-desc yas-text)}}${3:
-# binding: ${4:direct-keybinding}}${5:
-# expand-env: ((${6:some-var} ${7:some-value}))}${8:
-# type: command}
+# binding: ${4:direct-keybinding}}
# --
$0"
"Default snippet to use when creating a new snippet.
`yas-expand' returns nil)
- A Lisp form (apply COMMAND . ARGS) means interactively call
- COMMAND, if ARGS is non-nil, call COMMAND non-interactively
+ COMMAND. If ARGS is non-nil, call COMMAND non-interactively
with ARGS as arguments."
:type '(choice (const :tag "Call previous command" call-other-command)
(const :tag "Do nothing" return-nil))
map)
"The active keymap while a snippet expansion is in progress.")
-(defvar yas-key-syntaxes (list "w" "w_" "w_." "w_.()" "^ ")
- "List of character syntaxes used to find a trigger key before point.
-The list is tried in the order while scanning characters
-backwards from point. For example, if the list is '(\"w\" \"w_\")
-first look for trigger keys which are composed exclusively of
-\"word\"-syntax characters, and then, if that fails, look for
-keys which are either of \"word\" or \"symbol\"
-syntax. Triggering after
+(defvar yas-key-syntaxes (list "w" "w_" "w_." "w_.()"
+ #'yas-try-key-from-whitespace)
+ "Syntaxes and functions to help look for trigger keys before point.
+
+Each element in this list specifies how to skip buffer positions
+backwards and look for the start of a trigger key.
+
+Each element can be either a string or a function receiving the
+original point as an argument. A string element is simply passed
+to `skip-syntax-backward' whereas a function element is called
+with no arguments and should also place point before the original
+position.
+
+The string between the resulting buffer position and the original
+point is matched against the trigger keys in the active snippet
+tables.
+
+If no expandable snippets are found, the next element is the list
+is tried, unless a function element returned the symbol `again',
+in which case it is called again from the previous position and
+may once more reposition point.
+
+For example, if `yas-key-syntaxes'' value is '(\"w\" \"w_\"),
+trigger keys composed exclusively of \"word\"-syntax characters
+are looked for first. Failing that, longer keys composed of
+\"word\" or \"symbol\" syntax are looked for. Therefore,
+triggering after
foo-bar
-will, according to the \"w\" element first try \"bar\". If that
-isn't a trigger key, \"foo-bar\" is tried, respecting a second
-\"w_\" element.")
+will, according to the \"w\" element first try \"barbaz\". If
+that isn't a trigger key, \"foo-barbaz\" is tried, respecting the
+second \"w_\" element. Notice that even if \"baz\" is a trigger
+key for an active snippet, it won't be expanded, unless a
+function is added to `yas-key-syntaxes' that eventually places
+point between \"bar\" and \"baz\".
+
+See also Info node `(elisp) Syntax Descriptors'.")
(defvar yas-after-exit-snippet-hook
'()
(defvar yas--menu-table (make-hash-table)
"A hash table of MAJOR-MODE symbols to menu keymaps.")
-(defvar yas--known-modes
- '(ruby-mode rst-mode markdown-mode)
- "A list of mode which is well known but not part of Emacs.")
-
(defvar yas--escaped-characters
'(?\\ ?` ?\" ?' ?$ ?} ?{ ?\( ?\))
"List of characters which *might* need to be escaped.")
(defun yas--snippet-next-id ()
(let ((id yas--snippet-id-seed))
- (incf yas--snippet-id-seed)
+ (cl-incf yas--snippet-id-seed)
id))
\f
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)
(push mode explored)
(cons mode
(loop for neighbour
- in (remove nil (cons (get mode
- 'derived-mode-parent)
- (gethash mode yas--parents)))
-
- unless (memq neighbour explored)
+ 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)))))
+ (remove-duplicates (if mode
+ (funcall dfs mode)
+ (append yas--extra-modes
+ (funcall dfs major-mode))))))
(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-blank-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 file xkeybinding xuuid
+ &aux
+ (name (or xname
+ (and file (file-name-directory 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
table
)
-(defun yas--populate-template (template &rest args)
- "Helper function to populate TEMPLATE with properties."
- (while args
- (aset template
- (position (intern (substring (symbol-name (car args)) 1))
- (mapcar #'car (get 'yas--template 'cl-struct-slots)))
- (second args))
- (setq args (cddr args)))
- template)
-
(defstruct (yas--table (:constructor yas--make-snippet-table (name)))
"A table to store snippets for a particular mode.
(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."
(yas--table-hash table))
(yas--filter-templates-by-condition acc))))
-(defun yas--current-key ()
- "Get the key under current position.
-A key is used to find the template of a snippet in the current snippet-table."
- (let ((start (point))
- (end (point))
- (syntaxes yas-key-syntaxes)
- syntax
- done
- templates)
- (while (and (not done) syntaxes)
- (setq syntax (car syntaxes))
- (setq syntaxes (cdr syntaxes))
- (save-excursion
- (skip-syntax-backward syntax)
- (setq start (point)))
- (setq templates
- (mapcan #'(lambda (table)
- (yas--fetch table (buffer-substring-no-properties start end)))
- (yas--get-snippet-tables)))
- (if templates
- (setq done t)
- (setq start end)))
- (list templates
- start
- end)))
-
+(defun yas--templates-for-key-at-point ()
+ "Find `yas--template' objects for any trigger keys preceding point.
+Returns (TEMPLATES START END). This function respects
+`yas-key-syntaxes', which see."
+ (save-excursion
+ (let ((original (point))
+ (methods yas-key-syntaxes)
+ (templates)
+ (method))
+ (while (and methods
+ (not templates))
+ (unless (eq method (car methods))
+ ;; TRICKY: `eq'-ness test means we can only be here if
+ ;; `method' is a function that returned `again', and hence
+ ;; don't revert back to original position as per
+ ;; `yas-key-syntaxes'.
+ (goto-char original))
+ (setq method (car methods))
+ (cond ((stringp method)
+ (skip-syntax-backward method)
+ (setq methods (cdr methods)))
+ ((functionp method)
+ (unless (eq (funcall method original)
+ 'again)
+ (setq methods (cdr methods))))
+ (t
+ (yas--warning "Warning invalid element %s in `yas-key-syntaxes'" method)))
+ (let ((possible-key (buffer-substring-no-properties (point) original)))
+ (save-excursion
+ (goto-char original)
+ (setq templates
+ (mapcan #'(lambda (table)
+ (yas--fetch table possible-key))
+ (yas--get-snippet-tables))))))
+ (when templates
+ (list templates (point) original)))))
(defun yas--table-all-keys (table)
"Get trigger keys of all active snippets in TABLE."
\f
;;; Internal functions and macros:
-(defun yas--real-mode? (mode)
- "Try to find out if MODE is a real mode.
-
-The MODE bound to a function (like `c-mode') is considered real
-mode. Other well known mode like `ruby-mode' which is not part of
-Emacs might not bound to a function until it is loaded. So
-yasnippet keeps a list of modes like this to help the judgment."
- (or (fboundp mode)
- (find mode yas--known-modes)))
+(defun yas--handle-error (err)
+ "Handle error depending on value of `yas-good-grace'."
+ (let ((msg (yas--format "elisp error: %s" (error-message-string err))))
+ (if yas-good-grace msg
+ (error "%s" msg))))
(defun yas--eval-lisp (form)
"Evaluate FORM and convert the result to string."
(let ((result (eval form)))
(when result
(format "%s" result))))))
- (error (if yas-good-grace
- (yas--format "elisp error! %s" (error-message-string err))
- (error (yas--format "elisp error: %s"
- (error-message-string err)))))))))
+ (error (yas--handle-error err))))))
(when (and (consp retval)
(eq 'yas--exception (car retval)))
(error (cdr retval)))
(defun yas--eval-lisp-no-saves (form)
(condition-case err
(eval form)
- (error (if yas-good-grace
- (yas--format "elisp error! %s" (error-message-string err))
- (error (yas--format "elisp error: %s"
- (error-message-string err)))))))
+ (error (message "%s" (yas--handle-error err)))))
(defun yas--read-lisp (string &optional nil-on-error)
"Read STRING as a elisp expression and return it.
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.
(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-blank-template))))
- ;; X) populate the template object
- ;;
- (yas--populate-template template
- :table snippet-table
- :key key
- :content (second snippet)
- :name (or name key)
- :group group
- :condition condition
- :expand-env (sixth snippet)
- :file (seventh snippet)
- :keybinding keybinding
- :uuid uuid)
- ;; 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.
FILE is probably of very little use if you're programatically
defining snippets.
-UUID is the snippets \"unique-id\". Loading a second snippet file
-with the same uuid replaced the previous snippet.
+UUID is the snippet's \"unique-id\". Loading a second snippet
+file with the same uuid would replace the previous snippet.
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)
+ ;; We omit file because the snippet will be loaded from
+ ;; the compiled file instead, so deleting or changing
+ ;; the original won't have any effect.
+ (setcar (nthcdr 6 snippet) nil))
+ (insert (pp-to-string
+ `(yas-define-snippets ',mode ',snippets)))
+ (insert "\n\n"))
;; Normal case.
(let ((snippet-table (yas--table-get-create mode))
(template nil))
(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))))))
Below TOP-LEVEL-DIR each directory should be a mode name.
-Optional USE-JIT use jit-loading of snippets."
- (interactive "DSelect the root directory: ni\np")
+With prefix argument USE-JIT do jit-loading of snippets."
+ (interactive
+ (list (read-directory-name "Select the root directory: " nil nil t)
+ current-prefix-arg t))
(unless yas-snippet-dirs
(setq yas-snippet-dirs top-level-dir))
- (dolist (dir (yas--subdirs top-level-dir))
- (let* ((major-mode-and-parents (yas--compute-major-mode-and-parents
- (concat dir "/dummy")))
- (mode-sym (car major-mode-and-parents))
- (parents (cdr major-mode-and-parents)))
- ;; Attention: The parents and the menus are already defined
- ;; here, even if the snippets are later jit-loaded.
- ;;
- ;; * We need to know the parents at this point since entering a
- ;; given mode should jit load for its parents
- ;; immediately. This could be reviewed, the parents could be
- ;; discovered just-in-time-as well
- ;;
- ;; * We need to create the menus here to support the `full'
- ;; option to `yas-use-menu' (all known snippet menus are shown to the user)
- ;;
- (yas--define-parents mode-sym parents)
- (yas--menu-keymap-get-create mode-sym)
- (let ((fun `(lambda () ;; FIXME: Simulating lexical-binding.
- (yas--load-directory-1 ',dir ',mode-sym))))
- (if (and use-jit
- (not (some #'(lambda (buffer)
- (with-current-buffer buffer
- ;; FIXME: Shouldn't this use derived-mode-p?
- (when (eq major-mode mode-sym)
- (yas--message 3 "Discovered there was already %s in %s" buffer mode-sym)
- t)))
- (buffer-list))))
- (yas--schedule-jit mode-sym fun)
- (funcall fun)))))
+ (let ((impatient-buffers))
+ (dolist (dir (yas--subdirs top-level-dir))
+ (let* ((major-mode-and-parents (yas--compute-major-mode-and-parents
+ (concat dir "/dummy")))
+ (mode-sym (car major-mode-and-parents))
+ (parents (cdr major-mode-and-parents)))
+ ;; Attention: The parents and the menus are already defined
+ ;; here, even if the snippets are later jit-loaded.
+ ;;
+ ;; * We need to know the parents at this point since entering a
+ ;; given mode should jit load for its parents
+ ;; immediately. This could be reviewed, the parents could be
+ ;; discovered just-in-time-as well
+ ;;
+ ;; * We need to create the menus here to support the `full'
+ ;; option to `yas-use-menu' (all known snippet menus are shown to the user)
+ ;;
+ (yas--define-parents mode-sym parents)
+ (yas--menu-keymap-get-create mode-sym)
+ (let ((fun `(lambda () ;; FIXME: Simulating lexical-binding.
+ (yas--load-directory-1 ',dir ',mode-sym))))
+ (if use-jit
+ (yas--schedule-jit mode-sym fun)
+ (funcall fun)))
+ ;; Look for buffers that are already in `mode-sym', and so
+ ;; need the new snippets immediately...
+ ;;
+ (when use-jit
+ (cl-loop for buffer in (buffer-list)
+ do (with-current-buffer buffer
+ (when (eq major-mode mode-sym)
+ (yas--message 3 "Discovered there was already %s in %s" buffer 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
(yas--message 3 "Loaded snippets from %s." top-level-dir)))
(call-interactively 'yas-load-directory))
errors))
-(defun yas-reload-all (&optional interactive)
+(defun yas-reload-all (&optional no-jit interactive)
"Reload all snippets and rebuild the YASnippet menu.
-When called interactively force immediate reload of all known
+When NO-JIT is non-nil force immediate reload of all known
snippets under `yas-snippet-dirs', otherwise use just-in-time
-loading."
- (interactive "p")
+loading.
+
+When called interactively, use just-in-time loading when given a
+prefix argument."
+ (interactive (list (not current-prefix-arg) t))
(catch 'abort
(let ((errors)
(snippet-editing-buffers
;; Reload the directories listed in `yas-snippet-dirs' or prompt
;; the user to select one.
;;
- (setq errors (yas--load-snippet-dirs interactive))
+ (setq errors (yas--load-snippet-dirs no-jit))
;; Reload the direct keybindings
;;
(yas-direct-keymaps-reload)
(run-hooks 'yas-after-reload-hook)
(yas--message 3 "Reloaded everything%s...%s."
- (if interactive "" " (snippets will load just-in-time)")
+ (if no-jit "" " (snippets will load just-in-time)")
(if errors " (some errors, check *Messages*)" "")))))
(defvar yas-after-reload-hook nil
\f
;;; Snippet compilation function
-(defun yas--initialize ()
- "For backward compatibility, enable `yas-minor-mode' globally."
- (yas-global-mode 1))
-
(defun yas-compile-directory (top-level-dir)
"Create .yas-compiled-snippets.el files under subdirs of TOP-LEVEL-DIR.
hash)
(dolist (uuid omit-items)
(let ((template (or (gethash uuid hash)
- (yas--populate-template (puthash uuid
- (yas--make-blank-template)
- hash)
- :table table
- :uuid uuid))))
+ (puthash uuid
+ (yas--make-template :table table
+ :uuid uuid)
+ hash))))
(setf (yas--template-menu-binding-pair template) (cons nil :none))))))
(defun yas--define-menu-1 (table menu-keymap menu uuidhash &optional group-list)
(dolist (e (reverse menu))
(cond ((eq (first e) 'yas-item)
(let ((template (or (gethash (second e) uuidhash)
- (yas--populate-template (puthash (second e)
- (yas--make-blank-template)
- uuidhash)
- :table table
- :perm-group group-list
- :uuid (second e)))))
+ (puthash (second e)
+ (yas--make-template
+ :table table
+ :perm-group group-list
+ :uuid (second e))
+ uuidhash))))
(define-key menu-keymap (vector (gensym))
(car (yas--template-menu-binding-pair-get-create template :stay)))))
((eq (first e) 'yas-submenu)
(save-restriction
(narrow-to-region (yas--field-start field)
(yas--field-end field))
- (yas--current-key))
- (yas--current-key))))
- (if (and templates-and-pos
- (first templates-and-pos))
+ (yas--templates-for-key-at-point))
+ (yas--templates-for-key-at-point))))
+ (if templates-and-pos
(yas--expand-or-prompt-for-template (first templates-and-pos)
- (second templates-and-pos)
- (third templates-and-pos))
+ (second templates-and-pos)
+ (third templates-and-pos))
(yas--fallback))))
(defun yas-expand-from-keymap ()
(cond ((eq yas-fallback-behavior 'return-nil)
;; return nil
nil)
+ ((eq yas-fallback-behavior 'yas--fallback)
+ (error (concat "yasnippet fallback loop!\n"
+ "This can happen when you bind `yas-expand' "
+ "outside of the `yas-minor-mode-map'.")))
((eq yas-fallback-behavior 'call-other-command)
- (let* ((beyond-yasnippet (yas--keybinding-beyond-yasnippet)))
+ (let* ((yas-fallback-behavior 'yas--fallback)
+ ;; Also bind `yas-minor-mode' to prevent fallback
+ ;; 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)
((and (listp yas-fallback-behavior)
(cdr yas-fallback-behavior)
(eq 'apply (car yas-fallback-behavior)))
- (if (cddr yas-fallback-behavior)
- (apply (cadr yas-fallback-behavior)
- (cddr yas-fallback-behavior))
- (when (commandp (cadr yas-fallback-behavior))
- (setq this-command (cadr yas-fallback-behavior))
- (call-interactively (cadr yas-fallback-behavior)))))
+ (let ((command-or-fn (cadr yas-fallback-behavior))
+ (args (cddr yas-fallback-behavior))
+ (yas-fallback-behavior 'yas--fallback)
+ (yas-minor-mode nil))
+ (if args
+ (apply command-or-fn args)
+ (when (commandp command-or-fn)
+ (setq this-command command-or-fn)
+ (call-interactively command-or-fn)))))
(t
;; also return nil if all the other fallbacks have failed
nil)))
(defun yas--keybinding-beyond-yasnippet ()
- "Return the ??"
+ "Get current keys's binding as if YASsnippet didn't exist."
(let* ((yas-minor-mode nil)
(yas--direct-keymaps nil)
(keys (this-single-command-keys)))
(remove-duplicates (mapcan #'yas--table-templates tables)
:test #'equal))))
+(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* ((yas-choose-tables-first nil) ; avoid prompts
+ (yas-choose-keys-first nil)
+ (snippet (cl-find name (yas--all-templates
+ (yas--get-snippet-tables mode))
+ :key #'yas--template-name :test #'string=)))
+ (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'.
;;
(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)))))
+ (and (cdr-safe yas-snippet-dirs)
+ (not (string-prefix-p (expand-file-name (car 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--current-template
(and parsed
(fboundp test-mode)
- (yas--populate-template (yas--make-blank-template)
- :table nil ;; no tables for ephemeral snippets
- :key (first parsed)
- :content (second parsed)
- :name (third parsed)
- :expand-env (sixth parsed)))))
+ (yas--make-template :table nil ;; no tables for ephemeral snippets
+ :key (first parsed)
+ :content (second parsed)
+ :name (third parsed)
+ :expand-env (sixth parsed)))))
(cond (yas--current-template
(let ((buffer-name (format "*testing snippet: %s*" (yas--template-name yas--current-template))))
(kill-buffer (get-buffer-create buffer-name))
groups-hash)))
+\f
+;;; User convenience functions, for using in `yas-key-syntaxes'
+
+(defun yas-try-key-from-whitespace (_start-point)
+ "As `yas-key-syntaxes' element, look for whitespace delimited key.
+
+A newline will be considered whitespace even if the mode syntax
+marks it as something else (typically comment ender)."
+ (skip-chars-backward "^[:space:]\n"))
+
+(defun yas-shortest-key-until-whitespace (_start-point)
+ "Like `yas-longest-key-from-whitespace' but take the shortest key."
+ (when (/= (skip-chars-backward "^[:space:]\n" (1- (point))) 0)
+ 'again))
+
+(defun yas-longest-key-from-whitespace (start-point)
+ "As `yas-key-syntaxes' element, look for longest key between point and whitespace.
+
+A newline will be considered whitespace even if the mode syntax
+marks it as something else (typically comment ender)."
+ (if (= (point) start-point)
+ (yas-try-key-from-whitespace start-point)
+ (forward-char))
+ (unless (<= start-point (1+ (point)))
+ 'again))
+
+
\f
;;; User convenience functions, for using in snippet definitions
;; field must be zero length
;;
(zerop (- (yas--field-start field) (yas--field-end field)))
- ;; skip if:
+ ;; field must have been modified
+ ;;
+ (yas--field-modified-p field)
+ ;; either:
(or
- ;; 1) is a nested field and it's been modified
+ ;; 1) it's a nested field
;;
- (and (yas--field-parent-field field)
- (yas--field-modified-p field))
+ (yas--field-parent-field field)
;; 2) ends just before the snippet end
;;
(and (eq field (car (last (yas--snippet-fields snippet))))
;; the field numbered 0, just before the exit marker, should
;; never be skipped
;;
- (not (zerop (yas--field-number field)))))
+ (not (and (yas--field-number field)
+ (zerop (yas--field-number field))))))
(defun yas--snippets-at-point (&optional all-snippets)
"Return a sorted list of snippets at point.
;; snippet outside the active field. Actual protection happens in
;; `yas--on-protection-overlay-modification'.
;;
-;; Currently this signals an error which inhibits the command. For
-;; commands that move point (like `kill-line'), point is restored in
-;; the `yas--post-command-handler' using a global
-;; `yas--protection-violation' variable.
-;;
-;; Alternatively, I've experimented with an implementation that
-;; commits the snippet before actually calling `this-command'
-;; interactively, and then signals an error, which is ignored. but
-;; blocks all other million modification hooks. This presented some
-;; problems with stacked expansion.
-;;
+;; 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.
;; (overlay-put ov 'evaporate t)
(overlay-put ov 'modification-hooks '(yas--on-protection-overlay-modification)))))))
-(defvar yas--protection-violation nil
- "When non-nil, signals attempts to erroneously exit or modify the snippet.
-
-Functions in the `post-command-hook', for example
-`yas--post-command-handler' can check it and reset its value to
-nil. The variables value is the point where the violation
-originated")
-
(defun yas--on-protection-overlay-modification (_overlay after? _beg _end &optional _length)
"Signals a snippet violation, then issues error.
The error should be ignored in `debug-ignored-errors'"
- (unless yas--inhibit-overlay-hooks
- (cond ((not (or after?
- (yas--undo-in-progress)))
- (setq yas--protection-violation (point))
- (error "Exit the snippet first!")))))
+ (unless (or yas--inhibit-overlay-hooks
+ after?
+ (yas--undo-in-progress))
+ (let ((snippets (yas--snippets-at-point)))
+ (yas--message 3 "Comitting snippets. Action would destroy a protection overlay.")
+ (cl-loop for snippet in snippets
+ do (yas--commit-snippet snippet)))))
(add-to-list 'debug-ignored-errors "^Exit the snippet first!$")
"Expand snippet CONTENT at current point.
Text between START and END will be deleted before inserting
-template. EXPAND-ENV is are let-style variable to value bindings
+template. EXPAND-ENV is a list of (SYM VALUE) let-style dynamic bindings
considered when expanding the snippet."
+ (cl-assert (and yas-minor-mode
+ (memq 'yas--post-command-handler post-command-hook))
+ nil
+ "[yas] `yas-expand-snippet' needs properly setup `yas-minor-mode'")
(run-hooks 'yas-before-expand-snippet-hook)
;;
(n (line-beginning-position)))
(while (or (eql c ?\ )
(eql c ?\t))
- (incf n)
+ (cl-incf n)
(setq c (char-after n)))
n))
(goto-char (match-beginning 0))
(when transformed
(let ((marker (make-marker)))
- (insert "Y") ;; quite horrendous, I love it :)
- (set-marker marker (point))
- (insert "Y")
+ (save-restriction
+ (widen)
+ (insert "Y") ;; quite horrendous, I love it :)
+ (set-marker marker (point))
+ (insert "Y"))
(push (cons marker transformed) yas--backquote-markers-and-strings))))))
(defun yas--restore-backquotes ()
(string (cdr marker-and-string)))
(save-excursion
(goto-char marker)
- (delete-char -1)
- (insert string)
- (delete-char 1)
+ (save-restriction
+ (widen)
+ (delete-char -1)
+ (insert string)
+ (delete-char 1))
(set-marker marker nil)))))
(defun yas--scan-sexps (from count)
;;
(defun yas--post-command-handler ()
"Handles various yasnippet conditions after each command."
- (cond (yas--protection-violation
- (goto-char yas--protection-violation)
- (setq yas--protection-violation nil))
- ((eq 'undo this-command)
+ (cond ((eq 'undo this-command)
;;
;; After undo revival the correct field is sometimes not
;; restored correctly, this condition handles that
(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)."))))
(when (> yas-verbosity level)
(message "%s" (apply #'yas--format message args))))
+(defun yas--warning (format-control &rest format-args)
+ (let ((msg (apply #'format format-control format-args)))
+ (display-warning 'yasnippet msg :warning)
+ (yas--message 1 msg)))
+
(defun yas--format (format-control &rest format-args)
(apply #'format (concat "[yas] " format-control) format-args))
\f
;;; Backward compatibility to yasnippet <= 0.7
+(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
;;
yas-snippet-dirs
yas-exit-snippet
yas-exit-all-snippets
yas-skip-and-clear-or-delete-char
+ yas-initialize
;; symbols that I "exported" for use
;; in snippets and hookage
\f
(provide 'yasnippet)
-
-;;; yasnippet.el ends here
;; Local Variables:
;; coding: utf-8
+;; indent-tabs-mode: nil
;; byte-compile-warnings: (not cl-functions)
;; End:
+;;; yasnippet.el ends here