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

@@ -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)

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.
+  "Syntaxes and functions to help look for trigger keys before point.
-The list is tried in the order while scanning characters
+
-backwards from point.  For example, if the list is '(\"w\" \"w_\")
+Its elements can be either strings or functions (see below for
-first look for trigger keys which are composed exclusively of
+the difference) and are tried in order by the snippet expansion
-\"word\"-syntax characters, and then, if that fails, look for
+mechanism until one or more expandable snippets are found.
-keys which are either of \"word\" or \"symbol\"
+
-syntax.  Triggering after
+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
+will, according to the \"w\" element first try \"barbaz\". If
-isn't a trigger key, \"foo-bar\" is tried, respecting a second
+that isn't a trigger key, \"foo-barbaz\" is tried, respecting the
-\"w_\" element.")
+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 ()
+(defun yas--templates-for-key-at-point ()
-  "Get the key under current position.
+  "Find `yas--template' objects for any trigger keys preceding point.
-A key is used to find the template of a snippet in the current snippet-table."
+Returns (TEMPLATES START END). This function respects
-  (let ((start (point))
+`yas-key-syntaxes', which see."
-        (end (point))
+  (save-excursion
-        (syntaxes yas-key-syntaxes)
+    (let ((original (point))
-        syntax
+          (methods yas-key-syntaxes)
-        done
+          (templates)
-        templates)
+          (method))
-    (while (and (not done) syntaxes)
+      (while (and methods
-      (setq syntax (car syntaxes))
+                  (not templates))
-      (setq syntaxes (cdr syntaxes))
+        (unless (eq method (car methods))
-      (save-excursion
+          ;; TRICKY: `eq'-ness test means we can only be here if
-        (skip-syntax-backward syntax)
+          ;; `method' is a function that returned `again', and hence
-        (setq start (point)))
+          ;; don't revert back to original position as per
-      (setq templates
+          ;; `yas-key-syntaxes'.
-            (mapcan #'(lambda (table)
+          (goto-char original))
-                        (yas--fetch table (buffer-substring-no-properties start end)))
+        (setq method (car methods))
-                    (yas--get-snippet-tables)))
+        (cond ((stringp method)
-      (if templates
+               (skip-syntax-backward method)
-          (setq done t)
+               (setq methods (cdr methods)))
-        (setq start end)))
+              ((functionp method)
-    (list templates
+               (unless (eq (funcall method)
-          start
+                           'again)
-          end)))
+                 (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--templates-for-key-at-point))
-                                (yas--current-key))))
+                                (yas--templates-for-key-at-point))))
-    (if (and templates-and-pos
+    (if templates-and-pos
-             (first templates-and-pos))
         (yas--expand-or-prompt-for-template (first templates-and-pos)
-                                           (second templates-and-pos)
+                                            (second templates-and-pos)
-                                           (third templates-and-pos))
+                                            (third templates-and-pos))
       (yas--fallback))))
 
 (defun yas-expand-from-keymap ()