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