X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/f7ef023ebb746ee1597b20d6770fffd106c802f4..1b8f5b7a72c13d1daadc8af2ca6a27403830146d:/yasnippet.el diff --git a/yasnippet.el b/yasnippet.el index 821e74844..4514f1be3 100644 --- a/yasnippet.el +++ b/yasnippet.el @@ -1,13 +1,15 @@ ;;; 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-2016 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 +;; Package-Requires: ((cl-lib "0.5")) ;; EmacsWiki: YaSnippetMode ;; This program is free software: you can redistribute it and/or modify @@ -41,7 +43,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. ;; @@ -130,8 +132,7 @@ ;;; Code: (require 'cl) -(eval-and-compile - (require 'cl-lib)) +(require 'cl-lib) (require 'easymenu) (require 'help-mode) @@ -149,25 +150,34 @@ (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 + (expand-file-name "snippets" (file-name-directory load-file-name)))) + +(defconst yas--default-user-snippets-dir + (expand-file-name "snippets" user-emacs-directory)) (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." - :type '(choice (string :tag "Single directory (string)") - (repeat :args (string) :tag "List of directories (strings)")) + (list yas--default-user-snippets-dir + '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 (directory :tag "Single directory") + (repeat :tag "List of directories" + (choice (directory) (variable)))) :group 'yasnippet :require 'yasnippet :set #'(lambda (symbol new) @@ -179,16 +189,25 @@ as the default for storing the user's new snippets." (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) (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. @@ -196,10 +215,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. @@ -275,7 +293,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)) @@ -328,11 +346,16 @@ Any other non-nil value, every submenu is listed." :group 'yasnippet) (defcustom yas-wrap-around-region nil - "If non-nil, snippet expansion wraps around selected region. - -The wrapping occurs just before the snippet's exit marker. This -can be overridden on a per-snippet basis." - :type 'boolean + "What to insert for snippet's $0 field. + +If set to a character, insert contents of corresponding register. +If non-nil insert region contents. This can be overridden on a +per-snippet basis. A value of `cua' is considered equivalent to +`?0' for backwards compatibility." + :type '(choice (character :tag "Insert from register") + (const t :tag "Insert region contents") + (const nil :tag "Don't insert anything") + (const cua)) ; backwards compat :group 'yasnippet) (defcustom yas-good-grace t @@ -445,10 +468,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. @@ -493,7 +516,7 @@ snippets returning the symbol 'force-in-comment in their conditions. (add-hook 'python-mode-hook - '(lambda () + (lambda () (setq yas-buffer-local-condition '(if (python-in-string/comment) '(require-snippet-condition . force-in-comment) @@ -507,15 +530,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.") @@ -545,7 +564,7 @@ snippet itself contains a condition that returns the symbol (defun yas--snippet-next-id () (let ((id yas--snippet-id-seed)) - (incf yas--snippet-id-seed) + (cl-incf yas--snippet-id-seed) id)) @@ -677,7 +696,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.") @@ -715,23 +734,26 @@ defined direct keybindings to the command yas--direct-keymaps)) yas--tables)) -(defun yas--modes-to-activate () - "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))))) +(defun yas--modes-to-activate (&optional mode) + "Compute list of mode symbols that are active for `yas-expand' and friends." + (defvar yas--dfs) ;We rely on dynbind. We could use `letrec' instead! + (let* ((explored (if mode (list mode) ; Building up list in reverse. + (cons major-mode (reverse yas--extra-modes)))) + (yas--dfs + (lambda (mode) + (cl-loop for neighbour + in (cl-list* (get mode 'derived-mode-parent) + ;; NOTE: `fboundp' check is redundant + ;; since Emacs 24.4. + (and (fboundp mode) (symbol-function mode)) + (gethash mode yas--parents)) + when (and neighbour + (not (memq neighbour explored)) + (symbolp neighbour)) + do (push neighbour explored) + (funcall yas--dfs neighbour))))) + (mapc yas--dfs explored) + (nreverse explored))) (defvar yas-minor-mode-hook nil "Hook run when `yas-minor-mode' is turned on.") @@ -762,8 +784,8 @@ Key bindings: ;; ;; Also install the post-command-hook. ;; - (add-hook 'emulation-mode-map-alists 'yas--direct-keymaps) - (add-hook 'post-command-hook 'yas--post-command-handler nil t) + (cl-pushnew 'yas--direct-keymaps emulation-mode-map-alists) + (add-hook 'post-command-hook #'yas--post-command-handler nil t) ;; Set the `yas--direct-%s' vars for direct keymap expansion ;; (dolist (mode (yas--modes-to-activate)) @@ -776,8 +798,9 @@ Key bindings: (t ;; Uninstall the direct keymaps and the post-command hook ;; - (remove-hook 'post-command-hook 'yas--post-command-handler t) - (remove-hook 'emulation-mode-map-alists 'yas--direct-keymaps)))) + (remove-hook 'post-command-hook #'yas--post-command-handler t) + (setq emulation-mode-map-alists + (remove 'yas--direct-keymaps emulation-mode-map-alists))))) (defun yas-activate-extra-mode (mode) "Activates the snippets for the given `mode' in the buffer. @@ -809,21 +832,20 @@ activate snippets associated with that mode." (remove mode yas--extra-modes))) -(defvar yas-dont-activate '(minibufferp) - "If non-nil don't let `yas-global-mode' affect some buffers. - -If a function of zero arguments, then its result is used. +(define-obsolete-variable-alias 'yas-dont-activate + 'yas-dont-activate-functions "0.9.2") +(defvar yas-dont-activate-functions (list #'minibufferp) + "Special hook to control which buffers `yas-global-mode' affects. +Functions are called with no argument, and should return non-nil to prevent +`yas-global-mode' from enabling yasnippet in this buffer. -If a list of functions, then all functions must return nil to -activate yas for this buffer. - -In Emacsen <= 23, this variable is buffer-local. Because +In Emacsen < 24, this variable is buffer-local. Because `yas-minor-mode-on' is called by `yas-global-mode' after executing the buffer's major mode hook, setting this variable there is an effective way to define exceptions to the \"global\" activation behaviour. -In Emacsen > 23, only the global value is used. To define +In Emacsen >= 24, only the global value is used. To define per-mode exceptions to the \"global\" activation behaviour, call `yas-minor-mode' with a negative argument directily in the major mode's hook.") @@ -835,14 +857,14 @@ mode's hook.") (defun yas-minor-mode-on () "Turn on YASnippet minor mode. -Honour `yas-dont-activate', which see." +Honour `yas-dont-activate-functions', which see." (interactive) - ;; Check `yas-dont-activate' - (unless (cond ((functionp yas-dont-activate) - (funcall yas-dont-activate)) - ((consp yas-dont-activate) - (some #'funcall yas-dont-activate)) - (yas-dont-activate)) + (unless (or + ;; The old behavior used for Emacs<24 was to set + ;; `yas-dont-activate-functions' to t buffer-locally. + (not (or (listp yas-dont-activate-functions) + (functionp yas-dont-activate-functions))) + (run-hook-with-args-until-success 'yas-dont-activate-functions)) (yas-minor-mode 1))) ;;;###autoload @@ -854,22 +876,26 @@ Honour `yas-dont-activate', which see." "Run `yas-reload-all' when `yas-global-mode' is on." (when yas-global-mode (yas-reload-all))) -(add-hook 'yas-global-mode-hook 'yas--global-mode-reload-with-jit-maybe) +(add-hook 'yas-global-mode-hook #'yas--global-mode-reload-with-jit-maybe) ;;; Major mode stuff (defvar yas--font-lock-keywords (append '(("^#.*$" . font-lock-comment-face)) - lisp-font-lock-keywords-2 + (with-temp-buffer + (ignore-errors (emacs-lisp-mode)) + (font-lock-set-defaults) + (if (eq t (car-safe font-lock-keywords)) + ;; They're "compiled", so extract the source. + (cadr font-lock-keywords) + font-lock-keywords)) '(("$\\([0-9]+\\)" (0 font-lock-keyword-face) (1 font-lock-string-face t)) ("${\\([0-9]+\\):?" (0 font-lock-keyword-face) (1 font-lock-warning-face t)) - ("${" . font-lock-keyword-face) - ("$[0-9]+?" . font-lock-preprocessor-face) ("\\(\\$(\\)" 1 font-lock-preprocessor-face) ("}" (0 font-lock-keyword-face))))) @@ -891,6 +917,7 @@ Honour `yas-dont-activate', which see." "The keymap used when `snippet-mode' is active.") +;;;###autoload (define-derived-mode snippet-mode text-mode "Snippet" "A mode for editing yasnippets" (setq font-lock-defaults '(yas--font-lock-keywords)) @@ -902,14 +929,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 @@ -918,16 +970,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. @@ -1079,7 +1121,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)) @@ -1088,7 +1131,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." @@ -1243,12 +1287,15 @@ 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 templates - (mapcan #'(lambda (table) - (yas--fetch table (buffer-substring-no-properties (point) - original))) - (yas--get-snippet-tables)))) + (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) + (setq templates + (mapcan #'(lambda (table) + (yas--fetch table possible-key)) + (yas--get-snippet-tables)))))) (when templates (list templates (point) original))))) @@ -1267,16 +1314,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)))) @@ -1325,7 +1362,7 @@ return an expression that when evaluated will issue an error." (read-kbd-macro keybinding 'need-vector)))) res) (error - (yas--message 3 "warning: keybinding \"%s\" invalid since %s." + (yas--message 2 "warning: keybinding \"%s\" invalid since %s." keybinding (error-message-string err)) nil)))) @@ -1341,15 +1378,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. @@ -1364,16 +1403,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 @@ -1388,7 +1417,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: @@ -1425,7 +1454,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)) @@ -1460,10 +1489,7 @@ Here's a list of currently recognized directives: (let* ((dominating-dir (locate-dominating-file file ".yas-make-groups")) (extra-path (and dominating-dir - (replace-regexp-in-string (concat "^" - (expand-file-name dominating-dir)) - "" - (expand-file-name file)))) + (file-relative-name file dominating-dir))) (extra-dir (and extra-path (file-name-directory extra-path))) (group (and extra-dir @@ -1474,17 +1500,17 @@ Here's a list of currently recognized directives: (defun yas--subdirs (directory &optional filep) "Return subdirs or files of DIRECTORY according to FILEP." - (remove-if (lambda (file) - (or (string-match "^\\." - (file-name-nondirectory file)) - (string-match "^#.*#$" - (file-name-nondirectory file)) - (string-match "~$" - (file-name-nondirectory file)) - (if filep - (file-directory-p file) - (not (file-directory-p file))))) - (directory-files directory t))) + (cl-remove-if (lambda (file) + (or (string-match "\\`\\." + (file-name-nondirectory file)) + (string-match "\\`#.*#\\'" + (file-name-nondirectory file)) + (string-match "~\\'" + (file-name-nondirectory file)) + (if filep + (file-directory-p file) + (not (file-directory-p file))))) + (directory-files directory t))) (defun yas--make-menu-binding (template) (let ((mode (yas--table-mode (yas--template-table template)))) @@ -1552,6 +1578,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) @@ -1566,11 +1595,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) @@ -1604,43 +1635,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. @@ -1648,7 +1646,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. @@ -1670,33 +1668,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)) @@ -1708,13 +1692,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 3 "%s has no load file, using 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 4)) (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)))))) @@ -1736,36 +1729,44 @@ With prefix argument USE-JIT do jit-loading of snippets." 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 4 "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))) @@ -1781,10 +1782,10 @@ With prefix argument USE-JIT do jit-loading of snippets." (insert (format ";;; Do not edit! File generated at %s\n" (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 (file-exists-p (expand-file-name ".yas-skip" directory)) + (unless (and (load (expand-file-name ".yas-compiled-snippets" directory) 'noerror (<= yas-verbosity 3)) + (progn (yas--message 4 "Loaded compiled snippets from %s" directory) t)) + (yas--message 4 "Loading snippet files from %s" directory) (yas--load-directory-2 directory mode-sym))))) (defun yas--load-directory-2 (directory mode-sym) @@ -1814,16 +1815,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 4 "Loaded %s" directory) + (yas--message 4 "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) @@ -1886,9 +1889,9 @@ prefix argument." (yas-direct-keymaps-reload) (run-hooks 'yas-after-reload-hook) - (yas--message 3 "Reloaded everything%s...%s." - (if no-jit "" " (snippets will load just-in-time)") - (if errors " (some errors, check *Messages*)" ""))))) + (yas--message (if errors 2 3) "Reloaded everything%s...%s." + (if no-jit "" " (snippets will load just-in-time)") + (if errors " (some errors, check *Messages*)" ""))))) (defvar yas-after-reload-hook nil "Hooks run after `yas-reload-all'.") @@ -1898,7 +1901,7 @@ prefix argument." (let ((funs (reverse (gethash mode yas--scheduled-jit-loads)))) ;; must reverse to maintain coherence with `yas-snippet-dirs' (dolist (fun funs) - (yas--message 3 "Loading for `%s', just-in-time: %s!" mode fun) + (yas--message 4 "Loading for `%s', just-in-time: %s!" mode fun) (funcall fun)) (remhash mode yas--scheduled-jit-loads)))) @@ -1917,10 +1920,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. @@ -1953,12 +1952,12 @@ This works by stubbing a few functions, then calling (interactive) (message (concat "yasnippet (version " yas--version - ") -- pluskid /joaotavora "))) + ") -- pluskid/joaotavora/npostavs"))) ;;; Apropos snippet menu: ;; -;; The snippet menu keymaps are store by mode in hash table called +;; The snippet menu keymaps are stored by mode in hash table called ;; `yas--menu-table'. They are linked to the main menu in ;; `yas--menu-keymap-get-create' and are initially created empty, ;; reflecting the table hierarchy. @@ -1980,9 +1979,9 @@ This works by stubbing a few functions, then calling ;; duplicate entries. The `yas--template' objects are created in ;; `yas-define-menu', holding nothing but the menu entry, ;; represented by a pair of ((menu-item NAME :keys KEYS) TYPE) and -;; stored in `yas--template-menu-binding-pair'. The (menu-item ...) +;; stored in `yas--template-menu-binding-pair'. The (menu-item ...) ;; part is then stored in the menu keymap itself which make the item -;; appear to the user. These limitations could probably be revised. +;; appear to the user. These limitations could probably be revised. ;; ;; * The `yas--template-perm-group' slot is only used in ;; `yas-describe-tables'. @@ -2065,11 +2064,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) @@ -2077,12 +2075,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) @@ -2098,7 +2096,7 @@ omitted from MODE's menu, even if they're manually loaded." (define-key menu-keymap (vector (gensym)) '(menu-item "----"))) (t - (yas--message 3 "Don't know anything about menu entry %s" (first e)))))) + (yas--message 1 "Don't know anything about menu entry %s" (first e)))))) (defun yas--define (mode key template &optional name condition group) "Define a snippet. Expanding KEY into TEMPLATE. @@ -2172,9 +2170,13 @@ object satisfying `yas--field-p' to restrict the expansion to." (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)) + (yas--expand-or-prompt-for-template + (nth 0 templates-and-pos) + ;; Delete snippet key and active region when expanding. + (min (if (use-region-p) (region-beginning) most-positive-fixnum) + (nth 1 templates-and-pos)) + (max (if (use-region-p) (region-end) most-negative-fixnum) + (nth 2 templates-and-pos))) (yas--fallback)))) (defun yas-expand-from-keymap () @@ -2224,28 +2226,42 @@ Common gateway for `yas-expand-from-trigger-key' and (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) + (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))) - (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))) @@ -2297,6 +2313,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'. @@ -2321,7 +2359,7 @@ by condition." (car where) (cdr where) (yas--template-expand-env yas--current-template)) - (yas--message 3 "No snippets can be inserted here!")))) + (yas--message 1 "No snippets can be inserted here!")))) (defun yas-visit-snippet-file () "Choose a snippet to edit, selection like `yas-insert-snippet'. @@ -2331,7 +2369,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: ") @@ -2343,7 +2380,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) @@ -2386,13 +2423,11 @@ tables (or optional TABLE). Returns a list of elements (TABLE . DIRS) where TABLE is a `yas--table' object and DIRS is a list of all possible directories 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"))))))) - (tables (or (and table - (list table)) - (yas--get-snippet-tables)))) + (let ((main-dir (car (or (yas-snippet-dirs) + (setq yas-snippet-dirs + (list yas--default-user-snippets-dir))))) + (tables (if table (list table) + (yas--get-snippet-tables)))) ;; HACK! the snippet table created here is actually registered! ;; (unless (or table (gethash major-mode yas--tables)) @@ -2402,7 +2437,7 @@ where snippets of table might exist." (mapcar #'(lambda (table) (cons table (mapcar #'(lambda (subdir) - (concat main-dir "/" subdir)) + (expand-file-name subdir main-dir)) (yas--guess-snippet-directories-1 table)))) tables))) @@ -2507,17 +2542,15 @@ neither do the elements of PARENTS." (defun yas-load-snippet-buffer (table &optional interactive) "Parse and load current buffer's snippet definition into TABLE. - -TABLE is a symbol naming a passed to `yas--table-get-create'. - -When called interactively, prompt for the table name." +TABLE is a symbol name passed to `yas--table-get-create'. When +called interactively, prompt for the table name." (interactive (list (yas--read-table) t)) (cond ;; We have `yas--editing-template', this buffer's content comes from a ;; 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' @@ -2535,11 +2568,10 @@ When called interactively, prompt for the table name." (yas--table-name (yas--template-table yas--editing-template))))) (defun yas-load-snippet-buffer-and-close (table &optional kill) - "Load the snippet with `yas-load-snippet-buffer', possibly - save, then `quit-window' if saved. - -If the snippet is new, ask the user whether (and where) to save -it. If the snippet already has a file, just save it. + "Load and save the snippet, then `quit-window' if saved. +Loading is performed by `yas-load-snippet-buffer'. If the +snippet is new, ask the user whether (and where) to save it. If +the snippet already has a file, just save it. The prefix argument KILL is passed to `quit-window'. @@ -2547,29 +2579,28 @@ 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 (expand-file-name + (read-file-name (format "File name to create in %s? " chosen) + chosen default-file-name) + chosen)) + (setf (yas--template-load-file yas--editing-template) buffer-file-name)))))) (when buffer-file-name (save-buffer) (quit-window kill))) @@ -2587,12 +2618,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 (nth 0 parsed) + :content (nth 1 parsed) + :name (nth 2 parsed) + :expand-env (nth 5 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)) @@ -2609,7 +2639,7 @@ and `kill-buffer' instead." (require 'yasnippet-debug nil t)) (add-hook 'post-command-hook 'yas-debug-snippet-vars nil t)))) (t - (yas--message 3 "Cannot test snippet for unknown major mode"))))) + (yas--message 1 "Cannot test snippet for unknown major mode"))))) (defun yas-active-keys () "Return all active trigger keys for current buffer and point." @@ -2642,7 +2672,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)) @@ -2698,31 +2728,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))) @@ -2935,7 +2966,6 @@ If there is a transform but it returns nil, return the empty string iff EMPTY-ON-NIL-P is true." (let* ((yas-text (yas--field-text-for-display field)) (yas-modified-p (yas--field-modified-p field)) - (yas-moving-away-p nil) (transform (if (yas--mirror-p field-or-mirror) (yas--mirror-transform field-or-mirror) (yas--field-transform field-or-mirror))) @@ -2994,12 +3024,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)))) @@ -3007,18 +3039,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))))) @@ -3035,38 +3068,41 @@ Otherwise delegate to `yas-next-field'." (yas-next-field)))) (yas-next-field))) +(defun yas-next-field-will-exit-p (&optional arg) + "Return non-nil if (yas-next-field ARG) would exit the current snippet." + (let ((snippet (car (yas--snippets-at-point))) + (active (overlay-get yas--active-field-overlay 'yas--field))) + (when snippet + (not (yas--find-next-field arg snippet active))))) + +(defun yas--find-next-field (n snippet active) + "Return the Nth field after the ACTIVE one in SNIPPET." + (let ((live-fields (cl-remove-if + (lambda (field) + (and (not (eq field active)) + (yas--field-probably-deleted-p snippet field))) + (yas--snippet-fields snippet)))) + (if (>= n 0) (nth n (memq active live-fields)) + (car (last (memq active (reverse live-fields)) (- n)))))) + (defun yas-next-field (&optional arg) "Navigate to the ARGth next field. If there's none, exit the snippet." (interactive) - (let* ((arg (or arg - 1)) - (snippet (first (yas--snippets-at-point))) + (unless arg (setq arg 1)) + (let* ((snippet (car (yas--snippets-at-point))) (active-field (overlay-get yas--active-field-overlay 'yas--field)) - (live-fields (remove-if #'(lambda (field) - (and (not (eq field active-field)) - (yas--field-probably-deleted-p snippet field))) - (yas--snippet-fields snippet))) - (active-field-pos (position active-field live-fields)) - (target-pos (and active-field-pos (+ arg active-field-pos))) - (target-field (and target-pos (nth target-pos live-fields)))) - ;; First check if we're moving out of a field with a transform - ;; - (when (and active-field - (yas--field-transform active-field)) - (let* ((yas-moving-away-p t) - (yas-text (yas--field-text-for-display active-field)) - (yas-modified-p (yas--field-modified-p active-field))) - ;; primary field transform: exit call to field-transform - (yas--eval-lisp (yas--field-transform active-field)))) + (target-field (yas--find-next-field arg snippet active-field))) + ;; Apply transform to active field. + (when active-field + (let ((yas-moving-away-p t)) + (when (yas--field-update-display active-field) + (yas--update-mirrors snippet)))) ;; Now actually move... - (cond ((and target-pos (>= target-pos (length live-fields))) - (yas-exit-snippet snippet)) - (target-field - (yas--move-to-field snippet target-field)) - (t - nil)))) + (if target-field + (yas--move-to-field snippet target-field) + (yas-exit-snippet snippet)))) (defun yas--place-overlays (snippet field) "Correctly place overlays for SNIPPET's FIELD." @@ -3131,12 +3167,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.") @@ -3156,7 +3186,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 @@ -3189,7 +3219,7 @@ This renders the snippet as ordinary text." (condition-case error (run-hooks hook-var) (error - (yas--message 3 "%s error: %s" hook-var (error-message-string error))))) + (yas--message 2 "%s error: %s" hook-var (error-message-string error))))) (defun yas--check-commit-snippet () @@ -3326,15 +3356,17 @@ Otherwise deletes a character normally by calling `delete-char'." (t (call-interactively 'delete-char))))) -(defun yas--skip-and-clear (field) - "Deletes the region of FIELD and sets it's modified state to t." +(defun yas--skip-and-clear (field &optional from) + "Deletes the region of FIELD and sets it's modified state to t. +If given, FROM indicates position to start at instead of FIELD's beginning." ;; Just before skipping-and-clearing the field, mark its children ;; fields as modified, too. If the children have mirrors-in-fields ;; this prevents them from updating erroneously (we're skipping and ;; deleting!). ;; (yas--mark-this-and-children-modified field) - (delete-region (yas--field-start field) (yas--field-end field))) + (unless (= (yas--field-start field) (yas--field-end field)) + (delete-region (or from (yas--field-start field)) (yas--field-end field)))) (defun yas--mark-this-and-children-modified (field) (setf (yas--field-modified-p field) t) @@ -3368,29 +3400,33 @@ 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 length) + "Tell if newly modified FIELD should be cleared and skipped. +BEG, END and LENGTH like overlay modification hooks." + (and (= length 0) ; A 0 pre-change length indicates insertion. + (= beg (yas--field-start field)) ; Insertion at field start? + (not (yas--field-modified-p field)))) + +(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." - (unless (or yas--inhibit-overlay-hooks +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 (not after?) + 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)) + (let* ((inhibit-modification-hooks t) + (field (overlay-get overlay 'yas--field)) (snippet (overlay-get yas--active-field-overlay 'yas--snippet))) - (cond (after? - (yas--advance-end-maybe field (overlay-end overlay)) - (save-excursion - (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)))) - (yas--skip-and-clear field)) - (setf (yas--field-modified-p field) t)))))) + (when (yas--skip-and-clear-field-p field beg end length) + ;; We delete text starting from the END of insertion. + (yas--skip-and-clear field end)) + (setf (yas--field-modified-p field) t) + (yas--advance-end-maybe field (overlay-end overlay)) + (save-excursion + (yas--field-update-display field)) + (yas--update-mirrors snippet)))) ;;; Apropos protection overlays: ;; @@ -3398,16 +3434,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. @@ -3422,7 +3451,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 @@ -3441,23 +3470,16 @@ 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!"))))) +(defun yas--on-protection-overlay-modification (_overlay after? beg end &optional length) + "Commit the snippet if the protection overlay is being killed." + (unless (or yas--inhibit-overlay-hooks + (not after?) + (= length (- end beg)) ; deletion or insertion + (yas--undo-in-progress)) + (let ((snippets (yas--snippets-at-point))) + (yas--message 2 "Committing 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!$") @@ -3491,8 +3513,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) ;; @@ -3540,14 +3566,21 @@ 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) + ;; Avoid major-mode's syntax propertizing function, + ;; since we mess with the syntax-table and also + ;; insert things that are not valid in the + ;; major-mode language syntax anyway. + (syntax-propertize-function nil)) (setq snippet (if expand-env (eval `(let* ,expand-env (insert content) (yas--snippet-create start (point)))) (insert content) - (yas--snippet-create start (point)))))) + (yas--snippet-create start (point))))) + ;; Invalidate any syntax-propertizing done while `syntax-propertize-function' was nil + (syntax-ppss-flush-cache start)) ;; stacked-expansion: This checks for stacked expansion, save the ;; `yas--previous-active-field' and advance its boundary. @@ -3587,7 +3620,7 @@ considered when expanding the snippet." (when first-field (sit-for 0) ;; fix issue 125 (yas--move-to-field snippet first-field))) - (yas--message 3 "snippet expanded.") + (yas--message 4 "snippet expanded.") t)))) (defun yas--take-care-of-redo (_beg _end snippet) @@ -3794,6 +3827,9 @@ cons cells to this var.") backquoted Lisp expressions should be inserted at the end of expansion.") +(defvar yas--indent-markers nil + "List of markers for manual indentation.") + (defun yas--snippet-parse-create (snippet) "Parse a recently inserted snippet template, creating all necessary fields, mirrors and exit points. @@ -3813,6 +3849,9 @@ Meant to be called in a narrowed buffer, does various passes" ;; protect escaped characters ;; (yas--protect-escapes) + ;; Parse indent markers: `$>'. + (goto-char parse-start) + (yas--indent-parse-create snippet) ;; parse fields with {} ;; (goto-char parse-start) @@ -3830,7 +3869,22 @@ Meant to be called in a narrowed buffer, does various passes" (yas--calculate-adjacencies snippet) ;; Delete $-constructs ;; - (save-restriction (widen) (yas--delete-regions yas--dollar-regions)) + (save-restriction + (widen) + (yas--delete-regions yas--dollar-regions)) + ;; Make sure to do this insertion *after* deleting the dollar + ;; regions, otherwise we invalidate the calculated positions of + ;; all the fields following $0. + (let ((exit (yas--snippet-exit snippet))) + (goto-char (if exit (yas--exit-marker exit) (point-max)))) + (when (eq yas-wrap-around-region 'cua) + (setq yas-wrap-around-region ?0)) + (cond ((and yas-wrap-around-region yas-selected-text) + (insert yas-selected-text)) + ((and (characterp yas-wrap-around-region) + (get-register yas-wrap-around-region)) + (insert (prog1 (get-register yas-wrap-around-region) + (set-register yas-wrap-around-region nil))))) ;; restore backquoted expression values ;; (yas--restore-backquotes) @@ -3846,8 +3900,9 @@ Meant to be called in a narrowed buffer, does various passes" (goto-char parse-start) (yas--indent snippet))) -(defun yas--indent-according-to-mode (snippet-markers) - "Indent current line according to mode, preserving SNIPPET-MARKERS." +(defun yas--indent-region (from to snippet) + "Indent the lines between FROM and TO with `indent-according-to-mode'. +The SNIPPET's markers are preserved." ;;; Apropos indenting problems.... ;; ;; `indent-according-to-mode' uses whatever `indent-line-function' @@ -3860,54 +3915,54 @@ Meant to be called in a narrowed buffer, does various passes" ;; `front-advance' property set to nil. ;; ;; This is why I have these `trouble-markers', they are the ones at - ;; they are the ones at the first non-whitespace char at the line - ;; (i.e. at `yas--real-line-beginning'. After indentation takes place - ;; we should be at the correct to restore them to. All other - ;; non-trouble-markers have been *pushed* and don't need special - ;; attention. - ;; - (goto-char (yas--real-line-beginning)) - (let ((trouble-markers (remove-if-not #'(lambda (marker) - (= marker (point))) - snippet-markers))) - (save-restriction - (widen) - (condition-case _ - (indent-according-to-mode) - (error (yas--message 3 "Warning: `yas--indent-according-to-mode' having problems running %s" indent-line-function) - nil))) - (mapc #'(lambda (marker) - (set-marker marker (point))) - trouble-markers))) + ;; the first non-whitespace char at the line. After indentation + ;; takes place we should be at the correct to restore them. All + ;; other non-trouble-markers should have been *pushed* and don't + ;; need special attention. + (let* ((snippet-markers (yas--collect-snippet-markers snippet)) + (to (set-marker (make-marker) to))) + (save-excursion + (goto-char from) + (save-restriction + (widen) + ;; Indent each non-empty line. + (cl-loop if (/= (line-beginning-position) (line-end-position)) do + (back-to-indentation) + (let ((trouble-markers ; The markers at (point). + (cl-remove (point) snippet-markers :test #'/=))) + (unwind-protect + (indent-according-to-mode) + (dolist (marker trouble-markers) + (set-marker marker (point))))) + while (and (zerop (forward-line 1)) + (< (point) to))))))) (defvar yas--indent-original-column nil) (defun yas--indent (snippet) - (let ((snippet-markers (yas--collect-snippet-markers snippet))) - ;; Look for those $> - (save-excursion - (while (re-search-forward "$>" nil t) - (delete-region (match-beginning 0) (match-end 0)) - (when (not (eq yas-indent-line 'auto)) - (yas--indent-according-to-mode snippet-markers)))) - ;; Now do stuff for 'fixed and 'auto - (save-excursion - (cond ((eq yas-indent-line 'fixed) - (while (and (zerop (forward-line)) - (zerop (current-column))) - (indent-to-column yas--indent-original-column))) - ((eq yas-indent-line 'auto) - (let ((end (set-marker (make-marker) (point-max))) - (indent-first-line-p yas-also-auto-indent-first-line)) - (while (and (zerop (if indent-first-line-p - (prog1 - (forward-line 0) - (setq indent-first-line-p nil)) - (forward-line 1))) - (not (eobp)) - (<= (point) end)) - (yas--indent-according-to-mode snippet-markers)))) - (t - nil))))) + ;; Indent lines that had indent markers (`$>') on them. + (save-excursion + (dolist (marker yas--indent-markers) + (unless (eq yas-indent-line 'auto) + (goto-char marker) + (yas--indent-region (line-beginning-position) + (line-end-position) + snippet)) + ;; Finished with this marker. + (set-marker marker nil)) + (setq yas--indent-markers nil)) + ;; Now do stuff for `fixed' and `auto'. + (save-excursion + (cond ((eq yas-indent-line 'fixed) + (while (and (zerop (forward-line)) + (zerop (current-column))) + (indent-to-column yas--indent-original-column))) + ((eq yas-indent-line 'auto) + (let ((end (set-marker (make-marker) (point-max)))) + (unless yas-also-auto-indent-first-line + (forward-line 1)) + (yas--indent-region (line-beginning-position) + (point-max) + snippet)))))) (defun yas--collect-snippet-markers (snippet) "Make a list of all the markers used by SNIPPET." @@ -3924,15 +3979,6 @@ Meant to be called in a narrowed buffer, does various passes" (push (yas--exit-marker snippet-exit) markers))) markers)) -(defun yas--real-line-beginning () - (let ((c (char-after (line-beginning-position))) - (n (line-beginning-position))) - (while (or (eql c ?\ ) - (eql c ?\t)) - (incf n) - (setq c (char-after n))) - n)) - (defun yas--escape-string (escaped) (concat "YASESCAPE" (format "%d" escaped) "PROTECTGUARD")) @@ -3998,11 +4044,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'." @@ -4010,6 +4055,16 @@ with their evaluated value into `yas--backquote-markers-and-strings'." (set-marker-insertion-type marker nil) marker)) +(defun yas--indent-parse-create (snippet) + "Parse the \"$>\" indentation markers in SNIPPET." + (setq yas--indent-markers ()) + (while (search-forward "$>" nil t) + (delete-region (match-beginning 0) (match-end 0)) + ;; Mark the beginning of the line. + (push (yas--make-marker (line-beginning-position)) + yas--indent-markers)) + (setq yas--indent-markers (nreverse yas--indent-markers))) + (defun yas--field-parse-create (snippet &optional parent-field) "Parse most field expressions in SNIPPET, except for the simple one \"$n\". @@ -4034,9 +4089,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 @@ -4113,21 +4167,10 @@ When multiple expressions are found, only the last one counts." (while (re-search-forward yas--simple-mirror-regexp nil t) (let ((number (string-to-number (match-string-no-properties 1)))) (cond ((zerop number) - (setf (yas--snippet-exit snippet) (yas--make-exit (yas--make-marker (match-end 0)))) - (save-excursion - (goto-char (match-beginning 0)) - (when yas-wrap-around-region - (cond (yas-selected-text - (insert yas-selected-text)) - ((and (eq yas-wrap-around-region 'cua) - cua-mode - (get-register ?0)) - (insert (prog1 (get-register ?0) - (set-register ?0 nil)))))) - (push (cons (point) (yas--exit-marker (yas--snippet-exit snippet))) - yas--dollar-regions))) + (push (cons (match-beginning 0) (yas--exit-marker (yas--snippet-exit snippet))) + yas--dollar-regions)) (t (let ((field (yas--snippet-find-field snippet number))) (if field @@ -4176,43 +4219,45 @@ When multiple expressions are found, only the last one counts." (defun yas--update-mirrors (snippet) "Update all the mirrors of SNIPPET." - (save-excursion - (dolist (field-and-mirror (sort - ;; make a list of ((F1 . M1) (F1 . M2) (F2 . M3) (F2 . M4) ...) - ;; where F is the field that M is mirroring - ;; - (mapcan #'(lambda (field) - (mapcar #'(lambda (mirror) - (cons field mirror)) - (yas--field-mirrors field))) - (yas--snippet-fields snippet)) - ;; then sort this list so that entries with mirrors with parent - ;; fields appear before. This was important for fixing #290, and - ;; luckily also handles the case where a mirror in a field causes - ;; another mirror to need reupdating - ;; - #'(lambda (field-and-mirror1 field-and-mirror2) - (> (yas--calculate-mirror-depth (cdr field-and-mirror1)) - (yas--calculate-mirror-depth (cdr field-and-mirror2)))))) - (let* ((field (car field-and-mirror)) - (mirror (cdr field-and-mirror)) - (parent-field (yas--mirror-parent-field mirror))) - ;; before updating a mirror with a parent-field, maybe advance - ;; its start (#290) - ;; - (when parent-field - (yas--advance-start-maybe mirror (yas--fom-start parent-field))) - ;; update this mirror - ;; - (yas--mirror-update-display mirror field) - ;; `yas--place-overlays' is needed if the active field and - ;; protected overlays have been changed because of insertions - ;; in `yas--mirror-update-display' - ;; - (when (eq field (yas--snippet-active-field snippet)) - (yas--place-overlays snippet field)))))) - -(defun yas--mirror-update-display (mirror field) + (save-restriction + (widen) + (save-excursion + (dolist (field-and-mirror + (sort + ;; make a list of ((F1 . M1) (F1 . M2) (F2 . M3) (F2 . M4) ...) + ;; where F is the field that M is mirroring + ;; + (cl-mapcan #'(lambda (field) + (mapcar #'(lambda (mirror) + (cons field mirror)) + (yas--field-mirrors field))) + (yas--snippet-fields snippet)) + ;; then sort this list so that entries with mirrors with parent + ;; fields appear before. This was important for fixing #290, and + ;; luckily also handles the case where a mirror in a field causes + ;; another mirror to need reupdating + ;; + #'(lambda (field-and-mirror1 field-and-mirror2) + (> (yas--calculate-mirror-depth (cdr field-and-mirror1)) + (yas--calculate-mirror-depth (cdr field-and-mirror2)))))) + (let* ((field (car field-and-mirror)) + (mirror (cdr field-and-mirror)) + (parent-field (yas--mirror-parent-field mirror))) + ;; before updating a mirror with a parent-field, maybe advance + ;; its start (#290) + ;; + (when parent-field + (yas--advance-start-maybe mirror (yas--fom-start parent-field))) + ;; update this mirror + ;; + (yas--mirror-update-display mirror field snippet) + ;; `yas--place-overlays' is needed since the active field and + ;; protected overlays might have been changed because of insertions + ;; in `yas--mirror-update-display'. + (let ((active-field (yas--snippet-active-field snippet))) + (when active-field (yas--place-overlays snippet active-field)))))))) + +(defun yas--mirror-update-display (mirror field snippet) "Update MIRROR according to FIELD (and mirror transform)." (let* ((mirror-parent-field (yas--mirror-parent-field mirror)) @@ -4224,14 +4269,18 @@ 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)) (set-marker (yas--mirror-end mirror) (point)) (yas--advance-start-maybe (yas--mirror-next mirror) (point)) ;; super-special advance - (yas--advance-end-of-parents-maybe mirror-parent-field (point)))))) + (yas--advance-end-of-parents-maybe mirror-parent-field (point))) + (let ((yas--inhibit-overlay-hooks t)) + (yas--indent-region (yas--mirror-start mirror) + (yas--mirror-end mirror) + snippet))))) (defun yas--field-update-display (field) "Much like `yas--mirror-update-display', but for fields." @@ -4243,7 +4292,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)) @@ -4256,10 +4305,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 @@ -4294,7 +4340,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).")))) @@ -4308,7 +4354,7 @@ object satisfying `yas--field-p' to restrict the expansion to."))) '(yas--expand-from-keymap-doc t)) (defun yas--expand-from-keymap-doc (context) "A doc synthesizer for `yas--expand-from-keymap-doc'." - (add-hook 'temp-buffer-show-hook 'yas--snippet-description-finish-runonce) + (add-hook 'temp-buffer-show-hook #'yas--snippet-description-finish-runonce) (concat "Expand/run snippets from keymaps, possibly falling back to original binding.\n" (when (and context (eq this-command 'describe-key)) (let* ((vec (this-single-command-keys)) @@ -4343,7 +4389,8 @@ object satisfying `yas--field-p' to restrict the expansion to."))) (defun yas--snippet-description-finish-runonce () "Final adjustments for the help buffer when snippets are concerned." (yas--create-snippet-xrefs) - (remove-hook 'temp-buffer-show-hook 'yas--snippet-description-finish-runonce)) + (remove-hook 'temp-buffer-show-hook + #'yas--snippet-description-finish-runonce)) (defun yas--create-snippet-xrefs () (save-excursion @@ -4353,12 +4400,12 @@ object satisfying `yas--field-p' to restrict the expansion to."))) 'yasnippet))) (when template (help-xref-button 1 'help-snippet-def template) - (kill-region (match-end 1) (match-end 0)) - (kill-region (match-beginning 0) (match-beginning 1))))))) + (delete-region (match-end 1) (match-end 0)) + (delete-region (match-beginning 0) (match-beginning 1))))))) ;;; Utils -(defvar yas-verbosity 4 +(defvar yas-verbosity 3 "Log level for `yas--message' 4 means trace most anything, 0 means nothing.") (defun yas--message (level message &rest args) @@ -4434,6 +4481,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 @@ -4499,6 +4551,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 @@ -4544,7 +4597,7 @@ and return the directory. Return nil if not found." They are mapped to \"yas/*\" variants.") (dolist (sym yas--backported-syms) - (let ((backported (intern (replace-regexp-in-string "^yas-" "yas/" (symbol-name sym))))) + (let ((backported (intern (replace-regexp-in-string "\\`yas-" "yas/" (symbol-name sym))))) (when (boundp sym) (make-obsolete-variable backported sym "yasnippet 0.8") (defvaralias backported sym)) @@ -4559,7 +4612,7 @@ They are mapped to \"yas/*\" variants.") (not (get atom 'byte-obsolete-variable))) (and (fboundp atom) (not (get atom 'byte-obsolete-info)))) - (string-match-p "^yas-[^-]" (symbol-name atom))) + (string-match-p "\\`yas-[^-]" (symbol-name atom))) (push atom exported)))) exported) "Exported yasnippet symbols. @@ -4570,9 +4623,9 @@ can more or less safely rely upon them.") (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