]> code.delx.au - gnu-emacs-elpa/blob - yasnippet.el
Fixing some issues, might be broken
[gnu-emacs-elpa] / yasnippet.el
1 ;;; Yasnippet.el --- Yet another snippet extension for Emacs.
2
3 ;; Copyright 2008 pluskid
4 ;; 2009 pluskid, joaotavora
5
6 ;; Authors: pluskid <pluskid@gmail.com>, joaotavora <joaotavora@gmail.com>
7 ;; Version: 0.6.1
8 ;; Package-version: 0.6.1c
9 ;; X-URL: http://code.google.com/p/yasnippet/
10 ;; Keywords: convenience, emulation
11 ;; URL: http://code.google.com/p/yasnippet/
12 ;; EmacsWiki: YaSnippetMode
13
14 ;; This file is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
18
19 ;; This file is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to
26 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
28
29 ;;; Commentary:
30
31 ;; Basic steps to setup:
32 ;;
33 ;; 1. In your .emacs file:
34 ;; (add-to-list 'load-path "/dir/to/yasnippet.el")
35 ;; (require 'yasnippet)
36 ;; 2. Place the `snippets' directory somewhere. E.g: ~/.emacs.d/snippets
37 ;; 3. In your .emacs file
38 ;; (setq yas/root-directory "~/.emacs/snippets")
39 ;; (yas/load-directory yas/root-directory)
40 ;; 4. To enable the YASnippet menu and tab-trigger expansion
41 ;; M-x yas/minor-mode
42 ;; 5. To globally enable the minor mode in *all* buffers
43 ;; M-x yas/global-mode
44 ;;
45 ;; Steps 4. and 5. are optional, you don't have to use the minor
46 ;; mode to use YASnippet.
47 ;;
48 ;; Interesting variables are:
49 ;;
50 ;; `yas/root-directory'
51 ;;
52 ;; The directory where user-created snippets are to be
53 ;; stored. Can also be a list of directories that
54 ;; `yas/reload-all' will use for bulk-reloading snippets. In
55 ;; that case the first directory the default for storing new
56 ;; snippets.
57 ;;
58 ;; `yas/mode-symbol'
59 ;;
60 ;; A local variable that you can set in a hook to override
61 ;; snippet-lookup based on major mode. It is a a symbol (or
62 ;; list of symbols) that correspond to subdirectories of
63 ;; `yas/root-directory' and is used for deciding which
64 ;; snippets to consider for the active buffer.
65 ;;
66 ;; Major commands are:
67 ;;
68 ;; M-x yas/expand
69 ;;
70 ;; Try to expand snippets before point. In `yas/minor-mode',
71 ;; this is bound to `yas/trigger-key' which you can customize.
72 ;;
73 ;; M-x yas/load-directory
74 ;;
75 ;; Prompts you for a directory hierarchy of snippets to load.
76 ;;
77 ;; M-x yas/insert-snippet
78 ;;
79 ;; Prompts you for possible snippet expansion if that is
80 ;; possible according to buffer-local and snippet-local
81 ;; expansion conditions. With prefix argument, ignore these
82 ;; conditions.
83 ;;
84 ;; M-x yas/find-snippets
85 ;;
86 ;; Lets you find the snippet files in the correct
87 ;; subdirectory of `yas/root-directory', according to the
88 ;; active major mode (if it exists) like
89 ;; `find-file-other-window'.
90 ;;
91 ;; M-x yas/visit-snippet-file
92 ;;
93 ;; Prompts you for possible snippet expansions like
94 ;; `yas/insert-snippet', but instead of expanding it, takes
95 ;; you directly to the snippet definition's file, if it
96 ;; exists.
97 ;;
98 ;; M-x yas/new-snippet
99 ;;
100 ;; Lets you create a new snippet file in the correct
101 ;; subdirectory of `yas/root-directory', according to the
102 ;; active major mode.
103 ;;
104 ;; M-x yas/load-snippet-buffer
105 ;;
106 ;; When editing a snippet, this loads the snippet. This is
107 ;; bound to "C-c C-c" while in the `snippet-mode' editing
108 ;; mode.
109 ;;
110 ;; M-x yas/tryout-snippet
111 ;;
112 ;; When editing a snippet, this opens a new empty buffer,
113 ;; sets it to the appropriate major mode and inserts the
114 ;; snippet there, so you can see what it looks like. This is
115 ;; bound to "C-c C-t" while in `snippet-mode'.
116 ;;
117 ;; The `dropdown-list.el' extension is bundled with YASnippet, you
118 ;; can optionally use it the preferred "prompting method", puting in
119 ;; your .emacs file, for example:
120 ;;
121 ;; (require 'dropdown-list)
122 ;; (setq yas/prompt-functions '(yas/dropdown-prompt
123 ;; yas/ido-prompt
124 ;; yas/completing-prompt))
125 ;;
126 ;; Also check out the customization group
127 ;;
128 ;; M-x customize-group RET yasnippet RET
129 ;;
130 ;; If you use the customization group to set variables
131 ;; `yas/root-directory' or `yas/global-mode', make sure the path to
132 ;; "yasnippet.el" is present in the `load-path' *before* the
133 ;; `custom-set-variables' is executed in your .emacs file.
134 ;;
135 ;; For more information and detailed usage, refer to the project page:
136 ;; http://code.google.com/p/yasnippet/
137
138 ;;; Code:
139
140 (require 'cl)
141 (require 'assoc)
142 (require 'easymenu)
143
144 \f
145 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
146 ;; User customizable variables
147
148
149 (defgroup yasnippet nil
150 "Yet Another Snippet extension"
151 :group 'editing)
152
153 ;;;###autoload
154 (defcustom yas/root-directory nil
155 "Root directory that stores the snippets for each major mode.
156
157 If you set this from your .emacs, can also be a list of strings,
158 for multiple root directories. If you make this a list, the first
159 element is always the user-created snippets directory. Other
160 directories are used for bulk reloading of all snippets using
161 `yas/reload-all'"
162 :type '(choice (string :tag "Single directory (string)")
163 (repeat :args (string) :tag "List of directories (strings)"))
164 :group 'yasnippet
165 :require 'yasnippet
166 :set #'(lambda (symbol new)
167 (let ((old (and (boundp symbol)
168 (symbol-value symbol))))
169 (set-default symbol new)
170 (unless (or (not (fboundp 'yas/reload-all))
171 (equal old new))
172 (yas/reload-all)))))
173
174 (defcustom yas/prompt-functions '(yas/x-prompt
175 yas/dropdown-prompt
176 yas/completing-prompt
177 yas/ido-prompt
178 yas/no-prompt)
179 "Functions to prompt for keys, templates, etc interactively.
180
181 These functions are called with the following arguments:
182
183 - PROMPT: A string to prompt the user
184
185 - CHOICES: a list of strings or objects.
186
187 - optional DISPLAY-FN : A function that, when applied to each of
188 the objects in CHOICES will return a string.
189
190 The return value of any function you put here should be one of
191 the objects in CHOICES, properly formatted with DISPLAY-FN (if
192 that is passed).
193
194 - To signal that your particular style of prompting is
195 unavailable at the moment, you can also have the function return
196 nil.
197
198 - To signal that the user quit the prompting process, you can
199 signal `quit' with
200
201 (signal 'quit \"user quit!\")."
202 :type '(repeat function)
203 :group 'yasnippet)
204
205 (defcustom yas/indent-line 'auto
206 "Controls indenting applied to a recent snippet expansion.
207
208 The following values are possible:
209
210 - `fixed' Indent the snippet to the current column;
211
212 - `auto' Indent each line of the snippet with `indent-according-to-mode'
213
214 Every other value means don't apply any snippet-side indendation
215 after expansion (the manual per-line \"$>\" indentation still
216 applies)."
217 :type '(choice (const :tag "Nothing" nothing)
218 (const :tag "Fixed" fixed)
219 (const :tag "Auto" auto))
220 :group 'yasnippet)
221
222 (defcustom yas/also-auto-indent-first-line nil
223 "Non-nil means also auto indent first line according to mode.
224
225 Naturally this is only valid when `yas/indent-line' is `auto'"
226 :type 'boolean
227 :group 'yasnippet)
228
229 (defcustom yas/snippet-revival t
230 "Non-nil means re-activate snippet fields after undo/redo."
231 :type 'boolean
232 :group 'yasnippet)
233
234 (defcustom yas/trigger-key "TAB"
235 "The key bound to `yas/expand' when function `yas/minor-mode' is active.
236
237 Value is a string that is converted to the internal Emacs key
238 representation using `read-kbd-macro'."
239 :type 'string
240 :group 'yasnippet
241 :set #'(lambda (symbol key)
242 (let ((old (and (boundp symbol)
243 (symbol-value symbol))))
244 (set-default symbol key)
245 (if (fboundp 'yas/trigger-key-reload)
246 (yas/trigger-key-reload old)))))
247
248 (defcustom yas/next-field-key "TAB"
249 "The key to navigate to next field when a snippet is active.
250
251 Value is a string that is converted to the internal Emacs key
252 representation using `read-kbd-macro'.
253
254 Can also be a list of strings."
255 :type '(choice (string :tag "String")
256 (repeat :args (string) :tag "List of strings"))
257 :group 'yasnippet
258 :set #'(lambda (symbol val)
259 (set-default symbol val)
260 (if (fboundp 'yas/init-yas-in-snippet-keymap)
261 (yas/init-yas-in-snippet-keymap))))
262
263
264 (defcustom yas/prev-field-key '("<backtab>" "<S-tab>")
265 "The key to navigate to previous 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 (defcustom yas/skip-and-clear-key "C-d"
280 "The key to clear the currently active field.
281
282 Value is a string that is converted to the internal Emacs key
283 representation using `read-kbd-macro'.
284
285 Can also be a list of strings."
286 :type '(choice (string :tag "String")
287 (repeat :args (string) :tag "List of strings"))
288 :group 'yasnippet
289 :set #'(lambda (symbol val)
290 (set-default symbol val)
291 (if (fboundp 'yas/init-yas-in-snippet-keymap)
292 (yas/init-yas-in-snippet-keymap))))
293
294 (defcustom yas/triggers-in-field nil
295 "If non-nil, `yas/next-field-key' can trigger stacked expansions.
296
297 Otherwise, `yas/next-field-key' just tries to move on to the next
298 field"
299 :type 'boolean
300 :group 'yasnippet)
301
302 (defcustom yas/fallback-behavior 'call-other-command
303 "How to act when `yas/trigger-key' does *not* expand a snippet.
304
305 - `call-other-command' means try to temporarily disable YASnippet
306 and call the next command bound to `yas/trigger-key'.
307
308 - nil or the symbol `return-nil' mean do nothing. (and
309 `yas/expand-returns' nil)
310
311 - A lisp form (apply COMMAND . ARGS) means interactively call
312 COMMAND, if ARGS is non-nil, call COMMAND non-interactively
313 with ARGS as arguments."
314 :type '(choice (const :tag "Call previous command" call-other-command)
315 (const :tag "Do nothing" return-nil))
316 :group 'yasnippet)
317
318 (defcustom yas/choose-keys-first nil
319 "If non-nil, prompt for snippet key first, then for template.
320
321 Otherwise prompts for all possible snippet names.
322
323 This affects `yas/insert-snippet' and `yas/visit-snippet-file'."
324 :type 'boolean
325 :group 'yasnippet)
326
327 (defcustom yas/choose-tables-first nil
328 "If non-nil, and multiple eligible snippet tables, prompts user for tables first.
329
330 Otherwise, user chooses between the merging together of all
331 eligible tables.
332
333 This affects `yas/insert-snippet', `yas/visit-snippet-file'"
334 :type 'boolean
335 :group 'yasnippet)
336
337 (defcustom yas/use-menu 'real-modes
338 "Display a YASnippet menu in the menu bar.
339
340 When non-nil, submenus for each snippet table will be listed
341 under the menu \"Yasnippet\".
342
343 - If set to `real-modes' only submenus whose name more or less
344 corresponds to a major mode are listed.
345
346 - If set to `abbreviate', only the current major-mode
347 menu and the modes set in `yas/mode-symbol' are listed.
348
349 Any other non-nil value, every submenu is listed."
350 :type '(choice (const :tag "Full" t)
351 (const :tag "Real modes only" real-modes)
352 (const :tag "Abbreviate" abbreviate))
353 :group 'yasnippet)
354
355 (defcustom yas/trigger-symbol " =>"
356 "The text that will be used in menu to represent the trigger."
357 :type 'string
358 :group 'yasnippet)
359
360 (defcustom yas/wrap-around-region nil
361 "If non-nil, snippet expansion wraps around selected region.
362
363 The wrapping occurs just before the snippet's exit marker. This
364 can be overriden on a per-snippet basis."
365 :type 'boolean
366 :group 'yasnippet)
367
368 (defcustom yas/good-grace t
369 "If non-nil, don't raise errors in inline elisp evaluation.
370
371 An error string \"[yas] error\" is returned instead."
372 :type 'boolean
373 :group 'yasnippet)
374
375 (defcustom yas/ignore-filenames-as-triggers nil
376 "If non-nil, don't derive tab triggers from filenames.
377
378 This means a snippet without a \"# key:'\ directive wont have a
379 tab trigger."
380 :type 'boolean
381 :group 'yasnippet)
382
383 (defcustom yas/visit-from-menu nil
384 "If non-nil visit snippets's files from menu, instead of expanding them.
385
386 This cafn only work when snippets are loaded from files."
387 :type 'boolean
388 :group 'yasnippet)
389
390 (defface yas/field-highlight-face
391 '((((class color) (background light)) (:background "DarkSeaGreen1"))
392 (t (:background "DimGrey")))
393 "The face used to highlight the currently active field of a snippet"
394 :group 'yasnippet)
395
396 (defface yas/field-debug-face
397 '()
398 "The face used for debugging some overlays normally hidden"
399 :group 'yasnippet)
400
401 \f
402 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
403 ;; User can also customize these
404 (defvar yas/keymap nil
405 "The keymap active while a snippet expansion is in progress.")
406
407 (defun yas/define-some-keys (keys keymap definition)
408 "Bind KEYS to DEFINITION in KEYMAP, read with `read-kbd-macro'."
409 (let ((keys (or (and (listp keys) keys)
410 (list keys))))
411 (dolist (key keys)
412 (define-key keymap (read-kbd-macro key) definition))))
413
414 (defun yas/init-yas-in-snippet-keymap ()
415 (let ((map (make-sparse-keymap)))
416 (mapc #'(lambda (binding)
417 (yas/define-some-keys (car binding) map (cdr binding)))
418 `((,yas/next-field-key . yas/next-field-or-maybe-expand)
419 (,yas/prev-field-key . yas/prev-field)
420 ("C-g" . yas/abort-snippet)
421 (,yas/skip-and-clear-key . yas/skip-and-clear-or-delete-char)))
422 (setq yas/keymap map)))
423
424 (yas/init-yas-in-snippet-keymap)
425
426 (defvar yas/key-syntaxes (list "w" "w_" "w_." "^ ")
427 "A list of syntax of a key. This list is tried in the order
428 to try to find a key. For example, if the list is '(\"w\" \"w_\").
429 And in emacs-lisp-mode, where \"-\" has the syntax of \"_\":
430
431 foo-bar
432
433 will first try \"bar\", if not found, then \"foo-bar\" is tried.")
434
435 (defvar yas/after-exit-snippet-hook
436 '()
437 "Hooks to run after a snippet exited.
438
439 The hooks will be run in an environment where some variables bound to
440 proper values:
441
442 `yas/snippet-beg' : The beginning of the region of the snippet.
443
444 `yas/snippet-end' : Similar to beg.
445
446 Attention: These hooks are not run when exiting nested/stackd snippet expansion!")
447
448 (defvar yas/before-expand-snippet-hook
449 '()
450 "Hooks to run just before expanding a snippet.")
451
452 (defvar yas/buffer-local-condition
453 '(if (and (not (bobp))
454 (or (equal 'font-lock-comment-face
455 (get-char-property (1- (point))
456 'face))
457 (equal 'font-lock-string-face
458 (get-char-property (1- (point))
459 'face))))
460 '(require-snippet-condition . force-in-comment)
461 t)
462 "Condition to yasnippet local to each buffer.
463
464 The default value helps filtering out potential snippet
465 expansions inside comments and string literals, unless the
466 snippet itself contains a condition that returns the symbol
467 `force-in-comment'.
468
469 * If yas/buffer-local-condition evaluate to nil, snippet
470 won't be expanded.
471
472 * If it evaluate to the a cons cell where the car is the
473 symbol `require-snippet-condition' and the cdr is a
474 symbol (let's call it \"requirement\"):
475 * If the snippet has no condition, then it won't be
476 expanded.
477 * If the snippet has a condition but it evaluates to nil or
478 error occured during evaluation, it won't be expanded.
479 * If the snippet has a condition that evaluate to
480 non-nil (let's call it \"result\"):
481 * If \"requirement\" is t, the snippet is ready to be
482 expanded.
483 * If \"requirement\" is eq to \"result\", the snippet is ready
484 to be expanded.
485 * Otherwise the snippet won't be expanded.
486
487 * If it evaluates to `always', snippet is unconditionally
488 expanded.
489
490 * If it evaluates to other non-nil value:
491 * If the snippet has no condition, or has a condition that
492 evaluate to non-nil, it is ready to be expanded.
493 * Otherwise, it won't be expanded.
494
495 Here's an example:
496
497 (add-hook 'python-mode-hook
498 '(lambda ()
499 (setq yas/buffer-local-condition
500 '(if (python-in-string/comment)
501 '(require-snippet-condition . force-in-comment)
502 t))))")
503 (make-variable-buffer-local 'yas/buffer-local-condition)
504
505 \f
506 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
507 ;; Internal variables
508
509 (defvar yas/version "0.6.1b")
510
511 (defvar yas/menu-table (make-hash-table)
512 "A hash table of MAJOR-MODE symbols to menu keymaps.")
513
514 (defvar yas/active-keybindings nil
515 "A list of cons (KEYMAP . KEY) setup from defining snippets.")
516
517 (defvar yas/known-modes
518 '(ruby-mode rst-mode markdown-mode)
519 "A list of mode which is well known but not part of emacs.")
520
521 (defvar yas/escaped-characters
522 '(?\\ ?` ?' ?$ ?} )
523 "List of characters which *might* need to be escaped.")
524
525 (defconst yas/field-regexp
526 "${\\([0-9]+:\\)?\\([^}]*\\)}"
527 "A regexp to *almost* recognize a field.")
528
529 (defconst yas/multi-dollar-lisp-expression-regexp
530 "$+[ \t\n]*\\(([^)]*)\\)"
531 "A regexp to *almost* recognize a \"$(...)\" expression.")
532
533 (defconst yas/backquote-lisp-expression-regexp
534 "`\\([^`]*\\)`"
535 "A regexp to recognize a \"`lisp-expression`\" expression." )
536
537 (defconst yas/transform-mirror-regexp
538 "${\\(?:\\([0-9]+\\):\\)?$\\([ \t\n]*([^}]*\\)"
539 "A regexp to *almost* recognize a mirror with a transform.")
540
541 (defconst yas/simple-mirror-regexp
542 "$\\([0-9]+\\)"
543 "A regexp to recognize a simple mirror.")
544
545 (defvar yas/snippet-id-seed 0
546 "Contains the next id for a snippet.")
547
548 (defun yas/snippet-next-id ()
549 (let ((id yas/snippet-id-seed))
550 (incf yas/snippet-id-seed)
551 id))
552
553 \f
554 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
555 ;; Minor mode stuff
556
557 ;; XXX: `last-buffer-undo-list' is somehow needed in Carbon Emacs for MacOSX
558 (defvar last-buffer-undo-list nil)
559
560 (defvar yas/minor-mode-map (make-sparse-keymap)
561 "The keymap used when `yas/minor-mode' is active.")
562
563 (defvar yas/minor-mode-menu (make-sparse-keymap)
564 "Holds the YASnippet menu. For use with `easy-menu-define'.")
565
566 (defun yas/init-minor-keymap ()
567 (easy-menu-define yas/minor-mode-menu
568 yas/minor-mode-map
569 "Menu used when YAS/minor-mode is active."
570 '("YASnippet"
571 "----"
572 ["Expand trigger" yas/expand
573 :help "Possibly expand tab trigger before point"]
574 ["Insert at point..." yas/insert-snippet
575 :help "Prompt for an expandable snippet and expand it at point"]
576 ["New snippet..." yas/new-snippet
577 :help "Create a new snippet in an appropriate directory"]
578 ["Visit snippet file..." yas/visit-snippet-file
579 :help "Prompt for an expandable snippet and find its file"]
580 ["Find snippets..." yas/find-snippets
581 :help "Invoke `find-file' in the appropriate snippet directory"]
582 "----"
583 ("Snippet menu behaviour"
584 ["Visit snippets" (setq yas/visit-from-menu t)
585 :help "Visit snippets from the menu"
586 :active t :style radio :selected yas/visit-from-menu]
587 ["Expand snippets" (setq yas/visit-from-menu nil)
588 :help "Expand snippets from the menu"
589 :active t :style radio :selected (not yas/visit-from-menu)]
590 "----"
591 ["Show \"Real\" modes only" (setq yas/use-menu 'real-modes)
592 :help "Show snippet submenus for modes that appear to be real major modes"
593 :active t :style radio :selected (eq yas/use-menu 'real-modes)]
594 ["Show all modes" (setq yas/use-menu 't)
595 :help "Show one snippet submenu for each loaded table"
596 :active t :style radio :selected (eq yas/use-menu 't)]
597 ["Abbreviate according to current mode" (setq yas/use-menu 'abbreviate)
598 :help "Show only snippet submenus for the current active modes"
599 :active t :style radio :selected (eq yas/use-menu 'abbreviate)])
600 ("Indenting"
601 ["Auto" (setq yas/indent-line 'auto)
602 :help "Indent each line of the snippet with `indent-according-to-mode'"
603 :active t :style radio :selected (eq yas/indent-line 'auto)]
604 ["Fixed" (setq yas/indent-line 'fixed)
605 :help "Indent the snippet to the current column"
606 :active t :style radio :selected (eq yas/indent-line 'fixed)]
607 ["None" (setq yas/indent-line 'none)
608 :help "Don't apply any particular snippet indentation after expansion"
609 :active t :style radio :selected (not (member yas/indent-line '(fixed auto)))]
610 "----"
611 ["Also auto indent first line" (setq yas/also-auto-indent-first-line
612 (not yas/also-auto-indent-first-line))
613 :help "When auto-indenting also, auto indent the first line menu"
614 :active (eq yas/indent-line 'auto)
615 :style toggle :selected yas/also-auto-indent-first-line]
616 )
617 ("Prompting method"
618 ["System X-widget" (setq yas/prompt-functions
619 (cons 'yas/x-prompt
620 (remove 'yas/x-prompt
621 yas/prompt-functions)))
622 :help "Use your windowing system's (gtk, mac, windows, etc...) default menu"
623 :active t :style radio :selected (eq (car yas/prompt-functions)
624 'yas/x-prompt)]
625 ["Dropdown-list" (setq yas/prompt-functions
626 (cons 'yas/dropdown-prompt
627 (remove 'yas/dropdown-prompt
628 yas/prompt-functions)))
629 :help "Use a special dropdown list"
630 :active t :style radio :selected (eq (car yas/prompt-functions)
631 'yas/dropdown-prompt)]
632 ["Ido" (setq yas/prompt-functions
633 (cons 'yas/ido-prompt
634 (remove 'yas/ido-prompt
635 yas/prompt-functions)))
636 :help "Use an ido-style minibuffer prompt"
637 :active t :style radio :selected (eq (car yas/prompt-functions)
638 'yas/ido-prompt)]
639 ["Completing read" (setq yas/prompt-functions
640 (cons 'yas/completing-prompt
641 (remove 'yas/completing-prompt-prompt
642 yas/prompt-functions)))
643 :help "Use a normal minibuffer prompt"
644 :active t :style radio :selected (eq (car yas/prompt-functions)
645 'yas/completing-prompt-prompt)]
646 )
647 ("Misc"
648 ["Wrap region in exit marker"
649 (setq yas/wrap-around-region
650 (not yas/wrap-around-region))
651 :help "If t automatically wrap the selected text in the $0 snippet exit"
652 :style toggle :selected yas/wrap-around-region]
653 ["Allow stacked expansions "
654 (setq yas/triggers-in-field
655 (not yas/triggers-in-field))
656 :help "If t allow snippets to be triggered inside other snippet fields"
657 :style toggle :selected yas/triggers-in-field]
658 ["Revive snippets on undo "
659 (setq yas/snippet-revival
660 (not yas/snippet-revival))
661 :help "If t allow snippets to become active again after undo"
662 :style toggle :selected yas/snippet-revival]
663 ["Good grace "
664 (setq yas/good-grace
665 (not yas/good-grace))
666 :help "If t don't raise errors in bad embedded eslip in snippets"
667 :style toggle :selected yas/good-grace]
668 ["Ignore filenames as triggers"
669 (setq yas/ignore-filenames-as-triggers
670 (not yas/ignore-filenames-as-triggers))
671 :help "If t don't derive tab triggers from filenames"
672 :style toggle :selected yas/ignore-filenames-as-triggers]
673 )
674 "----"
675 ["Load snippets..." yas/load-directory
676 :help "Load snippets from a specific directory"]
677 ["Reload everything" yas/reload-all
678 :help "Cleanup stuff, reload snippets, rebuild menus"]
679 ["About" yas/about
680 :help "Display some information about YASsnippet"]))
681 ;; Now for the stuff that has direct keybindings
682 ;;
683 (yas/trigger-key-reload)
684 (define-key yas/minor-mode-map "\C-c&\C-s" 'yas/insert-snippet)
685 (define-key yas/minor-mode-map "\C-c&\C-n" 'yas/new-snippet)
686 (define-key yas/minor-mode-map "\C-c&\C-v" 'yas/visit-snippet-file)
687 (define-key yas/minor-mode-map "\C-c&\C-f" 'yas/find-snippets))
688
689
690 (defun yas/trigger-key-reload (&optional unbind-key)
691 "Rebind `yas/expand' to the new value of `yas/trigger-key'.
692
693 With optional UNBIND-KEY, try to unbind that key from
694 `yas/minor-mode-map'."
695 (when (and unbind-key
696 (stringp unbind-key)
697 (not (string= unbind-key "")))
698 (define-key yas/minor-mode-map (read-kbd-macro unbind-key) nil))
699 (when (and yas/trigger-key
700 (stringp yas/trigger-key)
701 (not (string= yas/trigger-key "")))
702 (define-key yas/minor-mode-map (read-kbd-macro yas/trigger-key) 'yas/expand)))
703
704 (define-minor-mode yas/minor-mode
705 "Toggle YASnippet mode.
706
707 When YASnippet mode is enabled, the `tas/trigger-key' key expands
708 snippets of code depending on the mode.
709
710 With no argument, this command toggles the mode.
711 positive prefix argument turns on the mode.
712 Negative prefix argument turns off the mode.
713
714 You can customize the key through `yas/trigger-key'.
715
716 Key bindings:
717 \\{yas/minor-mode-map}"
718 nil
719 ;; The indicator for the mode line.
720 " yas"
721 :group 'yasnippet
722 (when yas/minor-mode
723 ;; when turning on the minor mode.
724 ;;
725 ;; re-read the `yas/trigger-key' if a `yas/minor-mode-map' is
726 ;; already built. Else, call `yas/init-minor-keymap' to build it
727 (unless (and (cdr yas/minor-mode-map)
728 (yas/trigger-key-reload))
729 (yas/init-minor-keymap))
730 ;; load all snippets definitions unless we still don't have a
731 ;; root-directory or some snippets have already been loaded.
732 (unless (or (null yas/root-directory)
733 (> (hash-table-count yas/snippet-tables) 0))
734 (yas/reload-all))))
735
736 (defvar yas/dont-activate nil
737 "If non-nil don't let `yas/minor-mode-on' active yas for this buffer.
738
739 `yas/minor-mode-on' is usually called by `yas/global-mode' so
740 this effectively lets you define exceptions to the \"global\"
741 behaviour.")
742 (make-variable-buffer-local 'yas/dont-activate)
743
744 (defun yas/minor-mode-on ()
745 "Turn on YASnippet minor mode.
746
747 Do this unless `yas/dont-activate' is t or the function
748 `yas/get-snippet-tables' (which see), returns an empty list."
749 (interactive)
750 (unless (or yas/dont-activate
751 (null (yas/get-snippet-tables)))
752 (yas/minor-mode 1)))
753
754 (defun yas/minor-mode-off ()
755 "Turn off YASnippet minor mode."
756 (interactive)
757 (yas/minor-mode -1))
758
759 (define-globalized-minor-mode yas/global-mode yas/minor-mode yas/minor-mode-on
760 :group 'yasnippet
761 :require 'yasnippet)
762
763 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
764 ;; Major mode stuff
765 ;;
766 (defvar yas/font-lock-keywords
767 (append '(("^#.*$" . font-lock-comment-face))
768 lisp-font-lock-keywords
769 lisp-font-lock-keywords-1
770 lisp-font-lock-keywords-2
771 '(("$\\([0-9]+\\)"
772 (0 font-lock-keyword-face)
773 (1 font-lock-string-face t))
774 ("${\\([0-9]+\\):?"
775 (0 font-lock-keyword-face)
776 (1 font-lock-warning-face t))
777 ("${" font-lock-keyword-face)
778 ("$[0-9]+?" font-lock-preprocessor-face)
779 ("\\(\\$(\\)" 1 font-lock-preprocessor-face)
780 ("}"
781 (0 font-lock-keyword-face)))))
782
783 (defvar snippet-mode-map (make-sparse-keymap)
784 "The keymap used when `snippet-mode' is active")
785
786 (defvar yas/major-mode-menu (make-sparse-keymap)
787 "Holds the snippet-mode menu. For use with `easy-menu-define'.")
788
789 (defun yas/init-major-keymap ()
790 (easy-menu-define yas/major-mode-menu
791 snippet-mode-map
792 "Menu used when snippet-mode is active."
793 (cons "Snippet"
794 (mapcar #'(lambda (ent)
795 (when (third ent)
796 (define-key snippet-mode-map (third ent) (second ent)))
797 (vector (first ent) (second ent) t))
798 (list
799 (list "Load this snippet" 'yas/load-snippet-buffer "\C-c\C-c")
800 (list "Try out this snippet" 'yas/tryout-snippet "\C-c\C-t"))))))
801
802 (progn
803 (yas/init-major-keymap))
804
805 (define-derived-mode snippet-mode text-mode "Snippet"
806 "A mode for editing yasnippets"
807 (set-syntax-table (standard-syntax-table))
808 (setq font-lock-defaults '(yas/font-lock-keywords))
809 (set (make-local-variable 'require-final-newline) nil)
810 (use-local-map snippet-mode-map))
811
812 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
813 ;; Internal structs for template management
814
815 (defstruct (yas/template (:constructor yas/make-template
816 (content name condition expand-env file keybinding)))
817 "A template for a snippet."
818 content
819 name
820 condition
821 expand-env
822 file
823 keybinding)
824
825 (defvar yas/snippet-tables (make-hash-table)
826 "A hash table of MAJOR-MODE symbols to `yas/snippet-table' objects.")
827
828 (defstruct (yas/snippet-table (:constructor yas/make-snippet-table (name)))
829 "A table to store snippets for a particular mode.
830
831 Has the following fields:
832
833 `yas/snippet-table-name'
834
835 A symbol normally corresponding to a major mode, but can also be
836 a pseudo major-mode to be referenced in `yas/mode-symbol', for
837 example.
838
839 `yas/snippet-table-hash'
840
841 A hash table the key is a string (the snippet key) and the
842 value is yet another hash of (NAME TEMPLATE), where NAME is the
843 snippet name and TEMPLATE is a `yas/template' object name.
844
845 `yas/snippet-table-parents'
846
847 A list of tables considered parents of this table: i.e. when
848 searching for expansions they are searched as well."
849 name
850 (hash (make-hash-table :test 'equal))
851 (parents nil))
852
853 (defvar yas/better-guess-for-replacements nil
854 "If non-nil `yas/store' better guess snippet replacements.")
855
856 (defun yas/store (table name key template)
857 "Store a snippet template in the TABLE."
858
859 ;; This is dones by searching twice:
860 ;;
861 ;; * Try to get the existing namehash from TABLE using key.
862 ;;
863 ;; * Try to get the existing namehash from by searching the *whole*
864 ;; snippet table for NAME. This is becuase they user might have
865 ;; changed the key and that can no longer be used to locate the
866 ;; previous `yas/template-structure'.
867 ;;
868 ;; * If that returns nothing, oh well...
869 ;;
870 (dolist (existing-namehash (remove nil (list (gethash key (yas/snippet-table-hash table))
871 (when yas/better-guess-for-replacements
872 (let (a)
873 (maphash #'(lambda (key namehash)
874 (when (gethash name namehash)
875 (setq a namehash)))
876 (yas/snippet-table-hash table))
877 a)))))
878 (let ((existing-template (gethash name existing-namehash)))
879 (when existing-template
880 ;; Remove the existing keybinding
881 (when (yas/template-keybinding existing-template)
882 (define-key
883 (symbol-value (first (yas/template-keybinding existing-template)))
884 (second (yas/template-keybinding existing-template))
885 nil)
886 (setq yas/active-keybindings
887 (delete (yas/template-keybinding existing-template)
888 yas/active-keybindings)))
889 ;; Remove the (name . template) mapping from existing-namehash.
890 (remhash name existing-namehash))))
891 ;; Now store the new template independent of the previous steps.
892 ;;
893 (puthash name
894 template
895 (or (gethash key
896 (yas/snippet-table-hash table))
897 (puthash key
898 (make-hash-table :test 'equal)
899 (yas/snippet-table-hash table)))))
900
901 (defun yas/fetch (table key)
902 "Fetch a snippet binding to KEY from TABLE."
903 (let* ((keyhash (yas/snippet-table-hash table))
904 (namehash (and keyhash (gethash key keyhash))))
905 (when namehash
906 (yas/filter-templates-by-condition
907 (let (alist)
908 (maphash #'(lambda (k v)
909 (push (cons k v) alist))
910 namehash)
911 alist)))))
912
913 \f
914 ;; Filtering/condition logic
915
916 (defun yas/eval-condition (condition)
917 (condition-case err
918 (save-excursion
919 (save-restriction
920 (save-match-data
921 (eval condition))))
922 (error (progn
923 (message (format "[yas] error in condition evaluation: %s"
924 (error-message-string err)))
925 nil))))
926
927
928 (defun yas/filter-templates-by-condition (templates)
929 "Filter the templates using the applicable condition.
930
931 TEMPLATES is a list of cons (NAME . TEMPLATE) where NAME is a
932 string and TEMPLATE is a `yas/template' structure.
933
934 This function implements the rules described in
935 `yas/buffer-local-condition'. See that variables documentation."
936 (let ((requirement (yas/require-template-specific-condition-p)))
937 (if (eq requirement 'always)
938 templates
939 (remove-if-not #'(lambda (pair)
940 (yas/template-can-expand-p (yas/template-condition (cdr pair)) requirement))
941 templates))))
942
943 (defun yas/require-template-specific-condition-p ()
944 "Decides if this buffer requests/requires snippet-specific
945 conditions to filter out potential expansions."
946 (if (eq 'always yas/buffer-local-condition)
947 'always
948 (let ((local-condition (or (and (consp yas/buffer-local-condition)
949 (yas/eval-condition yas/buffer-local-condition))
950 yas/buffer-local-condition)))
951 (when local-condition
952 (if (eq local-condition t)
953 t
954 (and (consp local-condition)
955 (eq 'require-snippet-condition (car local-condition))
956 (symbolp (cdr local-condition))
957 (cdr local-condition)))))))
958
959 (defun yas/template-can-expand-p (condition &optional requirement)
960 "Evaluates CONDITION and REQUIREMENT and returns a boolean"
961 (let* ((requirement (or requirement
962 (yas/require-template-specific-condition-p)))
963 (result (or (null condition)
964 (yas/eval-condition
965 (condition-case err
966 (read condition)
967 (error (progn
968 (message (format "[yas] error reading condition: %s"
969 (error-message-string err))))
970 nil))))))
971 (cond ((eq requirement t)
972 result)
973 (t
974 (eq requirement result)))))
975
976 (defun yas/snippet-table-get-all-parents (table)
977 (let ((parents (yas/snippet-table-parents table)))
978 (when parents
979 (append (copy-list parents)
980 (mapcan #'yas/snippet-table-get-all-parents parents)))))
981
982 (defun yas/snippet-table-templates (table)
983 (when table
984 (let ((acc (list)))
985 (maphash #'(lambda (key namehash)
986 (maphash #'(lambda (name template)
987 (push (cons name template) acc))
988 namehash))
989 (yas/snippet-table-hash table))
990 (yas/filter-templates-by-condition acc))))
991
992 (defun yas/current-key ()
993 "Get the key under current position. A key is used to find
994 the template of a snippet in the current snippet-table."
995 (let ((start (point))
996 (end (point))
997 (syntaxes yas/key-syntaxes)
998 syntax
999 done
1000 templates)
1001 (while (and (not done) syntaxes)
1002 (setq syntax (car syntaxes))
1003 (setq syntaxes (cdr syntaxes))
1004 (save-excursion
1005 (skip-syntax-backward syntax)
1006 (setq start (point)))
1007 (setq templates
1008 (mapcan #'(lambda (table)
1009 (yas/fetch table (buffer-substring-no-properties start end)))
1010 (yas/get-snippet-tables)))
1011 (if templates
1012 (setq done t)
1013 (setq start end)))
1014 (list templates
1015 start
1016 end)))
1017
1018
1019 (defun yas/snippet-table-all-keys (table)
1020 (when table
1021 (let ((acc))
1022 (maphash #'(lambda (key templates)
1023 (when (yas/filter-templates-by-condition templates)
1024 (push key acc)))
1025 (yas/snippet-table-hash table))
1026 acc)))
1027
1028 \f
1029 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1030 ;; Internal functions
1031
1032 (defun yas/real-mode? (mode)
1033 "Try to find out if MODE is a real mode. The MODE bound to
1034 a function (like `c-mode') is considered real mode. Other well
1035 known mode like `ruby-mode' which is not part of Emacs might
1036 not bound to a function until it is loaded. So yasnippet keeps
1037 a list of modes like this to help the judgement."
1038 (or (fboundp mode)
1039 (find mode yas/known-modes)))
1040
1041 (defun yas/read-and-eval-string (string)
1042 ;; TODO: This is a possible optimization point, the expression could
1043 ;; be stored in cons format instead of string,
1044 "Evaluate STRING and convert the result to string."
1045 (let ((retval (catch 'yas/exception
1046 (condition-case err
1047 (save-excursion
1048 (save-restriction
1049 (save-match-data
1050 (widen)
1051 (let ((result (eval (read string))))
1052 (when result
1053 (format "%s" result))))))
1054 (error (if yas/good-grace
1055 "[yas] elisp error!"
1056 (error (format "[yas] elisp error: %s"
1057 (error-message-string err)))))))))
1058 (when (and (consp retval)
1059 (eq 'yas/exception (car retval)))
1060 (error (cdr retval)))
1061 retval))
1062
1063 (defvar yas/mode-symbol nil
1064 "If non-nil, lookup snippets using this instead of `major-mode'.")
1065 (make-variable-buffer-local 'yas/mode-symbol)
1066
1067 (defun yas/snippet-table-get-create (mode)
1068 "Get the snippet table corresponding to MODE.
1069
1070 Optional DIRECTORY gets recorded as the default directory to
1071 search for snippet files if the retrieved/created table didn't
1072 already have such a property."
1073 (let ((table (gethash mode
1074 yas/snippet-tables)))
1075 (unless table
1076 (setq table (yas/make-snippet-table (symbol-name mode)))
1077 (puthash mode table yas/snippet-tables))
1078 table))
1079
1080 (defun yas/get-snippet-tables (&optional mode-symbol dont-search-parents)
1081 "Get snippet tables for current buffer.
1082
1083 Return a list of 'yas/snippet-table' objects indexed by mode.
1084
1085 The modes are tried in this order: optional MODE-SYMBOL, then
1086 `yas/mode-symbol', then `major-mode' then, unless
1087 DONT-SEARCH-PARENTS is non-nil, the guessed parent mode of either
1088 MODE-SYMBOL or `major-mode'.
1089
1090 Guessing is done by looking up the MODE-SYMBOL's
1091 `derived-mode-parent' property, see also `derived-mode-p'."
1092 (let ((mode-tables
1093 (mapcar #'(lambda (mode)
1094 (gethash mode yas/snippet-tables))
1095 (append (list mode-symbol)
1096 (if (listp yas/mode-symbol)
1097 yas/mode-symbol
1098 (list yas/mode-symbol))
1099 (list major-mode
1100 (and (not dont-search-parents)
1101 (get (or mode-symbol major-mode)
1102 'derived-mode-parent))))))
1103 (all-tables))
1104 (dolist (table (remove nil mode-tables))
1105 (push table all-tables)
1106 (nconc all-tables (yas/snippet-table-get-all-parents table)))
1107 (remove-duplicates all-tables)))
1108
1109 (defun yas/menu-keymap-get-create (mode)
1110 "Get the menu keymap correspondong to MODE."
1111 (or (gethash mode yas/menu-table)
1112 (puthash mode (make-sparse-keymap) yas/menu-table)))
1113
1114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1115 ;;; Template-related and snippet loading functions
1116
1117 (defun yas/parse-template (&optional file)
1118 "Parse the template in the current buffer.
1119
1120 Optional FILE is the absolute file name of the file being
1121 parsed.
1122
1123 Return a snippet-definition, i.e. a list
1124
1125 (KEY TEMPLATE NAME CONDITION GROUP VARS FILE KEYBINDING)
1126
1127 If the buffer contains a line of \"# --\" then the contents
1128 above this line are ignored. Variables can be set above this
1129 line through the syntax:
1130
1131 #name : value
1132
1133 Here's a list of currently recognized variables:
1134
1135 * name
1136 * contributor
1137 * condition
1138 * key
1139 * group
1140 * expand-env
1141
1142 #name: #include \"...\"
1143 # --
1144 #include \"$1\""
1145 ;;
1146 ;;
1147 (goto-char (point-min))
1148 (let* ((name (and file
1149 (file-name-nondirectory file)))
1150 (key (unless yas/ignore-filenames-as-triggers
1151 (and name
1152 (file-name-sans-extension name))))
1153 template
1154 bound
1155 condition
1156 (group (and file
1157 (yas/calculate-group file)))
1158 expand-env
1159 binding)
1160 (if (re-search-forward "^# --\n" nil t)
1161 (progn (setq template
1162 (buffer-substring-no-properties (point)
1163 (point-max)))
1164 (setq bound (point))
1165 (goto-char (point-min))
1166 (while (re-search-forward "^# *\\([^ ]+?\\) *: *\\(.*\\)$" bound t)
1167 (when (string= "name" (match-string-no-properties 1))
1168 (setq name (match-string-no-properties 2)))
1169 (when (string= "condition" (match-string-no-properties 1))
1170 (setq condition (match-string-no-properties 2)))
1171 (when (string= "group" (match-string-no-properties 1))
1172 (setq group (match-string-no-properties 2)))
1173 (when (string= "expand-env" (match-string-no-properties 1))
1174 (setq expand-env (match-string-no-properties 2)))
1175 (when (string= "key" (match-string-no-properties 1))
1176 (setq key (match-string-no-properties 2)))
1177 (when (string= "binding" (match-string-no-properties 1))
1178 (setq binding (match-string-no-properties 2)))))
1179 (setq template
1180 (buffer-substring-no-properties (point-min) (point-max))))
1181 (list key template name condition group expand-env file binding)))
1182
1183 (defun yas/calculate-group (file)
1184 "Calculate the group for snippet file path FILE."
1185 (let* ((dominating-dir (locate-dominating-file file
1186 ".yas-make-groups"))
1187 (extra-path (and dominating-dir
1188 (replace-regexp-in-string (concat "^"
1189 (expand-file-name dominating-dir))
1190 ""
1191 (expand-file-name file))))
1192 (extra-dir (and extra-path
1193 (file-name-directory extra-path)))
1194 (group (and extra-dir
1195 (replace-regexp-in-string "/"
1196 "."
1197 (directory-file-name extra-dir)))))
1198 group))
1199
1200 ;; (defun yas/glob-files (directory &optional recurse-p append)
1201 ;; "Returns files under DIRECTORY ignoring dirs and hidden files.
1202
1203 ;; If RECURSE in non-nil, do that recursively."
1204 ;; (let (ret
1205 ;; (default-directory directory))
1206 ;; (dolist (entry (directory-files "."))
1207 ;; (cond ((or (string-match "^\\."
1208 ;; (file-name-nondirectory entry))
1209 ;; (string-match "~$"
1210 ;; (file-name-nondirectory entry)))
1211 ;; nil)
1212 ;; ((and recurse-p
1213 ;; (file-directory-p entry))
1214 ;; (setq ret (nconc ret
1215 ;; (yas/glob-files (expand-file-name entry)
1216 ;; recurse-p
1217 ;; (if append
1218 ;; (concat append "/" entry)
1219 ;; entry)))))
1220 ;; ((file-directory-p entry)
1221 ;; nil)
1222 ;; (t
1223 ;; (push (if append
1224 ;; (concat append "/" entry)
1225 ;; entry) ret))))
1226 ;; ret))
1227
1228 (defun yas/subdirs (directory &optional file?)
1229 "Return subdirs or files of DIRECTORY according to FILE?."
1230 (remove-if (lambda (file)
1231 (or (string-match "^\\."
1232 (file-name-nondirectory file))
1233 (string-match "~$"
1234 (file-name-nondirectory file))
1235 (if file?
1236 (file-directory-p file)
1237 (not (file-directory-p file)))))
1238 (directory-files directory t)))
1239
1240 (defun yas/make-menu-binding (template)
1241 `(lambda () (interactive) (yas/expand-or-visit-from-menu ,template)))
1242
1243 (defun yas/expand-or-visit-from-menu (template)
1244 (if yas/visit-from-menu
1245 (yas/visit-snippet-file-1 template)
1246 (let ((where (if mark-active
1247 (cons (region-beginning) (region-end))
1248 (cons (point) (point)))))
1249 (yas/expand-snippet (yas/template-content template)
1250 (car where)
1251 (cdr where)))))
1252
1253 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1254 ;; Popping up for keys and templates
1255 ;;
1256 (defun yas/prompt-for-template (templates &optional prompt)
1257 "Interactively choose a template from the list TEMPLATES.
1258
1259 TEMPLATES is a list of `yas/template'."
1260 (when templates
1261 (some #'(lambda (fn)
1262 (funcall fn (or prompt "Choose a snippet: ")
1263 templates
1264 #'yas/template-name))
1265 yas/prompt-functions)))
1266
1267 (defun yas/prompt-for-keys (keys &optional prompt)
1268 "Interactively choose a template key from the list KEYS."
1269 (when keys
1270 (some #'(lambda (fn)
1271 (funcall fn (or prompt "Choose a snippet key: ") keys))
1272 yas/prompt-functions)))
1273
1274 (defun yas/prompt-for-table (tables &optional prompt)
1275 (when tables
1276 (some #'(lambda (fn)
1277 (funcall fn (or prompt "Choose a snippet table: ")
1278 tables
1279 #'yas/snippet-table-name))
1280 yas/prompt-functions)))
1281
1282 (defun yas/x-prompt (prompt choices &optional display-fn)
1283 (when (and window-system choices)
1284 (let ((keymap (cons 'keymap
1285 (cons
1286 prompt
1287 (mapcar (lambda (choice)
1288 (list choice
1289 'menu-item
1290 (if display-fn
1291 (funcall display-fn choice)
1292 choice)
1293 t))
1294 choices)))))
1295 (when (cdr keymap)
1296 (car (x-popup-menu (if (fboundp 'posn-at-point)
1297 (let ((x-y (posn-x-y (posn-at-point (point)))))
1298 (list (list (+ (car x-y) 10)
1299 (+ (cdr x-y) 20))
1300 (selected-window)))
1301 t)
1302 keymap))))))
1303
1304 (defun yas/ido-prompt (prompt choices &optional display-fn)
1305 (when (and (featurep 'ido)
1306 ido-mode)
1307 (let* ((formatted-choices (or (and display-fn
1308 (mapcar display-fn choices))
1309 choices))
1310 (chosen (and formatted-choices
1311 (ido-completing-read prompt
1312 formatted-choices
1313 nil
1314 'require-match
1315 nil
1316 nil))))
1317 (when chosen
1318 (nth (position chosen formatted-choices :test #'string=) choices)))))
1319
1320 (eval-when-compile (require 'dropdown-list nil t))
1321 (defun yas/dropdown-prompt (prompt choices &optional display-fn)
1322 (when (featurep 'dropdown-list)
1323 (let* ((formatted-choices (or (and display-fn
1324 (mapcar display-fn choices))
1325 choices))
1326 (chosen (and formatted-choices
1327 (nth (dropdown-list formatted-choices)
1328 choices))))
1329 chosen)))
1330
1331 (defun yas/completing-prompt (prompt choices &optional display-fn)
1332 (let* ((formatted-choices (or (and display-fn
1333 (mapcar display-fn choices))
1334 choices))
1335 (chosen (and formatted-choices
1336 (completing-read prompt
1337 formatted-choices
1338 nil
1339 'require-match
1340 nil
1341 nil))))
1342 (when chosen
1343 (nth (position chosen formatted-choices :test #'string=) choices))))
1344
1345 (defun yas/no-prompt (prompt choices &optional display-fn)
1346 (first choices))
1347
1348 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1349 ;; Loading snippets from files
1350 ;;
1351 (defun yas/load-directory-1 (directory &optional parents no-hierarchy-parents making-groups-sym)
1352 "Recursively load snippet templates from DIRECTORY."
1353 ;; TODO: Rewrite this horrible, horrible monster I created
1354 (unless (file-exists-p (concat directory "/" ".yas-skip"))
1355 (let* ((major-mode-and-parents (unless making-groups-sym
1356 (yas/compute-major-mode-and-parents (concat directory "/dummy")
1357 nil
1358 no-hierarchy-parents)))
1359 (yas/ignore-filenames-as-triggers (or yas/ignore-filenames-as-triggers
1360 (file-exists-p (concat directory "/" ".yas-ignore-filenames-as-triggers"))))
1361 (mode-sym (and major-mode-and-parents
1362 (car major-mode-and-parents)))
1363 (parents (if making-groups-sym
1364 parents
1365 (rest major-mode-and-parents)))
1366 (snippet-defs nil)
1367 (make-groups-p (or making-groups-sym
1368 (file-exists-p (concat directory "/" ".yas-make-groups")))))
1369 (with-temp-buffer
1370 (dolist (file (yas/subdirs directory 'no-subdirs-just-files))
1371 (when (file-readable-p file)
1372 (insert-file-contents file nil nil nil t)
1373 (push (yas/parse-template file)
1374 snippet-defs))))
1375 (yas/define-snippets (or mode-sym
1376 making-groups-sym)
1377 snippet-defs
1378 parents)
1379 (dolist (subdir (yas/subdirs directory))
1380 (if make-groups-p
1381 (yas/load-directory-1 subdir parents 't (or mode-sym
1382 making-groups-sym))
1383 (yas/load-directory-1 subdir (list mode-sym)))))))
1384
1385 (defun yas/load-directory (directory)
1386 "Load snippet definition from a directory hierarchy.
1387
1388 Below the top-level directory, each directory is a mode
1389 name. And under each subdirectory, each file is a definition
1390 of a snippet. The file name is the trigger key and the
1391 content of the file is the template."
1392 (interactive "DSelect the root directory: ")
1393 (unless (file-directory-p directory)
1394 (error "Error %s not a directory" directory))
1395 (unless yas/root-directory
1396 (setq yas/root-directory directory))
1397 (dolist (dir (yas/subdirs directory))
1398 (yas/load-directory-1 dir nil 'no-hierarchy-parents))
1399 (when (interactive-p)
1400 (message "done.")))
1401
1402 (defun yas/kill-snippet-keybindings ()
1403 "Remove the all active snippet keybindings."
1404 (interactive)
1405 (dolist (keybinding yas/active-keybindings)
1406 (define-key (symbol-value (first keybinding)) (second keybinding) nil))
1407 (setq yas/active-keybindings nil))
1408
1409 (defun yas/reload-all (&optional reset-root-directory)
1410 "Reload all snippets and rebuild the YASnippet menu. "
1411 (interactive "P")
1412 ;; Turn off global modes and minor modes, save their state though
1413 ;;
1414 (let ((restore-global-mode (prog1 yas/global-mode
1415 (yas/global-mode -1)))
1416 (restore-minor-mode (prog1 yas/minor-mode
1417 (yas/minor-mode -1))))
1418 ;; Empty all snippet tables and all menu tables
1419 ;;
1420 (setq yas/snippet-tables (make-hash-table))
1421 (setq yas/menu-table (make-hash-table))
1422
1423 ;; The minor mode and major mode keymap's cdr set to nil (this is
1424 ;; the same as `make-sparse-keymap;)
1425 (setf (cdr yas/minor-mode-menu) nil)
1426 (setf (cdr yas/minor-mode-map) nil)
1427 (setf (cdr yas/major-mode-menu) nil)
1428 (setf (cdr snippet-mode-map) nil)
1429
1430 ;; Initialize both keymaps
1431 ;;
1432 (yas/init-minor-keymap)
1433 (yas/init-major-keymap)
1434
1435 ;; Now, clean up the other keymaps we might have cluttered up.
1436 (yas/kill-snippet-keybindings)
1437
1438 (when reset-root-directory
1439 (setq yas/root-directory nil))
1440
1441 ;; Reload the directories listed in `yas/root-directory' or prompt
1442 ;; the user to select one.
1443 ;;
1444 (if yas/root-directory
1445 (if (listp yas/root-directory)
1446 (dolist (directory yas/root-directory)
1447 (yas/load-directory directory))
1448 (yas/load-directory yas/root-directory))
1449 (call-interactively 'yas/load-directory))
1450
1451 ;; Restore the mode configuration
1452 ;;
1453 (when restore-minor-mode
1454 (yas/minor-mode 1))
1455 (when restore-global-mode
1456 (yas/global-mode 1))
1457
1458 (message "done.")))
1459
1460 (defun yas/quote-string (string)
1461 "Escape and quote STRING.
1462 foo\"bar\\! -> \"foo\\\"bar\\\\!\""
1463 (concat "\""
1464 (replace-regexp-in-string "[\\\"]"
1465 "\\\\\\&"
1466 string
1467 t)
1468 "\""))
1469 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1470 ;;; Yasnippet Bundle
1471
1472 (defun yas/initialize ()
1473 "For backward compatibility, enable `yas/minor-mode' globally"
1474 (yas/global-mode 1))
1475
1476 (defun yas/compile-bundle
1477 (&optional yasnippet yasnippet-bundle snippet-roots code dropdown)
1478 "Compile snippets in SNIPPET-ROOTS to a single bundle file.
1479
1480 YASNIPPET is the yasnippet.el file path.
1481
1482 YASNIPPET-BUNDLE is the output file of the compile result.
1483
1484 SNIPPET-ROOTS is a list of root directories that contains the
1485 snippets definition.
1486
1487 CODE is the code to be placed at the end of the generated file
1488 and that can initialize the YASnippet bundle.
1489
1490 Last optional argument DROPDOWN is the filename of the
1491 dropdown-list.el library.
1492
1493 Here's the default value for all the parameters:
1494
1495 (yas/compile-bundle \"yasnippet.el\"
1496 \"yasnippet-bundle.el\"
1497 \"snippets\")
1498 \"(yas/initialize-bundle)
1499 ### autoload
1500 (require 'yasnippet-bundle)`\"
1501 \"dropdown-list.el\")
1502 "
1503 (interactive "ffind the yasnippet.el file: \nFTarget bundle file: \nDSnippet directory to bundle: \nMExtra code? \nfdropdown-library: ")
1504
1505 (let* ((yasnippet (or yasnippet
1506 "yasnippet.el"))
1507 (yasnippet-bundle (or yasnippet-bundle
1508 "./yasnippet-bundle.el"))
1509 (snippet-roots (or snippet-roots
1510 "snippets"))
1511 (dropdown (or dropdown
1512 "dropdown-list.el"))
1513 (code (or (and code
1514 (condition-case err (read code) (error nil))
1515 code)
1516 (concat "(yas/initialize-bundle)"
1517 "\n;;;###autoload" ; break through so that won't
1518 "(require 'yasnippet-bundle)")))
1519 (dirs (or (and (listp snippet-roots) snippet-roots)
1520 (list snippet-roots)))
1521 (bundle-buffer nil))
1522 (with-temp-file yasnippet-bundle
1523 (insert ";;; yasnippet-bundle.el --- "
1524 "Yet another snippet extension (Auto compiled bundle)\n")
1525 (insert-file-contents yasnippet)
1526 (goto-char (point-max))
1527 (insert "\n")
1528 (when dropdown
1529 (insert-file-contents dropdown))
1530 (goto-char (point-max))
1531 (insert ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n")
1532 (insert ";;;; Auto-generated code ;;;;\n")
1533 (insert ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n")
1534 (insert "(defun yas/initialize-bundle ()\n"
1535 " \"Initialize YASnippet and load snippets in the bundle.\""
1536 " (yas/global-mode 1)\n")
1537 (flet ((yas/define-snippets
1538 (mode snippets &optional parent-or-parents)
1539 (insert ";;; snippets for " (symbol-name mode) "\n")
1540 (let ((literal-snippets (list)))
1541 (dolist (snippet snippets)
1542 (let ((key (first snippet))
1543 (template-content (second snippet))
1544 (name (third snippet))
1545 (condition (fourth snippet))
1546 (group (fifth snippet))
1547 (expand-env (sixth snippet))
1548 ;; Omit the file on purpose
1549 (file nil) ;; (seventh snippet))
1550 (binding (eighth snippet)))
1551 (push `(,key
1552 ,template-content
1553 ,name
1554 ,condition
1555 ,group
1556 ,expand-env
1557 ,file
1558 ,binding)
1559 literal-snippets)))
1560 (insert (pp-to-string `(yas/define-snippets ',mode ',literal-snippets ',parent-or-parents)))
1561 (insert "\n\n"))))
1562 (dolist (dir dirs)
1563 (dolist (subdir (yas/subdirs dir))
1564 (yas/load-directory-1 subdir nil 'no-hierarchy-parents))))
1565
1566 (insert ")\n\n" code "\n")
1567 (insert "(provide '"
1568 (file-name-nondirectory
1569 (file-name-sans-extension
1570 yasnippet-bundle))
1571 ")\n")
1572 (insert ";;; "
1573 (file-name-nondirectory yasnippet-bundle)
1574 " ends here\n"))))
1575
1576 (defun yas/compile-textmate-bundle ()
1577 (interactive)
1578 (yas/compile-bundle "yasnippet.el"
1579 "./yasnippet-textmate-bundle.el"
1580 "extras/imported/"
1581 (concat "(yas/initialize-bundle)"
1582 "\n;;;###autoload" ; break through so that won't
1583 "(require 'yasnippet-textmate-bundle)")
1584 "dropdown-list.el"))
1585
1586 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1587 ;;; Some user level functions
1588 ;;;
1589
1590 (defun yas/about ()
1591 (interactive)
1592 (message (concat "yasnippet (version "
1593 yas/version
1594 ") -- pluskid <pluskid@gmail.com>/joaotavora <joaotavora@gmail.com>")))
1595
1596 (defun yas/define-snippets (mode snippets &optional parent-mode)
1597 "Define SNIPPETS for MODE.
1598
1599 SNIPPETS is a list of snippet definitions, each taking the
1600 following form:
1601
1602 (KEY TEMPLATE NAME CONDITION GROUP EXPAND-ENV FILE KEYBINDING)
1603
1604 Within these, only TEMPLATE is actually mandatory.
1605
1606 All the elelements are strings, including CONDITION, EXPAND-ENV
1607 and KEYBINDING which will be `read' and eventually `eval'-ed.
1608
1609 FILE is probably of very little use if you're programatically
1610 defining snippets.
1611
1612 You can use `yas/parse-template' to return such lists based on
1613 the current buffers contents.
1614
1615 Optional PARENT-MODE can be used to specify the parent tables of
1616 MODE. It can be a mode symbol of a list of mode symbols. It does
1617 not need to be a real mode."
1618 (let ((snippet-table (yas/snippet-table-get-create mode))
1619 (parent-tables (mapcar #'yas/snippet-table-get-create
1620 (if (listp parent-mode)
1621 parent-mode
1622 (list parent-mode))))
1623 (keymap (if yas/use-menu
1624 (yas/menu-keymap-get-create mode)
1625 nil)))
1626 ;; Setup the menu
1627 ;;
1628 (when parent-tables
1629 (setf (yas/snippet-table-parents snippet-table)
1630 parent-tables)
1631 (when yas/use-menu
1632 (let ((parent-menu-syms-and-names
1633 (if (listp parent-mode)
1634 (mapcar #'(lambda (sym)
1635 (cons sym (concat "parent mode - " (symbol-name sym))))
1636 parent-mode)
1637 '((parent-mode . "parent mode")))))
1638 (mapc #'(lambda (sym-and-name)
1639 (define-key keymap
1640 (vector (intern (replace-regexp-in-string " " "_" (cdr sym-and-name))))
1641 (list 'menu-item (cdr sym-and-name)
1642 (yas/menu-keymap-get-create (car sym-and-name)))))
1643 (reverse parent-menu-syms-and-names)))))
1644 (when yas/use-menu
1645 (define-key yas/minor-mode-menu (vector mode)
1646 `(menu-item ,(symbol-name mode) ,keymap
1647 :visible (yas/show-menu-p ',mode))))
1648 ;; Iterate the recently parsed snippets definition
1649 ;;
1650 (dolist (snippet snippets)
1651 (let* ((file (seventh snippet))
1652 (key (or (car snippet)
1653 (unless yas/ignore-filenames-as-triggers
1654 (and file
1655 (file-name-sans-extension (file-name-nondirectory file))))))
1656 (name (or (third snippet)
1657 (and file
1658 (file-name-directory file))))
1659 (condition (fourth snippet))
1660 (group (fifth snippet))
1661 (keybinding (eighth snippet))
1662 (template nil))
1663 ;; Read the snippet's "binding :" expression
1664 ;;
1665 (condition-case err
1666 (when keybinding
1667 (setq keybinding (read (eighth snippet)))
1668 (let* ((this-mode-map-symbol (intern (concat (symbol-name mode) "-map")))
1669 (keys (or (and (consp keybinding)
1670 (read-kbd-macro (cdr keybinding)))
1671 (read-kbd-macro keybinding)))
1672 (keymap-symbol (or (and (consp keybinding)
1673 (car keybinding))
1674 this-mode-map-symbol)))
1675 (if (and (boundp keymap-symbol)
1676 (keymapp (symbol-value keymap-symbol)))
1677 (setq keybinding (list keymap-symbol
1678 keys
1679 name))
1680 (error (format "keymap \"%s\" does not (yet?) exist" keymap-symbol)))))
1681 (error
1682 (message "[yas] warning: keybinding \"%s\" invalid for snippet \"%s\" since %s."
1683 keybinding name (error-message-string err))
1684 (setf keybinding nil)))
1685
1686 ;; Create the `yas/template' object and store in the
1687 ;; appropriate snippet table. This only done if we have found
1688 ;; a key and a name for the snippet, because that is what
1689 ;; indexes the snippet tables
1690 ;;
1691 (setq template (yas/make-template (second snippet)
1692 (or name key)
1693 condition
1694 (sixth snippet)
1695 (seventh snippet)
1696 keybinding))
1697 (when (and key
1698 name)
1699 (yas/store snippet-table
1700 name
1701 key
1702 template))
1703 ;; If we have a keybinding, register it if it does not
1704 ;; conflict!
1705 ;;
1706 (when keybinding
1707 (let ((lookup (lookup-key (symbol-value (first keybinding)) (second keybinding))))
1708 (if (and lookup
1709 (not (numberp lookup)))
1710 (message "[yas] warning: won't overwrite keybinding \"%s\" for snippet \"%s\" in `%s'"
1711 (key-description (second keybinding)) name (first keybinding))
1712 (define-key
1713 (symbol-value (first keybinding))
1714 (second keybinding)
1715 `(lambda (&optional yas/prefix)
1716 (interactive "P")
1717 (when (yas/template-can-expand-p ,(yas/template-condition template))
1718 (yas/expand-snippet ,(yas/template-content template)
1719 nil
1720 nil
1721 ,(yas/template-expand-env template)))))
1722 (add-to-list 'yas/active-keybindings keybinding))))
1723
1724 ;; Setup the menu groups, reorganizing from group to group if
1725 ;; necessary
1726 ;;
1727 (when yas/use-menu
1728 (let ((group-keymap keymap))
1729 ;; Delete this entry from another group if already exists
1730 ;; in some other group. An entry is considered as existing
1731 ;; in another group if its name string-matches.
1732 ;;
1733 (yas/delete-from-keymap group-keymap name)
1734
1735 ;; ... then add this entry to the correct group
1736 (when (and (not (null group))
1737 (not (string= "" group)))
1738 (dolist (subgroup (mapcar #'make-symbol
1739 (split-string group "\\.")))
1740 (let ((subgroup-keymap (lookup-key group-keymap
1741 (vector subgroup))))
1742 (when (null subgroup-keymap)
1743 (setq subgroup-keymap (make-sparse-keymap))
1744 (define-key group-keymap (vector subgroup)
1745 `(menu-item ,(symbol-name subgroup)
1746 ,subgroup-keymap)))
1747 (setq group-keymap subgroup-keymap))))
1748 (define-key group-keymap (vector (gensym))
1749 `(menu-item ,(yas/template-name template)
1750 ,(yas/make-menu-binding template)
1751 :help ,name
1752 :keys ,(when (and key name)
1753 (concat key yas/trigger-symbol))))))))))
1754
1755 (defun yas/show-menu-p (mode)
1756 (cond ((eq yas/use-menu 'abbreviate)
1757 (find mode
1758 (mapcar #'(lambda (table)
1759 (intern (yas/snippet-table-name table)))
1760 (yas/get-snippet-tables))))
1761 ((eq yas/use-menu 'real-modes)
1762 (yas/real-mode? mode))
1763 (t
1764 t)))
1765
1766 (defun yas/delete-from-keymap (keymap name)
1767 "Recursively delete items name NAME from KEYMAP and its submenus.
1768
1769 Skip any submenus named \"parent mode\""
1770 ;; First of all, recursively enter submenus, i.e. the tree is
1771 ;; searched depth first so that stale submenus can be found in the
1772 ;; higher passes.
1773 ;;
1774 (mapc #'(lambda (item)
1775 (when (and (keymapp (fourth item))
1776 (stringp (third item))
1777 (not (string-match "parent mode" (third item))))
1778 (yas/delete-from-keymap (fourth item) name)))
1779 (rest keymap))
1780 ;;
1781 (when (keymapp keymap)
1782 (let ((pos-in-keymap))
1783 (while (setq pos-in-keymap
1784 (position-if #'(lambda (item)
1785 (and (listp item)
1786 (or
1787 ;; the menu item we want to delete
1788 (and (eq 'menu-item (second item))
1789 (third item)
1790 (and (string= (third item) name)))
1791 ;; a stale subgroup
1792 (and (keymapp (fourth item))
1793 (not (and (stringp (third item))
1794 (string-match "parent mode"
1795 (third item))))
1796 (null (rest (fourth item)))))))
1797 keymap))
1798 (setf (nthcdr pos-in-keymap keymap)
1799 (nthcdr (+ 1 pos-in-keymap) keymap))))))
1800
1801 (defun yas/define (mode key template &optional name condition group)
1802 "Define a snippet. Expanding KEY into TEMPLATE.
1803
1804 NAME is a description to this template. Also update the menu if
1805 `yas/use-menu' is `t'. CONDITION is the condition attached to
1806 this snippet. If you attach a condition to a snippet, then it
1807 will only be expanded when the condition evaluated to non-nil."
1808 (yas/define-snippets mode
1809 (list (list key template name condition group))))
1810
1811 (defun yas/hippie-try-expand (first-time?)
1812 "Integrate with hippie expand. Just put this function in
1813 `hippie-expand-try-functions-list'."
1814 (if (not first-time?)
1815 (let ((yas/fallback-behavior 'return-nil))
1816 (yas/expand))
1817 (undo 1)
1818 nil))
1819
1820 (defun yas/expand ()
1821 "Expand a snippet before point.
1822
1823 If no snippet expansion is possible, fall back to the behaviour
1824 defined in `yas/fallback-behavior'"
1825 (interactive)
1826 (yas/expand-1))
1827
1828 (defun yas/expand-1 (&optional field)
1829 "Actually fo the work for `yas/expand'"
1830 (multiple-value-bind (templates start end) (if field
1831 (save-restriction
1832 (narrow-to-region (yas/field-start field) (yas/field-end field))
1833 (yas/current-key))
1834 (yas/current-key))
1835 (if templates
1836 (let ((template (or (and (rest templates) ;; more than one
1837 (yas/prompt-for-template (mapcar #'cdr templates)))
1838 (cdar templates))))
1839 (when template
1840 (yas/expand-snippet (yas/template-content template)
1841 start
1842 end
1843 (yas/template-expand-env template))))
1844 (cond ((eq yas/fallback-behavior 'return-nil)
1845 ;; return nil
1846 nil)
1847 ((eq yas/fallback-behavior 'call-other-command)
1848 (let* ((yas/minor-mode nil)
1849 (keys (or (and yas/trigger-key
1850 (stringp yas/trigger-key)
1851 (read-kbd-macro yas/trigger-key))
1852 (this-command-keys-vector)))
1853 (command (key-binding keys)))
1854 (when (and (commandp command)
1855 (not (eq 'yas/expand command)))
1856 (setq this-command command)
1857 (call-interactively command))))
1858 ((and (listp yas/fallback-behavior)
1859 (cdr yas/fallback-behavior)
1860 (eq 'apply (car yas/fallback-behavior)))
1861 (if (cddr yas/fallback-behavior)
1862 (apply (cadr yas/fallback-behavior)
1863 (cddr yas/fallback-behavior))
1864 (when (commandp (cadr yas/fallback-behavior))
1865 (setq this-command (cadr yas/fallback-behavior))
1866 (call-interactively (cadr yas/fallback-behavior)))))
1867 (t
1868 ;; also return nil if all the other fallbacks have failed
1869 nil)))))
1870
1871 \f
1872 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1873 ;;; Snippet development
1874
1875 (defun yas/all-templates (tables)
1876 "Return all snippet tables applicable for the current buffer.
1877
1878 Honours `yas/choose-tables-first', `yas/choose-keys-first' and
1879 `yas/buffer-local-condition'"
1880 (when yas/choose-tables-first
1881 (setq tables (list (yas/prompt-for-table tables))))
1882 (mapcar #'cdr
1883 (if yas/choose-keys-first
1884 (let ((key (yas/prompt-for-keys
1885 (mapcan #'yas/snippet-table-all-keys tables))))
1886 (when key
1887 (mapcan #'(lambda (table)
1888 (yas/fetch table key))
1889 tables)))
1890 (mapcan #'yas/snippet-table-templates tables))))
1891
1892 (defun yas/insert-snippet (&optional no-condition)
1893 "Choose a snippet to expand, pop-up a list of choices according
1894 to `yas/prompt-function'.
1895
1896 With prefix argument NO-CONDITION, bypass filtering of snippets
1897 by condition."
1898 (interactive "P")
1899 (let* ((yas/buffer-local-condition (or (and no-condition
1900 'always)
1901 yas/buffer-local-condition))
1902 (templates (yas/all-templates (yas/get-snippet-tables)))
1903 (template (and templates
1904 (or (and (rest templates) ;; more than one template for same key
1905 (yas/prompt-for-template templates))
1906 (car templates))))
1907 (where (if mark-active
1908 (cons (region-beginning) (region-end))
1909 (cons (point) (point)))))
1910 (if template
1911 (yas/expand-snippet (yas/template-content template)
1912 (car where)
1913 (cdr where)
1914 (yas/template-expand-env template))
1915 (message "[yas] No snippets can be inserted here!"))))
1916
1917 (defun yas/visit-snippet-file ()
1918 "Choose a snippet to edit, selection like `yas/insert-snippet'.
1919
1920 Only success if selected snippet was loaded from a file. Put the
1921 visited file in `snippet-mode'."
1922 (interactive)
1923 (let* ((yas/buffer-local-condition 'always)
1924 (templates (yas/all-templates (yas/get-snippet-tables)))
1925 (template (and templates
1926 (or (and (rest templates) ;; more than one template for same key
1927 (yas/prompt-for-template templates
1928 "Choose a snippet template to edit: "))
1929 (car templates)))))
1930
1931 (when template
1932 (yas/visit-snippet-file-1 template))))
1933
1934 (defun yas/visit-snippet-file-1 (template)
1935 (let ((file (yas/template-file template)))
1936 (cond ((and file (file-exists-p file))
1937 (find-file-other-window file)
1938 (snippet-mode))
1939 (file
1940 (message "Original file %s no longer exists!" file))
1941 (t
1942 (message "This snippet was not loaded from a file!")))))
1943
1944 (defun yas/guess-snippet-directories-1 (table &optional suffix)
1945 "Guesses possible snippet subdirsdirectories for TABLE."
1946 (unless suffix
1947 (setq suffix (yas/snippet-table-name table)))
1948 (cons suffix
1949 (mapcan #'(lambda (parent)
1950 (yas/guess-snippet-directories-1
1951 parent
1952 (concat (yas/snippet-table-name parent) "/" suffix)))
1953 (yas/snippet-table-parents table))))
1954
1955 (defun yas/guess-snippet-directories ()
1956 "Try to guess suitable directories based on the current active
1957 tables.
1958
1959 Returns a a list of options alist TABLE -> DIRS where DIRS are
1960 all the possibly directories where snippets of table might be
1961 lurking."
1962 (let ((main-dir (or (and (listp yas/root-directory)
1963 (first yas/root-directory))
1964 yas/root-directory
1965 (setq yas/root-directory "~/.emacs.d/snippets")))
1966 (tables (yas/get-snippet-tables)))
1967 ;; HACK! the snippet table created here is a dummy table that
1968 ;; holds the correct name so that `yas/make-directory-maybe' can
1969 ;; work. The real table, if it does not exist in
1970 ;; yas/snippet-tables will be created when the first snippet for
1971 ;; that mode is loaded.
1972 ;;
1973 (unless (gethash major-mode yas/snippet-tables)
1974 (setq tables (cons (yas/make-snippet-table (symbol-name major-mode))
1975 tables)))
1976
1977 (mapcar #'(lambda (table)
1978 (cons table
1979 (mapcar #'(lambda (subdir)
1980 (concat main-dir "/" subdir))
1981 (yas/guess-snippet-directories-1 table))))
1982 tables)))
1983
1984 (defun yas/make-directory-maybe (table-and-dirs &optional main-table-string)
1985 "Returns a dir inside TABLE-AND-DIRS, prompts for creation if none exists."
1986 (or (some #'(lambda (dir) (when (file-directory-p dir) dir)) (cdr table-and-dirs))
1987 (let ((candidate (first (cdr table-and-dirs))))
1988 (if (y-or-n-p (format "Guessed directory (%s) for%s%s table \"%s\" does not exist! Create? "
1989 candidate
1990 (if (gethash (intern (yas/snippet-table-name (car table-and-dirs)))
1991 yas/snippet-tables)
1992 ""
1993 " brand new")
1994 (or main-table-string
1995 "")
1996 (yas/snippet-table-name (car table-and-dirs))))
1997 (progn
1998 (make-directory candidate 'also-make-parents)
1999 ;; create the .yas-parents file here...
2000 candidate)))))
2001
2002 (defun yas/new-snippet (&optional choose-instead-of-guess)
2003 ""
2004 (interactive "P")
2005 (let* ((guessed-directories (yas/guess-snippet-directories))
2006 (option (or (and choose-instead-of-guess
2007 (some #'(lambda (fn)
2008 (funcall fn "Choose a snippet table: "
2009 guessed-directories
2010 #'(lambda (option)
2011 (yas/snippet-table-name (car option)))))
2012 yas/prompt-functions))
2013 (first guessed-directories)))
2014 (chosen))
2015 (setq chosen (yas/make-directory-maybe option (unless choose-instead-of-guess
2016 " main")))
2017 (unless (or chosen
2018 choose-instead-of-guess)
2019 (if (y-or-n-p (format "Continue guessing for other active tables %s? "
2020 (mapcar #'(lambda (table-and-dirs)
2021 (yas/snippet-table-name (car table-and-dirs)))
2022 (rest guessed-directories))))
2023 (setq chosen (some #'yas/make-directory-maybe
2024 (rest guessed-directories)))))
2025 (unless (or chosen
2026 choose-instead-of-guess)
2027 (when (y-or-n-p "Having trouble... use snippet root dir? ")
2028 (setq chosen (if (listp yas/root-directory)
2029 (first yas/root-directory)
2030 yas/root-directory))))
2031 (if chosen
2032 (let ((default-directory chosen)
2033 (name (read-from-minibuffer "Enter a snippet name: ")))
2034 (find-file-other-window (concat name
2035 ".yasnippet"))
2036 (snippet-mode)
2037 (unless (and choose-instead-of-guess
2038 (not (y-or-n-p "Insert a snippet with useful headers? ")))
2039 (yas/expand-snippet (format
2040 "\
2041 # -*- mode: snippet -*-
2042 # name: %s
2043 # key: $1${2:
2044 # binding: \"${3:keybinding}\"}${4:
2045 # expand-env: ((${5:some-var} ${6:some-value}))}
2046 # --
2047 $0" name))))
2048 (message "[yas] aborted snippet creation."))))
2049
2050 (defun yas/find-snippets (&optional same-window )
2051 "Look for user snippets in guessed current mode's directory.
2052
2053 Calls `find-file' interactively in the guessed directory.
2054
2055 With prefix arg SAME-WINDOW opens the buffer in the same window.
2056
2057 Because snippets can be loaded from many different locations,
2058 this has to guess the correct directory using
2059 `yas/guess-snippet-directories', which returns a list of
2060 options.
2061
2062 If any one of these exists, it is taken and `find-file' is called
2063 there, otherwise, proposes to create the first option returned by
2064 `yas/guess-snippet-directories'."
2065 (interactive "P")
2066 (let* ((guessed-directories (yas/guess-snippet-directories))
2067 (chosen)
2068 (buffer))
2069 (setq chosen (yas/make-directory-maybe (first guessed-directories) " main"))
2070 (unless chosen
2071 (if (y-or-n-p (format "Continue guessing for other active tables %s? "
2072 (mapcar #'(lambda (table-and-dirs)
2073 (yas/snippet-table-name (car table-and-dirs)))
2074 (rest guessed-directories))))
2075 (setq chosen (some #'yas/make-directory-maybe
2076 (rest guessed-directories)))))
2077 (unless chosen
2078 (when (y-or-n-p "Having trouble... go to snippet root dir? ")
2079 (setq chosen (if (listp yas/root-directory)
2080 (first yas/root-directory)
2081 yas/root-directory))))
2082 (if chosen
2083 (let ((default-directory chosen))
2084 (setq buffer (call-interactively (if same-window
2085 'find-file
2086 'find-file-other-window)))
2087 (when buffer
2088 (save-excursion
2089 (set-buffer buffer)
2090 (when (eq major-mode 'fundamental-mode)
2091 (snippet-mode)))))
2092 (message "Could not guess snippet dir!"))))
2093
2094 (defun yas/compute-major-mode-and-parents (file &optional prompt-if-failed no-hierarchy-parents)
2095 (let* ((file-dir (and file
2096 (directory-file-name (or (locate-dominating-file file ".yas-make-groups")
2097 (directory-file-name (file-name-directory file))))))
2098 (major-mode-name (and file-dir
2099 (file-name-nondirectory file-dir)))
2100 (parent-file-dir (and file-dir
2101 (directory-file-name (file-name-directory file-dir))))
2102 (parent-mode-name (and parent-file-dir
2103 (not no-hierarchy-parents)
2104 (file-name-nondirectory parent-file-dir)))
2105 (major-mode-sym (or (and major-mode-name
2106 (intern major-mode-name))
2107 (when prompt-if-failed
2108 (read-from-minibuffer
2109 "[yas] Cannot auto-detect major mode! Enter a major mode: "))))
2110 (parent-mode-sym (and parent-mode-name
2111 (intern parent-mode-name)))
2112 (extra-parents-file-name (concat file-dir "/.yas-parents"))
2113 (more-parents (when (file-readable-p extra-parents-file-name)
2114 (mapcar #'intern
2115 (split-string
2116 (with-temp-buffer
2117 (insert-file-contents extra-parents-file-name)
2118 (buffer-substring-no-properties (point-min)
2119 (point-max))))))))
2120 (when major-mode-sym
2121 (remove nil (append (list major-mode-sym parent-mode-sym)
2122 more-parents)))))
2123
2124 (defun yas/load-snippet-buffer (&optional kill)
2125 "Parse and load current buffer's snippet definition.
2126
2127 With optional prefix argument KILL quit the window and buffer."
2128 (interactive "P")
2129 (if buffer-file-name
2130 (let ((major-mode-and-parent (yas/compute-major-mode-and-parents buffer-file-name)))
2131 (if major-mode-and-parent
2132 (let* ((parsed (yas/parse-template buffer-file-name))
2133 (name (and parsed
2134 (third parsed))))
2135 (when name
2136 (let ((yas/better-guess-for-replacements t))
2137 (yas/define-snippets (car major-mode-and-parent)
2138 (list parsed)
2139 (cdr major-mode-and-parent)))
2140 (when (and (buffer-modified-p)
2141 (y-or-n-p "Save snippet? "))
2142 (save-buffer))
2143 (if kill
2144 (quit-window kill)
2145 (message "[yas] Snippet \"%s\" loaded for %s."
2146 name
2147 (car major-mode-and-parent)))))
2148 (message "[yas] Cannot load snippet for unknown major mode")))
2149 (message "Save the buffer as a file first!")))
2150
2151 (defun yas/tryout-snippet (&optional debug)
2152 "Test current buffers's snippet template in other buffer."
2153 (interactive "P")
2154 (let* ((major-mode-and-parent (yas/compute-major-mode-and-parents buffer-file-name))
2155 (parsed (yas/parse-template))
2156 (test-mode (or (and (car major-mode-and-parent)
2157 (fboundp (car major-mode-and-parent))
2158 (car major-mode-and-parent))
2159 (intern (read-from-minibuffer "[yas] please input a mode: "))))
2160 (template (and parsed
2161 (fboundp test-mode)
2162 (yas/make-template (second parsed)
2163 (third parsed)
2164 nil
2165 (sixth parsed)
2166 nil
2167 nil))))
2168 (cond (template
2169 (let ((buffer-name (format "*YAS TEST: %s*" (yas/template-name template))))
2170 (set-buffer (switch-to-buffer buffer-name))
2171 (erase-buffer)
2172 (setq buffer-undo-list nil)
2173 (funcall test-mode)
2174 (yas/expand-snippet (yas/template-content template)
2175 (point-min)
2176 (point-max)
2177 (yas/template-expand-env template))
2178 (when debug
2179 (add-hook 'post-command-hook 'yas/debug-snippet-vars 't 'local))))
2180 (t
2181 (message "[yas] Cannot test snippet for unknown major mode")))))
2182
2183 \f
2184 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2185 ;;; User convenience functions, for using in snippet definitions
2186
2187 (defvar yas/modified-p nil
2188 "Non-nil if field has been modified by user or transformation.")
2189
2190 (defvar yas/moving-away-p nil
2191 "Non-nil if user is about to exit field.")
2192
2193 (defvar yas/text nil
2194 "Contains current field text.")
2195
2196 (defun yas/substr (str pattern &optional subexp)
2197 "Search PATTERN in STR and return SUBEXPth match.
2198
2199 If found, the content of subexp group SUBEXP (default 0) is
2200 returned, or else the original STR will be returned."
2201 (let ((grp (or subexp 0)))
2202 (save-match-data
2203 (if (string-match pattern str)
2204 (match-string-no-properties grp str)
2205 str))))
2206
2207 (defun yas/choose-value (possibilities)
2208 "Prompt for a string in the list POSSIBILITIES and return it."
2209 (unless (or yas/moving-away-p
2210 yas/modified-p)
2211 (some #'(lambda (fn)
2212 (funcall fn "Choose: " possibilities))
2213 yas/prompt-functions)))
2214
2215 (defun yas/key-to-value (alist)
2216 "Prompt for a string in the list POSSIBILITIES and return it."
2217 (unless (or yas/moving-away-p
2218 yas/modified-p)
2219 (let ((key (read-key-sequence "")))
2220 (when (stringp key)
2221 (or (cdr (find key alist :key #'car :test #'string=))
2222 key)))))
2223
2224 (defun yas/throw (text)
2225 "Throw a yas/exception with TEXT as the reason."
2226 (throw 'yas/exception (cons 'yas/exception text)))
2227
2228 (defun yas/verify-value (possibilities)
2229 "Verify that the current field value is in POSSIBILITIES
2230
2231 Otherwise throw exception."
2232 (when (and yas/moving-away-p (notany #'(lambda (pos) (string= pos yas/text)) possibilities))
2233 (yas/throw (format "[yas] field only allows %s" possibilities))))
2234
2235 (defun yas/field-value (number)
2236 (let* ((snippet (car (yas/snippets-at-point)))
2237 (field (and snippet
2238 (yas/snippet-find-field snippet number))))
2239 (when field
2240 (yas/field-text-for-display field))))
2241
2242 (defun yas/default-from-field (number)
2243 (unless yas/modified-p
2244 (yas/field-value number)))
2245
2246 (defun yas/inside-string ()
2247 (equal 'font-lock-string-face (get-char-property (1- (point)) 'face)))
2248
2249 \f
2250 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2251 ;;; Snippet expansion and field management
2252
2253 (defvar yas/active-field-overlay nil
2254 "Overlays the currently active field.")
2255
2256 (defvar yas/field-protection-overlays nil
2257 "Two overlays protect the current active field ")
2258
2259 (defconst yas/prefix nil
2260 "A prefix argument for expansion direct from keybindings")
2261
2262 (defvar yas/deleted-text nil
2263 "The text deleted in the last snippet expansion.")
2264
2265 (defvar yas/selected-text nil
2266 "The selected region deleted on the last snippet expansion.")
2267
2268 (defvar yas/start-column nil
2269 "The column where the snippet expansion started.")
2270
2271 (make-variable-buffer-local 'yas/active-field-overlay)
2272 (make-variable-buffer-local 'yas/field-protection-overlays)
2273 (make-variable-buffer-local 'yas/deleted-text)
2274
2275 (defstruct (yas/snippet (:constructor yas/make-snippet ()))
2276 "A snippet.
2277
2278 ..."
2279 (fields '())
2280 (exit nil)
2281 (id (yas/snippet-next-id) :read-only t)
2282 (control-overlay nil)
2283 active-field
2284 ;; stacked expansion: the `previous-active-field' slot saves the
2285 ;; active field where the child expansion took place
2286 previous-active-field
2287 force-exit)
2288
2289 (defstruct (yas/field (:constructor yas/make-field (number start end parent-field)))
2290 "A field."
2291 number
2292 start end
2293 parent-field
2294 (mirrors '())
2295 (transform nil)
2296 (modified-p nil)
2297 next)
2298
2299 (defstruct (yas/mirror (:constructor yas/make-mirror (start end transform)))
2300 "A mirror."
2301 start end
2302 (transform nil)
2303 next)
2304
2305 (defstruct (yas/exit (:constructor yas/make-exit (marker)))
2306 marker
2307 next)
2308
2309 (defun yas/apply-transform (field-or-mirror field)
2310 "Calculate the value of the field/mirror. If there's a transform
2311 for this field, apply it. Otherwise, returned nil."
2312 (let* ((yas/text (yas/field-text-for-display field))
2313 (text yas/text)
2314 (yas/modified-p (yas/field-modified-p field))
2315 (yas/moving-away-p nil)
2316 (transform (if (yas/mirror-p field-or-mirror)
2317 (yas/mirror-transform field-or-mirror)
2318 (yas/field-transform field-or-mirror)))
2319 (start-point (if (yas/mirror-p field-or-mirror)
2320 (yas/mirror-start field-or-mirror)
2321 (yas/field-start field-or-mirror)))
2322 (transformed (and transform
2323 (save-excursion
2324 (goto-char start-point)
2325 (yas/read-and-eval-string transform)))))
2326 transformed))
2327
2328 (defsubst yas/replace-all (from to &optional text)
2329 "Replace all occurance from FROM to TO.
2330
2331 With optional string TEXT do it in that string."
2332 (if text
2333 (replace-regexp-in-string (regexp-quote from) to text t t)
2334 (goto-char (point-min))
2335 (while (search-forward from nil t)
2336 (replace-match to t t text))))
2337
2338 (defun yas/snippet-find-field (snippet number)
2339 (find-if #'(lambda (field)
2340 (eq number (yas/field-number field)))
2341 (yas/snippet-fields snippet)))
2342
2343 (defun yas/snippet-sort-fields (snippet)
2344 "Sort the fields of SNIPPET in navigation order."
2345 (setf (yas/snippet-fields snippet)
2346 (sort (yas/snippet-fields snippet)
2347 '(lambda (field1 field2)
2348 (yas/snippet-field-compare field1 field2)))))
2349
2350 (defun yas/snippet-field-compare (field1 field2)
2351 "Compare two fields. The field with a number is sorted first.
2352 If they both have a number, compare through the number. If neither
2353 have, compare through the field's start point"
2354 (let ((n1 (yas/field-number field1))
2355 (n2 (yas/field-number field2)))
2356 (if n1
2357 (if n2
2358 (< n1 n2)
2359 t)
2360 (if n2
2361 nil
2362 (< (yas/field-start field1)
2363 (yas/field-start field2))))))
2364
2365 (defun yas/field-probably-deleted-p (snippet field)
2366 "Guess if SNIPPET's FIELD should be skipped."
2367 (and (zerop (- (yas/field-start field) (yas/field-end field)))
2368 (or (yas/field-parent-field field)
2369 (and (eq field (car (last (yas/snippet-fields snippet))))
2370 (= (yas/field-start field) (overlay-end (yas/snippet-control-overlay snippet)))))))
2371
2372 (defun yas/snippets-at-point (&optional all-snippets)
2373 "Return a sorted list of snippets at point, most recently
2374 inserted first."
2375 (sort
2376 (remove nil (remove-duplicates (mapcar #'(lambda (ov)
2377 (overlay-get ov 'yas/snippet))
2378 (if all-snippets
2379 (overlays-in (point-min) (point-max))
2380 (overlays-at (point))))))
2381 #'(lambda (s1 s2)
2382 (<= (yas/snippet-id s2) (yas/snippet-id s1)))))
2383
2384 (defun yas/next-field-or-maybe-expand ()
2385 "Try to expand a snippet at a key before point, otherwise
2386 delegate to `yas/next-field'."
2387 (interactive)
2388 (if yas/triggers-in-field
2389 (let ((yas/fallback-behavior 'return-nil)
2390 (active-field (overlay-get yas/active-field-overlay 'yas/field)))
2391 (when active-field
2392 (unless (yas/expand-1 active-field)
2393 (yas/next-field))))
2394 (yas/next-field)))
2395
2396 (defun yas/next-field (&optional arg)
2397 "Navigate to next field. If there's none, exit the snippet."
2398 (interactive)
2399 (let* ((arg (or arg
2400 1))
2401 (snippet (first (yas/snippets-at-point)))
2402 (active-field (overlay-get yas/active-field-overlay 'yas/field))
2403 (live-fields (remove-if #'(lambda (field)
2404 (and (not (eq field active-field))
2405 (yas/field-probably-deleted-p snippet field)))
2406 (yas/snippet-fields snippet)))
2407 (active-field-pos (position active-field live-fields))
2408 (target-pos (and active-field-pos (+ arg active-field-pos)))
2409 (target-field (nth target-pos live-fields)))
2410 ;; First check if we're moving out of a field with a transform
2411 ;;
2412 (when (and active-field
2413 (yas/field-transform active-field))
2414 (let* ((yas/moving-away-p t)
2415 (yas/text (yas/field-text-for-display active-field))
2416 (text yas/text)
2417 (yas/modified-p (yas/field-modified-p active-field)))
2418 ;;; primary field transform: exit call to field-transform
2419 (yas/read-and-eval-string (yas/field-transform active-field))))
2420 ;; Now actually move...
2421 (cond ((>= target-pos (length live-fields))
2422 (yas/exit-snippet snippet))
2423 (target-field
2424 (yas/move-to-field snippet target-field))
2425 (t
2426 nil))))
2427
2428 (defun yas/place-overlays (snippet field)
2429 "Correctly place overlays for SNIPPET's FIELD"
2430 (yas/make-move-field-protection-overlays snippet field)
2431 (yas/make-move-active-field-overlay snippet field))
2432
2433 (defun yas/move-to-field (snippet field)
2434 "Update SNIPPET to move to field FIELD.
2435
2436 Also create some protection overlays"
2437 (goto-char (yas/field-start field))
2438 (setf (yas/snippet-active-field snippet) field)
2439 (yas/place-overlays snippet field)
2440 (overlay-put yas/active-field-overlay 'yas/field field)
2441 ;;; primary field transform: first call to snippet transform
2442 (unless (yas/field-modified-p field)
2443 (if (yas/field-update-display field snippet)
2444 (let ((inhibit-modification-hooks t))
2445 (yas/update-mirrors snippet))
2446 (setf (yas/field-modified-p field) nil))))
2447
2448 (defun yas/prev-field ()
2449 "Navigate to prev field. If there's none, exit the snippet."
2450 (interactive)
2451 (yas/next-field -1))
2452
2453 (defun yas/abort-snippet (&optional snippet)
2454 (interactive)
2455 (let ((snippet (or snippet
2456 (car (yas/snippets-at-point)))))
2457 (when snippet
2458 (setf (yas/snippet-force-exit snippet) t))))
2459
2460 (defun yas/exit-snippet (snippet)
2461 "Goto exit-marker of SNIPPET."
2462 (interactive)
2463 (setf (yas/snippet-force-exit snippet) t)
2464 (goto-char (if (yas/snippet-exit snippet)
2465 (yas/exit-marker (yas/snippet-exit snippet))
2466 (overlay-end (yas/snippet-control-overlay snippet)))))
2467
2468 (defun yas/exit-all-snippets ()
2469 "Exit all snippets."
2470 (interactive)
2471 (mapc #'(lambda (snippet)
2472 (yas/exit-snippet snippet)
2473 (yas/check-commit-snippet))
2474 (yas/snippets-at-point)))
2475
2476 \f
2477 ;;; Apropos markers-to-points:
2478 ;;;
2479 ;;; This was found useful for performance reasons, so that an
2480 ;;; excessive number of live markers aren't kept around in the
2481 ;;; `buffer-undo-list'. However, in `markers-to-points', the
2482 ;;; set-to-nil markers can't simply be discarded and replaced with
2483 ;;; fresh ones in `points-to-markers'. The original marker that was
2484 ;;; just set to nil has to be reused.
2485 ;;;
2486 ;;; This shouldn't bring horrible problems with undo/redo, but it
2487 ;;; you never know
2488 ;;;
2489
2490 (defun yas/markers-to-points (snippet)
2491 "Convert all markers in SNIPPET to a cons (POINT . MARKER)
2492 where POINT is the original position of the marker and MARKER is
2493 the original marker object with the position set to nil."
2494 (dolist (field (yas/snippet-fields snippet))
2495 (let ((start (marker-position (yas/field-start field)))
2496 (end (marker-position (yas/field-end field))))
2497 (set-marker (yas/field-start field) nil)
2498 (set-marker (yas/field-end field) nil)
2499 (setf (yas/field-start field) (cons start (yas/field-start field)))
2500 (setf (yas/field-end field) (cons end (yas/field-end field))))
2501 (dolist (mirror (yas/field-mirrors field))
2502 (let ((start (marker-position (yas/mirror-start mirror)))
2503 (end (marker-position (yas/mirror-end mirror))))
2504 (set-marker (yas/mirror-start mirror) nil)
2505 (set-marker (yas/mirror-end mirror) nil)
2506 (setf (yas/mirror-start mirror) (cons start (yas/mirror-start mirror)))
2507 (setf (yas/mirror-end mirror) (cons end (yas/mirror-end mirror))))))
2508 (let ((snippet-exit (yas/snippet-exit snippet)))
2509 (when snippet-exit
2510 (let ((exit (marker-position (yas/exit-marker snippet-exit))))
2511 (set-marker (yas/exit-marker snippet-exit) nil)
2512 (setf (yas/exit-marker snippet-exit) (cons exit (yas/exit-marker snippet-exit)))))))
2513
2514 (defun yas/points-to-markers (snippet)
2515 "Convert all cons (POINT . MARKER) in SNIPPET to markers. This
2516 is done by setting MARKER to POINT with `set-marker'."
2517 (dolist (field (yas/snippet-fields snippet))
2518 (setf (yas/field-start field) (set-marker (cdr (yas/field-start field))
2519 (car (yas/field-start field))))
2520 (setf (yas/field-end field) (set-marker (cdr (yas/field-end field))
2521 (car (yas/field-end field))))
2522 (dolist (mirror (yas/field-mirrors field))
2523 (setf (yas/mirror-start mirror) (set-marker (cdr (yas/mirror-start mirror))
2524 (car (yas/mirror-start mirror))))
2525 (setf (yas/mirror-end mirror) (set-marker (cdr (yas/mirror-end mirror))
2526 (car (yas/mirror-end mirror))))))
2527 (let ((snippet-exit (yas/snippet-exit snippet)))
2528 (when snippet-exit
2529 (setf (yas/exit-marker snippet-exit) (set-marker (cdr (yas/exit-marker snippet-exit))
2530 (car (yas/exit-marker snippet-exit)))))))
2531
2532 (defun yas/commit-snippet (snippet &optional no-hooks)
2533 "Commit SNIPPET, but leave point as it is. This renders the
2534 snippet as ordinary text.
2535
2536 Return a buffer position where the point should be placed if
2537 exiting the snippet.
2538
2539 NO-HOOKS means don't run the `yas/after-exit-snippet-hook' hooks."
2540
2541 (let ((control-overlay (yas/snippet-control-overlay snippet))
2542 yas/snippet-beg
2543 yas/snippet-end)
2544 ;;
2545 ;; Save the end of the moribund snippet in case we need to revive it
2546 ;; its original expansion.
2547 ;;
2548 (when (and control-overlay
2549 (overlay-buffer control-overlay))
2550 (setq yas/snippet-beg (overlay-start control-overlay))
2551 (setq yas/snippet-end (overlay-end control-overlay))
2552 (delete-overlay control-overlay))
2553
2554 (let ((inhibit-modification-hooks t))
2555 (when yas/active-field-overlay
2556 (delete-overlay yas/active-field-overlay))
2557 (when yas/field-protection-overlays
2558 (mapc #'delete-overlay yas/field-protection-overlays)))
2559
2560 ;; stacked expansion: if the original expansion took place from a
2561 ;; field, make sure we advance it here at least to
2562 ;; `yas/snippet-end'...
2563 ;;
2564 (let ((previous-field (yas/snippet-previous-active-field snippet)))
2565 (when (and yas/snippet-end previous-field)
2566 (yas/advance-end-maybe previous-field yas/snippet-end)))
2567
2568 ;; Convert all markers to points,
2569 ;;
2570 (yas/markers-to-points snippet)
2571
2572 ;; Take care of snippet revival
2573 ;;
2574 (if yas/snippet-revival
2575 (push `(apply yas/snippet-revive ,yas/snippet-beg ,yas/snippet-end ,snippet)
2576 buffer-undo-list)
2577 ;; Dismember the snippet... this is useful if we get called
2578 ;; again from `yas/take-care-of-redo'....
2579 (setf (yas/snippet-fields snippet) nil))
2580
2581 ;; XXX: `yas/after-exit-snippet-hook' should be run with
2582 ;; `yas/snippet-beg' and `yas/snippet-end' bound. That might not
2583 ;; be the case if the main overlay had somehow already
2584 ;; disappeared, which sometimes happens when the snippet's messed
2585 ;; up...
2586 ;;
2587 (unless no-hooks (run-hooks 'yas/after-exit-snippet-hook)))
2588
2589 (message "[yas] snippet exited."))
2590
2591 (defun yas/check-commit-snippet ()
2592 "Checks if point exited the currently active field of the
2593 snippet, if so cleans up the whole snippet up."
2594 (let* ((snippets (yas/snippets-at-point 'all-snippets))
2595 (snippets-left snippets))
2596 (dolist (snippet snippets)
2597 (let ((active-field (yas/snippet-active-field snippet)))
2598 (cond ((or (prog1 (yas/snippet-force-exit snippet)
2599 (setf (yas/snippet-force-exit snippet) nil))
2600 (not (and active-field (yas/field-contains-point-p active-field))))
2601 (setq snippets-left (delete snippet snippets-left))
2602 (yas/commit-snippet snippet snippets-left))
2603 ((and active-field
2604 (or (not yas/active-field-overlay)
2605 (not (overlay-buffer yas/active-field-overlay))))
2606 ;;
2607 ;; stacked expansion: this case is mainly for recent
2608 ;; snippet exits that place us back int the field of
2609 ;; another snippet
2610 ;;
2611 (save-excursion
2612 (yas/move-to-field snippet active-field)
2613 (yas/update-mirrors snippet)))
2614 (t
2615 nil))))
2616 (unless snippets-left
2617 (remove-hook 'post-command-hook 'yas/post-command-handler 'local)
2618 (remove-hook 'pre-command-hook 'yas/pre-command-handler 'local))))
2619
2620 (defun yas/field-contains-point-p (field &optional point)
2621 (let ((point (or point
2622 (point))))
2623 (and (>= point (yas/field-start field))
2624 (<= point (yas/field-end field)))))
2625
2626 (defun yas/field-text-for-display (field)
2627 "Return the propertized display text for field FIELD. "
2628 (buffer-substring (yas/field-start field) (yas/field-end field)))
2629
2630 (defun yas/undo-in-progress ()
2631 "True if some kind of undo is in progress"
2632 (or undo-in-progress
2633 (eq this-command 'undo)
2634 (eq this-command 'redo)))
2635
2636 (defun yas/make-control-overlay (snippet start end)
2637 "Creates the control overlay that surrounds the snippet and
2638 holds the keymap."
2639 (let ((overlay (make-overlay start
2640 end
2641 nil
2642 nil
2643 t)))
2644 (overlay-put overlay 'keymap yas/keymap)
2645 (overlay-put overlay 'yas/snippet snippet)
2646 overlay))
2647
2648 (defun yas/skip-and-clear-or-delete-char (&optional field)
2649 "Clears unmodified field if at field start, skips to next tab.
2650
2651 Otherwise deletes a character normally by calling `delete-char'."
2652 (interactive)
2653 (let ((field (or field
2654 (and yas/active-field-overlay
2655 (overlay-buffer yas/active-field-overlay)
2656 (overlay-get yas/active-field-overlay 'yas/field)))))
2657 (cond ((and field
2658 (not (yas/field-modified-p field))
2659 (eq (point) (marker-position (yas/field-start field))))
2660 (yas/skip-and-clear field)
2661 (yas/next-field 1))
2662 (t
2663 (call-interactively 'delete-char)))))
2664
2665 (defun yas/skip-and-clear (field)
2666 "Deletes the region of FIELD and sets it modified state to t"
2667 (setf (yas/field-modified-p field) t)
2668 (delete-region (yas/field-start field) (yas/field-end field)))
2669
2670 (defun yas/make-move-active-field-overlay (snippet field)
2671 "Place the active field overlay in SNIPPET's FIELD.
2672
2673 Move the overlay, or create it if it does not exit."
2674 (if (and yas/active-field-overlay
2675 (overlay-buffer yas/active-field-overlay))
2676 (move-overlay yas/active-field-overlay
2677 (yas/field-start field)
2678 (yas/field-end field))
2679 (setq yas/active-field-overlay
2680 (make-overlay (yas/field-start field)
2681 (yas/field-end field)
2682 nil nil t))
2683 (overlay-put yas/active-field-overlay 'face 'yas/field-highlight-face)
2684 (overlay-put yas/active-field-overlay 'yas/snippet snippet)
2685 (overlay-put yas/active-field-overlay 'modification-hooks '(yas/on-field-overlay-modification))
2686 (overlay-put yas/active-field-overlay 'insert-in-front-hooks
2687 '(yas/on-field-overlay-modification))
2688 (overlay-put yas/active-field-overlay 'insert-behind-hooks
2689 '(yas/on-field-overlay-modification))))
2690
2691 (defun yas/on-field-overlay-modification (overlay after? beg end &optional length)
2692 "Clears the field and updates mirrors, conditionally.
2693
2694 Only clears the field if it hasn't been modified and it point it
2695 at field start. This hook doesn't do anything if an undo is in
2696 progress."
2697 (unless (yas/undo-in-progress)
2698 (let ((field (overlay-get yas/active-field-overlay 'yas/field)))
2699 (cond (after?
2700 (yas/advance-end-maybe field (overlay-end overlay))
2701 ;;; primary field transform: normal calls to expression
2702 (let ((saved-point (point)))
2703 (yas/field-update-display field (car (yas/snippets-at-point)))
2704 (goto-char saved-point))
2705 (yas/update-mirrors (car (yas/snippets-at-point))))
2706 (field
2707 (when (and (not after?)
2708 (not (yas/field-modified-p field))
2709 (eq (point) (if (markerp (yas/field-start field))
2710 (marker-position (yas/field-start field))
2711 (yas/field-start field))))
2712 (yas/skip-and-clear field))
2713 (setf (yas/field-modified-p field) t))))))
2714 \f
2715 ;;; Apropos protection overlays:
2716 ;;;
2717 ;;; These exist for nasty users who will try to delete parts of the
2718 ;;; snippet outside the active field. Actual protection happens in
2719 ;;; `yas/on-protection-overlay-modification'.
2720 ;;;
2721 ;;; Currently this signals an error which inhibits the command. For
2722 ;;; commands that move point (like `kill-line'), point is restored in
2723 ;;; the `yas/post-command-handler' using a global
2724 ;;; `yas/protection-violation' variable.
2725 ;;;
2726 ;;; Alternatively, I've experimented with an implementation that
2727 ;;; commits the snippet before actually calling `this-command'
2728 ;;; interactively, and then signals an eror, which is ignored. but
2729 ;;; blocks all other million modification hooks. This presented some
2730 ;;; problems with stacked expansion.
2731 ;;;
2732
2733 (defun yas/make-move-field-protection-overlays (snippet field)
2734 "Place protection overlays surrounding SNIPPET's FIELD.
2735
2736 Move the overlays, or create them if they do not exit."
2737 (let ((start (yas/field-start field))
2738 (end (yas/field-end field)))
2739 ;; First check if the (1+ end) is contained in the buffer,
2740 ;; otherwise we'll have to do a bit of cheating and silently
2741 ;; insert a newline. the `(1+ (buffer-size))' should prevent this
2742 ;; when using stacked expansion
2743 ;;
2744 (when (< (buffer-size) end)
2745 (save-excursion
2746 (let ((inhibit-modification-hooks t))
2747 (goto-char (point-max))
2748 (newline))))
2749 ;; go on to normal overlay creation/moving
2750 ;;
2751 (cond ((and yas/field-protection-overlays
2752 (every #'overlay-buffer yas/field-protection-overlays))
2753 (move-overlay (first yas/field-protection-overlays) (1- start) start)
2754 (move-overlay (second yas/field-protection-overlays) end (1+ end)))
2755 (t
2756 (setq yas/field-protection-overlays
2757 (list (make-overlay (1- start) start nil t nil)
2758 (make-overlay end (1+ end) nil t nil)))
2759 (dolist (ov yas/field-protection-overlays)
2760 (overlay-put ov 'face 'yas/field-debug-face)
2761 (overlay-put ov 'yas/snippet snippet)
2762 ;; (overlay-put ov 'evaporate t)
2763 (overlay-put ov 'modification-hooks '(yas/on-protection-overlay-modification)))))))
2764
2765 (defvar yas/protection-violation nil
2766 "When non-nil, signals attempts to erronesly exit or modify the snippet.
2767
2768 Functions in the `post-command-hook', for example
2769 `yas/post-command-handler' can check it and reset its value to
2770 nil. The variables value is the point where the violation
2771 originated")
2772
2773 (defun yas/on-protection-overlay-modification (overlay after? beg end &optional length)
2774 "Signals a snippet violation, then issues error.
2775
2776 The error should be ignored in `debug-ignored-errors'"
2777 (cond ((not (or after?
2778 (yas/undo-in-progress)))
2779 (setq yas/protection-violation (point))
2780 (error "Exit the snippet first!"))))
2781
2782 (add-to-list 'debug-ignored-errors "^Exit the snippet first!$")
2783
2784 \f
2785 ;;; Apropos stacked expansion:
2786 ;;;
2787 ;;; the parent snippet does not run its fields modification hooks
2788 ;;; (`yas/on-field-overlay-modification' and
2789 ;;; `yas/on-protection-overlay-modification') while the child snippet
2790 ;;; is active. This means, among other things, that the mirrors of the
2791 ;;; parent snippet are not updated, this only happening when one exits
2792 ;;; the child snippet.
2793 ;;;
2794 ;;; Unfortunately, this also puts some ugly (and not fully-tested)
2795 ;;; bits of code in `yas/expand-snippet' and
2796 ;;; `yas/commit-snippet'. I've tried to mark them with "stacked
2797 ;;; expansion:".
2798 ;;;
2799 ;;; This was thought to be safer in in an undo/redo perpective, but
2800 ;;; maybe the correct implementation is to make the globals
2801 ;;; `yas/active-field-overlay' and `yas/field-protection-overlays' be
2802 ;;; snippet-local and be active even while the child snippet is
2803 ;;; running. This would mean a lot of overlay modification hooks
2804 ;;; running, but if managed correctly (including overlay priorities)
2805 ;;; they should account for all situations...
2806 ;;;
2807
2808 (defun yas/expand-snippet (template &optional start end expand-env)
2809 "Expand snippet at current point. Text between START and END
2810 will be deleted before inserting template."
2811 (run-hooks 'yas/before-expand-snippet-hook)
2812
2813 ;; If a region is active, set `yas/selected-text'
2814 (setq yas/selected-text
2815 (when mark-active
2816 (prog1 (buffer-substring-no-properties (region-beginning)
2817 (region-end))
2818 (unless start (setq start (region-beginning))
2819 (unless end (setq end (region-end)))))))
2820
2821 (when start
2822 (goto-char start))
2823
2824 ;; stacked expansion: shoosh the overlay modification hooks
2825 ;;
2826 (let ((to-delete (and start end (buffer-substring-no-properties start end)))
2827 (start (or start (point)))
2828 (end (or end (point)))
2829 (inhibit-modification-hooks t)
2830 (column (current-column))
2831 snippet)
2832
2833 ;; Delete the region to delete, this *does* get undo-recorded.
2834 ;;
2835 (when (and to-delete
2836 (> end start))
2837 (delete-region start end)
2838 (setq yas/deleted-text to-delete))
2839
2840 ;; Narrow the region down to the template, shoosh the
2841 ;; `buffer-undo-list', and create the snippet, the new snippet
2842 ;; updates its mirrors once, so we are left with some plain text.
2843 ;; The undo action for deleting this plain text will get recorded
2844 ;; at the end of this function.
2845 (save-restriction
2846 (narrow-to-region start start)
2847 (let ((buffer-undo-list t))
2848 ;; snippet creation might evaluate users elisp, which
2849 ;; might generate errors, so we have to be ready to catch
2850 ;; them mostly to make the undo information
2851 ;;
2852 (setq yas/start-column (save-restriction (widen) (current-column)))
2853 (insert template)
2854
2855 (setq snippet
2856 (if expand-env
2857 (let ((read-vars (condition-case err
2858 (read expand-env)
2859 (error nil))))
2860 (eval `(let ,read-vars
2861 (yas/snippet-create (point-min) (point-max)))))
2862 (yas/snippet-create (point-min) (point-max))))))
2863
2864 ;; stacked-expansion: This checks for stacked expansion, save the
2865 ;; `yas/previous-active-field' and advance its boudary.
2866 ;;
2867 (let ((existing-field (and yas/active-field-overlay
2868 (overlay-buffer yas/active-field-overlay)
2869 (overlay-get yas/active-field-overlay 'yas/field))))
2870 (when existing-field
2871 (setf (yas/snippet-previous-active-field snippet) existing-field)
2872 (yas/advance-end-maybe existing-field (overlay-end yas/active-field-overlay))))
2873
2874 ;; Exit the snippet immediately if no fields
2875 ;;
2876 (unless (yas/snippet-fields snippet)
2877 (yas/exit-snippet snippet))
2878
2879 ;; Push two undo actions: the deletion of the inserted contents of
2880 ;; the new snippet (without the "key") followed by an apply of
2881 ;; `yas/take-care-of-redo' on the newly inserted snippet boundaries
2882 ;;
2883 (let ((start (overlay-start (yas/snippet-control-overlay snippet)))
2884 (end (overlay-end (yas/snippet-control-overlay snippet))))
2885 (push (cons start end) buffer-undo-list)
2886 (push `(apply yas/take-care-of-redo ,start ,end ,snippet)
2887 buffer-undo-list))
2888 ;; Now, move to the first field
2889 ;;
2890 (let ((first-field (car (yas/snippet-fields snippet))))
2891 (when first-field
2892 (yas/move-to-field snippet first-field))))
2893 (message "[yas] snippet expanded."))
2894
2895 (defun yas/take-care-of-redo (beg end snippet)
2896 "Commits SNIPPET, which in turn pushes an undo action for
2897 reviving it.
2898
2899 Meant to exit in the `buffer-undo-list'."
2900 ;; slightly optimize: this action is only needed for snippets with
2901 ;; at least one field
2902 (when (yas/snippet-fields snippet)
2903 (yas/commit-snippet snippet 'no-hooks)))
2904
2905 (defun yas/snippet-revive (beg end snippet)
2906 "Revives the SNIPPET and creates a control overlay from BEG to
2907 END.
2908
2909 BEG and END are, we hope, the original snippets boudaries. All
2910 the markers/points exiting existing inside SNIPPET should point
2911 to their correct locations *at the time the snippet is revived*.
2912
2913 After revival, push the `yas/take-care-of-redo' in the
2914 `buffer-undo-list'"
2915 ;; Reconvert all the points to markers
2916 ;;
2917 (yas/points-to-markers snippet)
2918 ;; When at least one editable field existed in the zombie snippet,
2919 ;; try to revive the whole thing...
2920 ;;
2921 (let ((target-field (or (yas/snippet-active-field snippet)
2922 (car (yas/snippet-fields snippet)))))
2923 (when target-field
2924 (setf (yas/snippet-control-overlay snippet) (yas/make-control-overlay snippet beg end))
2925 (overlay-put (yas/snippet-control-overlay snippet) 'yas/snippet snippet)
2926
2927 (yas/move-to-field snippet target-field)
2928
2929 (add-hook 'post-command-hook 'yas/post-command-handler nil t)
2930 (add-hook 'pre-command-hook 'yas/pre-command-handler t t)
2931
2932 (push `(apply yas/take-care-of-redo ,beg ,end ,snippet)
2933 buffer-undo-list))))
2934
2935 (defun yas/snippet-create (begin end)
2936 "Creates a snippet from an template inserted between BEGIN and END.
2937
2938 Returns the newly created snippet."
2939 (let ((snippet (yas/make-snippet)))
2940 (goto-char begin)
2941 (yas/snippet-parse-create snippet)
2942
2943 ;; Sort and link each field
2944 (yas/snippet-sort-fields snippet)
2945
2946 ;; (yas/update-mirrors snippet) ;; XXX: WHY was this here for so long...
2947
2948 ;; Create keymap overlay for snippet
2949 (setf (yas/snippet-control-overlay snippet)
2950 (yas/make-control-overlay snippet (point-min) (point-max)))
2951
2952 ;; Move to end
2953 (goto-char (point-max))
2954
2955 ;; Setup hooks
2956 (add-hook 'post-command-hook 'yas/post-command-handler nil t)
2957 (add-hook 'pre-command-hook 'yas/pre-command-handler t t)
2958
2959 snippet))
2960
2961 \f
2962 ;;; Apropos adjacencies: Once the $-constructs bits like "$n" and
2963 ;;; "${:n" are deleted in the recently expanded snippet, we might
2964 ;;; actually have many fields, mirrors (and the snippet exit) in the
2965 ;;; very same position in the buffer. Therefore we need to single-link
2966 ;;; the fields-or-mirrors-or-exit, which I have called "fom",
2967 ;;; according to their original positions in the buffer.
2968 ;;;
2969 ;;; Then we have operation `yas/advance-end-maybe' and
2970 ;;; `yas/advance-start-maybe', which conditionally push the starts and
2971 ;;; ends of these foms down the chain.
2972 ;;;
2973 ;;; This allows for like the printf with the magic ",":
2974 ;;;
2975 ;;; printf ("${1:%s}\\n"${1:$(if (string-match "%" text) "," "\);")} \
2976 ;;; $2${1:$(if (string-match "%" text) "\);" "")}$0
2977 ;;;
2978
2979 (defun yas/fom-start (fom)
2980 (cond ((yas/field-p fom)
2981 (yas/field-start fom))
2982 ((yas/mirror-p fom)
2983 (yas/mirror-start fom))
2984 (t
2985 (yas/exit-marker fom))))
2986
2987 (defun yas/fom-end (fom)
2988 (cond ((yas/field-p fom)
2989 (yas/field-end fom))
2990 ((yas/mirror-p fom)
2991 (yas/mirror-end fom))
2992 (t
2993 (yas/exit-marker fom))))
2994
2995 (defun yas/fom-next (fom)
2996 (cond ((yas/field-p fom)
2997 (yas/field-next fom))
2998 ((yas/mirror-p fom)
2999 (yas/mirror-next fom))
3000 (t
3001 (yas/exit-next fom))))
3002
3003 (defun yas/calculate-adjacencies (snippet)
3004 "Calculate adjacencies for fields or mirrors of SNIPPET.
3005
3006 This is according to their relative positions in the buffer, and
3007 has to be called before the $-constructs are deleted."
3008 (flet ((yas/fom-set-next-fom (fom nextfom)
3009 (cond ((yas/field-p fom)
3010 (setf (yas/field-next fom) nextfom))
3011 ((yas/mirror-p fom)
3012 (setf (yas/mirror-next fom) nextfom))
3013 (t
3014 (setf (yas/exit-next fom) nextfom))))
3015 (yas/compare-fom-begs (fom1 fom2)
3016 (> (yas/fom-start fom2) (yas/fom-start fom1)))
3017 (yas/link-foms (fom1 fom2)
3018 (yas/fom-set-next-fom fom1 fom2)))
3019 ;; make some yas/field, yas/mirror and yas/exit soup
3020 (let ((soup))
3021 (when (yas/snippet-exit snippet)
3022 (push (yas/snippet-exit snippet) soup))
3023 (dolist (field (yas/snippet-fields snippet))
3024 (push field soup)
3025 (dolist (mirror (yas/field-mirrors field))
3026 (push mirror soup)))
3027 (setq soup
3028 (sort soup
3029 #'yas/compare-fom-begs))
3030 (when soup
3031 (reduce #'yas/link-foms soup)))))
3032
3033 (defun yas/advance-end-maybe (fom newend)
3034 "Maybe advance FOM's end to NEWEND if it needs it.
3035
3036 If it does, also:
3037
3038 * call `yas/advance-start-maybe' on FOM's next fom.
3039
3040 * in case FOM is field call `yas/advance-end-maybe' on its parent
3041 field"
3042 (when (and fom (< (yas/fom-end fom) newend))
3043 (set-marker (yas/fom-end fom) newend)
3044 (yas/advance-start-maybe (yas/fom-next fom) newend)
3045 (if (and (yas/field-p fom)
3046 (yas/field-parent-field fom))
3047 (yas/advance-end-maybe (yas/field-parent-field fom) newend))))
3048
3049 (defun yas/advance-start-maybe (fom newstart)
3050 "Maybe advance FOM's start to NEWSTART if it needs it.
3051
3052 If it does, also call `yas/advance-end-maybe' on FOM."
3053 (when (and fom (< (yas/fom-start fom) newstart))
3054 (set-marker (yas/fom-start fom) newstart)
3055 (yas/advance-end-maybe fom newstart)))
3056
3057 (defvar yas/dollar-regions nil
3058 "When expanding the snippet the \"parse-create\" functions add
3059 cons cells to this var")
3060
3061 (defun yas/snippet-parse-create (snippet)
3062 "Parse a recently inserted snippet template, creating all
3063 necessary fields, mirrors and exit points.
3064
3065 Meant to be called in a narrowed buffer, does various passes"
3066 (let ((parse-start (point)))
3067 ;; Reset the yas/dollar-regions
3068 ;;
3069 (setq yas/dollar-regions nil)
3070 ;; protect quote and backquote escapes
3071 ;;
3072 (yas/protect-escapes nil '(?` ?'))
3073 ;; replace all backquoted expressions
3074 ;;
3075 (goto-char parse-start)
3076 (yas/replace-backquotes)
3077 ;; protect escapes again since previous steps might have generated
3078 ;; more characters needing escaping
3079 ;;
3080 (goto-char parse-start)
3081 (yas/protect-escapes)
3082 ;; parse fields with {}
3083 ;;
3084 (goto-char parse-start)
3085 (yas/field-parse-create snippet)
3086 ;; parse simple mirrors and fields
3087 ;;
3088 (goto-char parse-start)
3089 (yas/simple-mirror-parse-create snippet)
3090 ;; parse mirror transforms
3091 ;;
3092 (goto-char parse-start)
3093 (yas/transform-mirror-parse-create snippet)
3094 ;; calculate adjacencies of fields and mirrors
3095 ;;
3096 (yas/calculate-adjacencies snippet)
3097 ;; Delete $-constructs
3098 ;;
3099 (yas/delete-regions yas/dollar-regions)
3100 ;; restore escapes
3101 ;;
3102 (goto-char parse-start)
3103 (yas/restore-escapes)
3104 ;; update mirrors for the first time
3105 ;;
3106 (yas/update-mirrors snippet)
3107 ;; indent the best we can
3108 ;;
3109 (goto-char parse-start)
3110 (yas/indent snippet)))
3111
3112 (defun yas/indent-according-to-mode (snippet-markers)
3113 "Indent current line according to mode, preserving
3114 SNIPPET-MARKERS."
3115 ;; XXX: Here seems to be the indent problem:
3116 ;;
3117 ;; `indent-according-to-mode' uses whatever
3118 ;; `indent-line-function' is available. Some
3119 ;; implementations of these functions delete text
3120 ;; before they insert. If there happens to be a marker
3121 ;; just after the text being deleted, the insertion
3122 ;; actually happens after the marker, which misplaces
3123 ;; it.
3124 ;;
3125 ;; This would also happen if we had used overlays with
3126 ;; the `front-advance' property set to nil.
3127 ;;
3128 ;; This is why I have these `trouble-markers', they are the ones at
3129 ;; they are the ones at the first non-whitespace char at the line
3130 ;; (i.e. at `yas/real-line-beginning'. After indentation takes place
3131 ;; we should be at the correct to restore them to. All other
3132 ;; non-trouble-markers have been *pushed* and don't need special
3133 ;; attention.
3134 ;;
3135 (goto-char (yas/real-line-beginning))
3136 (let ((trouble-markers (remove-if-not #'(lambda (marker)
3137 (= marker (point)))
3138 snippet-markers)))
3139 (save-restriction
3140 (widen)
3141 (condition-case err
3142 (indent-according-to-mode)
3143 (error (message "[yas] warning: yas/indent-according-to-mode habing problems running %s" indent-line-function)
3144 nil)))
3145 (mapc #'(lambda (marker)
3146 (set-marker marker (point)))
3147 trouble-markers)))
3148
3149 (defun yas/indent (snippet)
3150 (let ((snippet-markers (yas/collect-snippet-markers snippet)))
3151 ;; Look for those $>
3152 (save-excursion
3153 (while (re-search-forward "$>" nil t)
3154 (delete-region (match-beginning 0) (match-end 0))
3155 (when (not (eq yas/indent-line 'auto))
3156 (yas/indent-according-to-mode snippet-markers))))
3157 ;; Now do stuff for 'fixed and 'auto
3158 (save-excursion
3159 (cond ((eq yas/indent-line 'fixed)
3160 (while (and (zerop (forward-line))
3161 (zerop (current-column)))
3162 (indent-to-column column)))
3163 ((eq yas/indent-line 'auto)
3164 (let ((end (set-marker (make-marker) (point-max)))
3165 (indent-first-line-p yas/also-auto-indent-first-line))
3166 (while (and (zerop (if indent-first-line-p
3167 (prog1
3168 (forward-line 0)
3169 (setq indent-first-line-p nil))
3170 (forward-line 1)))
3171 (not (eobp))
3172 (<= (point) end))
3173 (yas/indent-according-to-mode snippet-markers))))
3174 (t
3175 nil)))))
3176
3177 (defun yas/collect-snippet-markers (snippet)
3178 "Make a list of all the markers used by SNIPPET."
3179 (let (markers)
3180 (dolist (field (yas/snippet-fields snippet))
3181 (push (yas/field-start field) markers)
3182 (push (yas/field-end field) markers)
3183 (dolist (mirror (yas/field-mirrors field))
3184 (push (yas/mirror-start mirror) markers)
3185 (push (yas/mirror-end mirror) markers)))
3186 (let ((snippet-exit (yas/snippet-exit snippet)))
3187 (when (and snippet-exit
3188 (marker-buffer (yas/exit-marker snippet-exit)))
3189 (push (yas/exit-marker snippet-exit) markers)))
3190 markers))
3191
3192 (defun yas/real-line-beginning ()
3193 (let ((c (char-after (line-beginning-position)))
3194 (n (line-beginning-position)))
3195 (while (or (eql c ?\ )
3196 (eql c ?\t))
3197 (incf n)
3198 (setq c (char-after n)))
3199 n))
3200
3201 (defun yas/escape-string (escaped)
3202 (concat "YASESCAPE" (format "%d" escaped) "PROTECTGUARD"))
3203
3204 (defun yas/protect-escapes (&optional text escaped)
3205 "Protect all escaped characters with their numeric ASCII value.
3206
3207 With optional string TEXT do it in string instead of buffer."
3208 (let ((changed-text text)
3209 (text-provided-p text))
3210 (mapc #'(lambda (escaped)
3211 (setq changed-text
3212 (yas/replace-all (concat "\\" (char-to-string escaped))
3213 (yas/escape-string escaped)
3214 (when text-provided-p changed-text))))
3215 (or escaped yas/escaped-characters))
3216 changed-text))
3217
3218 (defun yas/restore-escapes (&optional text escaped)
3219 "Restore all escaped characters from their numeric ASCII value.
3220
3221 With optional string TEXT do it in string instead of the buffer."
3222 (let ((changed-text text)
3223 (text-provided-p text))
3224 (mapc #'(lambda (escaped)
3225 (setq changed-text
3226 (yas/replace-all (yas/escape-string escaped)
3227 (char-to-string escaped)
3228 (when text-provided-p changed-text))))
3229 (or escaped yas/escaped-characters))
3230 changed-text))
3231
3232 (defun yas/replace-backquotes ()
3233 "Replace all the \"`(lisp-expression)`\"-style expression
3234 with their evaluated value"
3235 (while (re-search-forward yas/backquote-lisp-expression-regexp nil t)
3236 (let ((transformed (yas/read-and-eval-string (yas/restore-escapes (match-string 1)))))
3237 (goto-char (match-end 0))
3238 (when transformed (insert transformed))
3239 (delete-region (match-beginning 0) (match-end 0)))))
3240
3241 (defun yas/scan-sexps (from count)
3242 (condition-case err
3243 (with-syntax-table (standard-syntax-table)
3244 (scan-sexps from count))
3245 (error
3246 nil)))
3247
3248 (defun yas/make-marker (pos)
3249 "Create a marker at POS with `nil' `marker-insertion-type'"
3250 (let ((marker (set-marker (make-marker) pos)))
3251 (set-marker-insertion-type marker nil)
3252 marker))
3253
3254 (defun yas/field-parse-create (snippet &optional parent-field)
3255 "Parse most field expressions, except for the simple one \"$n\".
3256
3257 The following count as a field:
3258
3259 * \"${n: text}\", for a numbered field with default text, as long as N is not 0;
3260
3261 * \"${n: text$(expression)}, the same with a lisp expression;
3262 this is caught with the curiously named `yas/multi-dollar-lisp-expression-regexp'
3263
3264 * the same as above but unnumbered, (no N:) and number is calculated automatically.
3265
3266 When multiple expressions are found, only the last one counts."
3267 ;;
3268 (save-excursion
3269 (while (re-search-forward yas/field-regexp nil t)
3270 (let* ((real-match-end-0 (yas/scan-sexps (1+ (match-beginning 0)) 1))
3271 (number (and (match-string-no-properties 1)
3272 (string-to-number (match-string-no-properties 1))))
3273 (brand-new-field (and real-match-end-0
3274 ;; break if on "$(" immediately
3275 ;; after the ":", this will be
3276 ;; caught as a mirror with
3277 ;; transform later.
3278 (not (save-match-data
3279 (eq (string-match "$[ \t\n]*("
3280 (match-string-no-properties 2)) 0)))
3281 (not (and number (zerop number)))
3282 (yas/make-field number
3283 (yas/make-marker (match-beginning 2))
3284 (yas/make-marker (1- real-match-end-0))
3285 parent-field))))
3286 (when brand-new-field
3287 (goto-char real-match-end-0)
3288 (push (cons (1- real-match-end-0) real-match-end-0)
3289 yas/dollar-regions)
3290 (push (cons (match-beginning 0) (match-beginning 2))
3291 yas/dollar-regions)
3292 (push brand-new-field (yas/snippet-fields snippet))
3293 (save-excursion
3294 (save-restriction
3295 (narrow-to-region (yas/field-start brand-new-field) (yas/field-end brand-new-field))
3296 (goto-char (point-min))
3297 (yas/field-parse-create snippet brand-new-field)))))))
3298 ;; if we entered from a parent field, now search for the
3299 ;; `yas/multi-dollar-lisp-expression-regexp'. THis is used for
3300 ;; primary field transformations
3301 ;;
3302 (when parent-field
3303 (save-excursion
3304 (while (re-search-forward yas/multi-dollar-lisp-expression-regexp nil t)
3305 (let* ((real-match-end-1 (yas/scan-sexps (match-beginning 1) 1)))
3306 ;; commit the primary field transformation if we don't find
3307 ;; it in yas/dollar-regions (a subnested field) might have
3308 ;; already caught it.
3309 (when (and real-match-end-1
3310 (not (member (cons (match-beginning 0)
3311 real-match-end-1)
3312 yas/dollar-regions)))
3313 (let ((lisp-expression-string (buffer-substring-no-properties (match-beginning 1)
3314 real-match-end-1)))
3315 (setf (yas/field-transform parent-field) (yas/restore-escapes lisp-expression-string)))
3316 (push (cons (match-beginning 0) real-match-end-1)
3317 yas/dollar-regions)))))))
3318
3319 (defun yas/transform-mirror-parse-create (snippet)
3320 "Parse the \"${n:$(lisp-expression)}\" mirror transformations."
3321 (while (re-search-forward yas/transform-mirror-regexp nil t)
3322 (let* ((real-match-end-0 (yas/scan-sexps (1+ (match-beginning 0)) 1))
3323 (number (string-to-number (match-string-no-properties 1)))
3324 (field (and number
3325 (not (zerop number))
3326 (yas/snippet-find-field snippet number))))
3327 (when (and real-match-end-0
3328 field)
3329 (push (yas/make-mirror (yas/make-marker (match-beginning 0))
3330 (yas/make-marker (match-beginning 0))
3331 (yas/restore-escapes
3332 (buffer-substring-no-properties (match-beginning 2)
3333 (1- real-match-end-0))))
3334 (yas/field-mirrors field))
3335 (push (cons (match-beginning 0) real-match-end-0) yas/dollar-regions)))))
3336
3337 (defun yas/simple-mirror-parse-create (snippet)
3338 "Parse the simple \"$n\" mirrors and the exit-marker."
3339 (while (re-search-forward yas/simple-mirror-regexp nil t)
3340 (let ((number (string-to-number (match-string-no-properties 1))))
3341 (cond ((zerop number)
3342
3343 (setf (yas/snippet-exit snippet)
3344 (yas/make-exit (yas/make-marker (match-end 0))))
3345 (save-excursion
3346 (goto-char (match-beginning 0))
3347 (when yas/wrap-around-region
3348 (cond (yas/selected-text
3349 (insert yas/selected-text))
3350 ((and (eq yas/wrap-around-region 'cua)
3351 cua-mode
3352 (get-register ?0))
3353 (insert (prog1 (get-register ?0)
3354 (set-register ?0 nil))))))
3355 (push (cons (point) (yas/exit-marker (yas/snippet-exit snippet)))
3356 yas/dollar-regions)))
3357 (t
3358 (let ((field (yas/snippet-find-field snippet number)))
3359 (if field
3360 (push (yas/make-mirror (yas/make-marker (match-beginning 0))
3361 (yas/make-marker (match-beginning 0))
3362 nil)
3363 (yas/field-mirrors field))
3364 (push (yas/make-field number
3365 (yas/make-marker (match-beginning 0))
3366 (yas/make-marker (match-beginning 0))
3367 nil)
3368 (yas/snippet-fields snippet))))
3369 (push (cons (match-beginning 0) (match-end 0))
3370 yas/dollar-regions))))))
3371
3372 (defun yas/delete-regions (regions)
3373 "Sort disjuct REGIONS by start point, then delete from the back."
3374 (mapc #'(lambda (reg)
3375 (delete-region (car reg) (cdr reg)))
3376 (sort regions
3377 #'(lambda (r1 r2)
3378 (>= (car r1) (car r2))))))
3379
3380 (defun yas/update-mirrors (snippet)
3381 "Updates all the mirrors of SNIPPET."
3382 (save-excursion
3383 (dolist (field (yas/snippet-fields snippet))
3384 (dolist (mirror (yas/field-mirrors field))
3385 ;; stacked expansion: I added an `inhibit-modification-hooks'
3386 ;; here, for safety, may need to remove if we the mechanism is
3387 ;; altered.
3388 ;;
3389 (let ((inhibit-modification-hooks t))
3390 (yas/mirror-update-display mirror field)
3391 ;; `yas/place-overlays' is needed if the active field and
3392 ;; protected overlays have been changed because of insertions
3393 ;; in `yas/mirror-update-display'
3394 ;;
3395 (when (eq field (yas/snippet-active-field snippet))
3396 (yas/place-overlays snippet field)))))))
3397
3398 (defun yas/mirror-update-display (mirror field)
3399 "Update MIRROR according to FIELD (and mirror transform)."
3400 (let ((reflection (or (yas/apply-transform mirror field)
3401 (yas/field-text-for-display field))))
3402 (when (and reflection
3403 (not (string= reflection (buffer-substring-no-properties (yas/mirror-start mirror)
3404 (yas/mirror-end mirror)))))
3405 (goto-char (yas/mirror-start mirror))
3406 (insert reflection)
3407 (if (> (yas/mirror-end mirror) (point))
3408 (delete-region (point) (yas/mirror-end mirror))
3409 (set-marker (yas/mirror-end mirror) (point))
3410 (yas/advance-start-maybe (yas/mirror-next mirror) (point))))))
3411
3412 (defun yas/field-update-display (field snippet)
3413 "Much like `yas/mirror-update-display', but for fields"
3414 (when (yas/field-transform field)
3415 (let ((inhibit-modification-hooks t)
3416 (transformed (yas/apply-transform field field))
3417 (point (point)))
3418 (when (and transformed
3419 (not (string= transformed (buffer-substring-no-properties (yas/field-start field)
3420 (yas/field-end field)))))
3421 (setf (yas/field-modified-p field) t)
3422 (goto-char (yas/field-start field))
3423 (insert transformed)
3424 (if (> (yas/field-end field) (point))
3425 (delete-region (point) (yas/field-end field))
3426 (set-marker (yas/field-end field) (point))
3427 (yas/advance-start-maybe (yas/field-next field) (point)))
3428 t))))
3429
3430 \f
3431 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3432 ;; Pre- and post-command hooks
3433 ;;
3434 (defun yas/pre-command-handler () )
3435
3436 (defun yas/post-command-handler ()
3437 "Handles various yasnippet conditions after each command."
3438 (cond (yas/protection-violation
3439 (goto-char yas/protection-violation)
3440 (setq yas/protection-violation nil))
3441 ((eq 'undo this-command)
3442 ;;
3443 ;; After undo revival the correct field is sometimes not
3444 ;; restored correctly, this condition handles that
3445 ;;
3446 (let* ((snippet (car (yas/snippets-at-point)))
3447 (target-field (and snippet
3448 (find-if-not #'(lambda (field)
3449 (yas/field-probably-deleted-p snippet field))
3450 (remove nil
3451 (cons (yas/snippet-active-field snippet)
3452 (yas/snippet-fields snippet)))))))
3453 (when target-field
3454 (yas/move-to-field snippet target-field))))
3455 ((not (yas/undo-in-progress))
3456 ;; When not in an undo, check if we must commit the snippet (use exited it).
3457 (yas/check-commit-snippet))))
3458
3459 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3460 ;; Evaluated on load or require
3461 ;;
3462 ;; ;;;### eval this on require!
3463 ;; (progn
3464 ;; (yas/init-minor-keymap))
3465
3466 ;; ;;;### eval this on require!
3467 ;; (progn
3468 ;; (yas/init-major-keymap))
3469
3470 ;; ;;;### eval this on require!
3471 ;; (progn
3472 ;; (when yas/root-directory
3473 ;; (yas/reload-all)))
3474
3475
3476 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3477 ;; Debug functions. Use (or change) at will whenever needed.
3478 ;;
3479 ;; some useful debug code for looking up snippet tables
3480 ;;
3481 ;; (insert (pp
3482 ;; (let ((shit))
3483 ;; (maphash #'(lambda (k v)
3484 ;; (push k shit))
3485 ;; (yas/snippet-table-hash (gethash 'ruby-mode yas/snippet-tables)))
3486 ;; shit)))
3487 ;;
3488
3489 (defun yas/debug-tables ()
3490 (interactive)
3491 (with-output-to-temp-buffer "*YASnippet tables*"
3492 (dolist (symbol (remove nil (append (list major-mode)
3493 (if (listp yas/mode-symbol)
3494 yas/mode-symbol
3495 (list yas/mode-symbol)))))
3496 (princ (format "Snippet table hash keys for %s:\n\n" symbol))
3497 (let ((keys))
3498 (maphash #'(lambda (k v)
3499 (push k keys))
3500 (yas/snippet-table-hash (gethash symbol yas/snippet-tables)))
3501 (princ keys))
3502
3503 (princ (format "Keymap for %s:\n\n" symbol))
3504 (princ (gethash symbol yas/menu-table)))))
3505
3506 (defun yas/debug-snippet-vars ()
3507 "Debug snippets, fields, mirrors and the `buffer-undo-list'."
3508 (interactive)
3509 (with-output-to-temp-buffer "*YASnippet trace*"
3510 (princ "Interesting YASnippet vars: \n\n")
3511
3512 (princ (format "\nPost command hook: %s\n" post-command-hook))
3513 (princ (format "\nPre command hook: %s\n" pre-command-hook))
3514
3515 (princ (format "%s live snippets in total\n" (length (yas/snippets-at-point (quote all-snippets)))))
3516 (princ (format "%s overlays in buffer:\n\n" (length (overlays-in (point-min) (point-max)))))
3517 (princ (format "%s live snippets at point:\n\n" (length (yas/snippets-at-point))))
3518
3519
3520 (dolist (snippet (yas/snippets-at-point))
3521 (princ (format "\tsid: %d control overlay from %d to %d\n"
3522 (yas/snippet-id snippet)
3523 (overlay-start (yas/snippet-control-overlay snippet))
3524 (overlay-end (yas/snippet-control-overlay snippet))))
3525 (princ (format "\tactive field: %d from %s to %s covering \"%s\"\n"
3526 (yas/field-number (yas/snippet-active-field snippet))
3527 (marker-position (yas/field-start (yas/snippet-active-field snippet)))
3528 (marker-position (yas/field-end (yas/snippet-active-field snippet)))
3529 (buffer-substring-no-properties (yas/field-start (yas/snippet-active-field snippet)) (yas/field-end (yas/snippet-active-field snippet)))))
3530 (when (yas/snippet-exit snippet)
3531 (princ (format "\tsnippet-exit: at %s next: %s\n"
3532 (yas/exit-marker (yas/snippet-exit snippet))
3533 (yas/exit-next (yas/snippet-exit snippet)))))
3534 (dolist (field (yas/snippet-fields snippet))
3535 (princ (format "\tfield: %d from %s to %s covering \"%s\" next: %s\n"
3536 (yas/field-number field)
3537 (marker-position (yas/field-start field))
3538 (marker-position (yas/field-end field))
3539 (buffer-substring-no-properties (yas/field-start field) (yas/field-end field))
3540 (yas/debug-format-fom-concise (yas/field-next field))))
3541 (dolist (mirror (yas/field-mirrors field))
3542 (princ (format "\t\tmirror: from %s to %s covering \"%s\" next: %s\n"
3543 (marker-position (yas/mirror-start mirror))
3544 (marker-position (yas/mirror-end mirror))
3545 (buffer-substring-no-properties (yas/mirror-start mirror) (yas/mirror-end mirror))
3546 (yas/debug-format-fom-concise (yas/mirror-next mirror)))))))
3547
3548 (princ (format "\nUndo is %s and point-max is %s.\n"
3549 (if (eq buffer-undo-list t)
3550 "DISABLED"
3551 "ENABLED")
3552 (point-max)))
3553 (unless (eq buffer-undo-list t)
3554 (princ (format "Undpolist has %s elements. First 10 elements follow:\n" (length buffer-undo-list)))
3555 (let ((first-ten (subseq buffer-undo-list 0 19)))
3556 (dolist (undo-elem first-ten)
3557 (princ (format "%2s: %s\n" (position undo-elem first-ten) (truncate-string-to-width (format "%s" undo-elem) 70))))))))
3558
3559 (defun yas/debug-format-fom-concise (fom)
3560 (when fom
3561 (cond ((yas/field-p fom)
3562 (format "field %d from %d to %d"
3563 (yas/field-number fom)
3564 (marker-position (yas/field-start fom))
3565 (marker-position (yas/field-end fom))))
3566 ((yas/mirror-p fom)
3567 (format "mirror from %d to %d"
3568 (marker-position (yas/mirror-start fom))
3569 (marker-position (yas/mirror-end fom))))
3570 (t
3571 (format "snippet exit at %d"
3572 (marker-position (yas/fom-start fom)))))))
3573
3574
3575 (defun yas/exterminate-package ()
3576 (interactive)
3577 (yas/global-mode -1)
3578 (yas/minor-mode -1)
3579 (yas/kill-snippet-keybindings)
3580 (mapatoms #'(lambda (atom)
3581 (when (string-match "yas/" (symbol-name atom))
3582 (unintern atom)))))
3583
3584 (defun yas/debug-test (&optional quiet)
3585 (interactive "P")
3586 (yas/load-directory (or (and (listp yas/root-directory)
3587 (first yas/root-directory))
3588 yas/root-directory
3589 "~/Source/yasnippet/snippets/"))
3590 (set-buffer (switch-to-buffer "*YAS TEST*"))
3591 (mapc #'yas/commit-snippet (yas/snippets-at-point 'all-snippets))
3592 (erase-buffer)
3593 (setq buffer-undo-list nil)
3594 (setq undo-in-progress nil)
3595 (snippet-mode)
3596 (yas/minor-mode 1)
3597 (let ((abbrev))
3598 (setq abbrev "$f")
3599 (insert abbrev))
3600 (unless quiet
3601 (add-hook 'post-command-hook 'yas/debug-snippet-vars 't 'local)))
3602
3603
3604 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3605 ;;; `locate-dominating-file' is added for compatibility in emacs < 23
3606 (unless (or (eq emacs-major-version 23)
3607 (fboundp 'locate-dominating-file))
3608 (defvar locate-dominating-stop-dir-regexp
3609 "\\`\\(?:[\\/][\\/][^\\/]+[\\/]\\|/\\(?:net\\|afs\\|\\.\\.\\.\\)/\\)\\'"
3610 "Regexp of directory names which stop the search in `locate-dominating-file'.
3611 Any directory whose name matches this regexp will be treated like
3612 a kind of root directory by `locate-dominating-file' which will stop its search
3613 when it bumps into it.
3614 The default regexp prevents fruitless and time-consuming attempts to find
3615 special files in directories in which filenames are interpreted as hostnames,
3616 or mount points potentially requiring authentication as a different user.")
3617
3618 (defun locate-dominating-file (file name)
3619 "Look up the directory hierarchy from FILE for a file named NAME.
3620 Stop at the first parent directory containing a file NAME,
3621 and return the directory. Return nil if not found."
3622 ;; We used to use the above locate-dominating-files code, but the
3623 ;; directory-files call is very costly, so we're much better off doing
3624 ;; multiple calls using the code in here.
3625 ;;
3626 ;; Represent /home/luser/foo as ~/foo so that we don't try to look for
3627 ;; `name' in /home or in /.
3628 (setq file (abbreviate-file-name file))
3629 (let ((root nil)
3630 (prev-file file)
3631 ;; `user' is not initialized outside the loop because
3632 ;; `file' may not exist, so we may have to walk up part of the
3633 ;; hierarchy before we find the "initial UID".
3634 (user nil)
3635 try)
3636 (while (not (or root
3637 (null file)
3638 ;; FIXME: Disabled this heuristic because it is sometimes
3639 ;; inappropriate.
3640 ;; As a heuristic, we stop looking up the hierarchy of
3641 ;; directories as soon as we find a directory belonging
3642 ;; to another user. This should save us from looking in
3643 ;; things like /net and /afs. This assumes that all the
3644 ;; files inside a project belong to the same user.
3645 ;; (let ((prev-user user))
3646 ;; (setq user (nth 2 (file-attributes file)))
3647 ;; (and prev-user (not (equal user prev-user))))
3648 (string-match locate-dominating-stop-dir-regexp file)))
3649 (setq try (file-exists-p (expand-file-name name file)))
3650 (cond (try (setq root file))
3651 ((equal file (setq prev-file file
3652 file (file-name-directory
3653 (directory-file-name file))))
3654 (setq file nil))))
3655 root)))
3656
3657 (provide 'yasnippet)
3658
3659 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3660 ;; Monkey patching for other functions that's causing
3661 ;; problems to yasnippet. For details on why I patch
3662 ;; those functions, refer to
3663 ;; http://code.google.com/p/yasnippet/wiki/MonkeyPatching
3664 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3665 (defadvice c-neutralize-syntax-in-CPP
3666 (around yas-mp/c-neutralize-syntax-in-CPP activate)
3667 "Adviced `c-neutralize-syntax-in-CPP' to properly
3668 handle the end-of-buffer error fired in it by calling
3669 `forward-char' at the end of buffer."
3670 (condition-case err
3671 ad-do-it
3672 (error (message (error-message-string err)))))
3673
3674 ;; disable c-electric-* serial command in YAS fields
3675 (add-hook 'c-mode-common-hook
3676 '(lambda ()
3677 (make-variable-buffer-local 'yas/keymap)
3678 (dolist (k '(":" ">" ";" "<" "{" "}"))
3679 (define-key yas/keymap
3680 k 'self-insert-command))))
3681
3682
3683 ;;; yasnippet.el ends here