ld/yasnippet
1
0
Fork 0
mirror of https://github.com/joaotavora/yasnippet.git synced 2025-10-13 13:13:03 +00:00
Code Issues Packages Projects Releases Wiki Activity

fix: more idiomatic elisp, better docstrings, less byte-compiler warnings

Browse Source 
By Stefan Monnier, with original commentary.

"Here's an untested patch of cleanups, found partly via compilation using
lexical-binding and partly via checkdoc-current-buffer (and
occasionally by stumble-upon happenstance)."
This commit is contained in:
Joao Tavora 2013-08-29 10:20:31 +01:00
parent a2f0f7f767
commit 13d87aa3c0
2 changed files with 228 additions and 259 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
yasnippet-tests.el
View File

@ -264,8 +264,44 @@ TODO: correct this bug!"
;;; Loading ;;; Loading
;;; ;;;
(defun yas--call-with-temporary-redefinitions (function
&rest function-names-and-overriding-functions)
(let* ((overrides (remove-if-not #'(lambda (fdef)
(fboundp (first fdef)))
function-names-and-overriding-functions))
(definition-names (mapcar #'first overrides))
(overriding-functions (mapcar #'second overrides))
(saved-functions (mapcar #'symbol-function definition-names)))
;; saving all definitions before overriding anything ensures FDEFINITION
;; errors don't cause accidental permanent redefinitions.
;;
(labels ((set-fdefinitions (names functions)
(loop for name in names
for fn in functions
do (fset name fn))))
(set-fdefinitions definition-names overriding-functions)
(unwind-protect (funcall function)
(set-fdefinitions definition-names saved-functions)))))
(defmacro yas--with-temporary-redefinitions (fdefinitions &rest body)
;; "Temporarily (but globally) redefine each function in FDEFINITIONS.
;; E.g.: (yas--with-temporary-redefinitions ((foo (x) ...)
;; (bar (x) ...))
;; ;; code that eventually calls foo, bar of (setf foo)
;; ...)"
;; FIXME: This is hideous! Better use defadvice (or at least letf).
`(yas--call-with-temporary-redefinitions
(lambda () ,@body)
,@(mapcar #'(lambda (thingy)
`(list ',(first thingy)
(lambda ,@(rest thingy))))
fdefinitions)))
(put 'yas--with-temporary-redefinitions 'lisp-indent-function 1)
(put 'yas--with-temporary-redefinitions 'edebug-form-spec '((&rest (defun*)) cl-declarations body))
(defmacro yas-with-overriden-buffer-list (&rest body) (defmacro yas-with-overriden-buffer-list (&rest body)
(let ((saved-sym (gensym))) (let ((saved-sym (make-symbol "yas--buffer-list")))
`(let ((,saved-sym (symbol-function 'buffer-list))) `(let ((,saved-sym (symbol-function 'buffer-list)))
(yas--with-temporary-redefinitions (yas--with-temporary-redefinitions
((buffer-list () ((buffer-list ()
@ -306,8 +342,7 @@ TODO: correct this bug!"
(yas-reload-all) (yas-reload-all)
(yas-recompile-all) (yas-recompile-all)
(yas--with-temporary-redefinitions ((yas--load-directory-2 (yas--with-temporary-redefinitions ((yas--load-directory-2
(&rest dummies) (&rest _dummies)
(declare (ignore dummies))
(ert-fail "yas--load-directory-2 shouldn't be called when snippets have been compiled"))) (ert-fail "yas--load-directory-2 shouldn't be called when snippets have been compiled")))
(yas-reload-all) (yas-reload-all)
(yas--basic-jit-loading-1)))) (yas--basic-jit-loading-1))))
@ -328,7 +363,7 @@ TODO: correct this bug!"
(error (error
(ert-fail "cyclic parenthood test failed")))))) (ert-fail "cyclic parenthood test failed"))))))
(defun yas--basic-jit-loading-1 (&optional compile) (defun yas--basic-jit-loading-1 ()
(with-temp-buffer (with-temp-buffer
(should (= 4 (hash-table-count yas--scheduled-jit-loads))) (should (= 4 (hash-table-count yas--scheduled-jit-loads)))
(should (= 0 (hash-table-count yas--tables))) (should (= 0 (hash-table-count yas--tables)))
@ -514,9 +549,7 @@ TODO: be meaner"
(interactive) (interactive)
(with-temp-buffer (with-temp-buffer
(yas--with-temporary-redefinitions (yas--with-temporary-redefinitions
((message (&rest args) ; ((message (&rest _args) nil))
(declare (ignore args))
nil))
(ert t (buffer-name (current-buffer))) (ert t (buffer-name (current-buffer)))
(princ (buffer-string))))) (princ (buffer-string)))))
@ -602,7 +635,8 @@ TODO: be meaner"
;;; Older emacsen ;;; Older emacsen
;;; ;;;
(unless (fboundp 'special-mode) (unless (fboundp 'special-mode)
(define-minor-mode special-mode "Just a placeholder for something isn't in emacs 22")) ;; FIXME: Why provide this default definition here?!?
(defalias 'special-mode 'fundamental))
;;; btw to test this in emacs22 mac osx: ;;; btw to test this in emacs22 mac osx:
;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el ;;; curl -L -O https://github.com/mirrors/emacs/raw/master/lisp/emacs-lisp/ert.el

383
yasnippet.el
View File

@ -1,7 +1,8 @@
;;; yasnippet.el --- Yet another snippet extension for Emacs. ;;; yasnippet.el --- Yet another snippet extension for Emacs.
;; Copyright (C) 2008-2012 Free Software Foundation, Inc. ;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
;; Authors: pluskid <pluskid@gmail.com>, João Távora <joaotavora@gmail.com> ;; Authors: pluskid <pluskid@gmail.com>, João Távora <joaotavora@gmail.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
;; Version: 0.8.0 ;; Version: 0.8.0
;; Package-version: 0.8.0 ;; Package-version: 0.8.0
;; X-URL: http://github.com/capitaomorte/yasnippet ;; X-URL: http://github.com/capitaomorte/yasnippet
@ -137,15 +138,14 @@
(require 'easymenu) (require 'easymenu)
(require 'help-mode) (require 'help-mode)
(eval-when-compile (defvar yas--editing-template)
(defvar yas--editing-template) (defvar yas--guessed-modes)
(defvar yas--guessed-modes) (defvar yas--indent-original-column)
(defvar yas--indent-original-column) (defvar yas--scheduled-jit-loads)
(defvar yas--scheduled-jit-loads) (defvar yas-keymap)
(defvar yas-keymap) (defvar yas-selected-text)
(defvar yas-selected-text) (defvar yas-verbosity)
(defvar yas-verbosity)) (defvar yas--current-template)
;;; User customizable variables ;;; User customizable variables
@ -182,7 +182,7 @@ as the default for storing the user's new snippets."
(yas-reload-all))))) (yas-reload-all)))))
(defun yas-snippet-dirs () (defun yas-snippet-dirs ()
"Returns `yas-snippet-dirs' (which see) as a list." "Return `yas-snippet-dirs' (which see) as a list."
(if (listp yas-snippet-dirs) yas-snippet-dirs (list yas-snippet-dirs))) (if (listp yas-snippet-dirs) yas-snippet-dirs (list yas-snippet-dirs)))
(defvaralias 'yas/root-directory 'yas-snippet-dirs) (defvaralias 'yas/root-directory 'yas-snippet-dirs)
@ -196,8 +196,8 @@ as the default for storing the user's new snippets."
# type: command} # type: command}
# -- # --
$0" $0"
"Default snippet to use when creating a new snippet. If nil, "Default snippet to use when creating a new snippet.
don't use any snippet." If nil, don't use any snippet."
:type 'string :type 'string
:group 'yasnippet) :group 'yasnippet)
@ -781,7 +781,8 @@ per-mode exceptions to the \"global\" activation behaviour, call
`yas-minor-mode' with a negative argument directily in the major `yas-minor-mode' with a negative argument directily in the major
mode's hook.") mode's hook.")
(unless (> emacs-major-version 23) (unless (> emacs-major-version 23)
(make-variable-buffer-local 'yas-dont-activate)) (with-no-warnings
(make-variable-buffer-local 'yas-dont-activate)))
(defun yas-minor-mode-on () (defun yas-minor-mode-on ()
@ -828,8 +829,7 @@ Honour `yas-dont-activate', which see."
("}" ("}"
(0 font-lock-keyword-face))))) (0 font-lock-keyword-face)))))
(defun yas--init-major-keymap () (defvar snippet-mode-map
"Setup YASnippet major-mode keymap."
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
(easy-menu-define nil (easy-menu-define nil
map map
@ -839,13 +839,9 @@ Honour `yas-dont-activate', which see."
(when (third ent) (when (third ent)
(define-key map (third ent) (second ent))) (define-key map (third ent) (second ent)))
(vector (first ent) (second ent) t)) (vector (first ent) (second ent) t))
(list '(("Load this snippet" yas-load-snippet-buffer "\C-c\C-c")
(list "Load this snippet" 'yas-load-snippet-buffer "\C-c\C-c") ("Try out this snippet" yas-tryout-snippet "\C-c\C-t")))))
(list "Try out this snippet" 'yas-tryout-snippet "\C-c\C-t"))))) map)
map))
(defvar snippet-mode-map
(yas--init-major-keymap)
"The keymap used when `snippet-mode' is active.") "The keymap used when `snippet-mode' is active.")
@ -878,14 +874,13 @@ Honour `yas-dont-activate', which see."
(defun yas--populate-template (template &rest args) (defun yas--populate-template (template &rest args)
"Helper function to populate TEMPLATE with properties." "Helper function to populate TEMPLATE with properties."
(let (p v)
(while args (while args
(aset template (aset template
(position (intern (substring (symbol-name (car args)) 1)) (position (intern (substring (symbol-name (car args)) 1))
(mapcar #'car (get 'yas--template 'cl-struct-slots))) (mapcar #'car (get 'yas--template 'cl-struct-slots)))
(second args)) (second args))
(setq args (cddr args))) (setq args (cddr args)))
template)) template)
(defstruct (yas--table (:constructor yas--make-snippet-table (name))) (defstruct (yas--table (:constructor yas--make-snippet-table (name)))
"A table to store snippets for a particular mode. "A table to store snippets for a particular mode.
@ -916,8 +911,7 @@ Has the following fields:
`yas--table-uuidhash' `yas--table-uuidhash'
A hash table mapping snippets uuid's to the same `yas--template' A hash table mapping snippets uuid's to the same `yas--template'
objects. A snippet uuid defaults to the snippet's name. objects. A snippet uuid defaults to the snippet's name."
"
name name
(hash (make-hash-table :test 'equal)) (hash (make-hash-table :test 'equal))
(uuidhash (make-hash-table :test 'equal)) (uuidhash (make-hash-table :test 'equal))
@ -1019,7 +1013,7 @@ keybinding)."
(let ((name (yas--template-name template)) (let ((name (yas--template-name template))
(key (yas--template-key template)) (key (yas--template-key template))
(keybinding (yas--template-keybinding template)) (keybinding (yas--template-keybinding template))
(menu-binding-pair (yas--template-menu-binding-pair-get-create template))) (_menu-binding-pair (yas--template-menu-binding-pair-get-create template)))
(dolist (k (remove nil (list key keybinding))) (dolist (k (remove nil (list key keybinding)))
(puthash name (puthash name
template template
@ -1144,7 +1138,7 @@ This function implements the rules described in
templates)))) templates))))
(defun yas--require-template-specific-condition-p () (defun yas--require-template-specific-condition-p ()
"Decides if this buffer requests/requires snippet-specific "Decide if this buffer requests/requires snippet-specific
conditions to filter out potential expansions." conditions to filter out potential expansions."
(if (eq 'always yas-buffer-local-condition) (if (eq 'always yas-buffer-local-condition)
'always 'always
@ -1160,7 +1154,7 @@ conditions to filter out potential expansions."
(cdr local-condition))))))) (cdr local-condition)))))))
(defun yas--template-can-expand-p (condition requirement) (defun yas--template-can-expand-p (condition requirement)
"Evaluates CONDITION and REQUIREMENT and returns a boolean." "Evaluate CONDITION and REQUIREMENT and return a boolean."
(let* ((result (or (null condition) (let* ((result (or (null condition)
(yas--eval-condition condition)))) (yas--eval-condition condition))))
(cond ((eq requirement t) (cond ((eq requirement t)
@ -1169,7 +1163,7 @@ conditions to filter out potential expansions."
(eq requirement result))))) (eq requirement result)))))
(defun yas--all-parents (mode) (defun yas--all-parents (mode)
"Returns a list of all parent modes of MODE." "Return a list of all parent modes of MODE."
(or (gethash mode yas--ancestors) (or (gethash mode yas--ancestors)
(let ((seen '())) (let ((seen '()))
(labels ((yas--all-parents-1 (labels ((yas--all-parents-1
@ -1189,7 +1183,7 @@ conditions to filter out potential expansions."
(defun yas--table-templates (table) (defun yas--table-templates (table)
(when table (when table
(let ((acc (list))) (let ((acc (list)))
(maphash #'(lambda (key namehash) (maphash #'(lambda (_key namehash)
(maphash #'(lambda (name template) (maphash #'(lambda (name template)
(push (cons name template) acc)) (push (cons name template) acc))
namehash)) namehash))
@ -1197,8 +1191,8 @@ conditions to filter out potential expansions."
(yas--filter-templates-by-condition acc)))) (yas--filter-templates-by-condition acc))))
(defun yas--current-key () (defun yas--current-key ()
"Get the key under current position. A key is used to find "Get the key under current position.
the template of a snippet in the current snippet-table." A key is used to find the template of a snippet in the current snippet-table."
(let ((start (point)) (let ((start (point))
(end (point)) (end (point))
(syntaxes yas-key-syntaxes) (syntaxes yas-key-syntaxes)
@ -1329,8 +1323,8 @@ ensure your use `make-local-variable' when you set it.")
Return a list of `yas--table' objects. The list of modes to Return a list of `yas--table' objects. The list of modes to
consider is returned by `yas--modes-to-activate'" consider is returned by `yas--modes-to-activate'"
(remove nil (remove nil
(mapcar #'(lambda (mode-name) (mapcar #'(lambda (name)
(gethash mode-name yas--tables)) (gethash name yas--tables))
(yas--modes-to-activate)))) (yas--modes-to-activate))))
(defun yas--menu-keymap-get-create (mode &optional parents) (defun yas--menu-keymap-get-create (mode &optional parents)
@ -1356,43 +1350,6 @@ in GNU Emacs 24.1 or higher."
'(called-interactively-p) '(called-interactively-p)
`(called-interactively-p ,kind))) `(called-interactively-p ,kind)))
(defun yas--call-with-temporary-redefinitions (function
&rest function-names-and-overriding-functions)
(let* ((overrides (remove-if-not #'(lambda (fdef)
(fboundp (first fdef)))
function-names-and-overriding-functions))
(definition-names (mapcar #'first overrides))
(overriding-functions (mapcar #'second overrides))
(saved-functions (mapcar #'symbol-function definition-names)))
;; saving all definitions before overriding anything ensures FDEFINITION
;; errors don't cause accidental permanent redefinitions.
;;
(labels ((set-fdefinitions (names functions)
(loop for name in names
for fn in functions
do (fset name fn))))
(set-fdefinitions definition-names overriding-functions)
(unwind-protect (funcall function)
(set-fdefinitions definition-names saved-functions)))))
(defmacro yas--with-temporary-redefinitions (fdefinitions &rest body)
;; "Temporarily (but globally) redefine each function in FDEFINITIONS.
;; E.g.: (yas--with-temporary-redefinitions ((foo (x) ...)
;; (bar (x) ...))
;; ;; code that eventually calls foo, bar of (setf foo)
;; ...)"
`(yas--call-with-temporary-redefinitions
(lambda () ,@body)
,@(mapcar #'(lambda (thingy)
`(list ',(first thingy)
(lambda ,@(rest thingy))))
fdefinitions)))
(put 'yas--with-temporary-redefinitions 'lisp-indent-function 1)
(put 'yas--with-temporary-redefinitions 'edebug-form-spec '((&rest (defun*)) cl-declarations body))
;;; Template-related and snippet loading functions ;;; Template-related and snippet loading functions
@ -1641,12 +1598,8 @@ Optional PROMPT sets the prompt to use."
ido-mode)) ido-mode))
(yas-completing-prompt prompt choices display-fn #'ido-completing-read))) (yas-completing-prompt prompt choices display-fn #'ido-completing-read)))
(eval-when-compile (defun yas-dropdown-prompt (_prompt choices &optional display-fn)
(if (fboundp 'declare-function) (when (fboundp 'dropdown-list)
(declare-function dropdown-list "dropdown-list")))
(defun yas-dropdown-prompt (prompt choices &optional display-fn)
(when (featurep 'dropdown-list)
(let (formatted-choices (let (formatted-choices
filtered-choices filtered-choices
d d
@ -1688,7 +1641,7 @@ Optional PROMPT sets the prompt to use."
0))) 0)))
(nth position filtered-choices)))) (nth position filtered-choices))))
(defun yas-no-prompt (prompt choices &optional display-fn) (defun yas-no-prompt (_prompt choices &optional _display-fn)
(first choices)) (first choices))
@ -1697,6 +1650,8 @@ Optional PROMPT sets the prompt to use."
;; correct tables. ;; correct tables.
;; ;;
(defvar yas--creating-compiled-snippets nil)
(defun yas--define-snippets-1 (snippet snippet-table) (defun yas--define-snippets-1 (snippet snippet-table)
"Helper for `yas-define-snippets'." "Helper for `yas-define-snippets'."
;; X) Calculate some more defaults on the values returned by ;; X) Calculate some more defaults on the values returned by
@ -1747,10 +1702,10 @@ following form
Within these, only KEY and TEMPLATE are actually mandatory. Within these, only KEY and TEMPLATE are actually mandatory.
TEMPLATE might be a lisp form or a string, depending on whether TEMPLATE might be a Lisp form or a string, depending on whether
this is a snippet or a snippet-command. this is a snippet or a snippet-command.
CONDITION, EXPAND-ENV and KEYBINDING are lisp forms, they have CONDITION, EXPAND-ENV and KEYBINDING are Lisp forms, they have
been `yas--read-lisp'-ed and will eventually be been `yas--read-lisp'-ed and will eventually be
`yas--eval-lisp'-ed. `yas--eval-lisp'-ed.
@ -1764,18 +1719,54 @@ with the same uuid replaced the previous snippet.
You can use `yas--parse-template' to return such lists based on You can use `yas--parse-template' to return such lists based on
the current buffers contents." the current buffers contents."
(if yas--creating-compiled-snippets
(progn
(insert ";;; Snippet definitions:\n;;;\n")
(let ((literal-snippets (list))
(print-length nil))
(dolist (snippet snippets)
(let ((key (nth 0 snippet))
(template-content (nth 1 snippet))
(name (nth 2 snippet))
(condition (nth 3 snippet))
(group (nth 4 snippet))
(expand-env (nth 5 snippet))
(file nil) ;; omit on purpose
(binding (nth 7 snippet))
(uuid (nth 8 snippet)))
(push `(,key
,template-content
,name
,condition
,group
,expand-env
,file
,binding
,uuid)
literal-snippets)))
(insert (pp-to-string
`(yas-define-snippets ',mode ',literal-snippets)))
(insert "\n\n")))
;; Normal case.
(let ((snippet-table (yas--table-get-create mode)) (let ((snippet-table (yas--table-get-create mode))
(template nil)) (template nil))
(dolist (snippet snippets) (dolist (snippet snippets)
(setq template (yas--define-snippets-1 snippet (setq template (yas--define-snippets-1 snippet
snippet-table))) snippet-table)))
template)) template)))
;;; Loading snippets from files ;;; Loading snippets from files
(defun yas--load-yas-setup-file (file) (defun yas--load-yas-setup-file (file)
(load file 'noerror)) (if (not yas--creating-compiled-snippets)
;; Normal case.
(load file 'noerror)
(let ((elfile (concat file ".el")))
(when (file-exists-p elfile)
(insert ";;; .yas-setup.el support file if any:\n;;;\n")
(insert-file-contents elfile)
(goto-char (point-max))))))
(defun yas--define-parents (mode parents) (defun yas--define-parents (mode parents)
"Add PARENTS to the list of MODE's parents." "Add PARENTS to the list of MODE's parents."
@ -1784,13 +1775,13 @@ the current buffers contents."
(gethash mode yas--parents))) (gethash mode yas--parents)))
yas--parents)) yas--parents))
(defun yas-load-directory (top-level-dir &optional use-jit) (defun yas-load-directory (top-level-dir &optional use-jit interactive)
"Load snippets in directory hierarchy TOP-LEVEL-DIR. "Load snippets in directory hierarchy TOP-LEVEL-DIR.
Below TOP-LEVEL-DIR each directory should be a mode name. Below TOP-LEVEL-DIR each directory should be a mode name.
Optional USE-JIT use jit-loading of snippets." Optional USE-JIT use jit-loading of snippets."
(interactive "DSelect the root directory: ") (interactive "DSelect the root directory: ni\np")
(unless yas-snippet-dirs (unless yas-snippet-dirs
(setq yas-snippet-dirs top-level-dir)) (setq yas-snippet-dirs top-level-dir))
(dolist (dir (yas--subdirs top-level-dir)) (dolist (dir (yas--subdirs top-level-dir))
@ -1811,29 +1802,38 @@ Optional USE-JIT use jit-loading of snippets."
;; ;;
(yas--define-parents mode-sym parents) (yas--define-parents mode-sym parents)
(yas--menu-keymap-get-create mode-sym) (yas--menu-keymap-get-create mode-sym)
(let ((form `(yas--load-directory-1 ,dir (let ((fun `(lambda () ;; FIXME: Simulating lexical-binding.
',mode-sym (yas--load-directory-1 ',dir ',mode-sym))))
',parents)))
(if (and use-jit (if (and use-jit
(not (some #'(lambda (buffer) (not (some #'(lambda (buffer)
(with-current-buffer buffer (with-current-buffer buffer
;; FIXME: Shouldn't this use derived-mode-p?
(when (eq major-mode mode-sym) (when (eq major-mode mode-sym)
(yas--message 3 "Discovered there was already %s in %s" buffer mode-sym) (yas--message 3 "Discovered there was already %s in %s" buffer mode-sym)
t))) t)))
(buffer-list)))) (buffer-list))))
(yas--schedule-jit mode-sym form) (yas--schedule-jit mode-sym fun)
(eval form))))) (funcall fun)))))
(when (yas--called-interactively-p 'interactive) (when interactive
(yas--message 3 "Loaded snippets from %s." top-level-dir))) (yas--message 3 "Loaded snippets from %s." top-level-dir)))
(defun yas--load-directory-1 (directory mode-sym parents &optional no-compiled-snippets) (defun yas--load-directory-1 (directory mode-sym)
"Recursively load snippet templates from DIRECTORY." "Recursively load snippet templates from DIRECTORY."
(if yas--creating-compiled-snippets
(let ((output-file (expand-file-name ".yas-compiled-snippets.el"
directory)))
(with-temp-file output-file
(insert (format ";;; Compiled snippets and support files for `%s'\n"
mode-sym))
(yas--load-directory-2 directory mode-sym)
(insert (format ";;; Do not edit! File generated at %s\n"
(current-time-string)))))
;; Normal case.
(unless (file-exists-p (concat directory "/" ".yas-skip")) (unless (file-exists-p (concat directory "/" ".yas-skip"))
(if (and (not no-compiled-snippets) (if (and (progn (yas--message 2 "Loading compiled snippets from %s" directory) t)
(progn (yas--message 2 "Loading compiled snippets from %s" directory) t)
(load (expand-file-name ".yas-compiled-snippets" directory) 'noerror (<= yas-verbosity 3))) (load (expand-file-name ".yas-compiled-snippets" directory) 'noerror (<= yas-verbosity 3)))
(yas--message 2 "Loading snippet files from %s" directory) (yas--message 2 "Loading snippet files from %s" directory)
(yas--load-directory-2 directory mode-sym)))) (yas--load-directory-2 directory mode-sym)))))
(defun yas--load-directory-2 (directory mode-sym) (defun yas--load-directory-2 (directory mode-sym)
;; Load .yas-setup.el files wherever we find them ;; Load .yas-setup.el files wherever we find them
@ -1898,7 +1898,10 @@ loading."
(throw 'abort nil)) (throw 'abort nil))
;; in a non-interactive use, at least set ;; in a non-interactive use, at least set
;; `yas--editing-template' to nil, make it guess it next time around ;; `yas--editing-template' to nil, make it guess it next time around
(mapc #'(lambda (buffer) (setq yas--editing-template nil)) (buffer-list)))) (mapc #'(lambda (buffer)
(with-current-buffer buffer
(kill-local-variable 'yas--editing-template)))
(buffer-list))))
;; Empty all snippet tables and parenting info ;; Empty all snippet tables and parenting info
;; ;;
@ -1910,7 +1913,7 @@ loading."
;; mode menu parts of `yas--minor-mode-menu' (thus also cleaning ;; mode menu parts of `yas--minor-mode-menu' (thus also cleaning
;; up `yas-minor-mode-map', which points to it) ;; up `yas-minor-mode-map', which points to it)
;; ;;
(maphash #'(lambda (menu-symbol keymap) (maphash #'(lambda (menu-symbol _keymap)
(define-key yas--minor-mode-menu (vector menu-symbol) nil)) (define-key yas--minor-mode-menu (vector menu-symbol) nil))
yas--menu-table) yas--menu-table)
;; Now empty `yas--menu-table' as well ;; Now empty `yas--menu-table' as well
@ -1934,11 +1937,11 @@ loading."
(defun yas--load-pending-jits () (defun yas--load-pending-jits ()
(dolist (mode (yas--modes-to-activate)) (dolist (mode (yas--modes-to-activate))
(let ((forms (reverse (gethash mode yas--scheduled-jit-loads)))) (let ((funs (reverse (gethash mode yas--scheduled-jit-loads))))
;; must reverse to maintain coherence with `yas-snippet-dirs' ;; must reverse to maintain coherence with `yas-snippet-dirs'
(dolist (form forms) (dolist (fun funs)
(yas--message 3 "Loading for `%s', just-in-time: %s!" mode form) (yas--message 3 "Loading for `%s', just-in-time: %s!" mode fun)
(eval form)) (funcall fun))
(remhash mode yas--scheduled-jit-loads)))) (remhash mode yas--scheduled-jit-loads))))
;; (when (<= emacs-major-version 22) ;; (when (<= emacs-major-version 22)
@ -1966,49 +1969,7 @@ foo\"bar\\! -> \"foo\\\"bar\\\\!\""
This works by stubbing a few functions, then calling This works by stubbing a few functions, then calling
`yas-load-directory'." `yas-load-directory'."
(interactive "DTop level snippet directory?") (interactive "DTop level snippet directory?")
(yas--with-temporary-redefinitions (let ((yas--creating-compiled-snippets t))
((yas--load-yas-setup-file
(file)
(let ((elfile (concat file ".el")))
(when (file-exists-p elfile)
(insert ";;; .yas-setup.el support file if any:\n;;;\n")
(insert-file-contents elfile)
(goto-char (point-max))
)))
(yas-define-snippets
(mode snippets)
(insert ";;; Snippet definitions:\n;;;\n")
(let ((literal-snippets (list))
(print-length nil))
(dolist (snippet snippets)
(let ((key (first snippet))
(template-content (second snippet))
(name (third snippet))
(condition (fourth snippet))
(group (fifth snippet))
(expand-env (sixth snippet))
(file nil) ;; (seventh snippet)) ;; omit on purpose
(binding (eighth snippet))
(uuid (ninth snippet)))
(push `(,key
,template-content
,name
,condition
,group
,expand-env
,file
,binding
,uuid)
literal-snippets)))
(insert (pp-to-string `(yas-define-snippets ',mode ',literal-snippets)))
(insert "\n\n")))
(yas--load-directory-1
(dir mode parents &rest ignore)
(let ((output-file (concat (file-name-as-directory dir) ".yas-compiled-snippets.el")))
(with-temp-file output-file
(insert (format ";;; Compiled snippets and support files for `%s'\n" mode))
(yas--load-directory-2 dir mode)
(insert (format ";;; Do not edit! File generated at %s\n" (current-time-string)))))))
(yas-load-directory top-level-dir nil))) (yas-load-directory top-level-dir nil)))
(defun yas-recompile-all () (defun yas-recompile-all ()
@ -2023,11 +1984,8 @@ This works by stubbing a few functions, then calling
(defvar yas--scheduled-jit-loads (make-hash-table) (defvar yas--scheduled-jit-loads (make-hash-table)
"Alist of mode-symbols to forms to be evaled when `yas-minor-mode' kicks in.") "Alist of mode-symbols to forms to be evaled when `yas-minor-mode' kicks in.")
(defun yas--schedule-jit (mode form) (defun yas--schedule-jit (mode fun)
(puthash mode (push fun (gethash mode yas--scheduled-jit-loads)))
(cons form
(gethash mode yas--scheduled-jit-loads))
yas--scheduled-jit-loads))
@ -2077,8 +2035,9 @@ This works by stubbing a few functions, then calling
TYPE may be `:stay', signaling this menu binding should be TYPE may be `:stay', signaling this menu binding should be
static in the menu." static in the menu."
(or (yas--template-menu-binding-pair template) (or (yas--template-menu-binding-pair template)
(let ((key (yas--template-key template)) (let (;; (key (yas--template-key template))
(keybinding (yas--template-keybinding template))) ;; (keybinding (yas--template-keybinding template))
)
(setf (yas--template-menu-binding-pair template) (setf (yas--template-menu-binding-pair template)
(cons `(menu-item ,(or (yas--template-name template) (cons `(menu-item ,(or (yas--template-name template)
(yas--template-uuid template)) (yas--template-uuid template))
@ -2218,8 +2177,8 @@ Just put this function in `hippie-expand-try-functions-list'."
;;; ;;;
(defvar yas--condition-cache-timestamp nil) (defvar yas--condition-cache-timestamp nil)
(defmacro yas-define-condition-cache (func doc &rest body) (defmacro yas-define-condition-cache (func doc &rest body)
"Define a function FUNC with doc DOC and body BODY, BODY is "Define a function FUNC with doc DOC and body BODY.
executed at most once every snippet expansion attempt, to check BODY is executed at most once every snippet expansion attempt, to check
expansion conditions. expansion conditions.
It doesn't make any sense to call FUNC programatically." It doesn't make any sense to call FUNC programatically."
@ -2265,7 +2224,7 @@ object satisfying `yas--field-p' to restrict the expansion to."
(yas--expand-or-prompt-for-template (first templates-and-pos) (yas--expand-or-prompt-for-template (first templates-and-pos)
(second templates-and-pos) (second templates-and-pos)
(third templates-and-pos)) (third templates-and-pos))
(yas--fallback 'trigger-key)))) (yas--fallback))))
(defun yas-expand-from-keymap () (defun yas-expand-from-keymap ()
"Directly expand some snippets, searching `yas--direct-keymaps'. "Directly expand some snippets, searching `yas--direct-keymaps'.
@ -2273,8 +2232,7 @@ object satisfying `yas--field-p' to restrict the expansion to."
If expansion fails, execute the previous binding for this key" If expansion fails, execute the previous binding for this key"
(interactive) (interactive)
(setq yas--condition-cache-timestamp (current-time)) (setq yas--condition-cache-timestamp (current-time))
(let* ((yas--prefix current-prefix-arg) (let* ((vec (subseq (this-command-keys-vector) (if current-prefix-arg
(vec (subseq (this-command-keys-vector) (if current-prefix-arg
universal-argument-num-events universal-argument-num-events
0))) 0)))
(templates (mapcan #'(lambda (table) (templates (mapcan #'(lambda (table)
@ -2307,7 +2265,7 @@ expand immediately. Common gateway for
;; returns `org-cycle'. However, most other modes bind "TAB". TODO, ;; returns `org-cycle'. However, most other modes bind "TAB". TODO,
;; improve this explanation. ;; improve this explanation.
;; ;;
(defun yas--fallback (&optional from-trigger-key-p) (defun yas--fallback ()
"Fallback after expansion has failed. "Fallback after expansion has failed.
Common gateway for `yas-expand-from-trigger-key' and Common gateway for `yas-expand-from-trigger-key' and
@ -2335,7 +2293,7 @@ Common gateway for `yas-expand-from-trigger-key' and
nil))) nil)))
(defun yas--keybinding-beyond-yasnippet () (defun yas--keybinding-beyond-yasnippet ()
"Returns the " "Return the ??"
(let* ((yas-minor-mode nil) (let* ((yas-minor-mode nil)
(yas--direct-keymaps nil) (yas--direct-keymaps nil)
(keys (this-single-command-keys))) (keys (this-single-command-keys)))
@ -2346,7 +2304,7 @@ Common gateway for `yas-expand-from-trigger-key' and
"Emulate `read-key-sequence', at least what I think it does. "Emulate `read-key-sequence', at least what I think it does.
Keys should be an untranslated key vector. Returns a translated Keys should be an untranslated key vector. Returns a translated
vector of keys. FIXME not thoroughly tested" vector of keys. FIXME not thoroughly tested."
(let ((retval []) (let ((retval [])
(i 0)) (i 0))
(while (< i (length keys)) (while (< i (length keys))
@ -2462,7 +2420,7 @@ visited file in `snippet-mode'."
(set (make-local-variable 'yas--editing-template) template))))) (set (make-local-variable 'yas--editing-template) template)))))
(defun yas--guess-snippet-directories-1 (table) (defun yas--guess-snippet-directories-1 (table)
"Guesses possible snippet subdirectories for TABLE." "Guess possible snippet subdirectories for TABLE."
(cons (yas--table-name table) (cons (yas--table-name table)
(mapcan #'(lambda (parent) (mapcan #'(lambda (parent)
(yas--guess-snippet-directories-1 (yas--guess-snippet-directories-1
@ -2497,7 +2455,7 @@ where snippets of table might exist."
tables))) tables)))
(defun yas--make-directory-maybe (table-and-dirs &optional main-table-string) (defun yas--make-directory-maybe (table-and-dirs &optional main-table-string)
"Returns a dir inside TABLE-AND-DIRS, prompts for creation if none exists." "Return a dir inside TABLE-AND-DIRS, prompts for creation if none exists."
(or (some #'(lambda (dir) (when (file-directory-p dir) dir)) (cdr table-and-dirs)) (or (some #'(lambda (dir) (when (file-directory-p dir) dir)) (cdr table-and-dirs))
(let ((candidate (first (cdr table-and-dirs)))) (let ((candidate (first (cdr table-and-dirs))))
(unless (file-writable-p (file-name-directory candidate)) (unless (file-writable-p (file-name-directory candidate))
@ -2706,7 +2664,7 @@ whether (and where) to save the snippet, then quit the window."
(buffer (get-buffer-create "*YASnippet tables*")) (buffer (get-buffer-create "*YASnippet tables*"))
(active-tables (yas--get-snippet-tables)) (active-tables (yas--get-snippet-tables))
(remain-tables (let ((all)) (remain-tables (let ((all))
(maphash #'(lambda (k v) (maphash #'(lambda (_k v)
(unless (find v active-tables) (unless (find v active-tables)
(push v all))) (push v all)))
yas--tables) yas--tables)
@ -2737,13 +2695,13 @@ whether (and where) to save the snippet, then quit the window."
(dolist (table (append active-tables remain-tables)) (dolist (table (append active-tables remain-tables))
(insert (format "\nSnippet table `%s':\n\n" (yas--table-name table))) (insert (format "\nSnippet table `%s':\n\n" (yas--table-name table)))
(let ((keys)) (let ((keys))
(maphash #'(lambda (k v) (maphash #'(lambda (k _v)
(push k keys)) (push k keys))
(yas--table-hash table)) (yas--table-hash table))
(dolist (key keys) (dolist (key keys)
(insert (format " key %s maps snippets: %s\n" key (insert (format " key %s maps snippets: %s\n" key
(let ((names)) (let ((names))
(maphash #'(lambda (k v) (maphash #'(lambda (k _v)
(push k names)) (push k names))
(gethash key (yas--table-hash table))) (gethash key (yas--table-hash table)))
names)))))))) names))))))))
@ -2762,7 +2720,7 @@ whether (and where) to save the snippet, then quit the window."
(insert (make-string 100 ?-) "\n") (insert (make-string 100 ?-) "\n")
(insert "group state name key binding\n") (insert "group state name key binding\n")
(let ((groups-hash (make-hash-table :test #'equal))) (let ((groups-hash (make-hash-table :test #'equal)))
(maphash #'(lambda (k v) (maphash #'(lambda (_k v)
(let ((group (or (yas--template-fine-group v) (let ((group (or (yas--template-fine-group v)
"(top level)"))) "(top level)")))
(when (yas--template-name v) (when (yas--template-name v)
@ -2912,9 +2870,6 @@ Use this in primary and mirror transformations to tget."
(defvar yas--field-protection-overlays nil (defvar yas--field-protection-overlays nil
"Two overlays protect the current active field.") "Two overlays protect the current active field.")
(defconst yas--prefix nil
"A prefix argument for expansion direct from keybindings.")
(defvar yas-selected-text nil (defvar yas-selected-text nil
"The selected region deleted on the last snippet expansion.") "The selected region deleted on the last snippet expansion.")
@ -2986,7 +2941,6 @@ If there is no transform for ht field, return nil.
If there is a transform but it returns nil, return the empty If there is a transform but it returns nil, return the empty
string iff EMPTY-ON-NIL-P is true." string iff EMPTY-ON-NIL-P is true."
(let* ((yas-text (yas--field-text-for-display field)) (let* ((yas-text (yas--field-text-for-display field))
(text yas-text)
(yas-modified-p (yas--field-modified-p field)) (yas-modified-p (yas--field-modified-p field))
(yas-moving-away-p nil) (yas-moving-away-p nil)
(transform (if (yas--mirror-p field-or-mirror) (transform (if (yas--mirror-p field-or-mirror)
@ -3110,7 +3064,6 @@ If there's none, exit the snippet."
(yas--field-transform active-field)) (yas--field-transform active-field))
(let* ((yas-moving-away-p t) (let* ((yas-moving-away-p t)
(yas-text (yas--field-text-for-display active-field)) (yas-text (yas--field-text-for-display active-field))
(text yas-text)
(yas-modified-p (yas--field-modified-p active-field))) (yas-modified-p (yas--field-modified-p active-field)))
;; primary field transform: exit call to field-transform ;; primary field transform: exit call to field-transform
(yas--eval-lisp (yas--field-transform active-field)))) (yas--eval-lisp (yas--field-transform active-field))))
@ -3146,7 +3099,7 @@ Also create some protection overlays"
(setf (yas--snippet-active-field snippet) field) (setf (yas--snippet-active-field snippet) field)
;; primary field transform: first call to snippet transform ;; primary field transform: first call to snippet transform
(unless (yas--field-modified-p field) (unless (yas--field-modified-p field)
(if (yas--field-update-display field snippet) (if (yas--field-update-display field)
(yas--update-mirrors snippet) (yas--update-mirrors snippet)
(setf (yas--field-modified-p field) nil)))))) (setf (yas--field-modified-p field) nil))))))
@ -3182,11 +3135,14 @@ Also create some protection overlays"
;;; Some low level snippet-routines: ;;; Some low level snippet-routines:
(defvar yas--inhibit-overlay-hooks nil
"Bind this temporarily to non-nil to prevent running `yas--on-*-modification'.")
(defmacro yas--inhibit-overlay-hooks (&rest body) (defmacro yas--inhibit-overlay-hooks (&rest body)
"Run BODY with `yas--inhibit-overlay-hooks' set to t." "Run BODY with `yas--inhibit-overlay-hooks' set to t."
(declare (indent 0)) (declare (indent 0))
`(let ((yas--inhibit-overlay-hooks t)) `(let ((yas--inhibit-overlay-hooks t))
(progn ,@body))) ,@body))
(defvar yas-snippet-beg nil "Beginning position of the last snippet committed.") (defvar yas-snippet-beg nil "Beginning position of the last snippet committed.")
(defvar yas-snippet-end nil "End position of the last snippet committed.") (defvar yas-snippet-end nil "End position of the last snippet committed.")
@ -3244,7 +3200,7 @@ This renders the snippet as ordinary text."
(defun yas--check-commit-snippet () (defun yas--check-commit-snippet ()
"Checks if point exited the currently active field of the snippet. "Check if point exited the currently active field of the snippet.
If so cleans up the whole snippet up." If so cleans up the whole snippet up."
(let* ((snippets (yas--snippets-at-point 'all-snippets)) (let* ((snippets (yas--snippets-at-point 'all-snippets))
@ -3348,7 +3304,7 @@ This is done by setting MARKER to POINT with `set-marker'."
(eq this-command 'redo))) (eq this-command 'redo)))
(defun yas--make-control-overlay (snippet start end) (defun yas--make-control-overlay (snippet start end)
"Creates the control overlay that surrounds the snippet and "Create the control overlay that surrounds the snippet and
holds the keymap." holds the keymap."
(let ((overlay (make-overlay start (let ((overlay (make-overlay start
end end
@ -3419,10 +3375,7 @@ Move the overlay, or create it if it does not exit."
(overlay-put yas--active-field-overlay 'insert-behind-hooks (overlay-put yas--active-field-overlay 'insert-behind-hooks
'(yas--on-field-overlay-modification)))) '(yas--on-field-overlay-modification))))
(defvar yas--inhibit-overlay-hooks nil (defun yas--on-field-overlay-modification (overlay after? _beg _end &optional _length)
"Bind this temporarily to non-nil to prevent running `yas--on-*-modification'.")
(defun yas--on-field-overlay-modification (overlay after? beg end &optional length)
"Clears the field and updates mirrors, conditionally. "Clears the field and updates mirrors, conditionally.
Only clears the field if it hasn't been modified and it point it Only clears the field if it hasn't been modified and it point it
@ -3431,12 +3384,11 @@ progress."
(unless (or yas--inhibit-overlay-hooks (unless (or yas--inhibit-overlay-hooks
(yas--undo-in-progress)) (yas--undo-in-progress))
(let* ((field (overlay-get overlay 'yas--field)) (let* ((field (overlay-get overlay 'yas--field))
(number (and field (yas--field-number field)))
(snippet (overlay-get yas--active-field-overlay 'yas--snippet))) (snippet (overlay-get yas--active-field-overlay 'yas--snippet)))
(cond (after? (cond (after?
(yas--advance-end-maybe field (overlay-end overlay)) (yas--advance-end-maybe field (overlay-end overlay))
(save-excursion (save-excursion
(yas--field-update-display field snippet)) (yas--field-update-display field))
(yas--update-mirrors snippet)) (yas--update-mirrors snippet))
(field (field
(when (and (not after?) (when (and (not after?)
@ -3504,7 +3456,7 @@ Functions in the `post-command-hook', for example
nil. The variables value is the point where the violation nil. The variables value is the point where the violation
originated") originated")
(defun yas--on-protection-overlay-modification (overlay after? beg end &optional length) (defun yas--on-protection-overlay-modification (_overlay after? _beg _end &optional _length)
"Signals a snippet violation, then issues error. "Signals a snippet violation, then issues error.
The error should be ignored in `debug-ignored-errors'" The error should be ignored in `debug-ignored-errors'"
@ -3602,9 +3554,9 @@ considered when expanding the snippet."
(if expand-env (if expand-env
(eval `(let* ,expand-env (eval `(let* ,expand-env
(insert content) (insert content)
(yas--snippet-create (point-min) (point-max)))) (yas--snippet-create (point-min))))
(insert content) (insert content)
(yas--snippet-create (point-min) (point-max))))))) (yas--snippet-create (point-min)))))))
;; stacked-expansion: This checks for stacked expansion, save the ;; stacked-expansion: This checks for stacked expansion, save the
;; `yas--previous-active-field' and advance its boundary. ;; `yas--previous-active-field' and advance its boundary.
@ -3647,7 +3599,7 @@ considered when expanding the snippet."
(yas--message 3 "snippet expanded.") (yas--message 3 "snippet expanded.")
t)))) t))))
(defun yas--take-care-of-redo (beg end snippet) (defun yas--take-care-of-redo (_beg _end snippet)
"Commits SNIPPET, which in turn pushes an undo action for reviving it. "Commits SNIPPET, which in turn pushes an undo action for reviving it.
Meant to exit in the `buffer-undo-list'." Meant to exit in the `buffer-undo-list'."
@ -3659,8 +3611,8 @@ Meant to exit in the `buffer-undo-list'."
(defun yas--snippet-revive (beg end snippet) (defun yas--snippet-revive (beg end snippet)
"Revives SNIPPET and creates a control overlay from BEG to END. "Revives SNIPPET and creates a control overlay from BEG to END.
BEG and END are, we hope, the original snippets boundaries. All BEG and END are, we hope, the original snippets boundaries.
the markers/points exiting existing inside SNIPPET should point All the markers/points exiting existing inside SNIPPET should point
to their correct locations *at the time the snippet is revived*. to their correct locations *at the time the snippet is revived*.
After revival, push the `yas--take-care-of-redo' in the After revival, push the `yas--take-care-of-redo' in the
@ -3682,8 +3634,8 @@ After revival, push the `yas--take-care-of-redo' in the
(push `(apply yas--take-care-of-redo ,beg ,end ,snippet) (push `(apply yas--take-care-of-redo ,beg ,end ,snippet)
buffer-undo-list)))) buffer-undo-list))))
(defun yas--snippet-create (begin end) (defun yas--snippet-create (begin)
"Creates a snippet from an template inserted between BEGIN and END. "Create a snippet from a template inserted at BEGIN.
Returns the newly created snippet." Returns the newly created snippet."
(let ((snippet (yas--make-snippet))) (let ((snippet (yas--make-snippet)))
@ -3758,19 +3710,20 @@ Returns the newly created snippet."
This is according to their relative positions in the buffer, and This is according to their relative positions in the buffer, and
has to be called before the $-constructs are deleted." has to be called before the $-constructs are deleted."
(labels ((yas--fom-set-next-fom (fom nextfom) (let* ((fom-set-next-fom
(lambda (fom nextfom)
(cond ((yas--field-p fom) (cond ((yas--field-p fom)
(setf (yas--field-next fom) nextfom)) (setf (yas--field-next fom) nextfom))
((yas--mirror-p fom) ((yas--mirror-p fom)
(setf (yas--mirror-next fom) nextfom)) (setf (yas--mirror-next fom) nextfom))
(t (t
(setf (yas--exit-next fom) nextfom)))) (setf (yas--exit-next fom) nextfom)))))
(yas--compare-fom-begs (fom1 fom2) (compare-fom-begs
(lambda (fom1 fom2)
(if (= (yas--fom-start fom2) (yas--fom-start fom1)) (if (= (yas--fom-start fom2) (yas--fom-start fom1))
(yas--mirror-p fom2) (yas--mirror-p fom2)
(>= (yas--fom-start fom2) (yas--fom-start fom1)))) (>= (yas--fom-start fom2) (yas--fom-start fom1)))))
(yas--link-foms (fom1 fom2) (link-foms fom-set-next-fom))
(yas--fom-set-next-fom fom1 fom2)))
;; make some yas--field, yas--mirror and yas--exit soup ;; make some yas--field, yas--mirror and yas--exit soup
(let ((soup)) (let ((soup))
(when (yas--snippet-exit snippet) (when (yas--snippet-exit snippet)
@ -3780,10 +3733,9 @@ has to be called before the $-constructs are deleted."
(dolist (mirror (yas--field-mirrors field)) (dolist (mirror (yas--field-mirrors field))
(push mirror soup))) (push mirror soup)))
(setq soup (setq soup
(sort soup (sort soup compare-fom-begs))
#'yas--compare-fom-begs))
(when soup (when soup
(reduce #'yas--link-foms soup))))) (reduce link-foms soup)))))
(defun yas--calculate-mirrors-in-fields (snippet mirror) (defun yas--calculate-mirrors-in-fields (snippet mirror)
"Attempt to assign a parent field of SNIPPET to the mirror MIRROR. "Attempt to assign a parent field of SNIPPET to the mirror MIRROR.
@ -3846,7 +3798,7 @@ cons cells to this var.")
(defvar yas--backquote-markers-and-strings nil (defvar yas--backquote-markers-and-strings nil
"List of (MARKER . STRING) marking where the values from "List of (MARKER . STRING) marking where the values from
backquoted lisp expressions should be inserted at the end of backquoted Lisp expressions should be inserted at the end of
expansion.") expansion.")
(defun yas--snippet-parse-create (snippet) (defun yas--snippet-parse-create (snippet)
@ -3927,7 +3879,7 @@ Meant to be called in a narrowed buffer, does various passes"
snippet-markers))) snippet-markers)))
(save-restriction (save-restriction
(widen) (widen)
(condition-case err (condition-case _
(indent-according-to-mode) (indent-according-to-mode)
(error (yas--message 3 "Warning: `yas--indent-according-to-mode' having problems running %s" indent-line-function) (error (yas--message 3 "Warning: `yas--indent-according-to-mode' having problems running %s" indent-line-function)
nil))) nil)))
@ -4048,7 +4000,7 @@ with their evaluated value into `yas--backquote-markers-and-strings'."
(set-marker marker nil))))) (set-marker marker nil)))))
(defun yas--scan-sexps (from count) (defun yas--scan-sexps (from count)
(condition-case err (condition-case _
(with-syntax-table (standard-syntax-table) (with-syntax-table (standard-syntax-table)
(scan-sexps from count)) (scan-sexps from count))
(error (error
@ -4067,7 +4019,7 @@ The following count as a field:
* \"${n: text}\", for a numbered field with default text, as long as N is not 0; * \"${n: text}\", for a numbered field with default text, as long as N is not 0;
* \"${n: text$(expression)}, the same with a lisp expression; * \"${n: text$(expression)}, the same with a Lisp expression;
this is caught with the curiously named `yas--multi-dollar-lisp-expression-regexp' this is caught with the curiously named `yas--multi-dollar-lisp-expression-regexp'
* the same as above but unnumbered, (no N:) and number is calculated automatically. * the same as above but unnumbered, (no N:) and number is calculated automatically.
@ -4225,7 +4177,7 @@ When multiple expressions are found, only the last one counts."
0)))))) 0))))))
(defun yas--update-mirrors (snippet) (defun yas--update-mirrors (snippet)
"Updates all the mirrors of SNIPPET." "Update all the mirrors of SNIPPET."
(save-excursion (save-excursion
(dolist (field-and-mirror (sort (dolist (field-and-mirror (sort
;; make a list of ((F1 . M1) (F1 . M2) (F2 . M3) (F2 . M4) ...) ;; make a list of ((F1 . M1) (F1 . M2) (F2 . M3) (F2 . M4) ...)
@ -4283,12 +4235,11 @@ When multiple expressions are found, only the last one counts."
;; super-special advance ;; super-special advance
(yas--advance-end-of-parents-maybe mirror-parent-field (point)))))) (yas--advance-end-of-parents-maybe mirror-parent-field (point))))))
(defun yas--field-update-display (field snippet) (defun yas--field-update-display (field)
"Much like `yas--mirror-update-display', but for fields." "Much like `yas--mirror-update-display', but for fields."
(when (yas--field-transform field) (when (yas--field-transform field)
(let ((transformed (and (not (eq (yas--field-number field) 0)) (let ((transformed (and (not (eq (yas--field-number field) 0))
(yas--apply-transform field field))) (yas--apply-transform field field))))
(point (point)))
(when (and transformed (when (and transformed
(not (string= transformed (buffer-substring-no-properties (yas--field-start field) (not (string= transformed (buffer-substring-no-properties (yas--field-start field)
(yas--field-end field))))) (yas--field-end field)))))
@ -4404,16 +4355,6 @@ object satisfying `yas--field-p' to restrict the expansion to.")))
(help-xref-button 1 'help-snippet-def template) (help-xref-button 1 'help-snippet-def template)
(kill-region (match-end 1) (match-end 0)) (kill-region (match-end 1) (match-end 0))
(kill-region (match-beginning 0) (match-beginning 1))))))) (kill-region (match-beginning 0) (match-beginning 1)))))))
(defun yas--expand-uuid (mode-symbol uuid &optional start end expand-env)
"Expand a snippet registered in MODE-SYMBOL's table with UUID.
Remaining args as in `yas-expand-snippet'."
(let* ((table (gethash mode-symbol yas--tables))
(yas--current-template (and table
(gethash uuid (yas--table-uuidhash table)))))
(when yas--current-template
(yas-expand-snippet (yas--template-content yas--current-template)))))
;;; Utils ;;; Utils
@ -4464,11 +4405,6 @@ and return the directory. Return nil if not found."
;; `name' in /home or in /. ;; `name' in /home or in /.
(setq file (abbreviate-file-name file)) (setq file (abbreviate-file-name file))
(let ((root nil) (let ((root nil)
(prev-file file)
;; `user' is not initialized outside the loop because
;; `file' may not exist, so we may have to walk up part of the
;; hierarchy before we find the "initial UUID".
(user nil)
try) try)
(while (not (or root (while (not (or root
(null file) (null file)
@ -4485,8 +4421,7 @@ and return the directory. Return nil if not found."
(string-match locate-dominating-stop-dir-regexp file))) (string-match locate-dominating-stop-dir-regexp file)))
(setq try (file-exists-p (expand-file-name name file))) (setq try (file-exists-p (expand-file-name name file)))
(cond (try (setq root file)) (cond (try (setq root file))
((equal file (setq prev-file file ((equal file (setq file (file-name-directory
file (file-name-directory
(directory-file-name file)))) (directory-file-name file))))
(setq file nil)))) (setq file nil))))
root)))) root))))
@ -4506,7 +4441,7 @@ and return the directory. Return nil if not found."
(defadvice c-neutralize-syntax-in-CPP (defadvice c-neutralize-syntax-in-CPP
(around yas--mp/c-neutralize-syntax-in-CPP activate) (around yas--mp/c-neutralize-syntax-in-CPP activate)
"Adviced `c-neutralize-syntax-in-CPP' to properly "Adviced `c-neutralize-syntax-in-CPP' to properly
handle the end-of-buffer error fired in it by calling handle the `end-of-buffer' error fired in it by calling
`forward-char' at the end of buffer." `forward-char' at the end of buffer."
(condition-case err (condition-case err
ad-do-it ad-do-it