Various cleanup

* yasnippet/yasnippet.el: Add Package-Requires since we use cl-lib.
(yas-installed-snippets-dir, yas--default-user-snippets-dir)
(yas--load-directory-1, yas-load-snippet-buffer-and-close):
Use expand-file-name.
(yas-buffer-local-condition): Let's not quote lambdas.
(yas--modes-to-activate): Fix compiler warning about free `dfs' var and
unused return value of `mapcar'.
(yas-minor-mode): Don't confuse emulation-mode-map-alists for a hook.
(yas--font-lock-keywords): Don't hardcode the name of emacs-lisp-mode's
font-lock keywords.
(yas--calculate-group): Use file-relative-name.
(yas--subdirs): Don't mismatch \n in file name.
(yas-expand-from-trigger-key, yas-tryout-snippet): Prefer numbers to
number names.
(yas--guess-snippet-directories): Use expand-file-name rather than
removing&adding / by hand.
(yas--on-field-overlay-modification): Mark `length' as unused.
(yas--update-mirrors): Try to better fit within 80 columns.
(yas--backported-syms, yas--exported-syms): Don't mismatch \n in
symbol name.
This commit is contained in:
Stefan Monnier 2016-04-05 23:48:01 -04:00 committed by Noam Postavsky
parent 6aeccce2f1
commit 18f7b1b9fe

View File

@ -1,12 +1,15 @@
;;; yasnippet.el --- Yet another snippet extension for Emacs. ;;; yasnippet.el --- Yet another snippet extension for Emacs.
;; Copyright (C) 2008-2013, 2015 Free Software Foundation, Inc. ;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
;; Authors: pluskid <pluskid@gmail.com>, João Távora <joaotavora@gmail.com>, Noam Postavsky <npostavs@gmail.com> ;; Authors: pluskid <pluskid@gmail.com>,
;; João Távora <joaotavora@gmail.com>,
;; Noam Postavsky <npostavs@gmail.com>
;; Maintainer: Noam Postavsky <npostavs@gmail.com> ;; Maintainer: Noam Postavsky <npostavs@gmail.com>
;; Version: 0.9.1 ;; Version: 0.9.1
;; X-URL: http://github.com/capitaomorte/yasnippet ;; X-URL: http://github.com/capitaomorte/yasnippet
;; Keywords: convenience, emulation ;; Keywords: convenience, emulation
;; URL: http://github.com/capitaomorte/yasnippet ;; URL: http://github.com/capitaomorte/yasnippet
;; Package-Requires: ((cl-lib "0.5"))
;; EmacsWiki: YaSnippetMode ;; EmacsWiki: YaSnippetMode
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
@ -153,10 +156,10 @@
(defvar yas-installed-snippets-dir nil) (defvar yas-installed-snippets-dir nil)
(setq yas-installed-snippets-dir (setq yas-installed-snippets-dir
(when load-file-name (when load-file-name
(concat (file-name-directory load-file-name) "snippets"))) (expand-file-name "snippets" (file-name-directory load-file-name))))
(defconst yas--default-user-snippets-dir (defconst yas--default-user-snippets-dir
(concat user-emacs-directory "snippets")) (expand-file-name "snippets" user-emacs-directory))
(defcustom yas-snippet-dirs (remove nil (defcustom yas-snippet-dirs (remove nil
(list yas--default-user-snippets-dir (list yas--default-user-snippets-dir
@ -172,6 +175,7 @@ snippets.
The first directory is taken as the default for storing snippet's The first directory is taken as the default for storing snippet's
created with `yas-new-snippet'. " created with `yas-new-snippet'. "
;; FIXME: Why use type `string' rather than `directory'?
:type '(choice (string :tag "Single directory (string)") :type '(choice (string :tag "Single directory (string)")
(repeat :args (string) :tag "List of directories (strings)")) (repeat :args (string) :tag "List of directories (strings)"))
:group 'yasnippet :group 'yasnippet
@ -507,7 +511,7 @@ snippets returning the symbol 'force-in-comment in their
conditions. conditions.
(add-hook 'python-mode-hook (add-hook 'python-mode-hook
'(lambda () (lambda ()
(setq yas-buffer-local-condition (setq yas-buffer-local-condition
'(if (python-in-string/comment) '(if (python-in-string/comment)
'(require-snippet-condition . force-in-comment) '(require-snippet-condition . force-in-comment)
@ -726,22 +730,24 @@ defined direct keybindings to the command
yas--tables)) yas--tables))
(defun yas--modes-to-activate (&optional mode) (defun yas--modes-to-activate (&optional mode)
"Compute list of mode symbols that are active for `yas-expand' "Compute list of mode symbols that are active for `yas-expand' and friends."
and friends." (defvar yas--dfs) ;We rely on dynbind. We could use `letrec' instead!
(let* ((explored (if mode (list mode) ; Building up list in reverse. (let* ((explored (if mode (list mode) ; Building up list in reverse.
(cons major-mode (reverse yas--extra-modes)))) (cons major-mode (reverse yas--extra-modes))))
(dfs (yas--dfs
(lambda (mode) (lambda (mode)
(cl-loop for neighbour (cl-loop for neighbour
in (cl-list* (get mode 'derived-mode-parent) in (cl-list* (get mode 'derived-mode-parent)
;; FIXME: `ignore-errors' can be dropped here
;; in Emacs≥24.3.
(ignore-errors (symbol-function mode)) (ignore-errors (symbol-function mode))
(gethash mode yas--parents)) (gethash mode yas--parents))
when (and neighbour when (and neighbour
(not (memq neighbour explored)) (not (memq neighbour explored))
(symbolp neighbour)) (symbolp neighbour))
do (push neighbour explored) do (push neighbour explored)
(funcall dfs neighbour))))) (funcall yas--dfs neighbour)))))
(mapcar dfs explored) (mapc yas--dfs explored)
(nreverse explored))) (nreverse explored)))
(defvar yas-minor-mode-hook nil (defvar yas-minor-mode-hook nil
@ -773,8 +779,8 @@ Key bindings:
;; ;;
;; Also install the post-command-hook. ;; Also install the post-command-hook.
;; ;;
(add-hook 'emulation-mode-map-alists 'yas--direct-keymaps) (cl-pushnew 'yas--direct-keymaps emulation-mode-map-alists)
(add-hook 'post-command-hook 'yas--post-command-handler nil t) (add-hook 'post-command-hook #'yas--post-command-handler nil t)
;; Set the `yas--direct-%s' vars for direct keymap expansion ;; Set the `yas--direct-%s' vars for direct keymap expansion
;; ;;
(dolist (mode (yas--modes-to-activate)) (dolist (mode (yas--modes-to-activate))
@ -787,8 +793,9 @@ Key bindings:
(t (t
;; Uninstall the direct keymaps and the post-command hook ;; Uninstall the direct keymaps and the post-command hook
;; ;;
(remove-hook 'post-command-hook 'yas--post-command-handler t) (remove-hook 'post-command-hook #'yas--post-command-handler t)
(remove-hook 'emulation-mode-map-alists 'yas--direct-keymaps)))) (setq emulation-mode-map-alists
(remove 'yas--direct-keymaps emulation-mode-map-alists)))))
(defun yas-activate-extra-mode (mode) (defun yas-activate-extra-mode (mode)
"Activates the snippets for the given `mode' in the buffer. "Activates the snippets for the given `mode' in the buffer.
@ -865,22 +872,28 @@ Honour `yas-dont-activate', which see."
"Run `yas-reload-all' when `yas-global-mode' is on." "Run `yas-reload-all' when `yas-global-mode' is on."
(when yas-global-mode (yas-reload-all))) (when yas-global-mode (yas-reload-all)))
(add-hook 'yas-global-mode-hook 'yas--global-mode-reload-with-jit-maybe) (add-hook 'yas-global-mode-hook #'yas--global-mode-reload-with-jit-maybe)
;;; Major mode stuff ;;; Major mode stuff
(defvar yas--font-lock-keywords (defvar yas--font-lock-keywords
(append '(("^#.*$" . font-lock-comment-face)) (append '(("^#.*$" . font-lock-comment-face))
lisp-font-lock-keywords-2 (with-temp-buffer
(emacs-lisp-mode)
(font-lock-set-defaults)
(if (eq t (car-safe font-lock-keywords))
;; They're "compiled", so extract the source.
(cadr font-lock-keywords)
font-lock-keywords))
'(("$\\([0-9]+\\)" '(("$\\([0-9]+\\)"
(0 font-lock-keyword-face) (0 font-lock-keyword-face)
(1 font-lock-string-face t)) (1 font-lock-string-face t))
("${\\([0-9]+\\):?" ("${\\([0-9]+\\):?"
(0 font-lock-keyword-face) (0 font-lock-keyword-face)
(1 font-lock-warning-face t)) (1 font-lock-warning-face t))
("${" . font-lock-keyword-face) ("${" . font-lock-keyword-face) ;FIXME: Redundant?
("$[0-9]+?" . font-lock-preprocessor-face) ("$[0-9]+?" . font-lock-preprocessor-face) ;FIXME: Redundant?
("\\(\\$(\\)" 1 font-lock-preprocessor-face) ("\\(\\$(\\)" 1 font-lock-preprocessor-face)
("}" ("}"
(0 font-lock-keyword-face))))) (0 font-lock-keyword-face)))))
@ -1473,10 +1486,7 @@ Here's a list of currently recognized directives:
(let* ((dominating-dir (locate-dominating-file file (let* ((dominating-dir (locate-dominating-file file
".yas-make-groups")) ".yas-make-groups"))
(extra-path (and dominating-dir (extra-path (and dominating-dir
(replace-regexp-in-string (concat "^" (file-relative-name file dominating-dir)))
(expand-file-name dominating-dir))
""
(expand-file-name file))))
(extra-dir (and extra-path (extra-dir (and extra-path
(file-name-directory extra-path))) (file-name-directory extra-path)))
(group (and extra-dir (group (and extra-dir
@ -1487,12 +1497,12 @@ Here's a list of currently recognized directives:
(defun yas--subdirs (directory &optional filep) (defun yas--subdirs (directory &optional filep)
"Return subdirs or files of DIRECTORY according to FILEP." "Return subdirs or files of DIRECTORY according to FILEP."
(remove-if (lambda (file) (cl-remove-if (lambda (file)
(or (string-match "^\\." (or (string-match "\\`\\."
(file-name-nondirectory file)) (file-name-nondirectory file))
(string-match "^#.*#$" (string-match "\\`#.*#\\'"
(file-name-nondirectory file)) (file-name-nondirectory file))
(string-match "~$" (string-match "~\\'"
(file-name-nondirectory file)) (file-name-nondirectory file))
(if filep (if filep
(file-directory-p file) (file-directory-p file)
@ -1769,7 +1779,7 @@ With prefix argument USE-JIT do jit-loading of snippets."
(insert (format ";;; Do not edit! File generated at %s\n" (insert (format ";;; Do not edit! File generated at %s\n"
(current-time-string))))) (current-time-string)))))
;; Normal case. ;; Normal case.
(unless (file-exists-p (concat directory "/" ".yas-skip")) (unless (file-exists-p (expand-file-name ".yas-skip" directory))
(unless (and (load (expand-file-name ".yas-compiled-snippets" directory) 'noerror (<= yas-verbosity 3)) (unless (and (load (expand-file-name ".yas-compiled-snippets" directory) 'noerror (<= yas-verbosity 3))
(progn (yas--message 2 "Loaded compiled snippets from %s" directory) t)) (progn (yas--message 2 "Loaded compiled snippets from %s" directory) t))
(yas--message 2 "Loading snippet files from %s" directory) (yas--message 2 "Loading snippet files from %s" directory)
@ -1944,7 +1954,7 @@ This works by stubbing a few functions, then calling
;;; Apropos snippet menu: ;;; Apropos snippet menu:
;; ;;
;; The snippet menu keymaps are store by mode in hash table called ;; The snippet menu keymaps are stored by mode in hash table called
;; `yas--menu-table'. They are linked to the main menu in ;; `yas--menu-table'. They are linked to the main menu in
;; `yas--menu-keymap-get-create' and are initially created empty, ;; `yas--menu-keymap-get-create' and are initially created empty,
;; reflecting the table hierarchy. ;; reflecting the table hierarchy.
@ -2157,9 +2167,9 @@ object satisfying `yas--field-p' to restrict the expansion to."
(yas--templates-for-key-at-point)) (yas--templates-for-key-at-point))
(yas--templates-for-key-at-point)))) (yas--templates-for-key-at-point))))
(if templates-and-pos (if templates-and-pos
(yas--expand-or-prompt-for-template (first templates-and-pos) (yas--expand-or-prompt-for-template (nth 0 templates-and-pos)
(second templates-and-pos) (nth 1 templates-and-pos)
(third templates-and-pos)) (nth 2 templates-and-pos))
(yas--fallback)))) (yas--fallback))))
(defun yas-expand-from-keymap () (defun yas-expand-from-keymap ()
@ -2406,10 +2416,8 @@ tables (or optional TABLE).
Returns a list of elements (TABLE . DIRS) where TABLE is a Returns a list of elements (TABLE . DIRS) where TABLE is a
`yas--table' object and DIRS is a list of all possible directories `yas--table' object and DIRS is a list of all possible directories
where snippets of table might exist." where snippets of table might exist."
(let ((main-dir (replace-regexp-in-string (let ((main-dir (or (cl-first (or (yas-snippet-dirs)
"/+$" "" (setq yas-snippet-dirs (list yas--default-user-snippets-dir))))))
(or (first (or (yas-snippet-dirs)
(setq yas-snippet-dirs (list yas--default-user-snippets-dir)))))))
(tables (or (and table (tables (or (and table
(list table)) (list table))
(yas--get-snippet-tables)))) (yas--get-snippet-tables))))
@ -2422,7 +2430,7 @@ where snippets of table might exist."
(mapcar #'(lambda (table) (mapcar #'(lambda (table)
(cons table (cons table
(mapcar #'(lambda (subdir) (mapcar #'(lambda (subdir)
(concat main-dir "/" subdir)) (expand-file-name subdir main-dir))
(yas--guess-snippet-directories-1 table)))) (yas--guess-snippet-directories-1 table))))
tables))) tables)))
@ -2584,9 +2592,10 @@ and `kill-buffer' instead."
(when chosen (when chosen
(let ((default-file-name (or (and file (file-name-nondirectory file)) (let ((default-file-name (or (and file (file-name-nondirectory file))
(yas--template-name yas--editing-template)))) (yas--template-name yas--editing-template))))
(write-file (concat chosen "/" (write-file (expand-file-name ;; FIXME: Why not read-file-name?
(read-from-minibuffer (format "File name to create in %s? " chosen) (read-from-minibuffer (format "File name to create in %s? " chosen)
default-file-name))) default-file-name)
chosen))
(setf (yas--template-load-file yas--editing-template) buffer-file-name)))))) (setf (yas--template-load-file yas--editing-template) buffer-file-name))))))
(when buffer-file-name (when buffer-file-name
(save-buffer) (save-buffer)
@ -2606,10 +2615,10 @@ and `kill-buffer' instead."
(and parsed (and parsed
(fboundp test-mode) (fboundp test-mode)
(yas--make-template :table nil ;; no tables for ephemeral snippets (yas--make-template :table nil ;; no tables for ephemeral snippets
:key (first parsed) :key (nth 0 parsed)
:content (second parsed) :content (nth 1 parsed)
:name (third parsed) :name (nth 2 parsed)
:expand-env (sixth parsed))))) :expand-env (nth 5 parsed)))))
(cond (yas--current-template (cond (yas--current-template
(let ((buffer-name (format "*testing snippet: %s*" (yas--template-name yas--current-template)))) (let ((buffer-name (format "*testing snippet: %s*" (yas--template-name yas--current-template))))
(kill-buffer (get-buffer-create buffer-name)) (kill-buffer (get-buffer-create buffer-name))
@ -3398,7 +3407,7 @@ BEG, END and LENGTH like overlay modification hooks."
(setq clearp (funcall clearp))) (setq clearp (funcall clearp)))
clearp))) clearp)))
(defun yas--on-field-overlay-modification (overlay after? beg end &optional length) (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 point is at Only clears the field if it hasn't been modified and point is at
@ -4192,11 +4201,12 @@ When multiple expressions are found, only the last one counts."
(defun yas--update-mirrors (snippet) (defun yas--update-mirrors (snippet)
"Update 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) ...)
;; where F is the field that M is mirroring ;; where F is the field that M is mirroring
;; ;;
(mapcan #'(lambda (field) (cl-mapcan #'(lambda (field)
(mapcar #'(lambda (mirror) (mapcar #'(lambda (mirror)
(cons field mirror)) (cons field mirror))
(yas--field-mirrors field))) (yas--field-mirrors field)))
@ -4320,7 +4330,7 @@ object satisfying `yas--field-p' to restrict the expansion to.")))
'(yas--expand-from-keymap-doc t)) '(yas--expand-from-keymap-doc t))
(defun yas--expand-from-keymap-doc (context) (defun yas--expand-from-keymap-doc (context)
"A doc synthesizer for `yas--expand-from-keymap-doc'." "A doc synthesizer for `yas--expand-from-keymap-doc'."
(add-hook 'temp-buffer-show-hook 'yas--snippet-description-finish-runonce) (add-hook 'temp-buffer-show-hook #'yas--snippet-description-finish-runonce)
(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))
@ -4355,7 +4365,8 @@ object satisfying `yas--field-p' to restrict the expansion to.")))
(defun yas--snippet-description-finish-runonce () (defun yas--snippet-description-finish-runonce ()
"Final adjustments for the help buffer when snippets are concerned." "Final adjustments for the help buffer when snippets are concerned."
(yas--create-snippet-xrefs) (yas--create-snippet-xrefs)
(remove-hook 'temp-buffer-show-hook 'yas--snippet-description-finish-runonce)) (remove-hook 'temp-buffer-show-hook
#'yas--snippet-description-finish-runonce))
(defun yas--create-snippet-xrefs () (defun yas--create-snippet-xrefs ()
(save-excursion (save-excursion
@ -4562,7 +4573,7 @@ and return the directory. Return nil if not found."
They are mapped to \"yas/*\" variants.") They are mapped to \"yas/*\" variants.")
(dolist (sym yas--backported-syms) (dolist (sym yas--backported-syms)
(let ((backported (intern (replace-regexp-in-string "^yas-" "yas/" (symbol-name sym))))) (let ((backported (intern (replace-regexp-in-string "\\`yas-" "yas/" (symbol-name sym)))))
(when (boundp sym) (when (boundp sym)
(make-obsolete-variable backported sym "yasnippet 0.8") (make-obsolete-variable backported sym "yasnippet 0.8")
(defvaralias backported sym)) (defvaralias backported sym))
@ -4577,7 +4588,7 @@ They are mapped to \"yas/*\" variants.")
(not (get atom 'byte-obsolete-variable))) (not (get atom 'byte-obsolete-variable)))
(and (fboundp atom) (and (fboundp atom)
(not (get atom 'byte-obsolete-info)))) (not (get atom 'byte-obsolete-info))))
(string-match-p "^yas-[^-]" (symbol-name atom))) (string-match-p "\\`yas-[^-]" (symbol-name atom)))
(push atom exported)))) (push atom exported))))
exported) exported)
"Exported yasnippet symbols. "Exported yasnippet symbols.