mirror of https://github.com/Chizi123/.emacs.d.git

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