config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

yasnippet.el (216926B)


      1 ;;; yasnippet.el --- Yet another snippet extension for Emacs  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2008-2024 Free Software Foundation, Inc.
      4 ;; Authors: pluskid <pluskid@gmail.com>,
      5 ;;          João Távora <joaotavora@gmail.com>,
      6 ;;          Noam Postavsky <npostavs@gmail.com>
      7 ;; Maintainer: Noam Postavsky <npostavs@gmail.com>
      8 ;; Version: 0.14.1
      9 ;; X-URL: http://github.com/joaotavora/yasnippet
     10 ;; Keywords: convenience, emulation
     11 ;; URL: http://github.com/joaotavora/yasnippet
     12 ;; Package-Requires: ((cl-lib "0.5") (emacs "24.4"))
     13 ;; EmacsWiki: YaSnippetMode
     14 
     15 ;; This program is free software: you can redistribute it and/or modify
     16 ;; it under the terms of the GNU General Public License as published by
     17 ;; the Free Software Foundation, either version 3 of the License, or
     18 ;; (at your option) any later version.
     19 
     20 ;; This program is distributed in the hope that it will be useful,
     21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     23 ;; GNU General Public License for more details.
     24 
     25 ;; You should have received a copy of the GNU General Public License
     26 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     27 
     28 ;;; Commentary:
     29 ;;
     30 ;;   Basic steps to setup:
     31 ;;
     32 ;;    (add-to-list 'load-path
     33 ;;                 "~/path-to-yasnippet")
     34 ;;    (require 'yasnippet)
     35 ;;    (yas-global-mode 1)
     36 ;;
     37 ;;
     38 ;;   Interesting variables are:
     39 ;;
     40 ;;       `yas-snippet-dirs'
     41 ;;
     42 ;;           The directory where user-created snippets are to be
     43 ;;           stored.  Can also be a list of directories.  In that case,
     44 ;;           when used for bulk (re)loading of snippets (at startup or
     45 ;;           via `yas-reload-all'), directories appearing earlier in
     46 ;;           the list override other dir's snippets.  Also, the first
     47 ;;           directory is taken as the default for storing the user's
     48 ;;           new snippets.
     49 ;;
     50 ;;           The deprecated `yas/root-directory' aliases this variable
     51 ;;           for backward-compatibility.
     52 ;;
     53 ;;
     54 ;;   Major commands are:
     55 ;;
     56 ;;       M-x yas-expand
     57 ;;
     58 ;;           Try to expand snippets before point.  In `yas-minor-mode',
     59 ;;           this is normally bound to TAB, but you can customize it in
     60 ;;           `yas-minor-mode-map'.
     61 ;;
     62 ;;       M-x yas-load-directory
     63 ;;
     64 ;;           Prompts you for a directory hierarchy of snippets to load.
     65 ;;
     66 ;;       M-x yas-activate-extra-mode
     67 ;;
     68 ;;           Prompts you for an extra mode to add snippets for in the
     69 ;;           current buffer.
     70 ;;
     71 ;;       M-x yas-insert-snippet
     72 ;;
     73 ;;           Prompts you for possible snippet expansion if that is
     74 ;;           possible according to buffer-local and snippet-local
     75 ;;           expansion conditions.  With prefix argument, ignore these
     76 ;;           conditions.
     77 ;;
     78 ;;       M-x yas-visit-snippet-file
     79 ;;
     80 ;;           Prompts you for possible snippet expansions like
     81 ;;           `yas-insert-snippet', but instead of expanding it, takes
     82 ;;           you directly to the snippet definition's file, if it
     83 ;;           exists.
     84 ;;
     85 ;;       M-x yas-new-snippet
     86 ;;
     87 ;;           Lets you create a new snippet file in the correct
     88 ;;           subdirectory of `yas-snippet-dirs', according to the
     89 ;;           active major mode.
     90 ;;
     91 ;;       M-x yas-load-snippet-buffer
     92 ;;
     93 ;;           When editing a snippet, this loads the snippet.  This is
     94 ;;           bound to "C-c C-c" while in the `snippet-mode' editing
     95 ;;           mode.
     96 ;;
     97 ;;       M-x yas-tryout-snippet
     98 ;;
     99 ;;           When editing a snippet, this opens a new empty buffer,
    100 ;;           sets it to the appropriate major mode and inserts the
    101 ;;           snippet there, so you can see what it looks like.  This is
    102 ;;           bound to "C-c C-t" while in `snippet-mode'.
    103 ;;
    104 ;;       M-x yas-describe-tables
    105 ;;
    106 ;;           Lists known snippets in a separate buffer.  User is
    107 ;;           prompted as to whether only the currently active tables
    108 ;;           are to be displayed, or all the tables for all major
    109 ;;           modes.
    110 ;;
    111 ;;   If you have `dropdown-list' installed, you can optionally use it
    112 ;;   as the preferred "prompting method", putting in your .emacs file,
    113 ;;   for example:
    114 ;;
    115 ;;       (require 'dropdown-list)
    116 ;;       (setq yas-prompt-functions '(yas-dropdown-prompt
    117 ;;                                    yas-ido-prompt
    118 ;;                                    yas-completing-prompt))
    119 ;;
    120 ;;   Also check out the customization group
    121 ;;
    122 ;;        M-x customize-group RET yasnippet RET
    123 ;;
    124 ;;   If you use the customization group to set variables
    125 ;;   `yas-snippet-dirs' or `yas-global-mode', make sure the path to
    126 ;;   "yasnippet.el" is present in the `load-path' *before* the
    127 ;;   `custom-set-variables' is executed in your .emacs file.
    128 ;;
    129 ;;   For more information and detailed usage, refer to the project page:
    130 ;;      http://github.com/joaotavora/yasnippet
    131 
    132 ;;; Code:
    133 
    134 (require 'cl-lib)
    135 (require 'eldoc) ; Needed for Emacs<25.
    136 (require 'easymenu)
    137 (require 'help-mode)
    138 
    139 (defvar yas--editing-template)
    140 (defvar yas--guessed-modes)
    141 (defvar yas--indent-original-column)
    142 (defvar yas--scheduled-jit-loads)
    143 (defvar yas-keymap)
    144 (defvar yas-selected-text)
    145 (defvar yas-verbosity)
    146 (defvar yas--current-template)
    147 
    148 
    149 ;;; User customizable variables
    150 
    151 (defgroup yasnippet nil
    152   "Yet Another Snippet extension"
    153   :prefix "yas-"
    154   :group 'editing)
    155 
    156 (defconst yas--loaddir
    157   (file-name-directory (or load-file-name buffer-file-name))
    158   "Directory that yasnippet was loaded from.")
    159 
    160 (defconst yas-installed-snippets-dir (expand-file-name "snippets" yas--loaddir))
    161 (make-obsolete-variable 'yas-installed-snippets-dir "\
    162 Yasnippet no longer comes with installed snippets" "0.14")
    163 
    164 (defconst yas--default-user-snippets-dir
    165   (expand-file-name "snippets" user-emacs-directory))
    166 
    167 (defcustom yas-snippet-dirs (list yas--default-user-snippets-dir)
    168   "List of top-level snippet directories.
    169 
    170 Each element, a string or a symbol whose value is a string,
    171 designates a top-level directory where per-mode snippet
    172 directories can be found.
    173 
    174 Elements appearing earlier in the list override later elements'
    175 snippets.
    176 
    177 The first directory is taken as the default for storing snippet's
    178 created with `yas-new-snippet'. "
    179   :type '(choice (directory :tag "Single directory")
    180                  (repeat :tag "List of directories"
    181                          (choice (directory) (variable))))
    182   :set #'(lambda (symbol new)
    183            (let ((old (and (boundp symbol)
    184                            (symbol-value symbol))))
    185              (set-default symbol new)
    186              (unless (or (not (fboundp 'yas-reload-all))
    187                          (equal old new))
    188                (yas-reload-all)))))
    189 
    190 (defun yas-snippet-dirs ()
    191   "Return variable `yas-snippet-dirs' as list of strings."
    192   (cl-loop for e in (if (listp yas-snippet-dirs)
    193                         yas-snippet-dirs
    194                       (list yas-snippet-dirs))
    195            collect
    196            (cond ((stringp e) e)
    197                  ((and (symbolp e)
    198                        (boundp e)
    199                        (stringp (symbol-value e)))
    200                   (symbol-value e))
    201                  (t
    202                   (error "[yas] invalid element %s in `yas-snippet-dirs'" e)))))
    203 
    204 (defcustom yas-new-snippet-default "\
    205 # -*- mode: snippet -*-
    206 # name: $1
    207 # key: ${2:${1:$(yas--key-from-desc yas-text)}}
    208 # --
    209 $0`(yas-escape-text yas-selected-text)`"
    210   "Default snippet to use when creating a new snippet.
    211 If nil, don't use any snippet."
    212   :type 'string)
    213 
    214 (defcustom yas-prompt-functions '(yas-dropdown-prompt
    215                                   yas-completing-prompt
    216                                   yas-maybe-ido-prompt
    217                                   yas-no-prompt)
    218   "Functions to prompt for keys, templates, etc interactively.
    219 
    220 These functions are called with the following arguments:
    221 
    222 - PROMPT: A string to prompt the user
    223 
    224 - CHOICES: a list of strings or objects.
    225 
    226 - optional DISPLAY-FN : A function that, when applied to each of
    227 the objects in CHOICES will return a string.
    228 
    229 The return value of any function you put here should be one of
    230 the objects in CHOICES, properly formatted with DISPLAY-FN (if
    231 that is passed).
    232 
    233 - To signal that your particular style of prompting is
    234 unavailable at the moment, you can also have the function return
    235 nil.
    236 
    237 - To signal that the user quit the prompting process, you can
    238 signal `quit' with
    239 
    240     (signal \\='quit \"user quit!\")"
    241   :type '(repeat function))
    242 
    243 (defcustom yas-indent-line 'auto
    244   "Controls indenting applied to a recent snippet expansion.
    245 
    246 The following values are possible:
    247 
    248 - `fixed' Indent the snippet to the current column;
    249 
    250 - `auto' Indent each line of the snippet with `indent-according-to-mode'
    251 
    252 Every other value means don't apply any snippet-side indentation
    253 after expansion (the manual per-line \"$>\" indentation still
    254 applies)."
    255   :type '(choice (const :tag "Nothing"  nothing)
    256                  (const :tag "Fixed"    fixed)
    257                  (const :tag "Auto"     auto)))
    258 
    259 (defcustom yas-also-auto-indent-first-line nil
    260   "Non-nil means also auto indent first line according to mode.
    261 
    262 Naturally this is only valid when `yas-indent-line' is `auto'."
    263   :type 'boolean)
    264 
    265 (defcustom yas-also-indent-empty-lines nil
    266   "Non-nil means also indent empty lines according to mode."
    267   :type 'boolean)
    268 
    269 (defcustom yas-snippet-revival t
    270   "Non-nil means re-activate snippet fields after undo/redo."
    271   :type 'boolean)
    272 
    273 (defcustom yas-triggers-in-field nil
    274   "If non-nil, allow stacked expansions (snippets inside snippets).
    275 
    276 Otherwise `yas-next-field-or-maybe-expand' just moves on to the
    277 next field"
    278   :type 'boolean)
    279 
    280 (defcustom yas-fallback-behavior 'return-nil
    281   "This option is obsolete.
    282 Now that the conditional keybinding `yas-maybe-expand' is
    283 available, there's no more need for it."
    284   :type '(choice (const :tag "Call previous command"  call-other-command)
    285                  (const :tag "Do nothing"             return-nil)))
    286 
    287 (make-obsolete-variable
    288  'yas-fallback-behavior
    289  "For `call-other-command' behavior bind to the conditional
    290 command value `yas-maybe-expand', for `return-nil' behavior bind
    291 directly to `yas-expand'."
    292  "0.12")
    293 
    294 (defcustom yas-choose-keys-first nil
    295   "If non-nil, prompt for snippet key first, then for template.
    296 
    297 Otherwise prompts for all possible snippet names.
    298 
    299 This affects `yas-insert-snippet' and `yas-visit-snippet-file'."
    300   :type 'boolean)
    301 
    302 (defcustom yas-choose-tables-first nil
    303   "If non-nil, and multiple eligible snippet tables, prompts user for tables first.
    304 
    305 Otherwise, user chooses between the merging together of all
    306 eligible tables.
    307 
    308 This affects `yas-insert-snippet', `yas-visit-snippet-file'"
    309   :type 'boolean)
    310 
    311 (defcustom yas-use-menu 'abbreviate
    312   "Display a YASnippet menu in the menu bar.
    313 
    314 When non-nil, submenus for each snippet table will be listed
    315 under the menu \"Yasnippet\".
    316 
    317 - If set to `abbreviate', only the current major-mode
    318 menu and the modes set in `yas--extra-modes' are listed.
    319 
    320 - If set to `full', every submenu is listed
    321 
    322 - If set to nil, hide the menu.
    323 
    324 Any other non-nil value, every submenu is listed."
    325   :type '(choice (const :tag "Full"  full)
    326                  (const :tag "Abbreviate" abbreviate)
    327                  (const :tag "No menu" nil)))
    328 
    329 (defcustom yas-trigger-symbol (or (and (eq window-system 'mac)
    330                                        (ignore-errors
    331                                          (char-to-string ?\x21E5))) ;; little ->| sign
    332                                   " =>")
    333   "The text that will be used in menu to represent the trigger."
    334   :type 'string)
    335 
    336 (defcustom yas-wrap-around-region nil
    337   "What to insert for snippet's $0 field.
    338 
    339 If set to a character, insert contents of corresponding register.
    340 If non-nil insert region contents.  This can be overridden on a
    341 per-snippet basis.  A value of `cua' is considered equivalent to
    342 `?0' for backwards compatibility."
    343   :type '(choice (character :tag "Insert from register")
    344                  (const :tag "Insert region contents" t)
    345                  (const :tag "Don't insert anything" nil)
    346                  (const cua))) ; backwards compat
    347 
    348 (defcustom yas-good-grace t
    349   "If non-nil, don't raise errors in elisp evaluation.
    350 
    351 This affects both the inline elisp in snippets and the hook
    352 variables such as `yas-after-exit-snippet-hook'.
    353 
    354 If this variable's value is `inline', an error string \"[yas]
    355 error\" is returned instead of raising the error.  If this
    356 variable's value is `hooks', a message is output to according to
    357 `yas-verbosity-level'.  If this variable's value is t, both are
    358 active."
    359   :type 'boolean)
    360 
    361 (defcustom yas-visit-from-menu nil
    362   "If non-nil visit snippets's files from menu, instead of expanding them.
    363 
    364 This can only work when snippets are loaded from files."
    365   :type 'boolean)
    366 
    367 (defcustom yas-expand-only-for-last-commands nil
    368   "List of `last-command' values to restrict tab-triggering to, or nil.
    369 
    370 Leave this set at nil (the default) to be able to trigger an
    371 expansion simply by placing the cursor after a valid tab trigger,
    372 using whichever commands.
    373 
    374 Optionally, set this to something like (self-insert-command) if
    375 you to wish restrict expansion to only happen when the last
    376 letter of the snippet tab trigger was typed immediately before
    377 the trigger key itself."
    378   :type '(repeat function))
    379 
    380 (defcustom yas-alias-to-yas/prefix-p t
    381   "If non-nil make aliases for the old style yas/ prefixed symbols.
    382 It must be set to nil before loading yasnippet to take effect."
    383   :type 'boolean)
    384 
    385 ;; Only two faces, and one of them shouldn't even be used...
    386 ;;
    387 (defface yas-field-highlight-face
    388   '((t (:inherit region)))
    389   "The face used to highlight the currently active field of a snippet")
    390 
    391 (defface yas--field-debug-face
    392   '()
    393   "The face used for debugging some overlays normally hidden")
    394 
    395 
    396 ;;; User-visible variables
    397 
    398 (defconst yas-maybe-skip-and-clear-field
    399   '(menu-item "" yas-skip-and-clear-field
    400               :filter yas--maybe-clear-field-filter)
    401   "A conditional key definition.
    402 This can be used as a key definition in keymaps to bind a key to
    403 `yas-skip-and-clear-field' only when at the beginning of an
    404 unmodified snippet field.")
    405 
    406 (defconst yas-maybe-clear-field
    407     '(menu-item "" yas-clear-field
    408                 :filter yas--maybe-clear-field-filter)
    409     "A conditional key definition.
    410 This can be used as a key definition in keymaps to bind a key to
    411 `yas-clear-field' only when at the beginning of an
    412 unmodified snippet field.")
    413 
    414 (defun yas-filtered-definition (def)
    415   "Return a condition key definition.
    416 The condition will respect the value of `yas-keymap-disable-hook'."
    417   `(menu-item "" ,def
    418               :filter ,(lambda (cmd) (unless (run-hook-with-args-until-success
    419                                          'yas-keymap-disable-hook)
    420                                   cmd))))
    421 
    422 (defvar yas-keymap
    423   (let ((map (make-sparse-keymap)))
    424     ;; Modes should always bind to TAB instead of `tab', so as not to override
    425     ;; bindings that should take higher precedence but which bind to `TAB`
    426     ;; instead (relying on `function-key-map` to remap `tab` to TAB).
    427     ;; If this causes problem because of another package that binds to `tab`,
    428     ;; complain to that other package!
    429     ;; (define-key map [tab]       (yas-filtered-definition 'yas-next-field-or-maybe-expand))
    430     (define-key map (kbd "TAB")   (yas-filtered-definition 'yas-next-field-or-maybe-expand))
    431     (define-key map [(shift tab)] (yas-filtered-definition 'yas-prev-field))
    432     (define-key map [backtab]     (yas-filtered-definition 'yas-prev-field))
    433     (define-key map (kbd "C-g")   (yas-filtered-definition 'yas-abort-snippet))
    434     ;; Yes, filters can be chained!
    435     (define-key map (kbd "C-d")   (yas-filtered-definition yas-maybe-skip-and-clear-field))
    436     (define-key map (kbd "DEL")   (yas-filtered-definition yas-maybe-clear-field))
    437     map)
    438   "The active keymap while a snippet expansion is in progress.")
    439 
    440 (defvar yas-key-syntaxes (list #'yas-try-key-from-whitespace
    441                                "w_.()" "w_." "w_" "w")
    442   "Syntaxes and functions to help look for trigger keys before point.
    443 
    444 Each element in this list specifies how to skip buffer positions
    445 backwards and look for the start of a trigger key.
    446 
    447 Each element can be either a string or a function receiving the
    448 original point as an argument. A string element is simply passed
    449 to `skip-syntax-backward' whereas a function element is called
    450 with no arguments and should also place point before the original
    451 position.
    452 
    453 The string between the resulting buffer position and the original
    454 point is matched against the trigger keys in the active snippet
    455 tables.
    456 
    457 If no expandable snippets are found, the next element is the list
    458 is tried, unless a function element returned the symbol `again',
    459 in which case it is called again from the previous position and
    460 may once more reposition point.
    461 
    462 For example, if `yas-key-syntaxes' has the value (\"w\" \"w_\"),
    463 trigger keys composed exclusively of \"word\"-syntax characters
    464 are looked for first. Failing that, longer keys composed of
    465 \"word\" or \"symbol\" syntax are looked for. Therefore,
    466 triggering after
    467 
    468 foo-barbaz
    469 
    470 will, according to the \"w\" element first try \"barbaz\". If
    471 that isn't a trigger key, \"foo-barbaz\" is tried, respecting the
    472 second \"w_\" element. Notice that even if \"baz\" is a trigger
    473 key for an active snippet, it won't be expanded, unless a
    474 function is added to `yas-key-syntaxes' that eventually places
    475 point between \"bar\" and \"baz\".
    476 
    477 See also Info node `(elisp) Syntax Descriptors'.")
    478 
    479 (defvar yas-after-exit-snippet-hook
    480   '()
    481   "Hook run after a snippet exited.
    482 
    483 The functions will be run in an environment where some variables bound to
    484 proper values:
    485 
    486 `yas-snippet-beg' : The beginning of the region of the snippet.
    487 
    488 `yas-snippet-end' : Similar to beg.
    489 
    490 Attention: This hook is not run when exiting nested/stacked snippet expansion!")
    491 
    492 (defvar yas-before-expand-snippet-hook
    493   '()
    494   "Hook run just before expanding a snippet.")
    495 
    496 (defconst yas-not-string-or-comment-condition
    497   (lambda ()
    498     (if (let ((ppss (syntax-ppss)))
    499           (or (nth 3 ppss) (nth 4 ppss)))
    500         '(require-snippet-condition . force-in-comment)
    501       t))
    502   "Disables snippet expansion in strings and comments.
    503 To use, set `yas-buffer-local-condition' to this value.")
    504 
    505 (defcustom yas-buffer-local-condition t
    506   "Snippet expanding condition.
    507 
    508 This variable is either a Lisp function (called with no arguments)
    509 or a Lisp form.  It is evaluated every time a snippet expansion is attempted:
    510 
    511     * If it evaluates to nil, no snippets can be expanded.
    512 
    513     * If it evaluates to the a cons (require-snippet-condition
    514       . REQUIREMENT)
    515 
    516        * Snippets bearing no \"# condition:\" directive are not
    517          considered
    518 
    519        * Snippets bearing conditions that evaluate to nil (or
    520          produce an error) won't be considered.
    521 
    522        * If the snippet has a condition that evaluates to non-nil
    523          RESULT:
    524 
    525           * If REQUIREMENT is t, the snippet is considered
    526 
    527           * If REQUIREMENT is `eq' RESULT, the snippet is
    528             considered
    529 
    530           * Otherwise, the snippet is not considered.
    531 
    532     * If it evaluates to the symbol `always', all snippets are
    533       considered for expansion, regardless of any conditions.
    534 
    535     * If it evaluates to t or some other non-nil value
    536 
    537        * Snippet bearing no conditions, or conditions that
    538          evaluate to non-nil, are considered for expansion.
    539 
    540        * Otherwise, the snippet is not considered.
    541 
    542 Here's an example preventing snippets from being expanded from
    543 inside comments, in `python-mode' only, with the exception of
    544 snippets returning the symbol `force-in-comment' in their
    545 conditions.
    546 
    547     (add-hook \\='python-mode-hook
    548               (lambda ()
    549                 (setq yas-buffer-local-condition
    550                       (lambda ()
    551                         (if (python-syntax-comment-or-string-p)
    552                             \\='(require-snippet-condition . force-in-comment)
    553                           t)))))"
    554   :type
    555   `(choice
    556     (const :tag "Disable snippet expansion inside strings and comments"
    557            ,yas-not-string-or-comment-condition)
    558     (const :tag "Expand all snippets regardless of conditions" always)
    559     (const :tag "Expand snippets unless their condition is nil" t)
    560     (const :tag "Disable all snippet expansion" nil)
    561     sexp))
    562 
    563 (defcustom yas-keymap-disable-hook nil
    564   "Abnormal hook run to decide when `yas-keymap' bindings are enabled.
    565 The bindings are disabled whenever any function in this list returns non-nil.
    566 This is useful to control whether snippet navigation bindings
    567 override bindings from other packages (e.g., `company-mode').
    568 This is run (several times) every time we perform a key lookup, so
    569 it has to be fast."
    570   :type 'hook)
    571 
    572 (defcustom yas-overlay-priority 100
    573   "Priority to use for yasnippets overlays.
    574 This is useful to control whether snippet navigation bindings
    575 override `keymap' overlay property bindings from other packages."
    576   :type 'integer)
    577 
    578 (defcustom yas-inhibit-overlay-modification-protection nil
    579   "If nil, changing text outside the active field aborts the snippet.
    580 This protection is intended to prevent yasnippet from ending up
    581 in an inconsistent state.  However, some packages (e.g., the
    582 company completion package) may trigger this protection when it
    583 is not needed.  In that case, setting this variable to non-nil
    584 can be useful."
    585   ;; See also `yas--on-protection-overlay-modification'.
    586   :type 'boolean)
    587 
    588 
    589 ;;; Internal variables
    590 
    591 (defconst yas--version "0.14.0")
    592 
    593 (defvar yas--menu-table (make-hash-table)
    594   "A hash table of MAJOR-MODE symbols to menu keymaps.")
    595 
    596 (defvar yas--escaped-characters
    597   '(?\\ ?` ?\" ?' ?$ ?} ?{ ?\( ?\))
    598   "List of characters which *might* need to be escaped.")
    599 
    600 (defconst yas--field-regexp
    601   "${\\([0-9]+:\\)?\\([^}]*\\)}"
    602   "A regexp to *almost* recognize a field.")
    603 
    604 (defconst yas--multi-dollar-lisp-expression-regexp
    605   "$+[ \t\n]*\\(([^)]*)\\)"
    606   "A regexp to *almost* recognize a \"$(...)\" expression.")
    607 
    608 (defconst yas--backquote-lisp-expression-regexp
    609   "`\\([^`]*\\)`"
    610   "A regexp to recognize a \"\\=`lisp-expression\\=`\" expression." )
    611 
    612 (defconst yas--transform-mirror-regexp
    613   "${\\(?:\\([0-9]+\\):\\)?$\\([ \t\n]*([^}]*\\)"
    614   "A regexp to *almost* recognize a mirror with a transform.")
    615 
    616 (defconst yas--simple-mirror-regexp
    617   "$\\([0-9]+\\)"
    618   "A regexp to recognize a simple mirror.")
    619 
    620 (defvar yas--snippet-id-seed 0
    621   "Contains the next id for a snippet.")
    622 
    623 (defun yas--snippet-next-id ()
    624   (let ((id yas--snippet-id-seed))
    625     (cl-incf yas--snippet-id-seed)
    626     id))
    627 
    628 
    629 ;;; Minor mode stuff
    630 
    631 (defvar yas--minor-mode-menu nil
    632   "Holds the YASnippet menu.")
    633 
    634 (defvar yas--condition-cache-timestamp nil)
    635 
    636 (defun yas-maybe-expand-abbrev-key-filter (cmd)
    637   "Return CMD if there is an expandable snippet at point.
    638 This function is useful as a `:filter' to a conditional key
    639 definition."
    640   (when (let ((yas--condition-cache-timestamp (current-time)))
    641           (yas--templates-for-key-at-point))
    642     cmd))
    643 
    644 (define-obsolete-function-alias 'yas--maybe-expand-key-filter
    645   #'yas-maybe-expand-abbrev-key-filter "0.14")
    646 
    647 (defconst yas-maybe-expand
    648   '(menu-item "" yas-expand :filter yas-maybe-expand-abbrev-key-filter)
    649   "A conditional key definition.
    650 This can be used as a key definition in keymaps to bind a key to
    651 `yas-expand' only when there is a snippet available to be
    652 expanded.")
    653 
    654 (defvar yas-minor-mode-map
    655   (let ((map (make-sparse-keymap)))
    656     ;; Modes should always bind to TAB instead of `tab', so as not to override
    657     ;; bindings that should take higher precedence but which bind to `TAB`
    658     ;; instead (relying on `function-key-map` to remap `tab` to TAB).
    659     ;; If this causes problem because of another package that binds to `tab`,
    660     ;; complain to that other package!
    661     ;;(define-key map [tab]     yas-maybe-expand)
    662     (define-key map (kbd "TAB") yas-maybe-expand)
    663     (define-key map "\C-c&\C-s" #'yas-insert-snippet)
    664     (define-key map "\C-c&\C-n" #'yas-new-snippet)
    665     (define-key map "\C-c&\C-v" #'yas-visit-snippet-file)
    666     map)
    667   "The keymap used when `yas-minor-mode' is active.")
    668 
    669 (easy-menu-define yas--minor-mode-menu
    670       yas-minor-mode-map
    671       "Menu used when `yas-minor-mode' is active."
    672   '("YASnippet" :visible yas-use-menu
    673     "----"
    674     ["Expand trigger" yas-expand
    675      :help "Possibly expand tab trigger before point"]
    676     ["Insert at point..." yas-insert-snippet
    677      :help "Prompt for an expandable snippet and expand it at point"]
    678     ["New snippet..." yas-new-snippet
    679      :help "Create a new snippet in an appropriate directory"]
    680     ["Visit snippet file..." yas-visit-snippet-file
    681      :help "Prompt for an expandable snippet and find its file"]
    682     "----"
    683     ("Snippet menu behaviour"
    684      ["Visit snippets" (setq yas-visit-from-menu t)
    685       :help "Visit snippets from the menu"
    686       :active t :style radio   :selected yas-visit-from-menu]
    687      ["Expand snippets" (setq yas-visit-from-menu nil)
    688       :help "Expand snippets from the menu"
    689       :active t :style radio :selected (not yas-visit-from-menu)]
    690      "----"
    691      ["Show all known modes" (setq yas-use-menu 'full)
    692       :help "Show one snippet submenu for each loaded table"
    693       :active t :style radio   :selected (eq yas-use-menu 'full)]
    694      ["Abbreviate according to current mode" (setq yas-use-menu 'abbreviate)
    695       :help "Show only snippet submenus for the current active modes"
    696       :active t :style radio   :selected (eq yas-use-menu 'abbreviate)])
    697     ("Indenting"
    698      ["Auto" (setq yas-indent-line 'auto)
    699       :help "Indent each line of the snippet with `indent-according-to-mode'"
    700       :active t :style radio   :selected (eq yas-indent-line 'auto)]
    701      ["Fixed" (setq yas-indent-line 'fixed)
    702       :help "Indent the snippet to the current column"
    703       :active t :style radio   :selected (eq yas-indent-line 'fixed)]
    704      ["None" (setq yas-indent-line 'none)
    705       :help "Don't apply any particular snippet indentation after expansion"
    706       :active t :style radio   :selected (not (member yas-indent-line '(fixed auto)))]
    707      "----"
    708      ["Also auto indent first line" (setq yas-also-auto-indent-first-line
    709                                           (not yas-also-auto-indent-first-line))
    710       :help "When auto-indenting also, auto indent the first line menu"
    711       :active (eq yas-indent-line 'auto)
    712       :style toggle :selected yas-also-auto-indent-first-line]
    713      )
    714     ("Prompting method"
    715      ["System X-widget" (setq yas-prompt-functions
    716                               (cons #'yas-x-prompt
    717                                     (remove #'yas-x-prompt
    718                                             yas-prompt-functions)))
    719       :help "Use your windowing system's (gtk, mac, windows, etc...) default menu"
    720       :active t :style radio   :selected (eq (car yas-prompt-functions)
    721                                              #'yas-x-prompt)]
    722      ["Dropdown-list" (setq yas-prompt-functions
    723                             (cons #'yas-dropdown-prompt
    724                                   (remove #'yas-dropdown-prompt
    725                                           yas-prompt-functions)))
    726       :help "Use a special dropdown list"
    727       :active t :style radio   :selected (eq (car yas-prompt-functions)
    728                                              #'yas-dropdown-prompt)]
    729      ["Ido" (setq yas-prompt-functions
    730                   (cons #'yas-ido-prompt
    731                         (remove #'yas-ido-prompt
    732                                 yas-prompt-functions)))
    733       :help "Use an ido-style minibuffer prompt"
    734       :active t :style radio   :selected (eq (car yas-prompt-functions)
    735                                              #'yas-ido-prompt)]
    736      ["Completing read" (setq yas-prompt-functions
    737                               (cons #'yas-completing-prompt
    738                                     (remove #'yas-completing-prompt
    739                                             yas-prompt-functions)))
    740       :help "Use a normal minibuffer prompt"
    741       :active t :style radio   :selected (eq (car yas-prompt-functions)
    742                                              #'yas-completing-prompt)]
    743      )
    744     ("Misc"
    745      ["Wrap region in exit marker"
    746       (setq yas-wrap-around-region
    747             (not yas-wrap-around-region))
    748       :help "If non-nil automatically wrap the selected text in the $0 snippet exit"
    749       :style toggle :selected yas-wrap-around-region]
    750      ["Allow stacked expansions "
    751       (setq yas-triggers-in-field
    752             (not yas-triggers-in-field))
    753       :help "If non-nil allow snippets to be triggered inside other snippet fields"
    754       :style toggle :selected yas-triggers-in-field]
    755      ["Revive snippets on undo "
    756       (setq yas-snippet-revival
    757             (not yas-snippet-revival))
    758       :help "If non-nil allow snippets to become active again after undo"
    759       :style toggle :selected yas-snippet-revival]
    760      ["Good grace "
    761       (setq yas-good-grace
    762             (not yas-good-grace))
    763       :help "If non-nil don't raise errors in bad embedded elisp in snippets"
    764       :style toggle :selected yas-good-grace]
    765      )
    766     "----"
    767     ["Load snippets..."  yas-load-directory
    768      :help "Load snippets from a specific directory"]
    769     ["Reload everything" yas-reload-all
    770      :help "Cleanup stuff, reload snippets, rebuild menus"]
    771     ["About"            yas-about
    772      :help "Display some information about YASnippet"]))
    773 
    774 (define-obsolete-variable-alias 'yas-extra-modes 'yas--extra-modes "0.9.1")
    775 (defvar yas--extra-modes nil            ;FIXME: Use `defvar-local'?
    776   "An internal list of modes for which to also lookup snippets.
    777 
    778 This variable probably makes more sense as buffer-local, so
    779 ensure your use `make-local-variable' when you set it.")
    780 
    781 (defvar yas--tables (make-hash-table)
    782   "A hash table of mode symbols to `yas--table' objects.")
    783 
    784 (defvar yas--parents (make-hash-table)
    785   "A hash table of mode symbols to lists of direct parent mode symbols.
    786 
    787 This list is populated when reading the \".yas-parents\" files
    788 found when traversing snippet directories with
    789 `yas-load-directory'.
    790 
    791 There might be additional parenting information stored in the
    792 `derived-mode-parent' property of some mode symbols, but that is
    793 not recorded here.")
    794 
    795 (defvar yas--direct-keymaps (list)
    796   "Keymap alist supporting direct snippet keybindings.
    797 
    798 This variable is placed in `emulation-mode-map-alists'.
    799 
    800 Its elements looks like (TABLE-NAME . KEYMAP).  They're
    801 instantiated on `yas-reload-all' but KEYMAP is added to only when
    802 loading snippets.  `yas--direct-TABLE-NAME' is then a variable
    803 set buffer-locally when entering `yas-minor-mode'.  KEYMAP binds
    804 all defined direct keybindings to `yas-maybe-expand-from-keymap'
    805 which decides on the snippet to expand.")
    806 
    807 (defun yas-direct-keymaps-reload ()
    808   "Force reload the direct keybinding for active snippet tables."
    809   (interactive)
    810   (setq yas--direct-keymaps nil)
    811   (maphash #'(lambda (name table)
    812                (push (cons (intern (format "yas--direct-%s" name))
    813                            (yas--table-direct-keymap table))
    814                      yas--direct-keymaps))
    815            yas--tables))
    816 
    817 (defalias 'yas--merge-ordered-lists
    818   (if (fboundp 'merge-ordered-lists)    ;Emacs≥30.
    819       #'merge-ordered-lists
    820     (lambda (lists)
    821       (setq lists (delq nil lists))
    822       (if (null (cdr lists)) (car lists) ;Common case.
    823         (delete-dups (apply #'append
    824                             ;; Prevent sharing the tail.
    825                             (append lists '(()) )))))))
    826 
    827 (defun yas--flush-all-parents (mode)
    828   (if (get mode 'yas--all-parents)
    829       (put mode 'yas--all-parents nil)))
    830 
    831 (defun yas--all-parents (mode)
    832   "Like `derived-mode-all-parents' but obeying `yas--parents'."
    833   (or (get mode 'yas--all-parents) ;; FIXME: Use `with-memoization'?
    834       (progn
    835         (put mode 'yas--all-parents (list mode)) ;; Stop inf-loop with cycles.
    836         (let ((all-parents
    837                (if (fboundp 'derived-mode-all-parents)
    838                    (let* ((ap (derived-mode-all-parents mode))
    839                           (extras
    840                            (mapcar (lambda (parent)
    841                                      (yas--merge-ordered-lists
    842                                       (mapcar #'yas--all-parents
    843                                               (gethash parent yas--parents))))
    844                                    ap)))
    845                      (cl-assert (eq mode (car ap)))
    846                      (cons mode
    847                            (yas--merge-ordered-lists
    848                             (cons (if (eq mode 'fundamental-mode) ()
    849                                     (append (cdr ap) '(fundamental-mode)))
    850                                   extras))))
    851                  (delete-dups
    852                   (cons mode
    853                         (yas--merge-ordered-lists
    854                          (mapcar #'yas--all-parents
    855                                  (remq nil
    856                                        `(,(or (get mode 'derived-mode-parent)
    857                                               ;; Consider `fundamental-mode'
    858                                               ;; as ultimate ancestor.
    859                                               'fundamental-mode)
    860                                          ,(let ((alias (symbol-function mode)))
    861                                             (when (symbolp alias) alias))
    862                                          ,@(get mode 'derived-mode-extra-parents)
    863                                          ,@(gethash mode yas--parents))))))))))
    864           (dolist (parent all-parents)
    865             (cl-pushnew mode (get parent 'yas--cached-children)))
    866           (put mode 'yas--all-parents all-parents)))))
    867 
    868 (defun yas--modes-to-activate (&optional mode)
    869   "Compute list of mode symbols that are active for `yas-expand' and friends."
    870   (let* ((modes
    871           (delete-dups
    872            (remq nil `(,@(unless mode yas--extra-modes)
    873                        ,(or mode major-mode)
    874                        ;; FIXME: Alternative major modes should use
    875                        ;; `derived-mode-add-parents', but until that
    876                        ;; becomes common, use `major-mode-remap-alist'
    877                        ;; as a crutch to supplement the mode hierarchy.
    878                        ,(and (boundp 'major-mode-remap-alist)
    879                              (car (rassq (or mode major-mode)
    880                                          major-mode-remap-alist))))))))
    881     (yas--merge-ordered-lists
    882      (mapcar #'yas--all-parents modes))))
    883 
    884 (defvar yas-minor-mode-hook nil
    885   "Hook run when `yas-minor-mode' is turned on.")
    886 
    887 (defun yas--auto-fill-wrapper ()
    888   (when auto-fill-function ;Turning the mode ON.
    889     ;; (cl-assert (local-variable-p 'auto-fill-function))
    890     (add-function :around (local 'auto-fill-function) #'yas--auto-fill)))
    891 
    892 ;;;###autoload
    893 (define-minor-mode yas-minor-mode
    894   "Toggle YASnippet mode.
    895 
    896 When YASnippet mode is enabled, `yas-expand', normally bound to
    897 the TAB key, expands snippets of code depending on the major
    898 mode.
    899 
    900 With no argument, this command toggles the mode.
    901 positive prefix argument turns on the mode.
    902 Negative prefix argument turns off the mode.
    903 
    904 Key bindings:
    905 \\{yas-minor-mode-map}"
    906   :lighter " yas" ;; The indicator for the mode line.
    907   (cond ((and yas-minor-mode (featurep 'yasnippet))
    908          ;; Install the direct keymaps in `emulation-mode-map-alists'
    909          ;; (we use `add-hook' even though it's not technically a hook,
    910          ;; but it works). Then define variables named after modes to
    911          ;; index `yas--direct-keymaps'.
    912          ;;
    913          ;; Also install the post-command-hook.
    914          ;;
    915          (cl-pushnew 'yas--direct-keymaps emulation-mode-map-alists)
    916          (add-hook 'post-command-hook #'yas--post-command-handler nil t)
    917          ;; Set the `yas--direct-%s' vars for direct keymap expansion
    918          ;;
    919          (dolist (mode (yas--modes-to-activate))
    920            (let ((name (intern (format "yas--direct-%s" mode))))
    921              (set-default name nil)
    922              (set (make-local-variable name) t)))
    923          ;; Perform JIT loads
    924          (yas--load-pending-jits)
    925          ;; Install auto-fill handler.
    926          (yas--auto-fill-wrapper)       ; Now...
    927          (add-hook 'auto-fill-mode-hook #'yas--auto-fill-wrapper)) ; or later.
    928         (t
    929          ;; Uninstall the direct keymaps, post-command hook, and
    930          ;; auto-fill handler.
    931          (remove-hook 'post-command-hook #'yas--post-command-handler t)
    932          (remove-hook 'auto-fill-mode-hook #'yas--auto-fill-wrapper)
    933          (when (local-variable-p 'auto-fill-function)
    934            (remove-function (local 'auto-fill-function) #'yas--auto-fill))
    935          (setq emulation-mode-map-alists
    936                (remove 'yas--direct-keymaps emulation-mode-map-alists)))))
    937 
    938 (defun yas-activate-extra-mode (mode)
    939   "Activates the snippets for the given `mode' in the buffer.
    940 
    941 The function can be called in the hook of a minor mode to
    942 activate snippets associated with that mode."
    943   (interactive
    944    (let ((symbol (completing-read
    945                   "Activate mode: " yas--parents nil t)))
    946      (list
    947       (when (not (string= "" symbol))
    948         (intern symbol)))))
    949   (when mode
    950     (add-to-list (make-local-variable 'yas--extra-modes) mode)
    951     (yas--load-pending-jits)))
    952 
    953 (defun yas-deactivate-extra-mode (mode)
    954   "Deactivates the snippets for the given `mode' in the buffer."
    955   (interactive
    956    (list (intern
    957           (completing-read
    958            "Deactivate mode: " (mapcar #'list yas--extra-modes) nil t))))
    959   (setq-local yas--extra-modes
    960               (remove mode yas--extra-modes)))
    961 
    962 (defun yas-temp-buffer-p (&optional buffer)
    963   (eq (aref (buffer-name buffer) 0) ?\s))
    964 
    965 (define-obsolete-variable-alias 'yas-dont-activate
    966   'yas-dont-activate-functions "0.9.2")
    967 (defvar yas-dont-activate-functions (list #'minibufferp #'yas-temp-buffer-p)
    968   "Special hook to control which buffers `yas-global-mode' affects.
    969 Functions are called with no argument, and should return non-nil to prevent
    970 `yas-global-mode' from enabling yasnippet in this buffer.
    971 
    972 Only the global value is used.  To define
    973 per-mode exceptions to the \"global\" activation behaviour, call
    974 `yas-minor-mode' with a negative argument directily in the major
    975 mode's hook.") ;; FIXME: Why do we say "Only the global value is used"?
    976 
    977 (defun yas-minor-mode-on ()
    978   "Turn on YASnippet minor mode.
    979 
    980 Honour `yas-dont-activate-functions', which see."
    981   (interactive)
    982   (unless (or
    983            ;; The old behavior used for Emacs<24 was to set
    984            ;; `yas-dont-activate-functions' to t buffer-locally.
    985            (not (or (listp yas-dont-activate-functions)
    986                     (functionp yas-dont-activate-functions)))
    987            (run-hook-with-args-until-success 'yas-dont-activate-functions))
    988     (yas-minor-mode 1)))
    989 
    990 ;;;###autoload
    991 (define-globalized-minor-mode yas-global-mode yas-minor-mode yas-minor-mode-on)
    992 
    993 (defun yas--global-mode-reload-with-jit-maybe ()
    994   "Run `yas-reload-all' when `yas-global-mode' is on."
    995   (when yas-global-mode (yas-reload-all)))
    996 
    997 (add-hook 'yas-global-mode-hook #'yas--global-mode-reload-with-jit-maybe)
    998 
    999 
   1000 ;;; Major mode stuff
   1001 
   1002 (defvar yas--font-lock-keywords
   1003   (append '(("^#.*$" . font-lock-comment-face))
   1004           (with-temp-buffer
   1005             (let ((prog-mode-hook nil)
   1006                   (emacs-lisp-mode-hook nil))
   1007               (ignore-errors (emacs-lisp-mode)))
   1008             (font-lock-set-defaults)
   1009             (if (eq t (car-safe font-lock-keywords))
   1010                 ;; They're "compiled", so extract the source.
   1011                 (cadr font-lock-keywords)
   1012               font-lock-keywords))
   1013           '(("\\$\\([0-9]+\\)"
   1014              (0 font-lock-keyword-face)
   1015              (1 font-lock-string-face t))
   1016             ("\\${\\([0-9]+\\):?"
   1017              (0 font-lock-keyword-face)
   1018              (1 font-lock-warning-face t))
   1019             ("\\(\\$(\\)" 1 font-lock-preprocessor-face)
   1020             ("}"
   1021              (0 font-lock-keyword-face)))))
   1022 
   1023 (defvar snippet-mode-map
   1024   (let ((map (make-sparse-keymap)))
   1025     (easy-menu-define nil
   1026       map
   1027       "Menu used when snippet-mode is active."
   1028       (cons "Snippet"
   1029             (mapcar #'(lambda (ent)
   1030                         (when (nth 2 ent)
   1031                           (define-key map (nth 2 ent) (nth 1 ent)))
   1032                         (vector (nth 0 ent) (nth 1 ent) t))
   1033                     '(("Load this snippet" yas-load-snippet-buffer "\C-c\C-l")
   1034                       ("Load and quit window" yas-load-snippet-buffer-and-close "\C-c\C-c")
   1035                       ("Try out this snippet" yas-tryout-snippet "\C-c\C-t")))))
   1036     map)
   1037   "The keymap used when `snippet-mode' is active.")
   1038 
   1039 
   1040 
   1041 ;;;###autoload(autoload 'snippet-mode "yasnippet" "A mode for editing yasnippets" t nil)
   1042 (define-derived-mode snippet-mode prog-mode "Snippet"
   1043   "A mode for editing yasnippets"
   1044   (setq font-lock-defaults '(yas--font-lock-keywords))
   1045   (setq-local require-final-newline nil)
   1046   (setq-local comment-start "#")
   1047   (setq-local comment-start-skip "#+[\t ]*")
   1048   (add-hook 'after-save-hook #'yas-maybe-load-snippet-buffer nil t))
   1049 
   1050 (defun yas-snippet-mode-buffer-p ()
   1051   "Return non-nil if current buffer should be in `snippet-mode'.
   1052 Meaning it's visiting a file under one of the mode directories in
   1053 `yas-snippet-dirs'."
   1054   (when buffer-file-name
   1055     (cl-member buffer-file-name (yas-snippet-dirs)
   1056                :test #'file-in-directory-p)))
   1057 
   1058 ;; We're abusing `magic-fallback-mode-alist' here because
   1059 ;; `auto-mode-alist' doesn't support function matchers.
   1060 (add-to-list 'magic-fallback-mode-alist
   1061              `(yas-snippet-mode-buffer-p . snippet-mode))
   1062 
   1063 
   1064 ;;; Internal structs for template management
   1065 
   1066 (cl-defstruct (yas--template
   1067                (:constructor yas--make-template)
   1068                ;; Handles `yas-define-snippets' format, plus the
   1069                ;; initial TABLE argument.
   1070                (:constructor
   1071                 yas--define-snippets-2
   1072                 (table
   1073                  key content
   1074                  &optional xname condition group
   1075                  expand-env load-file xkeybinding xuuid save-file
   1076                  &aux
   1077                  (name (or xname
   1078                            ;; A little redundant: we always get a name
   1079                            ;; from `yas--parse-template' except when
   1080                            ;; there isn't a file.
   1081                            (and load-file (file-name-nondirectory load-file))
   1082                            (and save-file (file-name-nondirectory save-file))
   1083                            key))
   1084                  (keybinding (yas--read-keybinding xkeybinding))
   1085                  (uuid (or xuuid name))
   1086                  (old (gethash uuid (yas--table-uuidhash table)))
   1087                  (menu-binding-pair
   1088                   (and old (yas--template-menu-binding-pair old)))
   1089                  (perm-group
   1090                   (and old (yas--template-perm-group old))))))
   1091   "A template for a snippet."
   1092   key
   1093   content
   1094   name
   1095   condition
   1096   expand-env
   1097   load-file
   1098   save-file
   1099   keybinding
   1100   uuid
   1101   menu-binding-pair
   1102   group      ;; as dictated by the #group: directive or .yas-make-groups
   1103   perm-group ;; as dictated by `yas-define-menu'
   1104   table
   1105   )
   1106 
   1107 (cl-defstruct (yas--table (:constructor yas--make-snippet-table (name)))
   1108   "A table to store snippets for a particular mode.
   1109 
   1110 Has the following fields:
   1111 
   1112 `yas--table-name'
   1113 
   1114   A symbol name normally corresponding to a major mode, but can
   1115   also be a pseudo major-mode to be used in
   1116   `yas-activate-extra-mode', for example.
   1117 
   1118 `yas--table-hash'
   1119 
   1120   A hash table (KEY . NAMEHASH), known as the \"keyhash\". KEY is
   1121   a string or a vector, where the former is the snippet's trigger
   1122   and the latter means it's a direct keybinding. NAMEHASH is yet
   1123   another hash of (NAME . TEMPLATE) where NAME is the snippet's
   1124   name and TEMPLATE is a `yas--template' object.
   1125 
   1126 `yas--table-direct-keymap'
   1127 
   1128   A keymap for the snippets in this table that have direct
   1129   keybindings. This is kept in sync with the keyhash, i.e., all
   1130   the elements of the keyhash that are vectors appear here as
   1131   bindings to `yas-maybe-expand-from-keymap'.
   1132 
   1133 `yas--table-uuidhash'
   1134 
   1135   A hash table mapping snippets uuid's to the same `yas--template'
   1136   objects. A snippet uuid defaults to the snippet's name."
   1137   name
   1138   (hash (make-hash-table :test 'equal))
   1139   (uuidhash (make-hash-table :test 'equal))
   1140   (parents nil)
   1141   (direct-keymap (make-sparse-keymap)))
   1142 
   1143 (defun yas--get-template-by-uuid (mode uuid)
   1144   "Find the snippet template in MODE by its UUID."
   1145   (let* ((table (gethash mode yas--tables mode)))
   1146     (when table
   1147       (gethash uuid (yas--table-uuidhash table)))))
   1148 
   1149 ;; Apropos storing/updating in TABLE, this works in two steps:
   1150 ;;
   1151 ;; 1. `yas--remove-template-by-uuid' removes any
   1152 ;;    keyhash-namehash-template mappings from TABLE, grabbing the
   1153 ;;    snippet by its uuid. Also removes mappings from TABLE's
   1154 ;;    `yas--table-direct-keymap' (FIXME: and should probably take care
   1155 ;;    of potentially stale menu bindings right?.)
   1156 ;;
   1157 ;; 2. `yas--add-template' adds this all over again.
   1158 ;;
   1159 ;;    Create a new or add to an existing keyhash-namehash mapping.
   1160 ;;
   1161 ;;  For reference on understanding this, consider three snippet
   1162 ;;  definitions:
   1163 ;;
   1164 ;;  A:   # name: The Foo
   1165 ;;       # key: foo
   1166 ;;       # binding: C-c M-l
   1167 ;;
   1168 ;;  B:   # name: Mrs Foo
   1169 ;;       # key: foo
   1170 ;;
   1171 ;;  C:   # name: The Bar
   1172 ;;       # binding: C-c M-l
   1173 ;;
   1174 ;;  D:   # name: Baz
   1175 ;;       # key: baz
   1176 ;;
   1177 ;;  keyhash       namehashes(3)      yas--template structs(4)
   1178 ;;  -----------------------------------------------------
   1179 ;;                                            __________
   1180 ;;                                           /          \
   1181 ;;  "foo"      --->  "The Foo" --->  [yas--template A]   |
   1182 ;;                   "Mrs Foo" --->  [yas--template B]   |
   1183 ;;                                                      |
   1184 ;;  [C-c M-l]  --->  "The Foo" -------------------------/
   1185 ;;                   "The Bar" --->  [yas--template C]
   1186 ;;
   1187 ;;  "baz"      --->  "Baz"     --->  [yas--template D]
   1188 ;;
   1189 ;; Additionally, since uuid defaults to the name, we have a
   1190 ;; `yas--table-uuidhash' for TABLE
   1191 ;;
   1192 ;; uuidhash       yas--template structs
   1193 ;; -------------------------------
   1194 ;; "The Foo" ---> [yas--template A]
   1195 ;; "Mrs Foo" ---> [yas--template B]
   1196 ;; "The Bar" ---> [yas--template C]
   1197 ;; "Baz"     ---> [yas--template D]
   1198 ;;
   1199 ;; FIXME: the more I look at this data-structure the more I think I'm
   1200 ;; stupid. There has to be an easier way (but beware lots of code
   1201 ;; depends on this).
   1202 ;;
   1203 (defun yas--remove-template-by-uuid (table uuid)
   1204   "Remove from TABLE a template identified by UUID."
   1205   (let ((template (gethash uuid (yas--table-uuidhash table))))
   1206     (when template
   1207       (let* ((name                (yas--template-name template))
   1208              (empty-keys          nil))
   1209         ;; Remove the name from each of the targeted namehashes
   1210         ;;
   1211         (maphash #'(lambda (k v)
   1212                      (let ((template (gethash name v)))
   1213                        (when (and template
   1214                                   (equal uuid (yas--template-uuid template)))
   1215                          (remhash name v)
   1216                          (when (zerop (hash-table-count v))
   1217                            (push k empty-keys)))))
   1218                  (yas--table-hash table))
   1219         ;; Remove the namehash themselves if they've become empty
   1220         ;;
   1221         (dolist (key empty-keys)
   1222           (when (vectorp key)
   1223             (define-key (yas--table-direct-keymap table) key nil))
   1224           (remhash key (yas--table-hash table)))
   1225 
   1226         ;; Finally, remove the uuid from the uuidhash
   1227         ;;
   1228         (remhash uuid (yas--table-uuidhash table))))))
   1229 
   1230 (defconst yas-maybe-expand-from-keymap
   1231   '(menu-item "" yas-expand-from-keymap
   1232               :filter yas--maybe-expand-from-keymap-filter))
   1233 
   1234 (defun yas--add-template (table template)
   1235   "Store in TABLE the snippet template TEMPLATE.
   1236 
   1237 KEY can be a string (trigger key) of a vector (direct
   1238 keybinding)."
   1239   (let ((name (yas--template-name template))
   1240         (key (yas--template-key template))
   1241         (keybinding (yas--template-keybinding template))
   1242         (_menu-binding-pair (yas--template-menu-binding-pair-get-create template)))
   1243     (dolist (k (remove nil (list key keybinding)))
   1244       (puthash name
   1245                template
   1246                (or (gethash k
   1247                             (yas--table-hash table))
   1248                    (puthash k
   1249                             (make-hash-table :test 'equal)
   1250                             (yas--table-hash table))))
   1251       (when (vectorp k)
   1252         (define-key (yas--table-direct-keymap table) k yas-maybe-expand-from-keymap)))
   1253 
   1254     ;; Update TABLE's `yas--table-uuidhash'
   1255     (puthash (yas--template-uuid template)
   1256              template
   1257              (yas--table-uuidhash table))))
   1258 
   1259 (defun yas--update-template (table template)
   1260   "Add or update TEMPLATE in TABLE.
   1261 
   1262 Also takes care of adding and updating to the associated menu.
   1263 Return TEMPLATE."
   1264   ;; Remove from table by uuid
   1265   ;;
   1266   (yas--remove-template-by-uuid table (yas--template-uuid template))
   1267   ;; Add to table again
   1268   ;;
   1269   (yas--add-template table template)
   1270   ;; Take care of the menu
   1271   ;;
   1272   (yas--update-template-menu table template)
   1273   template)
   1274 
   1275 (defun yas--update-template-menu (table template)
   1276   "Update every menu-related for TEMPLATE."
   1277   (let ((menu-binding-pair (yas--template-menu-binding-pair-get-create template))
   1278         (key (yas--template-key template))
   1279         (keybinding (yas--template-keybinding template)))
   1280     ;; The snippet might have changed name or keys, so update
   1281     ;; user-visible strings
   1282     ;;
   1283     (unless (eq (cdr menu-binding-pair) :none)
   1284       ;; the menu item name
   1285       ;;
   1286       (setf (cl-cadar menu-binding-pair) (yas--template-name template))
   1287       ;; the :keys information (also visible to the user)
   1288       (setf (cl-getf (cdr (car menu-binding-pair)) :keys)
   1289             (or (and keybinding (key-description keybinding))
   1290                 (and key (concat key yas-trigger-symbol))))))
   1291   (unless (yas--template-menu-managed-by-yas-define-menu template)
   1292     (let ((menu-keymap
   1293            (yas--menu-keymap-get-create (yas--table-mode table)
   1294                                         (mapcar #'yas--table-mode
   1295                                                 (yas--table-parents table))))
   1296           (group (yas--template-group template)))
   1297       ;; Remove from menu keymap
   1298       ;;
   1299       (cl-assert menu-keymap)
   1300       (yas--delete-from-keymap menu-keymap (yas--template-uuid template))
   1301 
   1302       ;; Add subgroups as necessary.
   1303       ;;
   1304       (dolist (subgroup group)
   1305         (let ((subgroup-keymap (lookup-key menu-keymap (vector (make-symbol subgroup)))))
   1306           (unless (and subgroup-keymap
   1307                        (keymapp subgroup-keymap))
   1308             (setq subgroup-keymap (make-sparse-keymap))
   1309             (define-key menu-keymap (vector (make-symbol subgroup))
   1310               `(menu-item ,subgroup ,subgroup-keymap)))
   1311           (setq menu-keymap subgroup-keymap)))
   1312 
   1313       ;; Add this entry to the keymap
   1314       ;;
   1315       (define-key menu-keymap
   1316         (vector (make-symbol (yas--template-uuid template)))
   1317         (car (yas--template-menu-binding-pair template))))))
   1318 
   1319 (defun yas--namehash-templates-alist (namehash)
   1320   "Return NAMEHASH as an alist."
   1321   (let (alist)
   1322     (maphash #'(lambda (k v)
   1323                  (push (cons k v) alist))
   1324              namehash)
   1325     alist))
   1326 
   1327 (defun yas--fetch (table key)
   1328   "Fetch templates in TABLE by KEY.
   1329 
   1330 Return a list of cons (NAME . TEMPLATE) where NAME is a
   1331 string and TEMPLATE is a `yas--template' structure."
   1332   (let* ((keyhash (yas--table-hash table))
   1333          (namehash (and keyhash (gethash key keyhash))))
   1334     (when namehash
   1335       (yas--filter-templates-by-condition (yas--namehash-templates-alist namehash)))))
   1336 
   1337 
   1338 ;;; Filtering/condition logic
   1339 
   1340 (defun yas--funcall-condition (fun &rest args)
   1341   (condition-case err
   1342       (save-excursion
   1343         (save-restriction
   1344           (save-match-data
   1345             (apply fun args))))
   1346     (error (progn
   1347              (yas--message 1 "Error in condition evaluation: %s"
   1348                            (error-message-string err))
   1349              nil))))
   1350 
   1351 
   1352 (defun yas--filter-templates-by-condition (templates)
   1353   "Filter the templates using the applicable condition.
   1354 
   1355 TEMPLATES is a list of cons (NAME . TEMPLATE) where NAME is a
   1356 string and TEMPLATE is a `yas--template' structure.
   1357 
   1358 This function implements the rules described in
   1359 `yas-buffer-local-condition'.  See that variables documentation."
   1360   (let ((requirement (yas--require-template-specific-condition-p)))
   1361     (if (eq requirement 'always)
   1362         templates
   1363       (cl-remove-if-not (lambda (pair)
   1364                           (yas--template-can-expand-p
   1365                            (yas--template-condition (cdr pair)) requirement))
   1366                         templates))))
   1367 
   1368 (defun yas--require-template-specific-condition-p ()
   1369   "Decide if this buffer requests/requires snippet-specific
   1370 conditions to filter out potential expansions."
   1371   (if (eq 'always yas-buffer-local-condition)
   1372       'always
   1373     (let ((local-condition
   1374            (or (cond
   1375                 ((functionp yas-buffer-local-condition)
   1376                  (yas--funcall-condition yas-buffer-local-condition))
   1377                 ((consp yas-buffer-local-condition)
   1378                  (yas--funcall-condition #'eval yas-buffer-local-condition t)))
   1379                yas-buffer-local-condition)))
   1380       (when local-condition
   1381         (if (eq local-condition t)
   1382             t
   1383           (and (consp local-condition)
   1384                (eq 'require-snippet-condition (car local-condition))
   1385                (symbolp (cdr local-condition))
   1386                (cdr local-condition)))))))
   1387 
   1388 (defun yas--template-can-expand-p (condition requirement)
   1389   "Evaluate CONDITION and REQUIREMENT and return a boolean."
   1390   (let* ((result (or (null condition)
   1391                      (yas--funcall-condition #'eval condition t))))
   1392     (cond ((eq requirement t)
   1393            result)
   1394           (t
   1395            (eq requirement result)))))
   1396 
   1397 (defun yas--table-templates (table)
   1398   (when table
   1399     (let ((acc (list)))
   1400       (maphash #'(lambda (_key namehash)
   1401                    (maphash #'(lambda (name template)
   1402                                 (push (cons name template) acc))
   1403                             namehash))
   1404                (yas--table-hash table))
   1405       (maphash #'(lambda (uuid template)
   1406                    (push (cons uuid template) acc))
   1407                (yas--table-uuidhash table))
   1408       (yas--filter-templates-by-condition acc))))
   1409 
   1410 (defun yas--templates-for-key-at-point ()
   1411   "Find `yas--template' objects for any trigger keys preceding point.
   1412 Returns (TEMPLATES START END). This function respects
   1413 `yas-key-syntaxes', which see."
   1414   (save-excursion
   1415     (let ((original (point))
   1416           (methods yas-key-syntaxes)
   1417           (templates)
   1418           (method))
   1419       (while (and methods
   1420                   (not templates))
   1421         (unless (eq method (car methods))
   1422           ;; TRICKY: `eq'-ness test means we can only be here if
   1423           ;; `method' is a function that returned `again', and hence
   1424           ;; don't revert back to original position as per
   1425           ;; `yas-key-syntaxes'.
   1426           (goto-char original))
   1427         (setq method (car methods))
   1428         (cond ((stringp method)
   1429                (skip-syntax-backward method)
   1430                (setq methods (cdr methods)))
   1431               ((functionp method)
   1432                (unless (eq (funcall method original)
   1433                            'again)
   1434                  (setq methods (cdr methods))))
   1435               (t
   1436                (setq methods (cdr methods))
   1437                (yas--warning "Invalid element `%s' in `yas-key-syntaxes'" method)))
   1438         (let ((possible-key (buffer-substring-no-properties (point) original)))
   1439           (save-excursion
   1440             (goto-char original)
   1441             (setq templates
   1442                   (cl-mapcan (lambda (table)
   1443                                (yas--fetch table possible-key))
   1444                              (yas--get-snippet-tables))))))
   1445       (when templates
   1446         (list templates (point) original)))))
   1447 
   1448 (defun yas--table-all-keys (table)
   1449   "Get trigger keys of all active snippets in TABLE."
   1450   (let ((acc))
   1451     (maphash #'(lambda (key namehash)
   1452                  (when (yas--filter-templates-by-condition (yas--namehash-templates-alist namehash))
   1453                    (push key acc)))
   1454              (yas--table-hash table))
   1455     acc))
   1456 
   1457 (defun yas--table-mode (table)
   1458   (intern (yas--table-name table)))
   1459 
   1460 
   1461 ;;; Internal functions and macros:
   1462 
   1463 (defun yas--remove-misc-free-from-undo (old-undo-list)
   1464   "Tries to work around Emacs Bug#30931.
   1465 Helper function for `yas--save-restriction-and-widen'."
   1466   ;; If Bug#30931 is unfixed, we get (#<Lisp_Misc_Free> . INTEGER)
   1467   ;; entries in the undo list.  If we call `type-of' on the
   1468   ;; Lisp_Misc_Free object then Emacs aborts, so try to find it by
   1469   ;; checking that its type is none of the expected ones.
   1470   (when (consp buffer-undo-list)
   1471     (let* ((prev buffer-undo-list)
   1472            (undo-list prev))
   1473       (while (and (consp undo-list)
   1474                   ;; Only check new entries.
   1475                   (not (eq undo-list old-undo-list)))
   1476         (let ((entry (pop undo-list)))
   1477           (when (consp entry)
   1478             (let ((head (car entry)))
   1479               (unless (or (stringp head)
   1480                           (markerp head)
   1481                           (integerp head)
   1482                           (symbolp head)
   1483                           (not (integerp (cdr entry))))
   1484                 ;; (message "removing misc free %S" entry)
   1485                 (setcdr prev undo-list)))))
   1486         (setq prev undo-list)))))
   1487 
   1488 (defmacro yas--save-restriction-and-widen (&rest body)
   1489   "Equivalent to (save-restriction (widen) BODY).
   1490 Also tries to work around Emacs Bug#30931."
   1491   (declare (debug (body)) (indent 0))
   1492   ;; Disable garbage collection, since it could cause an abort.
   1493   `(let ((gc-cons-threshold most-positive-fixnum)
   1494          (old-undo-list buffer-undo-list))
   1495      (prog1 (save-restriction
   1496               (widen)
   1497               ,@body)
   1498        (yas--remove-misc-free-from-undo old-undo-list))))
   1499 
   1500 (defun yas--eval-for-string (form)
   1501   "Evaluate FORM and convert the result to string."
   1502   (let ((debug-on-error (and (not (memq yas-good-grace '(t inline)))
   1503                              debug-on-error)))
   1504     (condition-case oops
   1505         (save-excursion
   1506           (yas--save-restriction-and-widen
   1507             (save-match-data
   1508               (let ((result (eval form t)))
   1509                 (when result
   1510                   (format "%s" result))))))
   1511       ((debug error) (error-message-string oops)))))
   1512 
   1513 (defun yas--eval-for-effect (form)
   1514   (yas--safely-call-fun (apply-partially #'eval form)))
   1515 
   1516 (defun yas--read-lisp (string &optional nil-on-error)
   1517   "Read STRING as an Elisp expression and return it.
   1518 
   1519 In case STRING in an invalid expression and NIL-ON-ERROR is nil,
   1520 return an expression that when evaluated will issue an error."
   1521   (condition-case err
   1522       (read string)
   1523     (error (and (not nil-on-error)
   1524                 `(error (error-message-string ',err))))))
   1525 
   1526 (defun yas--read-keybinding (keybinding)
   1527   "Read KEYBINDING as a snippet keybinding, return a vector."
   1528   (when (and keybinding
   1529              (not (string-match "keybinding" keybinding)))
   1530     (condition-case err
   1531         (let ((res (or (and (string-match "\\`\\[.*\\]\\'" keybinding)
   1532                             (read keybinding))
   1533                        (read-kbd-macro keybinding 'need-vector))))
   1534           res)
   1535       (error
   1536        (yas--message 2 "warning: keybinding \"%s\" invalid since %s."
   1537                 keybinding (error-message-string err))
   1538        nil))))
   1539 
   1540 (defun yas--table-get-create (mode)
   1541   "Get or create the snippet table corresponding to MODE."
   1542   (let ((table (gethash mode
   1543                         yas--tables)))
   1544     (unless table
   1545       (setq table (yas--make-snippet-table (symbol-name mode)))
   1546       (puthash mode table yas--tables)
   1547       (push (cons (intern (format "yas--direct-%s" mode))
   1548                   (yas--table-direct-keymap table))
   1549             yas--direct-keymaps))
   1550     table))
   1551 
   1552 (defun yas--get-snippet-tables (&optional mode)
   1553   "Get snippet tables for MODE.
   1554 
   1555 MODE defaults to the current buffer's `major-mode'.
   1556 
   1557 Return a list of `yas--table' objects.  The list of modes to
   1558 consider is returned by `yas--modes-to-activate'"
   1559   (remove nil
   1560           (mapcar #'(lambda (name)
   1561                       (gethash name yas--tables))
   1562                   (yas--modes-to-activate mode))))
   1563 
   1564 (defun yas--menu-keymap-get-create (mode &optional parents)
   1565   "Get or create the menu keymap for MODE and its PARENTS.
   1566 
   1567 This may very well create a plethora of menu keymaps and arrange
   1568 them all in `yas--menu-table'"
   1569   (let* ((menu-keymap (or (gethash mode yas--menu-table)
   1570                           (puthash mode (make-sparse-keymap) yas--menu-table))))
   1571     (mapc #'yas--menu-keymap-get-create parents)
   1572     (define-key yas--minor-mode-menu (vector mode)
   1573         `(menu-item ,(symbol-name mode) ,menu-keymap
   1574                     :visible (yas--show-menu-p ',mode)))
   1575     menu-keymap))
   1576 
   1577 
   1578 ;;; Template-related and snippet loading functions
   1579 
   1580 (defun yas--parse-template (&optional file)
   1581   "Parse the template in the current buffer.
   1582 
   1583 Optional FILE is the absolute file name of the file being
   1584 parsed.
   1585 
   1586 Optional GROUP is the group where the template is to go,
   1587 otherwise we attempt to calculate it from FILE.
   1588 
   1589 Return a snippet-definition, i.e. a list
   1590 
   1591  (KEY TEMPLATE NAME CONDITION GROUP VARS LOAD-FILE KEYBINDING UUID)
   1592 
   1593 If the buffer contains a line of \"# --\" then the contents above
   1594 this line are ignored. Directives can set most of these with the syntax:
   1595 
   1596 # directive-name : directive-value
   1597 
   1598 Here's a list of currently recognized directives:
   1599 
   1600  * type
   1601  * name
   1602  * contributor
   1603  * condition
   1604  * group
   1605  * key
   1606  * expand-env
   1607  * binding
   1608  * uuid"
   1609   (goto-char (point-min))
   1610   (let* ((type 'snippet)
   1611          (name (and file
   1612                     (file-name-nondirectory file)))
   1613          (key nil)
   1614          template
   1615          condition
   1616          (group (and file
   1617                      (yas--calculate-group file)))
   1618          expand-env
   1619          binding
   1620          uuid)
   1621     (if (re-search-forward "^# --\\s-*\n" nil t)
   1622         (let ((bound (point)))
   1623           (setq template
   1624                 (buffer-substring-no-properties (point)
   1625                                                 (point-max)))
   1626           (goto-char (point-min))
   1627           (while (re-search-forward
   1628                   "^# *\\([^ ]+?\\) *: *\\(.*?\\)[[:space:]]*$" bound t)
   1629             (let ((val (match-string-no-properties 2)))
   1630               (pcase (match-string-no-properties 1)
   1631                 ("uuid"      (setq uuid val))
   1632                 ("type"      (setq type (intern val)))
   1633                 ("key"       (setq key val))
   1634                 ("name"      (setq name val))
   1635                 ("condition" (setq condition (yas--read-lisp val)))
   1636                 ("group"     (setq group val))
   1637                 ("expand-env"
   1638                  (setq expand-env (yas--read-lisp val 'nil-on-error)))
   1639                 ("binding" (setq binding val))
   1640                 ("contributor" nil) ;Documented in `snippet-development.org'.
   1641                 (dir (message "Ignoring unknown directive %S in file: %s"
   1642                               dir file))))))
   1643       (setq template
   1644             (buffer-substring-no-properties (point-min) (point-max))))
   1645     (unless (or key binding)
   1646       (setq key (and file (file-name-nondirectory file))))
   1647     (when (eq type 'command)
   1648       (setq template (yas--read-lisp (concat "(progn" template ")"))))
   1649     (when group
   1650       (setq group (split-string group "\\.")))
   1651     (list key template name condition group expand-env file binding uuid)))
   1652 
   1653 (defun yas--calculate-group (file)
   1654   "Calculate the group for snippet file path FILE."
   1655   (let* ((dominating-dir (locate-dominating-file file
   1656                                                  ".yas-make-groups"))
   1657          (extra-path (and dominating-dir
   1658                           (file-relative-name file dominating-dir)))
   1659          (extra-dir (and extra-path
   1660                          (file-name-directory extra-path)))
   1661          (group (and extra-dir
   1662                      (replace-regexp-in-string "/"
   1663                                                "."
   1664                                                (directory-file-name extra-dir)))))
   1665     group))
   1666 
   1667 (defun yas--subdirs (directory &optional filep)
   1668   "Return subdirs or files of DIRECTORY according to FILEP."
   1669   (cl-remove-if (lambda (file)
   1670                   (or (string-match "\\`\\."
   1671                                     (file-name-nondirectory file))
   1672                       (string-match "\\`#.*#\\'"
   1673                                     (file-name-nondirectory file))
   1674                       (string-match "~\\'"
   1675                                     (file-name-nondirectory file))
   1676                       (if filep
   1677                           (file-directory-p file)
   1678                         (not (file-directory-p file)))))
   1679                 (directory-files directory t)))
   1680 
   1681 (defun yas--make-menu-binding (template)
   1682   (let ((mode (yas--table-mode (yas--template-table template))))
   1683     `(lambda () (interactive) (yas--expand-or-visit-from-menu ',mode ,(yas--template-uuid template)))))
   1684 
   1685 (defun yas--expand-or-visit-from-menu (mode uuid)
   1686   (let* ((table (yas--table-get-create mode))
   1687          (yas--current-template (and table
   1688                                     (gethash uuid (yas--table-uuidhash table)))))
   1689     (when yas--current-template
   1690       (if yas-visit-from-menu
   1691           (yas--visit-snippet-file-1 yas--current-template)
   1692         (let ((where (if (region-active-p)
   1693                          (cons (region-beginning) (region-end))
   1694                        (cons (point) (point)))))
   1695           (yas-expand-snippet yas--current-template
   1696                               (car where) (cdr where)))))))
   1697 
   1698 (defun yas--key-from-desc (text)
   1699   "Return a yasnippet key from a description string TEXT."
   1700   (replace-regexp-in-string "\\(\\w+\\).*" "\\1" text))
   1701 
   1702 
   1703 ;;; Popping up for keys and templates
   1704 
   1705 (defun yas--prompt-for-template (templates &optional prompt)
   1706   "Interactively choose a template from the list TEMPLATES.
   1707 
   1708 TEMPLATES is a list of `yas--template'.
   1709 
   1710 Optional PROMPT sets the prompt to use."
   1711   (when templates
   1712     (setq templates
   1713           (sort templates #'(lambda (t1 t2)
   1714                               (< (length (yas--template-name t1))
   1715                                  (length (yas--template-name t2))))))
   1716     (cl-some (lambda (fn)
   1717                (funcall fn (or prompt "Choose a snippet: ")
   1718                         templates
   1719                         #'yas--template-name))
   1720              yas-prompt-functions)))
   1721 
   1722 (defun yas--prompt-for-keys (keys &optional prompt)
   1723   "Interactively choose a template key from the list KEYS.
   1724 
   1725 Optional PROMPT sets the prompt to use."
   1726   (when keys
   1727     (cl-some (lambda (fn)
   1728                (funcall fn (or prompt "Choose a snippet key: ") keys))
   1729              yas-prompt-functions)))
   1730 
   1731 (defun yas--prompt-for-table (tables &optional prompt)
   1732   "Interactively choose a table from the list TABLES.
   1733 
   1734 Optional PROMPT sets the prompt to use."
   1735   (when tables
   1736     (cl-some (lambda (fn)
   1737                (funcall fn (or prompt "Choose a snippet table: ")
   1738                         tables
   1739                         #'yas--table-name))
   1740              yas-prompt-functions)))
   1741 
   1742 (defun yas-x-prompt (prompt choices &optional display-fn)
   1743   "Display choices in a x-window prompt."
   1744   (when (and window-system choices)
   1745     ;; Let window position be recalculated to ensure that
   1746     ;; `posn-at-point' returns non-nil.
   1747     (redisplay)
   1748     (or
   1749      (x-popup-menu
   1750       (let ((x-y (posn-x-y (posn-at-point (point)))))
   1751         (list (list (+ (car x-y) 10)
   1752                     (+ (cdr x-y) 20))
   1753               (selected-window)))
   1754       `(,prompt ("title"
   1755                  ,@(cl-mapcar (lambda (c d) `(,(concat "   " d) . ,c))
   1756                               choices
   1757                               (if display-fn (mapcar display-fn choices)
   1758                                 choices)))))
   1759      (keyboard-quit))))
   1760 
   1761 (defun yas-maybe-ido-prompt (prompt choices &optional display-fn)
   1762   (when (bound-and-true-p ido-mode)
   1763     (yas-ido-prompt prompt choices display-fn)))
   1764 
   1765 (defun yas-ido-prompt (prompt choices &optional display-fn)
   1766   (require 'ido)
   1767   (yas-completing-prompt prompt choices display-fn #'ido-completing-read))
   1768 
   1769 (defun yas-dropdown-prompt (_prompt choices &optional display-fn)
   1770   (when (fboundp 'dropdown-list)
   1771     (let* ((formatted-choices
   1772             (if display-fn (mapcar display-fn choices) choices))
   1773            (n (dropdown-list formatted-choices)))
   1774       (if n (nth n choices)
   1775         (keyboard-quit)))))
   1776 
   1777 (defun yas-completing-prompt (prompt choices &optional display-fn completion-fn)
   1778   (let* ((formatted-choices
   1779           (if display-fn (mapcar display-fn choices) choices))
   1780          (chosen (funcall (or completion-fn #'completing-read)
   1781                           prompt formatted-choices
   1782                           nil 'require-match nil nil)))
   1783     (if (eq choices formatted-choices)
   1784         chosen
   1785       (nth (or (cl-position chosen formatted-choices :test #'string=) 0)
   1786            choices))))
   1787 
   1788 (defun yas-no-prompt (_prompt choices &optional _display-fn)
   1789   (cl-first choices))
   1790 
   1791 
   1792 ;;; Defining snippets
   1793 ;; This consists of creating and registering `yas--template' objects in the
   1794 ;; correct tables.
   1795 ;;
   1796 
   1797 (defvar yas--creating-compiled-snippets nil)
   1798 
   1799 (defun yas--define-snippets-1 (snippet snippet-table)
   1800   "Helper for `yas-define-snippets'."
   1801   ;; Update the appropriate table.  Also takes care of adding the
   1802   ;; key indicators in the templates menu entry, if any.
   1803   (yas--update-template
   1804    snippet-table (apply #'yas--define-snippets-2 snippet-table snippet)))
   1805 
   1806 (defun yas-define-snippets (mode snippets)
   1807   "Define SNIPPETS for MODE.
   1808 
   1809 SNIPPETS is a list of snippet definitions, each taking the
   1810 following form
   1811 
   1812  (KEY TEMPLATE
   1813   NAME CONDITION GROUP EXPAND-ENV LOAD-FILE KEYBINDING UUID SAVE-FILE)
   1814 
   1815 Within these, only KEY and TEMPLATE are actually mandatory.
   1816 
   1817 TEMPLATE might be a Lisp form or a string, depending on whether
   1818 this is a snippet or a snippet-command.
   1819 
   1820 CONDITION, EXPAND-ENV and KEYBINDING are Lisp forms, they have
   1821 been `yas--read-lisp'-ed and will eventually be
   1822 `yas--eval-for-string'-ed.
   1823 
   1824 The remaining elements are strings.
   1825 
   1826 FILE is probably of very little use if you're programatically
   1827 defining snippets.
   1828 
   1829 UUID is the snippet's \"unique-id\". Loading a second snippet
   1830 file with the same uuid would replace the previous snippet.
   1831 
   1832 You can use `yas--parse-template' to return such lists based on
   1833 the current buffers contents."
   1834   (if yas--creating-compiled-snippets
   1835       (let ((print-length nil))
   1836         (insert ";;; Snippet definitions:\n;;;\n")
   1837         (insert (pp-to-string
   1838                  `(yas-define-snippets ',mode ',snippets)))
   1839         (insert "\n\n"))
   1840     ;; Normal case.
   1841     (let ((snippet-table (yas--table-get-create mode))
   1842           (uuids nil)
   1843           (template nil))
   1844       (dolist (snippet snippets)
   1845         (setq template (yas--define-snippets-1 snippet
   1846                                                snippet-table))
   1847         (let ((uuid (yas--template-uuid template)))
   1848           (if (member uuid uuids)
   1849               ;; It's normal for a snippet to override another one
   1850               ;; in `snippet-table`, but not one in `snippets`.
   1851               (message "Multiple snippets with same identity: %S" uuid)
   1852             (push uuid uuids))))
   1853       template)))
   1854 
   1855 
   1856 ;;; Loading snippets from files
   1857 
   1858 (defun yas--template-get-file (template)
   1859   "Return TEMPLATE's LOAD-FILE or SAVE-FILE."
   1860   (or (yas--template-load-file template)
   1861       (let ((file (yas--template-save-file template)))
   1862         (when file
   1863           (yas--message 3 "%s has no load file, using save file, %s, instead."
   1864                         (yas--template-name template) file))
   1865         file)))
   1866 
   1867 (defun yas--load-yas-setup-file (file)
   1868   (if (not yas--creating-compiled-snippets)
   1869       ;; Normal case.
   1870       (load file 'noerror (<= yas-verbosity 4))
   1871     (let ((elfile (concat file ".el")))
   1872       (when (file-exists-p elfile)
   1873         (insert ";;; contents of the .yas-setup.el support file:\n;;;\n")
   1874         (insert-file-contents elfile)
   1875         (goto-char (point-max))))))
   1876 
   1877 (defun yas--define-parents (mode parents)
   1878   "Add PARENTS to the list of MODE's parents."
   1879   (dolist (child (get mode 'yas--cached-children))
   1880     (put child 'yas--all-parents nil))  ;Flush the cache for children.
   1881   (put 'mode 'yas--cached-children nil)
   1882   (puthash mode (cl-remove-duplicates
   1883                  (append parents
   1884                          (gethash mode yas--parents)))
   1885            yas--parents))
   1886 
   1887 (defun yas-load-directory (top-level-dir &optional use-jit interactive)
   1888   "Load snippets in directory hierarchy TOP-LEVEL-DIR.
   1889 
   1890 Below TOP-LEVEL-DIR each directory should be a mode name.
   1891 
   1892 With prefix argument USE-JIT do jit-loading of snippets."
   1893   (interactive
   1894    (list (read-directory-name "Select the root directory: " nil nil t)
   1895          current-prefix-arg t))
   1896   (unless yas-snippet-dirs
   1897     (setq yas-snippet-dirs top-level-dir))
   1898   (let ((impatient-buffers))
   1899     (dolist (dir (yas--subdirs top-level-dir))
   1900       (let* ((major-mode-and-parents (yas--compute-major-mode-and-parents
   1901                                       (concat dir "/dummy")))
   1902              (mode-sym (car major-mode-and-parents))
   1903              (parents (cdr major-mode-and-parents)))
   1904         ;; Attention: The parents and the menus are already defined
   1905         ;; here, even if the snippets are later jit-loaded.
   1906         ;;
   1907         ;; * We need to know the parents at this point since entering a
   1908         ;;   given mode should jit load for its parents
   1909         ;;   immediately. This could be reviewed, the parents could be
   1910         ;;   discovered just-in-time-as well
   1911         ;;
   1912         ;; * We need to create the menus here to support the `full'
   1913         ;;   option to `yas-use-menu' (all known snippet menus are shown to the user)
   1914         ;;
   1915         (yas--define-parents mode-sym parents)
   1916         (yas--menu-keymap-get-create mode-sym)
   1917         (let ((fun (apply-partially #'yas--load-directory-1 dir mode-sym)))
   1918           (if use-jit
   1919               (yas--schedule-jit mode-sym fun)
   1920             (funcall fun)))
   1921         ;; Look for buffers that are already in `mode-sym', and so
   1922         ;; need the new snippets immediately...
   1923         ;;
   1924         (when use-jit
   1925           (cl-loop for buffer in (buffer-list)
   1926                    do (with-current-buffer buffer
   1927                         (when (eq major-mode mode-sym)
   1928                           (yas--message 4 "Discovered there was already %s in %s" buffer mode-sym)
   1929                           (push buffer impatient-buffers)))))))
   1930     ;; ...after TOP-LEVEL-DIR has been completely loaded, call
   1931     ;; `yas--load-pending-jits' in these impatient buffers.
   1932     ;;
   1933     (cl-loop for buffer in impatient-buffers
   1934              do (with-current-buffer buffer (yas--load-pending-jits))))
   1935   (when interactive
   1936     (yas--message 3 "Loaded snippets from %s." top-level-dir)))
   1937 
   1938 (defun yas--load-directory-1 (directory mode-sym)
   1939   "Recursively load snippet templates from DIRECTORY."
   1940   (if yas--creating-compiled-snippets
   1941       (let ((output-file (expand-file-name ".yas-compiled-snippets.el"
   1942                                            directory)))
   1943         (with-temp-file output-file
   1944           (insert (format ";;; Compiled snippets and support files for `%s'\n"
   1945                           mode-sym))
   1946           (yas--load-directory-2 directory mode-sym)
   1947           (insert (format ";;; Do not edit! File generated at %s\n"
   1948                           (current-time-string)))))
   1949     ;; Normal case.
   1950     (unless (file-exists-p (expand-file-name ".yas-skip" directory))
   1951       (unless (and (load (expand-file-name ".yas-compiled-snippets" directory)
   1952                          'noerror (<= yas-verbosity 3))
   1953                    (progn (yas--message 4 "Loaded compiled snippets from %s" directory) t))
   1954         (yas--message 4 "Loading snippet files from %s" directory)
   1955         (yas--load-directory-2 directory mode-sym)))))
   1956 
   1957 (defun yas--load-directory-2 (directory mode-sym)
   1958   ;; Load .yas-setup.el files wherever we find them
   1959   ;;
   1960   (yas--load-yas-setup-file (expand-file-name ".yas-setup" directory))
   1961   (let* ((default-directory directory)
   1962          (snippet-defs nil))
   1963     ;; load the snippet files
   1964     ;;
   1965     (with-temp-buffer
   1966       (dolist (file (yas--subdirs directory 'no-subdirs-just-files))
   1967         (when (file-readable-p file)
   1968           ;; Erase the buffer instead of passing non-nil REPLACE to
   1969           ;; `insert-file-contents' (avoids Emacs bug #23659).
   1970           (erase-buffer)
   1971           (insert-file-contents file)
   1972           (push (yas--parse-template file)
   1973                 snippet-defs))))
   1974     (when snippet-defs
   1975       (yas-define-snippets mode-sym
   1976                            snippet-defs))
   1977     ;; now recurse to a lower level
   1978     ;;
   1979     (dolist (subdir (yas--subdirs directory))
   1980       (yas--load-directory-2 subdir
   1981                             mode-sym))))
   1982 
   1983 (defun yas--load-snippet-dirs (&optional nojit)
   1984   "Reload the directories listed in `yas-snippet-dirs' or
   1985 prompt the user to select one."
   1986   (let (errors)
   1987     (if (null yas-snippet-dirs)
   1988         (call-interactively 'yas-load-directory)
   1989       (when (member yas--default-user-snippets-dir yas-snippet-dirs)
   1990         (make-directory yas--default-user-snippets-dir t))
   1991       (dolist (directory (reverse (yas-snippet-dirs)))
   1992         (cond ((file-directory-p directory)
   1993                (yas-load-directory directory (not nojit))
   1994                (if nojit
   1995                    (yas--message 4 "Loaded %s" directory)
   1996                  (yas--message 4 "Prepared just-in-time loading for %s" directory)))
   1997               (t
   1998                (push (yas--message 1 "Check your `yas-snippet-dirs': %s is not a directory" directory) errors)))))
   1999     errors))
   2000 
   2001 (defun yas-reload-all (&optional no-jit interactive)
   2002   "Reload all snippets and rebuild the YASnippet menu.
   2003 
   2004 When NO-JIT is non-nil force immediate reload of all known
   2005 snippets under `yas-snippet-dirs', otherwise use just-in-time
   2006 loading.
   2007 
   2008 When called interactively, use just-in-time loading when given a
   2009 prefix argument."
   2010   (interactive (list (not current-prefix-arg) t))
   2011   (catch 'abort
   2012     (let ((errors)
   2013           (snippet-editing-buffers
   2014            (cl-remove-if-not (lambda (buffer)
   2015                                (with-current-buffer buffer
   2016                                  yas--editing-template))
   2017                              (buffer-list))))
   2018 
   2019       (mapatoms #'yas--flush-all-parents)
   2020 
   2021       ;; Warn if there are buffers visiting snippets, since reloading will break
   2022       ;; any on-line editing of those buffers.
   2023       ;;
   2024       (when snippet-editing-buffers
   2025           (if interactive
   2026               (if (y-or-n-p "Some buffers editing live snippets, close them and proceed with reload? ")
   2027                   (mapc #'kill-buffer snippet-editing-buffers)
   2028                 (yas--message 1 "Aborted reload...")
   2029                 (throw 'abort nil))
   2030             ;; in a non-interactive use, at least set
   2031             ;; `yas--editing-template' to nil, make it guess it next time around
   2032             (mapc #'(lambda (buffer)
   2033                       (with-current-buffer buffer
   2034                         (kill-local-variable 'yas--editing-template)))
   2035                   (buffer-list))))
   2036 
   2037       ;; Empty all snippet tables and parenting info
   2038       ;;
   2039       (setq yas--tables (make-hash-table))
   2040       (setq yas--parents (make-hash-table))
   2041 
   2042       ;; Before killing `yas--menu-table' use its keys to cleanup the
   2043       ;; mode menu parts of `yas--minor-mode-menu' (thus also cleaning
   2044       ;; up `yas-minor-mode-map', which points to it)
   2045       ;;
   2046       (maphash #'(lambda (menu-symbol _keymap)
   2047                    (define-key yas--minor-mode-menu (vector menu-symbol) nil))
   2048                yas--menu-table)
   2049       ;; Now empty `yas--menu-table' as well
   2050       (setq yas--menu-table (make-hash-table))
   2051 
   2052       ;; Cancel all pending 'yas--scheduled-jit-loads'
   2053       ;;
   2054       (setq yas--scheduled-jit-loads (make-hash-table))
   2055 
   2056       ;; Reload the directories listed in `yas-snippet-dirs' or prompt
   2057       ;; the user to select one.
   2058       ;;
   2059       (setq errors (yas--load-snippet-dirs no-jit))
   2060       ;; Reload the direct keybindings
   2061       ;;
   2062       (yas-direct-keymaps-reload)
   2063 
   2064       (run-hooks 'yas-after-reload-hook)
   2065       (let ((no-snippets
   2066              (cl-every (lambda (table) (= (hash-table-count table) 0))
   2067                        (list yas--scheduled-jit-loads
   2068                              yas--parents yas--tables))))
   2069         (yas--message (if (or no-snippets errors) 2 3)
   2070                       (if no-jit "Snippets loaded %s."
   2071                         "Prepared just-in-time loading of snippets %s.")
   2072                       (cond (errors
   2073                              "with some errors.  Check *Messages*")
   2074                             (no-snippets
   2075                              "(but no snippets found)")
   2076                             (t
   2077                              "successfully")))))))
   2078 
   2079 (defvar yas-after-reload-hook nil
   2080   "Hook run after `yas-reload-all'.")
   2081 
   2082 (defun yas--load-pending-jits ()
   2083   (dolist (mode (yas--modes-to-activate))
   2084     (let ((funs (reverse (gethash mode yas--scheduled-jit-loads))))
   2085       ;; must reverse to maintain coherence with `yas-snippet-dirs'
   2086       (dolist (fun funs)
   2087         (yas--message 4 "Loading for `%s', just-in-time: %s!" mode fun)
   2088         (funcall fun))
   2089       (remhash mode yas--scheduled-jit-loads))))
   2090 
   2091 (defun yas-escape-text (text)
   2092   "Escape TEXT for snippet."
   2093   (when text
   2094     (replace-regexp-in-string "[\\$]" "\\\\\\&" text)))
   2095 
   2096 
   2097 ;;; Snippet compilation function
   2098 
   2099 (defun yas-compile-directory (top-level-dir)
   2100   "Create .yas-compiled-snippets.el files under subdirs of TOP-LEVEL-DIR.
   2101 
   2102 This works by stubbing a few functions, then calling
   2103 `yas-load-directory'."
   2104   (interactive "DTop level snippet directory? ")
   2105   (let ((yas--creating-compiled-snippets t))
   2106     (yas-load-directory top-level-dir nil)))
   2107 
   2108 (defun yas-recompile-all ()
   2109   "Compile every dir in `yas-snippet-dirs'."
   2110   (interactive)
   2111   (mapc #'yas-compile-directory (yas-snippet-dirs)))
   2112 
   2113 
   2114 ;;; JIT loading
   2115 ;;;
   2116 
   2117 (defvar yas--scheduled-jit-loads (make-hash-table)
   2118   "Alist of mode-symbols to forms to be evaled when `yas-minor-mode' kicks in.")
   2119 
   2120 (defun yas--schedule-jit (mode fun)
   2121   (push fun (gethash mode yas--scheduled-jit-loads)))
   2122 
   2123 
   2124 
   2125 ;;; Some user level functions
   2126 
   2127 (defun yas-about ()
   2128   (interactive)
   2129   (message "yasnippet (version %s) -- pluskid/joaotavora/npostavs"
   2130            (or (ignore-errors (car (let ((default-directory yas--loaddir))
   2131                                      (process-lines "git" "describe"
   2132                                                     "--tags" "--dirty"))))
   2133                (eval-when-compile
   2134                  (and (fboundp 'package-get-version)
   2135                       (package-get-version)))
   2136                (when (and (featurep 'package)
   2137                           (fboundp 'package-desc-version)
   2138                           (fboundp 'package-version-join))
   2139                  (defvar package-alist)
   2140                  (ignore-errors
   2141                    (let* ((yas-pkg (cdr (assq 'yasnippet package-alist)))
   2142                           (version (package-version-join
   2143                                     (package-desc-version (car yas-pkg)))))
   2144                      ;; Special case for MELPA's bogus version numbers.
   2145                      (if (string-match "\\`20..[01][0-9][0-3][0-9][.][0-9]\\{3,4\\}\\'"
   2146                                        version)
   2147                          (concat yas--version "-snapshot" version)
   2148                        version))))
   2149                yas--version)))
   2150 
   2151 
   2152 ;;; Apropos snippet menu:
   2153 ;;
   2154 ;; The snippet menu keymaps are stored by mode in hash table called
   2155 ;; `yas--menu-table'. They are linked to the main menu in
   2156 ;; `yas--menu-keymap-get-create' and are initially created empty,
   2157 ;; reflecting the table hierarchy.
   2158 ;;
   2159 ;; They can be populated in two mutually exclusive ways: (1) by
   2160 ;; reading `yas--template-group', which in turn is populated by the "#
   2161 ;; group:" directives of the snippets or the ".yas-make-groups" file
   2162 ;; or (2) by using a separate `yas-define-menu' call, which declares a
   2163 ;; menu structure based on snippets uuids.
   2164 ;;
   2165 ;; Both situations are handled in `yas--update-template-menu', which
   2166 ;; uses the predicate `yas--template-menu-managed-by-yas-define-menu'
   2167 ;; that can tell between the two situations.
   2168 ;;
   2169 ;; Note:
   2170 ;;
   2171 ;; * if `yas-define-menu' is used it must run before
   2172 ;;   `yas-define-snippets' and the UUIDS must match, otherwise we get
   2173 ;;   duplicate entries. The `yas--template' objects are created in
   2174 ;;   `yas-define-menu', holding nothing but the menu entry,
   2175 ;;   represented by a pair of ((menu-item NAME :keys KEYS) TYPE) and
   2176 ;;   stored in `yas--template-menu-binding-pair'.  The (menu-item ...)
   2177 ;;   part is then stored in the menu keymap itself which make the item
   2178 ;;   appear to the user.  These limitations could probably be revised.
   2179 ;;
   2180 ;; * The `yas--template-perm-group' slot is only used in
   2181 ;;   `yas-describe-tables'.
   2182 ;;
   2183 (defun yas--template-menu-binding-pair-get-create (template &optional type)
   2184   "Get TEMPLATE's menu binding or assign it a new one.
   2185 
   2186 TYPE may be `:stay', signaling this menu binding should be
   2187 static in the menu."
   2188   (or (yas--template-menu-binding-pair template)
   2189       (let (;; (key (yas--template-key template))
   2190             ;; (keybinding (yas--template-keybinding template))
   2191             )
   2192         (setf (yas--template-menu-binding-pair template)
   2193               (cons `(menu-item ,(or (yas--template-name template)
   2194                                      (yas--template-uuid template))
   2195                                 ,(yas--make-menu-binding template)
   2196                                 :keys ,nil)
   2197                     type)))))
   2198 (defun yas--template-menu-managed-by-yas-define-menu (template)
   2199   "Non-nil if TEMPLATE's menu entry was included in a `yas-define-menu' call."
   2200   (cdr (yas--template-menu-binding-pair template)))
   2201 
   2202 
   2203 (defun yas--show-menu-p (mode)
   2204   (cond ((eq yas-use-menu 'abbreviate)
   2205          (cl-find mode
   2206                   (mapcar #'yas--table-mode
   2207                           (yas--get-snippet-tables))))
   2208         (yas-use-menu t)))
   2209 
   2210 (defun yas--delete-from-keymap (keymap uuid)
   2211   "Recursively delete items with UUID from KEYMAP and its submenus."
   2212 
   2213   ;; XXX: This used to skip any submenus named \"parent mode\"
   2214   ;;
   2215   ;; First of all, recursively enter submenus, i.e. the tree is
   2216   ;; searched depth first so that stale submenus can be found in the
   2217   ;; higher passes.
   2218   ;;
   2219   (mapc #'(lambda (item)
   2220             (when (and (consp (cdr-safe item))
   2221                        (keymapp (nth 2 (cdr item))))
   2222               (yas--delete-from-keymap (nth 2 (cdr item)) uuid)))
   2223         (cdr keymap))
   2224   ;; Set the uuid entry to nil
   2225   ;;
   2226   (define-key keymap (vector (make-symbol uuid)) nil)
   2227   ;; Destructively modify keymap
   2228   ;;
   2229   (setcdr keymap (cl-delete-if (lambda (item)
   2230                                  (cond ((not (listp item)) nil)
   2231                                        ((null (cdr item)))
   2232                                        ((and (keymapp (nth 2 (cdr item)))
   2233                                              (null (cdr (nth 2 (cdr item))))))))
   2234                                (cdr keymap))))
   2235 
   2236 (defun yas-define-menu (mode menu &optional omit-items)
   2237   "Define a snippet menu for MODE according to MENU, omitting OMIT-ITEMS.
   2238 
   2239 MENU is a list, its elements can be:
   2240 
   2241 - (yas-item UUID) : Creates an entry the snippet identified with
   2242   UUID.  The menu entry for a snippet thus identified is
   2243   permanent, i.e. it will never move (be reordered) in the menu.
   2244 
   2245 - (yas-separator) : Creates a separator
   2246 
   2247 - (yas-submenu NAME SUBMENU) : Creates a submenu with NAME,
   2248   SUBMENU has the same form as MENU.  NAME is also added to the
   2249   list of groups of the snippets defined thereafter.
   2250 
   2251 OMIT-ITEMS is a list of snippet uuids that will always be
   2252 omitted from MODE's menu, even if they're manually loaded."
   2253   (let* ((table (yas--table-get-create mode))
   2254          (hash (yas--table-uuidhash table)))
   2255     (yas--define-menu-1 table
   2256                         (yas--menu-keymap-get-create mode)
   2257                         menu
   2258                         hash)
   2259     (dolist (uuid omit-items)
   2260       (let ((template (or (gethash uuid hash)
   2261                           (puthash uuid
   2262                                    (yas--make-template :table table
   2263                                                        :uuid uuid)
   2264                                    hash))))
   2265         (setf (yas--template-menu-binding-pair template) (cons nil :none))))))
   2266 
   2267 (defun yas--define-menu-1 (table menu-keymap menu uuidhash &optional group-list)
   2268   "Helper for `yas-define-menu'."
   2269   (cl-loop
   2270    for (type name submenu) in (reverse menu)
   2271    collect (cond
   2272             ((or (eq type 'yas-item)
   2273                  (and yas-alias-to-yas/prefix-p
   2274                       (eq type 'yas/item)))
   2275              (let ((template (or (gethash name uuidhash)
   2276                                  (puthash name
   2277                                           (yas--make-template
   2278                                            :table table
   2279                                            :perm-group group-list
   2280                                            :uuid name)
   2281                                           uuidhash))))
   2282                (car (yas--template-menu-binding-pair-get-create
   2283                      template :stay))))
   2284             ((or (eq type 'yas-submenu)
   2285                  (and yas-alias-to-yas/prefix-p
   2286                       (eq type 'yas/submenu)))
   2287              (let ((subkeymap (make-sparse-keymap)))
   2288                (yas--define-menu-1 table subkeymap submenu uuidhash
   2289                                    (append group-list (list name)))
   2290                `(menu-item ,name ,subkeymap)))
   2291             ((or (eq type 'yas-separator)
   2292                  (and yas-alias-to-yas/prefix-p
   2293                       (eq type 'yas/separator)))
   2294              '(menu-item "----"))
   2295             (t (yas--message 1 "Don't know anything about menu entry %s" type)
   2296                nil))
   2297    into menu-entries
   2298    finally do (push (apply #'vector menu-entries) (cdr menu-keymap))))
   2299 
   2300 (defun yas--define (mode key template &optional name condition group)
   2301   "Define a snippet.  Expanding KEY into TEMPLATE.
   2302 
   2303 NAME is a description to this template.  Also update the menu if
   2304 `yas-use-menu' is t.  CONDITION is the condition attached to
   2305 this snippet.  If you attach a condition to a snippet, then it
   2306 will only be expanded when the condition evaluated to non-nil."
   2307   (yas-define-snippets mode
   2308                        (list (list key template name condition group))))
   2309 
   2310 (defun yas-hippie-try-expand (first-time?)
   2311   "Integrate with hippie expand.
   2312 
   2313 Just put this function in `hippie-expand-try-functions-list'."
   2314   (when yas-minor-mode
   2315     (if (not first-time?)
   2316         (let ((yas-fallback-behavior 'return-nil))
   2317           (yas-expand))
   2318       (undo 1)
   2319       nil)))
   2320 
   2321 
   2322 ;;; Apropos condition-cache:
   2323 ;;;
   2324 ;;;
   2325 ;;;
   2326 ;;;
   2327 (defmacro yas-define-condition-cache (func doc &rest body)
   2328   "Define a function FUNC with doc DOC and body BODY.
   2329 BODY is executed at most once every snippet expansion attempt, to check
   2330 expansion conditions.
   2331 
   2332 It doesn't make any sense to call FUNC programatically."
   2333   `(defun ,func () ,(if (and doc
   2334                              (stringp doc))
   2335                         (concat doc
   2336 "\n\nFor use in snippets' conditions. Within each
   2337 snippet-expansion routine like `yas-expand', computes actual
   2338 value for the first time then always returns a cached value.")
   2339                       (setq body (cons doc body))
   2340                       nil)
   2341      (let ((timestamp-and-value (get ',func 'yas--condition-cache)))
   2342        (if (equal (car timestamp-and-value) yas--condition-cache-timestamp)
   2343            (cdr timestamp-and-value)
   2344          (let ((new-value (progn
   2345                             ,@body
   2346                             )))
   2347            (put ',func 'yas--condition-cache (cons yas--condition-cache-timestamp new-value))
   2348            new-value)))))
   2349 
   2350 (defalias 'yas-expand #'yas-expand-from-trigger-key)
   2351 (defun yas-expand-from-trigger-key (&optional field)
   2352   "Expand a snippet before point.
   2353 
   2354 If no snippet expansion is possible, fall back to the behaviour
   2355 defined in `yas-fallback-behavior'.
   2356 
   2357 Optional argument FIELD is for non-interactive use and is an
   2358 object satisfying `yas--field-p' to restrict the expansion to."
   2359   (interactive)
   2360   (setq yas--condition-cache-timestamp (current-time))
   2361   (let (templates-and-pos)
   2362     (unless (and yas-expand-only-for-last-commands
   2363                  (not (member last-command yas-expand-only-for-last-commands)))
   2364       (setq templates-and-pos (if field
   2365                                   (save-restriction
   2366                                     (narrow-to-region (yas--field-start field)
   2367                                                       (yas--field-end field))
   2368                                     (yas--templates-for-key-at-point))
   2369                                 (yas--templates-for-key-at-point))))
   2370     (if templates-and-pos
   2371         (yas--expand-or-prompt-for-template
   2372          (nth 0 templates-and-pos)
   2373          ;; Delete snippet key and active region when expanding.
   2374          (min (if (use-region-p) (region-beginning) most-positive-fixnum)
   2375               (nth 1 templates-and-pos))
   2376          (max (if (use-region-p) (region-end) most-negative-fixnum)
   2377               (nth 2 templates-and-pos)))
   2378       (yas--fallback))))
   2379 
   2380 (defun yas--maybe-expand-from-keymap-filter (cmd)
   2381   "Check whether a snippet may be expanded.
   2382 If there are expandable snippets, return CMD (this is useful for
   2383 conditional keybindings) or the list of expandable snippet
   2384 template objects if CMD is nil (this is useful as a more general predicate)."
   2385   (let* ((yas--condition-cache-timestamp (current-time))
   2386          (vec (cl-subseq (this-command-keys-vector)
   2387                          (if current-prefix-arg
   2388                              (length (this-command-keys))
   2389                            0)))
   2390          (templates (cl-mapcan (lambda (table)
   2391                                  (yas--fetch table vec))
   2392                                (yas--get-snippet-tables))))
   2393     (if templates (or cmd templates))))
   2394 
   2395 (defun yas-expand-from-keymap ()
   2396   "Directly expand some snippets, searching `yas--direct-keymaps'."
   2397   (interactive)
   2398   (setq yas--condition-cache-timestamp (current-time))
   2399   (let* ((templates (yas--maybe-expand-from-keymap-filter nil)))
   2400     (when templates
   2401       (yas--expand-or-prompt-for-template templates))))
   2402 
   2403 (defun yas--expand-or-prompt-for-template (templates &optional start end)
   2404   "Expand one of TEMPLATES from START to END.
   2405 
   2406 Prompt the user if TEMPLATES has more than one element, else
   2407 expand immediately.  Common gateway for
   2408 `yas-expand-from-trigger-key' and `yas-expand-from-keymap'."
   2409   (let ((yas--current-template
   2410          (or (and (cl-rest templates) ;; more than one
   2411                   (yas--prompt-for-template (mapcar #'cdr templates)))
   2412              (cdar templates))))
   2413     (when yas--current-template
   2414       (yas-expand-snippet yas--current-template start end))))
   2415 
   2416 ;; Apropos the trigger key and the fallback binding:
   2417 ;;
   2418 ;; When `yas-minor-mode-map' binds <tab>, that correctly overrides
   2419 ;; org-mode's <tab>, for example and searching for fallbacks correctly
   2420 ;; returns `org-cycle'. However, most other modes bind "TAB". TODO,
   2421 ;; improve this explanation.
   2422 ;;
   2423 (defun yas--fallback ()
   2424   "Fallback after expansion has failed.
   2425 
   2426 Common gateway for `yas-expand-from-trigger-key' and
   2427 `yas-expand-from-keymap'."
   2428   (cond ((eq yas-fallback-behavior 'return-nil)
   2429          ;; return nil
   2430          nil)
   2431         ((eq yas-fallback-behavior 'yas--fallback)
   2432          (error (concat "yasnippet fallback loop!\n"
   2433                         "This can happen when you bind `yas-expand' "
   2434                         "outside of the `yas-minor-mode-map'.")))
   2435         ((eq yas-fallback-behavior 'call-other-command)
   2436          (let* ((yas-fallback-behavior 'yas--fallback)
   2437                 ;; Also bind `yas-minor-mode' to prevent fallback
   2438                 ;; loops when other extensions use mechanisms similar
   2439                 ;; to `yas--keybinding-beyond-yasnippet'. (github #525
   2440                 ;; and #526)
   2441                 ;;
   2442                 (yas-minor-mode nil)
   2443                 (beyond-yasnippet (yas--keybinding-beyond-yasnippet)))
   2444            (yas--message 4 "Falling back to %s"  beyond-yasnippet)
   2445            (cl-assert (or (null beyond-yasnippet) (commandp beyond-yasnippet)))
   2446            (setq this-command beyond-yasnippet)
   2447            (when beyond-yasnippet
   2448              (call-interactively beyond-yasnippet))))
   2449         ((and (listp yas-fallback-behavior)
   2450               (cdr yas-fallback-behavior)
   2451               (eq 'apply (car yas-fallback-behavior)))
   2452          (let ((command-or-fn (cadr yas-fallback-behavior))
   2453                (args (cddr yas-fallback-behavior))
   2454                (yas-fallback-behavior 'yas--fallback)
   2455                (yas-minor-mode nil))
   2456            (if args
   2457                (apply command-or-fn args)
   2458              (when (commandp command-or-fn)
   2459                (setq this-command command-or-fn)
   2460                (call-interactively command-or-fn)))))
   2461         (t
   2462          ;; also return nil if all the other fallbacks have failed
   2463          nil)))
   2464 
   2465 (defun yas--keybinding-beyond-yasnippet ()
   2466   "Get current keys's binding as if YASsnippet didn't exist."
   2467   (let* ((yas-minor-mode nil)
   2468          (yas--direct-keymaps nil)
   2469          (keys (this-single-command-keys)))
   2470     (or (key-binding keys t)
   2471         (key-binding (yas--fallback-translate-input keys) t))))
   2472 
   2473 (defun yas--fallback-translate-input (keys)
   2474   "Emulate `read-key-sequence', at least what I think it does.
   2475 
   2476 Keys should be an untranslated key vector.  Returns a translated
   2477 vector of keys.  FIXME not thoroughly tested."
   2478   (let ((retval [])
   2479         (i 0))
   2480     (while (< i (length keys))
   2481       (let ((j i)
   2482             (translated local-function-key-map))
   2483         (while (and (< j (length keys))
   2484                     translated
   2485                     (keymapp translated))
   2486           (setq translated (cdr (assoc (aref keys j) (remove 'keymap translated)))
   2487                 j (1+ j)))
   2488         (setq retval (vconcat retval (cond ((symbolp translated)
   2489                                             `[,translated])
   2490                                            ((vectorp translated)
   2491                                             translated)
   2492                                            (t
   2493                                             (substring keys i j)))))
   2494         (setq i j)))
   2495     retval))
   2496 
   2497 
   2498 ;;; Utils for snippet development:
   2499 
   2500 (defun yas--all-templates (tables)
   2501   "Get `yas--template' objects in TABLES, applicable for buffer and point.
   2502 
   2503 Honours `yas-choose-tables-first', `yas-choose-keys-first' and
   2504 `yas-buffer-local-condition'"
   2505   (when yas-choose-tables-first
   2506     (setq tables (list (yas--prompt-for-table tables))))
   2507   (mapcar #'cdr
   2508           (if yas-choose-keys-first
   2509               (let ((key (yas--prompt-for-keys
   2510                           (cl-mapcan #'yas--table-all-keys tables))))
   2511                 (when key
   2512                   (cl-mapcan (lambda (table)
   2513                                (yas--fetch table key))
   2514                              tables)))
   2515             (cl-remove-duplicates (cl-mapcan #'yas--table-templates tables)
   2516                                   :test #'equal))))
   2517 
   2518 (defun yas--lookup-snippet-1 (name mode)
   2519   "Get the snippet called NAME in MODE's tables."
   2520   (let ((yas-choose-tables-first nil)   ; avoid prompts
   2521         (yas-choose-keys-first nil))
   2522     (cl-find name (yas--all-templates
   2523                    (yas--get-snippet-tables mode))
   2524              :key #'yas--template-name :test #'string=)))
   2525 
   2526 (defun yas-lookup-snippet (name &optional mode noerror)
   2527   "Get the snippet named NAME in MODE's tables.
   2528 
   2529 MODE defaults to the current buffer's `major-mode'.  If NOERROR
   2530 is non-nil, then don't signal an error if there isn't any snippet
   2531 called NAME.
   2532 
   2533 Honours `yas-buffer-local-condition'."
   2534   (cond
   2535    ((yas--lookup-snippet-1 name mode))
   2536    (noerror nil)
   2537    (t (error "No snippet named: %s" name))))
   2538 
   2539 (defun yas-insert-snippet (&optional no-condition)
   2540   "Choose a snippet to expand, pop-up a list of choices according
   2541 to `yas-prompt-functions'.
   2542 
   2543 With prefix argument NO-CONDITION, bypass filtering of snippets
   2544 by condition."
   2545   (interactive "P")
   2546   (setq yas--condition-cache-timestamp (current-time))
   2547   (let* ((yas-buffer-local-condition (or (and no-condition
   2548                                               'always)
   2549                                          yas-buffer-local-condition))
   2550          (templates (yas--all-templates (yas--get-snippet-tables)))
   2551          (yas--current-template (and templates
   2552                                     (or (and (cl-rest templates) ;; more than one template for same key
   2553                                              (yas--prompt-for-template templates))
   2554                                         (car templates))))
   2555          (where (if (region-active-p)
   2556                     (cons (region-beginning) (region-end))
   2557                   (cons (point) (point)))))
   2558     (if yas--current-template
   2559         (yas-expand-snippet yas--current-template (car where) (cdr where))
   2560       (yas--message 1 "No snippets can be inserted here!"))))
   2561 
   2562 (defun yas-visit-snippet-file ()
   2563   "Choose a snippet to edit, selection like `yas-insert-snippet'.
   2564 
   2565 Only success if selected snippet was loaded from a file.  Put the
   2566 visited file in `snippet-mode'."
   2567   (interactive)
   2568   (let* ((yas-buffer-local-condition 'always)
   2569          (templates (yas--all-templates (yas--get-snippet-tables)))
   2570          (template (and templates
   2571                         (or (yas--prompt-for-template templates
   2572                                                      "Choose a snippet template to edit: ")
   2573                             (car templates)))))
   2574 
   2575     (if template
   2576         (yas--visit-snippet-file-1 template)
   2577       (message "No snippets tables active!"))))
   2578 
   2579 (defun yas--visit-snippet-file-1 (template)
   2580   "Helper for `yas-visit-snippet-file'."
   2581   (let ((file (yas--template-get-file template)))
   2582     (cond ((and file (file-readable-p file))
   2583            (find-file-other-window file)
   2584            (snippet-mode)
   2585            (setq-local yas--editing-template template))
   2586           (file
   2587            (message "Original file %s no longer exists!" file))
   2588           (t
   2589            (switch-to-buffer (format "*%s*"(yas--template-name template)))
   2590            (let ((type 'snippet))
   2591              (when (listp (yas--template-content template))
   2592                (insert (format "# type: command\n"))
   2593                (setq type 'command))
   2594              (insert (format "# key: %s\n" (yas--template-key template)))
   2595              (insert (format "# name: %s\n" (yas--template-name template)))
   2596              (when (yas--template-keybinding template)
   2597                (insert (format "# binding: %s\n" (yas--template-keybinding template))))
   2598              (when (yas--template-expand-env template)
   2599                (insert (format "# expand-env: %s\n" (yas--template-expand-env template))))
   2600              (when (yas--template-condition template)
   2601                (insert (format "# condition: %s\n" (yas--template-condition template))))
   2602              (insert "# --\n")
   2603              (insert (if (eq type 'command)
   2604                          (pp-to-string (yas--template-content template))
   2605                        (yas--template-content template))))
   2606            (snippet-mode)
   2607            (setq-local yas--editing-template template)
   2608            (setq-local default-directory
   2609                        (car (cdr (car (yas--guess-snippet-directories
   2610                                        (yas--template-table template))))))))))
   2611 
   2612 (defun yas--guess-snippet-directories-1 (table)
   2613   "Guess possible snippet subdirectories for TABLE."
   2614   (cons (file-name-as-directory (yas--table-name table))
   2615         (cl-mapcan #'yas--guess-snippet-directories-1
   2616                    (yas--table-parents table))))
   2617 
   2618 (defun yas--guess-snippet-directories (&optional table)
   2619   "Try to guess suitable directories based on the current active
   2620 tables (or optional TABLE).
   2621 
   2622 Returns a list of elements (TABLE . DIRS) where TABLE is a
   2623 `yas--table' object and DIRS is a list of all possible directories
   2624 where snippets of table might exist."
   2625   (let ((main-dir (car (or (yas-snippet-dirs)
   2626                            (setq yas-snippet-dirs
   2627                                  (list yas--default-user-snippets-dir)))))
   2628         (tables (if table (list table)
   2629                   (yas--get-snippet-tables))))
   2630     ;; HACK! the snippet table created here is actually registered!
   2631     (unless table
   2632       ;; The major mode is probably the best guess, put it first.
   2633       (let ((major-mode-table (yas--table-get-create major-mode)))
   2634         (cl-callf2 delq major-mode-table tables)
   2635         (push major-mode-table tables)))
   2636 
   2637     (mapcar #'(lambda (table)
   2638                 (cons table
   2639                       (mapcar #'(lambda (subdir)
   2640                                   (expand-file-name subdir main-dir))
   2641                               (yas--guess-snippet-directories-1 table))))
   2642             tables)))
   2643 
   2644 (defun yas--make-directory-maybe (table-and-dirs &optional main-table-string)
   2645   "Return a dir inside TABLE-AND-DIRS, prompts for creation if none exists."
   2646   (or (cl-some (lambda (dir) (when (file-directory-p dir) dir))
   2647                (cdr table-and-dirs))
   2648       (let ((candidate (cl-first (cdr table-and-dirs))))
   2649         (unless (file-writable-p (file-name-directory candidate))
   2650           (error (yas--format "%s is not writable." candidate)))
   2651         (if (y-or-n-p (format "Guessed directory (%s) for%s%s table \"%s\" does not exist! Create? "
   2652                               candidate
   2653                               (if (gethash (yas--table-mode (car table-and-dirs))
   2654                                            yas--tables)
   2655                                   ""
   2656                                 " brand new")
   2657                               (or main-table-string
   2658                                   "")
   2659                               (yas--table-name (car table-and-dirs))))
   2660             (progn
   2661               (make-directory candidate 'also-make-parents)
   2662               ;; create the .yas-parents file here...
   2663               candidate)))))
   2664 
   2665 ;; NOTE: Using the traditional "*new snippet*" stops whitespace mode
   2666 ;; from activating (it doesn't like the leading "*").
   2667 (defconst yas-new-snippet-buffer-name "+new-snippet+")
   2668 
   2669 (defun yas-new-snippet (&optional no-template)
   2670   "Pops a new buffer for writing a snippet.
   2671 
   2672 Expands a snippet-writing snippet, unless the optional prefix arg
   2673 NO-TEMPLATE is non-nil."
   2674   (interactive "P")
   2675   (let ((guessed-directories (yas--guess-snippet-directories))
   2676         (yas-selected-text (or yas-selected-text
   2677                                (and (region-active-p)
   2678                                     (buffer-substring-no-properties
   2679                                      (region-beginning) (region-end))))))
   2680 
   2681     (switch-to-buffer yas-new-snippet-buffer-name)
   2682     (erase-buffer)
   2683     (kill-all-local-variables)
   2684     (snippet-mode)
   2685     (yas-minor-mode 1)
   2686     (setq-local yas--guessed-modes
   2687                 (mapcar (lambda (d) (yas--table-mode (car d)))
   2688                         guessed-directories))
   2689     (setq-local default-directory
   2690                 (car (cdr (car guessed-directories))))
   2691     (if (and (not no-template) yas-new-snippet-default)
   2692         (yas-expand-snippet yas-new-snippet-default))))
   2693 
   2694 (defun yas--compute-major-mode-and-parents (file)
   2695   "Given FILE, find the nearest snippet directory for a given mode.
   2696 
   2697 Returns a list (MODE-SYM PARENTS), the mode's symbol and a list
   2698 representing one or more of the mode's parents.
   2699 
   2700 Note that MODE-SYM need not be the symbol of a real major mode,
   2701 neither do the elements of PARENTS."
   2702   (let* ((file-dir (and file
   2703                         (directory-file-name
   2704                          (or (cl-some (lambda (special)
   2705                                         (locate-dominating-file file special))
   2706                                       '(".yas-setup.el"
   2707                                         ".yas-make-groups"
   2708                                         ".yas-parents"))
   2709                              (directory-file-name (file-name-directory file))))))
   2710          (parents-file-name (concat file-dir "/.yas-parents"))
   2711          (major-mode-name (and file-dir
   2712                                (file-name-nondirectory file-dir)))
   2713          (major-mode-sym (or (and major-mode-name
   2714                                   (intern major-mode-name))))
   2715          (parents (when (file-readable-p parents-file-name)
   2716                          (mapcar #'intern
   2717                                  (split-string
   2718                                   (with-temp-buffer
   2719                                     (insert-file-contents parents-file-name)
   2720                                     (buffer-substring-no-properties (point-min)
   2721                                                                     (point-max))))))))
   2722     (when major-mode-sym
   2723       (cons major-mode-sym (remove major-mode-sym parents)))))
   2724 
   2725 (defvar yas--editing-template nil
   2726   "Supporting variable for `yas-load-snippet-buffer' and `yas--visit-snippet'.")
   2727 
   2728 (defvar yas--current-template nil
   2729   "Holds the current template being expanded into a snippet.")
   2730 
   2731 (defvar yas--guessed-modes nil
   2732   "List of guessed modes supporting `yas-load-snippet-buffer'.")
   2733 
   2734 (defun yas--read-table ()
   2735   "Ask user for a snippet table, help with some guessing."
   2736   (let ((prompt (if (and (featurep 'ido)
   2737                          ido-mode)
   2738                     'ido-completing-read 'completing-read)))
   2739     (unless yas--guessed-modes
   2740       (setq-local yas--guessed-modes
   2741                   (yas--compute-major-mode-and-parents buffer-file-name)))
   2742     (intern
   2743      (funcall prompt (format "Choose or enter a table (yas guesses %s): "
   2744                              (if yas--guessed-modes
   2745                                  (cl-first yas--guessed-modes)
   2746                                "nothing"))
   2747               (mapcar #'symbol-name yas--guessed-modes)
   2748               nil
   2749               nil
   2750               nil
   2751               nil
   2752               (if (cl-first yas--guessed-modes)
   2753                   (symbol-name (cl-first yas--guessed-modes)))))))
   2754 
   2755 (defun yas-load-snippet-buffer (table &optional interactive)
   2756   "Parse and load current buffer's snippet definition into TABLE.
   2757 TABLE is a symbol name passed to `yas--table-get-create'.  When
   2758 called interactively, prompt for the table name.
   2759 Return the `yas--template' object created"
   2760   (interactive (list (yas--read-table) t))
   2761   (cond
   2762    ;;  We have `yas--editing-template', this buffer's content comes from a
   2763    ;;  template which is already loaded and neatly positioned,...
   2764    ;;
   2765    (yas--editing-template
   2766     (yas--define-snippets-1 (yas--parse-template (yas--template-load-file yas--editing-template))
   2767                            (yas--template-table yas--editing-template)))
   2768    ;; Try to use `yas--guessed-modes'. If we don't have that use the
   2769    ;; value from `yas--compute-major-mode-and-parents'
   2770    ;;
   2771    (t
   2772     (unless yas--guessed-modes
   2773       (setq-local yas--guessed-modes
   2774                   (or (yas--compute-major-mode-and-parents buffer-file-name))))
   2775     (let* ((table (yas--table-get-create table)))
   2776       (setq-local yas--editing-template
   2777                   (yas--define-snippets-1 (yas--parse-template buffer-file-name)
   2778                                           table)))))
   2779   (when interactive
   2780     (yas--message 3 "Snippet \"%s\" loaded for %s."
   2781                   (yas--template-name yas--editing-template)
   2782                   (yas--table-name (yas--template-table yas--editing-template))))
   2783   yas--editing-template)
   2784 
   2785 (defun yas-maybe-load-snippet-buffer ()
   2786   "Added to `after-save-hook' in `snippet-mode'."
   2787   (let* ((mode (intern (file-name-sans-extension
   2788                         (file-name-nondirectory
   2789                          (directory-file-name default-directory)))))
   2790          (current-snippet
   2791           (apply #'yas--define-snippets-2 (yas--table-get-create mode)
   2792                  (yas--parse-template buffer-file-name)))
   2793          (uuid (yas--template-uuid current-snippet)))
   2794     (unless (equal current-snippet
   2795                    (if uuid (yas--get-template-by-uuid mode uuid)
   2796                      (yas--lookup-snippet-1
   2797                       (yas--template-name current-snippet) mode)))
   2798       (yas-load-snippet-buffer mode t))))
   2799 
   2800 (defun yas-load-snippet-buffer-and-close (table &optional kill)
   2801   "Load and save the snippet, then `quit-window' if saved.
   2802 Loading is performed by `yas-load-snippet-buffer'.  If the
   2803 snippet is new, ask the user whether (and where) to save it.  If
   2804 the snippet already has a file, just save it.
   2805 
   2806 The prefix argument KILL is passed to `quit-window'.
   2807 
   2808 Don't use this from a Lisp program, call `yas-load-snippet-buffer'
   2809 and `kill-buffer' instead."
   2810   (interactive (list (yas--read-table) current-prefix-arg))
   2811   (let ((template (yas-load-snippet-buffer table t)))
   2812     (when (and (buffer-modified-p)
   2813                (y-or-n-p
   2814                 (format "[yas] Loaded for %s. Also save snippet buffer?"
   2815                         (yas--table-name (yas--template-table template)))))
   2816       (let ((default-directory (car (cdr (car (yas--guess-snippet-directories
   2817                                                (yas--template-table template))))))
   2818             (default-file-name (yas--template-name template)))
   2819         (unless (or buffer-file-name (not default-file-name))
   2820           (setq buffer-file-name
   2821                 (read-file-name "File to save snippet in: "
   2822                                 nil nil nil default-file-name))
   2823           (rename-buffer (file-name-nondirectory buffer-file-name) t))
   2824         (save-buffer)))
   2825     (quit-window kill)))
   2826 
   2827 (declare-function yas-debug-snippets "yasnippet-debug")
   2828 
   2829 (defun yas-tryout-snippet (&optional debug)
   2830   "Test current buffer's snippet template in other buffer.
   2831 DEBUG is for debugging the YASnippet engine itself."
   2832   (interactive "P")
   2833   (let* ((major-mode-and-parent (yas--compute-major-mode-and-parents buffer-file-name))
   2834          (parsed (yas--parse-template))
   2835          (test-mode (or (and (car major-mode-and-parent)
   2836                              (fboundp (car major-mode-and-parent))
   2837                              (car major-mode-and-parent))
   2838                         (cl-first yas--guessed-modes)
   2839                         (intern (read-from-minibuffer (yas--format "Please input a mode: ")))))
   2840          (yas--current-template
   2841           (and parsed
   2842                (fboundp test-mode)
   2843                (yas--make-template :table       nil ;; no tables for ephemeral snippets
   2844                                    :key         (nth 0 parsed)
   2845                                    :content     (nth 1 parsed)
   2846                                    :name        (nth 2 parsed)
   2847                                    :expand-env  (nth 5 parsed)))))
   2848     (cond (yas--current-template
   2849            (let ((buffer-name
   2850                   (format "*testing snippet: %s*"
   2851                           (yas--template-name yas--current-template))))
   2852              (kill-buffer (get-buffer-create buffer-name))
   2853              (switch-to-buffer (get-buffer-create buffer-name))
   2854              (setq buffer-undo-list nil)
   2855              (condition-case nil (funcall test-mode) (error nil))
   2856 	     (yas-minor-mode 1)
   2857              (setq buffer-read-only nil)
   2858              (yas-expand-snippet yas--current-template
   2859                                  (point-min) (point-max))
   2860              (when (and debug
   2861                         (require 'yasnippet-debug nil t))
   2862                (yas-debug-snippets "*YASnippet trace*" 'snippet-navigation)
   2863                (display-buffer "*YASnippet trace*"))))
   2864           (t
   2865            (yas--message 1 "Cannot test snippet for unknown major mode")))))
   2866 
   2867 (defun yas-active-keys ()
   2868   "Return all active trigger keys for current buffer and point."
   2869   (cl-remove-duplicates
   2870    (cl-remove-if-not #'stringp (cl-mapcan #'yas--table-all-keys
   2871                                           (yas--get-snippet-tables)))
   2872    :test #'string=))
   2873 
   2874 (defun yas--template-fine-group (template)
   2875   (car (last (or (yas--template-group template)
   2876                  (yas--template-perm-group template)))))
   2877 
   2878 (defun yas-describe-table-by-namehash ()
   2879   "Display snippet tables by NAMEHASH."
   2880   (interactive)
   2881   (with-current-buffer (get-buffer-create "*YASnippet Tables by NAMEHASH*")
   2882     (let ((inhibit-read-only t))
   2883       (erase-buffer)
   2884       (insert "YASnippet tables by NAMEHASH: \n")
   2885       (maphash
   2886        (lambda (_mode table)
   2887          (insert (format "\nSnippet table `%s':\n\n" (yas--table-name table)))
   2888          (maphash
   2889           (lambda (key _v)
   2890             (insert (format "   key %s maps snippets: %s\n" key
   2891                             (let ((names))
   2892                               (maphash #'(lambda (k _v)
   2893                                            (push k names))
   2894                                        (gethash key (yas--table-hash table)))
   2895                               names))))
   2896           (yas--table-hash table)))
   2897        yas--tables))
   2898     (view-mode +1)
   2899     (goto-char 1)
   2900     (display-buffer (current-buffer))))
   2901 
   2902 (defun yas-describe-tables (&optional with-nonactive)
   2903   "Display snippets for each table."
   2904   (interactive "P")
   2905   (let ((original-buffer (current-buffer))
   2906         (tables (yas--get-snippet-tables)))
   2907    (with-current-buffer (get-buffer-create "*YASnippet Tables*")
   2908      (let ((inhibit-read-only t))
   2909        (when with-nonactive
   2910          (maphash #'(lambda (_k v)
   2911                       (cl-pushnew v tables))
   2912                   yas--tables))
   2913        (erase-buffer)
   2914        (insert "YASnippet tables:\n")
   2915        (dolist (table tables)
   2916          (yas--describe-pretty-table table original-buffer))
   2917        (yas--create-snippet-xrefs))
   2918      (help-mode)
   2919      (goto-char 1)
   2920      (display-buffer (current-buffer)))))
   2921 
   2922 (defun yas--describe-pretty-table (table &optional original-buffer)
   2923   (insert (format "\nSnippet table `%s'"
   2924                   (yas--table-name table)))
   2925   (if (yas--table-parents table)
   2926       (insert (format " parents: %s\n"
   2927                       (mapcar #'yas--table-name
   2928                               (yas--table-parents table))))
   2929     (insert "\n"))
   2930   (insert (make-string 100 ?-) "\n")
   2931   (insert "group                   state name                                    key             binding\n")
   2932   (let ((groups-hash (make-hash-table :test #'equal)))
   2933     (maphash #'(lambda (_k v)
   2934                  (let ((group (or (yas--template-fine-group v)
   2935                                   "(top level)")))
   2936                    (when (yas--template-name v)
   2937                      (puthash group
   2938                               (cons v (gethash group groups-hash))
   2939                               groups-hash))))
   2940              (yas--table-uuidhash table))
   2941     (maphash
   2942      #'(lambda (group templates)
   2943          (setq group (truncate-string-to-width group 25 0 ?  "..."))
   2944          (insert (make-string 100 ?-) "\n")
   2945          (dolist (p templates)
   2946            (let* ((name (truncate-string-to-width (propertize (format "\\\\snippet `%s'" (yas--template-name p))
   2947                                                               'yasnippet p)
   2948                                                   50 0 ? "..."))
   2949                   (group (prog1 group
   2950                            (setq group (make-string (length group) ? ))))
   2951                   (condition-string (let ((condition (yas--template-condition p)))
   2952                                       (if (and condition
   2953                                                original-buffer)
   2954                                           (with-current-buffer original-buffer
   2955                                             (if (yas--funcall-condition
   2956                                                  #'eval condition t)
   2957                                                 "(y)"
   2958                                               "(s)"))
   2959                                         "(a)")))
   2960                   (key-description-string (key-description (yas--template-keybinding p)))
   2961                   (template-key-padding (if (string= key-description-string "") nil ? )))
   2962              (insert group " "
   2963                      condition-string " "
   2964                      name (if (string-match "\\.\\.\\.$" name)
   2965                               "'" " ")
   2966                      " "
   2967                      (truncate-string-to-width (or (yas--template-key p) "")
   2968                                                15 0 template-key-padding "...")
   2969                      (or template-key-padding "")
   2970                      (truncate-string-to-width key-description-string
   2971                                                15 0 nil "...")
   2972                      "\n"))))
   2973      groups-hash)))
   2974 
   2975 
   2976 
   2977 ;;; User convenience functions, for using in `yas-key-syntaxes'
   2978 
   2979 (defun yas-try-key-from-whitespace (_start-point)
   2980   "As `yas-key-syntaxes' element, look for whitespace delimited key.
   2981 
   2982 A newline will be considered whitespace even if the mode syntax
   2983 marks it as something else (typically comment ender)."
   2984   (skip-chars-backward "^[:space:]\n"))
   2985 
   2986 (defun yas-shortest-key-until-whitespace (_start-point)
   2987   "Like `yas-longest-key-from-whitespace' but take the shortest key."
   2988   (when (/= (skip-chars-backward "^[:space:]\n" (1- (point))) 0)
   2989     'again))
   2990 
   2991 (defun yas-longest-key-from-whitespace (start-point)
   2992   "Look for longest key between point and whitespace.
   2993 For use as `yas-key-syntaxes' element.
   2994 
   2995 A newline will be considered whitespace even if the mode syntax
   2996 marks it as something else (typically comment ender)."
   2997   (if (= (point) start-point)
   2998       (yas-try-key-from-whitespace start-point)
   2999     (forward-char))
   3000   (unless (<= start-point (1+ (point)))
   3001     'again))
   3002 
   3003 
   3004 
   3005 ;;; User convenience functions, for using in snippet definitions
   3006 
   3007 (defvar yas-modified-p nil
   3008   "Non-nil if field has been modified by user or transformation.")
   3009 
   3010 (defvar yas-moving-away-p nil
   3011   "Non-nil if user is about to exit field.")
   3012 
   3013 (defvar yas-text nil
   3014   "Contains current field text.")
   3015 
   3016 (defun yas-substr (str pattern &optional subexp)
   3017   "Search PATTERN in STR and return SUBEXPth match.
   3018 
   3019 If found, the content of subexp group SUBEXP (default 0) is
   3020   returned, or else the original STR will be returned."
   3021   (let ((grp (or subexp 0)))
   3022     (save-match-data
   3023       (if (string-match pattern str)
   3024           (match-string-no-properties grp str)
   3025         str))))
   3026 
   3027 (defun yas-choose-value (&rest possibilities)
   3028   "Prompt for a string in POSSIBILITIES and return it.
   3029 
   3030 The last element of POSSIBILITIES may be a list of strings."
   3031   (unless (or yas-moving-away-p
   3032               yas-modified-p)
   3033     (let* ((last-link (last possibilities))
   3034            (last-elem (car last-link)))
   3035       (when (listp last-elem)
   3036         (setcar last-link (car last-elem))
   3037         (setcdr last-link (cdr last-elem))))
   3038     (cl-some (lambda (fn)
   3039                (funcall fn "Choose: " possibilities))
   3040              yas-prompt-functions)))
   3041 
   3042 (defun yas-completing-read (&rest args)
   3043   "A snippet-aware version of `completing-read'.
   3044 This can be used to query the user for the initial value of a
   3045 snippet field.  The arguments are the same as `completing-read'.
   3046 
   3047 \(fn PROMPT COLLECTION &optional PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF INHERIT-INPUT-METHOD)"
   3048   (unless (or yas-moving-away-p
   3049               yas-modified-p)
   3050     (apply #'completing-read args)))
   3051 
   3052 (defun yas--auto-next ()
   3053   "Helper for `yas-auto-next'."
   3054   (cl-loop
   3055    do (progn (remove-hook 'post-command-hook #'yas--auto-next t)
   3056              (yas-next-field))
   3057    ;; The transform in the next field may have requested auto-next as
   3058    ;; well.  Call it ourselves, since the command loop itself won't
   3059    ;; recheck the value of post-command-hook while running it.
   3060    while (memq #'yas--auto-next post-command-hook)))
   3061 
   3062 (defmacro yas-auto-next (&rest body)
   3063   "Automatically advance to next field after eval'ing BODY."
   3064   (declare (indent 0) (debug t))
   3065   `(unless yas-moving-away-p
   3066      (prog1 ,@body
   3067        (add-hook 'post-command-hook #'yas--auto-next nil t))))
   3068 
   3069 (defun yas-key-to-value (alist)
   3070   (unless (or yas-moving-away-p
   3071               yas-modified-p)
   3072     (let ((key (read-key-sequence "")))
   3073       (when (stringp key)
   3074         (or (cdr (cl-find key alist :key #'car :test #'string=))
   3075             key)))))
   3076 
   3077 (defun yas-throw (text)
   3078   "Signal `yas-exception' with TEXT as the reason."
   3079   (signal 'yas-exception (list text)))
   3080 (define-error 'yas-exception "[yas] Exception")
   3081 
   3082 (defun yas-verify-value (possibilities)
   3083   "Verify that the current field value is in POSSIBILITIES.
   3084 Otherwise signal `yas-exception'."
   3085   (when (and yas-moving-away-p (not (member yas-text possibilities)))
   3086     (yas-throw (format "Field only allows %s" possibilities))))
   3087 
   3088 (defun yas-field-value (number)
   3089   "Get the string for field with NUMBER.
   3090 
   3091 Use this in primary and mirror transformations to get the text of
   3092 other fields."
   3093   (let* ((snippet (car (yas-active-snippets)))
   3094          (field (and snippet
   3095                      (yas--snippet-find-field snippet number))))
   3096     (when field
   3097       (yas--field-text-for-display field))))
   3098 
   3099 (defun yas-text ()
   3100   "Return `yas-text' if that exists and is non-empty, else nil."
   3101   (if (and yas-text
   3102            (not (string= "" yas-text)))
   3103       yas-text))
   3104 
   3105 (defun yas-selected-text ()
   3106   "Return `yas-selected-text' if that exists and is non-empty, else nil."
   3107   (if (and yas-selected-text
   3108            (not (string= "" yas-selected-text)))
   3109       yas-selected-text))
   3110 
   3111 (defun yas--get-field-once (number &optional transform-fn)
   3112   (unless yas-modified-p
   3113     (if transform-fn
   3114         (funcall transform-fn (yas-field-value number))
   3115       (yas-field-value number))))
   3116 
   3117 (defun yas-default-from-field (number)
   3118   (unless yas-modified-p
   3119     (yas-field-value number)))
   3120 
   3121 (defun yas-inside-string ()
   3122   "Return non-nil if the point is inside a string according to font-lock."
   3123   (equal 'font-lock-string-face (get-char-property (1- (point)) 'face)))
   3124 
   3125 (defun yas-unimplemented (&optional missing-feature)
   3126   (if yas--current-template
   3127       (if (y-or-n-p (format "This snippet is unimplemented (missing %s) Visit the snippet definition? "
   3128                             (or missing-feature
   3129                                 "something")))
   3130           (yas--visit-snippet-file-1 yas--current-template))
   3131     (message "No implementation. Missing %s" (or missing-feature "something"))))
   3132 
   3133 
   3134 ;;; Snippet expansion and field management
   3135 
   3136 (defvar-local yas--active-field-overlay nil
   3137   "Overlays the currently active field.")
   3138 
   3139 (defvar-local yas--active-snippets nil
   3140   "List of currently active snippets")
   3141 
   3142 (defvar-local yas--field-protection-overlays nil
   3143   "Two overlays protect the current active field.")
   3144 
   3145 (defvar yas-selected-text nil
   3146   "The selected region deleted on the last snippet expansion.")
   3147 
   3148 (defvar yas--start-column nil
   3149   "The column where the snippet expansion started.")
   3150 
   3151 (put 'yas--active-field-overlay 'permanent-local t)
   3152 (put 'yas--field-protection-overlays 'permanent-local t)
   3153 
   3154 (cl-defstruct (yas--snippet (:constructor yas--make-snippet (expand-env)))
   3155   "A snippet.
   3156 
   3157 ..."
   3158   expand-env
   3159   (fields '())
   3160   (exit nil)
   3161   (id (yas--snippet-next-id) :read-only t)
   3162   (control-overlay nil)
   3163   active-field
   3164   ;; stacked expansion: the `previous-active-field' slot saves the
   3165   ;; active field where the child expansion took place
   3166   previous-active-field
   3167   force-exit)
   3168 
   3169 (cl-defstruct (yas--field (:constructor yas--make-field (number start end parent-field)))
   3170   "A field.
   3171 
   3172 NUMBER is the field number.
   3173 START and END are mostly buffer markers, but see \"apropos markers-to-points\".
   3174 PARENT-FIELD is a `yas--field' this field is nested under, or nil.
   3175 MIRRORS is a list of `yas--mirror's
   3176 TRANSFORM is a lisp form.
   3177 MODIFIED-P is a boolean set to true once user inputs text.
   3178 NEXT is another `yas--field' or `yas--mirror' or `yas--exit'.
   3179 "
   3180   number
   3181   start end
   3182   parent-field
   3183   (mirrors '())
   3184   (transform nil)
   3185   (modified-p nil)
   3186   next)
   3187 
   3188 
   3189 (cl-defstruct (yas--mirror (:constructor yas--make-mirror (start end transform)))
   3190   "A mirror.
   3191 
   3192 START and END are mostly buffer markers, but see \"apropos markers-to-points\".
   3193 TRANSFORM is a lisp form.
   3194 PARENT-FIELD is a `yas--field' this mirror is nested under, or nil.
   3195 NEXT is another `yas--field' or `yas--mirror' or `yas--exit'
   3196 DEPTH is a count of how many nested mirrors can affect this mirror"
   3197   start end
   3198   (transform nil)
   3199   parent-field
   3200   next
   3201   depth)
   3202 
   3203 (cl-defstruct (yas--exit (:constructor yas--make-exit (marker)))
   3204   marker
   3205   next)
   3206 
   3207 (defmacro yas--letenv (env &rest body)
   3208   "Evaluate BODY with bindings from ENV.
   3209 ENV is a lisp expression that evaluates to list of elements with
   3210 the form (VAR FORM), where VAR is a symbol and FORM is a lisp
   3211 expression that evaluates to its value."
   3212   (declare (debug (form body)) (indent 1))
   3213   (let ((envvar (make-symbol "envvar")))
   3214     `(let ((,envvar ,env))
   3215        (cl-progv
   3216            (mapcar #'car ,envvar)
   3217            (mapcar (lambda (v-f) (eval (cadr v-f) t)) ,envvar)
   3218          ,@body))))
   3219 
   3220 (defun yas--snippet-map-markers (fun snippet)
   3221   "Apply FUN to all marker (sub)fields in SNIPPET.
   3222 Update each field with the result of calling FUN."
   3223   (dolist (field (yas--snippet-fields snippet))
   3224     (setf (yas--field-start field) (funcall fun (yas--field-start field)))
   3225     (setf (yas--field-end field)   (funcall fun (yas--field-end field)))
   3226     (dolist (mirror (yas--field-mirrors field))
   3227       (setf (yas--mirror-start mirror) (funcall fun (yas--mirror-start mirror)))
   3228       (setf (yas--mirror-end mirror)   (funcall fun (yas--mirror-end mirror)))))
   3229   (let ((snippet-exit (yas--snippet-exit snippet)))
   3230     (when snippet-exit
   3231       (setf (yas--exit-marker snippet-exit)
   3232             (funcall fun (yas--exit-marker snippet-exit))))))
   3233 
   3234 (defun yas--snippet-live-p (snippet)
   3235   "Return non-nil if SNIPPET hasn't been committed."
   3236   (catch 'live
   3237     (yas--snippet-map-markers (lambda (m)
   3238                                 (if (markerp m) m
   3239                                   (throw 'live nil)))
   3240                               snippet)
   3241     t))
   3242 
   3243 (defun yas--apply-transform (field-or-mirror field &optional empty-on-nil-p)
   3244   "Calculate transformed string for FIELD-OR-MIRROR from FIELD.
   3245 
   3246 If there is no transform for ht field, return nil.
   3247 
   3248 If there is a transform but it returns nil, return the empty
   3249 string iff EMPTY-ON-NIL-P is true."
   3250   (let* ((yas-text (yas--field-text-for-display field))
   3251          (yas-modified-p (yas--field-modified-p field))
   3252          (transform (if (yas--mirror-p field-or-mirror)
   3253                         (yas--mirror-transform field-or-mirror)
   3254                       (yas--field-transform field-or-mirror)))
   3255          (start-point (if (yas--mirror-p field-or-mirror)
   3256                           (yas--mirror-start field-or-mirror)
   3257                         (yas--field-start field-or-mirror)))
   3258          (transformed (and transform
   3259                            (save-excursion
   3260                              (goto-char start-point)
   3261                              (let ((ret (yas--eval-for-string transform)))
   3262                                (or ret (and empty-on-nil-p "")))))))
   3263     transformed))
   3264 
   3265 (defsubst yas--replace-all (from to &optional text)
   3266   "Replace all occurrences from FROM to TO.
   3267 
   3268 With optional string TEXT do it in that string."
   3269   (if text
   3270       (replace-regexp-in-string (regexp-quote from) to text t t)
   3271     (goto-char (point-min))
   3272     (while (search-forward from nil t)
   3273       (replace-match to t t text))))
   3274 
   3275 (defun yas--snippet-find-field (snippet number)
   3276   (cl-find-if (lambda (field)
   3277                 (eq number (yas--field-number field)))
   3278               (yas--snippet-fields snippet)))
   3279 
   3280 (defun yas--snippet-sort-fields (snippet)
   3281   "Sort the fields of SNIPPET in navigation order."
   3282   (setf (yas--snippet-fields snippet)
   3283         (sort (yas--snippet-fields snippet)
   3284               #'yas--snippet-field-compare)))
   3285 
   3286 (defun yas--snippet-field-compare (field1 field2)
   3287   "Compare FIELD1 and FIELD2.
   3288 
   3289 The field with a number is sorted first.  If they both have a
   3290 number, compare through the number.  If neither have, compare
   3291 through the field's start point"
   3292   (let ((n1 (yas--field-number field1))
   3293         (n2 (yas--field-number field2)))
   3294     (if n1
   3295         (if n2
   3296             (or (zerop n2) (and (not (zerop n1))
   3297                                 (< n1 n2)))
   3298           (not (zerop n1)))
   3299       (if n2
   3300           (zerop n2)
   3301         (< (yas--field-start field1)
   3302            (yas--field-start field2))))))
   3303 
   3304 (defun yas--field-probably-deleted-p (snippet field)
   3305   "Guess if SNIPPET's FIELD should be skipped."
   3306   (and
   3307    ;; field must be zero length
   3308    ;;
   3309    (zerop (- (yas--field-start field) (yas--field-end field)))
   3310    ;; field must have been modified
   3311    ;;
   3312    (yas--field-modified-p field)
   3313    ;; either:
   3314    (or
   3315     ;;  1) it's a nested field
   3316     ;;
   3317     (yas--field-parent-field field)
   3318     ;;  2) ends just before the snippet end
   3319     ;;
   3320     (and (eq field (car (last (yas--snippet-fields snippet))))
   3321          (= (yas--field-start field) (overlay-end (yas--snippet-control-overlay snippet)))))
   3322    ;; the field numbered 0, just before the exit marker, should
   3323    ;; never be skipped
   3324    ;;
   3325    (not (and (yas--field-number field)
   3326              (zerop (yas--field-number field))))))
   3327 
   3328 (defun yas-active-snippets (&optional beg end)
   3329   "Return a sorted list of active snippets.
   3330 The most recently-inserted snippets are returned first.
   3331 
   3332 Only snippets overlapping the region BEG ... END are returned.
   3333 Overlapping has the same meaning as described in `overlays-in'.
   3334 If END is omitted, it defaults to (1+ BEG).  If BEG is omitted,
   3335 it defaults to point.  A non-nil, non-buffer position BEG is
   3336 equivalent to a range covering the whole buffer."
   3337   (unless beg
   3338     (setq beg (point)))
   3339   (cond ((not (or (integerp beg) (markerp beg)))
   3340          (setq beg (point-min) end (point-max)))
   3341         ((not end)
   3342          (setq end (1+ beg))))
   3343   (if (and (eq beg (point-min))
   3344            (eq end (point-max)))
   3345       yas--active-snippets
   3346     ;; Note: don't use `mapcar' here, since it would allocate in
   3347     ;; proportion to the amount of overlays, even though the list of
   3348     ;; active snippets should be very small.
   3349     (let ((snippets nil))
   3350       (dolist (ov (overlays-in beg end))
   3351         (let ((snippet (overlay-get ov 'yas--snippet)))
   3352           ;; Snippets have multiple overlays, so check for dups.
   3353           (when (and snippet (not (memq snippet snippets)))
   3354             (push snippet snippets))))
   3355       (cl-sort snippets #'>= :key #'yas--snippet-id))))
   3356 
   3357 (define-obsolete-function-alias 'yas--snippets-at-point
   3358   #'yas-active-snippets "0.12")
   3359 
   3360 (defun yas-next-field-or-maybe-expand ()
   3361   "Try to expand a snippet at a key before point.
   3362 
   3363 Otherwise delegate to `yas-next-field'."
   3364   (interactive)
   3365   (if yas-triggers-in-field
   3366       (let ((yas-fallback-behavior 'return-nil)
   3367             (active-field (overlay-get yas--active-field-overlay 'yas--field)))
   3368         (when active-field
   3369           (unless (yas-expand-from-trigger-key active-field)
   3370             (yas-next-field))))
   3371     (yas-next-field)))
   3372 
   3373 (defun yas-next-field-will-exit-p (&optional arg)
   3374   "Return non-nil if (yas-next-field ARG) would exit the current snippet."
   3375   (let ((snippet (car (yas-active-snippets)))
   3376         (active (overlay-get yas--active-field-overlay 'yas--field)))
   3377     (when snippet
   3378       (not (yas--find-next-field arg snippet active)))))
   3379 
   3380 (defun yas--find-next-field (n snippet active)
   3381   "Return the Nth field after the ACTIVE one in SNIPPET."
   3382   (let ((live-fields (cl-remove-if
   3383                       (lambda (field)
   3384                         (and (not (eq field active))
   3385                              (yas--field-probably-deleted-p snippet field)))
   3386                       (yas--snippet-fields snippet))))
   3387     (nth (abs n) (memq active (if (>= n 0) live-fields (reverse live-fields))))))
   3388 
   3389 (defun yas-next-field (&optional arg)
   3390   "Navigate to the ARGth next field.
   3391 
   3392 If there's none, exit the snippet."
   3393   (interactive)
   3394   (unless arg (setq arg 1))
   3395   (let* ((active-field (overlay-get yas--active-field-overlay 'yas--field))
   3396          (snippet (car (yas-active-snippets (yas--field-start active-field)
   3397                                             (yas--field-end active-field))))
   3398          (target-field (yas--find-next-field arg snippet active-field)))
   3399     (yas--letenv (yas--snippet-expand-env snippet)
   3400       ;; Apply transform to active field.
   3401       (when active-field
   3402         (let ((yas-moving-away-p t))
   3403           (when (yas--field-update-display active-field)
   3404             (yas--update-mirrors snippet))))
   3405       ;; Now actually move...
   3406       (if target-field
   3407           (yas--move-to-field snippet target-field)
   3408         (yas-exit-snippet snippet)))))
   3409 
   3410 (defun yas--place-overlays (snippet field)
   3411   "Correctly place overlays for SNIPPET's FIELD."
   3412   (yas--make-move-field-protection-overlays snippet field)
   3413   ;; Only move active field overlays if this is field is from the
   3414   ;; innermost snippet.
   3415   (when (eq snippet (car (yas-active-snippets (1- (yas--field-start field))
   3416                                               (1+ (yas--field-end field)))))
   3417     (yas--make-move-active-field-overlay snippet field)))
   3418 
   3419 (defun yas--move-to-field (snippet field)
   3420   "Update SNIPPET to move to field FIELD.
   3421 
   3422 Also create some protection overlays"
   3423   (goto-char (yas--field-start field))
   3424   (yas--place-overlays snippet field)
   3425   (overlay-put yas--active-field-overlay 'yas--snippet snippet)
   3426   (overlay-put yas--active-field-overlay 'yas--field field)
   3427   (let ((number (yas--field-number field)))
   3428     ;; check for the special ${0: ...} field
   3429     (if (and number (zerop number))
   3430         (progn
   3431           (set-mark (yas--field-end field))
   3432           (setf (yas--snippet-force-exit snippet)
   3433                 (or (yas--field-transform field)
   3434                     t)))
   3435       ;; make this field active
   3436       (setf (yas--snippet-active-field snippet) field)
   3437       ;; primary field transform: first call to snippet transform
   3438       (unless (yas--field-modified-p field)
   3439         (if (yas--field-update-display field)
   3440             (yas--update-mirrors snippet)
   3441           (setf (yas--field-modified-p field) nil))))))
   3442 
   3443 (defun yas-prev-field ()
   3444   "Navigate to prev field.  If there's none, exit the snippet."
   3445   (interactive)
   3446   (yas-next-field -1))
   3447 
   3448 (defun yas-abort-snippet (&optional snippet)
   3449   (interactive)
   3450   (let ((snippet (or snippet
   3451                      (car (yas-active-snippets)))))
   3452     (when snippet
   3453       (setf (yas--snippet-force-exit snippet) t))))
   3454 
   3455 (defun yas-exit-snippet (snippet)
   3456   "Goto exit-marker of SNIPPET."
   3457   (interactive (list (cl-first (yas-active-snippets))))
   3458   (when snippet
   3459     (setf (yas--snippet-force-exit snippet) t)
   3460     (goto-char (if (yas--snippet-exit snippet)
   3461                    (yas--exit-marker (yas--snippet-exit snippet))
   3462                  (overlay-end (yas--snippet-control-overlay snippet))))))
   3463 
   3464 (defun yas-exit-all-snippets ()
   3465   "Exit all snippets."
   3466   (interactive)
   3467   (mapc #'(lambda (snippet)
   3468             (yas-exit-snippet snippet)
   3469             (yas--check-commit-snippet))
   3470         (yas-active-snippets 'all)))
   3471 
   3472 
   3473 ;;; Some low level snippet-routines:
   3474 
   3475 (defvar yas--inhibit-overlay-hooks nil
   3476   "Bind this temporarily to non-nil to prevent running `yas--on-*-modification'.")
   3477 
   3478 (defvar yas-snippet-beg nil "Beginning position of the last snippet committed.")
   3479 (defvar yas-snippet-end nil "End position of the last snippet committed.")
   3480 
   3481 (defun yas--commit-snippet (snippet)
   3482   "Commit SNIPPET, but leave point as it is.
   3483 
   3484 This renders the snippet as ordinary text."
   3485 
   3486   (let ((control-overlay (yas--snippet-control-overlay snippet)))
   3487     ;;
   3488     ;; Save the end of the moribund snippet in case we need to revive it
   3489     ;; its original expansion.
   3490     ;;
   3491     (when (and control-overlay
   3492                (overlay-buffer control-overlay))
   3493       (setq yas-snippet-beg (overlay-start control-overlay))
   3494       (setq yas-snippet-end (overlay-end control-overlay))
   3495       (delete-overlay control-overlay)
   3496       (setf (yas--snippet-control-overlay snippet) nil))
   3497 
   3498     (let ((yas--inhibit-overlay-hooks t))
   3499       (when yas--active-field-overlay
   3500         (delete-overlay yas--active-field-overlay))
   3501       (when yas--field-protection-overlays
   3502         (mapc #'delete-overlay yas--field-protection-overlays)))
   3503 
   3504     ;; stacked expansion: if the original expansion took place from a
   3505     ;; field, make sure we advance it here at least to
   3506     ;; `yas-snippet-end'...
   3507     ;;
   3508     (let ((previous-field (yas--snippet-previous-active-field snippet)))
   3509       (when (and yas-snippet-end previous-field)
   3510         (yas--advance-end-maybe-previous-fields
   3511          previous-field yas-snippet-end (cdr yas--active-snippets))))
   3512 
   3513     ;; Convert all markers to points,
   3514     ;;
   3515     (yas--markers-to-points snippet)
   3516 
   3517     ;; It's no longer an active snippet.
   3518     (cl-callf2 delq snippet yas--active-snippets)
   3519 
   3520     ;; Take care of snippet revival on undo.
   3521     (if (and yas-snippet-revival (listp buffer-undo-list))
   3522         (push `(apply yas--snippet-revive ,yas-snippet-beg ,yas-snippet-end ,snippet)
   3523               buffer-undo-list)
   3524       ;; Dismember the snippet... this is useful if we get called
   3525       ;; again from `yas--take-care-of-redo'....
   3526       (setf (yas--snippet-fields snippet) nil)))
   3527 
   3528   (yas--message 4 "Snippet %s exited." (yas--snippet-id snippet)))
   3529 
   3530 (defvar-local yas--snippets-to-move nil)
   3531 
   3532 (defun yas--prepare-snippets-for-move (beg end buf pos)
   3533   "Gather snippets in BEG..END for moving to POS in BUF."
   3534   (let ((to-move nil)
   3535         (snippets (yas-active-snippets beg end))
   3536         (dst-base-line (with-current-buffer buf
   3537                          (count-lines (point-min) pos))))
   3538     (when snippets
   3539       (dolist (snippet snippets)
   3540         (yas--snippet-map-markers
   3541          (lambda (m)
   3542            (prog1 (cons m (yas--snapshot-line-location m))
   3543              (set-marker m nil)))
   3544          snippet)
   3545         (let ((ctrl-ov (yas--snapshot-overlay-line-location
   3546                         (yas--snippet-control-overlay snippet))))
   3547           (push (list ctrl-ov dst-base-line snippet) to-move)
   3548           (delete-overlay (car ctrl-ov))))
   3549       (with-current-buffer buf
   3550         (cl-callf2 nconc to-move yas--snippets-to-move)))))
   3551 
   3552 (defun yas--on-buffer-kill ()
   3553   ;; Org mode uses temp buffers for fontification and "native tab",
   3554   ;; move all the snippets to the original org-mode buffer when it's
   3555   ;; killed.
   3556   (let ((org-marker nil)
   3557         (org-buffer nil))
   3558     (when (and yas-minor-mode
   3559                (or (bound-and-true-p org-edit-src-from-org-mode)
   3560                    (bound-and-true-p org-src--from-org-mode))
   3561                (markerp
   3562                 (setq org-marker
   3563                       (or (bound-and-true-p org-edit-src-beg-marker)
   3564                           (bound-and-true-p org-src--beg-marker))))
   3565                ;; If the org source buffer is killed before the temp
   3566                ;; fontification one, org-marker might point nowhere.
   3567                (setq org-buffer (marker-buffer org-marker)))
   3568       (yas--prepare-snippets-for-move
   3569        (point-min) (point-max)
   3570        org-buffer org-marker))))
   3571 
   3572 (add-hook 'kill-buffer-hook #'yas--on-buffer-kill)
   3573 
   3574 (defun yas--finish-moving-snippets ()
   3575   "Finish job started in `yas--prepare-snippets-for-move'."
   3576   (cl-loop for (ctrl-ov base-line snippet) in yas--snippets-to-move
   3577            for base-pos = (progn (goto-char (point-min))
   3578                                  (forward-line base-line) (point))
   3579            do (yas--snippet-map-markers
   3580                (lambda (saved-location)
   3581                  (let ((m (pop saved-location)))
   3582                    (set-marker m (yas--goto-saved-line-location
   3583                                   base-pos saved-location))
   3584                    m))
   3585                snippet)
   3586            (goto-char base-pos)
   3587            (yas--restore-overlay-line-location base-pos ctrl-ov)
   3588            (yas--maybe-move-to-active-field snippet)
   3589            (push snippet yas--active-snippets))
   3590   (setq yas--snippets-to-move nil))
   3591 
   3592 (defun yas--safely-call-fun (fun)
   3593   "Call FUN and catch any errors."
   3594   (condition-case error
   3595       (funcall fun)
   3596     ((debug error)
   3597      (yas--message 2 "Error running %s: %s" fun
   3598                    (error-message-string error)))))
   3599 
   3600 (defun yas--safely-run-hook (hook)
   3601   "Call HOOK's functions.
   3602 HOOK should be a symbol, a hook variable, as in `run-hooks'."
   3603   (let ((debug-on-error (and (not (memq yas-good-grace '(t hooks)))
   3604                              debug-on-error)))
   3605     (yas--safely-call-fun (apply-partially #'run-hooks hook))))
   3606 
   3607 (defun yas--check-commit-snippet ()
   3608   "Check if point exited the currently active field of the snippet.
   3609 
   3610 If so cleans up the whole snippet up."
   3611   (let* ((snippet-exit-transform nil)
   3612          (exited-snippets-p nil)
   3613          ;; Record the custom snippet `yas-after-exit-snippet-hook'
   3614          ;; set in the expand-env field.
   3615          (snippet-exit-hook yas-after-exit-snippet-hook))
   3616     (dolist (snippet yas--active-snippets)
   3617       (let ((active-field (yas--snippet-active-field snippet)))
   3618         (yas--letenv (yas--snippet-expand-env snippet)
   3619           ;; Note: the `force-exit' field could be a transform in case of
   3620           ;; ${0: ...}, see `yas--move-to-field'.
   3621           (setq snippet-exit-transform (yas--snippet-force-exit snippet))
   3622           (cond ((or snippet-exit-transform
   3623                      (not (and active-field (yas--field-contains-point-p active-field))))
   3624                  (setf (yas--snippet-force-exit snippet) nil)
   3625                  (setq snippet-exit-hook yas-after-exit-snippet-hook)
   3626                  (yas--commit-snippet snippet)
   3627                  (setq exited-snippets-p t))
   3628                 ((and active-field
   3629                       (not (and yas--active-field-overlay
   3630                                 (overlay-buffer yas--active-field-overlay))))
   3631                  ;;
   3632                  ;; stacked expansion: this case is mainly for recent
   3633                  ;; snippet exits that place us back int the field of
   3634                  ;; another snippet
   3635                  ;;
   3636                  (save-excursion
   3637                    (yas--move-to-field snippet active-field)
   3638                    (yas--update-mirrors snippet)))
   3639                 (t
   3640                  nil)))))
   3641     (unless (or yas--active-snippets (not exited-snippets-p))
   3642       (when snippet-exit-transform
   3643         (yas--eval-for-effect snippet-exit-transform))
   3644       (let ((yas-after-exit-snippet-hook snippet-exit-hook))
   3645         (yas--safely-run-hook 'yas-after-exit-snippet-hook)))))
   3646 
   3647 ;; Apropos markers-to-points:
   3648 ;;
   3649 ;; This was found useful for performance reasons, so that an excessive
   3650 ;; number of live markers aren't kept around in the
   3651 ;; `buffer-undo-list'.  We don't reuse the original marker object
   3652 ;; because that leaves an unreadable object in the history list and
   3653 ;; undo-tree persistence has trouble with that.
   3654 ;;
   3655 ;; This shouldn't bring horrible problems with undo/redo, but you
   3656 ;; never know.
   3657 ;;
   3658 (defun yas--markers-to-points (snippet)
   3659   "Save all markers of SNIPPET as positions."
   3660   (yas--snippet-map-markers (lambda (m)
   3661                               (prog1 (marker-position m)
   3662                                 (set-marker m nil)))
   3663                             snippet))
   3664 
   3665 (defun yas--points-to-markers (snippet)
   3666   "Restore SNIPPET's marker positions, saved by `yas--markers-to-points'."
   3667   (yas--snippet-map-markers #'copy-marker snippet))
   3668 
   3669 (defun yas--maybe-move-to-active-field (snippet)
   3670   "Try to move to SNIPPET's active (or first) field and return it if found."
   3671   (let ((target-field (or (yas--snippet-active-field snippet)
   3672                           (car (yas--snippet-fields snippet)))))
   3673     (when target-field
   3674       (yas--move-to-field snippet target-field)
   3675       target-field)))
   3676 
   3677 (defun yas--field-contains-point-p (field &optional point)
   3678   (let ((point (or point
   3679                    (point))))
   3680     (and (>= point (yas--field-start field))
   3681          (<= point (yas--field-end field)))))
   3682 
   3683 (defun yas--field-text-for-display (field)
   3684   "Return the propertized display text for field FIELD."
   3685   (buffer-substring (yas--field-start field) (yas--field-end field)))
   3686 
   3687 (defun yas--undo-in-progress ()
   3688   "True if some kind of undo is in progress."
   3689   (or undo-in-progress
   3690       (eq this-command 'undo)
   3691       (eq this-command 'redo)))
   3692 
   3693 (defun yas--make-control-overlay (snippet start end)
   3694   "Create the control overlay that surrounds the snippet and
   3695 holds the keymap."
   3696   (let ((overlay (make-overlay start
   3697                                end
   3698                                nil
   3699                                nil
   3700                                t)))
   3701     (overlay-put overlay 'keymap yas-keymap)
   3702     (overlay-put overlay 'priority yas-overlay-priority)
   3703     (overlay-put overlay 'yas--snippet snippet)
   3704     overlay))
   3705 
   3706 (defun yas-current-field ()
   3707   "Return the currently active field."
   3708   (and yas--active-field-overlay
   3709        (overlay-buffer yas--active-field-overlay)
   3710        (overlay-get yas--active-field-overlay 'yas--field)))
   3711 
   3712 (defun yas--maybe-clear-field-filter (cmd)
   3713   "Return CMD if at start of unmodified snippet field.
   3714 Use as a `:filter' argument for a conditional keybinding."
   3715   (let ((field (yas-current-field)))
   3716     (when (and field
   3717                (not (yas--field-modified-p field))
   3718                (eq (point) (marker-position (yas--field-start field))))
   3719       cmd)))
   3720 
   3721 (defun yas-skip-and-clear-field (&optional field)
   3722   "Clears unmodified FIELD if at field start, skips to next tab."
   3723   (interactive)
   3724   (yas--skip-and-clear (or field (yas-current-field)))
   3725   (yas-next-field 1))
   3726 
   3727 (defun yas-clear-field (&optional field)
   3728   "Clears unmodified FIELD if at field start."
   3729   (interactive)
   3730   (yas--skip-and-clear (or field (yas-current-field))))
   3731 
   3732 (defun yas-skip-and-clear-or-delete-char (&optional field)
   3733   "Clears unmodified field if at field start, skips to next tab.
   3734 
   3735 Otherwise deletes a character normally by calling `delete-char'."
   3736   (declare (obsolete "Bind to `yas-maybe-skip-and-clear-field' instead." "0.13"))
   3737   (interactive)
   3738   (cond ((yas--maybe-clear-field-filter t)
   3739          (yas--skip-and-clear (or field (yas-current-field)))
   3740          (yas-next-field 1))
   3741         (t (call-interactively 'delete-char))))
   3742 
   3743 (defun yas--skip-and-clear (field &optional from)
   3744   "Delete the region of FIELD and set its modified state to t.
   3745 If given, FROM indicates position to start at instead of FIELD's beginning."
   3746   ;; Just before skipping-and-clearing the field, mark its children
   3747   ;; fields as modified, too. If the children have mirrors-in-fields
   3748   ;; this prevents them from updating erroneously (we're skipping and
   3749   ;; deleting!).
   3750   ;;
   3751   (yas--mark-this-and-children-modified field)
   3752   (unless (= (yas--field-start field) (yas--field-end field))
   3753     (delete-region (or from (yas--field-start field)) (yas--field-end field))))
   3754 
   3755 (defun yas--mark-this-and-children-modified (field)
   3756   (setf (yas--field-modified-p field) t)
   3757   (let ((fom (yas--field-next field)))
   3758     (while (and fom
   3759                 (yas--fom-parent-field fom))
   3760       (when (and (eq (yas--fom-parent-field fom) field)
   3761                  (yas--field-p fom))
   3762         (yas--mark-this-and-children-modified fom))
   3763       (setq fom (yas--fom-next fom)))))
   3764 
   3765 (defun yas--make-move-active-field-overlay (snippet field)
   3766   "Place the active field overlay in SNIPPET's FIELD.
   3767 
   3768 Move the overlay, or create it if it does not exit."
   3769   (if (and yas--active-field-overlay
   3770            (overlay-buffer yas--active-field-overlay))
   3771       (move-overlay yas--active-field-overlay
   3772                     (yas--field-start field)
   3773                     (yas--field-end field))
   3774     (setq yas--active-field-overlay
   3775           (make-overlay (yas--field-start field)
   3776                         (yas--field-end field)
   3777                         nil nil t))
   3778     (overlay-put yas--active-field-overlay 'priority yas-overlay-priority)
   3779     (overlay-put yas--active-field-overlay 'face 'yas-field-highlight-face)
   3780     (overlay-put yas--active-field-overlay 'yas--snippet snippet)
   3781     (overlay-put yas--active-field-overlay 'modification-hooks '(yas--on-field-overlay-modification))
   3782     (overlay-put yas--active-field-overlay 'insert-in-front-hooks
   3783                  '(yas--on-field-overlay-modification))
   3784     (overlay-put yas--active-field-overlay 'insert-behind-hooks
   3785                  '(yas--on-field-overlay-modification))))
   3786 
   3787 (defun yas--skip-and-clear-field-p (field beg _end length)
   3788   "Tell if newly modified FIELD should be cleared and skipped.
   3789 BEG, END and LENGTH like overlay modification hooks."
   3790   (and (= length 0) ; A 0 pre-change length indicates insertion.
   3791        (= beg (yas--field-start field)) ; Insertion at field start?
   3792        (not (yas--field-modified-p field))))
   3793 
   3794 
   3795 (defun yas--merge-and-drop-dups (list1 list2 cmp key)
   3796   ;; `delete-consecutive-dups' + `cl-merge'.
   3797   (delete-consecutive-dups
   3798    (cl-merge 'list list1 list2 cmp :key key)))
   3799 
   3800 (defvar-local yas--before-change-modified-snippets nil)
   3801 
   3802 (defun yas--gather-active-snippets (overlay beg end then-delete)
   3803   ;; Add active snippets in BEG..END into an OVERLAY keyed entry of
   3804   ;; `yas--before-change-modified-snippets'.  Return accumulated list.
   3805   ;; If THEN-DELETE is non-nil, delete the entry.
   3806   (let ((new (yas-active-snippets beg end))
   3807         (old (assq overlay yas--before-change-modified-snippets)))
   3808     (prog1 (cond ((and new old)
   3809                   (setf (cdr old)
   3810                         (yas--merge-and-drop-dups
   3811                          (cdr old) new
   3812                          ;; Sort like `yas-active-snippets'.
   3813                          #'>= #'yas--snippet-id)))
   3814                  (new (unless then-delete
   3815                         ;; Don't add new entry if we're about to
   3816                         ;; remove it anyway.
   3817                         (push (cons overlay new)
   3818                               yas--before-change-modified-snippets))
   3819                       new)
   3820                  (old (cdr old))
   3821                  (t nil))
   3822       (when then-delete
   3823         (cl-callf2 delq old yas--before-change-modified-snippets)))))
   3824 
   3825 (defvar-local yas--todo-snippet-indent nil nil)
   3826 
   3827 (defun yas--on-field-overlay-modification (overlay after? beg end &optional length)
   3828   "Clears the field and updates mirrors, conditionally.
   3829 
   3830 Only clears the field if it hasn't been modified and point is at
   3831 field start.  This hook does nothing if an undo is in progress."
   3832   (unless (or yas--inhibit-overlay-hooks
   3833               (not (overlayp yas--active-field-overlay)) ; Avoid Emacs bug #21824.
   3834               ;; If a single change hits multiple overlays of the same
   3835               ;; snippet, then we delete the snippet the first time,
   3836               ;; and then subsequent calls get a deleted overlay.
   3837               ;; Don't delete the snippet again!
   3838               (not (overlay-buffer overlay))
   3839               (yas--undo-in-progress))
   3840     (let* ((inhibit-modification-hooks nil)
   3841            (yas--inhibit-overlay-hooks t)
   3842            (field (overlay-get overlay 'yas--field))
   3843            (snippet (overlay-get yas--active-field-overlay 'yas--snippet)))
   3844       (if (yas--snippet-live-p snippet)
   3845           (if after?
   3846               (save-match-data
   3847                 (yas--letenv (yas--snippet-expand-env snippet)
   3848                   (when (yas--skip-and-clear-field-p field beg end length)
   3849                     ;; We delete text starting from the END of insertion.
   3850                     (yas--skip-and-clear field end))
   3851                   (setf (yas--field-modified-p field) t)
   3852                   ;; Adjust any pending active fields in case of stacked
   3853                   ;; expansion.
   3854                   (yas--advance-end-maybe-previous-fields
   3855                    field (overlay-end overlay)
   3856                    (yas--gather-active-snippets overlay beg end t))
   3857                   ;; Update fields now, but delay auto indentation until
   3858                   ;; post-command.  We don't want to run indentation on
   3859                   ;; the intermediate state where field text might be
   3860                   ;; removed (and hence the field could be deleted along
   3861                   ;; with leading indentation).
   3862                   (let ((yas-indent-line nil))
   3863                     (save-excursion
   3864                       (yas--field-update-display field))
   3865                     (yas--update-mirrors snippet))
   3866                   (unless (or (not (eq yas-indent-line 'auto))
   3867                               (memq snippet yas--todo-snippet-indent))
   3868                     (push snippet yas--todo-snippet-indent))))
   3869             ;; Remember active snippets to use for after the change.
   3870             (yas--gather-active-snippets overlay beg end nil))
   3871         (lwarn '(yasnippet zombie) :warning "Killing zombie snippet!")
   3872         (delete-overlay overlay)))))
   3873 
   3874 (defun yas--do-todo-snippet-indent ()
   3875   ;; Do pending indentation of snippet fields, called from
   3876   ;; `yas--post-command-handler'.
   3877   (when yas--todo-snippet-indent
   3878     (save-excursion
   3879       (cl-loop for snippet in yas--todo-snippet-indent
   3880                do (yas--indent-mirrors-of-snippet
   3881                    snippet (yas--snippet-field-mirrors snippet)))
   3882       (setq yas--todo-snippet-indent nil))))
   3883 
   3884 (defun yas--auto-fill (orig-fun &rest args)
   3885   ;; Preserve snippet markers during auto-fill.
   3886   (let* ((orig-point (point))
   3887          (end (progn (forward-paragraph) (point)))
   3888          (beg (progn (backward-paragraph) (point)))
   3889          (snippets (yas-active-snippets beg end))
   3890          (remarkers nil)
   3891          (reoverlays nil))
   3892     (dolist (snippet snippets)
   3893       (dolist (m (yas--collect-snippet-markers snippet))
   3894         (when (and (<= beg m) (<= m end))
   3895           (push (cons m (yas--snapshot-location m beg end)) remarkers)))
   3896       (push (yas--snapshot-overlay-location
   3897              (yas--snippet-control-overlay snippet) beg end)
   3898             reoverlays))
   3899     (goto-char orig-point)
   3900     (let ((yas--inhibit-overlay-hooks t))
   3901       (apply orig-fun args))
   3902     (save-excursion
   3903       (setq end (progn (forward-paragraph) (point)))
   3904       (setq beg (progn (backward-paragraph) (point))))
   3905     (save-excursion
   3906       (save-restriction
   3907         (narrow-to-region beg end)
   3908         (dolist (remarker remarkers)
   3909           (set-marker (car remarker)
   3910                       (yas--goto-saved-location (cdr remarker))))
   3911         (mapc #'yas--restore-overlay-location reoverlays))
   3912       (mapc (lambda (snippet)
   3913               (yas--letenv (yas--snippet-expand-env snippet)
   3914                 (yas--update-mirrors snippet)))
   3915             snippets))))
   3916 
   3917 
   3918 ;;; Apropos protection overlays:
   3919 ;;
   3920 ;; These exist for nasty users who will try to delete parts of the
   3921 ;; snippet outside the active field. Actual protection happens in
   3922 ;; `yas--on-protection-overlay-modification'.
   3923 ;;
   3924 ;; As of github #537 this no longer inhibits the command by issuing an
   3925 ;; error: all the snippets at point, including nested snippets, are
   3926 ;; automatically commited and the current command can proceed.
   3927 ;;
   3928 (defun yas--make-move-field-protection-overlays (snippet field)
   3929   "Place protection overlays surrounding SNIPPET's FIELD.
   3930 
   3931 Move the overlays, or create them if they do not exit."
   3932   (let ((start (yas--field-start field))
   3933         (end (yas--field-end field)))
   3934     ;; First check if the (1+ end) is contained in the buffer,
   3935     ;; otherwise we'll have to do a bit of cheating and silently
   3936     ;; insert a newline. the `(1+ (buffer-size))' should prevent this
   3937     ;; when using stacked expansion
   3938     ;;
   3939     (when (< (buffer-size) end)
   3940       (save-excursion
   3941         (let ((yas--inhibit-overlay-hooks t))
   3942           (goto-char (point-max))
   3943           (newline))))
   3944     ;; go on to normal overlay creation/moving
   3945     ;;
   3946     (cond ((and yas--field-protection-overlays
   3947                 (cl-every #'overlay-buffer yas--field-protection-overlays))
   3948            (move-overlay (nth 0 yas--field-protection-overlays)
   3949                          (1- start) start)
   3950            (move-overlay (nth 1 yas--field-protection-overlays) end (1+ end)))
   3951           (t
   3952            (setq yas--field-protection-overlays
   3953                  (list (make-overlay (1- start) start nil t nil)
   3954                        (make-overlay end (1+ end) nil t nil)))
   3955            (dolist (ov yas--field-protection-overlays)
   3956              (overlay-put ov 'face 'yas--field-debug-face)
   3957              (overlay-put ov 'yas--snippet snippet)
   3958              ;; (overlay-put ov 'evaporate t)
   3959              (overlay-put ov 'modification-hooks
   3960                           '(yas--on-protection-overlay-modification)))))))
   3961 
   3962 (defun yas--on-protection-overlay-modification (overlay after? beg end &optional length)
   3963   "Commit the snippet if the protection overlay is being killed."
   3964   (unless (or yas--inhibit-overlay-hooks
   3965               yas-inhibit-overlay-modification-protection
   3966               (not after?)
   3967               (= length (- end beg)) ; deletion or insertion
   3968               (>= beg (overlay-end overlay)) ;Emacs=29.1 bug#65929
   3969               (yas--undo-in-progress))
   3970     (let ((snippets (yas-active-snippets)))
   3971       (yas--message 2 "Committing snippets. Action would destroy a protection overlay.")
   3972       (cl-loop for snippet in snippets
   3973                do (yas--commit-snippet snippet)))))
   3974 
   3975 
   3976 ;;; Snippet expansion and "stacked" expansion:
   3977 ;;
   3978 ;; Stacked expansion is when you try to expand a snippet when already
   3979 ;; inside a snippet expansion.
   3980 ;;
   3981 ;; The parent snippet does not run its fields modification hooks
   3982 ;; (`yas--on-field-overlay-modification' and
   3983 ;; `yas--on-protection-overlay-modification') while the child snippet
   3984 ;; is active. This means, among other things, that the mirrors of the
   3985 ;; parent snippet are not updated, this only happening when one exits
   3986 ;; the child snippet.
   3987 ;;
   3988 ;; Unfortunately, this also puts some ugly (and not fully-tested)
   3989 ;; bits of code in `yas-expand-snippet' and
   3990 ;; `yas--commit-snippet'. I've tried to mark them with "stacked
   3991 ;; expansion:".
   3992 ;;
   3993 ;; This was thought to be safer in an undo/redo perspective, but
   3994 ;; maybe the correct implementation is to make the globals
   3995 ;; `yas--active-field-overlay' and `yas--field-protection-overlays' be
   3996 ;; snippet-local and be active even while the child snippet is
   3997 ;; running. This would mean a lot of overlay modification hooks
   3998 ;; running, but if managed correctly (including overlay priorities)
   3999 ;; they should account for all situations...
   4000 
   4001 (defun yas-expand-snippet (snippet &optional start end expand-env)
   4002   "Expand SNIPPET at current point.
   4003 
   4004 Text between START and END will be deleted before inserting
   4005 template.  EXPAND-ENV is a list of (SYM VALUE) let-style dynamic
   4006 bindings considered when expanding the snippet.  If omitted, use
   4007 SNIPPET's expand-env field.
   4008 
   4009 SNIPPET may be a snippet structure (e.g., as returned by
   4010 `yas-lookup-snippet'), or just a snippet body (which is a string
   4011 for normal snippets, and a list for command snippets)."
   4012   (cl-assert (and yas-minor-mode
   4013                   (memq #'yas--post-command-handler post-command-hook))
   4014              nil
   4015              "[yas] `yas-expand-snippet' needs properly setup `yas-minor-mode'")
   4016   (run-hooks 'yas-before-expand-snippet-hook)
   4017 
   4018   (let* ((clear-field
   4019           (let ((field (yas-current-field)))
   4020             (and field (yas--skip-and-clear-field-p
   4021                         field (point) (point) 0)
   4022                  field)))
   4023          (start (cond (start)
   4024                       ((region-active-p)
   4025                        (region-beginning))
   4026                       (clear-field
   4027                        (yas--field-start clear-field))
   4028                       (t (point))))
   4029          (end (cond (end)
   4030                     ((region-active-p)
   4031                      (region-end))
   4032                     (clear-field
   4033                      (yas--field-end clear-field))
   4034                     (t (point))))
   4035          (to-delete (and (> end start)
   4036                          (buffer-substring-no-properties start end)))
   4037          (yas-selected-text
   4038           (cond (yas-selected-text)
   4039                 ((and (region-active-p)
   4040                       (not clear-field))
   4041                  to-delete))))
   4042     (goto-char start)
   4043     (setq yas--indent-original-column (current-column))
   4044     ;; Delete the region to delete, this *does* get undo-recorded.
   4045     (when to-delete
   4046       (delete-region start end))
   4047 
   4048     (let ((content (if (yas--template-p snippet)
   4049                        (yas--template-content snippet)
   4050                      snippet)))
   4051       (when (and (not expand-env) (yas--template-p snippet))
   4052         (setq expand-env (yas--template-expand-env snippet)))
   4053       (cond ((listp content)
   4054              ;; x) This is a snippet-command.
   4055              (yas--eval-for-effect content))
   4056             (t
   4057              ;; x) This is a snippet-snippet :-)
   4058              (setq yas--start-column (current-column))
   4059              ;; Stacked expansion: also shoosh the overlay modification hooks.
   4060              (let ((yas--inhibit-overlay-hooks t))
   4061                (setq snippet
   4062                      (yas--snippet-create content expand-env start (point))))
   4063 
   4064              ;; Stacked-expansion: This checks for stacked expansion, save the
   4065              ;; `yas--previous-active-field' and advance its boundary.
   4066              (let ((existing-field (yas-current-field)))
   4067                (when existing-field
   4068                  (setf (yas--snippet-previous-active-field snippet) existing-field)
   4069                  (yas--advance-end-maybe-previous-fields
   4070                   existing-field (overlay-end yas--active-field-overlay)
   4071                   (cdr yas--active-snippets))))
   4072 
   4073              ;; Exit the snippet immediately if no fields.
   4074              (unless (yas--snippet-fields snippet)
   4075                (yas-exit-snippet snippet))
   4076 
   4077              ;; Now, schedule a move to the first field.
   4078              (let ((first-field (car (yas--snippet-fields snippet))))
   4079                (when first-field
   4080                  (sit-for 0) ;; fix issue 125
   4081                  (yas--letenv (yas--snippet-expand-env snippet)
   4082                    (yas--move-to-field snippet first-field))
   4083                  (when (and (eq (yas--field-number first-field) 0)
   4084                             (> (length (yas--field-text-for-display
   4085                                         first-field))
   4086                                0))
   4087                    ;; Keep region for ${0:exit text}.
   4088                    (setq deactivate-mark nil))))
   4089              (yas--message 4 "snippet %d expanded." (yas--snippet-id snippet))
   4090              t)))))
   4091 
   4092 (defun yas--take-care-of-redo (snippet)
   4093   "Commits SNIPPET, which in turn pushes an undo action for reviving it.
   4094 
   4095 Meant to exit in the `buffer-undo-list'."
   4096   ;; slightly optimize: this action is only needed for snippets with
   4097   ;; at least one field
   4098   (when (yas--snippet-fields snippet)
   4099     (yas--commit-snippet snippet)))
   4100 
   4101 (defun yas--snippet-revive (beg end snippet)
   4102   "Revives SNIPPET and creates a control overlay from BEG to END.
   4103 
   4104 BEG and END are, we hope, the original snippets boundaries.
   4105 All the markers/points exiting existing inside SNIPPET should point
   4106 to their correct locations *at the time the snippet is revived*.
   4107 
   4108 After revival, push the `yas--take-care-of-redo' in the
   4109 `buffer-undo-list'"
   4110   ;; Reconvert all the points to markers
   4111   (yas--points-to-markers snippet)
   4112   ;; When at least one editable field existed in the zombie snippet,
   4113   ;; try to revive the whole thing...
   4114   (when (yas--maybe-move-to-active-field snippet)
   4115     (setf (yas--snippet-control-overlay snippet) (yas--make-control-overlay snippet beg end))
   4116     (overlay-put (yas--snippet-control-overlay snippet) 'yas--snippet snippet)
   4117     (push snippet yas--active-snippets)
   4118     (when (listp buffer-undo-list)
   4119       (push `(apply yas--take-care-of-redo ,snippet)
   4120             buffer-undo-list))))
   4121 
   4122 (defun yas--snippet-create (content expand-env begin end)
   4123   "Create a snippet from a template inserted at BEGIN to END.
   4124 
   4125 Returns the newly created snippet."
   4126   (save-restriction
   4127     (let ((snippet (yas--make-snippet expand-env)))
   4128       (yas--letenv expand-env
   4129         ;; Put a single undo action for the expanded snippet's
   4130         ;; content.
   4131         (let ((buffer-undo-list t))
   4132           (goto-char begin)
   4133           (if (> emacs-major-version 29)
   4134               ;; Don't use the workaround for CC-mode's cache,
   4135               ;; since it was presumably a bug in CC-mode, so either
   4136               ;; it's fixed already, or it should get fixed.
   4137               (progn
   4138                 (insert content)
   4139                 (narrow-to-region begin (point))
   4140                 (goto-char (point-min))
   4141                 (yas--snippet-parse-create snippet))
   4142             ;; Call before and after change functions manually,
   4143             ;; otherwise cc-mode's cache can get messed up.  Don't use
   4144             ;; `inhibit-modification-hooks' for that, that blocks
   4145             ;; overlay and text property hooks as well!  FIXME: Maybe
   4146             ;; use `combine-change-calls'?  (Requires Emacs 27+ though.)
   4147             (run-hook-with-args 'before-change-functions begin end)
   4148             (let ((before-change-functions nil)
   4149                   (after-change-functions nil))
   4150               ;; Some versions of cc-mode (might be the one with Emacs
   4151               ;; 24.3 only) fail when inserting snippet content in a
   4152               ;; narrowed buffer, so make sure to insert before
   4153               ;; narrowing.
   4154               (insert content)
   4155               (narrow-to-region begin (point))
   4156               (goto-char (point-min))
   4157               (yas--snippet-parse-create snippet))
   4158             (run-hook-with-args 'after-change-functions
   4159                                 (point-min) (point-max)
   4160                                 (- end begin))))
   4161         (when (listp buffer-undo-list)
   4162           (push (cons (point-min) (point-max))
   4163                 buffer-undo-list))
   4164 
   4165         ;; Indent, collecting undo information normally.
   4166         (yas--indent snippet)
   4167 
   4168         ;; Follow up with `yas--take-care-of-redo' on the newly
   4169         ;; inserted snippet boundaries.
   4170         (when (listp buffer-undo-list)
   4171           (push `(apply yas--take-care-of-redo ,snippet)
   4172                 buffer-undo-list))
   4173 
   4174         ;; Sort and link each field
   4175         (yas--snippet-sort-fields snippet)
   4176 
   4177         ;; Create keymap overlay for snippet
   4178         (setf (yas--snippet-control-overlay snippet)
   4179               (yas--make-control-overlay snippet (point-min) (point-max)))
   4180 
   4181         ;; Move to end
   4182         (goto-char (point-max))
   4183 
   4184         (push snippet yas--active-snippets)
   4185         snippet))))
   4186 
   4187 
   4188 ;;; Apropos adjacencies and "fom's":
   4189 ;;
   4190 ;; Once the $-constructs bits like "$n" and "${:n" are deleted in the
   4191 ;; recently expanded snippet, we might actually have many fields,
   4192 ;; mirrors (and the snippet exit) in the very same position in the
   4193 ;; buffer. Therefore we need to single-link the
   4194 ;; fields-or-mirrors-or-exit (which I have abbreviated to "fom")
   4195 ;; according to their original positions in the buffer.
   4196 ;;
   4197 ;; Then we have operation `yas--advance-end-maybe' and
   4198 ;; `yas--advance-start-maybe', which conditionally push the starts and
   4199 ;; ends of these foms down the chain.
   4200 ;;
   4201 ;; This allows for like the printf with the magic ",":
   4202 ;;
   4203 ;;   printf ("${1:%s}\\n"${1:$(if (string-match "%" text) "," "\);")}  \
   4204 ;;   $2${1:$(if (string-match "%" text) "\);" "")}$0
   4205 ;;
   4206 (defun yas--fom-start (fom)
   4207   (cond ((yas--field-p fom)
   4208          (yas--field-start fom))
   4209         ((yas--mirror-p fom)
   4210          (yas--mirror-start fom))
   4211         (t
   4212          (yas--exit-marker fom))))
   4213 
   4214 (defun yas--fom-end (fom)
   4215   (cond ((yas--field-p fom)
   4216          (yas--field-end fom))
   4217         ((yas--mirror-p fom)
   4218          (yas--mirror-end fom))
   4219         (t
   4220          (yas--exit-marker fom))))
   4221 
   4222 (defun yas--fom-next (fom)
   4223   (cond ((yas--field-p fom)
   4224          (yas--field-next fom))
   4225         ((yas--mirror-p fom)
   4226          (yas--mirror-next fom))
   4227         (t
   4228          (yas--exit-next fom))))
   4229 
   4230 (defun yas--fom-parent-field (fom)
   4231   (cond ((yas--field-p fom)
   4232          (yas--field-parent-field fom))
   4233         ((yas--mirror-p fom)
   4234          (yas--mirror-parent-field fom))
   4235         (t
   4236          nil)))
   4237 
   4238 (defun yas--calculate-adjacencies (snippet)
   4239   "Calculate adjacencies for fields or mirrors of SNIPPET.
   4240 
   4241 This is according to their relative positions in the buffer, and
   4242 has to be called before the $-constructs are deleted."
   4243   (let* ((fom-set-next-fom
   4244          (lambda (fom nextfom)
   4245            (cond ((yas--field-p fom)
   4246                   (setf (yas--field-next fom) nextfom))
   4247                  ((yas--mirror-p fom)
   4248                   (setf (yas--mirror-next fom) nextfom))
   4249                  (t
   4250                   (setf (yas--exit-next fom) nextfom)))))
   4251         (compare-fom-begs
   4252          (lambda (fom1 fom2)
   4253            (if (= (yas--fom-start fom2) (yas--fom-start fom1))
   4254                (yas--mirror-p fom2)
   4255              (>= (yas--fom-start fom2) (yas--fom-start fom1)))))
   4256         (link-foms fom-set-next-fom))
   4257     ;; make some yas--field, yas--mirror and yas--exit soup
   4258     (let ((soup))
   4259       (when (yas--snippet-exit snippet)
   4260         (push (yas--snippet-exit snippet) soup))
   4261       (dolist (field (yas--snippet-fields snippet))
   4262         (push field soup)
   4263         (dolist (mirror (yas--field-mirrors field))
   4264           (push mirror soup)))
   4265       (setq soup
   4266             (sort soup compare-fom-begs))
   4267       (when soup
   4268         (cl-reduce link-foms soup)))))
   4269 
   4270 (defun yas--calculate-simple-fom-parentage (snippet fom)
   4271   "Discover if FOM is parented by some field in SNIPPET.
   4272 
   4273 Use the tightest containing field if more than one field contains
   4274 the mirror.  Intended to be called *before* the dollar-regions are
   4275 deleted."
   4276   (let ((min (point-min))
   4277         (max (point-max)))
   4278     (dolist (field (remq fom (yas--snippet-fields snippet)))
   4279       (when (and (<= (yas--field-start field) (yas--fom-start fom))
   4280                  (<= (yas--fom-end fom) (yas--field-end field))
   4281                (< min (yas--field-start field))
   4282                (< (yas--field-end field) max))
   4283           (setq min (yas--field-start field)
   4284                 max (yas--field-end field))
   4285           (cond ((yas--field-p fom)
   4286                  (setf (yas--field-parent-field fom) field))
   4287                 ((yas--mirror-p fom)
   4288                  (setf (yas--mirror-parent-field fom) field))
   4289                 (t ; it's an exit, so noop
   4290                  nil ))))))
   4291 
   4292 (defun yas--advance-end-maybe (fom newend)
   4293   "Maybe advance FOM's end to NEWEND if it needs it.
   4294 
   4295 If it does, also:
   4296 
   4297 * call `yas--advance-start-maybe' on FOM's next fom.
   4298 
   4299 * in case FOM is field call `yas--advance-end-maybe' on its parent
   4300   field
   4301 
   4302 Also, if FOM is an exit-marker, always call
   4303 `yas--advance-start-maybe' on its next fom.  This is because
   4304 exit-marker have identical start and end markers."
   4305   (cond ((and fom (< (yas--fom-end fom) newend))
   4306          (set-marker (yas--fom-end fom) newend)
   4307          (yas--advance-start-maybe (yas--fom-next fom) newend)
   4308          (yas--advance-end-of-parents-maybe (yas--fom-parent-field fom) newend))
   4309         ((yas--exit-p fom)
   4310          (yas--advance-start-maybe (yas--fom-next fom) newend))))
   4311 
   4312 (defun yas--advance-end-maybe-previous-fields (field end snippets)
   4313   "Call `yas--advance-end-maybe' on FIELD, and previous fields on SNIPPETS."
   4314   (dolist (snippet snippets)
   4315     (cl-assert (memq field (yas--snippet-fields snippet)))
   4316     (yas--advance-end-maybe field end)
   4317     (setq field (yas--snippet-previous-active-field snippet))))
   4318 
   4319 (defun yas--advance-start-maybe (fom newstart)
   4320   "Maybe advance FOM's start to NEWSTART if it needs it.
   4321 
   4322 If it does, also call `yas--advance-end-maybe' on FOM."
   4323   (when (and fom (< (yas--fom-start fom) newstart))
   4324     (set-marker (yas--fom-start fom) newstart)
   4325     (yas--advance-end-maybe fom newstart)))
   4326 
   4327 (defun yas--advance-end-of-parents-maybe (field newend)
   4328   "Like `yas--advance-end-maybe' but for parent fields.
   4329 
   4330 Only works for fields and doesn't care about the start of the
   4331 next FOM.  Works its way up recursively for parents of parents."
   4332   (when (and field
   4333              (< (yas--field-end field) newend))
   4334     (set-marker (yas--field-end field) newend)
   4335     (yas--advance-end-of-parents-maybe (yas--field-parent-field field) newend)))
   4336 
   4337 (defvar yas--dollar-regions nil
   4338   "When expanding the snippet the \"parse-create\" functions add
   4339 cons cells to this var.")
   4340 
   4341 (defvar yas--indent-markers nil
   4342   "List of markers for manual indentation.")
   4343 
   4344 (defun yas--snippet-parse-create (snippet)
   4345   "Parse a recently inserted snippet template, creating all
   4346 necessary fields, mirrors and exit points.
   4347 
   4348 Meant to be called in a narrowed buffer, does various passes"
   4349   (let ((saved-quotes nil)
   4350         (parse-start (point)))
   4351     ;; Avoid major-mode's syntax propertizing function, since we
   4352     ;; change the syntax-table while calling `scan-sexps'.
   4353     (let ((syntax-propertize-function nil))
   4354       (setq yas--dollar-regions nil)  ; Reset the yas--dollar-regions.
   4355       (yas--protect-escapes nil '(?`))  ; Protect just the backquotes.
   4356       (goto-char parse-start)
   4357       (setq saved-quotes (yas--save-backquotes)) ; `expressions`.
   4358       (yas--protect-escapes)            ; Protect escaped characters.
   4359       (goto-char parse-start)
   4360       (yas--indent-parse-create)        ; Parse indent markers: `$>'.
   4361       (goto-char parse-start)
   4362       (yas--field-parse-create snippet) ; Parse fields with {}.
   4363       (goto-char parse-start)
   4364       (yas--simple-fom-create snippet) ; Parse simple mirrors & fields.
   4365       (goto-char parse-start)
   4366       (yas--transform-mirror-parse-create snippet) ; Parse mirror transforms.
   4367       ;; Invalidate any syntax-propertizing done while
   4368       ;; `syntax-propertize-function' was nil.
   4369       (syntax-ppss-flush-cache parse-start))
   4370     ;; Set "next" links of fields & mirrors.
   4371     (yas--calculate-adjacencies snippet)
   4372     (yas--save-restriction-and-widen    ; Delete $-constructs.
   4373       (yas--delete-regions yas--dollar-regions))
   4374     ;; Make sure to do this insertion *after* deleting the dollar
   4375     ;; regions, otherwise we invalidate the calculated positions of
   4376     ;; all the fields following $0.
   4377     (let ((exit (yas--snippet-exit snippet)))
   4378       (goto-char (if exit (yas--exit-marker exit) (point-max))))
   4379     (when (eq yas-wrap-around-region 'cua)
   4380       (setq yas-wrap-around-region ?0))
   4381     (cond ((and yas-wrap-around-region yas-selected-text)
   4382            (insert yas-selected-text))
   4383           ((and (characterp yas-wrap-around-region)
   4384                 (get-register yas-wrap-around-region))
   4385            (insert (prog1 (get-register yas-wrap-around-region)
   4386                      (set-register yas-wrap-around-region nil)))))
   4387     (yas--restore-backquotes saved-quotes)  ; Restore `expression` values.
   4388     (goto-char parse-start)
   4389     (yas--restore-escapes)        ; Restore escapes.
   4390     (yas--update-mirrors snippet) ; Update mirrors for the first time.
   4391     (goto-char parse-start)))
   4392 
   4393 ;; HACK: Some implementations of `indent-line-function' (called via
   4394 ;; `indent-according-to-mode') delete text before they insert (like
   4395 ;; cc-mode), some make complicated regexp replacements (looking at
   4396 ;; you, org-mode).  To find place where the marker "should" go after
   4397 ;; indentation, we create a regexp based on what the line looks like
   4398 ;; before, putting a capture group where the marker is.  The regexp
   4399 ;; matches any whitespace with [[:space:]]* to allow for the
   4400 ;; indentation changing whitespace.  Additionally, we try to preserve
   4401 ;; the amount of whitespace *following* the marker, because
   4402 ;; indentation generally affects whitespace at the beginning, not the
   4403 ;; end.
   4404 ;;
   4405 ;; Two other cases where we apply a similar strategy:
   4406 ;;
   4407 ;; 1. Handling `auto-fill-mode', in this case we need to use the
   4408 ;; current paragraph instead of line.
   4409 ;;
   4410 ;; 2. Moving snippets from an `org-src' temp buffer into the main org
   4411 ;; buffer, in this case we need to count the relative line number
   4412 ;; (because org may add indentation on each line making character
   4413 ;; positions unreliable).
   4414 ;;
   4415 ;; Data formats:
   4416 ;; (LOCATION) = (REGEXP WS-COUNT)
   4417 ;; MARKER -> (MARKER . (LOCATION))
   4418 ;; OVERLAY -> (OVERLAY LOCATION-BEG LOCATION-END)
   4419 ;;
   4420 ;; For `org-src' temp buffer, add a line number to format:
   4421 ;; (LINE-LOCATION) = (LINE . (LOCATION))
   4422 ;; MARKER@LINE -> (MARKER . (LINE-LOCATION))
   4423 ;; OVERLAY@LINE -> (OVERLAY LINE-LOCATION-BEG LINE-LOCATION-END)
   4424 ;;
   4425 ;; This is all best-effort heuristic stuff, but it should cover 99% of
   4426 ;; use-cases.
   4427 
   4428 (defun yas--snapshot-location (position &optional beg end)
   4429   "Returns info for restoring POSITIONS's location after indent.
   4430 The returned value is a list of the form (REGEXP WS-COUNT).
   4431 POSITION may be either a marker or just a buffer position.  The
   4432 REGEXP matches text between BEG..END which default to the current
   4433 line if omitted."
   4434   (goto-char position)
   4435   (unless beg (setq beg (line-beginning-position)))
   4436   (unless end (setq end (line-end-position)))
   4437   (let ((before (split-string (buffer-substring-no-properties beg position)
   4438                               "[[:space:]\n]+" t))
   4439         (after (split-string (buffer-substring-no-properties position end)
   4440                              "[[:space:]\n]+" t)))
   4441     (list (concat "[[:space:]\n]*"
   4442                   (mapconcat (lambda (s)
   4443                                (if (eq s position) "\\(\\)"
   4444                                  (regexp-quote s)))
   4445                              (nconc before (list position) after)
   4446                              "[[:space:]\n]*"))
   4447           (progn (skip-chars-forward "[:space:]\n" end)
   4448                  (- (point) position)))))
   4449 
   4450 (defun yas--snapshot-line-location (position &optional beg end)
   4451   "Like `yas--snapshot-location', but return also line number.
   4452 Returned format is (LINE REGEXP WS-COUNT)."
   4453   (goto-char position)
   4454   (cons (count-lines (point-min) (line-beginning-position))
   4455         (yas--snapshot-location position beg end)))
   4456 
   4457 (defun yas--snapshot-overlay-location (overlay beg end)
   4458   "Like `yas--snapshot-location' for overlays.
   4459 The returned format is (OVERLAY (RE WS) (RE WS)).  Either of
   4460 the (RE WS) lists may be nil if the start or end, respectively,
   4461 of the overlay is outside the range BEG .. END."
   4462   (let ((obeg (overlay-start overlay))
   4463         (oend (overlay-end overlay)))
   4464     (list overlay
   4465           (when (and (<= beg obeg) (< obeg end))
   4466             (yas--snapshot-location obeg beg end))
   4467           (when (and (<= beg oend) (< oend end))
   4468             (yas--snapshot-location oend beg end)))))
   4469 
   4470 (defun yas--snapshot-overlay-line-location (overlay)
   4471   "Return info for restoring OVERLAY's line based location.
   4472 The returned format is (OVERLAY (LINE RE WS) (LINE RE WS))."
   4473   (list overlay
   4474         (yas--snapshot-line-location (overlay-start overlay))
   4475         (yas--snapshot-line-location (overlay-end overlay))))
   4476 
   4477 (defun yas--goto-saved-location (re-count)
   4478   "Move to and return point saved by `yas--snapshot-location'.
   4479 Buffer must be narrowed to BEG..END used to create the snapshot info."
   4480   (let ((regexp (pop re-count))
   4481         (ws-count (pop re-count)))
   4482     (goto-char (point-min))
   4483     (if (not (looking-at regexp))
   4484         (lwarn '(yasnippet re-marker) :warning
   4485                "Couldn't find: %S" regexp)
   4486       (goto-char (match-beginning 1))
   4487       (skip-chars-forward "[:space:]\n")
   4488       (skip-chars-backward "[:space:]\n" (- (point) ws-count)))
   4489     (point)))
   4490 
   4491 (defun yas--restore-overlay-location (ov-locations)
   4492   "Restores marker based on info from `yas--snapshot-overlay-location'.
   4493 Buffer must be narrowed to BEG..END used to create the snapshot info."
   4494   (cl-destructuring-bind (overlay loc-beg loc-end) ov-locations
   4495     (move-overlay overlay
   4496                   (if (not loc-beg) (overlay-start overlay)
   4497                     (yas--goto-saved-location loc-beg))
   4498                   (if (not loc-end) (overlay-end overlay)
   4499                     (yas--goto-saved-location loc-end)))))
   4500 
   4501 (defun yas--goto-saved-line-location (base-pos l-re-count)
   4502   "Move to and return point saved by `yas--snapshot-line-location'.
   4503 Additionally requires BASE-POS to tell where the line numbers are
   4504 relative to."
   4505   (goto-char base-pos)
   4506   (forward-line (pop l-re-count))
   4507   (save-restriction
   4508     (narrow-to-region (line-beginning-position)
   4509                       (line-end-position))
   4510     (yas--goto-saved-location l-re-count)))
   4511 
   4512 (defun yas--restore-overlay-line-location (base-pos ov-locations)
   4513   "Restores marker based on info from `yas--snapshot-overlay-line-location'."
   4514   (cl-destructuring-bind (overlay beg-l-r-w end-l-r-w)
   4515       ov-locations
   4516     (move-overlay overlay
   4517                   (yas--goto-saved-line-location base-pos beg-l-r-w)
   4518                   (yas--goto-saved-line-location base-pos end-l-r-w))))
   4519 
   4520 (defun yas--indent-region (from to snippet)
   4521   "Indent the lines between FROM and TO with `indent-according-to-mode'.
   4522 The SNIPPET's markers are preserved."
   4523   (save-excursion
   4524     (yas--save-restriction-and-widen
   4525       (let* ((snippet-markers (yas--collect-snippet-markers snippet))
   4526              (to (set-marker (make-marker) to)))
   4527         (goto-char from)
   4528         (cl-loop for bol = (line-beginning-position)
   4529                  for eol = (line-end-position)
   4530                  if (or yas-also-indent-empty-lines
   4531                         (/= bol eol))
   4532                  do
   4533                  ;; Indent each non-empty line.
   4534                  (let ((remarkers nil))
   4535                    (dolist (m snippet-markers)
   4536                      (when (and (<= bol m) (<= m eol))
   4537                        (push (cons m (yas--snapshot-location m bol eol))
   4538                              remarkers)))
   4539                    (unwind-protect
   4540                        (progn (back-to-indentation)
   4541                               (with-demoted-errors "%S"
   4542                                 (indent-according-to-mode)))
   4543                      (save-restriction
   4544                        (narrow-to-region bol (line-end-position))
   4545                        (dolist (remarker remarkers)
   4546                          (set-marker (car remarker)
   4547                                      (yas--goto-saved-location (cdr remarker)))))))
   4548                  while (and (zerop (forward-line 1))
   4549                             (< (point) to)))))))
   4550 
   4551 (defvar yas--indent-original-column nil)
   4552 (defun yas--indent (snippet)
   4553   ;; Indent lines that had indent markers (`$>') on them.
   4554   (save-excursion
   4555     (dolist (marker yas--indent-markers)
   4556       (unless (eq yas-indent-line 'auto)
   4557         (goto-char marker)
   4558         (yas--indent-region (line-beginning-position)
   4559                             (line-end-position)
   4560                             snippet))
   4561       ;; Finished with this marker.
   4562       (set-marker marker nil))
   4563     (setq yas--indent-markers nil))
   4564   ;; Now do stuff for `fixed' and `auto'.
   4565   (save-excursion
   4566     ;; We need to be at end of line, so that `forward-line' will only
   4567     ;; report 0 if it actually moves over a newline.
   4568     (end-of-line)
   4569     (cond ((eq yas-indent-line 'fixed)
   4570            (when (= (forward-line 1) 0)
   4571              (let ((indent-line-function
   4572                     (lambda ()
   4573                       ;; We need to be at beginning of line in order to
   4574                       ;; indent existing whitespace correctly.
   4575                       (beginning-of-line)
   4576                       (indent-to-column yas--indent-original-column))))
   4577                (yas--indent-region (line-beginning-position)
   4578                                    (point-max)
   4579                                    snippet))))
   4580           ((eq yas-indent-line 'auto)
   4581            (when (or yas-also-auto-indent-first-line
   4582                      (= (forward-line 1) 0))
   4583              (yas--indent-region (line-beginning-position)
   4584                                  (point-max)
   4585                                  snippet))))))
   4586 
   4587 (defun yas--collect-snippet-markers (snippet)
   4588   "Make a list of all the markers used by SNIPPET."
   4589   (let (markers)
   4590     (yas--snippet-map-markers (lambda (m) (push m markers) m) snippet)
   4591     markers))
   4592 
   4593 (defun yas--escape-string (escaped)
   4594   (concat "YASESCAPE" (format "%d" escaped) "PROTECTGUARD"))
   4595 
   4596 (defun yas--protect-escapes (&optional text escaped)
   4597   "Protect all escaped characters with their numeric ASCII value.
   4598 
   4599 With optional string TEXT do it in string instead of buffer."
   4600   (let ((changed-text text)
   4601         (text-provided-p text))
   4602     (mapc #'(lambda (escaped)
   4603               (setq changed-text
   4604                     (yas--replace-all (concat "\\" (char-to-string escaped))
   4605                                      (yas--escape-string escaped)
   4606                                      (when text-provided-p changed-text))))
   4607           (or escaped yas--escaped-characters))
   4608     changed-text))
   4609 
   4610 (defun yas--restore-escapes (&optional text escaped)
   4611   "Restore all escaped characters from their numeric ASCII value.
   4612 
   4613 With optional string TEXT do it in string instead of the buffer."
   4614   (let ((changed-text text)
   4615         (text-provided-p text))
   4616     (mapc #'(lambda (escaped)
   4617               (setq changed-text
   4618                     (yas--replace-all (yas--escape-string escaped)
   4619                                      (char-to-string escaped)
   4620                                      (when text-provided-p changed-text))))
   4621           (or escaped yas--escaped-characters))
   4622     changed-text))
   4623 
   4624 (defun yas--save-backquotes ()
   4625   "Save all \"\\=`(lisp-expression)\\=`\"-style expressions.
   4626 Return a list of (MARKER . STRING) entires for each backquoted
   4627 Lisp expression."
   4628   (let* ((saved-quotes nil)
   4629          (yas--snippet-buffer (current-buffer))
   4630          (yas--change-detected nil)
   4631          (detect-change (lambda (_beg _end)
   4632                           (when (eq (current-buffer) yas--snippet-buffer)
   4633                             (setq yas--change-detected t)))))
   4634     (while (re-search-forward yas--backquote-lisp-expression-regexp nil t)
   4635       (let ((current-string (match-string-no-properties 1)) transformed)
   4636         (yas--save-restriction-and-widen
   4637           (delete-region (match-beginning 0) (match-end 0)))
   4638         (let ((before-change-functions
   4639                (cons detect-change before-change-functions)))
   4640           (setq transformed (yas--eval-for-string (yas--read-lisp
   4641                                                    (yas--restore-escapes
   4642                                                     current-string '(?`))))))
   4643         (goto-char (match-beginning 0))
   4644         (when transformed
   4645           (let ((marker (make-marker)))
   4646             (yas--save-restriction-and-widen
   4647               (insert "Y") ;; quite horrendous, I love it :)
   4648               (set-marker marker (point))
   4649               (insert "Y"))
   4650             (push (cons marker transformed) saved-quotes)))))
   4651     (when yas--change-detected
   4652       (lwarn '(yasnippet backquote-change) :warning
   4653              "`%s' modified buffer in a backquote expression.
   4654   To hide this warning, add (yasnippet backquote-change) to `warning-suppress-types'."
   4655              (if yas--current-template
   4656                  (yas--template-name yas--current-template)
   4657                "Snippet")))
   4658     saved-quotes))
   4659 
   4660 (defun yas--restore-backquotes (saved-quotes)
   4661   "Replace markers in SAVED-QUOTES with their values.
   4662 SAVED-QUOTES is the in format returned by `yas--save-backquotes'."
   4663   (cl-loop for (marker . string) in saved-quotes do
   4664            (save-excursion
   4665              (goto-char marker)
   4666              (yas--save-restriction-and-widen
   4667                (delete-char -1)
   4668                (insert string)
   4669                (delete-char 1))
   4670              (set-marker marker nil))))
   4671 
   4672 (defun yas--scan-sexps (from count)
   4673   (ignore-errors
   4674     (save-match-data ; `scan-sexps' may modify match data.
   4675       ;; Parse using the syntax table corresponding to the yasnippet syntax.
   4676       (with-syntax-table (standard-syntax-table)
   4677         ;; And ignore syntax-table properties that may have been placed by the
   4678         ;; major mode since these aren't related to the yasnippet syntax.
   4679         (let ((parse-sexp-lookup-properties nil))
   4680           (scan-sexps from count))))))
   4681 
   4682 (defun yas--make-marker (pos)
   4683   "Create a marker at POS with nil `marker-insertion-type'."
   4684   (let ((marker (set-marker (make-marker) pos)))
   4685     (set-marker-insertion-type marker nil)
   4686     marker))
   4687 
   4688 (defun yas--indent-parse-create ()
   4689   "Parse the \"$>\" indentation markers just inserted."
   4690   (setq yas--indent-markers ())
   4691   (while (search-forward "$>" nil t)
   4692     (delete-region (match-beginning 0) (match-end 0))
   4693     ;; Mark the beginning of the line.
   4694     (push (yas--make-marker (line-beginning-position))
   4695           yas--indent-markers))
   4696   (setq yas--indent-markers (nreverse yas--indent-markers)))
   4697 
   4698 (defun yas--scan-for-field-end ()
   4699   (while (progn (re-search-forward "\\${\\|}")
   4700                 (when (eq (char-before) ?\{)
   4701                   ;; Nested field.
   4702                   (yas--scan-for-field-end))))
   4703   (point))
   4704 
   4705 (defun yas--field-parse-create (snippet &optional parent-field)
   4706   "Parse most field expressions in SNIPPET, except for the simple one \"$n\".
   4707 
   4708 The following count as a field:
   4709 
   4710 * \"${n: text}\", for a numbered field with default text, as long as N is not 0;
   4711 
   4712 * \"${n: text$(expression)}, the same with a Lisp expression; this is caught
   4713   with the curiously named `yas--multi-dollar-lisp-expression-regexp'
   4714 
   4715 * the same as above but unnumbered, (no N:) and number is calculated
   4716   automatically.
   4717 
   4718 When multiple expressions are found, only the last one counts."
   4719   ;;
   4720   (save-excursion
   4721     (while (re-search-forward yas--field-regexp nil t)
   4722       (let* ((brace-scan (save-match-data
   4723                            (goto-char (match-beginning 2))
   4724                            (yas--scan-for-field-end)))
   4725              ;; if the `brace-scan' didn't reach a brace, we have a
   4726              ;; snippet with invalid escaping, probably a closing
   4727              ;; brace escaped with two backslashes (github#979). But
   4728              ;; be lenient, because we can.
   4729              (real-match-end-0 (if (eq ?} (char-before brace-scan))
   4730                                    brace-scan
   4731                                  (point)))
   4732              (number (and (match-string-no-properties 1)
   4733                           (string-to-number (match-string-no-properties 1))))
   4734              (field2 (match-string-no-properties 2))
   4735              (simple-fom (string-match-p "\\`[0-9]+\\'" field2))
   4736              (brand-new-field
   4737               (and ;; break if on "$(" immediately after the ":", this
   4738                ;; will be caught as a mirror with transform later.
   4739                (not (string-match-p "\\`\\$[ \t\n]*(" field2))
   4740                ;; allow ${0: some exit text}
   4741                ;; (not (and number (zerop number)))
   4742                (yas--make-field number
   4743                                 (yas--make-marker (match-beginning 2))
   4744                                 (yas--make-marker (1- real-match-end-0))
   4745                                 parent-field))))
   4746         (cond
   4747          ((and (not number) simple-fom)
   4748           (yas--one-simple-fom snippet field2))
   4749          (brand-new-field
   4750           (goto-char real-match-end-0)
   4751           (push (cons (1- real-match-end-0) real-match-end-0)
   4752                 yas--dollar-regions)
   4753           (push (cons (match-beginning 0) (match-beginning 2))
   4754                 yas--dollar-regions)
   4755           (push brand-new-field (yas--snippet-fields snippet))
   4756           (save-excursion
   4757             (save-restriction
   4758               (narrow-to-region (yas--field-start brand-new-field)
   4759                                 (yas--field-end brand-new-field))
   4760               (goto-char (point-min))
   4761               (yas--field-parse-create snippet brand-new-field))))))))
   4762 
   4763   ;; if we entered from a parent field, now search for the
   4764   ;; `yas--multi-dollar-lisp-expression-regexp'. This is used for
   4765   ;; primary field transformations
   4766   ;;
   4767   (when parent-field
   4768     (save-excursion
   4769       (while (re-search-forward yas--multi-dollar-lisp-expression-regexp nil t)
   4770         (let* ((real-match-end-1 (yas--scan-sexps (match-beginning 1) 1)))
   4771           ;; commit the primary field transformation if:
   4772           ;;
   4773           ;; 1. we don't find it in yas--dollar-regions (a subnested
   4774           ;; field) might have already caught it.
   4775           ;;
   4776           ;; 2. we really make sure we have either two '$' or some
   4777           ;; text and a '$' after the colon ':'. This is a FIXME: work
   4778           ;; my regular expressions and end these ugly hacks.
   4779           ;;
   4780           (when (and real-match-end-1
   4781                      (not (member (cons (match-beginning 0)
   4782                                         real-match-end-1)
   4783                                   yas--dollar-regions))
   4784                      (not (eq ?:
   4785                               (char-before (1- (match-beginning 1))))))
   4786             (let ((lisp-expression-string (buffer-substring-no-properties (match-beginning 1)
   4787                                                                           real-match-end-1)))
   4788               (setf (yas--field-transform parent-field)
   4789                     (yas--read-lisp (yas--restore-escapes lisp-expression-string))))
   4790             (push (cons (match-beginning 0) real-match-end-1)
   4791                   yas--dollar-regions)))))))
   4792 
   4793 (defun yas--transform-mirror-parse-create (snippet)
   4794   "Parse the \"${n:$(lisp-expression)}\" mirror transformations in SNIPPET."
   4795   (while (re-search-forward yas--transform-mirror-regexp nil t)
   4796     (let* ((real-match-end-0 (yas--scan-sexps (1+ (match-beginning 0)) 1))
   4797            (number (string-to-number (match-string-no-properties 1)))
   4798            (field (and number
   4799                        (not (zerop number))
   4800                        (yas--snippet-find-field snippet number)))
   4801            (brand-new-mirror
   4802             (and real-match-end-0
   4803                  field
   4804                  (yas--make-mirror (yas--make-marker (match-beginning 0))
   4805                                   (yas--make-marker (match-beginning 0))
   4806                                   (yas--read-lisp
   4807                                    (yas--restore-escapes
   4808                                     (buffer-substring-no-properties (match-beginning 2)
   4809                                                                     (1- real-match-end-0))))))))
   4810       (when brand-new-mirror
   4811         (push brand-new-mirror
   4812               (yas--field-mirrors field))
   4813         (yas--calculate-simple-fom-parentage snippet brand-new-mirror)
   4814         (push (cons (match-beginning 0) real-match-end-0) yas--dollar-regions)))))
   4815 
   4816 (defun yas--simple-fom-create (snippet)
   4817   "Parse the simple \"$n\" fields/mirrors/exitmarkers in SNIPPET."
   4818   (while (re-search-forward yas--simple-mirror-regexp nil t)
   4819     (yas--one-simple-fom snippet (match-string-no-properties 1))))
   4820 
   4821 (defun yas--one-simple-fom (snippet numstring)
   4822   (let ((number (string-to-number numstring)))
   4823     (cond ((zerop number)
   4824            (setf (yas--snippet-exit snippet)
   4825                  (yas--make-exit (yas--make-marker (match-end 0))))
   4826            (push (cons (match-beginning 0)
   4827                        (yas--exit-marker (yas--snippet-exit snippet)))
   4828                  yas--dollar-regions))
   4829           (t
   4830            (let ((field (yas--snippet-find-field snippet number))
   4831                  (fom))
   4832              (if field
   4833                  (push
   4834                   (setq fom (yas--make-mirror
   4835                              (yas--make-marker (match-beginning 0))
   4836                              (yas--make-marker (match-beginning 0))
   4837                              nil))
   4838                   (yas--field-mirrors field))
   4839                (push
   4840                 (setq fom (yas--make-field number
   4841                                            (yas--make-marker (match-beginning 0))
   4842                                            (yas--make-marker (match-beginning 0))
   4843                                            nil))
   4844                 (yas--snippet-fields snippet)))
   4845              (yas--calculate-simple-fom-parentage snippet fom))
   4846            (push (cons (match-beginning 0) (match-end 0))
   4847                  yas--dollar-regions)))))
   4848 
   4849 (defun yas--delete-regions (regions)
   4850   "Sort disjuct REGIONS by start point, then delete from the back."
   4851   (mapc #'(lambda (reg)
   4852             (delete-region (car reg) (cdr reg)))
   4853         (sort regions
   4854               #'(lambda (r1 r2)
   4855                   (>= (car r1) (car r2))))))
   4856 
   4857 (defun yas--calculate-mirror-depth (mirror &optional traversed)
   4858   (let* ((parent (yas--mirror-parent-field mirror))
   4859          (parents-mirrors (and parent
   4860                                (yas--field-mirrors parent))))
   4861     (or (yas--mirror-depth mirror)
   4862         (setf (yas--mirror-depth mirror)
   4863               (cond ((memq mirror traversed) 0)
   4864                     ((and parent parents-mirrors)
   4865                      (1+ (cl-reduce
   4866                           #'max parents-mirrors
   4867                           :key (lambda (m)
   4868                                  (yas--calculate-mirror-depth
   4869                                   m (cons mirror traversed))))))
   4870                     (parent 1)
   4871                     (t 0))))))
   4872 
   4873 (defun yas--snippet-field-mirrors (snippet)
   4874   ;; Make a list of (FIELD . MIRROR).
   4875   (cl-sort
   4876    (cl-mapcan (lambda (field)
   4877                 (mapcar (lambda (mirror)
   4878                           (cons field mirror))
   4879                         (yas--field-mirrors field)))
   4880               (yas--snippet-fields snippet))
   4881    ;; Then sort this list so that entries with mirrors with
   4882    ;; parent fields appear before.  This was important for
   4883    ;; fixing #290, and also handles the case where a mirror in
   4884    ;; a field causes another mirror to need reupdating.
   4885    #'> :key (lambda (fm) (yas--calculate-mirror-depth (cdr fm)))))
   4886 
   4887 (defun yas--indent-mirrors-of-snippet (snippet &optional f-ms)
   4888   ;; Indent mirrors of SNIPPET.  F-MS is the return value of
   4889   ;; (yas--snippet-field-mirrors SNIPPET).
   4890   (when (eq yas-indent-line 'auto)
   4891     (let ((yas--inhibit-overlay-hooks t))
   4892       (cl-loop for (beg . end) in
   4893                (cl-sort (mapcar (lambda (f-m)
   4894                                   (let ((mirror (cdr f-m)))
   4895                                     (cons (yas--mirror-start mirror)
   4896                                           (yas--mirror-end mirror))))
   4897                                 (or f-ms
   4898                                     (yas--snippet-field-mirrors snippet)))
   4899                         #'< :key #'car)
   4900                do (yas--indent-region beg end snippet)))))
   4901 
   4902 (defun yas--update-mirrors (snippet)
   4903   "Update all the mirrors of SNIPPET."
   4904   (yas--save-restriction-and-widen
   4905     (save-excursion
   4906       (let ((f-ms (yas--snippet-field-mirrors snippet)))
   4907         (cl-loop
   4908          for (field . mirror) in f-ms
   4909          ;; Before updating a mirror with a parent-field, maybe advance
   4910          ;; its start (#290).
   4911          do (let ((parent-field (yas--mirror-parent-field mirror)))
   4912               (when parent-field
   4913                 (yas--advance-start-maybe mirror (yas--fom-start parent-field))))
   4914          ;; Update this mirror.
   4915          do (yas--mirror-update-display mirror field)
   4916          ;; `yas--place-overlays' is needed since the active field and
   4917          ;; protected overlays might have been changed because of insertions
   4918          ;; in `yas--mirror-update-display'.
   4919          do (let ((active-field (yas--snippet-active-field snippet)))
   4920               (when active-field (yas--place-overlays snippet active-field))))
   4921         ;; Delay indenting until we're done all mirrors.  We must do
   4922         ;; this to avoid losing whitespace between fields that are
   4923         ;; still empty (i.e., they will be non-empty after updating).
   4924         (yas--indent-mirrors-of-snippet snippet f-ms)))))
   4925 
   4926 (defun yas--mirror-update-display (mirror field)
   4927   "Update MIRROR according to FIELD (and mirror transform)."
   4928 
   4929   (let* ((mirror-parent-field (yas--mirror-parent-field mirror))
   4930          (reflection (and (not (and mirror-parent-field
   4931                                     (yas--field-modified-p mirror-parent-field)))
   4932                           (or (yas--apply-transform mirror field 'empty-on-nil)
   4933                               (yas--field-text-for-display field)))))
   4934     (when (and reflection
   4935                (not (string= reflection (buffer-substring-no-properties (yas--mirror-start mirror)
   4936                                                                         (yas--mirror-end mirror)))))
   4937       (goto-char (yas--mirror-start mirror))
   4938       (let ((yas--inhibit-overlay-hooks t))
   4939         (insert reflection))
   4940       (if (> (yas--mirror-end mirror) (point))
   4941           (delete-region (point) (yas--mirror-end mirror))
   4942         (set-marker (yas--mirror-end mirror) (point))
   4943         (yas--advance-start-maybe (yas--mirror-next mirror) (point))
   4944         ;; super-special advance
   4945         (yas--advance-end-of-parents-maybe mirror-parent-field (point))))))
   4946 
   4947 (defun yas--field-update-display (field)
   4948   "Much like `yas--mirror-update-display', but for fields."
   4949   (when (yas--field-transform field)
   4950     (let ((transformed (and (not (eq (yas--field-number field) 0))
   4951                             (yas--apply-transform field field))))
   4952       (when (and transformed
   4953                  (not (string= transformed (buffer-substring-no-properties (yas--field-start field)
   4954                                                                            (yas--field-end field)))))
   4955         (setf (yas--field-modified-p field) t)
   4956         (goto-char (yas--field-start field))
   4957         (let ((yas--inhibit-overlay-hooks t))
   4958           (insert transformed)
   4959           (if (> (yas--field-end field) (point))
   4960               (delete-region (point) (yas--field-end field))
   4961             (set-marker (yas--field-end field) (point))
   4962             (yas--advance-start-maybe (yas--field-next field) (point)))
   4963           t)))))
   4964 
   4965 
   4966 ;;; Post-command hook:
   4967 ;;
   4968 (defun yas--post-command-handler ()
   4969   "Handles various yasnippet conditions after each command."
   4970   (yas--do-todo-snippet-indent)
   4971   (condition-case err
   4972       (progn (yas--finish-moving-snippets)
   4973              (cond ((eq 'undo this-command)
   4974                     ;;
   4975                     ;; After undo revival the correct field is sometimes not
   4976                     ;; restored correctly, this condition handles that
   4977                     ;;
   4978                     (let* ((snippet (car (yas-active-snippets)))
   4979                            (target-field
   4980                             (and snippet
   4981                                  (cl-find-if-not
   4982                                   (lambda (field)
   4983                                     (yas--field-probably-deleted-p snippet field))
   4984                                   (remq nil
   4985                                         (cons (yas--snippet-active-field snippet)
   4986                                               (yas--snippet-fields snippet)))))))
   4987                       (when target-field
   4988                         (yas--move-to-field snippet target-field))))
   4989                    ((not (yas--undo-in-progress))
   4990                     ;; When not in an undo, check if we must commit the snippet
   4991                     ;; (user exited it).
   4992                     (yas--check-commit-snippet))))
   4993     ;; FIXME: Why?
   4994     ((debug error) (signal (car err) (cdr err)))))
   4995 
   4996 ;;; Fancy docs:
   4997 ;;
   4998 ;; The docstrings for some functions are generated dynamically
   4999 ;; depending on the context.
   5000 ;;
   5001 (put 'yas-expand  'function-documentation
   5002      '(yas--expand-from-trigger-key-doc t))
   5003 (defun yas--expand-from-trigger-key-doc (context)
   5004   "A doc synthesizer for `yas--expand-from-trigger-key-doc'."
   5005   (let* ((yas-fallback-behavior (and context yas-fallback-behavior))
   5006          (fallback-description
   5007           (cond ((eq yas-fallback-behavior 'call-other-command)
   5008                  (let* ((fallback (yas--keybinding-beyond-yasnippet)))
   5009                    (or (and fallback
   5010                             (format "call command `%s'."
   5011                                     (pp-to-string fallback)))
   5012                        "do nothing (`yas-expand' doesn't override\nanything).")))
   5013                 ((eq yas-fallback-behavior 'return-nil)
   5014                  "do nothing.")
   5015                 (t "defer to `yas-fallback-behavior' (which see)."))))
   5016     (concat "Expand a snippet before point. If no snippet
   5017 expansion is possible, "
   5018             fallback-description
   5019             "\n\nOptional argument FIELD is for non-interactive use and is an
   5020 object satisfying `yas--field-p' to restrict the expansion to.")))
   5021 
   5022 (put 'yas-expand-from-keymap 'function-documentation
   5023      '(yas--expand-from-keymap-doc t))
   5024 (defun yas--expand-from-keymap-doc (context)
   5025   "A doc synthesizer for `yas--expand-from-keymap-doc'."
   5026   (add-hook 'temp-buffer-show-hook #'yas--snippet-description-finish-runonce)
   5027   (concat "Expand/run snippets from keymaps, possibly falling back to original binding.\n"
   5028           (when (and context (eq this-command 'describe-key))
   5029             (let* ((vec (this-single-command-keys))
   5030                    (templates (cl-mapcan (lambda (table)
   5031                                            (yas--fetch table vec))
   5032                                          (yas--get-snippet-tables)))
   5033                    (yas--direct-keymaps nil)
   5034                    (fallback (key-binding vec)))
   5035               (concat "In this case, "
   5036                       (when templates
   5037                         (concat "these snippets are bound to this key:\n"
   5038                                 (yas--template-pretty-list templates)
   5039                                 "\n\nIf none of these expands, "))
   5040                       (or (and fallback
   5041                                (format "fallback `%s' will be called." (pp-to-string fallback)))
   5042                           "no fallback keybinding is called."))))))
   5043 
   5044 (defun yas--template-pretty-list (templates)
   5045   (let ((acc)
   5046         (yas-buffer-local-condition 'always))
   5047     (dolist (plate templates)
   5048       (setq acc (concat acc "\n*) "
   5049                         (propertize (concat "\\\\snippet `" (car plate) "'")
   5050                                     'yasnippet (cdr plate)))))
   5051     acc))
   5052 
   5053 (define-button-type 'help-snippet-def
   5054   :supertype 'help-xref
   5055   'help-function (lambda (template) (yas--visit-snippet-file-1 template))
   5056   'help-echo (purecopy "mouse-2, RET: find snippets's definition"))
   5057 
   5058 (defun yas--snippet-description-finish-runonce ()
   5059   "Final adjustments for the help buffer when snippets are concerned."
   5060   (yas--create-snippet-xrefs)
   5061   (remove-hook 'temp-buffer-show-hook
   5062                #'yas--snippet-description-finish-runonce))
   5063 
   5064 (defun yas--create-snippet-xrefs ()
   5065   (save-excursion
   5066     (goto-char (point-min))
   5067     (while (search-forward-regexp "\\\\\\\\snippet[ \s\t]+`\\([^']+\\)'" nil t)
   5068       (let ((template (get-text-property (match-beginning 1)
   5069                                          'yasnippet)))
   5070         (when template
   5071           (help-xref-button 1 'help-snippet-def template)
   5072           (delete-region (match-end 1) (match-end 0))
   5073           (delete-region (match-beginning 0) (match-beginning 1)))))))
   5074 
   5075 ;;; Eldoc configuration.
   5076 (eldoc-add-command 'yas-next-field-or-maybe-expand
   5077                    'yas-next-field 'yas-prev-field
   5078                    'yas-expand 'yas-expand-from-keymap
   5079                    'yas-expand-from-trigger-key)
   5080 
   5081 ;;; Utils
   5082 
   5083 (defvar yas-verbosity 3
   5084   "Log level for `yas--message' 4 means trace most anything, 0 means nothing.")
   5085 
   5086 (defun yas--message (level message &rest args)
   5087   "When LEVEL is at or below `yas-verbosity', log MESSAGE and ARGS."
   5088   (when (>= yas-verbosity level)
   5089     (message "%s" (apply #'yas--format message args))))
   5090 
   5091 (defun yas--warning (format-control &rest format-args)
   5092   (let ((msg (apply #'format format-control format-args)))
   5093     (display-warning 'yasnippet msg :warning)
   5094     (yas--message 1 msg)))
   5095 
   5096 (defun yas--format (format-control &rest format-args)
   5097   (apply #'format (concat "[yas] " format-control) format-args))
   5098 
   5099 
   5100 ;;; Unloading
   5101 
   5102 (defvar unload-function-defs-list) ; loadhist.el
   5103 
   5104 (defun yasnippet-unload-function ()
   5105   "Disable minor modes when calling `unload-feature'."
   5106   ;; Disable `yas-minor-mode' everywhere it's enabled.
   5107   (yas-global-mode -1)
   5108   (save-current-buffer
   5109     (dolist (buffer (buffer-list))
   5110       (set-buffer buffer)
   5111       (when yas-minor-mode
   5112         (yas-minor-mode -1))))
   5113   ;; Remove symbol properties of all our functions, this avoids
   5114   ;; Bug#25088 in Emacs 25.1, where the compiler macro on
   5115   ;; `cl-defstruct' created functions hang around in the symbol plist
   5116   ;; and cause errors when loading again (we don't *need* to clean
   5117   ;; *all* symbol plists, but it's easier than being precise).
   5118   (dolist (def unload-function-defs-list)
   5119     (when (eq (car-safe def) 'defun)
   5120       (setplist (cdr def) nil)))
   5121   ;; Return nil so that `unload-feature' will take of undefining
   5122   ;; functions, and changing any buffers using `snippet-mode'.
   5123   nil)
   5124 
   5125 
   5126 ;;; Backward compatibility to yasnippet <= 0.7
   5127 
   5128 (defun yas-initialize ()
   5129   "For backward compatibility, enable `yas-minor-mode' globally."
   5130   (declare (obsolete "Use (yas-global-mode 1) instead." "0.8"))
   5131   (yas-global-mode 1))
   5132 
   5133 (defvar yas--backported-syms '(;; `defcustom's
   5134                              ;;
   5135                              yas-snippet-dirs
   5136                              yas-prompt-functions
   5137                              yas-indent-line
   5138                              yas-also-auto-indent-first-line
   5139                              yas-snippet-revival
   5140                              yas-triggers-in-field
   5141                              yas-fallback-behavior
   5142                              yas-choose-keys-first
   5143                              yas-choose-tables-first
   5144                              yas-use-menu
   5145                              yas-trigger-symbol
   5146                              yas-wrap-around-region
   5147                              yas-good-grace
   5148                              yas-visit-from-menu
   5149                              yas-expand-only-for-last-commands
   5150                              yas-field-highlight-face
   5151 
   5152                              ;; these vars can be customized as well
   5153                              ;;
   5154                              yas-keymap
   5155                              yas-verbosity
   5156                              yas-extra-modes
   5157                              yas-key-syntaxes
   5158                              yas-after-exit-snippet-hook
   5159                              yas-before-expand-snippet-hook
   5160                              yas-buffer-local-condition
   5161                              yas-dont-activate
   5162 
   5163                              ;; prompting functions
   5164                              ;;
   5165                              yas-x-prompt
   5166                              yas-ido-prompt
   5167                              yas-no-prompt
   5168                              yas-completing-prompt
   5169                              yas-dropdown-prompt
   5170 
   5171                              ;; interactive functions
   5172                              ;;
   5173                              yas-expand
   5174                              yas-minor-mode
   5175                              yas-global-mode
   5176                              yas-direct-keymaps-reload
   5177                              yas-minor-mode-on
   5178                              yas-load-directory
   5179                              yas-reload-all
   5180                              yas-compile-directory
   5181                              yas-recompile-all
   5182                              yas-about
   5183                              yas-expand-from-trigger-key
   5184                              yas-expand-from-keymap
   5185                              yas-insert-snippet
   5186                              yas-visit-snippet-file
   5187                              yas-new-snippet
   5188                              yas-load-snippet-buffer
   5189                              yas-tryout-snippet
   5190                              yas-describe-tables
   5191                              yas-next-field-or-maybe-expand
   5192                              yas-next-field
   5193                              yas-prev-field
   5194                              yas-abort-snippet
   5195                              yas-exit-snippet
   5196                              yas-exit-all-snippets
   5197                              yas-skip-and-clear-or-delete-char
   5198                              yas-initialize
   5199 
   5200                              ;; symbols that I "exported" for use
   5201                              ;; in snippets and hookage
   5202                              ;;
   5203                              yas-expand-snippet
   5204                              yas-define-snippets
   5205                              yas-define-menu
   5206                              yas-snippet-beg
   5207                              yas-snippet-end
   5208                              yas-modified-p
   5209                              yas-moving-away-p
   5210                              yas-substr
   5211                              yas-choose-value
   5212                              yas-key-to-value
   5213                              yas-throw
   5214                              yas-verify-value
   5215                              yas-field-value
   5216                              yas-text
   5217                              yas-selected-text
   5218                              yas-default-from-field
   5219                              yas-inside-string
   5220                              yas-unimplemented
   5221                              yas-define-condition-cache
   5222                              yas-hippie-try-expand
   5223 
   5224                              ;; debug definitions
   5225                              ;; yas-debug-snippet-vars
   5226                              ;; yas-exterminate-package
   5227                              ;; yas-debug-test
   5228 
   5229                              ;; testing definitions
   5230                              ;; yas-should-expand
   5231                              ;; yas-should-not-expand
   5232                              ;; yas-mock-insert
   5233                              ;; yas-make-file-or-dirs
   5234                              ;; yas-variables
   5235                              ;; yas-saving-variables
   5236                              ;; yas-call-with-snippet-dirs
   5237                              ;; yas-with-snippet-dirs
   5238 )
   5239   "Backported yasnippet symbols.
   5240 
   5241 They are mapped to \"yas/*\" variants.")
   5242 
   5243 (when yas-alias-to-yas/prefix-p
   5244   (dolist (sym yas--backported-syms)
   5245     (let ((backported (intern (replace-regexp-in-string "\\`yas-" "yas/" (symbol-name sym)))))
   5246       (when (boundp sym)
   5247         (make-obsolete-variable backported sym "yasnippet 0.8")
   5248         (defvaralias backported sym))
   5249       (when (fboundp sym)
   5250         (make-obsolete backported sym "yasnippet 0.8")
   5251         (defalias backported sym))))
   5252   (make-obsolete 'yas/root-directory 'yas-snippet-dirs "yasnippet 0.8")
   5253   (defvaralias 'yas/root-directory 'yas-snippet-dirs))
   5254 
   5255 (defvar yas--exported-syms
   5256   (let (exported)
   5257     (mapatoms (lambda (atom)
   5258                 (if (and (or (and (boundp atom)
   5259                                   (not (get atom 'byte-obsolete-variable)))
   5260                              (and (fboundp atom)
   5261                                   (not (get atom 'byte-obsolete-info))))
   5262                          (string-match-p "\\`yas-[^-]" (symbol-name atom)))
   5263                     (push atom exported))))
   5264     exported)
   5265   "Exported yasnippet symbols.
   5266 
   5267 i.e. the ones with \"yas-\" single dash prefix. I will try to
   5268 keep them in future yasnippet versions and other elisp libraries
   5269 can more or less safely rely upon them.")
   5270 
   5271 
   5272 (provide 'yasnippet)
   5273 ;; Local Variables:
   5274 ;; coding: utf-8
   5275 ;; indent-tabs-mode: nil
   5276 ;; End:
   5277 ;;; yasnippet.el ends here