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