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