]> code.delx.au - gnu-emacs-elpa/blobdiff - yasnippet.el
Closes #537: Be lenient to extensions operating on snippet fields
[gnu-emacs-elpa] / yasnippet.el
index 93eceb24a247c93e6154b9e89155028738af7196..c93d886c19e2fed28fafbf2091b5dc3e7687248f 100644 (file)
 ;;; Code:
 
 (require 'cl)
-(eval-and-compile
-  (require 'cl-lib))
+(require 'cl-lib)
 (require 'easymenu)
 (require 'help-mode)
 
 
 (defgroup yasnippet nil
   "Yet Another Snippet extension"
+  :prefix "yas-"
   :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 +183,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)
 
@@ -275,7 +289,7 @@ next field"
   `yas-expand' returns nil)
 
 - A Lisp form (apply COMMAND . ARGS) means interactively call
-  COMMAND, if ARGS is non-nil, call COMMAND non-interactively
+  COMMAND. If ARGS is non-nil, call COMMAND non-interactively
   with ARGS as arguments."
   :type '(choice (const :tag "Call previous command"  call-other-command)
                  (const :tag "Do nothing"             return-nil))
@@ -545,7 +559,7 @@ snippet itself contains a condition that returns the symbol
 
 (defun yas--snippet-next-id ()
   (let ((id yas--snippet-id-seed))
-    (incf yas--snippet-id-seed)
+    (cl-incf yas--snippet-id-seed)
     id))
 
 \f
@@ -1243,12 +1257,14 @@ Returns (TEMPLATES START END). This function respects
                            'again)
                  (setq methods (cdr methods))))
               (t
-               (error "[yas] invalid element in `yas-key-syntaxes'")))
-        (setq templates
-              (mapcan #'(lambda (table)
-                          (yas--fetch table (buffer-substring-no-properties (point)
-                                                                            original)))
-                      (yas--get-snippet-tables))))
+               (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)))))
 
@@ -1736,36 +1752,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)))
 
@@ -2224,8 +2248,19 @@ Common gateway for `yas-expand-from-trigger-key' and
   (cond ((eq yas-fallback-behavior 'return-nil)
          ;; return nil
          nil)
+        ((eq yas-fallback-behavior 'yas--fallback)
+         (error (concat "yasnippet fallback loop!\n"
+                        "This can happen when you bind `yas-expand' "
+                        "outside of the `yas-minor-mode-map'.")))
         ((eq yas-fallback-behavior 'call-other-command)
-         (let* ((beyond-yasnippet (yas--keybinding-beyond-yasnippet)))
+         (let* ((yas-fallback-behavior 'yas--fallback)
+                ;; Also bind `yas-minor-mode' to prevent fallback
+                ;; loops when other extensions use mechanisms similar
+                ;; to `yas--keybinding-beyond-yasnippet'. (github #525
+                ;; and #526)
+                ;; 
+                (yas-minor-mode nil)
+                (beyond-yasnippet (yas--keybinding-beyond-yasnippet)))
            (yas--message 4 "Falling back to %s"  beyond-yasnippet)
            (assert (or (null beyond-yasnippet) (commandp beyond-yasnippet)))
            (setq this-original-command beyond-yasnippet)
@@ -2234,18 +2269,21 @@ Common gateway for `yas-expand-from-trigger-key' and
         ((and (listp yas-fallback-behavior)
               (cdr yas-fallback-behavior)
               (eq 'apply (car yas-fallback-behavior)))
-         (if (cddr yas-fallback-behavior)
-             (apply (cadr yas-fallback-behavior)
-                    (cddr yas-fallback-behavior))
-           (when (commandp (cadr yas-fallback-behavior))
-             (setq this-command (cadr yas-fallback-behavior))
-             (call-interactively (cadr yas-fallback-behavior)))))
+         (let ((command-or-fn (cadr yas-fallback-behavior))
+               (args (cddr yas-fallback-behavior))
+               (yas-fallback-behavior 'yas--fallback)
+               (yas-minor-mode nil))
+           (if args
+               (apply command-or-fn args)
+             (when (commandp command-or-fn)
+               (setq this-command command-or-fn)
+               (call-interactively command-or-fn)))))
         (t
          ;; also return nil if all the other fallbacks have failed
          nil)))
 
 (defun yas--keybinding-beyond-yasnippet ()
-  "Return the ??"
+  "Get current keys's binding as if YASsnippet didn't exist."
   (let* ((yas-minor-mode nil)
          (yas--direct-keymaps nil)
          (keys (this-single-command-keys)))
@@ -2730,22 +2768,29 @@ and `kill-buffer' instead."
 ;;; User convenience functions, for using in `yas-key-syntaxes'
 
 (defun yas-try-key-from-whitespace (_start-point)
-  "Go back to nearest whitespace.
+  "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). Use as
-element of `yas-key-syntaxes'."
+marks it as something else (typically comment ender)."
   (skip-chars-backward "^[:space:]\n"))
 
 (defun yas-shortest-key-until-whitespace (_start-point)
-  "Return `again' until at whitespace.
+  "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). Use as
-element of `yas-key-syntaxes'."
-  (when (/= (skip-chars-backward "^[:space:]\n" (1- (point))) 0)
+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))
 
+
 \f
 ;;; User convenience functions, for using in snippet definitions
 
@@ -2987,12 +3032,14 @@ through the field's start point"
    ;; field must be zero length
    ;;
    (zerop (- (yas--field-start field) (yas--field-end field)))
-   ;; skip if:
+   ;; field must have been modified
+   ;;
+   (yas--field-modified-p field)
+   ;; either:
    (or
-    ;;  1) is a nested field and it's been modified
+    ;;  1) it's a nested field
     ;;
-    (and (yas--field-parent-field field)
-         (yas--field-modified-p field))
+    (yas--field-parent-field field)
     ;;  2) ends just before the snippet end
     ;;
     (and (eq field (car (last (yas--snippet-fields snippet))))
@@ -3449,8 +3496,14 @@ The error should be ignored in `debug-ignored-errors'"
   (unless yas--inhibit-overlay-hooks
     (cond ((not (or after?
                     (yas--undo-in-progress)))
-           (setq yas--protection-violation (point))
-           (error "Exit the snippet first!")))))
+           (cond (t
+                  (let ((snippets (yas--snippets-at-point)))
+                    (yas--message 3 "Comitting snippets. Action would destroy a protection overlay.")
+                    (cl-loop for snippet in snippets
+                             do (yas--commit-snippet snippet))))
+                 (nil
+                  (setq yas--protection-violation (point))
+                  (error "Exit the snippet first!")))))))
 
 (add-to-list 'debug-ignored-errors "^Exit the snippet first!$")
 
@@ -3922,7 +3975,7 @@ Meant to be called in a narrowed buffer, does various passes"
         (n (line-beginning-position)))
     (while (or (eql c ?\ )
                (eql c ?\t))
-      (incf n)
+      (cl-incf n)
       (setq c (char-after n)))
     n))
 
@@ -4359,6 +4412,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))
 
@@ -4558,9 +4616,9 @@ can more or less safely rely upon them.")
 
 \f
 (provide 'yasnippet)
-
-;;; yasnippet.el ends here
 ;; Local Variables:
 ;; coding: utf-8
+;; indent-tabs-mode: nil
 ;; byte-compile-warnings: (not cl-functions)
 ;; End:
+;;; yasnippet.el ends here