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

Cleanup redundant cl dependency, :group & :require

Browse Source 
* yasnippet.el: Replace calls to cl functions with cl- prefixed cl-lib
equivalents.  Use #' to quote function symbols.
(yas-snippet-dirs, yas-new-snippet-default, yas-prompt-functions):
(yas-indent-line, yas-also-auto-indent-first-line):
(yas-snippet-revival, yas-triggers-in-field):
(yas-fallback-behavior, yas-choose-keys-first, yas-choose-tables-first):
(yas-use-menu, yas-trigger-symbol, yas-wrap-around-region):
(yas-good-grace, yas-visit-from-menu, yas-expand-only-for-last-commands):
(yas-field-highlight-face, yas--field-debug-face): Remove redundant
:group.
(yas-snippet-dirs, yas-global-mode): Remove :require.  The :set value
for yas-snippet-dirs checks if yas-reload-all is fbound, and the
autoload cookie on yas-global-mode makes :require redundant.
This commit is contained in:
Stefan Monnier 2016-07-31 08:17:55 -04:00 committed by Noam Postavsky
parent 7e0a0de499
commit 5264379908
1 changed files with 164 additions and 182 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

346
yasnippet.el
View File

@ -131,7 +131,6 @@
;;; Code: ;;; Code:
(require 'cl)
(require 'cl-lib) (require 'cl-lib)
(require 'easymenu) (require 'easymenu)
(require 'help-mode) (require 'help-mode)
@ -178,8 +177,6 @@ created with `yas-new-snippet'. "
:type '(choice (directory :tag "Single directory") :type '(choice (directory :tag "Single directory")
(repeat :tag "List of directories" (repeat :tag "List of directories"
(choice (directory) (variable)))) (choice (directory) (variable))))
:group 'yasnippet
:require 'yasnippet
:set #'(lambda (symbol new) :set #'(lambda (symbol new)
(let ((old (and (boundp symbol) (let ((old (and (boundp symbol)
(symbol-value symbol)))) (symbol-value symbol))))
@ -210,8 +207,7 @@ created with `yas-new-snippet'. "
$0`(yas-escape-text yas-selected-text)`" $0`(yas-escape-text yas-selected-text)`"
"Default snippet to use when creating a new snippet. "Default snippet to use when creating a new snippet.
If nil, don't use any snippet." If nil, don't use any snippet."
:type 'string :type 'string)
:group 'yasnippet)
(defcustom yas-prompt-functions '(yas-dropdown-prompt (defcustom yas-prompt-functions '(yas-dropdown-prompt
yas-completing-prompt yas-completing-prompt
@ -240,8 +236,7 @@ nil.
signal `quit' with signal `quit' with
(signal \\='quit \"user quit!\")." (signal \\='quit \"user quit!\")."
:type '(repeat function) :type '(repeat function))
:group 'yasnippet)
(defcustom yas-indent-line 'auto (defcustom yas-indent-line 'auto
"Controls indenting applied to a recent snippet expansion. "Controls indenting applied to a recent snippet expansion.
@ -257,28 +252,24 @@ after expansion (the manual per-line \"$>\" indentation still
applies)." applies)."
:type '(choice (const :tag "Nothing" nothing) :type '(choice (const :tag "Nothing" nothing)
(const :tag "Fixed" fixed) (const :tag "Fixed" fixed)
(const :tag "Auto" auto)) (const :tag "Auto" auto)))
:group 'yasnippet)
(defcustom yas-also-auto-indent-first-line nil (defcustom yas-also-auto-indent-first-line nil
"Non-nil means also auto indent first line according to mode. "Non-nil means also auto indent first line according to mode.
Naturally this is only valid when `yas-indent-line' is `auto'" Naturally this is only valid when `yas-indent-line' is `auto'"
:type 'boolean :type 'boolean)
:group 'yasnippet)
(defcustom yas-snippet-revival t (defcustom yas-snippet-revival t
"Non-nil means re-activate snippet fields after undo/redo." "Non-nil means re-activate snippet fields after undo/redo."
:type 'boolean :type 'boolean)
:group 'yasnippet)
(defcustom yas-triggers-in-field nil (defcustom yas-triggers-in-field nil
"If non-nil, allow stacked expansions (snippets inside snippets). "If non-nil, allow stacked expansions (snippets inside snippets).
Otherwise `yas-next-field-or-maybe-expand' just moves on to the Otherwise `yas-next-field-or-maybe-expand' just moves on to the
next field" next field"
:type 'boolean :type 'boolean)
:group 'yasnippet)
(defcustom yas-fallback-behavior 'call-other-command (defcustom yas-fallback-behavior 'call-other-command
"How to act when `yas-expand' does *not* expand a snippet. "How to act when `yas-expand' does *not* expand a snippet.
@ -294,8 +285,7 @@ next field"
COMMAND. If ARGS is non-nil, call COMMAND non-interactively COMMAND. If ARGS is non-nil, call COMMAND non-interactively
with ARGS as arguments." with ARGS as arguments."
:type '(choice (const :tag "Call previous command" call-other-command) :type '(choice (const :tag "Call previous command" call-other-command)
(const :tag "Do nothing" return-nil)) (const :tag "Do nothing" return-nil)))
:group 'yasnippet)
(defcustom yas-choose-keys-first nil (defcustom yas-choose-keys-first nil
"If non-nil, prompt for snippet key first, then for template. "If non-nil, prompt for snippet key first, then for template.
@ -303,8 +293,7 @@ next field"
Otherwise prompts for all possible snippet names. Otherwise prompts for all possible snippet names.
This affects `yas-insert-snippet' and `yas-visit-snippet-file'." This affects `yas-insert-snippet' and `yas-visit-snippet-file'."
:type 'boolean :type 'boolean)
:group 'yasnippet)
(defcustom yas-choose-tables-first nil (defcustom yas-choose-tables-first nil
"If non-nil, and multiple eligible snippet tables, prompts user for tables first. "If non-nil, and multiple eligible snippet tables, prompts user for tables first.
@ -313,8 +302,7 @@ Otherwise, user chooses between the merging together of all
eligible tables. eligible tables.
This affects `yas-insert-snippet', `yas-visit-snippet-file'" This affects `yas-insert-snippet', `yas-visit-snippet-file'"
:type 'boolean :type 'boolean)
:group 'yasnippet)
(defcustom yas-use-menu 'abbreviate (defcustom yas-use-menu 'abbreviate
"Display a YASnippet menu in the menu bar. "Display a YASnippet menu in the menu bar.
@ -332,16 +320,14 @@ menu and the modes set in `yas--extra-modes' are listed.
Any other non-nil value, every submenu is listed." Any other non-nil value, every submenu is listed."
:type '(choice (const :tag "Full" full) :type '(choice (const :tag "Full" full)
(const :tag "Abbreviate" abbreviate) (const :tag "Abbreviate" abbreviate)
(const :tag "No menu" nil)) (const :tag "No menu" nil)))
:group 'yasnippet)
(defcustom yas-trigger-symbol (or (and (eq window-system 'mac) (defcustom yas-trigger-symbol (or (and (eq window-system 'mac)
(ignore-errors (ignore-errors
(char-to-string ?\x21E5))) ;; little ->| sign (char-to-string ?\x21E5))) ;; little ->| sign
" =>") " =>")
"The text that will be used in menu to represent the trigger." "The text that will be used in menu to represent the trigger."
:type 'string :type 'string)
:group 'yasnippet)
(defcustom yas-wrap-around-region nil (defcustom yas-wrap-around-region nil
"What to insert for snippet's $0 field. "What to insert for snippet's $0 field.
@ -353,22 +339,19 @@ per-snippet basis. A value of `cua' is considered equivalent to
:type '(choice (character :tag "Insert from register") :type '(choice (character :tag "Insert from register")
(const t :tag "Insert region contents") (const t :tag "Insert region contents")
(const nil :tag "Don't insert anything") (const nil :tag "Don't insert anything")
(const cua)) ; backwards compat (const cua))) ; backwards compat
:group 'yasnippet)
(defcustom yas-good-grace t (defcustom yas-good-grace t
"If non-nil, don't raise errors in inline elisp evaluation. "If non-nil, don't raise errors in inline elisp evaluation.
An error string \"[yas] error\" is returned instead." An error string \"[yas] error\" is returned instead."
:type 'boolean :type 'boolean)
:group 'yasnippet)
(defcustom yas-visit-from-menu nil (defcustom yas-visit-from-menu nil
"If non-nil visit snippets's files from menu, instead of expanding them. "If non-nil visit snippets's files from menu, instead of expanding them.
This can only work when snippets are loaded from files." This can only work when snippets are loaded from files."
:type 'boolean :type 'boolean)
:group 'yasnippet)
(defcustom yas-expand-only-for-last-commands nil (defcustom yas-expand-only-for-last-commands nil
"List of `last-command' values to restrict tab-triggering to, or nil. "List of `last-command' values to restrict tab-triggering to, or nil.
@ -381,8 +364,7 @@ Optionally, set this to something like (self-insert-command) if
you to wish restrict expansion to only happen when the last you to wish restrict expansion to only happen when the last
letter of the snippet tab trigger was typed immediately before letter of the snippet tab trigger was typed immediately before
the trigger key itself." the trigger key itself."
:type '(repeat function) :type '(repeat function))
:group 'yasnippet)
(defcustom yas-alias-to-yas/prefix-p t (defcustom yas-alias-to-yas/prefix-p t
"If non-nil make aliases for the old style yas/ prefixed symbols. "If non-nil make aliases for the old style yas/ prefixed symbols.
@ -394,13 +376,11 @@ It must be set to nil before loading yasnippet to take effect."
;; ;;
(defface yas-field-highlight-face (defface yas-field-highlight-face
'((t (:inherit 'region))) '((t (:inherit 'region)))
"The face used to highlight the currently active field of a snippet" "The face used to highlight the currently active field of a snippet")
:group 'yasnippet)
(defface yas--field-debug-face (defface yas--field-debug-face
'() '()
"The face used for debugging some overlays normally hidden" "The face used for debugging some overlays normally hidden")
:group 'yasnippet)
;;; User-visible variables ;;; User-visible variables
@ -637,33 +617,33 @@ snippet itself contains a condition that returns the symbol
) )
("Prompting method" ("Prompting method"
["System X-widget" (setq yas-prompt-functions ["System X-widget" (setq yas-prompt-functions
(cons 'yas-x-prompt (cons #'yas-x-prompt
(remove 'yas-x-prompt (remove #'yas-x-prompt
yas-prompt-functions))) yas-prompt-functions)))
:help "Use your windowing system's (gtk, mac, windows, etc...) default menu" :help "Use your windowing system's (gtk, mac, windows, etc...) default menu"
:active t :style radio :selected (eq (car yas-prompt-functions) :active t :style radio :selected (eq (car yas-prompt-functions)
'yas-x-prompt)] #'yas-x-prompt)]
["Dropdown-list" (setq yas-prompt-functions ["Dropdown-list" (setq yas-prompt-functions
(cons 'yas-dropdown-prompt (cons #'yas-dropdown-prompt
(remove 'yas-dropdown-prompt (remove #'yas-dropdown-prompt
yas-prompt-functions))) yas-prompt-functions)))
:help "Use a special dropdown list" :help "Use a special dropdown list"
:active t :style radio :selected (eq (car yas-prompt-functions) :active t :style radio :selected (eq (car yas-prompt-functions)
'yas-dropdown-prompt)] #'yas-dropdown-prompt)]
["Ido" (setq yas-prompt-functions ["Ido" (setq yas-prompt-functions
(cons 'yas-ido-prompt (cons #'yas-ido-prompt
(remove 'yas-ido-prompt (remove #'yas-ido-prompt
yas-prompt-functions))) yas-prompt-functions)))
:help "Use an ido-style minibuffer prompt" :help "Use an ido-style minibuffer prompt"
:active t :style radio :selected (eq (car yas-prompt-functions) :active t :style radio :selected (eq (car yas-prompt-functions)
'yas-ido-prompt)] #'yas-ido-prompt)]
["Completing read" (setq yas-prompt-functions ["Completing read" (setq yas-prompt-functions
(cons 'yas-completing-prompt (cons #'yas-completing-prompt
(remove 'yas-completing-prompt (remove #'yas-completing-prompt
yas-prompt-functions))) yas-prompt-functions)))
:help "Use a normal minibuffer prompt" :help "Use a normal minibuffer prompt"
:active t :style radio :selected (eq (car yas-prompt-functions) :active t :style radio :selected (eq (car yas-prompt-functions)
'yas-completing-prompt)] #'yas-completing-prompt)]
) )
("Misc" ("Misc"
["Wrap region in exit marker" ["Wrap region in exit marker"
@ -776,10 +756,7 @@ Negative prefix argument turns off the mode.
Key bindings: Key bindings:
\\{yas-minor-mode-map}" \\{yas-minor-mode-map}"
nil :lighter " yas" ;; The indicator for the mode line.
;; The indicator for the mode line.
" yas"
:group 'yasnippet
(cond ((and yas-minor-mode (featurep 'yasnippet)) (cond ((and yas-minor-mode (featurep 'yasnippet))
;; Install the direct keymaps in `emulation-mode-map-alists' ;; Install the direct keymaps in `emulation-mode-map-alists'
;; (we use `add-hook' even though it's not technically a hook, ;; (we use `add-hook' even though it's not technically a hook,
@ -872,9 +849,7 @@ Honour `yas-dont-activate-functions', which see."
(yas-minor-mode 1))) (yas-minor-mode 1)))
;;;###autoload ;;;###autoload
(define-globalized-minor-mode yas-global-mode yas-minor-mode yas-minor-mode-on (define-globalized-minor-mode yas-global-mode yas-minor-mode yas-minor-mode-on)
:group 'yasnippet
:require 'yasnippet)
(defun yas--global-mode-reload-with-jit-maybe () (defun yas--global-mode-reload-with-jit-maybe ()
"Run `yas-reload-all' when `yas-global-mode' is on." "Run `yas-reload-all' when `yas-global-mode' is on."
@ -913,9 +888,9 @@ Honour `yas-dont-activate-functions', which see."
"Menu used when snippet-mode is active." "Menu used when snippet-mode is active."
(cons "Snippet" (cons "Snippet"
(mapcar #'(lambda (ent) (mapcar #'(lambda (ent)
(when (third ent) (when (nth 2 ent)
(define-key map (third ent) (second ent))) (define-key map (nth 2 ent) (nth 1 ent)))
(vector (first ent) (second ent) t)) (vector (nth 0 ent) (nth 1 ent) t))
'(("Load this snippet" yas-load-snippet-buffer "\C-c\C-l") '(("Load this snippet" yas-load-snippet-buffer "\C-c\C-l")
("Load and quit window" yas-load-snippet-buffer-and-close "\C-c\C-c") ("Load and quit window" yas-load-snippet-buffer-and-close "\C-c\C-c")
("Try out this snippet" yas-tryout-snippet "\C-c\C-t"))))) ("Try out this snippet" yas-tryout-snippet "\C-c\C-t")))))
@ -977,7 +952,7 @@ Honour `yas-dont-activate-functions', which see."
table table
) )
(defstruct (yas--table (:constructor yas--make-snippet-table (name))) (cl-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.
Has the following fields: Has the following fields:
@ -1152,9 +1127,9 @@ Return TEMPLATE."
(unless (eq (cdr menu-binding-pair) :none) (unless (eq (cdr menu-binding-pair) :none)
;; the menu item name ;; the menu item name
;; ;;
(setf (cadar menu-binding-pair) (yas--template-name template)) (setf (cl-cadar menu-binding-pair) (yas--template-name template))
;; the :keys information (also visible to the user) ;; the :keys information (also visible to the user)
(setf (getf (cdr (car menu-binding-pair)) :keys) (setf (cl-getf (cdr (car menu-binding-pair)) :keys)
(or (and keybinding (key-description keybinding)) (or (and keybinding (key-description keybinding))
(and key (concat key yas-trigger-symbol)))))) (and key (concat key yas-trigger-symbol))))))
(unless (yas--template-menu-managed-by-yas-define-menu template) (unless (yas--template-menu-managed-by-yas-define-menu template)
@ -1165,7 +1140,7 @@ Return TEMPLATE."
(group (yas--template-group template))) (group (yas--template-group template)))
;; Remove from menu keymap ;; Remove from menu keymap
;; ;;
(assert menu-keymap) (cl-assert menu-keymap)
(yas--delete-from-keymap menu-keymap (yas--template-uuid template)) (yas--delete-from-keymap menu-keymap (yas--template-uuid template))
;; Add necessary subgroups as necessary. ;; Add necessary subgroups as necessary.
@ -1228,10 +1203,10 @@ This function implements the rules described in
(let ((requirement (yas--require-template-specific-condition-p))) (let ((requirement (yas--require-template-specific-condition-p)))
(if (eq requirement 'always) (if (eq requirement 'always)
templates templates
(remove-if-not #'(lambda (pair) (cl-remove-if-not (lambda (pair)
(yas--template-can-expand-p (yas--template-can-expand-p
(yas--template-condition (cdr pair)) requirement)) (yas--template-condition (cdr pair)) requirement))
templates)))) templates))))
(defun yas--require-template-specific-condition-p () (defun yas--require-template-specific-condition-p ()
"Decide if this buffer requests/requires snippet-specific "Decide if this buffer requests/requires snippet-specific
@ -1300,9 +1275,9 @@ Returns (TEMPLATES START END). This function respects
(save-excursion (save-excursion
(goto-char original) (goto-char original)
(setq templates (setq templates
(mapcan #'(lambda (table) (cl-mapcan (lambda (table)
(yas--fetch table possible-key)) (yas--fetch table possible-key))
(yas--get-snippet-tables)))))) (yas--get-snippet-tables))))))
(when templates (when templates
(list templates (point) original))))) (list templates (point) original)))))
@ -1556,31 +1531,31 @@ Optional PROMPT sets the prompt to use."
(sort templates #'(lambda (t1 t2) (sort templates #'(lambda (t1 t2)
(< (length (yas--template-name t1)) (< (length (yas--template-name t1))
(length (yas--template-name t2)))))) (length (yas--template-name t2))))))
(some #'(lambda (fn) (cl-some (lambda (fn)
(funcall fn (or prompt "Choose a snippet: ") (funcall fn (or prompt "Choose a snippet: ")
templates templates
#'yas--template-name)) #'yas--template-name))
yas-prompt-functions))) yas-prompt-functions)))
(defun yas--prompt-for-keys (keys &optional prompt) (defun yas--prompt-for-keys (keys &optional prompt)
"Interactively choose a template key from the list KEYS. "Interactively choose a template key from the list KEYS.
Optional PROMPT sets the prompt to use." Optional PROMPT sets the prompt to use."
(when keys (when keys
(some #'(lambda (fn) (cl-some (lambda (fn)
(funcall fn (or prompt "Choose a snippet key: ") keys)) (funcall fn (or prompt "Choose a snippet key: ") keys))
yas-prompt-functions))) yas-prompt-functions)))
(defun yas--prompt-for-table (tables &optional prompt) (defun yas--prompt-for-table (tables &optional prompt)
"Interactively choose a table from the list TABLES. "Interactively choose a table from the list TABLES.
Optional PROMPT sets the prompt to use." Optional PROMPT sets the prompt to use."
(when tables (when tables
(some #'(lambda (fn) (cl-some (lambda (fn)
(funcall fn (or prompt "Choose a snippet table: ") (funcall fn (or prompt "Choose a snippet table: ")
tables tables
#'yas--table-name)) #'yas--table-name))
yas-prompt-functions))) yas-prompt-functions)))
(defun yas-x-prompt (prompt choices &optional display-fn) (defun yas-x-prompt (prompt choices &optional display-fn)
"Display choices in a x-window prompt." "Display choices in a x-window prompt."
@ -1597,9 +1572,10 @@ Optional PROMPT sets the prompt to use."
(selected-window))) (selected-window)))
t) t)
`(,prompt ("title" `(,prompt ("title"
,@(mapcar* (lambda (c d) `(,(concat " " d) . ,c)) ,@(cl-mapcar (lambda (c d) `(,(concat " " d) . ,c))
choices choices
(if display-fn (mapcar display-fn choices) choices))))) (if display-fn (mapcar display-fn choices)
choices)))))
(keyboard-quit)))) (keyboard-quit))))
(defun yas-maybe-ido-prompt (prompt choices &optional display-fn) (defun yas-maybe-ido-prompt (prompt choices &optional display-fn)
@ -1626,11 +1602,11 @@ Optional PROMPT sets the prompt to use."
nil 'require-match nil nil))) nil 'require-match nil nil)))
(if (eq choices formatted-choices) (if (eq choices formatted-choices)
chosen chosen
(nth (or (position chosen formatted-choices :test #'string=) 0) (nth (or (cl-position chosen formatted-choices :test #'string=) 0)
choices)))) choices))))
(defun yas-no-prompt (_prompt choices &optional _display-fn) (defun yas-no-prompt (_prompt choices &optional _display-fn)
(first choices)) (cl-first choices))
;;; Defining snippets ;;; Defining snippets
@ -1720,7 +1696,7 @@ the current buffers contents."
(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."
(puthash mode (remove-duplicates (puthash mode (cl-remove-duplicates
(append parents (append parents
(gethash mode yas--parents))) (gethash mode yas--parents)))
yas--parents)) yas--parents))
@ -1852,9 +1828,10 @@ prefix argument."
(catch 'abort (catch 'abort
(let ((errors) (let ((errors)
(snippet-editing-buffers (snippet-editing-buffers
(remove-if-not #'(lambda (buffer) (cl-remove-if-not (lambda (buffer)
(with-current-buffer buffer yas--editing-template)) (with-current-buffer buffer
(buffer-list)))) yas--editing-template))
(buffer-list))))
;; Warn if there are buffers visiting snippets, since reloading will break ;; Warn if there are buffers visiting snippets, since reloading will break
;; any on-line editing of those buffers. ;; any on-line editing of those buffers.
;; ;;
@ -2011,10 +1988,9 @@ static in the menu."
(defun yas--show-menu-p (mode) (defun yas--show-menu-p (mode)
(cond ((eq yas-use-menu 'abbreviate) (cond ((eq yas-use-menu 'abbreviate)
(find mode (cl-find mode
(mapcar #'(lambda (table) (mapcar #'yas--table-mode
(yas--table-mode table)) (yas--get-snippet-tables))))
(yas--get-snippet-tables))))
(yas-use-menu t))) (yas-use-menu t)))
(defun yas--delete-from-keymap (keymap uuid) (defun yas--delete-from-keymap (keymap uuid)
@ -2028,19 +2004,19 @@ static in the menu."
;; ;;
(mapc #'(lambda (item) (mapc #'(lambda (item)
(when (and (listp (cdr item)) (when (and (listp (cdr item))
(keymapp (third (cdr item)))) (keymapp (nth 2 (cdr item))))
(yas--delete-from-keymap (third (cdr item)) uuid))) (yas--delete-from-keymap (nth 2 (cdr item)) uuid)))
(rest keymap)) (cdr keymap))
;; Set the uuid entry to nil ;; Set the uuid entry to nil
;; ;;
(define-key keymap (vector (make-symbol uuid)) nil) (define-key keymap (vector (make-symbol uuid)) nil)
;; Destructively modify keymap ;; Destructively modify keymap
;; ;;
(setcdr keymap (delete-if #'(lambda (item) (setcdr keymap (cl-delete-if (lambda (item)
(or (null (cdr item)) (or (null (cdr item))
(and (keymapp (third (cdr item))) (and (keymapp (nth 2 (cdr item)))
(null (cdr (third (cdr item))))))) (null (cdr (nth 2 (cdr item)))))))
(rest keymap)))) (cdr keymap))))
(defun yas-define-menu (mode menu &optional omit-items) (defun yas-define-menu (mode menu &optional omit-items)
"Define a snippet menu for MODE according to MENU, omitting OMIT-ITEMS. "Define a snippet menu for MODE according to MENU, omitting OMIT-ITEMS.
@ -2087,13 +2063,13 @@ omitted from MODE's menu, even if they're manually loaded."
:perm-group group-list :perm-group group-list
:uuid name) :uuid name)
uuidhash)))) uuidhash))))
(define-key menu-keymap (vector (gensym)) (define-key menu-keymap (vector (cl-gensym))
(car (yas--template-menu-binding-pair-get-create template :stay)))) (car (yas--template-menu-binding-pair-get-create template :stay))))
else if (or (eq type 'yas-submenu) else if (or (eq type 'yas-submenu)
(and yas-alias-to-yas/prefix-p (and yas-alias-to-yas/prefix-p
(eq type 'yas/submenu))) (eq type 'yas/submenu)))
do (let ((subkeymap (make-sparse-keymap))) do (let ((subkeymap (make-sparse-keymap)))
(define-key menu-keymap (vector (gensym)) (define-key menu-keymap (vector (cl-gensym))
`(menu-item ,name ,subkeymap)) `(menu-item ,name ,subkeymap))
(yas--define-menu-1 table (yas--define-menu-1 table
subkeymap subkeymap
@ -2103,7 +2079,7 @@ omitted from MODE's menu, even if they're manually loaded."
else if (or (eq type 'yas-separator) else if (or (eq type 'yas-separator)
(and yas-alias-to-yas/prefix-p (and yas-alias-to-yas/prefix-p
(eq type 'yas/separator))) (eq type 'yas/separator)))
do (define-key menu-keymap (vector (gensym)) do (define-key menu-keymap (vector (cl-gensym))
'(menu-item "----")) '(menu-item "----"))
else do (yas--message 1 "Don't know anything about menu entry %s" type))) else do (yas--message 1 "Don't know anything about menu entry %s" type)))
@ -2194,12 +2170,13 @@ 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* ((vec (subseq (this-command-keys-vector) (if current-prefix-arg (let* ((vec (cl-subseq (this-command-keys-vector)
(length (this-command-keys)) (if current-prefix-arg
0))) (length (this-command-keys))
(templates (mapcan #'(lambda (table) 0)))
(yas--fetch table vec)) (templates (cl-mapcan (lambda (table)
(yas--get-snippet-tables)))) (yas--fetch table vec))
(yas--get-snippet-tables))))
(if templates (if templates
(yas--expand-or-prompt-for-template templates) (yas--expand-or-prompt-for-template templates)
(let ((yas-fallback-behavior 'call-other-command)) (let ((yas-fallback-behavior 'call-other-command))
@ -2211,7 +2188,7 @@ If expansion fails, execute the previous binding for this key"
Prompt the user if TEMPLATES has more than one element, else Prompt the user if TEMPLATES has more than one element, else
expand immediately. Common gateway for expand immediately. Common gateway for
`yas-expand-from-trigger-key' and `yas-expand-from-keymap'." `yas-expand-from-trigger-key' and `yas-expand-from-keymap'."
(let ((yas--current-template (or (and (rest templates) ;; more than one (let ((yas--current-template (or (and (cl-rest templates) ;; more than one
(yas--prompt-for-template (mapcar #'cdr templates))) (yas--prompt-for-template (mapcar #'cdr templates)))
(cdar templates)))) (cdar templates))))
(when yas--current-template (when yas--current-template
@ -2249,7 +2226,7 @@ Common gateway for `yas-expand-from-trigger-key' and
(yas-minor-mode nil) (yas-minor-mode nil)
(beyond-yasnippet (yas--keybinding-beyond-yasnippet))) (beyond-yasnippet (yas--keybinding-beyond-yasnippet)))
(yas--message 4 "Falling back to %s" beyond-yasnippet) (yas--message 4 "Falling back to %s" beyond-yasnippet)
(assert (or (null beyond-yasnippet) (commandp beyond-yasnippet))) (cl-assert (or (null beyond-yasnippet) (commandp beyond-yasnippet)))
(setq this-command beyond-yasnippet) (setq this-command beyond-yasnippet)
(when beyond-yasnippet (when beyond-yasnippet
(call-interactively beyond-yasnippet)))) (call-interactively beyond-yasnippet))))
@ -2314,13 +2291,13 @@ Honours `yas-choose-tables-first', `yas-choose-keys-first' and
(mapcar #'cdr (mapcar #'cdr
(if yas-choose-keys-first (if yas-choose-keys-first
(let ((key (yas--prompt-for-keys (let ((key (yas--prompt-for-keys
(mapcan #'yas--table-all-keys tables)))) (cl-mapcan #'yas--table-all-keys tables))))
(when key (when key
(mapcan #'(lambda (table) (cl-mapcan (lambda (table)
(yas--fetch table key)) (yas--fetch table key))
tables))) tables)))
(remove-duplicates (mapcan #'yas--table-templates tables) (cl-remove-duplicates (cl-mapcan #'yas--table-templates tables)
:test #'equal)))) :test #'equal))))
(defun yas--lookup-snippet-1 (name mode) (defun yas--lookup-snippet-1 (name mode)
"Get the snippet called NAME in MODE's tables." "Get the snippet called NAME in MODE's tables."
@ -2357,7 +2334,7 @@ by condition."
yas-buffer-local-condition)) yas-buffer-local-condition))
(templates (yas--all-templates (yas--get-snippet-tables))) (templates (yas--all-templates (yas--get-snippet-tables)))
(yas--current-template (and templates (yas--current-template (and templates
(or (and (rest templates) ;; more than one template for same key (or (and (cl-rest templates) ;; more than one template for same key
(yas--prompt-for-template templates)) (yas--prompt-for-template templates))
(car templates)))) (car templates))))
(where (if (region-active-p) (where (if (region-active-p)
@ -2452,8 +2429,9 @@ where snippets of table might exist."
(defun yas--make-directory-maybe (table-and-dirs &optional main-table-string) (defun yas--make-directory-maybe (table-and-dirs &optional main-table-string)
"Return 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 (cl-some (lambda (dir) (when (file-directory-p dir) dir))
(let ((candidate (first (cdr table-and-dirs)))) (cdr table-and-dirs))
(let ((candidate (cl-first (cdr table-and-dirs))))
(unless (file-writable-p (file-name-directory candidate)) (unless (file-writable-p (file-name-directory candidate))
(error (yas--format "%s is not writable." candidate))) (error (yas--format "%s is not writable." candidate)))
(if (y-or-n-p (format "Guessed directory (%s) for%s%s table \"%s\" does not exist! Create? " (if (y-or-n-p (format "Guessed directory (%s) for%s%s table \"%s\" does not exist! Create? "
@ -2487,10 +2465,11 @@ NO-TEMPLATE is non-nil."
(kill-all-local-variables) (kill-all-local-variables)
(snippet-mode) (snippet-mode)
(yas-minor-mode 1) (yas-minor-mode 1)
(set (make-local-variable 'yas--guessed-modes) (mapcar #'(lambda (d) (set (make-local-variable 'yas--guessed-modes)
(yas--table-mode (car d))) (mapcar (lambda (d) (yas--table-mode (car d)))
guessed-directories)) guessed-directories))
(set (make-local-variable 'default-directory) (car (cdr (car guessed-directories)))) (set (make-local-variable 'default-directory)
(car (cdr (car guessed-directories))))
(if (and (not no-template) yas-new-snippet-default) (if (and (not no-template) yas-new-snippet-default)
(yas-expand-snippet yas-new-snippet-default)))) (yas-expand-snippet yas-new-snippet-default))))
@ -2503,12 +2482,13 @@ representing one or more of the mode's parents.
Note that MODE-SYM need not be the symbol of a real major mode, Note that MODE-SYM need not be the symbol of a real major mode,
neither do the elements of PARENTS." neither do the elements of PARENTS."
(let* ((file-dir (and file (let* ((file-dir (and file
(directory-file-name (or (some #'(lambda (special) (directory-file-name
(locate-dominating-file file special)) (or (cl-some (lambda (special)
'(".yas-setup.el" (locate-dominating-file file special))
".yas-make-groups" '(".yas-setup.el"
".yas-parents")) ".yas-make-groups"
(directory-file-name (file-name-directory file)))))) ".yas-parents"))
(directory-file-name (file-name-directory file))))))
(parents-file-name (concat file-dir "/.yas-parents")) (parents-file-name (concat file-dir "/.yas-parents"))
(major-mode-name (and file-dir (major-mode-name (and file-dir
(file-name-nondirectory file-dir))) (file-name-nondirectory file-dir)))
@ -2544,15 +2524,15 @@ neither do the elements of PARENTS."
(intern (intern
(funcall prompt (format "Choose or enter a table (yas guesses %s): " (funcall prompt (format "Choose or enter a table (yas guesses %s): "
(if yas--guessed-modes (if yas--guessed-modes
(first yas--guessed-modes) (cl-first yas--guessed-modes)
"nothing")) "nothing"))
(mapcar #'symbol-name yas--guessed-modes) (mapcar #'symbol-name yas--guessed-modes)
nil nil
nil nil
nil nil
nil nil
(if (first yas--guessed-modes) (if (cl-first yas--guessed-modes)
(symbol-name (first yas--guessed-modes))))))) (symbol-name (cl-first yas--guessed-modes)))))))
(defun yas-load-snippet-buffer (table &optional interactive) (defun yas-load-snippet-buffer (table &optional interactive)
"Parse and load current buffer's snippet definition into TABLE. "Parse and load current buffer's snippet definition into TABLE.
@ -2614,7 +2594,8 @@ and `kill-buffer' instead."
(y-or-n-p (y-or-n-p
(format "[yas] Loaded for %s. Also save snippet buffer?" (format "[yas] Loaded for %s. Also save snippet buffer?"
(yas--table-name (yas--template-table template))))) (yas--table-name (yas--template-table template)))))
(let ((default-directory (car (cdr (car (yas--guess-snippet-directories (yas--template-table template)))))) (let ((default-directory (car (cdr (car (yas--guess-snippet-directories
(yas--template-table template))))))
(default-file-name (yas--template-name template))) (default-file-name (yas--template-name template)))
(unless (or buffer-file-name (not default-file-name)) (unless (or buffer-file-name (not default-file-name))
(setq buffer-file-name (setq buffer-file-name
@ -2631,7 +2612,7 @@ and `kill-buffer' instead."
(test-mode (or (and (car major-mode-and-parent) (test-mode (or (and (car major-mode-and-parent)
(fboundp (car major-mode-and-parent)) (fboundp (car major-mode-and-parent))
(car major-mode-and-parent)) (car major-mode-and-parent))
(first yas--guessed-modes) (cl-first yas--guessed-modes)
(intern (read-from-minibuffer (yas--format "Please input a mode: "))))) (intern (read-from-minibuffer (yas--format "Please input a mode: ")))))
(yas--current-template (yas--current-template
(and parsed (and parsed
@ -2654,15 +2635,17 @@ and `kill-buffer' instead."
(point-max) (point-max)
(yas--template-expand-env yas--current-template)) (yas--template-expand-env yas--current-template))
(when (and debug (when (and debug
(require 'yasnippet-debug nil t)) (require 'yasnippet-debug nil t)
(add-hook 'post-command-hook 'yas-debug-snippet-vars nil t)))) (fboundp 'yas-debug-snippet-vars))
(add-hook 'post-command-hook #'yas-debug-snippet-vars nil t))))
(t (t
(yas--message 1 "Cannot test snippet for unknown major mode"))))) (yas--message 1 "Cannot test snippet for unknown major mode")))))
(defun yas-active-keys () (defun yas-active-keys ()
"Return all active trigger keys for current buffer and point." "Return all active trigger keys for current buffer and point."
(remove-duplicates (cl-remove-duplicates
(remove-if-not #'stringp (mapcan #'yas--table-all-keys (yas--get-snippet-tables))) (cl-remove-if-not #'stringp (cl-mapcan #'yas--table-all-keys
(yas--get-snippet-tables)))
:test #'string=)) :test #'string=))
(defun yas--template-fine-group (template) (defun yas--template-fine-group (template)
@ -2827,16 +2810,16 @@ The last element of POSSIBILITIES may be a list of strings."
(when (listp last-elem) (when (listp last-elem)
(setcar last-link (car last-elem)) (setcar last-link (car last-elem))
(setcdr last-link (cdr last-elem)))) (setcdr last-link (cdr last-elem))))
(some #'(lambda (fn) (cl-some (lambda (fn)
(funcall fn "Choose: " possibilities)) (funcall fn "Choose: " possibilities))
yas-prompt-functions))) yas-prompt-functions)))
(defun yas-key-to-value (alist) (defun yas-key-to-value (alist)
(unless (or yas-moving-away-p (unless (or yas-moving-away-p
yas-modified-p) yas-modified-p)
(let ((key (read-key-sequence ""))) (let ((key (read-key-sequence "")))
(when (stringp key) (when (stringp key)
(or (cdr (find key alist :key #'car :test #'string=)) (or (cdr (cl-find key alist :key #'car :test #'string=))
key))))) key)))))
(defun yas-throw (text) (defun yas-throw (text)
@ -2847,7 +2830,8 @@ The last element of POSSIBILITIES may be a list of strings."
"Verify that the current field value is in POSSIBILITIES. "Verify that the current field value is in POSSIBILITIES.
Otherwise throw exception." Otherwise throw exception."
(when (and yas-moving-away-p (notany #'(lambda (pos) (string= pos yas-text)) possibilities)) (when (and yas-moving-away-p
(cl-notany (lambda (pos) (string= pos yas-text)) possibilities))
(yas-throw (yas--format "Field only allows %s" possibilities)))) (yas-throw (yas--format "Field only allows %s" possibilities))))
(defun yas-field-value (number) (defun yas-field-value (number)
@ -2914,7 +2898,7 @@ Use this in primary and mirror transformations to tget."
(put 'yas--active-field-overlay 'permanent-local t) (put 'yas--active-field-overlay 'permanent-local t)
(put 'yas--field-protection-overlays 'permanent-local t) (put 'yas--field-protection-overlays 'permanent-local t)
(defstruct (yas--snippet (:constructor yas--make-snippet ())) (cl-defstruct (yas--snippet (:constructor yas--make-snippet ()))
"A snippet. "A snippet.
..." ..."
@ -2928,7 +2912,7 @@ Use this in primary and mirror transformations to tget."
previous-active-field previous-active-field
force-exit) force-exit)
(defstruct (yas--field (:constructor yas--make-field (number start end parent-field))) (cl-defstruct (yas--field (:constructor yas--make-field (number start end parent-field)))
"A field. "A field.
NUMBER is the field number. NUMBER is the field number.
@ -2948,7 +2932,7 @@ NEXT is another `yas--field' or `yas--mirror' or `yas--exit'.
next) next)
(defstruct (yas--mirror (:constructor yas--make-mirror (start end transform))) (cl-defstruct (yas--mirror (:constructor yas--make-mirror (start end transform)))
"A mirror. "A mirror.
START and END are mostly buffer markers, but see \"apropos markers-to-points\". START and END are mostly buffer markers, but see \"apropos markers-to-points\".
@ -2962,7 +2946,7 @@ DEPTH is a count of how many nested mirrors can affect this mirror"
next next
depth) depth)
(defstruct (yas--exit (:constructor yas--make-exit (marker))) (cl-defstruct (yas--exit (:constructor yas--make-exit (marker)))
marker marker
next) next)
@ -2999,9 +2983,9 @@ With optional string TEXT do it in that string."
(replace-match to t t text)))) (replace-match to t t text))))
(defun yas--snippet-find-field (snippet number) (defun yas--snippet-find-field (snippet number)
(find-if #'(lambda (field) (cl-find-if (lambda (field)
(eq number (yas--field-number field))) (eq number (yas--field-number field)))
(yas--snippet-fields snippet))) (yas--snippet-fields snippet)))
(defun yas--snippet-sort-fields (snippet) (defun yas--snippet-sort-fields (snippet)
"Sort the fields of SNIPPET in navigation order." "Sort the fields of SNIPPET in navigation order."
@ -3154,7 +3138,7 @@ Also create some protection overlays"
(defun yas-exit-snippet (snippet) (defun yas-exit-snippet (snippet)
"Goto exit-marker of SNIPPET." "Goto exit-marker of SNIPPET."
(interactive (list (first (yas--snippets-at-point)))) (interactive (list (cl-first (yas--snippets-at-point))))
(when snippet (when snippet
(setf (yas--snippet-force-exit snippet) t) (setf (yas--snippet-force-exit snippet) t)
(goto-char (if (yas--snippet-exit snippet) (goto-char (if (yas--snippet-exit snippet)
@ -3466,9 +3450,10 @@ Move the overlays, or create them if they do not exit."
;; go on to normal overlay creation/moving ;; go on to normal overlay creation/moving
;; ;;
(cond ((and yas--field-protection-overlays (cond ((and yas--field-protection-overlays
(every #'overlay-buffer yas--field-protection-overlays)) (cl-every #'overlay-buffer yas--field-protection-overlays))
(move-overlay (first yas--field-protection-overlays) (1- start) start) (move-overlay (nth 0 yas--field-protection-overlays)
(move-overlay (second yas--field-protection-overlays) end (1+ end))) (1- start) start)
(move-overlay (nth 1 yas--field-protection-overlays) end (1+ end)))
(t (t
(setq yas--field-protection-overlays (setq yas--field-protection-overlays
(list (make-overlay (1- start) start nil t nil) (list (make-overlay (1- start) start nil t nil)
@ -3770,7 +3755,7 @@ has to be called before the $-constructs are deleted."
(setq soup (setq soup
(sort soup compare-fom-begs)) (sort soup compare-fom-begs))
(when soup (when soup
(reduce link-foms soup))))) (cl-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.
@ -4228,19 +4213,15 @@ When multiple expressions are found, only the last one counts."
(yas--field-mirrors parent)))) (yas--field-mirrors parent))))
(or (yas--mirror-depth mirror) (or (yas--mirror-depth mirror)
(setf (yas--mirror-depth mirror) (setf (yas--mirror-depth mirror)
(cond ((memq mirror traversed) (cond ((memq mirror traversed) 0)
0)
((and parent parents-mirrors) ((and parent parents-mirrors)
(1+ (reduce #'max (1+ (cl-reduce
(mapcar #'(lambda (m) #'max parents-mirrors
(yas--calculate-mirror-depth m :key (lambda (m)
(cons mirror (yas--calculate-mirror-depth
traversed))) m (cons mirror traversed))))))
parents-mirrors)))) (parent 1)
(parent (t 0))))))
1)
(t
0))))))
(defun yas--update-mirrors (snippet) (defun yas--update-mirrors (snippet)
"Update all the mirrors of SNIPPET." "Update all the mirrors of SNIPPET."
@ -4340,12 +4321,14 @@ When multiple expressions are found, only the last one counts."
;; restored correctly, this condition handles that ;; restored correctly, this condition handles that
;; ;;
(let* ((snippet (car (yas--snippets-at-point))) (let* ((snippet (car (yas--snippets-at-point)))
(target-field (and snippet (target-field
(find-if-not #'(lambda (field) (and snippet
(yas--field-probably-deleted-p snippet field)) (cl-find-if-not
(remove nil (lambda (field)
(cons (yas--snippet-active-field snippet) (yas--field-probably-deleted-p snippet field))
(yas--snippet-fields snippet))))))) (remq nil
(cons (yas--snippet-active-field snippet)
(yas--snippet-fields snippet)))))))
(when target-field (when target-field
(yas--move-to-field snippet target-field)))) (yas--move-to-field snippet target-field))))
((not (yas--undo-in-progress)) ((not (yas--undo-in-progress))
@ -4387,9 +4370,9 @@ object satisfying `yas--field-p' to restrict the expansion to.")))
(concat "Expand/run snippets from keymaps, possibly falling back to original binding.\n" (concat "Expand/run snippets from keymaps, possibly falling back to original binding.\n"
(when (and context (eq this-command 'describe-key)) (when (and context (eq this-command 'describe-key))
(let* ((vec (this-single-command-keys)) (let* ((vec (this-single-command-keys))
(templates (mapcan #'(lambda (table) (templates (cl-mapcan (lambda (table)
(yas--fetch table vec)) (yas--fetch table vec))
(yas--get-snippet-tables))) (yas--get-snippet-tables)))
(yas--direct-keymaps nil) (yas--direct-keymaps nil)
(fallback (key-binding vec))) (fallback (key-binding vec)))
(concat "In this case, " (concat "In this case, "
@ -4658,6 +4641,5 @@ can more or less safely rely upon them.")
;; Local Variables: ;; Local Variables:
;; coding: utf-8 ;; coding: utf-8
;; indent-tabs-mode: nil ;; indent-tabs-mode: nil
;; byte-compile-warnings: (not cl-functions)
;; End: ;; End:
;;; yasnippet.el ends here ;;; yasnippet.el ends here