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