X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/e1ed662b7ca235d3feffe714280433ea25c83e9c..be2f815c43deb74e0f809ed47debc4aa2e67ea1e:/yasnippet.el diff --git a/yasnippet.el b/yasnippet.el index d0129b902..f26cc3fa5 100644 --- a/yasnippet.el +++ b/yasnippet.el @@ -130,8 +130,7 @@ ;;; Code: (require 'cl) -(eval-and-compile - (require 'cl-lib)) +(require 'cl-lib) (require 'easymenu) (require 'help-mode) @@ -151,21 +150,25 @@ "Yet Another Snippet extension" :group 'editing) -(defvar yas--load-file-name load-file-name - "Store the filename that yasnippet.el was originally loaded from.") +(defvar yas-installed-snippets-dir nil) +(setq yas-installed-snippets-dir + (when load-file-name + (concat (file-name-directory load-file-name) "snippets"))) (defcustom yas-snippet-dirs (remove nil (list "~/.emacs.d/snippets" - (when yas--load-file-name - (concat (file-name-directory yas--load-file-name) "snippets")))) - "Directory or list of snippet dirs for each major mode. - -The directory where user-created snippets are to be stored. Can -also be a list of directories. In that case, when used for -bulk (re)loading of snippets (at startup or via -`yas-reload-all'), directories appearing earlier in the list -shadow other dir's snippets. Also, the first directory is taken -as the default for storing the user's new snippets." + 'yas-installed-snippets-dir)) + "List of top-level snippet directories. + +Each element, a string or a symbol whose value is a string, +designates a top-level directory where per-mode snippet +directories can be found. + +Elements appearing earlier in the list shadow later elements' +snippets. + +The first directory is taken as the default for storing snippet's +created with `yas-new-snippet'. " :type '(choice (string :tag "Single directory (string)") (repeat :args (string) :tag "List of directories (strings)")) :group 'yasnippet @@ -179,8 +182,18 @@ as the default for storing the user's new snippets." (yas-reload-all))))) (defun yas-snippet-dirs () - "Return `yas-snippet-dirs' (which see) as a list." - (if (listp yas-snippet-dirs) yas-snippet-dirs (list yas-snippet-dirs))) + "Return variable `yas-snippet-dirs' as list of strings." + (cl-loop for e in (if (listp yas-snippet-dirs) + yas-snippet-dirs + (list yas-snippet-dirs)) + collect + (cond ((stringp e) e) + ((and (symbolp e) + (boundp e) + (stringp (symbol-value e))) + (symbol-value e)) + (t + (error "[yas] invalid element %s in `yas-snippet-dirs'" e))))) (defvaralias 'yas/root-directory 'yas-snippet-dirs) @@ -388,20 +401,44 @@ the trigger key itself." map) "The active keymap while a snippet expansion is in progress.") -(defvar yas-key-syntaxes (list "w" "w_" "w_." "w_.()" "^ ") - "List of character syntaxes used to find a trigger key before point. -The list is tried in the order while scanning characters -backwards from point. For example, if the list is '(\"w\" \"w_\") -first look for trigger keys which are composed exclusively of -\"word\"-syntax characters, and then, if that fails, look for -keys which are either of \"word\" or \"symbol\" -syntax. Triggering after +(defvar yas-key-syntaxes (list "w" "w_" "w_." "w_.()" + #'yas-try-key-from-whitespace) + "Syntaxes and functions to help look for trigger keys before point. + +Each element in this list specifies how to skip buffer positions +backwards and look for the start of a trigger key. + +Each element can be either a string or a function receiving the +original point as an argument. A string element is simply passed +to `skip-syntax-backward' whereas a function element is called +with no arguments and should also place point before the original +position. + +The string between the resulting buffer position and the original +point is matched against the trigger keys in the active snippet +tables. + +If no expandable snippets are found, the next element is the list +is tried, unless a function element returned the symbol `again', +in which case it is called again from the previous position and +may once more reposition point. + +For example, if `yas-key-syntaxes'' value is '(\"w\" \"w_\"), +trigger keys composed exclusively of \"word\"-syntax characters +are looked for first. Failing that, longer keys composed of +\"word\" or \"symbol\" syntax are looked for. Therefore, +triggering after foo-bar -will, according to the \"w\" element first try \"bar\". If that -isn't a trigger key, \"foo-bar\" is tried, respecting a second -\"w_\" element.") +will, according to the \"w\" element first try \"barbaz\". If +that isn't a trigger key, \"foo-barbaz\" is tried, respecting the +second \"w_\" element. Notice that even if \"baz\" is a trigger +key for an active snippet, it won't be expanded, unless a +function is added to `yas-key-syntaxes' that eventually places +point between \"bar\" and \"baz\". + +See also Info node `(elisp) Syntax Descriptors'.") (defvar yas-after-exit-snippet-hook '() @@ -699,11 +736,12 @@ and friends." (push mode explored) (cons mode (loop for neighbour - in (remove nil (cons (get mode - 'derived-mode-parent) - (gethash mode yas--parents))) - - unless (memq neighbour explored) + in (cl-list* (get mode 'derived-mode-parent) + (ignore-errors (symbol-function mode)) + (gethash mode yas--parents)) + when (and neighbour + (not (memq neighbour explored)) + (symbolp neighbour)) append (funcall dfs neighbour explored))))) (remove-duplicates (append yas--extra-modes (funcall dfs major-mode))))) @@ -1192,32 +1230,42 @@ conditions to filter out potential expansions." (yas--table-hash table)) (yas--filter-templates-by-condition acc)))) -(defun yas--current-key () - "Get the key under current position. -A key is used to find the template of a snippet in the current snippet-table." - (let ((start (point)) - (end (point)) - (syntaxes yas-key-syntaxes) - syntax - done - templates) - (while (and (not done) syntaxes) - (setq syntax (car syntaxes)) - (setq syntaxes (cdr syntaxes)) - (save-excursion - (skip-syntax-backward syntax) - (setq start (point))) - (setq templates - (mapcan #'(lambda (table) - (yas--fetch table (buffer-substring-no-properties start end))) - (yas--get-snippet-tables))) - (if templates - (setq done t) - (setq start end))) - (list templates - start - end))) - +(defun yas--templates-for-key-at-point () + "Find `yas--template' objects for any trigger keys preceding point. +Returns (TEMPLATES START END). This function respects +`yas-key-syntaxes', which see." + (save-excursion + (let ((original (point)) + (methods yas-key-syntaxes) + (templates) + (method)) + (while (and methods + (not templates)) + (unless (eq method (car methods)) + ;; TRICKY: `eq'-ness test means we can only be here if + ;; `method' is a function that returned `again', and hence + ;; don't revert back to original position as per + ;; `yas-key-syntaxes'. + (goto-char original)) + (setq method (car methods)) + (cond ((stringp method) + (skip-syntax-backward method) + (setq methods (cdr methods))) + ((functionp method) + (unless (eq (funcall method original) + 'again) + (setq methods (cdr methods)))) + (t + (yas--warning "Warning invalid element %s in `yas-key-syntaxes'" method))) + (let ((possible-key (buffer-substring-no-properties (point) original))) + (save-excursion + (goto-char original) + (setq templates + (mapcan #'(lambda (table) + (yas--fetch table possible-key)) + (yas--get-snippet-tables)))))) + (when templates + (list templates (point) original))))) (defun yas--table-all-keys (table) "Get trigger keys of all active snippets in TABLE." @@ -1703,36 +1751,44 @@ With prefix argument USE-JIT do jit-loading of snippets." current-prefix-arg t)) (unless yas-snippet-dirs (setq yas-snippet-dirs top-level-dir)) - (dolist (dir (yas--subdirs top-level-dir)) - (let* ((major-mode-and-parents (yas--compute-major-mode-and-parents - (concat dir "/dummy"))) - (mode-sym (car major-mode-and-parents)) - (parents (cdr major-mode-and-parents))) - ;; Attention: The parents and the menus are already defined - ;; here, even if the snippets are later jit-loaded. - ;; - ;; * We need to know the parents at this point since entering a - ;; given mode should jit load for its parents - ;; immediately. This could be reviewed, the parents could be - ;; discovered just-in-time-as well - ;; - ;; * We need to create the menus here to support the `full' - ;; option to `yas-use-menu' (all known snippet menus are shown to the user) - ;; - (yas--define-parents mode-sym parents) - (yas--menu-keymap-get-create mode-sym) - (let ((fun `(lambda () ;; FIXME: Simulating lexical-binding. - (yas--load-directory-1 ',dir ',mode-sym)))) - (if (and use-jit - (not (some #'(lambda (buffer) - (with-current-buffer buffer - ;; FIXME: Shouldn't this use derived-mode-p? - (when (eq major-mode mode-sym) - (yas--message 3 "Discovered there was already %s in %s" buffer mode-sym) - t))) - (buffer-list)))) - (yas--schedule-jit mode-sym fun) - (funcall fun))))) + (let ((impatient-buffers)) + (dolist (dir (yas--subdirs top-level-dir)) + (let* ((major-mode-and-parents (yas--compute-major-mode-and-parents + (concat dir "/dummy"))) + (mode-sym (car major-mode-and-parents)) + (parents (cdr major-mode-and-parents))) + ;; Attention: The parents and the menus are already defined + ;; here, even if the snippets are later jit-loaded. + ;; + ;; * We need to know the parents at this point since entering a + ;; given mode should jit load for its parents + ;; immediately. This could be reviewed, the parents could be + ;; discovered just-in-time-as well + ;; + ;; * We need to create the menus here to support the `full' + ;; option to `yas-use-menu' (all known snippet menus are shown to the user) + ;; + (yas--define-parents mode-sym parents) + (yas--menu-keymap-get-create mode-sym) + (let ((fun `(lambda () ;; FIXME: Simulating lexical-binding. + (yas--load-directory-1 ',dir ',mode-sym)))) + (if use-jit + (yas--schedule-jit mode-sym fun) + (funcall fun))) + ;; Look for buffers that are already in `mode-sym', and so + ;; need the new snippets immediately... + ;; + (when use-jit + (cl-loop for buffer in (buffer-list) + do (with-current-buffer buffer + (when (eq major-mode mode-sym) + (yas--message 3 "Discovered there was already %s in %s" buffer mode-sym) + (push buffer impatient-buffers))))))) + ;; ...after TOP-LEVEL-DIR has been completely loaded, call + ;; `yas--load-pending-jits' in these impatient buffers. + ;; + (cl-loop for buffer in impatient-buffers + do (with-current-buffer buffer (yas--load-pending-jits)))) (when interactive (yas--message 3 "Loaded snippets from %s." top-level-dir))) @@ -2136,13 +2192,12 @@ object satisfying `yas--field-p' to restrict the expansion to." (save-restriction (narrow-to-region (yas--field-start field) (yas--field-end field)) - (yas--current-key)) - (yas--current-key)))) - (if (and templates-and-pos - (first templates-and-pos)) + (yas--templates-for-key-at-point)) + (yas--templates-for-key-at-point)))) + (if templates-and-pos (yas--expand-or-prompt-for-template (first templates-and-pos) - (second templates-and-pos) - (third templates-and-pos)) + (second templates-and-pos) + (third templates-and-pos)) (yas--fallback)))) (defun yas-expand-from-keymap () @@ -2694,6 +2749,33 @@ and `kill-buffer' instead." groups-hash))) + +;;; User convenience functions, for using in `yas-key-syntaxes' + +(defun yas-try-key-from-whitespace (_start-point) + "As `yas-key-syntaxes' element, look for whitespace delimited key. + +A newline will be considered whitespace even if the mode syntax +marks it as something else (typically comment ender)." + (skip-chars-backward "^[:space:]\n")) + +(defun yas-shortest-key-until-whitespace (_start-point) + "Like `yas-longest-key-from-whitespace' but take the shortest key." + (when (/= (skip-chars-backward "^[:space:]\n" (1- (point))) 0) + 'again)) + +(defun yas-longest-key-from-whitespace (start-point) + "As `yas-key-syntaxes' element, look for longest key between point and whitespace. + +A newline will be considered whitespace even if the mode syntax +marks it as something else (typically comment ender)." + (if (= (point) start-point) + (yas-try-key-from-whitespace start-point) + (forward-char)) + (unless (<= start-point (1+ (point))) + 'again)) + + ;;; User convenience functions, for using in snippet definitions @@ -4307,6 +4389,11 @@ object satisfying `yas--field-p' to restrict the expansion to."))) (when (> yas-verbosity level) (message "%s" (apply #'yas--format message args)))) +(defun yas--warning (format-control &rest format-args) + (let ((msg (apply #'format format-control format-args))) + (display-warning 'yasnippet msg :warning) + (yas--message 1 msg))) + (defun yas--format (format-control &rest format-args) (apply #'format (concat "[yas] " format-control) format-args))