]> code.delx.au - gnu-emacs-elpa/blobdiff - yasnippet.el
Prevent disabling errors from recent `yas-current-syntaxes` logic
[gnu-emacs-elpa] / yasnippet.el
index 43564ffbac78e6858502929fec7ed2d1342ee78e..821e748447d349890d2434d630794129f304c4ab 100644 (file)
@@ -388,20 +388,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 +723,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 +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 original)
+                           'again)
+                 (setq methods (cdr methods))))
+              (t
+               (yas--warning "Warning invalid element %s in `yas-key-syntaxes'" method)))
+        (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."
@@ -1697,8 +1730,10 @@ the current buffers contents."
 
 Below TOP-LEVEL-DIR each directory should be a mode name.
 
-Optional USE-JIT use jit-loading of snippets."
-  (interactive "DSelect the root directory: ni\np")
+With prefix argument USE-JIT do jit-loading of snippets."
+  (interactive
+   (list (read-directory-name "Select the root directory: " nil nil t)
+         current-prefix-arg t))
   (unless yas-snippet-dirs
     (setq yas-snippet-dirs top-level-dir))
   (dolist (dir (yas--subdirs top-level-dir))
@@ -1791,13 +1826,16 @@ prompt the user to select one."
       (call-interactively 'yas-load-directory))
     errors))
 
-(defun yas-reload-all (&optional interactive)
+(defun yas-reload-all (&optional no-jit interactive)
   "Reload all snippets and rebuild the YASnippet menu.
 
-When called interactively force immediate reload of all known
+When NO-JIT is non-nil force immediate reload of all known
 snippets under `yas-snippet-dirs', otherwise use just-in-time
-loading."
-  (interactive "p")
+loading.
+
+When called interactively, use just-in-time loading when given a
+prefix argument."
+  (interactive (list (not current-prefix-arg) t))
   (catch 'abort
     (let ((errors)
           (snippet-editing-buffers
@@ -1842,14 +1880,14 @@ loading."
       ;; Reload the directories listed in `yas-snippet-dirs' or prompt
       ;; the user to select one.
       ;;
-      (setq errors (yas--load-snippet-dirs interactive))
+      (setq errors (yas--load-snippet-dirs no-jit))
       ;; Reload the direct keybindings
       ;;
       (yas-direct-keymaps-reload)
 
       (run-hooks 'yas-after-reload-hook)
       (yas--message 3 "Reloaded everything%s...%s."
-                   (if interactive "" " (snippets will load just-in-time)")
+                   (if no-jit "" " (snippets will load just-in-time)")
                    (if errors " (some errors, check *Messages*)" "")))))
 
 (defvar yas-after-reload-hook nil
@@ -2131,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 ()
@@ -2689,6 +2726,33 @@ and `kill-buffer' instead."
      groups-hash)))
 
 
+\f
+;;; 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))
+
+
 \f
 ;;; User convenience functions, for using in snippet definitions
 
@@ -3911,9 +3975,11 @@ with their evaluated value into `yas--backquote-markers-and-strings'."
       (goto-char (match-beginning 0))
       (when transformed
         (let ((marker (make-marker)))
-          (insert "Y") ;; quite horrendous, I love it :)
-          (set-marker marker (point))
-          (insert "Y")
+          (save-restriction
+            (widen)
+            (insert "Y") ;; quite horrendous, I love it :)
+            (set-marker marker (point))
+            (insert "Y"))
           (push (cons marker transformed) yas--backquote-markers-and-strings))))))
 
 (defun yas--restore-backquotes ()
@@ -3924,9 +3990,11 @@ with their evaluated value into `yas--backquote-markers-and-strings'."
            (string (cdr marker-and-string)))
       (save-excursion
         (goto-char marker)
-        (delete-char -1)
-        (insert string)
-        (delete-char 1)
+        (save-restriction
+          (widen)
+          (delete-char -1)
+          (insert string)
+          (delete-char 1))
         (set-marker marker nil)))))
 
 (defun yas--scan-sexps (from count)
@@ -4298,6 +4366,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))