[elpa] master 7761dee 128/177: Closes #497: Allow functions as elements in yas-key-syntaxes

[João Távora]

branch: master
commit 7761deeeb52b779b6c4fb7525aedced929099fbf
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    Closes #497: Allow functions as elements in yas-key-syntaxes
    
    * yasnippet.el (yas--templates-for-key-at-point): Renamed from
    `yas--current-key'.
    (yas-key-syntaxes): Overhaul documentation.
    (yas-expand-from-trigger-key): Use
    `yas--templates-for-key-at-point'.
    
    * yasnippet-tests.el (complicated-yas-key-syntaxes): New test.
    (yas-should-expand, yas-should-not-expand): Friendlier failure
    message.
---
 yasnippet-tests.el |   46 +++++++++++++++++++--
 yasnippet.el       |  115 +++++++++++++++++++++++++++++++++-------------------
 2 files changed, 115 insertions(+), 46 deletions(-)

diff --git a/yasnippet-tests.el b/yasnippet-tests.el
index 38aefc1..f40ed25 100644
--- a/yasnippet-tests.el
+++ b/yasnippet-tests.el
@@ -313,6 +313,37 @@ TODO: correct this bug!"
     (should (string= (yas--buffer-contents)
                      "brother from another mother") ;; no newline should be 
here!
             )))
+
+;; See issue #497. To understand this test, follow the example of the
+;; `yas-key-syntaxes' docstring.
+;; 
+(ert-deftest complicated-yas-key-syntaxes ()
+  (with-temp-buffer
+    (yas-saving-variables
+     (yas-with-snippet-dirs
+       '((".emacs.d/snippets"
+          ("text-mode"
+           ("foo-barbaz" . "# condition: yas--foobarbaz\n# --\nOKfoo-barbazOK")
+           ("barbaz" . "# condition: yas--barbaz\n# --\nOKbarbazOK")
+           ("baz" . "OKbazOK"))))
+       (yas-reload-all)
+       (text-mode)
+       (yas-minor-mode-on)
+       (let ((yas-key-syntaxes '("w" "w_")))
+         (let ((yas--barbaz t))
+           (yas-should-expand '(("foo-barbaz" . "foo-OKbarbazOK")
+                                ("barbaz" . "OKbarbazOK"))))
+         (let ((yas--foobarbaz t))
+           (yas-should-expand '(("foo-barbaz" . "OKfoo-barbazOK"))))
+         (let ((yas-key-syntaxes
+                (cons #'(lambda ()
+                          (unless (looking-back "-")
+                            (backward-char)
+                            'again))
+                      yas-key-syntaxes))
+               (yas--foobarbaz t))
+           (yas-should-expand '(("foo-barbaz" . "foo-barOKbazOK")))))))))
+
 
 ;;; Loading
 ;;;
@@ -656,21 +687,28 @@ add the snippets associated with the given mode."
 (defun yas-should-expand (keys-and-expansions)
   (dolist (key-and-expansion keys-and-expansions)
     (yas-exit-all-snippets)
-    (erase-buffer)
+    (narrow-to-region (point) (point))
     (insert (car key-and-expansion))
     (let ((yas-fallback-behavior nil))
       (ert-simulate-command '(yas-expand)))
-    (should (string= (yas--buffer-contents) (cdr key-and-expansion))))
+    (unless (string= (yas--buffer-contents) (cdr key-and-expansion))
+      (ert-fail (format "\"%s\" should have expanded to \"%s\" but got \"%s\""
+                        (car key-and-expansion)
+                        (cdr key-and-expansion)
+                        (yas--buffer-contents)))))
   (yas-exit-all-snippets))
 
 (defun yas-should-not-expand (keys)
   (dolist (key keys)
     (yas-exit-all-snippets)
-    (erase-buffer)
+    (narrow-to-region (point) (point))
     (insert key)
     (let ((yas-fallback-behavior nil))
       (ert-simulate-command '(yas-expand)))
-    (should (string= (yas--buffer-contents) key))))
+    (unless (string= (yas--buffer-contents) key)
+      (ert-fail (format "\"%s\" should have stayed put, but instead expanded 
to \"%s\""
+                        key
+                        (yas--buffer-contents))))))
 
 (defun yas-mock-insert (string)
   (interactive)
diff --git a/yasnippet.el b/yasnippet.el
index 39b4c0e..ae55883 100644
--- a/yasnippet.el
+++ b/yasnippet.el
@@ -389,19 +389,43 @@ the trigger key itself."
   "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
+  "Syntaxes and functions to help look for trigger keys before point.
+
+Its elements can be either strings or functions (see below for
+the difference) and are tried in order by the snippet expansion
+mechanism until one or more expandable snippets are found.
+
+Each element is a way to skip buffer positions backwards and look
+for the start of a trigger key. 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.
+
+If no expandable snippets are found but the function returns the
+symbol `try-again' it will be called again from the previous
+position and may again reposition point until it returns some
+other value.
+
+The buffer's string starting at the resulting position and ending
+at the original point is matched against the active snippet
+tables.
+
+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
   '()
@@ -1193,32 +1217,40 @@ 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)
+                           '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))))
+      (when templates
+        (list templates (point) original)))))
 
 (defun yas--table-all-keys (table)
   "Get trigger keys of all active snippets in TABLE."
@@ -2137,13 +2169,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 ()