X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/6877bc6db37d49a170e7bfb14aefff513891e482..6aeccce2f17aca6a59a2790ec08680d52c03f6c0:/yasnippet.el diff --git a/yasnippet.el b/yasnippet.el index 75f0ad4a1..f345e48dc 100644 --- a/yasnippet.el +++ b/yasnippet.el @@ -1,10 +1,9 @@ ;;; yasnippet.el --- Yet another snippet extension for Emacs. -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. -;; Authors: pluskid , João Távora -;; Maintainer: João Távora -;; Version: 0.8.1 -;; Package-version: 0.8.0 +;; Copyright (C) 2008-2013, 2015 Free Software Foundation, Inc. +;; Authors: pluskid , João Távora , Noam Postavsky +;; Maintainer: Noam Postavsky +;; Version: 0.9.1 ;; X-URL: http://github.com/capitaomorte/yasnippet ;; Keywords: convenience, emulation ;; URL: http://github.com/capitaomorte/yasnippet @@ -41,7 +40,7 @@ ;; 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. ;; @@ -156,8 +155,11 @@ (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. @@ -165,7 +167,7 @@ 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 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 @@ -199,10 +201,9 @@ created with `yas-new-snippet'. " (defvaralias 'yas/root-directory 'yas-snippet-dirs) (defcustom yas-new-snippet-default "\ -# -*- mode: snippet; require-final-newline: nil -*- +# -*- mode: snippet -*- # name: $1 -# key: ${2:${1:$(yas--key-from-desc yas-text)}}${3: -# binding: ${4:direct-keybinding}} +# key: ${2:${1:$(yas--key-from-desc yas-text)}} # -- $0" "Default snippet to use when creating a new snippet. @@ -210,10 +211,9 @@ If nil, don't use any snippet." :type 'string :group 'yasnippet) -(defcustom yas-prompt-functions '(yas-x-prompt - yas-dropdown-prompt +(defcustom yas-prompt-functions '(yas-dropdown-prompt yas-completing-prompt - yas-ido-prompt + yas-maybe-ido-prompt yas-no-prompt) "Functions to prompt for keys, templates, etc interactively. @@ -289,7 +289,7 @@ next field" `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)) @@ -459,10 +459,10 @@ Attention: These hooks are not run when exiting nested/stacked snippet expansion "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. @@ -521,15 +521,11 @@ snippet itself contains a condition that returns the symbol ;;; Internal variables -(defvar yas--version "0.8.0beta") +(defvar yas--version "0.9.1") (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.") @@ -691,7 +687,7 @@ snippet itself contains a condition that returns the symbol This variable probably makes more sense as buffer-local, so ensure your use `make-local-variable' when you set it.") -(define-obsolete-variable-alias 'yas-extra-modes 'yas--extra-modes "0.8.1") +(define-obsolete-variable-alias 'yas-extra-modes 'yas--extra-modes "0.9.1") (defvar yas--tables (make-hash-table) "A hash table of mode symbols to `yas--table' objects.") @@ -729,23 +725,24 @@ defined direct keybindings to the command 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.") @@ -916,14 +913,39 @@ Honour `yas-dont-activate', which see." ;;; 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 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 @@ -932,16 +954,6 @@ Honour `yas-dont-activate', which see." 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. @@ -1093,7 +1105,8 @@ keybinding)." (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)) @@ -1102,7 +1115,8 @@ Also takes care of adding and updating to the associated menu." (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." @@ -1257,7 +1271,8 @@ Returns (TEMPLATES START END). This function respects '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) @@ -1283,16 +1298,6 @@ Returns (TEMPLATES START END). This function respects ;;; 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)))) @@ -1357,15 +1362,17 @@ return an expression that when evaluated will issue an error." 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. @@ -1380,16 +1387,6 @@ them all in `yas--menu-table'" :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))) - ;;; Template-related and snippet loading functions @@ -1404,7 +1401,7 @@ otherwise we attempt to calculate it from FILE. 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: @@ -1441,7 +1438,7 @@ Here's a list of currently recognized directives: (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)) @@ -1568,6 +1565,9 @@ Optional PROMPT sets the prompt to use." (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) @@ -1582,11 +1582,13 @@ Optional PROMPT sets the prompt to use." (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) @@ -1620,43 +1622,10 @@ Optional PROMPT sets the prompt to use." (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. @@ -1664,7 +1633,7 @@ Optional PROMPT sets the prompt to use." 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. @@ -1686,33 +1655,19 @@ 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) + ;; 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)) @@ -1724,13 +1679,22 @@ the current buffers contents." ;;; 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)))))) @@ -1778,8 +1742,8 @@ With prefix argument USE-JIT do jit-loading of snippets." (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) @@ -1787,7 +1751,7 @@ With prefix argument USE-JIT do jit-loading of snippets." (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 @@ -1806,9 +1770,9 @@ With prefix argument USE-JIT do jit-loading of snippets." (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) @@ -1838,16 +1802,18 @@ With prefix argument USE-JIT do jit-loading of snippets." "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) @@ -1941,10 +1907,6 @@ foo\"bar\\! -> \"foo\\\"bar\\\\!\"" ;;; 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. @@ -1977,7 +1939,7 @@ This works by stubbing a few functions, then calling (interactive) (message (concat "yasnippet (version " yas--version - ") -- pluskid /joaotavora "))) + ") -- pluskid/joaotavora/npostavs"))) ;;; Apropos snippet menu: @@ -2089,11 +2051,10 @@ omitted from MODE's menu, even if they're manually loaded." 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) @@ -2101,12 +2062,12 @@ omitted from MODE's menu, even if they're manually loaded." (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) @@ -2254,28 +2215,36 @@ Common gateway for `yas-expand-from-trigger-key' and "outside of the `yas-minor-mode-map'."))) ((eq yas-fallback-behavior 'call-other-command) (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) + (setq this-command beyond-yasnippet) (when beyond-yasnippet (call-interactively beyond-yasnippet)))) ((and (listp yas-fallback-behavior) (cdr yas-fallback-behavior) (eq 'apply (car yas-fallback-behavior))) - (let ((yas-fallback-behavior 'yas--fallback)) - (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))) @@ -2327,6 +2296,28 @@ Honours `yas-choose-tables-first', `yas-choose-keys-first' and (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'. @@ -2361,7 +2352,6 @@ visited file in `snippet-mode'." (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: ") @@ -2373,7 +2363,7 @@ visited file in `snippet-mode'." (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) @@ -2419,7 +2409,7 @@ where snippets of table might exist." (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)))) @@ -2547,7 +2537,7 @@ When called interactively, prompt for the table name." ;; 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' @@ -2577,29 +2567,27 @@ Don't use this from a Lisp program, call `yas-load-snippet-buffer' 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))) @@ -2617,12 +2605,11 @@ and `kill-buffer' instead." (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)) @@ -2672,7 +2659,7 @@ and `kill-buffer' instead." (setq buffer-read-only nil) (erase-buffer) (cond ((not by-name-hash) - (insert "YASnippet tables: \n") + (insert "YASnippet tables:\n") (while (and table-lists continue) (dolist (table (car table-lists)) @@ -2728,31 +2715,32 @@ and `kill-buffer' instead." (setq group (truncate-string-to-width group 25 0 ? "...")) (insert (make-string 100 ?-) "\n") (dolist (p templates) - (let ((name (truncate-string-to-width (propertize (format "\\\\snippet `%s'" (yas--template-name p)) - 'yasnippet p) - 50 0 ? "...")) - (group (prog1 group - (setq group (make-string (length group) ? )))) - (condition-string (let ((condition (yas--template-condition p))) - (if (and condition - original-buffer) - (with-current-buffer original-buffer - (if (yas--eval-condition condition) - "(y)" - "(s)")) - "(a)")))) - (insert group " ") - (insert condition-string " ") - (insert name - (if (string-match "\\.\\.\\.$" name) - "'" - " ") - " ") - (insert (truncate-string-to-width (or (yas--template-key p) "") - 15 0 ? "...") " ") - (insert (truncate-string-to-width (key-description (yas--template-keybinding p)) - 15 0 ? "...") " ") - (insert "\n")))) + (let* ((name (truncate-string-to-width (propertize (format "\\\\snippet `%s'" (yas--template-name p)) + 'yasnippet p) + 50 0 ? "...")) + (group (prog1 group + (setq group (make-string (length group) ? )))) + (condition-string (let ((condition (yas--template-condition p))) + (if (and condition + original-buffer) + (with-current-buffer original-buffer + (if (yas--eval-condition condition) + "(y)" + "(s)")) + "(a)"))) + (key-description-string (key-description (yas--template-keybinding p))) + (template-key-padding (if (string= key-description-string "") nil ? ))) + (insert group " " + condition-string " " + name (if (string-match "\\.\\.\\.$" name) + "'" " ") + " " + (truncate-string-to-width (or (yas--template-key p) "") + 15 0 template-key-padding "...") + (or template-key-padding "") + (truncate-string-to-width key-description-string + 15 0 nil "...") + "\n")))) groups-hash))) @@ -3024,12 +3012,14 @@ through the field's start point" ;; 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)))) @@ -3037,18 +3027,19 @@ through the field's start point" ;; 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. 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))))) @@ -3161,12 +3152,6 @@ Also create some protection overlays" (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.") @@ -3186,7 +3171,7 @@ This renders the snippet as ordinary text." (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 @@ -3398,13 +3383,28 @@ Move the overlay, or create it if it does not exit." (overlay-put yas--active-field-overlay 'insert-behind-hooks '(yas--on-field-overlay-modification)))) -(defun yas--on-field-overlay-modification (overlay after? _beg _end &optional _length) +(defun yas--skip-and-clear-field-p (field _beg _end &optional _length) + "Tell if newly modified FIELD should be cleared and skipped. +BEG, END and LENGTH like overlay modification hooks." + (and (not (yas--field-modified-p field)) + (= (point) (yas--field-start field)) + (require 'delsel) + ;; `yank' sets `this-command' to t during execution. + (let* ((command (if (commandp this-command) this-command + this-original-command)) + (clearp (if (symbolp command) (get command 'delete-selection)))) + (when (and (not (memq clearp '(yank supersede kill))) + (functionp clearp)) + (setq clearp (funcall clearp))) + clearp))) + +(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))) @@ -3414,11 +3414,7 @@ progress." (yas--field-update-display field)) (yas--update-mirrors snippet)) (field - (when (and (not after?) - (not (yas--field-modified-p field)) - (eq (point) (if (markerp (yas--field-start field)) - (marker-position (yas--field-start field)) - (yas--field-start field)))) + (when (yas--skip-and-clear-field-p field beg end) (yas--skip-and-clear field)) (setf (yas--field-modified-p field) t)))))) @@ -3428,16 +3424,9 @@ progress." ;; 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. @@ -3452,7 +3441,7 @@ Move the overlays, or create them if they do not exit." ;; (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 @@ -3471,23 +3460,17 @@ Move the overlays, or create them if they do not exit." ;; (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!$") @@ -3521,8 +3504,12 @@ The error should be ignored in `debug-ignored-errors'" "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) ;; @@ -3570,7 +3557,7 @@ considered when expanding the snippet." ;; 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 @@ -4028,11 +4015,10 @@ with their evaluated value into `yas--backquote-markers-and-strings'." (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'." @@ -4064,9 +4050,8 @@ When multiple expressions are found, only the last one counts." ;; 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 @@ -4254,7 +4239,7 @@ When multiple expressions are found, only the last one counts." (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)) @@ -4273,7 +4258,7 @@ When multiple expressions are found, only the last one counts." (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)) @@ -4286,10 +4271,7 @@ When multiple expressions are found, only the last one counts." ;; (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 @@ -4324,7 +4306,7 @@ When multiple expressions are found, only the last one counts." (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).")))) @@ -4464,6 +4446,11 @@ and return the directory. Return nil if not found." ;;; 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 @@ -4529,6 +4516,7 @@ and return the directory. Return nil if not found." 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