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