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