]>
Commit | Line | Data |
---|---|---|
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 "\ | |
163 | Yasnippet 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 | ||
171 | Each element, a string or a symbol whose value is a string, | |
172 | designates a top-level directory where per-mode snippet | |
173 | directories can be found. | |
174 | ||
175 | Elements appearing earlier in the list override later elements' | |
176 | snippets. | |
177 | ||
178 | The first directory is taken as the default for storing snippet's | |
179 | created 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. | |
212 | If 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 | ||
221 | These 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 | |
228 | the objects in CHOICES will return a string. | |
229 | ||
230 | The return value of any function you put here should be one of | |
231 | the objects in CHOICES, properly formatted with DISPLAY-FN (if | |
232 | that is passed). | |
233 | ||
234 | - To signal that your particular style of prompting is | |
235 | unavailable at the moment, you can also have the function return | |
236 | nil. | |
237 | ||
238 | - To signal that the user quit the prompting process, you can | |
239 | signal `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 | ||
247 | The 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 | ||
253 | Every other value means don't apply any snippet-side indentation | |
254 | after expansion (the manual per-line \"$>\" indentation still | |
255 | applies)." | |
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 | ||
263 | Naturally 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 | ||
277 | Otherwise `yas-next-field-or-maybe-expand' just moves on to the | |
278 | next field" | |
279 | :type 'boolean) | |
280 | ||
281 | (defcustom yas-fallback-behavior 'return-nil | |
282 | "This option is obsolete. | |
283 | Now that the conditional keybinding `yas-maybe-expand' is | |
284 | available, 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 | |
291 | command value `yas-maybe-expand', for `return-nil' behavior bind | |
292 | directly 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 | ||
298 | Otherwise prompts for all possible snippet names. | |
299 | ||
300 | This 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 | ||
306 | Otherwise, user chooses between the merging together of all | |
307 | eligible tables. | |
308 | ||
309 | This 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 | ||
315 | When non-nil, submenus for each snippet table will be listed | |
316 | under the menu \"Yasnippet\". | |
317 | ||
318 | - If set to `abbreviate', only the current major-mode | |
319 | menu 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 | ||
325 | Any 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 | ||
340 | If set to a character, insert contents of corresponding register. | |
341 | If non-nil insert region contents. This can be overridden on a | |
342 | per-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 | ||
352 | This affects both the inline elisp in snippets and the hook | |
353 | variables such as `yas-after-exit-snippet-hook'. | |
354 | ||
355 | If this variable's value is `inline', an error string \"[yas] | |
356 | error\" is returned instead of raising the error. If this | |
357 | variable's value is `hooks', a message is output to according to | |
358 | `yas-verbosity-level'. If this variable's value is t, both are | |
359 | active." | |
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 | ||
365 | This 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 | ||
371 | Leave this set at nil (the default) to be able to trigger an | |
372 | expansion simply by placing the cursor after a valid tab trigger, | |
373 | using whichever commands. | |
374 | ||
375 | Optionally, set this to something like (self-insert-command) if | |
376 | you to wish restrict expansion to only happen when the last | |
377 | letter of the snippet tab trigger was typed immediately before | |
378 | the 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. | |
383 | It 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. | |
403 | This 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 | |
405 | unmodified 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. | |
411 | This 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 | |
413 | unmodified snippet field.") | |
414 | ||
415 | (defun yas-filtered-definition (def) | |
416 | "Return a condition key definition. | |
417 | The 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 | ||
440 | Each element in this list specifies how to skip buffer positions | |
441 | backwards and look for the start of a trigger key. | |
442 | ||
443 | Each element can be either a string or a function receiving the | |
444 | original point as an argument. A string element is simply passed | |
445 | to `skip-syntax-backward' whereas a function element is called | |
446 | with no arguments and should also place point before the original | |
447 | position. | |
448 | ||
449 | The string between the resulting buffer position and the original | |
450 | point is matched against the trigger keys in the active snippet | |
451 | tables. | |
452 | ||
453 | If no expandable snippets are found, the next element is the list | |
454 | is tried, unless a function element returned the symbol `again', | |
455 | in which case it is called again from the previous position and | |
456 | may once more reposition point. | |
457 | ||
458 | For example, if `yas-key-syntaxes' has the value (\"w\" \"w_\"), | |
459 | trigger keys composed exclusively of \"word\"-syntax characters | |
460 | are looked for first. Failing that, longer keys composed of | |
461 | \"word\" or \"symbol\" syntax are looked for. Therefore, | |
462 | triggering after | |
463 | ||
464 | foo-barbaz | |
465 | ||
466 | will, according to the \"w\" element first try \"barbaz\". If | |
467 | that isn't a trigger key, \"foo-barbaz\" is tried, respecting the | |
468 | second \"w_\" element. Notice that even if \"baz\" is a trigger | |
469 | key for an active snippet, it won't be expanded, unless a | |
470 | function is added to `yas-key-syntaxes' that eventually places | |
471 | point between \"bar\" and \"baz\". | |
472 | ||
473 | See also Info node `(elisp) Syntax Descriptors'.") | |
474 | ||
475 | (defvar yas-after-exit-snippet-hook | |
476 | '() | |
477 | "Hooks to run after a snippet exited. | |
478 | ||
479 | The hooks will be run in an environment where some variables bound to | |
480 | proper values: | |
481 | ||
482 | `yas-snippet-beg' : The beginning of the region of the snippet. | |
483 | ||
484 | `yas-snippet-end' : Similar to beg. | |
485 | ||
486 | Attention: 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. | |
498 | To use, set `yas-buffer-local-condition' to this value.") | |
499 | ||
500 | (defcustom yas-buffer-local-condition t | |
501 | "Snippet expanding condition. | |
502 | ||
503 | This variable is a Lisp form which is evaluated every time a | |
504 | snippet 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 | ||
537 | Here's an example preventing snippets from being expanded from | |
538 | inside comments, in `python-mode' only, with the exception of | |
539 | snippets returning the symbol `force-in-comment' in their | |
540 | conditions. | |
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. | |
559 | This is useful to control whether snippet navigation bindings | |
560 | override 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. | |
565 | This is useful to control whether snippet navigation bindings | |
566 | override `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. | |
571 | This protection is intended to prevent yasnippet from ending up | |
572 | in an inconsistent state. However, some packages (e.g., the | |
573 | company completion package) may trigger this protection when it | |
574 | is not needed. In that case, setting this variable to non-nil | |
575 | can 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. | |
661 | This function is useful as a `:filter' to a conditional key | |
662 | definition." | |
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. | |
673 | This 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 | |
675 | expanded.") | |
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 | ||
796 | This variable probably makes more sense as buffer-local, so | |
797 | ensure 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 | ||
805 | This list is populated when reading the \".yas-parents\" files | |
806 | found when traversing snippet directories with | |
807 | `yas-load-directory'. | |
808 | ||
809 | There might be additional parenting information stored in the | |
810 | `derived-mode-parent' property of some mode symbols, but that is | |
811 | not recorded here.") | |
812 | ||
813 | (defvar yas--direct-keymaps (list) | |
814 | "Keymap alist supporting direct snippet keybindings. | |
815 | ||
816 | This variable is placed in `emulation-mode-map-alists'. | |
817 | ||
818 | Its elements looks like (TABLE-NAME . KEYMAP). They're | |
819 | instantiated on `yas-reload-all' but KEYMAP is added to only when | |
820 | loading snippets. `yas--direct-TABLE-NAME' is then a variable | |
821 | set buffer-locally when entering `yas-minor-mode'. KEYMAP binds | |
822 | all defined direct keybindings to `yas-maybe-expand-from-keymap' | |
823 | which 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 | ||
872 | When YASnippet mode is enabled, `yas-expand', normally bound to | |
873 | the TAB key, expands snippets of code depending on the major | |
874 | mode. | |
875 | ||
876 | With no argument, this command toggles the mode. | |
877 | positive prefix argument turns on the mode. | |
878 | Negative prefix argument turns off the mode. | |
879 | ||
880 | Key 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 | ||
917 | The function can be called in the hook of a minor mode to | |
918 | activate 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. | |
951 | Functions are called with no argument, and should return non-nil to prevent | |
952 | `yas-global-mode' from enabling yasnippet in this buffer. | |
953 | ||
954 | In Emacsen < 24, this variable is buffer-local. Because | |
955 | `yas-minor-mode-on' is called by `yas-global-mode' after | |
956 | executing the buffer's major mode hook, setting this variable | |
957 | there is an effective way to define exceptions to the \"global\" | |
958 | activation behaviour. | |
959 | ||
960 | In Emacsen >= 24, only the global value is used. To define | |
961 | per-mode exceptions to the \"global\" activation behaviour, call | |
962 | `yas-minor-mode' with a negative argument directily in the major | |
963 | mode'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 | ||
972 | Honour `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'. | |
1054 | Meaning 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 | ||
1112 | Has 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 | ||
1239 | KEY can be a string (trigger key) of a vector (direct | |
1240 | keybinding)." | |
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 | ||
1264 | Also takes care of adding and updating to the associated menu. | |
1265 | Return 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 | ||
1332 | Return a list of cons (NAME . TEMPLATE) where NAME is a | |
1333 | string 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 | ||
1356 | TEMPLATES is a list of cons (NAME . TEMPLATE) where NAME is a | |
1357 | string and TEMPLATE is a `yas--template' structure. | |
1358 | ||
1359 | This 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 | |
1371 | conditions 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. | |
1409 | Returns (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. | |
1462 | Helper 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). | |
1487 | Also 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 | ||
1516 | In case STRING in an invalid expression and NIL-ON-ERROR is nil, | |
1517 | return 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 | ||
1552 | MODE defaults to the current buffer's `major-mode'. | |
1553 | ||
1554 | Return a list of `yas--table' objects. The list of modes to | |
1555 | consider 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 | ||
1564 | This may very well create a plethora of menu keymaps and arrange | |
1565 | them 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 | ||
1580 | Optional FILE is the absolute file name of the file being | |
1581 | parsed. | |
1582 | ||
1583 | Optional GROUP is the group where the template is to go, | |
1584 | otherwise we attempt to calculate it from FILE. | |
1585 | ||
1586 | Return a snippet-definition, i.e. a list | |
1587 | ||
1588 | (KEY TEMPLATE NAME CONDITION GROUP VARS LOAD-FILE KEYBINDING UUID) | |
1589 | ||
1590 | If the buffer contains a line of \"# --\" then the contents above | |
1591 | this line are ignored. Directives can set most of these with the syntax: | |
1592 | ||
1593 | # directive-name : directive-value | |
1594 | ||
1595 | Here'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 | ||
1710 | TEMPLATES is a list of `yas--template'. | |
1711 | ||
1712 | Optional 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 | ||
1727 | Optional 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 | ||
1736 | Optional 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 | ||
1813 | SNIPPETS is a list of snippet definitions, each taking the | |
1814 | following form | |
1815 | ||
1816 | (KEY TEMPLATE NAME CONDITION GROUP EXPAND-ENV LOAD-FILE KEYBINDING UUID SAVE-FILE) | |
1817 | ||
1818 | Within these, only KEY and TEMPLATE are actually mandatory. | |
1819 | ||
1820 | TEMPLATE might be a Lisp form or a string, depending on whether | |
1821 | this is a snippet or a snippet-command. | |
1822 | ||
1823 | CONDITION, EXPAND-ENV and KEYBINDING are Lisp forms, they have | |
1824 | been `yas--read-lisp'-ed and will eventually be | |
1825 | `yas--eval-for-string'-ed. | |
1826 | ||
1827 | The remaining elements are strings. | |
1828 | ||
1829 | FILE is probably of very little use if you're programatically | |
1830 | defining snippets. | |
1831 | ||
1832 | UUID is the snippet's \"unique-id\". Loading a second snippet | |
1833 | file with the same uuid would replace the previous snippet. | |
1834 | ||
1835 | You can use `yas--parse-template' to return such lists based on | |
1836 | the 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 | ||
1891 | Below TOP-LEVEL-DIR each directory should be a mode name. | |
1892 | ||
1893 | With 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 | |
1985 | prompt the user to select one." | |
1986 | (let (errors) | |
1987 | (if (null yas-snippet-dirs) | |
1988 | (call-interactively 'yas-load-directory) | |
1989 | (when (member yas--default-user-snippets-dir yas-snippet-dirs) | |
1990 | (make-directory yas--default-user-snippets-dir t)) | |
1991 | (dolist (directory (reverse (yas-snippet-dirs))) | |
1992 | (cond ((file-directory-p directory) | |
1993 | (yas-load-directory directory (not nojit)) | |
1994 | (if nojit | |
1995 | (yas--message 4 "Loaded %s" directory) | |
1996 | (yas--message 4 "Prepared just-in-time loading for %s" directory))) | |
1997 | (t | |
1998 | (push (yas--message 1 "Check your `yas-snippet-dirs': %s is not a directory" directory) errors))))) | |
1999 | errors)) | |
2000 | ||
2001 | (defun yas-reload-all (&optional no-jit interactive) | |
2002 | "Reload all snippets and rebuild the YASnippet menu. | |
2003 | ||
2004 | When NO-JIT is non-nil force immediate reload of all known | |
2005 | snippets under `yas-snippet-dirs', otherwise use just-in-time | |
2006 | loading. | |
2007 | ||
2008 | When called interactively, use just-in-time loading when given a | |
2009 | prefix argument." | |
2010 | (interactive (list (not current-prefix-arg) t)) | |
2011 | (catch 'abort | |
2012 | (let ((errors) | |
2013 | (snippet-editing-buffers | |
2014 | (cl-remove-if-not (lambda (buffer) | |
2015 | (with-current-buffer buffer | |
2016 | yas--editing-template)) | |
2017 | (buffer-list)))) | |
2018 | ;; 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 | ||
2099 | This 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 | ||
2180 | TYPE may be `:stay', signaling this menu binding should be | |
2181 | static 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 | ||
2233 | MENU 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 | ||
2245 | OMIT-ITEMS is a list of snippet uuids that will always be | |
2246 | omitted 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 | ||
2297 | NAME is a description to this template. Also update the menu if | |
2298 | `yas-use-menu' is t. CONDITION is the condition attached to | |
2299 | this snippet. If you attach a condition to a snippet, then it | |
2300 | will 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 | ||
2307 | Just 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. | |
2323 | BODY is executed at most once every snippet expansion attempt, to check | |
2324 | expansion conditions. | |
2325 | ||
2326 | It 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 | |
2331 | snippet-expansion routine like `yas-expand', computes actual | |
2332 | value 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 | ||
2348 | If no snippet expansion is possible, fall back to the behaviour | |
2349 | defined in `yas-fallback-behavior'. | |
2350 | ||
2351 | Optional argument FIELD is for non-interactive use and is an | |
2352 | object 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. | |
2376 | If there are expandable snippets, return CMD (this is useful for | |
2377 | conditional keybindings) or the list of expandable snippet | |
2378 | template 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 | ||
2400 | Prompt the user if TEMPLATES has more than one element, else | |
2401 | expand 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 | ||
2420 | Common 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 | ||
2470 | Keys should be an untranslated key vector. Returns a translated | |
2471 | vector 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 | ||
2497 | Honours `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 | ||
2523 | MODE defaults to the current buffer's `major-mode'. If NOERROR | |
2524 | is non-nil, then don't signal an error if there isn't any snippet | |
2525 | called NAME. | |
2526 | ||
2527 | Honours `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 | |
2535 | to `yas-prompt-functions'. | |
2536 | ||
2537 | With prefix argument NO-CONDITION, bypass filtering of snippets | |
2538 | by 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 | ||
2559 | Only success if selected snippet was loaded from a file. Put the | |
2560 | visited 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 | |
2613 | tables (or optional TABLE). | |
2614 | ||
2615 | Returns a list of elements (TABLE . DIRS) where TABLE is a | |
2616 | `yas--table' object and DIRS is a list of all possible directories | |
2617 | where 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 | ||
2665 | Expands a snippet-writing snippet, unless the optional prefix arg | |
2666 | NO-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 | ||
2690 | Returns a list (MODE-SYM PARENTS), the mode's symbol and a list | |
2691 | representing one or more of the mode's parents. | |
2692 | ||
2693 | Note that MODE-SYM need not be the symbol of a real major mode, | |
2694 | neither 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. | |
2750 | TABLE is a symbol name passed to `yas--table-get-create'. When | |
2751 | called interactively, prompt for the table name. | |
2752 | Return 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. | |
2794 | Loading is performed by `yas-load-snippet-buffer'. If the | |
2795 | snippet is new, ask the user whether (and where) to save it. If | |
2796 | the snippet already has a file, just save it. | |
2797 | ||
2798 | The prefix argument KILL is passed to `quit-window'. | |
2799 | ||
2800 | Don't use this from a Lisp program, call `yas-load-snippet-buffer' | |
2801 | and `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. | |
2823 | DEBUG 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 | ||
2973 | A newline will be considered whitespace even if the mode syntax | |
2974 | marks 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 | ||
2985 | A newline will be considered whitespace even if the mode syntax | |
2986 | marks 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 | ||
3009 | If 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 | ||
3020 | The 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'. | |
3034 | This can be used to query the user for the initial value of a | |
3035 | snippet 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. | |
3075 | Otherwise 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 | ||
3082 | Use this in primary and mirror transformations to get the text of | |
3083 | other 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 | ||
3166 | NUMBER is the field number. | |
3167 | START and END are mostly buffer markers, but see \"apropos markers-to-points\". | |
3168 | PARENT-FIELD is a `yas--field' this field is nested under, or nil. | |
3169 | MIRRORS is a list of `yas--mirror's | |
3170 | TRANSFORM is a lisp form. | |
3171 | MODIFIED-P is a boolean set to true once user inputs text. | |
3172 | NEXT 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 | ||
3186 | START and END are mostly buffer markers, but see \"apropos markers-to-points\". | |
3187 | TRANSFORM is a lisp form. | |
3188 | PARENT-FIELD is a `yas--field' this mirror is nested under, or nil. | |
3189 | NEXT is another `yas--field' or `yas--mirror' or `yas--exit' | |
3190 | DEPTH 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. | |
3203 | ENV is a lisp expression that evaluates to list of elements with | |
3204 | the form (VAR FORM), where VAR is a symbol and FORM is a lisp | |
3205 | expression 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. | |
3216 | Update 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 | ||
3240 | If there is no transform for ht field, return nil. | |
3241 | ||
3242 | If there is a transform but it returns nil, return the empty | |
3243 | string 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 | ||
3262 | With 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 | ||
3283 | The field with a number is sorted first. If they both have a | |
3284 | number, compare through the number. If neither have, compare | |
3285 | through 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. | |
3324 | The most recently-inserted snippets are returned first. | |
3325 | ||
3326 | Only snippets overlapping the region BEG ... END are returned. | |
3327 | Overlapping has the same meaning as described in `overlays-in'. | |
3328 | If END is omitted, it defaults to (1+ BEG). If BEG is omitted, | |
3329 | it defaults to point. A non-nil, non-buffer position BEG is | |
3330 | equivalent 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 | ||
3357 | Otherwise 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 | ||
3386 | If 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 | ||
3416 | Also 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 | ||
3478 | This 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. | |
3597 | HOOK 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 | ||
3605 | If 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 | |
3690 | holds 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. | |
3709 | Use 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 | ||
3730 | Otherwise 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. | |
3740 | If 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 | ||
3763 | Move 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. | |
3784 | BEG, 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 | ||
3829 | Only clears the field if it hasn't been modified and point is at | |
3830 | field 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 | ||
3967 | Move 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 | ||
4040 | Text between START and END will be deleted before inserting | |
4041 | template. EXPAND-ENV is a list of (SYM VALUE) let-style dynamic | |
4042 | bindings considered when expanding the snippet. If omitted, use | |
4043 | SNIPPET's expand-env field. | |
4044 | ||
4045 | SNIPPET may be a snippet structure (e.g., as returned by | |
4046 | `yas-lookup-snippet'), or just a snippet body (which is a string | |
4047 | for 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 | ||
4135 | Meant 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 | ||
4144 | BEG and END are, we hope, the original snippets boundaries. | |
4145 | All the markers/points exiting existing inside SNIPPET should point | |
4146 | to their correct locations *at the time the snippet is revived*. | |
4147 | ||
4148 | After 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 | ||
4165 | Returns 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 | ||
4272 | This is according to their relative positions in the buffer, and | |
4273 | has 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 | ||
4304 | Use the tightest containing field if more than one field contains | |
4305 | the mirror. Intended to be called *before* the dollar-regions are | |
4306 | deleted." | |
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 | ||
4326 | If 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 | ||
4333 | Also, if FOM is an exit-marker, always call | |
4334 | `yas--advance-start-maybe' on its next fom. This is because | |
4335 | exit-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 | ||
4353 | If 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 | ||
4361 | Only works for fields and doesn't care about the start of the | |
4362 | next 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 | |
4370 | cons 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 | |
4377 | necessary fields, mirrors and exit points. | |
4378 | ||
4379 | Meant 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. | |
4461 | The returned value is a list of the form (REGEXP WS-COUNT). | |
4462 | POSITION may be either a marker or just a buffer position. The | |
4463 | REGEXP matches text between BEG..END which default to the current | |
4464 | line 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. | |
4483 | Returned 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. | |
4490 | The returned format is (OVERLAY (RE WS) (RE WS)). Either of | |
4491 | the (RE WS) lists may be nil if the start or end, respectively, | |
4492 | of 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. | |
4503 | The 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'. | |
4510 | Buffer 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'. | |
4524 | Buffer 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'. | |
4534 | Additionally requires BASE-POS to tell where the line numbers are | |
4535 | relative 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'. | |
4553 | The 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 | ||
4629 | With 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 | ||
4643 | With 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. | |
4656 | Return a list of (MARKER . STRING) entires for each backquoted | |
4657 | Lisp 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. | |
4692 | SAVED-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 | ||
4738 | The 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 | ||
4747 | When 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 | |
5049 | expansion is possible, " | |
5050 | fallback-description | |
5051 | "\n\nOptional argument FIELD is for non-interactive use and is an | |
5052 | object 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 | ||
5273 | They 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 | ||
5299 | i.e. the ones with \"yas-\" single dash prefix. I will try to | |
5300 | keep them in future yasnippet versions and other elisp libraries | |
5301 | can 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 |